Get metronome display started.

Get metronome display started.

Refactored so multiple Push bindings to individual shows can be
supported, and started the UI update system.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -4,18 +4,19 @@
   {:author "James Elliott"
    :doc/format :markdown}
   (:require [afterglow.controllers :as controllers]
+            [afterglow.rhythm :refer :all]
+            [afterglow.show :as show]
             [afterglow.util :as util]
             [clojure.math.numeric-tower :as math]
             [environ.core :refer [env]]
             [com.evocomputing.colors :as colors]
             [overtone.midi :as midi]
             [overtone.at-at :as at-at]
-            [taoensso.timbre :refer [warn]]))
-
-(defonce user-port-out (atom nil))
-(defonce live-port-out (atom nil))
-(defonce last-display (for [_ (range 4)] (byte-array (take 68 (repeat 32)))))
-(defonce next-display (for [_ (range 4)] (byte-array (take 68 (repeat 32)))))
+            [taoensso.timbre :refer [warn]])
+  (:import [java.util Arrays]))
+
+;; TODO: Move globals into a map allocated when binding to a show, so
+;;       multiple controllers can be active at once.

 (defn velocity-for-color
   "Given a target color, calculate the MIDI note velocity which will
@@ -58,10 +59,10 @@
 (defn set-pad-color
   "Set the color of one of the 64 touch pads to the closest
   approximation available for a desired color."
-  [x y color]
+  [controller x y color]
   {:pre [(<= 0 x 7) (<= 0 y 7)]}
   (let [note (+ 36 x (* y 8))]  ;; Calculate note from grid coordinates
-    (midi/midi-note-on @user-port-out note (velocity-for-color color))))
+    (midi/midi-note-on (:user-port-out controller) note (velocity-for-color color))))

 (def monochrome-button-states
   "The control values and modes for a labeled button which does not
@@ -137,65 +138,158 @@

    })

-(defn set-button-state
-  "Set one of the labeled buttons to a particular state, and, if
-  supported, color."
+(defn button-state
+  "Calculate the numeric value that corresponds to a particular
+  named state for the specified button, and (if supported and
+  supplied), a named color."
   ([button state]
-   (set-button-state button state :amber))
+   (button-state button state :amber))
   ([button state color-key]
    (let [base-value ((keyword state) monochrome-button-states)
          color-shift (or (when (and (= (:kind button) :color)
                                     (not= state :off))
                            ((keyword color-key) color-button-colors))
                          0)]
-     (midi/midi-control @user-port-out (:control button)
-                        (+ base-value color-shift)))))
-
-(defn set-track-select-state
-  "Set one of the top-row pads to a particular state and color."
+     (+ base-value color-shift))))
+
+(defn set-button-state
+  "Set one of the labeled buttons to a particular state, and, if
+  supported, color. If the state is already a number, it is used
+  as-is, otherwise it is calculated using button-state."
+  ([controller button state]
+   (set-button-state controller button state :amber))
+  ([controller button state color-key]
+   (let [state (if (number? state)
+                 state
+                 (button-state button state color-key))]
+     (midi/midi-control (:user-port-out controller) (:control button) state))))
+
+(defn track-select-state
+  "Calculate the numeric value that corresponds to a particular
+  named state for the specified top-row pad, and (if supplied),
+  named color."
   ([x state]
-   (set-track-select-state x state :amber))
+   (track-select-state x state :amber))
   ([x state color-key]
    {:pre [(<= 0 x 7)]}
    (let [base-value ((keyword state) monochrome-button-states)
          color-shift (or (when-not (= state :off)
                            ((keyword color-key) color-button-colors))
                          0)]
-     (midi/midi-control @user-port-out (+ x 20) (+ base-value color-shift)))))
+     (+ base-value color-shift))))
+
+(defn set-track-select-state
+  "Set one of the top-row pads to a particular state and color.
+  If state is already a number, it is used as-is, otherwise it is
+  calculated using track-select-state."
+  ([controller x state]
+   (set-track-select-state controller x state :amber))
+  ([controller x state color-key]
+   {:pre [(<= 0 x 7)]}
+   (let [state (if (number? state)
+                 state
+                 (track-select-state x state color-key))]
+     (midi/midi-control (:user-port-out controller) (+ x 20) state))))

 (defn set-scene-launch-color
   "Set the color of one of the 8 scene-launch touch pads (right above
   the 8x8 pad of larger, velocity sensitive, pads) to the closest
   approximation available for a desired color."
-  [x color]
+  [controller x color]
   {:pre [(<= 0 x 7)]}
   (let [control (+ 102 x)]  ;; Calculate controller number
-    (midi/midi-control @user-port-out control (velocity-for-color color))))
+    (midi/midi-control (:user-port-out controller) control (velocity-for-color color))))

 (defn set-display-line
   "Sets a line of the text display."
-  [line bytes]
-  {:pre [(<= 1 line 4)]}
-  (let [message (concat [240 71 127 21 (+ line 23) 0 69 0]
+  [controller line bytes]
+  {:pre [(<= 0 line 3)]}
+  (let [message (concat [240 71 127 21 (+ line 24) 0 69 0]
                         (take 68 (concat (map int bytes) (repeat 32)))
                         [247])]
-    (midi/midi-sysex @live-port-out message)))
+    (midi/midi-sysex (:live-port-out controller) message)))

 (defn clear-display-line
   "Clears a line of the text display."
-  [line]
-  {:pre [(<= 1 line 4)]}
-  (midi/midi-sysex @live-port-out [240 71 127 21 (+ line 27) 0 0 247]))
-
-(defn show-labels
-  "Illuminates all buttons with text labels"
-  ([]
-   (show-labels :bright :amber))
-  ([state]
-   (show-labels state :amber))
-  ([state color]
+  [controller line]
+  {:pre [(<= 0 line 3)]}
+  (midi/midi-sysex (:live-port-out controller) [240 71 127 21 (+ line 28) 0 0 247]))
+
+(defn- show-labels
+  "Illuminates all buttons with text labels, for development assistance."
+  ([controller]
+   (show-labels controller :bright :amber))
+  ([controller state]
+   (show-labels controller state :amber))
+  ([controller state color]
    (doseq [[_ button] control-buttons]
-     (set-button-state button state color))))
+     (set-button-state controller button state color))))
+
+(defn update-text
+  "Sees if any text has changed since the last time the display
+  was updated, and if so, sends the necessary MIDI SysEx values
+  to update it on the Push."
+  [controller]
+  (doseq [row (range 4)]
+    (when-not (.equals (get (:next-display controller) row)
+                       (get (:last-display controller) row))
+      (set-display-line controller row (get (:next-display controller) row))
+      (System/arraycopy (get (:next-display controller) row) 0
+                        (get (:last-display controller) row) 0 68))))
+
+(defn update-text-buttons
+  "Sees if any labeled buttons have changed state since the last time
+  the interface was updated, and if so, sends the necessary MIDI
+  control values to update them on the Push."
+  [controller]
+  ;; First turn off any which were on before but no longer are
+  (doseq [[button old-state] @(:last-text-buttons controller)]
+    (when-not (button @(:next-text-buttons controller))
+      (when-not (#{0 :off} old-state)
+        (set-button-state controller button :off))))
+
+  ;; Then, set any currently requested states
+  (doseq [[button state] @(:next-text-buttons controller)]
+    (set-button-state controller button state))
+
+  ;; And record the new state for next time
+  (reset! (:last-text-buttons controller) @(:next-text-buttons controller)))
+
+(defn write-display-cell
+  "Update a single text cell (of which there are four per row) in the
+  display to be rendered on the next update."
+  [controller row cell text]
+  {:pre [(<= 0 row 3) (<= 0 cell 3)]}
+  (let [bytes (take 17 (concat (map int text) (repeat 32)))]
+    (doseq [[i val] (map-indexed vector bytes)]
+      (aset (get (:next-display controller) row) (+ (* cell 17) i) (util/ubyte val)))))
+
+(defn update-interface
+  "Determine the desired current state of the interface, and send any
+  changes needed to get it to that state."
+  [controller]
+  (try
+    ;; Assume we are starting out with a blank interface.
+    (for [row (range 4)]
+      (Arrays/fill (get (:next-display controller) row) (byte 32)))
+    (reset! (:next-text-buttons controller) {})
+
+    ;; TODO: Loop over the most recent four active cues, rendering information
+    ;;       about them.
+
+    (let [metronome-button (:metronome control-buttons)]
+      (if @(:metronome-mode controller)
+        (let [metronome (:metronome (:show controller))]
+          (swap! (:next-text-buttons controller)
+                 assoc metronome-button (button-state metronome-button :bright))
+          (write-display-cell controller 3 0 (metro-marker metronome)))
+        (swap! (:next-text-buttons controller)
+               assoc metronome-button (button-state metronome-button :dim))))
+
+    (update-text controller)
+    (update-text-buttons controller)
+    (catch Throwable t
+      (warn t "Problem updating Ableton Push Interface"))))

 (declare clear-interface)

@@ -203,110 +297,152 @@
   "Render a frame of the welcome animation, or if it is done, start
   the main interface update thread, and terminate the task running the
   animation."
-  [counter task]
+  [controller counter task]
   (try
     (cond
       (< @counter 8)
       (doseq [y (range 0 (inc @counter))]
         (let [color (com.evocomputing.colors/create-color
                      :h 0 :s 0 :l (max 10 (- 50 (/ (* 50 (- @counter y)) 4))))]
-          (set-pad-color 3 y color)
-          (set-pad-color 4 y color)))
+          (set-pad-color controller 3 y color)
+          (set-pad-color controller 4 y color)))

       (< @counter 12)
       (doseq [x (range 0 (- @counter 7))
               y (range 0 8)]
         (let [color (com.evocomputing.colors/create-color
                      :h 340 :s 100 :l (if (= x (- @counter 8)) 75 50))]
-          (set-pad-color (- 3 x) y color)
-          (set-pad-color (+ 4 x) y color)))
+          (set-pad-color controller (- 3 x) y color)
+          (set-pad-color controller (+ 4 x) y color)))

       (< @counter 15)
       (doseq [y (range 0 8)]
         (let [color (com.evocomputing.colors/create-color
                      :h (* 13 (- @counter 11)) :s 100 :l 50)]
-          (set-pad-color (- @counter 7) y color)
-          (set-pad-color (- 14 @counter) y color)))
+          (set-pad-color controller (- @counter 7) y color)
+          (set-pad-color controller (- 14 @counter) y color)))

       (= @counter 15)
