diff options
Diffstat (limited to 'src/scm/webid-oidc/serve.scm')
-rw-r--r-- | src/scm/webid-oidc/serve.scm | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/serve.scm b/src/scm/webid-oidc/serve.scm new file mode 100644 index 0000000..4f54495 --- /dev/null +++ b/src/scm/webid-oidc/serve.scm @@ -0,0 +1,73 @@ +;; webid-oidc, implementation of the Solid specification +;; Copyright (C) 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 serve) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc fetch) + #:use-module (ice-9 optargs) + #:use-module (ice-9 receive) + #:use-module (ice-9 exceptions) + #:use-module (rnrs bytevectors) + #:use-module (web client) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:use-module (rdf rdf) + #:use-module (turtle fromrdf) + #:use-module (nquads fromrdf) + #:export + ( + convert + )) + +(define (convert client-accepts server-name path content-type content) + (let ((data-as-rdf + (false-if-exception + (fetch + (build-uri (uri-scheme server-name) + #:userinfo (uri-userinfo server-name) + #:host (uri-host server-name) + #:port (uri-port server-name) + #:path path) + #:http-get + (lambda args + (values (build-response + #:headers `((content-type ,content-type))) + content)))))) + (if client-accepts + ;; Content negociation is asked + (let try-satisfy ((accepts client-accepts)) + (if (null? accepts) + (raise-exception (make-not-acceptable client-accepts path content-type)) + (let ((request (caar accepts))) + (cond + ((or (eq? request content-type) + (eq? request '*/*)) + (values content-type content)) + ((and (eq? request 'text/turtle) data-as-rdf) + (values 'text/turtle + (rdf->turtle data-as-rdf))) + ((and (or (eq? request 'application/n-quads) + (eq? request 'text/x-nquads)) + data-as-rdf) + (values request + (rdf->nquads + (make-rdf-dataset data-as-rdf '())))) + ;; Add other conversion strategies here + (else + (try-satisfy (cdr accepts))))))) + ;; Content negociation is unwanted + (values content-type content)))) |