Utility function for parsing and bootstrapping in tests

--- test/puppetlabs/trapperkeeper/core_test.clj
+++ test/puppetlabs/trapperkeeper/core_test.clj
@@ -10,6 +10,14 @@
             [puppetlabs.testutils.logging :refer [with-test-logging with-test-logging-debug]]
             [puppetlabs.utils.classpath :refer [with-additional-classpath-entries]]))

+(defn parse-and-bootstrap
+  ([bootstrap-config]
+   (parse-and-bootstrap bootstrap-config {}))
+  ([bootstrap-config cli-data]
+   (-> bootstrap-config
+       parse-bootstrap-config!
+       (trapperkeeper/bootstrap* cli-data))))
+
 (deftest test-bootstrapping
   (testing "Valid bootstrap configurations"
     (let [bootstrap-config    "
@@ -18,7 +26,7 @@
 puppetlabs.trapperkeeper.examples.bootstrapping.test-services/hello-world-service

 "
-          app                 (trapperkeeper/bootstrap* (parse-bootstrap-config! (StringReader. bootstrap-config)))]
+          app                 (parse-and-bootstrap (StringReader. bootstrap-config))]

       (testing "Can load a service based on a valid bootstrap config string"
         (let [test-fn             (trapperkeeper/get-service-fn app :foo-test-service :test-fn)
@@ -33,7 +41,7 @@
       (testing "The CLI service has the CLI data."
         (let [config-file-path  "/path/to/config/files"
               cli-data          (trapperkeeper/parse-cli-args! ["--config" config-file-path "--debug"])
-              app-with-cli-args (trapperkeeper/bootstrap* (parse-bootstrap-config! (StringReader. bootstrap-config)) cli-data)
+              app-with-cli-args (parse-and-bootstrap (StringReader. bootstrap-config) cli-data)
               cli-data-fn       (trapperkeeper/get-service-fn app-with-cli-args :cli-service :cli-data)]
           (is (not (empty? (cli-data-fn))))
           (is (cli-data-fn :debug))
@@ -103,14 +111,14 @@
         (is (thrown-with-msg?
               IllegalArgumentException
               #"(?is)Invalid line in bootstrap.*This is not a legit line"
-              (trapperkeeper/bootstrap* (parse-bootstrap-config! bootstrap-config))))))
+              (parse-and-bootstrap bootstrap-config)))))

     (testing "Bootstrap config file is empty."
       (let [bootstrap-config (StringReader. "")]
         (is (thrown-with-msg?
               Exception
               #"Empty bootstrap config file"
-        (trapperkeeper/bootstrap* (parse-bootstrap-config! bootstrap-config))))))
+        (parse-and-bootstrap bootstrap-config)))))

     (testing "Service namespace doesn't exist"
       (let [bootstrap-config (StringReader.
@@ -118,7 +126,7 @@
         (is (thrown-with-msg?
               IllegalArgumentException
               #"Unable to load service: non-existent-service/test-service"
-              (trapperkeeper/bootstrap* (parse-bootstrap-config! bootstrap-config))))))
+              (parse-and-bootstrap bootstrap-config)))))

     (testing "Service function doesn't exist"
       (let [bootstrap-config (StringReader.
@@ -126,7 +134,7 @@
         (is (thrown-with-msg?
               IllegalArgumentException
               #"Unable to load service: puppetlabs.trapperkeeper.examples.bootstrapping.test-services/non-existent-service"
-              (trapperkeeper/bootstrap* (parse-bootstrap-config! bootstrap-config))))))
+              (parse-and-bootstrap bootstrap-config)))))

     (testing "Invalid service graph"

@@ -135,7 +143,7 @@
         (is (thrown-with-msg?
               IllegalArgumentException
               #"Invalid service graph;"
-              (trapperkeeper/bootstrap* (parse-bootstrap-config! bootstrap-config)))))))
+              (parse-and-bootstrap bootstrap-config))))))

   (testing "CLI arg parsing"
     (testing "CLI args are parsed to a map"


Tag-set added

Tag-set added

Ultimately, tags entered in the :tags field of a post map should be
present in the tagset too, or an exception will be raised. This should
help catch typos in tags and in having an authorative set of tags

--- src/omhome/posts_meta.clj
+++ src/omhome/posts_meta.clj
@@ -3,20 +3,22 @@
 (def empty-post
   {:title ""
    :post-url "" ;; a custom url for the post
-   :post-filepath "" ;; a path to the post data. The filename suffix determines the post format (.md, .html or .clj for hiccup).
+   :post-filepath "" ;; a path to the post data. The filename suffix determines the post format (.md, .html or .clj for hiccup).
    :publish false ;; set to true to include the post in the generated output, indices etc
    :date ""
    :category ""
    :tags []
-   :author "Oliver Mooney"
+   :author "Oliver Mooney"
    })
+
+(def tagset #{}) ;; any tags cited in meta post data but not found here will raise an error (to help catch tag typos)

 (def posts
   [
    (assoc empty-post
           :title "Test meta hiccup post"
           :post-url "/hicplay/"
-          :post-filepath "resources/fragments/hicplay.clj")
+          :post-filepath "resources/fragments/hicplay.clj")
    (assoc empty-post
           :title "On VIM"
           :post-url "/onvim/"


Remove li markup

Remove li markup

--- src/orbitingnews/core.clj
+++ src/orbitingnews/core.clj
@@ -16,12 +16,12 @@
     [:body
       [:h1 "Orbiting News"]
       [:h2 "Houston we have a problem"]
-      [:img {:src "https://earthkam.ucsd.edu/images/iss-future.jpg"}]
+      [:img {:src "https://earthkam.ucsd.edu/images/iss-future.jpg" :width "20%"}]
       (for [tweet tweets]
         [:p tweet])]])

 (defn root-handler [req]
-  (let [tweets (map #(str "<li>" (.getText %) "</li>") (twitter/search "#clojurecup"))]
+  (let [tweets (map #(.getText %) (twitter/search "#clojurecup"))]
     (dom/html (tweets-page tweets))))

 (defroutes app-routes


send message serialized with transit

send message serialized with transit

--- src/orbitingnews/core.clj
+++ src/orbitingnews/core.clj
@@ -1,13 +1,15 @@
 (ns orbitingnews.core
   (:use compojure.core)
   (:use org.httpkit.server)
-  (:use org.httpkit.timer)
+  (:import [java.io ByteArrayInputStream ByteArrayOutputStream])
   (:require [org.httpkit.client :as http]
+            [org.httpkit.timer :as timer]
             [compojure.route :as route]
             [orbitingnews.config :as config]
             [orbitingnews.twitter :as twitter]
             [hiccup.core :as dom]
-            [hiccup.page :as page])
+            [hiccup.page :as page]
+            [cognitect.transit :as transit])
   (:gen-class))

 (defn handler [req]
@@ -16,9 +18,14 @@
     (on-close channel (fn [status]
                         (println "channel closed, " status)))

-    (if (websocket? channel)
-      (println "WebSocket channel")
-      (println "HTTP channel"))
+      (loop [id 0]
+        (when (< id 10)
+          (timer/schedule-task (* id 200) ;; send a message every 200ms
+                               (let [out (ByteArrayOutputStream. 4096)
+                                     writer (transit/writer out :json)]
+                                 (transit/write writer {:msg (str "message from server #" id)})
+                                 (send! channel (.toString out) false))) ; false => don't close after send
+          (recur (inc id))))

     (on-receive channel (fn [data]       ; data received from client
                           ;; An optional param can pass to send!: close-after-send?


extract gen-synth-name and simplify pre-synth slightly.

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -224,28 +224,32 @@
           []
           (partition 2 params)))

+(defn- gen-synth-name
+  "Auto generate an anonymous synth name. Intended for use in synths that have not
+   been defined with an explicit name. Has the form \"anon-id\" where id is a unique
+   integer across all anonymous synths."
+  []
+  (str "anon-" (next-id :anonymous-synth)))
+
 ; TODO: Figure out how to generate the let-bindings rather than having them
 ; hard coded here.
 (defmacro pre-synth [& args]
   (let [[sname args] (cond
                        (or (string? (first args))
                            (symbol? (first args))) [(str (first args)) (rest args)]
-                       :default                    [:no-name args])
+                       :default                    [(gen-synth-name) args])
         [params ugen-form] (if (vector? (first args))
                              [(first args) (rest args)]
                              [[] args])
         params (vec (map #(if (symbol? %) (str %) %) params))
         param-proxies (control-proxies params)]
-    `(let [~@param-proxies
-           sname# (if (= :no-name ~sname)
-                    (str "anon-" (next-id :anonymous-synth))
-                    ~sname)]
+    `(let [~@param-proxies]
        (binding [*ugens* []
                  *constants* #{}]
          (with-ugens
            (do
              ~@ugen-form)
-           [sname# ~params *ugens* (into [] *constants*)])))))
+           [~sname ~params *ugens* (into [] *constants*)])))))

 (defmacro synth
   "Define a SuperCollider synthesizer using the library of ugen functions


Allows to generate test results in junit format

--- src/riemann/bin.clj
+++ src/riemann/bin.clj
@@ -5,6 +5,7 @@
             riemann.time
             [riemann.test :as test]
             riemann.pubsub
+            [clojure.test.junit :refer [with-junit-output]]
             [cemerick.pomegranate :as pom]
             [clojure.java.io :as io]
             [clojure.tools.logging :refer :all])
@@ -82,6 +83,28 @@
       (get (re-find #"^(\d+).*" name) 1)
       (catch Exception e name))))

+
+(defn run-tests-with-format
+  "Run all tests matching `test-name-pattern`.
+  If the `test.output.format` property is set to `junit`, the test output will be
+  JUnit compatible."
+  [test-name-pattern]
+  (if (= (System/getProperty "test.output.format")
+         "junit")
+    (with-junit-output
+      (clojure.test/run-all-tests test-name-pattern))
+    (clojure.test/run-all-tests test-name-pattern)))
+
+(defn run-tests
+  "Run all tests matching `test-name-pattern`.
+  The test output will be saved in the `test.output.file` value if this property is set."
+  [test-name-pattern]
+  (if-let [file-path (System/getProperty "test.output.file")]
+    (with-open [w (java.io.FileWriter. file-path)]
+      (binding [clojure.test/*test-out* w]
+        (run-tests-with-format test-name-pattern)))
+    (run-tests-with-format test-name-pattern)))
+
 (defn -main
   "Start Riemann. Loads a configuration file from the first of its args."
   ([]
@@ -108,7 +131,7 @@
                 (riemann.config/include @config-file)
                 (binding [test/*streams* (:streams @config/next-core)]
                   (let [test-name-pattern (if test-name (re-pattern test-name) #".*-test")
-                        results (clojure.test/run-all-tests test-name-pattern)]
+                        results (run-tests test-name-pattern)]
                     (if (and (zero? (:error results))
                              (zero? (:fail results)))
                       (System/exit 0)


require should be kw

require should be kw


[popovers] remove stopPropagation from popover event listener

This prevented links in the popover from being seen by secretary,
causing a full page refresh on click

--- src/braid/popovers/impl.cljs
+++ src/braid/popovers/impl.cljs
@@ -17,11 +17,9 @@
                           (when-not modal?
                             (reset! popover nil)))
         :on-click (fn [e]
-                    (.stopPropagation e)
                     (when (= (.-target e) (.-currentTarget e))
                       (reset! popover nil)))
         :on-touch-start (fn [e]
-                          (.stopPropagation e)
                           (when (= (.-target e) (.-currentTarget e))
                             (reset! popover nil)))
         :style


Remove debug print

Remove debug print

--- src/chronograph/handlers.clj
+++ src/chronograph/handlers.clj
@@ -113,7 +113,6 @@
                      arg1 (::arg1 ctx)
                      arg2 (::arg2 ctx)
                      arg3 (::arg3 ctx)]
-                 (prn doi type-id source-id (t/now) 1 arg1 arg2 arg3)
                (d/insert-event doi type-id source-id (t/now) 1 arg1 arg2 arg3))))

 (defresource doi-facts


Fix migration 2 (spec->project) which didn't migrate :inferred, and had a bad assertion.

--- src/circle/db/migrations.clj
+++ src/circle/db/migrations.clj
@@ -25,9 +25,9 @@
   :num 2
   :coll :projects
   :transform (fn [p]
-               (assert (= 1 (mongo/fetch :specs :where {:project_id (:_id p)} :count? true)))
+               (assert (> 2 (mongo/fetch-count :specs :where {:project_id (:_id p)})))
                (let [spec (mongo/fetch-one :specs :where {:project_id (:_id p)})]
-                 (apply-if spec merge p (select-keys spec [:dependencies :setup :compile :test])))))
+                 (apply-if spec merge p (select-keys spec [:dependencies :setup :compile :test :inferred])))))

 ;; (def-migration "old builds w/ git commit info")


Return payload on insert / update, add find-by-id

--- src/clj/clojuredocs/data.clj
+++ src/clj/clojuredocs/data.clj
@@ -10,16 +10,21 @@
   (let [context-name :create
         coll (:mongo-coll comp)]
     (validate-payload comp context-name payload)
-    (mon/insert! coll payload)))
+    (mon/insert! coll payload)
+    payload))

 (defn update-where! [comp where-fn payload]
   (let [context-name :update
         coll (:mongo-coll comp)]
     (validate-payload comp context-name payload)
-    (mon/update! coll (where-fn payload) payload)))
+    (mon/update! coll (where-fn payload) payload)
+    payload))

 (defn update-by-id! [schema payload]
   (update-where! schema #(select-keys % [:_id]) payload))
+
+(defn find-by-id [{:keys [mongo-coll]} _id]
+  (mon/fetch-one mongo-coll :where {:_id _id}))

 ;; Examples
@@ -39,7 +44,6 @@
             :var.ns ns
             :var.library-url library-url}
     :sort {:created-at 1}))
-

 ;; Notes


Add with-fresh-collected docstring

Add with-fresh-collected docstring

--- src/clj/com/rpl/specter.cljc
+++ src/clj/com/rpl/specter.cljc
@@ -1089,7 +1089,12 @@
   (collect-val [this structure]
     val))

-(defdynamicnav with-fresh-collected
+(defdynamicnav
+  ^{:doc
+    "Continues navigating on the given path with the collected vals reset to []. Once
+     navigation leaves the scope of with-fresh-collected, the collected vals revert
+     to what they were before."}
+  with-fresh-collected
   [& path]
   (late-bound-richnav [late (late-path path)]
     (select* [this vals structure next-fn]


resolve login redirect issue

resolve login redirect issue

--- src/clj_money/web/server.clj
+++ src/clj_money/web/server.clj
@@ -40,7 +40,8 @@
   (-> routes
       (friend/authenticate
         {:workflows [(workflows/interactive-form)]
-         :credential-fn (partial clj-money.models.users/authenticate (env :db))})
+         :credential-fn (partial clj-money.models.users/authenticate (env :db))
+         :redirect-on-auth? false})
       (wrap-resource "public")
       (wrap-keyword-params)
       (wrap-params)


Change card input to add to atom defined in core

--- src/cljs/decktouch/core.cljs
+++ src/cljs/decktouch/core.cljs
@@ -6,6 +6,8 @@
               [goog.history.EventType :as EventType]
               [decktouch.card-data :as card-data])
     (:import goog.History))
+
+(def the-cards (atom card-data/cards))

 (defn get-card-input-value []
   (.-value (.getElementById js/document "the-input")))
@@ -16,9 +18,10 @@
    (str card)])

 (defn card-input []
-  [:form {:on-submit #(do
-                       (swap! card-data/cards (conj @card-data/cards)
-                                              (get-card-input-value))
+  [:form {:onSubmit #(do
+                       (swap! the-cards conj
+                                             {:name (get-card-input-value)})
+                       (.log js/console (str @the-cards))
                        false)}
    [:input#the-input {:type "text"}]])

@@ -29,7 +32,8 @@

 (defn home-page []
   [:div [:h2 "Welcome to decktouch"]
-   [:div [card-list @card-data/cards]]
+   [:div (card-input)]
+   [:div [card-list @the-cards]]
    [:div [:a {:href "#/about"} "go to about page"]]])

 (defn about-page []


fix sort order

fix sort order

--- src/clojure/cljam/sorter.clj
+++ src/clojure/cljam/sorter.clj
@@ -22,14 +22,19 @@
 (defn- replace-header [hdr vn so]
   (conj hdr {:HD {:VN vn, :SO so}}))

-(defn- compkey-pos [ref-map b]
-  [(get ref-map (:rname b)) (:pos b)])
+(defn- compare-key-pos [ref-map b1 b2]
+  (if (= (:rname b1) (:rname b2))
+    (compare (:pos b1) (:pos b2))
+    (cond
+     (= (:rname b1) "*") 1
+     (= (:rname b2) "*") -1
+     :else (compare (:rname b1) (:rname b2)))))

 (defn- sort-alignments-by-pos [rdr]
   (let [ref-map (apply merge
                        (map-indexed (fn [i val] {val i})
                                     (map :name (sam-util/make-refs (io/read-header rdr)))))]
-    (sort-by (partial compkey-pos ref-map) (io/read-coordinate-blocks rdr))))
+    (sort (compare-key-pos ref-map) (io/read-coordinate-blocks rdr))))

 ;;
 ;; queryname sorter
@@ -59,18 +64,19 @@
   (format "%s/%s_%05d.sorted.cache" util/temp-dir prefix i))

 (defn- find-head
-  ([keyfn x] x)
-  ([keyfn x y] (case (compare (keyfn x) (keyfn y))
-                 0 x
-                 1 y
-                 -1 x))
-  ([keyfn x y & more]
-     (reduce #(find-head keyfn %1 %2) (find-head keyfn x y) more)))
+  ([keyfn l]
+     (reduce (fn [e1 e2]
+               (condp = (compare e1 e2)
+                 0 e1
+                 1 e2
+                 -1 e1))
+             l)))

 (defn- head
   [blocks ref-map]
-  (apply find-head
-         (fn [[idx b]] (compkey-pos ref-map b))
+  (find-head
+         (fn [[idx1 b1] [idx2 b2]]
+           (compare-key-pos ref-map b1 b2))
          (filter
           (fn [[_ b]] (not (nil? b)))
           (map-indexed vector blocks))))
@@ -102,7 +108,7 @@
         (let [candidates (map first blocks-list)]
           (when-not (every? nil? candidates)
             (let [[i b] (head candidates ref-map)]
-              (io/write-blocks wtr [b])
+              (io/write-coordinate-blocks wtr [b])
               (recur (map
                       (fn [[idx blocks]]
                         (if (= idx i)


fix docs for coerce! fixes #131

fix docs for coerce! fixes #131


guard againt empty dep trees

guard againt empty dep trees


improve credential handling for e2e

improve credential handling for e2e

Signed-off-by: Michele Balistreri <47483730395cccb6448ad7313d5cedb48de25e40@bitgamma.com>

--- src/status_im/keycard/simulated_keycard.cljs
+++ src/status_im/keycard/simulated_keycard.cljs
@@ -12,6 +12,11 @@
             [taoensso.timbre :as log]
             [status-im.multiaccounts.create.core :as multiaccounts.create]))

+(def kk1-password "000000")
+(def default-pin "111111")
+(def default-puk "000000000000")
+(def account-password (ethereum/sha3 "no password"))
+
 (def initial-state
   {:card-connected?  false
    :nfc-started? false
@@ -27,7 +32,7 @@
 (defn connect-selected-card []
   (swap! state assoc :application-info
          {:free-pairing-slots     5
-          :app-version            "2.2"
+          :app-version            "3.0"
           :secure-channel-pub-key "04c3071768912a515c00aeab7ceb8a5bfda91d036f4a4e60b7944cee3ca7fb67b6d118e8df1e2480b87fd636c6615253245bbbc93a6a407f155f2c58f76c96ef0e",
           :instance-uid           "1b360b10a9a68b7d494e8f059059f118"
           :paired?                true
@@ -36,6 +41,7 @@
           :pin-retry-counter      3
           :puk-retry-counter      5
           :key-uid                (get-in @re-frame.db/app-db [:multiaccounts/login :key-uid])})
+  (swap! state assoc :pin default-pin :puk default-puk :password kk1-password)
   (connect-card))

 (def initialization (atom false))
@@ -44,7 +50,7 @@
   (reset! initialization false)
   (swap! state assoc :application-info
          {:free-pairing-slots     5
-          :app-version            "2.2"
+          :app-version            "3.0"
           :secure-channel-pub-key "04c3071768912a515c00aeab7ceb8a5bfda91d036f4a4e60b7944cee3ca7fb67b6d118e8df1e2480b87fd636c6615253245bbbc93a6a407f155f2c58f76c96ef0e",
           :instance-uid           "1b360b10a9a68b7d494e8f059059f118"
           :paired?                false
@@ -53,6 +59,7 @@
           :pin-retry-counter      3
           :puk-retry-counter      5
           :key-uid                "0x16839e8b1b8a395acb18100c7e2b161701c225adf31eefa02114099b4d81a30b"})
+  (swap! state assoc :pin default-pin :puk default-puk :password kk1-password)
   (connect-card))

 (defn disconnect-card []
@@ -67,6 +74,27 @@
   (when f
     (utils/set-timeout f 500)))

+(defn pin-error []
+  #js {:code    "EUNSPECIFIED"
+       :message (str "Unexpected error SW, 0x63C" (get-in @state [:application-info :pin-retry-counter]))})
+
+(defn puk-error []
+  #js {:code    "EUNSPECIFIED"
+       :message (str "Unexpected error SW, 0x63C" (get-in @state [:application-info :puk-retry-counter]))})
+
+(defn with-pin [pin on-failure on-valid]
+  (if (= pin (get @state :pin))
+    (do
+      (swap! state update :application-info assoc
+             :pin-retry-counter 3
+             :puk-retry-counter 5)
+      (later on-valid))
+    (do
+      (swap! state update-in
+             [:application-info :pin-retry-counter]
+             (fnil dec 3))
+      (later #(on-failure (pin-error))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn start-nfc [{:keys [on-success]}]
@@ -119,24 +147,28 @@
   (log/debug "get-application-info")
   (later #(on-success (get @state :application-info))))

-(defn factory-reset [_])
+(defn factory-reset [args]
+  (log/debug "factory-reset")
+  (reset-state)
+  (get-application-info args))
+
 (defn install-applet [_])
 (defn install-cash-applet [_])

-(def kk1-password "000000")
-(def default-puk "000000000000")
 (defn init-card [{:keys [pin on-success]}]
   (reset! initialization true)
   (swap! state assoc :application-info
          {:free-pairing-slots     5
-          :app-version            "2.2"
+          :app-version            "3.0"
           :secure-channel-pub-key "04c3071768912a515c00aeab7ceb8a5bfda91d036f4a4e60b7944cee3ca7fb67b6d118e8df1e2480b87fd636c6615253245bbbc93a6a407f155f2c58f76c96ef0e",
           :key-uid                "",
           :instance-uid           "1b360b10a9a68b7d494e8f059059f118"
           :paired?                false
           :has-master-key?        false
+          :pin-retry-counter      3
+          :puk-retry-counter      5
           :initialized?           true})
-  (swap! state assoc :pin pin)
+  (swap! state assoc :pin pin :puk default-puk :password kk1-password)
   (later
    #(on-success {:password kk1-password
                  :puk      default-puk
@@ -144,11 +176,9 @@

 (defn install-applet-and-init-card [_])

-(def kk1-pair "ADEol+GCD67EO7zU6ko0DNK7XrNs9w2+h9GxcibNY4yf")
-
 (def derived-acc (atom nil))

-(defn multiaccount->keys [pin data]
+(defn multiaccount->keys [data]
   (let [{:keys [selected-id multiaccounts root-key derived]}
         data

@@ -161,7 +191,7 @@
         whisper     (get derived constants/path-whisper-keyword)
         wallet      (get derived constants/path-default-wallet-keyword)
         wallet-root (get derived constants/path-wallet-root-keyword)
-        password    (ethereum/sha3 pin)
+        password    account-password
         response    {:key-uid                key-uid
                      :encryption-public-key  password
                      :address                address
@@ -206,7 +236,7 @@
                    (reset! derived-acc
                            {:root-key root-data
                             :derived  derived-data-extended})))))))))))
-  (when (= password kk1-password)
+  (when (= password (get @state :password))
     (do
       (swap! state assoc-in [:application-info :paired?] true)
       (later #(on-success (str (rand-int 10000000)))))))
@@ -215,7 +245,6 @@
   [{:keys [pin on-success]}]
   (when (= pin (get @state :pin))
     (let [[id response] (multiaccount->keys
-                         pin
                          (:intro-wizard @re-frame.db/app-db))]
       (log/debug "[simulated kk] generate-and-load-key response" response)
       (swap! state assoc-in
@@ -227,12 +256,12 @@
         constants/path-eip1581
         constants/path-whisper
         constants/path-default-wallet]
-       (ethereum/sha3 pin)
+       account-password
        #(on-success response)))))

 (defn unblock-pin
   [{:keys [puk on-success on-failure]}]
-  (if (= puk default-puk)
+  (if (= puk (get @state :puk))
     (do
       (swap! state update :application-info assoc
              :pin-retry-counter 3
@@ -243,27 +272,29 @@
              [:application-info :puk-retry-counter]
              (fnil dec 5))
       (later
-       #(on-failure
-         #js {:code    "EUNSPECIFIED"
-              :message "Unexpected error SW, 0x63C2"})))))
+       #(on-failure (puk-error))))))

 (defn verify-pin [{:keys [pin on-success on-failure]}]
-  (if (= pin (get @state :pin))
-    (later #(on-success 3))
-    (do
-      (swap! state update-in
-             [:application-info :pin-retry-counter]
-             (fnil dec 3))
-      (later #(on-failure
-               #js {:code    "EUNSPECIFIED"
-                    :message "Unexpected error SW, 0x63C2"})))))
-
-(defn change-pin [args]
-  (log/warn "change-pin not implemented" args))
-(defn change-puk [args]
-  (log/warn "change-puk not implemented" args))
-(defn change-pairing [args]
-  (log/warn "change-pairing not implemented" args))
+  (with-pin pin on-failure #(on-success 3)))
+
+(defn change-pin [{:keys [current-pin new-pin on-success on-failure]}]
+  (with-pin current-pin on-failure
+    (fn []
+      (swap! state assoc :pin new-pin)
+      (on-success))))
+
+(defn change-puk [{:keys [pin puk on-success on-failure]}]
+  (with-pin pin on-failure
+    (fn []
+      (swap! state assoc :puk puk)
+      (on-success))))
+
+(defn change-pairing [{:keys [pin pairing on-success on-failure]}]
+  (with-pin pin on-failure
+    (fn []
+      (swap! state assoc :password pairing)
+      (on-success))))
+
 (defn unpair [args]
   (log/warn "unpair not implemented" args))
 (defn delete [args]
@@ -280,124 +311,100 @@
     path))

 (defn export-key [{:keys [pin on-success on-failure]}]
-  (let [{:keys [key-uid wallet-root-address]}
-        (get @re-frame.db/app-db :multiaccount)
-        accounts            (get @re-frame.db/app-db :multiaccount/accounts)
-        hashed-password     (ethereum/sha3 pin)
-        path-num            (inc (get-in @re-frame.db/app-db [:multiaccount :latest-derived-path]))
-        path                (str "m/" path-num)]
-    (status/multiaccount-load-account
-     wallet-root-address
-     hashed-password
-     (fn [value]
-       (let [{:keys [id error]} (types/json->clj value)]
-         (if error
-           (re-frame/dispatch [::new-account-error :password-error error])
-           (status/multiaccount-derive-addresses
-            id
-            [path]
-            (fn [derived]
-              (let [derived-address (get-in (types/json->clj derived) [(keyword path) :address])]
-                (if (some #(= derived-address (get % :address)) accounts)
-                  (re-frame/dispatch [::new-account-error :account-error (i18n/label :t/account-exists-title)])
-                  (status/multiaccount-store-derived
-                   id
-                   key-uid
-                   [path]
-                   hashed-password
-                   (fn [result]
-                     (let [{:keys [error] :as result}  (types/json->clj result)
-                           {:keys [publicKey]} (get result (keyword path))]
-                       (if error
-                         (on-failure error)
-                         (on-success publicKey)))))))))))))))
+  (with-pin pin on-failure
+    #(let [{:keys [key-uid wallet-root-address]}
+           (get @re-frame.db/app-db :multiaccount)
+           accounts            (get @re-frame.db/app-db :multiaccount/accounts)
+           hashed-password     account-password
+           path-num            (inc (get-in @re-frame.db/app-db [:multiaccount :latest-derived-path]))
+           path                (str "m/" path-num)]
+       (status/multiaccount-load-account
+        wallet-root-address
+        hashed-password
+        (fn [value]
+          (let [{:keys [id error]} (types/json->clj value)]
+            (if error
+              (re-frame/dispatch [::new-account-error :password-error error])
+              (status/multiaccount-derive-addresses
+               id
+               [path]
+               (fn [derived]
+                 (let [derived-address (get-in (types/json->clj derived) [(keyword path) :address])]
+                   (if (some (fn [a] (= derived-address (get a :address))) accounts)
+                     (re-frame/dispatch [::new-account-error :account-error (i18n/label :t/account-exists-title)])
+                     (status/multiaccount-store-derived
+                      id
+                      key-uid
+                      [path]
+                      hashed-password
+                      (fn [result]
+                        (let [{:keys [error] :as result}  (types/json->clj result)
+                              {:keys [publicKey]} (get result (keyword path))]
+                          (if error
+                            (on-failure error)
+                            (on-success publicKey))))))))))))))))

 (defn unpair-and-delete [_])

-;; It is a bit complicated to verify password before we have multiaccs main
-;; wallet address, so we just define a set of "allowed" pins
-(def allowed-pins
-  #{"121212" "111111" "222222" "123123"})
-
 (defn get-keys [{:keys [on-success on-failure pin]}]
-  (if (contains? allowed-pins pin)
-    (do
-      (swap! state assoc :pin pin)
-      (later
-       (if @derived-acc
-         (let [[id keys] (multiaccount->keys pin @derived-acc)]
-           (swap! state assoc-in
-                  [:application-info :key-uid] (:key-uid keys))
-           (status/multiaccount-store-derived
-            id
-            (:key-uid keys)
-            [constants/path-wallet-root
-             constants/path-eip1581
-             constants/path-whisper
-             constants/path-default-wallet]
-            (ethereum/sha3 pin)
-            #(on-success keys)))
-         #(on-success
-           {:key-uid               (get-in @state [:application-info :key-uid])
-            :encryption-public-key (ethereum/sha3 pin)}))))
-    (do
-      (log/debug "Incorrect PIN" pin)
-      (swap! state update-in
-             [:application-info :pin-retry-counter]
-             (fnil dec 3))
-      (later
-       #(on-failure
-         #js {:code    "EUNSPECIFIED"
-              :message "Unexpected error SW, 0x63C2"})))))
+  (with-pin pin on-failure
+    (if @derived-acc
+      (let [[id keys] (multiaccount->keys @derived-acc)]
+        (swap! state assoc-in
+               [:application-info :key-uid] (:key-uid keys))
+        (status/multiaccount-store-derived
+         id
+         (:key-uid keys)
+         [constants/path-wallet-root
+          constants/path-eip1581
+          constants/path-whisper
+          constants/path-default-wallet]
+         account-password
+         #(on-success keys)))
+      #(on-success
+        {:key-uid               (get-in @state [:application-info :key-uid])
+         :instance-uid          (get-in @state [:application-info :instance-uid])
+         :encryption-public-key account-password}))))

 (def import-keys get-keys)

 (defn sign [{:keys [pin hash data path typed? on-success on-failure]}]
-  (if (= pin (get @state :pin))
-    (later
-     #(let [address
-            (if path
-              (reduce
-               (fn [_ {:keys [address] :as acc}]
-                 (when (= path (:path acc))
-                   (reduced address)))
-               nil
-               (:multiaccount/accounts @re-frame.db/app-db))
-              (-> (:multiaccount/accounts @re-frame.db/app-db)
-                  first
-                  :address))
-            password (ethereum/sha3 pin)]
-        (if-not typed?
-          (let [params (types/clj->json
-                        {:account  address
-                         :password password
-                         :data     (or data (str "0x" hash))})]
-            (status/sign-message
-             params
-             (fn [res]
-               (let [signature (-> res
-                                   types/json->clj
-                                   :result
-                                   ethereum/normalized-hex)]
-                 (on-success signature)))))
-          (status/sign-typed-data
-           data
-           address
-           password
-           (fn [res]
-             (let [signature (-> res
-                                 types/json->clj
-                                 :result
-                                 ethereum/normalized-hex)]
-               (on-success signature)))))))
-    (do
-      (swap! state update-in
-             [:application-info :pin-retry-counter]
-             (fnil dec 3))
-      (later
-       #(on-failure
-         #js {:code    "EUNSPECIFIED"
-              :message "Unexpected error SW, 0x63C2"})))))
+  (with-pin pin on-failure
+    #(let [address
+           (if path
+             (reduce
+              (fn [_ {:keys [address] :as acc}]
+                (when (= path (:path acc))
+                  (reduced address)))
+              nil
+              (:multiaccount/accounts @re-frame.db/app-db))
+             (-> (:multiaccount/accounts @re-frame.db/app-db)
+                 first
+                 :address))
+           password account-password]
+       (if-not typed?
+         (let [params (types/clj->json
+                       {:account  address
+                        :password password
+                        :data     (or data (str "0x" hash))})]
+           (status/sign-message
+            params
+            (fn [res]
+              (let [signature (-> res
+                                  types/json->clj
+                                  :result
+                                  ethereum/normalized-hex)]
+                (on-success signature)))))
+         (status/sign-typed-data
+          data
+          address
+          password
+          (fn [res]
+            (let [signature (-> res
+                                types/json->clj
+                                :result
+                                ethereum/normalized-hex)]
+              (on-success signature))))))))

 (defn sign-typed-data [args]
   (log/warn "sign-typed-data not implemented" args))
@@ -417,7 +424,7 @@

 (defn send-transaction-with-signature
   [{:keys [transaction on-completed]}]
-  (status/send-transaction transaction (ethereum/sha3 (:pin @state)) on-completed))
+  (status/send-transaction transaction account-password on-completed))

 (defrecord SimulatedKeycard []
   keycard/Keycard


[WM] add voter reg status channels

[WM] add voter reg status channels


Refactoring: functions to send confix.xml into jenkins, responses etc.

--- src/emender_jenkins/jenkins_api.clj
+++ src/emender_jenkins/jenkins_api.clj
@@ -63,21 +63,29 @@
                  (.printStackTrace e)
                  nil))))

+(defn ok-response-structure
+    [job-name command jenkins-response]
+    {:status   "ok"
+     :job-name job-name
+     :command  command
+     :jenkins-response jenkins-response})
+
+(defn error-response-structure
+    [job-name command exception]
+    {:status   "error"
+     :job-name job-name
+     :command  command
+     :message  (.getMessage exception)
+    })
+
 (defn job-related-command
     [jenkins-url jenkins-auth job-name command]
     (try
         (let [response (post-command jenkins-url jenkins-auth job-name command)]
-            {:status   "ok"
-             :job-name job-name
-             :command  command
-             :jenkins-response response})
+            (ok-response-structure job-name command response))
         (catch Exception e
             (.printStackTrace e)
-            {:status "error"
-             :job-name job-name
-             :command  command
-             :message (.getMessage e)
-            })))
+            (error-response-structure job-name command e))))

 (defn update-template
     [template git-repo branch]
@@ -101,34 +109,34 @@
     [jenkins-url jenkins-auth job-name]
     (job-related-command jenkins-url jenkins-auth job-name "doDelete"))

+(defn log-operation
+    [job-name git-repo branch operation]
+    (println "***" operation "***")
+    (println "job-name" job-name)
+    (println "git-repo" git-repo)
+    (println "branch"   branch))
+
+(defn send-configuration-xml-to-jenkins
+    [url config]
+    (http-client/post url {
+        :body             config
+        :content-type     "application/xml"
+        :keystore         "keystore"
+        :keystore-pass    "changeit"
+        :trust-store      "keystore"
+        :trust-store-pass "changeit"}))
+
 (defn create-job
     [jenkins-url jenkins-auth job-name git-repo branch]
-    (println "***create job***")
-    (println "job-name" job-name)
-    (println "git-repo" git-repo)
-    (println "branch"   branch)
+    (log-operation job-name git-repo branch "create")
     (let [template (slurp "data/template.xml")
           config   (update-template template git-repo branch)
           url      (str (update-jenkins-url jenkins-url jenkins-auth) "createItem?name=" (.replaceAll job-name " " "%20"))]
           (println "URL to use: " url)
-          ;(spit "data/config2.xml" config)
           (try
-              (let [response (http-client/post url {
-                      :body config
-                      :content-type "application/xml"
-                      :keystore "keystore"
-                      :keystore-pass "changeit"
-                      :trust-store "keystore"
-                      :trust-store-pass "changeit"})]
-                {:status   "ok"
-                 :job-name job-name
-                 :command  "create"
-                 :jenkins-response response})
-            (catch Exception e
-                (.printStackTrace e)
-                {:status "error"
-                 :job-name job-name
-                 :command  "create"
-                 :message (.getMessage e)
-                }))))
+              (->> (send-configuration-xml-to-jenkins url config)
+                   (ok-response-structure job-name "create"))
+              (catch Exception e
+                  (.printStackTrace e)
+                  (error-response-structure job-name "create" e)))))


Add ES bench

Add ES bench

--- src/cyanite_fetcher/core.clj
+++ src/cyanite_fetcher/core.clj
@@ -62,6 +62,7 @@
     (map #(:_source %) hits)))

 (defn lookup [host tenant path]
+  "Look up path."
   (let [full-path-cache (atom #{})
         conn (esr/connect host)
         scrollfn (partial esrd/scroll-seq conn)
@@ -69,9 +70,11 @@
     (map :path (search queryfn scrollfn tenant path true))))

 (defn es-get-paths
+  "Get paths from ElasticSearch."
   [host path tenant]
-  (let [paths (lookup host (or tenant "NONE") path)]
-    (println "Number of paths: " (count paths))
+  (println "Getting paths form ElasticSearch...")
+  (let [paths (time (doall (lookup host (or tenant "NONE") path)))]
+    (println "Number of paths:" (count paths))
     paths))

 ;;------------------------------------------------------------------------------


Add alia/shutdown

Add alia/shutdown

--- src/cyanite_fetcher/core.clj
+++ src/cyanite_fetcher/core.clj
@@ -148,14 +148,18 @@
   "Get data from C*."
   [host paths tenant rollup period from to]
   (println "Connecting to Cassandra...")
-  (let [session (-> (alia/cluster {:contact-points [host]})
-                    (alia/connect keyspace))
+  (let [cluster (alia/cluster {:contact-points [host]})
+        session (alia/connect keyspace cluster)
         fetch! (fetchq session)]
     (println "Getting data form Cassandra...")
-    (let [data (time (doall (par-fetch session fetch! paths tenant
-                                       rollup period from to)))]
-      (newline)
-      data)))
+    (try
+      (let [data (time (doall (par-fetch session fetch! paths tenant
+                                         rollup period from to)))]
+        (newline)
+        data)
+      (catch Exception e
+        (alia/shutdown cluster)
+        (throw e)))))

 ;;------------------------------------------------------------------------------
 ;; ElasticSearch


Add parallel fetcher based on pmap

Add parallel fetcher based on pmap

--- src/cyanite_fetcher/core.clj
+++ src/cyanite_fetcher/core.clj
@@ -109,6 +109,20 @@
                     paths))]
     (map deref futures)))

+(defn par-fetch-pmap
+  "Fetch data in parallel fashion using pmap."
+  [session fetch! paths tenant rollup period from to]
+
+  (pmap (fn [path] (->> (alia/execute
+                         session fetch!
+                         {:values [path tenant (int rollup)
+                                   (int period)
+                                   from to]
+                          :fetch-size Integer/MAX_VALUE})
+                        (map detect-aggregate)
+                        (doall)
+                        (seq))) paths))
+
 (defn c-get-data
   "Get data from C*."
   [host paths tenant rollup period from to]
@@ -116,8 +130,8 @@
                     (alia/connect keyspace))
         fetch! (fetchq session)]
     (println "Getting data form Cassandra...")
-    (let [data (time (doall (par-fetch session fetch! paths tenant rollup
-                                       period from to)))]
+    (let [data (time (doall (par-fetch session fetch! paths tenant
+                                       rollup period from to)))]
       (newline)
       data)))


Correct inconsistent message

Correct inconsistent message

--- src/exploud/messages/asg.clj
+++ src/exploud/messages/asg.clj
@@ -473,7 +473,7 @@
         (if (aws/auto-scaling-group old-auto-scaling-group-name environment region)
           (do
             (when (= 1 attempt)
-              (log/write (format "Waiting for auto scaling group '%s' to be deleted (%d/%d)." old-auto-scaling-group-name attempt max-attempts)))
+              (log/write (format "Waiting for auto scaling group '%s' to be deleted." old-auto-scaling-group-name)))
             (capped-retry-after 10000 attempt max-attempts))
           (do
             (log/write (format "Finished deletion of auto scaling group '%s'." old-auto-scaling-group-name))


Bug fix

Bug fix

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -321,8 +321,8 @@
                   :title title
                   :times-solved 0
                   :description description
-                  :tags (s/split tags #"\s+")
-                  :restricted (s/split restricted #"\s+")
+                  :tags (re-seq #"\S+" tags)
+                  :restricted (re-seq #"\S+" restricted)
                   :tests (s/split-lines code)
                   :user (if (empty? author) user author)
                   :approved false})


(SERVER-876) Add with-puppet-conf-files macro to jruby-testutils

It is occasionally desirable to only have a single test have the
with-puppet-conf behavior of copying files into a directory, running a
test, and then cleaning the files up. This was previously impossible,
so this commit adds a macro that can be used in a test to accomplish
this. Here a with-puppet-conf-files macro is added, and the
with-puppet-conf-fixture is updated to use the macro under the hood.

--- test/integration/puppetlabs/puppetserver/testutils.clj
+++ test/integration/puppetlabs/puppetserver/testutils.clj
@@ -4,6 +4,12 @@
             [cheshire.core :as json]
             [puppetlabs.http.client.sync :as http-client])
   (:import (java.io File)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Schemas
+
+(def PuppetConfFiles
+  {schema/Str (schema/pred (some-fn string? #(instance? File %)))})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Default settings
@@ -37,6 +43,35 @@
    ssl-request-options
    {:headers     {"Accept" "pson"}
     :as          :text}))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Internal functions
+
+(schema/defn ^:always-validate get-with-puppet-conf-target-paths :- PuppetConfFiles
+  "Helper function that joins the filename onto the dest-dir for each file in
+  puppet-conf-files."
+  [puppet-conf-files :- PuppetConfFiles
+   dest-dir :- schema/Str]
+  (reduce
+   (fn [acc filename]
+     (assoc acc filename (fs/file dest-dir filename)))
+   {}
+   (keys puppet-conf-files)))
+
+(schema/defn ^:always-validate copy-with-puppet-conf-files-into-place!
+  "Copies each file in puppet-conf-files into the corresponding destination in
+  target-paths."
+  [puppet-conf-files :- PuppetConfFiles
+   target-paths :- PuppetConfFiles]
+  (doseq [filename (keys puppet-conf-files)]
+    (fs/copy+ (get puppet-conf-files filename)
+              (get target-paths filename))))
+
+(schema/defn ^:always-validate cleanup-with-puppet-conf-files!
+  "Deletes all of the files in the target-paths map."
+  [target-paths :- PuppetConfFiles]
+  (doseq [target-path (vals target-paths)]
+    (fs/delete target-path)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Utilities
@@ -101,7 +136,31 @@
   [catalogs resource-type resource-title]
   (count (filter #(catalog-contains? % resource-type resource-title) catalogs)))

-(schema/defn ^:always-validate with-puppet-conf-files
+(defmacro with-puppet-conf-files
+  "A macro that can be used to wrap a single test with the setup and teardown
+  of with-puppet-conf.
+
+  Accepts a map with the following characteristics:
+
+  * keys are simple filenames (no paths) that will be created in puppet's $confdir
+  * values are paths to a test-specific file that should be copied to puppet's confdir,
+    a la `$confdir/<key>`.
+
+  For each entry in the map, copies the files into $confdir, runs the test function,
+  and then deletes all of the files from $confdir.
+
+  Optionally accepts a second argument `dest-dir`, which specifies the location
+  of Puppet's $confdir.  If this argument is not provided, defaults to
+  `jruby-testutils/conf-dir`."
+  [puppet-conf-files dest-dir & body]
+  `(let [target-paths# (get-with-puppet-conf-target-paths ~puppet-conf-files ~dest-dir)]
+     (copy-with-puppet-conf-files-into-place! ~puppet-conf-files target-paths#)
+     (try
+       ~@body
+       (finally
+         (cleanup-with-puppet-conf-files! target-paths#)))))
+
+(schema/defn ^:always-validate with-puppet-conf-fixture
   "Test fixture; Accepts a map with the following characteristics:

   * keys are simple filenames (no paths) that will be created in puppet's $confdir
@@ -113,26 +172,13 @@

   Optionally accepts a second argument `dest-dir`, which specifies the location
   of Puppet's $confdir.  If this argument is not provided, defaults to
-  `testutils/conf-dir`."
+  `jruby-testutils/conf-dir`."
   ([puppet-conf-files]
-   (with-puppet-conf-files puppet-conf-files conf-dir))
-  ([puppet-conf-files :- {schema/Str (schema/pred (some-fn string? #(instance? File %)))}
+   (with-puppet-conf-fixture puppet-conf-files conf-dir))
+  ([puppet-conf-files :- PuppetConfFiles
     dest-dir :- schema/Str]
-
-   (let [target-paths (reduce
-                       (fn [acc filename]
-                         (assoc acc filename (fs/file dest-dir filename)))
-                       {}
-                       (keys puppet-conf-files))]
-     (fn [f]
-       (doseq [filename (keys puppet-conf-files)]
-         (fs/copy+ (get puppet-conf-files filename)
-                   (get target-paths filename)))
-       (try
-         (f)
-         (finally
-           (doseq [target-path (vals target-paths)]
-             (fs/delete target-path))))))))
+   (fn [f]
+     (with-puppet-conf-files puppet-conf-files dest-dir (f)))))

 (defn with-puppet-conf
   "This function returns a test fixture that will copy a specified puppet.conf
@@ -142,4 +188,4 @@
   ([puppet-conf-file]
    (with-puppet-conf puppet-conf-file conf-dir))
   ([puppet-conf-file dest-dir]
-   (with-puppet-conf-files {"puppet.conf" puppet-conf-file} dest-dir)))+   (with-puppet-conf-fixture {"puppet.conf" puppet-conf-file} dest-dir)))


Cleanup HTTP

Cleanup HTTP

--- src/icecap/handlers/http.clj
+++ src/icecap/handlers/http.clj
@@ -1,14 +1,15 @@
 (ns icecap.handlers.http
   (:require [aleph.http :refer [request]]
-            [clojure.core.async :refer [chan]]
+            [clojure.core.async :refer [to-chan]]
             [icecap.handlers.core :refer [defstep]]
             [manifold.stream :refer [connect]]
-            [schema-contrib.core :refer [URI]]))
+            [schema-contrib.core :refer [URI]]
+            [taoensso.timbre :refer [info spy]]))

 (defstep :http
   {:url URI}
   [step]
-  (let [ch (chan)
-        req (request step)]
-    (connect req ch)
-    ch))
+  (let [args (spy (select-keys step [:url]))
+        req (spy (request args))
+        res (spy @req)]
+    (to-chan [res])))


runner: skip jsch exceptions

runner: skip jsch exceptions

--- src/jepsen/voltdb/runner.clj
+++ src/jepsen/voltdb/runner.clj
@@ -160,13 +160,16 @@

       (println "Test options:\n" (with-out-str (pprint options)))

-      ; Run test
       (dotimes [i (:test-count options)]
         (move-logfile!)
         ; Run test!
-        (when-not (:valid? (:results (jepsen/run! (test-fn options))))
-          (move-logfile!)
-          (System/exit 1)))
+        (try
+          (when-not (:valid? (:results (jepsen/run! (test-fn options))))
+            (move-logfile!)
+            (System/exit 1))
+          (catch com.jcraft.jsch.JSchException e
+            (info e "SSH connection fault; aborting test and moving on")
+            (move-logfile!))))

       (move-logfile!)
       (System/exit 0))


CMR-3682: Separate warning messages.

CMR-3682: Separate warning messages.

--- umm-spec-lib/src/cmr/umm_spec/validation/data_date.clj
+++ umm-spec-lib/src/cmr/umm_spec/validation/data_date.clj
@@ -18,28 +18,31 @@
         earliest-review (date-util/earliest-date-of-type value "REVIEW")
         latest-review (date-util/latest-date-of-type value "REVIEW")
         earliest-delete (date-util/earliest-date-of-type value "DELETE")]
-    ;;First check the absolute range.
-    (if (or (and latest-create (not (date-util/is-in-past? latest-create)))
-            (and latest-update (not (date-util/is-in-past? latest-update)))
-            (and earliest-review (not (date-util/is-in-future? earliest-review)))
-            (and earliest-delete (not (date-util/is-in-future? earliest-delete))))
-      {field-path [(format
-                     (str "Latest CREATE and UPDATE values: [%s] [%s]"
-                          " need to be in the past if not nil and"
-                          " earliest REVIEW and DELETE values: [%s] [%s]"
-                          " need to be in the future if not nil.")
-                     latest-create latest-update earliest-review earliest-delete)]}
-      ;;Then check the relative range
-      (when (or (and latest-create
-                     earliest-update
-                     (time/after? latest-create earliest-update))
-                (and latest-review
-                     earliest-delete
-                     (time/after? latest-review earliest-delete)))
-        {field-path [(format
-                       (str "Latest CREATE value: [%s] must be no later than"
-                            " earliest UPDATE value: [%s] if both are not nil and"
-                            " latest REVIEW value: [%s] must be no later than"
-                            " the earliest DELETE value: [%s] if both are not nil.")
-                       latest-create earliest-update latest-review earliest-delete)]}))))
+    (def warning-msgs (atom ""))
+    (when (and latest-create (not (date-util/is-in-past? latest-create)))
+      (swap! warning-msgs str "CREATE date value: [" latest-create "] needs to be in the past. "))
+    (when (and latest-update (not (date-util/is-in-past? latest-update)))
+      (swap! warning-msgs str "UPDATE date value: [" latest-update "] needs to be in the past. "))
+    (when (and earliest-review (not (date-util/is-in-future? earliest-review)))
+      (swap! warning-msgs str "REVIEW date value: [" earliest-review "] needs to be in the future. "))
+    (when (and earliest-delete (not (date-util/is-in-future? earliest-delete)))
+      (swap! warning-msgs str "DELETE date value: [" earliest-delete "] needs to be in the future. "))
+    (when (and latest-create
+               earliest-update
+               (time/after? latest-create earliest-update))
+      (swap! warning-msgs str "Earliest UPDATE date value: ["
+                              earliest-update
+                              "] needs to be later than the CREATE date value: ["
+                              latest-create
+                              "]"))
+    (when (and latest-review
+                earliest-delete
+                (time/after? latest-review earliest-delete))
+      (swap! warning-msgs str "Earliest DELETE date value: ["
+                              earliest-delete
+                              "] needs to be later than the REVIEW date value: "
+                              latest-review
+                              "]"))
+    {field-path [@warning-msgs]}))

+


color [r g b a] option for tinting TextureEntity

--- src/play_clj/entities.clj
+++ src/play_clj/entities.clj
@@ -1,6 +1,6 @@
 (ns play-clj.entities
   (:import [com.badlogic.gdx Gdx Graphics]
-           [com.badlogic.gdx.graphics Camera]
+           [com.badlogic.gdx.graphics Camera Color]
            [com.badlogic.gdx.graphics.g2d Batch NinePatch ParticleEffect
             TextureRegion]
            [com.badlogic.gdx.graphics.g3d Environment ModelBatch ModelInstance]
@@ -21,13 +21,15 @@

 (defrecord TextureEntity [object] Entity
   (draw! [{:keys [^TextureRegion object x y width height
-                  scale-x scale-y angle origin-x origin-y]}
+                  scale-x scale-y angle origin-x origin-y color]}
           _
           batch]
     (let [x (float (or x 0))
           y (float (or y 0))
           width (float (or width (.getRegionWidth object)))
           height (float (or height (.getRegionHeight object)))]
+      (when-let [[r g b a] color]
+        (.setColor ^Batch batch r g b a))
       (if (or scale-x scale-y angle)
         (let [scale-x (float (or scale-x 1))
               scale-y (float (or scale-y 1))
@@ -36,7 +38,9 @@
               angle (float (or angle 0))]
           (.draw ^Batch batch object x y origin-x origin-y width height
             scale-x scale-y angle))
-        (.draw ^Batch batch object x y width height)))))
+        (.draw ^Batch batch object x y width height))
+      (when color
+        (.setColor ^Batch batch Color/WHITE)))))

 (defrecord NinePatchEntity [object] Entity
   (draw! [{:keys [^NinePatch object x y width height]} _ batch]


more tooltip tweaks

more tooltip tweaks


fix a bug that lein-test did not realize that tests are failed

--- src/leiningen/namespaces.clj
+++ src/leiningen/namespaces.clj
@@ -165,15 +165,27 @@
     (update-resource! resource project source-project-desc))
   (m/info "*\n******************************************************\n"))

+(defn run-cmd [cmd]
+  (m/info "... Executing " (str/join " " cmd))
+  (let [result (apply sh/sh cmd)]
+    (if (u/is-success? result)
+      {:result :passed}
+      {:result :failed :cmd cmd})))
+
 (defn lein-test [project]
   (m/info "\n... Executing tests of" project "on" (u/output-of (sh/sh "pwd")) "\n")
-  (doseq [cmd (test-cmd project)]
-    (m/info "... Executing " (str/join " " cmd))
-    (if (not (u/is-success? (apply sh/sh cmd)))
-      {:project project
-       :result  :failed}))
-  {:project project
-   :result  :passed})
+  (let [failed-cmd (->> project
+                        (test-cmd)
+                        (map run-cmd)
+                        (filter #(= (:result %) :failed))
+                        (first))]
+    (if (empty? failed-cmd)
+      (do
+        (m/info "===> All Tests of" project "are passed\n")
+        {:project project :result :passed})
+      (do
+        (m/info "===> Some Tests of" project "are FAILED!!!\n")
+        {:project project :result :failed}))))

 (defn reset-project! [project]
   (m/info "\n... Reset changes of" project "on" (u/output-of (sh/sh "pwd")))


latest versions of ClojureScript and Sente

--- Clojure-Websockets/MainApp/project.clj
+++ Clojure-Websockets/MainApp/project.clj
@@ -9,7 +9,7 @@
                  [com.matthiasnehlsen/inspect "0.1.3"]
                  [org.clojure/tools.namespace "0.2.7"]
                  [ch.qos.logback/logback-classic "1.1.1"]
-                 [com.taoensso/sente "1.3.0-RC1"]
+                 [com.taoensso/sente "1.3.0"]
                  [org.clojure/core.match "0.3.0-alpha4"]
                  [http-kit "2.1.19"]
                  [compojure "1.2.1"]
@@ -17,7 +17,7 @@
                  [ring/ring-defaults "0.1.1"]
                  [clj-time "0.8.0"]
                  [pandect "0.4.1"]
-                 [org.clojure/clojurescript "0.0-2727"]
+                 [org.clojure/clojurescript "0.0-2740"]
                  [tailrecursion/cljs-priority-map "1.1.0"]
                  [org.clojure/data.priority-map "0.0.5"]
                  [reagent "0.5.0-alpha"]


removed comments and whitespace require more tweaking/viewing

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/workspace_method_confs.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/workspace_method_confs.cljs
@@ -10,60 +10,25 @@

 (defn- create-mock-methodconfs []
   (map
-    (fn [i]
-
-        {
-
-         ;; first the 3 basic keys (string -> string)
-
-         :name (rand-nth ["rand_name_1" "rand_name_2" "rand_name_3" "rand_name_4"])
+    (fn [i] {:name (rand-nth ["rand_name_1" "rand_name_2" "rand_name_3" "rand_name_4"])
          :namespace (str "ns_s_" (inc i))
          :root-ent-type (str "r_e_t_" (inc i))
-
-         ;; Here 6 complex fields string -> Map[String,String]
-
-         ;;workspace
-         :workspaceName {
-                        :namespace (str "ws_ns_" (inc i))
-                        :name (str "ws_n_" (inc i))
-                        }
-
-         ;;methodStoreMethod
-         :methodStoreMethod {
-                            :namespace (str "ms_ns_" (inc i))
-                            :name (str "ms_n_" (inc i))
-                            :version (str "ms_v_" (inc i))
+         :workspaceName {:namespace (str "*ws_ns_" (inc i))
+                        :name (str "*ws_n_" (inc i))}
+         :methodStoreMethod {:namespace (str "*ms_ns_" (inc i))
+                            :name (str "*ms_n_" (inc i))
+                            :version (str "*ms_v_" (inc i))}
+         :methodStoreConfig {:namespace (str "*msc_ns_" (inc i))
+                             :name (str "*msc_n_" (inc i))
+                             :version (str "*msc_v_" (inc i))
                              }
-
-         ;;methodStoreConfig
-         :methodStoreConfig {
-                             :namespace (str "msc_ns_" (inc i))
-                             :name (str "msc_n_" (inc i))
-                             :version (str "msc_v_" (inc i))
-                             }
-         ;;I/O (I)
-         :inputs {
-                  :i1 (str "i_1_" (inc i))
-                  :i2 (str "i_2_" (inc i))
-                  }
-
-         ;;I/O (O)
-         :outputs {
-                  :o1 (str "o_1_" (inc i))
-                  :o2 (str "o_2_" (inc i))
-                  }
-
-         ;;pre-requisites
-         :prerequisites {
-                  :p1 (str "p_1_" (inc i))
-                  :p2 (str "p_2_" (inc i))
-                  }
-
-         }
-
-
-      )
-    (range (rand-int 20))))
+         :inputs {:i1 (str "*i_1_" (inc i))
+                  :i2 (str "*i_2_" (inc i))}
+         :outputs {:o1 (str "*o_1_" (inc i))
+                  :o2 (str "*o_2_" (inc i))}
+         :prerequisites {:p1 (str "*p_1_" (inc i))
+                  :p2 (str "*p_2_" (inc i))}})
+    (range (rand-int 50))))

@@ -82,50 +47,42 @@
                header-label (fn [text & [padding]]
                               [:span {:style {:paddingLeft (or padding "1em")}}
                                [:span {:style {:fontSize "90%"}} text]])]
-           {:columns [
-
-                      {:label (header-label "Name")
+           {:columns [{:label (header-label "Name")
                        :style (merge cell-style {:borderLeft "none"})}
                       {:label (header-label "Namespace")
                        :style cell-style
                        :header-style {:borderLeft "none"}}
                       {:label (header-label "Root Entity Type")
-                       :style (merge cell-style {:flexBasis "30ex"})
+                       :style cell-style
                        :header-style {:borderLeft "none"}}
                       {:label (header-label "Workspace Name")
-                       :style (merge cell-style {:borderLeft "none"})}
+                       :header-style {:borderLeft "none"}
+                       :style cell-style}
                       {:label (header-label "Method Store Method")
                        :style cell-style
                        :header-style {:borderLeft "none"}}
                       {:label (header-label "Method Store Config")
-                       :style (merge cell-style {:flexBasis "30ex"})
+                       :style cell-style
                        :header-style {:borderLeft "none"}}
                       {:label (header-label "Inputs")
-                       :style (merge cell-style {:borderLeft "none"})}
+                       :header-style {:borderLeft "none"}
+                       :style cell-style}
                       {:label (header-label "Outputs")
                        :style cell-style
                        :header-style {:borderLeft "none"}}
                       {:label (header-label "Pre-Requisites")
                        :style (merge cell-style {:flexBasis "30ex"})
-                       :header-style {:borderLeft "none"}}
-
-                      ]
+                       :header-style {:borderLeft "none"}}]
             :data (map (fn [m]
-                         [
-                          ;; first the 3 basic keys (string -> string)
-                          (m "name")
+                         [(m "name")
                           (m "namespace")
                           (m "root-ent-type")
-
-                          ;;6 complex fields string -> Map[String,String]
                           (m "workspaceName")
                           (m "methodStoreMethod")
                           (m "methodStoreConfig")
                           (m "inputs")
                           (m "outputs")
-                          (m "prerequisites")
-                          ]
-                         )
+                          (m "prerequisites")])
                     (:method-confs props))})])])})


(SERVER-391) Correct wrong namespace for keyword

--- src/clj/puppetlabs/services/request_handler/request_handler_core.clj
+++ src/clj/puppetlabs/services/request_handler/request_handler_core.clj
@@ -265,7 +265,8 @@
   "Determine if the supplied slingshot message is for a JRuby borrow timeout."
   (when (map? x)
     (= (:type x)
-       ::jruby/jruby-timeout)))
+       :puppetlabs.services.jruby.jruby-puppet-service/jruby-timeout)))
+

 (defn output-error
   [{:keys [uri]} {:keys [message]} http-status]


GAWB-1821: reformat

GAWB-1821: reformat

--- src/cljs/main/broadfcui/page/method_repo/method_config_importer.cljs
+++ src/cljs/main/broadfcui/page/method_repo/method_config_importer.cljs
@@ -75,9 +75,9 @@
           [:div {:style {:float "left" :marginRight "0.5em"}}
            (style/create-form-label (:label field))
            (if (= (:type field) "identity-select")
-             (style/create-identity-select
-               {:ref (:key field) :defaultValue (or (entity (:key field)) "")}
-               (:options field))
+             (style/create-identity-select {:ref (:key field)
+                                            :defaultValue (or (entity (:key field)) "")}
+                                           (:options field))
              [input/TextField {:defaultValue (entity (:key field))
                                :ref (:key field) :placeholder "Required"
                                :predicates [(input/nonempty "Fields")]}])])


Enable alt-click preservation

Enable alt-click preservation

--- src-cljs/cljs_workspace/om_test.cljs
+++ src-cljs/cljs_workspace/om_test.cljs
@@ -9,14 +9,24 @@
             [goog.style :as gstyle]
             [om-sync.core :refer [om-sync]]
             [om-sync.util :refer [tx-tag edn-xhr]]
-            [cljs-workspace.morph :as morphic]
+            [cljs-workspace.morph :as morphic :refer [set-fill toggle-halo find-morph-path]]
             [cljs-workspace.history :as history :refer [app-state init-history]]
             [cljs-workspace.repl :as repl])
+            [cljs-workspace.branch-merge :as branch-merge])
   (:import [goog.events EventType]))

 (enable-console-print!)

-(println "Hello :)")
+; Initialize modules
+
+(reset! morphic/right-click-behavior
+  (fn [e state]
+    (branch-merge/toggle-preserve (find-morph-path @app-state (state :id)))
+    ; now also highlight all the morphs that are being preserved
+    ; without changing the state
+    (toggle-halo app-state (state :id))))
+
+(prn @morphic/right-click-behavior)

 (init-history
          {:url "/data"
@@ -46,7 +56,8 @@
                                         :Fill "rgb(255,244,194)"}
                                 :submorphs [
                                       {:id 4
-                                       :morph {:MorphClass "Text"
+                                       :morph {:Preserve true
+                                               :MorphClass "Text"
                                                :Position {:x 10 :y 10}
                                                :TextString "Hallo Welt!"
                                                :isDraggable true}
@@ -138,4 +149,4 @@
 ;         (om/build morphic/morph app)
 ;         history/history-slider)))
 ;   history/history-view
-;   {:target (. js/document (getElementById "inspector"))})+;   {:target (. js/document (getElementById "inspector"))})


Fix validation on radio-button fields (due to typo)

--- src/braid/client/gateway/events.cljs
+++ src/braid/client/gateway/events.cljs
@@ -19,7 +19,7 @@
                              (let [prefilled-value (get-url-param field)]
                                (assoc memo field
                                  {:value (or prefilled-value "")
-                                  :typing false
+                                  :typing? false
                                   :untouched? (if prefilled-value
                                                 false
                                                 true)


Document the framework.

Document the framework.

--- src/cljs/leipzig_live/framework.cljs
+++ src/cljs/leipzig_live/framework.cljs
@@ -1,14 +1,19 @@
 (ns leipzig-live.framework)

 (defprotocol Action
+  "Calculate the new state and `handle!` any new Actions that arise."
   (process [this handle! state]))

 (declare handler-for)

-(defn apply-action! [state-atom action]
+(defn apply-action!
+  "Update the atom using the action."
+  [state-atom action]
   (swap!
     state-atom
     (fn [state] (process action (handler-for state-atom) state))))

-(defn handler-for [state-atom]
+(defn handler-for
+  "Build a `handle!` function for the atom."
+  [state-atom]
   (partial apply-action! state-atom))


latest version of core.match

latest version of core.match

--- Clojure-Websockets/TwitterClient/project.clj
+++ Clojure-Websockets/TwitterClient/project.clj
@@ -10,7 +10,7 @@
                  [org.clojure/tools.logging "0.3.0"]
                  [com.matthiasnehlsen/inspect "0.1.3"]
                  [ch.qos.logback/logback-classic "1.1.1"]
-                 [org.clojure/core.match "0.2.1"]
+                 [org.clojure/core.match "0.3.0-alpha3"]
                  [clj-time "0.8.0"]
                  [pandect "0.4.1"]
                  [clj-pid "0.1.1"]


Two minor connection fixes.

Two minor connection fixes.

--- src/merkle_db/connection.clj
+++ src/merkle_db/connection.clj
@@ -178,7 +178,8 @@
       ; Load database.
       (db/load-database (.store conn) (ref-version-info version))
       ; No version found.
-      (throw (ex-info (str "No version found for database " db-name " with " opts)
+      (throw (ex-info (str "No version found for database " db-name
+                           " with options " (pr-str opts))
                       {:type ::no-database-version
                        :db-name db-name
                        :opts opts})))))
@@ -213,9 +214,9 @@

   (list-dbs
     ([this]
-     (-list-dbs nil))
+     (-list-dbs this nil))
     ([this opts]
-     (-list-dbs opts)))
+     (-list-dbs this opts)))

   (get-db-history


lein-release plugin: preparing 0.4.5 release

--- re_view/project.clj
+++ re_view/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view "0.4.5-SNAPSHOT"
+(defproject re-view "0.4.5"
   :description "ClojureScript React Library"
   :url "https://www.github.com/braintripping/re-view/tree/master/re_view"
   :license {:name "Eclipse Public License"


Lock publications when creating new pub #389

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -177,26 +177,22 @@

 (defrecord TrackedPub [publication last-used])

-(defn get-publication [messenger {:keys [channel] :as conn-info}]
-  ;; FIXME, race condition may cause two publications to be created
-  (if-let [pub (get @(:publications messenger) channel)]
+(defn get-publication [{:keys [publications] :as messenger} {:keys [channel] :as conn-info}]
+  (if-let [pub (get @publications channel)]
     (do
       (reset! (:last-used pub) (System/currentTimeMillis))
       (:publication pub))
-    (let [stream-id (:stream-id conn-info)
-          pub-manager (-> (pubm/new-publication-manager channel
-                                                        stream-id
-                                                        (:send-idle-strategy messenger)
-                                                        (:write-buffer-size messenger)
-                                                        (fn []
-                                                          (swap! (:publications messenger) dissoc channel)))
-                          (pubm/connect)
-                          (pubm/start))]
-      (swap! (:publications messenger)
-             assoc
-             channel
-             (->TrackedPub pub-manager (atom (System/currentTimeMillis))))
-      pub-manager)))
+    (locking publications
+      (let [stream-id (:stream-id conn-info)
+            pub-manager (-> (pubm/new-publication-manager channel
+                                                          stream-id
+                                                          (:send-idle-strategy messenger)
+                                                          (:write-buffer-size messenger)
+                                                          (fn [] (swap! publications dissoc channel)))
+                            (pubm/connect)
+                            (pubm/start))]
+        (swap! publications assoc channel (->TrackedPub pub-manager (atom (System/currentTimeMillis))))
+        pub-manager))))

 (defn opts->port [opts]
   (or (:onyx.messaging/peer-port opts)


Fix batch sending

Fix batch sending

--- src/onyx/metrics/riemann.clj
+++ src/onyx/metrics/riemann.clj
@@ -42,7 +42,7 @@
           timeout-count (atom 0)]

       (while (not (Thread/interrupted))
-        (let [events (read-batch ch batch-size batch-timeout)]
+        (let [events (map metric->riemann-event (read-batch ch batch-size batch-timeout))]
           (when-not (empty? events)
             (loop [sleep 0]
               ;; Exponential backoff to rate limit errors
@@ -61,4 +61,5 @@
                                (warn e "Lost riemann connection" address port)
                                ::exception))]
                 (when (#{::exception ::timeout} result)
+                  (swap! timeout-count inc)
                   (recur (next-sleep-time sleep)))))))))))


Pass time remaining to input poll as long.

--- src/onyx/peer/read_batch.clj
+++ src/onyx/peer/read_batch.clj
@@ -32,17 +32,15 @@
   (let [pipeline (get-input-pipeline state)
         event (get-event state)
         end-time (+ (System/nanoTime) batch-timeout-ns)
-        batch (persistent!
-               (loop [outgoing (transient [])
-                      remaining (- end-time (System/nanoTime))]
-                 (if (and (< (count outgoing) batch-size)
-                          (pos? remaining))
-                   (let [segment (p/poll! pipeline event (ns->ms remaining))]
-                     (if (nil? segment)
-                       outgoing
-                       (recur (conj! outgoing segment)
-                              (- end-time (System/nanoTime)))))
-                   outgoing)))]
+        outgoing (transient [])
+        _ (loop [remaining (- end-time (System/nanoTime))]
+            (when (and (< (count outgoing) batch-size)
+                       (pos? remaining))
+              (let [segment (p/poll! pipeline event (long (ns->ms remaining)))]
+                (when-not (nil? segment)
+                  (conj! outgoing segment)
+                  (recur (- end-time (System/nanoTime)))))))
+        batch (persistent! outgoing)]
     (-> state
         (set-event! (assoc event :onyx.core/batch batch))
         (advance))))


fix scheduler

fix scheduler

--- src/shuppet/scheduler.clj
+++ src/shuppet/scheduler.clj
@@ -5,6 +5,7 @@
     [core :as core]
     [util :refer [rfc2616-time str-stacktrace]]]
    [clojure.tools.logging :refer [info warn error]]
+   [slingshot.slingshot :refer [try+ throw+]]
    [environ.core :refer [env]]
    [clojure.string :refer [split]]
    [overtone.at-at :as at-at]))
@@ -34,19 +35,23 @@
       (error (str-stacktrace e)))))

 (defn schedule
-  [env & [action interval]]
-  (let [pool (get-pool env)]
-    (at-at/stop-and-reset-pool! pool :strategy :kill)
-    (if (= action "stop")
-      {:message "Succefully stopped the shuppet scheduler"}
-      (let [interval (Integer/parseInt (or interval (env :service-scheduler-interval)))]
-        (at-at/every (* interval 60 1000)
-                     #(configure-apps env)
-                     pool
-                     :desc (rfc2616-time))
-        {:message
-         (str "Succesfully started the shuppet scheduler. The scheduler will run in every "
-              interval " minutes.") }))))
+  [environment & [action interval]]
+  (try+
+   (let [pool (get-pool environment)]
+     (at-at/stop-and-reset-pool! pool :strategy :kill)
+     (if (= action "stop")
+       {:message "Succefully stopped the shuppet scheduler"}
+       (let [interval (Integer/parseInt (or interval (env :service-scheduler-interval)))]
+         (at-at/every (* interval 60 1000)
+                      #(configure-apps environment)
+                      pool
+                      :desc (rfc2616-time))
+         {:message
+          (str "Succesfully started the shuppet scheduler. The scheduler will run in every "
+               interval " minutes.") })))
+   (catch Exception e
+     (error (str-stacktrace e))
+     (throw+ e))))

 (defn get-schedule
   [env]
@@ -61,9 +66,8 @@
   []
   (when-not (= (env :environment-name) "local") ;dont want the auto scheduler for our test envs
     (doseq [environment environments]
-      (at-at/after (* (or
-                       (Integer/parseInt (env (keyword (str "service-scheduler-delay-" environment))))
-                       10)
+      (at-at/after (* (Integer/parseInt
+                       (or (env (keyword (str "service-scheduler-delay-" environment))) "1"))
                       60 1000)
                    #(schedule environment)
                    (get-pool environment)


Make primary components black and secondary components grey.

--- sonic-jam/src/sonic_jam/core.cljs
+++ sonic-jam/src/sonic_jam/core.cljs
@@ -16,7 +16,9 @@
     (render-state [_ state]
       (dom/td #js {:onClick #(do
                                (om/update! cursor [(mod (inc (first cursor)) 2)])
-                               (go (>! (:set-state-ch state) (:ns state))))}
+                               (go (>! (:set-state-ch state) (:ns state))))
+                   :style #js {:width "20px"
+                               :fontSize "20px"}}
              (str " " (first cursor))))))

 (declare grid-view)
@@ -33,9 +35,11 @@
     om/IRenderState
     (render-state [_ state]
       (if-not (:track-expanded state)
-        (dom/tr nil (dom/td #js {:onClick #(om/set-state! owner :track-expanded true)} ">"))
+        (dom/tr nil (dom/td #js {:onClick #(om/set-state! owner :track-expanded true)
+                                 :style #js {:color "#999"}} ">"))
         (dom/tr nil
-                (dom/td #js {:onClick #(om/set-state! owner :track-expanded false)} "<")
+                (dom/td #js {:onClick #(om/set-state! owner :track-expanded false)
+                             :style #js {:color "#999"}} "<")
                 (dom/td nil
                  (dom/table nil
                   (apply dom/tr nil
@@ -61,10 +65,15 @@
       {:grid-expanded false})
     om/IRenderState
     (render-state [_ state]
-      (dom/div nil
+      (dom/div #js {:style #js {:borderLeft "solid 3px #ccc"
+                                :paddingLeft "10px"}}
                (if-not (:grid-expanded state)
-                 (dom/div nil (dom/p #js {:onClick #(om/set-state! owner :grid-expanded true)} "[+]"))
-                 (dom/div nil (dom/p #js {:onClick #(om/set-state! owner :grid-expanded false)} "[-]")
+                 (dom/div nil (dom/p #js {:onClick #(om/set-state! owner :grid-expanded true)
+                                          :style #js {:color "#999"}}
+                                     (str "[+] " (:ns state))))
+                 (dom/div nil (dom/p #js {:onClick #(om/set-state! owner :grid-expanded false)
+                                          :style #js {:color "#999"}}
+                                     (str "[-] " (:ns state)))
                           (apply dom/table nil
                                  (om/build-all track-view (get cursor "tracks")
                                                {:state state}))))))))
@@ -105,7 +114,7 @@
     (render-state [_ state]
       (let [root (get (:grids cursor) "root")]
         (if root
-          (dom/div nil
+          (dom/div #js {:style #js {:fontFamily "monospace"}}
                    (om/build grid-view root {:state (assoc state :ns "root")}))
           (dom/div nil "loading..."))))))


essential for recreation of asg

essential for recreation of asg

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -293,6 +293,7 @@
                    :health_check_grace_period 20
                    :root_block_device {:volume_size 20}
                    :subnets public-subnets
+                   :lifecycle {:create_before_destroy true}
                    :elb [{:name "MasterServerGroup"
                           :health_check {:healthy_threshold 2
                                          :unhealthy_threshold 3
@@ -351,6 +352,7 @@
                    :health_check_type "EC2"
                    :health_check_grace_period 20
                    :subnets public-subnets
+                   :lifecycle {:create_before_destroy true}
                    :elb [{:name "PublicSlaveServerGroup"
                           :health_check {:healthy_threshold 2
                                          :unhealthy_threshold 2
@@ -391,6 +393,7 @@
                    :health_check_type "EC2" ;; or "ELB"?
                    :health_check_grace_period 20
                    :subnets private-subnets
+                   :lifecycle {:create_before_destroy true}
                    :elb []
                    })
              ))))


♻ Guard against non-configured demo-congregation

Why:
- The getter should already return nil for a nil cong-id, but it's
  better to be explicit about it

--- src/territory_bro/api.clj
+++ src/territory_bro/api.clj
@@ -168,7 +168,8 @@
       (let [cong-id (:demo-congregation config/env)
             user-id (current-user-id)
             state (state-for-request request)
-            congregation (congregation/get-unrestricted-congregation state cong-id)]
+            congregation (when cong-id
+                           (congregation/get-unrestricted-congregation state cong-id))]
         (when-not congregation
           (forbidden! "No demo congregation"))
         (ok (format-for-api (-> (fetch-congregation conn state user-id congregation)


Eliminate deprecated parameter count warning

--- cortex/test/cljc/cortex/nn/network_test.cljc
+++ cortex/test/cljc/cortex/nn/network_test.cljc
@@ -39,7 +39,7 @@
         n-epochs 1000
         loss-fn (opt/mse-loss)
         batch-size 1
-        optimizer (opt/sgd-optimiser (core/parameter-count net))
+        optimizer (opt/sgd-optimiser)
         network (net/train net optimizer loss-fn training-data training-labels batch-size n-epochs)
         score-percent (net/evaluate net training-data training-labels)]
     (is (< (abs-diff score-percent 1.0) 0.001))))


We'll use the constant instead.

We'll use the constant instead.

--- src/uuuurrrrllll/core.clj
+++ src/uuuurrrrllll/core.clj
@@ -8,7 +8,7 @@

 ;; One day in ms.
-(def one-day (* (* (* 60 60) 24) 1000))
+(def one-day 86400000)
 (def url-map (atom (cache/ttl-cache-factory {} :ttl one-day)))

 (defn expire-entries! [c]


Add missing images menu entry translation string.

--- src/uxbox/locales/en.cljs
+++ src/uxbox/locales/en.cljs
@@ -20,6 +20,7 @@

    "ds.elements" "ELEMENTS"
    "ds.icons" "ICONS"
+   "ds.images" "IMAGES"
    "ds.colors" "COLORS"
    "ds.library-title" "Library: "
    "ds.standard-title" "STANDARD"


delaney.clj: started new function (fundamental-edges)

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -247,6 +247,47 @@

 (defn automorphism-orbits [ds]
   (or (seq (into pempty (apply concat (automorphisms ds)))) (elements ds)))
+
+(defn- initial-queue [ds]
+  (into empty-queue (for [[D i E] (traversal ds (indices ds) (elements ds))
+                          :when (not= :root i)]
+                      [D i nil])))
+
+(defn- update-queue [ds q neighbor D i]
+  (into q (for [j (indices ds) :when (not= i j)
+                [E k] (neighbor [[D i] j])]
+            [E k (- (+ i j) k)])))
+
+(defn- initial-boundary [ds]
+  [(set (for [D (elements ds), i (indices ds)] [D i]))
+   (into {} (for [D (elements ds)
+                  i (indices ds)
+                  j (indices ds) :when (not= i j)]
+              [[[D i] j] 1]))
+   (into {} (for [D (elements ds)
+                  i (indices ds)
+                  j (indices ds) :when (not= i j)]
+              [[[D i] j] [D j]]))])
+
+(defn- glue-boundary [ds [on-bnd chain-len neighbor] D i]
+  ;; TODO implement this
+  )
+
+(defn fundamental-edges [ds]
+  (loop [q (initial-queue ds)
+         [on-bnd chain-len neighbor :as boundary] (initial-boundary ds)
+         result []]
+    (if (empty? q)
+      result
+      (let [[D i j] (first q)
+            q (pop q)]
+        (if (and (on-bnd [D i])
+                 (or (nil? j)
+                     (= chain-len (* 2 (m ds i j D)))))
+          (recur (update-queue ds q neighbor D i)
+                 (glue-boundary ds boundary D i)
+                 (conj result [D i]))
+          (recur q boundary result))))))

 ;; === Persistent Clojure implementation of IDSymbol with some common


use log/info instead of println

use log/info instead of println

Signed-off-by: Gregg Reynolds <d0f77bc71a9867acdcb4f62f012b858edad79160@norc.org>


Story ID: RPC-236 Summary: - added missing require for parse-stacktrace - moved stack-trace className to the <div> not the <code>


[JE] add booleanize to csv loader

[JE] add booleanize to csv loader


Add npm request

Add npm request

--- mern_utils/project.clj
+++ mern_utils/project.clj
@@ -35,6 +35,7 @@
                        [passport-google-oauth "1.0.0"]
                        [passport-local "1.0.0"]
                        [react "0.13.3"]
+                       [request "2.72.0"]
                        [source-map-support "0.4.0"]
                        [vogels "2.2.0"]
                        [when "3.7.7"]


a whole new world

a whole new world

--- ros/angelic_planning/src/ros/robot_actions.clj
+++ ros/angelic_planning/src/ros/robot_actions.clj
@@ -219,7 +219,6 @@

 (defn execute-robot-plan-robustly  [nh actions]
   (loop [i 0]
-    (loop []
       (if
         (try (execute-robot-primitive nh (nth actions i))
 	     false


Correct a state propagation error down to child components. See: http://stackoverflow.com/questions/26354662/om-app-state-and-application-structure

--- metlog-vault/src-client/metlog.cljs
+++ metlog-vault/src-client/metlog.cljs
@@ -171,8 +171,9 @@
       (dom/canvas #js {:width (str (om/get-state owner :width) "px")
                        :height (str (om/get-state owner :height) "px")}))))

-(defn series-pane [ state owner ]
+(defn series-pane [ { state :series-cursor app :app-cursor} owner ]
   (om/component
+   (.log js/console "re-render series-pane")
    (dom/div #js { :className "series-pane"}
             (dom/div #js { :className "series-pane-header "}
                      (dom/span #js { :className "series-name"} (:name state)))
@@ -182,8 +183,9 @@
   (reify
     om/IRender
     (render [ this ]
+      (.log js/console "re-render series-list")
       (apply dom/div nil
-             (om/build-all series-pane (:series state))))))
+             (map #(om/build series-pane { :series-cursor % :app-cursor state}) (:series state))))))

 (defn handle-change [ evt owner state app-state]
   (om/set-state! owner :text (.. evt -target -value)))
@@ -196,6 +198,7 @@
   (reify
     om/IRenderState
     (render-state [ this state ]
+      (.log js/console "re-render header")
       (dom/div #js { :className "header"}
                (dom/span #js { :className "left" }
                          "Metlog"


allow for creation of HMAC function without '-hmac' suffix.

--- src/clojure/pandect/impl/message_digest/hmac.clj
+++ src/clojure/pandect/impl/message_digest/hmac.clj
@@ -8,14 +8,16 @@

 ;; ## Code Generator

-(deftype MessageDigestHMACGen [algorithm]
+(deftype MessageDigestHMACGen [algorithm symbol-suffix]
   gen/CodeGen
   (algorithm-string [_]
     algorithm)

   hmac/HMACGen
   (base-symbol [_ sym]
-    (gen/symbol+ sym :hmac))
+    (if symbol-suffix
+      (gen/symbol+ sym symbol-suffix)
+      sym))
   (bytes->hmac [_ msg-form key-form]
     `(let [mac# (Mac/getInstance ~algorithm)
            msg# (bytes ~msg-form)
@@ -46,4 +48,8 @@

 (defn make
   [algorithm]
-  (some-> algorithm ->MessageDigestHMACGen))
+  (some-> algorithm (->MessageDigestHMACGen :hmac)))
+
+(defn make-exclusive
+  [algorithm]
+  (some-> algorithm (->MessageDigestHMACGen nil)))


cleanup

cleanup

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@10393 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/SlideExplorer2/src/slide_explorer/view.clj
+++ plugins/SlideExplorer2/src/slide_explorer/view.clj
@@ -233,25 +233,30 @@
   "Runs visible-loader whenever screen-state-atom changes."
   [screen-state-atom memory-tile-atom
    overlay-tiles-atom acquired-images]
-  (let [react-monochrome (fn [_ _] (monochrome-loader screen-state-atom memory-tile-atom
-                                           acquired-images))
-        react-overlay (fn [_ _] (overlay-loader screen-state-atom memory-tile-atom
-                                               overlay-tiles-atom))
+  (let [load-monochrome (fn [_ _]
+                          (monochrome-loader
+                            screen-state-atom
+                            memory-tile-atom
+                            acquired-images))
+        load-overlay (fn [_ _]
+                       (overlay-loader
+                         screen-state-atom
+                         memory-tile-atom
+                         overlay-tiles-atom))
         agent (agent {})]
     (def agent1 agent)
     (reactive/handle-update
       memory-tile-atom
-      react-overlay
+      load-overlay
       agent)
     (reactive/handle-update
       screen-state-atom
-      react-monochrome
+      load-monochrome
       agent)
     (reactive/handle-update
       acquired-images
-      react-monochrome
-      agent)
-    ))
+      load-monochrome
+      agent)))

 ;; MAIN WINDOW AND PANEL


goofy cat

goofy cat

--- clojure-scip/src/clojure_scip/core.clj
+++ clojure-scip/src/clojure_scip/core.clj
@@ -76,4 +76,17 @@

 ;;1.6
 (defn new-if [pre tc ec]
-  (cond (pre tc) ))+  (cond (pre tc) ))
+
+
+
+
+
+(+ 10 10)
+
+(def x [1 2])
+
+(first x)
+(last x)
+(rest x)
+


Update ring-jetty dependencies

Update ring-jetty dependencies

--- ring-jetty-adapter/project.clj
+++ ring-jetty-adapter/project.clj
@@ -10,7 +10,7 @@
                  [org.eclipse.jetty/jetty-server "9.4.22.v20191022"]]
   :aliases {"test-all" ["with-profile" "default:+1.8:+1.9:+1.10" "test"]}
   :profiles
-  {:dev  {:dependencies [[clj-http "2.2.0"]]
+  {:dev  {:dependencies [[clj-http "3.10.0"]]
           :jvm-opts ["-Dorg.eclipse.jetty.server.HttpChannelState.DEFAULT_TIMEOUT=500"]}
    :1.8  {:dependencies [[org.clojure/clojure "1.8.0"]]}
    :1.9  {:dependencies [[org.clojure/clojure "1.9.0"]]}


create UI first in make-level

create UI first in make-level

--- Assets/game/core.clj
+++ Assets/game/core.clj
@@ -205,6 +205,8 @@

 (defn make-level []
   (clear-cloned!)
+  (clone! :EventSystem)
+  (clone! :Canvas)
   (make-park park-size park-size)
   (reset! player (make-player
     (v3 (* park-size park-scale)
@@ -217,9 +219,7 @@
   (hook-clear @player :on-collision-exit)
   (hook+ @player :update #'game.core/handle-input)
   (hook+ @player :on-collision-enter #(do %1 %2 (reset! TOUCHING true)))
-  (hook+ @player :on-collision-exit #(do %1 %2 (reset! TOUCHING false)))
-  (clone! :EventSystem)
-  (clone! :Canvas))
+  (hook+ @player :on-collision-exit #(do %1 %2 (reset! TOUCHING false))))

@@ -235,5 +235,5 @@
   (wait 0.1)
   #(do (message "brb   7min") nil))

-'(make-level)
-
+(make-level)
+


Reindent a test

Reindent a test


updated lein-cljsbuild

updated lein-cljsbuild

--- resources/project.clj
+++ resources/project.clj
@@ -8,7 +8,7 @@
                  [$REACT_INTERFACE$]
                  [org.omcljs/ambly "0.6.0"]
                  [natal-shell "0.1.2"]]
- :plugins [[lein-cljsbuild "1.1.1"]]
+ :plugins [[lein-cljsbuild "1.1.2"]]
  :cljsbuild {:builds {:dev {:source-paths ["src"]
                             :compiler {:output-to "target/out/main.js"
                                        :output-dir "target/out"


Add missing `:collection` attr on create-icon message.

--- src/uxbox/frontend/icons.clj
+++ src/uxbox/frontend/icons.clj
@@ -95,6 +95,7 @@
                       :type :create-icon
                       :user user
                       :name name
+                      :collection collection
                       :metadata metadata
                       :content content})
          (p/map (fn [entry]


Add non-stable video files to pending list during initial scan

--- src/video_server/watcher.clj
+++ src/video_server/watcher.clj
@@ -38,6 +38,21 @@
            (metadata? file)
            (< (.lastModified file) (- (System/currentTimeMillis) stable-time)))))

+(defn remove-file
+  "Removes the file from the video library."
+  [folder file]
+  (when (has-file? folder file)
+    (log/info "removing file" (str file))
+    (library/remove-file folder file)))
+
+(defn add-pending-file
+  "Adds a new or changing file to the list of pending files."
+  [folder file]
+  (when-not (contains? @pending-files [folder file])
+    (log/info "watching file" (str file))
+    (remove-file folder file)
+    (dosync (alter pending-files conj [folder file]))))
+
 (defn add-metadata
   "Reads existing metadata for the given video."
   [folder title]
@@ -50,12 +65,14 @@
   "Scans the directory for videos."
   [folder path]
   (let [dir (io/file (or path (:file folder)))
-        files (.listFiles dir (movie-filter))]
-    (parseq scan-threads [file (filter stable? files)]
+        files (group-by stable? (.listFiles dir (movie-filter)))]
+    (parseq scan-threads [file (get files true)]
       (log/info "adding video" (str file))
       (let [added (library/add-video folder file)]
         (when (:title added)
-          (add-metadata folder (title-for-file file)))))))
+          (add-metadata folder (title-for-file file)))))
+    (doseq [file (get files false)]
+      (add-pending-file folder file))))

 (defn scan-images
   "Scans the directory for images."
@@ -150,21 +167,6 @@
          (when (or (stable? file) (not (.exists file)))
            (dosync (alter pending-files disj [folder file])))
          (catch Exception e (log/error e "adding pending file" (str file))))))
-
-(defn remove-file
-  "Removes the file from the video library."
-  [folder file]
-  (when (has-file? folder file)
-    (log/info "removing file" (str file))
-    (library/remove-file folder file)))
-
-(defn add-pending-file
-  "Adds a new or changing file to the list of pending files."
-  [folder file]
-  (when-not (contains? @pending-files [folder file])
-    (log/info "watching file" (str file))
-    (remove-file folder file)
-    (dosync (alter pending-files conj [folder file]))))

 (defn file-event
   "Processes the file system events related to files."


Removing the entry page startinfo-container

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -49,6 +49,7 @@
   generate the html to fill them again and sets the path."
   (empty $content)
   (empty $header)
+  (remove ($ "#startinfo-container"))
   (append $content (wish-ul wish))
   (append $header  (wishlist-title title))
   (set-path! code))


Remove redundant file

Remove redundant file

--- src/yada/serializers/map.clj
+++ src/yada/serializers/map.clj
@@ -1,5 +0,0 @@
-;; Copyright © 2015, JUXT LTD.
-
-(ns yada.serializers.map
-  (:require
-   [yada.representation :refer (Content)]))


Add a test that / returns a real response

--- test/icecap/rest_test.clj
+++ test/icecap/rest_test.clj
@@ -30,6 +30,8 @@
   (and (some? clength) (= ctype "application/edn; charset=utf-8")))

 (deftest handler-tests
+  (testing "root is handled"
+    (is (some? (handler (mock/request :get "/")))))
   (testing "creating cap with valid plan succeeds"
     (let-flow [req (create-cap-req {:type :succeed})
                {status :status headers :headers} (handler req)]


Updates version to 1.37.1-SNAPSHOT

Updates version to 1.37.1-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.37.0"
+(defproject cook "1.37.1-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


better error handling

better error handling

--- src-cljs/frontend/components/integrations.cljs
+++ src-cljs/frontend/components/integrations.cljs
@@ -125,12 +125,7 @@
                                    #(om/set-state! owner :show-options? false)
                                    #(om/set-state! owner :show-options? true))}
          (common/icon :slack)
-         [:span
-          (cond submitting? "Sending..."
-                submitted? "Sent!"
-                error error
-                :else
-                (:slack-hook/channel-name slack-hook))]]
+         (:slack-hook/channel-name slack-hook)]
         (when (om/get-state owner :show-options?)
           (if (om/get-state owner :you-sure?)

@@ -150,6 +145,7 @@
                        :data-label "Comment"}]]
              [:div.menu-buttons
               [:button.menu-button {:class (when (or submitting? submitted?) "disabled")
+                                    :disabled (or submitting? submitted?)
                                     :key (:db/id slack-hook)
                                     :on-click (fn [e]
                                                 (om/set-state! owner :submitting? true)
@@ -162,19 +158,26 @@
                                                                                (async/promise-chan)))]
                                                       (if-not (taoensso.sente/cb-success? resp)
                                                         (om/update-state! owner (fn [s] (assoc s
-                                                                                :submitting? false
-                                                                                :error "The request timed out, please try again.")))
+                                                                                :submitting? false
+                                                                                :error "Request timed out, please try again.")))
                                                         (do
                                                           (om/update-state! owner #(assoc % :submitting? false :error nil))
                                                           (if (= :success (:status resp))
                                                             (do
-                                                              (om/set-state! owner :submitted? true)
+                                                              (om/update-state! owner #(assoc % :error nil :submitted? true :submitting? false))
                                                               (js/setTimeout #(when (om/mounted? owner) (om/set-state! owner :submitted? nil))
                                                                              1000))
                                                             (om/set-state! owner :error (:error-msg resp))))))))}
-               "Post to Slack."]
+
+               (cond submitting? "Sending..."
+                     submitted? "Sent!"
+                     :else "Post this doc.")]
               [:button.slack-channel-remove {:on-click #(om/set-state! owner :you-sure? true)}
-               (common/icon :times)]]]))]))))
+               (common/icon :times)]]
+
+             (when error
+               [:div.content.make.error
+                error])]))]))))

 (defn slack-hooks [app owner]
   (reify