-      (show-labels :bright :amber)
+      (show-labels controller :bright :amber)

       (= @counter 16)
       (doseq [x (range 0 8)]
-        (set-track-select-state x :bright :amber))
+        (set-track-select-state controller x :bright :amber))

       (= @counter 17)
       (doseq [x (range 0 8)]
-        (set-scene-launch-color x (com.evocomputing.colors/create-color :h 45 :s 100 :l 50))
-        (set-track-select-state x :bright :red))
+        (set-scene-launch-color controller x
+                                (com.evocomputing.colors/create-color :h 45 :s 100 :l 50))
+        (set-track-select-state controller x :bright :red))

       (< @counter 26)
       (doseq [x (range 0 8)]
         (let [color (com.evocomputing.colors/create-color
                      :h (+ 60 (* 40 (- @counter 18))) :s 100 :l 50)]
-          (set-pad-color x (- 25 @counter) color)))
+          (set-pad-color controller x (- 25 @counter) color)))

       (= @counter 26)
       (do
-        (show-labels :dim :amber)
+        (show-labels controller :dim :amber)
         (doseq [x (range 0 8)]
-          (set-track-select-state x :off)))
+          (set-track-select-state controller x :off)))

       (= @counter 27)
       (doseq [x (range 0 8)]
-          (set-scene-launch-color x off-color))
-
-      (< @counter 37)
+          (set-scene-launch-color controller x off-color))
+
+      (< @counter 36)
       (doseq [x (range 0 8)]
-        (set-pad-color x (- 35 @counter) off-color))
+        (set-pad-color controller x (- 35 @counter) off-color))

       :else
       (do
-        (clear-interface)
-        ;;
+        (clear-interface controller)
+        (reset! (:task controller) (at-at/every (:refresh-interval controller)
+                                                #(update-interface controller)
+                                                controllers/pool))
         (at-at/kill @task)))
     (catch Throwable t
       (warn t "Animation frame failed")))

   (swap! counter inc))

