Update index tree docs.

Update index tree docs.

--- src/merkle_db/index.clj
+++ src/merkle_db/index.clj
@@ -180,24 +180,22 @@
 ;; be at least half full.
 ;;
 ;; The root node may be:
+;;
 ;; - nil, indicating an empty tree.
 ;; - A partition, indicating that the tree has only a single node and fewer
 ;;   than `::partition/limit` records.
 ;; - An index, which is treated as the root node of the tree.
 ;;
-;; At each node, the update proceeds in a number of phases. The algorithm
-;; described below uses three terms for nodes:
-;; - The "parent" is the current top level node we're recursing on.
-;; - The "children" are the direct descendants of the parent node.
-;; - The "candidates" are changed but unstored descendant nodes.
-;;
 ;; The batch-update algorithm has the following goals:
+;;
 ;; - **Log scaling:** visit `O(log_b(n))` nodes for `n` nodes updated.
 ;; - **Minimize garbage:** avoid storing nodes which are not part of the final
 ;;   tree.
 ;; - **Deduplication:** reuse existing stored nodes where possible.
 ;;
-;; In the following diagrams, these symbols are used:
+;; In the following diagrams, these symbols are used to represent a tree with
+;; branching-factor of 4:
+;;
 ;; - `O` - unchanged index node
 ;; - `*` - candidate index node
 ;; - `+` - persisted index node
@@ -205,49 +203,52 @@
 ;; - `@` - persisted partition leaf
 ;; - `U` - underflowing partition leaf
 ;; - `x` - node which has had all children deleted
+;;
+;; Algorithm Phases:
+;;
+;; - divide changes (downward)
+;; - apply changes (to partition leaves)
+;; - carry orphans (upward/sideways)
+;; - redistribute children
+;; - serialize the tree
+

 ;; ### Divide Changes
 ;;
 ;; In the first **downward** phase, changes at the parent are grouped by the
 ;; child which links to the subtree containing the referenced keys.
 ;;
-;;     >        .[O].         [????|?????]
-;;             /     \
-;;            /       \
-;;           O        .O.
+;;     >       ..[O]..        [????|?????]
+;;            /       \
+;;           O        .O.
+;;          / \      / | \
+;;         O   O    O  O  O
+;;        /|\ / \  / \/|\/ \
+;;        ### # #  # ##### #
+;;
+;;             ...O...             |?????]
+;;            /       \
+;;     >    [O]       .O.     [??|???]
 ;;          / \      / | \
 ;;         O   O    O  O  O
 ;;        /|\  |\  / \/|\/ \
-;;       # # # # # # ##### #
-;;
-;;              ..O..              |?????]
-;;             /     \
-;;            /       \
-;;     >    [O]       .O.     [??|???]
-;;          / \      / | \
-;;         O   O    O  O  O
-;;        /|\  |\  / \/|\/ \
-;;       # # # # # # ##### #
-;;
-;;              ..O..              |?????]
-;;             /     \
+;;        ###  ##  # ##### #
+;;
+;;             ...O...             |?????]
 ;;            /       \
 ;;           O        .O.        |???]
 ;;          / \      / | \
 ;;     >  [O]  O    O  O  O   [?|?]
 ;;        /|\  |\  / \/|\/ \
-;;       # # # # # # ##### #
-;;
-;;              ..O..              |?????]
-;;             /     \
+;;        ###  ##  # ##### #
+;;
+;;             ...O...             |?????]
 ;;            /       \
 ;;           O        .O.        |???]
 ;;          / \      / | \
 ;;         O   O    O  O  O     |?]
 ;;        /|\  |\  / \/|\/ \
