accounts: Expect a reason for an authorization prompt

7 files changed, 103 insertions, 51 deletions

diff --git a/doc/disfluid.texi b/doc/disfluid.texi
index c268bcf..011f3f9 100644
--- a/doc/disfluid.texi
+++ b/doc/disfluid.texi
@@ -1815,9 +1815,10 @@ In any case, when you don’t specify a value, it’s as if you passed
 This function is called when an explicit user authorization is
 required, for instance because there is no refresh token and the
 access token expired. The function takes an URI as argument, with an
-additional @code{#:issuer} keyword argument containing the issuer. In
-this function, you should ask the user to browse this URI so that your
-application gets the authorization code.
+additional @code{#:reason} keyword argument containing the reason for
+the authorization as a string. In this function, you should present
+the reason to the user and ask the user to browse this URI so that
+your application gets the authorization code.
 @end defvr
 
 @defvr {Parameter} anonymous-http-request
diff --git a/po/disfluid.pot b/po/disfluid.pot
index 8155a56..b9857d7 100644
--- a/po/disfluid.pot
+++ b/po/disfluid.pot
@@ -8,7 +8,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: disfluid SNAPSHOT\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-04 23:12+0200\n"
+"POT-Creation-Date: 2021-10-04 23:13+0200\n"
 "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
 "Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
 "Language-Team: LANGUAGE <LL@li.org>\n"
@@ -525,78 +525,93 @@ msgstr ""
 msgid "This page does not exist on the server."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:239
+#: src/scm/webid-oidc/client/accounts.scm:118
+#, scheme-format
+msgid "an authorization code is required: ~s, it can be obtained at ~s"
+msgstr ""
+
+#: src/scm/webid-oidc/client/accounts.scm:121
+#, scheme-format
+msgid "an authorization code is required, it can be obtained at ~s"
+msgstr ""
+
+#: src/scm/webid-oidc/client/accounts.scm:212
+#, scheme-format
+msgid "the application wants to manage your account at ~s"
+msgstr ""
+
+#: src/scm/webid-oidc/client/accounts.scm:244
 msgid "The refresh token has expired."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:246
+#: src/scm/webid-oidc/client/accounts.scm:251
 #, scheme-format
 msgid "The token request failed with code ~s (~s)."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:255
+#: src/scm/webid-oidc/client/accounts.scm:260
 msgid "The token response did not set the content type."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:263
+#: src/scm/webid-oidc/client/accounts.scm:268
 msgid "The token endpoint did not respond in UTF-8."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:275
+#: src/scm/webid-oidc/client/accounts.scm:280
 #, scheme-format
 msgid "The token response has content-type ~s, not application/json."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:285
+#: src/scm/webid-oidc/client/accounts.scm:290
 msgid "The token response is not valid JSON."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:299
+#: src/scm/webid-oidc/client/accounts.scm:304
 #, scheme-format
 msgid "The token response did not include an ID token: ~s"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:307
+#: src/scm/webid-oidc/client/accounts.scm:312
 #, scheme-format
 msgid "The token response did not include an access token: ~s\n"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:318
+#: src/scm/webid-oidc/client/accounts.scm:323
 #, scheme-format
 msgid "the ID token signature is invalid: ~a"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:320
+#: src/scm/webid-oidc/client/accounts.scm:325
 msgid "the ID token signature is invalid"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:336
+#: src/scm/webid-oidc/client/accounts.scm:341
 #, scheme-format
 msgid "the ID token delivered by the identity provider for ~s has ~s as webid"
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:346
+#: src/scm/webid-oidc/client/accounts.scm:351
 #, scheme-format
 msgid "The ID token delivered by the identity provider ~s is for issuer ~s."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:361
+#: src/scm/webid-oidc/client/accounts.scm:366
 msgid "The issuer is required."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:366
+#: src/scm/webid-oidc/client/accounts.scm:371
 msgid "The optional subject and required issuer should be strings or URI."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:382
+#: src/scm/webid-oidc/client/accounts.scm:387
 msgid "Cannot check the username and/or password."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:392
+#: src/scm/webid-oidc/client/accounts.scm:397
 msgid "The subject should be a string or URI."
 msgstr ""
 
-#: src/scm/webid-oidc/client/accounts.scm:406
+#: src/scm/webid-oidc/client/accounts.scm:411
 msgid "The issuer should be a string or URI."
 msgstr ""
 
@@ -801,7 +816,7 @@ msgstr ""
 
 #: src/scm/webid-oidc/example-app.scm:298
 #, scheme-format
-msgid "To log in on ~a, please visit: ~a\n"
+msgid "Your authorization is required: ~a, please visit: ~a\n"
 msgstr ""
 
 #: src/scm/webid-oidc/example-app.scm:301
diff --git a/po/fr.po b/po/fr.po
index cf2fcd6..15e8834 100644
--- a/po/fr.po
+++ b/po/fr.po
@@ -2,7 +2,7 @@ msgid ""
 msgstr ""
 "Project-Id-Version: webid-oidc 0.0.0\n"
 "Report-Msgid-Bugs-To: vivien@planete-kraus.eu\n"
-"POT-Creation-Date: 2021-10-04 23:12+0200\n"
+"POT-Creation-Date: 2021-10-04 23:13+0200\n"
 "PO-Revision-Date: 2021-10-04 23:06+0200\n"
 "Last-Translator: Vivien Kraus <vivien@planete-kraus.eu>\n"
 "Language-Team: French <vivien@planete-kraus.eu>\n"
@@ -569,83 +569,98 @@ msgstr "Non Trouvé"
 msgid "This page does not exist on the server."
 msgstr "Cette page n’existe pas sur le serveur."
 
-#: src/scm/webid-oidc/client/accounts.scm:239
+#: src/scm/webid-oidc/client/accounts.scm:118
+#, scheme-format
+msgid "an authorization code is required: ~s, it can be obtained at ~s"
+msgstr "un code d’autorisation est requis : ~s, vous pouvez l’obtenir à ~s"
+
+#: src/scm/webid-oidc/client/accounts.scm:121
+#, scheme-format
+msgid "an authorization code is required, it can be obtained at ~s"
+msgstr "un code d’autorisation est requis, vous pouvez en obtenir un à ~s"
+
+#: src/scm/webid-oidc/client/accounts.scm:212
+#, scheme-format
+msgid "the application wants to manage your account at ~s"
+msgstr "l’application veut gérer votre compte sur ~s"
+
+#: src/scm/webid-oidc/client/accounts.scm:244
 msgid "The refresh token has expired."
 msgstr "le jeton de rafraîchissement a expiré."
 
-#: src/scm/webid-oidc/client/accounts.scm:246
+#: src/scm/webid-oidc/client/accounts.scm:251
 #, scheme-format
 msgid "The token request failed with code ~s (~s)."
 msgstr "La requête de jeton a échoué avec un code ~s (~s)."
 
-#: src/scm/webid-oidc/client/accounts.scm:255
+#: src/scm/webid-oidc/client/accounts.scm:260
 msgid "The token response did not set the content type."
 msgstr "Le jeton de réponse n’a pas défini de type de contenu."
 
-#: src/scm/webid-oidc/client/accounts.scm:263
+#: src/scm/webid-oidc/client/accounts.scm:268
 msgid "The token endpoint did not respond in UTF-8."
 msgstr "Le terminal de jetonn n’a pas répondu en UTF-8."
 
-#: src/scm/webid-oidc/client/accounts.scm:275
+#: src/scm/webid-oidc/client/accounts.scm:280
 #, scheme-format
 msgid "The token response has content-type ~s, not application/json."
 msgstr "La réponse de jeton a un type de contenu ~s, pas application/json."
 
-#: src/scm/webid-oidc/client/accounts.scm:285
+#: src/scm/webid-oidc/client/accounts.scm:290
 msgid "The token response is not valid JSON."
 msgstr "La réponse de jeton n’est pas un JSON valide."
 
-#: src/scm/webid-oidc/client/accounts.scm:299
+#: src/scm/webid-oidc/client/accounts.scm:304
 #, scheme-format
 msgid "The token response did not include an ID token: ~s"
 msgstr "La réponse de jeton n’a pas inclus de jeton d’ID : ~s"
 
-#: src/scm/webid-oidc/client/accounts.scm:307
+#: src/scm/webid-oidc/client/accounts.scm:312
 #, scheme-format
 msgid "The token response did not include an access token: ~s\n"
 msgstr "La réponse de jeton n’a pas inclus de jeton d’accès : ~s\n"
 
-#: src/scm/webid-oidc/client/accounts.scm:318
+#: src/scm/webid-oidc/client/accounts.scm:323
 #, scheme-format
 msgid "the ID token signature is invalid: ~a"
 msgstr "la signature du jeton d’ID est invalide : ~a"
 
-#: src/scm/webid-oidc/client/accounts.scm:320
+#: src/scm/webid-oidc/client/accounts.scm:325
 msgid "the ID token signature is invalid"
 msgstr "la signature du jeton d’ID est invalide"
 
-#: src/scm/webid-oidc/client/accounts.scm:336
+#: src/scm/webid-oidc/client/accounts.scm:341
 #, scheme-format
 msgid "the ID token delivered by the identity provider for ~s has ~s as webid"
 msgstr ""
 "le jeton d’ID délivré par le fournisseur d’identité pour ~s a ~s pour webid"
 
-#: src/scm/webid-oidc/client/accounts.scm:346
+#: src/scm/webid-oidc/client/accounts.scm:351
 #, scheme-format
 msgid "The ID token delivered by the identity provider ~s is for issuer ~s."
 msgstr ""
 "Le jeton d’ID délivré par le fournisseur d’identité ~s est pour l’émetteur "
 "~s."
 
-#: src/scm/webid-oidc/client/accounts.scm:361
+#: src/scm/webid-oidc/client/accounts.scm:366
 msgid "The issuer is required."
 msgstr "L’émetteur est requis."
 
-#: src/scm/webid-oidc/client/accounts.scm:366
+#: src/scm/webid-oidc/client/accounts.scm:371
 msgid "The optional subject and required issuer should be strings or URI."
 msgstr ""
 "Le sujet optionnel et émetteur doivent être des chaînes de caractère ou des "
 "URIs."
 
-#: src/scm/webid-oidc/client/accounts.scm:382
+#: src/scm/webid-oidc/client/accounts.scm:387
 msgid "Cannot check the username and/or password."
 msgstr "Impossible de vérifier le nom d’utilisateur et/ou le mot de passe."
 
-#: src/scm/webid-oidc/client/accounts.scm:392
+#: src/scm/webid-oidc/client/accounts.scm:397
 msgid "The subject should be a string or URI."
 msgstr "Le sujet doit être une chaîne de caractères ou une URI."
 
-#: src/scm/webid-oidc/client/accounts.scm:406
+#: src/scm/webid-oidc/client/accounts.scm:411
 msgid "The issuer should be a string or URI."
 msgstr "L’émetteur doit être une chaîne de caractères ou une URI."
 
@@ -861,8 +876,8 @@ msgstr "refaire"
 
 #: src/scm/webid-oidc/example-app.scm:298
 #, scheme-format
-msgid "To log in on ~a, please visit: ~a\n"
-msgstr "Pour vous connecte avec ~a, veuillez visiter : ~a\n"
+msgid "Your authorization is required: ~a, please visit: ~a\n"
+msgstr "Votre autorisation est requise : ~a, veuillez visiter : ~a\n"
 
 #: src/scm/webid-oidc/example-app.scm:301
 msgid "Then, paste the authorization code you get:\n"
@@ -2646,6 +2661,22 @@ msgstr "Annuler"
 msgid "Update"
 msgstr "Mettre à jour"
 
+#~ msgid "Your authorization is required because <reasons>:"
+#~ msgstr "Votre autorisation est requise parce que <raisons> :"
+
+#~ msgid "Authorize"
+#~ msgstr "Autoriser"
+
+#~ msgid "Please paste your authorization code below:"
+#~ msgstr "Veuillez coller votre code d’autorisation :"
+
+#~ msgid "OK"
+#~ msgstr "OK"
+
+#, scheme-format
+#~ msgid "To log in on ~a, please visit: ~a\n"
+#~ msgstr "Pour vous connecte avec ~a, veuillez visiter : ~a\n"
+
 #, scheme-format
 #~ msgid "this is not a client manifest: ~a"
 #~ msgstr "ce n’est pas un manifeste client : ~a"
diff --git a/src/scm/webid-oidc/client/accounts.scm b/src/scm/webid-oidc/client/accounts.scm
index 24298b0..3de91b3 100644
--- a/src/scm/webid-oidc/client/accounts.scm
+++ b/src/scm/webid-oidc/client/accounts.scm
@@ -112,10 +112,13 @@
 
 (define authorization-process
   (make-parameter
-   (lambda* (uri #:key issuer)
+   (lambda* (uri #:key (reason #f))
      (let ((final-message
-            (G_ (format #f "An authorization code is required to log in with ~s, it can be obtained at ~s."
-                        (uri->string issuer)
+            (if reason
+                (format #f (G_ "an authorization code is required: ~s, it can be obtained at ~s")
+                        reason
+                        (uri->string uri))
+                (format #f (G_ "an authorization code is required, it can be obtained at ~s")
                         (uri->string uri)))))
        (raise-exception
         (make-exception
@@ -205,7 +208,9 @@
                                            `((state . ,state))
                                            '()))))
                             "&"))))
-                     ((authorization-process) authorization-uri #:issuer issuer))))
+                     ((authorization-process) authorization-uri
+                      #:reason (format #f (G_ "the application wants to manage your account at ~s")
+                                       (uri->string issuer))))))
             (unless key-pair
               (set! key-pair (client:key-pair client)))
             (let ((dpop-proof
diff --git a/src/scm/webid-oidc/client/application.scm b/src/scm/webid-oidc/client/application.scm
index d448976..6263a82 100644
--- a/src/scm/webid-oidc/client/application.scm
+++ b/src/scm/webid-oidc/client/application.scm
@@ -164,7 +164,7 @@
              (parameterize
                  ((client:client (client state))
                   (account:authorization-process
-                   (lambda* (uri #:key issuer)
+                   (lambda* (uri #:key (reason #f))
                      (abort-to-prompt
                       tag
                       (lambda (continuation)
diff --git a/src/scm/webid-oidc/example-app.scm b/src/scm/webid-oidc/example-app.scm
index fb12431..052ebdc 100644
--- a/src/scm/webid-oidc/example-app.scm
+++ b/src/scm/webid-oidc/example-app.scm
@@ -294,9 +294,9 @@
           #:redirect-uri
           "https://webid-oidc-demo.planete-kraus.eu/authorized"))
        (client:authorization-process
-        (lambda* (uri #:key issuer)
-          (format (current-error-port) (G_ "To log in on ~a, please visit: ~a\n")
-                  (uri->string issuer)
+        (lambda* (uri #:key reason)
+          (format (current-error-port) (G_ "Your authorization is required: ~a, please visit: ~a\n")
+                  reason
                   (uri->string uri))
           (format (current-error-port) (G_ "Then, paste the authorization code you get:\n"))
           (read-line (current-input-port) 'trim)))
diff --git a/tests/client-workflow.scm b/tests/client-workflow.scm
index 9c74198..ed1c1b4 100644
--- a/tests/client-workflow.scm
+++ b/tests/client-workflow.scm
@@ -79,7 +79,7 @@
                      (cute sim:request simulation <...>)))
        (parameterize ((p:current-date 0)
                       (client:authorization-process
-                       (lambda* (uri #:key issuer)
+                       (lambda* (uri #:key reason)
                          (sim:grant-authorization simulation uri))))
          (receive (new-account response response-body)
              (begin