aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/main.lisp184
1 files changed, 134 insertions, 50 deletions
diff --git a/src/main.lisp b/src/main.lisp
index 57cf74d..ebd07c1 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -8,7 +8,19 @@
#:http-err))
(in-package :oneliners.api)
-;;; DATA
+;;; DATA DEFINITIONS
+
+(defclass invite (db:store-object)
+ ((code
+ :reader invite-code
+ :initarg :code
+ :initform (error "invite code required")
+ :index-type bknr.indices:string-unique-index
+ :index-reader invite-by-code)
+ (from
+ :reader invite-from
+ :initarg :from))
+ (:metaclass db:persistent-class))
(defclass contributor (db:store-object)
((handle
@@ -17,7 +29,7 @@
:initform (error "Contributors must have a name.")
:index-type bknr.indices:string-unique-index
:index-reader contributor-by-handle)
- (contributor-salt
+ (salt
:reader contributor-salt
:initform (uuid)
:type string
@@ -39,7 +51,7 @@
(defclass api-access (db:store-object)
((token
:reader api-token
- :initarg :token
+ :initform (uuid)
:index-type bknr.indices:string-unique-index
:index-reader access-by-token)
(contributor
@@ -174,7 +186,8 @@
(defvar *server* nil)
(defvar *cleaning-thread* nil)
(defvar *runningp* nil)
-(defvar *instance-salt* "change me")
+(defvar *instance-salt* "change me"
+ "This is salt used for password hashing and login recovery")
(defparameter +data-store-directory-name+
"oneliners-api-datastore")
@@ -198,9 +211,14 @@
(defun ensure-server (port address)
(unless *server*
(setf *server* (lzb:create-server :port port :address address))
- (lzb:set-canned-response *server* 400 "Bad Request" "text/plain")
- (lzb:set-canned-response *server* 404 "Not Found" "text/plain")
- (lzb:set-canned-response *server* 500 "Server Error" "text/plain")))
+ (set-canned-responses)))
+
+(defun set-canned-responses ()
+ (lzb:set-canned-response *server* 400 "Bad Request" "text/plain")
+ (lzb:set-canned-response *server* 401 "Unauthorized" "text/plain")
+ (lzb:set-canned-response *server* 403 "Forbidden" "text/plain")
+ (lzb:set-canned-response *server* 404 "Not Found" "text/plain")
+ (lzb:set-canned-response *server* 500 "Server Error" "text/plain"))
(defun start
(&key
@@ -257,12 +275,30 @@
;; presently if the token merely exists then that's good enough.
(request-contributor))
+
+;;; DATABASE TRANSACTIONS
+
+(defun redeem-invite (invite handle password)
+ (db:with-transaction ()
+ (with-slots (salt hashed-pw) (make-instance 'contributor :handle handle)
+ (setf hashed-pw (pw-hash password salt)))
+ (db:delete-object invite)))
+
+
+(defun make-api-access (contributor)
+ (db:with-transaction ()
+ (make-instance 'api-access :contributor contributor)))
+
;;; ROUTE VARIABLE AND PARAMATER PARSERS
(defun an-int (string)
"An Integer"
(parse-integer string))
+(defun a-string (string)
+ "A String"
+ string)
+
(defun a-csl (s)
"A list of strings separated by commas. e.g. \"foo,bar,goo\""
(mapcar #'str:trim (str:split "," s)))
@@ -277,43 +313,92 @@
"A page key"
key)
+(defun an-invite-code (code)
+ "An invite code."
+ (a:if-let (invite (invite-by-code code))
+ invite
+ (http-err 404)))
+
+(defun a-user-handle (handle)
+ "A Contributor's Handle"
+ (a:if-let (contributor (contributor-by-handle handle))
+ contributor
+ (http-err 404)))
+
+(defun a-short-string (string)
+ "A string at most 50 characters in length"
+ (when (< 50 (length string))
+ (http-err 400 "String Too Long"))
+ string)
+
+
;;; ENDPOINT DEFINITIONS
-(defendpoint* :get "/search" ((commands a-csl)
- (keywords a-csl )
- (limit an-int)
- (pagekey a-page-key)
- (nextpage a-boolean)
- (notflagged a-boolean)
- (onlyaudited a-boolean))
+(defendpoint* :post "/redeem/:invite an-invite-code:"
+ ((username a-string)
+ (password1 a-string)
+ (password2 a-string))
()
- "A search endpoint returning a JSON encoded array of Oneliner Entries.
-
-**Note**: either command or keywords are required.
-"
- (cond
- (pagekey ; return page if present.
- (to-json (fetch-next-page page)))
-
- ((or commands keywords) ; else search for oneliners
- (let* ((limit
- (or limit 10)) ;TODO: no magic numbers
- (results
- (query-oneliners :commands commands
- :keywords keywords
- :notflagged notflagged
- :onlyaudited onlyaudited))
- (limited-results
- (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)))))
-
- (t ; else responde with 400
- (http-err 400))))
+ "Redeem an invite code"
+ (unless (equal password1 password2)
+ (http-err 400 "Passwords dont match"))
+ (when (contributor-by-handle username)
+ (http-err 403 (format nil "The name ~a is already taken." username)))
+ (redeem-invite invite username password1)
+ "true")
+
+(defendpoint* :post "/request-token/:contributor a-user-handle:"
+ ((password a-string))
+ ()
+ "Authenticate a user and reply with an api 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
+ (t
+ (http-err 401))))
+
+(defendpoint* :post "/add-oneliner" ()
+ (:auth t)
+ )
+
+;; (defendpoint* :get "/search" ((commands a-csl)
+;; (keywords a-csl )
+;; (limit an-int)
+;; (pagekey a-page-key)
+;; (nextpage a-boolean)
+;; (notflagged a-boolean)
+;; (onlyaudited a-boolean))
+;; ()
+;; "A search endpoint returning a JSON encoded array of Oneliner Entries.
+
+;; **Note**: either command or keywords are required.
+;; "
+;; (cond
+;; (pagekey ; return page if present.
+;; (to-json (fetch-next-page page)))
+
+;; ((or commands keywords) ; else search for oneliners
+;; (let* ((limit
+;; (or limit 10)) ;TODO: no magic numbers
+;; (results
+;; (query-oneliners :commands commands
+;; :keywords keywords
+;; :notflagged notflagged
+;; :onlyaudited onlyaudited))
+;; (limited-results
+;; (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)))))
+
+;; (t ; else responde with 400
+;; (http-err 400))))
;; (defendpoint* :put "/oneliner/:oneliner object-with-id:" () (:auth t)
;; "Updates a oneliner entry in the wiki database."
@@ -325,11 +410,11 @@
;; "true")
;; (t (http-err 404))))
-(defendpoint* :post "/oneliner" () (:auth t)
- "Adds a new oneliner entry to the wiki database."
- (a:if-let (new-oneliner (add-oneliner-to-db (request-contributor) (lzb:request-body)))
- "{}" ; dummy implementation
- (http-err 400)))
+;; (defendpoint* :post "/oneliner" () (:auth t)
+;; "Adds a new oneliner entry to the wiki database."
+;; (a:if-let (new-oneliner (add-oneliner-to-db (request-contributor) (lzb:request-body)))
+;; "{}" ; dummy implementation
+;; (http-err 400)))
;; (defendpoint* :post "/auth" () ()
;; "Requests an authorization token")
@@ -392,19 +477,18 @@ names. NAME must be a symbol or a string."
(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
(ironclad:digest-sequence
:sha3
- (flexi-streams:string-to-octets (concatenate 'string salt plaintext) :external-format :utf-8))
+ (flexi-streams:string-to-octets (concatenate 'string *instance-salt* salt plaintext)
+ :external-format :utf-8))
:external-format :latin1))
(defun uuid ()
(format nil "~a" (uuid:make-v1-uuid)))
-
-
-
(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