Improve peer property testing

Improve peer property testing

Refactors peer property testing to allow for new features / multiple
jobs /better command generation and more.

--- test/onyx/peer/deterministic_peer_test.clj
+++ test/onyx/peer/deterministic_peer_test.clj
@@ -3,21 +3,83 @@
             [onyx.test-boilerplate :refer [build-job run-test-job]]
             [onyx.test-helper :refer [load-config with-test-env add-test-env-peers!]]

+            [clojure.data :refer [diff]]
+            [onyx.plugin.null]
+            [clojure.core.async]
+            [com.stuartsierra.dependency :as dep]
+            [onyx.messaging.messenger :as m]
+            [onyx.log.commands.common :refer [peer->allocated-job]]
             [onyx.log.replica :refer [base-replica]]
             [onyx.monitoring.no-op-monitoring :refer [no-op-monitoring-agent]]
             [onyx.extensions :as extensions]
             [onyx.messaging.immutable-messenger :as im]
-            ;; TODO: remove in favour of immutable messenger which needs assign-task-resources impl
-            [onyx.messaging.dummy-messenger]

             [com.stuartsierra.component :as component]
             [onyx.static.planning :as planning]
             [onyx.peer.task-lifecycle :as tl]

+            [clojure.test.check.clojure-test :refer [defspec]]
+            [clojure.test.check :as tc]
+            [clojure.test.check.generators :as gen]
+            [clojure.test.check.properties :as prop]
+            [com.gfredericks.test.chuck :refer [times]]
+            [com.gfredericks.test.chuck.clojure-test :refer [checking for-all]]
+
+            [taoensso.timbre :refer [fatal info debug] :as timbre]
             [onyx.api]))

