Mercurial > openid

comparison src/ur/openidUser.ur @ 51:a984dc1c8954

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge
author Adam Chlipala <adam@chlipala.net>
date Sun, 24 Jul 2011 10:51:35 -0400
parents 328a429dfedb 9c83592de908
children 9f392276d614
comparison
equal deleted inserted replaced
50:328a429dfedb 51:a984dc1c8954
7 7
8 datatype choose_result a = Success of a | Failure of string 8 datatype choose_result a = Success of a | Failure of string
9 9
10 signature CTLDISPLAY = sig 10 signature CTLDISPLAY = sig
11 val formatUser : xbody -> xbody 11 val formatUser : xbody -> xbody
12 val formatLogout : url -> xbody 12 val formatLogout : ($([]) -> transaction page) -> xbody
13 val formatSignup : url -> xbody 13 val formatSignup : url -> xbody
14 val formatLogon : ({User : string} -> transaction page) -> xbody 14 val formatLogon : ({User : string} -> transaction page) -> xbody
15 end 15 end
16 16
17 structure DefaultDisplay : CTLDISPLAY = struct 17 structure DefaultDisplay : CTLDISPLAY = struct
18 fun formatUser user = 18 fun formatUser user =
19 <xml>You are logged in as {user}.</xml> 19 <xml>You are logged in as {user}.</xml>
20 20
21 fun formatLogout url = 21 fun formatLogout handler =
22 <xml><a href={url}>Log Out</a></xml> 22 <xml>
23 <form><submit value="Logout" action={handler}/></form>
24 </xml>
23 25
24 fun formatSignup url = 26 fun formatSignup url =
25 <xml><a href={url}>Sign Up</a></xml> 27 <xml><a href={url}>Sign Up</a></xml>
26 28
27 fun formatLogon handler = 29 fun formatLogon handler =
125 && String.all Char.isAlnum s 127 && String.all Char.isAlnum s
126 128
127 fun main wrap = 129 fun main wrap =
128 let 130 let
129 fun logout () = 131 fun logout () =
132 login <- getCookie auth;
130 clearCookie auth; 133 clearCookie auth;
134 (case login of
135 Some (LoggedIn login) =>
136 dml (DELETE FROM session
137 WHERE Id = {[login.Session]}
138 AND Key = {[login.Key]})
139 | _ => return ());
131 redirect M.afterLogout 140 redirect M.afterLogout
132 141
133 fun newSession identO = 142 fun newSession identO =
134 ses <- nextval sessionIds; 143 ses <- nextval sessionIds;
135 now <- now; 144 now <- now;
344 cur <- current; 353 cur <- current;
345 here <- currentUrl; 354 here <- currentUrl;
346 355
347 case cur of 356 case cur of
348 Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>), 357 Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>),
349 Other = {Url = (url (logout ())), 358 Other = {Url = None,
350 Xml = (M.CtlDisplay.formatLogout (url (logout ())))}} 359 Xml = (M.CtlDisplay.formatLogout logout)}}
351 | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))), 360 | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))),
352 Other = {Url = (url (signup (show here))), 361 Other = {Url = Some (url (signup (show here))),
353 Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}} 362 Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}}
354 end 363 end
355 364
356 task periodic 60 = fn () => dml (DELETE FROM session 365 task periodic 60 = fn () => dml (DELETE FROM session
357 WHERE Expires < CURRENT_TIMESTAMP) 366 WHERE Expires < CURRENT_TIMESTAMP)