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

This commit is contained in:
Helmut Merz 2025-09-29 10:21:06 +02:00
parent baee9008f2
commit 8e9995cf9a

View file

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