Mercurial > openid
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;