# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1306929115 14400
# Node ID f6b3fbf10dac669eb8bd6d9bfdd7776edd360192
# Parent  8d23d76b5d4854250b3f549d5c50e6be68d23cb2
Proper handling of known vs. to-be-chosen identifiers

diff -r 8d23d76b5d48 -r f6b3fbf10dac src/ur/openid.ur
--- 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
diff -r 8d23d76b5d48 -r f6b3fbf10dac src/ur/openid.urs
--- a/src/ur/openid.urs	Mon May 16 22:31:26 2011 -0400
+++ b/src/ur/openid.urs	Wed Jun 01 07:51:55 2011 -0400
@@ -72,6 +72,16 @@
        | Stateful of {AssociationType : association_type,
                       AssociationSessionType : association_session_type}
 
+(* It is possible to request authentication in two different modes: *)
+
+datatype authentication_mode =
+         ChooseIdentifier of string
+         (* The provider prompts the user to select his identity.
+          * The string argument should be a generic endpoint, e.g.,
+          * "https://www.google.com/accounts/o8/id". *)
+       | KnownIdentifier of string
+         (* Require authentication as this precise identifier. *)
+
 (* An authentication attempt terminates in one of four ways.
  * First, the user might get bored and surf away, never finishing the process.
  * If so, your application will never be told explicitly.
@@ -110,7 +120,7 @@
                         * crypto that you ask for, the library automatically
                         * switches to a mode that the server advertises as
                         * supported. *)
-                       Identifier : string,
+                       Identifier : authentication_mode,
                        (* The URL that the user claims identifies him.
                         * It may also point to a generic authentication service
                         * that will take care of deciding the proper
diff -r 8d23d76b5d48 -r f6b3fbf10dac src/ur/openidUser.ur
--- a/src/ur/openidUser.ur	Mon May 16 22:31:26 2011 -0400
+++ b/src/ur/openidUser.ur	Wed Jun 01 07:51:55 2011 -0400
@@ -272,7 +272,7 @@
                         msg <- Openid.authenticate (opCallback after ses)
                                                    {Association = M.association,
                                                     Realm = M.realm,
-                                                    Identifier = ident};
+                                                    Identifier = Openid.KnownIdentifier ident};
                         error <xml>Login with your identity provider failed: {[msg]}</xml>
 
             fun doSignup after r =
@@ -287,7 +287,7 @@
                     msg <- Openid.authenticate (opCallback after ses)
                                                {Association = M.association,
                                                 Realm = M.realm,
-                                                Identifier = r.Identifier};
+                                                Identifier = Openid.ChooseIdentifier r.Identifier};
                     error <xml>Login with your identity provider failed: {[msg]}</xml>
 
             fun signup after =
diff -r 8d23d76b5d48 -r f6b3fbf10dac tests/test.ur
--- a/tests/test.ur	Mon May 16 22:31:26 2011 -0400
+++ b/tests/test.ur	Wed Jun 01 07:51:55 2011 -0400
@@ -9,7 +9,7 @@
     msg <- Openid.authenticate afterward
                                {Association = Openid.Stateful {AssociationType = Openid.HMAC_SHA256,
                                                                AssociationSessionType = Openid.NoEncryption},
-                                Identifier = r.Id,
+                                Identifier = Openid.KnownIdentifier r.Id,
                                 Realm = Some "http://localhost:8080/"};
     error <xml>{[msg]}</xml>