thru rm_cfg_dsr_owner

thru rm_cfg_dsr_owner

--- src/pg_demo/table_defs.clj
+++ src/pg_demo/table_defs.clj
@@ -2595,7 +2595,7 @@
               REPORT_FORM_ID numeric,
               OWNER_ID numeric,
               DELETED timestamp,
-              PRIMARY KEY (ENTERPRISE_ID,"ID")
+              PRIMARY KEY (ENTERPRISE_ID,ID)
           ); " }

   ] ))


Adding logging of database connection info when we can't get a connection to the database.

--- oracle-lib/src/cmr/oracle/connection.clj
+++ oracle-lib/src/cmr/oracle/connection.clj
@@ -23,6 +23,12 @@
    :fcf-enabled fcf-enabled
    :ons-config ons-config})

+(defn- db-conn-info-safe-for-logging
+  "Returns the database connection info without password details"
+  [oracle-store]
+  (pr-str (-> oracle-store
+              :spec
+              (assoc :password "*****"))))

 (defn health-fn
   "Returns the health status of the database by executing some sql."
@@ -33,9 +39,7 @@
       {:ok? true}
       {:ok? false :problem "Could not select data from database."})
     (catch Exception e
-      (info "Database conn info" (pr-str (-> oracle-store
-                                             :spec
-                                             (assoc :password "*****"))))
+      (info "Database conn info" (db-conn-info-safe-for-logging oracle-store))
       {:ok? false :problem (.getMessage e)})))

 (defn health
@@ -48,6 +52,8 @@
   [oracle-store]
   (let [db-health (health oracle-store)]
     (when-not (:ok? db-health)
+      (error (str "Could not get successful health from oracle store: "
+                  (db-conn-info-safe-for-logging oracle-store)))
       (throw (Exception. (:problem db-health))))))

 (defn db->oracle-conn


make multiple sorting code more beautiful with (juxt a b)

--- frontend/src/cruncher/utils/lib.cljs
+++ frontend/src/cruncher/utils/lib.cljs
@@ -48,9 +48,8 @@

 (defmethod mutate 'sort/pokemon
   [{:keys [state]} _ {:keys [key]}]
-  {:action (fn [] (swap! state update-in [:pokemon] (fn [] (reverse (sort-by key
-    (sort-by :individual_percentage
-      (reverse (sort-by :cp (:pokemon @state)))))))))})
+  {:action (fn [] (swap! state update-in [:pokemon] (fn []
+    (reverse (sort-by (juxt key :individual_percentage :cp) (:pokemon @state))))))})

 (defmethod mutate 'change/view
   [{:keys [state]} _ {:keys [view]}]


realign containers when browser is resized

--- frontend/core.cljs
+++ frontend/core.cljs
@@ -164,9 +164,19 @@
     (sec/dispatch! (str (.getPath uri) (when-not (string/blank? (.getFragment uri))
                                          (str "#" (.getFragment uri)))))))

+(defn handle-browser-resize
+  "Handles scrolling the container on the build page to the correct position when
+  the size of the browser window chagnes. Has to add an event listener at the top level."
+  [app-state]
+  (goog.events/listen
+   js/window "resize"
+   #(when (= :build (:navigation-point @app-state))
+      (put! controls-ch [:container-selected (get-in @app-state [:current-build :current-container-id] 0)]))))
+
 (defn setup! []
   (main app-state (sel1 :body))
   (dispatch-to-current-location!)
+  (handle-browser-resize app-state)
   (when-let [user (:current-user @app-state)]
     (subscribe-to-user-channel user (get-in @app-state [:comms :ws])))
   (when (env/development?)


Fix kw.

Fix kw.

--- test/onyx/plugin/output_update_test.clj
+++ test/onyx/plugin/output_update_test.clj
@@ -104,7 +104,7 @@

 (def catalog
   [{:onyx/name :in
-    :onyx/plugin: :onyx.plugin.core-async/output
+    :onyx/plugin :onyx.plugin.core-async/output
     :onyx/type :input
     :onyx/medium :core.async
     :onyx/batch-size 1000
@@ -164,7 +164,6 @@

 (fact results => (map transform-word words))

-
 (close! update-in-chan)

 (doseq [v-peer v-peers]


Brackets.

Brackets.

--- test/onyx/peer/fault_tolerance.clj
+++ test/onyx/peer/fault_tolerance.clj
@@ -143,8 +143,8 @@
                          (if v
                            (recur (conj after-done v))
                            after-done)))]
-      (fact after-done => #{})
-      (fact @bad-values => #{}))
+      (fact after-done => #{}))
+      (fact @bad-values => #{})
     (close! kill-ch)
     #_(<!! mess-with-peers-ch))
   (finally


(SERVER-2550) Add testutils for generating revoked certs

This commit adds test utilities for generating and writing certificate chains
(and associated CRLS) that contain a revoked certificate. This will be used for
testing that upstream CRLs that revoke a CA cert are rejected.

--- test/puppetlabs/ssl_utils/testutils.clj
+++ test/puppetlabs/ssl_utils/testutils.clj
@@ -167,6 +167,23 @@
                   new-cert
                   new-key-pair)))))))

+(defn generate-cert-chain-with-revoked-cert
+  [number-of-certs]
+  (if (< number-of-certs 2)
+    (throw (Exception. (format "Can't perform revocations on a %d-cert chain."
+                               number-of-certs))))
+  (let [key-pair (generate-key-pair 2048)
+        [certs crls] (generate-cert-chain-with-crls number-of-certs
+                                                    generate-crl
+                                                    key-pair)
+        cert-to-revoke (nth certs (- number-of-certs 2))
+        crl-to-update (last crls)
+        updated-crl (revoke crl-to-update
+                            (get-private-key key-pair)
+                            (get-public-key key-pair)
+                            (get-serial cert-to-revoke))]
+    [certs (-> crls drop-last (conj updated-crl))]))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Writing test files

@@ -216,3 +233,10 @@
         crl-filename "crl-with-bad-signature.pem"
         [cert bad-crl] (generate-cert-chain-with-crls 1 generate-crl-with-bad-signature)]
     (write-certs-and-crls cert bad-crl test-subpath cert-filename crl-filename)))
+
+(defn write-cert-chain-with-revoked-cert
+  [number-of-certs test-subpath]
+  (let [certs-filename "cert-chain-with-revoked-cert.pem"
+        crls-filename "crl-chain-with-cert-revoked.pem"
+        [certs crls] (generate-cert-chain-with-revoked-cert number-of-certs)]
+    (write-certs-and-crls certs crls test-subpath certs-filename crls-filename)))


fetch environment variable only once

fetch environment variable only once

--- server/feed/src/feed/messaging_kafka.clj
+++ server/feed/src/feed/messaging_kafka.clj
@@ -7,10 +7,12 @@
                   "serializer.class" "kafka.serializer.DefaultEncoder"
                   "partitioner.class" "kafka.producer.DefaultPartitioner"})))

