web/response, work in progress: provide set-cookie action handler (and default action)
This commit is contained in:
parent
487279bc1b
commit
d934928a28
1 changed files with 14 additions and 16 deletions
|
@ -13,13 +13,22 @@
|
|||
(in-package :scopes/web/response)
|
||||
|
||||
;;;; server interaction - receive response message from action processing chain
|
||||
;;; predefined action handlers / default actions
|
||||
|
||||
(defun store-msg (ia msg)
|
||||
(push msg (messages ia)))
|
||||
|
||||
(defun set-cookie (ia msg)
|
||||
(let ((headers (headers (response ia))))
|
||||
(setf headers
|
||||
(cons :set-cookie (cons (render-cookie (message:data msg)) headers)))
|
||||
headers))
|
||||
|
||||
(defvar *interaction-default-actions*
|
||||
;(list (core::define-action nil #'store-msg)))
|
||||
(core:define-actions (list nil #'store-msg)))
|
||||
(core:define-actions '(nil store-msg)
|
||||
'((:web :set-cookie) set-cookie)))
|
||||
|
||||
;;; interaction class and methods
|
||||
|
||||
(defclass interaction (core:base-context)
|
||||
((core:default-actions :initform *interaction-default-actions*)
|
||||
|
@ -29,19 +38,8 @@
|
|||
(defmethod print-object ((ia interaction) s)
|
||||
(shape:print-fields ia s 'messages))
|
||||
|
||||
(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))
|
||||
(defun render-cookie (cdata)
|
||||
"DEMO=1234567_value; Path=/") ;"; Domain=testing.cyberscopes.org")
|
||||
|
||||
;;;; response definitions
|
||||
|
||||
|
@ -93,7 +91,7 @@
|
|||
(defun render (resp iact)
|
||||
; pre-process special message heads, e.g. (:system :error ...)
|
||||
; => set status code, provide additional data elements
|
||||
; set additional headers
|
||||
; set additional headers (<- will be done by interaction)
|
||||
(let ((headers (make-headers resp))
|
||||
(rcode 200))
|
||||
#'(lambda (responder)
|
||||
|
|
Loading…
Add table
Reference in a new issue