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

web: rename response to interaction; client: provide 'accept' header

Browse source
This commit is contained in:
Helmut Merz 2024-07-12 13:52:20 +02:00
parent 5d27e99bb7
commit a1ced84b80
2 changed files with 15 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
web/client.lisp
View file

@ -15,7 +15,8 @@
((config:setup :initform #'core:default-setup)
(base-url :reader base-url :initarg :base-url :initform "http://localhost:8135")
(doc-path :reader doc-path :initarg :doc-path :initform "/")
(api-path :reader api-path :initarg :api-path :initform "/api/")))
(api-path :reader api-path :initarg :api-path :initform "/api/")
(accept :reader accept :initarg :accept :initform "text/html")))
;;;; client context (= service)
@ -23,12 +24,14 @@
(let* ((cfg (core:config ctx))
(path (getf (message:data msg) :path))
(url (str:concat (base-url cfg) (doc-path cfg) path)))
(dex:get url)))
(dex:get url :headers '(("Accept". "text/html")))))
(defun send-message (ctx msg)
(let* ((cfg (core:config ctx))
(url (str:concat (base-url cfg) (api-path cfg) (msgpath msg))))
(dex:post url :content (data-as-alist (message:data msg)))))
(dex:post url
:content (data-as-alist (message:data msg))
:headers `(("Accept" . ,(accept cfg))))))
(defun msgpath (msg)
(str:join "/" (loop for p in (message:head-as-list msg)

18
web/server.lisp
View file

@ -81,26 +81,26 @@
(lack/component:call file-app env))))
(defun message-handler (ctx env)
(let* ((resp (make-instance 'response))
(let* ((iact (make-instance 'interaction))
(msg (message:create
(head env) :data (plist (post-data env)) :sender resp)))
(head env) :data (plist (post-data env)) :sender iact)))
(log:debug "msg ~s" msg)
; (check-auth ctx msg env) => (render-unauthorized ctx msg env)
(if (core:handle-message ctx msg)
(render ctx (message resp) env)
(render ctx (message iact) env)
(render-not-found ctx env))))
;;;; server response - provide response data and render body and headers
;;;; server interaction and response - provide response data and render body and headers
(defclass response ()
(defclass interaction ()
((message :accessor message :initform nil)))
(defmethod print-object ((r response) s)
(format s "<response ~s>" (message r)))
(defmethod print-object ((ia interaction) s)
(format s "<interaction ~s>" (message ia)))
(defmethod core:send ((r response) msg)
(defmethod core:send ((ia interaction) msg)
(log:debug "receiving ~s" msg)
(setf (message r) msg))
(setf (message ia) msg))
(defun render (ctx msg env)
(let ((headers '(:content-type "text/plain"))