Mercurial > openid

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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>