diff options
Diffstat (limited to 'src/scm/webid-oidc/client-manifest.scm')
-rw-r--r-- | src/scm/webid-oidc/client-manifest.scm | 62 |
1 files changed, 19 insertions, 43 deletions
diff --git a/src/scm/webid-oidc/client-manifest.scm b/src/scm/webid-oidc/client-manifest.scm index 0515fdd..c4b49f0 100644 --- a/src/scm/webid-oidc/client-manifest.scm +++ b/src/scm/webid-oidc/client-manifest.scm @@ -82,54 +82,21 @@ (vector->list redirect-uris) (uri->string redir))))) -(define (turtle-escape str) - (define (folder c other) - (if (or (eq? c #\\) (eq? c #\")) - (cons* c #\\ other) - (cons c other))) - (list->string (reverse (string-fold folder '() str)))) - (define-public (serve-client-manifest expiration-date mf) (when (eq? mf public-oidc-client) (raise-cannot-serve-public-manifest)) - (let ((json-object (stubs:scm->json-string (the-client-manifest mf))) - (id (uri->string (client-manifest-client-id (the-client-manifest mf))))) - (let ((resource (string-append " -@prefix solid: <http://www.w3.org/ns/solid/terms#> . - -<" id "> solid:oidcRegistration \"\"\" -" (turtle-escape json-object) " -\"\"\" . -"))) - (values (build-response #:headers `((content-type text/turtle) - (expires . ,expiration-date))) - resource)))) - -(define (find-registration id graph) - (cond ((null? graph) - (raise-no-client-manifest-registration (string->uri id))) - ((and (string=? (rdf-triple-predicate (car graph)) - "http://www.w3.org/ns/solid/terms#oidcRegistration") - (string? (rdf-triple-subject (car graph))) - (string=? (rdf-triple-subject (car graph)) id) - (rdf-literal? (rdf-triple-object (car graph))) - (string=? (rdf-literal-type (rdf-triple-object (car graph))) - "http://www.w3.org/2001/XMLSchema#string")) - (let ((object (rdf-triple-object (car graph)))) - (let ((ret (stubs:json-string->scm (rdf-literal-lexical-form object)))) - (if (client-manifest? ret) - (begin - (unless (equal? (uri->string (client-manifest-client-id ret)) - id) - (raise-inconsistent-client-manifest-id (string->uri id) - (client-manifest-client-id ret))) - ret) - (find-registration id (cdr graph)))))) - (else (find-registration id (cdr graph))))) + (let ((json-object (stubs:scm->json-string + `((@context . "https://www.w3.org/ns/solid/oidc-context.jsonld") + ,@(the-client-manifest mf))))) + (values (build-response #:headers `((content-type application/ld+json) + (expires . ,expiration-date))) + json-object))) (define*-public (get-client-manifest id #:key (http-get http-get)) + (unless (uri? id) + (set! id (string->uri id))) (with-exception-handler (lambda (error) (raise-cannot-fetch-client-manifest id error)) @@ -138,5 +105,14 @@ (string->uri "http://www.w3.org/ns/solid/terms#PublicOidcClient")) public-oidc-client - (let ((graph (fetch id #:http-get http-get))) - (find-registration (uri->string id) graph)))))) + (receive (response response-body) + (http-get id) + (when (bytevector? response-body) + (set! response-body (utf8->string response-body))) + (let ((mf (the-client-manifest (stubs:json-string->scm response-body)))) + (unless (equal? (uri->string (client-manifest-client-id mf)) + (uri->string id)) + (raise-inconsistent-client-manifest-id + id + (client-manifest-client-id mf))) + mf)))))) |