web/server: use simple echo action handler for first full set-up of message handling chain with response object

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))

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

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")))

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