-
 (defn welcome-animation
   "Provide a fun animation to make it clear the Push is online."
-  []
-  (set-display-line 1 (concat (repeat 24 \space) (seq "Welcome toAfterglow")))
-  (set-display-line 3 (concat (repeat 27 \space)
+  [controller]
+  (set-display-line controller 0 (concat (repeat 24 \space) (seq "Welcome toAfterglow")))
+  (set-display-line controller 2 (concat (repeat 27 \space)
                               (seq (str "version" (env  :afterglow-version)))))
   (let [counter (atom 0)
         task (atom nil)]
-    (reset! task (at-at/every 30 #(welcome-frame counter task)
+    (reset! task (at-at/every 30 #(welcome-frame controller counter task)
                               controllers/pool))))

 (defn clear-interface
   "Clears the text display and all illuminated buttons and pads."
-  []
-  (doseq [line (range 1 5)]
-    (clear-display-line line))
+  [controller]
+  (doseq [line (range 4)]
+    (clear-display-line controller line))
   (doseq [x (range 8)]
-    (set-track-select-state x :off)
-    (set-scene-launch-color x off-color)
+    (set-track-select-state controller x :off)
+    (set-scene-launch-color controller x off-color)
     (doseq [y (range 8)]
-      (set-pad-color x y off-color)))
+      (set-pad-color controller x y off-color)))
   (doseq [[_ button] control-buttons]
-    (set-button-state button :off)))
-
-
-(defn connect-to-push
-  "Try to establish the connection to the Ableton Push, if that has
-  not already been made, initialize the display, and start the UI
+    (set-button-state controller button :off)))
+
+(defonce ^{:doc "Counts the controller bindings which have been made,
+  so each can be assigned a unique ID."}
+  controller-counter (atom 0))
+
+(defonce ^{:doc "Controllers which are currently bound to shows,
+  indexed by the controller binding ID."}
+  active-bindings (atom {}))
+
+(defn bind-to-show
+  "Establish a connection to the Ableton Push, for managing the
+  given show. Initialize the display, and start the UI
   updater thread. Since SysEx messages are required for updating the
   display, assumes that if you are on a Mac, you have installed
   [mmj](http://www.humatic.de/htools/mmj.htm) to provide a
   working implementation."
   {:doc/format :markdown}
-  [& {:keys [prefix] :or {prefix (when (re-find #"Mac" (System/getProperty "os.name"))
-                                   "Ableton Push - ")}}]
-  (swap! user-port-out #(or % (midi/midi-out (str prefix "User Port"))))
-  (swap! live-port-out #(or % (midi/midi-out (str prefix "Live Port"))))
-  (clear-interface)
-  (welcome-animation))
+  [show & {:keys [prefix refresh-interval]
+           :or {prefix (when (re-find #"Mac" (System/getProperty "os.name"))
+                         "Ableton Push - ")
+                refresh-interval show/default-refresh-interval}}]
+  (let [controller
+        {:id (swap! controller-counter inc)
+         :show show
+         :refresh-interval refresh-interval
+         :user-port-out (midi/midi-out (str prefix "User Port"))
+         :live-port-out (midi/midi-out (str prefix "Live Port"))
+         :task (atom nil)
+         :last-display (vec (for [_ (range 4)] (byte-array (take 68 (repeat 32)))))
+         :next-display (vec (for [_ (range 4)] (byte-array (take 68 (repeat 32)))))
+         :last-text-buttons (atom {})
+         :next-text-buttons (atom {})
+         :metronome-mode (atom true)
+         }]
+    (clear-interface controller)
+    (welcome-animation controller)
+    (swap! active-bindings assoc (:id controller) controller)
+    controller))
+
+(defn deactivate
+  "Deactivates a controller interface, killing its update thread
+  and removing its MIDI listeners."
+  [controller]
+  (swap! (:task controller) (fn [task]
+                              (when task (at-at/kill task))
+                              nil))
+  (clear-interface controller)
+  ;; TODO: Remove any MIDI listeners which have been set up.
+
+  (swap! active-bindings dissoc (:id controller)))
+
+(defn deactivate-all
+  "Deactivates all controller bindings which are currently active."
+  []
+  (doseq [[_ controller] @active-bindings]
+    (deactivate controller)))


Fixed issue #19

Fixed issue #19

--- src/alfresco_technical_validation/main.clj
+++ src/alfresco_technical_validation/main.clj
@@ -98,7 +98,7 @@
             (let [spinner (start-spinner)]
               (atv/validate source binaries neo4j-url report-filename)
               (.interrupt ^Thread spinner))
-            (println (str "\033[26D" (ava/green "✔") " " report-filename))
+            (println (str "\033[1G\033[2K" (ava/green "✔") " " report-filename))
             (flush))))
       nil)
     (catch Exception e


cljs: use stringToByteArray instead of stringToUtf8ByteArray

Our array only conatains ascii code.

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- src/emulator_4917/core.cljc
+++ src/emulator_4917/core.cljc
@@ -24,7 +24,7 @@
            (->  (nodejs/require "fs")
                 (.readFileSync file "ascii")
                 .toString
-                gcrypt/stringToUtf8ByteArray)
+                gcrypt/stringToByteArray)
            ))))

 (defn -main [& args]


Make sure we always conj to the end

Make sure we always conj to the end

--- src/exploud/util.clj
+++ src/exploud/util.clj
@@ -49,7 +49,6 @@
   "Appends the given message to the task's `:log`, creating a new one if it
    doesn't exist."
   [message task]
-  (let [updated-log (conj (or (:log task) [])
-                          {:message message
-                           :date (time/now)})]
+  (let [updated-log (conj (vec (:log task))
+                          {:message message :date (time/now)})]
     (assoc task :log updated-log)))


(maint) Workaround binary template test failure

Temporarily force puppet to use pson for serialization. This will be removed
once Puppet learns how to automatically downgrade from json to pson
serialization.

--- test/puppetlabs/puppetdb/integration/file_with_binary_template.clj
+++ test/puppetlabs/puppetdb/integration/file_with_binary_template.clj
@@ -14,11 +14,16 @@
           binary-template-path (fs/absolute "test-resources/binary-template.erb")]

       (testing "Run puppet with a binary template"
-        (int/run-puppet-as "binary-file-agent" ps pdb
-                           (str "file { '" file-resource-path "':"
-                                "  content => template('" binary-template-path "'),"
-                                "  tag => 'binary_file',"
-                                "}")))
+        (int/run-puppet ps pdb
+                        (str "file { '" file-resource-path "':"
+                             "  content => template('" binary-template-path "'),"
+                             "  tag => 'binary_file',"
+                             "}")
+                        {:certname "binary-file-agent"
+                         ;; this is a workaround for puppet's present inability to automatically
+                         ;; downgrade from json to pson; it will be removed once
+                         ;; that feature is added.
+                         :extra-puppet-args ["--preferred_serialization_format" "pson"]}))

       (testing "PDB should have stored the resource"
         (is (= {:certname "binary-file-agent"


implementing delete and status

implementing delete and status

--- src/gce/provider.clj
+++ src/gce/provider.clj
@@ -6,6 +6,7 @@
    [celestial.provider :refer (wait-for-ssh mappings wait-for transform os->template)]
    [clojure.java.data :refer (to-java from-java)]
    [celestial.core :refer (Vm)]
+   [clojure.walk :refer (keywordize-keys)]
    [taoensso.timbre :as timbre]
    [celestial.persistency.systems :as s]
    [celestial.model :refer (translate vconstruct hypervisor)])
@@ -39,17 +40,31 @@

 (defn create-instance [compute gce {:keys [project-id zone] :as spec}]
   (let [instance (.fromString (JacksonFactory/getDefaultInstance) (write-str gce) Instance)]
-    (-> (instances compute) (.insert project-id zone instance))
+    (-> (instances compute)
+      (.insert project-id zone instance) (.execute) from-java keywordize-keys)
     ))
-
+
+(defn delete-instance [compute {:keys [name]} {:keys [project-id zone]}]
+   (-> (instances compute) (.delete project-id zone name) (.execute)))
+
+(defn get-instance [compute {:keys [name]} {:keys [project-id zone]}]
+   (-> (instances compute) (.get project-id zone name) (.execute) from-java keywordize-keys))
+
+(defn get-operation [compute {:keys [project-id zone]} operation]
+  (-> (.zoneOperations compute)
+    (.get project-id zone (:name operation)) (.execute) from-java keywordize-keys))
+
 (defmacro with-id [& body])

 (defrecord GCEInstance [compute gce spec]
   Vm
   (create [this]
-    (let [{:keys [id] :as instance} (create-instance gce) ]
-     (debug "created" id)
-     (s/partial-system (spec :system-id) {:gce {:id id}})
+    (let [operation (create-instance compute gce spec)]
+     (wait-for {:timeout [5 :minute]}
+        #(= (:status (get-operation compute spec operation)) "DONE")
+         {:type ::gce:creation-fail} "Timed out on waiting for creation to be done")
+     (let [{:keys [natIp]} (get-instance compute gce spec)]
+       (s/partial-system (spec :system-id) {:machine {:ip natIp}}))
       this))

   (start [this]
@@ -60,16 +75,26 @@
         (wait-for-ssh (machine :ip) "root" [5 :minute]))
       ))

-  (delete [this])
+  (delete [this]
+     (let [{:keys [id] :as operation} (create-instance compute gce spec) ]
+      (wait-for {:timeout [5 :minute]} #(= ("status" operation) "DONE")
+       {:type ::gce:fail} "Timed out on waiting for operation to be done"))
+    )

   (stop [this])

-  (status [this]))
+  (status [this]
+    (try
+      (let [{:keys [status]} (get-instance compute gce spec)]
+        (.toLowerCase status))
+      (catch Exception e false)
+      )))

-(defn into-gce [{:keys [name machine-type zone image]}]
+(defn into-gce [{:keys [name machine-type tags zone image]}]
   {
     :name name
     :machineType (<< "zones/~{zone}/machineTypes/~{machine-type}")
+    :tags {:items (clojure.tools.trace/trace tags)}
     :disks [{
       :initializeParams {:sourceImage image} :autoDelete true
       :type "PERSISTENT" :boot true
@@ -80,8 +105,6 @@
     }]
  })

-(defn into-system [system-id])
-
 (def machine-ts
   "Construcuting machine transformations"
    {:image (fn [os] (:image ((os->template :gce) os)))})
@@ -91,11 +114,11 @@
     (-> (merge machine gce {:system-id system-id})
       (mappings {:os :image :hostname :name})
       (transform machine-ts)
-      ((juxt into-gce (partial select-keys [:system-id :project-id])))
+      ((juxt into-gce (fn [m] (select-keys m [:system-id :project-id :zone]))))
     ))

-(defn validate [spec &]
-  (validate-provider spec) spec)
+(defn validate [[gce spec]]
+  (validate-provider gce spec) [gce spec])

 (defmethod vconstruct :gce [spec]
   (let [compute (build-compute (hypervisor :gce :service-file))]


(MAINT) change to keep the test key consistent This key is to denote the reason for borrowing an instance

--- test/integration/puppetlabs/services/jruby/jruby_puppet_pool_int_test.clj
+++ test/integration/puppetlabs/services/jruby/jruby_puppet_pool_int_test.clj
@@ -393,7 +393,7 @@
                  (set (keys jruby-env))))
           (is (= (.get jruby-env "FOO") (System/getenv "HOME")))
           (finally
-            (jruby-testutils/return-instance jruby-service jruby-instance :settings-plumbed-test)))))))
+            (jruby-testutils/return-instance jruby-service jruby-instance :test)))))))

 (deftest master-termination-test
   (testing "Flushing the pool causes masters to be terminated"


old webserver comopnent removed. (replaced by pedestal)

--- src/clj/hellhound/components/webserver.clj
+++ src/clj/hellhound/components/webserver.clj
@@ -1,87 +0,0 @@
-(ns hellhound.components.webserver
-  "Hellhound webserver component namespace. Webserver component is
-  responsible for running an `Immutant` webserver and setting up a
-  `bidi` ring handler. In order to run a webserver use `webserver`
-  function  alongside with `hellhound.system.defsystem` macro you can define a
-  system with webserver component in it. But if you want to define your
-  own system map you can use `make-webserver` function and do it like
-  you used to do."
-  (:require [ring.middleware.defaults       :refer [site-defaults]]
-            [hellhound.components.protocols :as protocols]
-            [taoensso.timbre                :as log]
-            [immutant.web                   :as web]))
-
-(defn- http-port
-  []
-  (Integer. (or (env :http-port)  "4000")))
-
-(defn- http-host
-  []
-  (or (env :http-host) "0.0.0.0"))
-
-
-(defrecord Webserver [handler host port]
-  protocols/Lifecycle
-  (start [component]
-    (if-not (:server component)
-      (let [config {:host host :port port :path "/"}
-            server (do (-> (str "Starting web server. Listening on host: %s "
-                                "and port: %d")
-                           (format host port)
-                           (log/info))
-                       (web/run handler config))]
-        (assoc component
-               :server  server
-               :host    host
-               :handler handler
-               :config  config
-               :port    port))
-      component))
-
-  (stop [component]
-    (let [server (:server component)]
-      (-> (str "Stopping web server on host: %s and port: %d")
-          (format (:host component) (:port component))
-          (println))
-      (web/stop server)
-      (dissoc component :server))))
-
-(defn ring-handler
-  "Create a ring handler from the given routs. This function
-  will make sure that sente's required middlewares are present
-  in the resulted handler"
-  [routes options]
-  (let [defaults-config
-        (-> site-defaults
-            (assoc-in [:static :resources] "/")
-            (assoc-in [:security :anti-forgery]
-                      {:read-token (fn [req] (-> req :params :csrf-token))}))
-        ring-defaults-config (merge defaults-config options)]
-
-    ;; To make sure that sente's required middlewares are present.
-    (ring.middleware.defaults/wrap-defaults routes ring-defaults-config)))
-
-
-(defn make-webserver
-  "Creat and launch an `immutant` server."
-  ([routes]
-   (make-webserver routes (http-host) 4000 {}))
-
-  ([routes host]
-   (make-webserver routes host 4000 {}))
-
-  ([routes host port]
-   (make-webserver routes host port {}))
-
-  ([routes host port handler-options]
-   (->Webserver (ring-handler routes handler-options) host port)))
-
-(defn webserver
-  "Create a webserver instance from the webserver components.
-  This function is meant to be used with `hellhound.system.defsystem` macro."
-  ([system-map routes]
-   (webserver system-map routes {}))
-
-  ([system-map routes handler-options]
-   (update-in system-map [:components :webserver]
-             (make-webserver routes (http-host) (http-port) handler-options))))


show node-id if node is lost without name

--- src/clj/swarmpit/docker/mapper/inbound.clj
+++ src/clj/swarmpit/docker/mapper/inbound.clj
@@ -57,7 +57,7 @@

 (defn ->task-node
   [node-id nodes]
-  (first (filter #(= (:ID %) node-id) nodes)))
+  (or (first (filter #(= (:ID %) node-id) nodes)) node-id))

 (defn ->task-service
   [service-id services]


Implement action cards through om components.

--- src/cljs/hatnik/web/client/components.cljs
+++ src/cljs/hatnik/web/client/components.cljs
@@ -15,30 +15,43 @@
   (when (= "email" a-type)
     (dom/span #js {:className "glyphicon glyphicon-envelope action-type"})))

-(defn render-action [project-id act]
-  (dom/div
-   #js {:onClick (fn []
-                   (add-action/show :project-id project-id
-                                    :type :update
-                                    :action @act))
-        :className "panel panel-default action"}
-   (dom/div
-    #js {:className "panel-body bg-success"}
-    (render-action-type (get act "type"))
-    (dom/span #js {:className "action-info"}
-              (dom/div #js {:className "library-name"}
-                       (get act "library"))
-              (dom/div #js {:className "version"}
-                       (get act "last-processed-version"))))))
+(defn add-new-action-card [data owner]
+  (reify
+    om/IRender
+    (render [this]
+      (let [id (:project-id data)]
+      (dom/div #js {:className "panel panel-default panel-info action add-action"
+                    :onClick #(add-action/show :type :add
+                                               :project-id id)}
+               (dom/div #js {:className "panel-body bg-info"}
+                        (dom/span #js {:className "glyphicon glyphicon-plus"})
+                        " Add action"))))))

-(defn add-new-action [project-id]
-  (dom/div #js {:className "panel panel-default panel-info action add-action"
-                :onClick #(add-action/show :type :add
-                                           :project-id project-id)}
-           (dom/div #js {:className "panel-body bg-info"}
-                    (dom/span #js {:className "glyphicon glyphicon-plus"})
-                    " Add action")))
+(defn email-action-card [data owner]
+  (reify
+    om/IRender
+    (render [this]
+      (let [id (:project-id data)]
+      (dom/div #js {:className "panel panel-default action"
+                    :onClick #(add-action/show :type :update
+                                               :project-id id
+                                               :action @data)}
+               (dom/div
+                #js {:className "panel-body bg-success"}
+                (dom/span #js {:className "glyphicon glyphicon-envelope action-type"})
+                (dom/span #js {:className "action-info"}
+                          (dom/div #js {:className "library-name"}
+                                   (get data "library"))
+                          (dom/div #js {:className "version"}
+                                   (get data "last-processed-version")))))))))

+(defmulti render-action #(:type %))
+
+(defmethod render-action "email" [data]
+  (om/build email-action-card data))
+
+(defmethod render-action :add [data]
+  (om/build add-new-action-card data))

 (defn actions-table [id actions]
   (let [actions (->> actions
@@ -47,12 +60,12 @@
         rendered
         (map (fn [act]
                (dom/div #js {:className "col-sm-12 col-md-6 col-lg-4 prj-list-item"}
-                        (render-action id act)))
+                        (render-action (assoc act :project-id id :type (get act "type")))))
              actions)]
     (apply dom/div #js {:className "row"}
            (concat rendered
                    [(dom/div #js {:className "col-sm-12 col-md-6 col-lg-4 prj-list-item"}
-                             (add-new-action id))]))))
+                             (render-action {:type :add :project-id id}))]))))

 (defn project-menu [project]
   (let [project-name-input (.getElementById js/document "project-name-edit-input")]
@@ -106,7 +119,8 @@
             user-data (:user data)]
         (dom/div #js {:className "panel-group" :id "iProjectList"}
                  (apply dom/div nil
-                        (map #(om/build project-view %) project-data)))))))
+                        (map #(om/build project-view (assoc % :user user-data))
+                             project-data)))))))

 (defn app-view [data owner]


Whitespace

Whitespace

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -305,7 +305,7 @@
                (assoc :parent other-p)
                (dissoc ::t/url))))
         ?versions))))
