(ns frereth-cp.message.flow-control
  "Cope with flow-control algorithms"
  (:require [clojure.spec.alpha :as s]
            [clojure.tools.logging :as log]
            [frereth-cp.message.constants :as K]
            [frereth-cp.message.specs :as specs]
            [frereth-cp.shared.crypto :as crypto]
            [frereth-cp.shared.logging :as log2]
            [frereth-cp.util :as utils]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal Helpers

(s/fdef recalc-rtt-average
        :args (s/cat :state ::specs/state
                     :rtt ::specs/rtt)
        :ret ::specs/state)
(defn calculate-base-rtt-averages
  "Lines 460-466"
  [{{:keys [::specs/rtt-average]} ::specs/flow-control
    :keys [::specs/recent]
    :as state}
   ackd-time]
  (let [rtt (- recent ackd-time)]
    (when (< 0 rtt)
      ;; I'm getting into scenarios with negative RTT, which
      ;; seems to have something to do with math overflow
      ;; warnings. That seems to be breaking things.
      ;; We should have set the block time when we first
      ;; spotted it. By contrast, recent should have
      ;; been set later, when the block was handed over
      ;; to the ioloop.
      ;; Note that assertions here just get swallowed
      ;; silently, and the thread gets returned to the pool.
      ;; This is terrible behavior. I've been meaning
      ;; to read a blog post that's probably about this exact
      ;; problem, but it involves a JVM-wide setting, and it
      ;; doesn't sound like something a library should mess
      ;; with. Although it might make sense in terms of unit
      ;; testing.
      (throw (ex-info "ACK arrived before recent"
                      {::specs/recent recent
                       ::ackd-time ackd-time
                       ::delta rtt})))
    (if (= 0 rtt-average)
      (update state
              ::specs/flow-control
              (fn [s]
                (assoc s
                       ::specs/n-sec-per-block rtt
                       ::specs/rtt rtt
                       ::specs/rtt-average rtt
                       ::specs/rtt-deviation (quot rtt 2)
                       ::specs/rtt-highwater rtt
                       ::specs/rtt-lowwater rtt)))
      state)))
(comment
  (let [times {::specs/recent 1515989075638
               ::ackd-time 2024584666631859}]
    (- (::specs/recent times) (::ackd-time times)))
  1515989075638)

(s/fdef jacobson-adjust-block-time
        :args (s/cat :n-sec-per-block ::specs/n-sec-per-block)
        :ret ::specs/n-sec-per-block)
(defn jacobson-adjust-block-time
  "Lines 496-509"
  [n-sec-per-block]
  (let [result
        (if (> n-sec-per-block K/k-128)
          ;; DJB had this to say.
          ;; As 4 separate comments.
          ;; additive increase: adjust 1/N by a constant c
          ;; rtt-fair additive increase: adjust 1/N by a constant c every nanosecond
          ;; approximation: adjust 1/N by cN every N nanoseconds
          ;; i.e., N <- 1/(1/N + cN) = N/(1 + cN^2) every N nanoseconds
          (if (< n-sec-per-block K/m-16)
            (let [u (quot n-sec-per-block K/k-128)]
              (- n-sec-per-block (* u u u)))
            (let [d (double n-sec-per-block)]
              ;; TODO: figure out the meaning behind this magic
              ;; formulation
              (long (/ d (inc (/ (* d d) 2251799813685248.0))))))
          n-sec-per-block)]
    (when-not (pos? result)
      ;; There's an important detail here for my current debugging
      ;; woes:
      ;; If I throw this exception erroneously (I had the logic
      ;; backwards, throwing when result was positive), then my
      ;; handshake test passes.
      (throw (ex-info "n-sec-per-block went negative"
                      {::specs/n-sec-per-block n-sec-per-block
                       ::adjusted-to result
                       ::u (quot n-sec-per-block K/k-128)})))
    result))

(s/fdef adjust-rtt-phase
        :args (s/cat :state ::specs/state)
        :ret ::specs/state)
(defn adjust-rtt-phase
  "Lines 511-521"
  [{:keys [::specs/recent]
    {:keys [::specs/n-sec-per-block
            ::specs/rtt-phase
            ::specs/rtt-seen-older-high
            ::specs/rtt-seen-older-low]} ::specs/flow-control
    :as state}]
  (if rtt-phase
    (if rtt-seen-older-high
      (update state (fn [s]
                      (assoc s
                             ::specs/rtt-phase true
                             ::specs/last-edge recent
                             ::specs/n-sec-per-block (+ n-sec-per-block
                                                        (crypto/random-mod (quot n-sec-per-block 4))))))
      state)
    (if rtt-seen-older-low
      (assoc-in state [::specs/flow-control ::specs/rtt-phase] false)
      state)))
(comment
  (crypto/random-mod (quot 1000000000 4))
  (crypto/random-mod 4))

(defn possibly-adjust-speed
  [{:keys [::specs/recent]
    {:keys [::specs/last-edge
            ::specs/last-speed-adjustment
            ::specs/n-sec-per-block
            ::specs/rtt-seen-recent-high
            ::specs/rtt-seen-recent-low]} ::specs/flow-control
    :as state}]
  ;; Lines 488-527
  (if (>= recent (+ last-speed-adjustment (* 16 n-sec-per-block)))
    (let [n-sec-per-block (if (> (- recent last-speed-adjustment) K/secs-10)
                            (+ K/secs-1 (crypto/random-mod (quot K/sec->n-sec 8)))
                            n-sec-per-block)
          n-sec-per-block (jacobson-adjust-block-time n-sec-per-block)
          ;; adjust-rtt-phase depends on this
          state (assoc-in state [::specs/flow-control ::specs/n-sec-per-block] n-sec-per-block)
          ;; adjust-rtt-phase does not modify rtt-seen-recent-high/low.
          ;; Q: Should it?
          {{:keys [::specs/rtt-seen-recent-high ::specs/rtt-seen-recent-low]} ::specs/flow-control
           :as state} (adjust-rtt-phase state)]
      (update state
              ::specs/flow-control
              (fn [cur]
                (assoc cur
                       ::specs/last-speed-adjustment recent
                       ::specs/seen-older-high rtt-seen-recent-high
                       ::specs/seen-older-low rtt-seen-recent-low
                       ;; We're throwing away the values we just calculated.
                       ;; Well, except that they got moved into seen-older-*
                       ;; Saving these booleans seems pointless.
                       ::specs/seen-recent-high false
                       ::specs/seen-recent-low false))))
    state))

(s/fdef jacobson's-retransmission-timeout
        :args (s/cat :state ::specs/state
                     :block ::specs/block)
        :ret ::specs/state)
(defn jacobson's-retransmission-timeout
  "Jacobson's retransmission timeout calculation: --DJB

  I'm lumping lines 467-527 into here, even though I haven't
  seen the actual paper describing the algorithm. This is the
  basic algorithm that TCP uses pretty much everywhere. -- JRG"
  [{:keys [::specs/recent]
    {:keys [::specs/last-doubling
            ::specs/last-edge
            ::specs/last-speed-adjustment
            ::specs/n-sec-per-block
            ::specs/rtt
            ::specs/rtt-average
            ::specs/rtt-deviation
            ::specs/rtt-highwater
            ::specs/rtt-lowwater
            ::specs/rtt-seen-recent-high
            ::specs/rtt-seen-recent-low
            ::specs/rtt-timeout]} ::specs/flow-control
    :as state}
   {block-send-time ::specs/time
    :as block}]
  (let [rtt-delta (- rtt rtt-average)
        ;; I'm seeing this drop below 0.
        ;; The math that leads to that *is* plausible.
        ;; But...does it ever make any sense?
        rtt-average (+ rtt-average (/ rtt-delta 8.0))
        rtt-delta (if (> 0 rtt-delta)
                    (- rtt-delta)
                    rtt-delta)
        rtt-delta (- rtt-delta rtt-deviation)
        rtt-deviation (+ rtt-deviation (/ rtt-delta 4.0))
        rtt-timeout (+ rtt-average (* 4 rtt-deviation))
        ;; adjust for delayed acks with anti-spiking: --DJB
        rtt-timeout (+ rtt-timeout (* 8 n-sec-per-block))

        ;; recognizing top and bottom of congestion cycle:  --DJB
        rtt-delta (- rtt rtt-highwater)
        rtt-highwater (+ rtt-highwater (/ rtt-delta K/k-1f))
        rtt-delta (- rtt rtt-lowwater)
        rtt-lowwater (+ rtt-lowwater
                        (if (> rtt-delta 0)
                          (/ rtt-delta K/k-8f)
                          (/ rtt-delta K/k-div4f)))
        ;; Q: Are these actually used anywhere else?
        recently-seen-rtt-high? (> rtt-average (+ rtt-highwater K/ms-5))
        rtt-seen-recent-high recently-seen-rtt-high?
        rtt-seen-recent-low (and (not recently-seen-rtt-high?)
                                 (< rtt-average rtt-lowwater))
        state (update state
                      ::specs/flow-control
                      (fn [cur]
                        (assoc cur
                               ::specs/n-sec-per-block n-sec-per-block
                               ::specs/rtt-average rtt-average
                               ::specs/rtt-deviation rtt-deviation
                               ::specs/rtt-highwater rtt-highwater
                               ::specs/rtt-lowwater rtt-lowwater
                               ::specs/rtt-seen-recent-high rtt-seen-recent-high
                               ::specs/rtt-seen-recent-low rtt-seen-recent-low
                               ::specs/rtt-timeout rtt-timeout)))
        state (possibly-adjust-speed state)
        been-a-minute? (- recent last-edge K/minute-1)]
    (cond
      ;; Note that we generally don't need to make any changes
      (and (> 0 been-a-minute?)
           (< recent (+ last-doubling
                        (* 4 n-sec-per-block)
                        (* 64 rtt-timeout)
                        K/ms-5))) state
      (and (<= 0 been-a-minute?)
           (< recent (+ last-doubling
                        (* 4 n-sec-per-block)
                        (* 2 rtt-timeout)))) state
      ;; Q: Really? A: Yep. This is line 535
      (<= (dec K/k-64) n-sec-per-block) state
      :else (-> state
                (assoc ::specs/last-edge
                       (if (not= 0 last-edge) recent last-edge))
                (assoc-in [::specs/flow-control ::specs/last-doubling]
                          recent)
                (assoc-in [::specs/flow-control ::specs/n-sec-per-block]
                          (quot n-sec-per-block 2))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public

(s/fdef update-statistics
        :args (s/cat :state ::specs/state
                     :acked-block ::specs/block)
        :ret ::specs/state)
(defn update-statistics
  "It looks like this is coping with the first sent/ACK'd message from the child

  TODO: Better name
  Lines 458-541"
  [{:keys [::specs/message-loop-name
           ::specs/recent]
    :as state}
   {acked-time ::specs/time
    :as acked-block}]
  (log/debug (utils/pre-log message-loop-name)
             "Updating flow-control stats due to "
             acked-block)
  ;; The base-rtt-average calculation really only needs to
  ;; happen the first time around, when the rtt-average
  ;; is 0.
  ;; Q: Would it be worth moving the if check for that out
  ;; of there and into here to avoid the associated function
  ;; call overhead?
  ;; (It seems like premature optimization, but it's a cheap one)
  ;; A: Maybe, maybe not. This gets called again at the top
  ;; of jacobson's-retransmission-timeout.
  ;; Which is just wasteful duplication.
  (try
    (let [state (calculate-base-rtt-averages state acked-time)
          state (update state
                        ::log2/state
                        #(log2/debug %
                                     ::update-statistics
                                     "Recalculating retransmission timeout"
                                     {::specs/message-loop-name message-loop-name}))]
      (jacobson's-retransmission-timeout state acked-block))
    (catch RuntimeException ex
      (update state
              ::log2/state
              #(log2/exception %
                               ex
                               ::update-statistics
                               "Updating statistics failed"
                               (dissoc state ::log2/state))))))

(ns frereth-cp.message.flow-control
  "Cope with flow-control algorithms"
  (:require [clojure.spec.alpha :as s]
            [clojure.tools.logging :as log]
            [frereth-cp.message.constants :as K]
            [frereth-cp.message.specs :as specs]
            [frereth-cp.shared.crypto :as crypto]
            [frereth-cp.shared.logging :as log2]
            [frereth-cp.util :as utils]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Internal Helpers

(s/fdef recalc-rtt-average
        :args (s/cat :state ::specs/state
                     :rtt ::specs/rtt)
        :ret ::specs/state)
(defn calculate-base-rtt-averages
  "Lines 460-466"
  [{{:keys [::specs/rtt-average]} ::specs/flow-control
    :keys [::specs/recent]
    :as state}
   ackd-time]
  (let [rtt (- recent ackd-time)]
    (when (> 0 rtt)
      ;; I'm getting into scenarios with negative RTT, which
      ;; seems to have something to do with math overflow
      ;; warnings. That seems to be breaking things.
      ;; We should have set the block time when we first
      ;; spotted it. By contrast, recent should have
      ;; been set later, when the block was handed over
      ;; to the ioloop.
      ;; Note that assertions here just get swallowed
      ;; silently, and the thread gets returned to the pool.
      ;; This is terrible behavior. I've been meaning
      ;; to read a blog post that's probably about this exact
      ;; problem, but it involves a JVM-wide setting, and it
      ;; doesn't sound like something a library should mess
      ;; with. Although it might make sense in terms of unit
      ;; testing.
      (throw (ex-info "ACK arrived after recent"
                      {::specs/recent recent
                       ::ackd-time ackd-time
                       ::delta rtt})))
    (if (= 0 rtt-average)
      (update state
              ::specs/flow-control
              (fn [s]
                (assoc s
                       ::specs/n-sec-per-block rtt
                       ::specs/rtt rtt
                       ::specs/rtt-average rtt
                       ::specs/rtt-deviation (quot rtt 2)
                       ::specs/rtt-highwater rtt
                       ::specs/rtt-lowwater rtt)))
      state)))
(comment
  (let [times {::specs/recent 1515989075638
               ::ackd-time 2024584666631859}]
    (- (::specs/recent times) (::ackd-time times)))
  1515989075638)

(s/fdef jacobson-adjust-block-time
        :args (s/cat :n-sec-per-block ::specs/n-sec-per-block)
        :ret ::specs/n-sec-per-block)
(defn jacobson-adjust-block-time
  "Lines 496-509"
  [n-sec-per-block]
  (let [result
        (if (> n-sec-per-block K/k-128)
          ;; DJB had this to say.
          ;; As 4 separate comments.
          ;; additive increase: adjust 1/N by a constant c
          ;; rtt-fair additive increase: adjust 1/N by a constant c every nanosecond
          ;; approximation: adjust 1/N by cN every N nanoseconds
          ;; i.e., N <- 1/(1/N + cN) = N/(1 + cN^2) every N nanoseconds
          (if (< n-sec-per-block K/m-16)
            (let [u (quot n-sec-per-block K/k-128)]
              (- n-sec-per-block (* u u u)))
            (let [d (double n-sec-per-block)]
              ;; TODO: figure out the meaning behind this magic
              ;; formulation
              (long (/ d (inc (/ (* d d) 2251799813685248.0))))))
          n-sec-per-block)]
    (when-not (pos? result)
      ;; There's an important detail here for my current debugging
      ;; woes:
      ;; If I throw this exception erroneously (I had the logic
      ;; backwards, throwing when result was positive), then my
      ;; handshake test passes.
      (throw (ex-info "n-sec-per-block went negative"
                      {::specs/n-sec-per-block n-sec-per-block
                       ::adjusted-to result
                       ::u (quot n-sec-per-block K/k-128)})))
    result))

(s/fdef adjust-rtt-phase
        :args (s/cat :state ::specs/state)
        :ret ::specs/state)
(defn adjust-rtt-phase
  "Lines 511-521"
  [{:keys [::specs/recent]
    {:keys [::specs/n-sec-per-block
            ::specs/rtt-phase
            ::specs/rtt-seen-older-high
            ::specs/rtt-seen-older-low]} ::specs/flow-control
    :as state}]
  (if rtt-phase
    (if rtt-seen-older-high
      (update state (fn [s]
                      (assoc s
                             ::specs/rtt-phase true
                             ::specs/last-edge recent
                             ::specs/n-sec-per-block (+ n-sec-per-block
                                                        (crypto/random-mod (quot n-sec-per-block 4))))))
      state)
    (if rtt-seen-older-low
      (assoc-in state [::specs/flow-control ::specs/rtt-phase] false)
      state)))
(comment
  (crypto/random-mod (quot 1000000000 4))
  (crypto/random-mod 4))

(defn possibly-adjust-speed
  [{:keys [::specs/recent]
    {:keys [::specs/last-edge
            ::specs/last-speed-adjustment
            ::specs/n-sec-per-block
            ::specs/rtt-seen-recent-high
            ::specs/rtt-seen-recent-low]} ::specs/flow-control
    :as state}]
  ;; Lines 488-527
  (if (>= recent (+ last-speed-adjustment (* 16 n-sec-per-block)))
    (let [n-sec-per-block (if (> (- recent last-speed-adjustment) K/secs-10)
                            (+ K/secs-1 (crypto/random-mod (quot K/sec->n-sec 8)))
                            n-sec-per-block)
          n-sec-per-block (jacobson-adjust-block-time n-sec-per-block)
          ;; adjust-rtt-phase depends on this
          state (assoc-in state [::specs/flow-control ::specs/n-sec-per-block] n-sec-per-block)
          ;; adjust-rtt-phase does not modify rtt-seen-recent-high/low.
          ;; Q: Should it?
          {{:keys [::specs/rtt-seen-recent-high ::specs/rtt-seen-recent-low]} ::specs/flow-control
           :as state} (adjust-rtt-phase state)]
      (update state
              ::specs/flow-control
              (fn [cur]
                (assoc cur
                       ::specs/last-speed-adjustment recent
                       ::specs/seen-older-high rtt-seen-recent-high
                       ::specs/seen-older-low rtt-seen-recent-low
                       ;; We're throwing away the values we just calculated.
                       ;; Well, except that they got moved into seen-older-*
                       ;; Saving these booleans seems pointless.
                       ::specs/seen-recent-high false
                       ::specs/seen-recent-low false))))
    state))

(s/fdef jacobson's-retransmission-timeout
        :args (s/cat :state ::specs/state
                     :block ::specs/block)
        :ret ::specs/state)
(defn jacobson's-retransmission-timeout
  "Jacobson's retransmission timeout calculation: --DJB

  I'm lumping lines 467-527 into here, even though I haven't
  seen the actual paper describing the algorithm. This is the
  basic algorithm that TCP uses pretty much everywhere. -- JRG"
  [{:keys [::specs/recent]
    {:keys [::specs/last-doubling
            ::specs/last-edge
            ::specs/last-speed-adjustment
            ::specs/n-sec-per-block
            ::specs/rtt
            ::specs/rtt-average
            ::specs/rtt-deviation
            ::specs/rtt-highwater
            ::specs/rtt-lowwater
            ::specs/rtt-seen-recent-high
            ::specs/rtt-seen-recent-low
            ::specs/rtt-timeout]} ::specs/flow-control
    :as state}
   {block-send-time ::specs/time
    :as block}]
  (let [rtt-delta (- rtt rtt-average)
        ;; I'm seeing this drop below 0.
        ;; The math that leads to that *is* plausible.
        ;; But...does it ever make any sense?
        rtt-average (+ rtt-average (/ rtt-delta 8.0))
        rtt-delta (if (> 0 rtt-delta)
                    (- rtt-delta)
                    rtt-delta)
        rtt-delta (- rtt-delta rtt-deviation)
        rtt-deviation (+ rtt-deviation (/ rtt-delta 4.0))
        rtt-timeout (+ rtt-average (* 4 rtt-deviation))
        ;; adjust for delayed acks with anti-spiking: --DJB
        rtt-timeout (+ rtt-timeout (* 8 n-sec-per-block))

        ;; recognizing top and bottom of congestion cycle:  --DJB
        rtt-delta (- rtt rtt-highwater)
        rtt-highwater (+ rtt-highwater (/ rtt-delta K/k-1f))
        rtt-delta (- rtt rtt-lowwater)
        rtt-lowwater (+ rtt-lowwater
                        (if (> rtt-delta 0)
                          (/ rtt-delta K/k-8f)
                          (/ rtt-delta K/k-div4f)))
        ;; Q: Are these actually used anywhere else?
        recently-seen-rtt-high? (> rtt-average (+ rtt-highwater K/ms-5))
        rtt-seen-recent-high recently-seen-rtt-high?
        rtt-seen-recent-low (and (not recently-seen-rtt-high?)
                                 (< rtt-average rtt-lowwater))
        state (update state
                      ::specs/flow-control
                      (fn [cur]
                        (assoc cur
                               ::specs/n-sec-per-block n-sec-per-block
                               ::specs/rtt-average rtt-average
                               ::specs/rtt-deviation rtt-deviation
                               ::specs/rtt-highwater rtt-highwater
                               ::specs/rtt-lowwater rtt-lowwater
                               ::specs/rtt-seen-recent-high rtt-seen-recent-high
                               ::specs/rtt-seen-recent-low rtt-seen-recent-low
                               ::specs/rtt-timeout rtt-timeout)))
        state (possibly-adjust-speed state)
        been-a-minute? (- recent last-edge K/minute-1)]
    (cond
      ;; Note that we generally don't need to make any changes
      (and (> 0 been-a-minute?)
           (< recent (+ last-doubling
                        (* 4 n-sec-per-block)
                        (* 64 rtt-timeout)
                        K/ms-5))) state
      (and (<= 0 been-a-minute?)
           (< recent (+ last-doubling
                        (* 4 n-sec-per-block)
                        (* 2 rtt-timeout)))) state
      ;; Q: Really? A: Yep. This is line 535
      (<= (dec K/k-64) n-sec-per-block) state
      :else (-> state
                (assoc ::specs/last-edge
                       (if (not= 0 last-edge) recent last-edge))
                (assoc-in [::specs/flow-control ::specs/last-doubling]
                          recent)
                (assoc-in [::specs/flow-control ::specs/n-sec-per-block]
                          (quot n-sec-per-block 2))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Public

(s/fdef update-statistics
        :args (s/cat :state ::specs/state
                     :acked-block ::specs/block)
        :ret ::specs/state)
(defn update-statistics
  "It looks like this is coping with the first sent/ACK'd message from the child

  TODO: Better name
  Lines 458-541"
  [{:keys [::specs/message-loop-name
           ::specs/recent]
    :as state}
   {acked-time ::specs/time
    :as acked-block}]
  (log/debug (utils/pre-log message-loop-name)
             "Updating flow-control stats due to "
             acked-block)
  ;; The base-rtt-average calculation really only needs to
  ;; happen the first time around, when the rtt-average
  ;; is 0.
  ;; Q: Would it be worth moving the if check for that out
  ;; of there and into here to avoid the associated function
  ;; call overhead?
  ;; (It seems like premature optimization, but it's a cheap one)
  ;; A: Maybe, maybe not. This gets called again at the top
  ;; of jacobson's-retransmission-timeout.
  ;; Which is just wasteful duplication.
  (try
    (let [state (calculate-base-rtt-averages state acked-time)
          state (update state
                        ::log2/state
                        #(log2/debug %
                                     ::update-statistics
                                     "Recalculating retransmission timeout"
                                     {::specs/message-loop-name message-loop-name}))]
      (jacobson's-retransmission-timeout state acked-block))
    (catch RuntimeException ex
      (update state
              ::log2/state
              #(log2/exception %
                               ex
                               ::update-statistics
                               "Updating statistics failed"
                               (dissoc state ::log2/state))))))

Fix negative RTT issue

Fix negative RTT issue

The root cause behind this part of the problem in the past few (?)
commits was checking for < instead of >.


(ns lambdaui.testpipeline.simple-pipeline
  (:use [compojure.core])
  (:require [lambdacd.steps.shell :as shell]
            [lambdacd.steps.manualtrigger :refer [wait-for-manual-trigger]]
            [lambdacd.steps.control-flow :refer [either with-workspace in-parallel run]]
            [lambdacd.steps.support :refer [capture-output]]))

(def repo "https://github.com/flosell/testrepo.git")

(defonce lastStatus (atom nil))

(defn swapStatus [lastStatus]
  (case lastStatus
    :success :failure
    :failure :waiting
    :waiting :success
    :success)
  )

(defn spy [x]
  (println x)
  x)

(defn a-lot-output [args context]
  (shell/bash context (:cwd args) "for i in {1..200}; do echo \"Outputline ${i}\"; done")
  )

(defn long-running-task-20s [args context]
  (shell/bash context (:cwd args) "for i in {1..200}; do echo \"Outputline ${i}\"; sleep 0.1s; done")
  )

(defn different-status [_ _]
  {:status (swap! lastStatus swapStatus)})

(def pipeline-structure
  `( wait-for-manual-trigger
     a-lot-output
     different-status
     long-running-task-20s
     ))

(ns lambdaui.testpipeline.simple-pipeline
  (:use [compojure.core])
  (:require [lambdacd.steps.shell :as shell]
            [lambdacd.steps.manualtrigger :refer [wait-for-manual-trigger]]
            [lambdacd.steps.control-flow :refer [either with-workspace in-parallel run] :as step]
            [lambdacd.steps.support :refer [capture-output]]

            ))

(def repo "https://github.com/flosell/testrepo.git")

(defonce lastStatus (atom nil))

(defn swapStatus [lastStatus]
  (case lastStatus
    :success :failure
    :failure :waiting
    :waiting :success
    :success)
  )

(defn spy [x]
  (println x)
  x)

(defn successfullStep [args ctx]
  {:status :success :out "Wohoo!"})

(defn a-lot-output [args context]
  (shell/bash context (:cwd args) "for i in {1..200}; do echo \"Outputline ${i}\"; done")
  )

(defn long-running-task-20s [args context]
  (shell/bash context (:cwd args) "for i in {1..200}; do echo \"Outputline ${i}\"; sleep 0.1s; done")
  )

(defn different-status [_ _]
  {:status (swap! lastStatus swapStatus)})

(def pipeline-structure
  `( wait-for-manual-trigger
     a-lot-output
     (step/alias "i have substeps"
            (run successfullStep
                 successfullStep
                 (step/alias "i have more substeps"
                        (run a-lot-output
                             different-status))
                 a-lot-output)
            )
     long-running-task-20s
     ))

add nested steps

add nested steps


(ns videotest.coral.coral
  (:require
   [quil.core :as q]
   [videotest.coral.color :as color]
   [videotest.coral.hex :as hex]))

;; Should have a chance to attach, when:
;; - at bottom,
;; - run into existing coral,
;; -

;; (def NUM-CORAL-COL-BINS 64.0)
;; (def HEX-W 10.0)
(def NUM-CORAL-COL-BINS 110.0)
(def HEX-W 10.6)
(def CORAL-STROKE-WEIGHT 2.0)

(def CORAL-ROT-CYCLE 120)

(defn coral-size [display-w display-h]
  (let [col-bins NUM-CORAL-COL-BINS
        cell-w (/ display-w col-bins)
        row-bins (/ display-h cell-w)
        hex-w HEX-W]
    {:num-col-bins col-bins
     :num-row-bins row-bins
     :cell-w cell-w
     :cell-half-w (/ cell-w 2.0)
     :hex-w hex-w
     :hex-half-w (/ hex-w 2.0)
     :hex-y-offset (hex/hex-y-offset hex-w)
     :rot-cycle-length CORAL-ROT-CYCLE
     :rot-cycle 0
     :rot-cycle2 0
     :odd-col-lower true}))

(defn x->col [cell-w x]
  (int (/ x cell-w)))

(defn y->row [cell-w y]
  (int (/ y cell-w)))

(defn xy->coords
  ([cell-w [x y]]
     (xy->coords cell-w x y))
  ([cell-w x y]
     (let [col (x->col cell-w x)
           row (y->row cell-w y)]
       [col row])))

(defn is-bottom? [num-rows row]
  (<= (dec num-rows) row))

(defn is-occupied? [coral coords]
  (contains? coral coords))

(defn occupied-coral-under
  ([coral [col row :as coords]]
     (occupied-coral-under true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-plus (inc row)
           under-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row]
                           [     col  row-plus]
                           [(inc col) row]]
                          [[(dec col) row-plus]
                           [     col  row-plus]
                           [(inc col) row-plus]])]
       (filter #(is-occupied? coral %) under-coords))))

(defn occupied-coral-above
  ([coral [col row :as coords]]
     (occupied-coral-above true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-minus (dec row)
           other-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row-minus]
                           [     col  row-minus]
                           [(inc col) row-minus]]
                          [[(dec col) row]
                           [     col  row-minus]
                           [(inc col) row]])]
       (filter #(is-occupied? coral %) other-coords))))

#_(defn is-row-under-occupied? [coral [col row]]
  (seq (occupied-coral-under coral [col row])))

(defn is-leaf? [odd-col-lower coral [col row :as coords]]
  (not (seq (occupied-coral-above odd-col-lower coral coords))))

(def BOTTOM-ATTACH-PCT 0.1)

;; 127.5 = 180 degress (max on 0-255 scale)
;; 21.25 = 30 degrees (on 0-255 scale)
(def HUE-DIFF-CLIQUEY-THRESH-MAX 21.25)

(defn is-cliquey? [odd-col-lower coral coords this-hue]
  (if-let [occupied-under (seq
                           (occupied-coral-under odd-col-lower coral coords))]
    (let [sum-hue (reduce (fn [memo under-coords]
                            (let [{:keys [color-hsva]} (coral under-coords)]
                              (+ memo (first color-hsva))))
                          0
                          occupied-under)
          avg-hue (/ sum-hue (count occupied-under))
          diff (color/hue-diff avg-hue this-hue)]
      (and (< diff HUE-DIFF-CLIQUEY-THRESH-MAX)
           (> (q/map-range diff
                           0 HUE-DIFF-CLIQUEY-THRESH-MAX
                           1.0 0.0) (rand))))
    false))

(defn is-attaching? [coral coral-size
                     {:keys [x y color-hsva] :as seed}]
  (let [{:keys [num-row-bins cell-w odd-col-lower]} coral-size
        [col row :as coords] (xy->coords cell-w x y)]
    (and (not (is-occupied? coral coords))
         (not (is-occupied? coral [col (dec row)]))
         (or (and (is-bottom? num-row-bins row)
                  (> BOTTOM-ATTACH-PCT (rand)))
             (is-cliquey? odd-col-lower coral coords (first color-hsva)))
    )))

(defn remove-seeds [all-seeds seeds]
  (remove (set seeds) all-seeds))

(defn add-polyp [cell-w coral x y color-rgba color-hsva]
  (let [[col row :as coords] (xy->coords cell-w x y)]
    (assoc-in coral [coords] {:color-rgba color-rgba
                              :color-hsva color-hsva})))

(defn add-seeds-to-coral [cell-w coral seeds]
  (doall
   (reduce (fn [memo {:keys [x y color-rgba color-hsva] :as seed}]
             (add-polyp cell-w memo
                        x y
                        color-rgba color-hsva))
           coral
           seeds)))

(defn attach-seeds
  [display-h {:keys [motion-seeds coral-size coral] :as state}]
  (let [{:keys [cell-w]} coral-size
        attaching (filter (fn [seed]
                            (is-attaching? coral coral-size seed))
                          motion-seeds)]
    (-> state
        (update-in [:motion-seeds] #(remove-seeds % attaching))
        (update-in [:coral] #(add-seeds-to-coral cell-w % attaching)))))

(defn rotate-coral-side [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle]} coral-size]
    (if (= 0 rot-cycle)
      (update-in state [:coral]
                 #(reduce (fn [memo [[col row :as coords]
                                    polyp]]
                            (if (< col 1)
                              memo
                              (let [new-coords [(dec col) row]]
                                (assoc-in memo [new-coords] polyp))))
                          {}
                          %))
      state)))

(defn update-rot-cycle [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle-length]} coral-size
        frame-count (q/frame-count)
        rot-cycle   (mod frame-count rot-cycle-length)
        rot-cycle2 (mod frame-count (* 2 rot-cycle-length))]
   (update-in state [:coral-size]
              #(-> %
                   (assoc-in [:rot-cycle] rot-cycle)
                   (assoc-in [:rot-cycle2] rot-cycle2)
                   (assoc-in [:odd-col-lower]
                             (>= rot-cycle2 rot-cycle-length))))))

(defn rotate-coral [state]
  (-> state
      (update-rot-cycle)
      (rotate-coral-side)))

(defn draw-polyp [coral
                  {:keys [cell-w cell-half-w
                          hex-w hex-half-w
                          hex-y-offset
                          odd-col-lower] :as coral-size}
                  [[col row :as coords]
                   {:keys [color-rgba] :as polyp}]]
  #_(apply q/fill color-rgba)
  (if (is-leaf? odd-col-lower coral coords)
    (q/fill 50 255 0 155)
    (q/no-fill))
  (apply q/stroke color-rgba)
  (hex/draw-hex-cell odd-col-lower
                     cell-w cell-half-w
                     hex-w hex-half-w
                     hex-y-offset
                     col (- row 1)))

(defn draw-coral [{:keys [coral-size coral]}]
  (q/push-style)
  (q/no-fill)
  (q/stroke-weight CORAL-STROKE-WEIGHT)
  #_(q/stroke 255)
  (let [{:keys [cell-w rot-cycle-length rot-cycle odd-col-lower]} coral-size
        x-offset (* (/ cell-w (float rot-cycle-length))
                    (float rot-cycle))]
    (q/with-translation [(- x-offset) 0]
      (dorun
       (map (partial draw-polyp coral coral-size)
            coral))))
  (q/pop-style))

(ns videotest.coral.coral
  (:require
   [quil.core :as q]
   [videotest.coral.color :as color]
   [videotest.coral.hex :as hex]))

;; (def NUM-CORAL-COL-BINS 64.0)
;; (def HEX-W 10.0)
(def NUM-CORAL-COL-BINS 110.0)
(def HEX-W 10.6)
(def CORAL-STROKE-WEIGHT 2.0)

(def CORAL-ROT-CYCLE 120)

(defn coral-size [display-w display-h]
  (let [col-bins NUM-CORAL-COL-BINS
        cell-w (/ display-w col-bins)
        row-bins (/ display-h cell-w)
        hex-w HEX-W]
    {:num-col-bins col-bins
     :num-row-bins row-bins
     :cell-w cell-w
     :cell-half-w (/ cell-w 2.0)
     :hex-w hex-w
     :hex-half-w (/ hex-w 2.0)
     :hex-y-offset (hex/hex-y-offset hex-w)
     :rot-cycle-length CORAL-ROT-CYCLE
     :rot-cycle 0
     :rot-cycle2 0
     :odd-col-lower true}))

(defn x->col [cell-w x]
  (int (/ x cell-w)))

(defn y->row [cell-w y]
  (int (/ y cell-w)))

(defn xy->coords
  ([cell-w [x y]]
     (xy->coords cell-w x y))
  ([cell-w x y]
     (let [col (x->col cell-w x)
           row (y->row cell-w y)]
       [col row])))

(defn is-bottom? [num-rows row]
  (<= (dec num-rows) row))

(defn is-occupied? [coral coords]
  (contains? coral coords))

(defn occupied-coral-under
  ([coral [col row :as coords]]
     (occupied-coral-under true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-plus (inc row)
           under-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row]
                           [     col  row-plus]
                           [(inc col) row]]
                          [[(dec col) row-plus]
                           [     col  row-plus]
                           [(inc col) row-plus]])]
       (filter #(is-occupied? coral %) under-coords))))

(defn occupied-coral-above
  ([coral [col row :as coords]]
     (occupied-coral-above true coral coords))
  ([odd-col-lower coral [col row]]
     (let [row-minus (dec row)
           other-coords (if (or
                             (and odd-col-lower (even? col))
                             (and (not odd-col-lower) (odd? col)))
                          [[(dec col) row-minus]
                           [     col  row-minus]
                           [(inc col) row-minus]]
                          [[(dec col) row]
                           [     col  row-minus]
                           [(inc col) row]])]
       (filter #(is-occupied? coral %) other-coords))))

#_(defn is-row-under-occupied? [coral [col row]]
  (seq (occupied-coral-under coral [col row])))

(defn is-leaf? [odd-col-lower coral [col row :as coords]]
  (not (seq (occupied-coral-above odd-col-lower coral coords))))

(def BOTTOM-ATTACH-PCT 0.1)

;; 127.5 = 180 degress (max on 0-255 scale)
;; 21.25 = 30 degrees (on 0-255 scale)
(def HUE-DIFF-CLIQUEY-THRESH-MAX 21.25)

(defn is-cliquey? [odd-col-lower coral coords this-hue]
  (if-let [occupied-under (seq
                           (occupied-coral-under odd-col-lower coral coords))]
    (let [sum-hue (reduce (fn [memo under-coords]
                            (let [{:keys [color-hsva]} (coral under-coords)]
                              (+ memo (first color-hsva))))
                          0
                          occupied-under)
          avg-hue (/ sum-hue (count occupied-under))
          diff (color/hue-diff avg-hue this-hue)]
      (and (< diff HUE-DIFF-CLIQUEY-THRESH-MAX)
           (> (q/map-range diff
                           0 HUE-DIFF-CLIQUEY-THRESH-MAX
                           1.0 0.0) (rand))))
    false))

(defn is-attaching? [coral coral-size
                     {:keys [x y color-hsva] :as seed}]
  (let [{:keys [num-row-bins cell-w odd-col-lower]} coral-size
        [col row :as coords] (xy->coords cell-w x y)]
    (and (not (is-occupied? coral coords))
         (not (is-occupied? coral [col (dec row)]))
         (or (and (is-bottom? num-row-bins row)
                  (> BOTTOM-ATTACH-PCT (rand)))
             (is-cliquey? odd-col-lower coral coords (first color-hsva)))
    )))

(defn remove-seeds [all-seeds seeds]
  (remove (set seeds) all-seeds))

(defn add-polyp [cell-w coral x y color-rgba color-hsva]
  (let [[col row :as coords] (xy->coords cell-w x y)]
    (assoc-in coral [coords] {:color-rgba color-rgba
                              :color-hsva color-hsva})))

(defn add-seeds-to-coral [cell-w coral seeds]
  (doall
   (reduce (fn [memo {:keys [x y color-rgba color-hsva] :as seed}]
             (add-polyp cell-w memo
                        x y
                        color-rgba color-hsva))
           coral
           seeds)))

(defn attach-seeds
  [display-h {:keys [motion-seeds coral-size coral] :as state}]
  (let [{:keys [cell-w]} coral-size
        attaching (filter (fn [seed]
                            (is-attaching? coral coral-size seed))
                          motion-seeds)]
    (-> state
        (update-in [:motion-seeds] #(remove-seeds % attaching))
        (update-in [:coral] #(add-seeds-to-coral cell-w % attaching)))))

(defn rotate-coral-side [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle]} coral-size]
    (if (= 0 rot-cycle)
      (update-in state [:coral]
                 #(reduce (fn [memo [[col row :as coords]
                                    polyp]]
                            (if (< col 1)
                              memo
                              (let [new-coords [(dec col) row]]
                                (assoc-in memo [new-coords] polyp))))
                          {}
                          %))
      state)))

(defn update-rot-cycle [{:keys [coral-size] :as state}]
  (let [{:keys [rot-cycle-length]} coral-size
        frame-count (q/frame-count)
        rot-cycle   (mod frame-count rot-cycle-length)
        rot-cycle2 (mod frame-count (* 2 rot-cycle-length))]
   (update-in state [:coral-size]
              #(-> %
                   (assoc-in [:rot-cycle] rot-cycle)
                   (assoc-in [:rot-cycle2] rot-cycle2)
                   (assoc-in [:odd-col-lower]
                             (>= rot-cycle2 rot-cycle-length))))))

(defn rotate-coral [state]
  (-> state
      (update-rot-cycle)
      (rotate-coral-side)))

(defn draw-polyp [coral
                  {:keys [cell-w cell-half-w
                          hex-w hex-half-w
                          hex-y-offset
                          odd-col-lower] :as coral-size}
                  [[col row :as coords]
                   {:keys [color-rgba] :as polyp}]]
  #_(apply q/fill color-rgba)
  (if (is-leaf? odd-col-lower coral coords)
    (q/fill 50 255 0 155)
    (q/no-fill))
  (apply q/stroke color-rgba)
  (hex/draw-hex-cell odd-col-lower
                     cell-w cell-half-w
                     hex-w hex-half-w
                     hex-y-offset
                     col (- row 1)))

(defn draw-coral [{:keys [coral-size coral]}]
  (q/push-style)
  (q/no-fill)
  (q/stroke-weight CORAL-STROKE-WEIGHT)
  #_(q/stroke 255)
  (let [{:keys [cell-w rot-cycle-length rot-cycle odd-col-lower]} coral-size
        x-offset (* (/ cell-w (float rot-cycle-length))
                    (float rot-cycle))]
    (q/with-translation [(- x-offset) 0]
      (dorun
       (map (partial draw-polyp coral coral-size)
            coral))))
  (q/pop-style))

Remove comments

Remove comments


(ns onyx-dashboard.http.server
  (:require [clojure.core.async :refer [chan timeout thread <!! alts!!]]
            [onyx-dashboard.dev :refer [is-dev? inject-devmode-html #_browser-repl start-figwheel]]
            [org.httpkit.server :as http-kit-server]
            [com.stuartsierra.component :as component]
            [clojure.java.io :as io]
            [compojure.route :refer [resources]]
            [compojure.handler :refer [api]]
            [net.cgrand.enlive-html :refer [deftemplate]]
            [ring.middleware.session :refer [wrap-session]]
            [ring.middleware.defaults]
            [ring.util.response :refer [resource-response response content-type]]
            [compojure.core :as comp :refer (defroutes GET POST)]
            [compojure.route :as route]
            [com.stuartsierra.component :as component]
            [onyx-dashboard.onyx-deployment :as od]
            [zookeeper :as zk]
            [taoensso.timbre :as timbre :refer [info error spy]]))

(deftemplate page
  (io/resource "index.html") [] [:body] (if is-dev? inject-devmode-html identity))

(def ring-defaults-config
  (assoc-in ring.middleware.defaults/site-defaults
            [:security :anti-forgery]
            {:read-token (fn [req] (-> req :params :csrf-token))}))

(defn event->uid [event]
  (get-in event [:ring-req :cookies "ring-session" :value]))

(defn start-event-handler [sente peer-config deployments tracking]
  (future
    (loop []
      (when-let [event (<!! (:ch-chsk sente))]
        ;(info "EVENT:" event)
        ;; TODO: more sophisticated tracking,
        ;; should track by cluster id rather than user
        ;; and count the number of users tracking it. When the user count drops to 0
        ;; then stop the future.
        (let [user-id (event->uid event)]
          (case (:id event)
            :deployment/track (od/start-tracking! (:chsk-send! sente)
                                                  peer-config
                                                  tracking
                                                  (:?data event)
                                                  user-id)
            :deployment/get-listing ((:chsk-send! sente) user-id [:deployment/listing @deployments])
            :job/kill (od/kill-job peer-config
                                   (:deployment-id (:?data event))
                                   (:job (:?data event)))
            :job/start (od/start-job peer-config
                                     (:deployment-id (:?data event))
                                     (:job (:?data event)))
            :job/restart (od/restart-job peer-config
                                         (:deployment-id (:?data event))
                                         (:job (:?data event)))
            :chsk/uidport-close (swap! tracking od/stop-tracking! user-id)
            :chsk/ws-ping nil
            nil #_(println "Dunno what to do with: " event)))
        (recur)))))

(defn send-mult-fn [send-fn! connected-uids msg]
  (doseq [uid (:any @connected-uids)]
    (send-fn! uid msg)))

(defn metrics-handler [send-f request]
  (http-kit-server/with-channel request channel
    (http-kit-server/on-receive
     channel
     (fn [data] (send-f [:metrics/event (read-string data)])))))

(defrecord HttpServer [peer-config]
  component/Lifecycle
  (start [{:keys [sente] :as component}]
    (println "Starting HTTP Server")
    (let [send-f (partial send-mult-fn
                          (:chsk-send! sente)
                          (:connected-uids sente))]
      (defroutes routes
        (GET  "/" [] (page))
        (GET  "/chsk" req ((:ring-ajax-get-or-ws-handshake sente) req))
        (GET  "/metrics" req (partial metrics-handler send-f))
        (POST "/chsk" req ((:ring-ajax-post sente) req))
        (resources "/")
        (resources "/react" {:root "react"})
        (route/not-found "Page not found"))

      (let [deployments (atom {})
            tracking (atom {})
            event-handler-fut (start-event-handler sente peer-config deployments tracking)
            handler (ring.middleware.defaults/wrap-defaults routes ring-defaults-config)
            server (http-kit-server/run-server handler {:port 3000})
            uri (format "http://localhost:%s/" (:local-port (meta server)))]
        (println "Http-kit server is running at" uri)

                                        ; TODO: no way to currently stop this watch
                                        ; Should be in component and stoppable
        (od/refresh-deployments-watch send-f
                                      (zk/connect (:zookeeper/address peer-config))
                                      deployments)

        (assoc component
          :server server
          :event-handler-fut event-handler-fut
          :deployments deployments
          :tracking tracking))))
  (stop [{:keys [server tracking deployments] :as component}]
    (println "Stopping HTTP Server")
    (swap! tracking od/stop-all-tracking!)
    (future-cancel (:event-handler-fut component))
    (server :timeout 100)
    (assoc component :server nil :event-handler-fut nil :deployments nil :tracking nil)))

(defn new-http-server [peer-config]
  (map->HttpServer {:peer-config peer-config}))

(ns onyx-dashboard.http.server
  (:require [clojure.core.async :refer [chan timeout thread <!! alts!!]]
            [onyx-dashboard.dev :refer [is-dev? inject-devmode-html #_browser-repl start-figwheel]]
            [org.httpkit.server :as http-kit-server]
            [com.stuartsierra.component :as component]
            [clojure.java.io :as io]
            [compojure.route :refer [resources]]
            [compojure.handler :refer [api]]
            [net.cgrand.enlive-html :refer [deftemplate]]
            [ring.middleware.session :refer [wrap-session]]
            [ring.middleware.defaults]
            [ring.util.response :refer [resource-response response content-type]]
            [compojure.core :as comp :refer (defroutes GET POST)]
            [compojure.route :as route]
            [com.stuartsierra.component :as component]
            [onyx-dashboard.onyx-deployment :as od]
            [onyx.log.curator :as zk]
            [taoensso.timbre :as timbre :refer [info error spy]]))

(deftemplate page
  (io/resource "index.html") [] [:body] (if is-dev? inject-devmode-html identity))

(def ring-defaults-config
  (assoc-in ring.middleware.defaults/site-defaults
            [:security :anti-forgery]
            {:read-token (fn [req] (-> req :params :csrf-token))}))

(defn event->uid [event]
  (get-in event [:ring-req :cookies "ring-session" :value]))

(defn start-event-handler [sente peer-config deployments tracking]
  (future
    (loop []
      (when-let [event (<!! (:ch-chsk sente))]
        ;(info "EVENT:" event)
        ;; TODO: more sophisticated tracking,
        ;; should track by cluster id rather than user
        ;; and count the number of users tracking it. When the user count drops to 0
        ;; then stop the future.
        (let [user-id (event->uid event)]
          (case (:id event)
            :deployment/track (od/start-tracking! (:chsk-send! sente)
                                                  peer-config
                                                  tracking
                                                  (:?data event)
                                                  user-id)
            :deployment/get-listing ((:chsk-send! sente) user-id [:deployment/listing @deployments])
            :job/kill (od/kill-job peer-config
                                   (:deployment-id (:?data event))
                                   (:job (:?data event)))
            :job/start (od/start-job peer-config
                                     (:deployment-id (:?data event))
                                     (:job (:?data event)))
            :job/restart (od/restart-job peer-config
                                         (:deployment-id (:?data event))
                                         (:job (:?data event)))
            :chsk/uidport-close (swap! tracking od/stop-tracking! user-id)
            :chsk/ws-ping nil
            nil #_(println "Dunno what to do with: " event)))
        (recur)))))

(defn send-mult-fn [send-fn! connected-uids msg]
  (doseq [uid (:any @connected-uids)]
    (send-fn! uid msg)))

(defn metrics-handler [send-f request]
  (http-kit-server/with-channel request channel
    (http-kit-server/on-receive
     channel
     (fn [data] (send-f [:metrics/event (read-string data)])))))

(defrecord HttpServer [peer-config]
  component/Lifecycle
  (start [{:keys [sente] :as component}]
    (println "Starting HTTP Server")
    (let [send-f (partial send-mult-fn
                          (:chsk-send! sente)
                          (:connected-uids sente))]
      (defroutes routes
        (GET  "/" [] (page))
        (GET  "/chsk" req ((:ring-ajax-get-or-ws-handshake sente) req))
        (GET  "/metrics" req (partial metrics-handler send-f))
        (POST "/chsk" req ((:ring-ajax-post sente) req))
        (resources "/")
        (resources "/react" {:root "react"})
        (route/not-found "Page not found"))

      (let [deployments (atom {})
            tracking (atom {})
            event-handler-fut (start-event-handler sente peer-config deployments tracking)
            handler (ring.middleware.defaults/wrap-defaults routes ring-defaults-config)
            server (http-kit-server/run-server handler {:port 3000})
            uri (format "http://localhost:%s/" (:local-port (meta server)))]
        (println "Http-kit server is running at" uri)

                                        ; TODO: no way to currently stop this watch
                                        ; Should be in component and stoppable
        (od/refresh-deployments-watch send-f
                                      (zk/connect (:zookeeper/address peer-config))
                                      deployments)

        (assoc component
          :server server
          :event-handler-fut event-handler-fut
          :deployments deployments
          :tracking tracking))))
  (stop [{:keys [server tracking deployments] :as component}]
    (println "Stopping HTTP Server")
    (swap! tracking od/stop-all-tracking!)
    (future-cancel (:event-handler-fut component))
    (server :timeout 100)
    (assoc component :server nil :event-handler-fut nil :deployments nil :tracking nil)))

(defn new-http-server [peer-config]
  (map->HttpServer {:peer-config peer-config}))

Use onyx curator

Use onyx curator


(ns goya.components.mainmenu
  (:require-macros [cljs.core.async.macros :refer [go]])
	(:require [goog.events :as events]
            [goog.dom :as dom]
            [cljs.reader :as reader]
            [om.core :as om :include-macros true]
            [om.dom :as omdom :include-macros true]
            [goya.appstate :as app]
            [goya.timemachine :as timemachine]
            [goya.canvasdrawing :as canvasdrawing]
            [cljs.core.async :refer [put! chan <! alts!]]))

(defn file-list-to-cljs [js-col]
  (-> (clj->js [])
      (.-slice)
      (.call js-col)
      (js->clj)))

(defn reset-app-state-from-string [document-uri]
  (let [compressed-app-state (aget (.split document-uri ",") 1)
        decompressed-content (.decompressFromBase64 js/LZString compressed-app-state)
        document (reader/read-string decompressed-content)
        dummy-undo-history [{:action "Loaded Saved Project" :icon "upload"}]
        cleaned-document (assoc-in document [:undo-history] dummy-undo-history)
        current-app-state @app/app-state
        new-app-state (assoc-in current-app-state [:main-app] cleaned-document)]
    (reset! app/app-state new-app-state)
    (timemachine/forget-everything)))

(defn handle-file-load [e]
  (let [files (.-files (.-target e))
        files-list (file-list-to-cljs files)
        file (nth files-list 0)
        file-reader (js/FileReader.)]
    (set! (.-onload file-reader)
      #(reset-app-state-from-string (.-result (.-target %))))
    (.readAsDataURL file-reader file)))

(events/listen
  (dom/getElement "fileChooser")
  "change"
  #(handle-file-load %))

(defn show-progress [progress owner]
  (let [p (.round js/Math (* progress 100))]
    (om/set-state! owner :progress p)))

(defn dump-image []
  (.log js/console (str (get-in @app/app-state [:main-app :image-data]))))

(defn export-image []
  (let [canvas (. js/document (getElementById "main-canvas"))
        download-link (. js/document (getElementById "image-download-link"))]
    (set! (.-href download-link) (.toDataURL canvas))
    (.click download-link)))

(defn export-spritesheet []
  (let [render-canvas (. js/document (createElement "canvas"))
        animation (get-in @app/app-state [:main-app :animation])
        frame-width (get-in @app/app-state [:main-app :canvas-width])
        frame-height (get-in @app/app-state [:main-app :canvas-height])
        download-link (. js/document (getElementById "image-download-link"))]
    (canvasdrawing/draw-spritesheet-to-canvas animation render-canvas frame-width frame-height)
    (set! (.-href download-link) (.toDataURL render-canvas))
    (.click download-link)))

(defn save-document []
  (let [download-link (. js/document (getElementById "document-download-link"))
        app-state-to-save (get-in @app/app-state [:main-app])
        document-content (pr-str app-state-to-save)
        compressed-content (.compressToBase64 js/LZString document-content)
        href-content (str "data:application/octet-stream;base64," compressed-content)]
    (set! (.-href download-link) href-content)
    (.click download-link)))

(defn load-document []
  (let [upload-link (. js/document (getElementById "fileChooser"))]
    (.click upload-link)))

(defn download-history-animation [blob owner]
  (let [download-link (. js/document (getElementById "image-download-link"))]
    (om/set-state! owner :is-processing false)
    (set! (.-href download-link) (.createObjectURL js/URL blob))
    (.click download-link)))

(defn export-history-animation [owner]
  (let [render-canvas (. js/document (createElement "canvas"))
        max-width 64
        max-height 64
        zoom-factor 2
        app-history @timemachine/app-history
        gif (js/GIF. #js {:workers 2
                          :quality 10
                          :width (* max-width zoom-factor)
                          :height (* max-height zoom-factor)
                          :workerScript "./gifjs/dist/gif.worker.js"})]
    (om/set-state! owner :is-processing true)
    (om/set-state! owner :progress 0)
    (dotimes [x (count app-history)]
      (let [history-snapshot (nth app-history x)
            width (get-in history-snapshot [:canvas-width])
            height (get-in history-snapshot [:canvas-height])
            image-data (get-in history-snapshot [:image-data])
            context (.getContext render-canvas "2d")]
        (canvasdrawing/draw-image-to-canvas image-data render-canvas width height zoom-factor)
        (.addFrame gif context #js {:copy true :delay 300})))
    (.on gif "finished" #(download-history-animation % owner))
    (.on gif "progress" #(show-progress % owner))
    (.render gif)))

(defn export-animation [owner]
  (let [render-canvas (. js/document (createElement "canvas"))
        width (get-in @app/app-state [:main-app :canvas-width])
        height (get-in @app/app-state [:main-app :canvas-height])
        animation (get-in @app/app-state [:main-app :animation])
        gif (js/GIF. #js {:workers 4
                          :quality 1
                          :width width
                          :height height
                          :workerScript "./gifjs/dist/gif.worker.js"})]
    (om/set-state! owner :is-processing true)
    (om/set-state! owner :progress 0)
    (dotimes [x (count animation)]
      (let [frame (nth animation x)
            image-data (get-in frame [:image-data])
            context (.getContext render-canvas "2d")]
        (canvasdrawing/draw-image-to-canvas image-data render-canvas width height 1)
        (.addFrame gif context #js {:copy true :delay 300})))
    (.on gif "finished" #(download-history-animation % owner))
    (.on gif "progress" #(show-progress % owner))
    (.render gif)))

(defn assoc-all [v ks value]
  (reduce #(assoc %1 %2 value) v ks))

(defn create-new-document [app owner]
  (let [width (get-in @app [:main-app :canvas-width])
        height (get-in @app [:main-app :canvas-height])
        num-pixels (* width height)
        blank-frame {:image-data (vec (take num-pixels (repeat "#000000")))}
        new-animation [blank-frame]]
    (timemachine/forget-everything)
    (om/update! app [:main-app :editing-frame] 0)
    (om/update! app [:main-app :animation] new-animation :new-document)
    (om/update! app [:main-app :undo-history]
                    [{:action (str "Started New Project") :icon "tag"}] :add-to-undo)))

;; =============================================================================

(defn menu-entry-component [entry owner]
  (reify
    om/IInitState
      (init-state [_]
        {:is-processing false
         :progress 0})

    om/IRenderState
      (render-state [this {:keys [clickchan]}]
        (omdom/div
          #js {:className "main-menu-item"
               :onClick (fn [e] (put! clickchan {:command (:command @entry)
                                                 :owner owner})
                          (when (= (:command @entry) :load-doc) (load-document)))}
          (omdom/i #js {:className (:icon entry)})
          (if
            (om/get-state owner :is-processing)
            (str "Working... "(om/get-state owner :progress) "%")
            (:text entry))))))

(defn menu-component [app owner]
  (reify
    om/IInitState
    (init-state [_]
      {:clickchan (chan)})

    om/IWillMount
    (will-mount [_]
       (let [clickchan (om/get-state owner :clickchan)]
        (go (loop []
          (let [e (<! clickchan)
                command (:command e)
                origin-owner (:owner e)]
            (when (= command :new-doc) (create-new-document app owner))
            (when (= command :save-doc) (save-document))
            (when (= command :export-doc) (export-image))
            (when (= command :export-spritesheet) (export-spritesheet))
            (when (= command :export-animation) (export-animation origin-owner))
            (when (= command :export-history-animation) (export-history-animation origin-owner))
          (recur))))))

    om/IRenderState
    (render-state [this {:keys [clickchan]}]
      (omdom/div nil
        (om/build menu-entry-component
          (get-in app [:main-menu-items :new-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :save-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :load-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :export-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :export-document-spritesheet])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :export-document-animation])
          {:init-state {:clickchan clickchan}})
;;         (om/build menu-entry-component
;;           (get-in app [:main-menu-items :export-history-animation])
;;           {:init-state {:clickchan clickchan}})
        ))))

(ns goya.components.mainmenu
  (:require-macros [cljs.core.async.macros :refer [go]])
	(:require [goog.events :as events]
            [goog.dom :as dom]
            [cljs.reader :as reader]
            [om.core :as om :include-macros true]
            [om.dom :as omdom :include-macros true]
            [goya.appstate :as app]
            [goya.timemachine :as timemachine]
            [goya.canvasdrawing :as canvasdrawing]
            [cljs.core.async :refer [put! chan <! alts!]]))

(defn file-list-to-cljs [js-col]
  (-> (clj->js [])
      (.-slice)
      (.call js-col)
      (js->clj)))

(defn reset-app-state-from-string [document-uri]
  (let [compressed-app-state (aget (.split document-uri ",") 1)
        decompressed-content (.decompressFromBase64 js/LZString compressed-app-state)
        document (reader/read-string decompressed-content)
        dummy-undo-history [{:action "Loaded Saved Project" :icon "upload"}]
        cleaned-document (assoc-in document [:undo-history] dummy-undo-history)
        current-app-state @app/app-state
        new-app-state (assoc-in current-app-state [:main-app] cleaned-document)]
    (reset! app/app-state new-app-state)
    (timemachine/forget-everything)))

(defn handle-file-load [e]
  (let [files (.-files (.-target e))
        files-list (file-list-to-cljs files)
        file (nth files-list 0)
        file-reader (js/FileReader.)]
    (set! (.-onload file-reader)
      #(reset-app-state-from-string (.-result (.-target %))))
    (.readAsDataURL file-reader file)))

(events/listen
  (dom/getElement "fileChooser")
  "change"
  #(handle-file-load %))

(defn show-progress [progress owner]
  (let [p (.round js/Math (* progress 100))]
    (om/set-state! owner :progress p)))

(defn dump-image []
  (.log js/console (str (get-in @app/app-state [:main-app :image-data]))))

(defn export-image []
  (let [canvas (. js/document (getElementById "main-canvas"))
        download-link (. js/document (getElementById "image-download-link"))]
    (set! (.-href download-link) (.toDataURL canvas))
    (.click download-link)))

(defn export-spritesheet []
  (let [render-canvas (. js/document (createElement "canvas"))
        animation (get-in @app/app-state [:main-app :animation])
        frame-width (get-in @app/app-state [:main-app :canvas-width])
        frame-height (get-in @app/app-state [:main-app :canvas-height])
        download-link (. js/document (getElementById "image-download-link"))]
    (canvasdrawing/draw-spritesheet-to-canvas animation render-canvas frame-width frame-height)
    (set! (.-href download-link) (.toDataURL render-canvas))
    (.click download-link)))

(defn save-document []
  (let [download-link (. js/document (getElementById "document-download-link"))
        app-state-to-save (get-in @app/app-state [:main-app])
        document-content (pr-str app-state-to-save)
        compressed-content (.compressToBase64 js/LZString document-content)
        href-content (str "data:application/octet-stream;base64," compressed-content)]
    (set! (.-href download-link) href-content)
    (.click download-link)))

(defn load-document []
  (let [upload-link (. js/document (getElementById "fileChooser"))]
    (.click upload-link)))

(defn download-history-animation [blob owner]
  (let [download-link (. js/document (getElementById "image-download-link"))]
    (om/set-state! owner :is-processing false)
    (set! (.-href download-link) (.createObjectURL js/URL blob))
    (.click download-link)))

;; (defn export-history-animation [owner]
;;   (let [render-canvas (. js/document (createElement "canvas"))
;;         max-width 64
;;         max-height 64
;;         zoom-factor 2
;;         app-history @timemachine/app-history
;;         gif (js/GIF. #js {:workers 2
;;                           :quality 10
;;                           :width (* max-width zoom-factor)
;;                           :height (* max-height zoom-factor)
;;                           :workerScript "./gifjs/dist/gif.worker.js"})]
;;     (om/set-state! owner :is-processing true)
;;     (om/set-state! owner :progress 0)
;;     (dotimes [x (count app-history)]
;;       (let [history-snapshot (nth app-history x)
;;             width (get-in history-snapshot [:canvas-width])
;;             height (get-in history-snapshot [:canvas-height])
;;             image-data (get-in history-snapshot [:image-data])
;;             context (.getContext render-canvas "2d")]
;;         (canvasdrawing/draw-image-to-canvas image-data render-canvas width height zoom-factor)
;;         (.addFrame gif context #js {:copy true :delay 300})))
;;     (.on gif "finished" #(download-history-animation % owner))
;;     (.on gif "progress" #(show-progress % owner))
;;     (.render gif)))

(defn export-animation [owner]
  (let [render-canvas (. js/document (createElement "canvas"))
        width (get-in @app/app-state [:main-app :canvas-width])
        height (get-in @app/app-state [:main-app :canvas-height])
        animation (get-in @app/app-state [:main-app :animation])
        gif (js/GIF. #js {:workers 4
                          :quality 1
                          :width width
                          :height height
                          :workerScript "./gifjs/dist/gif.worker.js"})]
    (om/set-state! owner :is-processing true)
    (om/set-state! owner :progress 0)
    (dotimes [x (count animation)]
      (let [frame (nth animation x)
            image-data (get-in frame [:image-data])
            context (.getContext render-canvas "2d")]
        (canvasdrawing/draw-image-to-canvas image-data render-canvas width height 1)
        (.addFrame gif context #js {:copy true :delay 300})))
    (.on gif "finished" #(download-history-animation % owner))
    (.on gif "progress" #(show-progress % owner))
    (.render gif)))

(defn assoc-all [v ks value]
  (reduce #(assoc %1 %2 value) v ks))

(defn create-new-document [app owner]
  (let [width (get-in @app [:main-app :canvas-width])
        height (get-in @app [:main-app :canvas-height])
        num-pixels (* width height)
        blank-frame {:image-data (vec (take num-pixels (repeat "#000000")))}
        new-animation [blank-frame]]
    (timemachine/forget-everything)
    (om/update! app [:main-app :editing-frame] 0)
    (om/update! app [:main-app :animation] new-animation :new-document)
    (om/update! app [:main-app :undo-history]
                    [{:action (str "Started New Project") :icon "tag"}] :add-to-undo)))

;; =============================================================================

(defn menu-entry-component [entry owner]
  (reify
    om/IInitState
      (init-state [_]
        {:is-processing false
         :progress 0})

    om/IRenderState
      (render-state [this {:keys [clickchan]}]
        (omdom/div
          #js {:className "main-menu-item"
               :onClick (fn [e] (put! clickchan {:command (:command @entry)
                                                 :owner owner})
                          (when (= (:command @entry) :load-doc) (load-document)))}
          (omdom/i #js {:className (:icon entry)})
          (if
            (om/get-state owner :is-processing)
            (str "Working... "(om/get-state owner :progress) "%")
            (:text entry))))))

(defn menu-component [app owner]
  (reify
    om/IInitState
    (init-state [_]
      {:clickchan (chan)})

    om/IWillMount
    (will-mount [_]
       (let [clickchan (om/get-state owner :clickchan)]
        (go (loop []
          (let [e (<! clickchan)
                command (:command e)
                origin-owner (:owner e)]
            (when (= command :new-doc) (create-new-document app owner))
            (when (= command :save-doc) (save-document))
            (when (= command :export-doc) (export-image))
            (when (= command :export-spritesheet) (export-spritesheet))
            (when (= command :export-animation) (export-animation origin-owner))
;;             (when (= command :export-history-animation) (export-history-animation origin-owner))
          (recur))))))

    om/IRenderState
    (render-state [this {:keys [clickchan]}]
      (omdom/div nil
        (om/build menu-entry-component
          (get-in app [:main-menu-items :new-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :save-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :load-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :export-document])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :export-document-spritesheet])
          {:init-state {:clickchan clickchan}})
        (om/build menu-entry-component
          (get-in app [:main-menu-items :export-document-animation])
          {:init-state {:clickchan clickchan}})
;;         (om/build menu-entry-component
;;           (get-in app [:main-menu-items :export-history-animation])
;;           {:init-state {:clickchan clickchan}})
        ))))

Comment out code for exporting history animation


(ns oc.storage.api.digest
  "Liberator API for digest resource."
  (:require [if-let.core :refer (if-let*)]
            [compojure.core :as compojure :refer (OPTIONS GET)]
            [liberator.core :refer (defresource by-method)]
            [oc.lib.slugify :as slugify]
            [oc.lib.db.pool :as pool]
            [oc.lib.api.common :as api-common]
            [oc.storage.config :as config]
            [oc.storage.api.activity :as activity-api]
            [oc.storage.api.access :as access]
            [oc.storage.resources.activity :as activity-res]
            [oc.storage.resources.common :as common]
            [oc.storage.representations.media-types :as mt]
            [oc.storage.representations.digest :as digest-rep]
            [oc.storage.resources.org :as org-res]
            [oc.storage.urls.org :as org-urls]
            [oc.lib.change.resources.read :as read]))

;; ----- Helpers -----

(defn assemble-digest
  "Assemble the requested (by the params) entries for the provided org to populate the digest response."
  [conn {start :start direction :direction limit :limit} org boards-by-uuid user-id]
  (let [follow-data (activity-api/follow-parameters-map user-id (:uuid org))

        follow-following-data (assoc follow-data :following true)
        following-data (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start direction limit (vals boards-by-uuid) follow-following-data {})
        following-count (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start :after 0 (vals boards-by-uuid) follow-following-data {:count true})

        unfollow-limit (- limit (count following-data))
        follow-unfollowing-data (assoc follow-data :unfollowing true)
        load-unfollow? (and (pos? unfollow-limit)
                            (seq (:unfollow-board-uuids)))
        unfollowing-data (if load-unfollow?
                           (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start direction unfollow-limit (vals boards-by-uuid) follow-unfollowing-data {})
                           [])
        unfollowing-count (if load-unfollow?
                            (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start :after 0 (vals boards-by-uuid) follow-unfollowing-data {:count true})
                            0)

        user-reads (read/retrieve-by-user-org config/dynamodb-opts user-id (:uuid org))
        user-reads-map (zipmap (map :item-uuid user-reads) user-reads)]
    ;; Give each activity its board name
    (-> {:start start
         :direction direction
         :total-following-count following-count
         :total-unfollowing-count unfollowing-count}
        (assoc :following (map (fn [entry]
                                 (let [board (boards-by-uuid (:board-uuid entry))]
                                   (merge entry {:board-slug (:slug board)
                                                 :board-access (:access board)
                                                 :board-name (:name board)
                                                 :last-read-at (get-in user-reads-map [(:uuid entry) :read-at])})))
                               following-data))
        (assoc :unfollowing (map (fn [entry]
                                   (let [board (boards-by-uuid (:board-uuid entry))]
                                     (merge entry {:board-slug (:slug board)
                                                   :board-access (:access board)
                                                   :board-name (:name board)
                                                  :last-read-at (get-in user-reads-map [(:uuid entry) :read-at])})))
                                 unfollowing-data)))))

;; ----- Resources - see: http://clojure-liberator.github.io/liberator/assets/img/decision-graph.svg

;; A resource to retrieve the digest data of a particular Org
(defresource digest [conn slug]
  (api-common/open-company-authenticated-resource config/passphrase) ; verify validity and presence of required JWToken

  :allowed-methods [:options :get]

  ;; Media type client accepts
  :available-media-types [mt/entry-collection-media-type]
  :handle-not-acceptable (api-common/only-accept 406 mt/entry-collection-media-type)

  ;; Authorization
  :allowed? (by-method {
    :options true
    :get (fn [ctx] (access/allow-members conn slug (:user ctx)))})

  ;; Check the request
  :malformed? (fn [ctx]
                (let [ctx-params (-> ctx :request :params)
                      start (:start ctx-params)
                      ;; Start is always set for digest
                      valid-start? (and (seq start) (common/sort-value? start))
                      direction (keyword (:direction ctx-params))
                      ;; direction is always set to after for digest
                      valid-direction? (= direction :after)]
                  (not (and valid-start? valid-direction?))))

  ;; Existentialism
  :exists? (fn [ctx] (if-let* [_slug? (slugify/valid-slug? slug)
                               user (:user ctx)
                               org (or (:existing-org ctx) (org-res/get-org conn slug))
                               boards-by-uuid (activity-api/user-boards-by-uuid conn user org)]
                        {:existing-org (api-common/rep org)
                         :boards-by-uuid (api-common/rep boards-by-uuid)}
                        false))

  ;; Responses
  :handle-ok (fn [ctx] (let [user (:user ctx)
                             user-id (:user-id user)
                             org (:existing-org ctx)
                             boards-by-uuid (:boards-by-uuid ctx)
                             ctx-params (-> ctx :request :params)
                             params (-> ctx-params
                                     (dissoc :slug)
                                     (assoc :limit 10) ;; use a limit of 10 posts since digest can't be too long anyway
                                     (update :direction keyword)) ; always set to after)
                             results (assemble-digest conn params org boards-by-uuid user-id)]
                          (digest-rep/render-digest params org "digest" results boards-by-uuid user))))

;; ----- Routes -----

(defn routes [sys]
  (let [db-pool (-> sys :db-pool :pool)]
    (compojure/routes
      ;; Digest endpoint
      (OPTIONS (org-urls/digest ":slug") [slug] (pool/with-pool [conn db-pool] (digest conn slug)))
      (OPTIONS (str (org-urls/digest ":slug") "/") [slug] (pool/with-pool [conn db-pool] (digest conn slug)))
      (GET (org-urls/digest ":slug") [slug] (pool/with-pool [conn db-pool] (digest conn slug)))
      (GET (str (org-urls/digest ":slug") "/") [slug] (pool/with-pool [conn db-pool] (digest conn slug))))))

(ns oc.storage.api.digest
  "Liberator API for digest resource."
  (:require [if-let.core :refer (if-let*)]
            [compojure.core :as compojure :refer (OPTIONS GET)]
            [liberator.core :refer (defresource by-method)]
            [oc.lib.slugify :as slugify]
            [oc.lib.db.pool :as pool]
            [oc.lib.api.common :as api-common]
            [oc.storage.config :as config]
            [oc.storage.api.activity :as activity-api]
            [oc.storage.api.access :as access]
            [oc.storage.resources.activity :as activity-res]
            [oc.storage.resources.common :as common]
            [oc.storage.representations.media-types :as mt]
            [oc.storage.representations.digest :as digest-rep]
            [oc.storage.resources.org :as org-res]
            [oc.storage.urls.org :as org-urls]
            [oc.lib.change.resources.read :as read]))

;; ----- Helpers -----

(defn assemble-digest
  "Assemble the requested (by the params) entries for the provided org to populate the digest response."
  [conn {start :start direction :direction limit :limit} org boards-by-uuid user-id]
  (let [follow-data (activity-api/follow-parameters-map user-id (:uuid org))

        follow-following-data (assoc follow-data :following true)
        following-data (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start direction limit (vals boards-by-uuid) follow-following-data {})
        following-count (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start :after 0 (vals boards-by-uuid) follow-following-data {:count true})

        unfollow-limit (- limit (count following-data))
        follow-unfollowing-data (assoc follow-data :unfollowing true)
        load-unfollow? (and (pos? unfollow-limit)
                            (seq (:unfollow-board-uuids follow-data)))
        unfollowing-data (if load-unfollow?
                           (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start direction unfollow-limit (vals boards-by-uuid) follow-unfollowing-data {})
                           [])
        unfollowing-count (if load-unfollow?
                            (activity-res/paginated-entries-for-digest conn (:uuid org) :desc start :after 0 (vals boards-by-uuid) follow-unfollowing-data {:count true})
                            0)

        user-reads (read/retrieve-by-user-org config/dynamodb-opts user-id (:uuid org))
        user-reads-map (zipmap (map :item-uuid user-reads) user-reads)]
    ;; Give each activity its board name
    (-> {:start start
         :direction direction
         :total-following-count following-count
         :total-unfollowing-count unfollowing-count}
        (assoc :following (map (fn [entry]
                                 (let [board (boards-by-uuid (:board-uuid entry))]
                                   (merge entry {:board-slug (:slug board)
                                                 :board-access (:access board)
                                                 :board-name (:name board)
                                                 :last-read-at (get-in user-reads-map [(:uuid entry) :read-at])})))
                               following-data))
        (assoc :unfollowing (map (fn [entry]
                                   (let [board (boards-by-uuid (:board-uuid entry))]
                                     (merge entry {:board-slug (:slug board)
                                                   :board-access (:access board)
                                                   :board-name (:name board)
                                                  :last-read-at (get-in user-reads-map [(:uuid entry) :read-at])})))
                                 unfollowing-data)))))

;; ----- Resources - see: http://clojure-liberator.github.io/liberator/assets/img/decision-graph.svg

;; A resource to retrieve the digest data of a particular Org
(defresource digest [conn slug]
  (api-common/open-company-authenticated-resource config/passphrase) ; verify validity and presence of required JWToken

  :allowed-methods [:options :get]

  ;; Media type client accepts
  :available-media-types [mt/entry-collection-media-type]
  :handle-not-acceptable (api-common/only-accept 406 mt/entry-collection-media-type)

  ;; Authorization
  :allowed? (by-method {
    :options true
    :get (fn [ctx] (access/allow-members conn slug (:user ctx)))})

  ;; Check the request
  :malformed? (fn [ctx]
                (let [ctx-params (-> ctx :request :params)
                      start (:start ctx-params)
                      ;; Start is always set for digest
                      valid-start? (and (seq start) (common/sort-value? start))
                      direction (keyword (:direction ctx-params))
                      ;; direction is always set to after for digest
                      valid-direction? (= direction :after)]
                  (not (and valid-start? valid-direction?))))

  ;; Existentialism
  :exists? (fn [ctx] (if-let* [_slug? (slugify/valid-slug? slug)
                               user (:user ctx)
                               org (or (:existing-org ctx) (org-res/get-org conn slug))
                               boards-by-uuid (activity-api/user-boards-by-uuid conn user org)]
                        {:existing-org (api-common/rep org)
                         :boards-by-uuid (api-common/rep boards-by-uuid)}
                        false))

  ;; Responses
  :handle-ok (fn [ctx] (let [user (:user ctx)
                             user-id (:user-id user)
                             org (:existing-org ctx)
                             boards-by-uuid (:boards-by-uuid ctx)
                             ctx-params (-> ctx :request :params)
                             params (-> ctx-params
                                     (dissoc :slug)
                                     (assoc :limit 10) ;; use a limit of 10 posts since digest can't be too long anyway
                                     (update :direction keyword)) ; always set to after)
                             results (assemble-digest conn params org boards-by-uuid user-id)]
                          (digest-rep/render-digest params org "digest" results boards-by-uuid user))))

;; ----- Routes -----

(defn routes [sys]
  (let [db-pool (-> sys :db-pool :pool)]
    (compojure/routes
      ;; Digest endpoint
      (OPTIONS (org-urls/digest ":slug") [slug] (pool/with-pool [conn db-pool] (digest conn slug)))
      (OPTIONS (str (org-urls/digest ":slug") "/") [slug] (pool/with-pool [conn db-pool] (digest conn slug)))
      (GET (org-urls/digest ":slug") [slug] (pool/with-pool [conn db-pool] (digest conn slug)))
      (GET (str (org-urls/digest ":slug") "/") [slug] (pool/with-pool [conn db-pool] (digest conn slug))))))

Fix digest api.

Fix digest api.


(ns refactor-nrepl.config)

;; NOTE: Update the readme whenever this map is changed
(def ^:dynamic *config*
  {
   ;; Verbose setting for debugging.  The biggest effect this has is
   ;; to not catch any exceptions to provide meaningful error
   ;; messages for the client.

   :debug false

   ;; When true `clean-ns` will remove unused symbols, otherwise just
   ;; sort etc
   :prune-ns-form true

   ;; Should `clean-ns` favor prefix forms in the ns macro?
   :prefix-rewriting true

   ;; Some libspecs are side-effecting and shouldn't be pruned by `clean-ns`
   ;; even if they're otherwise unused.
   ;; This seq of strings will be used as regexp patterns to match
   ;; against the libspec name.
   :libspec-whitelist ["^cljsjs"]

   ;; Regexes matching paths that are to be ignored
   :ignore-paths []
   })

(defn opts-from-msg [msg]
  (into {}
        (map (fn [[k v]] (cond
                           (and (string? v) (= v "true")) [k true]
                           (string? v) [k false]
                           :else [k v]))
             (select-keys msg (keys *config*)))))

(defmacro with-config
  "Merge the override map with the default config and execute body."
  [overrides & body]
  `(binding [*config* (merge *config* (opts-from-msg ~overrides))]
     ~@body))

(ns refactor-nrepl.config)

;; NOTE: Update the readme whenever this map is changed
(def ^:dynamic *config*
  {
   ;; Verbose setting for debugging.  The biggest effect this has is
   ;; to not catch any exceptions to provide meaningful error
   ;; messages for the client.

   :debug false

   ;; When true `clean-ns` will remove unused symbols, otherwise just
   ;; sort etc
   :prune-ns-form true

   ;; Should `clean-ns` favor prefix forms in the ns macro?
   :prefix-rewriting true

   ;; Some libspecs are side-effecting and shouldn't be pruned by `clean-ns`
   ;; even if they're otherwise unused.
   ;; This seq of strings will be used as regexp patterns to match
   ;; against the libspec name.
   :libspec-whitelist ["^cljsjs"]

   ;; Regexes matching paths that are to be ignored
   :ignore-paths []
   })

(defn opts-from-msg [msg]
  (into {}
        (map (fn [[k v]] (cond
                           (and (string? v) (= v "true")) [k true]
                           (and (string? v) (= v "false")) [k false]
                           :else [k v]))
             (update (select-keys msg (keys *config*))
                     :ignore-paths
                     (partial map re-pattern)))))

(defmacro with-config
  "Merge the override map with the default config and execute body."
  [overrides & body]
  `(binding [*config* (merge *config* (opts-from-msg ~overrides))]
     ~@body))

Fix regex coercion in client config

Fix regex coercion in client config


(ns kanban.components.boards-menu
  (:require [goog.object :as gobj]
            [om.next :as om :refer-macros [defui]]
            [om.dom :as dom]))

(defui BoardMenuItem
  static om/Ident
  (ident [this props]
    [:board/by-id (:id props)])
  static om/IQuery
  (query [this]
    [:id :name])
  Object
  (render [this]
    (dom/li nil
      (let [{:keys [name activate-fn]} (om/props this)]
        (dom/a #js {:onClick #(activate-fn (om/get-ident this))}
          name)))))

(def board-menu-item (om/factory BoardMenuItem {:keyfn :id}))

(defui BoardsMenu
  Object
  (render [this]
    (dom/div #js {:className "header-menu"}
      (dom/a nil "Boards")
      (dom/ul nil
        (let [{:keys [boards activate-fn]} (om/props this)]
          (for [board boards]
            (board-menu-item
              (assoc board :activate-fn activate-fn))))))))

(def boards-menu (om/factory BoardsMenu))

(ns kanban.components.boards-menu
  (:require [goog.object :as gobj]
            [om.next :as om :refer-macros [defui]]
            [om.dom :as dom]))

(defui BoardMenuItem
  static om/Ident
  (ident [this props]
    [:board/by-id (:id props)])
  static om/IQuery
  (query [this]
    [:id :name])
  Object
  (render [this]
    (dom/li nil
      (let [{:keys [name activate-fn]} (om/props this)]
        (dom/a #js {:onClick #(activate-fn (om/get-ident this))}
          name)))))

(def board-menu-item (om/factory BoardMenuItem {:keyfn :id}))

(defui BoardsMenu
  Object
  (render [this]
    (dom/div #js {:className "header-menu"}
      (dom/a nil "▾ Boards")
      (dom/ul nil
        (let [{:keys [boards activate-fn]} (om/props this)]
          (for [board boards]
            (board-menu-item
              (assoc board :activate-fn activate-fn))))))))

(def boards-menu (om/factory BoardsMenu))

Add a triangle symbol to the board menu to make its purpose obvious


(defproject {{ns-name}} "0.1.0-SNAPSHOT"
  :dependencies [[org.clojure/clojure "1.8.0"]
                 [org.clojure/clojurescript "1.9.229"]
                 [reagent "0.6.0"]
                 [binaryage/devtools "0.8.2"]
                 [re-frame "0.8.0"]{{#re-com?}}
                 [org.clojure/core.async "0.2.391"]
                 [re-com "0.8.3"]{{/re-com?}}{{#routes?}}
                 [secretary "1.2.3"]{{/routes?}}{{#garden?}}
                 [garden "1.3.2"]
                 [ns-tracker "0.3.0"]{{/garden?}}{{#handler?}}
                 [compojure "1.5.0"]
                 [yogthos/config "0.8"]
                 [ring "1.4.0"]{{/handler?}}]

  :plugins [[lein-cljsbuild "1.1.4"]{{#garden?}}
            [lein-garden "0.2.8"]{{/garden?}}{{#less?}}
            [lein-less "1.7.5"]{{/less?}}]

  :min-lein-version "2.5.3"

  :source-paths ["src/clj"]

  :clean-targets ^{:protect false} ["resources/public/js/compiled" "target"{{#test?}}
                                    "test/js"{{/test?}}{{#garden?}}
                                    "resources/public/css"{{/garden?}}]

  :figwheel {:css-dirs ["resources/public/css"]{{#handler?}}
             :ring-handler {{name}}.handler/dev-handler{{/handler?}}}
{{#garden?}}

  :garden {:builds [{:id           "screen"
                     :source-paths ["src/clj"]
                     :stylesheet   {{name}}.css/screen
                     :compiler     {:output-to     "resources/public/css/screen.css"
                                    :pretty-print? true}}]}
{{/garden?}}{{#less?}}
  :less {:source-paths ["less"]
         :target-path  "resources/public/css"}
{{/less?}}{{#cider?}}
  :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}
{{/cider?}}

  :profiles
  {:dev
   {:dependencies [{{#cider?}}
                   [figwheel-sidecar "0.5.7"]
                   [com.cemerick/piggieback "0.2.1"]{{/cider?}}]

    :plugins      [[lein-figwheel "0.5.7"]{{#test?}}
                   [lein-doo "0.1.7"]{{/test?}}{{#cider?}}
                   [cider/cider-nrepl "0.13.0"]{{/cider?}}]
    }}

  :cljsbuild
  {:builds
   [{:id           "dev"
     :source-paths ["src/cljs"]
     :figwheel     {:on-jsload "{{name}}.core/mount-root"}
     :compiler     {:main                 {{name}}.core
                    :output-to            "resources/public/js/compiled/app.js"
                    :output-dir           "resources/public/js/compiled/out"
                    :asset-path           "js/compiled/out"
                    :source-map-timestamp true}}

    {:id           "min"
     :source-paths ["src/cljs"]{{#handler?}}
     :jar true{{/handler?}}
     :compiler     {:main            {{name}}.core
                    :output-to       "resources/public/js/compiled/app.js"
                    :optimizations   :advanced
                    :closure-defines {goog.DEBUG false}
                    :pretty-print    false}}
    {{#test?}}
    {:id           "test"
     :source-paths ["src/cljs" "test/cljs"]
     :compiler     {:output-to     "resources/public/js/compiled/test.js"
                    :main          {{name}}.runner
                    :optimizations :none}}{{/test?}}
    ]}
{{#handler?}}

  :main {{ns-name}}.server

  :aot [{{ns-name}}.server]

  :uberjar-name "{{name}}.jar"

  :prep-tasks [["cljsbuild" "once" "min"]{{{prep-garden}}}{{{prep-less}}} "compile"]{{/handler?}}
  )

(defproject {{ns-name}} "0.1.0-SNAPSHOT"
  :dependencies [[org.clojure/clojure "1.8.0"]
                 [org.clojure/clojurescript "1.9.229"]
                 [reagent "0.6.0"]
                 [binaryage/devtools "0.8.2"]
                 [re-frame "0.8.0"]{{#re-com?}}
                 [org.clojure/core.async "0.2.391"]
                 [re-com "0.8.3"]{{/re-com?}}{{#routes?}}
                 [secretary "1.2.3"]{{/routes?}}{{#garden?}}
                 [garden "1.3.2"]
                 [ns-tracker "0.3.0"]{{/garden?}}{{#handler?}}
                 [compojure "1.5.0"]
                 [yogthos/config "0.8"]
                 [ring "1.4.0"]{{/handler?}}]

  :plugins [[lein-cljsbuild "1.1.4"]{{#garden?}}
            [lein-garden "0.2.8"]{{/garden?}}{{#less?}}
            [lein-less "1.7.5"]{{/less?}}]

  :min-lein-version "2.5.3"

  :source-paths ["src/clj"]

  :clean-targets ^{:protect false} ["resources/public/js/compiled" "target"{{#test?}}
                                    "test/js"{{/test?}}{{#garden?}}
                                    "resources/public/css"{{/garden?}}]

  :figwheel {:css-dirs ["resources/public/css"]{{#handler?}}
             :ring-handler {{name}}.handler/dev-handler{{/handler?}}}
{{#garden?}}

  :garden {:builds [{:id           "screen"
                     :source-paths ["src/clj"]
                     :stylesheet   {{name}}.css/screen
                     :compiler     {:output-to     "resources/public/css/screen.css"
                                    :pretty-print? true}}]}
{{/garden?}}{{#less?}}
  :less {:source-paths ["less"]
         :target-path  "resources/public/css"}
{{/less?}}{{#cider?}}
  :repl-options {:nrepl-middleware [cemerick.piggieback/wrap-cljs-repl]}
{{/cider?}}

  :profiles
  {:dev
   {:dependencies [{{#cider?}}
                   [figwheel-sidecar "0.5.7"]
                   [com.cemerick/piggieback "0.2.1"]{{/cider?}}]

    :plugins      [[lein-figwheel "0.5.7"]{{#test?}}
                   [lein-doo "0.1.7"]{{/test?}}{{#cider?}}
                   [cider/cider-nrepl "0.13.0"]{{/cider?}}]
    }}

  :cljsbuild
  {:builds
   [{:id           "dev"
     :source-paths ["src/cljs"]
     :figwheel     {:on-jsload "{{name}}.core/mount-root"}
     :compiler     {:main                 {{name}}.core
                    :output-to            "resources/public/js/compiled/app.js"
                    :output-dir           "resources/public/js/compiled/out"
                    :asset-path           "js/compiled/out"
                    :source-map-timestamp true}}

    {:id           "min"
     :source-paths ["src/cljs"]{{#handler?}}
     :jar true{{/handler?}}
     :compiler     {:main            {{name}}.core
                    :output-to       "resources/public/js/compiled/app.js"
                    :optimizations   :advanced
                    :closure-defines {goog.DEBUG false}
                    :pretty-print    false}}
    {{#test?}}
    {:id           "test"
     :source-paths ["src/cljs" "test/cljs"]
     :compiler     {:main          {{name}}.runner
                    :output-to     "resources/public/js/compiled/test.js"
                    :output-dir    "resources/public/js/compiled/test/out"
                    :optimizations :none}}{{/test?}}
    ]}
{{#handler?}}

  :main {{ns-name}}.server

  :aot [{{ns-name}}.server]

  :uberjar-name "{{name}}.jar"

  :prep-tasks [["cljsbuild" "once" "min"]{{{prep-garden}}}{{{prep-less}}} "compile"]{{/handler?}}
  )

Set output-dir for tests in project.clj (#36)

Fixes figwheel error about unique output-dir, fixes #33