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