summaryrefslogtreecommitdiff
path: root/src/scm/webid-oidc/serve.scm
diff options
context:
space:
mode:
authorVivien Kraus <vivien@planete-kraus.eu>2021-08-09 18:46:48 +0200
committerVivien Kraus <vivien@planete-kraus.eu>2021-08-13 01:06:38 +0200
commitded10e28782f289ad3db15320bcf619ab4336876 (patch)
tree32609fd9f1eb0d2f8a23105e09f193827d16a275 /src/scm/webid-oidc/serve.scm
parent7b62790238902e10edb83c07286cf0643b097997 (diff)
Switch to a more sensible error reporting system
Diffstat (limited to 'src/scm/webid-oidc/serve.scm')
-rw-r--r--src/scm/webid-oidc/serve.scm27
1 files changed, 25 insertions, 2 deletions
diff --git a/src/scm/webid-oidc/serve.scm b/src/scm/webid-oidc/serve.scm
index c46ab8c..db95089 100644
--- a/src/scm/webid-oidc/serve.scm
+++ b/src/scm/webid-oidc/serve.scm
@@ -1,4 +1,4 @@
-;; webid-oidc, implementation of the Solid specification
+;; disfluid, implementation of the Solid specification
;; Copyright (C) 2021 Vivien Kraus
;; This program is free software: you can redistribute it and/or modify
@@ -17,6 +17,7 @@
(define-module (webid-oidc serve)
#:use-module (webid-oidc errors)
#:use-module (webid-oidc fetch)
+ #:use-module (webid-oidc web-i18n)
#:use-module (ice-9 optargs)
#:use-module (ice-9 receive)
#:use-module (ice-9 exceptions)
@@ -30,11 +31,29 @@
#:use-module (nquads fromrdf)
#:use-module (json)
#:use-module (jsonld)
+ #:declarative? #t
#:export
(
+
+ &not-acceptable
+ make-not-acceptable
+ not-acceptable?
+ not-acceptable-client-accepts
+ not-acceptable-path
+ not-acceptable-content-type
+
convert
))
+(define-exception-type
+ &not-acceptable
+ &external-error
+ make-not-acceptable
+ not-acceptable?
+ (client-accepts not-acceptable-client-accepts)
+ (path not-acceptable-path)
+ (content-type not-acceptable-content-type))
+
(define (convert client-accepts server-name path content-type content)
(let ((data-as-rdf
(false-if-exception
@@ -53,7 +72,11 @@
;; Content negociation is asked
(let try-satisfy ((accepts client-accepts))
(if (null? accepts)
- (raise-exception (make-not-acceptable client-accepts path content-type))
+ (let ((final-message
+ (format #f (G_ "content negociation failed while serving a request"))))
+ (raise-exception
+ (make-not-acceptable client-accepts path content-type)
+ (make-exception-with-message final-message)))
(let ((request (caar accepts)))
(cond
((or (eq? request content-type)