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

web/client: use content-renderer for preparing POST content and content-type header

Browse source
This commit is contained in:
Helmut Merz 2025-09-29 10:21:06 +02:00
parent baee9008f2
commit 8e9995cf9a
1 changed files with 16 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
web/client.lisp
View file

@ -22,7 +22,9 @@
(doc-path :reader doc-path :initarg :doc-path :initform "/") (doc-path :reader doc-path :initarg :doc-path :initform "/")
(credentials :reader credentials :initarg :credentials :initform nil) (credentials :reader credentials :initarg :credentials :initform nil)
(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"))) (accept :reader accept :initarg :accept :initform "text/html")
(data-renderer :reader data-renderer :initarg :data-renderer :initform #'urlencoded)
))
;;;; client context (= service) ;;;; client context (= service)
@ -35,14 +37,10 @@
(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)))
(data (shape:data msg))
(cred (credentials cfg)) (cred (credentials cfg))
(params `( (params `(:headers (("Accept" . ,(accept cfg)))
;:content ,(data-as-json data) :cookie-jar ,*cookie-jar*)))
:content ,(data-as-alist data) (setf params (funcall (data-renderer cfg) ctx msg params))
:headers (("Accept" . ,(accept cfg)))
:cookie-jar ,*cookie-jar*
)))
(when cred (when cred
(util:plist-add params :basic-auth (cons (car cred) (cadr cred)))) (util:plist-add params :basic-auth (cons (car cred) (cadr cred))))
(apply #'dex:post url params) (apply #'dex:post url params)
@ -52,11 +50,16 @@
(str:join "/" (loop for p in (shape:head msg) (str:join "/" (loop for p in (shape:head msg)
when p collect (string-downcase p)))) when p collect (string-downcase p))))
(defun data-as-json (data) (defun urlencoded (ctx msg params)
(if (symbolp (car data)) ; seems to be a property list (util:plist-add params :content (data-as-alist (shape:data msg)))
(let ((ht (alx:plist-hash-table data))) (push '(:content-type . "application/x-www-form-urlencoded") (getf params :headers))
(jzon:stringify ht)) params)
data))
(defun json (ctx msg params)
(let ((ht (alx:plist-hash-table (shape:data msg))))
(util:plist-add params :content (jzon:stringify ht)))
(push '(:content-type . "application/json") (getf params :headers))
params)
(defun data-as-alist (data) (defun data-as-alist (data)
(if (symbolp (car data)) ; seems to be a property list (if (symbolp (car data)) ; seems to be a property list