+(def messaging-enabled (= (System/getenv "MESSAGING_ENABLED") "true"))
+
 (defn log
   "log a message to topic via kafka"
   [topic entity operation duration]
-  (if (= (System/getenv "MESSAGING_ENABLED") "true")
+  (if messaging-enabled
     (let [now (java.util.Calendar/getInstance)
           msg (str (.get now java.util.Calendar/YEAR)
                    "|"


fix source-map file name

fix source-map file name

--- src/less4clj/core.clj
+++ src/less4clj/core.clj
@@ -176,7 +176,7 @@
 (defn less-compile-to-file [path target-dir relative-path options]
   (let [input-file (io/file path)
         output-file (io/file target-dir (string/replace relative-path #"\.main\.less$" ".css"))
-        source-map-output (io/file target-dir (string/replace relative-path #"\.main\.less$" ".main.css.map"))
+        source-map-output (io/file target-dir (string/replace relative-path #"\.main\.less$" ".css.map"))
         {:keys [output source-map] :as result} (less-compile input-file options)]
     (when output
       (io/make-parents output-file)


aot classes in cimi jar for jar-persistence

--- cimi/project.clj
+++ cimi/project.clj
@@ -72,6 +72,9 @@
    [org.clojure/test.check] ; FIXME: Needed for spec.gen.alpha. Fix "Could not locate clojure/test/check/generators__init.class"
    ]

+  :aot [com.sixsq.slipstream.ssclj.app.main
+        com.sixsq.slipstream.ssclj.util.userparamsdesc]
+
   :profiles
   {
    :provided {:aot [com.sixsq.slipstream.ssclj.app.main]}


ConversationManager component; removed ConvActor constructs; lots of simplification and updating for new mongo-stuff

--- src/polismath/conv_man.clj
+++ src/polismath/conv_man.clj
@@ -1,30 +1,20 @@
 (ns polismath.conv-man
+  "This is the namesascpe for the "
   (:require [polismath.math.named-matrix :as nm]
             [polismath.math.conversation :as conv]
             [polismath.math.clusters :as clust]
             [polismath.meta.metrics :as met]
-            [polismath.components.db :as db]
             [polismath.components.env :as env]
+            [polismath.components.mongo :as mongo]
             [polismath.utils :as utils]
             [clojure.core.matrix.impl.ndarray]
             [clojure.core.async :as async :refer [go go-loop <! >! <!! >!! alts!! alts! chan dropping-buffer put! take!]]
             [clojure.tools.trace :as tr]
             [clojure.tools.logging :as log]
+            [com.stuartsierra.component :as component]
             [plumbing.core :as pc]
             [schema.core :as s]
-            [monger.core :as mg]
-            [monger.collection :as mc]
-            [cheshire.core :as ch]
-            [cheshire.generate :refer [add-encoder encode-seq remove-encoder]]))
-
-
-(defn get-or-set!
-  "Either gets the key state of a collection atom, or sets it to a val"
-  [coll-atom key & [init-fn]]
-  (or (get @coll-atom key)
-      (do
-        (swap! coll-atom assoc key (init-fn))
-        (get-or-set! coll-atom key))))
+            ))

 (defn prep-bidToPid
@@ -61,32 +51,9 @@
         :group-votes})))

-(defn mongo-upsert-results
-  "Perform upsert of new results on mongo collection name"
-  [mongo config collection-name new-results]
-  (mc/update
-    ; Bleg; not the cleanest separation here; should at least try to make this something rebindable
-    (:db mongo)
-    (db/mongo-db (env/env :mongolab-uri))
-    collection-name
-    {:zid (or (:zid new-results) ; covering our bases for strings or keywords due to cheshire hack
-              (get new-results "zid"))}
-    new-results
-    {:upsert true}))
-
-
-(defn mongo-insert-results
-  "Perform insert to mongo collection by zid"
-  [collection-name object]
-  (mc/insert
-    (db/mongo-db (env/env :mongolab-uri))
-    collection-name
-    object))
-
-
 (defn handle-profile-data
   "For now, just log profile data. Eventually want to send to influxDB and graphite."
-  [conv & {:keys [recompute n-votes finish-time] :as extra-data}]
+  [conv-man conv & {:keys [recompute n-votes finish-time] :as extra-data}]
   (if-let [prof-atom (:profile-data conv)]
     (let [prof @prof-atom
           tot (apply + (map second prof))
@@ -96,7 +63,7 @@
             (assoc :n-ptps (:n conv))
             (merge (utils/hash-map-subset conv #{:n-cmts :zid :last-vote-timestamp})
                    extra-data)
-            ((partial mongo-insert-results (db/mongo-collection-name "profile"))))
+            (->> (mongo/insert (:mongo conv-man) (mongo/math-collection-name "profile"))))
         (catch Exception e
           (log/warn "Unable to submit profile data for zid:" (:zid conv))
           (.printStackTrace e)))
@@ -115,17 +82,20 @@
 (defn update-fn
   "This function is what actually gets sent to the conv-actor. In addition to the conversation and vote batches
   up in the channel, we also take an error-callback. Eventually we'll want to pass opts through here as well."
-  [conv votes error-callback]
-  (let [start-time (System/currentTimeMillis)]
+  [conv-man conv votes error-callback]
+  (let [start-time (System/currentTimeMillis)
+        mongo (:mongo conv-man)]
     (log/info "Starting conversation update for zid:" (:zid conv))
     (try
+      ;; Need to expose opts for conv-update through config... XXX
       (let [updated-conv   (conv/conv-update conv votes)
             zid            (:zid updated-conv)
             finish-time    (System/currentTimeMillis)
             ; If this is a recompute, we'll have either :full or :reboot, ow/ want to send false
             recompute      (if-let [rc (:recompute conv)] rc false)]
         (log/info "Finished computng conv-update for zid" zid "in" (- finish-time start-time) "ms")
-        (handle-profile-data updated-conv
+        (handle-profile-data conv-man
+                             updated-conv
                              :finish-time finish-time
                              :recompute recompute
                              :n-votes (count votes))
@@ -138,8 +108,11 @@
         ; Format and upload main results
         (doseq [[col-name prep-fn] [["main" prep-main] ; main math results, for client
                                     ["bidtopid" prep-bidToPid]]] ; bidtopid mapping, for server
-          (->> (db/format-for-mongo prep-fn updated-conv)
-               (mongo-upsert-results (db/mongo-collection-name col-name))))
+          ;; XXX Hmmm... format-for-mongo should be abstracted so that it always get's called, and the prep
+          ;; function gets taken care of separately; don't need to conplect these
+          (->> updated-conv
+               prep-fn
+               (mongo/zid-upsert mongo (mongo/collection-name mongo col-name))))
         (log/info "Finished uploading mongo results for zid" zid)
         ; Return the updated conv
         updated-conv)
@@ -153,6 +126,7 @@
         conv))))

+;; Maybe switch over to using this with arbitrary attrs map with zid and other data? XXX
 ;(defmacro try-with-error-log
   ;[zid message & body]
   ;`(try
@@ -162,11 +136,11 @@

 (defn build-update-error-handler
-  "Returns a clojure that can be called in case there is an update error. The closure gives access to
+  "Returns a closure that can be called in case there is an update error. The closure gives access to
   the queue so votes can be requeued"
-  [queue conv-actor]
+  [conv-man queue conv]
   (fn [votes start-time opts update-error]
-    (let [zid-str (str "zid=" (:zid @conv-actor))]
+    (let [zid-str (str "zid=" (:zid conv))]
       (log/error "Failed conversation update for" zid-str)
       (.printStackTrace update-error)
       ; Try requeing the votes that failed so that if we get more, they'll get replayed
@@ -174,6 +148,7 @@
       ; the conv-actor update?
       (try
         (log/info "Preparing to re-queue votes for failed conversation update for" zid-str)
+        ;; XXX Should we check if the queue got close due to error or manager close, and log?
         (async/go (async/>! queue [:votes votes]))
         (catch Exception qe
           (log/error "Unable to re-queue votes after conversation update failed for" zid-str)
@@ -182,13 +157,13 @@
       (try
         (let [end (System/currentTimeMillis)
               duration (- end start-time)]
-          ;; Update to use MetricSender component
-          (met/metric "math.pca.compute.fail" duration))
+          ;; Update to use MetricSender component XXX
+          (met/send-metric (:metrics conv-man) "math.pca.compute.fail" duration))
         (catch Exception e
           (log/error "Unable to send metrics for failed compute for" zid-str)))
       ; Try to save conversation state for debugging purposes
       (try
-        (conv/conv-update-dump @conv-actor votes opts update-error)
+        (conv/conv-update-dump conv votes opts update-error)
         (catch Exception e
           (log/error "Unable to perform conv-update dump for" zid-str))))))

@@ -217,7 +192,7 @@
 (defn load-or-init
   "Given a zid, either load a minimal set of information from mongo, or if a new zid, create a new conv"
   [zid & {:keys [recompute]}]
-  (if-let [conv (and (not recompute) (db/load-conv zid))]
+  (if-let [conv (and (not recompute) (mongo/load-conv zid))]
     (-> conv
         restructure-mongo-conv
         (assoc :recompute :reboot))
@@ -243,25 +218,6 @@
       (if (not= c :default)
         (recur (conj acc v))
         acc))))
-
-
-(defprotocol PActor
-  (snd [this votes]))
-
-
-(defrecord ConvActor [msgbox conv]
-  PActor
-  (snd [_ votes]
-    (>!! msgbox votes))
-  clojure.lang.IRef
-  (deref [_]
-    @conv))
-
-
-(defn add-conv-actor-watch
-  "Add a watcher to the atom holding state in a conv-actor"
-  [conv-actor key f]
-  (add-watch (:conv conv-actor) key f))

 (defn split-batches
@@ -277,29 +233,42 @@
                 (flatten))))))

-(defn new-conv-actor [init-fn & opts]
-  "Create a new conv actor which responds to snd. Messages should look like [<t> [...]], where <t> is either :votes or
-  :moderation, depending on what kind of batch is being sent/processed. Implements deref for state retrieval."
-  (let [msgbox (chan Long/MAX_VALUE) ; we want this to be as big as possible, since backpressure doesn't really work
-        conv (atom (init-fn)) ; keep track of conv state in atom so it can be dereffed
-        ca (ConvActor. msgbox conv)
-        err-handler (build-update-error-handler msgbox ca)]
-    ; Initialize the go loop which watches the mailbox, and runs updates all all pending messages when they
-    ; arrive
-    (go-loop []
-      (try
-        (let [first-msg (<! msgbox) ; do this so we park efficiently
-              msgs      (take-all! msgbox)
-              msgs      (concat [first-msg] msgs)
-              {votes :votes mods :moderation}
-                        (split-batches msgs)]
-          (when mods
-            (swap! conv conv/mod-update mods))
-          (swap! conv update-fn (or votes []) err-handler))
-        (catch Exception e
-          (log/error "Excpetion not handler by err-handler:" e)
-          (.printStackTrace e)))
-      (recur))
-    ca))
-
-
+(defrecord ConversationManager [config mongo metrics conversations]
+  component/Lifecycle
+  (start [component]
+    (let [conversations (atom {})]
+      (assoc component :conversations conversations)))
+  (stop [component]
+    ;; Close all our message channels for good measure
+    (doseq [[zid {:keys [message-chan]}] @conversations]
+      (async/close! message-chan))
+    ;; Not sure, but we might want this for GC
+    (reset! conversations nil)
+    (assoc component :conversations nil)))
+
+
+(defn queue-message-batch!
+  [{:keys [conversations] :as conv-man} message-type zid message-batch recompute]
+  (if-let [{:keys [conv message-chan]} (get @conversations zid)]
+    ;; Then we already have a go loop running for this
+    (>!! message-chan {:message-type message-type :message-batch message-batch})
+    ;; Then we need to initialize the conversation and set up the conversation channel and go routine
+    (let [conv (load-or-init zid :recompute recompute) ;; XXX recompute should be env var?
+          ;; XXX Need to set up message chan buffer as a env var
+          message-chan (chan 100000)]
+      (swap! conversations assoc zid {:conv conv :message-chan message-chan})
+      ;; However, we don't use the conversations atom conv state, but keep track of it explicitly in the loop,
+      ;; ensuring that we don't have race conditions for conv state. The state kept in the atom is basically
+      ;; just a convenience.
+      (go-loop [conv conv]
+        (let [first-msg (<! message-chan)
+              msgs (concat [first-msg] (take-all! message-chan))
+              {:keys [votes moderation]} (split-batches msgs)
+              error-handler (build-update-error-handler message-chan conv)
+              conv (-> conv
+                       (pc/?> moderation (conv/mod-update moderation))
+                       (pc/?> votes (update-fn votes error-handler)))]
+          (swap! conversations assoc-in [zid :conv] conv)
+          (recur conv))))))
+
+


Commented out sketch of the actual batch updates in last commit

--- src/polismath/intercom.clj
+++ src/polismath/intercom.clj
@@ -148,7 +148,11 @@
                            (map #(Integer/parseInt (get % "user_id")) icusers-by-id))
         dbusers-by-email (db/get-users-by-email
                            (map #(get % "email") icusers-by-email))
-        all-users        (into dbusers-by-id dbusers-by-email)]
+        all-users        (into dbusers-by-id dbusers-by-email)
+        ; User updates have to be batched, since there is a limit of 240 requests per one minute. Their API
+        ; suggests limiting batch size to </= 50.
+        batch-size       50
+        batched-users    (partition-all 50 all-users)]
     ; First some nice summary stats information
     (println "Total number of intercom users:" (count icusers))
     (println "Number of users with valid ids:" (count icusers-by-id))
@@ -165,6 +169,18 @@
       (println "Number of failed jobs:" (count failed-jobs))
       (doseq [[u _] failed-jobs]
         (println u)))
+    ; Stab at doing batched runs
+    ;(let [jobs (mapv
+                 ;(fn [us]
+                   ;[us
+                    ;(future
+                      ;(log/info "Running update for" (count us) "users:"
+                               ;(map (pc/fn-> (hash-map-subset [:uid :email :hname :created])) us))
+                      ;(update-icuser-from-dbuser! us))])
+                   ;batched-users)
+          ;failed-jobs (filterv (comp future-failed? second) jobs)]
+      ;(println "Number of failed jobs:" (count failed-jobs))
+      ;(println "Failed for users:" (apply concat (map first failed-jobs))))
     ; Call it a night
     (println "Done!")
     (shutdown-agents)))


replace 1 w -1 in cmnt projection

replace 1 w -1 in cmnt projection

--- src/polismath/math/pca.clj
+++ src/polismath/math/pca.clj
@@ -127,8 +127,7 @@
 (defn pca-project
   "Apply the principal component projection specified by pcs to the data"
   [data {:keys [comps center]}]
-  ; Here we map each row of data to it's projection
-  ; XXX - still need to verify this...
+  ; Here we map each row of data to its projection
   (matrix/mmul (- data center) (matrix/transpose comps)))

@@ -174,7 +173,7 @@
           (assoc
             (vec (repeat n-cols nil))
             i
-            1))
+            -1))
         (range n-cols))
       pca)))


consistent invalid

consistent invalid

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -172,7 +172,7 @@
                                                        (contains? selected-eids (:db/id layer)))
                                               "selected-group ")
                                             (when invalid?
-                                              "invalid-action"))
+                                              "invalid"))
                             :key (str "action-" (:db/id layer))))))))

 (defn svg-layers [{:keys [editing-eids selected-eid selected-eids tool]} owner]


removed unused styles

removed unused styles

--- src-cljs/frontend/components/signup.cljs
+++ src-cljs/frontend/components/signup.cljs
@@ -46,7 +46,7 @@
               [:div.status-bar.row
                [:div.col-xs-3.left.no-padding
                 [:div.success.circle [:i.fa.fa-check.fa-inverse]]
-                [:div.success.line.smaller-bottom-margin]]
+                [:div.success.line]]
                [:div.col-xs-6.middle.no-padding
                 [:div.line]
                 [:div.circle]


Add tech logos to search results.

Add tech logos to search results.

--- src-cljs/kixi/hecuba/tabs/hierarchy.cljs
+++ src-cljs/kixi/hecuba/tabs/hierarchy.cljs
@@ -252,7 +252,9 @@
        [:td (:programme_name cursor)]
        [:td (:project_name cursor)]
        [:td (:property_code cursor)]
-       [:td (slugs/postal-address property_data)]]))))
+       [:td (slugs/postal-address property_data)]
+       [:td.tech-icon-container-sm (for [ti (-> cursor :property_data :technology_icons)]
+                                     [:img {:src ti}])]]))))

 (defn search-results [cursor owner]
   (reify
@@ -277,7 +279,7 @@
                   [:table.table.table-hover.table-condensed
                    [:thead
                     [:tr [:th "Photo"] [:th "Programme Name"] [:th "Project Name"]
-                     [:th "Property ID"][:th "Address"]]]
+                     [:th "Property ID"][:th "Address"] [:th "Technologies"]]]
                    [:tbody
                     (om/build-all found-property-row data {:key :entity_id})]]
                   [:nav


tweak show-docs command to open only one doc

--- src/lt/objs/docs.cljs
+++ src/lt/objs/docs.cljs
@@ -35,8 +35,11 @@
 (cmd/command {:command :show-docs
               :desc "Docs: Open Light Table's documentation"
               :exec (fn []
-                      (let [docs (object/create ::docs)
-                            ts (tabs/spawn-tabset)]
-                        (tabs/equalize-tabset-widths)
-                        (tabs/add! docs ts)
-                        (tabs/active! docs)))})
+                      (if (empty? (object/by-tag :docs))
+                        (let [docs (object/create ::docs)
+                              ts (tabs/spawn-tabset)]
+                          (tabs/equalize-tabset-widths)
+                          (tabs/add! docs ts)
+                          (tabs/active! docs))
+                        (let [docs (first (object/by-tag :docs))]
+                          (tabs/add-or-focus! docs))))})


make-url preserves query string

make-url preserves query string

--- figwheel-repl/src/figwheel/repl.cljc
+++ figwheel-repl/src/figwheel/repl.cljc
@@ -313,9 +313,10 @@
       connect-url'))

 (defn make-url [connect-url']
-  (doto (guri/parse (fill-url-template (or connect-url' connect-url)))
-    (.setQueryData (cond-> (.add (QueryData.) "fwsid" (or (session-id) (random-uuid)))
-                     (session-name) (.add "fwsname" (session-name))))))
+  (let [uri (guri/parse (fill-url-template (or connect-url' connect-url)))]
+    (cond-> (.add (.getQueryData uri) "fwsid" (or (session-id) (random-uuid)))
+      (session-name) (.add "fwsname" (session-name)))
+    uri))

 (defn exponential-backoff [attempt]
   (* 1000 (min (js/Math.pow 2 attempt) 20)))


Gamepad connect/disconnect and state atom in infinitelives.utils.events. (install-gamepad-listener callback) to register a callback that takes [gamepad-index gamepad-data] - the latter being an atom with gamepad state. \!gamepads is a map of atoms containing the Javascript datastructure (or nil if disconnected) indexed on gamepad-index. The first time a listener is installed a singleton polling loop is kicked off to keep the state atoms updated because there are no gamepad events except connect/disconnect in the API.

--- src/cljs/infinitelives/utils/events.cljs
+++ src/cljs/infinitelives/utils/events.cljs
@@ -4,8 +4,7 @@
   (:require
    [cljs.core.async :refer [put! chan <! >! alts! timeout close!]])
   (:require-macros
-   [cljs.core.async.macros :refer [go]])
-  )
+   [cljs.core.async.macros :refer [go]]))

 ;; a dynamic var that passes through ctrl+shift+key events
 ;; to the root event handler
@@ -302,6 +301,56 @@

 (def get-gamepads (make-get-gamepads))

+; keep a list of gamepads and their connection state - when connected this is the gamepad state datastruct
+(def !gamepads {0 (atom nil) 1 (atom nil) 2 (atom nil) 3 (atom nil)})
+
+; list of functions listening for gamepad connect events
+(def !gamepad-connected-callbacks (atom []))
+
+(defn initiate-gamepad-callbacks [gamepad-index gamepad-data]
+  ; run the callbacks
+  (doseq [g @!gamepad-connected-callbacks] (g gamepad-index (get !gamepads gamepad-index))))
+
+; set a particular gamepad's connected atom state
+(defn set-gamepad-atom! [gamepad-index value]
+  (let [g (get !gamepads gamepad-index)]
+    (reset! g value)))
+
+; make the gamepad handler a singleton
+(def gamepad-handler-installed (atom false))
+
+; singleton function for initiating the listeners and polling loop
+(defn install-gamepad-handler! []
+  (when (compare-and-set! gamepad-handler-installed false true)
+    ; make sure the initial atoms are set and call the callback if it's already connected
+    (let [gamepads (get-gamepads)]
+      (doseq [gamepad-index (range 4)]
+        (let [gamepad-data (aget gamepads gamepad-index)]
+          (when gamepad-data
+            (set-gamepad-atom! gamepad-index gamepad-data)))))
+    ; catch gamepad connect events and fire the callback
+    (js/window.addEventListener "gamepadconnected" (fn [ev] (set-gamepad-atom! ev.gamepad.index ev.gamepad) (initiate-gamepad-callbacks ev.gamepad.index ev.gamepad)))
+    ; catch gamepad disconnect events and reset the relevant atom
+    (js/window.addEventListener "gamepaddisconnected" (fn [ev] (set-gamepad-atom! ev.gamepad.index nil) (initiate-gamepad-callbacks ev.gamepad.index nil)))
+    ; start the polling loop that will continuously query gamepads for updated data
+    ; because the API does not include events except for connect and disconnect
+    (js/setInterval get-gamepads 25)))
+
+; listen out for gamepads connecting and disconnecting
+; any time a new gamepad connects the callback will be called
+; the callback is passed [gamepad-index gamepad-data] whenever a gamepad connects or disconnects
+; gamepad-data is an atom that will contain the js datastructure of gamepad data
+; if will become nil if the gamepad disconnects (the callback will also be called)
+(defn install-gamepad-listener [callback]
+  ; kick off the background polling interval singleton if not started already
+  (install-gamepad-handler!)
+  ; add this callback to our list of listeners
+  (swap! !gamepad-connected-callbacks conj callback)
+  ; fire a callback for any gamepads that are already connected
+  (doseq [c (range 4)]
+    (let [g (get !gamepads c)]
+      (when @g (callback c g)))))
+
 ;;
 ;; touch wrapper (hammer.js)
 ;;


disabling read-timeout for wsd

disabling read-timeout for wsd

--- src/clojure/my/company/superapp/main.clj
+++ src/clojure/my/company/superapp/main.clj
@@ -59,6 +59,8 @@
     )
   )

+(def wsd-sessions (atom {}))
+
 (defn init-wsd
   [bind-address port]
   (let [wsd (proxy [NanoWSD] [bind-address port]
@@ -67,7 +69,8 @@
                 (log/i "openWebSocket")
                 (let [web-socket (proxy [NanoWSD$WebSocket] [handshake]
                                    (onOpen []
-                                     (log/i "onOpen"))
+                                     (log/i "onOpen")
+                                     (swap! wsd-sessions :sessiond handshake))
                                    (onClose [code, reason, initiated-by-remote]
                                      (log/i "onClose"))
                                    (onMessage [message]
@@ -75,8 +78,10 @@
                                    (onPong [pong]
                                      (log/i "onPong"))
                                    (onException [exception]
-                                    (log/i "onException")))]
-                  web-socket)
+                                     (log/i "onException")
+                                     (log/i exception)
+                                     ))]
+                  web-socket)
                 )
               )]
     wsd
@@ -99,7 +104,8 @@
     (log/i "staring httpd server")
     (.start httpd)
     (log/i "starting wsd server")
-    (.start wsd)
+    ;; starting wsd server with with a negative SOCKET_READ_TIMEOUT that will set no timeout
+    (.start wsd -1)
     (neko.debug/keep-screen-on this)
     (on-ui
       (set-content-view! (*a)


Adjust some examples

Adjust some examples

--- src/clojure_walkthrough/jocj/ch03_03.clj
+++ src/clojure_walkthrough/jocj/ch03_03.clj
@@ -41,25 +41,10 @@
 (def last-then-firstname (sorter-using lastname-firstname))

 ;; Let's see some result
-(map username users)  ;; ("kyle" "zak" "rob")
+(map username users) ;; ("kyle" "zak" "rob")
 (sort *1) ;; ("kyle" "rob" "zak") ;; Note: *1 means 'last result return by REPL'

-(pprint  (sort-by username users)) ;; =>
-;; ({:username "kyle",
-;;  :firstname "Kyle",
-;;  :lastname "Smith",
-;;  :balance 175.00M,
-;;  :member-since "2009-04-16"}
-;; {:username "rob",
-;;  :firstname "Robert",
-;;  :lastname "Jones",
-;;  :balance 98.50M,
-;;  :member-since "2009-03-30"}
-;; {:username "zak",
-;;  :firstname "Jones",
-;;  :lastname "Zackery",
-;;  :balance 12.95M,
-;;  :member-since "2009-02-01"})
+(sort-by username users) ;; ({:username "kyle", :firstname "Kyle", :lastname "Smith", :balance 175.00M, :member-since "2009-04-16"} {:username "rob", :firstname "Robert", :lastname "Jones", :balance 98.50M, :member-since "2009-03-30"} {:username "zak", :firstname "Jones", :lastname "Zackery", :balance 12.95M, :member-since "2009-02-01"})

 (def poorest-first (sorter-using balance))
 (poorest-first users) ;; ({:username "zak", :firstname "Jones", :lastname "Zackery", :balance 12.95M, :member-since "2009-02-01"} {:username "rob", :firstname "Robert", :lastname "Jones", :balance 98.50M, :member-since "2009-03-30"} {:username "kyle", :firstname "Kyle", :lastname "Smith", :balance 175.00M, :member-since "2009-04-16"})


fixed double post bug

fixed double post bug

--- src/ontrail/pages.clj
+++ src/ontrail/pages.clj
@@ -59,7 +59,7 @@
        (parse-int (params "duration.s")) "s"))

 (defn redirect [page]
-  {:status  301
+  {:status  302
    :headers {"Content-Type" "text/html"
              "Location"     page}
    :body    ""})
@@ -172,14 +172,19 @@
 (defn clear []
   [:div {:style "clear:both;"}])

+
+(defn onsubmit [id]
+  (str "var text = document.getElementById('" id
+       "').value; if(text.length < 3) { alert('Kommentin minimipituus kolme merkkiä.'); return false; } return true;"))
+
 (defn comment-div [id]
   [:div.container
    [:div.row
     [:div.col-md-8
-     [:form {:role "form" :accept-charset "UTF-8" :method "POST" :action (url "/comment/" id)}
+     [:form {:role "form" :accept-charset "UTF-8" :method "POST" :action (url "/comment/" id) :onsubmit (onsubmit "comment-text")}
       [:input {:type "hidden" :name id}]
       [:div.form-group
-        [:textarea.form-control {:name "mdbody" :rows "4" :required "required"}]]
+        [:textarea#comment-text.form-control {:name "mdbody" :rows "4" :required "required"}]]
       [:button.btn.btn-default {:type "submit"} "Kommentoi"]
       ]]]])

@@ -406,9 +411,9 @@
                  (require-auth cookies
                    (if (auth/valid-auth-token? (:value (cookies "authToken")))
                      (let [user (auth/user-from-cookie cookies)
-                           with-body (assoc params :body (md/md-to-html-string (params :mdbody)))]
-                       (render-with single-exercise
-                                    {:ex (mutate/comment-ex user with-body) :user user})))))
+                           with-body (assoc params :body (md/md-to-html-string (params :mdbody)))
+                           new-ex (mutate/comment-ex user with-body)]
+                       (redirect (str "/sp/ex/" (:id params)))))))

            (GET "/sp/addex" {params :params cookies :cookies} ;;addex
                 (require-auth cookies
@@ -428,7 +433,7 @@
                    (let [params-with-dur (assoc params :duration (to-dur-str params) :body (params :mdbody))
                          user (auth/user-from-cookie cookies)
                          posted (mutate/create-ex user params-with-dur)]
-                     (render-with single-exercise {:ex posted :user user}))))
+                     (redirect (str "/sp/ex/" (:id posted))))))

            (POST "/sp/addex/:id" {params :params cookies :cookies}
                  (.info logger (str params " " cookies))


Allow for passes to emit forms when updating forms

--- src/oxcart/passes.clj
+++ src/oxcart/passes.clj
@@ -64,14 +64,26 @@
        (merge whole-ast)))

+(defn merge-vecs
+  [forms]
+  (reduce
+   (fn [acc e]
+     (if (vector? e)
+       (concat acc e)
+       (conj acc e)))
+   nil forms))
+
+
 (defn update-forms
   "λ Whole-AST → (λ Form → args * → Form) → args *

   Updates every form in the given Whole-ast, replacing it with (apply
   f form args). Intended to eliminate repetitive Whole-AST
-  comprehensions in pass implementations. Note that if a form is nil,
-  it will be discarded. Consequently this operation and anything built
-  atop it has the potential to be highly destructive."
+  comprehensions in pass implementations.
+
+  Note that if a form is nil, it will be discarded.
+  Note that if a form is a vector (presumably of forms) it will be
+  concatinated into the forms sequence."
   [whole-ast f & args]
   (-> whole-ast
       (update-modules
@@ -81,6 +93,7 @@
                    (->> forms
                         (map #(apply f %1 args))
                         (keep identity)
+                        (merge-vecs)
                         (vec))))))))


(chore) change some arguments name

(chore) change some arguments name

--- src/papaline/core.clj
+++ src/papaline/core.clj
@@ -224,15 +224,15 @@
                      (sequential? args))
                args [args])]
     (try
-      (let [task-ret (apply task args)]
-        [(if (instance? CompletableFuture task-ret)
-           task-ret
-           (CompletableFuture/completedFuture task-ret))
+      (let [next-args (apply task args)]
+        [(if (instance? CompletableFuture next-args)
+           next-args
+           (CompletableFuture/completedFuture next-args))
          ctx])
       (catch Exception e
-        (let [ctx (process-exception ctx args e (:name current-stage) error-handler)]
-          [(CompletableFuture/completedFuture (:args ctx))
-           ctx])))))
+        (let [new-ctx (process-exception ctx args e (:name current-stage) error-handler)]
+          [(CompletableFuture/completedFuture (:args new-ctx))
+           new-ctx])))))

 (defrecord+ AsyncDedicatedThreadPoolPipeline [executor stages error-handler]
   clojure.lang.IFn
@@ -242,15 +242,15 @@
                 result (CompletableFuture.)]
             (letfn [(clos [stgs ctx]
                       (if-let [^RealizedStage s (first stgs)]
-                        (let [[^CompletableFuture future ctx] (run-task2 s ctx error-handler)]
-                          (if (.isDone future)
-                            (process-result (assoc ctx :args (.get future)) stgs)
-                            (.handleAsync ^CompletableFuture future
+                        (let [[^CompletableFuture next-args-future new-ctx] (run-task2 s ctx error-handler)]
+                          (if (.isDone next-args-future)
+                            (process-result (assoc new-ctx :args (.get next-args-future)) stgs)
+                            (.handleAsync ^CompletableFuture next-args-future
                                           (reify BiFunction
                                             (apply [this next-args ex]
                                               (let [ctx (if (some? ex)
-                                                          (process-exception ctx (:args ctx) ex (:name s) error-handler)
-                                                          (assoc ctx :args next-args))]
+                                                          (process-exception new-ctx (:args new-ctx) ex (:name s) error-handler)
+                                                          (assoc new-ctx :args next-args))]
                                                 (process-result ctx stgs))))
                                           executor)))
                         (do


moved import to access service

moved import to access service

--- src/tango/event_access.clj
+++ src/tango/event_access.clj
@@ -37,7 +37,18 @@
                    (let [result (d/query-competition conn (:query p))]
                      (async/put! out-channel {:topic :tx/processed :payload {:topic topic
                                                                              :result result}}))
-                   ;[:event-access/transact t]
+                   [:event-access/transact p]
+                   ;; TODO - Currently we do only support one competition imported at the time
+                   ;; TODO - fix this crap!
+                   (let [_ (d/delete-storage "datomic:free://localhost:4334//competitions")
+                         schema-tx (read-string (slurp (clojure.java.io/resource "schema/activity.edn")))
+                         _ (d/create-storage "datomic:free://localhost:4334//competitions" schema-tx)
+                         conn (d/create-connection "datomic:free://localhost:4334//competitions")
+                         tx (d/transact-competition conn p)]
+                     ;(log/info tx)
+                     (async/put! out-channel (merge message
+                                                    {:topic :event-access/transaction-result
+                                                     :payload :ok})))
                    ;(let [[tx c] (async/alts! [[(:in-channel storage-channels)
                    ;                             {:topic :event-file-storage/transact
                    ;                              :payload t}]


Fix ZooKeeper compilation.

Fix ZooKeeper compilation.

--- src/uswitch/bifrost/zk.clj
+++ src/uswitch/bifrost/zk.clj
@@ -1,7 +1,7 @@
 (ns uswitch.bifrost.zk
   (:require [clj-kafka.zk :refer (committed-offset set-offset!)]
             [com.stuartsierra.component :refer (Lifecycle)]
-            [clojure.core.async :refer (go-loop <!)]
+            [clojure.core.async :refer (go <!)]
             [clojure.tools.logging :refer (info error)]))

 (defrecord ZookeeperTracker [consumer-properties commit-offset-ch]


Add wait-for-git step

Add wait-for-git step

--- src/lambdacd_pipeline/pipelines/meta.clj
+++ src/lambdacd_pipeline/pipelines/meta.clj
@@ -36,8 +36,7 @@
 (def pipeline-structure
   `((either
       wait-for-manual-trigger
-      ;wait-for-git
-      )
+      wait-for-git)
      (with-workspace
        clone
        build


Fixed calculation of points in lost games

--- src/skat/gameplay.clj
+++ src/skat/gameplay.clj
@@ -197,7 +197,7 @@
             (update-points [points { :keys [:solist :success? :game-value] }]
               (update-in points
                          [solist]
-                         #(+ % (if success? game-value (- game-value)))))]
+                         #(+ % (if success? game-value (- (* 2 game-value))))))]
       (loop [round   1
              bidders initial-bidders
              points  initial-points]


serve actual media bits (no transcoding yet)

--- src/sledge/server.clj
+++ src/sledge/server.clj
@@ -144,12 +144,28 @@
      :headers {"Content-type" "text/html; charset=UTF-8"}
      :body (h/html (view req))}))

-(defn base64 [string]
-  (.encodeBuffer (sun.misc.BASE64Encoder.) (.getBytes string)))
-
-(defn unbase64 [string]
-  (String. (.decodeBuffer (sun.misc.BASE64Decoder.) string)))
-
+
+
+(def mime-types
+  {"ogg" "audio/ogg"
+   "mp3" "audio/mpeg"
+   "flac" "audio/flac"
+   "wav" "audio/x-wav"
+   })
+
+(defn mime-type-for-ext [ext]
+  (get mime-types (.toLowerCase ext)))
+
+;; avconv -i /srv/media/Music/flac/Delerium-Karma\ Disc\ 1/04.Silence.flac -f mp3 pipe: |cat > s.mp3
+
+(defn maybe-transcode [pathname from to]
+  (let [from (:suffix (get encoding-types from))
+        mime-type (mime-type-for-ext to)]
+    (if (= from to)
+      {:status 200 :headers {"content-type" mime-type}
+       :body (clojure.java.io/file pathname)}
+      {:status 404 :headers {"content-type" "text/plain"}
+       :body "transcoding not implemented"})))

 (defn bits-handler [req]
   (let [urlpath (str/split (:uri req) #"/")
@@ -157,13 +173,11 @@
         real-pathname (unbase64 b64)]
     (println real-pathname)
     ;; XXX this *really* needs to be an exact match
-    (if-let [track (search/search search/index {:pathname real-pathname} 1)]
-      (send-to-client real-pathname :transcoding-to ext)
+    (if-let [r (first (filter
+                       #(= (:pathname %) real-pathname)
+                       (search/search search/index {:pathname real-pathname} 100)))]
+      (maybe-transcode real-pathname (:encoding-type r) ext)
       {:status 404 :body "not found"})))
-
-
-;; avconv -i /srv/media/Music/flac/Delerium-Karma\ Disc\ 1/04.Silence.flac -f mp3 pipe: |cat > s.mp3
-

 (defn routes [req]
   (let [u (:uri req)]


Modify contains-fuzzy? to be a little faster by checking more intelligently. Modify get-fuzzy to prefer keywords over strings.

--- src/stencil/utils.clj
+++ src/stencil/utils.clj
@@ -49,15 +49,15 @@
    the variant of the found key for true, nil for false."
   ([map key] (contains-fuzzy? map key nil))
   ([map key not-found]
-      (if (contains? map key)
-        key
-        (let [str-key (name key)]
-          (if (contains? map str-key)
-            str-key
-            (let [kw-key (keyword key)]
-              (if (contains? map kw-key)
-                kw-key
-                not-found)))))))
+     (if (contains? map key)
+       key
+       (if (keyword? key)
+         (let [str-key (name key)]
+           (if (contains? map str-key)
+             str-key not-found))
+         (let [kw-key (keyword key)]
+           (if (contains? map kw-key)
+             kw-key not-found))))))

 (defn get-fuzzy
   "Given a map and a key, gets the value out of the map, trying various
@@ -67,8 +67,8 @@
      (get-fuzzy map key nil))
   ([map key not-found]
      (or (get map key)
+         (get map (keyword key))
          (get map (name key))
-         (get map (keyword key))
          not-found)))

 (defn assoc-fuzzy


fix :navigation-stack sub

fix :navigation-stack sub

Former-commit-id: 4eac55e756eca74391c2e5f5268ea18a2c54f6b4

--- src/syng_im/subs.cljs
+++ src/syng_im/subs.cljs
@@ -153,7 +153,7 @@

 (register-sub :navigation-stack
   (fn [db _]
-    (:navigation-stack @db)))
+    (reaction (:navigation-stack @db))))

 (register-sub :db
   (fn [db _] (reaction @db)))


Fix back quote logic in string escaping

Fix back quote logic in string escaping

--- src/transit/write.clj
+++ src/transit/write.clj
@@ -69,7 +69,7 @@
       (cond (and (= RESERVED c) (= ESC (subs s 1 2)))
             (subs s 1)

-            (or (= ESC c) (= SUB c))
+            (or (= ESC c) (= SUB c) (= RESERVED c))
             (str ESC s)

             :else s))))


allow nrepl to be disabled globally via user config

--- src/main/shadow/cljs/devtools/server.clj
+++ src/main/shadow/cljs/devtools/server.clj
@@ -121,7 +121,7 @@

   (do-shutdown (rt/stop-all app))

-  #_ (discard-println "shutdown complete."))
+  #_(discard-println "shutdown complete."))

 (defn make-port-files [cache-root ports]
   (io/make-parents (io/file cache-root "foo.txt"))
@@ -291,8 +291,12 @@
           (let [cli-port (Long/valueOf cli-port)]
             (create-cli-checker cli-port)))

+        disable-nrepl?
+        (or (false? (:nrepl config))
+            (false? (get-in config [:system-config :nrepl])))
+
         nrepl
-        (when-not (false? (:nrepl config))
+        (when-not disable-nrepl?
           (try
             ;; problem child nrepl
             ;; we need to start a 0.2 nrepl server
@@ -500,7 +504,7 @@
            (println (str "shadow-cljs - server version: "
                          version
                          " running at http" (when ssl-context "s") "://" http-host ":" (:port http)))
-           #_ (println (str "shadow-cljs - socket REPL running on port " (:port socket-repl)))
+           #_(println (str "shadow-cljs - socket REPL running on port " (:port socket-repl)))
            ;; must keep this message since cider looks for it
            (when nrepl
              (println (str "shadow-cljs - nREPL server started on port " (:port nrepl))))


Stop tracking element owner

Stop tracking element owner

--- src/zaffre/components.cljc
+++ src/zaffre/components.cljc
@@ -492,12 +492,12 @@
               (str " Not every child is a pixel in " type " "
                 (vec (filter (complement child-validator) children)))))
     (letfn [(child-validator [child] (or (component? child)
-                                  (element? child)
-                                  (string? child)
-                                  (nil? child)))]
+                                         (element? child)
+                                         (string? child)
+                                         (nil? child)))]
       (assert (every? child-validator children)
           (str " Not every child is a component or element in " type " "
-               (vec (filter (complement child-validator) children))))))
+               (first (filter (complement child-validator) children))))))
   true)

 ;; React.createElement(Hello, {toWhat: 'World'}, null)
@@ -521,7 +521,7 @@
                       (remove (fn [[prop-name _]]
                                 (reserved-prop? prop-name)))
                               config))
