web/response: set up test call for set-cookie, + minor improvements

config.lisp

@@ -7,7 +7,7 @@
   (:local-nicknames (:util :scopes/util))
   (:export #:base #:root #:*root* #:*current*
            #:env-data #:env-keys #:env-prefix #:env-path #:from-env #:path
-           #:actions #:add #:add-action #:children #:env-slots 
+           #:actions #:add #:add-action #:add-actions #:children #:env-slots 
            #:name #:setup #:parent #:shutdown))
 
 (in-package :scopes/config)
@@ -85,6 +85,10 @@
     (setf handler #'(lambda (ctx msg) (apply handler ctx msg params))))
   (push (list pattern handler) (actions cfg)))
 
+(defun add-actions (&rest acts)
+  (dolist (act acts)
+    (apply #'add-action (car act) (cadr act) (cddr act))))
+
 ;;;; utility functions
 
 (defun from-env (key default)

core/core.lisp

@@ -118,11 +118,11 @@
 
 ;;;; some simple predefined actions
 
-(defun echo (ctx msg)
+(defun echo (ctx msg &key (domain :scopes) (action :echo))
   (let ((sndr (message:sender msg)))
     (if sndr
       (let* ((h (shape:head msg))
-             (new-msg (message:create `(:scopes :echo ,@(cddr h))
+             (new-msg (message:create `(,domain ,action ,@(cddr h))
                                       :data (shape:data msg))))
         (send sndr new-msg))
       (util:lgw "sender missing" msg))))

test/etc/config-web.lisp

@@ -17,7 +17,9 @@
     `((("hx") server:message-handler :html-responder cs-hx:response)
       (() server:fileserver 
           :doc-root ,(t:test-path "" "docs"))))
-(config:add-action '(:test :data) #'core:echo)
+(config:add-actions
+  '((:test :data) core:echo)
+  '((:test :cookie) server:set-cookie))
 
 (config:add :client 
   :class 'client:config

test/test-web.lisp

@@ -69,5 +69,8 @@
 (deftest test-message (client)
   (let ((msg (message:create '(:test :data :field :info) :data '(:info "test data"))))
     (== (client:send-message client msg)
-        "<div><div><label>info</label>: test data</div></div>")))
+        "<div><div><label>info</label>: test data</div></div>"))
         ;"<dl><dt>info</dt><dd>test data</dd></dl>")))
+  (let ((msg (message:create '(:test :cookie) :data '(:name "mycookie"))))
+    (client:send-message client msg))
+  )

web/response.lisp

@@ -19,17 +19,18 @@
   (push msg (messages ia)))
 
 (defun set-cookie (ia msg)
-  (util:plist-add (headers (response ia)) :set-cookie (message:data msg)))
+  (util:plist-add (headers (response ia)) 
+                  :set-cookie (render-cookie (shape:data msg))))
 
 (defvar *interaction-default-actions* 
-  (core:define-actions '((:web :set-cookie) set-cookie) 
+  (core:define-actions '((:response :set-cookie) set-cookie) 
                        '(nil render-msg)))
 
 ;;; interaction class and methods
 
 (defclass interaction (core:base-context)
   ((core:default-actions :initform *interaction-default-actions*)
-   (response :reader nilresponse :initarg :response)
+   (response :reader response :initarg :response)
    (messages :accessor messages :initform nil)))
 
 (defmethod print-object ((ia interaction) s)

web/server.lisp

@@ -11,7 +11,8 @@
   (:export #:config #:address #:port #:routes
            #:*listener* #:setup #:start #:stop
            #:content
-           #:fileserver #:message-handler))
+           #:fileserver #:message-handler
+           #:set-cookie))
 
 (in-package :scopes/web/server)
 
@@ -96,6 +97,11 @@
       (response:render resp iact)
       (response:render-not-found resp))))
 
+;;;; predefined action handlers
+
+(defun set-cookie (ctx msg)
+  (core:echo ctx msg :domain :response :action :set-cookie))
+
 ;;;; helper functions
 
 (defun head (env)