diff options
author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-06-27 15:56:20 +0200 |
---|---|---|
committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-06-27 16:12:54 +0200 |
commit | f58f4a40a427926e90d8761a9ee02a8c0dd58455 (patch) | |
tree | 2f24a35293d9dde8ccdc2c5aba1242a7d2c759e7 | |
parent | 85061afe1cf31b66cf946c4e2393381df7305098 (diff) |
Add a function to delete a resource as with DELETE
-rw-r--r-- | src/scm/webid-oidc/server/Makefile.am | 6 | ||||
-rw-r--r-- | src/scm/webid-oidc/server/delete.scm | 66 | ||||
-rw-r--r-- | tests/crud.scm | 9 |
3 files changed, 77 insertions, 4 deletions
diff --git a/src/scm/webid-oidc/server/Makefile.am b/src/scm/webid-oidc/server/Makefile.am index 371fc3d..6ef3dcf 100644 --- a/src/scm/webid-oidc/server/Makefile.am +++ b/src/scm/webid-oidc/server/Makefile.am @@ -2,12 +2,14 @@ dist_serverwebidoidcmod_DATA += \ %reldir%/create.scm \ %reldir%/read.scm \ %reldir%/precondition.scm \ - %reldir%/update.scm + %reldir%/update.scm \ + %reldir%/delete.scm serverwebidoidcgo_DATA += \ %reldir%/create.go \ %reldir%/read.go \ %reldir%/precondition.go \ - %reldir%/update.go + %reldir%/update.go \ + %reldir%/delete.go include %reldir%/resource/Makefile.am diff --git a/src/scm/webid-oidc/server/delete.scm b/src/scm/webid-oidc/server/delete.scm new file mode 100644 index 0000000..edd23cb --- /dev/null +++ b/src/scm/webid-oidc/server/delete.scm @@ -0,0 +1,66 @@ +(define-module (webid-oidc server delete) + #:use-module (webid-oidc errors) + #:use-module (webid-oidc server resource path) + #:use-module (webid-oidc server resource content) + #:use-module (webid-oidc server precondition) + #:use-module (webid-oidc cache) + #:use-module (webid-oidc fetch) + #:use-module (webid-oidc http-link) + #:use-module (webid-oidc server resource wac) + #:use-module ((webid-oidc stubs) #:prefix stubs:) + #:use-module (webid-oidc rdf-index) + #:use-module ((webid-oidc refresh-token) #:prefix refresh:) + #:use-module (web uri) + #:use-module (web client) + #:use-module (web response) + #:use-module (rdf rdf) + #:use-module (turtle tordf) + #:use-module (turtle fromrdf) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 exceptions) + #:use-module (ice-9 receive) + #:use-module (ice-9 optargs) + #:use-module (ice-9 iconv) + #:use-module (ice-9 textual-ports) + #:use-module (ice-9 binary-ports) + #:use-module (ice-9 threads) + #:use-module (ice-9 hash-table) + #:use-module (rnrs bytevectors) + #:use-module (oop goops) + #:export + ( + + delete + + )) + +(define* (delete server-name owner user path if-match if-none-match + #:key + (http-get http-get)) + (check-acl-can-write server-name path owner user) + (with-session + (lambda (load-content-type load-contained load-static-content + do-create do-delete) + (receive (base-path path-type) + (base-path path) + (update-path + base-path + (lambda (main-etag auxiliary) + (let ((relevant-etag + (if path-type + (assoc-ref auxiliary path-type) + main-etag))) + (check-precondition path if-match if-none-match relevant-etag) + (if path-type + ;; Delete an auxiliary resource + (values + main-etag + (filter + (lambda (auxiliary) + (not (equal? (car auxiliary) path-type))) + auxiliary)) + ;; Delete the main resource, if it’s not the root and + ;; it’s not a non-empty container (those things are + ;; checked by update-path). + #f))) + load-content-type load-contained load-static-content do-create do-delete))))) diff --git a/tests/crud.scm b/tests/crud.scm index 6524cfd..6eb1bfe 100644 --- a/tests/crud.scm +++ b/tests/crud.scm @@ -1,6 +1,7 @@ (use-modules (webid-oidc server create) (webid-oidc server read) (webid-oidc server update) + (webid-oidc server delete) (webid-oidc server resource content) (webid-oidc server resource path) (webid-oidc errors) @@ -38,7 +39,9 @@ "5/KVojpXDg0Aob3_v" "S/9kvZXAg1UQojIal" "B/JadnRZKhcTKHHZU" - "_/VhVgLvE4J9JwpIP")) + "_/VhVgLvE4J9JwpIP" + "l/ljOph3RCCWJJW5K" + "o/UmwpeCFbPoc9PCL")) (for-each (lambda (f) (false-if-exception @@ -239,5 +242,7 @@ (when (bytevector? content) (set! content (utf8->string content))) (when (equal? content exact-content) - (exit 25))))))) + (exit 25)))) + (delete server-name owner owner "/inbox/test-notifications/welcome" #f #f) + (delete server-name owner owner "/inbox/test-notifications" #f #f)))) |