From 1aa5acda7cbbfa00a6b4cde56c6963fa684f391b Mon Sep 17 00:00:00 2001
From: Piotr Szarmanski
Date: Fri, 4 Aug 2023 19:39:32 +0200
Subject: New HTTP backend.

---
 extra/http/client.lisp | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)
 create mode 100644 extra/http/client.lisp

(limited to 'extra/http/client.lisp')

diff --git a/extra/http/client.lisp b/extra/http/client.lisp
new file mode 100644
index 0000000..a694612
--- /dev/null
+++ b/extra/http/client.lisp
@@ -0,0 +1,33 @@
+(in-package #:eris-http-client)
+
+(defclass http-backend (eris:encoding-backend eris:decoding-backend)
+  ((endpoint :initarg :endpoint :type quri:uri
+             :documentation "HTTP endpoint to use.")
+   (auth :initarg :auth :type cons
+         :documentation "A login:password pair for HTTP Basic auth.")))
+
+(defmethod initialize-instance ((http-backend http-backend) &rest initargs
+                                &key (endpoint nil endpoint-p)
+                                  (auth nil)
+                                &allow-other-keys)
+  (declare (ignore initargs))
+  (unless endpoint-p
+    (error 'simple-error "An endpoint must be specified."))
+  (let ((uri (quri:uri endpoint)))
+    ;; To prevent confusion of what part of the endpoint should be included
+    (unless (string-suffix-p "/uri-res/" (quri:uri-path uri))
+      (error 'simple-error "Endpoint must end in /uri-res/."))
+    (with-slots (eris:output-function eris:fetch-function) http-backend
+      (setf (quri:uri-path uri) (concatenate 'string (quri:uri-path uri) "N2R"))
+      (setf eris:fetch-function
+            (lambda (reference)
+              (setf (quri:uri-query uri) (eris:reference-to-block-urn reference))
+              (mvlet ((body status (dexador:get uri)))
+                (if (eql status 404)
+                    (error 'eris:missing-block)
+                    body)))
+            eris:output-function
+            (lambda (block reference)
+              (setf (quri:uri-query uri) (eris:reference-to-block-urn reference))
+              (dexador:post uri :force-binary t :content block :basic-auth auth)
+              block)))))
-- 
cgit v1.2.3