access token request and invite redeeming logic

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