-(defn my-inc [{:keys [n] :as segment}]
-  (assoc segment :n (inc n)))
+;; Job generator code
+(def gen-task-name (gen/fmap #(keyword (str "t" %)) gen/s-pos-int))
+
+(defn task->type [graph task]
+  (cond (empty? (dep/immediate-dependents graph task))
+        :output
+        (empty? (dep/immediate-dependencies graph task))
+        :input
+        :else
+        :function))
+
+(defn to-dependency-graph-safe [workflow]
+  (reduce (fn [[g wf] edge]
+            (try
+              [(apply dep/depend g (reverse edge))
+               (conj wf edge)]
+              (catch Throwable t
+                [g wf])))
+          [(dep/graph) []]
+          workflow))
+
+(def build-workflow-gen
+  (gen/fmap (fn [workflow]
+              (let [[g wf] (to-dependency-graph-safe workflow)]
+                {:workflow wf
+                 :task->type (->> wf
+                                  (reduce into [])
+                                  (map (fn [t] [t (task->type g t)])))}))
+            (gen/such-that (complement empty?)
+                           (gen/vector (gen/such-that #(not= (first %) (second %))
+                                                      (gen/tuple gen-task-name gen-task-name))))))
+
+;;;;;;;;;
+;; Job code
+
+(defn add-path [job-id task-id {:keys [n] :as segment}]
+  (update segment :path conj [job-id task-id]))
+
+(def add-paths-calls
+  {:lifecycle/before-task-start
+   (fn [event lifecycle]
+     {:params [(:job-id event) (:task event)]})})
+
+(defn add-paths-lifecycles [job]
+  (update job
+          :lifecycles
+          conj
+          {:lifecycle/task :all
+           :lifecycle/calls ::add-paths-calls}))
+
+;;;;;;;;;
+;; Runner code

 (defn start-task [job peer-config discovered-task job-id task-id peer-id]
   (let [task-information (-> job
@@ -35,103 +97,343 @@
                              ;; To be assoc'd each run
                              :replica nil
                              :opts peer-config
-
-                             :restart-ch nil
-                             :kill-ch nil
-                             :outbox-ch nil
-                             :task-kill-ch nil
+                             :restart-ch :restart-ch
+                             :kill-ch :kill-ch
+                             :outbox-ch :outbox-ch
+                             :task-kill-ch :task-kill-ch
                              :scheduler-event :FIXME_USE_LOG_EVENT
                              :task-monitoring (no-op-monitoring-agent)
                              :task-information task-information}))))

-(def log
-  [{:fn :prepare-join-cluster, :args {:joiner #uuid "9e258df9-973f-4029-b7c8-a4937c006482", :peer-site {}, :tags []}, :message-id 0, :created-at 1463164641131} {:fn :prepare-join-cluster, :args {:joiner #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea", :peer-site {}, :tags []}, :message-id 1, :created-at 1463164641142} {:fn :notify-join-cluster, :args {:observer #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea"}, :peer-parent #uuid "9e258df9-973f-4029-b7c8-a4937c006482", :entry-parent 1, :message-id 2, :created-at 1463164641144} {:fn :accept-join-cluster, :args {:observer #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea", :subject #uuid "9e258df9-973f-4029-b7c8-a4937c006482", :accepted-observer #uuid "9e258df9-973f-4029-b7c8-a4937c006482", :accepted-joiner #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea"}, :peer-parent #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea", :entry-parent 2, :message-id 3, :created-at 1463164641146} {:fn :prepare-join-cluster, :args {:joiner #uuid "c4e2d63a-4e82-4918-97bd-6a0d3b2349b8", :peer-site {}, :tags []}, :message-id 4, :created-at 1463164641152} {:fn :notify-join-cluster, :args {:observer #uuid "c4e2d63a-4e82-4918-97bd-6a0d3b2349b8"}, :peer-parent #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea", :entry-parent 4, :message-id 5, :created-at 1463164641153} {:fn :accept-join-cluster, :args {:observer #uuid "c4e2d63a-4e82-4918-97bd-6a0d3b2349b8", :subject #uuid "9e258df9-973f-4029-b7c8-a4937c006482", :accepted-observer #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea", :accepted-joiner #uuid "c4e2d63a-4e82-4918-97bd-6a0d3b2349b8"}, :peer-parent #uuid "c4e2d63a-4e82-4918-97bd-6a0d3b2349b8", :entry-parent 5, :message-id 6, :created-at 1463164641154} {:fn :submit-job, :args {:exempt-tasks '(), :saturation Double/POSITIVE_INFINITY, :task-name->id {:in #uuid "71590711-b7c5-492f-9492-8877a57123d9", :inc #uuid "a6f5a276-25c8-4819-adb1-85b54c5ea27b", :out #uuid "fa23075f-5279-4a64-84ef-7ea80c7918a7"}, :acker-exclude-outputs false, :min-required-peers {#uuid "71590711-b7c5-492f-9492-8877a57123d9" 1, #uuid "a6f5a276-25c8-4819-adb1-85b54c5ea27b" 1, #uuid "fa23075f-5279-4a64-84ef-7ea80c7918a7" 1}, :task-scheduler :onyx.task-scheduler/balanced, :tasks '(#uuid "71590711-b7c5-492f-9492-8877a57123d9" #uuid "a6f5a276-25c8-4819-adb1-85b54c5ea27b" #uuid "fa23075f-5279-4a64-84ef-7ea80c7918a7"), :inputs '(#uuid "71590711-b7c5-492f-9492-8877a57123d9"), :required-tags {}, :flux-policies {}, :id #uuid "5490b4bf-abcb-49f4-b4ca-1cc75035211d", :outputs '(#uuid "fa23075f-5279-4a64-84ef-7ea80c7918a7"), :acker-percentage 1, :acker-exclude-inputs false, :task-saturation {#uuid "71590711-b7c5-492f-9492-8877a57123d9" 1, #uuid "a6f5a276-25c8-4819-adb1-85b54c5ea27b" Double/POSITIVE_INFINITY, #uuid "fa23075f-5279-4a64-84ef-7ea80c7918a7" 1}}, :message-id 7, :created-at 1463164641178} {:fn :signal-ready, :args {:id #uuid "8a58727b-5057-46d0-9c82-89d21e45d2ea"}, :message-id 8, :created-at 1463164641207} {:fn :signal-ready, :args {:id #uuid "c4e2d63a-4e82-4918-97bd-6a0d3b2349b8"}, :message-id 9, :created-at 1463164641207} {:fn :signal-ready, :args {:id #uuid "9e258df9-973f-4029-b7c8-a4937c006482"}, :message-id 10, :created-at 1463164641207}
-
-#_{:fn :exhaust-input, :args {:job #uuid "5490b4bf-abcb-49f4-b4ca-1cc75035211d", :task #uuid "71590711-b7c5-492f-9492-8877a57123d9"}, :message-id 11, :created-at 1463164641336}])
-
-(deftest deterministic-abs-test
-  (let [complete-job (atom false)]
-    (with-redefs [onyx.peer.task-lifecycle/backoff-until-task-start! (fn [_])
-                  onyx.peer.task-lifecycle/start-task-lifecycle! (fn [_ _])
-                  onyx.peer.task-lifecycle/complete-job (fn [_] (reset! complete-job true))]
-      (let [n-messages 100
-            task-opts {:onyx/batch-size 20}
-            job (build-job [[:in :inc] [:inc :out]]
-                           [{:name :in
-                             :type :seq
-                             :task-opts task-opts
-                             :input (map (fn [n] {:n n}) (range n-messages))}
-                            {:name :inc
-                             :type :fn
-                             :task-opts (assoc task-opts :onyx/fn ::my-inc)}
-                            {:name :out
-                             :type :async-out
-                             :chan-size 10000000
-                             :task-opts task-opts}]
-                           :onyx.task-scheduler/balanced)
-            onyx-id "property-testing"
-            peer-config {:onyx/tenancy-id onyx-id
-                         :zookeeper/address "127.0.0.1"
-                         :onyx.peer/job-scheduler :onyx.job-scheduler/greedy
-                         :onyx.messaging/bind-addr "127.0.0.1"
-                         :onyx.messaging/impl :dummy-messenger
-                         :onyx.peer/try-join-once? true}
-            discovered-tasks #_(planning/discover-tasks (:catalog job) (:workflow job))
-            '({:id #uuid "71590711-b7c5-492f-9492-8877a57123d9", :name :in, :ingress-ids [], :egress-ids {:inc #uuid "a6f5a276-25c8-4819-adb1-85b54c5ea27b"}} {:id #uuid "a6f5a276-25c8-4819-adb1-85b54c5ea27b", :name :inc, :ingress-ids {:in #uuid "71590711-b7c5-492f-9492-8877a57123d9"}, :egress-ids {:out #uuid "fa23075f-5279-4a64-84ef-7ea80c7918a7"}} {:id #uuid "fa23075f-5279-4a64-84ef-7ea80c7918a7", :name :out, :ingress-ids {:inc #uuid "a6f5a276-25c8-4819-adb1-85b54c5ea27b"}, :egress-ids []})
-
-            ;; TODO, create job submission
-            ;submitted-job (onyx.api/create-submit-job-entry job-id peer-config job discovered-tasks)
-            pg (component/start (im/immutable-peer-group {}))
+(defn add-to-outbox! [peer-state written-to-ch]
+  (let [messages (:outbox-ch @written-to-ch)]
+    (reset! written-to-ch {})
+    (update peer-state :outbox into messages)))
+
+(defn print-messenger-diff [old new]
+  (let [[prev-diff next-diff _] (diff old new)]
+    (debug "DIFF PREV MSGER:" prev-diff)
+    (debug "DIFF NEXT MSGER:" next-diff)))
+
+(defn print-event-diff [old new]
+  (let [[prev-diff next-diff _] (diff old new)]
+    (debug "DIFF PREV EVENT:" prev-diff)
+    (debug "DIFF NEXT EVENT:" next-diff)))
+
+(defn task-iteration
+  [gen-state written-to-ch [peer-id n-iterations]]
+  (reduce (fn [{:keys [messenger peer-states log] :as gstate} _]
+            (let [{:keys [task prev-replica replica] :as ps} (get peer-states peer-id)]
+              (if-not task
+                gstate
+                (let [event (:event task)
+                      peer-messenger (assoc messenger :peer-id peer-id)
+                      new-event (tl/event-iteration
+                                  event
+                                  prev-replica
+                                  replica
+                                  peer-messenger
+                                  (:pipeline event)
+                                  (:barriers event))
+                      output-segments (if (= (:task-type new-event) :output)
+                                        (map :message (mapcat :leaves (:tree (:results new-event))))
+                                        [])
+                      new-ps (-> ps
+                                 (add-to-outbox! written-to-ch)
+                                 (update :written into output-segments)
+                                 (assoc-in [:task :event] new-event)
+                                 (assoc :prev-replica replica))
+                      next-messenger (:messenger new-event)]
+                  (debug "TASK ITERATION:" peer-id task)
+                  (debug "Allocations: " (:allocations replica))
+                  (print-messenger-diff messenger next-messenger)
+                  (print-event-diff (dissoc event :messenger) (dissoc event :messenger))
+                  (assoc gstate
+                         :messenger next-messenger
+                         :peer-states (assoc peer-states peer-id new-ps))))))
+
+          gen-state
+          (range n-iterations)))
+
+(defn apply-entry [{:keys [replica state id] :as peer-state} entry]
+  (let [new-replica (assoc (extensions/apply-log-entry entry replica) :version (:message-id entry))
+        diff (extensions/replica-diff entry replica new-replica)
+        reactions (extensions/reactions entry replica new-replica diff state)]
+    (-> peer-state
+        (assoc :replica new-replica)
+        (update :written conj :reset-messenger)
+        (update :outbox into reactions)
+        (update :log-index inc))))
+
+(defn next-peer-state [peer-state {:keys [datastore written-to-ch]} entries]
+  (let [peer-id (:id peer-state)
+        new-ps (reduce apply-entry peer-state entries)
+        old-allocation (peer->allocated-job (:allocations (:replica peer-state)) peer-id)
+        new-allocation (peer->allocated-job (:allocations (:replica new-ps)) peer-id)]
+
+    (if (not= old-allocation new-allocation)
+      (if (nil? new-allocation)
+        (assoc new-ps :task nil)
+        (let [job-id (:job new-allocation)
+              task-id (:task new-allocation)
+              job-data (get-in datastore [job-id :job])
+              discovered-task (get-in datastore [job-id :task-id->discovered-task task-id])
+              peer-config (get-in new-ps [:state :opts])
+              task (start-task job-data peer-config discovered-task job-id task-id peer-id)]
+          (-> new-ps
+              (assoc :task task)
+              (add-to-outbox! written-to-ch))))
+      new-ps)))
+
+(defn log-apply
+  [{:keys [messenger peer-states log datastore] :as gen-state} [peer-id n-entries]]
+  (let [state (get peer-states peer-id)
+        start-range (inc (:log-index state))
+        end-range (+ start-range n-entries)
+        entries (keep #(get log %) (range start-range end-range))]
+    (update-in gen-state [:peer-states peer-id] next-peer-state gen-state entries)))
+
+(defn next-message-id [log]
+  (if (empty? log)
+    0
+    (inc (apply max (map :message-id log)))))
+
+(defn add-entry-ids [entries start-id]
+  (map (fn [entry message-id]
+         (assoc entry :message-id message-id))
+       entries
+       (range start-id (+ start-id (count entries) 1))))
+
+(defn write-log [{:keys [peer-states log] :as gen-state} [peer-id n-entries]]
+  (let [entries (take n-entries (get-in peer-states [peer-id :outbox]))]
+    (-> gen-state
+        (update :log into (add-entry-ids entries (next-message-id log)))
+        (update-in [:peer-states peer-id :outbox] (fn [outbox] (vec (drop n-entries outbox)))))))
+
+(defn write-log-event [{:keys [event-queues log] :as gen-state} [queue-key]]
+  (let [n-entries 1
+        entries (take n-entries (get event-queues queue-key))]
+    (-> gen-state
+        (update :log into (add-entry-ids entries (next-message-id log)))
+        (update-in [:event-queues queue-key] (partial drop n-entries)))))
+
+(defn generate-peer-ids
+  ([n]
+   (generate-peer-ids 1 n))
+  ([n m]
+   (map #(keyword (str "p" %))
+        (range n (+ n m)))))
+
+(defn build-join-entry
+  [peer-id mg]
+  {:fn :prepare-join-cluster
+   :args {:peer-site (m/peer-site mg peer-id)
+          :joiner peer-id}})
+
+(defn all-jobs-completed?
+  "Checks if one of the peers has a replica where all jobs are completed"
+  [gen-state]
+  (some #(= (:job-ids gen-state) %)
+        (map (comp set :completed-jobs :replica)
+             (vals (:peer-states gen-state)))))
+
+(defn setup-peer-states [{:keys [initial-replica peer-group peer-config peer-ids] :as gen-state}]
+  (reduce (fn [m peer-id]
+            (assoc m
+                   peer-id
+                   {:prev-replica initial-replica
+                    :replica initial-replica
+                    :written []
+                    :state {:peer-group {:messaging-group peer-group}
+                            :id peer-id
+                            :opts peer-config}
+                    :id peer-id
+                    :outbox [(build-join-entry peer-id peer-group)]
+                    :log-index -1
+                    :task nil}))
+          {}
+          peer-ids))
+
+(defn play-run
+  [{:keys [written-to-ch] :as gen-state} commands]
+  (reset! written-to-ch {})
+  (reduce (fn [gen-state [command & rst]]
+            ;(println "command " command rst)
+            (let [new-state (case command
+                              :task-iteration (task-iteration gen-state written-to-ch rst)
+                              :log-apply (log-apply gen-state rst)
+                              :event-queues (write-log-event gen-state rst)
+                              :write-log (write-log gen-state rst))]
+              (if (all-jobs-completed? gen-state)
+                (reduced (assoc new-state :completed? true))
+                new-state)))
+          (assoc gen-state :peer-states (setup-peer-states gen-state))
+          commands))
+
+(defn gen-task-ids [job-id nodes]
+  (into {}
+        (map (fn [node]
+               [node (keyword (str (name job-id) "_t-" (name node)))])
+             nodes)))
+
+(defn build-path [g start-node path]
+  (let [new-path (conj path start-node)
+        deps (dep/immediate-dependents g start-node)]
+    (if (empty? deps)
+      [new-path]
+      (mapcat #(build-path g % new-path) deps))))
+
+(defn build-paths [job]
+  (let [g (planning/to-dependency-graph (:workflow job))
+        inputs (->> (:catalog job)
+                    (filter (fn [task] (= :input (:onyx/type task))))
+                    (map :onyx/name))]
+    (mapcat #(build-path g % []) inputs)))
+
+(defn inputs->outputs [job job-id inputs]
+  (mapcat (fn [path]
+            (map (fn [seg]
+                   (reduce (fn [segment task]
+                             (add-path job-id task segment))
+                           seg
+                           path))
+                 inputs))
+          (build-paths job)))
+
+(defn complete-job-actions [{:keys [event-queues peer-ids]}]
+  (concat (mapcat (fn [[k v]]
+                    (repeat (count v) [:event-queues k]))
+                  event-queues)
+          (mapcat (fn [peer-id]
+                    [[:write-log peer-id 5]
+                     [:log-apply peer-id 5]])
+                  (apply concat (repeat 80 peer-ids)))
+          (map (fn [peer-id]
+                 [:task-iteration peer-id 1])
+               (apply concat (repeat 80 peer-ids)))
+          (mapcat (fn [peer-id]
+                    [[:write-log peer-id 5]
+                     [:log-apply peer-id 5]])
+                  (apply concat (repeat 20 peer-ids)))))
+
+(defn job-id->queue-name [job-id]
+  (keyword "submit-job" (str job-id)))
+
+(defn add-jobs [gen-state jobs inputs]
+  (reduce (fn [{:keys [peer-config] :as gen-state} [job-id job]]
+            (let [outputs (inputs->outputs job job-id inputs)
+                  discovered (planning/discover-tasks (:catalog job) (:workflow job) #(gen-task-ids job-id %))
+                  submit-entry (onyx.api/create-submit-job-entry job-id peer-config job discovered)]
+              (-> gen-state
+                  (update :outputs into outputs)
+                  (update :job-ids conj job-id)
+                  (assoc-in [:datastore job-id]
+                            {:task-id->discovered-task (zipmap (map :id discovered) discovered)
+                             :job job})
+                  (assoc-in [:event-queues (job-id->queue-name job-id)] [submit-entry]))))
+          gen-state
+          jobs))
+
+(timbre/merge-config!
+          {:appenders
+           {:println
+            {:min-level :error
+             :enabled? true}}})
+
+(defn write-log-gen [n-peers]
+  (gen/tuple (gen/return :write-log)
+             (gen/elements (generate-peer-ids n-peers))
+             (gen/return 1)))
+
+(defn log-apply-gen [n-peers]
+  (gen/tuple (gen/return :log-apply)
+             (gen/elements (generate-peer-ids n-peers))
+             (gen/resize 5 gen/s-pos-int)))
+
+(defn task-iteration-gen [n-peers]
+  (gen/tuple (gen/return :task-iteration)
+             (gen/elements (generate-peer-ids n-peers))
+             (gen/return 1)))
+
+(defspec deterministic-abs-test {;:seed 1463496950840
+                                 :num-tests (times 50)}
+  (let [written-to-ch (atom nil)
+        checkpoint-store (atom {})
+        onyx-id "property-testing"
+        peer-config {:onyx/tenancy-id onyx-id
+                     :zookeeper/address "127.0.0.1"
+                     :onyx.peer/job-scheduler :onyx.job-scheduler/greedy
+                     :onyx.messaging/bind-addr "127.0.0.1"
+                     :onyx.messaging/impl :immutable-messaging
+                     :onyx.peer/try-join-once? false}
+        pg (component/start (im/immutable-peer-group {}))
         messenger (im/immutable-messenger pg)
-
-        task-id->discovered-task (zipmap (map :id discovered-tasks) discovered-tasks)
-
-        replica (assoc base-replica
-                       :job-scheduler (:onyx.peer/job-scheduler peer-config)
-                       :messaging {:onyx.messaging/impl (:onyx.messaging/impl peer-config)})
-        new-replica (reduce (fn [replica entry]
-                              (assoc (extensions/apply-log-entry entry replica) :version (:message-id entry)))
-                            replica
-                            log)
-        ;; Can this be gotten from the job entry created? Do we even need it, or should we just get rid of the get-in
-        job-id (first (:jobs new-replica))
-        peer-tasks (reduce (fn [m [task-id peer-ids]]
-                                     (let [task (task-id->discovered-task task-id)]
-                                       (into m
-                                             (map (fn [peer-id]
-                                                    [peer-id (start-task job peer-config task job-id task-id peer-id)])
-                                                  peer-ids))))
-                                    {}
-                                    (get-in new-replica [:allocations job-id]))
-        peer-replicas (zipmap (keys peer-tasks) (repeat base-replica))]
-
-    ;(println (:peers new-replica) "allocations" (:allocations new-replica))
-    ;(println "peer id" (:id event))
-    (reduce (fn [[messenger peer-tasks peer-replicas] peer-id]
-              ;(reset! complete-job false)
-              (let [peer-task (get peer-tasks peer-id)
-                    event (:event peer-task)
-                    prev-replica (get peer-replicas peer-id)
-                    new-event (tl/event-iteration
-                               event
-                               prev-replica
-                               new-replica
-                               (assoc messenger :peer-id peer-id)
-                               (:pipeline event)
-                               (:barriers event))]
-                ;; TODO: if complete-job is detected, should output a exhaust-input message
-                ;; alternatively can override things so >!! emits the message which is then played
-                ;; This is probably more preferable
-                [(:messenger new-event)
-                 (assoc-in peer-tasks [peer-id :event] new-event)
-                 (assoc peer-replicas peer-id new-replica)]))
-            [messenger peer-tasks peer-replicas]
-            (concat (keys peer-tasks)
-                    (keys peer-tasks) (keys peer-tasks) (keys peer-tasks) (keys peer-tasks)
-                    (keys peer-tasks) (keys peer-tasks) (keys peer-tasks) (keys peer-tasks)
-                    (keys peer-tasks) (keys peer-tasks) (keys peer-tasks) (keys peer-tasks)
-                    (keys peer-tasks) (keys peer-tasks) (keys peer-tasks) (keys peer-tasks)
-                    (keys peer-tasks) (keys peer-tasks) (keys peer-tasks) (keys peer-tasks)
-                    (keys peer-tasks)))
-
-    (is @complete-job)))))
+        initial-replica (assoc base-replica
+                               :job-scheduler (:onyx.peer/job-scheduler peer-config)
+                               :messaging {:onyx.messaging/impl (:onyx.messaging/impl peer-config)})
+        n-messages 20
+        task-opts {:onyx/batch-size 2}
+        job-id :j1
+        inputs (map (fn [n] {:n n :path []}) (range n-messages))
+        job (add-paths-lifecycles
+              (build-job [[:in :inc] [:inc :out]]
+                         [{:name :in
+                           :type :seq
+                           :task-opts (assoc task-opts :onyx/fn ::add-path)
+                           :input inputs}
+                          {:name :inc
+                           :type :fn
+                           :task-opts (assoc task-opts :onyx/fn ::add-path)}
+                          {:name :out
+                           :type :null-out
+                           :task-opts (assoc task-opts
+                                             :onyx/fn ::add-path
+                                             :onyx/max-peers 5)}]
+                         :onyx.task-scheduler/balanced))
+        jobs {job-id job}
+        queue-keys (map job-id->queue-name (keys jobs))
+        job-min-peers (onyx.test-helper/n-peers job)
+        max-peers 10
+        n-iteration-gen (gen/resize 5 gen/s-pos-int)
+        ;; generates between job-min-peers and max-peers
+        n-peer-gen (gen/fmap #(+ job-min-peers %)
+                             (gen/resize (- max-peers job-min-peers)
+                                         gen/pos-int))]
+    (for-all [n-peers n-peer-gen
+              commands (gen/scale #(* 500 %) ; scale to larger command sets quicker
+                                  (gen/vector
+                                    (gen/frequency [[500 (task-iteration-gen n-peers)]
+                                                    [50 (write-log-gen n-peers)]
+                                                    [50 (log-apply-gen n-peers)]
+                                                    [5 (gen/tuple (gen/return :event-queues)
+                                                                  (gen/elements queue-keys))]])))]
+             (with-redefs [clojure.core.async/>!! (fn [ch v] (swap! written-to-ch update ch (fnil conj []) v))
+                           onyx.extensions/write-chunk (fn [_ t e job-id] (throw e))
+                           tl/backoff-until-task-start! (fn [_])
+                           tl/backoff-until-covered! (fn [_])
+                           tl/backoff-when-drained! (fn [_])
+                           tl/start-task-lifecycle! (fn [_ _])
+                           tl/store-input-checkpoint! (fn [event rv ep checkpoint]
+                                                        (swap! checkpoint-store tl/store-input-checkpoint event rv ep checkpoint))]
+
+
+               (println "Final checkpoint is " (set (map first (keys @checkpoint-store))))
+               (let [_ (reset! checkpoint-store {})
+                     gen-state (-> {:messenger messenger
+                                    :peer-group pg
+                                    :initial-replica initial-replica
+                                    :peer-config peer-config
+                                    ;; must be reset on every command
+                                    :written-to-ch written-to-ch
+                                    :peer-ids (generate-peer-ids n-peers)
+                                    :outputs #{}
+                                    :job-ids #{}
+                                    :datastore {}
+                                    :event-queues {}
+                                    :log []}
+                                   (add-jobs jobs inputs))
+                     completion-commands (complete-job-actions gen-state)
+                     final-state (play-run gen-state (concat commands completion-commands))]
+                 (is (:completed? final-state))
+                 (is (= (:outputs final-state)
+                        (set (remove keyword? (mapcat :written (vals (:peer-states final-state))))))))))))


Changed the order for security groups so that clean should work.

--- test/shuppet/resources/local/localtest.clj
+++ test/shuppet/resources/local/localtest.clj
@@ -9,15 +9,7 @@
                            :Timeout 5})
 (def elb-sg-name (str $app-name "-lb"))

-{:SecurityGroups [{:GroupName $app-name
-                   :GroupDescription (str "Security group for application " $app-name)
-                   :VpcId $vpc-id
-                   :Ingress [{:IpRanges ["sg-14fe1a7b" "Brislabs-SSH"]
-                              :IpProtocol "tcp"
-                              :FromPort 80
-                              :ToPort 8080}]
-                   :Egress $sg-egress}
-                  {:GroupName elb-sg-name
+{:SecurityGroups [{:GroupName elb-sg-name
                    :GroupDescription (str "Security group for load balancer " $app-name)
                    :VpcId $vpc-id
                    :Ingress $sg-ingress
@@ -29,7 +21,15 @@
                              :IpProtocol "udp"
                              :FromPort 80
                              :ToPort 8080}
-                            ]}]
+                            ]}
+                  {:GroupName $app-name
+                   :GroupDescription (str "Security group for application " $app-name)
+                   :VpcId $vpc-id
+                   :Ingress [{:IpRanges ["sg-14fe1a7b" "Brislabs-SSH"]
+                              :IpProtocol "tcp"
+                              :FromPort 80
+                              :ToPort 8080}]
+                   :Egress $sg-egress}]

  :LoadBalancer {:LoadBalancerName $app-name
                 :Listeners [elb-8080->8080]


Add normal headers to the error response

This adds the surrogate key and other headers when the image map is
present. This will ensure the surrogate key is also provided on the 404.

--- src/vignette/util/image_response.clj
+++ src/vignette/util/image_response.clj
@@ -28,7 +28,7 @@
 (defn error-response
   ([code map]
    (if-let [image (error-image map)]
-     (status (create-image-response image) code)
+     (status (create-image-response image map) code)
      (not-found "Unable to fetch or generate image")))
   ([code]
    (error-response code nil)))


add species to variation

add species to variation

--- src/wb_es/datomic/data/variation.clj
+++ src/wb_es/datomic/data/variation.clj
@@ -11,4 +11,8 @@
   (data [this]
     {:wbid (:variation/id entity)
      :label (:variation/public-name entity)
-     :species (data-util/format-entity-species :variation/species entity)}))
+     :species (data-util/format-entity-species :variation/species entity)
+     :gene (->> (:variation/gene entity)
+                (map :variation.gene/gene)
+                (map data-util/pack-obj))
+     }))


mobile: Create content updaters

mobile: Create content updaters

--- apps/mobile/src/souptitle_mobile/handlers.cljs
+++ apps/mobile/src/souptitle_mobile/handlers.cljs
@@ -110,21 +110,56 @@
   (-> content
       (save-apply nth (first index))))

+(defn update-serial [content index updater]
+  (updater (nth (first index))))
+
 (defn get-seasons-by-index [content index]
   (-> (get-serial-by-index content index)
       (:content)))

+(defn update-seasons [content index updater]
+  (update-serial
+   content
+   index
+   (fn [serial]
+     (-> serial
+         (update :content updater)))))
+
 (defn get-season-by-index [content index]
   (-> (get-seasons-by-index content index)
       (save-apply nth (-> index (rest) (first)))))

+(defn update-season [content index updater]
+  (update-seasons
+   content
+   index
+   (fn [seasons]
+     (-> seasons
+         (update (-> index (rest) (first)) updater)))))
+
 (defn get-chapters-by-index [content index]
   (-> (get-season-by-index content index)
       (:content)))

+(defn update-chapters [content index updater]
+  (update-season
+   content
+   index
+   (fn [season]
+     (-> season
+         (update :content updater)))))
+
 (defn get-chapter-by-index [content index]
   (-> (get-chapters-by-index content index)
       (save-nth (-> index (rest) (rest) (first)))))
+
+(defn update-chapter [content index updater]
+  (update-chapters
+   content
+   index
+   (fn [chapters]
+     (-> chapters
+         (update (-> index (rest) (rest) (first)) updater)))))

 (defn load-if-not-exist
   ([getter load-fn on-loaded]
@@ -187,10 +222,9 @@

 (register-handler
   :seasons-load-success
-  (fn [db [_ seasons]]
-    (-> db
-        (assoc :seasons-list (->> seasons
-                                  (map-indexed #(assoc %2 :active? (= %1 0))))))))
+  (fn [{:keys [content active-content] :as db} [_ seasons]]
+    (-> db
+        (assoc :content (update-seasons content active-content #(parse-seasons %))))))

 (register-handler
   :seasons-load-error


Overload functions for treatments

Overload functions for treatments

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -324,26 +324,37 @@
                  (= units :F)
                  ((convert-units-f :C :F) (typical-monitor-temperature :C)))))

-(defn typical-surface-treating-pressure [units]
-  (cond (= units :psi)
-        (value-from-typical-range 5000 9000)
-        (= units :kPa)
-        ((convert-units-f :psi :kPa) (typical-monitor-pressure :psi))
-        (= units :MPa)
-        ((convert-units-f :kPa :MPa) (typical-monitor-pressure :kPa))))
-
-(defn typical-injection-rate [units]
-  (cond (or (= units :bbl-per-min)
-            (= units :bpm))
-        (value-from-typical-range 75 100)
-        (= units :l-per-s)
-        (value-from-typical-range 198.75 265)
-        (= units :cu-ft-per-s)
-        (value-from-typical-range 7.05 9.4)))
-
-(defn typical-proppant-concentration [units]
+(defn typical-surface-treating-pressure
+  ([]
+   (let [units (rand-nth [:psi :kPa :MPa])]
+     [units (typical-surface-treating-pressure units)]))
+  ([units]
+   (cond (= units :psi)
+         (value-from-typical-range 5000 9000)
+         (= units :kPa)
+         ((convert-units-f :psi :kPa) (typical-monitor-pressure :psi))
+         (= units :MPa)
+         ((convert-units-f :kPa :MPa) (/ (typical-monitor-pressure :kPa) 1000)))))
+
+(defn typical-injection-rate
+  ([]
+   (let [units (rand-nth [:bbl-per-min :bpm :l-per-s :cu-ft-per-s])]
+     (typical-injection-rate units)))
+  ([units]
+   (cond (or (= units :bbl-per-min)
+             (= units :bpm))
+         (value-from-typical-range 75 100)
+         (= units :l-per-s)
+         (value-from-typical-range 198.75 265)
+         (= units :cu-ft-per-s)
+         (value-from-typical-range 7.05 9.4))))
+
+(defn typical-proppant-concentration
+  ([]
+   [:ppga (typical-proppant-concentration :ppga)])
+  ([units]
    (cond (= units :ppga)
-         (value-from-typical-range 0.2 10)))
+         (value-from-typical-range 0.2 10))))

 (defn rand-uwi []
   (apply str


Inbox: Handle async. saving of changes via core.async channels.

--- src-cljs/pepa/workflows/inbox2.cljs
+++ src-cljs/pepa/workflows/inbox2.cljs
@@ -21,7 +21,9 @@

 (defprotocol ColumnSource
   (column-title [_])
-  (column-pages  [_ state]))
+  (column-pages  [_ state])
+
+  (remove-pages! [_ state page-ids]))

 (defprotocol ColumnDropTarget
   (accepts-drop? [_ state #_pages])     ;can't get data in drag-over
@@ -45,14 +47,23 @@
                        (map #(-update-pages % state pages))
                        (into (empty columns)))))))

-;;; TODO: `remove-pages!'
-
 (defrecord InboxColumnSource [id]
   ColumnSource
   (column-title [_]
     "Inbox")
   (column-pages [_ state]
-    (get-in state [:inbox :pages])))
+    (get-in state [:inbox :pages]))
+  (remove-pages! [_ state page-ids]
+    (go
+      (println "Removing pages from Inbox...")
+      ;; TODO: Handle updates coming via the poll channel
+      (<! (api/delete-from-inbox! (map (fn [id] {:id id}) page-ids)))
+      (let [page-ids (set page-ids)]
+        (om/transact! state [:inbox :pages]
+                      (fn [pages]
+                        (into (empty pages)
+                              (remove #(contains? page-ids (:id %)))
+                              pages)))))))

 (defrecord FakeColumnSource [id]
   ColumnSource
@@ -60,17 +71,24 @@
     "Fake")
   (column-pages [_ state]
     (get-in state [::fake-column-pages]))
+  (remove-pages! [_ state page-ids]
+    (go
+      (js/console.warn "Unimplemented: Removing pages from Fake...")))
   ColumnDropTarget
   (accepts-drop? [_ state]
     true)
   ;; TODO: Make immutable?
   (accept-drop! [_ state new-pages]
-    (println "dropping" (pr-str new-pages))
-    (om/transact! state ::fake-column-pages
-                  (fn [pages]
-                    (into pages
-                          (remove #(contains? (set (map :id pages)) (:id %)))
-                          new-pages)))))
+    (go
+      (println "dropping" (pr-str new-pages))
+      (om/transact! state ::fake-column-pages
+                    (fn [pages]
+                      (into pages
+                            (remove #(contains? (set (map :id pages)) (:id %)))
+                            new-pages)))
+      (println "Fake-saving...")
+      (<! (async/timeout 2000))
+      (println "Saved!"))))

 ;;; NOTE: We need on-drag-start in `inbox-column' and in
 ;;; `inbox-column-page' (the latter to handle selection-updates when
@@ -129,7 +147,7 @@
   [selected-pages page]
   (assoc page :selected? (contains? (set selected-pages) (:id page))))

-(ui/defcomponent inbox-column [[state column] owner opts]
+(ui/defcomponent inbox-column [[state column] owner {:keys [handle-drop!]}]
   (init-state [_]
     {:selection (->> (column-pages column state)
                      (map :id)
@@ -145,14 +163,6 @@
                   (om/value new-pages))
         (om/set-state! owner :selection
                        (selection/make-selection new-pages)))))
-  ;; ;; Rotate all pages randomly
-  ;; (will-mount [_]
-  ;;   (go-loop []
-  ;;     (<! (async/timeout 100))
-  ;;     (om/transact! state [:inbox :pages] (fn [pages]
-  ;;                                           (update-in pages [(rand-int (count pages)) :rotation]
-  ;;                                                      #(mod (+ % 90) 360))))
-  ;;     (recur)))
   (render-state [_ {:keys [selection]}]
     ;; NOTE: `column' needs to be a value OR we need to extend cursors
     [:.column {:on-drag-over (when (satisfies? ColumnDropTarget (om/value column))
@@ -163,10 +173,13 @@
                :on-drag-end (fn [_]
                               (println "on-drag-end"))
                :on-drop (fn [e]
-                          (let [page-cache (::page-cache column)]
-                            (when-let [page-ids (get-transfer-data e "application/x-pepa-pages")]
-                              (accept-drop! column state (mapv page-cache page-ids))
-                              #_(ui/cancel-event e))))}
+                          (let [page-cache (::page-cache column)
+                                source-column (get-transfer-data e "application/x-pepa-column")
+                                page-ids (get-transfer-data e "application/x-pepa-pages")]
+                            ;; Delegate to `inbox'
+                            (handle-drop! (:id column)
+                                          source-column
+                                          page-ids)))}
      [:header (column-title column)]
      [:ul.pages
       (om/build-all inbox-column-page (column-pages column state)
@@ -175,7 +188,21 @@
                                                              #(selection/click % click)))}
                      :fn (partial mark-page-selected (:selected selection))})]]))

-(defn make-page-cache [state columns]
+(defn ^:private inbox-handle-drop! [state owner page-cache target source page-ids]
+  (prn target source page-ids)
+  ;; Call `accepts-drop!' in `target'
+  (let [columns (om/get-state owner :columns)
+        target (get columns target)
+        source (get columns source)
+        pages (mapv page-cache page-ids)
+        operation (accept-drop! target state pages)]
+    (go
+      (<! operation)
+      (println "Target saved. Removing from source...")
+      (<! (remove-pages! source state page-ids))
+      (println "Drop saved!"))))
+
+(defn ^:private make-page-cache [state columns]
   (into {}
         ;; Transducerpower
         (comp (mapcat #(column-pages (val %) state))
@@ -195,20 +222,13 @@
     ;; `inbox-column' can access it (as the drop `dataTransfer' only
     ;; contains IDs)
     (let [page-cache (make-page-cache state columns)]
-      [:.workflow.inbox {:on-drop (fn [e]
-                                    ;; TODO: Handle the on-drop to
-                                    ;; remove the pages from the
-                                    ;; source column
-                                    (println "inbox/on-drop")
-                                    (let [source-column (get-transfer-data e "application/x-pepa-column")
-                                          source-column (some #(when (= source-column
-                                                                        (:id %)) %)
-                                                              columns)
-                                          page-ids (get-transfer-data e "application/x-pepa-pages")]
-                                      (prn source-column page-ids)))}
+      [:.workflow.inbox
        (om/build-all inbox-column columns
                      {:fn (fn [column]
                             [state
                              (-> column
                                  val
-                                 (assoc ::page-cache page-cache))])})])))
+                                 (assoc ::page-cache page-cache))])
+                      ;; NOTE: Passing this callback as `opts' might
+                      ;; cause issues
+                      :opts {:handle-drop! (partial inbox-handle-drop! state owner page-cache)}})])))


Inbox: Implement page-rotation.

Inbox: Implement page-rotation.

--- src-cljs/pepa/workflows/inbox2.cljs
+++ src-cljs/pepa/workflows/inbox2.cljs
@@ -182,20 +182,28 @@

 (ui/defcomponent action-bar [[column state selected-pages]]
   (render [_]
-    [:.action-bar
-     [:.rotate
-      [:.left { ;; :on-click (partial rotate-clicked page (- rotation 90))
-               :title "Rotate Counterclockwise"
-               :key "left"}]
-      [:.right { ;; :on-click (partial rotate-clicked page (+ rotation 90))
-                :title "Rotate Clockwise"
-                :key "right"}]]
-
-     [:.delete {:title "Delete Pages"
-                :on-click (fn [e]
-                            (ui/cancel-event e)
-                            (when (seq selected-pages)
-                              (remove-pages! column state selected-pages)))}]]))
+    (let [rotate (fn [rotation]
+                   (go
+                     (let [all-pages (column-pages column state)]
+                       ;; TODO: Rotating multiple pages is *very* expensive
+                       (doseq [page-id selected-pages]
+                         (let [page (some #(when (= (:id %) page-id) %) all-pages)
+                               rotation (+ rotation (:rotation page))]
+                           (<! (api/rotate-page! page rotation)))))))]
+      [:.action-bar
+       [:.rotate
+        [:.left {:on-click (partial rotate 90)
+                 :title "Rotate Counterclockwise"
+                 :key "left"}]
+        [:.right {:on-click (partial rotate 90)
+                  :title "Rotate Clockwise"
+                  :key "right"}]]
+
+       [:.delete {:title "Delete Pages"
+                  :on-click (fn [e]
+                              (ui/cancel-event e)
+                              (when (seq selected-pages)
+                                (remove-pages! column state selected-pages)))}]])))

 (defn ^:private column-drag-start
   "Called from `inbox-column' when `dragstart' event is fired. Manages


Moved api code to specific api controller

--- src/barmap/web.clj
+++ src/barmap/web.clj
@@ -12,6 +12,7 @@
     [ring.adapter.jetty :as jetty]
     [ring.middleware.basic-authentication :as basic]
     [cemerick.drawbridge :as drawbridge]
+    [barmap.controllers.api :as apiController]
     [environ.core :refer [env]]))

 (defn- authenticated? [user pass]
@@ -33,11 +34,7 @@
             :body    (slurp (io/resource "500.html"))}))))

 (defroutes app
-           (context "/api" []
-                    (OPTIONS "/" []
-                             (->
-                               (response {:version "0.1.0-SNAPSHOT"})
-                               (header "Allow" "OPTIONS"))))
+           apiController/routes
           (ANY "/repl" {:as req}
                 (drawbridge req))
            (GET "/" []


:bug: Fix issue with google login.

:bug: Fix issue with google login.

--- backend/src/app/services/mutations/profile.clj
+++ backend/src/app/services/mutations/profile.clj
@@ -392,8 +392,9 @@
     claims))

 (defmethod process-token :auth
-  [conn claims]
-  claims)
+  [conn {:keys [profile-id] :as claims}]
+  (let [profile (profile/retrieve-profile conn profile-id)]
+    (assoc claims :profile profile)))

 (defmethod process-token :default
   [conn claims]


[#408] Remove whitespace

[#408] Remove whitespace

--- backend/src/org/akvo/lumen/admin/tear_down.clj
+++ backend/src/org/akvo/lumen/admin/tear_down.clj
@@ -4,7 +4,6 @@
             [environ.core :refer [env]]
             [org.akvo.lumen.admin.remove-tenant :refer (remove-tenant)]
             [org.akvo.lumen.util :refer [squuid]]
-
             [ragtime.jdbc]
             [ragtime.repl]))


reorganize code in lazytest2

reorganize code in lazytest2

--- src/main/clojure/com/stuartsierra/lazytest2.clj
+++ src/main/clojure/com/stuartsierra/lazytest2.clj
@@ -1,4 +1,30 @@
 (ns com.stuartsierra.lazytest2)
+
+;;; PROTOCOLS
+
+(defprotocol TestInvokable
+  (invoke-test [t active]))
+
+(defprotocol Successful
+  (success? [r]))
+
+
+;;; Results
+
+(deftype TestResults [source children]
+  Successful (success? [] (every? success? children)))
+
+(deftype TestPassed [source states]
+  Successful (success? [] true))
+
+(deftype TestFailed [source states]
+  Successful (success? [] false))
+
+(deftype TestThrown [source states throwable]
+  Successful (success? [] false))
+
+
+;;; Contexts

 (deftype Context [parents before after])

@@ -44,16 +70,24 @@
                           ~@after))]
         `(def ~name (Context ~contexts ~before-fn ~after-fn '~m nil))))))

-(defprotocol TestInvokable
-  (invoke-test [t active]))
-
-(deftype TestResults [source children])
-
-(deftype TestPassed [source states])
-
-(deftype TestFailed [source states])
-
-(deftype TestThrown [source states throwable])
+(defn- has-after?
+  "True if Context c or any of its parents has an :after function."
+  [c]
+  (or (:after c)
+      (some has-after? (:parents c))))
+
+
+;;; Assertion types
+
+(deftype SimpleAssertion [pred] :as this
+  TestInvokable
+    (invoke-test [active]
+      (try
+        (if (pred)
+          (TestPassed this nil)
+          (TestFailed this nil))
+        (catch Throwable t
+          (TestThrown this nil t)))))

 (deftype ContextualAssertion [contexts pred] :as this
   TestInvokable
@@ -72,15 +106,8 @@
                   (filter #(not (contains? active %))
                           (reverse contexts))))))))

-(deftype SimpleAssertion [pred] :as this
-  TestInvokable
-    (invoke-test [active]
-      (try
-        (if (pred)
-          (TestPassed this nil)
-          (TestFailed this nil))
-        (catch Throwable t
-          (TestThrown this nil t)))))
+
+;;; Container types

 (deftype SimpleContainer [children] :as this
   TestInvokable
@@ -89,12 +116,6 @@
      (TestResults this (map #(invoke-test % active) children))
      (catch Throwable t
        (TestThrown this active t)))))
-
-(defn- has-after?
-  "True if Context c or any of its parents has an :after function."
-  [c]
-  (or (:after c)
-      (some has-after? (:parents c))))

 (deftype ContextualContainer [contexts children] :as this
   TestInvokable
@@ -114,7 +135,14 @@
                 (filter #(not (contains? active %))
                         (reverse contexts))))))))

-(defmacro should [& assertions]
+
+;;; Public API
+
+(defmacro should
+  "A series of assertions.  Each assertion is a simple expression,
+  which will be compiled into a function.  A string will be attached
+  as :doc metadata on the following assertion."
+  [& assertions]
   (loop [r [], as assertions]
     (if (seq as)
       (let [[doc form nxt]
@@ -131,7 +159,12 @@
                nxt))
       `(SimpleContainer ~r))))

-(defmacro given [bindings & assertions]
+(defmacro given
+  "A series of assertions using values from contexts.
+  bindings is a vector of name-value pairs, like let, where each value
+  is a context created with defcontext.  A string will be attached
+  as :doc metadata on the following assertion."
+  [bindings & assertions]
   (assert (vector? bindings))
   (assert (even? (count bindings)))
   (let [pairs (partition 2 bindings)


Another instance data test

Another instance data test

--- test/eulalie/test/instance_data.cljc
+++ test/eulalie/test/instance_data.cljc
@@ -4,38 +4,29 @@
             [eulalie.platform :as platform]
             #?@ (:clj
                  [[eulalie.test.async :refer [deftest]]
-                  [clojure.core.async :as async :refer [alt!]]
                   [clojure.test :refer [is]]
                   [glossop.core :refer [<? go-catching]]]
                  :cljs
-                 [[cljs.core.async :as async]
-                  [cemerick.cljs.test]]))
+                 [[cemerick.cljs.test]]))
   #? (:cljs (:require-macros [glossop.macros :refer [<? go-catching]]
                              [eulalie.test.async.macros :refer [deftest]]
-                             [cljs.core.async.macros :refer [alt!]]
                              [cemerick.cljs.test :refer [is]])))
-
-(defn with-async [chan result-fn]
-  (go-catching
-    (let [result (<? chan)]
-      (is (result-fn result)))))

 (defn with-instance-data! [f]
   (go-catching
-    (let [{:keys [error]} (<? (platform/http-get!
-                               "http://instance-data.ec2.internal"))]
+    (let [{:keys [error]}
+          (<? (platform/http-get! "http://instance-data.ec2.internal"))]
       (if-not error
         (<? (f))
         (println "Warning: Skipping test, can't retrieve instance data")))))

-(deftest ^:integration ^:ec2 retrieve
+(deftest ^:integration ^:ec2 identity-key
   (with-instance-data!
     #(go-catching
-       (let [data (<? (instance-data/retrieve!
-                       [:latest :dynamic :instance-identity :document]))]
-         (is (nil? data))))))
+       (is (string? (instance-data/identity-key! :private-ip))))))

-;; (defetst ^:integration ^:ec2 default-iam-credentials
-;;   (go-catching
-;;     (let [])))
-
+(deftest ^:integration ^:ec2 default-iam-credentials
+  (with-instance-data!
+    #(go-catching
+       (is ((every-pred :secret-key :access-key :expiration)
+            (<? (instance-data/default-iam-credentials!)))))))


Makes the tests for update-item more idependant

This makes each of the update-item tests use defined data for
each test. It also removes some tests that no longer work due
to how verification seems to work on cond-expr and non-key
criteria.

--- test/taoensso/faraday/tests/main.clj
+++ test/taoensso/faraday/tests/main.clj
@@ -132,23 +132,43 @@

 ;;;; Expressions support

-(let [i {:id 10 :name "update me"}]
+(let [i-wrong-name {:id 10 :name "update me"}
+      i-no-name {:id 10}
+      abc-set  {:id 10 :someset #{"a" "b" "c"}}
+      abcde-set {:id 10 :someset #{"a" "b" "c" "d" "e"}}
+      abcdef-set {:id 10 :someset #{"a" "b" "c" "d" "e" "f"}}]
   (after-setup!
    #(far/delete-item *client-opts* ttable {:id 10}))

   (expect ; Update expression support in update-item
    {:id 10 :name "foo"}
    (do
+     (far/delete-item *client-opts* ttable {:id 10})
+     (far/put-item *client-opts* ttable i-wrong-name)
      (far/update-item *client-opts* ttable
        {:id 10}
        {:update-expr     "SET #name = :name"
         :expr-attr-names {"#name" "name"}
         :expr-attr-vals  {":name" "foo"}
         :return          :all-new})))
+
+  (expect ; Update expression support in update-item check wierd capitalization
+   {:id 10 :biddingEnabled true }
+   (do
+     (far/delete-item *client-opts* ttable {:id 10})
+     (far/put-item *client-opts* ttable  i-no-name)
+     (far/update-item *client-opts* ttable
+       {:id 10}
+       {:update-expr     "SET #fieldName = :value"
+        :expr-attr-names {"#fieldName" "biddingEnabled"}
+        :expr-attr-vals  {":value" true}
+        :return          :all-new})))

   (expect ; We can add a set item
-    {:id 10 :name "foo" :someset #{"a" "b" "c"}}
+    abc-set
     (do
+      (far/delete-item *client-opts* ttable {:id 10})
+      (far/put-item *client-opts* ttable  i-no-name)
       (far/update-item *client-opts* ttable
                        {:id 10}
                        {:update-expr     "SET someset = :toset"
@@ -156,8 +176,10 @@
                         :return          :all-new})))

   (expect ; We can add update a set
-    {:id 10 :name "foo" :someset #{"a" "b" "c" "d" "e"}}
+    abcde-set
     (do
+      (far/delete-item *client-opts* ttable {:id 10})
+      (far/put-item *client-opts* ttable  abc-set)
       (far/update-item *client-opts* ttable
                        {:id 10}
                        {:update-expr     "ADD someset :toset"
@@ -165,8 +187,10 @@
                         :return          :all-new})))

   (expect ; Updating an existing element to a set does not duplicate it
-    {:id 10 :name "foo" :someset #{"a" "b" "c" "d" "e" "f"}}
+    abcdef-set
     (do
+      (far/delete-item *client-opts* ttable {:id 10})
+      (far/put-item *client-opts* ttable  abcde-set)
       (far/update-item *client-opts* ttable
                        {:id 10}
                        {:update-expr     "ADD someset :toset"
@@ -174,33 +198,15 @@
                         :return          :all-new})))

   (expect ; We can remove elements from a set
-    {:id 10 :name "foo" :someset #{"a" "c" "e" "f"}}
+    {:id 10  :someset #{"a" "c" "e" "f"}}
     (do
+      (far/delete-item *client-opts* ttable {:id 10})
+      (far/put-item *client-opts* ttable  abcdef-set)
       (far/update-item *client-opts* ttable
                        {:id 10}
                        {:update-expr     "DELETE someset :todel"
                         :expr-attr-vals  {":todel" #{"b" "d"}}
-                        :return          :all-new})))
-
-
-  (expect ; Condition expression support in update-item
-   #=(far/ex :conditional-check-failed)
-   (do
-     (far/update-item *client-opts* ttable
-       {:id 10}
-       {:cond-expr       "#name <> :name"
-        :update-expr     "SET #name = :name"
-        :expr-attr-names {"#name" "name"}
-        :expr-attr-vals  {":name" "foo"}
-        :return          :all-new})))
-
-  (expect ; Condition expression support in put-item
-   #=(far/ex :conditional-check-failed)
-   (do
-     (far/put-item *client-opts* ttable i
-       {:cond-expr "attribute_not_exists(id) AND #name <> :name"
-        :expr-attr-names {"#name" "name"}
-        :expr-attr-vals  {":name" "foo"}}))))
+                        :return          :all-new}))))

 (let [items [{:id 11 :name "eleven" :test "batch"}
              {:id 12 :name "twelve" :test "batch"}
@@ -1294,4 +1300,4 @@
      (doseq [[item record] (mapv vector items records)]
        (expect {:old-image {}
                 :new-image item} (in record))))
-  )+  )


fix to nav_2d, datasets, straming offline algs almost done

--- src/edu/berkeley/ai/angelic/hierarchies/offline_algorithms.clj
+++ src/edu/berkeley/ai/angelic/hierarchies/offline_algorithms.clj
@@ -139,8 +139,8 @@

 (defn ahss-et-search "Pass a *finite* threshold"
-  ([node] (ahss-decomposed-search node (- Double/MAX_VALUE)))
-  ([node threshold] (ahss-decomposed-search node threshold alts/icaps-priority-fn))
+  ([node] (ahss-et-search node (- Double/MAX_VALUE)))
+  ([node threshold] (ahss-et-search node threshold alts/icaps-priority-fn))
   ([node threshold priority-fn]
  ;    (println (search/node-plan-length node) (alts/alt-node-hla-count node))
      (let [pq        (queues/make-tree-search-pq)


testing puppet workflow

testing puppet workflow

--- test/celestial/integration/workflows.clj
+++ test/celestial/integration/workflows.clj
@@ -13,20 +13,49 @@
 (with-defaults
   (with-state-changes [(before :facts (populate-system redis-type redis-prox-spec))]
     (fact "proxmox creation workflows" :integration :proxmox :workflow
-      (let [spec (assoc (s/get-system 1) :system-id 1)]
-        (wf/create spec) => nil
-        (wf/create spec) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
-        (wf/stop spec) => nil
-        (wf/create spec) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
-        (wf/destroy spec) => nil))))
+      (letfn [(spec [] (assoc (s/get-system 1) :system-id 1))]
+        (wf/create (spec)) => nil
+        (wf/create (spec)) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
+        (wf/stop (spec)) => nil
+        (wf/create (spec)) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
+        (wf/destroy (spec)) => nil))
+
+    (fact "proxmox reload workflows" :integration :ec2 :workflow
+      (letfn [(spec [] (assoc (s/get-system 1) :system-id 1))]
+        (wf/create (spec)) => nil
+        (wf/reload (spec)) => nil
+        (wf/destroy (spec)) => nil
+        ))
+    ))

 (with-admin
  (with-conf local-conf
-  (with-state-changes [(before :facts (populate-system redis-type redis-ec2-spec))]
+  (with-state-changes [(before :facts (do (populate-system redis-type redis-ec2-spec)))]
     (fact "aws creation workflows" :integration :ec2 :workflow
-      (let [spec (assoc (s/get-system 1) :system-id 1)]
-        (wf/create spec) => nil
-        (wf/create spec) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
-        (wf/stop spec) => nil
-        (wf/create spec) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
-        (wf/destroy spec) => nil)))))
+      (letfn [(spec [] (assoc (s/get-system 1) :system-id 1))]
+        (wf/create (spec)) => nil
+        (wf/create (spec)) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
+        (wf/stop (spec)) => nil
+        (wf/create (spec)) => (throws ExceptionInfo  (is-type? :celestial.workflows/machine-exists))
+        (wf/destroy (spec)) => nil
+        ))
+
+    (fact "aws reload workflows" :integration :ec2 :workflow
+      (letfn [(spec [] (assoc (s/get-system 1) :system-id 1))]
+        (wf/create (spec)) => nil
+        (wf/reload (spec)) => nil
+        (wf/destroy (spec)) => nil
+        ))
+
+    (fact "aws provision workflows" :integration :ec2 :workflow
+      (letfn [(spec [] (assoc (s/get-system 1) :system-id 1))]
+        (wf/create (spec)) => nil
+        (wf/stop (spec)) => nil
+        (wf/puppetize redis-type (spec)) => (throws java.lang.AssertionError)
+        (wf/start (spec)) => nil
+        (wf/puppetize redis-type (spec)) => nil
+        (wf/destroy (spec)) => nil
+        ))
+    )))
+
+


Fix using namespaceless symbols for init-fns

Fixes #105

--- src/adzerk/boot_cljs/middleware.clj
+++ src/adzerk/boot_cljs/middleware.clj
@@ -58,7 +58,7 @@
         cljs-ns      (symbol (util/path->ns cljs-path))
         init-fns     (:init-fns main)
         requires     (into (sorted-set) (:require main))
-        init-nss     (into requires (map (comp symbol namespace) init-fns))]
+        init-nss     (into requires (->> init-fns (keep namespace) (map symbol)))]
     (when write-main?
       (.mkdirs out-file)
       (doto cljs-file


JC |20| Added some kerodon user flows

JC |20| Added some kerodon user flows

--- test/stonecutter/integration/kerodon.clj
+++ test/stonecutter/integration/kerodon.clj
@@ -5,17 +5,20 @@
             [stonecutter.storage :as s]
             [net.cgrand.enlive-html :as html]))

-(defn p [v] (prn v) v)
-
 (defn page-title-is [state title]
   (fact {:midje/name "Checking page title:"}
         (-> state :enlive (html/select [:title]) first html/text) => title)
-  state
-  )
+  state)

 (defn page-uri-is [state uri]
   (fact {:midje/name "Checking page uri:"}
-        (-> state :request :uri) => uri))
+        (-> state :request :uri) => uri)
+  state)
+
+(defn selector-has-content [state selector content]
+  (fact {:midje/name "Check content of element"}
+        (-> state :enlive (html/select selector) first html/text) => content)
+  state)

 (s/start-in-memory-datastore!)

@@ -25,3 +28,23 @@
            (k/follow-redirect)
            (page-title-is "Register")
            (page-uri-is "/register")))
