;; ## Catalog persistence
;;
;; Catalogs are persisted in a relational database. Roughly speaking,
;; the schema looks like this:
;;
;; * resource parameters are associated with a single resource
;;
;; * resources are associated 0 to N catalogs (they are deduped across
;;   catalogs). It's possible for a resource to exist in the database,
;;   yet not be associated with a catalog. This is done as a
;;   performance optimization.
;;
;; * edges, tags, and classes are associated with a single catalog
;;
;; * catalogs are associated with a single certname
;;
;; * facts are associated with a single certname
;;
;; The standard set of operations on information in the database will
;; likely result in dangling resources and catalogs; to clean these
;; up, it's important to run `garbage-collect!`.

(ns com.puppetlabs.cmdb.scf.storage
  (:require [com.puppetlabs.cmdb.catalog :as cat]
            [com.puppetlabs.utils :as utils]
            [clojure.java.jdbc :as sql]
            [clojure.contrib.logging :as log]
            [digest]
            [cheshire.core :as json]))

(defn db-serialize
  "Serialize `value` into a form appropriate for querying against a
  serialized database column."
  [value]
  (json/generate-string (if (map? value)
                      (into (sorted-map) value)
                      value)))

;; ## Entity manipulation

(defn certname-exists?
  "Returns a boolean indicating whether or not the given certname exists in the db"
  [certname]
  {:pre [certname]}
  (sql/with-query-results result-set
    ["SELECT 1 FROM certnames WHERE name=? LIMIT 1" certname]
    (pos? (count result-set))))

(defn add-certname!
  "Add the given host to the db"
  [certname]
  {:pre [certname]}
  (sql/insert-record :certnames {:name certname}))

(defn add-catalog-metadata!
  "Given some catalog metadata, persist it in the db"
  [hash api-version catalog-version]
  {:pre [(string? hash)
         (number? api-version)
         (string? catalog-version)]}
  (sql/insert-record :catalogs {:hash hash
                                :api_version api-version
                                :catalog_version catalog-version}))

(defn update-catalog-metadata!
  "Given some catalog metadata, update the db"
  [hash api-version catalog-version]
  {:pre [(string? hash)
         (number? api-version)
         (string? catalog-version)]}
  (sql/update-values :catalogs
                     ["hash=?" hash]
                     {:api_version api-version
                      :catalog_version catalog-version}))

(defn catalog-exists?
  "Returns a boolean indicating whether or not the given catalog exists in the db"
  [hash]
  {:pre [hash]}
  (sql/with-query-results result-set
    ["SELECT 1 FROM catalogs WHERE hash=? LIMIT 1" hash]
    (pos? (count result-set))))

