(SERVER-797) Reuse a ScriptingContainer throughout the http-client tests

Previously, each of the http-client tests created a new
ScriptingContainer.  This commit adds a test fixture to the http-client
tests which allows a Ruby ScriptingContainer to be created one time and
reused across all of the tests run for the namespace.  These changes
involve cleaning up http-client objects between tests to avoid
contamination, previously done just by throwing the entire
ScriptingContainer away.  Locally, this reduced the run time for the
namespace from about 51 to under 4 seconds.

--- test/unit/puppetlabs/puppetserver/ruby/http_client_test.clj
+++ test/unit/puppetlabs/puppetserver/ruby/http_client_test.clj
@@ -76,82 +76,120 @@
   map.  (This function differs from `jruby-tk-config` in that it returns a map
   that complies with the JRubyConfig schema, which differs slightly from the raw
   format that would be read from config files on disk.)"
-  ([]
-   (jruby-config {}))
-  ([options]
-   (jruby-core/initialize-config
-    (merge {:ruby-load-path (jruby-puppet-core/managed-load-path jruby-puppet-testutils/ruby-load-path)
-            :gem-home jruby-puppet-testutils/gem-home
-            :gem-path jruby-puppet-testutils/gem-path}
-           options))))
+  []
+  (jruby-core/initialize-config
+   {:ruby-load-path (jruby-puppet-core/managed-load-path
+                     jruby-puppet-testutils/ruby-load-path)
+    :gem-home jruby-puppet-testutils/gem-home
+    :gem-path jruby-puppet-testutils/gem-path}))

 (defn create-scripting-container
   "A JRuby ScriptingContainer with an instance of 'Puppet::Server::HttpClient'
   assigned to a variable 'c'.  The ScriptingContainer was created
   with LocalVariableBehavior.PERSISTENT so that the HTTP client instance
   will persistent across calls to 'runScriptlet' in tests."
-  ([port]
-   (create-scripting-container port {:use-ssl false}))
-  ([port options]
-   (let [jruby-config (jruby-config)
-         use-ssl?             (true? (:use-ssl options))
-         http-client-settings (get-http-client-settings
-                               (select-keys options [:ssl-protocols :cipher-suites]))
-         scripting-container (-> (jruby-impl-core/create-pool jruby-config)
-                                 (jruby-core/borrow-from-pool :http-client-test [])
-                                 :scripting-container)]
-     (.runScriptlet scripting-container "require 'puppet/server/http_client'")
-     (let [http-client-class (.runScriptlet scripting-container "Puppet::Server::HttpClient")]
-       (.callMethod scripting-container http-client-class "initialize_settings" http-client-settings Object))
-     (.runScriptlet scripting-container (str "require 'puppet/server/http_client';"
-                                             (format "$c = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
-                                                     port use-ssl?)))
-     (doto scripting-container
-       (.runScriptlet (format "Puppet[:hostcert] = '%s'" cert-pem))
-       (.runScriptlet (format "Puppet[:hostprivkey] = '%s'" privkey-pem))
-       (.runScriptlet (format "Puppet[:localcacert] = '%s'" ca-pem)))
-     scripting-container)))
+  []
+  (let [jruby-config (jruby-config)
+        scripting-container (-> (jruby-impl-core/create-pool jruby-config)
+                                (jruby-core/borrow-from-pool :http-client-test [])
+                                :scripting-container)]
+    (doto scripting-container,
+      (.runScriptlet "require 'puppet'")
+      (.runScriptlet (format "Puppet[:hostcert] = '%s'" cert-pem))
+      (.runScriptlet (format "Puppet[:hostprivkey] = '%s'" privkey-pem))
+      (.runScriptlet (format "Puppet[:localcacert] = '%s'" ca-pem)))
+    scripting-container))
+
+(defn create-http-client
+  [scripting-container port options]
+  (.runScriptlet scripting-container "require 'puppet/server/http_client'")
+  (let [use-ssl? (true? (:use-ssl options))
+        http-client-settings (get-http-client-settings
+                              (select-keys options [:ssl-protocols
+                                                    :cipher-suites]))
+        http-client-class (.runScriptlet scripting-container
+                                         "Puppet::Server::HttpClient")]
+    (.callMethod scripting-container http-client-class
+                 "initialize_settings" http-client-settings Object)
+    (.runScriptlet scripting-container
+                   (format "$c = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
+                           port use-ssl?))))
+
+(defn terminate-http-client
+  [scripting-container]
+  (.runScriptlet scripting-container "$c = nil")
+  ;; This step purges the '@ssl_context' which may have been used with an http
+  ;; client call.  This is necessary to ensure that any subsequent http client
+  ;; call utilizes a new SSL context rather than unintentionally using some
+  ;; cached state - e.g., ssl parameters from prior connection attempt.
+  (.runScriptlet scripting-container
+                 "Puppet::Server::Config.instance_variable_set('@ssl_context', nil)")
+  (.runScriptlet scripting-container "Puppet::Server::HttpClient.terminate"))

 (defn terminate-scripting-container
   [scripting-container]
-  (.runScriptlet scripting-container "Puppet::Server::HttpClient.terminate")
   (.terminate scripting-container))