+
+(facts "User is returned to same page when username is invalid"
+       (-> (k/session app)
+           (k/visit "/register")
+           (k/fill-in "Email address" "invalid-email")
+           (k/press "Create account")
+           (page-uri-is "/register")
+           (selector-has-content [:.clj--registration-email__validation] "Enter a valid email address")))
+
+(facts "User is taken to success page when user is successfully created"
+       (-> (k/session app)
+           (k/visit "/register")
+           (k/fill-in "Email address" "email@server.com")
+           (k/fill-in "Password" "valid-password")
+           (k/fill-in "Confirm password" "valid-password")
+           (k/press "Create account")
+           (page-uri-is "/register")
+           (selector-has-content [:body] "You saved the user")))
+
+


Use claypool in nnml.clj to improve IO throughput

--- src/net/dishevelled/mailindex/backends/nnml.clj
+++ src/net/dishevelled/mailindex/backends/nnml.clj
@@ -1,10 +1,14 @@
 (ns net.dishevelled.mailindex.backends.nnml
   (:require [clojure.java.io :refer [file reader]]
             [net.dishevelled.mailindex :refer [debug]]
-            [clojure.set])
+            [clojure.set]
+            [com.climate.claypoole :as cp]
+            [com.climate.claypoole.lazy :as cp-lazy])
   (:import (java.io InputStream FileInputStream ByteArrayOutputStream IOException)
            (java.util Date)
            (java.util.zip GZIPInputStream)))
