Content API: use GOOPS for the cache

1 files changed, 43 insertions, 45 deletions

diff --git a/tests/server-content.scm b/tests/server-content.scm
index bb32be4..b53e399 100644
--- a/tests/server-content.scm
+++ b/tests/server-content.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
@@ -14,16 +14,19 @@
 ;; You should have received a copy of the GNU Affero General Public License
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
-(use-modules (webid-oidc server resource content)
-             (webid-oidc fetch)
-             (webid-oidc testing)
-             (webid-oidc errors)
-             (web uri)
-             (web response)
-             (rnrs bytevectors)
-             (ice-9 optargs)
-             (ice-9 receive)
-             (oop goops))
+(define-module (tests server-content)
+  #:use-module (webid-oidc server resource content)
+  #:use-module (webid-oidc fetch)
+  #:use-module (webid-oidc testing)
+  #:use-module (webid-oidc errors)
+  #:use-module (web uri)
+  #:use-module (web response)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 optargs)
+  #:use-module (ice-9 receive)
+  #:use-module (oop goops)
+  #:duplicates (merge-generics)
+  #:declarative? #t)
 
 (with-test-environment
  "server-content"
@@ -34,37 +37,32 @@
    (false-if-exception
     ;; This is the etag of /wtf
     (delete-file "tests/server-content.home/disfluid/server/content/X/hqM_2Avn5_egTzs"))
-   (receive (/ /wtf)
-       (with-session
-        (lambda (content-type contained static-content create delete)
-          (let ((/ (create 'text/turtle '("/whatever" "/you" "/want")
-                           "# This is the content of the root"))
-                (/wtf (create 'text/plain '() "This is the content of the wtf")))
-            (unless (equal? (static-content /wtf)
-                            (string->utf8 "This is the content of the wtf"))
-              (exit 1))
-            (delete /wtf)
-            (unless (eq? (content-type /wtf) 'text/plain)
-              ;; It has survived in the cache
-              (exit 2))
-            (values / /wtf))))
-     (with-session
-      (lambda (content-type contained static-content create delete)
-        (unless
-            (with-exception-handler
-                (lambda (error)
-                  ;; Good, we can’t load /wtf
-                  #t)
-              (lambda ()
-                (content-type /wtf)
-                #f)
-              #:unwind? #t)
-          ;;We could read /wtf, it has not been deleted
-          (exit 3))
-        (unless (eq? (content-type /) 'text/turtle)
-          (exit 4))
-        (unless (equal? (contained /) '("/whatever" "/you" "/want"))
-          (exit 5))
-        (unless (equal? (static-content /)
-                        (string->utf8 "# This is the content of the root"))
-          (exit 6)))))))
+   (parameterize ((current-content-cache (make <content-cache>)))
+     (let ((/
+            (make <content>
+              #:content-type 'text/turtle
+              #:contained '("/whatever" "/you" "/want")
+              #:static-content "# This is the content of the root"))
+           (/wtf
+            (make <content>
+              #:content-type 'text/plain
+              #:static-content "This is the content of the wtf")))
+       (unless (equal? (static-content /wtf)
+                       (string->utf8 "This is the content of the wtf"))
+         (exit 1))
+       (delete-content /wtf)
+       ;; Reload it with cache, it should still be available
+       (set! /wtf (make <content> #:etag (etag /wtf)))
+       ;; Reload it without session, and it should fail
+       (parameterize ((current-content-cache #f))
+         (when (false-if-exception (make <content> #:etag (etag /wtf)))
+           (exit 2)))
+       (unless (eq? (content-type /wtf) 'text/plain)
+         (exit 3))
+       (unless (eq? (content-type /) 'text/turtle)
+         (exit 4))
+       (unless (equal? (contained /) '("/whatever" "/you" "/want"))
+         (exit 5))
+       (unless (equal? (static-content /)
+                       (string->utf8 "# This is the content of the root"))
+         (exit 6))))))