+
+(def ^:dynamic ^:private *scripting-container* nil)
+
+(defmacro with-scripting-container
+  [scripting-container & body]
+  `(let [~scripting-container (or *scripting-container*
+                                  (create-scripting-container))]
+     (try
+       ~@body
+       (finally
+         (when-not *scripting-container*
+           (terminate-scripting-container ~scripting-container))))))
+
+(defmacro with-http-client
+  [scripting-container port options & body]
+  `(try
+     (create-http-client ~scripting-container ~port ~options)
+     ~@body
+     (finally
+       (terminate-http-client ~scripting-container))))
+
+(defn http-client-scripting-container-fixture
+  [test-fn]
+  (with-scripting-container sc
+    (binding [*scripting-container* sc]
+      (test-fn))))
+
+(clojure.test/use-fixtures :once http-client-scripting-container-fixture)

 (deftest test-ruby-http-client
   (jetty9/with-test-webserver ring-app port
-    (let [scripting-container (create-scripting-container port)]
+    (with-scripting-container sc
+      (with-http-client sc port {:use-ssl false}
       (testing "HTTP GET"
-        (is (= "hi" (.runScriptlet scripting-container "$c.get('/', {}).body"))))
-
+        (is (= "hi" (.runScriptlet sc "$c.get('/', {}).body"))))
       (testing "HTTP POST"
-        (is (= "hi" (.runScriptlet scripting-container "$c.post('/', 'foo', {}).body"))))
-
-      (terminate-scripting-container scripting-container))))
+        (is (= "hi" (.runScriptlet sc "$c.post('/', 'foo', {}).body"))))))))

 (deftest http-basic-auth
   (jetty9/with-test-webserver ring-app-with-auth port
-    (let [scripting-container (create-scripting-container port)]
-      (testing "no credentials"
-        (.runScriptlet scripting-container "$response = $c.post('/', 'foo', {})")
-        (is (= "401" (.runScriptlet scripting-container "$response.code")))
-        (is (= "access denied" (.runScriptlet scripting-container "$response.body"))))
-
-      (testing "valid credentials"
-        (let [auth "{ :basic_auth => { :user => 'foo', :password => 'bar' }}"]
-          (.runScriptlet scripting-container (format "$response = $c.post('/', 'foo', {}, %s)" auth)))
-        (is (= "200" (.runScriptlet scripting-container "$response.code")))
-        (is (= "hi" (.runScriptlet scripting-container "$response.body"))))
-
-      (testing "invalid credentials"
-        (let [auth "{ :basic_auth => { :user => 'foo', :password => 'baz' }}"]
-          (.runScriptlet scripting-container (format "$response = $c.post('/', 'foo', {}, %s)" auth)))
-        (is (= "401" (.runScriptlet scripting-container "$response.code")))
-        (is (= "access denied" (.runScriptlet scripting-container "$response.body"))))
-
-      (terminate-scripting-container scripting-container))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; SSL Tests
+    (with-scripting-container sc
+      (with-http-client sc port {:use-ssl false}
+        (testing "no credentials"
+          (.runScriptlet sc "$response = $c.post('/', 'foo', {})")
+          (is (= "401" (.runScriptlet sc "$response.code")))
+          (is (= "access denied" (.runScriptlet sc "$response.body"))))
+
+        (testing "valid credentials"
+          (let [auth "{ :basic_auth => { :user => 'foo', :password => 'bar' }}"]
+            (.runScriptlet sc (format "$response = $c.post('/', 'foo', {}, %s)" auth)))
+          (is (= "200" (.runScriptlet sc "$response.code")))
+          (is (= "hi" (.runScriptlet sc "$response.body"))))
+
+        (testing "invalid credentials"
+          (let [auth "{ :basic_auth => { :user => 'foo', :password => 'baz' }}"]
+            (.runScriptlet sc (format "$response = $c.post('/', 'foo', {}, %s)" auth)))
+          (is (= "401" (.runScriptlet sc "$response.code")))
+          (is (= "access denied" (.runScriptlet sc "$response.body"))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; SSL Tests

 (defmacro with-webserver-with-protocols
   [protocols cipher-suites & body]
@@ -181,166 +219,164 @@
 (deftest https-tls-defaults
   (testing "requests fail without an SSL client"
     (with-webserver-with-protocols nil nil
-      (let [sc (create-scripting-container 10080)]
-        (logutils/with-test-logging
+      (with-scripting-container sc
+        (with-http-client sc 10080 {:use-ssl false}
+         (logutils/with-test-logging
           (try
             (.runScriptlet sc (raise-caught-http-error "$c.get('/', {})"))
             (is false "Expected HTTP connection to HTTPS port to fail")
-           (catch EvalFailedException e
-             (is (instance? ConnectionClosedException (.getCause e))))))
-        (terminate-scripting-container sc))))
+            (catch EvalFailedException e
+              (is (instance? ConnectionClosedException (.getCause e))))))))))

   (testing "Can connect via TLSv1 by default"
     (with-webserver-with-protocols ["TLSv1"] nil
-       (let [sc (create-scripting-container 10080 {:use-ssl true})]
-         (.runScriptlet sc "$response = $c.get('/', {})")
-         (is (= "200" (.runScriptlet sc "$response.code")))
-         (is (= "hi" (.runScriptlet sc "$response.body")))
-         (terminate-scripting-container sc))))
+      (with-scripting-container sc
+        (with-http-client sc 10080 {:use-ssl true}
+          (.runScriptlet sc "$response = $c.get('/', {})")
+          (is (= "200" (.runScriptlet sc "$response.code")))
+          (is (= "hi" (.runScriptlet sc "$response.body")))))))

   (testing "Can connect via TLSv1.1 by default"
     (with-webserver-with-protocols ["TLSv1.1"] nil
-       (let [sc (create-scripting-container 10080 {:use-ssl true})]
-         (.runScriptlet sc "$response = $c.get('/', {})")
-         (is (= "200" (.runScriptlet sc "$response.code")))
-         (is (= "hi" (.runScriptlet sc "$response.body")))
-         (terminate-scripting-container sc))))
+      (with-scripting-container sc
+        (with-http-client sc 10080 {:use-ssl true}
+          (.runScriptlet sc "$response = $c.get('/', {})")
+          (is (= "200" (.runScriptlet sc "$response.code")))
+          (is (= "hi" (.runScriptlet sc "$response.body")))))))

   (testing "Can connect via TLSv1.2 by default"
     (with-webserver-with-protocols ["TLSv1.2"] nil
-       (let [sc (create-scripting-container 10080 {:use-ssl true})]
-         (.runScriptlet sc "$response = $c.get('/', {})")
-         (is (= "200" (.runScriptlet sc "$response.code")))
-         (is (= "hi" (.runScriptlet sc "$response.body")))
-         (terminate-scripting-container sc)))))
+      (with-scripting-container sc
+        (with-http-client sc 10080 {:use-ssl true}
+          (.runScriptlet sc "$response = $c.get('/', {})")
+          (is (= "200" (.runScriptlet sc "$response.code")))
+          (is (= "hi" (.runScriptlet sc "$response.body"))))))))

 (deftest https-sslv3
   (logutils/with-test-logging
     (with-webserver-with-protocols ["SSLv3"] nil
       (testing "Cannot connect via SSLv3 by default"
-        (let [sc (create-scripting-container 10080 {:use-ssl true})]
-          (try
-            (.runScriptlet sc (raise-caught-http-error "$c.get('/', {})"))
-            (is false "Expected HTTP connection to HTTPS port to fail")
-            (catch EvalFailedException e
-              (is (ssl-connection-exception? (.. e getCause getCause)))))
-          (terminate-scripting-container sc)))
+        (with-scripting-container sc
+          (with-http-client sc 10080 {:use-ssl true}
+            (try
+              (.runScriptlet sc (raise-caught-http-error "$c.get('/', {})"))
+              (is false "Expected HTTP connection to HTTPS port to fail")
+              (catch EvalFailedException e
+                (is (ssl-connection-exception? (.. e getCause getCause))))))))

       (testing "Can connect via SSLv3 when specified"
-        (let [sc (create-scripting-container
-                  10080
-                  {:ssl-protocols ["SSLv3" "TLSv1"]
-                   :use-ssl true})]
-          (.runScriptlet sc "$response = $c.get('/', {})")
-          (is (= "200" (.runScriptlet sc "$response.code")))
-          (is (= "hi" (.runScriptlet sc "$response.body")))
-          (terminate-scripting-container sc))))))
+        (with-scripting-container sc
+          (with-http-client sc 10080
+            {:ssl-protocols ["SSLv3" "TLSv1"]
+             :use-ssl true}
+            (.runScriptlet sc "$response = $c.get('/', {})")
+            (is (= "200" (.runScriptlet sc "$response.code")))
+            (is (= "hi" (.runScriptlet sc "$response.body")))))))))

 (deftest https-cipher-suites
   (logutils/with-test-logging
     (with-webserver-with-protocols ["SSLv3"] ["SSL_RSA_WITH_RC4_128_SHA"]
       (testing "Should not be able to connect if no matching ciphers"
-        (let [sc (create-scripting-container
-                  10080
-                  {:ssl-protocols ["SSLv3"]
-                   :cipher-suites ["SSL_RSA_WITH_RC4_128_MD5"]
-                   :use-ssl true})]
-          (try
-            (.runScriptlet sc (raise-caught-http-error "$c.get('/', {})"))
-            (is false "Expected HTTP connection to HTTPS port to fail")
-            (catch EvalFailedException e
-              (is (ssl-connection-exception? (.. e getCause)))))
-          (terminate-scripting-container sc)))
+        (with-scripting-container sc
+          (with-http-client sc 10080
+           {:ssl-protocols ["SSLv3"]
+            :cipher-suites ["SSL_RSA_WITH_RC4_128_MD5"]
+            :use-ssl true}
+           (try
+             (.runScriptlet sc (raise-caught-http-error "$c.get('/', {})"))
+             (is false "Expected HTTP connection to HTTPS port to fail")
+             (catch EvalFailedException e
+               (is (ssl-connection-exception? (.. e getCause))))))))

       (testing "Should be able to connect if explicit matching ciphers are configured"
-        (let [sc (create-scripting-container
-                  10080
-                  {:ssl-protocols ["SSLv3"]
-                   :cipher-suites ["SSL_RSA_WITH_RC4_128_SHA"]
-                   :use-ssl true})]
-          (.runScriptlet sc "$response = $c.get('/', {})")
-          (is (= "200" (.runScriptlet sc "$response.code")))
-          (is (= "hi" (.runScriptlet sc "$response.body")))
-          (terminate-scripting-container sc))))))
+        (with-scripting-container sc
+          (with-http-client sc 10080
+            {:ssl-protocols ["SSLv3"]
+             :cipher-suites ["SSL_RSA_WITH_RC4_128_SHA"]
+             :use-ssl true}
+            (.runScriptlet sc "$response = $c.get('/', {})")
+            (is (= "200" (.runScriptlet sc "$response.code")))
+            (is (= "hi" (.runScriptlet sc "$response.body")))))))))

 (deftest clients-persist
   (testing "client persists when making HTTP requests"
     (logutils/with-test-logging
       (jetty9/with-test-webserver ring-app port
-        (let [sc (create-scripting-container port)
-              client1 (.runScriptlet sc "$c.get('/', {}); $c.class.client")
-              client2 (.runScriptlet sc "$c.post('/', 'foo', {}); $c.class.client")]
-          (is (= client1 client2))
-          (terminate-scripting-container sc)))))
+      (with-scripting-container sc
+        (with-http-client sc port {:use-ssl false}
+          (let [client1 (.runScriptlet sc "$c.get('/', {}); $c.class.client")
+                client2 (.runScriptlet sc "$c.post('/', 'foo', {}); $c.class.client")]
+            (is (= client1 client2))))))))
   (testing "all instances of HttpClient have the same underlying client object"
     (logutils/with-test-logging
       (jetty9/with-test-webserver ring-app port
-        (let [sc (create-scripting-container port)
-              client1 (.runScriptlet sc "$c.class.client")
-              client2 (.runScriptlet sc (str (format "$c2 = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
-                                                  port false)
-                                          "$c2.class.client"))]
-          (is (= client1 client2))
-          (terminate-scripting-container sc))))))
+        (with-scripting-container sc
+          (with-http-client sc port {:use-ssl false}
+            (let [client1 (.runScriptlet sc "$c.class.client")
+                  client2 (.runScriptlet sc (str (format "$c2 = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
+                                                         port false)
+                                                 "$c2.class.client"))]
+              (is (= client1 client2)))))))))

 (deftest connections-closed
   (testing "connection header always set to close on get"
     (logutils/with-test-logging
       (jetty9/with-test-webserver ring-app-connection-closed port
-        (let [sc (create-scripting-container port)]
-          (is (= "The Connection header has value close" (.runScriptlet sc "$c.get('/', {}).body")))
-          (terminate-scripting-container sc)))))
+        (with-scripting-container sc
+          (with-http-client sc port {:use-ssl false}
+            (is (= "The Connection header has value close"
+                   (.runScriptlet sc "$c.get('/', {}).body"))))))))
   (testing "connection header always set to close on post"
     (logutils/with-test-logging
       (jetty9/with-test-webserver ring-app-connection-closed port
-        (let [sc (create-scripting-container port)]
-          (is (= "The Connection header has value close" (.runScriptlet sc "$c.post('/', 'foo', {}).body")))
-          (terminate-scripting-container sc)))))
+        (with-scripting-container sc
+          (with-http-client sc port {:use-ssl false}
+            (is (= "The Connection header has value close"
+                   (.runScriptlet sc "$c.post('/', 'foo', {}).body"))))))))
   (testing "client's terminate function closes the client"
     (logutils/with-test-logging
       (jetty9/with-test-webserver ring-app-connection-closed port
-        (let [sc (create-scripting-container port)]
-          (.runScriptlet sc "$response = $c.get('/', {})")
-          (is (= "200" (.runScriptlet sc "$response.code")))
-          (.runScriptlet sc "$c.class.terminate")
-          (try
+        (with-scripting-container sc
+          (with-http-client sc port {:use-ssl false}
             (.runScriptlet sc "$response = $c.get('/', {})")
-            (catch EvalFailedException e
-              (let [wrapped-exception (.getCause e)
-                    message           (.getMessage e)]
-                (is (instance? IllegalStateException wrapped-exception))
-                (is (re-find #"Request cannot be executed; I/O reactor status: STOPPED" message)))))
-          (.terminate sc))))))
-
+            (is (= "200" (.runScriptlet sc "$response.code")))
+            (.runScriptlet sc "$c.class.terminate")
+            (try
+              (.runScriptlet sc "$response = $c.get('/', {})")
+              (catch EvalFailedException e
+                (let [wrapped-exception (.getCause e)
+                      message (.getMessage e)]
+                  (is (instance? IllegalStateException wrapped-exception))
+                  (is (re-find #"Request cannot be executed; I/O reactor status: STOPPED" message)))))))))))

 (deftest http-and-https
   (testing "can make http calls after https calls without a new scripting container"
     (logutils/with-test-logging
       (jetty9/with-test-webserver ring-app-alternate port
         (with-webserver-with-protocols nil nil
-          (let [sc (create-scripting-container 10080 {:use-ssl true})]
-            (.runScriptlet sc "$response = $c.get('/', {})")
-            (is (= "200" (.runScriptlet sc "$response.code")))
-            (is (= "hi" (.runScriptlet sc "$response.body")))
-            (.runScriptlet sc (str (format "$c = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
-                                           port false)
-                                   "$response = $c.get('/', {})"))
-            (is (= "200" (.runScriptlet sc "$response.code")))
-            (is (= "bye" (.runScriptlet sc "$response.body")))
-            (terminate-scripting-container sc))))))
+          (with-scripting-container sc
+            (with-http-client sc 10080 {:use-ssl true}
+              (.runScriptlet sc "$response = $c.get('/', {})")
+              (is (= "200" (.runScriptlet sc "$response.code")))
+              (is (= "hi" (.runScriptlet sc "$response.body")))
+              (.runScriptlet sc (str (format "$c = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
+                                            port false)
+                                    "$response = $c.get('/', {})"))
+              (is (= "200" (.runScriptlet sc "$response.code")))
+              (is (= "bye" (.runScriptlet sc "$response.body")))))))))

   (testing "can make https calls after http calls without a new scripting container"
     (logutils/with-test-logging
       (jetty9/with-test-webserver ring-app-alternate port
         (with-webserver-with-protocols nil nil
-          (let [sc (create-scripting-container port)]
-            (.runScriptlet sc "$response = $c.get('/', {})")
-            (is (= "200" (.runScriptlet sc "$response.code")))
-            (is (= "bye" (.runScriptlet sc "$response.body")))
-            (.runScriptlet sc (str (format "$c = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
-                                           10080 true)
-                                   "$response = $c.get('/', {})"))
-            (is (= "200" (.runScriptlet sc "$response.code")))
-            (is (= "hi" (.runScriptlet sc "$response.body")))
-            (terminate-scripting-container sc)))))))
-
+          (with-scripting-container sc
+            (with-http-client sc port {:use-ssl false}
+              (.runScriptlet sc "$response = $c.get('/', {})")
+              (is (= "200" (.runScriptlet sc "$response.code")))
+              (is (= "bye" (.runScriptlet sc "$response.body")))
+              (.runScriptlet sc (str (format "$c = Puppet::Server::HttpClient.new('localhost', %d, {:use_ssl => %s});"
+                                             10080 true)
+                                    "$response = $c.get('/', {})"))
+              (is (= "200" (.runScriptlet sc "$response.code")))
+              (is (= "hi" (.runScriptlet sc "$response.body"))))))))))
+


Use middleware to attach schemas to requests

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -216,6 +216,10 @@
        :handlers   handlers
        :middleware (set/map-invert middleware)})))

