;;;; 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
           #:urlencoded #:json))

(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")
   (data-renderer :reader data-renderer :initarg :data-renderer :initform #'urlencoded)
   ))

;;;; 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)))
         (cred (credentials cfg))
         (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)
    ))

(defun msgpath (msg)
  (str:join "/" (loop for p in (shape:head msg) 
                      when p collect (string-downcase p))))

(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
    (let ((al (alx:plist-alist data)))
      (mapcar #'(lambda (p) (cons (string (car p)) (cdr p))) al))
    data))