Very large syncing/serialization updates

Bulk sync posting is now working great. Also, fixed sync-id inclusion
bug in GET /sync. also working great.

Converted defvalidator to use new method by default (compatible with
adefun, the new async function definer) and converted all validators to
use :old t if not converted yet.

updating json parser to jonathan, although having a few bumps in the
road (nil -> [] vs null was a big one, and now a simple parser error)
but going to stick with it since performance is a big concern.

ripped out note bulk save endpoint/functions because they are fucking
stupid, especially with the bulk sync api.

there are probably more changes i'm not codifying, but it's been a long
week (or more?) and i don't remember everything. read the diff.

Author: orthecreedence

controllers/notes.lisp

@@ -214,16 +214,3 @@
       (track "file-delete" `(:shared ,(when persona-id t)) req)
       (send-json res t))))
 
-(defroute (:put "/api/notes/batch") (req res)
-  "Batch edit. Allows passing in a persona ID, which will be used in place of
-   the current user ID when validating permissions."
-  (catch-errors (res)
-    (alet* ((user-id (user-id req))
-            (persona-id (post-var req "persona"))
-            (batch-edit-data (post-var req "data"))
-            (nil (if persona-id
-                     (with-valid-persona (persona-id user-id)
-                       (batch-note-edit persona-id batch-edit-data))
-                     (batch-note-edit user-id batch-edit-data))))
-      (send-json res t))))
-

controllers/sync.lisp

@@ -31,10 +31,11 @@
       (alet ((user (get-user-by-id user-id))
              (keychain (get-user-keychain user-id))
              (personas (get-user-personas user-id))
-             (boards (get-user-boards user-id :get-persona-boards t :get-personas t))
              (global-sync-id (get-latest-sync-id)))
         ;; notes require all our board ids, so load them here
-        (alet* ((notes (get-notes-from-board-ids (map 'list (lambda (b) (gethash "id" b)) boards)))
+        (alet* ((boards (get-all-boards user-id (map 'list (lambda (p) (gethash "id" p)) personas)))
+                (board-ids (map 'list (lambda (b) (gethash "id" b)) boards))
+                (notes (get-all-notes user-id board-ids))
                 (files (remove-if-not (lambda (note)
                                         (and (hget note '("file"))
                                              (hget note '("file" "hash"))))
@@ -62,8 +63,21 @@
 
 (defroute (:post "/api/v2/sync") (req res)
   "Bulk sync API. Accepts any number of sync items and applies the updates to
-   the profile of the authed user."
-  )
+   the profile of the authed user.
+   
+   Note that the items are added in sequence and if any one in the sequence
+   fails, we abort and send back the successes and failures. This is because
+   many of the items need to be added in a specific sequence in order to work
+   correctly (for instance, a keychain entry for a board needs to be synced
+   before the board itself). Catching a failure in the sequence allows the
+   client to try again whilst still preserving the original order of the sync
+   items."
+  (catch-errors (res)
+    (alet* ((user-id (user-id req))
+            (sync-items (jonathan:parse (babel:octets-to-string (request-body req)) :as :hash-table))
+            (synced (bulk-sync user-id sync-items)))
+      (send-json res synced))))
+
 
 ;;; ----------------------------------------------------------------------------
 ;;; deprecated stuff

lib/util.lisp

@@ -55,11 +55,13 @@
       (error (format nil "Bad index name passed to db-index: ~a" index)))
     (format nil "~a.v~a" (string-downcase (string index-key)) (getf index-entry :version))))
 
+(defmethod jonathan:%to-json ((_ (eql nil)))
+  (jonathan:%write-string "null"))
+
 (defun to-json (object &key indent)
   "Convert an object to JSON."
-  (with-output-to-string (s)
-    (let ((js (yason:make-json-output-stream s :indent indent)))
-      (yason:encode object js))))
+  (declare (ignore indent))
+  (jonathan:to-json object))
 
 (defun send-json (response object &key (status 200))
   "Wraps sending of JSON back to the client."
@@ -96,8 +98,7 @@
 (defun copy-hash (hash)
   "Deep copy a hash table."
   ;; lazy way
-  (yason:parse (with-output-to-string (s)
-                 (yason:encode hash s))))
+  (jonathan:parse (jonathan:to-json hash) :as :hash-table))
 
 (defun add-id (hash-object &key (id-key "id"))
   "Add a mongo id to a hash table object."
@@ -140,6 +141,9 @@
       (setf body (cdr body)))
     `(defun ,name ,args
        ,(if (stringp docstring) docstring "")
+       ,(when (eq (caar body) 'declare)
+          (prog1 (car body)
+            (setf body (cdr body))))
        (catcher
          (progn ,@body)
          (error (e)
@@ -151,6 +155,10 @@
                                  :error e
                                  :function ',name)))))))
 
+;; !!!!!!!!!!!!!!!!!!
+;; !!! DEPRECATED !!!
+;; !!!!!!!!!!!!!!!!!!
+;; do not build new functions that use this macro. use adefun instead!
 (defmacro defafun (name (future-var &key (forward-errors t)) args &body body)
   "Define an asynchronous function with a returned promise that will be finished
    when the function completes. Also has the option to forward all async errors
@@ -266,7 +274,7 @@
 
 (defun jprint (db-result)
   "Pretty printer for JSON (mainly for database results)."
-  (yason:encode db-result (yason:make-json-output-stream *standard-output* :indent 2)))
+  (to-json db-result :indent 2))
 
 (defmacro with-test (&body body)
   "Makes testing async functions easier by abstracting an extremely common

lib/validation.lisp

@@ -33,7 +33,7 @@
           ;; check required fields
           (when (and (getf entry :required)
                      (not edit)
-                     (not obj-val))
+                     (not exists))
             (cond ((and default-val (symbolp default-val))
                    (setf obj-val (funcall default-val)))
                   (default-val
@@ -98,22 +98,27 @@
         (remhash key object))))
   nil)
 
-(defmacro defvalidator (name validation-form)
+(defmacro defvalidator (name validation-form &key old)
   "Makes defining a validation function for a data type simpler."
   `(progn
      (setf (getf *validation-forms* ',name) ',validation-form)
-     (defmacro ,name ((object future &key edit) &body body)
+     (defmacro ,name (,(append '(object)
+                               (when old '(future))
+                               '(&key edit))
+                       &body body)
        (let ((validation (gensym "validation"))
              (validation-form-var (gensym "validation-form"))
              (future-var (gensym "future")))
-         `(let* ((,future-var ,future)
+         `(let* ((,future-var ,(when ,old future))
                  (,validation-form-var (getf *validation-forms* ,'',name))
                  (,validation (do-validate ,object ,validation-form-var :edit ,edit)))
+            (declare (ignorable ,future-var))
             (if ,validation
-                (signal-error ,future-var (make-instance 'validation-failed
-                                                         :msg (format nil "Validation failed: ~s~%" ,validation)))
+                ,(if ,old
+                     `(signal-error ,future-var (make-instance 'validation-failed
+                                                              :msg (format nil "Validation failed: ~s~%" ,validation)))
+                     `(error 'validation-failed :msg (format nil "Validation failed: ~s~%" ,validation)))
                 (progn ,@body)))))))
-
 ;(defmacro defvalidator (name validation-form)
 ;  "Makes defining a validation function for a data type simpler."
 ;  `(progn

models/boards.lisp

@@ -3,8 +3,10 @@
 (defvalidator validate-board
   (("id" :type id :required t)
    ("user_id" :type id :required t)
+   ("parent_id" :type id)
    ("keys" :type sequence :required t :coerce simple-vector)
-   ("body" :type cl-async-util:bytes-or-string)))
+   ("body" :type cl-async-util:bytes-or-string))
+  :old t)
 
 (defafun populate-boards-data (future) (boards &key (get-privs t) get-notes get-personas)
   "Populate certain information given a list of boards."
@@ -32,9 +34,19 @@
             (finish future boards))))
       (finish future boards)))
 
-(defafun get-affected-users-from-board-ids (future) (board-ids)
+(adefun get-all-boards (user-id persona-ids)
+  "Given a user id and list of persona ids, get all boards this user has access
+   to."
+  (declare (ignore persona-ids))
+  ;; TODO: actually build this function out and make it useful. until then, we
+  ;; rely on old (and slow) tricks
+  (get-user-boards user-id :get-persona-boards t :get-personas t))
+
+(adefun get-affected-users-from-board-ids (board-ids)
   "For all given board-ids (list), find users that will be affected by changes
    to those boards or items in those boards. Returns a list of user-ids."
+  (unless board-ids
+    (return-from get-affected-users-from-board-ids))
   (alet* ((sock (db-sock))
           (query (r:r
                    (:attr
@@ -64,9 +76,9 @@
           (board-user-ids (r:to-array sock cursor))
           (nil (r:stop sock cursor)))
     (r:disconnect sock)
-    (finish future (concatenate 'vector shared-user-ids board-user-ids))))
+    (concatenate 'vector shared-user-ids board-user-ids)))
 
-(defafun get-user-boards (future) (user-id &key get-persona-boards get-notes get-personas)
+(adefun get-user-boards (user-id &key get-persona-boards get-notes get-personas)
   "Get all boards for a user."
   (alet* ((sock (db-sock))
           (query (r:r (:get-all
@@ -84,13 +96,15 @@
             (boards-populated (populate-boards-data all-boards
                                                     :get-notes get-notes
                                                     :get-personas get-personas)))
-      (finish future boards-populated))))
+      boards-populated)))
 
-(defafun get-all-user-board-ids (future) (user-id &key shared)
+(defafun get-all-user-board-ids (future) (user-id &key shared persona-ids)
   "Gets ALL a user's board IDs, with option to specify grabbing shared boards."
-  (alet* ((persona-ids (if shared
-                           (get-user-persona-ids user-id)
-                           #()))
+  (alet* ((persona-ids (if persona-ids
+                           persona-ids
+                           (if shared
+                               (get-user-persona-ids user-id)
+                               #())))
           (sock (db-sock)))
     (flet ((get-user-board-ids (append)
              (alet* ((query (r:r (:attr
@@ -116,6 +130,44 @@
             (r:stop sock cursor)
             (get-user-board-ids board-ids))))))
 
+(adefun get-user-board-perms (user-id &key min-perms)
+  "Grab all a users boards, including shared, with permissions."
+  (alet* ((persona-ids (get-user-persona-ids user-id))
+          (user-board-ids (get-all-user-board-ids user-id))
+          (sock (db-sock))
+          (qry (r:r (:pluck
+                      (:zip
+                        (:eq-join
+                          (:get-all
+                            (:table "boards_personas_link")
+                            (coerce persona-ids 'list)
+                            :index (db-index "boards_personas_link" "to"))
+                          "board_id"
+                          (:table "boards")))
+                      (list "user_id" "board_id" "perms"))))
+          (cursor (r:run sock qry))
+          (shared (r:to-array sock cursor))
+          (index (hash)))
+    (r:stop/disconnect sock cursor)
+    ;; set permissions for shared boards
+    (loop for entry across shared
+          for id = (gethash "board_id" entry)
+          for perms = (gethash "perms" entry) do
+      (when (or (not min-perms)
+                (<= min-perms perms))
+        (setf (gethash id index) (hash ("id" id)
+                                       ("owner" (gethash "user_id" entry))
+                                       ("perms" perms)))))
+    ;; set user-owned to the "owned" permission (3) in the index
+    (loop for id across user-board-ids
+          for perms = 3 do
+      (when (or (not min-perms)
+                (<= min-perms perms))
+        (setf (gethash id index) (hash ("id" id)
+                                       ("owner" user-id)
+                                       ("perms" perms)))))
+    index))
+
 (defafun get-persona-boards (future) (persona-id &key populate get-notes)
   "Get all boards for a persona."
   (alet* ((sock (db-sock))
@@ -177,7 +229,6 @@
 (defafun add-board (future) (user-id board-data)
   "Save a board with a user."
   (setf (gethash "user_id" board-data) user-id)
-  (add-id board-data)
   (let ((cid (gethash "cid" board-data)))
     (validate-board (board-data future)
       (alet* ((sock (db-sock))
@@ -260,7 +311,7 @@
 (defafun get-user-board-permissions (future) (user/persona-id board-id)
   "Returns an integer used to determine a user/persona's permissions for the
    given board.
-   
+
    0 == no permissions
    1 == read permissions
    2 == update permissions
@@ -388,7 +439,7 @@
     (finish future entry)))
 
 (defafun add-board-remote-invite (future) (user-id board-id from-persona-id invite-id permission-value to-email)
-  "Creates a remote (ie email) invite permission record on a board so the 
+  "Creates a remote (ie email) invite permission record on a board so the
    recipient of an invite can join the board without knowing what their account
    will be in advance."
   (alet* ((email (obscure-email to-email)))

models/email.lisp

@@ -89,7 +89,7 @@ Please respond in a timely manner!"))
           (finish future t)
           ;; error. grab the message and signal
           (let* ((res (babel:octets-to-string res))
-                 (hash (yason:parse res))
+                 (hash (jonathan:parse res :as :hash-table))
                  (msg (gethash "error" hash))
                  (msg (if (hash-table-p msg)
                           (gethash "message" msg)

models/feedback.lisp

@@ -3,7 +3,8 @@
 (defvalidator validate-feedback
   (("user_id" :type id :required t)
    ("email" :type string :required t)
-   ("body" :type string :required t)))
+   ("body" :type string :required t))
+  :old t)
 
 (defafun send-feedback (future) (user-id feedback-data)
   "Send feedback posted by a user to the proper channels (email, most likely)."

models/keychain.lisp

@@ -5,7 +5,8 @@
    ("user_id" :type id :required t)
    ("type" :type string :required t :max-length 24)
    ("item_id" :type string :required t)
-   ("body" :type string :required t)))
+   ("body" :type string :required t))
+  :old t)
 
 (defafun get-keychain-entry-by-id (future) (key-id)
   "Get a keychain entry by its id."
@@ -34,7 +35,6 @@
 (defafun add-keychain-entry (future) (user-id key-data)
   "Add a new keychain entry for the given user."
   (setf (gethash "user_id" key-data) user-id)
-  (add-id key-data)
   (validate-keychain-entry (key-data future)
     (alet* ((sock (db-sock))
             (query (r:r (:insert

models/messages.lisp

@@ -5,7 +5,8 @@
    ("from" :type id :required t)
    ("to" :type id :required t)
    ("keys" :type sequence :required t :coerce simple-vector)
-   ("data" :type cl-async-util:bytes-or-string)))
+   ("data" :type cl-async-util:bytes-or-string))
+  :old t)
 
 (defafun get-messages-by-persona (future) (persona-id &key (after "") (index "get_messages_to"))
   "Gets messages for a persona. If a message ID is specified for :after, will