+(defn wrap-with-schema [handler schema]
+  (fn [request]
+    (handler (assoc-in request [:rook :metadata :schema] schema))))
+
 (defn handler-form
   "Returns a Clojure form evaluating to a handler wrapped in middleware.
   The middleware stack includes the specified arg-resolvers, if any,
@@ -229,16 +233,19 @@
            verb-fn-sym
            arglist
            arg-resolvers
+           schema
            sync?]}]
   (let [prewrap-handler-sym (gensym (str handler-sym "__prewrap_handler__"))
-        resolving-mw-sym    (gensym
-                              (str middleware-sym "__with_arg_resolvers__"))]
+        wrapped-mw-sym      (gensym (str middleware-sym "__wrapped__"))]
     `(~apply-middleware
-       ~(if (seq arg-resolvers)
-          `(fn ~resolving-mw-sym [handler#]
+       ~(if (or (seq arg-resolvers) schema)
+          `(fn ~wrapped-mw-sym [handler#]
              (-> handler#
-               (rook/wrap-with-arg-resolvers ~@arg-resolvers)
-               ~middleware-sym))
+               ~@(if (seq arg-resolvers)
+                   [`(rook/wrap-with-arg-resolvers ~@arg-resolvers)])
+               ~middleware-sym
+               ~@(if schema
+                   [`(wrap-with-schema ~schema)])))
           middleware-sym)
        ~sync?
        (fn ~prewrap-handler-sym [~req]
@@ -269,11 +276,7 @@
                                     (map keyword route-params)
                                     route-params)]
                              (~handler-sym
-                               (-> ~req
-                                 (assoc :route-params route-params#)
-                                 ~@(if schema
-                                     [`(assoc-in [:rook :metadata :schema]
-                                         ~schema)]))))]))
+                               (assoc ~req :route-params route-params#)))]))
                routes)
            :else nil)))))


fixed path to css

fixed path to css

--- resources/leiningen/new/reagent_frontend/project.clj
+++ resources/leiningen/new/reagent_frontend/project.clj
@@ -39,7 +39,7 @@
                    :figwheel {:http-server-root "public"
                               :nrepl-port 7002
                               :nrepl-middleware ["cemerick.piggieback/wrap-cljs-repl"]
-                              :css-dirs ["resources/public/css"]}
+                              :css-dirs ["public/css"]}

                    :cljsbuild {:builds {:app {:source-paths ["env/dev/cljs"]
                                               :compiler {:main "{{project-ns}}.dev"


Splitting 'updating dynamic clusters' log into separate entries (#2065)

--- scheduler/src/cook/compute_cluster.clj
+++ scheduler/src/cook/compute_cluster.clj
@@ -530,11 +530,12 @@
         dissoc-ca-cert-vals
         (fn [configs]
           (map-vals dissoc-ca-cert configs))]
-    (log/info "Updating dynamic clusters."
-              {:current-configs (dissoc-ca-cert-vals current-configs)
-               :force? force?
-               :new-configs (dissoc-ca-cert-vals new-configs)
-               :updates (map #(update % :goal-config dissoc-ca-cert) updates)})
+    (doseq [[cluster-name config] (dissoc-ca-cert-vals current-configs)]
+      (log/info "Updating dynamic cluster current config for" cluster-name config))
+    (doseq [[cluster-name config] (dissoc-ca-cert-vals new-configs)]
+      (log/info "Updating dynamic cluster new config for" cluster-name config))
+    (doseq [{:keys [goal-config] :as updated-config} (map #(update % :goal-config dissoc-ca-cert) updates)]
+      (log/info "Updating dynamic cluster updated config for" (:name goal-config) (assoc updated-config :force? force?)))
     (let [updates-with-results (map
                                  #(assoc % :update-result
                                            (when (:valid? %) (execute-update! conn %)))


Fixed a bug due to lack of tests.

Fixed a bug due to lack of tests.

--- src/clojure/src/leela/blackbox/network/zmqserver.clj
+++ src/clojure/src/leela/blackbox/network/zmqserver.clj
@@ -147,8 +147,9 @@
     (msg-fail 400)))

 (defn handle-del [cluster msg]
-  "link" (exec-dellink cluster (subvec msg 1))
-  (msg-fail 400))
+  (case (first msg)
+    "link" (exec-dellink cluster (subvec msg 1))
+    (msg-fail 400)))

 (defn handle-message [cluster msg]
   (if (< (count msg) 1)


Added logger for remaining operations and removed dead code

--- src/clojure_rest/controllers/document_controller.clj
+++ src/clojure_rest/controllers/document_controller.clj
@@ -30,22 +30,12 @@
       (get-document id)))

 (defn update-document [id doc]
+  (log/info (str "update-document with id : " id ". New values : " doc))
       (let [document (assoc doc "id_document" id)]
         (jdbc/update! database/db-h2-connection :documents document ["id_document=?" id]))
     (get-document id))

 (defn delete-document [id]
+  (log/info (str "delete-document with id : " id))
     (jdbc/delete! database/db-h2-connection :documents ["id_document=?" id])
   {:status 204})
-
-
-; (defn update-document [id doc]
-;     (jdbc/with-connection (db-connection)
-;       (let [document (assoc doc "id" id)]
-;         (jdbc/update-values :documents ["id=?" id] document)))
-;     (get-document id))
-;
-; (defn delete-document [id]
-;   (jdbc/with-connection (db-connection)
-;     (jdbc/delete-rows :documents ["id=?" id]))
-;   {:status 204})


Added a summary method to the health protocol.

--- src/cmr/dev/env/manager/components/checks/health.clj
+++ src/cmr/dev/env/manager/components/checks/health.clj
@@ -5,6 +5,8 @@
     (cmr.dev.env.manager.components.docker DockerRunner)))

 (defprotocol Healthful
+  (get-summary [this]
+    "Provides high-level view on health of a component.")
   (get-status [this]
     "Performs a health check on a given component."))


CMR-713: Fixed collection additionalAttribute date range search.

--- src/cmr/search/services/aql/converters/attribute.clj
+++ src/cmr/search/services/aql/converters/attribute.clj
@@ -89,19 +89,30 @@
   [attrib-name value-elem]
   (let [{year :YYYY month :MM day :DD hour :HH minute :MI sec :SS} (:attrs value-elem)
         value (a/date-time-from-strings year month day hour minute sec)]
-    (qm/map->AttributeValueCondition
-      {:type :datetime
-       :name attrib-name
-       :value value})))
+    (qm/or-conds
+      [(qm/map->AttributeValueCondition
+         {:type :datetime
+          :name attrib-name
+          :value value})
+       (qm/map->AttributeValueCondition
+         {:type :date
+          :name attrib-name
+          :value value})])))

 (defmethod attrib-value-element->condition :dateRange
   [attrib-name value-elem]
   (let [[start-date stop-date] (a/parse-date-range-element value-elem)]
-    (qm/map->AttributeRangeCondition
-      {:type :datetime
-       :name attrib-name
-       :min-value start-date
-       :max-value stop-date})))
+    (qm/or-conds
+      [(qm/map->AttributeRangeCondition
+         {:type :datetime
+          :name attrib-name
+          :min-value start-date
+          :max-value stop-date})
+       (qm/map->AttributeRangeCondition
+         {:type :date
+          :name attrib-name
+          :min-value start-date
+          :max-value stop-date})])))

 (defmethod attrib-value-element->condition :time
   [attrib-name value-elem]


Don't add the html part if no html content is provided

--- src/clj/runbld/notifications/email.clj
+++ src/clj/runbld/notifications/email.clj
@@ -77,9 +77,10 @@
          [:alternative]
          attachments
          [{:type "text/plain; charset=utf-8"
-           :content plain}
-          {:type "text/html; charset=utf-8"
-           :content html}])]
+           :content plain}]
+         (when-not (empty? html)
+           [{:type "text/html; charset=utf-8"
+             :content html}]))]
     (mail/send-message
      conn
      {:from from


Add randomness to meadow connector

Add randomness to meadow connector

--- src/main/cljc/clojure_club/meadow_finder/mgrimm.cljc
+++ src/main/cljc/clojure_club/meadow_finder/mgrimm.cljc
@@ -89,9 +89,10 @@
 ;; Meadow connecting -----------------------------------------------------------

 (defn find-routes [cave meadows]
-  (for [[m1 m2] (partition 2 1 meadows)
-        :let [c1 (rand-nth m1), c2 (rand-nth m2)]]
-    (find-path cave c1 c2 {:cost-fn {\space 1, \# 1}, :dist-fn euclid})))
+  (letfn [(rand-cost [c] (when (#{\space \#} c) (rand-int 1000)))]
+    (for [[m1 m2] (partition 2 1 (shuffle meadows))
+          :let [c1 (rand-nth m1), c2 (rand-nth m2)]]
+      (find-path cave c1 c2 {:cost-fn rand-cost, :dist-fn euclid}))))

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


Document that watch-spec dirs must be on classpath

--- src/main/clojure/com/stuartsierra/lazytest/watch.clj
+++ src/main/clojure/com/stuartsierra/lazytest/watch.clj
@@ -68,10 +68,10 @@
       agnt)))

 (defn watch-spec
-  "Runs all specs in directory d, then watches d for changing
-  namespaces, reloads and runs their specs when they change.  Prints
-  reports to current *out*.  Returns the watching agent, send stop to
-  stop watching.
+  "Runs all specs in directory d, which must be on classpath, then
+  watches d for changing namespaces, reloads and runs their specs when
+  they change.  Prints reports to current *out*.  Returns the watching
+  agent, send stop to stop watching.

   Options are
     :reporter - report function, default is spec-report


fix(resources): Create project if not exists on run POST

--- src/main/clojure/com/xebia/visualreview/resource.clj
+++ src/main/clojure/com/xebia/visualreview/resource.clj
@@ -144,10 +144,14 @@
                      (let [runs (:runs (suite/get-full-suite (tx-conn ctx) (:project-id suite) (:id suite)))]
                        {::runs runs ::suite suite}))
                    (when-let [suite
-                              (or
-                                (suite/get-suite-by-name (tx-conn ctx) (-> ctx ::data :project-name) (-> ctx ::data :suite-name))
-                                (suite/get-suite-by-id (tx-conn ctx)
-                                                       (suite/create-suite-for-project! (tx-conn ctx) (-> ctx ::data :project-name) (-> ctx ::data :suite-name))))]
+                              (and
+                                (or
+                                  (project/get-project-by-name (tx-conn ctx) (-> ctx ::data :project-name))
+                                  (project/create-project! (tx-conn ctx) (-> ctx ::data :project-name)))
+                                (or
+                                  (suite/get-suite-by-name (tx-conn ctx) (-> ctx ::data :project-name) (-> ctx ::data :suite-name))
+                                  (suite/get-suite-by-id (tx-conn ctx)
+                                                         (suite/create-suite-for-project! (tx-conn ctx) (-> ctx ::data :project-name) (-> ctx ::data :suite-name)))))]
                      {::suite suite})))
     :can-post-to-missing? false
     :post! (fn [ctx]


removed leftover debug logging

removed leftover debug logging

--- src/main/clojure/com/xebia/visualreview/resource.clj
+++ src/main/clojure/com/xebia/visualreview/resource.clj
@@ -28,8 +28,7 @@
             [com.xebia.visualreview.service.project :as project]
             [com.xebia.visualreview.service.suite :as suite]
             [com.xebia.visualreview.service.run :as run]
-            [com.xebia.visualreview.service.baseline :as baseline]
-            [com.xebia.visualreview.logging :as log])
+            [com.xebia.visualreview.service.baseline :as baseline])
   (:import [java.util Map]))

 ;;;;;;;;; Projects ;;;;;;;;;;;
@@ -152,14 +151,9 @@
                      {::suite suite})))
     :can-post-to-missing? false
     :post! (fn [ctx]
-             (do
-               (log/error (:id (::suite ctx)) )
              (let [new-run-id (run/create-run! (tx-conn ctx) (:id (::suite ctx)))
                    run (run/get-run (tx-conn ctx) new-run-id)]
-               (do
-                 (log/error (str "new run id is " new-run-id))
-               {::run run})))
-               )
+               {::run run}))
     :handle-created ::run
     :handle-ok ::runs))


Fuzzy factorization now gets truth values explicitly

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

--- src/conexp/contrib/factor_analysis.clj
+++ src/conexp/contrib/factor_analysis.clj
@@ -140,9 +140,8 @@
   such that the cardinality of the set returned by fuzzy-oplus-a is
   maximal. Returns the triple [m v count], where count is the
   aforementioned cardinality."
