;;;; cl-scopes/web/server - web server functionality

(defpackage :scopes/web/server
  (:use :common-lisp)
  (:local-nicknames (:config :scopes/config)
                    (:core :scopes/core)
                    (:message :scopes/core/message)
                    (:response :scopes/web/response)
                    (:util :scopes/util)
                    (:alx :alexandria))
  (:export #:config #:address #:port #:routes
           #:*listener* #:setup #:start #:stop
           #:content
           #:fileserver #:message-handler
           #:set-cookie))

(in-package :scopes/web/server)

(defclass config (config:base)
  ((config:env-slots :initform '(address port))
   (config:setup :initform #'setup)
   (config:shutdown :initform #'stop)
   (address :reader address :initarg :address :initform "localhost")
   (port :reader port :initarg :port :initform "8888")
   (routes :reader routes :initarg :routes :initform nil)))

;;;; server context (= service), action handlers

(defclass context (core:context) 
  ((listener :accessor listener)))

(defun setup (cfg)
  (let ((ctx (core:default-setup cfg 'context)))
    (start ctx)))

;;;; listener = server process

(defun app (ctx env)
  ;(handler-case ...
  (let* ((method (getf env :request-method))
         (uri (getf env :request-uri))
         (headers (getf env :headers))
         (accept (gethash "accept" headers))
         (cookies (gethash "cookie" headers)))
    (util:lgi method uri accept cookies))
  ;(util:lgd env)
  (funcall (select-app ctx env)))

(defun start (ctx)
  (let ((cfg (core:config ctx)))
    (setf (listener ctx)
      (clack:clackup #'(lambda (env) (app ctx env))
                     :port (parse-integer (port cfg))
                     :address (address cfg)
                     ;:server :woo
                     :debug nil
                     :silent t))
    (util:lgi (port cfg))
    ctx))

(defun stop (ctx)
  (clack:stop (listener ctx))
  (util:lgi))

(defun select-app (ctx env)
  (let ((path (cdr (str:split "/" (getf env :path-info)))))
    (dolist (r (routes (core:config ctx)))
      (when (match (car r) path)
        (setf (getf env :message-head) (nthcdr (length (car r)) path))
        (return-from select-app 
                     #'(lambda () (apply (cadr r) ctx env (cddr r)))))))
  #'(lambda () (message-handler ctx env)))

(defun match (pattern path)
    (dolist (e pattern)
      (unless (string= e (pop path))
        (return-from match nil)))
  t)

(defun fileserver (ctx env &key doc-root)
  (let* ((message-head (getf env :message-head))
         (tail (last message-head)))
    (if (string= (car tail) "")
      (setf (car tail) "index.html"))
    (let* ((rel-path (str:join "/" message-head))
           (file-app (make-instance 'lack/app/file:lack-app-file 
                                    :file rel-path :root doc-root)))
      (lack/component:call file-app env))))

(defun message-handler (ctx env &key html-responder)
  (let* ((resp (response:setup ctx env :html-responder html-responder))
         (iact (make-instance 'response:interaction :response resp))
         (msg (message:create 
                (head env) :data (plist (post-data env)) :sender iact)))
    (util:lgd msg)
    ; (check-auth ctx msg env) => (response:render-unauthorized resp)
    (if (core:handle-message ctx msg)
      (response:render resp iact)
      (response:render-not-found resp))))

;;;; predefined action handlers

(defun set-cookie (ctx msg)
  (core:echo ctx msg :domain :response :action :set-cookie))

;;;; helper functions

(defun head (env)
  (mapcar #'(lambda (e) (util:to-keyword e)) (getf env :message-head)))

(defun post-data (env)
  (if (getf env :content-length)
    (let* ((raw (getf env :raw-body))
           (str (read-line (flexi-streams:make-flexi-stream raw))))
      (quri.decode:url-decode-params str))))

(defun plist (alst)
  (let ((a2 (mapcar #'(lambda (p) (cons (util:to-keyword (car p)) (cdr p))) alst)))
    (alx:alist-plist a2)))