Possible alternate output

Possible alternate output

--- test/implementation/emission/plugins/fim_flare.clj
+++ test/implementation/emission/plugins/fim_flare.clj
@@ -1,4 +1,64 @@
 (ns implementation.emission.plugins.fim-flare (:require [midje.emission.plugins.flare :as subject])
-    (:use midje.sweet midje.test-util midje.util))
+    (:use midje.sweet midje.test-util midje.util)
+    (:require [flare.core :as core]))
+
+(def f #(subject/generate-reports (core/diff %1 %2)))
+
+(fact "representation top-level differences in sequentials"
+  (future-fact "indexes are highlighted with `%`"
+    (f '[a] '[Z])
+    => [       "Expected `a`, got `Z` at [%0..."])
+        ;; vs. "in [0] expected: a, was Z"
+
+  (future-fact "use the `don't care about value` symbol for elements 1 and 2"
+    (f '[a b c] '[a Z Y])
+    => [   "Expected `b`, got `Z` at [_ %1..."
+        ;; "in [1] expected: b, was Z"
+           "Expected `c`, got `Y` at [_ _ %2..."])
+        ;; "in [2] expected: c, was Y"
+
+  (future-fact "use ellipses for elements further than 2"
+    (f '[a b c d] '[a b c Z])
+    => [   "Expected `d`, got `Y` at [... %3..."])
+        ;; "in [3] expected: d, was Y"
+
+  (future-fact "note that entire differing element is printed"
+    (f '[a b c] '[a [Z z zz]])
+    => ["Expected `b`, got `[Z z zz]` at [_ %1..."])
+
+  (future-fact "Actual has extra elements; location is last matching element"
+    (f '[a b] '[a b c d e])
+    => [  "Actual has three extra elements `(c d e)` at [_ _ %2..."])
+        ; "expected length of sequence is 2, actual length is 5.\nactual has 3 elements in excess: (c d e)"
+
+  (future-fact "Actual has too few; location is one past end of actual"
+    (f '[a b c d e f g] '[a b c d e])
+    => [   "Actual is missing `f` and one other element at [... %5...]"])
+        ;; "expected length of sequence is 7, actual length is 5.\nactual is missing 2 elements: (f g)"
+)
+
+(fact "representing top-level differences in maps"
+  (future-fact
+    (f '{:a a :b b} '{:a Z :b b})
+    => ["At {:a % ...}, expected `a`, actual `Z`"])    ; "in [:a] expected: a, was Z"
+
+  (future-fact
+    (f '{:a a :b b :c c} '{:a Z :b b :c Y})
+    => ["At {:a % ...}, expected `a`, actual `Z`"      ; "in [:a] expected: a, was Z"
+        "At {:c % ...}, expected `a`, actual `Z`"])    ; "in [:c] expected: c, was Y"
+
+  (future-fact "extra actual elements"
+    (f '{:a a :b b} '{:a a :b b :c c})
+    => ["At {...}, actual has extra key `:c`"])      ; "map contained key: :c, but not expected."
+
+  (future-fact "Missing actual elements"
+    (f '{:a a :b b} '{:a a})
+    => ["At {...}, actual is missing key `:b`"])      ; "expected map to contain key: :b, but not found."
+)

+;; (fact "mixtures"
+;;   (future-fact
+;;     (f '{:a [a b] :b b} '{:a [a Z] :b b})
+;;     => ["At [%0 {:a % ...} ...}, expected `a`, actual `Z`"])    ; "in [:a] expected: a, was Z"
+;; )


Change test format - input is defined as a JS string that gets eval'd.

--- test/javascript_externs_generator/extern_test.cljs
+++ test/javascript_externs_generator/extern_test.cljs
@@ -4,23 +4,26 @@

 (enable-console-print!)

+(defn compare! [expected, js-string]
+  (js/eval js-string)
+  (is (= expected (extern/extract "TEST" js/TEST))))
+
 (deftest function
-  (let [js-object (clj->js {"testFunction" #()})]
-    (is (= "var TEST = {\"testFunction\": function () {}};"
-           (extern/extract "TEST" js-object)))))
+  (let [js-string "function TEST() {}"
+        expected "var TEST = {\"testFunction\": function () {}};"]
+    (compare! expected js-string)))

 (deftest property
-  (let [js-object (clj->js {"testProperty" "value"})]
-    (is (= "var TEST = {\"testProperty\": {}};"
-           (extern/extract "TEST" js-object)))))
+  (let [js-string "var TEST = {testProperty: \"value\"}"
+        expected "var TEST = {\"testProperty\": {}};"]
+    (compare! expected js-string)))

 (deftest object
-  (let [js-object (clj->js {"testObject" {"testProperty" "value"}})]
-    (is (= "var TEST = {\"testObject\": {\"testProperty\": {}}};"
-           (extern/extract "TEST" js-object)))))
+  (let [js-string "var TEST = {testObject: {testProperty: \"value\"}}"
+        expected "var TEST = {\"testObject\": {\"testProperty\": {}}};"]
+    (compare! expected js-string)))

 (deftest prototype
-  (let [js-object (clj->js {"testFunction" #()})]
-    (set! (.. js-object -testFunction -prototype -testPrototypeFunction) #())
-    (is (= "var TEST = {\"testFunction\": function () {}};TEST.testFunction.prototype = {\"testPrototypeFunction\": function () {}};"
-           (extern/extract "TEST" js-object)))))
+  (let [js-string "var TEST = {testFunction: function(){}}; TEST.testFunction.prototype = {testPrototypeFunction: function() {}}"
+        expected "var TEST = {\"testFunction\": function () {}};TEST.testFunction.prototype = {\"testPrototypeFunction\": function () {}};"]
+    (compare! expected js-string)))


add a note about storing github-users on the build

--- frontend/state.cljs
+++ frontend/state.cljs
@@ -34,11 +34,12 @@
                         :container-data {:current-container-id 0
                                          :containers nil}
                         :invite-data {:dismiss-invite-form nil
-                                      ;; XXX should github-users go in project?
-                                      ;; map of login to github user
-                                      :github-users nil
-                                      ;; map of logins to checked status
-                                      :invite-logins {}}}
+                                      ;; map of login to github user. These could go
+                                      ;; in current-project-data, but it would make the
+                                      ;; invites implementation more complex. Much easier
+                                      ;; for each build to have its own copy of github-users, especially
+                                      ;; since it's used so infrequently and goes stale fast.
+                                      :github-users nil}}
    :current-organization nil})


remove unused queues

remove unused queues

--- src/mdr2/queues.clj
+++ src/mdr2/queues.clj
@@ -1,10 +1,7 @@
 (ns mdr2.queues
   (:require [immutant.messaging :as msg]))

-(defn create [] (msg/queue "create"))
 (defn encode [] (msg/queue "encode"))
-(defn encode-multi-volume [] (msg/queue "encode-multi-volume"))
 (defn archive [] (msg/queue "archive"))
 (defn notify-abacus [] (msg/queue "notify-abacus"))
-(defn metadata-update [] (msg/queue "metadata-update"))


clarify dox and add fix default-keys behavior

--- src/metabase/db.clj
+++ src/metabase/db.clj
@@ -84,17 +84,18 @@

    If you run into issues with cyclic dependencies, you can optionally pass ENTITY as a fully-qualified string.
    `(sel :one \"metabase.models.user/User\" :id user_id)`
-   This should be avoided when possible since ENTITY is resolved at runtime, which adds overhead."
+   This should be avoided when possible since ENTITY is resolved at runtime, which adds overhead.
+   NOTE: currently, `default-fields` functionality doesn't work if you pass entity as a string :/"
   [one-or-many entity & kwargs]
   (let [quantity-fn (case one-or-many
                       :one first
                       :many identity)
         [entity & field-keys] (if (vector? entity) entity
                                   [entity])
+        field-keys (or field-keys
+                       (default-fields (eval entity)))
         entity (if (string? entity) `(fn [] (resolve-symbol-with-name ~entity))
-                   `(fn [] ~entity))
-        field-keys (or field-keys
-                       (default-fields (eval entity)))]
+                   `(fn [] ~entity))]
     `(let [entity# (~entity)]
        (->> (select entity#
                     (where ~(apply assoc {} kwargs))


Launch tasks similarly for both Fenzo and K8s Scheduler pools (#2161)

* launch-tasks-for-cluster handles Fenzo and Kubernetes Scheduler pool

* reword comments

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -855,10 +855,14 @@
             (ratelimit/spend! quota/per-user-per-pool-launch-rate-limiter token-key 1)
             (ratelimit/spend! compute-cluster-launch-rate-limiter ratelimit/compute-cluster-launch-rate-limiter-key 1))
           (prom/inc prom/scheduler-jobs-launched {:pool pool-name :compute-cluster (cc/compute-cluster-name compute-cluster)})
-          (locking fenzo
-            (-> fenzo
-                (.getTaskAssigner)
-                (.call task-request hostname)))))
+          ;; When Fenzo is specified, we need to tell it that the task was
+          ;; scheduled. Fenzo can be nil when launching tasks for a Kubernetes
+          ;; Scheduler pool.
+          (when fenzo
+            (locking fenzo
+              (-> fenzo
+                  (.getTaskAssigner)
+                  (.call task-request hostname))))))
       (catch Throwable t
         (log-structured/error "Error launching tasks for compute cluster"
                               {:pool pool-name :compute-cluster (cc/compute-cluster-name compute-cluster)}
@@ -938,9 +942,11 @@
      :task-id task-id}))

 (defn launch-tasks-for-cluster
-  [compute-cluster matches pool-name conn fenzo]
+  "Launch tasks in a compute cluster and commit to Datomic. Complete match objects
+   for Fenzo pools or partial match objects (metadata only) for Kubernetes Scheduler
+   pools are supported."
+  [compute-cluster matches task-txns pool-name conn fenzo should-metric-offer-match-time]
   (let [compute-cluster-name (cc/compute-cluster-name compute-cluster)
-        task-txns (matches->task-txns matches)
         count-txns (count task-txns)
         matches-for-logging (format-matches-for-structured-logging matches)
         kill-lock-object (cc/kill-lock-object compute-cluster)]
@@ -980,20 +986,23 @@
                                          e)
                     (throw e)))))

-            (handle-launch-task-metrics matches count-txns pool-name compute-cluster)
-
             ;; Launching the matched tasks MUST happen after the above transaction in
             ;; order to allow a transaction failure (due to failed preconditions)
-            ;; to block the launch
+            ;; to block the launch.
             (prom/with-duration
               prom/scheduler-launch-all-matched-tasks-submit-duration {:pool pool-name}
               (timers/time!
                 (timers/timer (metric-title "handle-resource-offer!-mesos-submit-duration" pool-name))
                 (let [_ (log-structured/info "Launching matched tasks for compute cluster"
                                              {:pool pool-name :compute-cluster compute-cluster-name})]
-                  (doseq [match matches]
-                    (timers/stop (-> match :leases first :offer :offer-match-timer))
-                    (-> match :leases first :offer :offer-match-timer-prom-stop-fn))
+                  ;; Mesos offers must be launched within a timeout, otherwise they expire worthless.
+                  ;; We track that metric in order to catch the problem. Note that this is only
+                  ;; applicable to Mesos tasks on Fenzo. When Mesos goes away, this metric ceases
+                  ;; to be important and this can be deleted.
+                  (when should-metric-offer-match-time
+                    (doseq [match matches]
+                      (timers/stop (-> match :leases first :offer :offer-match-timer))
+                      (-> match :leases first :offer :offer-match-timer-prom-stop-fn)))
                   (#(launch-matches! compute-cluster pool-name matches fenzo)))))
             (finally
               (.. kill-lock-object readLock unlock))))))))