-  [context U D]
-  (let [values     (set (vals (incidence context))),
-        attributes (set-of m [[[_ m] _] (select-keys (incidence context) U)])] ;note: is not empty
+  [values context U D]
+  (let [attributes (set-of m [[[_ m] _] (select-keys (incidence context) U)])] ;note: is not empty
     (with-local-vars [attribute nil,
                       max-value -1,
                       fuzzyness nil]
@@ -157,9 +156,9 @@
       [(var-get attribute) (var-get fuzzyness), (var-get max-value)])))

 (defmethod factorize-context :fuzzy
-  [_ context]
+  [_ context truth-values]
   (let [inz          (incidence context),
-        find-maximal (partial find-maximal context)]
+        find-maximal (partial find-maximal truth-values context)]
     (loop [U (set-of [g m] [g (objects context),
                             m (attributes context),
                             :when (not (zero? (inz [g m])))]),


Rename `assortment-impl` to `assortment-pre-wrap` Also, make arguments a map, to match other pre-wraps

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -703,8 +703,8 @@
         (perun/report-info task-name (str task-name " found nothing to render"))
         []))))

-(defn- assortment-impl
-  [task-name tracer grouper options]
+(defn assortment-pre-wrap
+  [{:keys [task-name tracer grouper options]}]
   (cond (not (fn? (:comparator options)))
         (u/fail (str task-name " task :comparator option should implement Fn\n"))
         (not (ifn? (:filterer options)))
@@ -764,8 +764,12 @@
    m meta       META       edn   "metadata to set on each collection entry"
    n task-name  TASKNAME   str   "name to use for logging messages; only for tasks that use assortment under the hood"
    t tracer     TRACER     kw    "value to put in `:io.perun/trace`; only for tasks that use assortment under the hood"]
-  (let [options (merge +assortment-defaults+ (dissoc *opts* :grouper))]
-    (assortment-impl "assortment" :io.perun/assortment grouper options)))
+  (let [grouper (or grouper #(-> {"index.html" {:entries %}}))
+        options (merge +assortment-defaults+ (dissoc *opts* :grouper))]
+    (assortment-pre-wrap {:task-name "assortment"
+                          :tracer :io.perun/assortment
+                          :grouper grouper
+                          :options options})))

 (def ^:private +collection-defaults+
   {:out-dir "public"
@@ -795,10 +799,11 @@
    c comparator COMPARATOR code  "sort by comparator function"
    p page       PAGE       str   "collection result page path"
    m meta       META       edn   "metadata to set on each collection entry"]
-  (let [p (or page "index.html")
-        options (merge +collection-defaults+ (dissoc *opts* :page))
-        grouper #(-> {p {:entries %}})]
-    (assortment-impl "collection" :io.perun/collection grouper options)))
+  (let [p (or page "index.html")]
+    (assortment-pre-wrap {:task-name "collection"
+                          :tracer :io.perun/collection
+                          :grouper #(-> {p {:entries %}})
+                          :options (merge +collection-defaults+ (dissoc *opts* :page))})))

 (def +inject-scripts-defaults+
   {:extensions [".html"]})


Use form field components for SSH keys

Use form field components for SSH keys

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -1006,12 +1006,13 @@
                    {:title "Add an SSH Key"
                     :body (html
                            [:form
-                            [:input#hostname {:required true ,:type "text" :value (str hostname)
-                                              :on-change #(utils/edit-input owner (conj state/project-data-path :new-ssh-key :hostname) %)}]
-                            [:label {:placeholder "Hostname"}]
-                            [:textarea#privateKey {:required true :value (str private-key)
-                                                   :on-change #(utils/edit-input owner (conj state/project-data-path :new-ssh-key :private-key) %)}]
-                            [:label {:placeholder "Private Key"}]])
+                            (form/text-field {:label "Hostname"
+                                              :value hostname
+                                              :on-change #(utils/edit-input owner (conj state/project-data-path :new-ssh-key :hostname) %)})
+                            (form/text-area {:label "Private Key"
+                                             :required true
+                                             :value private-key
+                                             :on-change #(utils/edit-input owner (conj state/project-data-path :new-ssh-key :private-key) %)})])
                     :actions [(button/button {:on-click close-fn} "Cancel")
                               (forms/managed-button
                              [:input.btn.btn-primary


Ellipsis has three dots

Ellipsis has three dots

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -1021,7 +1021,7 @@
                              [:input.btn.btn-primary
                               {:data-failed-text "Failed"
                                :data-success-text "Saved"
-                               :data-loading-text "Saving.."
+                               :data-loading-text "Saving..."
                                :value "Add SSH Key"
                                :type "submit"
                                :on-click #(raise! owner [:saved-ssh-key {:project-id project-id


Keyword searches not restricted to the start of the sentence.

Keyword searches previously only filtered the start of the sentence.
Now spraffbot finds any n-gram containing the keyword and can generate a
sentence backward and forward from that n-gram.  Not sure what the
performance will be like on a large corpus.  Also added some
canonicaliser gubbins, as many of the vecs in the system are believed to
be dups.

--- Spraff/src/spraff/core.clj
+++ Spraff/src/spraff/core.clj
@@ -22,11 +22,36 @@
 (def retries 3)

 (def empty-state {
-    :table {}
-    :starter []
+    :forwardtable {}
+    :backwardtable {}
+    :n-grams []
 })

-(defn split-sentence-to-words [sentence] (map #(.intern %) (re-seq word-pattern sentence)))
+
+(defn make-canonicalizer [] {
+    :whm (new java.util.WeakHashMap)
+    :lock (new java.lang.Object)})
+
+(defn canonical-get [c v]
+    {
+        :pre [v]
+        :post [% (= v %)]
+    }
+
+    (locking (:lock c)
+        (if-let [result
+            (if-let [wr (.get (:whm c) v)]
+                (if-let [ret (.get wr)]
+                    ret))]
+            result
+            (do
+                (.put (:whm c) v (new java.lang.ref.WeakReference v))
+                (canonical-get c v) ))))
+
+(def canon (let [c (make-canonicalizer)]
+    (fn [v] (canonical-get c v))))
+
+(defn split-sentence-to-words [sentence] (map canon (re-seq word-pattern sentence)))

 (defn select [c i]
     (let [[word weight] (first c)]
@@ -45,25 +70,33 @@
             (cons [word had-choice] (further-stream-of-shite (concat (rest prefix) [word]) t)))))
 (defn stream-of-shite [prefix t]
     (concat (map vector prefix (repeat false)) (further-stream-of-shite prefix t)))
+
+(defn sentence-from-seed [seed backward forward]
+    (concat
+        (drop-last prefix-length
+            (reverse (take 500 (stream-of-shite (reverse seed) backward))))
+        (take 500 (stream-of-shite seed forward))))
+
 (defn generate-sentence [state keywords]
-    (let [{:keys [table starters]} state]
-        (if (empty? keywords)
-            (drop-last (map first
-                (apply max-key #(count (filter true? (map second %)))
-                    (take retries (repeatedly #(take 1000 (stream-of-shite
-                        (nth starters (rand-int (count starters)))
-                        table)))))))
-            (let [filtered-starters
-                    (filter
-                        (fn [s] (not (empty? (filter
-                            (fn [k] (not (empty? (filter #(.contains % k) s))))
-                            keywords))))
-                        starters)]
-                (if (empty? filtered-starters)
-                    (generate-sentence state [])
-                    (generate-sentence
-                        (assoc state :starters filtered-starters)
-                        []))))))
+    (println "keywords: " keywords "\n")
+    (if (empty? keywords)
+        (remove keyword? (map first
+            (apply max-key #(count (filter true? (map second %)))
+                (take retries (repeatedly #(sentence-from-seed
+                    (rand-nth (:n-grams state))
+                    (:backwardtable state)
+                    (:forwardtable state)))))))
+        (let [filtered-grams
+                (remove
+                    (fn [s] (empty? (remove
+                        (fn [k] (empty? (filter #(.contains % k) (remove keyword? s))))
+                        keywords)))
+                    (:n-grams state))]
+            (if (empty? filtered-grams)
+                (generate-sentence state [])
+                (generate-sentence
+                    (assoc state :n-grams filtered-grams)
+                    [])))))

 (defn value-or-default [value default]
     (if (nil? value) default value))
@@ -82,20 +115,28 @@
         (let [[prefix remainder] (split-at prefix-length words)]
             (recur
                 (update-transition
-                    prefix
+                    (canon (vec prefix))
                     (first remainder)
                     table)
                 (rest words)))
         table))
+(defn update-ngrams [ngrams words]
+    (if (>= (count words) prefix-length)
+        (let [[prefix remainder] (split-at prefix-length words)]
+            (recur
+                (conj ngrams (canon (vec prefix)))
+                (rest words)))
+        ngrams))
+
 (defn update-state [message state]
-    (let [words (split-sentence-to-words message)]
+    (let [words (concat [:begin] (split-sentence-to-words message) [:end])]
         (assoc state
-            :table
-                (update-table (:table state) (concat [:begin] words [:end]))
-            :starters
-                (if (>= (count words) prefix-length)
-                    (conj (:starters state) (take prefix-length words))
-                    (:starters state)))))
+            :forwardtable
+                (update-table (:forwardtable state) words)
+            :backwardtable
+                (update-table (:backwardtable state) (reverse words))
+            :n-grams
+                (update-ngrams (:n-grams state) words))))
 (defn log-sentence! [message]
     (with-open [out (writer corpus-file :append true)]
         (.write out (str message "\n"))))
@@ -176,7 +217,7 @@
         (send-message irc channel
             (join " " (generate-sentence
                 @state-ref
-                (let [keywords (set (filter #(not (.contains % (:name @irc))) (split-sentence-to-words message)))]
+                (let [keywords (set (remove #(.contains % (:name @irc)) (split-sentence-to-words message)))]
                     (if (<= (count keywords) 3) keywords #{}))))))
     (if (.startsWith message "!burrito")
         (send-message irc channel


Reducing number of retries, based on a complete hunch that 5 will be too biased.

--- Spraff/src/spraff/core.clj
+++ Spraff/src/spraff/core.clj
@@ -21,7 +21,7 @@
 (def word-pattern #"\S+")
 (def generated-sentence-length 30)
 (def prefix-length 3)
-(def retries 5)
+(def retries 3)

 (def table (ref {}))
 (def starters (ref []))


Fix off-by-one error in parallelism picker.

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -243,8 +243,7 @@
           [:div.try-out-build
            (om/build branch-picker project-data {:opts {:button-text (str "Try a build!")}})])
         [:form.parallelism-items
-         (for [parallelism (range 1 (max (plan-model/max-parallelism plan)
-                                         (inc 24)))]
+         (for [parallelism (range 1 (inc (max 24 (plan-model/max-parallelism plan))))]
            [:label {:class (parallel-label-classes project-data parallelism)
                     :for (str "parallel_input_" parallelism)}
             parallelism


fix another core.async blocking check issue

--- src/main/shadow/cljs/devtools/server/repl_system.clj
+++ src/main/shadow/cljs/devtools/server/repl_system.clj
@@ -98,16 +98,17 @@
                               ::m/runtime-id runtime-id
                               ::m/runtime-info runtime-info})

-    (go (loop []
-          (when-some [msg (<! runtime-out)]
-            (handle-runtime-msg state-ref runtime-data msg)
-            (recur)
-            ))
-
-        (send-to-tools state-ref {::m/op ::m/runtime-disconnect
-                                  ::m/runtime-id runtime-id})
-
-        (swap! state-ref update :runtimes dissoc runtime-id))
+    (async/thread
+      (loop []
+        (when-some [msg (<!! runtime-out)]
+          (handle-runtime-msg state-ref runtime-data msg)
+          (recur)
+          ))
+
+      (send-to-tools state-ref {::m/op ::m/runtime-disconnect
+                                ::m/runtime-id runtime-id})
+
+      (swap! state-ref update :runtimes dissoc runtime-id))

     runtime-in
     ))
@@ -132,17 +133,18 @@

     (swap! state-ref assoc-in [:tools tool-id] tool-data)

-    (go (loop []
-          (when-some [msg (<! tool-in)]
-            (handle-tool-msg state-ref tool-data msg)
-            (recur)))
-
-        ;; send to all runtimes so they can cleanup state?
-        (send-to-runtimes state-ref {::m/op ::m/tool-disconnect
-                                     ::m/tool-id tool-id})
-
-        (swap! state-ref update :tools dissoc tool-id)
-        (async/close! tool-out))
+    (async/thread
+      (loop []
+        (when-some [msg (<!! tool-in)]
+          (handle-tool-msg state-ref tool-data msg)
+          (recur)))
+
+      ;; send to all runtimes so they can cleanup state?
+      (send-to-runtimes state-ref {::m/op ::m/tool-disconnect
+                                   ::m/tool-id tool-id})
+
+      (swap! state-ref update :tools dissoc tool-id)
+      (async/close! tool-out))

     tool-out))


Update luhn test

Update luhn test

Remove obviated requirement of #'clojure.test/run-tests.

--- luhn/luhn_test.clj
+++ luhn/luhn_test.clj
@@ -1,5 +1,5 @@
 (ns luhn-test
-  (:require [clojure.test :refer [deftest is run-tests]]))
+  (:require [clojure.test :refer [deftest is]]))

 (deftest checksum-works
   (is (= 2 (luhn/checksum 10)))


Improve error message for deprecated keys.

--- src/onyx/static/helpful_job_errors.clj
+++ src/onyx/static/helpful_job_errors.clj
@@ -458,7 +458,10 @@
         context (get-in job (take n-deep (:path error-data)))
         entry (get-in model [(structure-names structure-type) :model faulty-key])
         match-f (match-map-or-val error-data)
-        error-f (display-err-map-or-val [(join " " (into ["Value must be"] (predicate-error-msg context error-data)))])]
+        error-pre (if (= 'deprecated-key? (:predicate error-data))
+                    "Deprecation error,"
+                    "Value must be")
+        error-f (display-err-map-or-val [(join " " (into [error-pre] (predicate-error-msg context error-data)))])]
     (show-header (first (:path error-data)) faulty-key)
     (show-value context (- path-len n-deep) match-f error-f)
     (println)


supports returning a dummy driver

supports returning a dummy driver

--- cljx/plongeur-cljs/src/kierros/sente_client_driver.cljs
+++ cljx/plongeur-cljs/src/kierros/sente_client_driver.cljs
@@ -8,17 +8,22 @@
 (defn make-sente-client-driver
   "Accepts a path and options.
   Returns a websocket client driver powered by Sente."
-  [path & options]
-  (prn options)
-  (fn [request-chan]
-    (let [{:keys [chsk ch-recv send-fn]} (s/make-channel-socket-client! path {:host "localhost:3000"})
-          server-response-chan           (chan 10)
-          router-shutdown-fn             (s/start-chsk-router! ch-recv #(go (>! server-response-chan %)))]
-      (go-loop []
-               (if-let [request->server (<! request-chan)]
-                 (do (send-fn request->server)
-                     (recur))
-                 (do (some-> chsk s/chsk-disconnect!)
-                     (router-shutdown-fn)
-                     (prn "sente client driver stopped"))))
-      server-response-chan)))
+  [{:keys [path host]} & options]
+  (if (-> options set :dummy)
+    (fn [_]
+      (prn "dummy sente client driver")
+      (chan 10))
+    (fn [request-chan]
+      (let [{:keys [chsk ch-recv send-fn]} (s/make-channel-socket-client! path {:host host})
+            server-response-chan (chan 10)
+            router-shutdown-fn (s/start-chsk-router! ch-recv #(go (>! server-response-chan %)))]
+        (go-loop []
+                 (if-let [request->server (<! request-chan)]
+                   (do (send-fn request->server)
+                       (recur))
+                   (do (some-> chsk s/chsk-disconnect!)
+                       (router-shutdown-fn)
+                       (prn "sente client driver stopped"))))
+        server-response-chan)))
+
+  )


added use for unless-headless

added use for unless-headless

--- clojure/spec/limelight/clojure/specs/spec_helper_spec.clj
+++ clojure/spec/limelight/clojure/specs/spec_helper_spec.clj
@@ -3,6 +3,7 @@
     [speclj.core]
     [limelight.clojure.util :only (->options)]
     [limelight.clojure.specs.spec-helper]
+    [limelight.clojure.spec-helper]
     [limelight.clojure.core :as ll :exclude (production stage scene)]))

 (unless-headless


Make api indentation consistent

Make api indentation consistent

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -139,35 +139,35 @@
   "Takes a peer configuration, job map, and optional monitoring config,
    sending the job to the cluster for eventual execution."
   ([peer-config job]
-     (submit-job peer-config job {:monitoring :no-op}))
+   (submit-job peer-config job {:monitoring :no-op}))
   ([peer-config job monitoring-config]
-     (try (validator/validate-peer-config peer-config)
-          (validator/validate-job (assoc job :workflow (:workflow job)))
-          (validator/validate-flow-conditions (:flow-conditions job) (:workflow job))
-          (validator/validate-lifecycles (:lifecycles job) (:catalog job))
-          (validator/validate-windows (:windows job) (:catalog job))
-          (validator/validate-triggers (:triggers job) (:windows job))
-          (catch Throwable t
-            (error t)
-            (throw t)))
-     (let [id (java.util.UUID/randomUUID)
-           tasks (planning/discover-tasks (:catalog job) (:workflow job))
-           entry (create-submit-job-entry id peer-config job tasks)
-           client (component/start (system/onyx-client peer-config monitoring-config))]
-       (extensions/write-chunk (:log client) :catalog (:catalog job) id)
-       (extensions/write-chunk (:log client) :workflow (:workflow job) id)
-       (extensions/write-chunk (:log client) :flow-conditions (:flow-conditions job) id)
-       (extensions/write-chunk (:log client) :lifecycles (:lifecycles job) id)
-       (extensions/write-chunk (:log client) :windows (:windows job) id)
-       (extensions/write-chunk (:log client) :triggers (:triggers job) id)
-
-       (doseq [task tasks]
-         (extensions/write-chunk (:log client) :task task id))
-
-       (extensions/write-log-entry (:log client) entry)
-       (component/stop client)
-       {:job-id id
-        :task-ids (zipmap (map :name tasks) tasks)})))
+   (try (validator/validate-peer-config peer-config)
+        (validator/validate-job (assoc job :workflow (:workflow job)))
+        (validator/validate-flow-conditions (:flow-conditions job) (:workflow job))
+        (validator/validate-lifecycles (:lifecycles job) (:catalog job))
+        (validator/validate-windows (:windows job) (:catalog job))
+        (validator/validate-triggers (:triggers job) (:windows job))
+        (catch Throwable t
+          (error t)
+          (throw t)))
+   (let [id (java.util.UUID/randomUUID)
+         tasks (planning/discover-tasks (:catalog job) (:workflow job))
+         entry (create-submit-job-entry id peer-config job tasks)
+         client (component/start (system/onyx-client peer-config monitoring-config))]
+     (extensions/write-chunk (:log client) :catalog (:catalog job) id)
+     (extensions/write-chunk (:log client) :workflow (:workflow job) id)
+     (extensions/write-chunk (:log client) :flow-conditions (:flow-conditions job) id)
+     (extensions/write-chunk (:log client) :lifecycles (:lifecycles job) id)
+     (extensions/write-chunk (:log client) :windows (:windows job) id)
+     (extensions/write-chunk (:log client) :triggers (:triggers job) id)
+
+     (doseq [task tasks]
+       (extensions/write-chunk (:log client) :task task id))
+
+     (extensions/write-log-entry (:log client) entry)
+     (component/stop client)
+     {:job-id id
+      :task-ids (zipmap (map :name tasks) tasks)})))

 (defn ^{:added "0.6.0"} kill-job
   "Kills a currently executing job, given it's job ID. All peers executing
@@ -175,16 +175,16 @@
    Task lifecycle APIs for closing tasks are invoked. This job is never again scheduled
    for execution."
   ([peer-config job-id]
-     (kill-job peer-config job-id {:monitoring :no-op}))
+   (kill-job peer-config job-id {:monitoring :no-op}))
   ([peer-config job-id monitoring-config]
-     (validator/validate-peer-config peer-config)
-     (when (nil? job-id)
-       (throw (ex-info "Invalid job id" {:job-id job-id})))
-     (let [client (component/start (system/onyx-client peer-config monitoring-config))
-           entry (create-log-entry :kill-job {:job (validator/coerce-uuid job-id)})]
-       (extensions/write-log-entry (:log client) entry)
-       (component/stop client)
-       true)))
+   (validator/validate-peer-config peer-config)
+   (when (nil? job-id)
+     (throw (ex-info "Invalid job id" {:job-id job-id})))
+   (let [client (component/start (system/onyx-client peer-config monitoring-config))
+         entry (create-log-entry :kill-job {:job (validator/coerce-uuid job-id)})]
+     (extensions/write-log-entry (:log client) entry)
+     (component/stop client)
+     true)))

 (defn ^{:added "0.6.0"} subscribe-to-log
   "Sends all events from the log to the provided core.async channel.
@@ -195,12 +195,12 @@
    convenient for directly querying the znodes. :env can be shutdown with
    the onyx.api/shutdown-env function"
   ([peer-config ch]
-     (subscribe-to-log peer-config ch {:monitoring :no-op}))
+   (subscribe-to-log peer-config ch {:monitoring :no-op}))
   ([peer-config ch monitoring-config]
-     (validator/validate-peer-config peer-config)
-     (let [env (component/start (system/onyx-client peer-config monitoring-config))]
-       {:replica (extensions/subscribe-to-log (:log env) ch)
-        :env env})))
+   (validator/validate-peer-config peer-config)
+   (let [env (component/start (system/onyx-client peer-config monitoring-config))]
+     {:replica (extensions/subscribe-to-log (:log env) ch)
+      :env env})))

 (defn ^{:added "0.6.0"} gc
   "Invokes the garbage collector on Onyx. Compresses all local replicas
@@ -214,26 +214,26 @@
   ([peer-config monitoring-config]
    (validator/validate-peer-config peer-config)
    (let [id (java.util.UUID/randomUUID)
-           client (component/start (system/onyx-client peer-config monitoring-config))
-           entry (create-log-entry :gc {:id id})
-           ch (chan 1000)]
-       (extensions/write-log-entry (:log client) entry)
-
-       (loop [replica (extensions/subscribe-to-log (:log client) ch)]
-         (let [entry (<!! ch)
-               new-replica (extensions/apply-log-entry entry replica)]
-           (if (and (= (:fn entry) :gc) (= (:id (:args entry)) id))
-             (let [diff (extensions/replica-diff entry replica new-replica)]
-               (extensions/fire-side-effects! entry replica new-replica diff {:id id :log (:log client)}))
-             (recur new-replica))))
-       (component/stop client)
-       true)))
+         client (component/start (system/onyx-client peer-config monitoring-config))
+         entry (create-log-entry :gc {:id id})
+         ch (chan 1000)]
+     (extensions/write-log-entry (:log client) entry)
+
+     (loop [replica (extensions/subscribe-to-log (:log client) ch)]
+       (let [entry (<!! ch)
+             new-replica (extensions/apply-log-entry entry replica)]
+         (if (and (= (:fn entry) :gc) (= (:id (:args entry)) id))
+           (let [diff (extensions/replica-diff entry replica new-replica)]
+             (extensions/fire-side-effects! entry replica new-replica diff {:id id :log (:log client)}))
+           (recur new-replica))))
+     (component/stop client)
+     true)))

 (defn ^{:added "0.7.4"} await-job-completion
   "Blocks until job-id has had all of its tasks completed or the job is killed.
    Returns true if the job completed successfully, false if the job was killed."
   ([peer-config job-id]
-     (await-job-completion peer-config job-id {:monitoring-config {:monitoring :no-op}}))
+   (await-job-completion peer-config job-id {:monitoring-config {:monitoring :no-op}}))
   ([peer-config job-id {:keys [monitoring-config timeout-ms]}]
    (validator/validate-peer-config peer-config)
    (let [job-id (validator/coerce-uuid job-id)
@@ -282,24 +282,24 @@
    a 3rd argument - a monitoring configuration map. See the User Guide
    for details."
   ([n peer-group]
-     (start-peers n peer-group {:monitoring :no-op}))
+   (start-peers n peer-group {:monitoring :no-op}))
   ([n {:keys [config] :as peer-group} monitoring-config]
-     (when-not (= (type peer-group) onyx.system.OnyxPeerGroup)
-       (throw (Exception. (str "start-peers must supplied with a peer-group not a " (type peer-group)))))
-     (validator/validate-java-version)
-     (doall
-      (map
-       (fn [_]
-         (let [v-peer (system/onyx-peer peer-group monitoring-config)
-               live (component/start v-peer)
-               shutdown-ch (chan 1)
-               ack-ch (chan)
-               started-peer (atom live)]
-           {:peer-lifecycle (future (peer-lifecycle started-peer config shutdown-ch ack-ch))
-            :started-peer started-peer
-            :shutdown-ch shutdown-ch
-            :ack-ch ack-ch}))
-       (range n)))))
+   (when-not (= (type peer-group) onyx.system.OnyxPeerGroup)
+     (throw (Exception. (str "start-peers must supplied with a peer-group not a " (type peer-group)))))
+   (validator/validate-java-version)
+   (doall
+    (map
+     (fn [_]
+       (let [v-peer (system/onyx-peer peer-group monitoring-config)
+             live (component/start v-peer)
+             shutdown-ch (chan 1)
+             ack-ch (chan)
+             started-peer (atom live)]
+         {:peer-lifecycle (future (peer-lifecycle started-peer config shutdown-ch ack-ch))
+          :started-peer started-peer
+          :shutdown-ch shutdown-ch
+          :ack-ch ack-ch}))
+     (range n)))))

 (defn ^{:added "0.6.0"} shutdown-peer
   "Shuts down the virtual peer, which releases all of its resources
@@ -321,7 +321,7 @@
 (defn ^{:added "0.6.0"} start-env
   "Starts a development environment using an in-memory implementation ZooKeeper."
   ([env-config]
-     (start-env env-config {:monitoring :no-op}))
+   (start-env env-config {:monitoring :no-op}))
   ([env-config monitoring-config]
    (validator/validate-env-config env-config)
    (component/start (system/onyx-development-env env-config monitoring-config))))


remove prevent default

remove prevent default

--- src/om_bootstrap/pagination.cljs
+++ src/om_bootstrap/pagination.cljs
@@ -16,11 +16,7 @@
 (sm/defn page :- t/Component [opts :- Page & children]
   (let [[bs props] (t/separate Page opts {:href "#"})
         classes {:disabled (:disabled? bs)
-                 :active (:active? bs)}
-        on-click (when-let [f (:on-click bs)]
-                   (fn [e]
-                     (.preventDefault e)
-                     (f e)))]
+                 :active (:active? bs)}]
     (d/li (u/merge-props props {:class (d/class-set classes)})
       (d/a {:href (:href bs)
             :on-click on-click}
@@ -35,4 +31,4 @@
 (sm/defn pagination :- t/Component [opts & children]
   (d/nav
     (d/ul {:class "pagination"}
-          children)))+          children)))


Multi job bug where input is incorrectly sealed Seal channel was was being signalled when an input was being sealed for a job other than the one that the task is currently on. This would lead to one job completing and causing another job to incorrectly complete in response.

--- src/onyx/log/commands/common.clj
+++ src/onyx/log/commands/common.clj
@@ -79,10 +79,14 @@
       (let [n (mod message-id (count peers))]
         (= (nth peers n) id)))))

+(defn allocated-to-job [replica args id])
+
 (defn should-seal? [replica args state message-id]
-  (and (all-inputs-exhausted? replica (:job args))
-       (executing-output-task? replica (:id state))
-       (elected-sealer? replica message-id (:id state))))
+  (let [allocated-to-job? (= (:job args) (:job (peer->allocated-job (:allocations replica) (:id state))))]
+    (and allocated-to-job?
+         (all-inputs-exhausted? replica (:job args))
+         (executing-output-task? replica (:id state))
+         (elected-sealer? replica message-id (:id state)))))

 (defn at-least-one-active? [replica peers]
   (->> peers


Extract assign-window stage from assign-windows. Delay expensive event key lookups which may not be necessary.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -23,7 +23,6 @@
               [onyx.types :refer [->Route ->Ack ->Results ->Result ->MonitorEvent dec-count! inc-count! map->Event]]
               [clj-tuple :as t]
               [onyx.interop]
-              [onyx.state.log.atom]
               [onyx.state.log.bookkeeper]
               [onyx.state.filter.set]
               [onyx.state.core :as state]
@@ -335,11 +334,30 @@
                replayed-state))))
   event)

+(defn assign-window [segment window-state w]
+  (let [window-id (:window/id w)
+        w-range (apply units/to-standard-units (:window/range w))
+        w-slide (apply units/to-standard-units (or (:window/slide w) (:window/range w)))
+        units (units/standard-units-for (last (:window/range w)))
+        segment-coerced (we/uniform-units (:window/record w) segment)
+        extents (we/extents (:window/record w) segment-coerced)]
+    (doall
+      (map (fn [e]
+             (let [f (:window/agg-fn w)
+                   state (init-window-state w (get-in @window-state [window-id e]))
+                   state-transition-entry (f state w segment)
+                   new-state ((:window/log-resolve w) state state-transition-entry)]
+               (swap! window-state assoc-in [window-id e] new-state)
+               (list e state-transition-entry)))
+           extents))))
+
 (defn assign-windows
-  [{:keys [onyx.core/monitoring onyx.core/replica onyx.core/state onyx.core/messenger
-           onyx.core/windows onyx.core/task-map onyx.core/window-state onyx.core/state-log onyx.core/results] :as event}]
+  [{:keys [onyx.core/windows] :as event}]
   (when (seq windows)
-    (let [id-key (:onyx/uniqueness-key task-map)]
+    (let [{:keys [onyx.core/monitoring onyx.core/replica onyx.core/state onyx.core/messenger
+                  onyx.core/triggers onyx.core/windows onyx.core/task-map onyx.core/window-state
+                  onyx.core/state-log onyx.core/results]} event
+          id-key (:onyx/uniqueness-key task-map)]
       (doall
         (map
           (fn [leaf fused-ack]
@@ -359,30 +377,12 @@
                     (when-not seen?
                       (inc-count! fused-ack)
                       (->> windows
-                           (map (fn [w]
-                                  (let [window-id (:window/id w)
-                                        w-range (apply units/to-standard-units (:window/range w))
-                                        w-slide (apply units/to-standard-units (or (:window/slide w) (:window/range w)))
-                                        units (units/standard-units-for (last (:window/range w)))
-                                        ;; switch we calls to take segments
-                                        segment-coerced (we/uniform-units (:window/record w) segment)
-                                        extents (we/extents (:window/record w) segment-coerced)
-                                        extents-entries (doall
-                                                          (map (fn [e]
-                                                                 (let [f (:window/agg-fn w)
-                                                                       state (init-window-state w (get-in @window-state [window-id e]))
-                                                                       state-transition-entry (f state w segment)
-                                                                       new-state ((:window/log-resolve w) state state-transition-entry)]
-                                                                   (swap! window-state assoc-in [(:window/id w) e] new-state)
-                                                                   ;; return window extent playback entry
-                                                                   (list e state-transition-entry)))
-                                                               extents))]
-                                    (doseq [t (:onyx.core/triggers event)]
-                                      (triggers/fire-trigger! event window-state t {:segment segment :context :new-segment}))
-                                    extents-entries)))
+                           (map (partial assign-window segment window-state))
                            doall
                            (cons unique-id) ;; store the id at the head of the log entry
                            (state-extensions/store-log-entry state-log event ack-fn))
+                      (doseq [t triggers]
+                        (triggers/fire-trigger! event window-state t {:segment segment :context :new-segment}))
                       (swap! window-state update :filter state-extensions/apply-filter-id event unique-id))))
                 (:leaves leaf))))
           (:tree results)


Comment formatting.

Comment formatting.

--- src/plugboard/core/plugboard.clj
+++ src/plugboard/core/plugboard.clj
@@ -308,7 +308,7 @@
       (throw (Exception. (format "No transition for tuple: %s" tuple)))
       res)))

-                                        ; Returns [boolean state] decision
+;; Returns [boolean state] decision
 (defn- decide [state f dlg]
   (cond
    (fn? f) (let [res (f state dlg)]
@@ -319,7 +319,7 @@
    :otherwise [f state]
    ))

-                                        ; Returns [boolean state]
+;; Returns [boolean state]
 (defn- decides [state stack]
   (decide state (first stack) (fn [state] (decides state (rest stack))))
   )


Adds production? to settings (#1996)

Adds production? to settings (#1996)

--- scheduler/src/cook/config.clj
+++ scheduler/src/cook/config.clj
@@ -550,7 +550,10 @@
                 (fn [pattern-transformation]
                   (update pattern-transformation :match re-pattern))
                 pattern-transformations)))
-         constraint-attribute->transformation))}))
+         constraint-attribute->transformation))
+     :production?
+     (fnk [[:config {production? nil}]]
+       production?)}))

 (defn read-config
   "Given a config file path, reads the config and returns the map"


Mimic the command-line jUnit output

Mimic the command-line jUnit output

--- src/radicalzephyr/boot_junit.clj
+++ src/radicalzephyr/boot_junit.clj
@@ -55,8 +55,8 @@
       (println "\nTest run finished!"))
     (testStarted [description]
       (print "."))
