Mercurial > openid
diff src/ur/openid.ur @ 17:df2eb629f21a
Successfully created an account
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 06 Jan 2011 14:42:37 -0500 |
parents | 35bc4da563dd |
children | 70ab0230649b |
line wrap: on
line diff
--- a/src/ur/openid.ur Thu Jan 06 12:48:13 2011 -0500 +++ b/src/ur/openid.ur Thu Jan 06 14:42:37 2011 -0500 @@ -7,7 +7,13 @@ table discoveries : { Identifier : string, Endpoint : string, Expires : time } PRIMARY KEY Identifier +fun eatFragment s = + case String.split s #"#" of + Some (s', _) => s' + | _ => s + fun discover s = + s <- return (eatFragment s); endpoint <- oneOrNoRowsE1 (SELECT (discoveries.Endpoint) FROM discoveries WHERE discoveries.Identifier = {[s]}); @@ -190,11 +196,6 @@ newAssociation url alt.Atype alt.Stype | v => return v -fun eatFragment s = - case String.split s #"#" of - Some (s', _) => s' - | _ => s - datatype handle_result = HandleOk of {Endpoint : string, Typ : association_type, Key : string} | NoAssociation of string | HandleError of string datatype authentication = AuthenticatedAs of string | Canceled | Failure of string @@ -310,11 +311,6 @@ HMAC_SHA256 => OpenidFfi.hmac_sha256 key nvps | HMAC_SHA1 => OpenidFfi.hmac_sha1 key nvps in - (*debug ("Fields: " ^ signed); - debug ("Nvps: " ^ nvps); - debug ("Key: " ^ key); - debug ("His: " ^ sign); - debug ("Mine: " ^ sign');*) if sign' = sign then return None else @@ -388,7 +384,8 @@ case r.Association of Stateless => redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" - ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.return_to=" + ^ eatFragment r.Identifier + ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) | Stateful ar => assoc <- association ar.AssociationType ar.AssociationSessionType dy; @@ -397,7 +394,8 @@ | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" | Association assoc => redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" - ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" + ^ eatFragment r.Identifier + ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) end