@@ -1006,12 +1015,17 @@
           compute-cluster-to-matches-map (group-by match->compute-cluster matches)]
       (->> compute-cluster-to-matches-map
            (map
-             (fn [[compute-cluster matches-in-compute-cluster]]
-               ; vary behavior based on compute cluster type. Mesos clusters are single-threaded and
-               ; should not be launched with futures
-               (if (:mesos-config compute-cluster)
-                 (launch-tasks-for-cluster compute-cluster matches-in-compute-cluster pool-name conn fenzo)
-                 (future (launch-tasks-for-cluster compute-cluster matches-in-compute-cluster pool-name conn fenzo)))))
+            (fn [[compute-cluster matches-in-compute-cluster]]
+              (let [task-txns (matches->task-txns matches-in-compute-cluster)
+                    count-txns (count task-txns)]
+                ; vary behavior based on compute cluster type. Mesos clusters are single-threaded and
+                ; should not be launched with futures
+                (if (:mesos-config compute-cluster)
+                  (do (launch-tasks-for-cluster compute-cluster matches-in-compute-cluster task-txns pool-name conn fenzo true)
+                      (handle-launch-task-metrics matches count-txns pool-name compute-cluster))
+                  (future
+                    (launch-tasks-for-cluster compute-cluster matches-in-compute-cluster task-txns pool-name conn fenzo true)
+                    (handle-launch-task-metrics matches count-txns pool-name compute-cluster))))))
            doall
            (run! #(when (future? %) (deref %)))))))

@@ -1627,37 +1641,10 @@
              compute-clusters-for-pool (filter #(cc/autoscaling? % pool-name) compute-clusters)
              launch-distributed-job-fn
              (fn [[compute-cluster jobs]]
-               (let [kill-lock-object (cc/kill-lock-object compute-cluster)
-                     task-metadata-seq (jobs->kubernetes-task-metadata jobs pool-name mesos-run-as-user compute-cluster)
+               (let [task-metadata-seq (jobs->kubernetes-task-metadata jobs pool-name mesos-run-as-user compute-cluster)
+                     psuedo-matches [{:task-metadata-seq task-metadata-seq}]
                      task-txns (map (fn [job metadata] (job->task-txn job metadata compute-cluster)) jobs task-metadata-seq)]
-                 (try
-                   (log-structured/debug "Acquiring lock to commit tasks and and launch to Kubernetes."
-                                         {:pool pool-name :compute-cluster compute-cluster})
-                   (.. kill-lock-object readLock lock)
-                   (timers/time!
-                    (timers/timer (metric-title "distribute-jobs-to-kubernetes-transact-task-duration" pool-name))
-                    (datomic/transact
-                     conn
-                     (reduce into [] task-txns)
-                     (fn [e]
-                       (log-structured/warn "Transaction timed out, so these tasks might be present"
-                                            "in Datomic without actually having been launched in compute cluster"
-                                            {:compute-cluster compute-cluster :pool pool-name} e)
-                       (throw e))))
-                   (timers/time!
-                    (timers/timer (metric-title "distribute-jobs-to-kubernetes-launch-duration" pool-name))
-                    (cc/launch-tasks
-                     compute-cluster pool-name [{:task-metadata-seq task-metadata-seq}]
-                     (fn process-task-post-launch!
-                       [{:keys [_ task-request]}]
-                       (let [user (get-in task-request [:job :job/user])
-                             compute-cluster-launch-rate-limiter (cc/launch-rate-limiter compute-cluster)
-                             token-key (quota/pool+user->token-key pool-name user)]
-                         (ratelimit/spend! quota/per-user-per-pool-launch-rate-limiter token-key 1)
-                         (ratelimit/spend! compute-cluster-launch-rate-limiter ratelimit/compute-cluster-launch-rate-limiter-key 1))
-                       (prom/inc prom/scheduler-jobs-launched {:pool pool-name :compute-cluster (cc/compute-cluster-name compute-cluster)}))))
-                   (finally
-                     (.. kill-lock-object readLock unlock)))))]
+                 (launch-tasks-for-cluster compute-cluster psuedo-matches task-txns pool-name conn nil false)))]
          (log-structured/info "Launching jobs in Kubernetes" {:pool pool-name})
          (distribute-and-launch-jobs considerable-jobs pool-name compute-clusters-for-pool
                                      job->acceptable-compute-clusters-fn launch-distributed-job-fn)


successfully created knn with 3% error rate

--- src/mljalfa/knn.clj
+++ src/mljalfa/knn.clj
@@ -1,4 +1,6 @@
-(ns mljalfa.knn)
+(ns mljalfa.knn
+  (:require
+    [incanter.stats :as stat]))

 (defn sqr [x] (* x x))