-    (testFinished [description]
-      (print "F"))))
+    (testFailure [failure]
+      (print "E"))))

 (core/deftask junit
   "Run the jUnit test runner."


Update to ClojureScript release 0.0-1236

--- sample-app/project.clj
+++ sample-app/project.clj
@@ -1,7 +1,7 @@
 (defproject cljs-browser "0.0.1-SNAPSHOT"
   :description ""
   :dependencies [[org.clojure/clojure "1.4.0-beta4"]
-                 [org.clojure/clojurescript "0.0-993"]
+                 [org.clojure/clojurescript "0.0-1236"]
                  [ring "1.0.0-RC1"]
                  [compojure "0.6.4"]
                  [enlive "1.0.0"]]


fixed heats in speaker ui

fixed heats in speaker ui

--- src/tango/cljs/speaker/core.cljs
+++ src/tango/cljs/speaker/core.cljs
@@ -38,6 +38,19 @@
 ;; Recall 18
 ;; Judges A, B, C      Event 3A

+(defui HeatRow
+  static om/IQuery
+  (query [_]
+    [])
+  Object
+  (render
+    [this]
+    (let [{:keys [heat-number starting]} (om/props this)]
+      (dom/div #js {:className "Row"}
+        (dom/h4 #js {:className "col-xs-2"} (str "Heat " heat-number ":"))
+        (dom/div #js {:className "col-xs-10"}
+          (map #(dom/h4 #js {:className "col-xs-1"} (:participant/number %)) starting))))))
+
 (defui HeatsComponent
   static om/IQuery
   (query [_]
@@ -45,7 +58,13 @@
   Object
   (render
     [this]
-    (dom/div nil "Heats")))
+    (let [{:keys [heats starting]} (om/props this)
+          heat-dist (domain/create-distribution starting heats)]
+      (log heat-dist)
+      (dom/div nil
+        (map-indexed #((om/factory HeatRow) {:heat-number (inc %1)
+                                             :starting    %2})
+                     heat-dist)))))

 (defui ActivityComponent
   static om/IQuery
@@ -75,9 +94,8 @@
           (dom/h4 #js {:className "col-xs-12"} (clojure.string/join "," (map :dance/name (:round/dances activity)))))

         ;; TODO - fix heats
-        (map-indexed #((om/factory HeatsComponent) %)
-                     (partition (:round/heats activity)
-                                (:round/starting (om/props this))))
+        ((om/factory HeatsComponent) {:heats (:round/heats activity)
+                                      :starting (:round/starting activity)})

         (dom/div #js {:className "Row"}
           (dom/h3 #js {:className "col-xs-12"} (str "Total: " (count starting))))
@@ -116,7 +134,7 @@
         (let [response (async/<! (http/get "/query" {:query-params
                                                      {:query (pr-str (:query edn))}}))
               edn-response (second (cljs.reader/read-string (:body response)))]
-          (log edn-response)
+          ;(log edn-response)
           ;; TODO - why is the response a vec?
           (cb edn-response))
         ))))


(maint) Update replac-pkgs for rubycas-server to higher than the last packaged version

--- configs/pe-console-services/pe-console-services.clj
+++ configs/pe-console-services/pe-console-services.clj
@@ -19,4 +19,4 @@
   :ezbake {:user "pe-console-services"
            :group "pe-console-services"
            :build-type "pe"
-           :replaces-pkgs [{:package "pe-rubycas-server", :version "1.1.17.3"}]})
+           :replaces-pkgs [{:package "pe-rubycas-server", :version "1.1.18"}]})


ECHO-616: Addressing code review comments.

--- transmit-lib/src/cmr/transmit/echo/soap/provider.clj
+++ transmit-lib/src/cmr/transmit/echo/soap/provider.clj
@@ -181,15 +181,14 @@
    provider-guid. provider-id and provider-guid are optional. If one or the other is specified they
    will indicate the provider otherwise the provider will be assumed to be one the user has logged in
    as."
-  [param-map]
-  (let [{:keys [token provider-id provider-guid]} param-map]
-    (soap/post-soap
-     :provider ["ns2:RemoveProviderPolicies"
-                soap/soap-ns-map
-                ["ns2:token" token]
-                (when provider-id ["ns2:providerId" provider-id])
-                (when provider-guid ["ns2:providerGuid" provider-guid])])
-    nil))
+  [{:keys [token provider-id provider-guid]}]
+  (soap/post-soap
+   :provider ["ns2:RemoveProviderPolicies"
+              soap/soap-ns-map
+              ["ns2:token" token]
+              (when provider-id ["ns2:providerId" provider-id])
+              (when provider-guid ["ns2:providerGuid" provider-guid])])
+  nil)

 (defn get-provider-policies
   "Get provider policies for the provider specified by the behalfOfProvider field of the specified token."


(PDB-5022) verify-accepts-content-type: put :pre condition in a vector

--- src/puppetlabs/puppetdb/middleware.clj
+++ src/puppetlabs/puppetdb/middleware.clj
@@ -108,7 +108,7 @@
   Acceptable status is returned, with a message informing the client it must
   accept the content type."
   [app content-type]
-  {:pre (string? content-type)}
+  {:pre [(string? content-type)]}
   (fn [{:keys [headers] :as req}]
     (if (http/acceptable-content-type
          content-type


Fix incorrect ordering of parameters

Fix incorrect ordering of parameters

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -376,7 +376,7 @@
          resources-so-far {:mem 0 :cpus 0}
          prev []]
     (let [required (merge-with + resources-so-far
-                               (select-keys [:mem :cpus] (util/job-ent->resources (last candidates))))]
+                               (select-keys (util/job-ent->resources (last candidates)) [:mem :cpus]))]
       (if (and candidates (>= cpus (:cpus required)) (>= mem (:mem required)))
         (recur remaining-prefixes required candidates)
         prev))))


