diff options
| -rw-r--r-- | clpmfile | 4 | ||||
| -rw-r--r-- | clpmfile.lock | 13 | ||||
| -rw-r--r-- | oneliners.api.asd | 1 | ||||
| -rw-r--r-- | src/main.lisp | 197 |
4 files changed, 137 insertions, 78 deletions
@@ -12,3 +12,7 @@ (:github "lambda-riffs" :path "cbeo/lambda-riffs" :branch "master") + +(:github "lazybones-client" + :path "cbeo/lazybones-client" + :branch "main") diff --git a/clpmfile.lock b/clpmfile.lock index db2995d..f1412ff 100644 --- a/clpmfile.lock +++ b/clpmfile.lock @@ -11,6 +11,8 @@ :sources (:implicit-file :type :file-system :system-files ("oneliners.api.asd")) (:implicit-vcs :type :vcs :projects + (("lazybones-client" :github :path "cbeo/lazybones-client"))) +(:implicit-vcs :type :vcs :projects (("lambda-riffs" :github :path "cbeo/lambda-riffs"))) (:implicit-vcs :type :vcs :projects (("lazybones" :github :path "cbeo/lazybones"))) @@ -23,6 +25,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; :requirements +(:project :name "lazybones-client" :branch "main" :source :implicit-vcs) (:project :name "lambda-riffs" :branch "master" :source :implicit-vcs) (:project :name "lazybones" :branch "master" :source :implicit-vcs) (:asd-file :name "oneliners.api.asd") @@ -67,8 +70,11 @@ ("jonathan" :version "2020-09-25" :source "quicklisp" :systems ("jonathan")) ("lambda-riffs" :version (:commit "f7b3c081f2361f7370c80e7ff4a432241f34ce55") :source :implicit-vcs :systems ("lambda-riffs")) -("lazybones" :version (:commit "5bf29467cae32ca2a2aba866a77c228e0b237e0e") +("lazybones" :version (:commit "128f72863fa3f736c93175267beb23292e70e096") :source :implicit-vcs :systems ("lazybones" "lazybones-hunchentoot")) +("lazybones-client" :version + (:commit "22a1c72874e579858d6add4f2b617495acc7cd4d") :source :implicit-vcs + :systems ("lazybones-client")) ("lisp-namespace" :version "2021-10-21" :source "quicklisp" :systems ("lisp-namespace")) ("md5" :version "2021-06-30" :source "quicklisp" :systems ("md5")) @@ -214,8 +220,13 @@ ("lazybones" ((:system :name "oneliners.api") (:system :name "lazybones-hunchentoot")) ((:system :name "lazybones-hunchentoot") (:system :name "lazybones")) + ((:system :name "lazybones-client") (:system :name "lazybones")) (t (:project :name "lazybones" :branch "master" :source :implicit-vcs))) +("lazybones-client" + ((:system :name "oneliners.api") (:system :name "lazybones-client")) + (t (:project :name "lazybones-client" :branch "main" :source :implicit-vcs))) + ("lisp-namespace" ((:system :name "lazybones") (:system :name "lisp-namespace"))) diff --git a/oneliners.api.asd b/oneliners.api.asd index 751f573..2091136 100644 --- a/oneliners.api.asd +++ b/oneliners.api.asd @@ -3,6 +3,7 @@ :author "Colin Okay" :license "AGPLv3" :depends-on ("lazybones-hunchentoot" + "lazybones-client" "bknr.datastore" "jonathan" "ironclad" 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))) + |