summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc
diff options
context:
space:
mode:
Diffstat (limited to 'src/scm/webid-oidc')
-rw-r--r--src/scm/webid-oidc/errors.scm34
-rw-r--r--src/scm/webid-oidc/stubs.scm21
2 files changed, 52 insertions, 3 deletions
diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm
index 9d08ed5..27dc6e2 100644
--- a/src/scm/webid-oidc/errors.scm
+++ b/src/scm/webid-oidc/errors.scm
@@ -26,7 +26,7 @@
(define-public &not-json
(make-exception-type
- 'not-json
+ '&not-json
&external-error
'(value cause)))
@@ -34,6 +34,26 @@
(raise-exception
((record-constructor &not-json) value cause)))
+(define-public &unsupported-crv
+ (make-exception-type
+ '&unsupported-crv
+ &external-error
+ '(crv)))
+
+(define-public (raise-unsupported-crv crv)
+ (raise-exception
+ ((record-constructor &unsupported-crv) crv)))
+
+(define-public &not-a-jwk
+ (make-exception-type
+ '&not-a-jwk
+ &external-error
+ '(value cause)))
+
+(define-public (raise-not-a-jwk value cause)
+ (raise-exception
+ ((record-constructor &not-a-jwk) value cause)))
+
(define*-public (error->str err #:key (max-depth #f))
(if (record? err)
(let* ((type (record-type-descriptor err))
@@ -49,9 +69,19 @@
((&not-base64)
(format #f (G_ "the value ~s is not a base64 string (because ~a)")
(get 'value) (recurse (get 'cause))))
- ((not-json)
+ ((&not-json)
(format #f (G_ "the value ~s is not JSON (because ~a)")
(get 'value) (recurse (get 'cause))))
+ ((&unsupported-crv)
+ (format #f (G_ "the value ~s does not identify an elleptic curve")
+ (get 'crv)))
+ ((&not-a-jwk)
+ (let ((cause (get 'cause)))
+ (if cause
+ (format #f (G_ "the value ~s does not identify a JWK (because ~a)")
+ (get 'value) cause)
+ (format #f (G_ "the value ~s does not identify a JWK")
+ (get 'value)))))
((&compound-exception)
(let ((components (get 'components)))
(if (null? components)
diff --git a/src/scm/webid-oidc/stubs.scm b/src/scm/webid-oidc/stubs.scm
index 0ef3fb5..ff94497 100644
--- a/src/scm/webid-oidc/stubs.scm
+++ b/src/scm/webid-oidc/stubs.scm
@@ -14,12 +14,31 @@
(lambda error
(raise-not-base64 data error))))
+(define (fix-generate-key . args)
+ (catch 'unsupported-crv
+ (lambda ()
+ (apply generate-key args))
+ (lambda (error)
+ (raise-unsupported-crv (cadr error)))))
+
+(define (fix-kty key)
+ (catch 'unsupported-crv
+ (lambda ()
+ (let ((ret (kty key)))
+ (unless ret
+ (raise-not-a-jwk key #f))
+ ret))
+ (lambda (error)
+ (raise-unsupported-crv (cadr error)))))
+
(export
base64-encode
(fix-base64-decode . base64-decode)
random
random-init!
- generate-key)
+ (fix-generate-key . generate-key)
+ (fix-kty . kty)
+ strip-key)
;; json reader from guile-json will not behave consistently with
;; SRFI-180 with objects: keys will be mapped to strings, not