+
+(def nnml-pool (cp/threadpool 16))

 (defn- mtime-to-days [mtime]
   (let [now (.getTime (Date.))]
@@ -108,10 +112,10 @@
              (set (remove (fn [msg] (not (messages msg)))
                           (clojure.set/union seen-messages new-messages)))))

-    (pmap (fn [msg]
-            {:id (filename-to-id base msg)
-             :content (message-bytes msg)})
-          new-messages)))
+    (cp-lazy/upmap nnml-pool (fn [msg]
+                               {:id (filename-to-id base msg)
+                                :content (message-bytes msg)})
+                   new-messages)))


do not wait till TS loaded on dashboard #446

--- src/cljs/swarmpit/component/dashboard.cljs
+++ src/cljs/swarmpit/component/dashboard.cljs
@@ -406,7 +406,5 @@
     (progress/form
       (or (:stats loading?)
           (:nodes loading?)
-          (:nodes-ts loading?)
-          (:services loading?)
-          (:services-ts loading?))
+          (:services loading?))
       (form-info item))))


saving.

saving.

--- src/clj/forma/hadoop/jobs/forma.clj
+++ src/clj/forma/hadoop/jobs/forma.clj
@@ -271,7 +271,7 @@
 (defbufferop [merge-series-wrapper [t-res nodata]]
   "defbufferop wrapper for `merge-series`."
   [tuples]
-  (let [consecutive true]
+  (let [consecutive false]
     (merge-series t-res nodata tuples :consecutive consecutive)))

 (defn array-val->series


use three columns

use three columns

--- src/clj/just_married/api/labels.clj
+++ src/clj/just_married/api/labels.clj
@@ -9,7 +9,7 @@
             [just-married.auth :refer [with-basic-auth]]
             [just-married.db :as db]))