-
+
 (defn read-notes
   "Succeeds with a result Seq[Version, string], being the zip of list-notes with
   read-note for each listed note.


fix cpu NaN usage

fix cpu NaN usage

--- src/cljs/swarmpit/component/dashboard.cljs
+++ src/cljs/swarmpit/component/dashboard.cljs
@@ -214,28 +214,29 @@
           "graph-disk")]])))

 (rum/defc dashboard-cpu < rum/static [{:keys [usage cores] :as cpu}]
-  (comp/paper
-    {:elevation 0
-     :className "Swarmpit-paper Swarmpit-dashboard-paper"}
-    (html
-      [:div.Swarmpit-dashboard-section
-       [:div
-        (comp/typography
-          {:variant   "body2"
-           :className "Swarmpit-dashboard-section-title"}
-          "CPU")
-        (comp/typography
-          {:variant   "h5"
-           :className "Swarmpit-dashboard-section-value"}
-          (common/render-cores (/ cores usage)))]
-       [:div.Swarmpit-dashbord-section-graph
-        (common/resource-pie
-          {:value (/ cores usage)
-           :limit cores
-           :usage usage
-           :type  :cpu}
-          (str cores " vCPU")
-          "graph-cpu")]])))
+  (let [used (/ cores usage)]
+    (comp/paper
+      {:elevation 0
+       :className "Swarmpit-paper Swarmpit-dashboard-paper"}
+      (html
+        [:div.Swarmpit-dashboard-section
+         [:div
+          (comp/typography
+            {:variant   "body2"
+             :className "Swarmpit-dashboard-section-title"}
+            "CPU")
+          (comp/typography
+            {:variant   "h5"
+             :className "Swarmpit-dashboard-section-value"}
+            (common/render-cores (if (js/isNaN used) nil used)))]
+         [:div.Swarmpit-dashbord-section-graph
+          (common/resource-pie
+            {:value used
+             :limit cores
+             :usage usage
+             :type  :cpu}
+            (str cores " vCPU")
+            "graph-cpu")]]))))

 (defn dashboard-node-ram-callback
   [state]


More NGM issues.

More NGM issues.

--- src/clojure/kamituel/ngm_toc/data/ngm.cljc
+++ src/clojure/kamituel/ngm_toc/data/ngm.cljc
@@ -1507,4 +1507,39 @@
                 :places [{:country "Pakistan" :region "Pendżab" :coords [31.3 73.0]}]}
                {:title "Pustynia Namib"
                 :description "Parki narodowe na blisko połowie powierzchni kraju? Tak, Namibia ma wielkie ambicje. Ale diamenty i inne minerały też kuszą."
-                :places [{:country "Namibia" :region "Pustynia Namib" :coords [-24 15]}]}]}])
+                :places [{:country "Namibia" :region "Pustynia Namib" :coords [-24 15]}]}]}
+   {:year 2011 :month 7 :vol 142
+    :articles [{:title "Medyczne koło"
+                :description "Rozmowa z Jerzym Woy-Wojciechowskim m.in. o znaczeniu przypadku w rozwoju medycyny.
+"}
+               {:title "Goryle"
+                :description "W kongijskiej puszczy buszują zbrojni rebelianci, żołnierze, uchodźcy, smolarze. Potężne małpy muszą przetrwać ten zalew ludzkich nieszczęść. Czasem padają od kul. "
+                :places [{:country "Rwanda"}
+                         {:country "Demokratyczna Republika Konga"}
+                         {:country "Uganda"}
+                         {:region "Park Narodowy Wirunga" :coords [-1.4 29.5]}]}
+               {:title "Narodziny religii"
+                :description "Czy cywilizację stworzyło rolnictwo? Imponujące kamienne sanktuarium wzniesione 12 tys. lat temu przez łowców-zbieraczy podważa tę teorię."
+                :places [{:country "Turcja" :region "Göbekli Tepe" :coords [37.223056 38.9225]}
+                         {:country "Turcja" :region "Nevalı Çori" :coords [37.518333 38.605556]}]}
+               {:title "Wodun"
+                :description "Mrożące krew w żyłach opowieści o czarach, które rzucają kapłani wodun, to wymysły popkultury. Dlaczego? Bo wedle ich przekonań złe moce są groźne także dla tych, którzy je stosują."
+                :places [{:country "Benin" :city "Aklampa" :coords [8.23 2.19]}]}
+               {:title "Dekonstrukcja"
+                :description "„Starchitekci” przynieśli rewolucję. Odrzucili porządek tradycyjnej architektury, stawiając na organiczność i chaos. Ale czy miasto może być zbiorem budowli-rzeźb?"
+                :places [{:country "Hiszpania" :city "Bilbao" :region "Muzeum Guggenheima" :coords [43.268531 -2.934054]}
+                         {:country "Czechy" :city "Praga" :region "Ginger i Fred" :coords [50.075504 14.414071]}
+                         {:country "Włochy" :city "Rzym" :region "Narodowe Muzeum Sztuki XXI w. MAXXI" :coords [41.928355 12.467011]}
+                         {:country "Niemcy" :city "Berlin" :region "Muzeum Żydowskie" :coords [52.502317 13.395411]}
+                         {:country "Wielka Brytania" :city "Manchester" :region "Imperial War Museum" :coords [53.469765 -2.298957]}
+                         {:country "Polsla" :city "Warszawa" :region "Złota 44" :coords [52.231130 21.002264]}]}
+               {:title "Bagdad"
+                :description "Raport z miasta przeoranego wojną. Świecka w czasach dyktatury metropolia po
+amerykańskiej inwazji podzieliła się na religijne dzielnice-getta pogrodzone murami."
+                :places [{:country "Irak" :city "Bagdad" :coords [33.3 44.4]}]}
+               {:title "Strefa wpływów"
+                :description "W wąskim pasie lądu zalewanym przypływami oceanu bogactwo i konkurencja małych stworzeń przypominają stosunki panujące w dżungli."
+                :places [{:country "USA" :region "Rezerwat Morski Fitzgerald" :coords [37.5 -122.5]}]}
+               {:title "Zielone Chiny"
+                :description "Chiny zwracają się ku słońcu. Czy staną się liderem czystych technologii? Skala zmian jest imponująca, ale ilość spalanego węgla nadal poraża."
+                :places [{:country "Chiny"}]}]}])


working on keep-word?

working on keep-word?

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -61,11 +61,8 @@
   { :pre  [ (= (count word) (count clue))
             (not-any? #(= \- %) word) ]
     :post [] }
-  (let [ pair-seq   (map vector clue word)  ; a sequence of pairs
-         result     (every? #(or (=    (first %) (second %))
-                                 (= \- (first %)) )
-                      pair-seq) ]
-    result ))
+  (let [ patt-str (clue-to-regex clue guessed-chars) ]
+    (re-find (re-pattern patt-str) word ) ))

 (defn word-has-letter?
   "Returns true if a letter appears in a word, else nil."
@@ -126,8 +123,8 @@
         letters         [\a \b \c \d]
         guessed-chars   #{\b \s}
         clue-str        "-b--"
+        not-char-class  (complement-char-class            guessed-chars)
         patt-str        (clue-to-regex          clue-str  guessed-chars)
-        not-char-class  (complement-char-class            guessed-chars)
   ]
     (assert (= not-char-class  "[^bs]"                 ))
     (assert (= patt-str        "[^bs]b[^bs][^bs]"      ))


testing import

testing import

--- src/hello_polymer/miraj.clj
+++ src/hello_polymer/miraj.clj
@@ -22,10 +22,10 @@

    ;; PROBLEM: distinguish css refs from shared style refs
    ;; delegate to config spec?
-   (h/import #_(styles hello world)
+   (h/import '(styles hello world)
              #_(html-imports hello world)
-             '(styles.shared foo bar))
-             '(scripts polyfill-lite))
+             #_(styles.shared foo bar)
+             #_(scripts polyfill-lite))

    (h/body
     (h/h1 "Hello Polymer!")


Only draw lattice if canvas is visible

Only draw lattice if canvas is visible

This seems to fix the "neverending rotation" bug!

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/draw/control/freese.clj
+++ src/conexp/contrib/draw/control/freese.clj
@@ -38,7 +38,8 @@
                                                       :while @rotate-thread]
                                                 (Thread/sleep 50)
                                                 (do-swing
-                                                 (.setValue spn angle))))))
+                                                 (when (.isVisible (scene-canvas scn))
+                                                   (.setValue spn angle)))))))
                            (.start ^Thread @rotate-thread)),
         stop-rotate     #(when @rotate-thread
                            (.stop ^Thread @rotate-thread)


Fix test-pom to watch for abort.

Fix test-pom to watch for abort.

