web/response, work in progress: more on response message processing by interaction

core/core.lisp

@@ -46,6 +46,8 @@
 
 (defvar *root* nil)
 
+(defclass base-context ())
+
 (defclass context () 
    ((config :reader config :initarg :config)
     (name :reader name :initarg :name)
@@ -95,7 +97,7 @@
     (cond 
       ((do-actions ctx msg) t)
       ((do-actions ctx msg #'default-actions) t)
-      (t (log:warn "no action selected for ~s" msg)))))
+      (t (log:warn "handle-message: no action selected for ~s" msg)))))
 
 (defun do-actions (ctx msg &optional (acts #'actions))
   (let ((hdlrs (select msg (funcall acts ctx))))

shape/shape.lisp

@@ -24,7 +24,7 @@
   (print-fields rec stream 'head 'data))
 
 (defun print-fields (rec stream &rest fields)
-  (let ((fm (util:make-vars-format fields)))
+  (let ((fm (util:make-vars-format fields nil)))
     (print-unreadable-object (rec stream :type t)
       (apply #'format stream fm (mapcar #'(lambda (x) (funcall x rec)) fields)))))
 

util/util.lisp

@@ -17,16 +17,17 @@
 
 ;;;; formatting and logging shortcuts
 
-(defun make-vars-format (vars)
+(defun make-vars-format (vars info)
-  (format nil "~{~(~a~): ~~S ~}" vars))
+  (let ((prefix (if info (format nil "~a: " info) "")))
+    (format nil "~a~{~(~a~): ~~S ~}" prefix vars)))
 
-(defmacro lg (level &rest vars)
+(defmacro lg (level info &rest vars)
   (let ((lm (find-symbol (string level) :log))
-        (fm (make-vars-format vars)))
+        (fm (make-vars-format vars info)))
     `(,lm ,fm ,@vars)))
 
-(defmacro lgd (&rest vars) `(lg :debug ,@vars))
+(defmacro lgd (&rest vars) `(lg :debug nil ,@vars))
-(defmacro lgi (&rest vars) `(lg :info ,@vars))
+(defmacro lgi (&rest vars) `(lg :info nil ,@vars))
 
 ;;;; date and time manipulations
 

web/response.lisp

@@ -15,15 +15,27 @@
 ;;;; server interaction - receive response message from action processing chain
 
 (defclass interaction ()
-  ((messages :accessor messages :initform nil)))
+  ((response :reader response :initarg :response)
+   (messages :accessor messages :initform nil)))
 
 (defmethod print-object ((ia interaction) s)
   (shape:print-fields ia s 'messages))
 
 (defmethod core:send ((ia interaction) msg)
   (util:lgd msg)
+  ;(handle-message ia msg)
   (push msg (messages ia)))
 
+(defun add-cookies (iact)
+  (let ((headers (resp (response iact))))
+    (dolist (cdata (cookie-data iact))
+      (setf headers 
+            (cons :set-cookie (cons (render-cookie iact cdata) headers))))
+    headers))
+
+(defun render-cookie (iact cdata)
+  "DEMO=1234567; Path=/; Domain=testing.cyberscopes.org")
+
 (defun cookie-data (ia)
   (let ((c nil))
     c))
@@ -35,7 +47,7 @@
 (defclass response ()
   ((context :reader context :initarg :context)
    (env :reader env :initarg :env)
-   (bakers :accessor bakers :initform nil)
+   (headers :accessor headers :initform nil)
    (ctype :reader ctype :allocation :class)))
 
 (defgeneric render-content (resp msg))
@@ -72,18 +84,14 @@
 (defun html-response-class (html-responder)
   (or html-responder *html-response-class* 'html-response))
 
-(defun make-headers (resp iact)
+(defun make-headers (resp)
-  (let ((headers (list :content-type (ctype resp))))
+  (cons :content-type (cons (ctype resp) (headers resp))))
-    (dolist (cdata (cookie-data iact))
-      (setf headers 
-            (cons :set-cookie (cons (render-cookie resp cdata) headers))))
-    headers))
 
 (defun render (resp iact)
   ; pre-process special message heads, e.g. (:system :error ...)
   ;   => set status code, provide additional data elements
   ;      set additional headers
-  (let ((headers (make-headers resp iact))
+  (let ((headers (make-headers resp))
         (rcode 200))
     #'(lambda (responder)
         (let ((writer (funcall responder (list rcode headers))))
@@ -93,6 +101,3 @@
 
 (defun render-not-found(resp)
   (list 404 '(:content-type "text/plain") '("Not found")))
-
-(defun render-cookie (resp cdata)
-  "DEMO=1234567; Path=/; Domain=testing.cyberscopes.org")

web/server.lisp

@@ -86,10 +86,10 @@
       (lack/component:call file-app env))))
 
 (defun message-handler (ctx env &key html-responder)
-  (let* ((iact (make-instance 'response:interaction))
+  (let* ((resp (response:setup ctx env :html-responder html-responder))
+         (iact (make-instance 'response:interaction :response resp))
          (msg (message:create 
-                (head env) :data (plist (post-data env)) :sender iact))
+                (head env) :data (plist (post-data env)) :sender iact)))
-         (resp (response:setup ctx env :html-responder html-responder)))
     (util:lgd msg)
     ; (check-auth ctx msg env) => (response:render-unauthorized resp)
     (if (core:handle-message ctx msg)