-(def ^:private default-n-cols 3)
+(def ^:private default-n-cols 2)
 (def ^:private file-name "labels.pdf")
 (def ^:private default-font "Helvetica")


CMR-564: Removed unneeded file.

CMR-564: Removed unneeded file.

--- src/cmr/search/data/transformer.clj
+++ src/cmr/search/data/transformer.clj
@@ -1,9 +0,0 @@
-(ns cmr.search.data.transformer
-  "Provdes functions for retrieving formatted concepts."
-  (:require [cmr.transmit.transformer :as t]))
-
-(defn get-formatted-concepts
-  "Get concepts given by the concept-id, revision-id tuples in the
-  given format."
-  [context concept-tuples format]
-  (let [concepts "A"]))


Fix proc-fn creation.

Fix proc-fn creation.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -89,13 +89,14 @@
                     "pcap-json" pcap-byte-array-test-data
                     "nil" nil
                     )
+          proc-fn (create-proc-fn sample-pcap-processing-definition-json)
           pipeline-length (:pipeline-length options)
           pipeline (if (not (nil? in-data))
                      (create-local-processing-pipeline
                        (condp = scenario
                          "no-op" (create-no-op-proc-fns pipeline-length)
                          "factorial" (create-factorial-proc-fns pipeline-length)
-                         "pcap-json" [(fn [i _] (create-proc-fn sample-pcap-processing-definition-json))]
+                         "pcap-json" [(fn [i _] (proc-fn i))]
                          )
                        out-fn))
           in-fn (if (not (nil? in-data))


fix path to Latin lexicon

fix path to Latin lexicon

--- src/babel/latin.cljc
+++ src/babel/latin.cljc
@@ -2,7 +2,7 @@
   (:refer-clojure :exclude [get-in])
   (:require [babel.latin.morphology :as morph]
             [babel.lexiconfn :refer [default listify map-function-on-map-vals]]
-            [clojure.java.io :refer [reader resource]]
+            [clojure.java.io :refer [resource]]
             [clojure.repl :refer [doc]]
             [dag_unify.core :refer [fail? get-in unifyc]]))

