(ns jepsen.atlasdb
  (:require [clj-http.client :as http]
            [clojure.tools.logging :refer :all]
            [jepsen.checker :as checker]
            [jepsen.client :as client]
            [jepsen.control :as c]
            [jepsen.db :as db]
            [jepsen.generator :as gen]
            [jepsen.nemesis :as nemesis]
            [jepsen.os.debian :as debian]
            [jepsen.util :refer [timeout]]
            [knossos.history :as history]
            [jepsen.tests :as tests])
  (:import com.palantir.atlasdb.jepsen.JepsenHistoryChecker)
  (:import com.palantir.atlasdb.http.TimestampClient))

(defn create-server
  "Creates an object that implements the db/DB protocol.
   This object defines how to setup and teardown a timelock server on a given
   node, and specifies where the log files can be found.
  "
  []
  (reify db/DB
    (setup! [_ _ node]
      (c/su
        (debian/install-jdk8!)
        (info node "Uploading and unpacking timelock server")
        (c/upload "resources/atlasdb/atlasdb-timelock-server.tgz" "/")
        (c/exec :mkdir "/atlasdb-timelock-server")
        (c/exec :tar :xf "/atlasdb-timelock-server.tgz" "-C" "/atlasdb-timelock-server" "--strip-components" "1")
        (c/upload "resources/atlasdb/timelock.yml" "/atlasdb-timelock-server/var/conf")
        (c/exec :sed :-i (format "s/<HOSTNAME>/%s/" (name node)) "/atlasdb-timelock-server/var/conf/timelock.yml")
        (info node "Starting timelock server")
        (c/exec :env "/usr/lib/jvm/java-8-oracle" "/atlasdb-timelock-server/service/bin/init.sh" "start")
        (info node "Waiting until timelock cluster is ready")
        (TimestampClient/waitUntilHostReady (name node))
        (TimestampClient/waitUntilTimestampClusterReady '("n1" "n2" "n3" "n4" "n5"))))

    (teardown! [_ _ node]
      (c/su
        (try (c/exec "/atlasdb-timelock-server/service/bin/init.sh" "stop") (catch Exception _))
        (try (c/exec :rm :-rf "/atlasdb-timelock-server") (catch Exception _))
        (try (c/exec :rm :-f "/atlasdb-timelock-server.tgz") (catch Exception _))))

    db/LogFiles
    (log-files [_ test node]
      ["/atlasdb-timelock-server/var/log/atlasdb-timelock-server-startup.log"])))

(defn read-operation [_ _] {:type :invoke, :f :read-operation, :value nil})

(defn create-client
  "Creates an object that implements the client/Client protocol.
   The object defines how you create a timestamp client, and how to request
   timestamps from it. The first call to this function will return an invalid
   object: you should call 'setup' on the returned object to get a valid one.
  "
  [timestamp-client]
  (reify client/Client
    (setup!
      [this test node]
      "Factory that returns an object implementing client/Client"
        (create-client (TimestampClient/create '("n1" "n2" "n3" "n4" "n5"))))

    (invoke!
      [this test op]
      "Run an operation on our client"
      (case (:f op)
        :read-operation
          (timeout (* 30 1000)
            (assoc op :type :fail :error :timeout)
            (try
              (assoc op :type :ok :value (.getFreshTimestamp timestamp-client))
              (catch Exception e
                (assoc op :type :fail :error (.toString e)))))))

    (teardown! [_ test])))

(def checker
  (reify checker/Checker
    (check [this test model history opts]
      (.checkClojureHistory (JepsenHistoryChecker/createWithStandardCheckers) history))))

(defn atlasdb-test
  []
  (assoc tests/noop-test
    :os debian/os
    :client (create-client nil)
    :nemesis (nemesis/partition-random-halves)
    :generator (->> read-operation
                    (gen/stagger 0.1)
                    (gen/nemesis
                    (gen/seq (cycle [(gen/sleep 5)
                                     {:type :info, :f :start}
                                     (gen/sleep 20)
                                     {:type :info, :f :stop}])))
                    (gen/time-limit 300))
    :db (create-server)
    :checker checker))

(ns jepsen.atlasdb
  (:require [clj-http.client :as http]
            [clojure.tools.logging :refer :all]
            [jepsen.checker :as checker]
            [jepsen.client :as client]
            [jepsen.control :as c]
            [jepsen.db :as db]
            [jepsen.generator :as gen]
            [jepsen.nemesis :as nemesis]
            [jepsen.os.debian :as debian]
            [jepsen.util :refer [timeout]]
            [knossos.history :as history]
            [jepsen.tests :as tests])
  (:import com.palantir.atlasdb.jepsen.JepsenHistoryChecker)
  (:import com.palantir.atlasdb.http.TimestampClient))

(defn create-server
  "Creates an object that implements the db/DB protocol.
   This object defines how to setup and teardown a timelock server on a given
   node, and specifies where the log files can be found.
  "
  []
  (reify db/DB
    (setup! [_ _ node]
      (c/su
        (debian/install-jdk8!)
        (info node "Uploading and unpacking timelock server")
        (c/upload "resources/atlasdb/atlasdb-timelock-server.tgz" "/")
        (c/exec :mkdir "/atlasdb-timelock-server")
        (c/exec :tar :xf "/atlasdb-timelock-server.tgz" "-C" "/atlasdb-timelock-server" "--strip-components" "1")
        (c/upload "resources/atlasdb/timelock.yml" "/atlasdb-timelock-server/var/conf")
        (c/exec :sed :-i (format "s/<HOSTNAME>/%s/" (name node)) "/atlasdb-timelock-server/var/conf/timelock.yml")
        (info node "Starting timelock server")
        (c/exec :env "JAVA_HOME=/usr/lib/jvm/java-8-oracle" "/atlasdb-timelock-server/service/bin/init.sh" "start")
        (info node "Waiting until timelock cluster is ready")
        (TimestampClient/waitUntilHostReady (name node))
        (TimestampClient/waitUntilTimestampClusterReady '("n1" "n2" "n3" "n4" "n5"))))

    (teardown! [_ _ node]
      (c/su
        (try (c/exec "/atlasdb-timelock-server/service/bin/init.sh" "stop") (catch Exception _))
        (try (c/exec :rm :-rf "/atlasdb-timelock-server") (catch Exception _))
        (try (c/exec :rm :-f "/atlasdb-timelock-server.tgz") (catch Exception _))))

    db/LogFiles
    (log-files [_ test node]
      ["/atlasdb-timelock-server/var/log/atlasdb-timelock-server-startup.log"])))

(defn read-operation [_ _] {:type :invoke, :f :read-operation, :value nil})

(defn create-client
  "Creates an object that implements the client/Client protocol.
   The object defines how you create a timestamp client, and how to request
   timestamps from it. The first call to this function will return an invalid
   object: you should call 'setup' on the returned object to get a valid one.
  "
  [timestamp-client]
  (reify client/Client
    (setup!
      [this test node]
      "Factory that returns an object implementing client/Client"
        (create-client (TimestampClient/create '("n1" "n2" "n3" "n4" "n5"))))

    (invoke!
      [this test op]
      "Run an operation on our client"
      (case (:f op)
        :read-operation
          (timeout (* 30 1000)
            (assoc op :type :fail :error :timeout)
            (try
              (assoc op :type :ok :value (.getFreshTimestamp timestamp-client))
              (catch Exception e
                (assoc op :type :fail :error (.toString e)))))))

    (teardown! [_ test])))

(def checker
  (reify checker/Checker
    (check [this test model history opts]
      (.checkClojureHistory (JepsenHistoryChecker/createWithStandardCheckers) history))))

(defn atlasdb-test
  []
  (assoc tests/noop-test
    :os debian/os
    :client (create-client nil)
    :nemesis (nemesis/partition-random-halves)
    :generator (->> read-operation
                    (gen/stagger 0.1)
                    (gen/nemesis
                    (gen/seq (cycle [(gen/sleep 5)
                                     {:type :info, :f :start}
                                     (gen/sleep 20)
                                     {:type :info, :f :stop}])))
                    (gen/time-limit 300))
    :db (create-server)
    :checker checker))

Fix atlasdb.clj

Fix atlasdb.clj


(defproject sample/sample "0.0.1-SNAPSHOT"
  :description "Sample Android project to test lein-droid plugin."
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}

  :global-vars {*warn-on-reflection* true}

  :source-paths ["src/clojure" "src"]
  :java-source-paths ["src/java"]
  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]

  :plugins [[lein-droid "0.3.4"]]

  ;; Uncomment this line if your project doesn't use Clojure. Also
  ;; don't forget to remove respective dependencies.
  ;; :java-only true

  :dependencies [[org.clojure-android/clojure "1.7.0-alpha5" :use-resources true]
                 [neko/neko "3.2.0-preview2"]]

  :profiles {:default [:dev]

             :dev
             [:android-common :android-user
              ;; These profiles can be specified in your profiles.clj and
              ;; contain machine-specific options such as {:android {:sdk-path
              ;; "/path/to/sdk"}}. :android-user profile is for global
              ;; dev-related options like CIDER configuration.
              {:dependencies [[org.clojure-android/tools.nrepl "0.2.6"]]
               :target-path "target/debug"
               :android {:aot :all-with-unused
                         ;; The namespace of the app package - having a
                         ;; different one for dev and release allows you to
                         ;; install both at the same time.
                         :rename-manifest-package "test.leindroid.sample.debug"
                         :manifest-options {:app-name "Android sample debug"}
                         }}]

             :release
             [:android-common
              {:target-path "target/release"
               :android { ;; Specify the path to your private keystore and the
                         ;; the alias of the key you want to sign APKs with.
                         ;; :keystore-path "/home/user/.android/private.keystore"
                         ;; :key-alias "mykeyalias"
                         ;; :sigalg "MD5withRSA"

                         ;; You can specify these to avoid entering them for
                         ;; each rebuild, but generally it's a bad idea.
                         ;; :keypass "android"
                         ;; :storepass "android"

                         :ignore-log-priority [:debug :verbose]
                         :aot :all

                         ;; This tells lein-droid to build in release mode,
                         ;; disabling debugging and signing the resulting
                         ;; package.
                         :build-type :release}}]

             :lean
             [:release
              {:dependencies ^:replace [[org.skummet/clojure-android "1.7.0-alpha5-r1" :use-resources true]
                                        [neko/neko "3.2.0-preview2" :exclusions [org.clojure-android/clojure]]]
               :jvm-opts ["-Dclojure.compile.ignore-lean-classes=true"]
               :global-vars ^:replace {clojure.core/*warn-on-reflection* true}
               :android {:use-debug-keystore? true
                         :lean-compile true
                         :skummet-skip-vars ["#'neko.init/init"
                                             "#'neko.context/context"
                                             "#'neko.resource/package-name"
                                             "#'neko.-utils/keyword->static-field"
                                             "#'neko.-utils/keyword->setter"
                                             "#'neko.ui.traits/get-display-metrics"
                                             "#'test.leindroid.sample.main/MainActivity-onCreate"
                                             "#'test.leindroid.sample.main/MainActivity-init"]}}]

             ;; Here's an example of using different profiles
             :trial-version-dev
             [:dev ; Inherits from :dev profile
              {:android {:rename-manifest-package "my.sample.app.dev.trial"
                         ;; And then some options which might be
                         ;; additional/different source-paths to pull in different
                         ;; code, or a manifest option which configures some aspect
                         ;; of your application.
                         }}]}

  :android {;; Specify the path to the Android SDK directory either here or in
            ;; :android-common profile in your ~/.lein/profiles.clj file.
            ;; :sdk-path "/home/user/path/to/android-sdk/"

            ;; Use this if you don't want to use the latest version of
            ;; Android Build Tools.
            ;; :build-tools-version "19.0.3"

            ;; Specify this if your project is a library.
            ;; :library true

            :dex-opts ["-JXmx4096M"]

            ;; Uncomment this if dexer fails with OutOfMemoryException.
            ;; :force-dex-optimize true

            ;; Uncomment this line to be able to use Google API.
            ;; :use-google-api true

            ;; This option allows you to specify Android support
            ;; libraries you want to use in your application.
            ;; Available versions: "v4", "v7-appcompat",
            ;; "v7-gridlayout", "v7-mediarouter", "v13".
            ;; :support-libraries ["v7-appcompat" "v13"]

            ;; Use this property to add project dependencies.
            ;; :project-dependencies [ "/path/to/library/project" ]

            ;; Sequence of external jars or class folders to include
            ;; into project.
            ;; :external-classes-paths ["path/to/external/jar/file"
            ;;                          "path/to/classfiles/"]

            ;; Sequence of jars, resources from which will be added to
            ;; application package.
            ;; :resource-jars-paths ["path/to/resource/jar"]

            ;; Sequence of native libraries files that will be added
            ;; to application package.
            ;; :native-libraries-paths ["path/to/native/library"]

            ;; Target version affects api used for compilation.
            :target-version 18

            ;; Sequence of namespaces that should not be compiled.
            :aot-exclude-ns ["clojure.parallel" "clojure.core.reducers"]

            ;; This specifies replacements which are inserted into
            ;; AndroidManifest-template.xml at build time. See Clostache for
            ;; more advanced substitution syntax. Version name and code are
            ;; automatically inserted
            :manifest-options {:app-name "@string/app_name"}
            })

(defproject sample/sample "0.0.1-SNAPSHOT"
  :description "Sample Android project to test lein-droid plugin."
  :url "http://example.com/FIXME"
  :license {:name "Eclipse Public License"
            :url "http://www.eclipse.org/legal/epl-v10.html"}

  :global-vars {*warn-on-reflection* true}

  :source-paths ["src/clojure" "src"]
  :java-source-paths ["src/java"]
  :javac-options ["-target" "1.6" "-source" "1.6" "-Xlint:-options"]

  :plugins [[lein-droid "0.3.4"]]

  ;; Uncomment this line if your project doesn't use Clojure. Also
  ;; don't forget to remove respective dependencies.
  ;; :java-only true

  :dependencies [[org.clojure-android/clojure "1.7.0-alpha5" :use-resources true]
                 [neko/neko "3.2.0-preview3"]]

  :profiles {:default [:dev]

             :dev
             [:android-common :android-user
              ;; These profiles can be specified in your profiles.clj and
              ;; contain machine-specific options such as {:android {:sdk-path
              ;; "/path/to/sdk"}}. :android-user profile is for global
              ;; dev-related options like CIDER configuration.
              {:dependencies [[org.clojure-android/tools.nrepl "0.2.6"]]
               :target-path "target/debug"
               :android {:aot :all-with-unused
                         ;; The namespace of the app package - having a
                         ;; different one for dev and release allows you to
                         ;; install both at the same time.
                         :rename-manifest-package "test.leindroid.sample.debug"
                         :manifest-options {:app-name "Android sample debug"}
                         }}]

             :release
             [:android-common
              {:target-path "target/release"
               :android { ;; Specify the path to your private keystore and the
                         ;; the alias of the key you want to sign APKs with.
                         ;; :keystore-path "/home/user/.android/private.keystore"
                         ;; :key-alias "mykeyalias"
                         ;; :sigalg "MD5withRSA"

                         ;; You can specify these to avoid entering them for
                         ;; each rebuild, but generally it's a bad idea.
                         ;; :keypass "android"
                         ;; :storepass "android"

                         :ignore-log-priority [:debug :verbose]
                         :aot :all

                         ;; This tells lein-droid to build in release mode,
                         ;; disabling debugging and signing the resulting
                         ;; package.
                         :build-type :release}}]

             :lean
             [:release
              {:dependencies ^:replace [[org.skummet/clojure-android "1.7.0-alpha5-r1" :use-resources true]
                                        [neko/neko "3.2.0-preview2" :exclusions [org.clojure-android/clojure]]]
               :jvm-opts ["-Dclojure.compile.ignore-lean-classes=true"]
               :global-vars ^:replace {clojure.core/*warn-on-reflection* true}
               :android {:use-debug-keystore? true
                         :lean-compile true
                         :skummet-skip-vars ["#'neko.init/init"
                                             "#'neko.context/context"
                                             "#'neko.resource/package-name"
                                             "#'neko.-utils/keyword->static-field"
                                             "#'neko.-utils/keyword->setter"
                                             "#'neko.ui.traits/get-display-metrics"
                                             "#'test.leindroid.sample.main/MainActivity-onCreate"
                                             "#'test.leindroid.sample.main/MainActivity-init"]}}]

             ;; Here's an example of using different profiles
             :trial-version-dev
             [:dev ; Inherits from :dev profile
              {:android {:rename-manifest-package "my.sample.app.dev.trial"
                         ;; And then some options which might be
                         ;; additional/different source-paths to pull in different
                         ;; code, or a manifest option which configures some aspect
                         ;; of your application.
                         }}]}

  :android {;; Specify the path to the Android SDK directory either here or in
            ;; :android-common profile in your ~/.lein/profiles.clj file.
            ;; :sdk-path "/home/user/path/to/android-sdk/"

            ;; Use this if you don't want to use the latest version of
            ;; Android Build Tools.
            ;; :build-tools-version "19.0.3"

            ;; Specify this if your project is a library.
            ;; :library true

            :dex-opts ["-JXmx4096M"]

            ;; Uncomment this if dexer fails with OutOfMemoryException.
            ;; :force-dex-optimize true

            ;; Uncomment this line to be able to use Google API.
            ;; :use-google-api true

            ;; This option allows you to specify Android support
            ;; libraries you want to use in your application.
            ;; Available versions: "v4", "v7-appcompat",
            ;; "v7-gridlayout", "v7-mediarouter", "v13".
            ;; :support-libraries ["v7-appcompat" "v13"]

            ;; Use this property to add project dependencies.
            ;; :project-dependencies [ "/path/to/library/project" ]

            ;; Sequence of external jars or class folders to include
            ;; into project.
            ;; :external-classes-paths ["path/to/external/jar/file"
            ;;                          "path/to/classfiles/"]

            ;; Sequence of jars, resources from which will be added to
            ;; application package.
            ;; :resource-jars-paths ["path/to/resource/jar"]

            ;; Sequence of native libraries files that will be added
            ;; to application package.
            ;; :native-libraries-paths ["path/to/native/library"]

            ;; Target version affects api used for compilation.
            :target-version 18

            ;; Sequence of namespaces that should not be compiled.
            :aot-exclude-ns ["clojure.parallel" "clojure.core.reducers"]

            ;; This specifies replacements which are inserted into
            ;; AndroidManifest-template.xml at build time. See Clostache for
            ;; more advanced substitution syntax. Version name and code are
            ;; automatically inserted
            :manifest-options {:app-name "@string/app_name"}
            })

Update Neko dependency

Update Neko dependency


(ns bulldog.components
  (:require [goog.dom :as gdom]
            [om.dom :as dom]
            [sablono.core :as html :refer-macros [html]]
            [om.next :as om :refer-macros [defui]]))

(defn onChange
  "Creates input callpack"
  [value component]
  (fn [event]
    (om/set-state!
     component
     (assoc
      (om/get-state component)
      value
      (.. event -target -value)))))

(defui EditorPage
  Object
  (render [this]
    (let [{:keys [title abstract article] :as local} (om/get-state this)]
      (html
       [:div
        [:input
         {:placeholder "What's the title?"
          :type :text
          :value title
          :onChange (onChange :title this)}]
        [:input
         {:placeholder "Give a short introduction"
          :type :text
          :value abstract
          :onChange (onChange :abstract this)}]
        [:input
         {:placeholder "Write your article"
          :type :text
          :value article
          :onChange (onChange :article this)}]
        [:div
         [:button {:onClick (fn [e] (-> js/document .-location (set! "#/")))} "Cancel" ]
         [:button "Publish"]]]))))

(defui ArticlePage
  om/IQuery
  (query [this]
    '[(:content/article nil)])
  Object
  (render [this]
    (let [{:keys [:content/article]} (om/props this)
          {:keys [title author content]} article]
      (html
       [:div
        [:h2 title]
        [:p author]
        content]))))

(defui FrontpageArticle
  Object
  (render [this]
    (let [{:keys [title abstract date-diff id]} (om/props this)]
      (html
       [:li
        [:a {:href (str "#/articles/" id)}
         [:div [:h3 title] [:span date-diff]]
         [:p abstract]]]))))

(def frontpage-article (om/factory FrontpageArticle))

(defui Frontpage
  static om/IQuery
  (query [this]
    '[(:articles/recent nil) (:content/title nil)])
  Object
  (render [this]
    (let [{:keys [:articles/recent :content/title] :as props} (om/props this)]
      (html
       [:div
        [:h2 title]
        [:h4 "Recent Articles"]
        [:ul (map frontpage-article recent)]]))))

(ns bulldog.components
  (:require [goog.dom :as gdom]
            [om.dom :as dom]
            [sablono.core :as html :refer-macros [html]]
            [om.next :as om :refer-macros [defui]]))

(defn onChange
  "Creates input callback"
  [value component]
  (fn [event]
    (om/set-state!
     component
     (assoc
      (om/get-state component)
      value
      (.. event -target -value)))))

(defui EditorPage
  Object
  (render [this]
    (let [{:keys [title abstract article] :as local} (om/get-state this)]
      (html
       [:div
        [:input
         {:placeholder "What's the title?"
          :type :text
          :value title
          :onChange (onChange :title this)}]
        [:input
         {:placeholder "Give a short introduction"
          :type :text
          :value abstract
          :onChange (onChange :abstract this)}]
        [:input
         {:placeholder "Write your article"
          :type :text
          :value article
          :onChange (onChange :article this)}]
        [:div
         [:button {:onClick (fn [e] (-> js/document .-location (set! "#/")))} "Cancel" ]
         [:button "Publish"]]]))))

(defui ArticlePage
  om/IQuery
  (query [this]
    '[(:content/article nil)])
  Object
  (render [this]
    (let [{:keys [:content/article]} (om/props this)
          {:keys [title author content]} article]
      (html
       [:div
        [:h2 title]
        [:p author]
        content]))))

(defui FrontpageArticle
  Object
  (render [this]
    (let [{:keys [title abstract date-diff id]} (om/props this)]
      (html
       [:li
        [:a {:href (str "#/articles/" id)}
         [:div [:h3 title] [:span date-diff]]
         [:p abstract]]]))))

(def frontpage-article (om/factory FrontpageArticle))

(defui Frontpage
  static om/IQuery
  (query [this]
    '[(:articles/recent nil) (:content/title nil)])
  Object
  (render [this]
    (let [{:keys [:articles/recent :content/title] :as props} (om/props this)]
      (html
       [:div
        [:h2 title]
        [:h4 "Recent Articles"]
        [:ul (map frontpage-article recent)]]))))

fix typo

fix typo


;; Copyright 2017 Jong-won Choi <oz.jongwon.choi@gmail.com>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns clojure-fabric.event-hub
  (:require [clojure-fabric.proto :as proto]
            [clojure-fabric.crypto-suite :as crypto]
            [clojure.core.async :as async])
  (:import io.grpc.stub.StreamObserver
           [com.google.protobuf ByteString]
           io.grpc.ManagedChannel
           org.hyperledger.fabric.protos.msp.Identities$SerializedIdentity
           [org.hyperledger.fabric.protos.common Common$Block Common$BlockMetadataIndex
            Common$Envelope]
           [org.hyperledger.fabric.protos.peer EventsGrpc EventsPackage$Event
            EventsPackage$Interest EventsPackage$Register EventsPackage$Event$EventCase
            EventsPackage$SignedEvent TransactionPackage$TxValidationCode]))

;; From NodeJs SDK
;;
;; EventHub
;; Transaction processing in fabric v1.0 is a long operation spanning multiple components
;; (application, endorsing peer, orderer, committing peer) and takes a relatively lengthy
;; period of time (think seconds instead of milliseconds) to complete. As a result the applications
;; must design their handling of the transaction lifecyle in an asynchrous fashion.
;; After the transaction proposal has been successfully endorsed, and before the transaction message
;; has been successfully broadcast to the orderer, the application should register a listener
;; to be notified of the event when the transaction achieves finality, which is when the block
;; containing the transaction gets added to the peer's ledger/blockchain.
;;
;; Fabric committing peers provides an event stream to publish events to registered listeners.
;; As of v1.0, the only events that get published are Block events. A Block event gets published
;; whenever the committing peer adds a validated block to the ledger. There are three ways
;; to register a listener to get notified:
;; - register a "block listener" to get called for every block event on all channels. The listener
;;      will be passed a fully decoded Block object. See registerBlockEvent
;; - register a "transaction listener" to get called when the specific transaction by id is
;;      committed (discovered inside a block event). The listener will be passed the transaction id
;;      and the validation code. See registerTxEvent
;; - register a "chaincode event listener" to get called when a specific chaincode event has arrived.
;;      The listener will be passed the ChaincodeEvent. See registerChaincodeEvent
;;
;; The events are ephemeral, such that if a registered listener crashed when the event is published,
;; the listener will miss the event. There are several techniques to compensate for missed events
;; due to client crashes:
;; - register block event listeners and record the block numbers received, such that when the next
;;      block arrives and its number is not the next in sequence, then the application knows exactly
;;      which block events have been missed. It can then use queryBlock to get those missed blocks
;;      from the target peer.
;; - use a message queue to catch all the block events. With many robust message queue
;;      implementations available today, you will be guaranteed to not miss an event. A fabric event
;;      listener can be written in any programming language. The following implementations can be
;;      used as reference to write the necessary glue code between the fabric event stream and
;;      a message queue:
;;      - Node.js: this class. Source code can be found here
;;      - Java: part of the Java SDK for Hyperledger Fabric. Source code can be found here
;;      - Golang: an example event listener client can be found here
;;
(defrecord EventHub [peer-address peer-tls-certificate peer-tls-certificate-override
                     tx-registrants
                     connected
                     mtx chaincode-registrants block-registrants
                     grpc-client
                     interested-events
                     event-client-factory client])

(defn make-event-hub [m]
  (map->EventHub m))

(def ^:dynamic *event-hub* nil)

(defn connect
  ([]
   (connect event-hub))
  ([event-hub]
   (when-not (:connected event-hub)
     (if-not (:peer-address event-hub)
       (throw (Exception. "Peer address is missing!"))
       ))))

;; connect
;; disconnect
;; get-peer-address
;; connected?
;; register-block-event
;; register-chaincode-event
;; register-tx-event
;; set-peer-address
;; unregister-block-event
;; unregister-chaincode-event
;; unregister-tx-event

;; set-interests
;; add-chaincode-interest
;; remove-chaincode-interest
;; get-interested-events
;; receive (i/f - block or chaincode)

#_
(defonce event-type {:register
                     :block
                     :chaincode
                     :rejection
                     :filtered-block})

(defonce default-sliding-buffer-size 32)
;; Block event - any block events
(defonce event-channels (atom []))
;; Transaction event - matching tx-id
(defonce tx-id-event-channels (atom {}))
;; Chaincode event - matching chaincode-id
(defonce chaincode-channels (atom {}))

(defonce block-metadata-index-map
  (zipmap [:signatures :last-config :transactions-filter :orderer]
          [Common$BlockMetadataIndex/SIGNATURES_VALUE Common$BlockMetadataIndex/LAST_CONFIG_VALUE
           Common$BlockMetadataIndex/TRANSACTIONS_FILTER_VALUE Common$BlockMetadataIndex/ORDERER_VALUE]))

(defonce tx-validation-code-map
  (zipmap [TransactionPackage$TxValidationCode/VALID_VALUE
           TransactionPackage$TxValidationCode/NIL_ENVELOPE_VALUE
           TransactionPackage$TxValidationCode/BAD_PAYLOAD_VALUE
           TransactionPackage$TxValidationCode/BAD_COMMON_HEADER_VALUE
           TransactionPackage$TxValidationCode/BAD_CREATOR_SIGNATURE_VALUE
           TransactionPackage$TxValidationCode/INVALID_ENDORSER_TRANSACTION_VALUE
           TransactionPackage$TxValidationCode/INVALID_CONFIG_TRANSACTION_VALUE
           TransactionPackage$TxValidationCode/UNSUPPORTED_TX_PAYLOAD_VALUE
           TransactionPackage$TxValidationCode/BAD_PROPOSAL_TXID_VALUE
           TransactionPackage$TxValidationCode/DUPLICATE_TXID_VALUE
           TransactionPackage$TxValidationCode/ENDORSEMENT_POLICY_FAILURE_VALUE
           TransactionPackage$TxValidationCode/MVCC_READ_CONFLICT_VALUE
           TransactionPackage$TxValidationCode/PHANTOM_READ_CONFLICT_VALUE
           TransactionPackage$TxValidationCode/UNKNOWN_TX_TYPE_VALUE
           TransactionPackage$TxValidationCode/TARGET_CHAIN_NOT_FOUND_VALUE
           TransactionPackage$TxValidationCode/MARSHAL_TX_ERROR_VALUE
           TransactionPackage$TxValidationCode/NIL_TXACTION_VALUE
           TransactionPackage$TxValidationCode/EXPIRED_CHAINCODE_VALUE
           TransactionPackage$TxValidationCode/CHAINCODE_VERSION_CONFLICT_VALUE
           TransactionPackage$TxValidationCode/BAD_HEADER_EXTENSION_VALUE
           TransactionPackage$TxValidationCode/BAD_CHANNEL_HEADER_VALUE
           TransactionPackage$TxValidationCode/BAD_RESPONSE_PAYLOAD_VALUE
           TransactionPackage$TxValidationCode/BAD_RWSET_VALUE
           TransactionPackage$TxValidationCode/ILLEGAL_WRITESET_VALUE
           TransactionPackage$TxValidationCode/INVALID_OTHER_REASON_VALUE]
          [:valid
           :nil-envelope
           :bad-payload
           :bad-common-header
           :bad-creator-signature
           :invalid-endorser-transaction
           :invalid-config-transaction
           :unsupported-tx-payload
           :bad-proposal-txid
           :duplicate-txid
           :endorsement-policy-failure
           :mvcc-read-conflict
           :phantom-read-conflict
           :unknown-tx-type
           :target-chain-not-found
           :marshal-tx-error
           :nil-txaction
           :expired-chaincode
           :chaincode-version-conflict
           :bad-header-extension
           :bad-channel-header
           :bad-response-payload
           :bad-rwset
           :illegal-writeset
           :invalid-other-reason]))

;; Block event is proto/Block
(defrecord TxEvent [tx-id status])

(defn tx-id->channel [tx-id]
  :fixme)

(defn deliver-block-events-to-channels
  [^Common$Block proto-block]
  (let [clj-block (proto/proto->clj proto-block (proto/parse-trees :block))]
    ;; 1. Block Event on all channels
    (async/put! block-channel clj-block)
    (doseq [[data code] (map list
                             (:data clj-block)
                             (-> (:metadata clj-block)
                                 (:metadata)
                                 (nth (block-metadata-index-map :transactions-filter))
                                 (.toByteArray)))]
      (let [payload (get data :payload)
            channel-header (get-in payload [:header :channel-header])]
        ;; 2. Transaction Event with tx-id
        (when-let [ch (tx-id->channel tx-id)]
          (async/put! ch (make-TxEvent (:tx-id channel-header) code)))
        ;; 3. Chaincode event
        (when (= (:type channel-header) (proto/header-types :endorser-transaction))
          (let [chaincode-event (get-in payload [:data :actions 0 :payload :action
                                                 :proposal-response-payload :extension :events])]
            (when-let [ch (chaincode-id->channel (:chaincode-id chaincode-event))]
              (async/put! ch chaincode-event))))))))

(defn transaction-observer
  [ch]
  (reify StreamObserver
    (onNext [this event]
      (case (.getEventCase ^EventsPackage$Event event)
        EventsPackage$Event$EventCase/BLOCK (deliver-block-to-channels (.getBlock event))
        EventsPackage$Event$EventCase/REGISTER nil ;; init
        ;; EventsPackage$Event$EventCase/CHAINCODE_EVENT ;; FIXME: not used??
        EventsPackage$Event$EventCase/UNREGISTER nil;; shutdown
        ))
    (onError [this err]
      ;; FIXME call shutdownNow when Status$Code/INTERNAL or Status$Code/UNAVAILABLE
      (async/put! ch err))
    (onCompleted [this]
      (async/put! ch :done))))

(defn make-event-hub???
  [user peer]
  (let [ch (async/chan (async/sliding-buffer default-sliding-buffer-size))
        ^StreamObserver observer (transaction-observer ch)
        ^ManagedChannel channel (proto/node->channel peer)]
    (.chat (EventsGrpc/newStub channel)
           observer)
    (let [interest (-> (EventsPackage$Interest/newBuilder)
                       (.setEventType EventsPackage$Event$EventCase/BLOCK)
                       (.build))
          register (-> (EventsPackage$Register/newBuilder)
                       (.addEvents interest)
                       (.build))
          block-event (-> (EventsPackage$Event/newBuilder)
                          (.setRegister register)
                          (.setCreator (.toByteString ^Identities$SerializedIdentity
                                                      (proto/clj->proto (proto/user->serialized-identity user))))
                          (.build))]
      (.onNext observer
               (-> (EventsPackage$SignedEvent/newBuilder)
                   (.setEventBytes (.toByteString block-event))
                   (.setSignature (ByteString/copyFrom ^bytes (crypto/sign (.toByteArray block-event) (:private-key user) {:algorithm (:key-algorithm (:crypto-suite user))})))
                   (.build)))
      (try
        (async/go-loop []
          (let [block (async/<!! ch)]
            (case (.getEventCase ^EventsPackage$Event event)
              EventsPackage$Event$EventCase/BLOCK (async/put! ch event) ;; ch is like eventQueue
              EventsPackage$Event$EventCase/REGISTER :FIXME ;; connected, connectedTime
        )
            (cond= (type v)

                   (instance? Exception v) (when-not (.isShutdown channel)
                                             (.shutdownNow channel))
                  ;; FIXME: do something here!!
                  :else (recur))))
        (finally (.onCompleted observer))))))

;; Copyright 2017 Jong-won Choi <oz.jongwon.choi@gmail.com>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns clojure-fabric.event-hub
  (:require [clojure-fabric.proto :as proto]
            [clojure-fabric.crypto-suite :as crypto]
            [clojure-fabric.utils :as utils]
            [clojure.core.async :as async]
            [clojure-fabric.core :as core])
  (:import io.grpc.stub.StreamObserver
           [clojure_fabric.proto Block ChaincodeEvent]
           [com.google.protobuf ByteString]
           io.grpc.ManagedChannel
           org.hyperledger.fabric.protos.msp.Identities$SerializedIdentity
           [org.hyperledger.fabric.protos.common Common$Block Common$BlockMetadataIndex
            Common$Envelope]
           [org.hyperledger.fabric.protos.peer EventsGrpc EventsPackage$Event
            EventsPackage$Interest EventsPackage$Register EventsPackage$Event$EventCase
            EventsPackage$SignedEvent TransactionPackage$TxValidationCode]))

;; From NodeJs SDK
;;
;; EventHub
;; Transaction processing in fabric v1.0 is a long operation spanning multiple components
;; (application, endorsing peer, orderer, committing peer) and takes a relatively lengthy
;; period of time (think seconds instead of milliseconds) to complete. As a result the applications
;; must design their handling of the transaction lifecyle in an asynchrous fashion.
;; After the transaction proposal has been successfully endorsed, and before the transaction message
;; has been successfully broadcast to the orderer, the application should register a listener
;; to be notified of the event when the transaction achieves finality, which is when the block
;; containing the transaction gets added to the peer's ledger/blockchain.
;;
;; Fabric committing peers provides an event stream to publish events to registered listeners.
;; As of v1.0, the only events that get published are Block events. A Block event gets published
;; whenever the committing peer adds a validated block to the ledger. There are three ways
;; to register a listener to get notified:
;; - register a "block listener" to get called for every block event on all channels. The listener
;;      will be passed a fully decoded Block object. See registerBlockEvent
;; - register a "transaction listener" to get called when the specific transaction by id is
;;      committed (discovered inside a block event). The listener will be passed the transaction id
;;      and the validation code. See registerTxEvent
;; - register a "chaincode event listener" to get called when a specific chaincode event has arrived.
;;      The listener will be passed the ChaincodeEvent. See registerChaincodeEvent
;;
;; The events are ephemeral, such that if a registered listener crashed when the event is published,
;; the listener will miss the event. There are several techniques to compensate for missed events
;; due to client crashes:
;; - register block event listeners and record the block numbers received, such that when the next
;;      block arrives and its number is not the next in sequence, then the application knows exactly
;;      which block events have been missed. It can then use queryBlock to get those missed blocks
;;      from the target peer.
;; - use a message queue to catch all the block events. With many robust message queue
;;      implementations available today, you will be guaranteed to not miss an event. A fabric event
;;      listener can be written in any programming language. The following implementations can be
;;      used as reference to write the necessary glue code between the fabric event stream and
;;      a message queue:
;;      - Node.js: this class. Source code can be found here
;;      - Java: part of the Java SDK for Hyperledger Fabric. Source code can be found here
;;      - Golang: an example event listener client can be found here
;;
(defrecord EventHub [peer-address peer-tls-certificate peer-tls-certificate-override
                     tx-registrants
                     connected
                     mtx chaincode-registrants block-registrants
                     grpc-client
                     interested-events
                     event-client-factory client])

(defn make-event-hub [m]
  (map->EventHub m))

(def ^:dynamic *event-hub* nil)

(defn connect
  ([]
   (connect event-hub))
  ([event-hub]
   (when-not (:connected event-hub)
     (if-not (:peer-address event-hub)
       (throw (Exception. "Peer address is missing!"))
       ))))

;; connect
;; disconnect
;; get-peer-address
;; connected?
;; set-peer-address
;; unregister-block-event
;; unregister-chaincode-event
;; unregister-tx-event

;; set-interests
;; add-chaincode-interest
;; remove-chaincode-interest
;; get-interested-events
;; receive (i/f - block or chaincode)

(defonce block-metadata-index-map
  (zipmap [:signatures :last-config :transactions-filter :orderer]
          [Common$BlockMetadataIndex/SIGNATURES_VALUE Common$BlockMetadataIndex/LAST_CONFIG_VALUE
           Common$BlockMetadataIndex/TRANSACTIONS_FILTER_VALUE Common$BlockMetadataIndex/ORDERER_VALUE]))

(defonce tx-validation-code-map
  (zipmap [TransactionPackage$TxValidationCode/VALID_VALUE
           TransactionPackage$TxValidationCode/NIL_ENVELOPE_VALUE
           TransactionPackage$TxValidationCode/BAD_PAYLOAD_VALUE
           TransactionPackage$TxValidationCode/BAD_COMMON_HEADER_VALUE
           TransactionPackage$TxValidationCode/BAD_CREATOR_SIGNATURE_VALUE
           TransactionPackage$TxValidationCode/INVALID_ENDORSER_TRANSACTION_VALUE
           TransactionPackage$TxValidationCode/INVALID_CONFIG_TRANSACTION_VALUE
           TransactionPackage$TxValidationCode/UNSUPPORTED_TX_PAYLOAD_VALUE
           TransactionPackage$TxValidationCode/BAD_PROPOSAL_TXID_VALUE
           TransactionPackage$TxValidationCode/DUPLICATE_TXID_VALUE
           TransactionPackage$TxValidationCode/ENDORSEMENT_POLICY_FAILURE_VALUE
           TransactionPackage$TxValidationCode/MVCC_READ_CONFLICT_VALUE
           TransactionPackage$TxValidationCode/PHANTOM_READ_CONFLICT_VALUE
           TransactionPackage$TxValidationCode/UNKNOWN_TX_TYPE_VALUE
           TransactionPackage$TxValidationCode/TARGET_CHAIN_NOT_FOUND_VALUE
           TransactionPackage$TxValidationCode/MARSHAL_TX_ERROR_VALUE
           TransactionPackage$TxValidationCode/NIL_TXACTION_VALUE
           TransactionPackage$TxValidationCode/EXPIRED_CHAINCODE_VALUE
           TransactionPackage$TxValidationCode/CHAINCODE_VERSION_CONFLICT_VALUE
           TransactionPackage$TxValidationCode/BAD_HEADER_EXTENSION_VALUE
           TransactionPackage$TxValidationCode/BAD_CHANNEL_HEADER_VALUE
           TransactionPackage$TxValidationCode/BAD_RESPONSE_PAYLOAD_VALUE
           TransactionPackage$TxValidationCode/BAD_RWSET_VALUE
           TransactionPackage$TxValidationCode/ILLEGAL_WRITESET_VALUE
           TransactionPackage$TxValidationCode/INVALID_OTHER_REASON_VALUE]
          [:valid
           :nil-envelope
           :bad-payload
           :bad-common-header
           :bad-creator-signature
           :invalid-endorser-transaction
           :invalid-config-transaction
           :unsupported-tx-payload
           :bad-proposal-txid
           :duplicate-txid
           :endorsement-policy-failure
           :mvcc-read-conflict
           :phantom-read-conflict
           :unknown-tx-type
           :target-chain-not-found
           :marshal-tx-error
           :nil-txaction
           :expired-chaincode
           :chaincode-version-conflict
           :bad-header-extension
           :bad-channel-header
           :bad-response-payload
           :bad-rwset
           :illegal-writeset
           :invalid-other-reason]))

#_
(defonce event-type {:register
                     :block
                     :chaincode
                     :rejection
                     :filtered-block})

(defonce default-sliding-buffer-size 32)
(defonce command-ch (chan))
;; Block event - any block events
(defonce block-event-chan (async/sliding-buffer default-sliding-buffer-size))
(defonce block-event-handlers (atom {}))
;; Transaction event - matching tx-id
(defonce tx-id->chan-fn-map (atom {}))
;; Chaincode event - matching chaincode-id
(defonce chaincode-id->chan-fn-map (atom {}))

(defrecord ChanFun [ch fn])
(defn make-chan-fun
  [fn]
  (->ChanFun (async/chan) fn))

(defn register-block-event
  [fn-name fn]
  (swap! block-event-handlers assoc fn-name fn))

(defn unregister-block-event
  [fn-name]
  (swap! block-event-handlers dissoc fn-name))

(defn- %unregister-event
  [id ref]
  (when-let [existing (get (deref ref) id)]
    (async/close! (:ch existing))
    (swap! ref dissoc id))
  (async/put! command-ch :refresh))

(defn- %register-event
  [id fn ref]
  (when-let [existing (get (deref ref) id)]
    (async/close! (:ch existing)))
  (swap! ref assoc id (make-chan-fun fn))
  (async/put! command-ch :refresh))

(defn register-tx-event
  [tx-id fn]
  (%register-event tx-id fn tx-id->chan-fn-map))

(defn unregister-tx-event
  [tx-id]
  (%unregister-event tx-id tx-id->chan-fn-map))

(defn register-chaincode-event
  [chaincode-id fn]
  (%register-event chaincode-id fn chaincode-id->chan-fn-map))

(defn unregister-chaincode-event
  [chaincode-id]
  (%unregister-event chaincode-id chaincode-id->chan-fn-map))

(defn get-all-event-chans
  []
  (letfn [(%get-all-chans [ref]
            (map :ch (vals (deref ref))))]
    `[~command-ch
      ~block-event-chans
      ~@(%get-all-chans tx-id->chan-fn-map)
      ~@(%get-all-chans chaincode-id->chan-fn-map)]))

;; Block event is proto/Block
;; Chaincode event is proto/ChaincodeEvent
(defrecord TxEvent [tx-id status])

(defonce event-go-loop
  (async/go-loop []
    (let [[v ch] (async/alts! (get-all-event-chans))]
      (cond (and (= ch command-ch) (= v :refresh))
            :renew-get-all-event-chans

            (instance? Block v)
            (doseq [f @block-event-handlers]
                  (utils/ignore-errors
                   (f v)))

            (instance? TxEvent v)
            (utils/ignore-errors
             ((:fn (get @tx-id->chan-fn-map (:tx-id v))) v))

            (instance? ChaincodeEvent v)
            (utils/ignore-errors
             ((:fn (get @chaincode-id->chan-fn-map (:chaincode-id v))) v)))
      (recur))))

(defn- %id->ch
  [id ref]
  (-> (deref ref) (get id) (:ch)))

(defn tx-id->chan
  [tx-id]
  (%id->ch tx-id tx-id->chan-fn-map))

(defn chaincode-id->chan
  [chaincode-id]
  (%id->ch chaincode-id chaincode-id->chan-fn-map))

(defn deliver-block-events-to-channels
  [^Common$Block proto-block]
  (let [clj-block (proto/proto->clj proto-block (proto/parse-trees :block))]
    ;; 1. Block Event on all channels
    (async/put! block-event-channel clj-block)
    (doseq [[data code] (map list
                             (:data clj-block)
                             (-> (:metadata clj-block)
                                 (:metadata)
                                 (nth (block-metadata-index-map :transactions-filter))
                                 (.toByteArray)))]
      (let [payload (:payload data)
            channel-header (get-in payload [:header :channel-header])]
        ;; 2. Transaction Event with tx-id
        (when-let [ch (tx-id->chan tx-id)]
          (async/put! ch (make-TxEvent (:tx-id channel-header) code)))
        ;; 3. Chaincode event
        (when (= (:type channel-header) (proto/header-types :endorser-transaction))
          (let [chaincode-event (get-in payload [:data :actions 0 :payload :action
                                                 :proposal-response-payload :extension :events])]
            (when-let [ch (chaincode-id->chan (:chaincode-id chaincode-event))]
              (async/put! ch chaincode-event))))))))

(defn transaction-observer
  [ch]
  (reify StreamObserver
    (onNext [this event]
      (case (.getEventCase ^EventsPackage$Event event)
        EventsPackage$Event$EventCase/BLOCK (deliver-block-to-channels (.getBlock event))
        EventsPackage$Event$EventCase/REGISTER nil ;; init
        ;; EventsPackage$Event$EventCase/CHAINCODE_EVENT ;; FIXME: not used??
        EventsPackage$Event$EventCase/UNREGISTER nil;; shutdown
        ))
    (onError [this err]
      ;; FIXME call shutdownNow when Status$Code/INTERNAL or Status$Code/UNAVAILABLE
      (async/put! ch err))
    (onCompleted [this]
      (async/put! ch :done))))

(defn make-event-hub???
  [user peer]
  (let [ch (async/chan (async/sliding-buffer default-sliding-buffer-size))
        ^StreamObserver observer (transaction-observer ch)
        ^ManagedChannel channel (proto/node->channel peer)]
    (.chat (EventsGrpc/newStub channel)
           observer)
    (let [interest (-> (EventsPackage$Interest/newBuilder)
                       (.setEventType EventsPackage$Event$EventCase/BLOCK)
                       (.build))
          register (-> (EventsPackage$Register/newBuilder)
                       (.addEvents interest)
                       (.build))
          block-event (-> (EventsPackage$Event/newBuilder)
                          (.setRegister register)
                          (.setCreator (.toByteString ^Identities$SerializedIdentity
                                                      (proto/clj->proto (proto/user->serialized-identity user))))
                          (.build))]
      (.onNext observer
               (-> (EventsPackage$SignedEvent/newBuilder)
                   (.setEventBytes (.toByteString block-event))
                   (.setSignature (ByteString/copyFrom ^bytes (crypto/sign (.toByteArray block-event) (:private-key user) {:algorithm (:key-algorithm (:crypto-suite user))})))
                   (.build)))
      (try
        (async/go-loop []
          (let [block (async/<!! ch)]
            (case (.getEventCase ^EventsPackage$Event event)
              EventsPackage$Event$EventCase/BLOCK (async/put! ch event) ;; ch is like eventQueue
              EventsPackage$Event$EventCase/REGISTER :FIXME ;; connected, connectedTime
        )
            (cond= (type v)

                   (instance? Exception v) (when-not (.isShutdown channel)
                                             (.shutdownNow channel))
                  ;; FIXME: do something here!!
                  :else (recur))))
        (finally (.onCompleted observer))))))

Implement event go loop

Implement event go loop


(ns cbfg.net-test
  (:require-macros [cbfg.ago :refer [achan aclose ago ago-loop aput atake]])
  (:require [cbfg.net :refer [make-net]]))

(defn e [n result expect result-nil]
  (let [pass (= result expect)
        my-n (swap! n inc)]
    (when (not pass)
      (println (str my-n ":") "FAIL:" result expect))
    (and pass (nil? result-nil))))

(defn test-net [actx]
  (ago tn actx
       (let [n (atom 0)]
         (if (and (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)]
                    (aclose tn listen-ch) ; Closing listen-ch should shutdown net.
                    (e n (atake tn net) :done (atake tn net)))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)]
                    (aclose tn connect-ch) ; Closing connect-ch should shutdown net.
                    (e n (atake tn net) :done (atake tn net)))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        accept-ch (achan tn)]
                    (aput tn listen-ch [:addr-a 1000 accept-ch])
                    (aclose tn listen-ch) ; Closing listen-ch should shutdown net and accept-ch's.
                    (and (e n (atake tn accept-ch) nil nil)
                         (e n (atake tn net) :done (atake tn net))))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        accept-ch (achan tn)]
                    (aput tn listen-ch [:addr-a 1000 accept-ch])
                    (aclose tn connect-ch) ; Closing connect-ch should shutdown net and accept-ch's.
                    (and (e n (atake tn accept-ch) nil nil)
                         (e n (atake tn net) :done (atake tn net))))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        accept-ch (achan tn)
                        accept-ch2 (achan tn)]
                    (aput tn listen-ch [:addr-a 1000 accept-ch])
                    (aput tn listen-ch [:addr-a 1000 accept-ch2]) ; 2nd listen on same addr/port should fail.
                    (and (e n (atake tn accept-ch2) nil nil)
                         (do (aclose tn listen-ch)
                             (aclose tn connect-ch)
                             (and (e n (atake tn accept-ch) nil nil)
                                  (e n (atake tn net) :done (atake tn net))))))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        connect-result-ch (achan tn)]
                    (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                    (and (e n (atake tn connect-result-ch) nil nil)
                         (do (aclose tn listen-ch)
                             (aclose tn connect-ch)
                             (e n (atake tn net) :done (atake tn net))))))
           "pass"
           (str "FAIL: on test-net #" @n)))))

(defn test [actx opaque]
  (ago test actx
       {:opaque opaque
        :result {"test-net"
                 (let [ch (test-net test)
                       cv (atake test ch)
                       _  (atake test ch)]
                   cv)}}))

(ns cbfg.net-test
  (:require-macros [cbfg.ago :refer [achan aclose ago ago-loop aput atake]])
  (:require [cbfg.net :refer [make-net]]))

(defn e [n result expect result-nil]
  (let [pass (= result expect)
        my-n (swap! n inc)]
    (when (not pass)
      (println (str my-n ":") "FAIL:" result expect))
    (and pass (nil? result-nil))))

(defn test-net [actx]
  (ago tn actx
       (let [n (atom 0)]
         (if (and (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)]
                    ; Closing listen-ch should shutdown net.
                    (aclose tn listen-ch)
                    (e n (atake tn net) :done (atake tn net)))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)]
                    ; Closing connect-ch should shutdown net.
                    (aclose tn connect-ch)
                    (e n (atake tn net) :done (atake tn net)))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        accept-ch (achan tn)]
                    ; Closing listen-ch should shutdown net and accept-ch's.
                    (aput tn listen-ch [:addr-a 1000 accept-ch])
                    (aclose tn listen-ch)
                    (and (e n (atake tn accept-ch) nil nil)
                         (e n (atake tn net) :done (atake tn net))))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        accept-ch (achan tn)]
                    ; Closing connect-ch should shutdown net and accept-ch's.
                    (aput tn listen-ch [:addr-a 1000 accept-ch])
                    (aclose tn connect-ch)
                    (and (e n (atake tn accept-ch) nil nil)
                         (e n (atake tn net) :done (atake tn net))))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        accept-ch (achan tn)
                        accept-ch2 (achan tn)]
                    ; 2nd listen on same addr/port should fail.
                    (aput tn listen-ch [:addr-a 1000 accept-ch])
                    (aput tn listen-ch [:addr-a 1000 accept-ch2])
                    (and (e n (atake tn accept-ch2) nil nil)
                         (do (aclose tn listen-ch)
                             (aclose tn connect-ch)
                             (and (e n (atake tn accept-ch) nil nil)
                                  (e n (atake tn net) :done (atake tn net))))))
                  (let [listen-ch (achan tn)
                        connect-ch (achan tn)
                        net (make-net tn listen-ch connect-ch)
                        connect-result-ch (achan tn)]
                    ; Connecting to unlistened to port should fail.
                    (aput tn connect-ch [:addr-a 1000 :addr-x connect-result-ch])
                    (and (e n (atake tn connect-result-ch) nil nil)
                         (do (aclose tn listen-ch)
                             (aclose tn connect-ch)
                             (e n (atake tn net) :done (atake tn net))))))
           "pass"
           (str "FAIL: on test-net #" @n)))))

(defn test [actx opaque]
  (ago test actx
       {:opaque opaque
        :result {"test-net"
                 (let [ch (test-net test)
                       cv (atake test ch)
                       _  (atake test ch)]
                   cv)}}))

Split long lines.

Split long lines.


(ns flense-nw.app
  (:require [cljs.core.async :as async :refer [<!]]
            [cljs.reader :as rdr]
            [flense.actions :refer [actions defaction]]
            [flense.actions.history :as hist]
            flense.actions.clipboard
            flense.actions.clojure
            flense.actions.movement
            flense.actions.paredit
            [flense.editor :refer [editor-view]]
            flense.editor.layout
            [flense.model :as model]
            [flense-nw.cli :refer [cli-view]]
            [flense-nw.error :refer [error-bar-view]]
            [fs.core :as fs]
            [om.core :as om]
            [phalanges.core :as phalanges])
  (:require-macros [cljs.core.async.macros :refer [go-loop]]))

(enable-console-print!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; top-level state setup and management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^:private app-state
  (atom
   {:path [0]
    :tree {:children
           [(model/form->tree '(fn greet [name] (str "Hello, " name "!")))]}}))

(def ^:private edit-chan (async/chan))
(def ^:private error-chan (async/chan))

(defn raise!
  "Display error message `mparts` to the user in the popover error bar."
  [& mparts]
  (async/put! error-chan (apply str mparts)))

(defn open!
  "Load the source file at `fpath` and open the loaded document, discarding any
   changes made to the previously active document."
  [fpath]
  (reset! app-state
    {:path [0]
     :tree {:children
            (->> (fs/slurp fpath) model/string->forms (mapv model/form->tree))}}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; text commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmulti handle-command (fn [command & _] command))

(defmethod handle-command :default [command & _]
  (raise! "Invalid command \"" command \"))

(defmethod handle-command "exec" [_ & args]
  (if-let [name (first args)]
    (if-let [action (-> name rdr/read-string (@actions))]
      (async/put! edit-chan action)
      (raise! "Invalid action \"" name \"))
    (raise! "Must specify an action to execute")))

(defmethod handle-command "open" [_ & args]
  (if-let [fpath (first args)]
    (open! fpath)
    (raise! "Must specify a filepath to open")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; keybinds
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^:dynamic *keymap*)

(defn- bound-action [ev]
  (-> ev phalanges/key-set *keymap* (@actions)))

(defaction :flense/text-command :edit identity) ; dummy action to trap ctrl+x keybind

(defn- handle-key [ev]
  (when-let [action (bound-action ev)]
    (if (= (:name action) :flense/text-command)
      (.. js/document (getElementById "cli") focus)
      (do (.preventDefault ev)
          (async/put! edit-chan action)))))

(defn- fully-selected? [input]
  (and (= (.-selectionStart input) 0)
       (= (.-selectionEnd input) (count (.-value input)))))

(defn- propagate-keypress? [ev form]
  (when-let [action (bound-action ev)]
    (if (model/stringlike? form)
      ;; prevent all keybinds except those that end editing
      (#{:flense/text-command :move/up :paredit/insert-outside} (:name action))
      ;; prevent delete keybind unless text fully selected
      (or (not= (:name action) :flense/remove)
          (fully-selected? (.-target ev))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; application setup and wiring
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- handle-tx [{:keys [new-state tag] :or {tag #{}}}]
  (when-not (tag :history)
    (hist/push-state! new-state)))

(defn init []
  (set! *keymap* (rdr/read-string (fs/slurp "resources/config/keymap.edn")))
  (let [command-chan (async/chan)]
    (hist/push-state! @app-state)
    (om/root editor-view app-state
             {:target (.getElementById js/document "editor-parent")
              :opts {:edit-chan edit-chan
                     :propagate-keypress? propagate-keypress?}
              :tx-listen handle-tx})
    (om/root cli-view nil
             {:target (.getElementById js/document "cli-parent")
              :shared {:command-chan command-chan}})
    (om/root error-bar-view nil
             {:target (.getElementById js/document "error-bar-parent")
              :shared {:error-chan error-chan}})
    (go-loop []
      (let [[command & args] (<! command-chan)]
        (apply handle-command command args))
      (recur))
    (.addEventListener js/window "keydown" handle-key)))

(init)

(ns flense-nw.app
  (:require [cljs.core.async :as async :refer [<!]]
            [cljs.reader :as rdr]
            [flense.actions :refer [actions defaction]]
            [flense.actions.history :as hist]
            flense.actions.clipboard
            flense.actions.clojure
            flense.actions.movement
            flense.actions.paredit
            [flense.editor :refer [editor-view]]
            [flense.model :as model]
            [flense-nw.cli :refer [cli-view]]
            [flense-nw.error :refer [error-bar-view]]
            [fs.core :as fs]
            [om.core :as om]
            [phalanges.core :as phalanges])
  (:require-macros [cljs.core.async.macros :refer [go-loop]]))

(enable-console-print!)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; top-level state setup and management
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^:private app-state
  (atom
   {:path [0]
    :tree {:children
           [(model/form->tree '(fn greet [name] (str "Hello, " name "!")))]}}))

(def ^:private edit-chan (async/chan))
(def ^:private error-chan (async/chan))

(defn raise!
  "Display error message `mparts` to the user in the popover error bar."
  [& mparts]
  (async/put! error-chan (apply str mparts)))

(defn open!
  "Load the source file at `fpath` and open the loaded document, discarding any
   changes made to the previously active document."
  [fpath]
  (reset! app-state
    {:path [0]
     :tree {:children
            (->> (fs/slurp fpath) model/string->forms (mapv model/form->tree))}}))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; text commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmulti handle-command (fn [command & _] command))

(defmethod handle-command :default [command & _]
  (raise! "Invalid command \"" command \"))

(defmethod handle-command "exec" [_ & args]
  (if-let [name (first args)]
    (if-let [action (-> name rdr/read-string (@actions))]
      (async/put! edit-chan action)
      (raise! "Invalid action \"" name \"))
    (raise! "Must specify an action to execute")))

(defmethod handle-command "open" [_ & args]
  (if-let [fpath (first args)]
    (open! fpath)
    (raise! "Must specify a filepath to open")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; keybinds
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(def ^:dynamic *keymap*)

(defn- bound-action [ev]
  (-> ev phalanges/key-set *keymap* (@actions)))

(defaction :flense/text-command :edit identity) ; dummy action to trap ctrl+x keybind

(defn- handle-key [ev]
  (when-let [action (bound-action ev)]
    (if (= (:name action) :flense/text-command)
      (.. js/document (getElementById "cli") focus)
      (do (.preventDefault ev)
          (async/put! edit-chan action)))))

(defn- fully-selected? [input]
  (and (= (.-selectionStart input) 0)
       (= (.-selectionEnd input) (count (.-value input)))))

(defn- propagate-keypress? [ev form]
  (when-let [action (bound-action ev)]
    (if (model/stringlike? form)
      ;; prevent all keybinds except those that end editing
      (#{:flense/text-command :move/up :paredit/insert-outside} (:name action))
      ;; prevent delete keybind unless text fully selected
      (or (not= (:name action) :flense/remove)
          (fully-selected? (.-target ev))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; application setup and wiring
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- handle-tx [{:keys [new-state tag] :or {tag #{}}}]
  (when-not (tag :history)
    (hist/push-state! new-state)))

(defn init []
  (set! *keymap* (rdr/read-string (fs/slurp "resources/config/keymap.edn")))
  (let [command-chan (async/chan)]
    (hist/push-state! @app-state)
    (om/root editor-view app-state
             {:target (.getElementById js/document "editor-parent")
              :opts {:edit-chan edit-chan
                     :propagate-keypress? propagate-keypress?}
              :tx-listen handle-tx})
    (om/root cli-view nil
             {:target (.getElementById js/document "cli-parent")
              :shared {:command-chan command-chan}})
    (om/root error-bar-view nil
             {:target (.getElementById js/document "error-bar-parent")
              :shared {:error-chan error-chan}})
    (go-loop []
      (let [[command & args] (<! command-chan)]
        (apply handle-command command args))
      (recur))
    (.addEventListener js/window "keydown" handle-key)))

(init)

Remove reference to dropped flense.editor.layout namespace


(ns marketing.env
  (:refer-clojure :exclude [get])
  (:require [clojure.tools.logging :as log]
            [clojure.string :as string]))

(def ^:private all-env-vars [{:name ::PORT :default 5000 :int? true}
                             {:name ::HOST :default "localhost"}
                             {:name ::REPO_URL}
                             {:name ::WEB_FLUSH_COMMAND :default "flush"}
                             {:name ::FLUSH_INTERVAL_MINS :default 10 :int? true}])

(def ^:private env-var-prefix "MARKETING_")

(defn env-var-name [env-var-kw]
  (str env-var-prefix (name env-var-kw)))

(defn get
  ([kw] (get kw nil))
  ([kw default]
   (let [add-prefix? (some #{kw} (map :name all-env-vars))]
     (or (System/getenv (if add-prefix? (env-var-name kw) kw)) default))))

(defn get-int [kw default]
  (let [v (get kw default)]
    (if (integer? v)
      v
      (Integer/parseInt v))))

(defn- defenv [vars]
  (doseq [env-var vars :let [env-var-kw (:name env-var)
                             env-var-default (:default env-var)
                             env-var-int? (:int? env-var)
                             def-name (symbol (name env-var-kw))
                             defn-name (-> env-var-kw
                                           (name)
                                           (string/lower-case)
                                           (string/replace \_ \-)
                                           (symbol))]]
    (intern *ns* defn-name (fn []
                             ((if env-var-int? get-int get) env-var-kw env-var-default)))
    (intern *ns* (with-meta def-name {:defn defn-name}) env-var-kw)))

(def defenv-all (delay (defenv all-env-vars)))

(force defenv-all)

; all this complexity due to be able to print all env vars, without code duplications
; it works, next time when there is a need to modify this code, might revisit and come with a better implementation
(defn log-all []
  (doseq [env-var all-env-vars :let [env-var-kw (:name env-var)
                                     ns-sym (symbol (namespace env-var-kw))
                                     env-var-resolved (ns-resolve ns-sym (symbol (name env-var-kw)))
                                     env-var-defn (-> env-var-resolved meta :defn)]]
    (log/info (env-var-name env-var-kw) "=" (or ((ns-resolve ns-sym env-var-defn)) ""))))

(ns marketing.env
  (:refer-clojure :exclude [get])
  (:require [clojure.tools.logging :as log]
            [clojure.string :as string]))

(def ^:private all-env-vars [{:name ::PORT :default 3000 :int? true}
                             {:name ::HOST :default "localhost"}
                             {:name ::REPO_URL}
                             {:name ::WEB_FLUSH_COMMAND :default "flush"}
                             {:name ::FLUSH_INTERVAL_MINS :default 10 :int? true}])

(def ^:private env-var-prefix "MARKETING_")

(defn env-var-name [env-var-kw]
  (str env-var-prefix (name env-var-kw)))

(defn get
  ([kw] (get kw nil))
  ([kw default]
   (let [add-prefix? (some #{kw} (map :name all-env-vars))]
     (or (System/getenv (if add-prefix? (env-var-name kw) kw)) default))))

(defn get-int [kw default]
  (let [v (get kw default)]
    (if (integer? v)
      v
      (Integer/parseInt v))))

(defn- defenv [vars]
  (doseq [env-var vars :let [env-var-kw (:name env-var)
                             env-var-default (:default env-var)
                             env-var-int? (:int? env-var)
                             def-name (symbol (name env-var-kw))
                             defn-name (-> env-var-kw
                                           (name)
                                           (string/lower-case)
                                           (string/replace \_ \-)
                                           (symbol))]]
    (intern *ns* defn-name (fn []
                             ((if env-var-int? get-int get) env-var-kw env-var-default)))
    (intern *ns* (with-meta def-name {:defn defn-name}) env-var-kw)))

(def defenv-all (delay (defenv all-env-vars)))

(force defenv-all)

; all this complexity due to be able to print all env vars, without code duplications
; it works, next time when there is a need to modify this code, might revisit and come with a better implementation
(defn log-all []
  (doseq [env-var all-env-vars :let [env-var-kw (:name env-var)
                                     ns-sym (symbol (namespace env-var-kw))
                                     env-var-resolved (ns-resolve ns-sym (symbol (name env-var-kw)))
                                     env-var-defn (-> env-var-resolved meta :defn)]]
    (log/info (env-var-name env-var-kw) "=" (or ((ns-resolve ns-sym env-var-defn)) ""))))

Switch to port 3000

Switch to port 3000


(ns postal.message
  (:use [clojure.set :only [difference]]
        [postal.date :only [make-date]]
        [postal.support :only [do-when make-props]])
  (:import [java.util UUID]
           [javax.mail Session Message$RecipientType]
           [javax.mail.internet MimeMessage InternetAddress
            AddressException]
           [javax.mail PasswordAuthentication]))

(declare make-jmessage)

(defn recipients [msg]
  (let [jmsg (make-jmessage msg)]
    (map str (.getAllRecipients jmsg))))

(defn sender [msg]
  (or (:sender msg) (:from msg)))

(defn make-address
  ([addr]
     (try (InternetAddress. addr)
          (catch Exception _)))
  ([addr name-str]
     (try (InternetAddress. addr name-str)
          (catch Exception _))))

(defn make-addresses [addresses]
  (if (string? addresses)
    (recur [addresses])
    (into-array InternetAddress (map make-address addresses))))

(defn message->str [msg]
  (with-open [out (java.io.ByteArrayOutputStream.)]
    (let [jmsg (if (instance? MimeMessage msg) msg (make-jmessage msg))]
      (.writeTo jmsg out)
      (str out))))

(defn add-recipient! [jmsg rtype addr]
  (if-let [addr (make-address addr)]
    (doto jmsg
      (.addRecipient rtype addr))
    jmsg))

(defn add-recipients! [jmsg rtype addrs]
  (when addrs
    (if (string? addrs)
      (add-recipient! jmsg rtype addrs)
      (doseq [addr addrs]
        (add-recipient! jmsg rtype addr))))
  jmsg)

(defn- fileize [x]
  (if (instance? java.io.File x) x (java.io.File. x)))

(declare eval-bodypart eval-multipart)

(defprotocol PartEval (eval-part [part]))

(extend-protocol PartEval
  clojure.lang.IPersistentMap
  (eval-part [part] (eval-bodypart part))
  clojure.lang.IPersistentCollection
  (eval-part [part]
    (doto (javax.mail.internet.MimeBodyPart.)
      (.setContent (eval-multipart part)))))

(defn eval-bodypart [part]
  (condp (fn [test type] (some #(= % type) test)) (:type part)
    [:inline :attachment]
    (doto (javax.mail.internet.MimeBodyPart.)
      (.attachFile (fileize (:content part)))
      (.setDisposition (name (:type part))))
    (doto (javax.mail.internet.MimeBodyPart.)
      (.setContent (:content part) (:type part)))))

(defn eval-multipart [parts]
  (let [;; multiparts can have a number of different types: mixed,
        ;; alternative, encrypted...
        ;; The caller can use the first two entries to specify a type.
        ;; If no type is given, we default to "mixed" (for attachments etc.)
        [multiPartType, parts] (if (keyword? (first parts))
                                 [(name (first parts)) (rest parts)]
                                 ["mixed" parts])
        mp (javax.mail.internet.MimeMultipart. multiPartType)]
    (doseq [part parts]
      (.addBodyPart mp (eval-part part)))
    mp))

(defn add-multipart! [jmsg parts]
    (.setContent jmsg (eval-multipart parts)))

(defn add-extra! [jmsg msgrest]
  (doseq [[n v] msgrest]
    (.addHeader jmsg (if (keyword? n) (name n) n) v))
  jmsg)

(defn add-body! [jmsg body]
  (if (string? body)
    (doto jmsg (.setText body))
    (doto jmsg (add-multipart! body))))

(defn drop-keys [m ks]
  (select-keys m
               (difference (set (keys m)) (set ks))))

(defn make-auth [user pass]
  (proxy [javax.mail.Authenticator] []
    (getPasswordAuthentication [] (PasswordAuthentication. user pass))))

(defn make-jmessage
  ([msg]
     (let [{:keys [sender from]} msg
           {:keys [user pass]} (meta msg)
           props (make-props (or sender from) (meta msg))
           session (or (:session (meta msg))
                       (if user
                         (Session/getInstance props (make-auth user pass))
                         (Session/getInstance props)))]
       (make-jmessage msg session)))
  ([msg session]
     (let [standard [:from :reply-to :to :cc :bcc :date :subject :body]
           jmsg (MimeMessage. session)]
       (doto jmsg
         (add-recipients! Message$RecipientType/TO (:to msg))
         (add-recipients! Message$RecipientType/CC (:cc msg))
         (add-recipients! Message$RecipientType/BCC (:bcc msg))
         (.setFrom (if-let [sender (:sender msg)]
                     (make-address (:from msg) sender)
                     (make-address (:from msg))))
         (.setReplyTo (when-let [reply-to (:reply-to msg)]
                        (make-addresses reply-to)))
         (.setSubject (:subject msg))
         (.setSentDate (or (:date msg) (make-date)))
         (add-extra! (drop-keys msg standard))
         (add-body! (:body msg))))))

(defn make-fixture [from to & {:keys [tag]}]
  (let [uuid (str (UUID/randomUUID))
        tag (or tag "[POSTAL]")]
    {:from from
     :to to
     :subject (format "%s Test -- %s" tag uuid)
     :body (format "Test %s" uuid)}))

(ns postal.message
  (:use [clojure.set :only [difference]]
        [postal.date :only [make-date]]
        [postal.support :only [do-when make-props]])
  (:import [java.util UUID]
           [javax.mail Session Message$RecipientType]
           [javax.mail.internet MimeMessage InternetAddress
            AddressException]
           [javax.mail PasswordAuthentication]))

(declare make-jmessage)

(defn recipients [msg]
  (let [jmsg (make-jmessage msg)]
    (map str (.getAllRecipients jmsg))))

(defn sender [msg]
  (or (:sender msg) (:from msg)))

(defn make-address
  ([addr]
     (try (InternetAddress. addr)
          (catch Exception _)))
  ([addr name-str]
     (try (InternetAddress. addr name-str)
          (catch Exception _))))

(defn make-addresses [addresses]
  (if (string? addresses)
    (recur [addresses])
    (into-array InternetAddress (map make-address addresses))))

(defn message->str [msg]
  (with-open [out (java.io.ByteArrayOutputStream.)]
    (let [jmsg (if (instance? MimeMessage msg) msg (make-jmessage msg))]
      (.writeTo jmsg out)
      (str out))))

(defn add-recipient! [jmsg rtype addr]
  (if-let [addr (make-address addr)]
    (doto jmsg
      (.addRecipient rtype addr))
    jmsg))

(defn add-recipients! [jmsg rtype addrs]
  (when addrs
    (if (string? addrs)
      (add-recipient! jmsg rtype addrs)
      (doseq [addr addrs]
        (add-recipient! jmsg rtype addr))))
  jmsg)

(defn- fileize [x]
  (if (instance? java.io.File x) x (java.io.File. x)))

(declare eval-bodypart eval-multipart)

(defprotocol PartEval (eval-part [part]))

(extend-protocol PartEval
  clojure.lang.IPersistentMap
  (eval-part [part] (eval-bodypart part))
  clojure.lang.IPersistentCollection
  (eval-part [part]
    (doto (javax.mail.internet.MimeBodyPart.)
      (.setContent (eval-multipart part)))))

(defn eval-bodypart [part]
  (condp (fn [test type] (some #(= % type) test)) (:type part)
    [:inline :attachment]
    (let [attachment-part (doto (javax.mail.internet.MimeBodyPart.)
                            (.attachFile (fileize (:content part)))
                            (.setDisposition (name (:type part))))]

      (when (:content-type part)
        (.setHeader attachment-part "Content-Type" (:content-type part)))
      attachment-part)
    (doto (javax.mail.internet.MimeBodyPart.)
      (.setContent (:content part) (:type part)))))

(defn eval-multipart [parts]
  (let [;; multiparts can have a number of different types: mixed,
        ;; alternative, encrypted...
        ;; The caller can use the first two entries to specify a type.
        ;; If no type is given, we default to "mixed" (for attachments etc.)
        [multiPartType, parts] (if (keyword? (first parts))
                                 [(name (first parts)) (rest parts)]
                                 ["mixed" parts])
        mp (javax.mail.internet.MimeMultipart. multiPartType)]
    (doseq [part parts]
      (.addBodyPart mp (eval-part part)))
    mp))

(defn add-multipart! [jmsg parts]
    (.setContent jmsg (eval-multipart parts)))

(defn add-extra! [jmsg msgrest]
  (doseq [[n v] msgrest]
    (.addHeader jmsg (if (keyword? n) (name n) n) v))
  jmsg)

(defn add-body! [jmsg body]
  (if (string? body)
    (doto jmsg (.setText body))
    (doto jmsg (add-multipart! body))))

(defn drop-keys [m ks]
  (select-keys m
               (difference (set (keys m)) (set ks))))

(defn make-auth [user pass]
  (proxy [javax.mail.Authenticator] []
    (getPasswordAuthentication [] (PasswordAuthentication. user pass))))

(defn make-jmessage
  ([msg]
     (let [{:keys [sender from]} msg
           {:keys [user pass]} (meta msg)
           props (make-props (or sender from) (meta msg))
           session (or (:session (meta msg))
                       (if user
                         (Session/getInstance props (make-auth user pass))
                         (Session/getInstance props)))]
       (make-jmessage msg session)))
  ([msg session]
     (let [standard [:from :reply-to :to :cc :bcc :date :subject :body]
           jmsg (MimeMessage. session)]
       (doto jmsg
         (add-recipients! Message$RecipientType/TO (:to msg))
         (add-recipients! Message$RecipientType/CC (:cc msg))
         (add-recipients! Message$RecipientType/BCC (:bcc msg))
         (.setFrom (if-let [sender (:sender msg)]
                     (make-address (:from msg) sender)
                     (make-address (:from msg))))
         (.setReplyTo (when-let [reply-to (:reply-to msg)]
                        (make-addresses reply-to)))
         (.setSubject (:subject msg))
         (.setSentDate (or (:date msg) (make-date)))
         (add-extra! (drop-keys msg standard))
         (add-body! (:body msg))))))

(defn make-fixture [from to & {:keys [tag]}]
  (let [uuid (str (UUID/randomUUID))
        tag (or tag "[POSTAL]")]
    {:from from
     :to to
     :subject (format "%s Test -- %s" tag uuid)
     :body (format "Test %s" uuid)}))

Allow to set Content-Type explicitly

Allow to set Content-Type explicitly


(ns discuss.utils.bootstrap
  "Reusable components, which use twitter bootstrap to reduce redundancy."
  (:require [om.dom :as dom]
            [discuss.utils.common :as lib]))

(defn button-primary
  "Create dom element of a bootstrap primary button."
  [fn & strs]
  (dom/button #js {:className "btn btn-primary"
                   :onClick   fn
                   :key       (lib/get-unique-key)}
              strs))

(ns discuss.utils.bootstrap
  "Reusable components, which use twitter bootstrap to reduce redundancy."
  (:require [om.dom :as dom]
            [discuss.utils.common :as lib]))

(defn button
  "Create dom element of a bootstrap button."
  [fn class & strs]
  (dom/button #js {:className (str "btn " class)
                   :onClick   fn
                   :key       (lib/get-unique-key)}
              strs))

(defn button-primary
  "Create dom element of a bootstrap primary button."
  [fn & strs] (button fn "btn-primary" strs))

(defn button-default
  "Create dom element of a bootstrap default button."
  [fn & strs] (button fn "btn-default" strs))

(defn button-default-sm
  "Create dom element of a bootstrap default small button."
  [fn & strs] (button fn "btn-default btn-sm" strs))

Add default buttons

Add default buttons


(ns scavenger.core
  (:require [compojure.core :refer :all]
            [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
            [ring.util.response :refer [header content-type response resource-response]])
  (:use [datomic.api :only [db q] :as d]))

(def uri "datomic:free://localhost:4334/items")

(def conn (d/connect uri))

(defn get-all-items []
  (map first (q '[:find (pull ?c [*]) :where [?c item/name]] (db conn))))

(defroutes app-routes
  (GET "/items" []
    (response (str (into [] (get-all-items)))))
  (POST "/items" {body :body}
    (let [tempid (d/tempid :items)
          data (merge (read-string (slurp body)) {:db/id tempid})
          tx @(d/transact conn [data])
          id (d/resolve-tempid (db conn) (:tempids tx) tempid)]
      (response (str (d/touch (d/entity (db conn) id))))))
  (GET "/" []
    (-> (resource-response "index.html" {:root "public"})
        (content-type "text/html")))
  (route/not-found "Page not found"))

(def app
  (wrap-defaults app-routes (assoc site-defaults :security nil)))

(ns scavenger.core
  (:require [compojure.core :refer :all]
            [compojure.route :as route]
            [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
            [ring.util.response :refer [header content-type response resource-response]])
  (:use [datomic.api :only [db q] :as d]))

(def uri "datomic:free://localhost:4334/items")

(def conn (d/connect uri))

(defn get-all-items []
  (map first (q '[:find (pull ?c [*]) :where [?c item/name]] (db conn))))

(defn generate-response [data & [status]]
  {:status (or status 200)
   :headers {"Content-Type" "application/edn"}
   :body (pr-str data)})

(defroutes app-routes
  (GET "/items" []
    (generate-response (into [] (get-all-items))))
  (POST "/items" {body :body}
    (let [tempid (d/tempid :items)
          data (merge (read-string (slurp body)) {:db/id tempid})
          tx @(d/transact conn [data])
          id (d/resolve-tempid (db conn) (:tempids tx) tempid)]
      (generate-response (d/touch (d/entity (db conn) id)))))
  (GET "/" []
    (-> (resource-response "index.html" {:root "public"})
        (content-type "text/html")))
  (route/not-found "Page not found"))

(def app
  (wrap-defaults app-routes (assoc site-defaults :security nil)))

Add helper for generating a server response

Add a helper for generating a server response with the correct
Content-Type and a reasonable status code.


(ns terraboot.core
  (:require [clojure.string :as string]
            [cheshire.core :as json]
            [stencil.core :as mustache]
            [clj-yaml.core :as yaml]
            [clojure.pprint :refer [pprint]]))

(letfn [(merge-in* [a b]
          (if (map? a)
            (merge-with merge-in* a b)
            b))]
  (defn merge-in
    "Merge multiple nested maps."
    [& args]
    (reduce merge-in* nil args)))

(defn output-of [type resource-name & values]
  (str "${"
       (name type) "."
       (name resource-name) "."
       (string/join "." (map name values))
       "}"))

(defn id-of [type name]
  (output-of type name "id"))

(defn resource [type name spec]
  {:resource
   {type
    {name
     spec}}})

(defn provider [type spec]
  {:provider
   {type
    spec}})

(defn resources [m]
  {:resource m})

(defn resource-seq [s]
  (apply merge-in (map (partial apply resource)
                       s)))

(defn add-to-every-value-map
  [map key value]
  (reduce-kv (fn [m k v]
               (assoc m k (assoc v key value))) {} map))

(defn in-vpc
  [vpc-name & resources]
  (let [vpc-id (id-of "aws_vpc" vpc-name)
        add-to-resources-if-present (fn [type resources]
                                      (if (get-in resources [:resource type])
                                        (update-in resources [:resource type] (fn [spec] (add-to-every-value-map spec :vpc_id vpc-id)))
                                        resources))]
    (apply merge-in
           (map (comp (partial add-to-resources-if-present "aws_security_group")
                      (partial add-to-resources-if-present "aws_internet_gateway")
                      (partial add-to-resources-if-present "aws_subnet")
                      (partial add-to-resources-if-present "aws_route_table")) resources))))

(def json-options {:key-fn name :pretty true})

(defn to-json [tfmap]
  (json/generate-string tfmap json-options))

(defn to-file [tfmap file-name]
  (println "Outputing to" file-name)
  (json/generate-stream tfmap (clojure.java.io/writer file-name) json-options))

(defn stringify [& args]
  (apply str (map name args)))

(defn security-group [name spec & rules]
  (merge-in
   (resource "aws_security_group" name
             (merge {:name name
                     :tags {:Name name}}
                    spec))
   (resource-seq
    (for [rule rules]
      (let [defaults {:protocol "tcp"
                      :type "ingress"
                      :security_group_id (id-of "aws_security_group" name)}
            port (:port rule)
            port-to-port-range (fn [rule] (if port (-> (assoc rule :from_port port :to_port port) (dissoc :port)) rule))
            rule (merge defaults (port-to-port-range rule))
            suffix (str (hash rule))]
        ["aws_security_group_rule"
         (stringify name "-" suffix)
         rule])))))

(defn aws-instance [name spec]
  (let [default-sgs ["allow_outbound"]
        default-sg-ids (map (partial id-of "aws_security_group") default-sgs)]
    (resource "aws_instance" name (-> {:tags {:Name name}
                                       :instance_type "t2.micro"
                                       :key_name "ops-terraboot"
                                       :monitoring true
                                       :subnet_id (id-of "aws_subnet" "private-a")}
                                      (merge-in spec)
                                      (update-in [:vpc_security_group_ids] concat default-sg-ids)))))

(defn elb [name spec]
  (resource "aws_elb" name (-> {:listeners [{:instance_port 80
                                             :lb_port 80
                                             :instance_protocol "http"
                                             :lb_protocol "http"}
                                            {:instance_port 443
                                             :instance_protocol "http"
                                             :lb_port 443
                                             :lb_protocol "http"}
                                            (merge-in spec)]})))
(def all-external "0.0.0.0/0")

(def region "eu-central-1")

(def azs [:a :b])

(defn from-template [template-name vars]
  (mustache/render-file template-name vars))

(defn snippet [path]
  (slurp (clojure.java.io/resource path)))

(ns terraboot.core
  (:require [clojure.string :as string]
            [cheshire.core :as json]
            [stencil.core :as mustache]
            [clj-yaml.core :as yaml]
            [clojure.pprint :refer [pprint]]))

(def account-id "12345")
(letfn [(merge-in* [a b]
          (if (map? a)
            (merge-with merge-in* a b)
            b))]
  (defn merge-in
    "Merge multiple nested maps."
    [& args]
    (reduce merge-in* nil args)))

(defn output-of [type resource-name & values]
  (str "${"
       (name type) "."
       (name resource-name) "."
       (string/join "." (map name values))
       "}"))

(defn id-of [type name]
  (output-of type name "id"))

(defn resource [type name spec]
  {:resource
   {type
    {name
     spec}}})

(defn provider [type spec]
  {:provider
   {type
    spec}})

(defn resources [m]
  {:resource m})

(defn resource-seq [s]
  (apply merge-in (map (partial apply resource)
                       s)))

(defn add-to-every-value-map
  [map key value]
  (reduce-kv (fn [m k v]
               (assoc m k (assoc v key value))) {} map))

(defn in-vpc
  [vpc-name & resources]
  (let [vpc-id (id-of "aws_vpc" vpc-name)
        add-to-resources-if-present (fn [type resources]
                                      (if (get-in resources [:resource type])
                                        (update-in resources [:resource type] (fn [spec] (add-to-every-value-map spec :vpc_id vpc-id)))
                                        resources))]
    (apply merge-in
           (map (comp (partial add-to-resources-if-present "aws_security_group")
                      (partial add-to-resources-if-present "aws_internet_gateway")
                      (partial add-to-resources-if-present "aws_subnet")
                      (partial add-to-resources-if-present "aws_route_table")) resources))))

(def json-options {:key-fn name :pretty true})

(defn to-json [tfmap]
  (json/generate-string tfmap json-options))

(defn to-file [tfmap file-name]
  (println "Outputing to" file-name)
  (json/generate-stream tfmap (clojure.java.io/writer file-name) json-options))

(defn stringify [& args]
  (apply str (map name args)))

(defn security-group [name spec & rules]
  (merge-in
   (resource "aws_security_group" name
             (merge {:name name
                     :tags {:Name name}}
                    spec))
   (resource-seq
    (for [rule rules]
      (let [defaults {:protocol "tcp"
                      :type "ingress"
                      :security_group_id (id-of "aws_security_group" name)}
            port (:port rule)
            port-to-port-range (fn [rule] (if port (-> (assoc rule :from_port port :to_port port) (dissoc :port)) rule))
            rule (merge defaults (port-to-port-range rule))
            suffix (str (hash rule))]
        ["aws_security_group_rule"
         (stringify name "-" suffix)
         rule])))))

(defn aws-instance [name spec]
  (let [default-sgs ["allow_outbound"]
        default-sg-ids (map (partial id-of "aws_security_group") default-sgs)]
    (resource "aws_instance" name (-> {:tags {:Name name}
                                       :instance_type "t2.micro"
                                       :key_name "ops-terraboot"
                                       :monitoring true
                                       :subnet_id (id-of "aws_subnet" "private-a")}
                                      (merge-in spec)
                                      (update-in [:vpc_security_group_ids] concat default-sg-ids)))))

(defn elb [name spec]
  (let [defaults {:cert_name false
                  :instances []
                  :health_check_url "/"
                  :lb_protocol "http"}
        spec (merge-in defaults spec)
        {:keys [health_check_url
                lb_protocol
                instances
                cert_name]} spec
        secure_protocol (if (= lb_protocol "http")
                          "https"
                          "ssl")
        default-listener {:instance_port 80
                          :instance_protocol lb_protocol
                          :lb_port 80
                          :lb_protocol lb_protocol}

        listeners (if cert_name
                    [default-listener {
                                       :instance_port 80
                                       :instance_protocol lb_protocol
                                       :lb_port 443
                                       :lb_protocol secure_protocol
                                       :ssl_certificate_id (str "arn:aws:iam::" account-id ":server-certificate/" cert_name)}]
                    [default-listener])
        ]
    (let [elb-sg (str "elb_" name)
          allow-sg (str "allow_elb_" name)]
      (merge-in (security-group allow-sg {}
                                {:port 80
                                 :source_security_group_id (id-of "aws_security_group" elb-sg)
                                 })
                (security-group elb-sg {})
                (resource "aws_elb" name {:subnets []
                                          :security_groups [(id-of "aws_security_group" elb-sg)
                                                            (id-of "aws_security_group" "allow_external_http_https")
                                                            (id-of "aws_security_group" "allow_outbound")]
                                          :listener listeners
                                          :instances instances
                                          :health_check {:healthy_threshold 2
                                                         :unhealthy_threshold 2
                                                         :timeout 3
                                                         :target (str "HTTP:80" health_check_url)
                                                         :interval 5}
                                          :cross_zone_load_balancing true
                                          :idle_timeout 60
                                          :connection_draining true
                                          :connection_draining_timeout 60
                                          :tags {:Name name}})))))

(defn asg [name {:keys [] :as spec}]
  (let [sgs (spec :sgs)
        elb? (spec :elb)
        sgs (if elb?
              (conj sgs (str "allow_elb_" name))
              sgs)

        asg-config
        (merge-in
         (resource "aws_launch_configuration" name
                   {:name_prefix (str name "-")
                    :image_id (spec :image_id)
                    :instance_type (spec :instance_type)
                    :user_data (spec :user_data)
                    :lifecycle { :create_before_destroy true }
                    :key_name (get spec :key_name "ops-terraboot")
                    :security_groups (map #(id-of "aws_security_group" %) sgs)})

         (resource "aws_autoscaling_group" name
                   {:vpc_zone_identifier []
                    :name name
                    :max_size (spec :max_size)
                    :min_size (spec :min_size)
                    :health_check_type (spec :health_check_type)
                    :health_check_grace_period (spec :health_check_grace_period)
                    :launch_configuration (output-of "aws_launch_configuration" name "name")
                    :lifecycle { :create_before_destroy true }
                    :load_balancers (if elb? [(output-of "aws_elb" name "name")]
                                        [])
                    :tag {
                          :key "Name"
                          :value "autoscale-#{name}"
                          :propagate_at_launch true
                          }}))]
    (if (spec :elb)
      (merge-in asg-config (elb name (spec :elb)))
      asg-config)))

(def all-external "0.0.0.0/0")

(def region "eu-central-1")

(def azs [:a :b])

(defn from-template [template-name vars]
  (mustache/render-file template-name vars))

(defn snippet [path]
  (slurp (clojure.java.io/resource path)))

Add elb/asg helpers

Add elb/asg helpers