From f472d4ad62c16d29047b00628c9561bd4729b199 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 28 Sep 2025 15:08:34 +0200
Subject: [PATCH] storage, web: extensions and fixes for message replay

---
 storage/msgstore.lisp  | 16 ++++++++++++----
 storage/tracking.lisp  |  5 ++++-
 test/test-storage.lisp |  6 +++---
 web/client.lisp        | 33 +++++++++++++++++++++++++--------
 4 files changed, 44 insertions(+), 16 deletions(-)

diff --git a/storage/msgstore.lisp b/storage/msgstore.lisp
index 14a8c47..8191714 100644
--- a/storage/msgstore.lisp
+++ b/storage/msgstore.lisp
@@ -7,7 +7,8 @@
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
                     (:storage :scopes/storage)
-                    (:tracking :scopes/storage/tracking))
+                    (:tracking :scopes/storage/tracking)
+                    (:util :scopes/util))
   (:export #:make-container #:save
            #:replay-id
            ))
@@ -35,8 +36,15 @@
                            :container cont)))
     (tracking:save pm)))
 
-(defun replay-id (ctx msgid rcvr)
+(defun replay-id (ctx msgid rcvr &key attrs)
   (let* ((st (storage:storage ctx))
          (cont (make-container st))
-         (msg (tracking:get-track cont msgid)))
-    (actor:send (core:find-service rcvr) msg)))
+         (msg (tracking:get-track cont msgid))
+         (ts (local-time:universal-to-timestamp (tracking:timestamp msg))))
+    (when attrs
+      (setf (shape:data msg)
+            (util:filter-plist (shape:data msg) attrs)))
+    (util:plist-add (shape:data msg) :|_timestamp| (local-time:format-timestring nil ts))
+    (format t "~&~s~%" msg)
+    (actor:send (core:mailbox (core:find-service rcvr)) msg)
+    ))
diff --git a/storage/tracking.lisp b/storage/tracking.lisp
index cfe79a2..d0af0c7 100644
--- a/storage/tracking.lisp
+++ b/storage/tracking.lisp
@@ -180,7 +180,10 @@
       (setf (timestamp tr) (getf row :timestamp))
       (setf (shape:data tr) 
             (funcall *build-track-data*
-              (jzon:parse (getf row :data) :key-fn #'util:to-keyword)))
+              ;(jzon:parse (getf row :data) :key-fn #'util:to-keyword)
+              (jzon:parse (getf row :data) 
+                          :key-fn (lambda (k) (intern k :keyword)))
+              ))
       tr)))
 
 (defun ensure-timestamp (track)
diff --git a/test/test-storage.lisp b/test/test-storage.lisp
index a0f2ba7..79c008f 100644
--- a/test/test-storage.lisp
+++ b/test/test-storage.lisp
@@ -58,7 +58,7 @@
     (== (tracking:trackid tr) 1)
     (setf tr2 (tracking:get-track cont 1))
     (== (shape:head tr2) '(:t01 :john))
-    (== (getf (shape:data tr2) :desc) "scopes/storage: queries")
+    (== (getf (shape:data tr2) :|desc|) "scopes/storage: queries")
     ))
 
 (deftest test-msgstore (ctx)
@@ -67,12 +67,12 @@
     (setf cont (msgstore:make-container st))
     (storage:drop-table st :messages)
     (tracking:create-table cont)
-    (setf msg (message:create '(:test :data :field) :data '(:info "test data")))
+    (setf msg (message:create '(:test :data :field) :data '(:|Info| "test data")))
     (setf pm (msgstore:save msg cont))
     (== (tracking:trackid pm) 1)
     (setf pm2 (tracking:get-track cont 1))
     (== (shape:head pm2) '(:test :data :field nil))
-    (== (getf (shape:data pm2) :info) "test data")
+    (== (getf (shape:data pm2) :|Info|) "test data") ; check: keyword case
     (setf pm3 (tracking:query-last cont '(:domain :test)))
     ;(util:lgi pm3)
     (msgstore:save pm3 cont)
diff --git a/web/client.lisp b/web/client.lisp
index ea116e5..d93c1cf 100644
--- a/web/client.lisp
+++ b/web/client.lisp
@@ -6,7 +6,9 @@
                     (:core :scopes/core)
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
-                    (:alx :alexandria))
+                    (:util :scopes/util)
+                    (:alx :alexandria)
+                    (:jzon :com.inuoe.jzon))
   (:export #:config #:base-url #:api-path #:doc-path
            #:get-page #:send-message))
 
@@ -18,6 +20,7 @@
   ((config:setup :initform (core:make-setup :class 'core:context))
    (base-url :reader base-url :initarg :base-url :initform "http://localhost:8135")
    (doc-path :reader doc-path :initarg :doc-path :initform "/")
+   (credentials :reader credentials :initarg :credentials :initform nil)
    (api-path :reader api-path :initarg :api-path :initform "/api/")
    (accept :reader accept :initarg :accept :initform "text/html")))
 
@@ -31,18 +34,32 @@
 
 (defun send-message (ctx msg)
   (let* ((cfg (core:config ctx))
-         (url (str:concat (base-url cfg) (api-path cfg) (msgpath msg))))
-    (dex:post url 
-              :content (data-as-alist (shape:data msg))
-              :headers `(("Accept" . ,(accept cfg)))
-              :cookie-jar *cookie-jar*)))
+         (url (str:concat (base-url cfg) (api-path cfg) (msgpath msg)))
+         (data (shape:data msg))
+         (cred (credentials cfg))
+         (params `(
+                   ;:content ,(data-as-json data)
+                   :content ,(data-as-alist data)
+                   :headers (("Accept" . ,(accept cfg)))
+                   :cookie-jar ,*cookie-jar*
+                   )))
+    (when cred
+      (util:plist-add params :basic-auth (cons (car cred) (cadr cred))))
+    (apply #'dex:post url params)
+    ))
 
 (defun msgpath (msg)
   (str:join "/" (loop for p in (shape:head msg) 
                       when p collect (string-downcase p))))
 
+(defun data-as-json (data)
+  (if (symbolp (car data))   ; seems to be a property list
+    (let ((ht (alx:plist-hash-table data)))
+      (jzon:stringify ht))
+    data))
+
 (defun data-as-alist (data)
   (if (symbolp (car data))   ; seems to be a property list
-    (mapcar #'(lambda (p) (cons (string-downcase (car p)) (cdr p)))
-            (alx:plist-alist data))
+    (let ((al (alx:plist-alist data)))
+      (mapcar #'(lambda (p) (cons (string (car p)) (cdr p))) al))
     data))