[cassandra] Upgrade to Cassaforte 2.0.0

[cassandra] Upgrade to Cassaforte 2.0.0

--- modules/cassandra/project.clj
+++ modules/cassandra/project.clj
@@ -5,5 +5,5 @@
   :url "https://github.com/juxt/modular/tree/master/modules/cassandra"
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"}
-  :dependencies [[clojurewerkz/cassaforte "2.0.0-rc4"]
+  :dependencies [[clojurewerkz/cassaforte "2.0.0"]
                  [prismatic/schema "0.2.1"]])


Propagate handling of character encoding through nailgun

--- server/src/main/clojure/vimclojure/nails.clj
+++ server/src/main/clojure/vimclojure/nails.clj
@@ -51,10 +51,10 @@
      (.start))))

 (defn- make-stream-set
-  [in out err]
-  [(-> in InputStreamReader. LineNumberingPushbackReader.)
-   (-> out OutputStreamWriter.)
-   (-> err OutputStreamWriter. PrintWriter.)])
+  [in out err encoding]
+  [(-> in (InputStreamReader. encoding) LineNumberingPushbackReader.)
+   (-> out (OutputStreamWriter. encoding))
+   (-> err (OutputStreamWriter. encoding) PrintWriter.)])

 (defn- set-input-stream
   [#^ThreadLocalInputStream sys local]
@@ -73,10 +73,8 @@
   [#^NGContext ctx nail]
   (let [out          (ByteArrayOutputStream.)
         err          (ByteArrayOutputStream.)
-        [clj-in clj-out clj-err] (make-stream-set (.in ctx) out err)
-        encoding     (if-let [encoding (System/getProperty "clojure.vim.encoding")]
-                       encoding
-                       "UTF-8")
+        encoding     (System/getProperty "clojure.vim.encoding" "UTF-8")
+        [clj-in clj-out clj-err] (make-stream-set (.in ctx) out err encoding)
         sys-in       (set-input-stream System/in (.in ctx))
         sys-out      (set-output-stream System/out (PrintStream. out))
         sys-err      (set-output-stream System/err (PrintStream. err))
@@ -92,12 +90,14 @@
     (set-input-stream System/in sys-in)
     (set-output-stream System/out sys-out)
     (set-output-stream System/err sys-err)
-    (.print (.out ctx)
-            (print-str
-              (util/clj->vim
-                {:value  result
-                 :stdout (.toString out encoding)
-                 :stderr (.toString err encoding)})))
+    (let [output (.getBytes
+                   (print-str
+                     (util/clj->vim
+                       {:value  result
+                        :stdout (.toString out encoding)
+                        :stderr (.toString err encoding)}))
+                   encoding)]
+      (.write (.out ctx) output 0 (alength output)))
     (.flush (.out ctx))))

 (defmacro defnail


TNS-20: Correct unload order on new tracker

http://dev.clojure.org/jira/browse/TNS-20

--- src/main/clojure/clojure/tools/namespace/track.clj
+++ src/main/clojure/clojure/tools/namespace/track.clj
@@ -71,11 +71,15 @@
          deps ::deps
          :or {load (), unload (), deps (dep/graph)}} tracker
         new-deps (update-deps deps depmap)
-        changed (affected-namespaces new-deps (keys depmap))]
+        changed (affected-namespaces new-deps (keys depmap))
+        ;; With a new tracker, old dependencies are empty, so
+        ;; unload order will be undefined unless we use new
+        ;; dependencies (TNS-20).
+        old-deps (if (empty? (dep/nodes deps)) new-deps deps)]
     (assoc tracker
       ::deps new-deps
       ::unload (distinct
-               (concat (reverse (sort (dep/topo-comparator deps) changed))
+               (concat (reverse (sort (dep/topo-comparator old-deps) changed))
                        unload))
       ::load (distinct
              (concat (sort (dep/topo-comparator new-deps) changed)


Old comment

Old comment

--- src/wishlistd/views/wishlist.clj
+++ src/wishlistd/views/wishlist.clj
@@ -10,7 +10,7 @@
   (common/layout ""))

 (defn create-wishlist-json [wishlist]
-  (let [wishlist (create-wishlist wishlist)] ; will in the future get a wishlist from the client
+  (let [wishlist (create-wishlist wishlist)]
     (response/json wishlist)))

 (defn get-wishlist-json [code]


dashboard routs accepts query-params

dashboard routs accepts query-params

- fix dashboard pagination

--- src-cljs/frontend/routes.cljs
+++ src-cljs/frontend/routes.cljs
@@ -138,24 +138,29 @@
                                           :org org
                                           :subpage (keyword (:_fragment maybe-fragment))}))

-  (defroute v1-org-dashboard-alternative #"/(gh|bb)/organizations/([^/]+)" [short-vcs-type org]
-    (open-to-inner! nav-ch :dashboard (->lengthen-vcs {:vcs_type short-vcs-type
-                                                       :org org})))
-
-  (defroute v1-org-dashboard #"/(gh|bb)/([^/]+)" [short-vcs-type org]
-    (open-to-inner! nav-ch :dashboard (->lengthen-vcs {:vcs_type short-vcs-type :org org})))
-
-  (defroute v1-project-dashboard #"/(gh|bb)/([^/]+)/([^/]+)" [short-vcs-type org repo]
-    (open-to-inner! nav-ch :dashboard (->lengthen-vcs {:vcs_type short-vcs-type
-                                                    :org org
-                                                    :repo repo})))
+  (defroute v1-org-dashboard-alternative #"/(gh|bb)/organizations/([^/]+)" [short-vcs-type org params]
+    (open-to-inner! nav-ch :dashboard (merge params
+                                             {:vcs_type (->lengthen-vcs short-vcs-type)
+                                              :org org})))
+
+  (defroute v1-org-dashboard #"/(gh|bb)/([^/]+)" [short-vcs-type org params]
+    (open-to-inner! nav-ch :dashboard (merge params
+                                             {:vcs_type (->lengthen-vcs short-vcs-type)
+                                              :org org})))
+
+  (defroute v1-project-dashboard #"/(gh|bb)/([^/]+)/([^/]+)" [short-vcs-type org repo params]
+    (open-to-inner! nav-ch :dashboard (merge params
+                                             {:vcs_type (->lengthen-vcs short-vcs-type)
+                                              :org org
+                                              :repo repo})))

   (defroute v1-project-branch-dashboard #"/(gh|bb)/([^/]+)/([^/]+)/tree/(.+)" ; workaround secretary's annoying auto-decode
-    [short-vcs-type org repo branch args]
-    (open-to-inner! nav-ch :dashboard (merge args {:vcs_type (->lengthen-vcs short-vcs-type)
-                                                   :org org
-                                                   :repo repo
-                                                   :branch branch})))
+    [short-vcs-type org repo branch params]
+    (open-to-inner! nav-ch :dashboard (merge params
+                                             {:vcs_type (->lengthen-vcs short-vcs-type)
+                                              :org org
+                                              :repo repo
+                                              :branch branch})))

   (defroute v1-build #"/(gh|bb)/([^/]+)/([^/]+)/(\d+)"
     [short-vcs-type org repo build-num _ maybe-fragment]


Диалоги для создания собщений

Диалоги для создания собщений


Remove unused code

Remove unused code

--- src/yetibot/core/interpreter.clj
+++ src/yetibot/core/interpreter.clj
@@ -42,9 +42,6 @@
                :yetibot-user *yetibot-user*
                :chat-source *chat-source*}
         possible-opts (to-coll-if-contains-newlines previous-value)]
-
-    ;; (debug "previous value" (pr-str previous-value))
-    ;; (debug "previous data" (pr-str previous-data))

     (if (pos? @(:skip-next-n acc))
       (do


Ditto

Ditto

--- metrics-clojure-core/test/metrics/test/utils_test.clj
+++ metrics-clojure-core/test/metrics/test/utils_test.clj
@@ -1,4 +1,4 @@
-(ns metrics.test.utils
+(ns metrics.test.utils-test
   (:require [metrics.utils :as utils])
   (:use [clojure.test]))


add delete helper to cache

add delete helper to cache

--- src/pc/cache.clj
+++ src/pc/cache.clj
@@ -23,6 +23,9 @@
 (defn safe-get [cache-key]
   (deref (c/async-get @conn cache-key) 25 nil))

+(defn delete [cache-key]
+  (c/delete @conn cache-key))
+
 (defn wrap-memcache
   "Doesn't cache nils"
   [cache-key f & args]


fix reloading for :browser

fix reloading for :browser

--- src/main/shadow/cljs/devtools/server/worker/ws.clj
+++ src/main/shadow/cljs/devtools/server/worker/ws.clj
@@ -138,12 +138,17 @@
         (-> (subs uri 6)
             (cond->
               (= :js module-format)
-              (output/flat-js-name)))]
+              (output/flat-js-name)))
+
+        file
+        (if (= :js module-format)
+          (io/file output-dir filename)
+          (io/file output-dir "cljs-runtime" filename))]

     {:status 200
      :headers {"cache-control" "no-store, must-revalidate, max-age=0"
                "content-type" "text/javascript"}
-     :body (slurp (io/file output-dir filename))}))
+     :body (slurp file)}))

 (defn process
   [{:keys [output] :as worker-proc} {:keys [uri] :as req}]


fix(backend): run fixtures without start http server

--- backend/src/uxbox/fixtures.clj
+++ backend/src/uxbox/fixtures.clj
@@ -6,18 +6,20 @@

 (ns uxbox.fixtures
   "A initial fixtures."
-  (:require [buddy.hashers :as hashers]
-            [buddy.core.codecs :as codecs]
-            [mount.core :as mount]
-            [clj-uuid :as uuid]
-            [suricatta.core :as sc]
-            [uxbox.config :as cfg]
-            [uxbox.db :as db]
-            [uxbox.migrations]
-            [uxbox.util.transit :as t]
-            [uxbox.services.users :as susers]
-            [uxbox.services.projects :as sproj]
-            [uxbox.services.pages :as spag]))
+  (:require
+   [buddy.core.codecs :as codecs]
+   [buddy.hashers :as hashers]
+   [clj-uuid :as uuid]
+   [mount.core :as mount]
+   [suricatta.core :as sc]
+   [uxbox.config :as cfg]
+   [uxbox.db :as db]
+   [uxbox.media :as media]
+   [uxbox.migrations]
+   [uxbox.services.pages :as spag]
+   [uxbox.services.projects :as sproj]
+   [uxbox.services.users :as susers]
+   [uxbox.util.transit :as t]))

 (defn- mk-uuid
   [prefix i]
@@ -68,7 +70,15 @@

 (defn -main
   [& args]
-  (mount/start)
+  (-> (mount/only #{#'uxbox.config/config
+                    #'uxbox.config/secret
+                    #'uxbox.db/datasource
+                    #'uxbox.migrations/migrations
+                    #'uxbox.media/assets-storage
+                    #'uxbox.media/media-storage
+                    #'uxbox.media/images-storage
+                    #'uxbox.media/thumbnails-storage})
+      (mount/start))
   (with-open [conn (db/connection)]
     (sc/atomic conn
       (doseq [i (range num-users)]


don't generate any sentences with [:sem :subj :city]=true

--- src/babel/italiano/writer.clj
+++ src/babel/italiano/writer.clj
@@ -71,7 +71,8 @@
                                          {:modified false}
                                          {:synsem {:sem
                                                    (get-in verb [:synsem :sem] :top)}}
-                                         {:root {:italiano {:italiano root-form}}})
+                                         {:root {:italiano {:italiano root-form}}}
+                                         {:synsem {:sem {:subj {:city false}}}})
                                         count no-older-than)))
                  tutti))))


