diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-02 12:03:00 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-04 23:14:38 +0200 |
commit | fd3b4c9747bc631a900a881bfdaadc65124cf0d1 (patch) | |
tree | 403b0611351694ee525ef85e3798017450244ecd /src | |
parent | 20a1d5236ded1738c6007bd9617a913e2c798a8c (diff) |
accounts: Expect a reason for an authorization prompt
Diffstat (limited to 'src')
-rw-r--r-- | src/scm/webid-oidc/client/accounts.scm | 13 | ||||
-rw-r--r-- | src/scm/webid-oidc/client/application.scm | 2 | ||||
-rw-r--r-- | src/scm/webid-oidc/example-app.scm | 6 |
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))) |