refactoring to match lazybones defendpoint change

1 files changed, 120 insertions, 77 deletions

diff --git a/src/main.lisp b/src/main.lisp
index 1411aa1..ddfcc20 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -5,7 +5,6 @@
                     (#:db #:bknr.datastore))
   (:import-from #:lazybones
                 #:defendpoint*
-                #:http-ok
                 #:http-err))
 (in-package :oneliners.api)
 
@@ -28,9 +27,15 @@
     :initform nil
     :type string
     :documentation "Hashed password for this contributor. Note, this
-    value is hashed with the server salt and the contributor-salt."))
+    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
@@ -57,32 +62,42 @@
       (revoke-access access))))
 
 (defclass oneliner (db:store-object)
-  ((text
-    :accessor oneliner-text 
+  ((oneliner
+    :accessor oneliner 
     :initarg :oneliner
     :initform (error "Onliner required"))
-   (command
-    :accessor oneliner-command
-    :initarg :command
-    :index-type bknr.indices:hash-index
+   (commands
+    :accessor oneliner-commands
+    :initarg :commands
+    :initform nil
+    :index-type bknr.indices:hash-list-index 
     :index-initargs (:test 'equal)
-    :index-reader oneliners-by-command)
+    :index-reader oneliners-by-command
+    :documentation "The commands that this oneliner principally involves.")
    (brief
     :accessor oneliner-brief
     :initarg :brief
-    :initform ""
+    :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))
-   (edit-history
-    :accessor edit-history
+   (edited-at
+    :accessor edited-at
     :initform nil
-    :documentation "A list of (WHO WHEN WHAT)")
+    :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
@@ -91,7 +106,12 @@
     :accessor audited-by
     :initform nil
     :documentation "NIL or a CONTRIBUTOR object. Indicates that a user
-    has approved of this oneliner."))
+    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)
@@ -110,14 +130,17 @@
   (:metaclass db:persistent-class))
 
 (defun make-next-page (limit to-page)
-  (let ((key (uuid)))
-    (make-instance 'query-results-page
-                   :key key
-                   :limit limit
-                   :to-page to-page
-                   :remaining (length to-page)
-                   :last-access (get-universal-time))
-    key))
+  (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
@@ -154,9 +177,7 @@
 (defvar *instance-salt* "change me")
 
 (defparameter +data-store-directory-name+
-  "onliners-api-datastore")
-
-
+  "oneliners-api-datastore")
 
 (defun data-store-path (store-dir)
   (let ((store-dir (or store-dir (pathname-directory (user-homedir-pathname)))))
@@ -196,16 +217,16 @@
   (start-cleaning-thread))
 
 (defun start-cleaning-thread (&key (run-period 45))
-  ;; thread not stopped properly.
+  ;; 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 (handler-case (routine-cleaning)
-                      (error (e) (print e)))
-                    (sleep run-period))))))
+                 do (sleep run-period)
+                    (handler-case (routine-cleaning)
+                      (error (e) (print e))))))))
 
 (defun stop ()
   (setf *runningp* nil)
@@ -234,18 +255,18 @@
     :auth 'api-token-authorization))
 
 (defun api-token-authorization ()
-  "TBD"
-  t)
+  ;; presently if the token merely exists then that's good enough.
+  (request-contributor)) 
 
 ;;; ENDPOINT DEFINITIONS
 
