Mercurial > openid

annotate 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
rev   line source
adam@16 1 functor Make(M: sig
adam@16 2 con cols :: {Type}
adam@16 3 constraint [Id] ~ cols
adam@17 4 val folder : folder cols
adam@17 5 val inj : $(map sql_injectable cols)
adam@17 6
adam@17 7 type creationState
adam@17 8 type creationData
adam@17 9 val creationState : transaction creationState
adam@17 10 val render : creationState -> xtable
adam@20 11 val ready : creationState -> signal bool
adam@17 12 val tabulate : creationState -> signal creationData
adam@17 13 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] -> creationData -> transaction $cols
adam@16 14
adam@16 15 val sessionLifetime : int
adam@16 16 val afterLogout : url
adam@16 17 val secureCookies : bool
adam@16 18 val association : Openid.association_mode
adam@16 19 val realm : option string
adam@17 20 val formClass : css_class
adam@16 21 end) = struct
adam@16 22
adam@16 23 type user = string
adam@16 24 val show_user = _
adam@16 25 val inj_user = _
adam@16 26
adam@16 27 table user : ([Id = user] ++ M.cols)
adam@16 28 PRIMARY KEY Id
adam@16 29
adam@16 30 table identity : {User : user, Identifier : string}
adam@16 31 PRIMARY KEY (User, Identifier)
adam@16 32
adam@16 33 sequence sessionIds
adam@16 34
adam@16 35 table session : {Id : int, Key : int, Identifier : option string, Expires : time}
adam@16 36 PRIMARY KEY Id
adam@16 37
adam@22 38 datatype authMode =
adam@22 39 SigningUp of {Session : int, Key : int}
adam@22 40 | LoggedIn of {User : user, Session : int, Key : int}
adam@22 41
adam@22 42 cookie auth : authMode
adam@16 43
adam@17 44 val currentUrl =
adam@17 45 b <- currentUrlHasPost;
adam@17 46 if b then
adam@17 47 return M.afterLogout
adam@17 48 else
adam@17 49 currentUrl
adam@17 50
adam@16 51 val current =
adam@22 52 login <- getCookie auth;
adam@16 53 case login of
adam@22 54 Some (LoggedIn login) =>
adam@22 55 (ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
adam@22 56 FROM session
adam@22 57 WHERE session.Id = {[login.Session]}
adam@22 58 AND session.Key = {[login.Key]});
adam@22 59 case ident of
adam@22 60 None => return None
adam@22 61 | Some None => return None
adam@22 62 | Some (Some ident) =>
adam@22 63 valid <- oneRowE1 (SELECT COUNT( * ) > 0
adam@22 64 FROM identity
adam@22 65 WHERE identity.User = {[login.User]}
adam@22 66 AND identity.Identifier = {[ident]});
adam@22 67 if valid then
adam@22 68 return (Some login.User)
adam@22 69 else
adam@22 70 error <xml>Session not authorized to act as user</xml>)
adam@22 71 | _ => return None
adam@16 72
adam@17 73 fun validUser s = String.length s > 0 && String.length s < 20
adam@17 74 && String.all Char.isAlnum s
adam@17 75
adam@16 76 fun main wrap =
adam@16 77 let
adam@16 78 fun logout () =
adam@22 79 clearCookie auth;
adam@16 80 redirect M.afterLogout
adam@16 81
adam@17 82 fun signupDetails after =
adam@17 83 let
adam@17 84 fun finishSignup uid data =
adam@17 85 if not (validUser uid) then
adam@17 86 return (Some "That username is not valid. It must be between 1 and 19 characters long, containing only letters and numbers.")
adam@17 87 else
adam@17 88 used <- oneRowE1 (SELECT COUNT( * ) > 0
adam@17 89 FROM user
adam@17 90 WHERE user.Id = {[uid]});
adam@17 91 if used then
adam@17 92 return (Some "That username is taken. Please choose another.")
adam@17 93 else
adam@22 94 ses <- getCookie auth;
adam@17 95 case ses of
adam@17 96 None => return (Some "Missing session cookie")
adam@22 97 | Some (LoggedIn _) => return (Some "Session cookie is for already logged-in user")
adam@22 98 | Some (SigningUp ses) =>
adam@17 99 ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
adam@17 100 FROM session
adam@17 101 WHERE session.Id = {[ses.Session]}
adam@17 102 AND session.Key = {[ses.Key]});
adam@17 103 case ident of
adam@17 104 None => return (Some "Invalid session data")
adam@17 105 | Some None => return (Some "Session has no associated identifier")
adam@17 106 | Some (Some ident) =>
adam@22 107 setCookie auth {Value = LoggedIn ({User = uid} ++ ses),
adam@22 108 Expires = None,
adam@22 109 Secure = M.secureCookies};
adam@17 110
adam@17 111 cols <- M.choose user data;
adam@17 112 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols));
adam@17 113 dml (INSERT INTO identity (User, Identifier)
adam@17 114 VALUES ({[uid]}, {[ident]}));
adam@17 115 redirect (bless after)
adam@17 116 in
adam@17 117 uid <- source "";
adam@17 118 cs <- M.creationState;
adam@17 119
adam@17 120 wrap "Your User Details" <xml>
adam@17 121 <table class={M.formClass}>
adam@17 122 <tr> <th class={M.formClass}>Username:</th> <td><ctextbox source={uid}/></td> </tr>
adam@17 123 {M.render cs}
adam@20 124 <tr> <td><dyn signal={b <- M.ready cs;
adam@20 125 return (if b then
adam@20 126 <xml><button value="Create Account"
adam@20 127 onclick={uid <- get uid;
adam@20 128 data <- Basis.current (M.tabulate cs);
adam@20 129 res <- rpc (finishSignup uid data);
adam@20 130 case res of
adam@20 131 None => redirect (bless after)
adam@20 132 | Some msg => alert msg}/></xml>
adam@20 133 else
adam@20 134 <xml/>)}/></td> </tr>
adam@17 135 </table>
adam@17 136 </xml>
adam@17 137 end
adam@17 138
adam@16 139 fun opCallback after ses res =
adam@16 140 case res of
adam@16 141 Openid.Canceled => error <xml>You canceled the login process.</xml>
adam@16 142 | Openid.Failure s => error <xml>Login failed: {[s]}</xml>
adam@16 143 | Openid.AuthenticatedAs ident =>
adam@22 144 av <- getCookie auth;
adam@22 145 case av of
adam@22 146 Some (SigningUp signup) =>
adam@16 147 if signup.Session <> ses then
adam@16 148 error <xml>Session has changed suspiciously</xml>
adam@16 149 else
adam@16 150 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@16 151 FROM session
adam@16 152 WHERE session.Id = {[signup.Session]}
adam@16 153 AND session.Key = {[signup.Key]});
adam@16 154 if invalid then
adam@16 155 error <xml>Invalid or expired session</xml>
adam@16 156 else
adam@17 157 dml (UPDATE session
adam@17 158 SET Identifier = {[Some ident]}
adam@17 159 WHERE Id = {[signup.Session]});
adam@17 160 signupDetails after
adam@22 161 | Some (LoggedIn login) =>
adam@22 162 if login.Session <> ses then
adam@22 163 error <xml>Session has changed suspiciously</xml>
adam@22 164 else
adam@22 165 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@22 166 FROM session
adam@22 167 WHERE session.Id = {[login.Session]}
adam@22 168 AND session.Key = {[login.Key]});
adam@22 169 if invalid then
adam@22 170 error <xml>Invalid or expired session</xml>
adam@16 171 else
adam@22 172 dml (UPDATE session
adam@22 173 SET Identifier = {[Some ident]}
adam@22 174 WHERE Id = {[login.Session]});
adam@22 175 redirect (bless after)
adam@22 176 | None => error <xml>Missing session cookie</xml>
adam@16 177
adam@16 178 fun newSession () =
adam@16 179 ses <- nextval sessionIds;
adam@16 180 now <- now;
adam@16 181 key <- rand;
adam@16 182 dml (INSERT INTO session (Id, Key, Identifier, Expires)
adam@16 183 VALUES ({[ses]}, {[key]}, NULL, {[addSeconds now M.sessionLifetime]}));
adam@16 184 return {Session = ses, Key = key}
adam@16 185
adam@17 186 fun logon after r =
adam@16 187 ident <- oneOrNoRowsE1 (SELECT (identity.Identifier)
adam@16 188 FROM identity
adam@16 189 WHERE identity.User = {[r.User]}
adam@16 190 LIMIT 1);
adam@16 191 case ident of
adam@16 192 None => error <xml>Username not found</xml>
adam@16 193 | Some ident =>
adam@16 194 ses <- newSession ();
adam@22 195 setCookie auth {Value = LoggedIn (r ++ ses),
adam@22 196 Expires = None,
adam@22 197 Secure = M.secureCookies};
adam@16 198 ses <- return ses.Session;
adam@16 199 msg <- Openid.authenticate (opCallback after ses)
adam@16 200 {Association = M.association,
adam@16 201 Realm = M.realm,
adam@16 202 Identifier = ident};
adam@16 203 error <xml>Login with your identity provider failed: {[msg]}</xml>
adam@16 204
adam@16 205 fun doSignup after r =
adam@16 206 ses <- newSession ();
adam@22 207 setCookie auth {Value = SigningUp ses,
adam@22 208 Expires = None,
adam@22 209 Secure = M.secureCookies};
adam@16 210 ses <- return ses.Session;
adam@16 211 msg <- Openid.authenticate (opCallback after ses)
adam@16 212 {Association = M.association,
adam@16 213 Realm = M.realm,
adam@16 214 Identifier = r.Identifier};
adam@16 215 error <xml>Login with your identity provider failed: {[msg]}</xml>
adam@16 216
adam@22 217 fun signup after =
adam@16 218 wrap "Account Signup" <xml>
adam@16 219 <form>
adam@16 220 OpenID Identifier: <textbox{#Identifier}/><br/>
adam@22 221 <submit value="Sign Up" action={doSignup after}/>
adam@16 222 </form>
adam@16 223 </xml>
adam@16 224 in
adam@16 225 cur <- current;
adam@17 226 here <- currentUrl;
adam@16 227 case cur of
adam@16 228 Some cur => return <xml>Logged in as {[cur]}. <a link={logout ()}>[Log out]</a></xml>
adam@16 229 | None => return <xml>
adam@17 230 <form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form>
adam@22 231 <a link={signup (show here)}>Sign up</a>
adam@16 232 </xml>
adam@16 233 end
adam@16 234
adam@16 235 task periodic 60 = fn () => dml (DELETE FROM session
adam@21 236 WHERE Expires < CURRENT_TIMESTAMP)
adam@16 237
adam@16 238 end