diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-05-09 22:26:23 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-06-19 15:44:36 +0200 |
commit | 86e3d1ee64d791f794f6ac4c44b4246dfe4a2aa6 (patch) | |
tree | 8506e445c2546f3fca47096f8bd369c9eaf2fd3b /src/scm/webid-oidc/authorization-page.scm | |
parent | 1f7dbf33c03a171b6d7d1198b66c024f5299092e (diff) |
Define the web pages for the authorization endpoint
Diffstat (limited to 'src/scm/webid-oidc/authorization-page.scm')
-rw-r--r-- | src/scm/webid-oidc/authorization-page.scm | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/authorization-page.scm b/src/scm/webid-oidc/authorization-page.scm new file mode 100644 index 0000000..b2c2f1f --- /dev/null +++ b/src/scm/webid-oidc/authorization-page.scm @@ -0,0 +1,59 @@ +(define-module (webid-oidc authorization-page) + #:use-module (webid-oidc errors) + #:use-module ((webid-oidc authorization-page-unsafe) #:prefix unsafe:) + #:use-module (ice-9 i18n) + #:use-module (ice-9 string-fun) + #:use-module (ice-9 receive) + #:use-module (ice-9 threads)) + +(define locale-mutex + (make-mutex)) + +(define-syntax with-locale + (syntax-rules () + ((with-locale web-locale . job) + (let ((locale-with-underscore + (if (equal? web-locale "C") + ;; For the unit tests + "C" + (string-append + (string-replace-substring web-locale "-" "_") + ".UTF-8"))) + (previous-locale (setlocale LC_ALL))) + (dynamic-wind + (lambda () + (lock-mutex locale-mutex)) + (lambda () + (dynamic-wind + (lambda () + (with-exception-handler + (lambda (error) + (raise-unknown-client-locale web-locale locale-with-underscore) + (setlocale LC_ALL "C")) + (lambda () + (setlocale LC_ALL locale-with-underscore)) + #:unwind? #t)) + (lambda () . job) + (lambda () + (setlocale LC_ALL previous-locale)))) + (lambda () + (unlock-mutex locale-mutex))))))) + +(define-public (authorization-page + locale credential-invalid? client-id post-uri) + (with-locale + locale + (unsafe:authorization-page credential-invalid? + client-id post-uri))) + +(define-public (error-no-client-id locale) + (with-locale locale (unsafe:error-no-client-id))) + +(define-public (error-no-redirect-uri locale) + (with-locale locale (unsafe:error-no-redirect-uri))) + +(define-public (error-application locale error) + (with-locale locale (unsafe:error-application error))) + +(define-public (redirection locale client-id uri) + (with-locale locale (unsafe:redirection client-id uri))) |