diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-17 14:52:14 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-21 09:45:14 +0200 |
commit | 1dc4802d231bf4083d387a6db0765730075cc752 (patch) | |
tree | 1dde8889f49ebeb7652d89bd1af8428480532201 /src/scm/webid-oidc/authorization-endpoint.scm | |
parent | 7debf052567f50d2c2510d80405069e53b0971bf (diff) |
Use the endpoint API
Diffstat (limited to 'src/scm/webid-oidc/authorization-endpoint.scm')
-rw-r--r-- | src/scm/webid-oidc/authorization-endpoint.scm | 85 |
1 files changed, 0 insertions, 85 deletions
diff --git a/src/scm/webid-oidc/authorization-endpoint.scm b/src/scm/webid-oidc/authorization-endpoint.scm deleted file mode 100644 index 74417aa..0000000 --- a/src/scm/webid-oidc/authorization-endpoint.scm +++ /dev/null @@ -1,85 +0,0 @@ -;; disfluid, implementation of the Solid specification -;; Copyright (C) 2020, 2021 Vivien Kraus - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU Affero General Public License as -;; published by the Free Software Foundation, either version 3 of the -;; License, or (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU Affero General Public License for more details. - -;; You should have received a copy of the GNU Affero General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -(define-module (webid-oidc authorization-endpoint) - #:use-module (webid-oidc errors) - #:use-module (webid-oidc server endpoint) - #:use-module (webid-oidc server endpoint identity-provider) - #:use-module (webid-oidc jwk) - #:use-module (webid-oidc authorization-code) - #:use-module (webid-oidc client-manifest) - #:use-module (webid-oidc web-i18n) - #:use-module ((webid-oidc parameters) #:prefix p:) - #:use-module (web uri) - #:use-module (web request) - #:use-module (web response) - #:use-module (rnrs bytevectors) - #:use-module (srfi srfi-19) - #:use-module (srfi srfi-26) - #:use-module (ice-9 receive) - #:use-module (ice-9 optargs) - #:use-module (ice-9 match) - #:use-module (sxml simple) - #:use-module (oop goops) - #:declarative? #t - #:duplicates (merge-generics) - #:export - ( - - make-authorization-endpoint - - )) - -(define (make-authorization-endpoint subject encrypted-password jwk-file) - (define endpoint - (make <authorization-endpoint> - #:subject subject - #:encrypted-password encrypted-password - #:key-file jwk-file)) - (lambda (request request-body) - (when (bytevector? request-body) - (set! request-body (utf8->string request-body))) - (parameterize ((web-locale request)) - (with-exception-handler - (lambda (exn) - (unless (web-exception? exn) - (raise-exception exn)) - (values - (build-response - #:code (web-exception-code exn) - #:reason-phrase (web-exception-reason-phrase exn) - #:headers `((content-type application/xhtml+xml))) - (call-with-output-string - (cute sxml->xml - `(*TOP* - (*PI* xml "version=\"1.0\" encoding=\"utf-8\"") - (html (@ (xmlns "http://www.w3.org/1999/xhtml") - (xml:lang ,(W_ "xml-lang|en"))) - (body - ,(call-with-input-string - (format #f (W_ "<h1>The authorization request failed</h1>")) - xml->sxml) - ,(if (user-message? exn) - (user-message-sxml exn) - (call-with-input-string - (format #f (W_ "<p>No more information.</p>")) - xml->sxml))))) - <>)))) - (lambda () - (receive (response response-body response-meta) - (handle endpoint request request-body) - (values response response-body))) - #:unwind? #t)))) |