minor refactoring; prepare response handling

test/etc/config-web.lisp

@@ -16,7 +16,6 @@
                 (() server:fileserver 
                     :doc-root ,(t:test-path "" "docs"))))
 (config:add-action '(:test :data) #'core:echo)
-;(config:add-action '(:test :data) #'(lambda (ctx msg)))
 
 (config:add :client :class 'client:config
             :base-url "http://localhost:8899"

test/test-web.lisp

@@ -41,5 +41,5 @@
     (has-prefix (client:get-page client msg) "Hello Fileserver!")))
 
 (deftest test-message (client)
-  (let ((msg (message:create '(:test :data) :data '(:info "test data"))))
+  (let ((msg (message:create '(:test :data :field :info) :data '(:info "test data"))))
     (== (client:send-message client msg) "test data")))

web/server.lisp

@@ -22,6 +22,15 @@
    (port :reader port :initarg :port :initform "8888")
    (routes :reader routes :initarg :routes :initform nil)))
 
+;;;; server context (= service), action handlers
+
+(defclass context (core:context) 
+  ((listener :accessor listener)))
+
+(defun setup (cfg)
+  (let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
+    (start ctx)))
+
 ;;;; listener = server process
 
 (defun app (ctx env)
@@ -46,27 +55,6 @@
 (defun stop (ctx)
   (clack:stop (listener ctx)))
 
-(defun fileserver (ctx env &key doc-root)
-  (let* ((message-head (getf env :message-head))
-         (tail (last message-head)))
-    (if (string= (car tail) "")
-      (setf (car tail) "index.html"))
-    (let* ((rel-path (str:join "/" message-head))
-           (file-app (make-instance 'lack/app/file:lack-app-file 
-                                    :file rel-path :root doc-root)))
-      (lack/component:call file-app env))))
-
-(defun message-handler (ctx env)
-  (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)))
-      (list 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)))))
     (dolist (r (routes (core:config ctx)))
@@ -82,31 +70,51 @@
         (return-from match nil)))
   t)
 
-;;;; server response - provice response body and headers
+(defun fileserver (ctx env &key doc-root)
+  (let* ((message-head (getf env :message-head))
+         (tail (last message-head)))
+    (if (string= (car tail) "")
+      (setf (car tail) "index.html"))
+    (let* ((rel-path (str:join "/" message-head))
+           (file-app (make-instance 'lack/app/file:lack-app-file 
+                                    :file rel-path :root doc-root)))
+      (lack/component:call file-app env))))
+
+(defun message-handler (ctx env)
+  (let* ((resp (make-instance 'response))
+         (msg (message:create 
+                (head env) :data (plist (post-data env)) :sender resp)))
+    (log:debug "msg ~s" msg)
+    ; (check-auth ctx msg env) => (render-unauthorized ctx msg env)
+    (if (core:handle-message ctx msg)
+      ;(render ctx (message resp) env)
+      (list 200 (headers resp) (list (body resp)))
+      (list 404 '(:content-type "text/plain") '("Not found")))))
+      ;(render-not-found ctx env)
+
+;;;; server response - provide response data for rendering body and headers
 
 (defclass response ()
   ((message :accessor message :initform nil)
    (headers :accessor headers :initform '(:content-type "text/plain"))))
 
-(defgeneric body (r)
+(defmethod print-object ((r response) s)
-  (:method ((r response))
+  (format s "<response ~s>" (message r)))
-    (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)
+(defgeneric body (r)
-  (format s "<response ~s>" (message r)))
+  (:method ((r response))
+    (getf (message:data (message r)) :info)))
 
-;;;; server context (= service), action handlers
+(defun render (ctx msg env)
-
+  ; process special message headers, e.g. (:system :error ...)
-(defclass context (core:context) 
+  ;   => set status code, provide additional data elements
-  ((listener :accessor listener)))
+  ; (gethash "accept" (getf env :headers)) => select output format
-
+  ; set headers, render body
-(defun setup (cfg)
+  )
-  (let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
-    (start ctx)))
 
 ;;;; helper functions