48 lines
1.8 KiB
Common Lisp
48 lines
1.8 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)
|
|
(:alx :alexandria))
|
|
(: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:default-setup)
|
|
(base-url :reader base-url :initarg :base-url :initform "http://localhost:8135")
|
|
(doc-path :reader doc-path :initarg :doc-path :initform "/")
|
|
(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))))
|
|
(dex:post url
|
|
:content (data-as-alist (shape:data msg))
|
|
:headers `(("Accept" . ,(accept cfg)))
|
|
:cookie-jar *cookie-jar*)))
|
|
|
|
(defun msgpath (msg)
|
|
(str:join "/" (loop for p in (shape:head msg)
|
|
when p collect (string-downcase p))))
|
|
|
|
(defun data-as-alist (data)
|
|
(if (symbolp (car data)) ; seems to be a property list
|
|
(mapcar #'(lambda (p) (cons (string-downcase (car p)) (cdr p)))
|
|
(alx:plist-alist data))
|
|
data))
|