comparison src/ur/openidUser.ur @ 54:1876aa854263

Merge from upstream.
author Karn Kallio <kkallio@eka>
date Mon, 04 Jul 2011 10:36:15 -0430
parents 72e942423f26
children 9c83592de908 328a429dfedb
comparison
equal deleted inserted replaced
53:ac1f1d44560d 54:1876aa854263
82 val currentUrl = 82 val currentUrl =
83 b <- currentUrlHasPost; 83 b <- currentUrlHasPost;
84 if b then 84 if b then
85 return M.afterLogout 85 return M.afterLogout
86 else 86 else
87 currentUrl 87 b <- currentUrlHasQueryString;
88 if b then
89 return M.afterLogout
90 else
91 currentUrl
88 92
89 val current = 93 val current =
90 login <- getCookie auth; 94 login <- getCookie auth;
91 case login of 95 case login of
92 Some (LoggedIn login) => 96 Some (LoggedIn login) =>
114 fun main wrap = 118 fun main wrap =
115 let 119 let
116 fun logout () = 120 fun logout () =
117 clearCookie auth; 121 clearCookie auth;
118 redirect M.afterLogout 122 redirect M.afterLogout
123
124 fun newSession identO =
125 ses <- nextval sessionIds;
126 now <- now;
127 key <- rand;
128 dml (INSERT INTO session (Id, Key, Identifier, Expires)
129 VALUES ({[ses]}, {[key]}, {[identO]}, {[addSeconds now M.sessionLifetime]}));
130 return {Session = ses, Key = key}
119 131
120 fun signupDetails after = 132 fun signupDetails after =
121 let 133 let
122 fun finishSignup uid data = 134 fun finishSignup uid data =
123 if not (validUser uid) then 135 if not (validUser uid) then
144 | Some (Some ident) => 156 | Some (Some ident) =>
145 cols <- M.choose user data; 157 cols <- M.choose user data;
146 case cols of 158 case cols of
147 Failure s => return (Some s) 159 Failure s => return (Some s)
148 | Success cols => 160 | Success cols =>
161 dml (DELETE FROM session
162 WHERE Id = {[ses.Session]});
163 ses <- newSession (Some ident);
149 setCookie auth {Value = LoggedIn ({User = uid} ++ ses), 164 setCookie auth {Value = LoggedIn ({User = uid} ++ ses),
150 Expires = None, 165 Expires = None,
151 Secure = M.secureCookies}; 166 Secure = M.secureCookies};
152 167
153 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols)); 168 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols));
193 WHERE session.Id = {[signup.Session]} 208 WHERE session.Id = {[signup.Session]}
194 AND session.Key = {[signup.Key]}); 209 AND session.Key = {[signup.Key]});
195 if invalid then 210 if invalid then
196 error <xml>Invalid or expired session</xml> 211 error <xml>Invalid or expired session</xml>
197 else 212 else
198 dml (UPDATE session 213 dml (DELETE FROM session
199 SET Identifier = {[Some ident]}
200 WHERE Id = {[signup.Session]}); 214 WHERE Id = {[signup.Session]});
215 ses <- newSession (Some ident);
216 setCookie auth {Value = SigningUp ses,
217 Expires = None,
218 Secure = M.secureCookies};
201 signupDetails after 219 signupDetails after
202 | Some (LoggedIn login) => 220 | Some (LoggedIn login) =>
203 if login.Session <> ses then 221 if login.Session <> ses then
204 error <xml>Session has changed suspiciously</xml> 222 error <xml>Session has changed suspiciously</xml>
205 else 223 else
208 WHERE session.Id = {[login.Session]} 226 WHERE session.Id = {[login.Session]}
209 AND session.Key = {[login.Key]}); 227 AND session.Key = {[login.Key]});
210 if invalid then 228 if invalid then
211 error <xml>Invalid or expired session</xml> 229 error <xml>Invalid or expired session</xml>
212 else 230 else
213 dml (UPDATE session 231 dml (DELETE FROM session
214 SET Identifier = {[Some ident]}
215 WHERE Id = {[login.Session]}); 232 WHERE Id = {[login.Session]});
233 ses <- newSession (Some ident);
234 setCookie auth {Value = LoggedIn ({User = login.User} ++ ses),
235 Expires = None,
236 Secure = M.secureCookies};
216 redirect (bless after) 237 redirect (bless after)
217 | None => error <xml>Missing session cookie</xml> 238 | None => error <xml>Missing session cookie</xml>
218 239
219 fun fakeCallback ident after ses = 240 fun fakeCallback ident after ses =
220 av <- getCookie auth; 241 av <- getCookie auth;
243 SET Identifier = {[Some ident]} 264 SET Identifier = {[Some ident]}
244 WHERE Id = {[login.Session]}); 265 WHERE Id = {[login.Session]});
245 redirect (bless after) 266 redirect (bless after)
246 | None => error <xml>Missing session cookie</xml> 267 | None => error <xml>Missing session cookie</xml>
247 268
248 fun newSession () =
249 ses <- nextval sessionIds;
250 now <- now;
251 key <- rand;
252 dml (INSERT INTO session (Id, Key, Identifier, Expires)
253 VALUES ({[ses]}, {[key]}, NULL, {[addSeconds now M.sessionLifetime]}));
254 return {Session = ses, Key = key}
255
256 fun logon after r = 269 fun logon after r =
257 ident <- oneOrNoRowsE1 (SELECT (identity.Identifier) 270 ident <- oneOrNoRowsE1 (SELECT (identity.Identifier)
258 FROM identity 271 FROM identity
259 WHERE identity.User = {[r.User]} 272 WHERE identity.User = {[r.User]}
260 LIMIT 1); 273 LIMIT 1);
261 case ident of 274 case ident of
262 None => error <xml>Username not found</xml> 275 None => error <xml>Username not found</xml>
263 | Some ident => 276 | Some ident =>
264 ses <- newSession (); 277 ses <- newSession None;
265 setCookie auth {Value = LoggedIn (r ++ ses), 278 setCookie auth {Value = LoggedIn (r ++ ses),
266 Expires = None, 279 Expires = None,
267 Secure = M.secureCookies}; 280 Secure = M.secureCookies};
268 ses <- return ses.Session; 281 ses <- return ses.Session;
269 if M.fakeId = Some ident then 282 if M.fakeId = Some ident then
274 Realm = M.realm, 287 Realm = M.realm,
275 Identifier = Openid.KnownIdentifier ident}; 288 Identifier = Openid.KnownIdentifier ident};
276 error <xml>Login with your identity provider failed: {[msg]}</xml> 289 error <xml>Login with your identity provider failed: {[msg]}</xml>
277 290
278 fun doSignup after r = 291 fun doSignup after r =
279 ses <- newSession (); 292 ses <- newSession None;
280 setCookie auth {Value = SigningUp ses, 293 setCookie auth {Value = SigningUp ses,
281 Expires = None, 294 Expires = None,
282 Secure = M.secureCookies}; 295 Secure = M.secureCookies};
283 ses <- return ses.Session; 296 ses <- return ses.Session;
284 if M.fakeId = Some r.Identifier then 297 if M.fakeId = Some r.Identifier then