65 lines
2.4 KiB
Common Lisp
65 lines
2.4 KiB
Common Lisp
;;;; cl-scopes/web/client - web client functionality
|
|
|
|
(defpackage :scopes/web/client
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:config :scopes/config)
|
|
(:core :scopes/core)
|
|
(:message :scopes/core/message)
|
|
(:shape :scopes/shape)
|
|
(:util :scopes/util)
|
|
(:alx :alexandria)
|
|
(:jzon :com.inuoe.jzon))
|
|
(:export #:config #:base-url #:api-path #:doc-path
|
|
#:get-page #:send-message))
|
|
|
|
(in-package :scopes/web/client)
|
|
|
|
(defvar *cookie-jar* (cl-cookie:make-cookie-jar))
|
|
|
|
(defclass config (config:base)
|
|
((config:setup :initform (core:make-setup :class 'core:context))
|
|
(base-url :reader base-url :initarg :base-url :initform "http://localhost:8135")
|
|
(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")))
|
|
|
|
;;;; client context (= service)
|
|
|
|
(defun get-page (ctx msg)
|
|
(let* ((cfg (core:config ctx))
|
|
(path (getf (shape:data msg) :path))
|
|
(url (str:concat (base-url cfg) (doc-path cfg) path)))
|
|
(dex:get url :headers '(("Accept". "text/html")) :cookie-jar *cookie-jar*)))
|
|
|
|
(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*
|
|
)))
|
|
(when cred
|
|
(util:plist-add params :basic-auth (cons (car cred) (cadr cred))))
|
|
(apply #'dex:post url params)
|
|
))
|
|
|
|
(defun msgpath (msg)
|
|
(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 data-as-alist (data)
|
|
(if (symbolp (car data)) ; seems to be a property list
|
|
(let ((al (alx:plist-alist data)))
|
|
(mapcar #'(lambda (p) (cons (string (car p)) (cdr p))) al))
|
|
data))
|