aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/main.lisp123
1 files changed, 34 insertions, 89 deletions
diff --git a/src/main.lisp b/src/main.lisp
index 13d0d57..11be7fd 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -84,17 +84,7 @@
: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
@@ -165,6 +155,7 @@
;;; SERVICE CONTROL
(defvar *server* nil)
+(defvar *server-domain* "localhost")
(defvar *cleaning-thread* nil)
(defvar *runningp* nil)
(defvar *instance-salt* "change me"
@@ -206,8 +197,10 @@
(port 8888)
(address "127.0.0.1")
(salt "change me")
+ (domain "localhost")
store-dir)
- (setf *instance-salt* salt )
+ (setf *instance-salt* salt
+ *server-domain* domain)
(ensure-datastore store-dir)
(ensure-server port address)
(lzb:install-app *server* (lzb:app))
@@ -298,6 +291,18 @@
(db:with-transaction ()
(make-instance 'api-access :contributor contributor)))
+(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))))
+
(defun make-new-oneliner (contributor plist)
(with-plist
(oneliner tags brief description) plist
@@ -427,16 +432,19 @@
"Authenticate a contributor and reply with an [api token](#access-token)"
(cond ((equal (pw-hash password (contributor-salt contributor))
(hashed-pw contributor))
- (to-json
- (a:if-let (access (access-by-contributor contributor))
- (list :token (api-token access)) ; return extant tokens
- (list :token (api-token (make-api-access contributor)))))) ; or make a new one
+ (let ((token (a:if-let (access (access-by-contributor contributor))
+ (api-token access)
+ (api-token (make-api-access contributor)))))
+ (lzb:set-response-cookie
+ +auth-cookie-name+ token
+ :path "/" :domain *server-domain*)
+ (to-json (list :token token))))
(t
(http-err 401))))
(defun authorized-to-invite ()
- "To make a new invite, a contributor must be either authorized,
-having not exceeded their invite limit, or must be an admin."
+ "To make a new invite, a contributor must be authorized and must not
+have exceeded the invite limit."
(a:when-let (contributor (and (api-token-authorization) (request-contributor)))
(or (adminp contributor)
(can-invite-p contributor))))
@@ -453,17 +461,19 @@ having not exceeded their invite limit, or must be an admin."
"true")
(defun admin-only ()
- "The request requires an API access token.
-Only contributors with admin privileges are allowed to perform this action."
+ "The request requires an API access token. Only contributors with
+admin privileges are allowed to perform this action."
(a:when-let (contributor (request-contributor))
(adminp contributor)))
-(defendpoint* :patch "/lock/:oneliner a-oneliner-id:" () (:auth 'admin-only)
+(defendpoint* :patch "/lock/:oneliner a-oneliner-id:" ()
+ (:auth 'admin-only)
"Locks a oneliner. Locked oneliners cannot be edited or flagged."
(lock-oneliner oneliner (request-contributor))
"true")
-(defendpoint* :patch "/unlock/:oneliner a-oneliner-id:" () (:auth 'admin-only)
+(defendpoint* :patch "/unlock/:oneliner a-oneliner-id:" ()
+ (:auth 'admin-only)
"Unlocks a oneliner."
(unlock-oneliner oneliner (request-contributor))
"true")
@@ -485,79 +495,17 @@ Only contributors with admin privileges are allowed to perform this action."
(limit an-int)
(notflagged a-boolean))
()
- "A search endpoint returning a JSON encoded array of Oneliner Entries.
-
-**Note**: either command or keywords are required.
-"
+ "A search endpoint returning a JSON encoded array of Oneliner Entries. TAGS cannot be empty."
(if tags
(to-json
(list :oneliners (query-oneliners :tags tags
:notflagged notflagged
:limit limit)))
- (t ; else responde with 400
- (http-err 400))))
-
-
-
+ (http-err 400)))
;;; 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)
"Hash plaintext using SALT and the value of *INSTANCE-SALT*"
(flexi-streams:octets-to-string
@@ -581,9 +529,6 @@ names. NAME must be a symbol or a string."
thereis (search word description :test #'char-equal))))
-
-
-
(defun to-json (thing)
(let ((jonathan:*false-value* :false)
(jonathan:*null-value* :null))