Mercurial > openid
diff src/ur/openid.ur @ 39:f6b3fbf10dac
Proper handling of known vs. to-be-chosen identifiers
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Wed, 01 Jun 2011 07:51:55 -0400 |
parents | f129ddee75f3 |
children | 00c8f43be8b7 |
line wrap: on
line diff
--- a/src/ur/openid.ur Mon May 16 22:31:26 2011 -0400 +++ b/src/ur/openid.ur Wed Jun 01 07:51:55 2011 -0400 @@ -41,6 +41,10 @@ | Stateful of {AssociationType : association_type, AssociationSessionType : association_session_type} +datatype authentication_mode = + ChooseIdentifier of string + | KnownIdentifier of string + table associations : { Endpoint : string, Handle : string, Typ : serialized association_type, Key : string, Expires : time } PRIMARY KEY Endpoint @@ -384,8 +388,18 @@ val realmString = case r.Realm of None => "" | Some realm => "&openid.realm=" ^ realm + + val (ident, claimed) = + case r.Identifier of + ChooseIdentifier s => (eatFragment s, "http://specs.openid.net/auth/2.0/identifier_select") + | KnownIdentifier s => + let + val s = eatFragment s + in + (s, s) + end in - dy <- discover r.Identifier; + dy <- discover ident; case dy of None => return "Discovery failed" | Some dy => @@ -397,8 +411,8 @@ case r.Association of Stateless => redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup" - ^ "&openid.claimed_id=http://specs.openid.net/auth/2.0/identifier_select" - ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" + ^ "&openid.claimed_id=" ^ claimed + ^ "&openid.identity=" ^ claimed ^ "&openid.assoc_handle=" ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) | Stateful ar => assoc <- association ar.AssociationType ar.AssociationSessionType dy; @@ -407,8 +421,8 @@ | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" | Association assoc => redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup" - ^ "&openid.claimed_id=http://specs.openid.net/auth/2.0/identifier_select" - ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" + ^ "&openid.claimed_id=" ^ claimed + ^ "&openid.identity=" ^ claimed ^ "&openid.assoc_handle=" ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) end end