Mercurial > openid

comparison src/ur/openidUser.ur @ 22:70ab0230649b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix calculation of URL to return to after sign-up
author Adam Chlipala <adam@chlipala.net>
date Sat, 15 Jan 2011 15:24:42 -0500
parents 354dae3008de
children e5df3d3554d3
comparison
equal deleted inserted replaced
21:354dae3008de 22:70ab0230649b
33 sequence sessionIds 33 sequence sessionIds
34 34
35 table session : {Id : int, Key : int, Identifier : option string, Expires : time} 35 table session : {Id : int, Key : int, Identifier : option string, Expires : time}
36 PRIMARY KEY Id 36 PRIMARY KEY Id
37 37
38 cookie signingUp : {Session : int, Key : int} 38 datatype authMode =
39 cookie login : {User : user, Session : int, Key : int} 39 SigningUp of {Session : int, Key : int}
40 | LoggedIn of {User : user, Session : int, Key : int}
41
42 cookie auth : authMode
40 43
41 val currentUrl = 44 val currentUrl =
42 b <- currentUrlHasPost; 45 b <- currentUrlHasPost;
43 if b then 46 if b then
44 return M.afterLogout 47 return M.afterLogout
45 else 48 else
46 currentUrl 49 currentUrl
47 50
48 val current = 51 val current =
49 login <- getCookie login; 52 login <- getCookie auth;
50 case login of 53 case login of
51 None => return None 54 Some (LoggedIn login) =>
52 | Some login => 55 (ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
53 ident <- oneOrNoRowsE1 (SELECT (session.Identifier) 56 FROM session
54 FROM session 57 WHERE session.Id = {[login.Session]}
55 WHERE session.Id = {[login.Session]} 58 AND session.Key = {[login.Key]});
56 AND session.Key = {[login.Key]}); 59 case ident of
57 case ident of 60 None => return None
58 None => return None 61 | Some None => return None
59 | Some None => return None 62 | Some (Some ident) =>
60 | Some (Some ident) => 63 valid <- oneRowE1 (SELECT COUNT( * ) > 0
61 valid <- oneRowE1 (SELECT COUNT( * ) > 0 64 FROM identity
62 FROM identity 65 WHERE identity.User = {[login.User]}
63 WHERE identity.User = {[login.User]} 66 AND identity.Identifier = {[ident]});
64 AND identity.Identifier = {[ident]}); 67 if valid then
65 if valid then 68 return (Some login.User)
66 return (Some login.User) 69 else
67 else 70 error <xml>Session not authorized to act as user</xml>)
68 error <xml>Session not authorized to act as user</xml> 71 | _ => return None
69 72
70 fun validUser s = String.length s > 0 && String.length s < 20 73 fun validUser s = String.length s > 0 && String.length s < 20
71 && String.all Char.isAlnum s 74 && String.all Char.isAlnum s
72 75
73 fun main wrap = 76 fun main wrap =
74 let 77 let
75 fun logout () = 78 fun logout () =
76 clearCookie login; 79 clearCookie auth;
77 redirect M.afterLogout 80 redirect M.afterLogout
78 81
79 fun signupDetails after = 82 fun signupDetails after =
80 let 83 let
81 fun finishSignup uid data = 84 fun finishSignup uid data =
86 FROM user 89 FROM user
87 WHERE user.Id = {[uid]}); 90 WHERE user.Id = {[uid]});
88 if used then 91 if used then
89 return (Some "That username is taken. Please choose another.") 92 return (Some "That username is taken. Please choose another.")
90 else 93 else
91 ses <- getCookie signingUp; 94 ses <- getCookie auth;
92 case ses of 95 case ses of
93 None => return (Some "Missing session cookie") 96 None => return (Some "Missing session cookie")
94 | Some ses => 97 | Some (LoggedIn _) => return (Some "Session cookie is for already logged-in user")
98 | Some (SigningUp ses) =>
95 ident <- oneOrNoRowsE1 (SELECT (session.Identifier) 99 ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
96 FROM session 100 FROM session
97 WHERE session.Id = {[ses.Session]} 101 WHERE session.Id = {[ses.Session]}
98 AND session.Key = {[ses.Key]}); 102 AND session.Key = {[ses.Key]});
99 case ident of 103 case ident of
100 None => return (Some "Invalid session data") 104 None => return (Some "Invalid session data")
101 | Some None => return (Some "Session has no associated identifier") 105 | Some None => return (Some "Session has no associated identifier")
102 | Some (Some ident) => 106 | Some (Some ident) =>
103 clearCookie signingUp; 107 setCookie auth {Value = LoggedIn ({User = uid} ++ ses),
104 setCookie login {Value = {User = uid} ++ ses, 108 Expires = None,
105 Expires = None, 109 Secure = M.secureCookies};
106 Secure = M.secureCookies};
107 110
108 cols <- M.choose user data; 111 cols <- M.choose user data;
109 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols)); 112 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols));
110 dml (INSERT INTO identity (User, Identifier) 113 dml (INSERT INTO identity (User, Identifier)
111 VALUES ({[uid]}, {[ident]})); 114 VALUES ({[uid]}, {[ident]}));
136 fun opCallback after ses res = 139 fun opCallback after ses res =
137 case res of 140 case res of
138 Openid.Canceled => error <xml>You canceled the login process.</xml> 141 Openid.Canceled => error <xml>You canceled the login process.</xml>
139 | Openid.Failure s => error <xml>Login failed: {[s]}</xml> 142 | Openid.Failure s => error <xml>Login failed: {[s]}</xml>
140 | Openid.AuthenticatedAs ident => 143 | Openid.AuthenticatedAs ident =>
141 signup <- getCookie signingUp; 144 av <- getCookie auth;
142 case signup of 145 case av of
143 Some signup => 146 Some (SigningUp signup) =>
144 if signup.Session <> ses then 147 if signup.Session <> ses then
145 error <xml>Session has changed suspiciously</xml> 148 error <xml>Session has changed suspiciously</xml>
146 else 149 else
147 invalid <- oneRowE1 (SELECT COUNT( * ) = 0 150 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
148 FROM session 151 FROM session
153 else 156 else
154 dml (UPDATE session 157 dml (UPDATE session
155 SET Identifier = {[Some ident]} 158 SET Identifier = {[Some ident]}
156 WHERE Id = {[signup.Session]}); 159 WHERE Id = {[signup.Session]});
157 signupDetails after 160 signupDetails after
158 | None => 161 | Some (LoggedIn login) =>
159 login <- getCookie login; 162 if login.Session <> ses then
160 case login of 163 error <xml>Session has changed suspiciously</xml>
161 None => error <xml>Missing session cookie</xml> 164 else
162 | Some login => 165 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
163 if login.Session <> ses then 166 FROM session
164 error <xml>Session has changed suspiciously</xml> 167 WHERE session.Id = {[login.Session]}
168 AND session.Key = {[login.Key]});
169 if invalid then
170 error <xml>Invalid or expired session</xml>
165 else 171 else
166 invalid <- oneRowE1 (SELECT COUNT( * ) = 0 172 dml (UPDATE session
167 FROM session 173 SET Identifier = {[Some ident]}
168 WHERE session.Id = {[login.Session]} 174 WHERE Id = {[login.Session]});
169 AND session.Key = {[login.Key]}); 175 redirect (bless after)
170 if invalid then 176 | None => error <xml>Missing session cookie</xml>
171 error <xml>Invalid or expired session</xml>
172 else
173 dml (UPDATE session
174 SET Identifier = {[Some ident]}
175 WHERE Id = {[login.Session]});
176 redirect (bless after)
177 177
178 fun newSession () = 178 fun newSession () =
179 ses <- nextval sessionIds; 179 ses <- nextval sessionIds;
180 now <- now; 180 now <- now;
181 key <- rand; 181 key <- rand;
190 LIMIT 1); 190 LIMIT 1);
191 case ident of 191 case ident of
192 None => error <xml>Username not found</xml> 192 None => error <xml>Username not found</xml>
193 | Some ident => 193 | Some ident =>
194 ses <- newSession (); 194 ses <- newSession ();
195 setCookie login {Value = r ++ ses, 195 setCookie auth {Value = LoggedIn (r ++ ses),
196 Expires = None, 196 Expires = None,
197 Secure = M.secureCookies}; 197 Secure = M.secureCookies};
198 ses <- return ses.Session; 198 ses <- return ses.Session;
199 msg <- Openid.authenticate (opCallback after ses) 199 msg <- Openid.authenticate (opCallback after ses)
200 {Association = M.association, 200 {Association = M.association,
201 Realm = M.realm, 201 Realm = M.realm,
202 Identifier = ident}; 202 Identifier = ident};
203 error <xml>Login with your identity provider failed: {[msg]}</xml> 203 error <xml>Login with your identity provider failed: {[msg]}</xml>
204 204
205 fun doSignup after r = 205 fun doSignup after r =
206 ses <- newSession (); 206 ses <- newSession ();
207 setCookie signingUp {Value = ses, 207 setCookie auth {Value = SigningUp ses,
208 Expires = None, 208 Expires = None,
209 Secure = M.secureCookies}; 209 Secure = M.secureCookies};
210 ses <- return ses.Session; 210 ses <- return ses.Session;
211 msg <- Openid.authenticate (opCallback after ses) 211 msg <- Openid.authenticate (opCallback after ses)
212 {Association = M.association, 212 {Association = M.association,
213 Realm = M.realm, 213 Realm = M.realm,
214 Identifier = r.Identifier}; 214 Identifier = r.Identifier};
215 error <xml>Login with your identity provider failed: {[msg]}</xml> 215 error <xml>Login with your identity provider failed: {[msg]}</xml>
216 216
217 fun signup () = 217 fun signup after =
218 after <- currentUrl;
219 wrap "Account Signup" <xml> 218 wrap "Account Signup" <xml>
220 <form> 219 <form>
221 OpenID Identifier: <textbox{#Identifier}/><br/> 220 OpenID Identifier: <textbox{#Identifier}/><br/>
222 <submit value="Sign Up" action={doSignup (show after)}/> 221 <submit value="Sign Up" action={doSignup after}/>
223 </form> 222 </form>
224 </xml> 223 </xml>
225 in 224 in
226 cur <- current; 225 cur <- current;
227 here <- currentUrl; 226 here <- currentUrl;
228 case cur of 227 case cur of
229 Some cur => return <xml>Logged in as {[cur]}. <a link={logout ()}>[Log out]</a></xml> 228 Some cur => return <xml>Logged in as {[cur]}. <a link={logout ()}>[Log out]</a></xml>
230 | None => return <xml> 229 | None => return <xml>
231 <form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form> 230 <form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form>
232 <a link={signup ()}>Sign up</a> 231 <a link={signup (show here)}>Sign up</a>
233 </xml> 232 </xml>
234 end 233 end
235 234
236 task periodic 60 = fn () => dml (DELETE FROM session 235 task periodic 60 = fn () => dml (DELETE FROM session
237 WHERE Expires < CURRENT_TIMESTAMP) 236 WHERE Expires < CURRENT_TIMESTAMP)