web/client: use content-renderer for preparing POST content and content-type header
This commit is contained in:
parent
baee9008f2
commit
8e9995cf9a
1 changed files with 16 additions and 13 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue