(defpackage oneliners.api
  (:use :cl)
  (:local-nicknames (#:lzb #:lazybones)
                    (#:a #:alexandria-2)
                    (#:db #:bknr.datastore))
  (:import-from #:lazybones
                #:defendpoint*
                #:http-err))
(in-package :oneliners.api)

;;; DATA 

(defclass contributor (db:store-object)
  ((handle
    :accessor contributor-handle
    :initarg :handle
    :initform (error "Contributors must have a name.")
    :index-type bknr.indices:string-unique-index
    :index-reader contributor-by-handle)
   (contributor-salt
    :reader contributor-salt
    :initform (uuid)
    :type string
    :documentation "Per user salt for password hashing.")
   (hashed-pw
    :accessor hashed-pw
    :initform nil
    :type string
    :documentation "Hashed password for this contributor. Note, this
    value is hashed with the server salt and the contributor-salt.")
   (adminp
    :accessor adminp
    :initform nil
    :documentation "indicates whether or not this contributor has admin privileges."))
  (:metaclass db:persistent-class))

(defparameter +auth-cookie-name+ "olauthtoken")

(defclass api-access (db:store-object)
  ((token
    :reader api-token
    :initarg :token
    :index-type bknr.indices:string-unique-index
    :index-reader access-by-token)
   (contributor
    :reader api-contributor
    :initarg :contributor
    :index-type bknr.indices:unique-index
    :index-reader access-by-contributor))
  (:metaclass db:persistent-class))

(defgeneric revoke-access (what)
  (:documentation "Effectively deletes an api-access instance.")
  (:method ((access api-access))
    (db:with-transaction ()
      (db:delete-object access)))
  (:method ((token string))
    (a:when-let ((access (access-by-token token)))
      (revoke-access access)))
  (:method ((contributor contributor))
    (a:when-let ((access (access-by-contributor contributor)))
      (revoke-access access))))

(defclass oneliner (db:store-object)
  ((oneliner
    :accessor oneliner 
    :initarg :oneliner
    :initform (error "Onliner required"))
   (commands
    :accessor oneliner-commands
    :initarg :commands
    :initform nil
    :index-type bknr.indices:hash-list-index 
    :index-initargs (:test 'equal)
    :index-reader oneliners-by-command
    :documentation "The commands that this oneliner principally involves.")
   (brief
    :accessor oneliner-brief
    :initarg :brief
    :initform (error "Oneliners need a brief title")
    :documentation "A short description of the oneliner.")
   (description
    :accessor oneliner-description
    :initarg :description
    :initform "")
   (created-by
    :reader created-by
    :initform (error "oneliners must be made by a contributor")
    :initarg :created-by)
   (created-at
    :reader created-at
    :initform (get-universal-time))
   (edited-at
    :accessor edited-at
    :initform nil
    :documentation "A universal time recording the last time of edit")
   (last-edited-by
    :accessor last-edited-by
    :initform nil
    :documentation "a contributor instance, the last person to edit thiscommand.")
   (flagged-by
    :accessor flagged-by
    :initform nil
    :documentation "NIL or :anonymous or a CONTRIBUTOR object.")
   (audited-by
    :accessor audited-by
    :initform nil
    :documentation "NIL or a CONTRIBUTOR object. Indicates that a user
    has approved of this oneliner.")
   (lockedp
    :accessor lockedp
    :initform nil
    :documentation "Prevents editing until unliked. Only users with
    admin priviliges can lock/unlock."))
  (:metaclass db:persistent-class))

(defclass query-results-page (db:store-object)
  ((limit
    :initarg :limit)
   (to-page
    :initarg :to-page)
   (remaining
    :initarg :remaining)
   (last-access
    :initarg :last-access)
   (key
    :initarg key
    :index-type bknr.indices:string-unique-index
    :index-reader page-by-key))
  (:metaclass db:persistent-class))

(defun make-next-page (limit to-page)
  (if to-page ;; only make a page if there are results to paginate
      (let ((key (uuid)))
        (db:with-transaction () 
          (make-instance 'query-results-page
                         :key key
                         :limit limit
                         :to-page to-page
                         :remaining (length to-page)
                         :last-access (get-universal-time)))
        key)
      :null)) ;; return the value that to-json will encode as null

(defun fetch-next-page (pagekey &key (attrib-name :oneliners))
  "Return next page in a search query, or throw an error if there is
  no such page / the page has expired."
  (a:if-let (qrp (page-by-key pagekey))
    (db:with-transaction () 
      (with-slots (limit to-page remaining last-access) qrp
        (let* ((n-to-send (min limit remaining))
               (to-return (subseq to-page 0 n-to-send)))
          (decf remaining n-to-send)
          (if (plusp remaining)
              (setf to-page (nthcdr n-to-send to-page)
                    last-access (get-universal-time))
              (db:delete-object qrp))
          (list :page (if (plusp remaining) pagekey :null)
                attrib-name to-return))))
    (error "No page for key ~a" pagekey)))

(defparameter +qrp-lifetime+ 300 ; five minutes
  "Number of seconds query-results-page instances live in the
  application state.")

(defun expired-page-p (qrp &optional (current-time (get-universal-time)))
  (when (typep qrp 'query-results-page)
    (> (- current-time (slot-value qrp 'last-access))
       +qrp-lifetime+)))


;;; SERVICE CONTROL

(defvar *server* nil)
(defvar *cleaning-thread* nil)
(defvar *runningp* nil)
(defvar *instance-salt* "change me")

(defparameter +data-store-directory-name+
  "oneliners-api-datastore")

(defun data-store-path (store-dir)
  (let ((store-dir (or store-dir (pathname-directory (user-homedir-pathname)))))
    (make-pathname
     :directory (append store-dir (list +data-store-directory-name+)))))

(defun initialize-datastore (store-dir)
  (ensure-directories-exist (data-store-path store-dir))
  (make-instance
   'db:mp-store
   :directory (data-store-path store-dir)
   :subsystems (list (make-instance 'db:store-object-subsystem))))

(defun ensure-datastore (store-dir)
  (unless (boundp 'db:*store*)
    (initialize-datastore store-dir)))

(defun ensure-server (port address)
  (unless *server*
    (setf *server* (lzb:create-server :port port :address address))
    (lzb:set-canned-response *server* 400 "Bad Request" "text/plain")
    (lzb:set-canned-response *server* 404 "Not Found" "text/plain")
    (lzb:set-canned-response *server* 500 "Server Error" "text/plain")))

(defun start
    (&key
       (port 8888)
       (address "127.0.0.1")
       (salt "change me")
       store-dir)
  (setf *instance-salt* salt )
  (ensure-datastore store-dir)
  (ensure-server port address)
  (lzb:install-app *server* (lzb:app))
  (lzb:start-server *server*)
  (setf *runningp* t)
  (start-cleaning-thread))

(defun start-cleaning-thread (&key (run-period 45))
  ;; when the thread  was stopped properly.
  (when (and *cleaning-thread* (bt:thread-alive-p *cleaning-thread*))
    (bt:destroy-thread *cleaning-thread*))
  (setf *cleaning-thread*
        (bt:make-thread
         (lambda ()
           (loop while *runningp*
                 do (sleep run-period)
                    (handler-case (routine-cleaning)
                      (error (e) (print e))))))))

(defun stop ()
  (setf *runningp* nil)
  (when *server*
    (lzb:stop-server *server*)))

(defun routine-cleaning ()
  (let ((now (get-universal-time))) 
    (db:with-transaction ()
      (dolist (qrp (db:store-objects-with-class 'query-results-page))
        (when (expired-page-p qrp now)
          (db:delete-object qrp))))))


;;; API DEFINITION AND PROVISIONING

(defparameter +oneliners-description+
  "TBD")

(defun init-app () 
  (lzb:provision-app ()
    :title "Oneliners Wiki API"
    :version "0.0.1"
    :desc +oneliners-description+
    :content-type "application/json"
    :auth 'api-token-authorization))

(defun api-token-authorization ()
  ;; presently if the token merely exists then that's good enough.
  (request-contributor)) 

;;; ENDPOINT DEFINITIONS

(defendpoint* :get "/search" () ()
  "A search endpoint returning a JSON encoded array of Oneliner Entries.

/search accepts the following query parameters:

- commands   : A comma-separated list of commands. E.g. `'ls,grep'`
- keywords   : A comma-separated list of words that may appear in the title or description, e.g. `'foo,bar,goo,zar,moo_blar'
- limit      : An integer, limiting the number of results returned. Defaults to 10.
- nextpage   : true or false; requests that the query be accompanied by a nextpage key
- page       : a nextpage token that will continue from a previous search. These expire after 10 minutes.
- notFlagged : true or false; defaults to false. true filters out oneliners that have been flagged.
- onlyAudited : true or false; defaults to false. true filters out oneliners that have not been audited. 

**Note**: either command or keywords are required.
"
  (lzb:map-parameters
      ((commands parse-cls)
       (keywords parse-cls)
       (limit parse-integer)
       (nextpage true-or-false)
       (page identity)
       (notflagged true-or-false)
       (onlyaudited true-or-false))
    (cond
      ;; if page is incluced, ignore everything, fetch the next page,
      ;; and return it.
      (page                             
       (to-json (fetch-next-page page)))

      ;; otherwise one of command keywords are required
      ((or commands keywords)
       (let* ((limit
                (or limit 10)) ; default-limit, should probably be configurable.
              (results
                (query-oneliners :commands commands
                                 :keywords keywords
                                 :notflagged notflagged
                                 :onlyaudited onlyaudited))
              (limited-results
                (a:subseq* results 0 limit)))
         (to-json
          (if nextpage
              (list
               :page (make-next-page limit (nthcdr limit results))
               :oneliners limited-results)
              (list :oneliners limited-results))))) 
      ;; if neither command nor keywords were supplied, return a 400
      (t
       (http-err 400)))))

(defendpoint* :put "/oneliner/:oneliner object-with-id:" ()  (:auth t)
  "Updates a oneliner entry in the wiki database."
  (cond
    (oneliner
     (update-oneliner (request-contributor)
                      oneliner
                      (lzb:request-body))  ; throws an error if fails, triggering a 500
     "true")                               
    (t (http-err 404))))                ;no oneliner with the given id.

(defendpoint* :post "/oneliner" ()  (:auth t)
  "Adds a new oneliner entry to the wiki database."
  (a:if-let (new-oneliner (add-oneliner-to-db (request-contributor) (lzb:request-body)))
    "{}" ; dummy implementation
    (http-err 400)))                            

(defendpoint* :post "/auth" () ()
  "Requests an authorization token")

;;; HELPERS

(defun slot-name-of (class name)
  "Returns the symbol naming a slot in the class class. Returns NIL if
there is no such slot.  Useful for converting keywords into slot
names.  NAME must be a symbol or a string."
  (assert (or (stringp name) (symbolp name)))
  (let ((name (if (symbolp name) (symbol-name name) name)))
    (loop for slot-def in (closer-mop:class-slots (find-class class))
          for slot-name = (closer-mop:slot-definition-name slot-def)
          when (string-equal name (symbol-name slot-name))
            return slot-name)))

(defun initarg-keyword (thing)
  (a:make-keyword
   (string-upcase
    (if (symbolp thing) (symbol-name thing) thing))))

(defun json-plist->initarg-keywords (plist)
  (loop for (k v . more) on plist by #'cddr
        collect (initarg-keyword k)
        collect v))

(defun object-with-id (id-string)
  "Integer id of the desired entity.."
  (db:store-object-with-id (parse-integer id-string)))

(defparameter +updatable-oneliner-slot-keywords+
  '(:|oneliner| :|commands| :|brief| :|description|))

(defun valid-oneliner-update-data-p (jsonplist)
  "Checks the fields of jsonplist, return t if they are sufficient to update a oneliner entry."
  (loop for (k v . more) on jsonplist by #'cddr
        always (member k +updatable-oneliner-slot-keywords+)))

(defun update-oneliner (contributor oneliner json-body)
  "Accepts a decoded json body, a plist, and "
  (assert (valid-oneliner-update-data-p json-body))
  (db:with-transaction ()
    (loop for (k v . more) on json-body
          do (setf (slot-value oneliner (slot-name-of 'oneliner k)) v))
    (setf (edit-history oneliner) (get-universal-time))))

(defun valid-oneliner-init-data-p (plist)
  "dchecks the fields in plist,returns t if they are sufficient to create a new oneliner."
  ;; right now, just aliasing valid-oneliner-update-data-p
  (valid-oneliner-update-data-p plist))

(defun add-oneliner-to-db (contributor json-plist)
  "adds a new oneliner to the database, returning it upon success "
  (assert (valid-oneliner-init-data-p json-plist))
  (db:with-transaction ()
    (apply 'make-instance 'oneliner
           :created-at (get-universal-time)
           :created-by contributor
           (json-plist->initarg-keywords json-plist))))

(defun pw-hash (plaintext salt)
  (flexi-streams:octets-to-string 
   (ironclad:digest-sequence
    :sha3
    (flexi-streams:string-to-octets (concatenate 'string salt plaintext)  :external-format :utf-8))
   :external-format :latin1))

(defun uuid ()
  (format nil "~a" (uuid:make-v1-uuid)))

(defun parse-cls (s)
  "parse comman separated list."
  (mapcar #'str:trim (str:split "," s)))

(defun parse-true-or-false (s)
  (cond ((string-equal s "true") t)
        ((string-equal s "false") nil)
        (t (error "String ~s is neither 'true' nor 'false'" s))))

(defun oneliner-mentions-any (ol keywords)
  "A case insensitive search for the presence of any of KEYWORDS in the oneliner OL."
  (with-slots (text breif description) ol
    (loop
      for word in keywords
      thereis (search word text :test #'char-equal)
      thereis (search word breif :test #'char-equal)
      thereis (search word description :test #'char-equal))))


(defun onliners-with-all-commands (commands)
  (reduce #'intersection (mapcar #'oneliners-by-command commands)))

(defun query-oneliners (&key commands keywords notflagged onlyaudited)
  (if commands
      (remove-if-not
       #$(and (not (and notflagged (flagged-by $ol)))
              (or (not onlyaudited) (audited-by $ol))
              (or (null keywords) (oneliner-mentions-any $ol keywords)))
       (oneliners-with-all-commands command))
      (remove-if-not
       #$(and (not (and notflagged (flagged-by $ol)))
              (or (not onlyaudited) (audited-by $ol)))
       (oneliners-from-keywords keywords))))

(defun oneliners-from-keywords (keywords)
  (error "TBD"))

(defun to-json (thing)
  (let ((jonathan:*false-value* :false)
        (jonathan:*null-value* :null))
    (jonathan:to-json thing)))

(defun request-contributor ()
  (a:when-let (access (access-by-token (lzb:request-cookie +auth-cookie-name+)))
    (api-contributor access)))