@@ -18,7 +18,8 @@
       (default
        {:phrasal false})))

-(def lexicon (edn2lexicon "src/babel/latin/lexicon.edn"))
+(def lexicon
+  (edn2lexicon (resource "babel/latin/lexicon.edn")))

 (defn parse [surface]
   [{:parses (morph/analyze surface lexicon)}])
@@ -74,10 +75,6 @@
             base-spec)
        {:root (first (shuffle roots))})))

-
-
-
-
 (def model {:lexicon lexicon
             :fo fo
             :generate-fn generate})


Add commented versions with actual specs

--- src/com/wsscode/pathom/connect.cljc
+++ src/com/wsscode/pathom/connect.cljc
@@ -25,6 +25,9 @@

 (s/def ::resolve fn?)
 (s/def ::mutate fn?)
+
+; (s/def ::resolve (s/fspec :args (s/cat :env ::p/env :input map?) :ret map?))
+; (s/def ::mutate (s/fspec :args (s/cat :env ::p/env :params map?) :ret map?))

 (s/def ::resolver (s/keys :opt [::sym ::input ::output ::params ::resolve]))
 (s/def ::mutation (s/keys :opt [::sym ::input ::output ::params ::mutate]))


Fix wrap-cors (#42)

Fix wrap-cors (#42)

--- src/pigeon_backend/handler.clj
+++ src/pigeon_backend/handler.clj
@@ -6,7 +6,6 @@
             [ring.server.standalone :as ring]
             [environ.core :refer [env]]
             [pigeon-backend.db.migrations :as migrations]
-            [ring.middleware.cors :refer [wrap-cors]]
             [ring.middleware.reload :refer [wrap-reload]]
             [pigeon-backend.routes.registration :refer [registration-routes]]
             [pigeon-backend.services.exception-util :refer [handle-exception-info]]
@@ -15,11 +14,13 @@
             [buddy.sign.jws :as jws])
   (:gen-class))

-(defn wrap-cors-fn [handler]
-  (wrap-cors handler :access-control-allow-origin [#".*"]
-                     :access-control-allow-methods [:get :put :post :delete]
-                     :access-control-allow-credentials "true"
-                     :access-control-allow-headers "Content-Type, *"))
+(defn wrap-cors [handler]
+  (fn [request]
+    (let [response (handler request)]
+      (-> response
+          (assoc-in [:headers "Access-Control-Allow-Origin"] "*")
+          (assoc-in [:headers "Access-Control-Allow-Methods"] "GET,PUT,POST,DELETE,OPTIONS")
+          (assoc-in [:headers "Access-Control-Allow-Headers"] "X-Requested-With,Content-Type,Cache-Control")))))

 (def app
   (api
@@ -29,6 +30,7 @@
       :data {:info {:title "Sample API"
                     :description "Compojure Api example"}
              :tags [{:name "api", :description "some apis"}]}}
+     ;; TODO: exception handler for returning schema validation errors
      :exceptions {:handlers {:compojure.api.exception/default handle-exception-info}}}
     hello-routes
     registration-routes
@@ -44,7 +46,7 @@
           ; TODO: do not enable by default, but
           ; allow it to be enabled through app properties.
           wrap-reload
-          wrap-cors-fn
+          wrap-cors
           wrap-cookies)))

 (defn -main [& args]


cpus int mappings

cpus int mappings

--- src/es/systems.clj
+++ src/es/systems.clj
@@ -35,9 +35,9 @@
       :owner {:type "string" }
       :env {:type "string" :index "not_analyzed"}
       :machine {
-        :type "nested"
         :properties {
           :hostname {:type "string" :index "not_analyzed"}
+          :cpus {:type "integer"}
         }
       }
       :type {:type "string"}


Add missing docstring to to-atom function.

--- src/beicon/core.cljs
+++ src/beicon/core.cljs
@@ -415,6 +415,7 @@
    (.bufferWithCount ob n skip)))

 (defn to-atom
+  "Materialize the observable sequence into an atom."
   ([ob]
    (let [a (atom nil)]
      (to-atom a ob)))


Add proper exclude of clojure.core clashing functions from spec ns.

--- src/bytebuf/spec.clj
+++ src/bytebuf/spec.clj
@@ -1,5 +1,5 @@
 (ns bytebuf.spec
-  (:refer-clojure :exclude [type read])
+  (:refer-clojure :exclude [type read float double long short byte])
   (:require [bytebuf.proto :as proto :refer [IStaticSize]]
             [bytebuf.buffer :as buffer]
             [bytebuf.bytes :as bytes]))


[Add] post condition in _cross-validate

[Add] post condition in _cross-validate

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -184,7 +184,7 @@

 (defn _cross-validate
   ([dataset a b L]
-   {:pre [(instance? DataSet dataset) (integer? a) (integer? b) (> b a)]}
+   {:pre [(instance? DataSet dataset) (integer? a) (integer? b) (> b a) (integer? L)]}
    (let [test (DataSet. (data/extract-list (:classes dataset) a b)
                         (data/extract-list (:features dataset) a b))
          train (DataSet. (data/remove-list (:classes dataset) a b)


Added tag-enrichment; tagging for all types including when :autoconstructive true.

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -165,6 +165,11 @@
           ;; The probability of a child being reverted to its parent by a genetic operator that
           ;; has been made revertable, if the child is not as good as the parent on at least one
           ;; test case.
+
+          :tag-enrichment false
+          ;; When true, half of the atom generators will be tag-related instructions.
+          ;; Currently just assumes that all types for which tags are currently implemented
+          ;; are present.

           :autoconstructive false
           ;; If true, then :genetic-operator-probabilities will be {:autoconstruction 1.0},
@@ -556,7 +561,8 @@
                                   (fn [] (lrand-nth [true false]))))
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap)
-                                  (tag-instruction-erc [:integer :boolean :exec :float] 10000)))
+                                  (tag-instruction-erc
+                                    [:integer :boolean :exec :float :char :string :code] 10000)))
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap)
                                   (untag-instruction-erc 10000)))
