diff options
Diffstat (limited to 'src/scm/webid-oidc/identity-provider.scm')
-rw-r--r-- | src/scm/webid-oidc/identity-provider.scm | 135 |
1 files changed, 0 insertions, 135 deletions
diff --git a/src/scm/webid-oidc/identity-provider.scm b/src/scm/webid-oidc/identity-provider.scm deleted file mode 100644 index 5970574..0000000 --- a/src/scm/webid-oidc/identity-provider.scm +++ /dev/null @@ -1,135 +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 identity-provider) - #:use-module (webid-oidc errors) - #:use-module (webid-oidc authorization-endpoint) - #:use-module (webid-oidc token-endpoint) - #:use-module (webid-oidc server endpoint) - #:use-module (webid-oidc server endpoint identity-provider) - #:use-module (webid-oidc oidc-configuration) - #:use-module (webid-oidc jwk) - #:use-module ((webid-oidc config) #:prefix cfg:) - #:use-module ((webid-oidc stubs) #:prefix stubs:) - #:use-module ((webid-oidc parameters) #:prefix p:) - #:use-module (webid-oidc jti) - #:use-module (web request) - #:use-module (web response) - #:use-module (web uri) - #:use-module (web server) - #:use-module (webid-oidc cache) - #:use-module (ice-9 optargs) - #:use-module (ice-9 receive) - #:use-module (webid-oidc web-i18n) - #:use-module (ice-9 getopt-long) - #:use-module (ice-9 suspendable-ports) - #:use-module (ice-9 match) - #:use-module (ice-9 exceptions) - #:use-module (sxml simple) - #:use-module (sxml match) - #:use-module (srfi srfi-19) - #:use-module (srfi srfi-26) - #:use-module (rnrs bytevectors) - #:use-module (oop goops) - #:duplicates (merge-generics) - #:declarative? #t - #:export - ( - - make-identity-provider - - )) - -(define-class <default> (<endpoint>)) - -(define-method (handle (endpoint <default>) request request-body) - (raise-exception - (make-exception - (make-web-exception 404 (W_ "reason-phrase|Not Found")) - (make-user-message - (call-with-input-string - (format #f (W_ "<p>Your request cannot be handled by the identity provider.</p>")) - xml->sxml))))) - -(define* (make-identity-provider - issuer - key-file - subject - encrypted-password - jwks-uri - authorization-endpoint-uri - token-endpoint-uri) - (let ((discovery - (make <oidc-discovery> - #:path "/.well-known/openid-configuration" - #:configuration - (make <oidc-configuration> - #:jwks-uri jwks-uri - #:authorization-endpoint authorization-endpoint-uri - #:token-endpoint token-endpoint-uri))) - (authz - (make <authorization-endpoint> - #:subject subject - #:encrypted-password encrypted-password - #:key-file key-file - #:path (uri-path authorization-endpoint-uri))) - (token - (make <token-endpoint> - #:path (uri-path token-endpoint-uri) - #:issuer issuer - #:key-file key-file)) - (jwks - (make <jwks-endpoint> - #:path (uri-path jwks-uri) - #:key-file key-file))) - (let ((idp (make <identity-provider> - #:oidc-discovery discovery - #:authorization-endpoint authz - #:token-endpoint token - #:jwks-endpoint jwks - #:default (make <default>)))) - (lambda (request 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 identity provider 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 idp request request-body) - (values response response-body))) - #:unwind? #t)))))) |