1 files changed, 112 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/jwk.scm b/src/scm/webid-oidc/jwk.scm
new file mode 100644
index 0000000..1ad54ad
--- /dev/null
+++ b/src/scm/webid-oidc/jwk.scm
@@ -0,0 +1,112 @@
+(define-module (webid-oidc jwk)
+  #:use-module ((webid-oidc stubs) #:prefix stubs:)
+  #:use-module (webid-oidc errors)
+  #:use-module (json))
+
+(define-public (the-jwk x)
+  (with-exception-handler
+      (lambda (cause)
+        (raise-not-a-jwk x cause))
+    (lambda ()
+      (let ((kty (stubs:kty x)))
+        (unless (or (eq? kty 'EC) (eq? kty 'RSA))
+          (throw 'really-not-a-jwk))
+        x))))
+
+(define-public (jwk? x)
+  (false-if-exception
+   (and (the-jwk x) #t)))
+
+(define-public (kty x)
+  (stubs:kty (the-jwk x)))
+
+(define-public (the-public-jwk x)
+  (with-exception-handler
+      (lambda (cause)
+        (raise-not-a-public-jwk x cause))
+    (lambda ()
+      (let ((key (the-jwk x)))
+        (let ((crv (assq-ref key 'crv))
+              (x (assq-ref key 'x))
+              (y (assq-ref key 'y))
+              (n (assq-ref key 'n))
+              (e (assq-ref key 'e)))
+          (let ((ec-part `((crv . ,crv)
+                           (x . ,x)
+                           (y . ,y)))
+                (rsa-part `((n . ,n)
+                            (e . ,e))))
+            (case (stubs:kty ec-part)
+              ((EC) ec-part)
+              ((RSA) rsa-part))))))))
+
+(define-public (jwk-public? key)
+  (false-if-exception
+   (and (the-public-jwk x) #t)))
+
+(define-public (strip key)
+  (with-exception-handler
+      (lambda (cause)
+        (raise-not-a-public-jwk key cause))
+    (lambda ()
+      (stubs:strip-key key))))
+
+(define-public (jkt x)
+  (stubs:jkt (the-public-jwk x)))
+
+(define-public (make-rsa-public-key n e)
+  (the-public-jwk
+   `((n . ,n)
+     (e . ,e))))
+
+(define-public (make-rsa-private-key d p q dp dq qi)
+  (the-jwk
+   `((d . ,d)
+     (p . ,p)
+     (q . ,q)
+     (dp . ,dp)
+     (dq . ,dq)
+     (qi . ,qi))))
+
+(define-public (make-ec-point crv x y)
+  (if (symbol? crv)
+      (make-ec-point (symbol->string crv) x y)
+      (the-public-jwk
+       `((crv . ,crv)
+         (x . ,x)
+         (y . ,y)))))
+
+(define-public (make-ec-scalar crv d)
+  (if (symbol? crv)
+      (make-ec-scalar (symbol->string crv) d)
+      (the-jwk
+       `((crv . ,crv)
+         (d . ,d)))))
+
+(define-public generate-key stubs:generate-key)
+
+(define (the-public-keys keys)
+  (map the-public-key keys))
+
+(define-public (the-jwks jwks)
+  (let ((keys (vector->list (assoc-ref jwks 'keys))))
+    (unless keys
+      (raise-not-a-jwks jwks #f))
+    (with-exception-handler
+        (lambda (cause)
+          (raise-not-a-jwks jwks cause))
+      (lambda ()
+        `((keys . ,(list->vector (the-public-keys keys))))))))
+
+(define-public (jwks? jwks)
+  (false-if-exception
+   (and (the-jwks jwks) #t)))
+
+(define-public (make-jwks keys)
+  (if (vector? keys)
+      (make-jwks (vector->list keys))
+      (let ((pubs (list->vector (map strip keys))))
+        (the-jwks `((keys . ,pubs))))))
+
+(define-public (jwks-keys jwks)
+  (vector->list (assq-ref (the-jwks jwks) keys)))