From fd3b4c9747bc631a900a881bfdaadc65124cf0d1 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Sat, 2 Oct 2021 12:03:00 +0200
Subject: accounts: Expect a reason for an authorization prompt

---
 src/scm/webid-oidc/client/accounts.scm    | 13 +++++++++----
 src/scm/webid-oidc/client/application.scm |  2 +-
 src/scm/webid-oidc/example-app.scm        |  6 +++---
 3 files changed, 13 insertions(+), 8 deletions(-)

(limited to 'src')

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)))
-- 
cgit v1.2.3