From 477919bbb0885167c459b6ce31beb9c9935ca576 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 14 Feb 2022 10:08:39 -0600 Subject: refactoring to match lazybones defendpoint change --- src/main.lisp | 197 +++++++++++++++++++++++++++++++++++----------------------- 1 file changed, 120 insertions(+), 77 deletions(-) (limited to 'src/main.lisp') 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))) + -- cgit v1.2.3