diff options
| -rw-r--r-- | src/main.lisp | 184 |
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 |