1 files changed, 36 insertions, 5 deletions
diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm
index 1ad54ad..db7a41f 100644
--- a/src/scm/webid-oidc/jwk.scm
+++ b/src/scm/webid-oidc/jwk.scm
@@ -1,7 +1,12 @@
 (define-module (webid-oidc jwk)
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc errors)
-  #:use-module (json))
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 optargs)
+  #:use-module (srfi srfi-19)
+  #:use-module (web response)
+  #:use-module (web client)
+  #:use-module (rnrs bytevectors))
 
 (define-public (the-jwk x)
   (with-exception-handler
@@ -36,13 +41,13 @@
                            (y . ,y)))
                 (rsa-part `((n . ,n)
                             (e . ,e))))
-            (case (stubs:kty ec-part)
+            (case (stubs:kty key)
               ((EC) ec-part)
               ((RSA) rsa-part))))))))
 
 (define-public (jwk-public? key)
   (false-if-exception
-   (and (the-public-jwk x) #t)))
+   (and (the-public-jwk key) #t)))
 
 (define-public (strip key)
   (with-exception-handler
@@ -86,7 +91,7 @@
 (define-public generate-key stubs:generate-key)
 
 (define (the-public-keys keys)
-  (map the-public-key keys))
+  (map the-public-jwk keys))
 
 (define-public (the-jwks jwks)
   (let ((keys (vector->list (assoc-ref jwks 'keys))))
@@ -109,4 +114,30 @@
         (the-jwks `((keys . ,pubs))))))
 
 (define-public (jwks-keys jwks)
-  (vector->list (assq-ref (the-jwks jwks) keys)))
+  (vector->list (assq-ref (the-jwks jwks) 'keys)))
+
+(define-public (serve-jwks expiration-date jwks)
+  (values (build-response
+           #:headers `((content-type . (application/json))
+                       (expires . ,expiration-date)))
+          (stubs:scm->json-string (the-jwks jwks))))
+
+(define*-public (get-jwks uri #:key (http-get http-get))
+  (receive (response response-body) (http-get uri)
+    (with-exception-handler
+        (lambda (cause)
+          (raise-unexpected-response response cause))
+      (lambda ()
+        (unless (eqv? (response-code response) 200)
+          (raise-request-failed-unexpectedly
+           (response-code response)
+           (response-reason-phrase response)))
+        (let ((content-type (response-content-type response)))
+          (unless (and (eq? (car content-type) 'application/json)
+                       (or (equal? (assoc-ref (cdr content-type) 'charset)
+                                   "utf-8")
+                           (not (assoc-ref (cdr content-type) 'charset))))
+            (raise-unexpected-header-value 'content-type content-type))
+          (unless (string? response-body)
+            (set! response-body (utf8->string response-body)))
+          (the-jwks (stubs:json-string->scm response-body)))))))