Mercurial > openid

comparison src/ur/openidUser.ur @ 48:3f475c6fb168

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Make logout clear the session on the server (which necessitates turning it from a link into a button)
author Robin Green <greenrd@greenrd.org>
date Mon, 04 Jul 2011 14:08:00 +0100
parents f6b3fbf10dac
children 9c83592de908
comparison
equal deleted inserted replaced
44:f8c9e1e4d337 48:3f475c6fb168
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 =
112 && String.all Char.isAlnum s 114 && String.all Char.isAlnum s
113 115
114 fun main wrap = 116 fun main wrap =
115 let 117 let
116 fun logout () = 118 fun logout () =
119 login <- getCookie auth;
117 clearCookie auth; 120 clearCookie auth;
121 (case login of
122 Some (LoggedIn login) =>
123 dml (DELETE FROM session
124 WHERE Id = {[login.Session]}
125 AND Key = {[login.Key]})
126 | _ => return ());
118 redirect M.afterLogout 127 redirect M.afterLogout
119 128
120 fun signupDetails after = 129 fun signupDetails after =
121 let 130 let
122 fun finishSignup uid data = 131 fun finishSignup uid data =
322 cur <- current; 331 cur <- current;
323 here <- currentUrl; 332 here <- currentUrl;
324 333
325 case cur of 334 case cur of
326 Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>), 335 Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>),
327 Other = {Url = (url (logout ())), 336 Other = {Url = None,
328 Xml = (M.CtlDisplay.formatLogout (url (logout ())))}} 337 Xml = (M.CtlDisplay.formatLogout logout)}}
329 | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))), 338 | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))),
330 Other = {Url = (url (signup (show here))), 339 Other = {Url = Some (url (signup (show here))),
331 Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}} 340 Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}}
332 end 341 end
333 342
334 task periodic 60 = fn () => dml (DELETE FROM session 343 task periodic 60 = fn () => dml (DELETE FROM session
335 WHERE Expires < CURRENT_TIMESTAMP) 344 WHERE Expires < CURRENT_TIMESTAMP)