--- test/test_pom.clj
+++ test/test_pom.clj
@@ -19,6 +19,8 @@
     (is (= "test" (-> model .getBuild .getTestSourceDirectory)))))

 (deftest test-snapshot-checking
-  (is (thrown? Exception (pom (assoc test-project
-                                :version "1.0"
-                                :dependencies [['clojure "1.0.0-SNAPSHOT"]])))))
+  (let [aborted? (atom false)]
+    (binding [leiningen.core/abort (partial reset! aborted?)]
+      (pom (assoc test-project :version "1.0"
+                  :dependencies [['clojure "1.0.0-SNAPSHOT"]]))
+      (is @aborted?))))


changed  1 futuro to future

changed  1 futuro to future

--- fr.clj
+++ fr.clj
@@ -44,7 +44,7 @@
                                                   :target-model fr/small}
                                                  :count count}])))
                                   [{:synsem {:sem {:tense :conditional}}}
-                                   {:synsem {:sem {:tense :futuro}}}
+                                   {:synsem {:sem {:tense :future}}}
                                    {:synsem {:sem {:tense :present}}}
                                    ;; TODO: enable this when ready:
                                    ;; {:synsem {:sem {:aspect :perfect


Add yetibot.core.repl/start-offline for offline dev

--- src/yetibot/core/repl.clj
+++ src/yetibot/core/repl.clj
@@ -16,11 +16,19 @@
   (require 'yetibot.core.commands.users :reload)
   (require 'yetibot.core.commands.collections :reload))

-(defn start []
+(defn start
+  "Load a minimal set of commands, start the database and connect to chat adapters"
+  []
   (load-minimal)
   (db/repl-start)
   (cf/start)
   (irc/start))
+
+(defn start-offline
+  "Offline repl-driven dev mode"
+  []
+  (load-minimal)
+  (db/repl-start))

 (defn stop []
   (irc/stop))


(SERVER-2721) Explain single-threaded-only test

This commit adds a comment to the `environment-flush-integration-test`
explaining why it doesn't make sense to run this test (or a test like it) in
multithreaded mode.

--- test/integration/puppetlabs/services/jruby/puppet_environments_int_test.clj
+++ test/integration/puppetlabs/services/jruby/puppet_environments_int_test.clj
@@ -61,6 +61,10 @@
 ;; not ideal, but we discussed it at length and agreed that the test has
 ;; value in terms of simulating an end user's experience, which could not
 ;; be achieved w/o some such assumptions, and thus is worth keeping.
+;;
+;; This test does NOT make sense in multithreaded mode: because there is only a
+;; single jruby instance, any environment context would be shared amongst all
+;; workers (threads in this case, since they share the jruby instance).
 (deftest ^:integration ^:single-threaded-only environment-flush-integration-test
   (testing "environments are flushed after marking expired"
     ;; This test is a bit complicated, so warrants some 'splainin.


(MAINT) Attempt to fix 502 failures in tests

--- test/puppetlabs/trapperkeeper/services/status/status_proxy_service_test.clj
+++ test/puppetlabs/trapperkeeper/services/status/status_proxy_service_test.clj
@@ -29,7 +29,7 @@
 (def status-proxy-service-config
   {:webserver          {:port 8181
                         :host "0.0.0.0"}
-   :status-proxy       {:proxy-target-url "https://0.0.0.0:9001/ssl-status"
+   :status-proxy       {:proxy-target-url "https://localhost:9001/ssl-status"
                         :ssl-opts common-ssl-config}
    :web-router-service {:puppetlabs.trapperkeeper.services.status.status-proxy-service/status-proxy-service "/status-proxy"}})


Static resource service fix

Static resource service fix

--- modules/bidi/src/modular/bidi.clj
+++ modules/bidi/src/modular/bidi.clj
@@ -45,13 +45,11 @@
        map->WebServiceFromArguments))

 (defrecord StaticResourceService [uri-context resource-prefix]
-  component/Lifecycle
-  (start [component] (assoc component :keyword (keyword (gensym))))
-  (stop [component] component)
   WebService
-  (request-handlers [component] {(:keyword component) (->ResourcesMaybe {:prefix resource-prefix})})
-  (routes [component] ["" (:keyword component)])
-  (uri-context [component] uri-context))
+  (request-handlers [_] {})
+  (routes [_]
+    [uri-context (->ResourcesMaybe {:prefix resource-prefix})])
+  (uri-context [_] ""))

 (def new-static-resource-service-schema
   {:uri-context s/Str


refactor with are

refactor with are

--- test/hu/ssh/github_changelog/semver_test.clj
+++ test/hu/ssh/github_changelog/semver_test.clj
@@ -8,13 +8,15 @@

 (deftest extract
   (testing "with a v prefix"
-    (is (semver/extract "v0.0.1"))
-    (is (semver/extract "v0.9.3-pre0"))
-    (is (semver/extract "v1.0.1")))
+    (are [version] (not (nil? (semver/extract version)))
+                   "v0.0.1"
+                   "v0.9.3-pre0"
+                   "v1.0.1"))
   (testing "without a v prefix"
-    (is (semver/extract "0.0.1"))
-    (is (semver/extract "0.9.3-pre0"))
-    (is (semver/extract "1.0.1"))))
+    (are [version] (not (nil? (semver/extract version)))
+                   "0.0.1"
+                   "0.9.3-pre0"
+                   "1.0.1")))

 (deftest newer?
   (is (semver/newer? (c/complete {:major 1} Semver) (c/complete {:major 0} Semver)))


Ring bindings should use (merge-with merge)

--- modules/ring/src/modular/ring.clj
+++ modules/ring/src/modular/ring.clj
@@ -21,7 +21,7 @@
     (let [dlg (ring-handler (:ring-handler this))]
       (fn [req]
         (let [bindings
-              (apply merge (map #(ring-binding % req) (::bindings this)))]
+              (apply merge-with merge (map #(ring-binding % req) (::bindings this)))]
           (infof "Request bindings are %s" (keys bindings))
           (dlg (merge req bindings)))))))


Remove unused fns.

Remove unused fns.

--- src/oc/storage/representations/content.clj
+++ src/oc/storage/representations/content.clj
@@ -43,11 +43,6 @@
   (let [react-url (interaction-url org-uuid board-uuid resource-uuid reaction)]
     (hateoas/link-map "react" hateoas/DELETE react-url {})))

-(defn- map-kv
-  "Utility function to do an operation on the value of every key in a map."
-  [f coll]
-  (reduce-kv (fn [m k v] (assoc m k (f v))) (empty coll) coll))
-
 (defn- reaction-and-link
   "Given the parts of a reaction URL, return a map representation of the reaction for use in the API."
   [org-uuid board-uuid resource-uuid reaction user?]
@@ -57,31 +52,6 @@
     (assoc :links [(if user?
                     (unreact-link org-uuid board-uuid resource-uuid (:reaction reaction))
                     (react-link org-uuid board-uuid resource-uuid (:reaction reaction)))])))
-
-(defn- reaction-selection-sort
-  "
-  Sort order to select the most used reactions, with a tie breaker for default reactions in their default reaction
-  order.
-  "
-  [reaction]
-  (let [index-of (inc (.indexOf config/default-reactions (first reaction)))] ; order in the defaults
-    (if (zero? index-of) ; is it in the defaults, or legacy?
-      ;; it's legacy, so by reaction count
-      (* (last reaction) -1) ; more reactions gives a lower (negative) #, so it has a higher sort
-      ;; it's in the defaults, so by reaction count, but with a little extra for tie breaking with other reactions
-      (- (* (last reaction) -1) (- 1 (* index-of 0.25)))))) ; the earlier it is in the defaults the bigger the tie breaker
-
-(defn- reaction-order-sort
-  "
-  Keep the reaction order stable by sorting on the order they are provided, and if they are legacy
-  reactions, by the order of how many reactions they have (which while not definitively stable, will
-  effectively be fairly stable for legacy reactions).
-  "
-  [reaction]
-  (let [index-of (.indexOf config/default-reactions (first reaction))] ; order in the defaults
-    (if (= index-of -1) ; is it in the defaults, or legacy?
-      (* (last reaction) 10) ; it's legacy, so by reaction count
-      index-of))) ; by order in the defaults

 (defn reactions-and-links
   "
@@ -93,4 +63,4 @@
     (map #(reaction-and-link org-uuid board-uuid resource-uuid %
             ; the user left one of these reactions?
             (some (fn [author-id] (= user-id author-id)) (:author-ids %)))
-      limited-reactions)))
+      limited-reactions)))


timbre supports clojurescript

timbre supports clojurescript

--- src/onyx/lifecycles/lifecycle_compile.cljc
+++ src/onyx/lifecycles/lifecycle_compile.cljc
@@ -1,6 +1,6 @@
 (ns ^:no-doc onyx.lifecycles.lifecycle-compile
   (:require #?(:clj [onyx.static.validation :as validation])
-            #?(:clj [taoensso.timbre :refer [error]])
+            [taoensso.timbre :refer [error]]
             [onyx.static.util :refer [kw->fn]]))

 (defn resolve-lifecycle-calls [calls]
@@ -10,7 +10,7 @@
          (validation/validate-lifecycle-calls calls-map)
          (catch Throwable t
            (let [e (ex-info (str "Error validating lifecycle map. " (.getCause t)) calls-map)]
-             #?(:clj (error e))
+             (error e)
              (throw e))))
        calls-map))
   #?(:cljs (onyx.static.util/resolve-dynamic calls)))


Init time-init-state to curr time on monitoring startup to avoid initial readings being wrong.

--- src/onyx/monitoring/metrics_monitoring.clj
+++ src/onyx/monitoring/metrics_monitoring.clj
@@ -261,7 +261,7 @@
                                      (fn []
                                        (ns->ms (- (System/nanoTime)
                                                   (.get ^AtomicLong last-heartbeat)))))
-          time-init-state (AtomicLong. 0)
+          time-init-state (AtomicLong. (System/nanoTime))
           time-in-state-gg (g/gauge-fn task-registry
                                        (conj tag "current-lifecycle-duration")
                                        (fn []


reimplement do-some

reimplement do-some

--- worker/src/worker/worker.cljs
+++ worker/src/worker/worker.cljs
@@ -69,3 +69,7 @@
 (def worker-body (create-worker-body))
 (def worker-blob (js/Blob. (clj->js [worker-body])))

+(defn do-some [wmeta]
+  (let [w (js/Worker. (.createObjectURL js/URL worker-blob))]
+    (set! (.-onmessage w) (fn [e] (println (:prnt (*deserialize* (.-data e))))))
+    (.postMessage w (cljs.core/clj->js [(:ns wmeta) (:name wmeta)]))))


Introduce Displayer protocol, implement for ConsoleDisplayer

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -45,37 +45,46 @@
 (defrecord RenderState [env model])

-(defn display [{:keys [frame-chan] :as displayer} frame]
+(defprotocol Displayer
+  "A protocol for things that are capable of displaying frames"
+  (display [displayer frame] "Display a frame"))
+
+(defn to-displayer [{:keys [frame-chan] :as displayer} frame]
   (>!! frame-chan frame))

-(defn start-displaying [{:keys [frame-chan] :as displayer}]
+(defn start-displayer [{:keys [frame-chan] :as displayer}]
   (thread
-    (loop [prev-frame nil]
+    (loop []
       (let [frame (<!! frame-chan)]
         (if frame
-          (do (when (not= frame prev-frame)
-                (println frame))
-              (recur frame))
+          (do (display displayer frame)
+              (recur))
           (println "Shutting down displayer"))))))

-(defrecord Displayer [frame-chan]
+
+(defrecord ConsoleDisplayer [frame-chan prev-frame]
   component/Lifecycle
-
   (start [displayer]
-    (let [frame-chan (chan)
-          displayer (assoc displayer :frame-chan frame-chan)]
-      (start-displaying displayer)
+    (let [displayer (-> displayer
+                        (assoc :frame-chan (chan))
+                        (assoc :prev-frame (atom nil)))]
+      (start-displayer displayer)
       displayer))

   (stop [displayer]
     (close! frame-chan)
-    displayer))
+    displayer)
+
+  Displayer
+  (display [{:keys [prev-frame]} frame]
+    (when (not= frame @prev-frame)
+      (reset! prev-frame frame)
+      (println frame))))

 (defn get-env-updates [env]
   (-> env
       (assoc :time (System/currentTimeMillis))))
-

 (defn render-step [{:keys [env model] :as state}]
   (let [{:keys [layers]} model
@@ -109,7 +118,7 @@
             (if (= status :running)
               (alt!! command-chan ([command] (execute command state status))
                      :default (let [next-frame (render-step state)]
-                                (display displayer next-frame)
+                                (to-displayer displayer next-frame)
                                 [state :running]))
               (execute (<!! command-chan) state status))]
         (if loop-result
@@ -134,7 +143,7 @@
   (component/system-map
    :renderer (component/using (map->Renderer {})
                               [:displayer])
-   :displayer (map->Displayer {})))
+   :displayer (map->ConsoleDisplayer {})))

 ;;; Below: defs useful for interacting with the running renderer

@@ -143,4 +152,3 @@
 (def renderer (:renderer started-system))

 (def displayer (:displayer started-system))
-


update migration banner to remove August reference (#1558) [SATURN-933]

--- src/cljs/main/broadfcui/common/notifications.cljs
+++ src/cljs/main/broadfcui/common/notifications.cljs
@@ -272,7 +272,7 @@
   (let [final-terra-url (or terra-redirect-url (common/make-return-url))]
     [:div {}
       "You are using the classic FireCloud interface. "
-      "As of August 2019, FireCloud will permanently migrate to our new experience, powered by Terra. Click "
+      "FireCloud will permanently migrate to our new experience, powered by Terra. Click "
       [:a {:href final-terra-url
            :target "_blank"
            :style {:color "white"}}


Fix arguments & support :after in refresh-all

--- src/main/clojure/clojure/tools/namespace/repl.clj
+++ src/main/clojure/clojure/tools/namespace/repl.clj
@@ -41,6 +41,10 @@
       (update-in [::track/load] #(remove load-disabled? %))))

 (defn- do-refresh [scan-fn after-sym]
+  (when after-sym
+    (assert (symbol? after-sym) ":after value must be a symbol")
+    (assert (namespace after-sym)
+            ":after value must be a namespace-qualified symbol"))
   (let [current-ns (ns-name *ns*)]
     (alter-var-root #'refresh-tracker
                     #(apply scan-fn % refresh-dirs))
@@ -83,10 +87,6 @@
                been reloaded."
   [& options]
   (let [{:keys [after]} options]
-    (when after
-      (assert (symbol? after) ":after value must be a symbol")
-      (assert (namespace after)
-              ":after value must be a namespace-qualified symbol"))
     (do-refresh dir/scan after)))

 (defn refresh-all
@@ -94,9 +94,17 @@
   reloads them in dependency order.

   The directories to be scanned are controlled by 'set-refresh-dirs';
-  defaults to all directories on the Java classpath."
-  []
-  (do-refresh dir/scan-all))
+  defaults to all directories on the Java classpath.
+
+  Options are key-value pairs. Valid options are:
+
+      :after   Namespace-qualified symbol naming a zero-argument
+               function to be invoked after a successful refresh. This
+               symbol will be resolved *after* all namespaces have
+               been reloaded."
+  [& options]
+  (let [{:keys [after]} options]
+    (do-refresh dir/scan-all after)))

 (defn set-refresh-dirs
   "Sets the directories which are scanned by 'refresh'. Supports the


Make run handle n arguments

Make run handle n arguments

--- src/overtunes/songs/canone_alla_quarta.clj
+++ src/overtunes/songs/canone_alla_quarta.clj
@@ -48,13 +48,13 @@
 (def leader
   (let [call
           {:time (mapcat repeat [2 1 14 1] [1/4 1/2 1/4 3/2])
-           :pitch (concat [0] (run -1 3) (run 2 0) [4] (run 1 8))}
+           :pitch (concat (run 0 -1 3 0) [4] (run 1 8))}
         response
           {:time (mapcat repeat [10 1 2 1]  [1/4 1/2 1/4 9/4])
-           :pitch (concat (run 7 -1) [0] (run 0 -3))}
+           :pitch (concat (run 7 -1 0) (run 0 -3))}
         development
           {:time (mapcat repeat [1 12 1 1 1 12 1] [3/4 1/4 1/2 1 1/2 1/4 3])
-           :pitch (concat [4 4] (run 2 -3) [-1 -2 0] (run 3 5) (repeat 3 1) [2] (run -1 1) [0 -1] (run 5 0))}
+           :pitch (concat [4 4] (run 2 -3) [-1 -2 0] (run 3 5) (repeat 3 1) [2] (run -1 1 -1) (run 5 0))}
         line
           (merge-with concat call response development)]
     (melody line)))


fix doc string

fix doc string

--- user.clj
+++ user.clj
@@ -28,8 +28,7 @@
 (defn spy "Simple print debugging" [arg]
   (doto arg prn))

-(defn doc-dir [nsname]
-  "Prints docs for a given namespace"
+(defn doc-dir "Prints docs for a given namespace" [nsname]
   (let [ [resolved unresolved] (split resolve (clojure.repl/dir-fn nsname)) ]
     (doseq [sym resolved]
       (@#'clojure.repl/print-doc (meta (sym-to-var sym))))


Fix empty NUX selection case logic.

Fix empty NUX selection case logic.

--- src/oc/storage/api/orgs.clj
+++ src/oc/storage/api/orgs.clj
@@ -170,7 +170,8 @@
                 (create-board conn updated-org {:name create-board-name} author))
                 create-board-names))
               ;; create a min of 3 / max of 4 sample entries, including at least 1 from the forced board
-              selected-entries (take 3 (flatten (map default-entries-for selected-board-names)))
+              selected-entries (take 3 (flatten (map default-entries-for
+                                                  (remove #(= % config/forced-board-name) selected-board-names))))
               forced-entries (default-entries-for config/forced-board-name)
               total-entries (take 4 (concat selected-entries forced-entries))
               create-entries (map #(assoc % :author (lib-schema/author-for-user author))


Flow condition handling dependend on :segment key

--- src/onyx/peer/transform.clj
+++ src/onyx/peer/transform.clj
@@ -7,7 +7,7 @@
   (let [segments (try (f input)
                       (catch Throwable e
                         (ex-info "Segment threw exception"
-                                 {:exception e :input input})))]
+                                 {:exception e :segment input})))]
     (if (sequential? segments) segments (t/vector segments))))

 (defn apply-fn-single [f {:keys [onyx.core/batch] :as event}]
@@ -33,10 +33,10 @@
 (defn collect-next-segments-batch [f input]
   (try (f input)
        (catch Throwable e
-         (mapv (fn [_]
+         (mapv (fn [segment]
                  (ex-info "Batch threw exception"
                           {:exception e
-                           :input input}))
+                           :segment segment}))
                input))))

 (defn apply-fn-batch [f {:keys [onyx.core/batch] :as event}]


bug fix

bug fix

--- src/pe_fp_app/lifecycle.clj
+++ src/pe_fp_app/lifecycle.clj
@@ -116,7 +116,10 @@
                          true
                          fpddl/v6-create-fuelstation-type-ddl
                          fpddl/v6-fuelstation-add-fstype-col
-                         fpddl/v6-create-postgis-extension)
+
+                         ; can only be done by super user
+                         ;fpddl/v6-create-postgis-extension
+                         )
        (fpddl/v6-fuelstation-add-location-col-sql config/db-spec)
        (fpdataloads/v6-data-loads config/db-spec))})


Add tests for 'and' queries

Add tests for 'and' queries

--- test/com/puppetlabs/puppetdb/test/query/event.clj
+++ test/com/puppetlabs/puppetdb/test/query/event.clj
@@ -161,7 +161,32 @@
                 actual      (resource-events-query-result
                               (vec (cons "or" (map term-fn terms))))]
             (is (= actual expected))
-            (is (= (count actual) num-matches))))))))
+            (is (= (count actual) num-matches))))))
+
+      (testing "'and' equality queries"
+        (doseq [[terms num-matches]
+                [[[[:resource-type  "Notify"]
+                   [:status         "success"]]       2]
+                 [[[:resource-type  "bunk"]
+                   [:resource-title "notify, yar"]]   0]
+                 [[[:resource-title "notify, yo"]
+                   [:status         "skipped"]]       0]
+                 [[[:new-value      "notify, yo"]
+                   [:resource-type  "Notify"]
+                   [:certname       "foo.local"]]     1]
+                 [[[:certname       "foo.local"]
+                   [:resource-type  "Notify"]]        3]]]
+          (let [equality-fn (fn [m [k v]] (= v (m k)))
+                expected    (expected-resource-events
+                              (filter #(every? identity (map (partial equality-fn %) terms))
+                                (:resource-events basic))
+                              report-hash)
+                term-fn     (fn [[field value]] ["=" (name field) value])
+                query       (vec (cons "and" (map term-fn terms)))
+                actual      (resource-events-query-result query)]
+            (is (= actual expected))
+            (is (= (count actual) num-matches)
+              (format "Counts didn't match for query '%s'" query)))))))


