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) ((config:setup :initform #'core:default-setup)
(base-url :reader base-url :initarg :base-url :initform "http://localhost:8135") (base-url :reader base-url :initarg :base-url :initform "http://localhost:8135")
(doc-path :reader doc-path :initarg :doc-path :initform "/") (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) ;;;; client context (= service)
@ -23,12 +24,14 @@
(let* ((cfg (core:config ctx)) (let* ((cfg (core:config ctx))
(path (getf (message:data msg) :path)) (path (getf (message:data msg) :path))
(url (str:concat (base-url cfg) (doc-path cfg) 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) (defun send-message (ctx msg)
(let* ((cfg (core:config ctx)) (let* ((cfg (core:config ctx))
(url (str:concat (base-url cfg) (api-path cfg) (msgpath msg)))) (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) (defun msgpath (msg)
(str:join "/" (loop for p in (message:head-as-list 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)))) (lack/component:call file-app env))))
(defun message-handler (ctx env) (defun message-handler (ctx env)
(let* ((resp (make-instance 'response)) (let* ((iact (make-instance 'interaction))
(msg (message:create (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) (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 iact) env)
(render-not-found ctx 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))) ((message :accessor message :initform nil)))
(defmethod print-object ((r response) s) (defmethod print-object ((ia interaction) s)
(format s "<response ~s>" (message r))) (format s "<interaction ~s>" (message ia)))
(defmethod core:send ((r response) msg) (defmethod core:send ((ia interaction) msg)
(log:debug "receiving ~s" msg) (log:debug "receiving ~s" msg)
(setf (message r) msg)) (setf (message ia) msg))
(defun render (ctx msg env) (defun render (ctx msg env)
(let ((headers '(:content-type "text/plain")) (let ((headers '(:content-type "text/plain"))