aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--clpmfile.lock10
-rw-r--r--src/main.lisp372
2 files changed, 336 insertions, 46 deletions
diff --git a/clpmfile.lock b/clpmfile.lock
index e3fdf30..db2995d 100644
--- a/clpmfile.lock
+++ b/clpmfile.lock
@@ -67,7 +67,7 @@
("jonathan" :version "2020-09-25" :source "quicklisp" :systems ("jonathan"))
("lambda-riffs" :version (:commit "f7b3c081f2361f7370c80e7ff4a432241f34ce55")
:source :implicit-vcs :systems ("lambda-riffs"))
-("lazybones" :version (:commit "aec0893df2f4bb8fa8da7c71cb8dca09c0bd5f86")
+("lazybones" :version (:commit "5bf29467cae32ca2a2aba866a77c228e0b237e0e")
:source :implicit-vcs :systems ("lazybones" "lazybones-hunchentoot"))
("lisp-namespace" :version "2021-10-21" :source "quicklisp" :systems
("lisp-namespace"))
@@ -209,16 +209,12 @@
("lambda-riffs"
((:system :name "oneliners.api") (:system :name "lambda-riffs"))
- (t
- (:project :name "lambda-riffs" :commit
- "f7b3c081f2361f7370c80e7ff4a432241f34ce55" :source :implicit-vcs)))
+ (t (:project :name "lambda-riffs" :branch "master" :source :implicit-vcs)))
("lazybones"
((:system :name "oneliners.api") (:system :name "lazybones-hunchentoot"))
((:system :name "lazybones-hunchentoot") (:system :name "lazybones"))
- (t
- (:project :name "lazybones" :commit
- "aec0893df2f4bb8fa8da7c71cb8dca09c0bd5f86" :source :implicit-vcs)))
+ (t (:project :name "lazybones" :branch "master" :source :implicit-vcs)))
("lisp-namespace"
((:system :name "lazybones") (:system :name "lisp-namespace")))
diff --git a/src/main.lisp b/src/main.lisp
index 8d01e4a..1411aa1 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -1,7 +1,7 @@
(defpackage oneliners.api
(:use :cl)
(:local-nicknames (#:lzb #:lazybones)
- (#:a #:alexandria)
+ (#:a #:alexandria-2)
(#:db #:bknr.datastore))
(:import-from #:lazybones
#:defendpoint*
@@ -9,9 +9,170 @@
#: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."))
+ (:metaclass db:persistent-class))
+
+(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)
+ ((text
+ :accessor oneliner-text
+ :initarg :oneliner
+ :initform (error "Onliner required"))
+ (command
+ :accessor oneliner-command
+ :initarg :command
+ :index-type bknr.indices:hash-index
+ :index-initargs (:test 'equal)
+ :index-reader oneliners-by-command)
+ (brief
+ :accessor oneliner-brief
+ :initarg :brief
+ :initform ""
+ :documentation "A short description of the oneliner.")
+ (description
+ :accessor oneliner-description
+ :initarg :description
+ :initform "")
+ (created-at
+ :reader created-at
+ :initform (get-universal-time))
+ (edit-history
+ :accessor edit-history
+ :initform nil
+ :documentation "A list of (WHO WHEN WHAT)")
+ (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."))
+ (: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)
+ (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))
+
+(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+
+ "onliners-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*
@@ -20,26 +181,57 @@
(lzb:set-canned-response *server* 404 "Not Found" "text/plain")
(lzb:set-canned-response *server* 500 "Server Error" "text/plain")))
-(defun start (&optional (port 8888) (address "127.0.0.1"))
+(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*))
+ (lzb:start-server *server*)
+ (setf *runningp* t)
+ (start-cleaning-thread))
+
+(defun start-cleaning-thread (&key (run-period 45))
+ ;; thread not 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))))))
(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")
-(lzb:provision-app ()
- :title "Oneliners Wiki API"
- :version "0.0.1"
- :desc +oneliners-description+
- :content-type "application/json"
- :auth 'api-token-authorization)
+(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 ()
"TBD"
@@ -48,32 +240,67 @@
;;; ENDPOINT DEFINITIONS
(defendpoint* :get "/search" ()
- "A search endpoint returning a JSON encoded array of Command Entries.
+ "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'
-- limit : An integer, limiting the number of results returned. Defaults to 10.
-- recent : 0 for false 1 for true; sorts results by how recently they were added. Defaults to 0.
-- nextpage : 0 for false 1 for true; 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.
+- 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'
+- 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** that either `command` or `keyword` parameters are required.
+**Note**: either command or keywords are required.
"
- (http-ok "[]"))
+ (lzb:map-parameters
+ ((command identity)
+ (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
+ (http-ok (to-json (fetch-next-page page))))
+
+ ;; otherwise one of command keywords are required
+ ((or command keywords)
+ (let* ((limit
+ (or limit 10))
+ (results
+ (query-oneliners :command command
+ :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
+ (t
+ (http-err 400)))))
-(defendpoint* :put "/command/:command command-by-id:" (:auth t)
- "Updates a command entry in the wiki database."
+(defendpoint* :put "/oneliner/:oneliner object-with-id:" (:auth t)
+ "Updates a oneliner entry in the wiki database."
(cond
- (command
- (update-commmand command (lzb:request-body)) ; throws an error if fails, triggering a 500
+ (oneliner
+ (update-oneliner oneliner (lzb:request-body)) ; throws an error if fails, triggering a 500
(http-ok "true"))
- (t (http-err 404)))) ;no command with the given id.
+ (t (http-err 404)))) ;no oneliner with the given id.
-(defendpoint* :post "/command" (:auth t)
- "Adds a new command entry to the wiki database."
- (a:if-let (new-command (add-command-to-db (lzb:request-body)))
+(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
(http-err 400)))
@@ -83,26 +310,93 @@
;;; HELPERS
-(defun command-by-id (id-string)
- "An integer id of a command."
- (list :a-dummy-command id-string))
+(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 valid-command-update-data-p (jsonplist)
- "Checks the fields of jsonplist, return t if they are sufficient to update a command entry."
+(defun object-with-id (id-string)
+ "Integer id of the entity desired."
+ (db:store-object-with-id (parse-integer id-string)))
+
+(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
-(defun update-commmand (command json-body)
+(defun update-oneliner (oneliner json-body)
"Accepts a decoded json body, a plist, and "
- (assert (valid-command-update-data-p json-body))
- (list command json-body)) ;; dummy implmenetation
+ (assert (valid-oneliner-update-data-p json-body))
+ (list oneliner json-body)) ;; dummy implmenetation
-(defun valid-command-init-data-p (plist)
- "dchecks the fields in plist,returns t if they are sufficient to create a new command."
+(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
-(defun add-command-to-db (json-plist)
- "adds a new command to the database, returning it upon success "
- (assert (valid-command-init-data-p json-plist))
+(defun add-oneliner-to-db (json-plist)
+ "adds a new oneliner to the database, returning it upon success "
+ (assert (valid-oneliner-init-data-p json-plist))
:dummy-ok)
+(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 query-oneliners (&key command keywords notflagged onlyaudited)
+ (if command
+ (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))
+ (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))))
+ (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