Remove dead code

Remove dead code

--- src/reabledit/keyboard.cljs
+++ src/reabledit/keyboard.cljs
@@ -45,7 +45,6 @@
           38 (f (max 0 (dec current-row)) current-col)
           39 (f current-row (min cols (inc current-col)))
           40 (f (min rows (inc current-row)) current-col)
-          9 (f current-row (min cols (inc current-col)))
           13 (util/enable-edit! columns data state)
           113 (util/enable-edit! columns data state)
           nil)))))


missed conflict

missed conflict

Former-commit-id: 06e0332f4fc36d269e6a9b688db3129d3c7529c3

--- src/status_im/handlers.cljs
+++ src/status_im/handlers.cljs
@@ -7,12 +7,8 @@
     [status-im.protocol.state.storage :as storage]
     [status-im.utils.logging :as log]
     [status-im.utils.crypt :refer [gen-random-bytes]]
-<<<<<<< HEAD
-    [status-im.utils.handlers :as u]
     [status-im.components.react :refer [geth]]
-=======
     [status-im.utils.handlers :refer [register-handler] :as u]
->>>>>>> origin/develop
     status-im.chat.handlers
     status-im.chat.handlers.animation
     status-im.group-settings.handlers


Added future-fact to pass on chatty results further.

--- test/midje/t_checkers.clj
+++ test/midje/t_checkers.clj
@@ -33,5 +33,24 @@
   [1] => (has every? odd?))

-

+(defn as-sets [& expected]
+  (let [set-of-sets #(set (map set %))]
+    (fn [actual]
+      ( (just (set-of-sets expected)) (set-of-sets actual)))))
+
+(after-silently
+ (fact
+   [ [1] [2 3] ] => (as-sets [ [1] ]))
+ (future-fact "Failures from chatty-checkers-within-functions propagate chatty information"
+   (first @reported) => (contains {:type :mock-expected-result-functional-failure
+                                   :actual [ [1] [2 3]]
+                                   :expected '(as-sets [[1]])
+                                   :notes  ["Expected one element. There were two."]})))
+
+
+
+
+
+
+


move to dev local

move to dev local

--- tutorial/schema_queries.clj
+++ tutorial/schema_queries.clj
@@ -6,17 +6,12 @@
 ;   the terms of this license.
 ;   You must not remove this notice, or any other, from this software.

-(require '[datomic.client.api :as d]
-         '[datomic.samples.repl :as repl])
-(import '(java.util UUID))
+(require '[datomic.client.api :as d])

-(def client-cfg (read-string (slurp "config.edn")))
-(def client (d/client client-cfg))
-(def db-name (str "scratch-" (UUID/randomUUID)))
-(d/create-database client {:db-name db-name})
-(def conn (d/connect client {:db-name db-name}))
+(def client (d/client {:server-type :dev-local
+                       :system "datomic-samples"}))
+(def conn (d/connect client {:db-name "social-news"}))

-(repl/transact-all conn (repl/resource "day-of-datomic-cloud/social-news.edn"))
 (def db (d/db conn))

 ;; find the idents of all schema elements in the system
@@ -60,6 +55,4 @@
              [?e :db/ident ?ident]
              [_ :db.install/attribute ?e]
              [?e :db/cardinality :db.cardinality/many]]
-           db))
-
-(d/delete-database client {:db-name db-name})
+           db))


comments

comments

