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

web/server: interaction with messages (plural, list or queue, ...) (more to come later)

Browse source
This commit is contained in:
Helmut Merz 2024-07-23 12:00:43 +02:00
parent 01bb322a6a
commit 81ce777444
2 changed files with 9 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
web/response.lisp
View file

@ -51,14 +51,15 @@
(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 render (resp msg) (defun render (resp msgs)
; process special message heads, e.g. (:system :error ...) ; 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 (list :content-type (ctype resp)))
(rcode 200) (rcode 200)
(content (render-content resp msg))) (content (mapcar #'(lambda (m) (render-content resp m)) msgs)))
(list rcode headers (list content)))) ;(content (render-content resp msg)))
(list rcode headers content)))
(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")))

9
web/server.lisp
View file

@ -89,20 +89,21 @@
(log:debug "msg ~s" msg) (log:debug "msg ~s" msg)
; (check-auth ctx msg env) => (response:render-unauthorized resp) ; (check-auth ctx msg env) => (response:render-unauthorized resp)
(if (core:handle-message ctx msg) (if (core:handle-message ctx msg)
(response:render resp (message iact)) (response:render resp (messages iact))
(response:render-not-found resp)))) (response:render-not-found resp))))
;;;; server interaction - receive response message from action processing chain ;;;; server interaction - receive response message from action processing chain
(defclass interaction () (defclass interaction ()
((message :accessor message :initform nil))) ((messages :accessor messages :initform nil)))
(defmethod print-object ((ia interaction) s) (defmethod print-object ((ia interaction) s)
(format s "<interaction ~s>" (message ia))) (format s "<interaction ~s>" (messages ia)))
(defmethod core:send ((ia interaction) msg) (defmethod core:send ((ia interaction) msg)
(log:debug "receiving ~s" msg) (log:debug "receiving ~s" msg)
(setf (message ia) msg)) (push msg (messages ia)))
;(setf (message ia) msg))
;;;; helper functions ;;;; helper functions