Mercurial > openid
comparison 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 |
comparison
equal
deleted
inserted
replaced
27:f129ddee75f3 | 28:fcd3a977d77b |
---|---|
2 | 2 |
3 style aol | 3 style aol |
4 style google | 4 style google |
5 style myspace | 5 style myspace |
6 style yahoo | 6 style yahoo |
7 | |
8 datatype choose_result a = Success of a | Failure of string | |
7 | 9 |
8 functor Make(M: sig | 10 functor Make(M: sig |
9 con cols :: {Type} | 11 con cols :: {Type} |
10 constraint [Id] ~ cols | 12 constraint [Id] ~ cols |
11 val folder : folder cols | 13 val folder : folder cols |
15 type creationData | 17 type creationData |
16 val creationState : transaction creationState | 18 val creationState : transaction creationState |
17 val render : creationState -> xtable | 19 val render : creationState -> xtable |
18 val ready : creationState -> signal bool | 20 val ready : creationState -> signal bool |
19 val tabulate : creationState -> signal creationData | 21 val tabulate : creationState -> signal creationData |
20 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] -> creationData -> transaction $cols | 22 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] -> creationData -> transaction (choose_result $cols) |
21 | 23 |
22 val sessionLifetime : int | 24 val sessionLifetime : int |
23 val afterLogout : url | 25 val afterLogout : url |
24 val secureCookies : bool | 26 val secureCookies : bool |
25 val association : Openid.association_mode | 27 val association : Openid.association_mode |
27 val formClass : css_class | 29 val formClass : css_class |
28 val fakeId : option string | 30 val fakeId : option string |
29 end) = struct | 31 end) = struct |
30 | 32 |
31 type user = string | 33 type user = string |
34 val eq_user = _ | |
35 val read_user = _ | |
32 val show_user = _ | 36 val show_user = _ |
33 val inj_user = _ | 37 val inj_user = _ |
34 | 38 |
35 table user : ([Id = user] ++ M.cols) | 39 table user : ([Id = user] ++ M.cols) |
36 PRIMARY KEY Id | 40 PRIMARY KEY Id |
110 AND session.Key = {[ses.Key]}); | 114 AND session.Key = {[ses.Key]}); |
111 case ident of | 115 case ident of |
112 None => return (Some "Invalid session data") | 116 None => return (Some "Invalid session data") |
113 | Some None => return (Some "Session has no associated identifier") | 117 | Some None => return (Some "Session has no associated identifier") |
114 | Some (Some ident) => | 118 | Some (Some ident) => |
115 setCookie auth {Value = LoggedIn ({User = uid} ++ ses), | |
116 Expires = None, | |
117 Secure = M.secureCookies}; | |
118 | |
119 cols <- M.choose user data; | 119 cols <- M.choose user data; |
120 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols)); | 120 case cols of |
121 dml (INSERT INTO identity (User, Identifier) | 121 Failure s => return (Some s) |
122 VALUES ({[uid]}, {[ident]})); | 122 | Success cols => |
123 redirect (bless after) | 123 setCookie auth {Value = LoggedIn ({User = uid} ++ ses), |
124 Expires = None, | |
125 Secure = M.secureCookies}; | |
126 | |
127 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols)); | |
128 dml (INSERT INTO identity (User, Identifier) | |
129 VALUES ({[uid]}, {[ident]})); | |
130 redirect (bless after) | |
124 in | 131 in |
125 uid <- source ""; | 132 uid <- source ""; |
126 cs <- M.creationState; | 133 cs <- M.creationState; |
127 | 134 |
128 wrap "Your User Details" <xml> | 135 wrap "Your User Details" <xml> |