--- src/strictly_specking/annotated_pprint.clj
+++ src/strictly_specking/annotated_pprint.clj
@@ -198,8 +198,8 @@
                            [:cljsbuild :builds 0 :source-paths-set]
                            {:abbrev true
                             :comments {"src" {
-                                          :key-colors [:green]
-                                          :value-colors [:bright]
+                                          :key-colors     [:green]
+                                          :value-colors   [:bright]
                                           :comment-colors [:magenta]
                                           :comment " is screwwed"
                                           }
@@ -207,7 +207,7 @@
                                           :key-colors [:green]
                                           :value-colors [:bright]
                                           :comment-colors [:magenta]
-                                          :comment " is screwwed"
+                                          :comment "is screwwed\n asdf  as df asdfads"
                                           }}}))))

 (comment
@@ -283,7 +283,7 @@
                                               :key-colors [:green]
                                               :value-colors [:red]
                                               :comment-colors [:magenta]
-                                              :comment " is missing yep "#_(CommentPointer. )
+                                              :comment " is missing yep\n asdf asd f asdf asdf asdf "#_(CommentPointer. )
                                              }}}})

        )))


Abbreviate finished "ago" time.

Abbreviate finished "ago" time.

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -1362,7 +1362,7 @@
     {:title (datetime/full-datetime stop-time)}
     (om/build common/updating-duration
               {:start stop-time}
-              {:opts {:formatter datetime/time-ago}})
+              {:opts {:formatter datetime/time-ago-abbreviated}})
     " ago"]
    (str " (" (build-model/duration build) ")")])


Add remote debug JVM param to project.clj

--- domain/project.clj
+++ domain/project.clj
@@ -13,4 +13,5 @@
   :ring {:handler domain.core/app
          :nrepl {:start? true
                  :port 3001}}
+  :jvm-opts ["-agentlib:jdwp=transport=dt_socket,server=y,suspend=y,address=5005"]
   :aot [domain.core])


Generalize background css to be not just for /enterprise

--- src-cljs/frontend/components/enterprise.cljs
+++ src-cljs/frontend/components/enterprise.cljs
@@ -31,8 +31,8 @@
                :src (utils/cdn-path (str "/img/outer/enterprise/arrow-" name ".svg"))}])

 (defn language [name]
-  [:img.language {:class name
-                  :src (utils/cdn-path (str "/img/outer/languages/language-" name ".svg"))}])
+  [:img.background.language {:class name
+                             :src (utils/cdn-path (str "/img/outer/languages/language-" name ".svg"))}])

 (defn contact-form
   [app owner opts]


WIP trying out a couple testing approaches

working to ensure that when a new block is
received the previous mining attempts are abandoned

--- test/block_chain/message_handlers_test.clj
+++ test/block_chain/message_handlers_test.clj
@@ -3,6 +3,7 @@
             [block-chain.utils :refer :all]
             [clojure.pprint :refer [pprint]]
             [block-chain.wallet :as wallet]
+            [block-chain.target :as target]
             [block-chain.miner :as miner]
             [block-chain.transactions :as txn]
             [org.httpkit.server :as httpkit]
@@ -294,3 +295,67 @@
       (is (= 4 (q/chain-length @db/db)))
       (is (= (q/highest-block @peer-db)
              (q/highest-block @db/db))))))
+
+(defn timed-out? [start duration]
+  (> (- (current-time-millis) start) duration))
+
+#_(deftest test-receiving-outside-block-stops-miner
+  (let [alt-block (miner/mine (miner/next-block @db/db))
+        mining-future (atom nil)]
+
+    (println "future: " @mining-future)
+
+    #_[target/default target/hard]
+    (reset! mining-future
+            (future
+              (println "FUTURE...")
+              (with-bindings {#'target/default target/hard}
+                (println "Target in thread: " target/default)
+                (miner/mine-and-commit-db! db/db))))
+
+    (println "Target in main: " target/default)
+    (println "future: " @mining-future)
+    (is (= {:message "block-accepted" :payload alt-block}
+           (handler {:message "submit_block" :payload alt-block}
+                    sock-info)))
+
+    (is (= :finished
+           (loop [start-time (current-time-millis)]
+             (cond
+               (timed-out? start-time 500) :timeout-elapsed
+               (future-done? @mining-future) :finished
+               :else (recur start-time))
+             )))
+    (miner/interrupt-miner!))
+  ;; make 1 block and mine it
+  ;; redef target hard
+  ;; start mine-and-commit-db! in future
+  ;; submit the mined block to db
+
+  ;; set a timestamp and start looping
+  ;; each loop check if future is done
+  ;; if so: pass
+  ;; if time diff is past threshold
+  ;; miner interrupt
+  )
+
+
+(deftest test-receiving-outside-block-stops-miner
+  (let [alt-block (miner/mine (miner/next-block @db/db))
+        pending (-> (miner/next-block @db/db)
+                    (assoc-in [:header :target] target/hard))
+        mining-future (future
+                        (miner/mine pending))]
+
+    (is (= {:message "block-accepted" :payload alt-block}
+           (handler {:message "submit_block" :payload alt-block}
+                    sock-info)))
+
+    (is (= :finished
+           (loop [start-time (current-time-millis)]
+             (cond
+               (timed-out? start-time 500) :timeout-elapsed
+               (future-done? mining-future) :finished
+               :else (recur start-time))
+             )))
+    (miner/interrupt-miner!)))


Label nodes in SVG

Label nodes in SVG

--- devcards/frontend/devcards/map.cljs
+++ devcards/frontend/devcards/map.cljs
@@ -216,13 +216,15 @@
              :height "500"}
        (for [[x things] (map-indexed vector things-in-columns)]
          (for [[y thing] (map-indexed vector things)]
-           (if thing
-             [:rect {:stroke "black"
-                     :fill "none"
-                     :width width
-                     :height height
-                     :x (* x (+ width x-spacing))
-                     :y (* y (+ height 10))}])))
+           (when thing
+             [:g {:transform (str "translate(" (* x (+ width x-spacing)) "," (* y (+ height 10)) ")")}
+              [:rect {:stroke "black"
+                      :fill "none"
+                      :width width
+                      :height height}]
+              [:text {:x 10
+                      :y 25}
+               thing]])))
        (for [[from to] edges
              :let [[fx fy] (get cs from)
                    [tx ty] (get cs to)]]


plan helpers

plan helpers

--- frontend/models/plan.cljs
+++ frontend/models/plan.cljs
@@ -26,7 +26,7 @@
   (not= (get-in plan [:template_properties :type] "trial") "trial"))

 (defn can-edit-plan? [plan org-name]
-  (and (utils/inspect (paid? plan)) (not (piggieback? plan org-name))))
+  (and (paid? plan) (not (piggieback? plan org-name))))

 (defn trial? [plan]
   (some-> plan :template_properties :type name (= "trial")))
@@ -55,3 +55,14 @@

           :else
           (str (time/in-minutes trial-interval) " minutes"))))
+
+;; The template tells how to price the plan
+(def default-template-properties {:price 19 :container_cost 50 :id "p18" :max_containers 1000 :free_containers 1})
+
+(defn container-cost [template-properties containers]
+  (let [{:keys [free_containers container_cost]} template-properties]
+    (max 0 (* container_cost (- containers free_containers)))))
+
+(defn cost [template-properties containers]
+  (+ (:price template-properties)
+     (container-cost template-properties containers)))


Some work on secretbox nmr tests

Some work on secretbox nmr tests

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -6,7 +6,7 @@
             [caesium.randombytes :as r]
             [caesium.util :as u]
             [caesium.crypto.generichash :as g]
