From bae1843f1a1d644fb3bd4f8c40b1dbb900aa3325 Mon Sep 17 00:00:00 2001
From: Vivien Kraus <vivien@planete-kraus.eu>
Date: Sun, 1 Aug 2021 14:51:28 +0200
Subject: Use guile parameters

With parameters, the API does not need to care about the directory
where to load files and how to get the time.
---
 src/scm/webid-oidc/server/resource/content.scm | 31 +++++++++++++-------------
 1 file changed, 15 insertions(+), 16 deletions(-)

(limited to 'src/scm/webid-oidc/server/resource/content.scm')

diff --git a/src/scm/webid-oidc/server/resource/content.scm b/src/scm/webid-oidc/server/resource/content.scm
index 29d8889..57c51dd 100644
--- a/src/scm/webid-oidc/server/resource/content.scm
+++ b/src/scm/webid-oidc/server/resource/content.scm
@@ -19,6 +19,7 @@
   #:use-module ((webid-oidc stubs) #:prefix stubs:)
   #:use-module (webid-oidc rdf-index)
   #:use-module ((webid-oidc refresh-token) #:prefix refresh:)
+  #:use-module ((webid-oidc parameters) #:prefix p:)
   #:use-module (web uri)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 exceptions)
@@ -36,18 +37,18 @@
 
    ))
 
-(define (default-dir)
-  (string-append (refresh:default-dir) "/server"))
-
 (define-class <content> ()
   (content-type #:init-keyword #:content-type #:getter content-type)
   (contained #:init-keyword #:contained #:getter contained)
   (static-content #:init-keyword #:static-content #:getter static-content))
 
-(define (load-content session dir etag)
+(define (load-content session etag)
   (let ((first-char (substring etag 0 1))
         (rest (substring etag 1)))
-    (call-with-input-file (format #f "~a/content/~a/~a" dir first-char rest)
+    (call-with-input-file (format #f "~a/server/content/~a/~a"
+                                  (p:data-home)
+                                  first-char
+                                  rest)
       (lambda (port)
         (let ((properties (read port)))
           (set-port-encoding! port "ISO-8859-1")
@@ -60,14 +61,14 @@
             (hash-set! session etag ret)
             ret))))))
 
-(define (new-content session dir content-type contained static-content)
+(define (new-content session content-type contained static-content)
   (when (string? static-content)
     (set! static-content (string->utf8 static-content)))
   (let ((etag (stubs:random 12)))
     (let ((first-char (substring etag 0 1))
           (rest (substring etag 1)))
-      (stubs:mkdir-p (format #f "~a/content/~a" dir first-char))
-      (let ((port (open (format #f "~a/content/~a/~a" dir first-char rest)
+      (stubs:mkdir-p (format #f "~a/server/content/~a" (p:data-home) first-char))
+      (let ((port (open (format #f "~a/server/content/~a/~a" (p:data-home) first-char rest)
                         (logior O_WRONLY O_CREAT O_EXCL))))
         (write `((content-type . ,content-type)
                  (contained . ,contained)) port)
@@ -82,18 +83,16 @@
                      #:static-content static-content))
         etag))))
 
-(define (delete-content dir etag)
+(define (delete-content etag)
   (let ((first-char (substring etag 0 1))
         (rest (substring etag 1)))
-    (delete-file (format #f "~a/content/~a/~a" dir first-char rest))))
+    (delete-file (format #f "~a/server/content/~a/~a" (p:data-home) first-char rest))))
 
-(define* (with-session f #:key (dir default-dir))
-  (when (thunk? dir)
-    (set! dir (dir)))
+(define (with-session f)
   (let ((session (make-hash-table)))
     (define (do-load etag)
       (or (hash-ref session etag)
-          (load-content session dir etag)))
+          (load-content session etag)))
     (define (get-content-type etag)
       (content-type (do-load etag)))
     (define (get-contained etag)
@@ -101,7 +100,7 @@
     (define (get-static-content etag)
       (static-content (do-load etag)))
     (define (do-create content-type contained static-content)
-      (new-content session dir content-type contained static-content))
+      (new-content session content-type contained static-content))
     (define (do-delete etag)
-      (delete-content dir etag))
+      (delete-content etag))
     (f get-content-type get-contained get-static-content do-create do-delete)))
-- 
cgit v1.2.3