s/user/contributor, added signatures to contributors, tag validation

1 files changed, 74 insertions, 26 deletions

diff --git a/src/main.lisp b/src/main.lisp
index c623336..4a0c2d1 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -46,11 +46,16 @@
     :index-reader contributor-by-handle
     :documentation "The contributor's name. Must be unique among all
     other contributor names.")
+   (signature
+    :accessor contributor-signature
+    :initarg :signature
+    :initform ""
+    :documentation "A short piece of contributor flair. May contain a url.")
    (salt
     :reader contributor-salt
     :initform (uuid)
     :type string
-    :documentation "Per user salt for password hashing.")
+    :documentation "Per contributor salt for password hashing.")
    (hashed-pw
     :accessor hashed-pw
     :initform nil
@@ -77,6 +82,12 @@
       (with-plist (limit made) (contributor-invites contributor)
                   (< made limit))))
 
+(defmethod json:%to-json ((obj contributor))
+  (json:with-object
+    (json:write-key-value "handle" (contributor-handle obj))
+    (json:write-key-value "signature" (contributor-signature obj))))
+
+
 (defclass api-access (db:store-object)
   ((token
     :reader api-token
@@ -110,7 +121,7 @@
     directly. Hence, clients should copy the text of this oneliner to
     the clipboard if possible.  Examples include ncurses applications,
     applications making use of readline, or those require extensive
-    user interaction.")
+    contributor interaction.")
    (tags
     :accessor oneliner-tags
     :initarg :tags
@@ -150,7 +161,7 @@
    (lockedp
     :accessor lockedp
     :initform nil
-    :documentation "Prevents editing until unliked. Only users with
+    :documentation "Prevents editing until unliked. Only contributors with
     admin priviliges can lock/unlock."))
   (:metaclass db:persistent-class))
 
@@ -238,7 +249,7 @@ accounts. So keep it secret, keep it safe."
                 () "Admins file formatted incorrectly. It should be a list of pairs of strings ((name pw) (name pw) ...)")
         (loop for (name pass) in admins
               unless (contributor-by-handle name)
-                do (make-new-admin-user name pass)
+                do (make-new-admin-contributor name pass)
               else
                 do (format *error-output* "Did not make admin ~a." name)))
       (format *error-output*
@@ -261,15 +272,14 @@ access to it.
 
 :INIT-ADMINS-FILE should be a file that contains a list of pairs of
 strings. This list is interpeted to be ((HANDLE1 PW1) (HANDLE2 PW2)
-...)  for admin users for this server. This file will be read and the
-users will be made. You should destroy this file after the initial
+...)  for admin contributors for this server. This file will be read and the
+contributors will be made. You should destroy this file after the initial
 boot up, subsequent boots will not need it, even if it remains
 mentioned in th config file.
 
 :SWANK-PORT, if provided, indicates that a swank server should be
 started, this will allow remote live debugging of the system.
 "
-
   (handler-case
       (progn 
         (assert (uiop:file-exists-p config-file))
@@ -389,6 +399,11 @@ started, this will allow remote live debugging of the system.
   (db:with-transaction ()
     (setf (contributor-lockedp contributor) value)))
 
+(defun set-signature (contributor signature)
+  "Set signature"
+  (db:with-transaction ()
+    (setf (contributor-signature contributor) signature)))
+
 (defun make-new-invite (&optional contributor)
   "Make and  return a new invite object. "
   (db:with-transaction ()
@@ -399,11 +414,13 @@ started, this will allow remote live debugging of the system.
         (make-instance 'invite :from contributor))
       (make-instance 'invite))))
 
-(defun redeem-invite (invite handle password)
+(defun redeem-invite (invite handle password &optional sig)
   (db:with-transaction ()
-    ;; make new user
-    (with-slots (salt hashed-pw)  (make-instance 'contributor :handle handle)
-      (setf hashed-pw (pw-hash password salt)))
+    ;; make new contributor
+    (with-slots (salt hashed-pw signature)  (make-instance 'contributor :handle handle)
+      (setf hashed-pw (pw-hash password salt))
+      (when sig
+        (setf signature sig)))
     ;; increment the redeemed invite count on the contributor who made
     ;; it, if exists.
     (a:when-let (contributor (invite-from invite))
@@ -415,7 +432,7 @@ started, this will allow remote live debugging of the system.
     ;; finally, delete the invite.
     (db:delete-object invite)))
 
-(defun make-new-admin-user (handle password)
+(defun make-new-admin-contributor (handle password)
   (db:with-transaction ()
     (with-slots (salt hashed-pw adminp) (make-instance 'contributor :handle handle)
       (setf hashed-pw (pw-hash password salt)
@@ -539,7 +556,7 @@ started, this will allow remote live debugging of the system.
     invite
     (http-err 404)))
 
-(defun a-user-handle (handle)
+(defun a-contributor-by-handle (handle)
   "A Contributor's Handle"
   (a:if-let (contributor (contributor-by-handle handle))
     contributor
@@ -566,42 +583,71 @@ started, this will allow remote live debugging of the system.
 
 ;;; SOME PREDICATES
 
+(defparameter +compiled-tag-and-handle-re+
+  (ppcre:create-scanner  "^[a-z0-9_\-]+$"
+                         :single-line-mode t
+                         :case-insensitive-mode t))
+
+(defun valid-tag-p (tag)
+  (and (stringp tag)
+       (<= (length tag) 20)
+       (ppcre:scan +compiled-tag-and-handle-re+ tag)))
 
 (defun valid-contributor-handle-p (handle)
   (and (stringp handle)
        (<= 3 (length handle) 15)
-       (ppcre:scan "[a-zA-Z_0-9\-]+" handle)))
+       (ppcre:scan +compiled-tag-and-handle-re+ handle)))
+
+(defun valid-signature-p (signature)
+  (and (stringp signature)
+       (<= (length signature) +oneliner-brief-max-length+)))
+
+
 
 ;;; ENDPOINT DEFINITIONS
 
-(defendpoint* :put "/contributor/:handle a-user-handle:/locked" ((value a-boolean)
-                                                                 (token an-api-token))
+(defendpoint* :get "/contributor/:who a-contributor-by-handle:" () ()
+  (to-json who))
+
+(defendpoint* :put "/contributor/:who a-contributor-by-handle:/locked" ((value a-boolean)
+                                                                        (token an-api-token))
   (:auth 'admin-only)
-  (set-contributor-locked contributor value)
+  (set-contributor-locked who value)
   "true")
 
-(defendpoint* :put "/contributor/:handle a-user-handle:/password" ((value a-string)
-                                                                   (repeated a-string)
-                                                                   (token an-api-token))
+(defendpoint* :put "/contributor/:who a-contributor-by-handle:/password" ((value a-string)
+                                                                          (repeated a-string)
+                                                                          (token an-api-token))
   (:auth t)
-  (unless (or (eq handle (api-contributor token))
+  (unless (or (eq who (api-contributor token))
               (adminp (api-contributor token)))
     (http-err 403 "Cannot change that password."))
   (unless (equalp value repeated)
     (http-err 400 "The two passwords do not match."))
-  (update-password handle value)
+  (update-password who value)
   "true")
 
+(defendpoint* :put "/contributor/:who a-contributor-by-handle:/signature" ((token an-api-token))
+  (:auth t)
+  (unless (or (eq who (api-contributor token))
+              (adminp (api-contributor token)))
+    (http-err 403))
+  (with-plist (signature) (lzb:request-body)
+              (unless (valid-signature-p signature)
+                (http-err 400 "Bad signature"))
+              (set-signature who signature)
+              "true"))
+
 (defendpoint* :post "/invite/redeem/:code an-invite-code:" () ()
   "Redeem an [invite code](#invite-code) and create a new [contributor](#new-contributor-post-body)"
-  (with-plist (password1 password2 handle) (lzb:request-body)
+  (with-plist (password1 password2 handle signature) (lzb:request-body)
               (unless (equal password1 password2)
                 (http-err 400 "Passwords dont match"))
               (unless (valid-contributor-handle-p handle)
                 (http-err 400 (format nil "~a is not a valid contributor handle." handle)))
               (when (contributor-by-handle handle)
                 (http-err 403 (format nil "The name ~a is already taken." handle)))
-              (redeem-invite code handle password1)
+              (redeem-invite code handle password1 signature)
               "true"))
 
 (defendpoint* :post "/access" () ()
@@ -643,13 +689,15 @@ have exceeded the invite limit."
   "On success, return an object containing a new [invite token](#invite-token)."
   (to-json (make-new-invite (api-contributor token))))
 
-(defparameter +explanation-wordcount-limit+ 550)
+(defparameter +explanation-wordcount-limit+ 549)
 
 (defun validate-new-oneliner-plist (plist)
   (with-plist
       (oneliner tags brief runstyle explanation) plist
       (unless tags
         (http-err 400 "A oneliner requires tags"))
+      (unless (every 'valid-tag-p tags)
+        (http-err 400 "Some tags are malformed."))
       (unless brief
         (http-err 400 "Oneliner requires a brief explanation"))
       (unless (<= (length brief) +oneliner-brief-max-length+)
@@ -658,7 +706,7 @@ have exceeded the invite limit."
         (http-err 400 "Oneliner cannot be blank"))
       (when explanation
         (unless (<= (count #\space explanation) +explanation-wordcount-limit+)
-          (http-err 400 "Explanation is too long. Limit to around 500 words.")))
+          (http-err 400 "Explanation is too long. Limit to around 550 words.")))
       (when runstyle
         (setf runstyle (a:make-keyword runstyle))
         (unless (typep runstyle 'runstyle)