cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

web/response, work in progress: render cookie data supplied by downstream service

Browse source
This commit is contained in:
Helmut Merz 2024-08-28 18:12:11 +02:00
parent cf7d85af4d
commit 2a4d3af1dd
1 changed files with 17 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
web/response.lisp
View file

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