Mercurial > openid
diff src/ur/openidUser.ur @ 22:70ab0230649b
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 |
line wrap: on
line diff
--- a/src/ur/openidUser.ur Sat Jan 08 18:47:27 2011 -0500 +++ b/src/ur/openidUser.ur Sat Jan 15 15:24:42 2011 -0500 @@ -35,8 +35,11 @@ table session : {Id : int, Key : int, Identifier : option string, Expires : time} PRIMARY KEY Id - cookie signingUp : {Session : int, Key : int} - cookie login : {User : user, Session : int, Key : int} + datatype authMode = + SigningUp of {Session : int, Key : int} + | LoggedIn of {User : user, Session : int, Key : int} + + cookie auth : authMode val currentUrl = b <- currentUrlHasPost; @@ -46,26 +49,26 @@ currentUrl val current = - login <- getCookie login; + login <- getCookie auth; case login of - None => return None - | Some login => - ident <- oneOrNoRowsE1 (SELECT (session.Identifier) - FROM session - WHERE session.Id = {[login.Session]} - AND session.Key = {[login.Key]}); - case ident of - None => return None - | Some None => return None - | Some (Some ident) => - valid <- oneRowE1 (SELECT COUNT( * ) > 0 - FROM identity - WHERE identity.User = {[login.User]} - AND identity.Identifier = {[ident]}); - if valid then - return (Some login.User) - else - error <xml>Session not authorized to act as user</xml> + Some (LoggedIn login) => + (ident <- oneOrNoRowsE1 (SELECT (session.Identifier) + FROM session + WHERE session.Id = {[login.Session]} + AND session.Key = {[login.Key]}); + case ident of + None => return None + | Some None => return None + | Some (Some ident) => + valid <- oneRowE1 (SELECT COUNT( * ) > 0 + FROM identity + WHERE identity.User = {[login.User]} + AND identity.Identifier = {[ident]}); + if valid then + return (Some login.User) + else + error <xml>Session not authorized to act as user</xml>) + | _ => return None fun validUser s = String.length s > 0 && String.length s < 20 && String.all Char.isAlnum s @@ -73,7 +76,7 @@ fun main wrap = let fun logout () = - clearCookie login; + clearCookie auth; redirect M.afterLogout fun signupDetails after = @@ -88,10 +91,11 @@ if used then return (Some "That username is taken. Please choose another.") else - ses <- getCookie signingUp; + ses <- getCookie auth; case ses of None => return (Some "Missing session cookie") - | Some ses => + | Some (LoggedIn _) => return (Some "Session cookie is for already logged-in user") + | Some (SigningUp ses) => ident <- oneOrNoRowsE1 (SELECT (session.Identifier) FROM session WHERE session.Id = {[ses.Session]} @@ -100,10 +104,9 @@ None => return (Some "Invalid session data") | Some None => return (Some "Session has no associated identifier") | Some (Some ident) => - clearCookie signingUp; - setCookie login {Value = {User = uid} ++ ses, - Expires = None, - Secure = M.secureCookies}; + setCookie auth {Value = LoggedIn ({User = uid} ++ ses), + Expires = None, + Secure = M.secureCookies}; cols <- M.choose user data; dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols)); @@ -138,9 +141,9 @@ Openid.Canceled => error <xml>You canceled the login process.</xml> | Openid.Failure s => error <xml>Login failed: {[s]}</xml> | Openid.AuthenticatedAs ident => - signup <- getCookie signingUp; - case signup of - Some signup => + av <- getCookie auth; + case av of + Some (SigningUp signup) => if signup.Session <> ses then error <xml>Session has changed suspiciously</xml> else @@ -155,25 +158,22 @@ SET Identifier = {[Some ident]} WHERE Id = {[signup.Session]}); signupDetails after - | None => - login <- getCookie login; - case login of - None => error <xml>Missing session cookie</xml> - | Some login => - if login.Session <> ses then - error <xml>Session has changed suspiciously</xml> + | Some (LoggedIn login) => + if login.Session <> ses then + error <xml>Session has changed suspiciously</xml> + else + invalid <- oneRowE1 (SELECT COUNT( * ) = 0 + FROM session + WHERE session.Id = {[login.Session]} + AND session.Key = {[login.Key]}); + if invalid then + error <xml>Invalid or expired session</xml> else - invalid <- oneRowE1 (SELECT COUNT( * ) = 0 - FROM session - WHERE session.Id = {[login.Session]} - AND session.Key = {[login.Key]}); - if invalid then - error <xml>Invalid or expired session</xml> - else - dml (UPDATE session - SET Identifier = {[Some ident]} - WHERE Id = {[login.Session]}); - redirect (bless after) + dml (UPDATE session + SET Identifier = {[Some ident]} + WHERE Id = {[login.Session]}); + redirect (bless after) + | None => error <xml>Missing session cookie</xml> fun newSession () = ses <- nextval sessionIds; @@ -192,9 +192,9 @@ None => error <xml>Username not found</xml> | Some ident => ses <- newSession (); - setCookie login {Value = r ++ ses, - Expires = None, - Secure = M.secureCookies}; + setCookie auth {Value = LoggedIn (r ++ ses), + Expires = None, + Secure = M.secureCookies}; ses <- return ses.Session; msg <- Openid.authenticate (opCallback after ses) {Association = M.association, @@ -204,9 +204,9 @@ fun doSignup after r = ses <- newSession (); - setCookie signingUp {Value = ses, - Expires = None, - Secure = M.secureCookies}; + setCookie auth {Value = SigningUp ses, + Expires = None, + Secure = M.secureCookies}; ses <- return ses.Session; msg <- Openid.authenticate (opCallback after ses) {Association = M.association, @@ -214,12 +214,11 @@ Identifier = r.Identifier}; error <xml>Login with your identity provider failed: {[msg]}</xml> - fun signup () = - after <- currentUrl; + fun signup after = wrap "Account Signup" <xml> <form> OpenID Identifier: <textbox{#Identifier}/><br/> - <submit value="Sign Up" action={doSignup (show after)}/> + <submit value="Sign Up" action={doSignup after}/> </form> </xml> in @@ -229,7 +228,7 @@ Some cur => return <xml>Logged in as {[cur]}. <a link={logout ()}>[Log out]</a></xml> | None => return <xml> <form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form> - <a link={signup ()}>Sign up</a> + <a link={signup (show here)}>Sign up</a> </xml> end