diff src/ur/openidUser.ur @ 28:fcd3a977d77b

More type class instances for user type; allow choose to fail
author Adam Chlipala <adam@chlipala.net>
date Thu, 24 Feb 2011 17:29:05 -0500
parents f129ddee75f3
children 5d6337df5ec7 43f921ee8ee5
line wrap: on
line diff
--- a/src/ur/openidUser.ur	Sun Jan 23 17:40:42 2011 -0500
+++ b/src/ur/openidUser.ur	Thu Feb 24 17:29:05 2011 -0500
@@ -5,6 +5,8 @@
 style myspace
 style yahoo
 
+datatype choose_result a = Success of a | Failure of string
+
 functor Make(M: sig
                  con cols :: {Type}
                  constraint [Id] ~ cols
@@ -17,7 +19,7 @@
                  val render : creationState -> xtable
                  val ready : creationState -> signal bool
                  val tabulate : creationState -> signal creationData
-                 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] -> creationData -> transaction $cols
+                 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] -> creationData -> transaction (choose_result $cols)
 
                  val sessionLifetime : int
                  val afterLogout : url
@@ -29,6 +31,8 @@
              end) = struct
 
     type user = string
+    val eq_user = _
+    val read_user = _
     val show_user = _
     val inj_user = _
 
@@ -112,15 +116,18 @@
                                         None => return (Some "Invalid session data")
                                       | Some None => return (Some "Session has no associated identifier")
                                       | Some (Some ident) =>
-                                        setCookie auth {Value = LoggedIn ({User = uid} ++ ses),
-                                                        Expires = None,
-                                                        Secure = M.secureCookies};
+                                        cols <- M.choose user data;
+                                        case cols of
+                                            Failure s => return (Some s)
+                                          | Success cols =>
+                                            setCookie auth {Value = LoggedIn ({User = uid} ++ ses),
+                                                            Expires = None,
+                                                            Secure = M.secureCookies};
 
-                                        cols <- M.choose user data;
-                                        dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols));
-                                        dml (INSERT INTO identity (User, Identifier)
-                                             VALUES ({[uid]}, {[ident]}));
-                                        redirect (bless after)
+                                            dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols));
+                                            dml (INSERT INTO identity (User, Identifier)
+                                                 VALUES ({[uid]}, {[ident]}));
+                                            redirect (bless after)
                 in
                     uid <- source "";
                     cs <- M.creationState;