-        element (->ReactElement nil type key ref self source *current-owner* props)]
+        element (->ReactElement nil type key ref self source nil props)]
     (assoc element :id (System/identityHashCode element))))

 (defn create-factory [type]


Fix anonymous secure entry retrieve.

Fix anonymous secure entry retrieve.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -172,7 +172,8 @@
         draft? (= :draft (keyword (:status entry)))
         entry-with-comments (assoc entry :interactions comments)
         has-new-comments-count? (contains? entry :new-comments-count)
-        entry-read (when-not has-new-comments-count?
+        entry-read (when (and user-id
+                              (not has-new-comments-count?))
                      (read/retrieve-by-user-item config/dynamodb-opts user-id (:uuid entry)))
         full-entry (merge {:board-slug board-slug
                            :board-access board-access


(PDB-4636) services: defer db pool inits until needed

Particularly so that we don't have to worry about attempting
migration checks until after the db has been initialized.

This is an adaptation of f46593bd32f025ab61df63eb28a193c69078b7a6 for
master.

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -566,29 +566,25 @@
         {:keys [cmd-event-mult cmd-event-ch]} context
         emit-cmd-events? (or (conf/pe? config) emit-cmd-events?)
         maybe-send-cmd-event! (partial maybe-send-cmd-event! emit-cmd-events? cmd-event-ch)
-        write-db (-> (assoc database
-                            :pool-name "PDBWritePool"
-                            :expected-schema desired-schema-version)
-                     (jdbc/pooled-datasource database-metrics-registry))
-        read-db (-> (assoc read-database
-                           :pool-name "PDBReadPool"
-                           :expected-schema desired-schema-version
-                           :read-only? true)
-                    (jdbc/pooled-datasource database-metrics-registry))
-        globals {:scf-read-db read-db
-                 :scf-write-db write-db
-                 :pretty-print (:pretty-print developer)
-                 :node-purge-ttl (:node-purge-ttl database)
-                 :cmd-event-mult cmd-event-mult
-                 :maybe-send-cmd-event! maybe-send-cmd-event!}]
+        clean-lock (ReentrantLock.)
+        context (assoc context  ;; context may be augmented further below
+                       :shared-globals {:pretty-print (:pretty-print developer)
+                                        :node-purge-ttl (:node-purge-ttl database)
+                                        :cmd-event-mult cmd-event-mult
+                                        :maybe-send-cmd-event! maybe-send-cmd-event!}
+                       :clean-lock clean-lock)]

     (when-let [v (version/version)]
       (log/info (trs "PuppetDB version {0}" v)))
     (init-with-db database config)

     (if upgrade-and-exit?
-      (assoc context :shared-globals globals)
-      (do
+      context
+      (let [read-db (-> (assoc read-database
+                               :pool-name "PDBReadPool"
+                               :expected-schema desired-schema-version
+                               :read-only? true)
+                        (jdbc/pooled-datasource database-metrics-registry))]
         (let [population-registry (get-in metrics/metrics-registries [:population :registry])]
           (pop/initialize-population-metrics! population-registry read-db))

@@ -602,13 +598,9 @@
               [q load-messages] (queue/create-or-open-stockpile (conf/stockpile-dir config)
                                                                 maybe-send-cmd-event!
                                                                 cmd-event-ch)
-              globals (assoc globals
-                             :q q
-                             :dlo (dlo/initialize (get-path stockdir "discard")
-                                                  (get-in metrics-registries
-                                                          [:dlo :registry]))
-                             :command-chan command-chan)
-              clean-lock (ReentrantLock.)
+              dlo (dlo/initialize (get-path stockdir "discard")
+                                  (get-in metrics-registries
+                                          [:dlo :registry]))
               command-loader (when load-messages
                                (future
                                  (load-messages command-chan cmd/inc-cmd-depth)))]
@@ -620,14 +612,18 @@
           ;; Pretty much this helper just knows our job-pool and gc-interval
           (let [job-pool (mk-pool)
                 gc-interval-millis (to-millis (:gc-interval database))
-                schema-check-interval (:schema-check-interval database)]
+                schema-check-interval (:schema-check-interval database)
+                write-db (-> (assoc database
+                                    :pool-name "PDBWritePool"
+                                    :expected-schema desired-schema-version)
+                             (jdbc/pooled-datasource database-metrics-registry))]
             (when-not (get-in config [:puppetdb :disable-update-checking])
               (maybe-check-for-updates config read-db job-pool))
             (when (pos? schema-check-interval)
               (interspaced schema-check-interval
                            #(check-schema-version desired-schema-version
                                                   context
-                                                  (:scf-read-db globals)
+                                                  read-db
                                                   service
                                                   shutdown-on-error)
                            job-pool))
@@ -638,11 +634,16 @@
                                                            database request
                                                            (:stop-status context))
                              job-pool)))