-            [caesium.byte-bufs :refer [buflen]]))
+            [caesium.byte-bufs :as bb]))

 (deftest xor-test
   (let [one (byte-array [1 0 1])
@@ -23,45 +23,54 @@
   (let [a (#'ms/random-nonce!)
         b (#'ms/random-nonce!)]
     (is (not (u/array-eq a b)))
-    (is (= s/noncebytes (buflen a) (buflen b)))))
+    (is (= s/noncebytes (bb/buflen a) (bb/buflen b)))))

 (defn is-valid-magicnonce-ctext?
   "Does the given ctext decrypt properly?"
   [ctext]
-  (let [ptextlen (buflen st/ptext)]
+  (let [ptextlen (bb/buflen st/ptext)]
     (is (= (+ s/noncebytes s/macbytes ptextlen)
-           (buflen ctext)))
+           (bb/buflen ctext)))

     (let [out (byte-array ptextlen)]
       (ms/decrypt-to-buf! out st/secret-key ctext)
       (is (u/array-eq st/ptext out)))

-    (let [out (byte-array ptextlen)
-          forgery (r/randombytes (buflen out))]
+    (let [out (bb/alloc ptextlen)
+          forgery (bb/->indirect-byte-buf (r/randombytes (bb/buflen out)))]
       (is (thrown-with-msg?
            RuntimeException #"Ciphertext verification failed"
-           (ms/decrypt-to-buf! out st/secret-key forgery))))
+           (ms/decrypt-to-buf!
+            out
+            (bb/->indirect-byte-buf st/secret-key)
+            forgery))))

     (is (u/array-eq st/ptext (ms/decrypt st/secret-key ctext)))

-    (let [forgery (r/randombytes (buflen ctext))]
+    (let [forgery (bb/->indirect-byte-buf (r/randombytes (bb/buflen ctext)))]
       (is (thrown-with-msg?
            RuntimeException #"Ciphertext verification failed"
            (ms/decrypt st/secret-key forgery))))

-    (let [out (byte-array ptextlen)]
-      (ms/open-to-buf! out ctext st/secret-key)
+    (let [out (bb/alloc ptextlen)]
+      (ms/open-to-buf!
+       out
+       (bb/->indirect-byte-buf ctext)
+       (bb/->indirect-byte-buf st/secret-key))
       (is (u/array-eq st/ptext out)))

-    (let [out (byte-array ptextlen)
-          forgery (r/randombytes (buflen out))]
+    (let [out (bb/alloc ptextlen)
+          forgery (bb/->indirect-byte-buf (r/randombytes (bb/buflen out)))]
       (is (thrown-with-msg?
            RuntimeException #"Ciphertext verification failed"
-           (ms/open-to-buf! out forgery st/secret-key))))
+           (ms/open-to-buf!
+            out
+            forgery
+            (bb/->indirect-byte-buf st/secret-key)))))

     (is (u/array-eq st/ptext (ms/open ctext st/secret-key)))

-    (let [forgery (r/randombytes (buflen ctext))]
+    (let [forgery (r/randombytes (bb/buflen ctext))]
       (is (thrown-with-msg?
            RuntimeException #"Ciphertext verification failed"
            (ms/open forgery st/secret-key))))))
@@ -116,7 +125,7 @@
       (is (= (range s/noncebytes) (take s/noncebytes c1) (take s/noncebytes c2))))))

 (deftest synthetic-nonce-test
-  (is (= (buflen @#'ms/synthetic-personal)
+  (is (= (bb/buflen @#'ms/synthetic-personal)
          g/blake2b-personalbytes))
   (let [k1 (byte-array (reverse (range 32)))
         k2 (byte-array (reverse (range 32 64)))
@@ -124,10 +133,10 @@
         m1 (byte-array (range 10))
         m2 (byte-array (range 10 20))]
     (is (= s/noncebytes
-           (buflen (sn m1 k1))
-           (buflen (sn m2 k1))
-           (buflen (sn m1 k2))
-           (buflen (sn m2 k2))))
+           (bb/buflen (sn m1 k1))
+           (bb/buflen (sn m2 k1))
+           (bb/buflen (sn m1 k2))
+           (bb/buflen (sn m2 k2))))
     (is (u/array-eq (sn m1 k1) (sn m1 k1)))
     (is (not (u/array-eq (sn m1 k1) (sn m2 k1))))
     (is (not (u/array-eq (sn m1 k1) (sn m1 k2))))))


re-initlizing

re-initlizing

--- test/celestial/integration/persistency.clj
+++ test/celestial/integration/persistency.clj
@@ -3,14 +3,14 @@
   (:refer-clojure :exclude [type])
   (:import clojure.lang.ExceptionInfo)
   (:require
-    [celestial.redis :refer (clear-all)]
     [celestial.fixtures.core :refer (with-conf is-type?)]
+    [celestial.fixtures.populate :refer (re-initlize)]
     [celestial.persistency :as p])
   (:use midje.sweet))

 (with-conf
-  (with-state-changes [(before :facts (clear-all))]
+  (with-state-changes [(before :facts (re-initlize))]
     (fact "generated crud user ops" :integration :redis
           (let [user {:username "foo" :password "bla" :roles #{:celestial.roles/user} :envs []} id (p/add-user user)]
             (p/get-user id) => user


Return the actual rmq-connection

Return the actual rmq-connection

--- resources/leiningen/new/kraken_works/queue.clj
+++ resources/leiningen/new/kraken_works/queue.clj
@@ -7,7 +7,7 @@
   (let [max-retries 5
         rmq-conn (kehaar.rabbitmq/connect-with-retries connection max-retries)
         kehaar-resources (kehaar/init! rmq-conn kehaar)]
-    {:connections [connection]
+    {:connections [rmq-conn]
      :kehaar-resources kehaar-resources}))

 (defn close-resources! [resources]


Changing PHI warning

Changing PHI warning

--- src/cljs/org/broadinstitute/firecloud_ui/common.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/common.cljs
@@ -186,9 +186,8 @@
           ;; something nonsensical has been selected, submission will probably fail anyway:
           :else 1)))

-
 (def PHI-warning
-  [:div {:style {:display "inline-flex" :marginBottom ".5em"}}
-   [:div {} (icons/icon {:style {:fontSize 48 :color (:exception-state style/colors) :marginRight ".15em"
+  [:div {:style {:display "inline-flex" :marginBottom ".5em" :marginLeft ".3em"}}
+   [:div {} (icons/icon {:style {:fontSize 28 :color (:exception-state style/colors) :marginRight ".26em"
                                  :verticalAlign "middle"}} :warning-triangle)]
-   [:span {:style {:fontWeight "bold" :fontSize "106%"}} "FireCloud is not intended to host personally identifiable information. Do not use any patient identifier, including name, social security number, or medical record number."]])+   [:span {:style {:fontWeight "bold" :fontSize "98%" :marginTop ".18a em"}} "FireCloud is not intended to host personally identifiable information. Do not use any patient identifier, including name, social security number, or medical record number."]])


mounts type + ro also relative

mounts type + ro also relative

--- src/cljs/swarmpit/component/service/form_mounts.cljs
+++ src/cljs/swarmpit/component/service/form_mounts.cljs
@@ -8,13 +8,13 @@
 (def cursor [:page :service :wizard :mounts])

 (def headers [{:name  "Type"
-               :width "150px"}
+               :width "15%"}
               {:name  "Container path"
                :width "35%"}
               {:name  "Host path"
                :width "35%"}
               {:name  "Read only"
-               :width "50px"}])
+               :width "5%"}])

 (def empty-info
   (comp/form-value "No mounts defined for the service."))


don't automatically trampoline on windows

#682 and #687

--- plugin/src/leiningen/figwheel.clj
+++ plugin/src/leiningen/figwheel.clj
@@ -8,6 +8,7 @@
    [leiningen.trampoline :as tramp]
    [clojure.java.io :as io]
    [clojure.set :refer [intersection]]
+   [clojure.string :as string]
    [leiningen.figwheel.fuzzy :as fuz]
    [simple-lein-profile-merge.core :as lm]))

@@ -538,6 +539,15 @@
         (if (and
              (or (= nil command)
                  (= ":reactor" command))
+             ;; no auto-trampoline on windows
+             ;; users can call lein trampoline figwheel if they wish
+             ;; see
+             ;; https://github.com/technomancy/leiningen/issues/982
+             ;; and
+             ;; https://github.com/bhauman/lein-figwheel/issues/682
+             (not (-> (System/getProperty "os.name")
+                      (string/lower-case)
+                      (.contains "windows")))
              (get-in project [:figwheel :repl] true)
              (get-in project [:figwheel :readline] true))
           (if tramp/*trampoline?*


Identify specific model in web UI.

Identify specific model in web UI.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -2729,7 +2729,7 @@
 (defmethod controllers/bind-to-show-impl ::controller
   [kind show port-in port-out device & {:keys [refresh-interval display-name]
                                         :or   {refresh-interval (/ 1000 15)
-                                               display-name     "Ableton Push"}}]
+                                               display-name     "Ableton Push 2"}}]
   {:pre [(some? show)]}
   (load-fonts)
   (let [modes (atom #{})


bring comment-counts filename up to date

--- src/atom_finder/questions/comment_counts.clj
+++ src/atom_finder/questions/comment_counts.clj
@@ -126,7 +126,7 @@
        ;frequencies
        (map prn)
        dorun
-       (log-to "tmp/comment-counts_2018-01-30_01_potential-atom-nodes_memory.edn")
+       (log-to "tmp/comment-counts_2018-10-05_01_filter-better-extensions.edn")
        time-mins
    ))


CM #53 - check username validity function

--- test/objective8/workflows/sign_up_test.clj
+++ test/objective8/workflows/sign_up_test.clj
@@ -9,3 +9,9 @@
         (authorised-redirect :user :some-url session-with-invitation)) => :authorised-response
         (provided
          (authorise (contains {:session (contains {:invitation :invitation-data})}) :user) => :authorised-response))
+
+(fact "only usernames containing alphanumeric characters, and between 1 and 16 characters long are valid"
+      (validate-username "1-a") => falsey
+      (validate-username "") => falsey
+      (validate-username "123456789abcdefgh") => falsey
+      (validate-username "val1d") => "val1d")


Feature-flag Bitbucket copy

Feature-flag Bitbucket copy

--- src-cljs/frontend/components/add_projects.cljs
+++ src-cljs/frontend/components/add_projects.cljs
@@ -165,7 +165,11 @@
 (def repos-explanation
   [:div.add-repos
    [:ul
-    [:li "Get started by selecting your GitHub or Bitbucket username or organization."]
+    [:li
+     "Get started by selecting your GitHub "
+     (when (feature/enabled? :bitbucket)
+       "or Bitbucket ")
+     "username or organization."]
     [:li "Choose a repo you want to test and we'll do the rest!"]]])

 (defn add-projects-head-actions [data owner]


Wordsmithing iOS -> OS X on plans page.

Wordsmithing iOS -> OS X on plans page.

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -433,12 +433,12 @@
         (html
           [:div.osx-plans {:data-component `osx-plans-list-ga}
            [:fieldset
-            [:legend (str "iOS Plans")]
-            [:p "Your selection selection below only applies to iOS service and will not affect Linux Containers."]
+            [:legend (str "OS X Plans")]
+            [:p "Your selection selection below only applies to OS X service and will not affect Linux Containers."]
             (when (and (pm/osx-trial-plan? plan) (not (pm/osx-trial-active? plan)))
-              [:p "The iOS trial you've selected has expired, please choose a plan below."])
+              [:p "The OS X trial you've selected has expired, please choose a plan below."])
             (when (and (pm/osx-trial-plan? plan) (pm/osx-trial-active? plan))
-              [:p (gstring/format "You have %s left on the iOS trial."
+              [:p (gstring/format "You have %s left on the OS X trial."
                                   (datetime/time-ago (time/in-millis (time/interval (js/Date. plan-start) (js/Date. trial-end)))))])]
            [:div.plan-selection
             (om/build-all osx-plan-ga osx-plans)]])))))


Now using core.async instead of agents

Now using core.async instead of agents

--- src/espdig/components/youtube_downloader.clj
+++ src/espdig/components/youtube_downloader.clj
@@ -2,7 +2,8 @@
   (:require [com.stuartsierra.component :as component]
             [taoensso.timbre :as log]
             [espdig.components.db :as db]
-            [pl.danieljanus.tagsoup :as tagsoup]))
+            [pl.danieljanus.tagsoup :as tagsoup]
+            [clojure.core.async :as async]))

 (def tbl-name "yt_videos")
 (def running? (atom false))
@@ -11,12 +12,11 @@
   [resp k]
   (some #(when (and (vector? %) (= (first %) k)) %) resp))

-(defn check-feed!
-  [_ db feed feed-idx]
+(defn fetch-feed-entries!
+  [db feed]
   (log/debug "Checking feed:" feed)
   (when-let [resp (tagsoup/parse feed)]
-    (hash-map :idx feed-idx
-              :chan-id (-> resp (find-element :channelId) (last))
+    (hash-map :chan-id (-> resp (find-element :channelId) (last))
               :author  (-> resp (find-element :author) (find-element :name) (last))
               :entries (map #(hash-map :id (-> % (find-element :videoId) (last))
                                        :title (-> % (find-element :title) (last))
@@ -31,14 +31,16 @@

 (defn start-loop!
   [db feeds]
-  (let [ended? (atom false)
-        a      (agent nil)]
-    (add-watch a :watcher (fn [_ _ _ state]
-                            (record-entries! state)
-                            (when (zero? (:idx state))
-                              (reset! ended? true))))
-    (doseq [[feed-idx feed] (reverse (map-indexed vector feeds))]
-      (send a check-feed! db feed feed-idx))))
+  (async/go-loop []
+    (loop [remaining-feeds feeds]
+      (when-let [feed (first remaining-feeds)]
+        (let [{:keys [chan-id author entries]} (fetch-feed-entries! db feed)]
+          (doseq [entry entries]
+            (println "Found entry" (:id entry))))
+        (recur [(next remaining-feeds)])))
+    (Thread/sleep 10000) ;; 10 secs
+    (when @running?
+      (recur))))

 (defn create-schema!
   [db]