From 9c3f68740c852f14b9a7c66ee8d5dcbee9c11503 Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Sat, 6 Jul 2024 23:02:19 +0200
Subject: [PATCH] web/server: use simple echo action handler for first full
 set-up of message handling chain with response object

---
 core/core.lisp           | 18 ++++++++----------
 test/etc/config-web.lisp |  2 +-
 test/test-web.lisp       | 10 +---------
 web/server.lisp          | 21 +++++++++++++--------
 4 files changed, 23 insertions(+), 28 deletions(-)

diff --git a/core/core.lisp b/core/core.lisp
index ac9b8e6..4f06100 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -9,7 +9,7 @@
            #:find-service #:setup-services
            #:context #:add-action #:config #:name #:send #:shutdown
            #:handle-message
-           #:printer))
+           #:do-print #:echo))
 
 (in-package :scopes/core)
 
@@ -102,16 +102,14 @@
         (funcall hdlr ctx msg))
       t)))
 
-;;;; simple printer service
+;;;; 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))))
 
 (defun do-print (ctx msg)
   (declare (ignore ctx))
   (format t "~&~s~%" msg))
-
-(defclass printer (context)
-  ((actions :initform 
-            (list (make-instance 'action-spec 
-                                 :handlers (list #'do-print))))))
-
-(defun printer (name)
-  (make-instance 'printer :name name))
diff --git a/test/etc/config-web.lisp b/test/etc/config-web.lisp
index d0f780c..9fb3aab 100644
--- a/test/etc/config-web.lisp
+++ b/test/etc/config-web.lisp
@@ -15,7 +15,7 @@
               `((("api") server:message-handler)
                 (() server:fileserver 
                     :doc-root ,(t:test-path "" "docs"))))
-(config:add-action '(:test :data) #'demo)
+(config:add-action '(:test :data) #'core:echo)
 ;(config:add-action '(:test :data) #'(lambda (ctx msg)))
 
 (config:add :client :class 'client:config
diff --git a/test/test-web.lisp b/test/test-web.lisp
index 8a7e2ec..c53e251 100644
--- a/test/test-web.lisp
+++ b/test/test-web.lisp
@@ -14,14 +14,6 @@
 
 (in-package :scopes/test-web)
 
-;;;; dummy / test / demo action handlers
-
-(defun demo (ctx msg)
-  (let ((resp (message:sender msg)))
-    (if (null resp)
-      (log:warn "sender missing: ~s" msg)
-      (setf (server:content resp) "Hello Demo-World!"))))
-
 ;;;; test runner
 
 (defun run ()
@@ -50,4 +42,4 @@
 
 (deftest test-message (client)
   (let ((msg (message:make-message '(:test :data) :data '(:info "test data"))))
-    (== (client:send-message client msg) "Hello Demo-World!")))
+    (== (client:send-message client msg) "test data")))
diff --git a/web/server.lisp b/web/server.lisp
index 7ee5ccb..8b41353 100644
--- a/web/server.lisp
+++ b/web/server.lisp
@@ -25,6 +25,7 @@
 ;;;; listener = server process
 
 (defun app (ctx env)
+  ;(handler-case ...
   (log:info "request: ~a ~a, accept: ~a" 
             (getf env :request-method) 
             (getf env :request-uri)
@@ -61,9 +62,10 @@
                 (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)))
-      ;'(200 (:content-type "text/plain") ("Hello World!"))
       '(404 (:content-type "text/plain") ("Not found")))))
+      ;(render-not-found ctx)
 
 (defun select-app (ctx env)
   (let ((path (cdr (str:split "/" (getf env :path-info)))))
@@ -84,18 +86,21 @@
 
 (defclass response ()
   ((ctx :reader ctx :initarg :ctx)
-   (content :accessor content :initform "")
-   (headers :accessor headers :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))
-    (content r)))
+    (getf (message:data (message r)) :info)))
+
+(defmethod core:send ((r response) msg)
+  (setf (message r) msg))
 
 (defmethod print-object ((r response) s)
-  (format s "<response ~s>" (util:trunc(content r) 12)))
+  (format s "<response ~s>" (message r)))
 
 ;;;; server context (= service), action handlers
 
@@ -113,9 +118,9 @@
 
 (defun post-data (env)
   (if (getf env :content-length)
-  (let* ((raw (getf env :raw-body))
-         (str (read-line (flexi-streams:make-flexi-stream raw))))
-    (quri.decode:url-decode-params str))))
+    (let* ((raw (getf env :raw-body))
+           (str (read-line (flexi-streams:make-flexi-stream raw))))
+      (quri.decode:url-decode-params str))))
 
 (defun plist (alst)
   (let ((a2 (mapcar #'(lambda (p) (cons (util:to-keyword (car p)) (cdr p))) alst)))