diff options
Diffstat (limited to 'src/scm/webid-oidc/server/create.scm')
-rw-r--r-- | src/scm/webid-oidc/server/create.scm | 53 |
1 files changed, 48 insertions, 5 deletions
diff --git a/src/scm/webid-oidc/server/create.scm b/src/scm/webid-oidc/server/create.scm index b7b208d..dc9651e 100644 --- a/src/scm/webid-oidc/server/create.scm +++ b/src/scm/webid-oidc/server/create.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -21,6 +21,7 @@ #:use-module (webid-oidc server read) #:use-module (webid-oidc cache) #:use-module (webid-oidc fetch) + #:use-module (webid-oidc web-i18n) #:use-module (webid-oidc rdf-index) #:use-module (webid-oidc server resource wac) #:use-module ((webid-oidc stubs) #:prefix stubs:) @@ -42,20 +43,51 @@ #:use-module (ice-9 threads) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:declarative? #t #:export ( + &incorrect-containment-triples + make-incorrect-containment-triples + incorrect-containment-triples? + incorrect-containment-triples-path + + &unsupported-media-type + make-unsupported-media-type + unsupported-media-type? + unsupported-media-type-content-type + create create-root )) +(define-exception-type + &incorrect-containment-triples + &external-error + make-incorrect-containment-triples + incorrect-containment-triples? + (path incorrect-containment-triples-path)) + +(define-exception-type + &unsupported-media-type + &external-error + make-unsupported-media-type + unsupported-media-type? + (content-type unsupported-media-type-content-type)) + (define (without-containment-triples doc-uri content-type content) (case content-type ((text/turtle) #t) (else - (raise-exception (make-unsupported-media-type content-type)))) + (let ((final-message + (format #f (G_ "only text/turtle is allowed for the target of a POST request, not ~s") + content-type))) + (raise-exception + (make-exception + (make-unsupported-media-type content-type) + (make-exception-with-message final-message)))))) (let ((graph (fetch doc-uri #:http-get @@ -69,8 +101,13 @@ (unless (null? (rdf-match (uri->string doc-uri) "http://www.w3.org/ns/auth/acl#contains" #f)) - (raise-exception (make-incorrect-containment-triples - (uri-path doc-uri)))))))) + (let ((final-message + (format #f (G_ "the created resource cannot have containment triples")))) + (raise-exception + (make-exception + (make-incorrect-containment-triples + (uri-path doc-uri)) + (make-exception-with-message final-message))))))))) (define (types-indicate-container? types) (and (not (null? types)) @@ -106,7 +143,13 @@ ;; non-empty. (if container? "/" ""))))) (when (auxiliary-path? (uri-path doc-uri)) - (raise-exception (make-path-is-auxiliary (uri-path doc-uri)))) + (let ((final-message + (format #f (G_ "cannot POST to an auxiliary resource path, ~s") + (uri-path doc-uri)))) + (raise-exception + (make-exception + (make-path-is-auxiliary (uri-path doc-uri)) + (make-exception-with-message final-message))))) (when container? (without-containment-triples doc-uri content-type content)) (with-session |