-(defendpoint* :get "/search" ()
+(defendpoint* :get "/search" () ()
   "A search endpoint returning a JSON encoded array of Oneliner Entries.
 
 /search accepts the following query parameters:
 
-- command    : The name of a command. E.g. `ls`, `grep`, `netcat`.
-- keywords   : A comma-separated list of words that may appear in the title or description of a command entry, e.t. `'foo,bar,goo,zar,moo_blar'
+- 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.
@@ -255,7 +276,7 @@
 **Note**: either command or keywords are required.
 "
   (lzb:map-parameters
-      ((command identity)
+      ((commands parse-cls)
        (keywords parse-cls)
        (limit parse-integer)
        (nextpage true-or-false)
@@ -263,49 +284,49 @@
        (notflagged true-or-false)
        (onlyaudited true-or-false))
     (cond
-      ;; if page is incluced, ignore everything, fetch the next page, and return it.
+      ;; if page is incluced, ignore everything, fetch the next page,
+      ;; and return it.
       (page                             
-       (http-ok (to-json (fetch-next-page page))))
+       (to-json (fetch-next-page page)))
 
       ;; otherwise one of command keywords are required
-      ((or command keywords)
+      ((or commands keywords)
        (let* ((limit
-                (or limit 10))
+                (or limit 10)) ; default-limit, should probably be configurable.
               (results
-                (query-oneliners :command command
+                (query-oneliners :commands commands
                                  :keywords keywords
                                  :notflagged notflagged
                                  :onlyaudited onlyaudited))
               (limited-results
-                (if (> limit (length results))  results
-                    (subseq results 0 limit))))
-         (http-ok
-          (to-json
-           (if nextpage
-               (list
-                :page (make-next-page limit (nthcdr limit results))
-                :oneliners limited-results)
-               (list :oneliners limited-results)))))) 
-      ;; if neither was supplied, return a 400
+                (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)
+(defendpoint* :put "/oneliner/:oneliner object-with-id:" ()  (:auth t)
   "Updates a oneliner entry in the wiki database."
   (cond
     (oneliner
-     (update-oneliner oneliner (lzb:request-body))  ; throws an error if fails, triggering a 500
-     (http-ok "true"))                               
+     (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)
+(defendpoint* :post "/oneliner" ()  (:auth t)
   "Adds a new oneliner entry to the wiki database."
-  (a:if-let (new-oneliner (add-oneliner-to-db (lzb:request-body)))
-    (http-ok "{}") ; dummy implementation
+  (a:if-let (new-oneliner (add-oneliner-to-db (request-contributor) (lzb:request-body)))
+    "{}" ; dummy implementation
     (http-err 400)))                            
 
-
-(defendpoint* :post "/auth" ()
+(defendpoint* :post "/auth" () ()
   "Requests an authorization token")
 
 ;;; HELPERS
@@ -321,27 +342,49 @@ names.  NAME must be a symbol or a string."
           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 entity desired."
+  "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."
-  jsonplist);; dummy implementation
+  (loop for (k v . more) on jsonplist by #'cddr
+        always (member k +updatable-oneliner-slot-keywords+)))
 
-(defun update-oneliner (oneliner json-body)
+(defun update-oneliner (contributor oneliner json-body)
   "Accepts a decoded json body, a plist, and "
   (assert (valid-oneliner-update-data-p json-body))
-  (list oneliner json-body)) ;; dummy implmenetation
+  (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."
-  plist);; dummy implementation
+  ;; right now, just aliasing valid-oneliner-update-data-p
+  (valid-oneliner-update-data-p plist))
 
-(defun add-oneliner-to-db (json-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))
-  :dummy-ok)
+  (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 
@@ -353,12 +396,10 @@ names.  NAME must be a symbol or a string."
 (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)
@@ -373,30 +414,32 @@ names.  NAME must be a symbol or a string."
       thereis (search word breif :test #'char-equal)
       thereis (search word description :test #'char-equal))))
 
-(defun query-oneliners (&key command keywords notflagged onlyaudited)
-  (if command
+
+(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-by-command command))
+       (oneliners-with-all-commands command))
       (remove-if-not
        #$(and (not (and notflagged (flagged-by $ol)))
-              (or (not onlyaudited) (audited-by $ol))
-              (or (not command) (string-equal command (oneliner-command $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)))
 
-;;; RESULTS PAGES
+(defun request-contributor ()
+  (a:when-let (access (access-by-token (lzb:request-cookie +auth-cookie-name+)))
+    (api-contributor access)))
+