diff options
Diffstat (limited to 'src/scm/webid-oidc/errors.scm')
| -rw-r--r-- | src/scm/webid-oidc/errors.scm | 208 |
1 files changed, 208 insertions, 0 deletions
diff --git a/src/scm/webid-oidc/errors.scm b/src/scm/webid-oidc/errors.scm index beeaaea..50d526c 100644 --- a/src/scm/webid-oidc/errors.scm +++ b/src/scm/webid-oidc/errors.scm @@ -227,6 +227,146 @@ (raise-exception ((record-constructor ¬-an-oidc-configuration) value cause))) +(define-public &incorrect-webid-field + (make-exception-type + '&incorrect-webid-field + &external-error + '(value))) + +(define-public (raise-incorrect-webid-field value) + (raise-exception + ((record-constructor &incorrect-webid-field) value))) + +(define-public &incorrect-iss-field + (make-exception-type + '&incorrect-iss-field + &external-error + '(value))) + +(define-public (raise-incorrect-iss-field value) + (raise-exception + ((record-constructor &incorrect-iss-field) value))) + +(define-public &incorrect-aud-field + (make-exception-type + '&incorrect-aud-field + &external-error + '(value))) + +(define-public (raise-incorrect-aud-field value) + (raise-exception + ((record-constructor &incorrect-aud-field) value))) + +(define-public &incorrect-iat-field + (make-exception-type + '&incorrect-iat-field + &external-error + '(value))) + +(define-public (raise-incorrect-iat-field value) + (raise-exception + ((record-constructor &incorrect-iat-field) value))) + +(define-public &incorrect-exp-field + (make-exception-type + '&incorrect-exp-field + &external-error + '(value))) + +(define-public (raise-incorrect-exp-field value) + (raise-exception + ((record-constructor &incorrect-exp-field) value))) + +(define-public &incorrect-cnf/jkt-field + (make-exception-type + '&incorrect-cnf/jkt-field + &external-error + '(value))) + +(define-public (raise-incorrect-cnf/jkt-field value) + (raise-exception + ((record-constructor &incorrect-cnf/jkt-field) value))) + +(define-public &incorrect-client-id-field + (make-exception-type + '&incorrect-client-id-field + &external-error + '(value))) + +(define-public (raise-incorrect-client-id-field value) + (raise-exception + ((record-constructor &incorrect-client-id-field) value))) + +(define-public ¬-an-access-token + (make-exception-type + '¬-an-access-token + &external-error + '(value cause))) + +(define-public (raise-not-an-access-token value cause) + (raise-exception + ((record-constructor ¬-an-access-token) value cause))) + +(define-public ¬-an-access-token-header + (make-exception-type + '¬-an-access-token-header + &external-error + '(value cause))) + +(define-public (raise-not-an-access-token-header value cause) + (raise-exception + ((record-constructor ¬-an-access-token-header) value cause))) + +(define-public ¬-an-access-token-payload + (make-exception-type + '¬-an-access-token-payload + &external-error + '(value cause))) + +(define-public (raise-not-an-access-token-payload value cause) + (raise-exception + ((record-constructor ¬-an-access-token-payload) value cause))) + +(define-public &cannot-fetch-issuer-configuration + (make-exception-type + '&cannot-fetch-issuer-configuration + &external-error + '(issuer cause))) + +(define-public (raise-cannot-fetch-issuer-configuration issuer cause) + (raise-exception + ((record-constructor &cannot-fetch-issuer-configuration) issuer cause))) + +(define-public &cannot-fetch-jwks + (make-exception-type + '&cannot-fetch-jwks + &external-error + '(issuer uri cause))) + +(define-public (raise-cannot-fetch-jwks issuer uri cause) + (raise-exception + ((record-constructor &cannot-fetch-jwks) issuer uri cause))) + +(define-public &cannot-decode-access-token + (make-exception-type + '&cannot-decode-access-token + &external-error + '(value cause))) + +(define-public (raise-cannot-decode-access-token value cause) + (raise-exception + ((record-constructor &cannot-decode-access-token) value cause))) + +(define-public &cannot-encode-access-token + (make-exception-type + '&cannot-encode-access-token + &external-error + '(access-token key cause))) + +(define-public (raise-cannot-encode-access-token access-token key cause) + (raise-exception + ((record-constructor &cannot-encode-access-token) access-token key cause))) + (define*-public (error->str err #:key (max-depth #f)) (if (record? err) (let* ((type (record-type-descriptor err)) @@ -322,6 +462,74 @@ ((¬-an-oidc-configuration) (format #f (G_ "the value ~s is not an OIDC configuration (because ~a)") (get 'value) (recurse (get 'cause)))) + ((&incorrect-webid-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the webid field is incorrect: ~s") value) + (format #f (G_ "the webid field is missing"))))) + ((&incorrect-iss-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the iss field is incorrect: ~s") value) + (format #f (G_ "the iss field is missing"))))) + ((&incorrect-aud-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the aud field is incorrect: ~s") value) + (format #f (G_ "the aud field is missing"))))) + ((&incorrect-iat-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the iat field is incorrect: ~s") value) + (format #f (G_ "the iat field is missing"))))) + ((&incorrect-exp-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the exp field is incorrect: ~s") value) + (format #f (G_ "the exp field is missing"))))) + ((&incorrect-cnf/jkt-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the cnf/jkt field is incorrect: ~s") value) + (format #f (G_ "the cnf/jkt field is missing"))))) + ((&incorrect-client-id-field) + (let ((value (get 'value))) + (if value + (format #f (G_ "the client-id field is incorrect: ~s") value) + (format #f (G_ "the client-id field is missing"))))) + ((¬-an-access-token) + (format #f (G_ "~s is not an access token (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((¬-an-access-token-header) + (format #f (G_ "~s is not an access token header (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((¬-an-access-token-payload) + (format #f (G_ "~s is not an access token payload (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((&cannot-fetch-issuer-configuration) + (format #f (G_ "I cannot fetch the issuer configuration of ~a (because ~a)" + (let ((iss (get 'issuer))) + (when (uri? iss) + (set! iss (uri->string iss))) + iss) + (recurse (get 'cause))))) + ((&cannot-fetch-jwks) + (format #f (G_ "I cannot fetch the JWKS of ~a at ~a (because ~a)" + (let ((iss (get 'issuer))) + (when (uri? iss) + (set! iss (uri->string iss))) + iss) + (let ((uri (get 'uri))) + (when (uri? uri) + (set! uri (uri->string uri))) + uri) + (recurse (get 'cause))))) + ((&cannot-decode-access-token) + (format #f (G_ "I cannot decode ~s as an access token (because ~a)" + (get 'value) (recurse (get 'cause))))) + ((&cannot-encode-access-token) + (format #f (G_ "I cannot encode ~s as an access token with key ~s (because ~a)") + (get 'access-token) (get 'key) (recurse (get 'cause)))) ((&compound-exception) (let ((components (get 'components))) (if (null? components) |