Add a signature and verification function for JWS

2 files changed, 36 insertions, 1 deletions

diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm
index a690088..ad8fef3 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.scm
@@ -94,6 +94,16 @@
   (raise-exception
    ((record-constructor &unsupported-alg) value)))
 
+(define-public &invalid-signature
+  (make-exception-type
+   '&invalid-signature
+   &external-error
+   '(key payload signature)))
+
+(define-public (raise-invalid-signature key payload signature)
+  (raise-exception
+   ((record-constructor &invalid-signature) key payload signature)))
+
 (define*-public (error->str err #:key (max-depth #f))
   (if (record? err)
       (let* ((type (record-type-descriptor err))
@@ -159,6 +169,9 @@
                          (format #f (G_ "~a, ~a")
                                  (recurse (car components))
                                  (recurse (apply make-exception (cdr components)))))))))
+          ((&invalid-signature)
+           (format #f (G_ "the signature ~a does not match key ~s with payload ~a")
+                   (get 'signature) (get 'key) (get 'payload)))
           ((&undefined-variable)
            (G_ "there is an undefined variable"))
           ((&origin)
@@ -174,6 +187,9 @@
            (format #f (G_ "there is a kind and args")))
           ((&assertion-failure)
            (format #f (G_ "there is an assertion failure")))
+          ((&quit-exception)
+           (format #f (G_ "the program quits with code ~a")
+                   (get 'code)))
           (else
            (error (format #f (G_ "Unhandled exception type ~a.")
                           (record-type-name type))))))
diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm
index 58fe356..3f16888 100644
--- a/src/scm/webid-oidc/stubs.scm
+++ b/src/scm/webid-oidc/stubs.scm
@@ -38,6 +38,23 @@
     (lambda error
       (raise-unsupported-alg (cadr error)))))
 
+(define (fix-sign alg key payload)
+  (catch 'unsupported-alg
+    (lambda ()
+      (sign alg key payload))
+    (lambda error
+      (raise-unsupported-alg (cadr error)))))
+
+(define (fix-verify alg key payload signature)
+  (catch 'unsupported-alg
+    (lambda ()
+      (let ((ok
+             (verify alg key payload signature)))
+        (unless ok
+          (raise-invalid-signature key payload signature))))
+    (lambda error
+      (raise-unsupported-alg (cadr error)))))
+
 (export
  base64-encode
  (fix-base64-decode . base64-decode)
@@ -47,7 +64,9 @@
  (fix-kty . kty)
  strip-key
  (fix-hash . hash)
- jkt)
+ jkt
+ (fix-sign . sign)
+ (fix-verify . verify))
 
 ;; json reader from guile-json will not behave consistently with
 ;; SRFI-180 with objects: keys will be mapped to strings, not