Mercurial > openid
comparison src/ur/openidUser.ur @ 51:a984dc1c8954
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) |