(defn add-classes!
  "Given a catalog-hash and a list of classes, persist them in the db"
  [catalog-hash classes]
  {:pre [(string? catalog-hash)
         (coll? classes)]}
  (let [default-row {:catalog catalog-hash}
        classes     (map #(assoc default-row :name %) classes)]
    (apply sql/insert-records :classes classes)))

(defn add-tags!
  "Given a catalog-hash and a list of tags, persist them in the db"
  [catalog-hash tags]
  {:pre [(string? catalog-hash)
         (coll? tags)]}
  (let [default-row {:catalog catalog-hash}
        tags        (map #(assoc default-row :name %) tags)]
    (apply sql/insert-records :tags tags)))

(defn resource-exists?
  "Returns a boolean indicating whether or not the given resource exists in the db"
  [resource-hash]
  {:pre [(string? resource-hash)]}
  (sql/with-query-results result-set
    ["SELECT 1 FROM resources WHERE hash=? LIMIT 1" resource-hash]
    (pos? (count result-set))))

(defn resource-identity-hash
  "Compute a hash for a given resource that will uniquely identify it
  within a population.

  A resource is represented by a map that itself contains maps and
  sets in addition to scalar values. We want two resources with the
  same attributes to be equal for the purpose of deduping, therefore
  we need to make sure that when generating a hash for a resource we
  look at a stably-sorted view of the resource. Thus, we need to sort
  both the resource as a whole as well as any nested collections it
  contains."
  [resource]
  {:pre  [(map? resource)]
   :post [(string? %)]}
  (-> ; Sort the entire resource map
      (into (sorted-map) resource)
      ; Sort the parameter map
      (assoc :parameters (into (sorted-map) (:parameters resource)))
      ; Sort the set of tags
      (assoc :tags (into (sorted-set) (:tags resource)))
      (pr-str)
      (digest/sha-1)))

(defn add-resource!
  "Given a certname and a single resource, persist that resource and its parameters"
  [catalog-hash {:keys [type title exported parameters tags file line] :as resource}]
  {:pre [(every? string? #{type title})]}

  (let [resource-hash (resource-identity-hash resource)
        persisted?    (resource-exists? resource-hash)
        connection    (sql/find-connection)]

    (when-not persisted?
      ; Add to resources table
      (sql/insert-record :resources {:hash resource-hash :type type :title title :exported exported :sourcefile file :sourceline line})

      ; Build up a list of records for insertion
      (let [records (for [[name value] parameters]
                      ; Parameter values are represented as serialized strings,
                      ; for ease of comparison.
                      (let [value (db-serialize value)]
                        {:resource resource-hash :name name :value value}))]

        ; ...and insert them
        (apply sql/insert-records :resource_params records))

      ; Add rows for each of the resource's tags
      (let [records (for [tag tags] {:resource resource-hash :name tag})]
        (apply sql/insert-records :resource_tags records)))

    ;; Insert pointer into certname => resource map
    (sql/insert-record :catalog_resources {:catalog catalog-hash :resource resource-hash})))

(defn edge-identity-hash
  "Compute a hash for a given edge that will uniquely identify it
  within a population."
  [edge]
  {:pre  [(map? edge)]
   :post [(string? %)]}
  (-> (into (sorted-map) edge)
      (assoc :source (into (sorted-map) (:source edge)))
      (assoc :target (into (sorted-map) (:target edge)))
      (pr-str)
      (digest/sha-1)))

(defn add-edges!
  "Persist the given edges in the database

  Each edge is looked up in the supplied resources map to find a
  resource object that corresponds to the edge. We then use that
  resource's hash for persistence purposes.

  For example, if the source of an edge is {'type' 'Foo' 'title' 'bar'},
  then we'll lookup a resource with that key and use its hash."
  [catalog-hash edges resources]
  {:pre [(string? catalog-hash)
         (coll? edges)
         (map? resources)]}
  (let [rows  (for [{:keys [source target relationship]} edges
                    :let [source-hash (resource-identity-hash (resources source))
                          target-hash (resource-identity-hash (resources target))
                          type        (name relationship)]]
                {:catalog catalog-hash :source source-hash :target target-hash :type type})]
    (apply sql/insert-records :edges rows)))

(defn catalog-similarity-hash
  "Compute a hash for the given catalog's content

  This hash is useful for situations where you'd like to determine
  whether or not two catalogs contain the same things (edges,
  resources, tags, classes, etc).

  Note that this hash *cannot* be used to uniquely identify a catalog
  within a population! This is because we're only examing a subset of
  a catalog's attributes. For example, two otherwise identical
  catalogs with different :version's would have the same similarity
  hash, but don't represent the same catalog across time."
  [{:keys [certname classes tags resources edges] :as catalog}]
  ;; deepak: This could probably be coded more compactly by just
  ;; dissociating the keys we don't want involved in the computation,
  ;; but I figure that for safety's sake, it's better to be very
  ;; explicit about the exact attributes of a catalog that we care
  ;; about when we think about "uniqueness".
  (-> (sorted-map)
      (assoc :certname certname)
      (assoc :classes (sort classes))
      (assoc :tags (sort tags))
      (assoc :resources (sort (map resource-identity-hash (vals resources))))
      (assoc :edges (sort (map edge-identity-hash edges)))
      (pr-str)
      (digest/sha-1)))

(defn add-catalog!
  "Persist the supplied catalog in the database, returning its
  similarity hash"
  [{:keys [api-version version resources classes edges tags] :as catalog}]
  {:pre [(number? api-version)
         (every? coll? #{classes tags edges})
         (map? resources)]}

  (let [hash (catalog-similarity-hash catalog)]

    (sql/transaction
     (let [exists? (catalog-exists? hash)]

       (when exists?
         (update-catalog-metadata! hash api-version version))

       (when-not exists?
         (add-catalog-metadata! hash api-version version)
         (add-classes! hash classes)
         (add-tags! hash tags)
         (doseq [resource (vals resources)]
           (add-resource! hash resource))
         (add-edges! hash edges resources))))

    hash))

(defn delete-catalog!
  "Remove the catalog identified by the following hash"
  [catalog-hash]
  (sql/delete-rows :catalogs ["hash=?" catalog-hash]))

(defn associate-catalog-with-certname!
  "Creates a relationship between the given certname and catalog"
  [catalog-hash certname]
  (sql/insert-record :certname_catalogs {:certname certname :catalog catalog-hash}))

(defn dissociate-catalog-with-certname!
  "Breaks the relationship between the given certname and catalog"
  [catalog-hash certname]
  (sql/delete-rows :certname_catalogs ["certname=? AND catalog=?" certname catalog-hash]))

(defn dissociate-all-catalogs-for-certname!
  "Breaks all relationships between `certname` and any catalogs"
  [certname]
  (sql/delete-rows :certname_catalogs ["certname=?" certname]))

(defn catalogs-for-certname
  "Returns a collection of catalog-hashes associated with the given
  certname"
  [certname]
  (sql/with-query-results result-set
    ["SELECT catalog FROM certname_catalogs WHERE certname=?" certname]
    (into [] (map :catalog result-set))))

;; ## Database compaction

(defn delete-unassociated-catalogs!
  "Remove any catalogs that aren't associated with a certname"
  []
  (sql/delete-rows :catalogs ["hash NOT IN (SELECT catalog FROM certname_catalogs)"]))

(defn delete-unassociated-resources!
  "Remove any resources that aren't associated with a catalog"
  []
  (sql/delete-rows :resources ["hash NOT IN (SELECT resource FROM catalog_resources)"]))

(defn garbage-collect!
  "Delete any lingering, unassociated data in the database"
  []
  (sql/transaction
   (delete-unassociated-catalogs!)
   (delete-unassociated-resources!)))

;; ## High-level entity manipulation

(defn replace-catalog!
  "Given a catalog, replace the current catalog, if any, for its
  associated host with the supplied one."
  [{:keys [certname] :as catalog}]
  (sql/transaction
   (let [catalog-hash (add-catalog! catalog)]
     (dissociate-all-catalogs-for-certname! certname)
     (associate-catalog-with-certname! catalog-hash certname))))

(defn add-facts!
  "Given a certname and a map of fact names to values, store records for those
facts associated with the certname."
  [certname facts]
  (let [default-row {:certname certname}
        rows (for [[fact value] facts]
               (assoc default-row :fact fact :value value))]
    (apply sql/insert-records :certname_facts rows)))

(defn delete-facts!
  "Delete all the facts for the given certname."
  [certname]
  {:pre [(string? certname)]}
  (sql/delete-rows :certname_facts ["certname=?" certname]))

(defn replace-facts!
  [certname facts]
  (sql/transaction
    (delete-facts! certname)
    (add-facts! certname facts)))

;; ## Catalog persistence
;;
;; Catalogs are persisted in a relational database. Roughly speaking,
;; the schema looks like this:
;;
;; * resource parameters are associated with a single resource
;;
;; * resources are associated 0 to N catalogs (they are deduped across
;;   catalogs). It's possible for a resource to exist in the database,
;;   yet not be associated with a catalog. This is done as a
;;   performance optimization.
;;
;; * edges, tags, and classes are associated with a single catalog
;;
;; * catalogs are associated with a single certname
;;
;; * facts are associated with a single certname
;;
;; The standard set of operations on information in the database will
;; likely result in dangling resources and catalogs; to clean these
;; up, it's important to run `garbage-collect!`.

(ns com.puppetlabs.cmdb.scf.storage
  (:require [com.puppetlabs.cmdb.catalog :as cat]
            [com.puppetlabs.utils :as utils]
            [clojure.java.jdbc :as sql]
            [clojure.contrib.logging :as log]
            [digest]
            [cheshire.core :as json]))

(defn db-serialize
  "Serialize `value` into a form appropriate for querying against a
  serialized database column."
  [value]
  (json/generate-string (if (map? value)
                      (into (sorted-map) value)
                      value)))

;; ## Entity manipulation

(defn certname-exists?
  "Returns a boolean indicating whether or not the given certname exists in the db"
  [certname]
  {:pre [certname]}
  (sql/with-query-results result-set
    ["SELECT 1 FROM certnames WHERE name=? LIMIT 1" certname]
    (pos? (count result-set))))

(defn add-certname!
  "Add the given host to the db"
  [certname]
  {:pre [certname]}
  (sql/insert-record :certnames {:name certname}))

(defn add-catalog-metadata!
  "Given some catalog metadata, persist it in the db"
  [hash api-version catalog-version]
  {:pre [(string? hash)
         (number? api-version)
         (string? catalog-version)]}
  (sql/insert-record :catalogs {:hash hash
                                :api_version api-version
                                :catalog_version catalog-version}))

(defn update-catalog-metadata!
  "Given some catalog metadata, update the db"
  [hash api-version catalog-version]
  {:pre [(string? hash)
         (number? api-version)
         (string? catalog-version)]}
  (sql/update-values :catalogs
                     ["hash=?" hash]
                     {:api_version api-version
                      :catalog_version catalog-version}))

(defn catalog-exists?
  "Returns a boolean indicating whether or not the given catalog exists in the db"
  [hash]
  {:pre [hash]}
  (sql/with-query-results result-set
    ["SELECT 1 FROM catalogs WHERE hash=? LIMIT 1" hash]
    (pos? (count result-set))))

(defn add-classes!
  "Given a catalog-hash and a list of classes, persist them in the db"
  [catalog-hash classes]
  {:pre [(string? catalog-hash)
         (coll? classes)]}
  (let [default-row {:catalog catalog-hash}
        classes     (map #(assoc default-row :name %) classes)]
    (apply sql/insert-records :classes classes)))

(defn add-tags!
  "Given a catalog-hash and a list of tags, persist them in the db"
  [catalog-hash tags]
  {:pre [(string? catalog-hash)
         (coll? tags)]}
  (let [default-row {:catalog catalog-hash}
        tags        (map #(assoc default-row :name %) tags)]
    (apply sql/insert-records :tags tags)))

(defn resource-exists?
  "Returns a boolean indicating whether or not the given resource exists in the db"
  [resource-hash]
  {:pre [(string? resource-hash)]}
  (sql/with-query-results result-set
    ["SELECT 1 FROM resources WHERE hash=? LIMIT 1" resource-hash]
    (pos? (count result-set))))

(defn resource-identity-string
  "Compute a stably-sorted, string representation of the given
  resource that will uniquely identify it within a population."
  [resource]
  {:pre  [(map? resource)]
   :post [(string? %)]}
  (-> ; Sort the entire resource map
      (into (sorted-map) resource)
      ; Sort the parameter map
      (assoc :parameters (into (sorted-map) (:parameters resource)))
      ; Sort the set of tags
      (assoc :tags (into (sorted-set) (:tags resource)))
      (pr-str)))

(defn resource-identity-hash
  "Compute a hash for a given resource that will uniquely identify it
  within a population.

  A resource is represented by a map that itself contains maps and
  sets in addition to scalar values. We want two resources with the
  same attributes to be equal for the purpose of deduping, therefore
  we need to make sure that when generating a hash for a resource we
  look at a stably-sorted view of the resource. Thus, we need to sort
  both the resource as a whole as well as any nested collections it
  contains."
  [resource]
  {:pre  [(map? resource)]
   :post [(string? %)]}
  (-> (resource-identity-string resource)
      (digest/sha-1)))

(defn add-resource!
  "Given a certname and a single resource, persist that resource and its parameters"
  [catalog-hash {:keys [type title exported parameters tags file line] :as resource}]
  {:pre [(every? string? #{type title})]}

  (let [resource-hash (resource-identity-hash resource)
        persisted?    (resource-exists? resource-hash)
        connection    (sql/find-connection)]

    (when-not persisted?
      ; Add to resources table
      (sql/insert-record :resources {:hash resource-hash :type type :title title :exported exported :sourcefile file :sourceline line})

      ; Build up a list of records for insertion
      (let [records (for [[name value] parameters]
                      ; Parameter values are represented as serialized strings,
                      ; for ease of comparison.
                      (let [value (db-serialize value)]
                        {:resource resource-hash :name name :value value}))]

        ; ...and insert them
        (apply sql/insert-records :resource_params records))

      ; Add rows for each of the resource's tags
      (let [records (for [tag tags] {:resource resource-hash :name tag})]
        (apply sql/insert-records :resource_tags records)))

    ;; Insert pointer into certname => resource map
    (sql/insert-record :catalog_resources {:catalog catalog-hash :resource resource-hash})))

(defn edge-identity-string
  "Compute a stably-sorted string for the given edge that will
  uniquely identify it within a population."
  [edge]
  {:pre  [(map? edge)]
   :post [(string? %)]}
  (-> (into (sorted-map) edge)
      (assoc :source (into (sorted-map) (:source edge)))
      (assoc :target (into (sorted-map) (:target edge)))
      (pr-str)))

(defn edge-identity-hash
  "Compute a hash for a given edge that will uniquely identify it
  within a population."
  [edge]
  {:pre  [(map? edge)]
   :post [(string? %)]}
  (-> (edge-identity-string edge)
      (digest/sha-1)))

(defn add-edges!
  "Persist the given edges in the database

  Each edge is looked up in the supplied resources map to find a
  resource object that corresponds to the edge. We then use that
  resource's hash for persistence purposes.

  For example, if the source of an edge is {'type' 'Foo' 'title' 'bar'},
  then we'll lookup a resource with that key and use its hash."
  [catalog-hash edges resources]
  {:pre [(string? catalog-hash)
         (coll? edges)
         (map? resources)]}
  (let [rows  (for [{:keys [source target relationship]} edges
                    :let [source-hash (resource-identity-hash (resources source))
                          target-hash (resource-identity-hash (resources target))
                          type        (name relationship)]]
                {:catalog catalog-hash :source source-hash :target target-hash :type type})]
    (apply sql/insert-records :edges rows)))

(defn catalog-similarity-hash
  "Compute a hash for the given catalog's content

  This hash is useful for situations where you'd like to determine
  whether or not two catalogs contain the same things (edges,
  resources, tags, classes, etc).

  Note that this hash *cannot* be used to uniquely identify a catalog
  within a population! This is because we're only examing a subset of
  a catalog's attributes. For example, two otherwise identical
  catalogs with different :version's would have the same similarity
  hash, but don't represent the same catalog across time."
  [{:keys [certname classes tags resources edges] :as catalog}]
  ;; deepak: This could probably be coded more compactly by just
  ;; dissociating the keys we don't want involved in the computation,
  ;; but I figure that for safety's sake, it's better to be very
  ;; explicit about the exact attributes of a catalog that we care
  ;; about when we think about "uniqueness".
  (-> (sorted-map)
      (assoc :certname certname)
      (assoc :classes (sort classes))
      (assoc :tags (sort tags))
      (assoc :resources (sort (map resource-identity-string (vals resources))))
      (assoc :edges (sort (map edge-identity-string edges)))
      (pr-str)
      (digest/sha-1)))

(defn add-catalog!
  "Persist the supplied catalog in the database, returning its
  similarity hash"
  [{:keys [api-version version resources classes edges tags] :as catalog}]
  {:pre [(number? api-version)
         (every? coll? #{classes tags edges})
         (map? resources)]}

  (let [hash (catalog-similarity-hash catalog)]

    (sql/transaction
     (let [exists? (catalog-exists? hash)]

       (when exists?
         (update-catalog-metadata! hash api-version version))

       (when-not exists?
         (add-catalog-metadata! hash api-version version)
         (add-classes! hash classes)
         (add-tags! hash tags)
         (doseq [resource (vals resources)]
           (add-resource! hash resource))
         (add-edges! hash edges resources))))

    hash))

(defn delete-catalog!
  "Remove the catalog identified by the following hash"
  [catalog-hash]
  (sql/delete-rows :catalogs ["hash=?" catalog-hash]))

(defn associate-catalog-with-certname!
  "Creates a relationship between the given certname and catalog"
  [catalog-hash certname]
  (sql/insert-record :certname_catalogs {:certname certname :catalog catalog-hash}))

(defn dissociate-catalog-with-certname!
  "Breaks the relationship between the given certname and catalog"
  [catalog-hash certname]
  (sql/delete-rows :certname_catalogs ["certname=? AND catalog=?" certname catalog-hash]))

(defn dissociate-all-catalogs-for-certname!
  "Breaks all relationships between `certname` and any catalogs"
  [certname]
  (sql/delete-rows :certname_catalogs ["certname=?" certname]))

(defn catalogs-for-certname
  "Returns a collection of catalog-hashes associated with the given
  certname"
  [certname]
  (sql/with-query-results result-set
    ["SELECT catalog FROM certname_catalogs WHERE certname=?" certname]
    (into [] (map :catalog result-set))))

;; ## Database compaction

(defn delete-unassociated-catalogs!
  "Remove any catalogs that aren't associated with a certname"
  []
  (sql/delete-rows :catalogs ["hash NOT IN (SELECT catalog FROM certname_catalogs)"]))

(defn delete-unassociated-resources!
  "Remove any resources that aren't associated with a catalog"
  []
  (sql/delete-rows :resources ["hash NOT IN (SELECT resource FROM catalog_resources)"]))

(defn garbage-collect!
  "Delete any lingering, unassociated data in the database"
  []
  (sql/transaction
   (delete-unassociated-catalogs!)
   (delete-unassociated-resources!)))

;; ## High-level entity manipulation

(defn replace-catalog!
  "Given a catalog, replace the current catalog, if any, for its
  associated host with the supplied one."
  [{:keys [certname] :as catalog}]
  (sql/transaction
   (let [catalog-hash (add-catalog! catalog)]
     (dissociate-all-catalogs-for-certname! certname)
     (associate-catalog-with-certname! catalog-hash certname))))

(defn add-facts!
  "Given a certname and a map of fact names to values, store records for those
facts associated with the certname."
  [certname facts]
  (let [default-row {:certname certname}
        rows (for [[fact value] facts]
               (assoc default-row :fact fact :value value))]
    (apply sql/insert-records :certname_facts rows)))

(defn delete-facts!
  "Delete all the facts for the given certname."
  [certname]
  {:pre [(string? certname)]}
  (sql/delete-rows :certname_facts ["certname=?" certname]))

(defn replace-facts!
  [certname facts]
  (sql/transaction
    (delete-facts! certname)
    (add-facts! certname facts)))

Use a single sha-1 pass for computing catalog hashes

Previously, we were computing sha-1 hashes for each resource and edge, then
hashing all of those strings to form a catalog hash. As sha-1 computations are
expensive, this slowed things down considerably.

We now just use a single sha-1 pass, at the very end of building up a
stably-sorted catalog, to create the catalog hash. Hashing one giant string is
way more efficient than hashing one giant string plus thousands of tiny
strings.

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


(ns frontend.components.navbar
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer put! close!]]
            [frontend.env :as env]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.github :refer [auth-url]]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [sablono.core :as html :refer-macros [html]]))

;; XXX: Replace logic to handle Gravatar/GitHub fallback
(defn gravatar-url [user]
  [:img
   {:height "30"
    :width "30"
    :src (-> user :selected_email utils/email->gravatar-url)}])

(defn show-environment? [user]
  (:admin user))

(defn crumb [data]
  (let [attrs {:href (:path data)
             :title (:name data)}]
    (if (:active data)
      [:span attrs (:name data)]
      [:a attrs (:name data)])))

(defn logged-out-header [{:keys [flash]}]
  [:div
   [:div
    (when flash
      [:div#flash flash])]
   [:div#navbar
    [:div.container
     [:div.row
      [:div.span8
       [:div.row
        [:a#logo.span2
         {:href "/"}
         [:img
          {:width "130",
           :src (utils/asset-path "/img/logo-new.svg")
           :height "40"}]]
        [:nav.span6
         {:role "navigation"}
         [:ul.nav.nav-pills
          [:li [:a {:href "/about"} "About"]]
          [:li [:a {:href "/pricing"} "Pricing"]]
          [:li [:a {:href "/docs"} "Documentation"]]
          [:li [:a {:href "/jobs"} "Jobs"]]
          [:li [:a {:href "http://blog.circleci.com"} "Blog"]]]]]]
      [:div.controls.span4
       ;; XXX: mixpanel event tracking
       [:a#login.login-link {:href (auth-url)
                             :title "Sign in with Github"
                             :data-bind "track_link: {event: 'Auth GitHub', properties: {'source': 'header sign-in', 'url' : window.location.pathname}}"}
        "Sign in"]
       [:span.seperator "|"]
       [:a#login.login-link {:href (auth-url)
                             :title "Sign up with Github"
                             :data-bind "track_link: {event: 'Auth GitHub', properties: {'source': 'header sign-up', 'url' : window.location.pathname}}"}
        "Sign up "
        [:i.fa.fa-github-alt]]]]]]])

(defn logged-in-header [{:keys [user settings crumbs controls-ch user-session-settings]}]
  [:nav.header-nav
   [:div.header-nav-logo [:a {:href "/"}]]
   [:div.header-nav-breadcrumb
    [:nav
     (map crumb crumbs)]]
   (when (show-environment? user)
     [:div.header-nav-environment
      [:span {:class (str "env-" (name (env/env)))}
       (name (env/env))]])
   [:div.header-nav-docs
    [:a.menu-item
     {:target "_blank", :href "/docs"}
     [:i.fa.fa-files-o]
     [:span "Documentation"]]]
   [:div.header-nav-menu {:class (when (get-in settings [:menus :user :open]) "open")}
    [:a
     {:on-click #(put! controls-ch [:user-menu-toggled])}
     (if-let [avatar (gravatar-url user)]
       avatar
       [:span (:login user)])
     [:i.fa.fa-caret-down]]
    [:aside
     [:a.menu-item
      {:href "/account"}
      [:i.fa.fa-gears]
      [:span "Settings"]]
     [:a.menu-item
      {:on-click #(put! controls-ch [:intercom-dialog-raised])}
      [:i.fa.fa-bullhorn]
      [:span "Support"]]
     [:a.menu-item
      {:target "_blank", :href "https://www.hipchat.com/gjwkHcrD5"}
      [:i.fa.fa-comments]
      [:span "Chat support"]]
     (if (:admin user)
       (list
        [:a.menu-item {:href "/admin"}
         [:i.fa.fa-wrench]
         "Admin"]
        [:a.menu-item {:href "/admin/users"}
         [:i.fa.fa-group]
         "Users"]
        [:a.menu-item {:href "/admin/recent-builds"}
         [:i.fa.fa-clock-o]
         "Recent builds"]
        [:a.menu-item {:href "/admin/projects"}
         [:i.fa.fa-code]
         "Projects"]
        [:a.menu-item
         {:on-click #(put! controls-ch [:intercom-user-inspected])}
         [:i.fa.fa-search]
         "Find project on Intercom"]
        (let [use-local-assets (get user-session-settings :use_local_assets)]
          [:a.menu-item
           {:on-click #(put! controls-ch [:set-user-session-setting {:setting :use-local-assets
                                                                     :value (not use-local-assets)}])}
           [:i.fa.fa-home]
           (if use-local-assets "Stop using local assets" "Use local assets")])
        [:a.menu-item
         {:on-click #(put! controls-ch [:set-user-session-setting {:setting :use-om
                                                                    :value false}])}
         [:i.fa "λ"]
         "Stop using om"]
        (let [current-build-id (get user-session-settings :om_build_id "dev")]
          (for [build-id (remove (partial = current-build-id) ["dev" "whitespace" "production"])]
            [:a.menu-item
             {:on-click #(put! controls-ch [:set-user-session-setting {:setting :om-build-id
                                                                       :value build-id}])}
             [:span (str "Use " build-id " om compiler")]]))))]]])

(defn navbar [app owner opts]
  (reify
    om/IRender
    (render [_]
      (let [controls-ch (get-in opts [:comms :controls])
            user (:current-user app)]
        (html/html
         (if user
           (logged-in-header {:user user
                              :settings (:settings app)
                              :user-session-settings (get-in app [:render-context :user_session_settings])
                              :crumbs (:crumbs app)
                              :controls-ch controls-ch})
           (logged-out-header {:flash (get-in app [:render-context :flash])})))))))

(ns frontend.components.navbar
  (:require [cljs.core.async :as async :refer [>! <! alts! chan sliding-buffer put! close!]]
            [frontend.env :as env]
            [frontend.utils :as utils :include-macros true]
            [frontend.utils.github :refer [auth-url]]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true]
            [sablono.core :as html :refer-macros [html]]))

;; XXX: Replace logic to handle Gravatar/GitHub fallback
(defn gravatar-url [user]
  [:img
   {:height "30"
    :width "30"
    :src (-> user :selected_email utils/email->gravatar-url)}])

(defn show-environment? [user]
  (:admin user))

(defn crumb [data]
  (let [attrs {:href (:path data)
             :title (:name data)}]
    (if (:active data)
      [:span attrs (:name data)]
      [:a attrs (:name data)])))

(defn logged-out-header [{:keys [flash]}]
  [:div
   [:div
    (when flash
      [:div#flash flash])]
   [:div#navbar
    [:div.container
     [:div.row
      [:div.span8
       [:div.row
        [:a#logo.span2
         {:href "/"}
         [:img
          {:width "130",
           :src (utils/asset-path "/img/logo-new.svg")
           :height "40"}]]
        [:nav.span6
         {:role "navigation"}
         [:ul.nav.nav-pills
          [:li [:a {:href "/about"} "About"]]
          [:li [:a {:href "/pricing"} "Pricing"]]
          [:li [:a {:href "/docs"} "Documentation"]]
          [:li [:a {:href "/jobs"} "Jobs"]]
          [:li [:a {:href "http://blog.circleci.com"} "Blog"]]]]]]
      [:div.controls.span4
       ;; XXX: mixpanel event tracking
       [:a#login.login-link {:href (auth-url)
                             :title "Sign in with Github"
                             :data-bind "track_link: {event: 'Auth GitHub', properties: {'source': 'header sign-in', 'url' : window.location.pathname}}"}
        "Sign in"]
       [:span.seperator "|"]
       [:a#login.login-link {:href (auth-url)
                             :title "Sign up with Github"
                             :data-bind "track_link: {event: 'Auth GitHub', properties: {'source': 'header sign-up', 'url' : window.location.pathname}}"}
        "Sign up "
        [:i.fa.fa-github-alt]]]]]]])

(defn logged-in-header [{:keys [user settings crumbs controls-ch user-session-settings]}]
  [:nav.header-nav
   [:div.header-nav-logo [:a {:href "/"}]]
   [:div.header-nav-breadcrumb
    [:nav
     (map crumb crumbs)]]
   (when (show-environment? user)
     [:div.header-nav-environment
      [:span {:class (str "env-" (name (env/env)))}
       (name (env/env))]])
   [:div.header-nav-docs
    [:a.menu-item
     {:target "_blank", :href "/docs"}
     [:i.fa.fa-files-o]
     [:span "Documentation"]]]
   [:div.header-nav-menu {:class (when (get-in settings [:menus :user :open]) "open")}
    [:a
     {:on-click #(put! controls-ch [:user-menu-toggled])}
     (if-let [avatar (gravatar-url user)]
       avatar
       [:span (:login user)])
     [:i.fa.fa-caret-down]]
    [:aside
     [:a.menu-item
      {:href "/account"}
      [:i.fa.fa-gears]
      [:span "Settings"]]
     [:a.menu-item
      {:on-click #(put! controls-ch [:intercom-dialog-raised])}
      [:i.fa.fa-bullhorn]
      [:span "Support"]]
     [:a.menu-item
      {:target "_blank", :href "https://www.hipchat.com/gjwkHcrD5"}
      [:i.fa.fa-comments]
      [:span "Chat support"]]
     (if (:admin user)
       (list
        [:a.menu-item {:href "/admin"}
         [:i.fa.fa-wrench]
         "Admin"]
        [:a.menu-item {:href "/admin/users"}
         [:i.fa.fa-group]
         "Users"]
        [:a.menu-item {:href "/admin/recent-builds"}
         [:i.fa.fa-clock-o]
         "Recent builds"]
        [:a.menu-item {:href "/admin/projects"}
         [:i.fa.fa-code]
         "Projects"]
        [:a.menu-item
         {:on-click #(put! controls-ch [:intercom-user-inspected])}
         [:i.fa.fa-search]
         "Find project on Intercom"]
        (let [use-local-assets (get user-session-settings :use_local_assets)]
          [:a.menu-item
           {:on-click #(put! controls-ch [:set-user-session-setting {:setting :use-local-assets
                                                                     :value (not use-local-assets)}])}
           [:i.fa.fa-home]
           (if use-local-assets "Stop using local assets" "Use local assets")])
        [:a.menu-item
         {:on-click #(put! controls-ch [:set-user-session-setting {:setting :use-om
                                                                    :value false}])}
         [:i.fa.fa-coffee]
         "Stop using om"]
        (let [current-build-id (get user-session-settings :om_build_id "dev")]
          (for [build-id (remove (partial = current-build-id) ["dev" "whitespace" "production"])]
            [:a.menu-item
             {:on-click #(put! controls-ch [:set-user-session-setting {:setting :om-build-id
                                                                       :value build-id}])}
             [:span (str "Use " build-id " om compiler")]]))))]]])

(defn navbar [app owner opts]
  (reify
    om/IRender
    (render [_]
      (let [controls-ch (get-in opts [:comms :controls])
            user (:current-user app)]
        (html/html
         (if user
           (logged-in-header {:user user
                              :settings (:settings app)
                              :user-session-settings (get-in app [:render-context :user_session_settings])
                              :crumbs (:crumbs app)
                              :controls-ch controls-ch})
           (logged-out-header {:flash (get-in app [:render-context :flash])})))))))

Use a coffee icon for 'stop using om'. ;)


