diff src/ur/openidUser.ur @ 17:df2eb629f21a

Successfully created an account
author Adam Chlipala <adam@chlipala.net>
date Thu, 06 Jan 2011 14:42:37 -0500
parents 9851bc87b0d7
children dd8eb53da51b
line wrap: on
line diff
--- a/src/ur/openidUser.ur	Thu Jan 06 12:48:13 2011 -0500
+++ b/src/ur/openidUser.ur	Thu Jan 06 14:42:37 2011 -0500
@@ -1,12 +1,22 @@
 functor Make(M: sig
                  con cols :: {Type}
                  constraint [Id] ~ cols
+                 val folder : folder cols
+                 val inj : $(map sql_injectable cols)
+
+                 type creationState
+                 type creationData
+                 val creationState : transaction creationState
+                 val render : creationState -> xtable
+                 val tabulate : creationState -> signal creationData
+                 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] -> creationData -> transaction $cols
 
                  val sessionLifetime : int
                  val afterLogout : url
                  val secureCookies : bool
                  val association : Openid.association_mode
                  val realm : option string
+                 val formClass : css_class
              end) = struct
 
     type user = string
@@ -27,6 +37,13 @@
     cookie signingUp : {Session : int, Key : int}
     cookie login : {User : user, Session : int, Key : int}
 
+    val currentUrl =
+        b <- currentUrlHasPost;
+        if b then
+            return M.afterLogout
+        else
+            currentUrl
+
     val current =
         login <- getCookie login;
         case login of
@@ -49,12 +66,67 @@
                 else
                     error <xml>Session not authorized to act as user</xml>
 
+    fun validUser s = String.length s > 0 && String.length s < 20
+                      && String.all Char.isAlnum s
+
     fun main wrap =
         let
             fun logout () =
                 clearCookie login;
                 redirect M.afterLogout
 
+            fun signupDetails after =
+                let
+                    fun finishSignup uid data =
+                        if not (validUser uid) then
+                            return (Some "That username is not valid.  It must be between 1 and 19 characters long, containing only letters and numbers.")
+                        else
+                            used <- oneRowE1 (SELECT COUNT( * ) > 0
+                                              FROM user
+                                              WHERE user.Id = {[uid]});
+                            if used then
+                                return (Some "That username is taken.  Please choose another.")
+                            else
+                                ses <- getCookie signingUp;
+                                case ses of
+                                    None => return (Some "Missing session cookie")
+                                  | Some ses =>
+                                    ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
+                                                            FROM session
+                                                            WHERE session.Id = {[ses.Session]}
+                                                              AND session.Key = {[ses.Key]});
+                                    case ident of
+                                        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};
+
+                                        cols <- M.choose user data;
+                                        dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols));
+                                        dml (INSERT INTO identity (User, Identifier)
+                                             VALUES ({[uid]}, {[ident]}));
+                                        redirect (bless after)
+                in
+                    uid <- source "";
+                    cs <- M.creationState;
+
+                    wrap "Your User Details" <xml>
+                      <table class={M.formClass}>
+                        <tr> <th class={M.formClass}>Username:</th> <td><ctextbox source={uid}/></td> </tr>
+                        {M.render cs}
+                        <tr> <td><button value="Create Account" onclick={uid <- get uid;
+                                                                         data <- Basis.current (M.tabulate cs);
+                                                                         res <- rpc (finishSignup uid data);
+                                                                         case res of
+                                                                             None => redirect (bless after)
+                                                                           | Some msg => alert msg}/></td> </tr>
+                      </table>
+                    </xml>
+                end
+
             fun opCallback after ses res =
                 case res of
                     Openid.Canceled => error <xml>You canceled the login process.</xml>
@@ -73,7 +145,10 @@
                             if invalid then
                                 error <xml>Invalid or expired session</xml>
                             else
-                                return <xml>I now believe that you are {[ident]}.</xml>
+                                dml (UPDATE session
+                                     SET Identifier = {[Some ident]}
+                                     WHERE Id = {[signup.Session]});
+                                signupDetails after
                       | None =>
                         login <- getCookie login;
                         case login of
@@ -91,7 +166,7 @@
                                 else
                                     dml (UPDATE session
                                          SET Identifier = {[Some ident]}
-                                         WHERE Key = {[login.Key]});
+                                         WHERE Id = {[login.Session]});
                                     redirect (bless after)
 
             fun newSession () =
@@ -102,7 +177,7 @@
                      VALUES ({[ses]}, {[key]}, NULL, {[addSeconds now M.sessionLifetime]}));
                 return {Session = ses, Key = key}
 
-            fun logon r =
+            fun logon after r =
                 ident <- oneOrNoRowsE1 (SELECT (identity.Identifier)
                                         FROM identity
                                         WHERE identity.User = {[r.User]}
@@ -114,8 +189,6 @@
                     setCookie login {Value = r ++ ses,
                                      Expires = None,
                                      Secure = M.secureCookies};
-                    after <- currentUrl;
-                    after <- return (show after);
                     ses <- return ses.Session;
                     msg <- Openid.authenticate (opCallback after ses)
                            {Association = M.association,
@@ -145,10 +218,11 @@
                 </xml>
         in
             cur <- current;
+            here <- currentUrl;
             case cur of
                 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}/></form>
+                <form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form>
                 <a link={signup ()}>Sign up</a>
               </xml>
         end