From 797b291262e3649fdbaec569851b586a824204c4 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sun, 7 Jul 2024 11:04:16 +0200
Subject: [PATCH] minor improvements on message handling, server response, echo
 handler

---
 core/core.lisp      | 11 +++++++----
 core/message.lisp   |  8 ++++++--
 test/test-core.lisp |  2 +-
 web/server.lisp     | 13 +++++--------
 4 files changed, 19 insertions(+), 15 deletions(-)

diff --git a/core/core.lisp b/core/core.lisp
index 4f06100..4e46217 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -105,10 +105,13 @@
 ;;;; some simple predefined actions
 
 (defun echo (ctx msg)
-  (let ((resp (message:sender msg)))
-    (if (null resp)
-      (log:warn "sender missing: ~s" msg)
-      (send resp msg))))
+  (let ((sndr (message:sender msg)))
+    (if sndr
+      (let* ((h (message:head-as-list msg))
+             (new-msg (message:create `(:scopes :echo ,@(cddr h))
+                                      :data (message:data msg))))
+        (send sndr new-msg))
+      (log:warn "sender missing: ~s" msg))))
 
 (defun do-print (ctx msg)
   (declare (ignore ctx))
diff --git a/core/message.lisp b/core/message.lisp
index 959c0de..76ac704 100644
--- a/core/message.lisp
+++ b/core/message.lisp
@@ -2,8 +2,9 @@
 
 (defpackage :scopes/core/message
   (:use :common-lisp)
-  (:export #:message #:make-message #:simple-message
-           #:head #:data #:sender #:head-as-list))
+  (:export #:message #:create #:make-message #:simple-message
+           #:head #:head-as-list
+           #:data #:sender))
 
 (in-package :scopes/core/message)
 
@@ -24,6 +25,9 @@
    (data :accessor data :initarg :data :initform nil)))
 
 (defun make-message (head-vals &key data sender)
+  (create head-vals :data data :sender sender))
+
+(defun create (head-vals &key data sender)
   (let ((h (make-instance 'message-head)))
     (dolist (sl '(domain action class item))
       (setf (slot-value h sl) (pop head-vals)))
diff --git a/test/test-core.lisp b/test/test-core.lisp
index 1d77804..99782b7 100644
--- a/test/test-core.lisp
+++ b/test/test-core.lisp
@@ -31,7 +31,7 @@
           (if (not (equalp (message:data msg) val))
             (t:failure "data mismatch: ~s, expected: ~s" msg val))
           (remhash key (expected ctx)))
-       (t:failure "unexpected: ~s" msg)))))
+        (t:failure "unexpected: ~s" msg)))))
 
 (defun expect (ctx msg)
   (setf (gethash (message:head-as-list msg) (expected ctx))
diff --git a/web/server.lisp b/web/server.lisp
index 8b41353..9c3d7da 100644
--- a/web/server.lisp
+++ b/web/server.lisp
@@ -57,14 +57,14 @@
       (lack/component:call file-app env))))
 
 (defun message-handler (ctx env)
-  (let* ((resp (make-response ctx))
-         (msg (message:make-message 
+  (let* ((resp (make-instance 'response))
+         (msg (message:create 
                 (head env) :data (plist (post-data env)) :sender resp)))
     (log:debug "msg ~s" msg)
     (if (core:handle-message ctx msg)
       ;(render-response ctx resp)
       (list 200 (headers resp) (list (body resp)))
-      '(404 (:content-type "text/plain") ("Not found")))))
+      (list 404 '(:content-type "text/plain") '("Not found")))))
       ;(render-not-found ctx)
 
 (defun select-app (ctx env)
@@ -85,18 +85,15 @@
 ;;;; server response - provice response body and headers
 
 (defclass response ()
-  ((ctx :reader ctx :initarg :ctx)
-   (message :accessor message :initform nil)
+  ((message :accessor message :initform nil)
    (headers :accessor headers :initform '(:content-type "text/plain"))))
 
-(defun make-response (ctx)
-  (make-instance 'response :ctx ctx))
-
 (defgeneric body (r)
   (:method ((r response))
     (getf (message:data (message r)) :info)))
 
 (defmethod core:send ((r response) msg)
+  (log:debug "receiving ~s" msg)
   (setf (message r) msg))
 
 (defmethod print-object ((r response) s)