summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorVivien Kraus <vivien@planete-kraus.eu>2021-10-02 12:03:00 +0200
committerVivien Kraus <vivien@planete-kraus.eu>2021-10-04 23:14:38 +0200
commitfd3b4c9747bc631a900a881bfdaadc65124cf0d1 (patch)
tree403b0611351694ee525ef85e3798017450244ecd /src
parent20a1d5236ded1738c6007bd9617a913e2c798a8c (diff)
accounts: Expect a reason for an authorization prompt
Diffstat (limited to 'src')
-rw-r--r--src/scm/webid-oidc/client/accounts.scm13
-rw-r--r--src/scm/webid-oidc/client/application.scm2
-rw-r--r--src/scm/webid-oidc/example-app.scm6
3 files changed, 13 insertions, 8 deletions
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)))