adam@16: functor Make(M: sig
adam@16: con cols :: {Type}
adam@16: constraint [Id] ~ cols
adam@16:
adam@16: val sessionLifetime : int
adam@16: val afterLogout : url
adam@16: val secureCookies : bool
adam@16: val association : Openid.association_mode
adam@16: val realm : option string
adam@16: end) = struct
adam@16:
adam@16: type user = string
adam@16: val show_user = _
adam@16: val inj_user = _
adam@16:
adam@16: table user : ([Id = user] ++ M.cols)
adam@16: PRIMARY KEY Id
adam@16:
adam@16: table identity : {User : user, Identifier : string}
adam@16: PRIMARY KEY (User, Identifier)
adam@16:
adam@16: sequence sessionIds
adam@16:
adam@16: table session : {Id : int, Key : int, Identifier : option string, Expires : time}
adam@16: PRIMARY KEY Id
adam@16:
adam@16: cookie signingUp : {Session : int, Key : int}
adam@16: cookie login : {User : user, Session : int, Key : int}
adam@16:
adam@16: val current =
adam@16: login <- getCookie login;
adam@16: case login of
adam@16: None => return None
adam@16: | Some login =>
adam@16: ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
adam@16: FROM session
adam@16: WHERE session.Id = {[login.Session]}
adam@16: AND session.Key = {[login.Key]});
adam@16: case ident of
adam@16: None => error Invalid or expired session
adam@16: | Some None => return None
adam@16: | Some (Some ident) =>
adam@16: valid <- oneRowE1 (SELECT COUNT( * ) > 0
adam@16: FROM identity
adam@16: WHERE identity.User = {[login.User]}
adam@16: AND identity.Identifier = {[ident]});
adam@16: if valid then
adam@16: return (Some login.User)
adam@16: else
adam@16: error Session not authorized to act as user
adam@16:
adam@16: fun main wrap =
adam@16: let
adam@16: fun logout () =
adam@16: clearCookie login;
adam@16: redirect M.afterLogout
adam@16:
adam@16: fun opCallback after ses res =
adam@16: case res of
adam@16: Openid.Canceled => error You canceled the login process.
adam@16: | Openid.Failure s => error Login failed: {[s]}
adam@16: | Openid.AuthenticatedAs ident =>
adam@16: signup <- getCookie signingUp;
adam@16: case signup of
adam@16: Some signup =>
adam@16: if signup.Session <> ses then
adam@16: error Session has changed suspiciously
adam@16: else
adam@16: invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@16: FROM session
adam@16: WHERE session.Id = {[signup.Session]}
adam@16: AND session.Key = {[signup.Key]});
adam@16: if invalid then
adam@16: error Invalid or expired session
adam@16: else
adam@16: return I now believe that you are {[ident]}.
adam@16: | None =>
adam@16: login <- getCookie login;
adam@16: case login of
adam@16: None => error Missing session cookie
adam@16: | Some login =>
adam@16: if login.Session <> ses then
adam@16: error Session has changed suspiciously
adam@16: else
adam@16: invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@16: FROM session
adam@16: WHERE session.Id = {[login.Session]}
adam@16: AND session.Key = {[login.Key]});
adam@16: if invalid then
adam@16: error Invalid or expired session
adam@16: else
adam@16: dml (UPDATE session
adam@16: SET Identifier = {[Some ident]}
adam@16: WHERE Key = {[login.Key]});
adam@16: redirect (bless after)
adam@16:
adam@16: fun newSession () =
adam@16: ses <- nextval sessionIds;
adam@16: now <- now;
adam@16: key <- rand;
adam@16: dml (INSERT INTO session (Id, Key, Identifier, Expires)
adam@16: VALUES ({[ses]}, {[key]}, NULL, {[addSeconds now M.sessionLifetime]}));
adam@16: return {Session = ses, Key = key}
adam@16:
adam@16: fun logon r =
adam@16: ident <- oneOrNoRowsE1 (SELECT (identity.Identifier)
adam@16: FROM identity
adam@16: WHERE identity.User = {[r.User]}
adam@16: LIMIT 1);
adam@16: case ident of
adam@16: None => error Username not found
adam@16: | Some ident =>
adam@16: ses <- newSession ();
adam@16: setCookie login {Value = r ++ ses,
adam@16: Expires = None,
adam@16: Secure = M.secureCookies};
adam@16: after <- currentUrl;
adam@16: after <- return (show after);
adam@16: ses <- return ses.Session;
adam@16: msg <- Openid.authenticate (opCallback after ses)
adam@16: {Association = M.association,
adam@16: Realm = M.realm,
adam@16: Identifier = ident};
adam@16: error Login with your identity provider failed: {[msg]}
adam@16:
adam@16: fun doSignup after r =
adam@16: ses <- newSession ();
adam@16: setCookie signingUp {Value = ses,
adam@16: Expires = None,
adam@16: Secure = M.secureCookies};
adam@16: ses <- return ses.Session;
adam@16: msg <- Openid.authenticate (opCallback after ses)
adam@16: {Association = M.association,
adam@16: Realm = M.realm,
adam@16: Identifier = r.Identifier};
adam@16: error Login with your identity provider failed: {[msg]}
adam@16:
adam@16: fun signup () =
adam@16: after <- currentUrl;
adam@16: wrap "Account Signup"
adam@16:
adam@16:
adam@16: in
adam@16: cur <- current;
adam@16: case cur of
adam@16: Some cur => return Logged in as {[cur]}. [Log out]
adam@16: | None => return
adam@16:
adam@16: Sign up
adam@16:
adam@16: end
adam@16:
adam@16: task periodic 60 = fn () => dml (DELETE FROM session
adam@16: WHERE Expires >= CURRENT_TIMESTAMP)
adam@16:
adam@16: end