(ns ring.adapter.test.jetty
  (:require [clojure.test :refer :all]
            [ring.adapter.jetty :refer :all]
            [clj-http.client :as http])
  (:import [org.eclipse.jetty.util.thread QueuedThreadPool]
           [org.eclipse.jetty.server Server Request]
           [org.eclipse.jetty.server.handler AbstractHandler]))

(defn- hello-world [request]
  {:status  200
   :headers {"Content-Type" "text/plain"}
   :body    "Hello World"})

(defn- content-type-handler [content-type]
  (constantly
   {:status  200
    :headers {"Content-Type" content-type}
    :body    ""}))

(defn- echo-handler [request]
  {:status 200
   :headers {"request-map" (str (dissoc request :body))}
   :body (:body request)})

(defn- all-threads []
  (.keySet (Thread/getAllStackTraces)))

(defmacro with-server [app options & body]
  `(let [server# (run-jetty ~app ~(assoc options :join? false))]
     (try
       ~@body
       (finally (.stop server#)))))

(deftest test-run-jetty
  (testing "HTTP server"
    (with-server hello-world {:port 4347}
      (let [response (http/get "http://localhost:4347")]
        (is (= (:status response) 200))
        (is (.startsWith (get-in response [:headers "content-type"])
                         "text/plain"))
        (is (= (:body response) "Hello World")))))

  (testing "HTTPS server"
    (with-server hello-world {:port 4347
                              :ssl-port 4348
                              :keystore "test/keystore.jks"
                              :key-password "password"}
      (let [response (http/get "https://localhost:4348" {:insecure? true})]
        (is (= (:status response) 200))
        (is (= (:body response) "Hello World")))))

  (testing "configurator set to run last"
    (let [max-threads 20
          new-handler  (proxy [AbstractHandler] []
                         (handle [_ ^Request base-request request response]))
          configurator (fn [server]
                         (.setMaxThreads (.getThreadPool server) max-threads)
                         (.setHandler server new-handler))
          server (run-jetty hello-world
                            {:join? false :port 4347 :configurator configurator})]
      (is (= (.getMaxThreads (.getThreadPool server)) max-threads))
      (is (identical? new-handler (.getHandler server)))
      (is (= 1 (count (.getHandlers server))))
      (.stop server)))

  (testing "setting daemon threads"
    (testing "default (daemon off)"
      (let [server (run-jetty hello-world {:port 4347 :join? false})]
        (is (not (.. server getThreadPool isDaemon)))
        (.stop server)))
    (testing "daemon on"
      (let [server (run-jetty hello-world {:port 4347 :join? false :daemon? true})]
        (is (.. server getThreadPool isDaemon))
        (.stop server)))
    (testing "daemon off"
      (let [server (run-jetty hello-world {:port 4347 :join? false :daemon? false})]
        (is (not (.. server getThreadPool isDaemon)))
        (.stop server))))

  (testing "setting max idle timeout"
    (let [server (run-jetty hello-world {:port 4347
                                         :ssl-port 4348
                                         :keystore "test/keystore.jks"
                                         :key-password "password"
                                         :join? false
                                         :max-idle-time 5000})
          connectors (. server getConnectors)]
      (is (= 5000 (. (first connectors) getIdleTimeout)))
      (is (= 5000 (. (second connectors) getIdleTimeout)))
      (.stop server)))

  (testing "using the default max idle time"
    (let [server (run-jetty hello-world {:port 4347
                                         :ssl-port 4348
                                         :keystore "test/keystore.jks"
                                         :key-password "password"
                                         :join? false})
          connectors (. server getConnectors)]
      (is (= 200000 (. (first connectors) getIdleTimeout)))
      (is (= 200000 (. (second connectors) getIdleTimeout)))
      (.stop server)))

  (testing "setting min-threads"
    (let [server (run-jetty hello-world {:port 4347
                                         :min-threads 3
                                         :join? false})
          thread-pool (. server getThreadPool)]
      (is (= 3 (. thread-pool getMinThreads)))
      (.stop server)))

  (testing "default min-threads"
    (let [server (run-jetty hello-world {:port 4347
                                         :join? false})
          thread-pool (. server getThreadPool)]
      (is (= 8 (. thread-pool getMinThreads)))
      (.stop server)))

  (testing "default character encoding"
    (with-server (content-type-handler "text/plain") {:port 4347}
      (let [response (http/get "http://localhost:4347")]
        (is (.contains
             (get-in response [:headers "content-type"])
             "text/plain")))))

  (testing "custom content-type"
    (with-server (content-type-handler "text/plain;charset=UTF-16;version=1") {:port 4347}
      (let [response (http/get "http://localhost:4347")]
        (is (= (get-in response [:headers "content-type"])
               "text/plain;charset=UTF-16;version=1")))))

  (testing "request translation"
    (with-server echo-handler {:port 4347}
      (let [response (http/post "http://localhost:4347/foo/bar/baz?surname=jones&age=123" {:body "hello"})]
        (is (= (:status response) 200))
        (is (= (:body response) "hello"))
        (let [request-map (read-string (get-in response [:headers "request-map"]))]
          (is (= (:query-string request-map) "surname=jones&age=123"))
          (is (= (:uri request-map) "/foo/bar/baz"))
          (is (= (:content-length request-map) 5))
          (is (= (:character-encoding request-map) "UTF-8"))
          (is (= (:request-method request-map) :post))
          (is (= (:content-type request-map) "text/plain; charset=UTF-8"))
          (is (= (:remote-addr request-map) "127.0.0.1"))
          (is (= (:scheme request-map) :http))
          (is (= (:server-name request-map) "localhost"))
          (is (= (:server-port request-map) 4347))
          (is (= (:ssl-client-cert request-map) nil))))))

  (testing "resource cleanup on exception"
    (with-server hello-world {:port 4347}
      (let [thread-count (count (all-threads))]
        (is (thrown? Exception (run-jetty hello-world {:port 4347})))
        (loop [i 0]
          (when (and (< i 400) (not= thread-count (count (all-threads))))
            (Thread/sleep 250)
            (recur (inc i))))
        (is (= thread-count (count (all-threads))))))))

(ns ring.adapter.test.jetty
  (:require [clojure.test :refer :all]
            [ring.adapter.jetty :refer :all]
            [clj-http.client :as http])
  (:import [org.eclipse.jetty.util.thread QueuedThreadPool]
           [org.eclipse.jetty.server Server Request]
           [org.eclipse.jetty.server.handler AbstractHandler]))

(defn- hello-world [request]
  {:status  200
   :headers {"Content-Type" "text/plain"}
   :body    "Hello World"})

(defn- content-type-handler [content-type]
  (constantly
   {:status  200
    :headers {"Content-Type" content-type}
    :body    ""}))

(defn- echo-handler [request]
  {:status 200
   :headers {"request-map" (str (dissoc request :body))}
   :body (:body request)})

(defn- all-threads []
  (.keySet (Thread/getAllStackTraces)))

(defmacro with-server [app options & body]
  `(let [server# (run-jetty ~app ~(assoc options :join? false))]
     (try
       ~@body
       (finally (.stop server#)))))

(deftest test-run-jetty
  (testing "HTTP server"
    (with-server hello-world {:port 4347}
      (let [response (http/get "http://localhost:4347")]
        (is (= (:status response) 200))
        (is (.startsWith (get-in response [:headers "content-type"])
                         "text/plain"))
        (is (= (:body response) "Hello World")))))

  (testing "HTTPS server"
    (with-server hello-world {:port 4347
                              :ssl-port 4348
                              :keystore "test/keystore.jks"
                              :key-password "password"}
      (let [response (http/get "https://localhost:4348" {:insecure? true})]
        (is (= (:status response) 200))
        (is (= (:body response) "Hello World")))))

  (testing "configurator set to run last"
    (let [max-threads 20
          new-handler  (proxy [AbstractHandler] []
                         (handle [_ ^Request base-request request response]))
          configurator (fn [server]
                         (.setMaxThreads (.getThreadPool server) max-threads)
                         (.setHandler server new-handler))
          server (run-jetty hello-world
                            {:join? false :port 4347 :configurator configurator})]
      (is (= (.getMaxThreads (.getThreadPool server)) max-threads))
      (is (identical? new-handler (.getHandler server)))
      (is (= 1 (count (.getHandlers server))))
      (.stop server)))

  (testing "setting daemon threads"
    (testing "default (daemon off)"
      (let [server (run-jetty hello-world {:port 4347 :join? false})]
        (is (not (.. server getThreadPool isDaemon)))
        (.stop server)))
    (testing "daemon on"
      (let [server (run-jetty hello-world {:port 4347 :join? false :daemon? true})]
        (is (.. server getThreadPool isDaemon))
        (.stop server)))
    (testing "daemon off"
      (let [server (run-jetty hello-world {:port 4347 :join? false :daemon? false})]
        (is (not (.. server getThreadPool isDaemon)))
        (.stop server))))

  (testing "setting max idle timeout"
    (let [server (run-jetty hello-world {:port 4347
                                         :ssl-port 4348
                                         :keystore "test/keystore.jks"
                                         :key-password "password"
                                         :join? false
                                         :max-idle-time 5000})
          connectors (. server getConnectors)]
      (is (= 5000 (. (first connectors) getIdleTimeout)))
      (is (= 5000 (. (second connectors) getIdleTimeout)))
      (.stop server)))

  (testing "using the default max idle time"
    (let [server (run-jetty hello-world {:port 4347
                                         :ssl-port 4348
                                         :keystore "test/keystore.jks"
                                         :key-password "password"
                                         :join? false})
          connectors (. server getConnectors)]
      (is (= 200000 (. (first connectors) getIdleTimeout)))
      (is (= 200000 (. (second connectors) getIdleTimeout)))
      (.stop server)))

  (testing "setting min-threads"
    (let [server (run-jetty hello-world {:port 4347
                                         :min-threads 3
                                         :join? false})
          thread-pool (. server getThreadPool)]
      (is (= 3 (. thread-pool getMinThreads)))
      (.stop server)))

  (testing "default min-threads"
    (let [server (run-jetty hello-world {:port 4347
                                         :join? false})
          thread-pool (. server getThreadPool)]
      (is (= 8 (. thread-pool getMinThreads)))
      (.stop server)))

  (testing "default character encoding"
    (with-server (content-type-handler "text/plain") {:port 4347}
      (let [response (http/get "http://localhost:4347")]
        (is (.contains
             (get-in response [:headers "content-type"])
             "text/plain")))))

  (testing "custom content-type"
    (with-server (content-type-handler "text/plain;charset=UTF-16;version=1") {:port 4347}
      (let [response (http/get "http://localhost:4347")]
        (is (= (get-in response [:headers "content-type"])
               "text/plain;charset=UTF-16;version=1")))))

  (testing "request translation"
    (with-server echo-handler {:port 4347}
      (let [response (http/post "http://localhost:4347/foo/bar/baz?surname=jones&age=123" {:body "hello"})]
        (is (= (:status response) 200))
        (is (= (:body response) "hello"))
        (let [request-map (read-string (get-in response [:headers "request-map"]))]
          (is (= (:query-string request-map) "surname=jones&age=123"))
          (is (= (:uri request-map) "/foo/bar/baz"))
          (is (= (:content-length request-map) 5))
          (is (= (:character-encoding request-map) "UTF-8"))
          (is (= (:request-method request-map) :post))
          (is (= (:content-type request-map) "text/plain; charset=UTF-8"))
          (is (= (:remote-addr request-map) "127.0.0.1"))
          (is (= (:scheme request-map) :http))
          (is (= (:server-name request-map) "localhost"))
          (is (= (:server-port request-map) 4347))
          (is (= (:ssl-client-cert request-map) nil))))))

  ;; Unable to get test working with Jetty 9
  (comment
    (testing "resource cleanup on exception"
      (with-server hello-world {:port 4347}
        (let [thread-count (count (all-threads))]
          (is (thrown? Exception (run-jetty hello-world {:port 4347})))
          (loop [i 0]
            (when (and (< i 400) (not= thread-count (count (all-threads))))
              (Thread/sleep 250)
              (recur (inc i))))
          (is (= thread-count (count (all-threads)))))))))

Comment out failing Jetty resource cleanup test

Can't get this to work consistently with Jetty 9.


(ns clojurewerkz.statistiker.clustering.kmeans
  (:import [org.apache.commons.math3.ml.clustering KMeansPlusPlusClusterer]
           [clojurewerkz.statistiker DoublePointWithMeta]))

(defn double-point
  [nums]
  (DoublePointWithMeta. (meta nums) (double-array nums)))

(defn- ^KMeansPlusPlusClusterer clusterer
  ([k max-iter]
     (KMeansPlusPlusClusterer. k max-iter))
  ([k max-iter distance-measure]
     (KMeansPlusPlusClusterer. k max-iter distance-measure)))

(defn cluster
  [initial k max-iter]
  (let [clusterer (clusterer k max-iter)]
    (->> initial
         (map double-point)
         (.cluster clusterer)
         (map #(hash-map :center (vec (.getPoint (.getCenter %)))
                         :points (map (fn [a] (with-meta (vec (.getPoint a))
                                               (.getMetadata a)))
                                      (.getPoints %)))))))

(defn cluster-by
  "Clusters the hashmaps by fields. Fields should be given as vector. Field values
   should be numerical.

   Resulting hashmap will be returned with :cluster-id field that identifies the cluster"
  [data fields]
  (let [vectors  (map (fn [point]
                        (with-meta
                          (into [] (for [field fields] (get point field)))
                          point))
                      data)
        clusters (map :points (cluster/cluster vectors 5 200))]
    (->> clusters
         (map vector (iterate inc (int 0)))
         (map (fn [[cluster points]]
                (map #(assoc (meta %) :cluster-id cluster) points)))
         ;; mapcat identity?
         flatten)))

(ns clojurewerkz.statistiker.clustering.kmeans
  (:import [org.apache.commons.math3.ml.clustering KMeansPlusPlusClusterer]
           [clojurewerkz.statistiker DoublePointWithMeta]))

(defn double-point
  [nums]
  (DoublePointWithMeta. (meta nums) (double-array nums)))

(defn- ^KMeansPlusPlusClusterer clusterer
  ([k max-iter]
     (KMeansPlusPlusClusterer. k max-iter))
  ([k max-iter distance-measure]
     (KMeansPlusPlusClusterer. k max-iter distance-measure)))

(defn cluster
  [initial k max-iter]
  (let [clusterer (clusterer k max-iter)]
    (->> initial
         (map double-point)
         (.cluster clusterer)
         (map #(hash-map :center (vec (.getPoint (.getCenter %)))
                         :points (map (fn [a] (with-meta (vec (.getPoint a))
                                               (.getMetadata a)))
                                      (.getPoints %)))))))

(defn cluster-by
  "Clusters the hashmaps by fields. Fields should be given as vector. Field values
   should be numerical.

   Resulting hashmap will be returned with :cluster-id field that identifies the cluster"
  [data fields]
  (let [vectors  (map (fn [point]
                        (with-meta
                          (into [] (for [field fields] (get point field)))
                          point))
                      data)
        clusters (map :points (cluster vectors 5 200))]
    (->> clusters
         (map vector (iterate inc (int 0)))
         (map (fn [[cluster points]]
                (map #(assoc (meta %) :cluster-id cluster) points)))
         ;; mapcat identity?
         flatten)))

Fix minotr issue with kmeans

Fix minotr issue with kmeans


(ns nightweb-desktop.actions
  (:use [nightweb.router :only [create-meta-torrent
                                create-imported-user]]
        [nightweb.io :only [list-dir
                            write-file
                            delete-file
                            write-pic-file
                            write-profile-file
                            write-post-file
                            delete-orphaned-pics]]
        [nightweb.db :only [insert-profile
                            insert-post]]
        [nightweb.formats :only [profile-encode
                                 post-encode
                                 b-decode
                                 b-decode-map
                                 base32-decode]]
        [nightweb.zip :only [zip-dir unzip-dir get-zip-headers]]
        [nightweb.constants :only [my-hash-bytes
                                   my-hash-str
                                   base-dir
                                   nw-dir
                                   user-zip-file
                                   slash
                                   get-user-dir]]
        [nightweb-desktop.utils :only [get-string
                                       decode-data-uri]])
  (:require clojure.edn))

(defn save-profile
  [params]
  (let [pic-str (:pic params)
        name-str (:name params)
        body-str (:body params)
        image-barray (decode-data-uri pic-str)
        pic-hash (write-pic-file image-barray)
        profile (profile-encode name-str body-str pic-hash)]
    (insert-profile @my-hash-bytes (b-decode-map (b-decode profile)))
    (delete-orphaned-pics @my-hash-bytes)
    (write-profile-file profile)
    (create-meta-torrent)))

(defn import-user
  [params]
  (let [path (str @base-dir nw-dir slash user-zip-file)
        dest-path (get-user-dir)
        file-str (:file params)
        password (:pass params)]
    (write-file path (decode-data-uri file-str))
    (if (unzip-dir path dest-path password)
      (let [paths (set (get-zip-headers path))
            new-dirs (-> (fn [d] (contains? paths (str d slash)))
                         (filter (list-dir dest-path)))]
        (if (create-imported-user new-dirs)
          ""
          (get-string :import_error)))
      (get-string :unzip_error))))

(defn export-user
  [params]
  (let [path (get-user-dir @my-hash-str)
        dest-path (str @base-dir nw-dir slash user-zip-file)
        password (:pass params)]
    (delete-file dest-path)
    (if (zip-dir path dest-path password)
      dest-path
      "")))

(defn new-post
  [params]
  (let [text (:body params)
        pics (clojure.edn/read-string (:pics params))
        pic-hashes (for [pic-str pics]
                     (write-pic-file (decode-data-uri pic-str)))
        post (post-encode :text text
                          :pic-hashes pic-hashes
                          :status 1
                          :ptrhash (:ptrhash (base32-decode params))
                          :ptrtime (:ptrtime params))
        create-time (.getTime (java.util.Date.))]
    (insert-post @my-hash-bytes
                 create-time
                 (b-decode-map (b-decode post)))
    (delete-orphaned-pics @my-hash-bytes)
    (write-post-file create-time post)
    (create-meta-torrent)))

(defn do-action
  [params]
  (case (:type params)
    "save-profile" (save-profile params)
    "import-user" (import-user params)
    "export-user" (export-user params)
    "new-post" (new-post params)
    nil))

(ns nightweb-desktop.actions
  (:use [nightweb.router :only [create-meta-torrent
                                create-imported-user]]
        [nightweb.io :only [list-dir
                            write-file
                            delete-file
                            write-pic-file
                            write-profile-file
                            write-post-file
                            delete-orphaned-pics]]
        [nightweb.db :only [insert-profile
                            insert-post]]
        [nightweb.formats :only [profile-encode
                                 post-encode
                                 b-decode
                                 b-decode-map
                                 base32-decode]]
        [nightweb.zip :only [zip-dir unzip-dir get-zip-headers]]
        [nightweb.constants :only [my-hash-bytes
                                   my-hash-str
                                   base-dir
                                   nw-dir
                                   user-zip-file
                                   slash
                                   get-user-dir]]
        [nightweb-desktop.utils :only [get-string
                                       decode-data-uri]])
  (:require clojure.edn))

(defn save-profile
  [params]
  (let [pic-str (:pic params)
        name-str (:name params)
        body-str (:body params)
        image-barray (decode-data-uri pic-str)
        pic-hash (write-pic-file image-barray)
        profile (profile-encode name-str body-str pic-hash)]
    (insert-profile @my-hash-bytes (b-decode-map (b-decode profile)))
    (delete-orphaned-pics @my-hash-bytes)
    (write-profile-file profile)
    (create-meta-torrent)))

(defn import-user
  [params]
  (let [path (str @base-dir nw-dir slash user-zip-file)
        dest-path (get-user-dir)
        file-str (:file params)
        password (:pass params)]
    (write-file path (decode-data-uri file-str))
    (if (unzip-dir path dest-path password)
      (let [paths (set (get-zip-headers path))
            new-dirs (-> (fn [d] (contains? paths (str d slash)))
                         (filter (list-dir dest-path)))]
        (if (create-imported-user new-dirs)
          ""
          (get-string :import_error)))
      (get-string :unzip_error))))

(defn export-user
  [params]
  (let [path (get-user-dir @my-hash-str)
        dest-path (str @base-dir nw-dir slash user-zip-file)
        password (:pass params)]
    (delete-file dest-path)
    (if (zip-dir path dest-path password)
      dest-path
      "")))

(defn new-post
  [params]
  (let [text (:body params)
        pics (clojure.edn/read-string (:pics params))
        pic-hashes (for [pic-str pics]
                     (write-pic-file (decode-data-uri pic-str)))
        post (post-encode :text text
                          :pic-hashes pic-hashes
                          :status 1
                          :ptrhash (base32-decode (:ptrhash params))
                          :ptrtime (:ptrtime params))
        create-time (.getTime (java.util.Date.))]
    (insert-post @my-hash-bytes
                 create-time
                 (b-decode-map (b-decode post)))
    (delete-orphaned-pics @my-hash-bytes)
    (write-post-file create-time post)
    (create-meta-torrent)))

(defn do-action
  [params]
  (case (:type params)
    "save-profile" (save-profile params)
    "import-user" (import-user params)
    "export-user" (export-user params)
    "new-post" (new-post params)
    nil))

Fix ptrhash again

Fix ptrhash again


(ns tryclojure.views.home
  (:require [noir.core :refer [defpartial defpage]]
            [noir.response :refer [redirect]]
            [hiccup.element :refer [javascript-tag link-to unordered-list]]
            [hiccup.page :refer [include-css include-js html5]]))

(defn repl-html [mode title]
  (html5
   [:head
    (include-css "/resources/public/css/tryclojure.css")
    (include-js "http://ajax.googleapis.com/ajax/libs/jquery/1.7.2/jquery.min.js"
                "/resources/public/javascript/jquery-console/jquery.console.js"
                "/resources/public/javascript/tryclojure.js")
    [:title title]]
   [:body
    [:div#wrapper
     [:div#content
      [:div#header
       [:h1 title]]
      [:div#container
       [:div#console.console]]
      (javascript-tag
       (str "mode = '" mode "';"))]]]))

(defpage "/story" []
  (repl-html "story" "Story time with Isla"))

(defpage "/code" []
  (repl-html "isla" "Try Isla"))

(defpage "/" []
  (html5
   [:head
    (include-css "/resources/public/css/tryclojure.css")

    [:title "Isla, a programming language for young children"]]
   [:body
    [:div#wrapper
     [:div#content
      [:div#header
       [:h1 "Isla"]
       [:div#subtitle "A programming language for young children"]]
      [:div#container
       [:div.prose-holder
        [:div.prose
         [:p "Use Isla to write your own story:
          "]
         [:div.story.story-code "
           my name
           is 'Mary'

           my summary
           is 'You are a boy.
           You have no shoes.'

           hallway is a
           room

           hallway summary
           is
           'You are in a hallway.  A candle burns on a table.  You can see a door.'
          "]
         [:p "
           Then, play through your adventure:
          "]
         [:div.story.story-playthrough "
           > play hallway

Are you sitting comfortably? Then, we shall begin.

           > look

You are in a hallway.  A candle burns in front of a mirror.
           You can see a door.

           > open door

The door is locked.

           > look at table

You find a key.

          "]
         [:p "
           No public version, yet.  The
           code is on github.
          "]
         ]]
       [:div.footer "by mary rose cook"]]]]]))

(ns tryclojure.views.home
  (:require [noir.core :refer [defpartial defpage]]
            [noir.response :refer [redirect]]
            [hiccup.element :refer [javascript-tag link-to unordered-list]]
            [hiccup.page :refer [include-css include-js html5]]))

(defn repl-html [mode title]
  (html5
   [:head
    (include-css "/resources/public/css/tryclojure.css")
    (include-js "http://ajax.googleapis.com/ajax/libs/jquery/1.7.2/jquery.min.js"
                "/resources/public/javascript/jquery-console/jquery.console.js"
                "/resources/public/javascript/tryclojure.js")
    [:title title]]
   [:body
    [:div#wrapper
     [:div#content
      [:div#header
       [:h1 title]]
      [:div#container
       [:div#console.console]]
      (javascript-tag
       (str "mode = '" mode "';"))]]]))

(defpage "/story" []
  (repl-html "story" "Story time with Isla"))

(defpage "/code" []
  (repl-html "isla" "Try Isla"))

(defpage "/" []
  (html5
   [:head
    (include-css "/resources/public/css/tryclojure.css")

    [:title "Isla, a programming language for young children"]]
   [:body
    [:div#wrapper
     [:div#content
      [:div#header
       [:h1 "Isla"]
       [:div#subtitle "A programming language for young children"]]
      [:div#container
       [:div.prose-holder
        [:div.prose
         [:p "Use Isla to write your own story:
          "]
         [:div.story.story-code "
           my name
           is 'Mary'

           my summary
           is 'You are a boy.
           You have no shoes.'

           hallway is a
           room

           hallway summary
           is
           'You are in a hallway.  A candle burns on a table.  You can see a door.'
          "]
         [:p "
           Then, play through your adventure:
          "]
         [:div.story.story-playthrough "
           > play The Hallway

Are you sitting comfortably? Then, we shall begin.

           > look

You are in a hallway.  A candle burns in front of a mirror.
           You can see a door.

           > open door

The door is locked.

           > look at table

You find a key.

          "]
         [:p "
           No public version, yet.  The
           code is on github.
          "]
         ]]
       [:div.footer "by mary rose cook"]]]]]))

Make chevron mimicking command line yellow, too.


(ns vault.blob.store.file
  (:require
    [byte-streams]
    [clojure.java.io :as io]
    [clojure.string :as string]
    [vault.blob.core :as blob :refer [BlobStore]])
  (:import
    (java.io
      File)))

;; HELPER FUNCTIONS

(defn- hashid->file
  ^File
  [root id]
  (let [id (blob/hash-id id)
        {:keys [algorithm digest]} id]
    (io/file root
             (name algorithm)
             (subs digest 0 3)
             (subs digest 3 6)
             (subs digest 6))))

(defn- file->hashid
  [root file]
  (let [root (str root)
        file (str file)]
    (when-not (.startsWith file root)
      (throw (IllegalArgumentException.
               (str "File " file " is not a child of root directory " root))))
    (let [[algorithm & digest] (-> file
                                   (subs (inc (count root)))
                                   (string/split #"/"))]
      (blob/hash-id algorithm (string/join digest)))))

(defmacro ^:private for-files
  [[sym dir] expr]
  `(let [files# (->> ~dir .listFiles sort)
         f# (fn [~(vary-meta sym assoc :tag 'java.io.File)] ~expr)]
     (map f# files#)))

(defn- enumerate-files
  "Generates a lazy sequence of file blobs contained in a root directory."
  [^File root]
  ; TODO: intelligently skip entries based on 'after'
  (flatten
    (for-files [algorithm-dir root]
      (for-files [prefix-dir algorithm-dir]
        (for-files [midfix-dir prefix-dir]
          (for-files [blob midfix-dir]
            blob))))))

;; FILE STORE

(defrecord FileBlobStore
  [^File root])

; Don't know why it has to be done this way, but if it's defined inline then
; cloverage breaks.
(extend-protocol BlobStore
  FileBlobStore

  (-list [this opts]
    (->> (enumerate-files (:root this))
         (map (partial file->hashid (:root this)))
         (blob/select-ids opts)))

  (-stat [this id]
    (let [file (hashid->file (:root this) id)]
      (when (.exists file)
        {:size (.length file)
         :stored-at (java.util.Date. (.lastModified file))
         :location (.toURI file)})))

  (-open [this id]
    (let [file (hashid->file (:root this) id)]
      (when (.exists file)
        (byte-streams/to-input-stream file))))

  (-store! [this blob]
    (let [{:keys [id content]} blob
          file (hashid->file (:root this) id)]
      (when-not (.exists file)
        (io/make-parents file)
        ; For some reason, io/copy is much faster than byte-streams/transfer here.
        (io/copy (byte-streams/to-input-stream content) file)
        (.setWritable file false false))))

  (-remove! [this id]
    (let [file (hashid->file (:root this) id)]
      (when (.exists file)
        (.delete file)))))

(defn file-store
  "Creates a new local file-based blob store."
  [root]
  (FileBlobStore. (io/file root)))

(ns vault.blob.store.file
  (:require
    [byte-streams]
    [clojure.java.io :as io]
    [clojure.string :as string]
    [vault.blob.core :as blob :refer [BlobStore]])
  (:import
    java.io.File
    java.util.Date))

;; HELPER FUNCTIONS

(defn- id->file
  ^File
  [root id]
  (let [id (blob/hash-id id)
        {:keys [algorithm digest]} id]
    (io/file root
      (name algorithm)
      (subs digest 0 3)
      (subs digest 3 6)
      (subs digest 6))))

(defn- file->id
  [root file]
  (let [root (str root)
        file (str file)]
    (when-not (.startsWith file root)
      (throw (IllegalArgumentException.
               (str "File " file " is not a child of root directory " root))))
    (let [[algorithm & digest] (-> file
                                   (subs (inc (count root)))
                                   (string/split #"/"))]
      (blob/hash-id algorithm (string/join digest)))))

(defmacro ^:private for-files
  [[sym dir] expr]
  `(let [files# (->> ~dir .listFiles sort)
         f# (fn [~(vary-meta sym assoc :tag 'java.io.File)] ~expr)]
     (map f# files#)))

(defn- enumerate-files
  "Generates a lazy sequence of blob files contained in a root directory."
  [^File root]
  ; TODO: intelligently skip entries based on 'after'
  (flatten
    (for-files [algorithm-dir root]
      (for-files [prefix-dir algorithm-dir]
        (for-files [midfix-dir prefix-dir]
          (for-files [blob midfix-dir]
            blob))))))

(defmacro ^:private when-blob-file
  "This is an unhygenic macro which binds the blob file to 'file' and executes
  the body only if it exists."
  [store id & body]
  `(let [~(with-meta 'file {:tag 'java.io.File})
         (id->file (:root ~store) ~id)]
     (when (.exists ~'file)
       ~@body)))

;; FILE STORE

(defrecord FileBlobStore
  [^File root])

; Don't know why it has to be done this way, but if it's defined inline then
; cloverage breaks.
(extend-protocol BlobStore
  FileBlobStore

  (enumerate [this opts]
    (->> (enumerate-files (:root this))
         (map (partial file->id (:root this)))
         (blob/select-ids opts)))

  (stat [this id]
    (when-blob-file this id
      {:size (.length file)
       :stored-at (Date. (.lastModified file))
       :location (.toURI file)}))

  (open [this id]
    (when-blob-file this id
      (io/input-stream file)))

  (store! [this blob]
    (let [{:keys [id content]} blob
          file (id->file (:root this) id)]
      (when-not (.exists file)
        (io/make-parents file)
        ; For some reason, io/copy is much faster than byte-streams/transfer here.
        (io/copy (byte-streams/to-input-stream content) file)
        (.setWritable file false false))))

  (delete! [this id]
    (when-blob-file this id
      (.delete file)))

  (destroy!! [this]
    (let [rm-r (fn rm-r [^File path]
                 (when (.isDirectory path)
                   (doseq [child (.listFiles path)]
                     (rm-r child)))
                 (.delete path))]
      (rm-r (:root this)))))

(defn file-store
  "Creates a new local file-based blob store."
  [root]
  (FileBlobStore. (io/file root)))

Update FileBlobStore.

Update FileBlobStore.


(ns game-of-life.core)

(defn neighbors [[x y]]
  (set
    (for [dx [-1 0 1] dy [-1 0 1]
          :when (not= 0 dx dy)]
      [(+ dx x) (+ dy y)])))

;; collect all neighbors of live cells
;; count their frequencies
;; if frequency == 2 then add to living set ONLY if alive
;; if frequency == 3 then add to living set
;;
(defn should-live?
  [living-cells [location occurrence-count]]
  (or (= occurrence-count 3)
      (and (= occurrence-count 2)
           (contains? living-cells location))))

(defn advance [living-cells]
  (set
    (map first
      (filter (partial should-live? living-cells)
              (frequencies (mapcat neighbors living-cells))))))

(ns game-of-life.core)

(defn neighbors [[x y]]
  (set
    (for [dx [-1 0 1] dy [-1 0 1]
          :when (not= 0 dx dy)]
      [(+ dx x) (+ dy y)])))

(defn should-live?
  [living-cells [location occurrence-count]]
  (or (= occurrence-count 3)
      (and (= occurrence-count 2)
           (contains? living-cells location))))

(defn advance [living-cells]
  (->>
    living-cells
    (mapcat neighbors)
    (frequencies)
    (filter (partial should-live? living-cells))
    (map first)
    set))

Use threading macro

Use threading macro


(ns scamp.core-test
  (:require [clojure.test :refer :all]
            [scamp.core :as core]
            [schema.core :as s]))

(def random-instance (atom (java.util.Random.)))

(defn reset-rand-state! [& seed]
  (let [seed (or seed 43)]
    (.setSeed @random-instance seed)))

(defn- testing-rand*
  ([] (.nextFloat @random-instance))
  ([n] (* n (testing-rand*))))

(defn- purge-envelope-id [envelope]
  (vec (butlast envelope)))

(defn- purge-world-envelope-ids [world]
  (update world :message-envelopes #(mapv purge-envelope-id %)))

(defn scamp-test [f]
  (core/reset-envelope-ids!)
  (reset-rand-state!)
  (f))

(deftest subscribe-new-node-test
  (scamp-test
   #(is (= (-> core/new-world
               (core/add-new-node (core/node-contact-address->node "node-id0"))
               (core/subscribe-new-node "node-id1" "node-id0")
               (dissoc :config)
               purge-world-envelope-ids)
           {:message-envelopes [],
            :network
            {"node-id0"
             {:self {:id "node-id0"},
              :upstream #{"node-id1"},
              :downstream #{},
              :messages-seen {}},
             "node-id1"
             {:self {:id "node-id1"},
              :upstream #{},
              :downstream #{"node-id0"},
              :messages-seen {}}}}))))

(deftest forward-subscription-test
  (scamp-test
   #(binding [scamp.core/*rand* testing-rand*]
      (let [result (->> (core/forward-subscription #{"stuffy-node" "stuffier-node"}
                                                   "allergen-free-node"
                                                   "43")
                        (map purge-envelope-id))]
        (is (= result
               [[:message-envelope "stuffier-node" :forwarded-subscription "allergen-free-node"]]))))))

(def comm-test-world
  (-> core/new-world
      (core/add-new-node (core/node-contact-address->node "node-id0"))
      (core/subscribe-new-node "node-id1" "node-id0")
      (core/subscribe-new-node "node-id2" "node-id1")
      (core/subscribe-new-node "node-id3" "node-id2")))

(deftest do-comm-test
  (scamp-test
   #(binding [scamp.core/*rand* testing-rand*]
      (let [world comm-test-world
            end-world (-> (reduce
                           (fn [world _n] (core/do-comm world))
                           world
                           (range 9))
                          (dissoc :config)
                          purge-world-envelope-ids)]
        (is (= end-world
               {:message-envelopes
                [[:message-envelope "node-id3" :add-upstream "node-id1"]
                 [:message-envelope "node-id3" :forwarded-subscription "node-id3"]
                 [:message-envelope "node-id3" :forwarded-subscription "node-id3"]
                 [:message-envelope "node-id1" :forwarded-subscription "node-id2"]
                 [:message-envelope "node-id1" :forwarded-subscription "node-id2"]],
                :network
                {"node-id0"
                 {:self {:id "node-id0"},
                  :upstream #{"node-id1"},
                  :downstream #{"node-id2"},
                  :messages-seen {"1" 1, "2" 1, "3" 1}},
                 "node-id1"
                 {:self {:id "node-id1"},
                  :upstream #{"node-id2"},
                  :downstream #{"node-id3" "node-id0"},
                  :messages-seen {"4" 1, "5" 1, "6" 1}},
                 "node-id2"
                 {:self {:id "node-id2"},
                  :upstream #{"node-id3" "node-id0"},
                  :downstream #{"node-id1"},
                  :messages-seen {"1" 1, "2" 1, "3" 1}},
                 "node-id3"
                 {:self {:id "node-id3"},
                  :upstream #{},
                  :downstream #{"node-id2"},
                  :messages-seen {}}}}))))))

(deftest notify-add-upstream-test
  (scamp-test
   #(is (= (-> {:self {:id "canticle"} :upstream #{} :downstream #{} :messages-seen {}}
               (core/notify-add-upstream "liebowitz")
               purge-envelope-id)
           [:message-envelope "liebowitz" :add-upstream "canticle"]))))

(deftest handle-add-upstream-test
  (scamp-test
   #(is (= (core/handle-add-upstream (:logging core/default-config)
                                     {:self {:id "canticle"} :upstream #{} :downstream #{} :messages-seen {}}
                                     "liebowitz")
           [{:self {:id "canticle"}, :upstream #{"liebowitz"}, :downstream #{} :messages-seen {}} []]))))

(deftest update-self-test
  (scamp-test
   (fn []
     (let [new-node (core/node-contact-address->node "node-id0")
           non-networked-node (core/node-contact-address->node "non-networked-node")]
       (is (= (-> core/new-world
                  (core/add-new-node new-node)
                  (core/update-self new-node #(update % :upstream conj "flimflam"))
                  (dissoc :config)
                  purge-world-envelope-ids)
              {:message-envelopes []
               :network
               {"node-id0"
                {:self {:id "node-id0"}, :upstream #{"flimflam"}, :downstream #{} :messages-seen {}}}}))))))

(comment
(binding [scamp.core/*rand* testing-rand*]
                                                                  (for [comm (range 2 252)]
                                                                       (-> comm-test-world (core/do-comms comm) (dissoc :config) purge-world-envelope-ids)))
  )

(ns scamp.core-test
  (:require [clojure.test :refer :all]
            [scamp.core :as core]
            [schema.core :as s]))

(def random-instance (atom (java.util.Random.)))

(defn reset-rand-state! [& seed]
  (let [seed (or seed 43)]
    (.setSeed @random-instance seed)))

(defn- testing-rand*
  ([] (.nextFloat @random-instance))
  ([n] (* n (testing-rand*))))

(defn- purge-envelope-id [envelope]
  (vec (butlast envelope)))

(defn- purge-world-envelope-ids [world]
  (update world :message-envelopes #(mapv purge-envelope-id %)))

(defn scamp-test [f]
  (core/reset-envelope-ids!)
  (reset-rand-state!)
  (f))

(deftest subscribe-new-node-test
  (scamp-test
   #(is (= (-> core/new-world
               (core/add-new-node (core/node-contact-address->node "node-id0"))
               (core/subscribe-new-node "node-id1" "node-id0")
               (dissoc :config)
               purge-world-envelope-ids)
           {:message-envelopes [],
            :network
            {"node-id0"
             {:self {:id "node-id0"},
              :upstream #{"node-id1"},
              :downstream #{},
              :messages-seen {}},
             "node-id1"
             {:self {:id "node-id1"},
              :upstream #{},
              :downstream #{"node-id0"},
              :messages-seen {}}}}))))

(deftest forward-subscription-test
  (scamp-test
   #(binding [scamp.core/*rand* testing-rand*]
      (let [result (->> (core/forward-subscription #{"stuffy-node" "stuffier-node"}
                                                   "allergen-free-node"
                                                   "43")
                        (map purge-envelope-id))]
        (is (= result
               [[:message-envelope "stuffier-node" :forwarded-subscription "allergen-free-node"]]))))))

(deftest do-comm-test
  (scamp-test
   #(binding [scamp.core/*rand* testing-rand*]
      (let [world comm-test-world
            end-world (-> (reduce
                           (fn [world _n] (core/do-comm world))
                           world
                           (range 9))
                          (dissoc :config)
                          purge-world-envelope-ids)]
        (is (= end-world
               {:message-envelopes
                [[:message-envelope "node-id3" :add-upstream "node-id1"]
                 [:message-envelope "node-id3" :forwarded-subscription "node-id3"]
                 [:message-envelope "node-id3" :forwarded-subscription "node-id3"]
                 [:message-envelope "node-id1" :forwarded-subscription "node-id2"]
                 [:message-envelope "node-id1" :forwarded-subscription "node-id2"]],
                :network
                {"node-id0"
                 {:self {:id "node-id0"},
                  :upstream #{"node-id1"},
                  :downstream #{"node-id2"},
                  :messages-seen {"1" 1, "2" 1, "3" 1}},
                 "node-id1"
                 {:self {:id "node-id1"},
                  :upstream #{"node-id2"},
                  :downstream #{"node-id3" "node-id0"},
                  :messages-seen {"4" 1, "5" 1, "6" 1}},
                 "node-id2"
                 {:self {:id "node-id2"},
                  :upstream #{"node-id3" "node-id0"},
                  :downstream #{"node-id1"},
                  :messages-seen {"1" 1, "2" 1, "3" 1}},
                 "node-id3"
                 {:self {:id "node-id3"},
                  :upstream #{},
                  :downstream #{"node-id2"},
                  :messages-seen {}}}}))))))

(deftest notify-add-upstream-test
  (scamp-test
   #(is (= (-> {:self {:id "canticle"} :upstream #{} :downstream #{} :messages-seen {}}
               (core/notify-add-upstream "liebowitz")
               purge-envelope-id)
           [:message-envelope "liebowitz" :add-upstream "canticle"]))))

(deftest handle-add-upstream-test
  (scamp-test
   #(is (= (core/handle-add-upstream (:logging core/default-config)
                                     {:self {:id "canticle"} :upstream #{} :downstream #{} :messages-seen {}}
                                     "liebowitz")
           [{:self {:id "canticle"}, :upstream #{"liebowitz"}, :downstream #{} :messages-seen {}} []]))))

(deftest update-self-test
  (scamp-test
   (fn []
     (let [new-node (core/node-contact-address->node "node-id0")
           non-networked-node (core/node-contact-address->node "non-networked-node")]
       (is (= (-> core/new-world
                  (core/add-new-node new-node)
                  (core/update-self new-node #(update % :upstream conj "flimflam"))
                  (dissoc :config)
                  purge-world-envelope-ids)
              {:message-envelopes []
               :network
               {"node-id0"
                {:self {:id "node-id0"}, :upstream #{"flimflam"}, :downstream #{} :messages-seen {}}}}))))))

(comment
(binding [scamp.core/*rand* testing-rand*]
                                                                  (for [comm (range 2 252)]
                                                                       (-> comm-test-world (core/do-comms comm) (dissoc :config) purge-world-envelope-ids)))
  )

remove deprecated 'comm-test-world

[scamp] remove deprecated 'comm-test-world