-            (assoc context
-                   :job-pool job-pool
-                   :shared-globals globals
-                   :clean-lock clean-lock
-                   :command-loader command-loader)))))))
+            (-> context
+                (assoc :job-pool job-pool
+                       :command-loader command-loader)
+                (assoc-in [:shared-globals :command-chan] command-chan)
+                (assoc-in [:shared-globals :cmd-event-mult] cmd-event-mult)
+                (assoc-in [:shared-globals :dlo] dlo)
+                (assoc-in [:shared-globals :maybe-send-cmd-event!] maybe-send-cmd-event!)
+                (assoc-in [:shared-globals :q] q)
+                (assoc-in [:shared-globals :scf-read-db] read-db)
+                (assoc-in [:shared-globals :scf-write-db] write-db))))))))

 (defn db-unsupported-msg
     "Returns a message describing which databases are supported."


working on support for braccio -> braccia

--- src/babel/italiano/morphology/nouns.cljc
+++ src/babel/italiano/morphology/nouns.cljc
@@ -33,6 +33,11 @@
                  :agr {:gender :fem
                        :number :plur}}}}

+   {:p [#"(.*)o$" "$1a"] ;; "braccio" -> "braccia"
+    :u {:synsem {:cat :noun
+                 :agr {:gender :fem
+                       :number :plur}}}}
+
    {:p [#"(.*)e$" "$1à"] ;; "citte" -> "città"
     :u {:synsem {:cat :noun
                  :agr {:gender :fem
@@ -50,9 +55,6 @@
    {:p [#"(.*)i$" "$1o"] ;; "compiti" -> "compito"
     :u {:synsem {:cat :noun
                  :agr {:number :plur}}}}
-
-
-
    ])

 (def plural-to-singular-noun-fem-1
@@ -64,8 +66,8 @@

 (def plural-to-singular-noun-masc-1
   {
-   #"ii$" ;; e.g. "braccio" => "bracci"
-   {:replace-with "io"
+   #"ii$" ;; e.g. "braccio" => "braccia"
+   {:replace-with "a"
     :unify-with {:synsem {:cat :noun
                           :agr {:number :plur}}}}
    #"([^i])i$"


Enable to get articles.

Enable to get articles.

--- src/clj/back_channeling/endpoint/api.clj
+++ src/clj/back_channeling/endpoint/api.clj
@@ -393,12 +393,16 @@
    :malformed? #(parse-request %)
    :post-to-existing? (fn [{{article-name :article/name} :edn :as ctx}]
                         (not
-                         (and (#{:post} (get-in ctx [:request :request-method]))
-                              (find-article-by-name datomic article-name))))
+                         (or
+                          (#{:get} (get-in ctx [:request :request-method]))
+                          (and (#{:post} (get-in ctx [:request :request-method]))
+                               (find-article-by-name datomic article-name)))))

    ;; Only :post-to-existing? = false pattern.
-   :put-to-existing? (fn [_] true)
-   :conflict? (fn [_] true)
+   :put-to-existing? (fn [ctx]
+                       (#{:post} (get-in ctx [:request :request-method])))
+   :conflict? (fn [ctx]
+                (#{:post} (get-in ctx [:request :request-method])))

    :post! (fn [{article :edn req :request}]
             (let [article-id (d/tempid :db.part/user)


topology submission exceptions printed in log

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -871,38 +871,41 @@
     (reify Nimbus$Iface
       (^void submitTopology
         [this ^String storm-name ^String uploadedJarLocation ^String serializedConf ^StormTopology topology]
-        (validate-topology-name! storm-name)
-        (check-storm-active! nimbus storm-name false)
-        (.validate ^backtype.storm.nimbus.ITopologyValidator (:validator nimbus)
-              storm-name
-              (from-json serializedConf)
-              topology)
-        (swap! (:submitted-count nimbus) inc)
-        (let [storm-id (str storm-name "-" @(:submitted-count nimbus) "-" (current-time-secs))
-              storm-conf (normalize-conf
-                          conf
-                          (-> serializedConf
-                              from-json
-                              (assoc STORM-ID storm-id)
-                              (assoc TOPOLOGY-NAME storm-name))
-                          topology)
-              total-storm-conf (merge conf storm-conf)
-              topology (normalize-topology total-storm-conf topology)
-              topology (if (total-storm-conf TOPOLOGY-OPTIMIZE)
-                         (optimize-topology topology)
-                         topology)
-              storm-cluster-state (:storm-cluster-state nimbus)]
-          (system-topology! total-storm-conf topology) ;; this validates the structure of the topology
-          (log-message "Received topology submission for " storm-name " with conf " storm-conf)
-          ;; lock protects against multiple topologies being submitted at once and
-          ;; cleanup thread killing topology in b/w assignment and starting the topology
-          (locking (:submit-lock nimbus)
-            (setup-storm-code conf storm-id uploadedJarLocation storm-conf topology)
-            (.setup-heartbeats! storm-cluster-state storm-id)
-            (start-storm nimbus storm-name storm-id)
-            (mk-assignments nimbus))
-          ))
-
+        (try
+          (validate-topology-name! storm-name)
+          (check-storm-active! nimbus storm-name false)
+          (.validate ^backtype.storm.nimbus.ITopologyValidator (:validator nimbus)
+                     storm-name
+                     (from-json serializedConf)
+                     topology)
+          (swap! (:submitted-count nimbus) inc)
+          (let [storm-id (str storm-name "-" @(:submitted-count nimbus) "-" (current-time-secs))
+                storm-conf (normalize-conf
+                            conf
+                            (-> serializedConf
+                                from-json
+                                (assoc STORM-ID storm-id)
+                                (assoc TOPOLOGY-NAME storm-name))
+                            topology)
+                total-storm-conf (merge conf storm-conf)
+                topology (normalize-topology total-storm-conf topology)
+                topology (if (total-storm-conf TOPOLOGY-OPTIMIZE)
+                           (optimize-topology topology)
+                           topology)
+                storm-cluster-state (:storm-cluster-state nimbus)]
+            (system-topology! total-storm-conf topology) ;; this validates the structure of the topology
+            (log-message "Received topology submission for " storm-name " with conf " storm-conf)
+            ;; lock protects against multiple topologies being submitted at once and
+            ;; cleanup thread killing topology in b/w assignment and starting the topology
+            (locking (:submit-lock nimbus)
+              (setup-storm-code conf storm-id uploadedJarLocation storm-conf topology)
+              (.setup-heartbeats! storm-cluster-state storm-id)
+              (start-storm nimbus storm-name storm-id)
+              (mk-assignments nimbus)))
+
+          (catch Throwable e
+            (log-warn-error e "Topology submission exception. (topology name='" storm-name "')"))))
+
       (^void killTopology [this ^String name]
         (.killTopologyWithOpts this name (KillOptions.)))


fix exception

fix exception

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

--- src/clj/migae/datastore/impl/keyword.clj
+++ src/clj/migae/datastore/impl/keyword.clj
@@ -99,7 +99,7 @@
              ;; (PersistentEntityMap. e nil)
              e)
            )
-         :else (throw (ex-info "InvalidKeychainException"
+         :else (throw (ex-info (str "InvalidKeychainException: " keychain)
                                {:type :keychain-exception, :cause :invalid}))))

      (= mode :multi)


More steam! Chooo chooo!

More steam! Chooo chooo!

--- src/clj/mokkameister/resources/slack.clj
+++ src/clj/mokkameister/resources/slack.clj
@@ -23,7 +23,7 @@
           (msg-coffee-count today-count "") slack-user brew-time))

 (defn- coffee-message-finished []
-  (format "Det er kaffi å få på kjøken!"))
+  ":steam_locomotive::coffee::coffee::coffee::coffee::coffee::coffee::dash:")

 (defn- coffee-message-instant [{:keys [slack-user]}]
   (format "Den sleipe robusta-knaskaren %s har lagt seg ein snar-kaffi :/" slack-user))


Debugging

Debugging

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1159,17 +1159,17 @@
                                    (assoc :parent1-errors (:errors parent1))
                                    (assoc :parent2-errors (:errors parent2))))]
     (if (:diversifying checked)
-      (make-individual :genome child-genome
-                       :errors (:errors checked)
-                       :history (:history parent1)
-                       :age ((age-combining-function argmap) parent1 parent2 child-genome)
-                       :grain-size (compute-grain-size child-genome parent1 parent2 argmap)
-                       :ancestors (if maintain-ancestors
-                                    (cons (:genome parent1) (:ancestors parent1))
-                                    (:ancestors parent1))
-                       :parent1-genome parent1-genome
-                       :parent2-genome parent2-genome
-                       :is-random-replacement false)
+      (assoc (make-individual :genome child-genome
+                              :errors (:errors checked)
+                              :history (:history parent1)
+                              :age ((age-combining-function argmap) parent1 parent2 child-genome)
+                              :grain-size (compute-grain-size child-genome parent1 parent2 argmap)
+                              :ancestors (if maintain-ancestors
+                                           (cons (:genome parent1) (:ancestors parent1))
+                                           (:ancestors parent1))
+                              :is-random-replacement false)
+        :parent1-genome parent1-genome
+        :parent2-genome parent2-genome)
       (let [new-genome (random-plush-genome
                          max-genome-size-in-initial-program atom-generators argmap)
             new-checked (diversifying? {:genome new-genome} argmap)]
@@ -1180,8 +1180,6 @@
                            :age 0
                            :grain-size (compute-grain-size new-genome argmap)
                            :ancestors ()
-                           :parent1-genome nil
-                           :parent2-genome nil
                            :is-random-replacement true)
           (make-individual :genome []
                            :errors nil
@@ -1189,7 +1187,5 @@
                            :age 0
                            :grain-size (compute-grain-size [] argmap)
                            :ancestors ()
-                           :parent1-genome nil
-                           :parent2-genome nil
                            :is-random-replacement true))))))


Refactor communication ns: schema.core -> s2

In preparation for using s for clojure.spec

--- src/com/frereth/common/communication.clj
+++ src/com/frereth/common/communication.clj
@@ -5,7 +5,7 @@
             [com.frereth.common.schema :as fr-sch]
             [com.frereth.common.util :as util]
             [hara.event :refer (raise)]
-            [schema.core :as s]
+            [schema.core :as s2]
             [taoensso.timbre :as log]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -18,21 +18,21 @@

 ;; Note that, in all honesty, this is pretty
 ;; inefficient.
-(def request {:version {:major s/Int
-                        :minor s/Int
-                        :detail s/Int}
-              :protocol s/Str
+(def request {:version {:major s2/Int
+                        :minor s2/Int
+                        :detail s2/Int}
+              :protocol s2/Str
               ;; For dispatching messages that arrive on the same socket
               ;; but are really directed toward different end-points
-              (s/optional-key :channel) s/Str
-              :headers {(s/either s/Str s/Keyword) s/Any}
-              :locator s/Str  ; think URL
-              (s/optional-key :parameters) {:s/Keyword s/Any}  ; think GET
+              (s2/optional-key :channel) s2/Str
+              :headers {(s2/either s2/Str s2/Keyword) s2/Any}
+              :locator s2/Str  ; think URL
+              (s2/optional-key :parameters) {:s2/Keyword s2/Any}  ; think GET
               ;; It's very tempting for the body to be just another dict like
               ;; :parameters. But it seems like we need to have some justification
               ;; for including them both.
               ;; And sticking GET params in the URL has always seemed pretty suspect
-              (s/optional-key :body) s/Str})
+              (s2/optional-key :body) s2/Str})

 (def router-message
   "The contents are byte-arrays? Really??
@@ -40,12 +40,12 @@
 wouldn't want this to handle the marshalling?"
   {:id fr-sch/java-byte-array
    :addresses fr-sch/byte-arrays
-   :contents s/Any})
+   :contents s2/Any})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internal

-(s/defn read-all! :- (s/maybe fr-sch/byte-arrays)
+(s2/defn read-all! :- (s2/maybe fr-sch/byte-arrays)
   "N.B. Pretty much by definition, this is non-blocking, as-written.
 This is almost definitely a bug"
   [s ;  :- mq/Socket ;;
@@ -71,7 +71,7 @@
             (log/debug "read-all: Done. Incoming:\n" (map #(String. %) result))
             result))))))

-(s/defn extract-router-message :- router-message
+(s2/defn extract-router-message :- router-message
   "Note that this limits the actual message to 1 frame of EDN"
   [frames :- fr-sch/byte-arrays]
   (log/debug "Extracting Router Message from "
@@ -110,7 +110,7 @@
 ;;;; parameter should be refactored to accept a zmq-socket/SocketDescription
 ;;;; instead
 ;;;; TODO: Make that so.
-(s/defn router-recv! :- (s/maybe router-message)
+(s2/defn router-recv! :- (s2/maybe router-message)
   ([s :- mq-cmn/Socket]
    (router-recv! s :wait))
   ([s :- mq-cmn/Socket
@@ -118,7 +118,7 @@
    (when-let [all-frames (read-all! s flags)]
      (extract-router-message all-frames))))

-(s/defn dealer-recv! :- s/Any
+(s2/defn dealer-recv! :- s2/Any
   "Really only for the simplest possible case"
   ([s :- mq-cmn/Socket]
    (dealer-recv! s :dont-wait))
@@ -130,7 +130,7 @@
        (assert (= 1 (count content)))
        (-> content first util/deserialize)))))

-(s/defn dealer-send!
+(s2/defn dealer-send!
   "For the very simplest scenario, just mimic the req/rep empty address frames"
   ;; TODO: Add an arity that defaults to nil flags
   ([s :- mq-cmn/Socket
@@ -152,7 +152,7 @@
     frames :- fr-sch/byte-arrays]
    (dealer-send! s frames [])))

-(s/defn router-send!
+(s2/defn router-send!
   ([sock :- mq-cmn/Socket
     msg :- router-message]
    (router-send! sock msg []))


Eliminate duplicate code to generate random units

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -309,8 +309,21 @@
                    [:m :ft] #(/ (* % 100) 30.48)}]
     (converter [from to])))

-(defn rand-pressure-unit []
-  (rand-nth [:psi :kPa :MPa]))
+(defn rand-unit [physical-quantity]
+  (let [quantity-units-map {:length [:ft :m]
+                            :mass [:lb :kg]
+                            :pressure [:psi :kPa :mPa]
+                            :volume [:bbl :m3]
+                            :injection-rate [:bbl-per-min :bpm :m3-per-min :m3/min]
+                            :proppant-concentration [:lb-per-gal :lb/gal :kg-per-m3 :kg/m3]}]
+    (fn [] (rand-nth (get quantity-units-map physical-quantity)))))
+
+(def rand-length-unit (rand-unit :length))
+(def rand-mass-unit (rand-unit :mass))
+(def rand-pressure-unit (rand-unit :pressure))
+(def rand-volume-unit (rand-unit :volume))
+(def rand-injection-rate-unit (rand-unit :injection-rate))
+(def rand-proppant-concentration-unit (rand-unit :proppant-concentration))

 (defn typical-monitor-pressure
   ([units]
@@ -350,9 +363,6 @@
         (keyword? arg)
         (repeatedly (fn [] (typical-surface-treating-pressure arg)))))

-(defn rand-injection-rate-unit []
-  (rand-nth [:bbl-per-min :bpm :m3-per-min :m3/min]))
-
 (defn typical-injection-rate
   ([]
    (let [unit (rand-injection-rate-unit)]
@@ -371,9 +381,6 @@
           [unit (take arg (injection-rate-seq unit))])
         (keyword? arg)
         (repeatedly (fn [] (typical-injection-rate arg)))))
-
-(defn rand-proppant-concentration-unit []
-  (rand-nth [:lb-per-gal :lb/gal :kg-per-m3 :kg/m3]))

 (defn typical-proppant-concentration
   ([]
@@ -420,10 +427,7 @@
 (defn typical-fracture-azimuth []
   (tuc/draw-normal 90 30))

-(defn rand-length-unit []
-  (rand-nth [:ft :m]))
-
-(defn typical-fracture-geometry
+(defn typical-fracture-geometry
   ([unit] [(map #(vector unit %) (typical-fracture-size unit)) (typical-fracture-azimuth)])
   ([] (typical-fracture-geometry (rand-length-unit))))


Fix selrect when zoom is activated.

Fix selrect when zoom is activated.

--- src/uxbox/main/ui/workspace/selrect.cljs
+++ src/uxbox/main/ui/workspace/selrect.cljs
@@ -69,8 +69,8 @@
         startx (* c/canvas-start-x zoom)
         starty (* c/canvas-start-y zoom)]
     (assoc rect
-           :x (- (:x rect) startx)
-           :y (- (:y rect) starty)
+           :x (/ (- (:x rect) startx) zoom)
+           :y (/ (- (:y rect) starty) zoom)
            :width (/ (:width rect) zoom)
            :height (/ (:height rect) zoom))))


support GitHub pull request reviews

support GitHub pull request reviews

- perform the auto labeling when a pull request review is submitted in
  the "approved" state

--- src/github_bot_app/action/auto_label.clj
+++ src/github_bot_app/action/auto_label.clj
@@ -3,6 +3,28 @@
             [tentacles.issues :as gh-issues]
             [github-bot-app.action.timer :refer [github-api-time!]]))

+(defn- mark-review-done [payload config]
+  (let [owner (get-in payload [:repository :owner :login])
+        repo (get-in payload [:repository :name])
+        issue-id (get-in payload [:pull_request :number])
+        {:keys [review-done-remove-labels review-done-add-label]} (:auto-label config)]
+   (github-api-time!
+           (gh-issues/add-labels
+            owner repo issue-id
+            [review-done-add-label]
+            (:auth-options config)))
+   (log/info (pr-str
+              {:api-call :add-labels
+               :url (get-in payload [:issue :labels_url])
+               :add-labels [review-done-add-label]}))
+   (doseq [label review-done-remove-labels]
+    (github-api-time!
+      (gh-issues/remove-label owner repo issue-id label
+       (:auth-options config)))
+    (log/info (pr-str)
+              {:api-call :remove-label
+               :url (get-in payload [:issue :labels_url])
+               :remove-label label}))))

 (defn run-action [event payload config]
   (cond
@@ -28,30 +50,20 @@
    (= event
       "issue_comment")
    (when (get-in payload [:issue :pull_request])
-     (let [owner (get-in payload [:repository :owner :login])
-           repo (get-in payload [:repository :name])
-           issue-id (get-in payload [:issue :number])
-           issue-user (get-in payload [:issue :user :login])
+     (let [issue-user (get-in payload [:issue :user :login])
            comment-user (get-in payload [:comment :user :login])
            comment-body (get-in payload [:comment :body])
-           {:keys [review-done-remove-labels review-done-add-label review-done-comment]} (:auto-label config)
+           {:keys [review-done-comment]} (:auto-label config)
            review-done-pat (re-pattern review-done-comment)]
        (when (and (not (= issue-user comment-user))
                   (re-find review-done-pat comment-body))
-         (github-api-time!
-          (gh-issues/add-labels
-           owner repo issue-id
-           [review-done-add-label]
-           (:auth-options config)))
-         (log/info (pr-str
-                    {:api-call :add-labels
-                     :url (get-in payload [:issue :labels_url])
-                     :add-labels [review-done-add-label]}))
-         (doseq [label review-done-remove-labels]
-          (github-api-time!
-            (gh-issues/remove-label owner repo issue-id label
-             (:auth-options config)))
-          (log/info (pr-str)
-                    {:api-call :remove-label
-                     :url (get-in payload [:issue :labels_url])
-                     :remove-label label})))))))
+        (mark-review-done payload config))))
+
+   (and (= event
+           "pull_request_review")
+        (= (:action payload) "submitted")
+        (= (get-in [:review :state]) "approved"))
+   (let [issue-user (get-in payload [:issue :user :login])
+         review-user (get-in payload [:review :user :login])]
+    (when (not (= issue-user review-user))
+      (mark-review-done payload config)))))


Call ensure-test-project rather than clean, ensure works when the DB is empty, and calls clean afterwards.

--- test/circle/backend/action/test_bash.clj
+++ test/circle/backend/action/test_bash.clj
@@ -31,7 +31,7 @@
     (-> @build :actions (first) :name) => "hostname"))

 (fact "bash action adds action results"
-  (let [_ (test/clean-test-project)
+  (let [_ (test/ensure-test-project)
         build (test/minimal-build :actions [(bash/bash "hostname")])]
     (let [result (run/run-build build)]
       (-> @build :action-results (count)) => 1


Fix broken test

Fix broken test


Test empty literal

Test empty literal

--- test/rdf_path_examples/distance_test.clj
+++ test/rdf_path_examples/distance_test.clj
@@ -40,6 +40,7 @@
     (testing "Equivalent resources have no distance."
       (are [resource] (== (distance-fn resource resource) 0)
            {"@value" 1}
+           {"@value" ""}
            {"@value" "2015-12-30"}
            {"@value" "https://example.com:3030/path/to/resource"}))
     (testing "Distance is symmetric"


Make sure edit and delete links are added to draft entries.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -306,7 +306,8 @@
                         inbox-link])
                ;; Only admins and the owner can edit or delete the entry
                (and (not secure-access?)
-                    (or (= role :admin)
+                    (or draft?
+                        (= role :admin)
                         (and (= access-level :author)
                              (= user-id (:user-id (first (:author entry)))))))
                (concat [(partial-update-link org-slug board-slug entry-uuid)


Pass back the offending task.

Pass back the offending task.

--- src/onyx/flow_conditions/fc_routing.cljc
+++ src/onyx/flow_conditions/fc_routing.cljc
@@ -33,27 +33,29 @@
    (->Route #{} #{} nil nil)
    compiled-flow-conditions))

-(defn maybe-attach-segment [e segment]
+(defn maybe-attach-segment [e task-id segment]
   #?(:cljs e)
-  #?(:clj (u/deserializable-exception e {:offending-segment segment})))
+  #?(:clj (u/deserializable-exception e {:offending-task task-id
+                                         :offending-segment segment})))

 (defn route-data
   [event {:keys [egress-ids compiled-ex-fcs compiled-norm-fcs flow-conditions] :as compiled} result message]
-  (if (nil? flow-conditions)
-    (if (exception? message)
-      (let [{:keys [exception segment]} (ex-data message)
-            e (maybe-attach-segment exception segment)]
-        (lc/handle-exception
-         event :lifecycle/apply-fn e (:compiled-handle-exception-fn compiled)))
-      (->Route egress-ids nil nil nil))
-    (if (exception? message)
-      (if (seq compiled-ex-fcs)
-        (choose-output-paths event compiled-ex-fcs result (:exception (ex-data message)) egress-ids)
-        (let [{:keys [exception segment]} (ex-data message)]
-          (throw (maybe-attach-segment exception segment))))
-      (if (seq compiled-norm-fcs)
-        (choose-output-paths event compiled-norm-fcs result message egress-ids)
-        (->Route egress-ids nil nil nil)))))
+  (let [{:keys [onyx.core/task-id]} event]
+    (if (nil? flow-conditions)
+      (if (exception? message)
+        (let [{:keys [exception segment]} (ex-data message)
+              e (maybe-attach-segment exception task-id segment)]
+          (lc/handle-exception
+           event :lifecycle/apply-fn e (:compiled-handle-exception-fn compiled)))
+        (->Route egress-ids nil nil nil))
+      (if (exception? message)
+        (if (seq compiled-ex-fcs)
+          (choose-output-paths event compiled-ex-fcs result (:exception (ex-data message)) egress-ids)
+          (let [{:keys [exception segment]} (ex-data message)]
+            (throw (maybe-attach-segment exception task-id segment))))
+        (if (seq compiled-norm-fcs)
+          (choose-output-paths event compiled-norm-fcs result message egress-ids)
+          (->Route egress-ids nil nil nil))))))

 (defn apply-post-transformation [message routes event]
   (let [post-transformation (:post-transformation routes)


Fix malformed file

Fix malformed file

Signed-off-by: Andrea Maria Piana <39e16ece3c2d27e1889178b15ddb376e524032f8@gmail.com>

--- src/status_im/ui/screens/chat/state.cljs
+++ src/status_im/ui/screens/chat/state.cljs
@@ -2,5 +2,5 @@

 (defonce viewable-item (atom nil))

-(defn reset
-  (reset! vieweable-item nil))
+(defn reset []
+  (reset! viewable-item nil))


Version 0.1.2-SNAPSHOT

Version 0.1.2-SNAPSHOT

--- metlog-agent/project.clj
+++ metlog-agent/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-agent "0.1.1"
+(defproject metlog-agent "0.1.2-SNAPSHOT"
   :description "Metlog agent - polls data sources for upload to vault."

   :license {:name "Eclipse Public License"


Update version

Update version

--- metlog-vault/project.clj
+++ metlog-vault/project.clj
@@ -1,4 +1,4 @@
-(defproject metlog-vault "0.1.0-SNAPSHOT"
+(defproject metlog-vault "0.2.0-SNAPSHOT"
   :description "Repository for long term storage of series data."

   :license {:name "Eclipse Public License"


#118 udated http-kit jdbc connect string

--- http-kit/hello/src/hello/handler.clj
+++ http-kit/hello/src/hello/handler.clj
@@ -39,7 +39,7 @@

 (defn start-server [{:keys [port db-host]}]
-  (db/use-database! (str "jdbc:mysql://" db-host "/hello_world")
+  (db/use-database! (str "jdbc:mysql://" db-host "/hello_world?jdbcCompliantTruncation=false&elideSetAutoCommits=true&useLocalSessionState=true&cachePrepStmts=true&cacheCallableStmts=true&alwaysSendSetIsolation=false&prepStmtCacheSize=4096&cacheServerConfiguration=true&prepStmtCacheSqlLimit=2048&zeroDateTimeBehavior=convertToNull&traceProtocol=false&useUnbufferedInput=false&useReadAheadInput=false&maintainTimeStats=false&useServerPrepStmts&cacheRSMetadata=true")
                     "benchmarkdbuser"
                     "benchmarkdbpass")
   ;; Format responses as JSON


[fix] crash with creation and invitation to 1 letter group chat

Signed-off-by: yenda <96f164ad4d9b2b0dacf8ebee2bb1eeb3aa69adf1@status.im>

--- src/status_im/ui/components/chat_icon/screen.cljs
+++ src/status_im/ui/components/chat_icon/screen.cljs
@@ -11,7 +11,15 @@
   (when-not (string/blank? name)
     [react/view (:default-chat-icon styles)
      [react/text {:style (:default-chat-icon-text styles)}
-      (string/capitalize (second name))]]))
+      ;; TODO: for now we check if the first letter is a #
+      ;; which means it is most likely a public chat and
+      ;; use the second letter if that is the case
+      ;; a broader refactoring should clean up upstream params
+      ;; for default-chat-icon
+      (string/capitalize (if (and (= "#" (first name))
+                                  (< 1 (count name)))
+                           (second name)
+                           (first name)))]]))

 (defn dapp-badge [{:keys [online-view-wrapper online-view online-dot-left online-dot-right]}]
   [react/view online-view-wrapper


Releasing 0.8.0

Releasing 0.8.0

--- modules/bidi/project.clj
+++ modules/bidi/project.clj
@@ -1,12 +1,12 @@
 ;; Copyright © 2014 JUXT LTD.

-(defproject juxt.modular/bidi "0.8.0-SNAPSHOT"
+(defproject juxt.modular/bidi "0.8.0"
   :description "A modular extension that provides support for bidi routing"
   :url "https://github.com/juxt/modular/tree/master/modules/bidi"
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
   :dependencies [[com.stuartsierra/component "0.2.1"]
-                 [bidi "1.18.0-SNAPSHOT"]
+                 [bidi "1.18.0"]
                  [juxt.modular/ring "0.5.2"]
                  [prismatic/schema "0.3.3"]
                  [prismatic/plumbing "0.3.5"]]


♻ Remove db-fixture from congregation-test

Why:
- The namespace no more depends on the database

--- test/territory_bro/congregation_test.clj
+++ test/territory_bro/congregation_test.clj
@@ -8,14 +8,11 @@
             [territory-bro.commands :as commands]
             [territory-bro.congregation :as congregation]
             [territory-bro.events :as events]
-            [territory-bro.fixtures :refer [db-fixture]]
             [territory-bro.permissions :as permissions]
             [territory-bro.testutil :as testutil])
   (:import (java.time Instant)
            (java.util UUID)
            (territory_bro NoPermitException ValidationException WriteConflictException)))
-
-(use-fixtures :once (join-fixtures [db-fixture]))

 (defn- apply-events [events]
   (testutil/apply-events congregation/congregations-view events))


fix local name

fix local name

--- src/asphalt/core.clj
+++ src/asphalt/core.clj
@@ -360,12 +360,12 @@
   ([^String sql {:keys [sql-name escape-char param-start-char type-start-char name-encoder]
                  :or {sql-name sql escape-char \\ param-start-char \$ type-start-char \^}
                  :as options}]
-    (let [[sql-template result-types]  (isql/parse-sql-str sql escape-char param-start-char type-start-char)]
+    (let [[sql-tokens result-types]  (isql/parse-sql-str sql escape-char param-start-char type-start-char)]
       [(reduce (fn [st token] (conj st (if (string? token)
                                          token
                                          (let [[pname ptype] token]
                                            [(isql/encode-name pname) (isql/encode-param-type sql ptype)]))))
-         [] sql-template)
+         [] sql-tokens)
        (mapv (partial isql/encode-result-type sql) result-types)])))


Remporary disable advanced compilation on dist for more easy debugging.

--- scripts/dist.clj
+++ scripts/dist.clj
@@ -16,10 +16,11 @@
     :output-dir "resources/public/js"
     :closure-defines {"uxbox.repo.core.url"
                       "https://test.uxbox.io/api"}
-    :optimizations :advanced
+    :optimizations :simple
     :externs ["externs/main.js"]
     :source-map "resources/public/js/main.js.map"
     :static-fns true
+    :pretty-print true
     :language-in  :ecmascript5
     :language-out :ecmascript5
     :verbose true})


Bind Hayt's param stack

Bind Hayt's param stack

--- src/clojure/clojurewerkz/cassaforte/policies.clj
+++ src/clojure/clojurewerkz/cassaforte/policies.clj
@@ -114,7 +114,8 @@
 (defmacro forcing-prepared-statements
   "Forces prepared statements for operations executed in the body"
   [& body]
-  `(binding [hayt/*prepared-statement* true]
+  `(binding [hayt/*prepared-statement* true
+             hayt/*param-stack*        (atom [])]
      ~@body))

 (defmacro without-prepared-statements


remove inspect

remove inspect

--- src-cljs/frontend/components/issues.cljs
+++ src-cljs/frontend/components/issues.cljs
@@ -678,7 +678,7 @@
                                   (fn [tx-report]
                                     (om/refresh! owner)))
       (go-loop []
-        (when-let [res (utils/inspect (async/<! (om/get-state owner :results-ch)))]
+        (when-let [res (async/<! (om/get-state owner :results-ch))]
           (when (= (:q res) (om/get-state owner :issue-search))
             (om/set-state! owner :searching? false)
             (om/set-state! owner :results (sorted-results (:results res))))


Handle empty result set.

Handle empty result set.

--- src/cavm/sqleval.clj
+++ src/cavm/sqleval.clj
@@ -60,4 +60,6 @@
 ; XXX Add some param guards, esp. rows is a sorted-set, keys in store, select is vec of string.
 (defn evaluate [rows store {:keys [select where]}]
   (let [result-rows (restrict rows rows store where)]
-    (zipmap select (project result-rows store select))))
+    (if (seq result-rows)
+      (zipmap select (project result-rows store select))
+      '())))


Avoid division by zero in sequence-similarity.

--- src/clojush/util.clj
+++ src/clojush/util.clj
@@ -350,9 +350,11 @@
   [sequence1 sequence2]
   "Returns a number between 0 and 1, indicating how similar the sequences are as a normalized,
   inverted Levenshtein distance, it 1 indicating identity and 0 indicating no similarity."
-  (let [dist (levenshtein-distance sequence1 sequence2)
-        max-dist (max (count sequence1) (count sequence2))]
-    (/ (- max-dist dist) max-dist)))
+  (if (and (empty? sequence1) (empty? sequence2))
+    1
+    (let [dist (levenshtein-distance sequence1 sequence2)
+          max-dist (max (count sequence1) (count sequence2))]
+      (/ (- max-dist dist) max-dist))))

 ;;;;;;;;;;;;;;:::::;;;;;;;;;;;;;;
 ;; Simple Statistic Functions


Disable requiring swank

Disable requiring swank

--- src/circleci/init.clj
+++ src/circleci/init.clj
@@ -1,5 +1,5 @@
 (ns circleci.init
-  (:require circleci.swank)
+  ;;(:require circleci.swank)
   (:require circleci.db)
   (:require circleci.db.migrations)
   (:require circleci.web)


list? -> seq? in try macro

list? -> seq? in try macro

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -863,7 +863,7 @@

   Catches and handles JavaScript exceptions."
   [& forms]
-  (let [catch? #(and (list? %) (= (first %) 'catch))
+  (let [catch? #(and (seq? %) (= (first %) 'catch))
         [body catches] (split-with (complement catch?) forms)
         [catches fin] (split-with catch? catches)
         e (gensym "e")]


Document REPL special fns

Document REPL special fns

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -250,6 +250,21 @@
       form
       (wrap-fn form))))

+;; Special REPL fns, these provide compatiblity with Clojure functions
+;; that are not possible to reproduce given ClojureScript's compilation model
+;; All functions should have the following signature
+;;
+;; (fn self
+;;   ([repl-env env form]
+;;     (self repl-env env form))
+;;   ([repl-env env form opts]
+;;     ..))
+;;
+;; repl-env - IJavaScriptEnv instance
+;; env      - a cljs.analyzer environment, *not* cljs.env environment
+;; form     - complete form entered at the repl
+;; opts     - REPL options, essentially augmented cljs.closure/build options
+
 (def default-special-fns
   (let [load-file-fn
         (fn self
@@ -258,57 +273,57 @@
           ([repl-env env [_ file :as form] opts]
             (load-file repl-env file opts)))]
     {'in-ns
-     (fn self
-       ([repl-env env form]
-         (self repl-env env form nil))
-       ([repl-env env [_ [quote ns-name] :as form] _]
-         (when-not (ana/get-namespace ns-name)
-           (swap! env/*compiler* assoc-in [::ana/namespaces ns-name] {:name ns-name})
-           (-evaluate repl-env "<cljs repl>" 1
-             (str "goog.provide('" (comp/munge ns-name) "');")))
-         (set! ana/*cljs-ns* ns-name)))
+                             (fn self
+                               ([repl-env env form]
+                                 (self repl-env env form nil))
+                               ([repl-env env [_ [quote ns-name] :as form] _]
+                                 (when-not (ana/get-namespace ns-name)
+                                   (swap! env/*compiler* assoc-in [::ana/namespaces ns-name] {:name ns-name})
+                                   (-evaluate repl-env "<cljs repl>" 1
+                                     (str "goog.provide('" (comp/munge ns-name) "');")))
+                                 (set! ana/*cljs-ns* ns-name)))
      'require
-     (fn self
-       ([repl-env env form]
-         (self repl-env env form nil))
-       ([repl-env env [_ & specs :as form] opts]
-         (evaluate-form repl-env env "<cljs repl>"
-           (with-meta
-             `(~'ns ~ana/*cljs-ns*
-                (:require
-                  ~@(map
-                      (fn [quoted-spec-or-kw]
-                        (if (keyword? quoted-spec-or-kw)
-                          quoted-spec-or-kw
-                          (second quoted-spec-or-kw)))
-                      specs)))
-             {:merge true :line 1 :column 1})
-           identity opts)))
+                             (fn self
+                               ([repl-env env form]
+                                 (self repl-env env form nil))
+                               ([repl-env env [_ & specs :as form] opts]
+                                 (evaluate-form repl-env env "<cljs repl>"
+                                   (with-meta
+                                     `(~'ns ~ana/*cljs-ns*
+                                        (:require
+                                          ~@(map
+                                              (fn [quoted-spec-or-kw]
+                                                (if (keyword? quoted-spec-or-kw)
+                                                  quoted-spec-or-kw
+                                                  (second quoted-spec-or-kw)))
+                                              specs)))
+                                     {:merge true :line 1 :column 1})
+                                   identity opts)))
      'require-macros
-     (fn self
-       ([repl-env env form]
-         (self repl-env env form nil))
-       ([repl-env env [_ & specs :as form] opts]
-         (evaluate-form repl-env env "<cljs repl>"
-           (with-meta
-             `(~'ns ~ana/*cljs-ns*
-                (:require-macros
-                  ~@(map
-                      (fn [quoted-spec-or-kw]
-                        (if (keyword? quoted-spec-or-kw)
-                          quoted-spec-or-kw
-                          (second quoted-spec-or-kw)))
-                      specs)))
-             {:merge true :line 1 :column 1})
-           identity opts)))
-     'load-file load-file-fn
+                             (fn self
+                               ([repl-env env form]
+                                 (self repl-env env form nil))
+                               ([repl-env env [_ & specs :as form] opts]
+                                 (evaluate-form repl-env env "<cljs repl>"
+                                   (with-meta
+                                     `(~'ns ~ana/*cljs-ns*
+                                        (:require-macros
+                                          ~@(map
+                                              (fn [quoted-spec-or-kw]
+                                                (if (keyword? quoted-spec-or-kw)
+                                                  quoted-spec-or-kw
+                                                  (second quoted-spec-or-kw)))
+                                              specs)))
+                                     {:merge true :line 1 :column 1})
+                                   identity opts)))
+     'load-file              load-file-fn
      'clojure.core/load-file load-file-fn
      'load-namespace
-     (fn self
-       ([repl-env env form]
-         (self env repl-env form nil))
-       ([repl-env env [_ ns :as form] opts]
-         (load-namespace repl-env ns opts)))}))
+                             (fn self
+                               ([repl-env env form]
+                                 (self env repl-env form nil))
+                               ([repl-env env [_ ns :as form] opts]
+                                 (load-namespace repl-env ns opts)))}))

 (defn analyze-source
   "Given a source directory, analyzes all .cljs files. Used to populate


whitespace

whitespace

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -23,8 +23,7 @@
     (try
       (-> http-client
         (.getParams)
-        (.setParameter ClientPNames/COOKIE_POLICY
-                      CookiePolicy/BROWSER_COMPATIBILITY))
+        (.setParameter ClientPNames/COOKIE_POLICY CookiePolicy/BROWSER_COMPATIBILITY))
       (let [http-url (str scheme "://" server-name
                           (if server-port (str ":" server-port))
                           uri


Deleted extra parens

Deleted extra parens