Use anonymous-http-request from (webid-oidc parameters) everywhere

6 files changed, 62 insertions, 78 deletions

diff --git a/src/scm/webid-oidc/server/create.scm b/src/scm/webid-oidc/server/create.scm
index dc9651e..0558ff3 100644
--- a/src/scm/webid-oidc/server/create.scm
+++ b/src/scm/webid-oidc/server/create.scm
@@ -27,8 +27,8 @@
   #: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 (web client)
   #:use-module (web response)
   #:use-module (rdf rdf)
   #:use-module (turtle tordf)
@@ -88,13 +88,14 @@
         (make-exception
          (make-unsupported-media-type content-type)
          (make-exception-with-message final-message))))))
-  (let ((graph (fetch
-                doc-uri
-                #:http-get
-                (lambda (uri . args)
-                  (values
-                   (build-response #:headers `((content-type ,content-type)))
-                   content)))))
+  (let ((graph
+         (parameterize
+             ((p:anonymous-http-request
+               (lambda* (uri . args)
+                 (values
+                  (build-response #:headers `((content-type ,content-type)))
+                  content))))
+           (fetch doc-uri))))
     (with-index
      graph
      (lambda (rdf-match)
@@ -117,10 +118,8 @@
          (or (equal? next "http://www.w3.org/ns/ldp#BasicContainer")
              (types-indicate-container? (cdr types))))))
 
-(define* (create server-name owner user container types slug content-type content
-                 #:key
-                 (http-get http-get))
-  (check-acl-can-append server-name container owner user #:http-get http-get)
+(define* (create server-name owner user container types slug content-type content)
+  (check-acl-can-append server-name container owner user)
   (unless (and slug (not (equal? slug "")))
     (set! slug (stubs:random 12)))
   (when (string-contains slug "/")
@@ -171,8 +170,7 @@
            (lambda error
              (create server-name owner user container types
                      (string-append slug "-" (stubs:random 12))
-                     content-type content
-                     #:http-get http-get))))))))
+                     content-type content))))))))
 
 (define (create-root server-name owner)
   (define (fix-angle-aux accu chars)
diff --git a/src/scm/webid-oidc/server/delete.scm b/src/scm/webid-oidc/server/delete.scm
index 4e4ce66..02344ad 100644
--- a/src/scm/webid-oidc/server/delete.scm
+++ b/src/scm/webid-oidc/server/delete.scm
@@ -26,8 +26,8 @@
   #: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 (web client)
   #:use-module (web response)
   #:use-module (rdf rdf)
   #:use-module (turtle tordf)
@@ -51,9 +51,7 @@
 
    ))
 
-(define* (delete server-name owner user path if-match if-none-match
-                 #:key
-                 (http-get http-get))
+(define* (delete server-name owner user path if-match if-none-match)
   (check-acl-can-write server-name path owner user)
   (with-session
    (lambda (load-content-type load-contained load-static-content
diff --git a/src/scm/webid-oidc/server/precondition.scm b/src/scm/webid-oidc/server/precondition.scm
index 03ee967..7e3a4bb 100644
--- a/src/scm/webid-oidc/server/precondition.scm
+++ b/src/scm/webid-oidc/server/precondition.scm
@@ -25,8 +25,8 @@
   #: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 (web client)
   #:use-module (web response)
   #:use-module (rdf rdf)
   #:use-module (turtle tordf)
diff --git a/src/scm/webid-oidc/server/read.scm b/src/scm/webid-oidc/server/read.scm
index cc74898..0cd49fd 100644
--- a/src/scm/webid-oidc/server/read.scm
+++ b/src/scm/webid-oidc/server/read.scm
@@ -26,8 +26,8 @@
   #: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 (web client)
   #:use-module (web response)
   #:use-module (rdf rdf)
   #:use-module (turtle tordf)
@@ -63,14 +63,12 @@
   (base-path auxiliary-resource-absent-base-path)
   (path-type auxiliary-resource-absent-path-type))
 
-(define* (read server-name owner user path
-               #:key
-               (http-get http-get))
+(define* (read server-name owner user path)
   (declare-link-header!)
   (with-session
    (lambda (load-content-type load-contained load-static-content
                               do-create do-delete)
-     (check-acl-can-read server-name path owner user #:http-get http-get)
+     (check-acl-can-read server-name path owner user)
      (receive (base-path path-type)
          (base-path path)
        (let ((container? (container-path? path))
@@ -183,19 +181,20 @@
                 ;; Content
                 (if container?
                     (let ((static-graph
-                           (fetch
-                            (build-uri
-                             'https
-                             #:userinfo (uri-userinfo server-name)
-                             #:host (uri-host server-name)
-                             #:port (uri-port server-name)
-                             #:path path)
-                            #:http-get
-                            (lambda (uri . args)
-                              (values
-                               (build-response
-                                #:headers `((content-type ,(load-content-type relevant-etag))))
-                               (load-static-content relevant-etag))))))
+                           (parameterize
+                               ((p:anonymous-http-request
+                                 (lambda (uri . args)
+                                   (values
+                                    (build-response
+                                     #:headers `((content-type ,(load-content-type relevant-etag))))
+                                    (load-static-content relevant-etag)))))
+                             (fetch
+                              (build-uri
+                               'https
+                               #:userinfo (uri-userinfo server-name)
+                               #:host (uri-host server-name)
+                               #:port (uri-port server-name)
+                               #:path path)))))
                       (let ((final-graph
                              (reverse
                               (append
diff --git a/src/scm/webid-oidc/server/resource/wac.scm b/src/scm/webid-oidc/server/resource/wac.scm
index e3ed089..d3f4adf 100644
--- a/src/scm/webid-oidc/server/resource/wac.scm
+++ b/src/scm/webid-oidc/server/resource/wac.scm
@@ -23,9 +23,9 @@
   #: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 (webid-oidc web-i18n)
   #:use-module (web uri)
-  #:use-module (web client)
   #:use-module (rdf rdf)
   #:use-module (turtle tordf)
   #:use-module (rnrs bytevectors)
@@ -82,7 +82,7 @@
   (owner forbidden-owner)
   (expected-mode forbidden-expected-mode))
 
-(define (group-member? http-get group-uri agent)
+(define (group-member? group-uri agent)
   (when (string? group-uri)
     (set! group-uri (string->uri group-uri)))
   (when (string? agent)
@@ -111,7 +111,7 @@
              #:continuable? #t))
           #f)
       (lambda ()
-        (let ((data (fetch group-doc-uri #:http-get http-get)))
+        (let ((data (fetch group-doc-uri)))
           (with-index
            data
            (lambda (rdf-match)
@@ -137,7 +137,7 @@
                                #:path (string-append path ".acl"))))))
    f))
 
-(define (check-authorization path check-default? server-name final-path http-get user rdf-match id)
+(define (check-authorization path check-default? server-name final-path user rdf-match id)
   ;; The authorization should give accessTo path,
   ;; or to a prefix of final-path; and it should
   ;; be for agent user, or a group that contains
@@ -211,7 +211,7 @@
                (and user
                     (not (null?
                           (filter (lambda (group)
-                                    (group-member? http-get group user))
+                                    (group-member? group user))
                                   groups))))))))
     (or
      (and access-to-ok
@@ -227,23 +227,21 @@
                            #f))))
      '())))
 
-(define (check-authorizations path check-default? server-name final-path http-get user rdf-match
+(define (check-authorizations path check-default? server-name final-path user rdf-match
                               allowed-modes authorizations)
   (if (null? authorizations)
       (reverse allowed-modes)
       (let ((new-modes
-             (check-authorization path check-default? server-name final-path http-get user rdf-match
+             (check-authorization path check-default? server-name final-path user rdf-match
                                   (car authorizations))))
         (check-authorizations
-         path check-default? server-name final-path http-get user rdf-match
+         path check-default? server-name final-path user rdf-match
          (append (reverse new-modes) allowed-modes)
          (cdr authorizations)))))
 
 (define acl-aux (string->uri "http://www.w3.org/ns/auth/acl#accessControl"))
 
-(define* (wac-get-modes server-name final-path user
-                        #:key
-                        (http-get http-get))
+(define (wac-get-modes server-name final-path user)
   (with-session
    (lambda (content-type contained static-content create delete)
      (define (wac-check-recursive path check-default?)
@@ -263,7 +261,7 @@
                 server-name path (content-type acl-etag) (static-content acl-etag)
                 (lambda (rdf-match)
                   (check-authorizations
-                   path check-default? server-name final-path http-get user rdf-match
+                   path check-default? server-name final-path user rdf-match
                    '()
                    (map rdf-triple-subject
                         (rdf-match #f
@@ -300,7 +298,7 @@
                   (? uri? (= uri->string b)))
                  (string< a b)))))))))
 
-(define (check-mode server-name path owner user http-get expected-mode)
+(define (check-mode server-name path owner user expected-mode)
   (unless (equal? owner user)
     (receive (base-path type)
         (base-path path)
@@ -313,7 +311,7 @@
         ;; for Control over the base resource.
         (set! path base-path)
         (set! expected-mode (string->uri "http://www.w3.org/ns/auth/acl#Control"))))
-    (let ((modes (wac-get-modes server-name path user #:http-get http-get)))
+    (let ((modes (wac-get-modes server-name path user)))
       (define (check-modes modes)
         (if (null? modes)
             (let ((final-message
@@ -337,26 +335,18 @@
              (check-modes (cdr modes)))))
       (check-modes modes))))
 
-(define* (check-acl-can-read server-name path owner user
-                             #:key
-                             (http-get http-get))
-  (check-mode server-name path owner user http-get
+(define (check-acl-can-read server-name path owner user)
+  (check-mode server-name path owner user
               (string->uri "http://www.w3.org/ns/auth/acl#Read")))
 
-(define* (check-acl-can-write server-name path owner user
-                             #:key
-                             (http-get http-get))
-  (check-mode server-name path owner user http-get
+(define (check-acl-can-write server-name path owner user)
+  (check-mode server-name path owner user
               (string->uri "http://www.w3.org/ns/auth/acl#Write")))
 
-(define* (check-acl-can-append server-name path owner user
-                             #:key
-                             (http-get http-get))
-  (check-mode server-name path owner user http-get
+(define (check-acl-can-append server-name path owner user)
+  (check-mode server-name path owner user
               (string->uri "http://www.w3.org/ns/auth/acl#Append")))
 
-(define* (check-acl-can-control server-name path owner user
-                             #:key
-                             (http-get http-get))
-  (check-mode server-name path owner user http-get
+(define (check-acl-can-control server-name path owner user)
+  (check-mode server-name path owner user
               (string->uri "http://www.w3.org/ns/auth/acl#Control")))
diff --git a/src/scm/webid-oidc/server/update.scm b/src/scm/webid-oidc/server/update.scm
index 589de44..d568d06 100644
--- a/src/scm/webid-oidc/server/update.scm
+++ b/src/scm/webid-oidc/server/update.scm
@@ -27,8 +27,8 @@
   #: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 (web client)
   #:use-module (web response)
   #:use-module (rdf rdf)
   #:use-module (turtle tordf)
@@ -60,13 +60,14 @@
      (raise-exception
       (make-exception
        (make-unsupported-media-type content-type)))))
-  (let ((graph (fetch
-                doc-uri
-                #:http-get
-                (lambda (uri . args)
-                  (values
-                   (build-response #:headers `((content-type ,content-type)))
-                   content)))))
+  (let ((graph
+         (parameterize
+             ((p:anonymous-http-request
+               (lambda (uri . args)
+                 (values
+                  (build-response #:headers `((content-type ,content-type)))
+                  content))))
+           (fetch doc-uri))))
     (with-index
      graph
      (lambda (rdf-match)
@@ -90,9 +91,7 @@
                    (rdf->turtle final-graph))))))))))
 
 (define* (update server-name owner user path if-match if-none-match
-                 content-type content
-                 #:key
-                 (http-get http-get))
+                 content-type content)
   (define updated-etag #f)
   (with-session
    (lambda (load-content-type load-contained load-static-content