Hide SSH components if SSH is disabled

Hide SSH components if SSH is disabled

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -686,8 +686,9 @@
   https://en.wikipedia.org/wiki/Truth_table#Logical_implication
   osx -> launch-darkly"
   [project]
-  (or (not (project-model/feature-enabled? project :osx))
-      (feature/enabled? :ios-ssh-builds)))
+  (and (or (not (project-model/feature-enabled? project :osx))
+           (feature/enabled? :ios-ssh-builds))
+       (not (project-model/feature-enabled? project :disable-ssh))))

 (def tab-tag :li.build-info-tab)
 (def tab-link :a.tab-link)
@@ -741,7 +742,8 @@
                    ")"])]])

             (when (and (has-scope :trigger-builds data)
-                       (show-ssh-button? project))
+                       (show-ssh-button? project)
+                       (not (:ssh_disabled build)))
               [tab-tag {:class (when (= :ssh-info selected-tab) "active")}
                [tab-link {:href "#ssh-info"}
                 "Debug via SSH"]])


CMR-2412: Commenting access control dependencies.

--- access-control-app/project.clj
+++ access-control-app/project.clj
@@ -6,6 +6,8 @@
    :cmr-elastic-utils-lib "0.1.0-SNAPSHOT"
    :cmr-message-queue-lib "0.1.0-SNAPSHOT"
    :cmr-common-app-lib "0.1.0-SNAPSHOT"