-;;     >[#]# # # # # ##### #  [?]
-
-,,,
+;;     >[#]##  ##  # ##### #  [?]

 ;; ### Apply Changes
@@ -258,20 +259,48 @@
 ;; number of children, meaning it can either underflow, be valid, or overflow,
 ;; depending on the changes applied.
 ;;
-;;              ..O..
-;;             /     \
+;; As an optimization when writing partitions out, keep the last-touched
+;; partition in memory until we're sure the next one won't need to be merged
+;; into it. If the last partition underflowed, hang onto it and merge in
+;; partitions until at least 150% of the partition limit has been reached, then
+;; emit a partition that is 75% full, leaving (at worst) another 75% full
+;; partition if there are no more adjacent to process.
+;;
+;; Here, updates have deleted one partition entirely and created an pair of
+;; partitions, which are merged and written out as a (still underflowing)
+;; partition.
+;;
+;;             ...O...
 ;;            /       \
 ;;           O        .O.
 ;;          / \      / | \
 ;;         O   O    O  O  O
 ;;        /|\  |\  /|\/|\/ \
-;;     > x x[U]# # ####### #
-;;
-;; When a node has only a single child, it is 'pulled' up the tree recursively
+;;     >  Ux[U]##  ####### #
+;;
+;;             ...O...
+;;            /       \
+;;           O        .O.
+;;          / \      / | \
+;;         O   O    O  O  O
+;;        / \  |\  /|\/|\/ \
+;;     > [U U] ##  ####### #
+;;
+;;             ...O...
+;;            /       \
+;;           O        .O.
+;;          / \      / | \
+;;         O   O    O  O  O
+;;         |   |\  /|\/|\/ \
+;;     >  [U]  ##  ####### #
+
+
+;; ### Carry Orphans
+;;
+;; When a node has only a single child, it is 'carried' up the tree recursively
 ;; so it can be passed down the next branch for merging into the next branch.
 ;;
-;;              ..O..
-;;             /     \
+;;             ...O...
 ;;            /       \
 ;;           O        .O.
 ;;          / \      / | \
@@ -279,30 +308,38 @@
 ;;             |\  /|\/|\/ \
 ;;             # # ####### #
 ;;
-;;              ..O..
-;;             /     \
-;;            /       \
-;;     >    [O](U)    .O.
+;;             ...O...
+;;            /       \
+;;     > (U)[O]       .O.
 ;;           |       / | \
 ;;           O      O  O  O
 ;;          / \    /|\/|\/ \
 ;;         #   #   ####### #
 ;;
-;; When a subtree is being passed to the next branch, and the current node's
-;; height is one more than the subtree root, insert it as a child of the
+;; When an orphaned subtree is being passed to the next branch, and the current
+;; node's height is one more than the subtree root, insert it as a child of the
 ;; current node:
 ;;
-;;              ..O..
-;;             /     \
+;;             ...O...
+;;            /       \
+;;           O        .O.
+;;           |       / | \
+;;     > (U)[*]     O  O  O
+;;          / \    /|\/|\/ \
+;;         #   #   ####### #
+;;
+;;             ...O...
 ;;            /       \
 ;;           O        .O.
 ;;           |       / | \
 ;;     >    [*]     O  O  O
 ;;          /|\    /|\/|\/ \
-;;        (U)# #   ####### #
-;;
-;;              ..O..
-;;             /     \
+;;         U # #   ####### #
+;;
+;; Apply updates to the remaining two partitions, deleting one and creating a
+;; second underflowing partition:
+;;
+;;             ...O...
 ;;            /       \
 ;;           O        .O.
 ;;           |       / | \
@@ -310,6 +347,118 @@
 ;;          /|\    /|\/|\/ \
 ;;     >   U x[U]  ####### #
 ;;
+;; Two underflowing partitions need to be merged into a valid partition:
+;;
+;;             ...O...
+;;            /       \
+;;           O        .O.
+;;           |       / | \
+;;           *      O  O  O
+;;           |     /|\/|\/ \
+;;     >  [->@<-]  ####### #
+;;
+;;             ...O...
+;;            /       \
+;;           O        .O.
+;;           |       / | \
+;;     >    [@]     O  O  O
+;;                 /|\/|\/ \
+;;                 ####### #
+;;
+;;             ...O...
+;;            /       \
+;;     >    [@]       .O.
+;;                   / | \
+;;                  O  O  O
+;;                 /|\/|\/ \
+;;                 ####### #
+;;
+;;     >     (@)[O]
+;;               |
+;;             ..O..
+;;            /  |  \
+;;           O   O   O
+;;          /|\ /|\ / \
+;;          ### ### # #
+;;
+;;               O
+;;               |
+;;     >    (@).[O].
+;;            /  |  \
+;;           O   O   O
+;;          /|\ /|\ / \
+;;          ### ### # #
+;;
+;;               O
+;;               |
+;;             ..O..
+;;            /  |  \
+;;     > (@)[O]  O   O
+;;          /|\ /|\ / \
+;;          ### ### # #
+;;
+;;               O
+;;               |
+;;             ..O..
+;;            /  |  \
+;;     >    [O]  O   O
+;;         //|\ /|\ / \
+;;         @### ### # #
+;;
+;;
+;;               O
+;;               |
+;;             ..O..
+;;            /  |  \
+;;           O   O   O
+;;         //|\ /|\ / \
+;;     >  @##[U]### # #
+;;
+;;              O
+;;              |
+;;            ..O..
+;;           /  |  \
+;;          O   O   O
+;;         /|\ /|\ / \
+;;     >  [@#@]### # #
+;;
+;;              O
+;;              |
+;;            ..O..
+;;           /  |  \
+;;     >   [*]  O   O
+;;         /|\ /|\ / \
+;;         @#@ ### # #
+;;
+;;              O
+;;              |
+;;     >      .[*].
+;;           /  |  \
+;;          *   O   O
+;;         /|\ /|\ / \
+;;         @#@ ### # #
+;;
+;; Fast forward, skipping a subtree...
+;;
+;;              O
+;;              |
+;;            ..*..
+;;           /  |  \
+;;     >    *   O  [O]
+;;         /|\ /|\ / \
+;;         @#@ ### # #
+;;
+;; Insert nodes into right subtree, resulting in splitting multiple partitions.
+;;
+;;              O
+;;              |
+;;           ...*...
+;;          /   |   \
+;;         *    O    *
+;;        /|\  /|\ //|\\
+;;     >  @#@  ###[#@@@@]
+
+
 ;; ### Redistribute Children
 ;;
 ;; In the **distribution** phase, any candidate children which have over or
@@ -323,160 +472,65 @@
 ;; to the pool to redistribute. Use the link after if the run includes the
 ;; first child.
 ;;
-;; Two underflowing partitions need to be merged, but still form an
-;; underflowing partition:
-;;
-;;              ..O..
-;;             /     \
-;;            /       \
-;;           O        .O.
-;;           |       / | \
-;;           *      O  O  O
-;;           |     /|\/|\/ \
-;;     >  [->U<-]  ####### #
-;;
-;;              ..O..
-;;             /     \
-;;            /       \
-;;           O        .O.
-;;           |       / | \
-;;     >    [U]     O  O  O
-;;                 /|\/|\/ \
-;;                 ####### #
-;;
-;;              ..O..
-;;             /     \
-;;            /       \
-;;     >    [U]       .O.
-;;                   / | \
-;;                  O  O  O
-;;                 /|\/|\/ \
-;;                 ####### #
-;;
-;;     >       [O](U)
-;;              |
-;;            ..O..
-;;           /  |  \
-;;          O   O   O
-;;         /|\ /|\ / \
-;;         ### ### # #
-;;
-;;              O
-;;              |
-;;     >      .[O]. (U)
-;;           /  |  \
-;;          O   O   O
-;;         /|\ /|\ / \
-;;         ### ### # #
-;;
-;;              O
-;;              |
-;;            ..O..
-;;           /  |  \
-;;     >   [O]  O   O
-;;        // \\/|\ / \
-;;        U# U@### # #
-;;
-;; Again, redistribute the records in the underflowing partitions.
-;;
-;;              O
-;;              |
-;;            ..O..
-;;           /  |  \
-;;          O   O   O
-;;         /|\ /|\ / \
-;;     >  [@@@]### # #
-;;
-;;              O
-;;              |
-;;            ..O..
-;;           /  |  \
-;;     >   [*]  O   O
-;;         /|\ /|\ / \
-;;         @@@ ### # #
-;;
-;;              O
-;;              |
-;;     >      .[*].
-;;           /  |  \
-;;          *   O   O
-;;         /|\ /|\ / \
-;;         @@@ ### # #
-;;
-;; Fast forward, deleting a subtree...
-;;
-;;              O
-;;              |
-;;            ..*..
-;;           /  |  \
-;;     >    *  [x]  O
-;;         /|\ /|\ / \
-;;     >   @@@[xxx]# #
-;;
-;; Insert nodes into right subtree, resulting in splitting multiple partitions.
-;;
-;;              O
-;;              |
-;;            ..*..
-;;           /     \
-;;          *       *
-;;         /|\    //|\\
-;;     >  @ @ @  [#@@@@]
-;;
-;; Back to distribution phase, fix overflow by splitting the node:
-;;              O
-;;              |
-;;            ..*..
-;;           /  |  \
-;;     >    *  [*   *]
-;;         /|\ / \ /|\
-;;         @@@ # @ @@@
-;;
-;;              *
-;;              |
-;;     >      .[*].
-;;           /  |  \
-;;          *   *   *
-;;         /|\ / \ /|\
-;;         @@@ # @ @@@
-;;
-;;     >       [*]
-;;              |
-;;            ..*..
-;;           /  |  \
-;;          *   *   *
-;;         /|\ / \ /|\
-;;         @@@ # @ @@@
-;;
-;; Now that we're back at the root, we can serialize out the resulting tree.
-;;
-;;              *
-;;              |
-;;     >      .[+].
-;;           /  |  \
-;;          +   +   +
-;;         /|\ / \ /|\
-;;         @@@ # @ @@@
+;;               O
+;;               |
+;;           ....*....
+;;          /   / \   \
+;;     >   *   O  [*   *]
+;;        /|\ /|\ / \ /|\
+;;        @#@ ### # @ @@@
+;;
+;;               *
+;;               |
+;;     >     ...[*]...
+;;          /   / \   \
+;;         *   O   *   *
+;;        /|\ /|\ / \ /|\
+;;        @#@ ### # @ @@@
+;;
+;;     >        [*]
+;;               |
+;;           ....*....
+;;          /   / \   \
+;;         *   O   *   *
+;;        /|\ /|\ / \ /|\
+;;        @#@ ### # @ @@@
+
+
+;; ### Serialize
+;;
+;; Now that we're back at the root, we can serialize out the resulting tree of
+;; index nodes. One branch is reused entirely from the original tree, since it
+;; hasn't been changed. All the partition leaves are serialized already at this
+;; point.
+;;
+;;               *
+;;               |
+;;     >     ...[+]...
+;;          /   / \   \
+;;     >  [+]  O  [+] [+]
+;;        /|\ /|\ / \ /|\
+;;        @#@ ### # @ @@@
 ;;
 ;; If the upward recursion reaches a branch with a single child, we're on a path
 ;; up to the root, so return the subtree directly, decreasing the height of the
 ;; tree.
 ;;
-;;     >       [*]
-;;              |
-;;            ..+..
-;;           /  |  \
-;;          +   +   +
-;;         /|\ / \ /|\
-;;         @@@ # @ @@@
+;;     >        [*]
+;;               |
+;;           ....+....
+;;          /   / \   \
+;;         +   O   +   +
+;;        /|\ /|\ / \ /|\
+;;        @#@ ### # @ @@@
 ;;
 ;; Resulting balanced tree:
 ;;
-;;            ..+..
-;;           /  |  \
-;;          +   +   +
-;;         /|\ / \ /|\
-;;         @@@ # @ @@@
+;;           ....+....
+;;          /   / \   \
+;;         +   O   +   +
+;;        /|\ /|\ / \ /|\
+;;        @#@ ### # @ @@@

 ;; ### References
@@ -549,3 +603,75 @@

 ; TODO: remove-range?
 ; TODO: drop-partition?
+
+
+
+
+
+;; TODO: what happens if the final child is orphaned?
+;;
+;;            ..*..
+;;           /  |  \
+;;     >    *   O  [O]
+;;         /|\ /|\ / \
+;;         @#@ ### # #
+;;
+;;            ..*..
+;;           /  |  \
+;;          *   O   O
+;;         /|\ /|\ / \
+;;     >   @#@ ###[x]#
+;;
+;;            ..*..
+;;           /  |  \
+;;          *   O   O
+;;         /|\ /|\  |
+;;     >   @#@ ### [#]
+;;
+;;            ..*..
+;;           /  |  \
+;;     >    *   O  [#]
+;;         /|\ /|\
+;;         @#@ ###
+;;
+;;     >      [*](#)
+;;           /   \
+;;          *     O
+;;         /|\   /|\
+;;         @#@   ###
+;;
+;; Higher-level node needs to recognize the orphan and do another pass down the
+;; (now final) child node:
+;;
+;;            .*.
+;;           /   \
+;;     >    *    [O](#)
+;;         /|\   /|\
+;;         @#@   ###
+;;
+;;            .*.
+;;           /   \
+;;     >    *    [*]
+;;         /|\  // \\
+;;         @#@  ## ##
+;;
+;; Say that node had been full:
+;;
+;;            .*.
+;;           /   \
+;;     >    *    [*]
+;;         /|\  //|\\
+;;         @#@  #####
+;;
+;;            ..*..
+;;           /  |  \
+;;     >    *  [*   *]
+;;         /|\ / \ /|\
+;;         @#@ # # ###
+;;
+;;     >      .[*].
+;;           /  |  \
+;;          *   *   *
+;;         /|\ / \ /|\
+;;         @#@ # # ###
+;;


Clean up patch ns a bit.

Clean up patch ns a bit.

--- src/merkle_db/patch.clj
+++ src/merkle_db/patch.clj
@@ -8,9 +8,7 @@
       [key :as key])))

-(def ^:const data-type
-  "Value of `:data/type` that indicates a tablet node."
-  :merkle-db/patch)
+;; ## Tombstones

 (def tombstone
   "Value which marks the deletion of a record."
@@ -18,13 +16,17 @@

 (defn tombstone?
-  "Returns true if the value x is a tombstone."
+  "Returns true if the value is a tombstone."
   [x]
   (identical? ::tombstone x))

 ;; ## Specs
+
+(def ^:const data-type
+  "Value of `:data/type` that indicates a patch tablet node."
+  :merkle-db/patch)

 ;; Maximum number of changes to allow in a patch tablet.
 (s/def ::limit pos-int?)
@@ -37,17 +39,25 @@
 (s/def ::changes
   (s/coll-of ::change-entry :kind vector?))

-;; Tablet node.
-(s/def :merkle-db/patch
-  (s/keys :req [::changes]))
+;; Patch tablet node data.
+(s/def ::node-data
+  (s/and
+    (s/keys :req [::changes])
+    #(= data-type (:data/type %))))
+
+
+
+;; ## Construction
+
+(defn from-changes
+  "Construct a patch tablet node data from a map of change data."
+  [changes]
+  {:data/type data-type
+   ::changes (vec changes)})

 ;; ## Utility Functions
-
-; (merge-patch patch-tablet pending) => patch-tablet
-; (apply-patch data-tree pending) => data-link
-

 (defn remove-tombstones
   "Returns a lazy sequence of record entries with tombstoned records removed."
@@ -56,7 +66,7 @@

 (defn filter-patch
-  "Takes a full set of patch data and returns a cleaned sequence based on the
+  "Takes a full set of patch data and returns a filtered sequence based on the
   given options."
   [patch opts]
   (when (seq patch)


Add :tags to State.

Add :tags to State.

--- src-cljs/pepa/data.cljs
+++ src-cljs/pepa/data.cljs
@@ -8,12 +8,13 @@
    [cljs.core.async.macros :refer [go-loop]]))

 (defrecord Page [id rotation render-status dpi])
-(defrecord Document [id title pages tags created modified notes])
-
-(defrecord State [documents navigation upload seqs])
+(defrecord Document [id title pages created modified notes])
+
+(defrecord State [documents navigation tags upload seqs])

 (defonce state (atom (map->State {:documents {}
                                   :navigation {:route :dashboard}
+                                  :tags {}
                                   :upload {}
                                   :ui/sidebars {}
                                   :seqs {}})))
@@ -76,7 +77,8 @@

 (defn sorted-tags [state]
   (->> (:tags state)
-       #_(remove (comp zero? val))
+       (om/value)
+       (remove (comp zero? val))
        (sort-by val >)
        (mapv key)))


rewrite QS endpoint that wasn't using defendpoint

--- src/metabase/api/qs.clj
+++ src/metabase/api/qs.clj
@@ -33,15 +33,15 @@
     (build-response query-execution)))

-(def query-result-csv
-  (GET "/:uuid/csv" [uuid]
-    (let-404 [{:keys [result_data] :as query-execution} (eval `(sel :one ~all-fields :uuid ~uuid))]
-      {:status 200
-       :body (with-out-str (csv/write-csv *out* (into [(:columns result_data)] (:rows result_data))))
-       :headers {"Content-Type" "text/csv", "Content-Disposition" (str "attachment; filename=\"query_result_" (now-iso8601) ".csv\"")}})))
+(defendpoint GET "/:uuid/csv" [uuid]
+  (let-404 [{{:keys [columns rows]} :result_data} (sel :one all-fields :uuid uuid)]
+    {:status 200
+     :body (with-out-str
+             (csv/write-csv *out* (into [columns] rows)))
+     :headers {"Content-Type" "text/csv"
+               "Content-Disposition" (str "attachment; filename=\"query_result_" (now-iso8601) ".csv\"")}}))

-
-(define-routes query-result-csv)
+(define-routes)

 ;; ===============================================================================================================


fix handling of btn's internal state on stop

--- src/metronome/core.cljs
+++ src/metronome/core.cljs
@@ -98,18 +98,23 @@
     (render-state [_ {:keys [tempo-channel should-stop]}]
                   (dom/button #js {:className "btn btn-default btn-lg btn-block btn-tap-tempo"
                                    :onClick (fn []
-                                              (let [m (millis)]
-                                                (when-let [previous-click (om/get-state owner :previous-click)]
-                                                  (let [interval (- m previous-click)
-                                                        previous-interval (om/get-state owner :previous-interval)]
-                                                    (when (or
-                                                            (nil? previous-interval)
-                                                            (and
-                                                              (> interval (* 0.8 previous-interval))
-                                                              (< interval (* 1.2 previous-interval))))
-                                                      (put! tempo-channel (if (om/get-state owner :should-stop) false interval)))
-                                                    (om/set-state! owner :previous-interval interval)))
-                                                (om/set-state! owner :previous-click m)))}
+                                              (if (om/get-state owner :should-stop)
+                                                (do
+                                                  (om/set-state! owner :previous-click nil)
+                                                  (om/set-state! owner :previous-interval nil)
+                                                  (put! tempo-channel false))
+                                                (let [m (millis)]
+                                                  (when-let [previous-click (om/get-state owner :previous-click)]
+                                                    (let [interval (- m previous-click)
+                                                          previous-interval (om/get-state owner :previous-interval)]
+                                                      (when (or
+                                                              (nil? previous-interval)
+                                                              (and
+                                                                (> interval (* 0.8 previous-interval))
+                                                                (< interval (* 1.2 previous-interval))))
+                                                        (put! tempo-channel interval))
+                                                      (om/set-state! owner :previous-interval interval)))
+                                                  (om/set-state! owner :previous-click m))))}
                               (if should-stop "stop" "tap tempo")))))

 (defn dots [meter owner]


fix typo

fix typo

--- test/bifurcan/durable_benchmark_test.clj
+++ test/bifurcan/durable_benchmark_test.clj
@@ -274,7 +274,7 @@
         false))
     (DurableEncodings$Codec/undelimited
       (u/->bi-consumer
-        (fn [^DurableInput n ^DurableOutput out]
+        (fn [^DurableInput in ^DurableOutput out]
           (.transferFrom out (-> in .duplicate (.seek 0)))))
       (u/->bi-fn
         (fn [^DurableInput in root]


Add test for request via :get method.

Add test for request via :get method.

--- test/catacumba/handlers_postal_tests.clj
+++ test/catacumba/handlers_postal_tests.clj
@@ -6,6 +6,7 @@
             [byte-streams :as bs]
             [manifold.deferred :as md]
             [promissum.core :as p]
+            [buddy.core.codecs :as codecs]
             [cats.core :as m]
             [cats.monad.exception :as exc]
             [catacumba.core :as ct]
@@ -27,16 +28,21 @@
     (pc/decode data :application/transit+json)))

 (defn- send-raw-frame
-  [uri frame content-type]
+  [uri method frame content-type]
   (let [headers {"content-type" content-type}]
-    (http/put uri {:body frame :headers headers})))
+    (condp = method
+      :put (http/put uri {:body frame :headers headers})
+      :get (http/get (str uri "?d=" (codecs/bytes->safebase64 frame))
+                     {:headers headers}))))

 (defn- send-frame
-  [uri frame]
-  (let [data (pc/encode frame :application/transit+json)]
-    @(md/chain
-      (send-raw-frame uri data "application/transit+json")
-      response->frame)))
+  ([uri frame]
+   (send-frame uri frame :put))
+  ([uri frame method]
+   (let [data (pc/encode frame :application/transit+json)]
+     @(md/chain
+       (send-raw-frame uri method data "application/transit+json")
+       response->frame))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Helpers
@@ -61,7 +67,7 @@
   (with-server {:handler (pc/router (constantly {}))}
     (let [frame (pr-str {:type :query :data nil})
           response (exc/try-on
-                    @(send-raw-frame base-url frame "application/edn"))]
+                    @(send-raw-frame base-url :put frame "application/edn"))]
       (is (exc/failure? response))
       (let [response (m/extract response)
             data (ex-data response)]
@@ -104,3 +110,11 @@
         (is (= (:type response) :response))
         (is (= (:data response) {:foo [1]}))))))

+(deftest request-using-get-method-spec
+  (letfn [(handler [context frame]
+            {:data frame})]
+    (with-server {:handler (pc/router handler)}
+      (let [frame {:type :query :data nil}
+            response (send-frame base-url frame :get)]
+        (is (= (:type response) :response))
+        (is (= (:data response) frame))))))


Test rfe start!

Test rfe start!

--- test/cljs/reitit/frontend/easy_test.cljs
+++ test/cljs/reitit/frontend/easy_test.cljs
@@ -12,6 +12,8 @@
                        ["foo" ::foo]
                        ["bar/:id" ::bar]]))

+;; TODO: Only tests fragment history, also test HTML5?
+
 (deftest easy-history-routing-test
   (when browser
     (gevents/removeAll js/window goog.events.EventType.POPSTATE)
@@ -24,7 +26,8 @@
                     (fn on-navigate [match history]
                       (let [url (rfh/-get-path history)]
                         (case (swap! n inc)
-                          1 (do (is (= "/" url)
+                          1 (do (is (some? (:popstate-listener history)))
+                                (is (= "/" url)
                                     "start at root")
                                 (rfe/push-state ::foo))
                           2 (do (is (= "/foo" url)
@@ -41,7 +44,24 @@
                                 (.back js/window.history))
                           6 (do (is (= "/" url)
                                     "go back after replace state")
-                                (rfh/stop! @rfe/history)
-                                (done))
-                          (is false "extra event"))))
+
+                                ;; Reset to ensure old event listeners aren't called
+                                (rfe/start! router
+                                            (fn on-navigate [match history]
+                                              (let [url (rfh/-get-path history)]
+                                                (case (swap! n inc)
+                                                  7 (do (is (= "/" url)
+                                                            "start at root")
+                                                        (rfe/push-state ::foo))
+                                                  8 (do (is (= "/foo" url)
+                                                            "push-state")
+                                                        (rfh/stop! @rfe/history)
+                                                        (done))
+                                                  (do
+                                                    (is false (str "extra event 2" {:n @n, :url url}))
+                                                    (done)))))
+                                            {:use-fragment true}))
+                          (do
+                            (is false (str "extra event 1" {:n @n, :url url}))
+                            (done)))))
                     {:use-fragment true})))))


(PDB-4934) Use connection-user for write DB pools.

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -772,11 +772,16 @@
             :let [config (get databases name)
                   pool-name (if (::conf/unnamed config)
                               "PDBWritePool"
-                              (str "PDBWritePool: " name))]]
+                              (str "PDBWritePool: " name))
+                  connection-username (:connection-username config)
+                  connection-password (:connection-password config)
+                  ]]
       (swap! pools conj
              (-> config
                  (assoc :pool-name pool-name
-                        :expected-schema desired-schema)
+                        :expected-schema desired-schema
+                        :user connection-username
+                        :password connection-password)
                  (jdbc/pooled-datasource database-metrics-registry))))
     {:write-db-names db-names
      :write-db-cfgs (mapv #(get databases %) db-names)


(PDB-4808) Validate the read-db at startup; migrate all write dbs

Rework the datbase initialization process to validate the
[read-database] too, and to migrate all write dbs.  (Though migrations
are still disallowed when multiple databses are specified.)

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -442,10 +442,9 @@
   "Verifies that the available database version is acceptable.  Throws
   {:kind ::unsupported-database :current version :oldest version} if
   the current database is not supported."
-  [config]
+  [min-version-override]
   (let [{current :version :as meta} (sutils/db-metadata)
-        oldest (get-in config [:database :min-required-version]
-                       scf-store/oldest-allowed-db)
+        oldest (or min-version-override scf-store/oldest-allowed-db)
         supported scf-store/oldest-supported-db]
     (when (neg? (compare current oldest))
       (throw (ex-info "Database version too old"
@@ -459,31 +458,32 @@
                      (first supported))))
     meta))

-(defn require-valid-db
-  [config]
-  (verify-database-version config)
+(defn require-valid-db-server
+  [min-version-override]
+  (verify-database-version min-version-override)
   (verify-database-settings (request-database-settings)))

 (defn require-current-schema
-  []
+  [msg]
   (require-valid-schema)
   (when-let [pending (seq (pending-migrations))]
-    (let [m (str
-             (trs "Database is not fully migrated and migration is disallowed.")
-             (trs "  Missing migrations: {0}" (mapv first pending)))]
+    (let [m (str msg (trs "  Missing migrations: {0}" (mapv first pending)))]
       (throw (ex-info m {:kind ::migration-required
                          :pending pending})))))

+(defn require-valid-db [min-version-override]
+  (require-valid-db-server min-version-override)
+  (require-current-schema (trs "Database is not fully migrated.")))
+
 (defn prep-db
-  [datasource config]
-  (jdbc/with-db-connection datasource
-    (require-valid-db config)
-    (if (get-in config [:database :migrate])
-      (let [{{:keys [username migrator-username]} :database} config]
-        (if (= username migrator-username)
-          (initialize-schema)
-          (initialize-schema username (jdbc/current-database))))
-      (require-current-schema))))
+  [{:keys [username migrator-username migrate min-required-version]}]
+  (require-valid-db-server min-required-version)
+  (if migrate
+    (if (= username migrator-username)
+      (initialize-schema)
+      (initialize-schema username (jdbc/current-database)))
+    (require-current-schema
+     (trs "Database is not fully migrated and migration is disallowed."))))

 (defn- require-db-connection-as [datasource migrator]
   (jdbc/with-db-connection datasource
@@ -500,23 +500,26 @@
 (defn init-with-db
   "Performs all initialization operations requiring a database
   connection using a transient connection pool derived from the
-  `write-db-config`.  Blocks until the initialization is complete, and
+  db-config.  Blocks until the initialization is complete, and
   then returns an unspecified value.  Throws exceptions on errors.
   Throws {:kind ::unsupported-database :current version :oldest
   version} if the current database is not supported. Throws
   {:kind ::invalid-database-configuration :failed-validation failed-map}
   if the database contains a disallowed setting."
-  [write-db-config config]
+  [db-name db-config]
   ;; A C-c (SIGINT) will close the pool via the shutdown hook, which
   ;; will then cause the pool connection to throw a (generic)
   ;; SQLException.
-  (let  [migrator (:migrator-username write-db-config)]
-    (with-open [db-pool (-> (assoc write-db-config
-                                   :pool-name "PDBMigrationsPool"
+  (log/info (trs "Ensuring {0} database is up to date" name))
+  (let  [migrator (:migrator-username db-config)]
+    (with-open [db-pool (-> (assoc db-config
+                                   :pool-name (if db-name
+                                                (str "PDBMigrationsPool: " db-name)
+                                                "PDBMigrationsPool")
                                    :connection-timeout 3000
                                    :rewrite-batched-inserts "true"
                                    :user migrator
-                                   :password (:migrator-password write-db-config))
+                                   :password (:migrator-password db-config))
                             (jdbc/make-connection-pool database-metrics-registry))]
       (let [runtime (Runtime/getRuntime)
             on-shutdown (doto (Thread.
@@ -533,7 +536,8 @@
             (let [result (try
                            (let [datasource {:datasource db-pool}]
                              (require-db-connection-as datasource migrator)
-                             (prep-db datasource config))
+                             (jdbc/with-db-connection datasource
+                               (prep-db db-config)))
                            true
                            (catch java.sql.SQLTransientConnectionException ex
                              ;; When coupled with the 3000ms timout, this
@@ -586,7 +590,7 @@
 ;; FIXME: with-logged-ex...

 (defn coordinate-gc-with-shutdown
-  [write-db clean-lock database request stop-status]
+  [write-db clean-lock config request stop-status]
   ;; This function assumes it will never be called concurrently with
   ;; itself, so that it's ok to just conj/disj below, instead of
   ;; tracking an atomic count or similar.
@@ -600,7 +604,7 @@
     (try
       (when (get-in (swap! stop-status update-if-not-stopping)
                     [:collecting-garbage thread])
-        (collect-garbage write-db clean-lock database request))
+        (collect-garbage write-db clean-lock config request))
       (catch Exception ex
         (log/error ex)
         (throw ex))
@@ -623,9 +627,9 @@
     (async/>!! cmd-event-ch (queue/make-cmd-event cmdref kind))))

 (defn check-schema-version
-  [desired-version context db service request-shutdown]
+  [desired-version stop-status db service request-shutdown]
   {:pre [(integer? desired-version)]}
-  (when-not (:stopping @(:stop-status context))
+  (when-not (:stopping @stop-status)
     (let [schema-version (-> (jdbc/with-transacted-connection db
                                (jdbc/query "select max(version) from schema_migrations"))
                              first
@@ -713,8 +717,9 @@
   (doseq [[{:keys [schema-check-interval] :as cfg} db] (map vector db-configs db-pools)
           :when (pos? schema-check-interval)]
     (interspaced schema-check-interval
-                 #(check-schema-version (desired-schema-version) context db
-                                        service request-shutdown)
+                 #(check-schema-version (desired-schema-version)
+                                        (:stop-status context)
+                                        db service request-shutdown)
                  job-pool)))

 (defn start-garbage-collection
@@ -763,7 +768,11 @@
          (ex-info "Currently unable to migrate multiple databases (see config)"
                   {:kind ::must-migrate-multiple-databases}))))

-    (init-with-db database config)
+    (conf/reduce-section
+     (fn [_ name settings]
+       (init-with-db name settings))
+     nil
+     database)

     (if upgrade-and-exit?
       context
@@ -773,6 +782,10 @@
                                       :read-only? true)
                                (jdbc/pooled-datasource database-metrics-registry))
                    :error .close
+
+                   _ (jdbc/with-db-connection read-db
+                       (require-valid-db
+                        (get-in config [:database :min-required-version])))

                    {:keys [command-chan command-loader dlo q]}
                    (init-queue config maybe-send-cmd-event! cmd-event-ch)


(PE-2329) factor-out 'handle-duplicate!' function

--- src/puppetlabs/trapperkeeper/plugins.clj
+++ src/puppetlabs/trapperkeeper/plugins.clj
@@ -20,25 +20,31 @@
     ;; lein includes project.clj ... no thank you
     (not (= name "project.clj"))))

+(defn- handle-duplicate!
+  "Helper for `process-file`; handles a found duplicate.  Throws an exception
+  if the duplicate is a .class or .clj file.  Otherwise, logs a warning and
+  returns the accumulator."
+  [container-filename acc filename]
+  (let [error-msg (str "Class or namespace " filename " found in both "
+                       container-filename " and " (acc filename))]
+    (if (or (.endsWith filename ".class") (.endsWith filename ".clj"))
+      (throw (IllegalArgumentException. error-msg))
+
+      ;; It is common to have other conflicts (besides classes and clojure
+      ;; namespaces), especially during development (for example,
+      ;; jetty-servlet and jetty-http both contain an `about.html` -
+      ;; these conflicts don't exist in the uberjar anyway,
+      ;; and likely aren't important.
+      (log/warn error-msg)))
+  acc)
+
 (defn- process-file
   "Helper for `process-container`.  Processes a file and adds it to the
   accumulator if it is a .class or .clj file we care about."
   [container-filename acc filename]
   (if (should-process? filename)
     (if (contains? acc filename)
-      (let [error-msg (str "Class or namespace " filename " found in both "
-                           container-filename " and " (acc filename))]
-        (if (or (.endsWith filename ".class") (.endsWith filename ".clj"))
-          (throw (IllegalArgumentException. error-msg))
-
-          ;; It is common to have other conflicts (besides classes and clojure
-          ;; namespaces), especially during development (for example,
-          ;; jetty-servlet and jetty-http both contain an `about.html` -
-          ;; these conflicts don't exist in the uberjar anyway,
-          ;; and likely aren't important, so just warn instead of throwing
-          (do
-            (log/warn error-msg)
-            acc)))
+      (handle-duplicate! container-filename acc filename)
       (assoc acc filename container-filename))
     acc))


Test path extraction SPARQL query

Test path extraction SPARQL query

--- test/rdf_path_examples/examples_test.clj
+++ test/rdf_path_examples/examples_test.clj
@@ -1,6 +1,7 @@
 (ns rdf-path-examples.examples-test
   (:require [rdf-path-examples.examples :as examples]
             [rdf-path-examples.json-ld :refer [json-ld->rdf-model]]
+            [rdf-path-examples.util :refer [resource->string]]
             [stencil.core :refer [render-file]]
             [clojure.tools.logging :as log]
             [clojure.test :refer :all]
@@ -34,6 +35,8 @@
     (valid-sparql-query? query)))

 (deftest preprocess-path
+  (is (valid-sparql-query? (resource->string "sparql/extract_path.rq"))
+      "SPARQL query for extracting paths is syntactically valid.")
   (let [preprocessed-path (examples/preprocess-path valid-path)]
     (is (= preprocessed-path {:path [{:start {:first true
                                               :type "http://purl.org/goodrelations/v1#BusinessEntity"


add asphalt-default benchmark to the comparison suite

--- perf/asphalt/test/perf.clj
+++ perf/asphalt/test/perf.clj
@@ -22,6 +22,7 @@

 (use-fixtures :once (c/make-bench-wrapper ["clojure.java.jdbc"
                                            "Asphalt-SQL"
+                                           "Asphalt-template-default"
                                            "Asphalt-template-unrolled"
                                            "Asphalt-template-runtime"]
                       {:chart-title "Clojure.java.jdbc vs Asphalt"
@@ -50,6 +51,15 @@
 (a/defsql t-insert "INSERT INTO emp (name, salary, dept) VALUES (^string $name, ^int $salary, ^string $dept)")
 (a/defsql t-delete "DELETE FROM emp")
 (a/defsql t-select "SELECT ^string name, ^int salary, ^string dept FROM emp")
+
+
+(def u-insert (assoc t-insert
+                :param-setter (p/make-params-layer [:name :salary :dept] [:string :int :string])))
+(def u-delete (assoc t-delete
+                :param-setter (p/make-params-layer [] [])))
+(def u-select (assoc t-select
+                :param-setter (p/make-params-layer [] [])
+                :row-maker    (r/make-columns-reader [:string :int :string])))

 (def r-insert (assoc t-insert
@@ -89,6 +99,9 @@
              (a/update conn t-insert data)
              (a/update conn t-delete nil))
            (do
+             (a/update conn u-insert data)
+             (a/update conn u-delete nil))
+           (do
              (a/update conn r-insert data)
              (a/update conn r-delete nil))))))))

@@ -107,6 +120,7 @@
             (first (jdbc/query db-con [s-select]))
             (first (a/query a/fetch-maps conn s-select nil))
             (first (a/query a/fetch-maps conn t-select nil))
+            (first (a/query a/fetch-maps conn u-select nil))
             (first (a/query a/fetch-maps conn r-select nil)))))
       ;; bench c.j.j `:as-arrays? true` with asphalt
       (jdbc/with-db-connection [db-con db-spec]
@@ -115,6 +129,7 @@
             (first (jdbc/query db-con [s-select] {:as-arrays? true}))
             (a/query a/fetch-single-row conn s-select nil)
             (a/query a/fetch-single-row conn t-select nil)
+            (a/query a/fetch-single-row conn u-select nil)
             (a/query a/fetch-single-row conn r-select nil)))))))

@@ -133,6 +148,7 @@
             (jdbc/query db-con [s-select])
             (a/query a/fetch-maps conn s-select nil)
             (a/query a/fetch-maps conn t-select nil)
+            (a/query a/fetch-maps conn u-select nil)
             (a/query a/fetch-maps conn r-select nil))))
       ;; bench c.j.j `:as-arrays? true` with asphalt
       (jdbc/with-db-connection [db-con db-spec]
@@ -141,4 +157,5 @@
             (jdbc/query db-con [s-select] {:as-arrays? true})
             (a/query a/fetch-rows conn s-select nil)
             (a/query a/fetch-rows conn t-select nil)
+            (a/query a/fetch-rows conn u-select nil)
             (a/query a/fetch-rows conn r-select nil)))))))


Buuug!

Buuug!

--- src/newswheel/core.cljs
+++ src/newswheel/core.cljs
@@ -6,7 +6,7 @@
             [sablono.core :as html :refer-macros [html]]
             [newswheel.components.circleview :as circleview]
             [newswheel.components.reader :as reader]
-            ))
+            )
   (:import [goog.net Jsonp]
            [goog Uri]))


Maintaible generate-measurement-pair

Maintaible generate-measurement-pair

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -650,7 +650,8 @@
         measurement (generate-measurement-f unit)]
     [measurement (measurement-as-f measurement (first (remove (partial = unit) units)))]))

-(generate-measurement-pair #{:bpm :m3-per-min} rand-slurry-rate-unit typical-slurry-rate slurry-rate-as)
+(generate-measurement-pair (set (quantity-unit-map :slurry-rate))
+                           rand-slurry-rate-unit typical-slurry-rate slurry-rate-as)

 (defn rand-measurement
   ([]


Correct slurry-rate-as

Correct slurry-rate-as

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -17,18 +17,25 @@
 (defn rand-physical-quantity []
   (rand-nth physical-quantities))

+(def quantity-unit-map {:density                [:lb-per-cu-ft :kg-per-m3]
+                        :energy                 [:ft-lb :J]
+                        :force                  [:lbf :N]
+                        :length                 [:ft :m]
+                        :mass                   [:lb :kg]
+                        :power                  [:hp :W]
+                        :pressure               [:psi :kPa]
+                        :proppant-concentration [:lb-per-gal :kg-per-m3]
+                        :temperature            [:F :C]
+                        :slurry-rate            [:bpm :m3-per-min]
+                        :volume                 [:bbl :m3]})
+
+
 (defn rand-unit [physical-quantity]
-  (let [quantity-units-map {:density                [:lb-per-cu-ft :kg-per-m3]
-                            :energy                 [:ft-lb :J]
-                            :force                  [:lbf :N]
-                            :length                 [:ft :m]
-                            :mass                   [:lb :kg]
-                            :power                  [:hp :W]
-                            :proppant-concentration [:lb-per-gal :kg-per-m3]
-                            :slurry-rate            [:bpm :m3-per-min]
-                            :volume                 [:bbl :m3]
-                            :temperature            [:F :C]}]
-    (fn [] (rand-nth (get quantity-units-map physical-quantity)))))
+  (rand-nth (get quantity-unit-map physical-quantity)))
+
+(repeatedly 25 (fn [] (let [physical-quantity (rand-physical-quantity)]
+                        [physical-quantity (rand-unit physical-quantity)])))
+

 (def rand-density-unit (rand-unit :density))
 (def rand-energy-unit (rand-unit :energy))
@@ -85,7 +92,7 @@
 (def power-as (as-f :hp :W 745.69987158227022))
 (def pressure-as (as-f :psi :kPa 6.894757293168361))
 (def proppant-concentration-as (as-f :lb-per-gal :kg-per-m3 119.826))
-(def slurry-rate-as (as-f :bpm :m3-per-min 6.28981077))
+(def slurry-rate-as (as-f :m3-per-min :bpm 6.28981077))

 ;; Because conversion between temperature units is not simply multiplicative, I define this function with a
 ;; unique body.
@@ -633,4 +640,4 @@
         measurement (generate-measurement-f unit)]
     [measurement (measurement-as-f measurement (first (remove (partial = unit) units)))]))

-(generate-measurement-pair #{:lb-per-cu-ft :kg-per-m3} rand-density-unit typical-density density-as)
+(generate-measurement-pair #{:bpm :m3-per-min} rand-slurry-rate-unit typical-slurry-rate slurry-rate-as)


Whitespace cleanup

Whitespace cleanup

--- clojure/basic_types.clj
+++ clojure/basic_types.clj
@@ -10,7 +10,5 @@
 (is (= (type nil) nil))
 (is (= (type 'dog) clojure.lang.Symbol))
 (is (= (type :dog) clojure.lang.Keyword))
-
-; And of course....
 (is (= (type Long) java.lang.Class))
 (is (= (type java.lang.Class) java.lang.Class))


fix test-task-metadata->pod unit test (#1371)

* fix test-task-metadata->pod

* pr feedback

--- scheduler/test/cook/test/kubernetes/api.clj
+++ scheduler/test/cook/test/kubernetes/api.clj
@@ -76,24 +76,26 @@
         (is (< 0 (-> pod .getSpec .getSecurityContext .getRunAsGroup)))
         (is (< 0 (-> pod .getSpec .getSecurityContext .getRunAsUser)))

-        (let [workdir-volume (->> pod
+        (let [cook-workdir-volume (->> pod
                                   .getSpec
                                   .getVolumes
-                                  (filter (fn [^V1Volume v] (= "cook-workdir" (.getName v))))
+                                  (filter (fn [^V1Volume v] (= "cook-workdir-volume" (.getName v))))
                                   first)]
-          (is (not (nil? (.getEmptyDir workdir-volume)))))
+          (is (not (nil? cook-workdir-volume)))
+          (is (not (nil? (.getEmptyDir cook-workdir-volume)))))

         (let [^V1Container container (-> pod .getSpec .getContainers first)]
           (is (= "required-cook-job-container" (.getName container)))
           (is (= ["/bin/sh" "-c" "foo && bar"] (.getCommand container)))
           (is (= "alpine:latest" (.getImage container)))
-          (is (= 3 (count (.getEnv container))))
+          (is (not (nil? container)))
+          (is (= 4 (count (.getEnv container))))
           (is (= "/mnt/sandbox" (.getWorkingDir container)))
-          (let [workdir-mount (->> container
+          (let [cook-workdir-mount (->> container
                                    .getVolumeMounts
-                                   (filter (fn [^V1VolumeMount m] (= "cook-workdir" (.getName m))))
+                                   (filter (fn [^V1VolumeMount m] (= "cook-workdir-volume" (.getName m))))
                                    first)]
-            (is (= "/mnt/sandbox" (.getMountPath workdir-mount))))
+            (is (= "/mnt/sandbox" (.getMountPath cook-workdir-mount))))

           (assert-env-var-value container "FOO" "BAR")
           (assert-env-var-value container "HOME" (.getWorkingDir container))


Rename to avoid shadowing

Rename to avoid shadowing