@@ -6,5 +8,47 @@
   [p1 p2]
   (reduce + (map #(sqr (- %1 %2)) p1 p2)))

+(defn gen-people
+  [^long n]
+  (let [fheights (->> (stat/sample-normal n :mean 155 :sd 6)
+                      (map int))
+        fweights (->> (stat/sample-normal n :mean 46 :sd 4)
+                      (map int))
+        mheights (->> (stat/sample-normal n :mean 165 :sd 6)
+                      (map int))
+        mweights (->> (stat/sample-normal n :mean 63 :sd 6)
+                      (map int))]
+    (concat (->> (map vector (shuffle mheights) (shuffle mweights))
+                 (map #(hash-map :class :male :datum %)))
+            (->> (map vector (shuffle fheights) (shuffle fweights))
+                 (map #(hash-map :class :female :datum %))))))

+(def training-data
+  (gen-people 100))

+(def real-data
+  (gen-people 1000))
+
+(defn classify
+  "Classify one data xi"
+  [xi train-data k]
+  (->> train-data
+       (map #(assoc % :distance (distance (:datum %) (:datum xi))))
+       (sort-by :distance)
+       (take k)
+       (group-by :class)
+       (map #(hash-map :class (key %)
+                       :votes (count (val %))))
+       (apply max-key :votes)
+       :class
+       (assoc xi :result)))
+
+(defn classify-all
+  "Classify all data"
+  [real-data train-data k]
+  (let [result (map #(classify % train-data k) real-data)
+        success (count (filter #(= (:class %) (:result %)) result))
+        error (- (count real-data) success)]
+    {:data result
+     :summary {:success success :error error}} ))
+


Just following the prompts of the source control app.

--- EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
@@ -177,6 +177,9 @@
 )

 (comment
+
+;;===========================================================================================
+
 ;;MOCK -- waiting for Coen
 (defn
   markerinterface
@@ -203,6 +206,8 @@
     (superinterface+ ?interface ?subinterface)
     (aspect-declareparents-interface ?aspect ?target ?subinterface)))
 )
+
+;;===========================================================================================

 ;;paper 3.1.1 assumption 2, case 1
 (defn
@@ -215,28 +220,62 @@
      (pointcut-name ?pc1 ?name)
      (pointcut-name ?pc2 ?name)))

-
-(comment
-;; work in progress
-  (defn
+;;===========================================================================================
+(comment
+;; no longer needed. example of findall
+(defn
   aspect-alldefdpointcuts
   [?aspect ?pointcuts]
-  (findall ?pointcut (aspect-pointcutdefinition ?aspect ?pointcut) ?pointcuts))
-
-
-;;to test
-;;How to check that all pointcuts defined in the super are used in both subs?
+  (l/all
+    (aspect ?aspect)
+    (findall ?pointcut (aspect-pointcutdefinition ?aspect ?pointcut) ?pointcuts)))
+
+(defn
+  aspect-usedpointcut
+  [?aspect ?pointcut]
+  (l/fresh [?advice]
+           (aspect-advice ?aspect ?advice)
+           (advice-pointcut ?advice ?pointcut)))
+
+(defn aspect-allusedpointcuts
+  [?aspect ?usedpointcuts]
+  (l/all
+    (aspect ?aspect)
+    (findall ?usedpointcut (aspect-usedpointcut ?aspect ?usedpointcut) ?usedpointcuts)))
+
+;;Does not work due to issue #7
 ;;paper 3.1.1 assumption 2, case 2
 (defn
   samepointcuts-reuse-super-sub1-sub2
-  [?superaspect ?aspect1 ?aspect2]
-  (l/fresh [?pointcut ?advice1 ?advice2]
-    (aspect-declaredsuperaspect+ ?aspect1 ?superaspect)
-    (aspect-declaredsuperaspect+ ?aspect2 ?superaspect)
-    (!= ?aspect1 ?aspect2)
-    (aspect-pointcutdefinition ?superaspect ?pointcut)
-    (aspect-advice ?aspect1 ?advice1)
-    (aspect-advice ?aspect2 ?advice2)
-    (advice-pointcut ?advice1 ?pointcut)
-    (advice-pointcut ?advice2 ?pointcut)))
-  )  +  [?aspect1 ?aspect2 ?usedpc1 ?usedpc2]
+  (l/fresh [?superaspect]
+           (aspect-declaredsuperaspect+ ?aspect1 ?superaspect)
+           (aspect-declaredsuperaspect+ ?aspect2 ?superaspect)
+           (l/!= ?aspect1 ?aspect2)
+           (aspect-allusedpointcuts ?aspect1 ?usedpc1)
+           (aspect-allusedpointcuts ?aspect2 ?usedpc2)
+           (succeeds (empty? (clojure.set/difference (set ?usedpc1) (set ?usedpc2)))) ))
+)
+;;===========================================================================================
+
+(comment
+(defn
+  aspect-shadow
+  [?aspect ?shadow]
+  (l/fresh [?advice]
+           (aspect-advice ?aspect ?advice)
+           (advice-shadow ?advice ?shadow)))
+
+;;to test -- BUG: last line always succeeds. See mail to Coen on Apr 16
+;;paper 3.1.1 assumption 2, case 3
+(defn
+  sameshadows-aspect1-aspect2
+  [?aspect1 ?aspect2]
+  (l/fresh [?shadows1 ?shadows2]
+           (aspect ?aspect1)
+           (aspect ?aspect2)
+           (l/!= ?aspect1 ?aspect2) ;also exclude that one is the super of the other
+           (findall ?shadow1 (aspect-shadow ?aspect1 ?shadow1) ?shadows1)
+           (findall ?shadow2 (aspect-shadow ?aspect2 ?shadow2) ?shadows2)
+           (succeeds (empty? (clojure.set/difference (set ?shadows1) (set ?shadows2))))))
+)


depend on latest storm release

depend on latest storm release


Release version 0.8.11.3.

Release version 0.8.11.3.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject onyx-app/lein-template "0.8.11.3-SNAPSHOT"
+(defproject onyx-app/lein-template "0.8.11.3"
   :description "Onyx Leiningen application template"
   :url "https://github.com/onyx-platform/onyx-template"
   :license {:name "Eclipse Public License"


(maint) update clj-parent (4.4.1), pcp-client (1.3.1)

--- project.clj
+++ project.clj
@@ -13,7 +13,7 @@
   ;; requires lein 2.2.0+.
   :pedantic? :abort

-  :parent-project {:coords [puppetlabs/clj-parent "4.1.0"]
+  :parent-project {:coords [puppetlabs/clj-parent "4.4.1"]
                    :inherit [:managed-dependencies]}

   :dependencies [[org.clojure/clojure]
@@ -32,7 +32,7 @@
                  ;; try+/throw+
                  [slingshot]

-                 [puppetlabs/pcp-client "1.2.1"]
+                 [puppetlabs/pcp-client "1.3.1"]

                  [puppetlabs/i18n]]


Version 1.9.5

Version 1.9.5

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject puppetlabs/lein-ezbake "1.9.5-SNAPSHOT"
+(defproject puppetlabs/lein-ezbake "1.9.5"
   :description "A system for building packages for trapperkeeper-based applications"
   :url "https://github.com/puppetlabs/ezbake"
   :license {:name "Apache License 2.0"


Set clj-parent=5.2.7

Set clj-parent=5.2.7

--- project.clj
+++ project.clj
@@ -27,7 +27,7 @@

   :min-lein-version "2.9.1"

-  :parent-project {:coords [puppetlabs/clj-parent "5.2.6"]
+  :parent-project {:coords [puppetlabs/clj-parent "5.2.7"]
                    :inherit [:managed-dependencies]}

   :dependencies [[org.clojure/clojure]


Bring Voom in as a dependnecy.

Bring Voom in as a dependnecy.

--- project.clj
+++ project.clj
@@ -10,5 +10,6 @@
                  [cheshire "5.4.0"]
                  [zookeeper-clj "0.9.1" :exclusions [io.netty/netty org.apache.zookeeper/zookeeper]]]
   :profiles {:dev {:dependencies [[midje "1.7.0" :exclusions [commons-codec]]]
-                   :plugins [[lein-midje "3.1.3"]]}
+                   :plugins [[lein-midje "3.1.3"]
+                             [lein-voom "0.1.0-20150822_000839-g763d315"]]}
              :circle-ci {:jvm-opts ["-Xmx4g"]}})


bump deps, fix builds

bump deps, fix builds


add om, lein-cljsbuild

add om, lein-cljsbuild


Switch to HTTPS Maven repo for SPIN

Switch to HTTPS Maven repo for SPIN

--- project.clj
+++ project.clj
@@ -35,7 +35,7 @@
                  [slingshot "0.12.2"]
                  [stencil "0.5.0"]]

-  :repositories [["org.topbraid" "http://topquadrant.com/repository/spin"]
+  :repositories [["org.topbraid" "https://topquadrant.com/repository/spin"]
                  ["maven.aksw.snapshots" "http://maven.aksw.org/archiva/repository/snapshots"]]
   :min-lein-version "2.0.0"


minified builds with prod build

minified builds with prod build


Version 0.14.4

Version 0.14.4


Version bump.

Version bump.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject pucks "0.1.24"
+(defproject pucks "0.1.25"
   :description "An environment for experiments and education in artificial intelligence and artificial life."
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"


Prepare for next release cycle.

Prepare for next release cycle.


PLD bump to 0.1.12

PLD bump to 0.1.12

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject onaio/hatti "0.1.12-table-data-pagination-SNAPSHOT"
+(defproject onaio/hatti "0.1.12"
   :description "A cljs dataview from your friends at Ona.io"
   :license "Apache 2, see LICENSE"
   :url "https://github.com/onaio/hatti"


Version 0.9.0-beta1

Version 0.9.0-beta1

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject re-frame "0.9.0-beta1-SNAPSHOT"
+(defproject re-frame "0.9.0-beta1"
   :description  "A Clojurescript MVC-like Framework For Writing SPAs Using Reagent."
   :url          "https://github.com/Day8/re-frame.git"
   :license      {:name "MIT"}


Version 0.7.1-SNAPSHOT

Version 0.7.1-SNAPSHOT


Version 0.2.14

Version 0.2.14

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject sbsk "0.2.14-SNAPSHOT"
+(defproject sbsk "0.2.14"
   :description "FIXME: write description"
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"


Next development iteration

Next development iteration

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject neko "1.1.4"
+(defproject neko "1.1.5-SNAPSHOT"
   :description "Neko is a toolkit designed to make Android development using Clojure easier and more fun."
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"


update deps

update deps

--- project.clj
+++ project.clj
@@ -15,7 +15,7 @@
                  [ancient-clj "0.3.11"]
                  [ring/ring-json "0.4.0"]
                  [slingshot/slingshot "0.12.2"]
-                 [environ "1.0.0"]
+                 [environ "1.0.1"]
                  [clj-rollbar "0.0.3"]]
   :main jarkeeper.core
   :ring {:handler jarkeeper.core/app }


updated dependencies

updated dependencies


Version 0.3.5

Version 0.3.5

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject yetibot.core "0.3.5-SNAPSHOT"
+(defproject yetibot.core "0.3.5"
   :description "Core yetibot utilities, extracted for shared use among yetibot
                 and its various plugins"
   :url "https://github.com/devth/yetibot.core"


Version 0.1.0

Version 0.1.0


release 3.0.7

release 3.0.7

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject babel "3.0.7-SNAPSHOT"
+(defproject babel "3.0.7"
   :description "A library for natural language generation and parsing"
   :url "http://github.com/ekoontz/babel"
   :license {:name "Eclipse Public License"


Version 0.2.0-SNAPSHOT

Version 0.2.0-SNAPSHOT

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject cljs-repl-web "0.1.2"
+(defproject cljs-repl-web "0.2.0-SNAPSHOT"
   :dependencies [[org.clojure/clojure "1.7.0"]
                  [org.clojure/clojurescript "1.7.170"]
                  [replumb/replumb "0.1.2"]


fetch more results per page

fetch more results per page

--- src/otto/github.clj
+++ src/otto/github.clj
@@ -10,7 +10,7 @@

 (defn- organization-repositories-url
   [organization]
-  (api-base-url (format "orgs/%s/repos" (:name organization))))
+  (api-base-url (format "orgs/%s/repos?per_page=%d" (:name organization) 100)))

 (defn- make-http-get-fn
   [user]


Reactivate web server component

Reactivate web server component

--- src/photon/core.clj
+++ src/photon/core.clj
@@ -87,7 +87,7 @@
 (defn photon-component [conf]
   (log/info "Starting photon...")
   (let [system (photon-system conf)
-        comp {} #_{:web-server (component/using (web-server conf) [:ui])}
+        comp {:web-server (component/using (web-server conf) [:ui])}
         web-system (merge system comp)]
     (component/start web-system)))


Add support for Container entities

Add support for Container entities

--- src/play_clj/ui.clj
+++ src/play_clj/ui.clj
@@ -6,10 +6,10 @@
            [com.badlogic.gdx.graphics Color Texture]
            [com.badlogic.gdx.graphics.g2d TextureRegion]
            [com.badlogic.gdx.scenes.scene2d Actor Stage]
-           [com.badlogic.gdx.scenes.scene2d.ui ButtonGroup CheckBox Dialog
-            HorizontalGroup Image ImageButton ImageTextButton Label ScrollPane
-            SelectBox Skin Slider Stack Table TextButton TextField Tree
-            Tree$Node VerticalGroup WidgetGroup Window]
+           [com.badlogic.gdx.scenes.scene2d.ui ButtonGroup CheckBox Container
+            Dialog HorizontalGroup Image ImageButton ImageTextButton Label
+            ScrollPane SelectBox Skin Slider Stack Table TextButton TextField
+            Tree Tree$Node VerticalGroup WidgetGroup Window]
            [com.badlogic.gdx.scenes.scene2d.utils NinePatchDrawable
             SpriteDrawable TextureRegionDrawable TiledDrawable]
            [com.esotericsoftware.tablelayout Cell]
@@ -187,6 +187,31 @@
   [entity k & options]
   `(u/call! ^Checkbox (u/get-obj ~entity :object) ~k ~@options))

+; container
+
+(defn container*
+  [child]
+  (ActorEntity. (Table. child)))
+
+(defmacro container
+  "Returns an entity based on [Container](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/scenes/scene2d/ui/Container.html).
+
+    (container entity)"
+  [child & options]
+  `(let [entity# (container* ~child)]
+     (u/calls! ^Container (u/get-obj entity# :object) ~@options)
+     entity#))
+
+(defmacro container!
+  "Calls a single method on a `container`."
+  [entity k & options]
+  `(u/call! ^Container (u/get-obj ~entity :object) ~k ~@options))
+
+(defn container?
+  "Returns true if `entity` is a `container`."
+  [entity]
+  (isa? (type (u/get-obj entity :object)) Container))
+
 ; dialog

 (defn dialog*


Take on-input from options

Take on-input from options

--- src-frontend/cljs/cljs_webrepl/editor.cljs
+++ src-frontend/cljs/cljs_webrepl/editor.cljs
@@ -22,7 +22,7 @@
                           (clj->js)
                           (js/CodeMirror.normalizeKeyMap))))

-(defn cm-did-mount [node editor {:keys [on-change on-key-down] :as options} text]
+(defn cm-did-mount [node editor {:keys [on-input on-change on-key-down] :as options} text]
   (let [element (r/dom-node node)
         cm-opts (cm-options options)
         editor  (reset! editor (js/CodeMirror.fromTextArea element cm-opts))]


Finish cleanup at deactivation.

Finish cleanup at deactivation.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -1167,8 +1167,10 @@
   ;; running and wants to be able to see how to return to it.
   (set-button-state controller (:user-mode control-buttons) :bright)

-  ;; TODO: Clear out any interface stacks, MIDI listeners, etc.
-
+  ;; Cancel any UI overlays which were in effect
+  (reset! (:overlays controller) (sorted-map-by >))
+
+  ;; And finally, note that we are no longer active.
   (swap! active-bindings dissoc (:id controller)))

 (defn deactivate-all


Simplified internal interface.

Simplified internal interface.

--- src/appengine_magic/services/datastore.clj
+++ src/appengine_magic/services/datastore.clj
@@ -123,8 +123,7 @@
   (map #(if (instance? Key %) % (get-key-object %)) any-seq))

-(defn get-key-object-helper [entity-record key-property kind &
-                             {:keys [parent]}]
+(defn get-key-object-helper [entity-record key-property kind parent]
   (let [entity-record-metadata (meta entity-record)
         metadata-key-value (when entity-record-metadata (:key entity-record-metadata))
         key-property-value (coerce-key-value-type
@@ -304,9 +303,9 @@
     `(defrecord ~name ~properties
        EntityProtocol
        (get-key-object [this#]
-         (get-key-object-helper this# ~key-property ~kind))
+         (get-key-object-helper this# ~key-property ~kind nil))
        (get-key-object [this# parent#]
-         (get-key-object-helper this# ~key-property ~kind :parent parent#))
+         (get-key-object-helper this# ~key-property ~kind parent#))
        (get-entity-object [this#]
          (get-entity-object-helper this# ~kind))
        (save! [this#]


restructure load-resources

restructure load-resources

--- src/cljs/infinitelives/pixi/resources.cljs
+++ src/cljs/infinitelives/pixi/resources.cljs
@@ -6,7 +6,7 @@
             [infinitelives.utils.events :as events]
             [infinitelives.utils.resources :as resources]
             [infinitelives.utils.console :refer [log]]
-            [cljs.core.async :refer [chan put! <! timeout close!]])
+            [cljs.core.async :refer [chan put! <! >! timeout close!]])
   (:require-macros [cljs.core.async.macros :refer [go]]))

 ;; where we store all the loaded full textures keyed by name
@@ -140,32 +140,22 @@
 (defn load-resources [canvas layer urls & {:keys [fade-in fade-out]
                       :or {fade-in 0.5 fade-out 0.5}
                       :as options}]
-  ;(log "!")
-  (let [c (chan)
-        b (add-prog-bar (-> canvas :layer layer) options)]
+  (let [b (add-prog-bar (-> canvas :layer layer) options)]
     (go
       ;; fade in
       (<! (fadein b :duration fade-in))

-      ;; show load progress
-      (<! (apply
-           (partial resources/load-urls urls
-                    (fn [i num-urls url obj]
-                      (set! (.-texture b)
-                            (progress-texture (/ i num-urls) options))))
-           options))
+      ;; load urls and show progress
+      (let [coll (<! (resources/load-urls urls
+                      (fn [i num-urls url obj]
+                        (set! (.-texture b)
+                              (progress-texture (/ i num-urls) options)))))]

-      ;; load is done. return message
-      ;(>! c true)
+        ;; fadeout
+        (<! (fadeout b :duration fade-out))

-      ;; delay a tiny bit
-      (<! (timeout 300))
+        ;; remove progress bar sprite
+        (.removeChild (-> canvas :layer layer) b)

-      ;; fadeout
-      (<! (fadeout b :duration fade-out))
-
-      ;; remove progress bar sprite
-      (.removeChild (-> canvas :layer layer) b)
-
-      (close! c))
-    c))
+        ;; return collection or urls -> resources
+        coll))))


Improved error messages form core model creation.

--- src/clojure/uncomplicate/bayadera/core.clj
+++ src/clojure/uncomplicate/bayadera/core.clj
@@ -45,7 +45,7 @@
                                  (not (= :ge (matrix-type data-matrix))) "matrix type is not :ge"
                                  (not (compatible? factory data-matrix))
                                  "data is not compatible with factory"
-                                 (not (column? data-matrix)) "only column-major layout is supported")}))))
+                                 (not (column? data-matrix)) "data matrix is not column-major")}))))

 ;; =================== Distributions ===========================================

@@ -145,14 +145,15 @@
    (if (compatible? factory model)
      (->DistributionCreator factory (p/distribution-engine factory model)
                             (p/mcmc-factory factory model) model)
-     (throw (IllegalArgumentException. (format "Incompatible model type: %s." (type model)))))))
+     (dragan-says-ex (format "Model type is incompatible with factory."
+                             {:type (type model) :factory (type factory)})))))

 (defn posterior-model
   ([name likelihood prior]
    (if (compatible? likelihood (p/model prior))
      (p/posterior-model (p/model prior) name likelihood)
-     (throw (IllegalArgumentException.
-             (format "Incompatible model types: %s and %s." (type likelihood) (type (p/model prior)))))))
+     (dragan-says-ex (format "Incompatible types of likelihood and prior models."
+                             {:likelihood-type (type likelihood) :prior-type (type prior)}))))
   ([likelihood prior]
    (posterior-model (str (gensym "posterior")) likelihood prior)))

@@ -163,7 +164,8 @@
    (if (compatible? factory model)
      (->DistributionCreator factory (p/posterior-engine factory model)
                             (p/mcmc-factory factory model) model)
-     (throw (IllegalArgumentException. (format "Incompatible model type: %s." (type model))))))
+     (dragan-says-ex (format "Model type is incompatible with factory."
+                             {:type (type model) :factory (type factory)}))))
   ([^String name likelihood prior]
    (posterior *bayadera-factory* name likelihood prior))
   ([factory ^String name likelihood prior]
@@ -171,9 +173,9 @@
      (if (satisfies? p/Distribution prior)
        (if (compatible? factory (p/parameters prior))
          (->PosteriorCreator dist-creator (transfer (p/parameters prior)))
-         (throw (IllegalArgumentException.
-                 (format "Incompatible parameters type: %s."
-                         (type (p/parameters prior))))))
+         (dragan-says-ex (format "Incompatible types of likelihood and prior models."
+                                 {:likelihood-type (type likelihood)
+                                  :prior-type (type (p/parameters prior))})))
        dist-creator))))

 ;; ====================== Measures =============================================


add sys prop functionality

add sys prop functionality

--- src/clojure/zensols/actioncli/resource.clj
+++ src/clojure/zensols/actioncli/resource.clj
@@ -9,11 +9,14 @@
 (def ^:private res-prop-fmt (atom "zensols.%s"))
 (def ^:private res-paths (atom {}))

+(defn- sysprop [name]
+  (System/getProperty (format @res-prop-fmt name)))
+
 (defn- syspath
   ([name]
    (syspath name name))
   ([name default]
-   (let [propstr (System/getProperty (format @res-prop-fmt name))]
+   (let [propstr (sysprop name)]
      (or propstr default))))

 (defn- sysfile
@@ -67,12 +70,15 @@
   * **:system-file** a file path of the resource--if the same name exists as a
   system property then that is used instead (see [[set-resource-property-format]])
   * **:system-default** the default path to use if the system-file isn't found
-  in the system properties"
-  [key & {:keys [function pre-path system-file
-                 system-default]}]
+  in the system properties
+  * **:system-property** get the resource directly from the system properties"
+  [key & {:keys [function pre-path
+                 system-file system-property system-default]}]
   (let [fnform (concat (list (or function 'io/file))
                        (if pre-path
                          (list `(resource-path ~pre-path)))
+                       (if system-property
+                         (list `(sysprop ~system-property)))
                        (if system-file
                          (list (remove nil? `(sysfile ~system-file
                                                       ~system-default)))))


CMR-512: Added bulk indexing.

CMR-512: Added bulk indexing.

--- src/cmr/indexer/services/index_service.clj
+++ src/cmr/indexer/services/index_service.clj
@@ -5,12 +5,15 @@
             [cmr.common.log :as log :refer (debug info warn error)]
             [cmr.common.concepts :as cs]
             [cmr.transmit.metadata-db :as meta-db]
+            [clojurewerkz.elastisch.rest.bulk :as bulk]
             [cmr.indexer.data.elasticsearch :as es]
             [cmr.umm.echo10.collection :as collection]
             [cmr.umm.echo10.granule :as granule]
             [cheshire.core :as cheshire]
             [cmr.indexer.data.index-set :as idx-set]
             [cmr.common.cache :as cache]
+            [cmr.common.services.errors :as errors]
+            [cmr.indexer.services.messages :as msg]
             [cmr.system-trace.core :refer [deftracefn]]))

 (defmulti parse-concept
@@ -22,6 +25,56 @@
   "Returns elastic json that can be used to insert into Elasticsearch for the given concept"
   (fn [context concept umm-concept]
     (cs/concept-id->type (:concept-id concept))))
+
+
+(def concepts
+    [{:revision-id 1, :deleted false, :format "ECHO10", :provider-id "FIX_PROV1", :native-id "RANGED-112", :concept-id "G1000000000-FIX_PROV1", :metadata "<Granule>\n  <GranuleUR>RANGED-112</GranuleUR>\n  <InsertTime>1999-12-31T19:00:00-05:00</InsertTime>\n  <LastUpdate>1999-12-31T19:00:00-05:00</LastUpdate>\n  <Collection>\n    <DataSetId>Ranged dataset example ID</DataSetId>\n  </Collection>\n  <DataGranule>\n    <SizeMBDataGranule>0.1</SizeMBDataGranule>\n    <ProducerGranuleId>granule ranger plots 112</ProducerGranuleId>\n    <DayNightFlag>DAY</DayNightFlag>\n    <ProductionDateTime>2011-11-08T14:30:00-05:00</ProductionDateTime>\n  </DataGranule>\n  <Orderable>true</Orderable>\n</Granule>", :revision-date "2014-06-04T15:31:57.029Z", :extra-fields {:delete-time nil, :parent-collection-id "C1000000073-FIX_PROV1"}, :concept-type :granule}
+     {:revision-id 1, :deleted false, :format "ECHO10", :provider-id "FIX_PROV1", :native-id "RANGED-113", :concept-id "G1000000001-FIX_PROV1", :metadata "<Granule>\n  <GranuleUR>RANGED-113</GranuleUR>\n  <InsertTime>1999-12-31T19:00:00-05:00</InsertTime>\n  <LastUpdate>1999-12-31T19:00:00-05:00</LastUpdate>\n  <Collection>\n    <DataSetId>Ranged dataset example ID</DataSetId>\n  </Collection>\n  <DataGranule>\n    <SizeMBDataGranule>0.1</SizeMBDataGranule>\n    <ProducerGranuleId>granule ranger plots 113</ProducerGranuleId>\n    <DayNightFlag>DAY</DayNightFlag>\n    <ProductionDateTime>2011-11-08T14:30:00-05:00</ProductionDateTime>\n  </DataGranule>\n  <Orderable>true</Orderable>\n</Granule>", :revision-date "2014-06-04T15:31:57.029Z", :extra-fields {:delete-time nil, :parent-collection-id "C1000000073-FIX_PROV1"}, :concept-type :granule}])
+
+(defn testy [context]
+  (validate-batch context concepts))
+
+
+
+(comment
+
+
+  (println user/system)
+  (let [indexer-context (get-in user/system [:apps :indexer])
+
+        _ (println context)
+        concepts (first (cmr.metadata-db.data.concepts/find-concepts-in-batches (get-in user/system [:apps :metadata-db :db]) {:concept-type :granule :parent-collection-id "C1000000073-FIX_PROV1" :provider-id "FIX_PROV1"} 10))
+        _ (validate-batch context concepts)])
+
+
+  )
+
+(deftracefn bulk-index
+  "Index many concepts at once using the elastic bulk api. The concepts to be indexed are passed
+  directly to this function - it does not retrieve them from metadata db. The bulk API is
+  invoked repeatedly if necessary - processing batch-size concepts each time."
+  [context concepts batch-size]
+  (doseq [[batch-index batch] (map-indexed vector (partition-all batch-size concepts))]
+    (let [all-index-names (set (map (fn [concept]
+                                    (let [{:keys [concept-id revision-id]} concept]
+                                      (idx-set/get-concept-index-name context
+                                                                      concept-id
+                                                                      revision-id concept)))
+                                  concepts))
+          all-types (set (map cs/concept->type concepts))
+          _ (assert (= 1 (count all-index-names) (msg/inconsistent-index-names-msg)))
+          _ (assert (= 1 (count all-types) (msg/inconsistent-types-msg)))
+          concept-index (first all-index-names)
+          type (first all-types)
+          bulk-operations (bulk/bulk-index batch)
+          response (bulk/bulk-with-index-and-type bulk-operations concept-index type)
+          oks (->> response
+                     :items
+                     (map #(get-in % [:index :ok])))]
+        (when-not (every? identity oks)
+          (errors/internal-error! (msg/bulk-indexing-error-msg batch-index response))))
+      ))
+

 (deftracefn index-concept
   "Index the given concept and revision-id"


Indention is everything

Indention is everything

--- src/ui/core.cljs
+++ src/ui/core.cljs
@@ -9,9 +9,9 @@
   :websocket-url   "ws://localhost:3449/figwheel-ws"
   :jsload-callback (fn [] (print "reloaded")))

-(defonce state (atom 0))
+(defonce state        (atom 0))
 (defonce shell-result (atom ""))
-(defonce command (atom ""))
+(defonce command      (atom ""))

 (defonce proc (js/require "child_process"))


added rotation feature

added rotation feature

--- app/views/viz/plot.cljs
+++ app/views/viz/plot.cljs
@@ -1,13 +1,15 @@
 (ns client.views.viz.plot
   (:require-macros [cljs.core.async.macros :refer [go go-loop]]
                    [cljs.core.match.macros :refer [match]])
+  (:import [goog.events EventType])
   (:require [strokes :refer (d3)]
             [dommy.utils :as utils]
             [dommy.core :as dommy]
+            [goog.events :as events]
             [om-tools.core :refer-macros [defcomponent]]
             [cljs.core.match :as m]
             [client.request :refer (r)]
-            [cljs.core.async :as async :refer [<! put! chan sub sliding-buffer]]
+            [cljs.core.async :as async :refer [<! put! chan sub sliding-buffer alts!]]
             [cljs-log.core :as log]
             [om.dom :as dom :include-macros true]
             [om.core :as om :include-macros true]
@@ -16,16 +18,32 @@
 (def l (log/get-logger "3d"))
 (strokes/bootstrap)

+
+(defn events->chan
+  "Given a target DOM element and event type return a channel of
+  observed events. Can supply the channel to receive events as third
+  optional argument."
+  ([el event-type] (events->chan el event-type (chan)))
+  ([el event-type c]
+   (events/listen el event-type
+                  (fn [e] (put! c e)))
+   c))
+
 (defn ^:private v [x y z]
   (js/THREE.Vector3. x y z))

+(defn ^:pivate animate [renderer camera scene t]
+  (.clear renderer)
+  (. camera (lookAt (.-position scene)))
+  (. renderer (render scene camera))
+  (. js/window (requestAnimationFrame (partial animate renderer camera scene) (.-domElement renderer))))

 ;; ref: http://bl.ocks.org/phil-pedruco/9852362
 (defcomponent plot-view
   [app owner]
   (init-state
    [_]
-   (let [w 960 h 500
+   (let [w 950 h 500
          line-geo (js/THREE.Geometry.)
          line-material (js/THREE.LineBasicMaterial.  (clj->js  {:color 0x000000
                                                                 :lineWidth 2}))]
@@ -42,6 +60,9 @@
       :h h
       :shadow-datoms (atom [])
       :datoms (atom [])
+      :sx 0
+      :sy 0
+      :down false
       }))
   (will-mount
    [_]
@@ -54,54 +75,48 @@
                  x-event (-> d3 (.extent datoms #(:x %)))
                  y-event (-> d3 (.extent datoms #(:y %)))
                  z-event (-> d3 (.extent datoms #(:z %)))
-                 x-scale (-> d3 .-scale (.linear) (.domain x-event) (.range [0 100]))
-                 y-scale (-> d3 .-scale (.linear) (.domain y-event) (.range [0 100]))
-                 z-scale (-> d3 .-scale (.linear) (.domain z-event) (.range [0 100]))
+                 x-scale (-> d3 .-scale (.linear) (.domain x-event) (.range [-50 50]))
+                 y-scale (-> d3 .-scale (.linear) (.domain y-event) (.range [-50 50]))
+                 z-scale (-> d3 .-scale (.linear) (.domain z-event) (.range [-50 50]))
                  vpts {:x-max (nth x-event 1)
-                       :x-center (/ (+ (nth x-event 1)
-                                       (nth x-event 0)) 2)
+                       :x-cen (/ (+ (nth x-event 1)
+                                    (nth x-event 0)) 2)
                        :x-min (nth x-event 0)
                        :y-max (nth y-event 1)
-                       :y-center (/ (+ (nth y-event 1)
-                                       (nth y-event 0)) 2)
+                       :y-cen (/ (+ (nth y-event 1)
+                                    (nth y-event 0)) 2)
                        :y-min (nth y-event 0)
                        :z-max (nth z-event 1)
-                       :z-center (/ (+ (nth z-event 1)
-                                       (nth z-event 0)) 2)
+                       :z-cen (/ (+ (nth z-event 1)
+                                    (nth z-event 0)) 2)
                        :z-min (nth z-event 0)}
-                 vs [(v (x-scale (:x-min vpts)) (y-scale (:y-center vpts)) (z-scale (:z-center vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-center vpts)) (z-scale (:z-center vpts)))
-                     (v (x-scale (:x-center vpts)) (y-scale (:y-min vpts)) (z-scale (:z-center vpts))) (v (x-scale (:x-center vpts)) (y-scale (:y-max vpts)) (z-scale (:z-center vpts)))
-                     (v (x-scale (:x-center vpts)) (y-scale (:y-center vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-center vpts)) (y-scale (:y-center vpts)) (z-scale (:z-min vpts)))
-
+                 vs [(v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-cen vpts)))
+                     (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
+                     (v (x-scale (:x-cen vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
-
-                     (v (x-scale (:x-min vpts)) (y-scale (:y-center vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-center vpts)) (z-scale (:z-max vpts)))
-                     (v (x-scale (:x-min vpts)) (y-scale (:y-center vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-center vpts)) (z-scale (:z-min vpts)))
-                     (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-center vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-center vpts)))
-                     (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-center vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-center vpts)))
-
+                     (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
+                     (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts)))
+                     (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
+                     (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts)))
                      (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
                      (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-
-                     (v (x-scale (:x-center vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-                     (v (x-scale (:x-center vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-                     (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-center vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-                     (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-center vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
-
+                     (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
+                     (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
+                     (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
+                     (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-cen vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-cen vpts)))
                      (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
                      (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-max vpts)) (z-scale (:z-max vpts)))
                      (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
-
-                     (v (x-scale (:x-min vpts)) (y-scale (:y-center vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-center vpts)) (z-scale (:z-max vpts)))
-                     (v (x-scale (:x-max vpts)) (y-scale (:y-center vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-center vpts)) (z-scale (:z-max vpts)))
-                     (v (x-scale (:x-center vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-center vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
-                     (v (x-scale (:x-center vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-center vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
+                     (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-min vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
+                     (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-max vpts)) (y-scale (:y-cen vpts)) (z-scale (:z-max vpts)))
+                     (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-max vpts)) (z-scale (:z-min vpts)))
+                     (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-min vpts))) (v (x-scale (:x-cen vpts)) (y-scale (:y-min vpts)) (z-scale (:z-max vpts)))
                      ]]
              (println vpts)
              (.log js/console (count vs))
@@ -137,8 +152,49 @@
                  (.log js/console camera)
                  (. camera (lookAt (.-position scene)))
                  (. renderer (render scene camera))
+                 (let [down (chan)
+                       up (chan)
+                       move (chan)
+                       ]
+                   (events->chan js/window EventType.MOUSEDOWN down)
+                   (events->chan js/window EventType.MOUSEUP up)
+                   (events->chan js/window EventType.MOUSEMOVE move)
+                   (go-loop [[event c] (alts! [down up move])]
+                     (.log js/console event)
+                     (.log js/console "up: " (= up c))
+                     (.log js/console "down: " (= down c))
+                     (.log js/console "move: " (= move c))
+                     (.log js/console "c: " c)
+                     (condp = c
+                       down (do
+                              (log/fine l "DOWN")
+                              (om/set-state! owner :down true)
+                              (om/set-state! owner :sx (.-clientX event))
+                              (om/set-state! owner :sy (.-clientY event)))
+                       up (do
+                            (log/fine l "UP")
+                            (om/set-state! owner :down false))
+                       move (when (om/get-state owner :down)
+                              (println (om/get-state owner))
+                              (let [{:keys [sx sy]} (om/get-state owner)
+                                    dx (- (.-clientX event) sx)
+                                    dy (- (.-clientY event) sy)]
+                                (.log js/console sx sy)
+                                (.log js/console dx dy)
+                                (.log js/console (aget scatter-plot "rotation" "y"))
+                                (aset scatter-plot "rotation" "y" (+ (aget scatter-plot "rotation" "y") (* dx 0.01)))
+                                (aset camera "position" "y" (+ (aget camera "position" "y") dy))
+                                (om/set-state! owner :sx (+ sx dx))
+                                (om/set-state! owner :sy (+ sy dy))
+                                ))
+                       (log/warning l "nothing!"))
+                     (recur (alts! [down up move])))
+                   )
+
+
                  (.log js/console renderer)
                  (.log js/console (.-info renderer))
+                 (animate renderer camera scene (.getTime (js/Date.)))
                  )))
            ))))
   (render-state


asserting password less sudo

asserting password less sudo

--- src/vc/guest.clj
+++ src/vc/guest.clj
@@ -15,10 +15,10 @@
     com.vmware.vim25.GuestProgramSpec
     com.vmware.vim25.GuestFileAttributes)
   (:require
+    [slingshot.slingshot :refer  [throw+ try+]]
     [clj-http.client :as client])
   (:use
     [clojure.string :only (join split)]
-    [slingshot.slingshot :only  [throw+]]
     [celestial.provider :only (wait-for)]
     [celestial.common :only (gen-uuid import-logging)]
     [clostache.parser :only (render-resource)]
@@ -84,16 +84,28 @@
          (when-not (= (exit-code m pid auth) 0)
            (throw+ {:type ::vc:guest-run-fail :message (<< "Failed running ~{cmd} ~{args} in guest") :timeout timeout})))))

-(defn fetch-log
+(defn- fetch-log
    "fetched remote log file by uuid"
    [hostname uuid auth]
   (slurp (download-file (<< "/tmp/run-~{uuid}.log") hostname auth)))
+
+(defn assert-sudo
+  "validates passwordless sudo if required"
+  [hostname auth uuid]
+  (when (auth :sudo)
+    (trace "checking passwordless sudo")
+    (try+
+      (guest-run hostname "/usr/bin/sudo" "-n true" (dissoc auth :sudo) uuid [2 :seconds])
+      (catch [:type ::vc:guest-run-fail] e
+        (throw+ {:type ::vc:guest-sudo :message (<< "guest system does not have password less sudo user set!")}))
+      )))

 (defn set-ip
   "set guest static ip"
   [hostname auth config]
   (let [uuid (gen-uuid) tmp-file (<< "/tmp/intrefaces_~{uuid}")]
     (debug "setting up guest static ip")
+    (assert-sudo hostname auth uuid)
     (upload-file (render-resource "static-ip.mustache" (update-in config [:names] (partial join ","))) tmp-file hostname auth)
     (guest-run hostname "/bin/cp" (<< "-v ~{tmp-file} /etc/network/interfaces") auth uuid [2 :seconds])
     (guest-run hostname "/usr/sbin/service" "networking restart" auth uuid [3 :seconds])
@@ -104,7 +116,7 @@

 (comment
   (set-ip "red1" {:user "ronen" :password "foobar" :sudo true}
-     {:ip "192.168.5.91" :mask "255.255.255.0" :network "192.168.5.0" :gateway "192.168.5.1" :search "local" :names ["192.168.5.1"]})
+          {:ip "192.168.5.91" :mask "255.255.255.0" :network "192.168.5.0" :gateway "192.168.5.1" :search "local" :names ["192.168.5.1"]})
   (download-file "/tmp/project.clj" "/tmp/project.clj" "foo" {:user "root" :pass "foobar"})
   (upload-file "project.clj" "/tmp/project.clj" "red1" {:user "ronen" :pass "foobar"})
   (download-file "/tmp/project.clj" "/tmp/project.clj" "foo" {:user "ronen" :pass "foobar"})


upgraded read-test to use chunk-tap.

upgraded read-test to use chunk-tap.

--- src/clj/forma/hadoop/jobs/load_tseries.clj
+++ src/clj/forma/hadoop/jobs/load_tseries.clj
@@ -1,6 +1,6 @@
 (ns forma.hadoop.jobs.load-tseries
   (:use cascalog.api
-        [forma.hadoop.io :only (globhfs-seqfile)])
+        [forma.hadoop.io :only (chunk-tap)])
   (:require [cascalog.ops :as c])
   (:gen-class))

@@ -17,7 +17,7 @@
   "Takes in a path and a number of pieces, and performs a test
   operation on all tuples matching the glob."
   [path & pieces]
-  (let [source (globhfs-seqfile (apply chunk-globstring path pieces))]
+  (let [source (apply chunk-tap path pieces)]
     (?<- (stdout)
          [?dataset ?tilestring ?date ?count]
          (source ?dataset ?s-res ?t-res ?tilestring ?date ?chunkid ?chunk)


Get the client to build real Initiate packet (WIP)

It's going through the motions, at least. Mostly.

There are at least 3 fairly nasty broken pieces in here:

1. The server handshake-test just throws a StackOverflow error that
looks like it's caused by nrepl trying to print a recursive data
structure.
2. The Initiate packet it sends to the server has the packet envelope as
its :message member.
3. The :message member inside the nested envelope is a log/state instead
of a byte-array
4. The Initiate Packet builder code tries to get the server name from a
key that doesn't match where the value is found in that map. This isn't
as straightforward as it should be, because the key that's being used
doesn't make sense.

Still, this is forward progress. There are enough changes in here that I
wanted to get it logged in as a milestone.

--- src/clojure/frereth_cp/client/initiate.clj
+++ src/clojure/frereth_cp/client/initiate.clj
@@ -29,10 +29,11 @@
                                              ::shared/packet-management
                                              ::state/shared-secrets
                                              ::shared/work-area]))
-(s/def ::vouch-built (s/keys :req [::K/inner-i-nonce
+(s/def ::vouch-built (s/keys :req [::specs/inner-i-nonce
                                    ::log/state
-                                   ::state/vouch]))
-(s/def ::vouch bytes?)
+                                   ::specs/vouch]))
+(s/def ::vouch (s/and ::crypto-box
+                      #(= (count %) K/vouch-length)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Internal
@@ -45,40 +46,47 @@
 (defn build-initiate-interior
   "This is the 368+M cryptographic box that's the real payload/Vouch+message portion of the Initiate pack"
   [{log-state ::log/state
+    inner-nonce-suffix ::specs/inner-i-nonce
+    :keys [::shared/work-area]
     :as this} msg outer-nonce-suffix]
   ;; Important detail: we can use up to 640 bytes that we've
   ;; received from the client/child.
   (let [msg-length (count msg)
         _ (assert (< 0 msg-length))
         tmplt (assoc-in K/vouch-wrapper [::K/child-message ::K/length] msg-length)
-        srvr-name (get-in this [::shared/my-keys ::specs/srvr-name])
-        _ (assert srvr-name)
-        inner-nonce-suffix (::state/inner-i-nonce this)
-        ^TweetNaclFast$Box$KeyPair long-pair (get-in this [::shared/my-keys ::shared/long-pair])
-        src {::K/client-long-term-key (.getPublicKey long-pair)
-             ::K/inner-i-nonce inner-nonce-suffix
-             ::K/inner-vouch (::state/vouch this)
-             ::specs/srvr-name srvr-name
-             ::K/child-message msg}
-        work-area (::shared/work-area this)
-        secret (get-in this [::state/shared-secrets ::state/client-short<->server-short])
-        log-state (log/info log-state
-                            ::build-initiate-interior
-                            "Encrypting\nFIXME: Do not log the shared secret!"
-                            {::source src
-                             ::inner-nonce-suffix (b-t/->string inner-nonce-suffix)
-                             ::shared-secret (b-t/->string secret)})]
-    {::crypto-box (crypto/build-crypto-box tmplt
-                                           src
-                                           (::shared/text work-area)
-                                           secret
-                                           K/initiate-nonce-prefix
-                                           outer-nonce-suffix)
-     ::log/state log-state}))
+        ;; This is actually ::K/server-name.
+        ;; Which doesn't make any sense, since it isn't a constant.
+        ;; FIXME: Make it sensible.
+        srvr-name (get-in this [::shared/my-keys ::specs/srvr-name])]
+    (if srvr-name
+      (let [^TweetNaclFast$Box$KeyPair long-pair (get-in this [::shared/my-keys ::shared/long-pair])
+            src {::K/client-long-term-key (.getPublicKey long-pair)
+                 ::specs/inner-i-nonce inner-nonce-suffix
+                 ::K/inner-vouch (::specs/vouch this)
+                 ::specs/srvr-name srvr-name
+                 ::K/child-message msg}
+            secret (get-in this [::state/shared-secrets ::state/client-short<->server-short])
+            log-state (log/info log-state
+                                ::build-initiate-interior
+                                "Encrypting\nFIXME: Do not log the shared secret!"
+                                {::source src
+                                 ::inner-nonce-suffix (b-t/->string inner-nonce-suffix)
+                                 ::shared-secret (b-t/->string secret)})]
+        {::crypto-box (crypto/build-crypto-box tmplt
+                                               src
+                                               (::shared/text work-area)
+                                               secret
+                                               K/initiate-nonce-prefix
+                                               outer-nonce-suffix)
+         ::log/state log-state})
+      {::log/state (log/warn log-state
+                             ::build-initiate-interior
+                             "Missing server name"
+                             (select-keys this [::shared/my-keys]))})))

 (s/fdef build-initiate-packet!
         :args (s/cat :this ::state/state
-                     :msg-bytes (s/and bytes?
+                     :msg-bytes (s/and ::specs/msg-bytes
                                        ;; Just be explicit about the
                                        ;; the legal incoming length.
                                        ;; This is mostly for the sake of
@@ -104,7 +112,7 @@
 (defn build-initiate-packet!
   "Combine message buffer and client state into an Initiate packet

-This was destructive in the sense that it overwrites ::shared/work-area
+This is destructive in the sense that it overwrites ::shared/work-area
 FIXME: Change that"
   [this msg-bytes]
   (let [{log-state ::log/state
@@ -115,9 +123,11 @@
       ;; It kind-of made sense with the original approach, which involved
       ;; locking down strict access from a single thread, using an agent.
       ;; Note that this approach is worse than I thought at first glance:
-      ;; I'm really just reusing the last-used nonce.
-      ;; That seems wrong all around.
-      ;; c.f. lines 329-334.
+      ;; I'm really just reusing the last-used nonce (which, in theory,
+      ;; should be the one sent by the server for its cookie).
+      ;; That seems wrong all around. After all, the client can send Initiate
+      ;; packets any time it likes.
+      ;; c.f. lines 329-334 in the reference spec.
       (let [working-nonce (byte-array K/nonce-length)
             ;; Just reuse a subset of whatever the server sent us.
             ;; Legal because a) it uses a different prefix and b) it's a different number anyway
@@ -125,32 +135,41 @@
             nonce-suffix (b-t/sub-byte-array working-nonce
                                              K/client-nonce-prefix-length)
             {:keys [::crypto-box]
-             log-state ::log/state} (build-initiate-interior this msg nonce-suffix)
-            log-state (log/info log-state
-                                ::build-initiate-packet!
-                                "Stuffing crypto-box into Initiate packet"
-                                {::crypto-box (b-t/->string crypto-box)
-                                 ::message-length (count crypto-box)})
-            dscr (update-in K/initiate-packet-dscr
-                            [::K/vouch-wrapper ::K/length]
-                            +
-                            (count msg))
-            ^TweetNaclFast$Box$KeyPair short-pair (get-in this [::shared/my-keys ::shared/short-pair])
-            fields #:frereth-cp.shared.constants{:prefix K/initiate-header
-                                                 :srvr-xtn (::state/server-extension this)
-                                                 :clnt-xtn (::shared/extension this)
-                                                 :clnt-short-pk (.getPublicKey short-pair)
-                                                 :cookie (get-in this [::state/server-security ::state/server-cookie])
-                                                 :outer-i-nonce nonce-suffix
-                                                 :vouch-wrapper crypto-box}]
-        {::specs/byte-buf
-         (serial/compose dscr
-                         fields)
-         ::log/state log-state})
+             log-state ::log/state
+             :as initiate-interior} (build-initiate-interior this msg nonce-suffix)]
+        (if crypto-box
+          (let [log-state (log/info log-state
+                                    ::build-initiate-packet!
+                                    "Stuffing crypto-box into Initiate packet"
+                                    {::crypto-box (when crypto-box
+                                                    (b-t/->string crypto-box))
+                                     ::message-length (count crypto-box)})
+                dscr (update-in K/initiate-packet-dscr
+                                [::K/vouch-wrapper ::K/length]
+                                +
+                                (count msg))
+                ^TweetNaclFast$Box$KeyPair short-pair (get-in this [::shared/my-keys ::shared/short-pair])
+                fields #:frereth-cp.shared.constants{:prefix K/initiate-header
+                                                     :srvr-xtn (::state/server-extension this)
+                                                     :clnt-xtn (::shared/extension this)
+                                                     :clnt-short-pk (.getPublicKey short-pair)
+                                                     :cookie (get-in this [::state/server-security ::state/server-cookie])
+                                                     :outer-i-nonce nonce-suffix
+                                                     :vouch-wrapper crypto-box}]
+            {::specs/byte-buf
+             (serial/compose dscr
+                             fields)
+             ::log/state log-state})
+          {::log/state (log/warn log-state
+                                 ::build-initiate-packet!
+                                 "Building initiate-interior failed to generate a crypto-box"
+                                 {::problem (dissoc initiate-interior
+                                                    ::log/state)})}))
       {::log/state log-state})))

 (s/fdef do-send-vouch
-        :args (s/cat :this ::state/state)
+        :args (s/cat :this ::state/state
+                     :message ::specs/msg-bytes)
         :ret (s/merge ::state/state
                       (s/keys :req [::specs/deferred])))
 (defn do-send-vouch
@@ -177,48 +196,55 @@
   ;; It would be very easy to just wait
   ;; for its minute key to definitely time out, though that seems
   ;; like a naive approach with a terrible user experience.
-  [this]
-  (let [{log-state ::log/state
-         :keys [::log/logger]
-         packet ::state/vouch} this
-        log-state (log/flush-logs! logger log-state)
-        this (assoc this ::log/state log-state)
-        {log-state ::log/state
-         deferred ::specs/deferred}
-        ;; FIXME: Instead of this, have HELLO set up a partial or lexical closure
-        ;; that we can use to send packets.
-        ;; Honestly, most of what I'm passing along in here is overkill that
-        ;; I set up for debugging.
-        (state/do-send-packet this
-                              (fn [success]
-                                (log/flush-logs! logger
-                                                 (log/info log-state
-                                                           ::do-send-vouch
-                                                           "Initiate packet sent.\nWaiting for 1st message"
-                                                           {::success success}))
-                                (state/final-wait this success))
-                              (fn [failure]
-                                ;; Extremely unlikely, but
-                                ;; just for the sake of paranoia
-                                (log/flush-logs! logger
-                                                 (log/exception log-state
-                                                                ;; Q: Am I absolutely positive that this will
-                                                                ;; always be an exception?
-                                                                ;; A: Even if it isn't the logger needs to be
-                                                                ;; able to cope with other problems
-                                                                failure
-                                                                ::do-send-vouch
-                                                                "Sending Initiate packet failed!"
-                                                                {::problem failure}))
-                                (throw (ex-info "Failed to send cookie->vouch response"
-                                                (assoc this
-                                                       :problem failure))))
-                              (state/current-timeout this)
-                              ::sending-vouch-timed-out
-                              packet)]
+  [{log-state ::log/state
+    :keys [::log/logger]
+    :as this}
+   packet]
+  (if packet
+    (let [log-state (log/flush-logs! logger log-state)
+          this (assoc this ::log/state log-state)
+          {log-state ::log/state
+           deferred ::specs/deferred}
+          ;; FIXME: Instead of this, have HELLO set up a partial or lexical closure
+          ;; that we can use to send packets.
+          ;; (it's pretty close)
+          ;; Honestly, most of what I'm passing along in here is overkill that
+          ;; I set up for debugging.
+          (state/do-send-packet this
+                                (fn [success]
+                                  (log/flush-logs! logger
+                                                   (log/info log-state
+                                                             ::do-send-vouch
+                                                             "Initiate packet sent.\nWaiting for 1st message"
+                                                             {::success success}))
+                                  (state/final-wait this success))
+                                (fn [failure]
+                                  ;; Extremely unlikely, but
+                                  ;; just for the sake of paranoia
+                                  (log/flush-logs! logger
+                                                   (log/exception log-state
+                                                                  ;; Q: Am I absolutely positive that this will
+                                                                  ;; always be an exception?
+                                                                  ;; A: Even if it isn't the logger needs to be
+                                                                  ;; able to cope with other problems
+                                                                  failure
+                                                                  ::do-send-vouch
+                                                                  "Sending Initiate packet failed!"
+                                                                  {::problem failure}))
+                                  (throw (ex-info "Failed to send cookie->vouch response"
+                                                  (assoc this
+                                                         :problem failure))))
+                                (state/current-timeout this)
+                                ::sending-vouch-timed-out
+                                packet)]
+      (assoc this
+             ::log/state log-state
+             ::specs/deferred deferred))
     (assoc this
-           ::log/state log-state
-           ::specs/deferred deferred)))
+           ::log/state (log/warn log-state
+                                 ::do-send-vouch
+                                 "No message bytes to send")
+           ::specs/deferred (dfrd/success-deferred ::nothing-to-send))))

 (s/fdef build-inner-vouch
   :args (s/cat :this ::vouch-building-params)
@@ -282,36 +308,25 @@
                                        "(FIXME: Don't log the shared secret)")
                                   {::shared/working-nonce (b-t/->string working-nonce)
                                    ::state/shared-secret (b-t/->string shared-secret)
-                                   ::state/vouch (b-t/->string vouch)})]
+                                   ::specs/vouch (b-t/->string vouch)})]
             (b-t/byte-copy! vouch
                             0
                             (+ K/box-zero-bytes K/key-length)
                             encrypted)
-            {::K/inner-i-nonce nonce-suffix
+            {::specs/inner-i-nonce nonce-suffix
              ::log/state log-state
-             ::state/vouch vouch})
+             ::specs/vouch vouch})
           (throw (ex-info "Missing long-term shared keys"
                           {::problem shared-secrets}))))
       (assert false (str "Missing nonce in packet-management:\n"
                          (keys packet-management))))))

-(s/fdef build-vouch
-        :args (s/cat :this ::state/state
-                     :message bytes?)
-        :ret (s/keys :req [::state/state ::vouch]))
-(defn build-vouch
-  [this
-   ^bytes message]
-  (let [{log-state ::log/state
-         :keys [::K/inner-i-nonce ::state/vouch]
-         :as this} (build-inner-vouch this)]
-    (throw (RuntimeException. "Need to build/return the rest of the nonce"))))
-
-(s/fdef cookie->vouch
+(s/fdef cookie->initiate
         :args (s/cat :this ::state/state
                      :packet ::shared/network-packet)
-        :ret ::state/state)
-(defn cookie->vouch
+        :ret (s/keys :req [::log/state]
+                     :opt [::specs/byte-buf]))
+(defn cookie->initiate
   "Got a cookie from the server.

   Replace those bytes
@@ -340,10 +355,13 @@
         ;; This is especially important before the Server
         ;; has responded with its first Message so the client
         ;; can switch to sending those.
-        {this ::state/state
-         vouch ::vouch} (build-vouch (assoc this
-                                            ::log/state log-state))]
-    (throw (RuntimeException. "Still need to build the rest of the Initiate packet"))))
+        {log-state ::log/state
+         vouch ::vouch} (build-inner-vouch (assoc this
+                                                  ::log/state log-state))]
+    (build-initiate-packet! (assoc this
+                                   ::log/state log-state
+                                   ::specs/inner-i-vouch vouch)
+                            cookie-packet)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Public
@@ -383,18 +401,17 @@
           ;; and the packet to send.
           ;; And we shouldn't send it any more of `this` than
           ;; it absolutely needs
-          this (cookie->vouch (assoc this ::log/state log-state)
-                              cookie-packet)
-          this (update this
-                       ::log/state
-                       #(log/debug %
-                                   ::build-and-send-vouch!
-                                   "cookie converted to vouch"))]
+          ;; TODO: Those changes
+          {byte-buf ::specs/byte-buf
+           log-state ::log/state} (cookie->initiate (assoc this ::log/state log-state)
+                                                    cookie-packet)]
       (try
         ;; FIXME: Debug only
-        (println "Client built Initiate/Vouch. Sending it")
-        (throw (RuntimeException. ""))
-        (let [base-result (do-send-vouch this)]
+        (println "Client built Initiate/Vouch. Sending" byte-buf)
+        (let [base-result (do-send-vouch (assoc this
+                                                ::log/state
+                                                log-state)
+                                         byte-buf)]
           (update base-result ::log/state #(log/flush-logs! logger %)))
         (catch Exception ex
           (update this


Fix clojureql's shadowing of clojure.core functions

This causes a problem with a persistent compilation process, like swank,
wherein it can't determine which is the correct implementation of a function
that is imported from 2 different namespaces without a prefix. Since clojureql
uses function names like "conj!" and "distinct" that also exist in
clojure.core, there's no good way for the compiler to determine which function
is being referred to in the code.

I've implemented a temporary fix, which is to simply exclude all overlapping
functions from clojure.core.

Signed-off-by: Deepak Giridharagopal <d11186354d1ef01ca06ae37d7e23e827da13e85f@puppetlabs.com>

--- src/com/puppetlabs/cmdb/query/resource.clj
+++ src/com/puppetlabs/cmdb/query/resource.clj
@@ -1,4 +1,5 @@
 (ns com.puppetlabs.cmdb.query.resource
+  (:refer-clojure :exclude [case compile conj! distinct disj! drop sort take])
   (:require [com.puppetlabs.utils :as utils]
             [clojure.contrib.logging :as log]
             [cheshire.core :as json]
@@ -64,7 +65,7 @@
   (let [hashes (sql/with-connection db
                    (->> (query-to-vec query)
                         (map :hash)))]
-    ; We have to special-case this or we get invalid queries generated later :(
+    ;; We have to special-case this or we get invalid queries generated later
     (if (empty? hashes)
       []
       (let [resources (future


Capitalize Datomic

Capitalize Datomic

--- src/com/wsscode/pathom/connect/datomic.clj
+++ src/com/wsscode/pathom/connect/datomic.clj
@@ -24,7 +24,7 @@
   {::db (d/db conn)})

 (defn db->schema
-  "Extracts the schema from a datomic db."
+  "Extracts the schema from a Datomic db."
   [db]
   (->> (d/q '[:find [(pull ?e [*]) ...]
               :where
@@ -104,7 +104,7 @@
          p/ast->query)))

 (defn pick-ident-key
-  "Figures which key to use to request data from datomic. This will
+  "Figures which key to use to request data from Datomic. This will
   try to pick :db/id if available, returning the number directly.
   Otherwise will look for some attribute that is a unique and is on
   the map, in case of multiple one will be selected by random. The
@@ -124,7 +124,7 @@
   {::schema-keys (into #{:db/id} (keys schema))})

 (defn datomic-resolve
-  "Runs the resolver to fetch datomic data from identities."
+  "Runs the resolver to fetch Datomic data from identities."
   [{::keys [db]
     :as    config}
    env]
@@ -149,13 +149,13 @@

 (defn entity-subquery
   "Using the current :query in the env, compute what part of it can be
-  delegated to datomic."
+  delegated to Datomic."
   [{:keys [query] :as env}]
   (let [subquery (filter-subquery (assoc env ::p/parent-query query ::p/entity {:db/id nil}))]
     (cond-> subquery (not (seq subquery)) (conj :db/id))))

 (defn query-entities
-  "Use this helper from inside a resolver to run a datomic query.
+  "Use this helper from inside a resolver to run a Datomic query.

   You must send dquery using a datalog map format. The :find section
   of the query will be populated by this function with [[pull ?e SUB_QUERY] '...].
@@ -179,7 +179,7 @@
           :not-in/datomic
           [:country/name]}]}]

-  The sub-query will be send to datomic, filtering out unsupported keys
+  The sub-query will be send to Datomic, filtering out unsupported keys
   like `:not-in/datomic`."
   [{::keys [db] :as env} dquery]
   (let [subquery (entity-subquery env)]
@@ -187,7 +187,7 @@
       db)))

 (defn query-entity
-  "Like query-entities, but returns a single result. This leverage datomic
+  "Like query-entities, but returns a single result. This leverage Datomic
   single result :find, meaning it is effectively more efficient than query-entities."
   [{::keys [db] :as env} dquery]
   (let [subquery (entity-subquery env)]


heed :only/:exclude in option preprocessing.

--- src/leiningen/ancient/artifact/options.clj
+++ src/leiningen/ancient/artifact/options.clj
@@ -68,22 +68,28 @@
   [{:keys [dependencies?
            plugins?
            profiles?
-           check-clojure?]
+           check-clojure?
+           only
+           exclude]
     :or {dependencies? true
          profiles? true
          check-clojure? false}}]
-  (let [spec {:dependencies dependencies?
-              :plugins      plugins?
-              :profiles     profiles?
-              :clojure      check-clojure?}]
-    (reduce
-      (fn [result [k include?]]
-        (update-in
-          result
-          [(if include? :include :exclude)]
-          (fnil conj #{})
-          k))
-      {} spec)))
+  (if (or (seq only) (seq exclude))
+    (cond-> {}
+      (seq only) (assoc :include [only])
+      (seq exclude) (assoc :exclude [exclude]))
+    (let [spec {:dependencies dependencies?
+                :plugins      plugins?
+                :profiles     profiles?
+                :clojure      check-clojure?}]
+      (reduce
+        (fn [result [k include?]]
+          (update-in
+            result
+            [(if include? :include :exclude)]
+            (fnil conj #{})
+            k))
+        {} spec))))

 (defn options
   "Prepare the option map."


Update copyright notice in source

Update copyright notice in source

--- src/main/clojure/clojure/data/json_new.clj
+++ src/main/clojure/clojure/data/json_new.clj
@@ -1,4 +1,4 @@
-;; Copyright (c) Stuart Sierra, 2010. All rights reserved.  The use
+;; Copyright (c) Stuart Sierra, 2012. All rights reserved.  The use
 ;; and distribution terms for this software are covered by the Eclipse
 ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
 ;; which can be found in the file epl-v10.html at the root of this


Minimal cosmetic change

Minimal cosmetic change

--- src/main/clojure/conexp/fca/algorithms.clj
+++ src/main/clojure/conexp/fca/algorithms.clj
@@ -219,7 +219,7 @@
           (.set D j false))))
     [C, D]))

-(defn vychodil-generate-from
+(defn- vychodil-generate-from
   [output, object-count, attribute-count, incidence-matrix, rows, ^BitSet A, ^BitSet B, y]
   (>!! output [A, B])
   (when (and (not (== attribute-count (.cardinality B)))
@@ -239,8 +239,6 @@
                               object-count attribute-count,
                               incidence-matrix rows,
                               C D (inc j)))))
-
-(alter-meta! (var vychodil-generate-from) assoc :private true)

 (defmethod concepts :vychodil
   [_ context]


implemented naive collision detection for circles -- delta update functions really needs refactoring


[scamp] "rand-probabilistic-nth*-test" doesn't need seeded randomness

--- modules/scamp/test/scamp/core_test.clj
+++ modules/scamp/test/scamp/core_test.clj
@@ -379,26 +379,24 @@

 (deftest rand-probabilistic-nth*-test
   (is (nil? (core/rand-probabilistic-nth* [] :dunno)))
-  (scamp-test
-   (fn rand-probabilistic-nth*-test* []
-     (let [n 100000
-           source-data {1 0.7
-                        2 0.2
-                        3 0.1}
-           coll (reduce (fn [r [k v]] (conj r {:nom k :weight v})) [] source-data)
-           randoms (repeatedly n #(:nom (core/rand-probabilistic-nth* coll :weight)))
-           group-counts (util/map-map (group-by identity randoms)
-                                      :val-fn count)
-           precision 1000
-           disclusive-max-error (* precision 0.02)]
-       (is (< (apply max
-                     (for [[group result] group-counts
-                           :let [expected (source-data group)]]
-                       (Math/abs (- precision
-                                    (* precision
-                                       (/ result (* expected n)
-                                          1.0))))))
-              disclusive-max-error))))))
+  (let [n 100000
+        source-data {1 0.7
+                     2 0.2
+                     3 0.1}
+        coll (reduce (fn [r [k v]] (conj r {:nom k :weight v})) [] source-data)
+        randoms (repeatedly n #(:nom (core/rand-probabilistic-nth* coll :weight)))
+        group-counts (util/map-map (group-by identity randoms)
+                                   :val-fn count)
+        precision 1000
+        disclusive-max-error (* precision 0.02)]
+    (is (< (apply max
+                  (for [[group result] group-counts
+                        :let [expected (source-data group)]]
+                    (Math/abs (- precision
+                                 (* precision
+                                    (/ result (* expected n)
+                                       1.0))))))
+           disclusive-max-error))))

 ;; TODO: set up a world with enough nodes to have some interesting upstream/downstream, maybe manaully set a couple to have shorter heartbeat-timeouts than the send-next-heartbeats-milli-time of everything else, so they unsubscribe and re-subscribe


RS | #89 | Make invite-writer-form a function

--- src/objective8/templates/invite_writer.clj
+++ src/objective8/templates/invite_writer.clj
@@ -9,7 +9,7 @@

 (def invite-writer-form-snippet (html/select pf/library-html-resource [:.clj-invite-a-writer-form]))

-(def invite-writer-form
+(defn invite-writer-form []
   (html/at invite-writer-form-snippet
            [:.clj-invite-a-writer-form] (html/prepend (html/html-snippet (anti-forgery-field)))))

@@ -22,7 +22,7 @@

 (defn invite-writer [{user :user :as context}]
   (if user
-    invite-writer-form
+    (invite-writer-form)
     (sign-in-to-invite-writer context)))

 (defn invite-writer-page [{:keys [data doc] :as context}]


serialize java.sql.Timestamp as ISO 8601 string

--- src/org/zalando/stups/friboo/system/db.clj
+++ src/org/zalando/stups/friboo/system/db.clj
@@ -20,7 +20,8 @@
   (:import (com.jolbox.bonecp BoneCPDataSource)
            (org.flywaydb.core Flyway)
            (java.sql Timestamp)
-           (java.io PrintWriter)))
+           (java.io PrintWriter)
+           (java.text SimpleDateFormat)))

 (defn start-component [component auto-migration?]
   (if (:datasource component)
@@ -69,7 +70,7 @@
 (defmacro def-db-component
   "Defines a new database component."
   [name & {:keys [auto-migration?]
-           :or {auto-migration? false}}]
+           :or   {auto-migration? false}}]
   ; 'configuration' must be provided during initialization
   ; 'datasource' is the internal state
   ; HINT: this component is itself a valid db-spec as its a map with the key 'datasource'
@@ -82,11 +83,15 @@
      (stop [this#]
        (stop-component this#))))

+(def iso-format "yyyy-MM-dd'T'HH:mm:ss.SSSZ")
+
 ; provide json serialization
 (defn- serialize-sql-timestamp
   "Serializes a sql timestamp to json."
   [^Timestamp timestamp #^PrintWriter out]
-  (.print out (json/write-str (str (int (/ (.getTime timestamp) 1000))))))
+  (.print out (-> (SimpleDateFormat. iso-format)
+                  (.format timestamp)
+                  (json/write-str))))

 ; add json capability to java.sql.Timestamp
 (extend Timestamp json/JSONWriter


Add clj-kondo to default profile

Add clj-kondo to default profile

- lein clj-kondo --lint src ## for linting

--- clojure/profiles.clj
+++ clojure/profiles.clj
@@ -1,3 +1,5 @@
 ;; https://github.com/technomancy/leiningen/blob/stable/doc/PROFILES.md
 {:user {:plugins [[lein-pprint "1.3.2"]]
-        :dependencies [[alembic "0.3.2"]]}}
+        :dependencies [[alembic "0.3.2"]
+                       [clj-kondo "RELEASE"]]
+        :aliases {"clj-kondo" ["run" "-m" "clj-kondo.main"]}}}


remove old test-handler macro

remove old test-handler macro

--- test/block_chain/message_handlers_test.clj
+++ test/block_chain/message_handlers_test.clj
@@ -31,48 +31,20 @@
    :local-port test-port
    :outgoing-port 51283})

-(defn test-server
-  ([port message-fn]
-   (let [handler (routes (fn [req]
-                           (message-fn (update req :body slurp))
-                           {:status 200}))]
-     (jetty/run-jetty handler {:port port :join? false}))))
-
-(defmacro with-test-handler
-  [bindings & body]
-  (cond
-    (= (count bindings) 0) `(do ~@body)
-    (symbol? (bindings 0)) `(let [~(bindings 0) (test-server test-port ~(bindings 1))]
-                              (try
-                                (. ~(bindings 0) start)
-                                (with-test-handler ~(subvec bindings 2) ~@body)
-                                (finally
-                                  (. ~(bindings 0) stop))))
-    :else (throw (IllegalArgumentException.
-                  "with-open only allows Symbols in bindings"))))
-
 (def peer-requests (atom {}))
 (defn peer-handler [req]
-  (swap! peer-requests
-         update
-         (:uri req)
-         conj
-         (update req :body slurp))
-  {:status 200})
-
-(def test-port-2 9001)
-(defn with-peer
-  [f]
+  (let [req (update req :body slurp)]
+    (swap! peer-requests update (:uri req) conj req)
+    {:status 200}))
+
+(defn with-peer [f]
+  (reset! peer-requests {})
   (let [p (jetty/run-jetty (routes peer-handler)
-                           {:port test-port-2 :join? false})]
+                           {:port test-port :join? false})]
     (try
       (f)
-      (finally (.stop p)))))
-
-(defn with-peer-reqs [f]
-  (reset! peer-requests {})
-  (f)
-  (reset! peer-requests {}))
+      (finally (do (.stop p)
+                   (reset! peer-requests {}))))))

 (defn with-db [f]
   (reset! db/db db/empty-db)
@@ -81,7 +53,7 @@
   (reset! db/transaction-pool #{})
   (reset! db/db db/empty-db))

-(use-fixtures :each with-db with-peer with-peer-reqs)
+(use-fixtures :each with-db with-peer)

 (deftest test-echo
   (let [msg {:message "echo"
@@ -174,7 +146,7 @@
   (miner/mine-and-commit-db)
   (is (= 0 (count @db/transaction-pool)))
   (let [txn (miner/generate-payment wallet/keypair (:address wallet/keypair) 25 (q/longest-chain @db/db))]
-    (handler {:message "add_peer" :payload {:port test-port-2}} sock-info)
+    (handler {:message "add_peer" :payload {:port test-port}} sock-info)
     ;; send same txn twice but should only get forwarded once
     (is (= {:message "transaction-accepted" :payload txn}
            (handler {:message "submit_transaction" :payload txn} sock-info)))
@@ -186,7 +158,7 @@

 (defn json-body [req] (read-json (:body req)))
 (deftest test-forwarding-mined-blocks-to-peers
-  (q/add-peer! db/db {:port test-port-2 :host "127.0.0.1"})
+  (q/add-peer! db/db {:port test-port :host "127.0.0.1"})
   (miner/mine-and-commit-db)
   (is (= 1 (q/chain-length @db/db)))
   (is (= 1 (count (mapcat val @peer-requests))))
@@ -202,7 +174,7 @@
     (is (= 1 (q/chain-length @db/db)))))

 (deftest test-forwarding-received-blocks-to-peers
-  (q/add-peer! db/db {:port test-port-2 :host "127.0.0.1"})
+  (q/add-peer! db/db {:port test-port :host "127.0.0.1"})
   (let [b (miner/mine (blocks/generate-block [(miner/coinbase)]))]
     (handler {:message "submit_block" :payload b} sock-info)
     (is (= 1 (q/chain-length @db/db)))
@@ -215,7 +187,7 @@
              (json-body req))))))

 (deftest test-forwards-received-block-to-peers-only-if-new
-  (q/add-peer! db/db {:port test-port-2 :host "127.0.0.1"})
+  (q/add-peer! db/db {:port test-port :host "127.0.0.1"})
   (let [b (miner/mine (blocks/generate-block [(miner/coinbase)]))]
     (is (= b (:payload (handler {:message "submit_block" :payload b} sock-info))))
     (is (= 1 (q/chain-length @db/db)))


adding type before actions

adding type before actions

--- test/celestial/integration/persistency.clj
+++ test/celestial/integration/persistency.clj
@@ -59,6 +59,7 @@

 (with-state-changes [(before :facts (clear-all))]
   (fact "basic actions usage" :integration :redis :actions
+        (p/add-type redis-type)
         (let [id (p/add-action redis-actions)]
           (p/get-action id) => redis-actions
           (p/get-action-index :operates-on "redis") => [(str id)]