+
+   ;; Only used for the integration testing utilities
    :cmr-metadata-db-app "0.1.0-SNAPSHOT"
    :cmr-mock-echo-app "0.1.0-SNAPSHOT"})


Actually fix ReferenceError bug with :optimizations :advanced.

When invoking the clojurescript compiler directly with :optimizations :advanced,
also set :output-wrapper true. lein-cljsbuild does this too, and without it
^:export'ed symbols don't get exported correctly.

--- plugin/src/leiningen/cljs_lambda.clj
+++ plugin/src/leiningen/cljs_lambda.clj
@@ -59,7 +59,13 @@

 (defn- extract-compile-opts [proj]
   {:post [(or (nil? %) (and (coll? (:inputs %)) (map? (:options %))))]}
-  (some-> proj :cljs-lambda :compiler))
+  (some-> proj
+    :cljs-lambda
+    :compiler
+    (update :options (fn [{:keys [optimizations] :as options}]
+                       (if (= :advanced optimizations)
+                         (merge {:output-wrapper true} options)
+                         options)))))

 (def fn-keys
   #{:name :create :region :memory-size :role :invoke :description :timeout


DM + CW | 226 | minor refactoring on in-memory database

--- test/mooncake/test/test_helpers/db.clj
+++ test/mooncake/test/test_helpers/db.clj
@@ -20,11 +20,13 @@
     (walk/stringify-keys collection)))

 (defn find-by-map-query [database coll single-query-map keywordise?]
-  (let [search-function (fn [[k vs]] (set (let [filter-function (fn [document] ((set (to-vector vs)) (get document k)))]
-                                            (filter filter-function (mongo/fetch-all database coll {:stringify? (not keywordise?)})))))
-        search-result-sets (map search-function single-query-map)]
+  (let [all-documents (mongo/fetch-all database coll {:stringify? (not keywordise?)})
+        documents-with-matching-key-values (fn [[k vs]] (filter #((set (to-vector vs)) (get % k)) all-documents))
+        search-result-sets (->> single-query-map
+                                (map documents-with-matching-key-values)
+                                (map set))]
     (if (empty? search-result-sets)
-      (mongo/fetch-all database coll {:stringify? (not keywordise?)})
+      all-documents
       (apply set/intersection search-result-sets))))

 (def neutral-comp-fn (constantly 0))


Applied some guidelines

Applied some guidelines

--- process-clojure/src/process/core.clj
+++ process-clojure/src/process/core.clj
@@ -11,16 +11,16 @@
   (with-open [f (io/writer filename)]
     (csv/write-csv f data)))

+(defn check-field [value]
+  (cond #(%1 %2) value
+    nil? (exit "Field is missing")
+    (complement string?) (exit "Field is not a string")
+    :else value))
+
 (defn process [field folder]
   (def files (glob (io/file folder) "*.json"))
   (def contents (map #(json/parse-string (slurp %)) files))
-  (def values (map
-    (fn [data]
-      (def value (get data field))
-      (case value
-        nil (exit "Field is missing")
-        (if (string? value) value (exit "Field is not a string"))))
-    contents))
+  (def values (map (comp check-field #(get % field)) contents))
   (def stats (sort-by val > (frequencies (remove empty? values))))
   (csv "output.csv" stats))


Use concurrency when outside the container.

--- modules/messaging/src/main/clojure/immutant/messaging.clj
+++ modules/messaging/src/main/clojure/immutant/messaging.clj
@@ -160,15 +160,16 @@
             (log/error "Failed to setup listener for" dest-name))))

       ;; out of container
-      (let [settings (setup-fn)]
-        (try
-          (.setMessageListener (settings "consumer")
-                               (create-listener (settings "handler")))
-          (.start connection)
-          connection
-          (catch Throwable e
-            (.close connection)
-            (throw e)))))))
+      (try
+        (dotimes [_ concurrency]
+          (let [settings (setup-fn)]
+            (.setMessageListener (settings "consumer")
+                                 (create-listener (settings "handler")))))
+        (.start connection)
+        connection
+        (catch Throwable e
+          (.close connection)
+          (throw e))))))

 (defn request
   "Send a message to queue and return a delay that will retrieve the response.


make us can draw grid

make us can draw grid

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

--- src/clj/brains_brain/core.clj
+++ src/clj/brains_brain/core.clj
@@ -8,21 +8,33 @@

 (native!)

+;; cell size
+(def cell-size 9)
+
 ;; actual board size is 90 x 90
-(def board-size 180)
+(def board-size 90)

 ;; board size with grid
-(def size (+ 3 (* 2 (- board-size 1))))
+(def size
+  (+ 1
+     (+ cell-size
+        (* (- cell-size 1)
+           (- board-size cell-size)
+           )
+        )
+     ;;(+ 3 (* 2 (- board-size 1)))
+     ))

+(println (str "size: " size))

 (defn draw-grid [c g]
   (let [cellw 3
         cellh 3
         ]
-    (doseq [x (range 1 size 2)
-            y (range 1 size 2)]
+    (doseq [x (range 1 size cell-size)
+            y (range 1 size cell-size)]
       (draw g
-            (rect x y 1 1)
+            (rect x y (dec cell-size))
             (style :background :white ;; "#F03232"
                    )
             )
@@ -37,7 +49,7 @@
                              ;; :size [270 :by 270]
                              :size [ size :by size ]
                              :background :black
-                             :border (line-border :thickness 2 :color :white)
+                             ;; :border (line-border :thickness 2 :color :white)
                              :paint draw-grid
                              )
              :border 5)


don’t instrument macros, use uninstrumented fn under test

Signed-off-by: Rich Hickey <2f3b32171da334ad5d7d0db393d0928eef4308ab@gmail.com>

--- src/clj/clojure/spec/test.clj
+++ src/clj/clojure/spec/test.clj
@@ -163,17 +163,18 @@
 (defn- instrument-1
   [s opts]
   (when-let [v (resolve s)]
-    (let [spec (s/get-spec v)
-          {:keys [raw wrapped]} (get @instrumented-vars v)
-          current @v
-          to-wrap (if (= wrapped current) raw current)
-          ospec (or (instrument-choose-spec spec s opts)
+    (when-not (-> v meta :macro)
+      (let [spec (s/get-spec v)
+            {:keys [raw wrapped]} (get @instrumented-vars v)
+            current @v
+            to-wrap (if (= wrapped current) raw current)
+            ospec (or (instrument-choose-spec spec s opts)
                       (throw (no-fspec v spec)))
-          ofn (instrument-choose-fn to-wrap ospec s opts)
-          checked (spec-checking-fn v ofn ospec)]
-      (alter-var-root v (constantly checked))
-      (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked}))
-    (->sym v)))
+            ofn (instrument-choose-fn to-wrap ospec s opts)
+            checked (spec-checking-fn v ofn ospec)]
+        (alter-var-root v (constantly checked))
+        (swap! instrumented-vars assoc v {:raw to-wrap :wrapped checked})
+        (->sym v)))))

 (defn- unstrument-1
   [s]
@@ -320,8 +321,8 @@

 (defn- check-1
   [{:keys [s f v spec]} opts]
-  (let [f (or f (when v @v))
-        re-inst? (and v (seq (unstrument s)) true)]
+  (let [re-inst? (and v (seq (unstrument s)) true)
+        f (or f (when v @v))]
     (try
      (cond
       (nil? f)