web/server: work in progress: render response

This commit is contained in:
Helmut Merz 2024-07-12 08:14:12 +02:00
parent 3b98c9cc54
commit 5d27e99bb7

View file

@ -87,16 +87,13 @@
(log:debug "msg ~s" msg) (log:debug "msg ~s" msg)
; (check-auth ctx msg env) => (render-unauthorized ctx msg env) ; (check-auth ctx msg env) => (render-unauthorized ctx msg env)
(if (core:handle-message ctx msg) (if (core:handle-message ctx msg)
;(render ctx (message resp) env) (render ctx (message resp) env)
(list 200 (headers resp) (list (body resp))) (render-not-found ctx env))))
(list 404 '(:content-type "text/plain") '("Not found")))))
;(render-not-found ctx env)
;;;; server response - provide response data for rendering body and headers ;;;; server response - provide response data and render body and headers
(defclass response () (defclass response ()
((message :accessor message :initform nil) ((message :accessor message :initform nil)))
(headers :accessor headers :initform '(:content-type "text/plain"))))
(defmethod print-object ((r response) s) (defmethod print-object ((r response) s)
(format s "<response ~s>" (message r))) (format s "<response ~s>" (message r)))
@ -105,16 +102,18 @@
(log:debug "receiving ~s" msg) (log:debug "receiving ~s" msg)
(setf (message r) msg)) (setf (message r) msg))
(defgeneric body (r)
(:method ((r response))
(getf (message:data (message r)) :info)))
(defun render (ctx msg env) (defun render (ctx msg env)
; process special message headers, e.g. (:system :error ...) (let ((headers '(:content-type "text/plain"))
(rcode 200)
(content (getf (message:data msg) :info)))
; process special message heads, e.g. (:system :error ...)
; => set status code, provide additional data elements ; => set status code, provide additional data elements
; (gethash "accept" (getf env :headers)) => select output format ; (gethash "accept" (getf env :headers)) => select output format
; set headers, render body ; set headers, render body
) (list rcode headers (list content))))
(defun render-not-found(ctx env)
(list 404 '(:content-type "text/plain") '("Not found")))
;;;; helper functions ;;;; helper functions