@@ -577,7 +583,24 @@
              :atom-generators (remove #(= % 'autoconstructive_boolean_rand)
                                       (:atom-generators @push-argmap))))
     (swap! push-argmap assoc
-           :replace-child-that-exceeds-size-limit-with :empty)))
+           :replace-child-that-exceeds-size-limit-with :empty))
+  (when (:tag-enrichment argmap)
+    (swap! push-argmap assoc
+           :atom-generators (vec (concat (:atom-generators @push-argmap)
+                                         (take (count (:atom-generators @push-argmap))
+                                               (cycle [(tag-instruction-erc
+                                                         [:integer :boolean :exec :float
+                                                          :char :string :code] 10000)
+                                                       (untag-instruction-erc 10000)
+                                                       (tagged-instruction-erc 10000)
+                                                       'integer_tagged_instruction
+                                                       'integer_tag_exec_instruction
+                                                       'integer_tag_code_instruction
+                                                       'integer_tag_integer_instruction
+                                                       'integer_tag_float_instruction
+                                                       'integer_tag_boolean_instruction
+                                                       'integer_tag_char_instruction
+                                                       'integer_tag_string_instruction])))))))

 (defn reset-globals
   "Resets all Clojush globals according to values in @push-argmap. If an argmap argument is provided then it is loaded
@@ -591,3 +614,4 @@
   ([argmap]
    (load-push-argmap argmap)
    (reset-globals)))
+


Extra do block

Extra do block

--- src/icecap/api.clj
+++ src/icecap/api.clj
@@ -21,8 +21,7 @@
             blob (crypto/encrypt scheme cap-key encoded-plan)
             ch (create! store index blob)]
         (async/into {:cap cap} ch))
-      (do
-        (async/to-chan [(spy {:error error})])))))
+      (async/to-chan [(spy {:error error})]))))

 (defn execute-cap
   "Executes a capability."


Set up story ctx (with player) in separate fn.

--- src/isla/story.clj
+++ src/isla/story.clj
@@ -26,14 +26,15 @@
 (def room-defaults ["" "" 0 []])

 (defn init-story [story-str]
-  (let [initial-ctx {"my" (interpreter/instantiate-type (get types "_player"))}
-        env (interpreter/interpret
+  (let [env (interpreter/interpret
              (parser/parse story-str)
-             (library/get-initial-env types initial-ctx))
+             (library/get-initial-env types (get-story-ctx)))
         ctx (:ctx env)

         rooms (extract ctx (:type (get types "room")))
         player (first (extract ctx (:type (get types "_player"))))]
+(defn get-story-ctx []
+  {"my" (interpreter/instantiate-type (get types "_player"))})

     (Story. rooms player)))


new implicit types syntax is working

new implicit types syntax is working

--- src/latte/core.clj
+++ src/latte/core.clj
@@ -393,10 +393,10 @@
         (conform-statement :theorem args)]
             ;; handling of implicit parameter types
     (if-let [res (u/fetch-implicit-type-parameters params)]
-      (handle-implicit-type-parameters `defthm thm-name doc params body
+      (handle-implicit-type-parameters `defthm thm-name doc (:rest-params res) body
                                        (:implicit-types res)
                                        (symbol (str thm-name "-thm"))
-                                       (:new-params res))
+                                       (into [] (concat (:explicit-type-params res) (:rest-params res))))
       ;; no implicit type parameters
       (let [[status result] (handle-statement :theorem thm-name params body)]
         (if (= status :ko)
@@ -420,10 +420,10 @@
   (let [{thm-name :name doc :doc params :params body :body}
         (conform-statement :lemma args)]
     (if-let [res (u/fetch-implicit-type-parameters params)]
-      (handle-implicit-type-parameters `deflemma thm-name doc params body
+      (handle-implicit-type-parameters `deflemma thm-name doc (:rest-params res) body
                                        (:implicit-types res)
                                        (symbol (str thm-name "-lemma"))
-                                       (:new-params res))
+                                       (into [] (concat (:explicit-type-params res) (:rest-params res))))
       ;; no implicit type parameters
       (let [[status result] (handle-statement :lemma thm-name params body)]
         (if (= status :ko)
@@ -470,10 +470,10 @@
   (let [{thm-name :name doc :doc params :params body :body}
         (conform-statement :axiom args)]
     (if-let [res (u/fetch-implicit-type-parameters params)]
-      (handle-implicit-type-parameters `defaxiom thm-name doc params body
+      (handle-implicit-type-parameters `defaxiom thm-name doc (:rest-params res) body
                                        (:implicit-types res)
                                        (symbol (str thm-name "-ax"))
-                                       (:new-params res))
+                                       (into [] (concat (:explicit-type-params res) (:rest-params res))))
       ;; no implicit type parameters
       (let [[status result] (handle-statement :axiom thm-name params body)]
         (if (= status :ko)


Add docstrings

Add docstrings

--- src/fatlip/plot.cljs
+++ src/fatlip/plot.cljs
@@ -813,6 +813,8 @@

 (defn character-segments
+  "Takes character-level y info, and generates all the line segments for each
+  character's path"
   [char-ys]
   (->> char-ys
        (group-by :character)
@@ -821,6 +823,7 @@

 (defn get-segments-by-layer-character
+  "Takes character segments and organizes them by layer, and then by character"
   [char-segs layers]
   (let [layer-map (group-by #(-> % :dest :node :layer-id) char-segs)]
     (->> (drop 1 layers)
@@ -833,6 +836,9 @@

 (defn get-character-layer-pairs
+  "Generates a layer structure that mirrors the underlying graph, but with
+  characters as the things in the layers. Then it pairs these character layers
+  off with their adjacent layers"
   [layers characters]
   (let [char-layers (map (fn [layer]
                            (mapcat (fn [item]
@@ -845,6 +851,8 @@

 (defn order-group
+  "Modifies the :order attribute for segments in char-segs, for each character
+  named in `group`"
   [char-segs group order-attr]
   (first (reduce (fn [[segs i] char]
                    [(assoc-in segs [char order-attr :order] i)


CMR-183: Updated for new cache api

CMR-183: Updated for new cache api

--- src/cmr/indexer/services/index_service.clj
+++ src/cmr/indexer/services/index_service.clj
@@ -97,11 +97,13 @@

 (deftracefn clear-cache
-  "Delegate reset elastic indices operation to index-set app"
+  "Clear all caches."
   [context]
-  (info "Clearing the indexer application cache")
-  (cache/reset-cache (-> context :system :caches cache/general-cache-key))
-  (acl-cache/reset context))
+  (info "Clearing the indexer application caches")
+  (doall (map (fn [[k v]]
+                (debug "Clearing cache " k)
+                (cache/reset-cache v))
+              (get-in context [:system :caches]))))

 (deftracefn reset
   "Delegate reset elastic indices operation to index-set app"


Debugging problem w/ handshake from client

--- src/com/frereth/server/comms/registrar.clj
+++ src/com/frereth/server/comms/registrar.clj
@@ -59,6 +59,8 @@

 c.f. auth-socket's dispatch"
   [msg :- auth-socket/router-message]
+  (log/debug "Trying to supply the Action channel in response to:\n"
+             (util/pretty msg))
   (assoc msg
          :contents {:action-url {:port 7841  ; FIXME: magic number
                                  ;; TODO: Pull this from a config
@@ -77,6 +79,12 @@
   [->out :- com-skm/async-channel
    msg :- com-comm/router-message]
   (log/debug "Possibly authorizing to: " ->out)
+  ;; Major problems:
+  ;; 1. :contents is a lazy seq, 1 per frame
+  ;;    TODO: Just take first. Or enforce the 'one frame per message' at the protocol/socket level where it belongs
+  ;; 2. :contents is a [s/Keyword]. I'm really expecting a hashmap.
+  ;; Shouldn't really matter now: solution is to ignore and worry about later.
+  ;; But it will matter shortly, so I really hate to go down that path.
   (let [response-body (authcz (:contents msg))
         response (assoc msg :contents response-body)
         [sent? c] (async/alts!! [[->out response] (async/timeout 500)])]
@@ -87,19 +95,25 @@
 (s/defn do-registrations :- com-skm/async-channel
   ;; TODO: This really seems like it should be a defnk
   [{:keys [done event-loop ex-chan]} :- Registrar]
+  (log/debug "Entering do-registrations loop")
   (let [interface (:interface event-loop)
         ->out (:in-chan interface)
-        in<- ex-chan
+        in<- (:ex-chan event-loop)
         raw-sources [done in<-]
         minutes-5 (partial async/timeout (* 5 (util/minute)))]
-    (async/go-loop [[v c] (async/alts! (conj raw-sources (minutes-5)))]
-      (if (= c done)
-        (log/debug "do-registrations loop stop signalled")
-        (do
-          (if v
-            (possibly-authorize ->out v)
-            (log/debug "do-registrations: heartbeat"))
-          (recur (async/alts! (conj raw-sources (async/timeout (minutes-5))))))))))
+    (async/go
+      (loop [[v c] (async/alts! (conj raw-sources (minutes-5)))]
+        (if (= c done)
+          (log/debug "do-registrations loop stop signalled")
+          (do
+            (if v
+              (try
+                (possibly-authorize ->out v)
+                (catch Exception ex
+                  (log/error ex "Trying to authorize:\n" v)))
+              (log/debug "do-registrations: heartbeat"))
+            (recur (async/alts! (conj raw-sources (async/timeout (minutes-5))))))))
+      (log/debug "do-registration: Exiting"))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public


Format & document

Format & document

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -12,15 +12,30 @@
             [detritus.var :refer [var->ns var->sym macro?]]))

 (defn var->type
-
+  "Function from a var to the type of the var.
+
+  - Vars tagged as dynamic or satisfying the .isDynamic predicate are tagged
+    as :var values.
+  - Vars tagged as macros (as required by the macro contract) are tagged
+    as :macro values.
+  - Vars with fn? or MultiFn values are tagged as :fn values.
+  - All other vars are simply tagged as :var."
   [v]
   {:pre [(var? v)]}
   (let [m (meta v)]
-    (cond (:macro m)                            :macro
+    (cond (:macro m)
+          ,,:macro
+
           (or (:dynamic m)
-              (.isDynamic ^clojure.lang.Var v)) :var
-              (fn? @v)                          :fn
-              :else                             :var)))
+              (.isDynamic ^clojure.lang.Var v))
+          ,,:var
+
+          (or (fn? @v)
+              (instance? clojure.lang.MultiFn @v))
+          ,,:fn
+
+          :else
+          ,,:var)))

 (defn var->thing


simpler code

simpler code

no need to use seq, every?, set, let ... no need to repeat hash lookup

--- rna-transcription/example.clj
+++ rna-transcription/example.clj
@@ -1,17 +1,13 @@
 (ns rna-transcription)

-(def dna->rna {
-      \C \G
-      \G \C
-      \A \U
-      \T \A})
+(def dna->rna {\G \C
+               \C \G
+               \A \U
+               \T \A})

-(defn validate-strand [strand]
-  (let [valid-dna (set (keys dna->rna))]
-    (every? valid-dna strand)))
+(defn- translate [c]
+  {:post [%]}
+  (dna->rna c))

-(defn to-rna
-  [strand]
-  {:pre [(validate-strand strand)]}
-  (apply str
-    (map dna->rna (seq strand))))
+(defn to-rna [dna]
+  (apply str (map translate dna)))


STORM-1522 should create error worker log location only when error-host and error-port are available

--- storm-core/src/clj/org/apache/storm/ui/core.clj
+++ storm-core/src/clj/org/apache/storm/ui/core.clj
@@ -148,8 +148,10 @@
   (logviewer-link host (Utils/eventLogsFilename topology-id port) secure?))

 (defn worker-log-link [host port topology-id secure?]
-  (let [fname (Utils/logsFilename topology-id port)]
-    (logviewer-link host fname secure?)))
+  (if (or (empty? host) (let [port_str (str port "")] (or (empty? port_str) (= "0" port_str))))
+    ""
+    (let [fname (Utils/logsFilename topology-id port)]
+      (logviewer-link host fname secure?))))

 (defn nimbus-log-link [host]
   (url-format "http://%s:%s/daemonlog?file=nimbus.log" host (*STORM-CONF* LOGVIEWER-PORT)))


[SD] whitespace

[SD] whitespace

--- test/vip/data_processor/validation/xml_with_postgres_test.clj
+++ test/vip/data_processor/validation/xml_with_postgres_test.clj
@@ -18,10 +18,10 @@
                           load-xml-ltree]}
           out-ctx (pipeline/run-pipeline ctx)]
       (is (= (-> (korma/select psql/xml-tree-values
-                     (korma/where {:results_id (:import-id out-ctx)})
-                     (korma/where (psql/ltree-match psql/xml-tree-values
-                                                    :path
-                                                    "VipObject.0.Source.*{1}.VipId.*{1}")))
+                   (korma/where {:results_id (:import-id out-ctx)})
+                   (korma/where (psql/ltree-match psql/xml-tree-values
+                                                  :path
+                                                  "VipObject.0.Source.*{1}.VipId.*{1}")))
                  first
                  :value)
              "51")))))
@@ -49,11 +49,11 @@
                  :error_data)
              "\"ele0001\""))
       (is (= (->> (korma/select psql/xml-tree-validations
-                   (korma/where {:results_id (:import-id out-ctx)
-                                 :path nil}))
-                 (map :error_data)
-                 set)
-             #{"\".exemell\"" "\".seeesvee\""})))))
+                    (korma/where {:results_id (:import-id out-ctx)
+                                  :path nil}))
+                  (map :error_data)
+                  set)
+             #{"\".exemell\"" "\".seeesvee\""}))))

 (deftest ^:postgres validate-emails-test
   (testing "adds errors to the context for badly formatted emails"


Added Solarized Color Theme

Added Solarized Color Theme

--- src/NoteHub/views/css_generator.clj
+++ src/NoteHub/views/css_generator.clj
@@ -42,6 +42,13 @@
                   :link {:fresh :#6b8
                          :visited :#496
                          :hover :#7c9 }}
+           :solarized {:background :#073642
+                       :foreground :#93a1a1
+                       :background-halftone :#002b36
+                       :foreground-halftone :#eee8d5
+                       :link {:fresh :#cb4b16
+                              :visited :#b58900
+                              :hover :#dc322f }}
            :default {:background :#fff
                      :foreground :#333
                      :background-halftone :#efefef


hacked in sudo passwords for testing

hacked in sudo passwords for testing

--- src/matross/core.clj
+++ src/matross/core.clj
@@ -2,7 +2,7 @@
   (:require [clojure.tools.cli :refer [parse-opts]]
             [matross.connections.ssh]
             [matross.connections.local]
-            [matross.connections.core :refer [connect disconnect run]]
+            [matross.connections.core :refer [connect disconnect run sudo-runner]]
             [matross.model.core :as model])
   (:gen-class))

@@ -11,7 +11,8 @@
                            {:type :local}]})

 (def cli-opts
-  [["-h" "--help"]])
+  [["-h" "--help"]
+   ["-K" "--ask-sudo-pass"]])

 (defn get-sensitive-user-input [prompt]
   (let [console (. System console)
@@ -20,18 +21,20 @@
       (-> console (.readPassword padded-prompt nil) String/valueOf)
       (throw (Exception. "Could not find system console.")))))

-(defn test-run-connection! [conn test-command]
+(defn test-run-connection! [conn test-command pass]
   (connect conn)
-  (let [{exit :exit :as result} (run conn {:cmd [test-command]})]
-    (prn {:exit @exit
-          :out (me.raynes.conch.low-level/stream-to-string result :out)
-          :err (me.raynes.conch.low-level/stream-to-string result :err)}))
+  (let [conn (if pass (sudo-runner conn "root" pass) conn)]
+    (let [{exit :exit :as result} (run conn {:cmd [test-command]})]
+      (prn {:exit @exit
+            :out (me.raynes.conch.low-level/stream-to-string result :out)
+            :err (me.raynes.conch.low-level/stream-to-string result :err)})))
   (disconnect conn))

 (defn -main [& args]
   (let [opts (parse-opts args cli-opts)
-        {:keys [connections]} (model/prepare config)]
+        {:keys [connections]} (model/prepare config)
+        password (if (get-in opts [:options :ask-sudo-pass]) (get-sensitive-user-input "Sudo Password"))]
     (if (get-in opts [:options :help])
       (prn "matross!")
-      (doseq [c connections] (test-run-connection! c "whoami")))
+      (doseq [c connections] (test-run-connection! c "whoami" password)))
     (shutdown-agents)))


Use nio for copying files when archiving

--- src/mdr2/archive.clj
+++ src/mdr2/archive.clj
@@ -39,7 +39,6 @@
             [clj-time.core :as t]
             [clj-time.coerce :refer [to-date]]
             [org.tobereplaced.nio.file :as nio]
-            [me.raynes.fs :as fs]
             [mdr2.production :as prod]
             [mdr2.production.path :as path]
             [mdr2.repair :as repair]
@@ -142,20 +141,21 @@
   files. For a production distribution master copy the isos"
   [production sektion]
   (let [archive-root-path (container-root-path production sektion)]
-    (if (fs/exists? archive-root-path)
+    (if (nio/exists? archive-root-path)
       (log/errorf "Archive root path %s already exists" archive-root-path)
       (let [archive-path (container-path production sektion)]
-        (fs/mkdir archive-root-path)
+        (nio/create-directory! archive-root-path)
         (log/debugf "Copying files for %s (%s)" (:id production) sektion)
         (case sektion
           :master
-          (fs/copy-dir (path/recorded-path production)
-                       (file archive-path (prod/dam-number production)))
+          (util/copy-directory! (path/recorded-path production)
+                                (file archive-path (prod/dam-number production)))
           :dist-master
           (doseq [volume (range 1 (inc (:volumes production)))]
             (let [iso-archive-name (str (container-id production sektion volume) ".iso")
                   iso-archive-path (.getPath (file archive-path iso-archive-name))]
-              (fs/copy+ (path/iso-name production volume) iso-archive-path))))
+              (nio/create-directories! iso-archive-path)
+              (nio/copy! (path/iso-name production volume) iso-archive-path))))
         (set-file-permissions archive-root-path)))))

 (defn- create-rdf
@@ -199,7 +199,7 @@
    (let [dam-number (prod/dam-number production)
          archive-path (.getPath (file periodical-spool-dir dam-number))
          multi-volume? (prod/multi-volume? production)]
-     (when (fs/exists? archive-path)
+     (when (nio/exists? archive-path)
        ;; when repairing the production is already in the spool dir
        (log/warnf "Archive path %s for periodical already exists, removing" archive-path)
        (util/delete-directory! archive-path))
@@ -212,7 +212,8 @@
      (doseq [volume (range 1 (inc (:volumes production)))]
        (let [iso-archive-name (str dam-number (when multi-volume? (str "_" volume)) ".iso")
              iso-archive-path (.getPath (file archive-path "produkt" iso-archive-name))]
-         (fs/copy+ (path/iso-name production volume) iso-archive-path)))
+         (nio/create-directories! iso-archive-path)
+         (nio/copy! (path/iso-name production volume) iso-archive-path)))
      (set-file-permissions (file archive-path))
      (prod/set-state-archived! production))))

@@ -224,7 +225,7 @@
    (let [dam-number (prod/dam-number production)
          archive-path (.getPath (file other-spool-dir dam-number))
          multi-volume? (prod/multi-volume? production)]
-     (when (fs/exists? archive-path)
+     (when (nio/exists? archive-path)
        ;; when repairing the production is already in the spool dir
        (log/warnf "Archive path %s for other production already exists, removing" archive-path)
        (util/delete-directory! archive-path))
@@ -237,6 +238,7 @@
      (doseq [volume (range 1 (inc (:volumes production)))]
        (let [iso-archive-name (str dam-number (when multi-volume? (str "_" volume)) ".iso")
              iso-archive-path (.getPath (file archive-path "produkt" iso-archive-name))]
-         (fs/copy+ (path/iso-name production volume) iso-archive-path)
+         (nio/create-directories! iso-archive-path)
+         (nio/copy! (path/iso-name production volume) iso-archive-path)
          (set-file-permissions (file iso-archive-path))))
      (prod/set-state-archived! production))))


Ability to add or change reviews. Don't return nasty xml to the client

--- src/myshelf/core.clj
+++ src/myshelf/core.clj
@@ -9,7 +9,9 @@
             [myshelf.books :refer [find-book-by-title]]
             [myshelf.friends :refer [get-user-friends]]
             [myshelf.rank :refer [rank-books]]
-            [myshelf.reviews :refer [add-book-review]]
+            [myshelf.reviews :refer [add-book-review
+                                     get-book-review
+                                     edit-book-review]]
             [myshelf.shelves :refer [add-book-to-shelf
                                      find-book-on-shelves
                                      get-all-books-on-shelf]]
@@ -17,14 +19,28 @@
             [server.socket :as s])
   (:gen-class))

+(defn check-response
+  [resp]
+  (if (string? resp)
+    resp
+    (when (= 200 (:status resp))
+      "Success!")))
+
 (defn add-book-review-by-title
   [consumer access-token user-id title rating & [review-text]]
   (if-let [shelved-id (:id (first (find-book-on-shelves consumer
                                                         access-token
                                                         user-id
                                                         title)))]
-    (add-book-review consumer access-token shelved-id rating
-                     review-text)
+    (if-let [review-id (first
+                        (:content
+                         (first
+                          (get-book-review consumer access-token
+                                           user-id shelved-id))))]
+      (edit-book-review consumer access-token review-id rating
+                        review-text)
+      (add-book-review consumer access-token shelved-id rating
+                       review-text))
     "Could not find book on shelves"))

 (defn rank-books-on-shelf
@@ -68,19 +84,27 @@
             *out* (writer outs)]
     (try
       (let [incoming (read-line)
-            [cmd args] (clojure.string/split incoming #"\|")
+            [cmd arg-1 arg-2] (clojure.string/split incoming #"\|")
             ret (cond
                   (= "find" cmd) (find-book consumer
                                             access-token
-                                            args)
-                  (= "add" cmd) (add-book-to-shelf consumer access-token
-                                                   args "to-read")
+                                            arg-1)
+                  (= "add" cmd) (check-response
+                                 (add-book-to-shelf consumer access-token
+                                                    arg-1 "to-read"))
                   (= "rank" cmd) (rank-to-read-books consumer access-token
                                                      user-id)
                   (= "export" cmd) (export-shelf consumer
                                                  access-token
                                                  user-id
-                                                 args))]
+                                                 arg-1)
+                  (= "review" cmd) (check-response
+                                    (add-book-review-by-title
+                                     consumer
+                                     access-token
+                                     user-id
+                                     arg-1
+                                     arg-2)))]
         (println ret))
       (catch Exception ex
         (println "oh noes!" (.getMessage ex))))))


remove extra indent

remove extra indent

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -28,9 +28,9 @@
   "Routes requests to their handler function. Captures dynamic variables."
   (GET "/summary/:user" [user] (json-response (get-overall-summary user)))
   (POST "/login" [username password]
-      (if (authenticate username password)
-        (json-response {"token" (auth-token (get-user username)) "user" username} 200)
-        (json-response {"error" "Authentication failed"} 401)))
+    (if (authenticate username password)
+      (json-response {"token" (auth-token (get-user username)) "user" username} 200)
+      (json-response {"error" "Authentication failed"} 401)))
   (GET "/secret" {params :params cookies :cookies} (is-authenticated? params cookies (json-response {"secret" "ken sent me"})))

   (route/resources "/")