(ns metabase.api.card-test
  "Tests for /api/card endpoints."
  (:require [expectations :refer :all]
            [metabase.db :refer :all]
            [metabase.http-client :refer :all]
            (metabase.models [card :refer [Card]]
                             [common :as common]
                             [database :refer [Database]])
            [metabase.test.data :refer :all]
            [metabase.test.data.users :refer :all]
            [metabase.test.util :refer [match-$ expect-eval-actual-first random-name with-temp]]
            [metabase.test.util.q :refer [Q-expand]]))

;; # CARD LIFECYCLE

;; ## Helper fns
(defn post-card [card-name]
  ((user->client :rasta) :post 200 "card" {:name                   card-name
                                           :public_perms           0
                                           :can_read               true
                                           :can_write              true
                                           :display                "scalar"
                                           :dataset_query          (Q-expand aggregate count of categories)
                                           :visualization_settings {:global {:title nil}}}))

;; ## GET /api/card
;; Filter cards by database
(expect [true
         false
         true]
  (with-temp Database [{dbid :id} {:name    (random-name)
                                    :engine  :h2
                                    :details {}}]
    (with-temp Card [{id1 :id} {:name                   (random-name)
                                :public_perms           common/perms-none
                                :creator_id             (user->id :crowberto)
                                :display                :table
                                :dataset_query          {}
                                :visualization_settings {}
                                :database_id            (db-id)}]
      (with-temp Card [{id2 :id} {:name                   (random-name)
                                  :public_perms           common/perms-none
                                  :creator_id             (user->id :crowberto)
                                  :display                :table
                                  :dataset_query          {}
                                  :visualization_settings {}
                                  :database_id            dbid}]
        (let [card-returned? (fn [database-id card-id]
                               (contains? (->> ((user->client :crowberto) :get 200 "card" :f :database :id database-id)
                                               (map :id)
                                               set)
                                          card-id))]
          [(card-returned? (db-id) id1)
           (card-returned? dbid id1)
           (card-returned? dbid id2)])))))

;; Make sure `id` is required when `f` is :database
(expect {:errors {:id "id is required parameter when filter mode is 'database'"}}
  ((user->client :crowberto) :get 400 "card" :f :database))

;; Filter cards by table
(expect [true
         false
         true]
  (with-temp Card [{id1 :id} {:name                   (random-name)
                              :public_perms           common/perms-none
                              :creator_id             (user->id :crowberto)
                              :display                :table
                              :dataset_query          {}
                              :visualization_settings {}
                              :table_id               1}]
    (with-temp Card [{id2 :id} {:name                   (random-name)
                                :public_perms           common/perms-none
                                :creator_id             (user->id :crowberto)
                                :display                :table
                                :dataset_query          {}
                                :visualization_settings {}
                                :table_id               2}]
      (let [card-returned? (fn [table-id card-id]
                             (contains? (->> ((user->client :crowberto) :get 200 "card" :f :table :id table-id)
                                             (map :id)
                                             set)
                                        card-id))]
      [(card-returned? 1 id1)
       (card-returned? 2 id1)
       (card-returned? 2 id2)]))))

;; Make sure `id` is required when `f` is :table
(expect {:errors {:id "id is required parameter when filter mode is 'table'"}}
  ((user->client :crowberto) :get 400 "card" :f :table))

;; Check that only the creator of a private Card can see it
(expect [true
         false]
  (with-temp Card [{:keys [id]} {:name                   (random-name)
                                 :public_perms           common/perms-none
                                 :creator_id             (user->id :crowberto)
                                 :display                :table
                                 :dataset_query          {}
                                 :visualization_settings {}}]
    (let [can-see-card? (fn [user]
                          (contains? (->> ((user->client user) :get 200 "card" :f :all)
                                          (map :id)
                                          set)
                                     id))]
      [(can-see-card? :crowberto)
       (can-see-card? :rasta)])))

;; ## POST /api/card
;; Test that we can make a card
(let [card-name (random-name)]
  (expect-eval-actual-first (match-$ (sel :one Card :name card-name)
                              {:description nil
                               :organization_id nil
                               :name card-name
                               :creator_id (user->id :rasta)
                               :updated_at $
                               :dataset_query (Q-expand aggregate count of categories)
                               :id $
                               :display "scalar"
                               :visualization_settings {:global {:title nil}}
                               :public_perms 0
                               :created_at $
                               :database_id (db-id)
                               :table_id (id :categories)
                               :query_type "query"})
    (post-card card-name)))

;; ## GET /api/card/:id
;; Test that we can fetch a card
(let [card-name (random-name)]
  (expect-eval-actual-first
      (match-$ (sel :one Card :name card-name)
        {:description nil
         :can_read true
         :can_write true
         :organization_id nil
         :dashboard_count 0
         :name card-name
         :creator_id (user->id :rasta)
         :creator (match-$ (fetch-user :rasta)
                    {:common_name "Rasta Toucan",
                     :is_superuser false,
                     :last_login $,
                     :last_name "Toucan",
                     :first_name "Rasta",
                     :date_joined $,
                     :email "rasta@metabase.com",
                     :id $})
         :updated_at $
         :dataset_query (Q-expand aggregate count of categories)
         :id $
         :display "scalar"
         :visualization_settings {:global {:title nil}}
         :public_perms 0
         :created_at $
         :database_id (db-id)
         :table_id (id :categories)
         :query_type "query"})
    (let [{:keys [id]} (post-card card-name)]
      ((user->client :rasta) :get 200 (format "card/%d" id)))))

;; ## PUT /api/card/:id
;; Test that we can edit a Card
(let [card-name (random-name)
      updated-name (random-name)]
  (expect-eval-actual-first
      [card-name
       updated-name]
    (let [{id :id} (post-card card-name)]
      [(sel :one :field [Card :name] :id id)
       (do ((user->client :rasta) :put 200 (format "card/%d" id) {:name updated-name})
           (sel :one :field [Card :name] :id id))])))

;; ## DELETE /api/card/:id
;; Check that we can delete a card
(expect-eval-actual-first nil
  (let [{:keys [id]} (post-card (random-name))]
    ((user->client :rasta) :delete 204 (format "card/%d" id))
    (Card id)))

;; # CARD FAVORITE STUFF

;; Helper Functions
(defn fave? [card]
  ((user->client :rasta) :get 200 (format "card/%d/favorite" (:id card))))

(defn fave [card]
  ((user->client :rasta) :post 200 (format "card/%d/favorite" (:id card))))

(defn unfave [card]
  ((user->client :rasta) :delete 204 (format "card/%d/favorite" (:id card))))

;; ## GET /api/card/:id/favorite
;; Can we see if a Card is a favorite ?
(expect-let [card (post-card (random-name))]
  {:favorite false}
  (fave? card))

;; ## POST /api/card/:id/favorite
;; Can we favorite a card?
(expect-let [card (post-card (random-name))]
  [{:favorite false}
   {:favorite true}]
  [(fave? card)
   (do (fave card)
       (fave? card))])

;; DELETE /api/card/:id/favorite
;; Can we unfavorite a card?
(expect-let [card (post-card (random-name))
             get-fave? ((user->client :rasta) :get (format "card/%d/favorite" (:id card)))]
  [{:favorite false}
   {:favorite true}
   {:favorite false}]
  [(fave? card)
   (do (fave card)
       (fave? card))
   (do (unfave card)
       (fave? card))])

(ns metabase.api.card-test
  "Tests for /api/card endpoints."
  (:require [expectations :refer :all]
            [metabase.db :refer :all]
            [metabase.http-client :refer :all]
            (metabase.models [card :refer [Card]]
                             [common :as common]
                             [database :refer [Database]])
            [metabase.test.data :refer :all]
            [metabase.test.data.users :refer :all]
            [metabase.test.util :refer [match-$ expect-eval-actual-first random-name with-temp]]
            [metabase.test.util.q :refer [Q-expand]]))

;; # CARD LIFECYCLE

;; ## Helper fns
(defn post-card [card-name]
  ((user->client :rasta) :post 200 "card" {:name                   card-name
                                           :public_perms           0
                                           :can_read               true
                                           :can_write              true
                                           :display                "scalar"
                                           :dataset_query          (Q-expand aggregate count of categories)
                                           :visualization_settings {:global {:title nil}}}))

;; ## GET /api/card
;; Filter cards by database
(expect [true
         false
         true]
  (with-temp Database [{dbid :id} {:name    (random-name)
                                    :engine  :h2
                                    :details {}}]
    (with-temp Card [{id1 :id} {:name                   (random-name)
                                :public_perms           common/perms-none
                                :creator_id             (user->id :crowberto)
                                :display                :table
                                :dataset_query          {}
                                :visualization_settings {}
                                :database_id            (db-id)}]
      (with-temp Card [{id2 :id} {:name                   (random-name)
                                  :public_perms           common/perms-none
                                  :creator_id             (user->id :crowberto)
                                  :display                :table
                                  :dataset_query          {}
                                  :visualization_settings {}
                                  :database_id            dbid}]
        (let [card-returned? (fn [database-id card-id]
                               (contains? (->> ((user->client :crowberto) :get 200 "card" :f :database :model_id database-id)
                                               (map :id)
                                               set)
                                          card-id))]
          [(card-returned? (db-id) id1)
           (card-returned? dbid id1)
           (card-returned? dbid id2)])))))

;; Make sure `id` is required when `f` is :database
(expect {:errors {:id "id is required parameter when filter mode is 'database'"}}
  ((user->client :crowberto) :get 400 "card" :f :database))

;; Filter cards by table
(expect [true
         false
         true]
  (with-temp Card [{id1 :id} {:name                   (random-name)
                              :public_perms           common/perms-none
                              :creator_id             (user->id :crowberto)
                              :display                :table
                              :dataset_query          {}
                              :visualization_settings {}
                              :table_id               1}]
    (with-temp Card [{id2 :id} {:name                   (random-name)
                                :public_perms           common/perms-none
                                :creator_id             (user->id :crowberto)
                                :display                :table
                                :dataset_query          {}
                                :visualization_settings {}
                                :table_id               2}]
      (let [card-returned? (fn [table-id card-id]
                             (contains? (->> ((user->client :crowberto) :get 200 "card" :f :table :model_id table-id)
                                             (map :id)
                                             set)
                                        card-id))]
      [(card-returned? 1 id1)
       (card-returned? 2 id1)
       (card-returned? 2 id2)]))))

;; Make sure `id` is required when `f` is :table
(expect {:errors {:id "id is required parameter when filter mode is 'table'"}}
  ((user->client :crowberto) :get 400 "card" :f :table))

;; Check that only the creator of a private Card can see it
(expect [true
         false]
  (with-temp Card [{:keys [id]} {:name                   (random-name)
                                 :public_perms           common/perms-none
                                 :creator_id             (user->id :crowberto)
                                 :display                :table
                                 :dataset_query          {}
                                 :visualization_settings {}}]
    (let [can-see-card? (fn [user]
                          (contains? (->> ((user->client user) :get 200 "card" :f :all)
                                          (map :id)
                                          set)
                                     id))]
      [(can-see-card? :crowberto)
       (can-see-card? :rasta)])))

;; ## POST /api/card
;; Test that we can make a card
(let [card-name (random-name)]
  (expect-eval-actual-first (match-$ (sel :one Card :name card-name)
                              {:description nil
                               :organization_id nil
                               :name card-name
                               :creator_id (user->id :rasta)
                               :updated_at $
                               :dataset_query (Q-expand aggregate count of categories)
                               :id $
                               :display "scalar"
                               :visualization_settings {:global {:title nil}}
                               :public_perms 0
                               :created_at $
                               :database_id (db-id)
                               :table_id (id :categories)
                               :query_type "query"})
    (post-card card-name)))

;; ## GET /api/card/:id
;; Test that we can fetch a card
(let [card-name (random-name)]
  (expect-eval-actual-first
      (match-$ (sel :one Card :name card-name)
        {:description nil
         :can_read true
         :can_write true
         :organization_id nil
         :dashboard_count 0
         :name card-name
         :creator_id (user->id :rasta)
         :creator (match-$ (fetch-user :rasta)
                    {:common_name "Rasta Toucan",
                     :is_superuser false,
                     :last_login $,
                     :last_name "Toucan",
                     :first_name "Rasta",
                     :date_joined $,
                     :email "rasta@metabase.com",
                     :id $})
         :updated_at $
         :dataset_query (Q-expand aggregate count of categories)
         :id $
         :display "scalar"
         :visualization_settings {:global {:title nil}}
         :public_perms 0
         :created_at $
         :database_id (db-id)
         :table_id (id :categories)
         :query_type "query"})
    (let [{:keys [id]} (post-card card-name)]
      ((user->client :rasta) :get 200 (format "card/%d" id)))))

;; ## PUT /api/card/:id
;; Test that we can edit a Card
(let [card-name (random-name)
      updated-name (random-name)]
  (expect-eval-actual-first
      [card-name
       updated-name]
    (let [{id :id} (post-card card-name)]
      [(sel :one :field [Card :name] :id id)
       (do ((user->client :rasta) :put 200 (format "card/%d" id) {:name updated-name})
           (sel :one :field [Card :name] :id id))])))

;; ## DELETE /api/card/:id
;; Check that we can delete a card
(expect-eval-actual-first nil
  (let [{:keys [id]} (post-card (random-name))]
    ((user->client :rasta) :delete 204 (format "card/%d" id))
    (Card id)))

;; # CARD FAVORITE STUFF

;; Helper Functions
(defn fave? [card]
  ((user->client :rasta) :get 200 (format "card/%d/favorite" (:id card))))

(defn fave [card]
  ((user->client :rasta) :post 200 (format "card/%d/favorite" (:id card))))

(defn unfave [card]
  ((user->client :rasta) :delete 204 (format "card/%d/favorite" (:id card))))

;; ## GET /api/card/:id/favorite
;; Can we see if a Card is a favorite ?
(expect-let [card (post-card (random-name))]
  {:favorite false}
  (fave? card))

;; ## POST /api/card/:id/favorite
;; Can we favorite a card?
(expect-let [card (post-card (random-name))]
  [{:favorite false}
   {:favorite true}]
  [(fave? card)
   (do (fave card)
       (fave? card))])

;; DELETE /api/card/:id/favorite
;; Can we unfavorite a card?
(expect-let [card (post-card (random-name))
             get-fave? ((user->client :rasta) :get (format "card/%d/favorite" (:id card)))]
  [{:favorite false}
   {:favorite true}
   {:favorite false}]
  [(fave? card)
   (do (fave card)
       (fave? card))
   (do (unfave card)
       (fave? card))])

update unit test to account for the fact that we changed the query param for specifying the model id.


(ns shadow.cljs.devtools.server.nrepl-impl
  (:refer-clojure :exclude (send))
  (:require [shadow.cljs.devtools.api :as api]
            [clojure.core.async :as async]
            [shadow.jvm-log :as log]
            [shadow.cljs.devtools.server.repl-impl :as repl-impl]
            [shadow.build.warnings :as warnings]
            [shadow.cljs.devtools.errors :as errors]
            [shadow.cljs.repl :as repl]
            [shadow.cljs.devtools.server.worker :as worker]
            [shadow.cljs.devtools.config :as config])
  (:import [java.io StringReader]))

(defn do-repl-quit [session]
  (let [quit-var #'api/*nrepl-quit-signal*
        quit-chan (get @session quit-var)]

    (when quit-chan
      (async/close! quit-chan))

    (swap! session assoc
      quit-var (async/chan)
      #'*ns* (get @session #'api/*nrepl-clj-ns*)
      #'api/*nrepl-cljs* nil
      #'cider.piggieback/*cljs-compiler-env* nil
      #'cemerick.piggieback/*cljs-compiler-env* nil)))

(defn handle-repl-result [worker {::keys [send] :keys [session] :as msg} result]
  (log/debug ::eval-result {:result result})

  (let [build-state (repl-impl/worker-build-state worker)
        repl-ns (-> build-state :repl-state :current-ns)]

    (case (:type result)
      :repl/results
      (let [{:keys [results]} result]
        (doseq [{:keys [warnings result] :as action} results]
          (binding [warnings/*color* false]
            (doseq [warning warnings]
              (send msg {:err (with-out-str (warnings/print-short-warning warning))})))

          (case (:type result)
            :repl/result
            (send msg {:value (:value result)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/set-ns-complete
            (send msg {:value (pr-str repl-ns)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            (:repl/invoke-error
              :repl/require-error)
            (send msg {:err (or (:stack result)
                                (:error result))})

            :repl/require-complete
            (send msg {:value "nil"
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/error
            (send msg {:err (errors/error-format (:ex result))})

            ;; :else
            (send msg {:err (pr-str [:FIXME action])}))))

      :repl/interrupt
      nil

      :repl/timeout
      (send msg {:err "REPL command timed out.\n"})

      :repl/no-runtime-connected
      (send msg {:err "No application has connected to the REPL server. Make sure your JS environment has loaded your compiled ClojureScript code.\n"})

      :repl/too-many-runtimes
      (send msg {:err "There are too many JS runtimes, don't know which to eval in.\n"})

      :repl/error
      (send msg {:err (errors/error-format (:ex result))})

      :repl/worker-stop
      (do (do-repl-quit session)
          (send msg {:err "The REPL worker has stopped.\n"})
          (send msg {:value ":cljs/quit"
                     :printed-value 1
                     :ns (-> *ns* ns-name str)}))

      ;; :else
      (send msg {:err (pr-str [:FIXME result])}))

    ))

(defn do-cljs-eval [{::keys [worker send] :keys [ns session code runtime-id] :as msg}]
  (let [reader (StringReader. code)

        session-id
        (-> session meta :id str)]

    (loop []
      (when-let [build-state (repl-impl/worker-build-state worker)]

        ;; need the repl state to properly support reading ::alias/foo
        (let [read-opts
              (-> {}
                  (cond->
                    (seq ns)
                    (assoc :ns (symbol ns))))

              {:keys [eof? error? ex form] :as read-result}
              (repl/read-one build-state reader read-opts)]

          (cond
            eof?
            :eof

            error?
            (do (send msg {:err (str "Failed to read input: " ex)})
                (recur))

            (nil? form)
            (recur)

            (= :repl/quit form)
            (do (do-repl-quit session)
                (send msg {:value ":repl/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            (= :cljs/quit form)
            (do (do-repl-quit session)
                (send msg {:value ":cljs/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            ;; Cursive supports
            ;; {:status :eval-error :ex <exception name/message> :root-ex <root exception name/message>}
            ;; {:err string} prints to stderr
            :else
            (when-some [result (worker/repl-eval worker session-id runtime-id read-result)]
              (handle-repl-result worker msg result)
              (recur))
            ))))

    (send msg {:status :done})
    ))

(defn worker-exit [session {::keys [send] :as msg}]
  (do (do-repl-quit session)
      (send msg {:err "\nThe REPL worker has stopped.\n"})
      (send msg {:value ":cljs/quit"
                 :printed-value 1
                 :ns (-> *ns* ns-name str)})))

(defn set-worker [{:keys [session] :as msg}]
  (let [repl-var #'api/*nrepl-cljs*]
    (when-not (contains? @session repl-var)
      (swap! session assoc
        repl-var nil
        #'api/*nrepl-quit-signal* (async/chan)
        #'api/*nrepl-active* true
        #'api/*nrepl-clj-ns* nil))

    (swap! session assoc
      #'api/*nrepl-worker-exit* #(worker-exit session msg)
      #'api/*nrepl-session* session
      #'api/*nrepl-msg* msg)

    (let [build-id
          (get @session repl-var)

          worker
          (when build-id
            (api/get-worker build-id))]

      ;; (prn [:cljs-select op build-id (some? worker) (keys msg)])
      #_(when (= op "eval")
          (println)
          (println (:code msg))
          (println)
          (flush))

      (-> msg
          (cond->
            worker
            ;; FIXME: add :cljs.env/compiler key for easier access?
            (assoc ::worker worker ::build-id build-id))
          ))))

(defn do-cljs-load-file [{::keys [worker send] :keys [file file-path] :as msg}]
  (when-some [result (worker/load-file worker {:file-path file-path :source file})]
    (handle-repl-result worker msg result))
  (send msg {:status :done}))

(defn shadow-init!
  [{:keys [session] :as msg}]
  (let [config
        (config/load-cljs-edn)

        init-ns
        (or (get-in config [:nrepl :init-ns])
            (get-in config [:repl :init-ns])
            'shadow.user)]

    (try
      (require init-ns)
      (swap! session assoc #'*ns* (find-ns init-ns))
      (catch Exception e
        (log/warn-ex e ::init-ns-ex {:init-ns init-ns})))))

(defn handle [{:keys [op] :as msg} next]
  (shadow-init! msg)
  (let [{::keys [worker] :as msg} (set-worker msg)]
    (log/debug ::handle {:msg-op op :worker (some? worker)})
    (cond
      (and worker (= op "eval"))
      (do-cljs-eval msg)

      (and worker (= op "load-file"))
      (do-cljs-load-file msg)

      :else
      (next msg))))

(ns shadow.cljs.devtools.server.nrepl-impl
  (:refer-clojure :exclude (send))
  (:require [shadow.cljs.devtools.api :as api]
            [clojure.core.async :as async]
            [shadow.jvm-log :as log]
            [shadow.cljs.devtools.server.repl-impl :as repl-impl]
            [shadow.build.warnings :as warnings]
            [shadow.cljs.devtools.errors :as errors]
            [shadow.cljs.repl :as repl]
            [shadow.cljs.devtools.server.worker :as worker]
            [shadow.cljs.devtools.config :as config])
  (:import [java.io StringReader]))

(defn do-repl-quit [session]
  (let [quit-var #'api/*nrepl-quit-signal*
        quit-chan (get @session quit-var)]

    (when quit-chan
      (async/close! quit-chan))

    (swap! session assoc
      quit-var (async/chan)
      #'*ns* (get @session #'api/*nrepl-clj-ns*)
      #'api/*nrepl-cljs* nil
      #'cider.piggieback/*cljs-compiler-env* nil
      #'cemerick.piggieback/*cljs-compiler-env* nil)))

(defn handle-repl-result [worker {::keys [send] :keys [session] :as msg} result]
  (log/debug ::eval-result {:result result})

  (let [build-state (repl-impl/worker-build-state worker)
        repl-ns (-> build-state :repl-state :current-ns)]

    (case (:type result)
      :repl/results
      (let [{:keys [results]} result]
        (doseq [{:keys [warnings result] :as action} results]
          (binding [warnings/*color* false]
            (doseq [warning warnings]
              (send msg {:err (with-out-str (warnings/print-short-warning warning))})))

          (case (:type result)
            :repl/result
            (send msg {:value (:value result)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/set-ns-complete
            (send msg {:value (pr-str repl-ns)
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            (:repl/invoke-error
              :repl/require-error)
            (send msg {:err (or (:stack result)
                                (:error result))})

            :repl/require-complete
            (send msg {:value "nil"
                       :printed-value 1
                       :ns (pr-str repl-ns)})

            :repl/error
            (send msg {:err (errors/error-format (:ex result))})

            ;; :else
            (send msg {:err (pr-str [:FIXME action])}))))

      :repl/interrupt
      nil

      :repl/timeout
      (send msg {:err "REPL command timed out.\n"})

      :repl/no-runtime-connected
      (send msg {:err "No application has connected to the REPL server. Make sure your JS environment has loaded your compiled ClojureScript code.\n"})

      :repl/too-many-runtimes
      (send msg {:err "There are too many JS runtimes, don't know which to eval in.\n"})

      :repl/error
      (send msg {:err (errors/error-format (:ex result))})

      :repl/worker-stop
      (do (do-repl-quit session)
          (send msg {:err "The REPL worker has stopped.\n"})
          (send msg {:value ":cljs/quit"
                     :printed-value 1
                     :ns (-> *ns* ns-name str)}))

      ;; :else
      (send msg {:err (pr-str [:FIXME result])}))

    ))

(defn do-cljs-eval [{::keys [worker send] :keys [ns session code runtime-id] :as msg}]
  (let [reader (StringReader. code)

        session-id
        (-> session meta :id str)]

    (loop []
      (when-let [build-state (repl-impl/worker-build-state worker)]

        ;; need the repl state to properly support reading ::alias/foo
        (let [read-opts
              (-> {}
                  (cond->
                    (seq ns)
                    (assoc :ns (symbol ns))))

              {:keys [eof? error? ex form] :as read-result}
              (repl/read-one build-state reader read-opts)]

          (cond
            eof?
            :eof

            error?
            (do (send msg {:err (str "Failed to read input: " ex)})
                (recur))

            (nil? form)
            (recur)

            (= :repl/quit form)
            (do (do-repl-quit session)
                (send msg {:value ":repl/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            (= :cljs/quit form)
            (do (do-repl-quit session)
                (send msg {:value ":cljs/quit"
                           :printed-value 1
                           :ns (-> *ns* ns-name str)}))

            ;; Cursive supports
            ;; {:status :eval-error :ex <exception name/message> :root-ex <root exception name/message>}
            ;; {:err string} prints to stderr
            :else
            (when-some [result (worker/repl-eval worker session-id runtime-id read-result)]
              (handle-repl-result worker msg result)
              (recur))
            ))))

    (send msg {:status :done})
    ))

(defn worker-exit [session {::keys [send] :as msg}]
  (do (do-repl-quit session)
      (send msg {:err "\nThe REPL worker has stopped.\n"})
      (send msg {:value ":cljs/quit"
                 :printed-value 1
                 :ns (-> *ns* ns-name str)})))

(defn set-worker [{:keys [session] :as msg}]
  (let [repl-var #'api/*nrepl-cljs*]
    (when-not (contains? @session repl-var)
      (swap! session assoc
        repl-var nil
        #'api/*nrepl-quit-signal* (async/chan)
        #'api/*nrepl-active* true
        #'api/*nrepl-clj-ns* nil))

    (swap! session assoc
      #'api/*nrepl-worker-exit* #(worker-exit session msg)
      #'api/*nrepl-session* session
      #'api/*nrepl-msg* msg)

    (let [build-id
          (get @session repl-var)

          worker
          (when build-id
            (api/get-worker build-id))]

      ;; (prn [:cljs-select op build-id (some? worker) (keys msg)])
      #_(when (= op "eval")
          (println)
          (println (:code msg))
          (println)
          (flush))

      (-> msg
          (cond->
            worker
            ;; FIXME: add :cljs.env/compiler key for easier access?
            (assoc ::worker worker ::build-id build-id))
          ))))

(defn do-cljs-load-file [{::keys [worker send] :keys [file file-path] :as msg}]
  (when-some [result (worker/load-file worker {:file-path file-path :source file})]
    (handle-repl-result worker msg result))
  (send msg {:status :done}))

(defn shadow-init!
  [{:keys [session] :as msg}]
  (let [config
        (config/load-cljs-edn)

        init-ns
        (or (get-in config [:nrepl :init-ns])
            (get-in config [:repl :init-ns])
            'shadow.user)]

    (try
      (require init-ns)
      (swap! session assoc #'*ns* (find-ns init-ns))
      (catch Exception e
        (log/warn-ex e ::init-ns-ex {:init-ns init-ns})))))

(defn handle [{:keys [op] :as msg} next]
  (let [{::keys [worker] :as msg} (set-worker msg)]
    (log/debug ::handle {:msg-op op :worker (some? worker)})
    (cond
      (and worker (= op "eval"))
      (do-cljs-eval msg)

      (and worker (= op "load-file"))
      (do-cljs-load-file msg)

      :else
      (next msg))))

drop leftover nrepl init call

drop leftover nrepl init call


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

(ns spacon.server
  (:gen-class)                                              ; for -main method in uberjar
  (:require [io.pedestal.http :as server]
            [spacon.components.http.core :as http]
            [com.stuartsierra.component :as component]
            [spacon.components.ping.core :as ping]
            [spacon.components.user.core :as user]
            [spacon.components.team.core :as team]
            [spacon.components.device.core :as device]
            [spacon.components.config.core :as config]
            [spacon.components.store.core :as store]
            [spacon.components.location.core :as location]
            [spacon.components.trigger.core :as trigger]
            [spacon.components.mqtt.core :as mqtt]
            [spacon.components.notification.core :as notification]
            [spacon.components.form.core :as form]
            [spacon.components.kafka.core :as kafka]
            [clojure.tools.logging :as log]))

(defrecord SpaconServer [http-service]
  component/Lifecycle
  (start [component]
    (log/info "Starting SpaconServer Component")
    (let [server (server/create-server (:service-def http-service))]
      (server/start server)
      (assoc component :http-server server)))
  (stop [component]
    (log/info "Stopping SpaconServer Component")
    (update-in component [:http-server] server/stop)))

(defn new-spacon-server []
  (map->SpaconServer {}))

(defn make-spacon-server
  "Returns a new instance of the system"
  [config-options]
  (log/debug "Making server config with these options" config-options)
  (let [{:keys [http-config mqtt-config kafka-producer-config kafka-consumer-config]} config-options]
    (component/system-map
     :user (user/make-user-component)
     :team (team/make-team-component)
     :mqtt (mqtt/make-mqtt-component mqtt-config)
     :kafka (kafka/make-kafka-component kafka-producer-config kafka-consumer-config)
     :ping (component/using (ping/make-ping-component) [:mqtt :kafka])
     :device (component/using (device/make-device-component) [:mqtt])
     :config (component/using (config/make-config-component) [:mqtt])
     :notify (component/using (notification/make-notification-component) [:mqtt])
     :trigger (component/using (trigger/make-trigger-component) [:notify])
     :store (component/using (store/make-store-component) [:mqtt :trigger])
     :location (component/using (location/make-location-component) [:mqtt :trigger])
     :form (component/using (form/make-form-component) [:mqtt :trigger])
     :http-service (component/using
                    (http/make-http-service-component http-config)
                    [:ping :user :team :device :location :trigger
                     :store :config :form :mqtt :notify])
     :server (component/using (new-spacon-server) [:http-service]))))

(defn -main
  "The entry-point for 'lein run'"
  [& _]
  (log/info "Configuring the server...")
  ;; create global uncaught exception handler so threads don't silently die
  (Thread/setDefaultUncaughtExceptionHandler
   (reify Thread$UncaughtExceptionHandler
     (uncaughtException [_ thread ex]
       (log/error ex "Uncaught exception on thread" (.getName thread)))))
  (System/setProperty "javax.net.ssl.trustStore"
                      (or (System/getenv "TRUST_STORE")
                          "tls/test-cacerts.jks"))
  (System/setProperty "javax.net.ssl.trustStoreType"
                      (or (System/getenv "TRUST_STORE_TYPE")
                          "JKS"))
  (System/setProperty "javax.net.ssl.trustStorePassword"
                      (or (System/getenv "TRUST_STORE_PASSWORD")
                          "changeit"))
  (System/setProperty "javax.net.ssl.keyStore"
                      (or (System/getenv "KEY_STORE")
                          "tls/test-keystore.p12"))
  (System/setProperty "javax.net.ssl.keyStoreType"
                      (or (System/getenv "KEY_STORE_TYPE")
                          "pkcs12"))
  (System/setProperty "javax.net.ssl.keyStorePassword"
                      (or (System/getenv "KEY_STORE_PASSWORD")
                          "somepass"))
  ;; todo: auto migrate flag?
  (component/start-system
   (make-spacon-server {:http-config {}
                        :mqtt-config {:broker-url (System/getenv "MQTT_BROKER_URL")}
                        :kafka-producer-config {:timeout-ms 2000}
                        :kafka-consumer-config {:servers (System/getenv "BOOTSTRAP_SERVERS")
                                                :group-id (System/getenv "GROUP_ID")}})))

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

(ns spacon.server
  (:gen-class)                                              ; for -main method in uberjar
  (:require [io.pedestal.http :as server]
            [spacon.components.http.core :as http]
            [com.stuartsierra.component :as component]
            [spacon.components.ping.core :as ping]
            [spacon.components.user.core :as user]
            [spacon.components.team.core :as team]
            [spacon.components.device.core :as device]
            [spacon.components.config.core :as config]
            [spacon.components.store.core :as store]
            [spacon.components.location.core :as location]
            [spacon.components.trigger.core :as trigger]
            [spacon.components.mqtt.core :as mqtt]
            [spacon.components.notification.core :as notification]
            [spacon.components.form.core :as form]
            [spacon.components.kafka.core :as kafka]
            [clojure.tools.logging :as log]))

(defrecord SpaconServer [http-service]
  component/Lifecycle
  (start [component]
    (log/info "Starting SpaconServer Component")
    (let [server (server/create-server (:service-def http-service))]
      (server/start server)
      (assoc component :http-server server)))
  (stop [component]
    (log/info "Stopping SpaconServer Component")
    (update-in component [:http-server] server/stop)))

(defn new-spacon-server []
  (map->SpaconServer {}))

(defn make-spacon-server
  "Returns a new instance of the system"
  [config-options]
  (log/debug "Making server config with these options" config-options)
  (let [{:keys [http-config mqtt-config kafka-producer-config kafka-consumer-config]} config-options]
    (component/system-map
     :user (user/make-user-component)
     :team (team/make-team-component)
     :mqtt (mqtt/make-mqtt-component mqtt-config)
     :kafka (kafka/make-kafka-component kafka-producer-config kafka-consumer-config)
     :ping (component/using (ping/make-ping-component) [:mqtt :kafka])
     :device (component/using (device/make-device-component) [:mqtt])
     :config (component/using (config/make-config-component) [:mqtt])
     :notify (component/using (notification/make-notification-component) [:mqtt])
     :trigger (component/using (trigger/make-trigger-component) [:notify])
     :store (component/using (store/make-store-component) [:mqtt :trigger])
     :location (component/using (location/make-location-component) [:mqtt :trigger])
     :form (component/using (form/make-form-component) [:mqtt :trigger])
     :http-service (component/using
                    (http/make-http-service-component http-config)
                    [:ping :user :team :device :location :trigger
                     :store :config :form :mqtt :notify])
     :server (component/using (new-spacon-server) [:http-service]))))

(defn -main
  "The entry-point for 'lein run'"
  [& _]
  (log/info "Configuring the server...")
  ;; create global uncaught exception handler so threads don't silently die
  (Thread/setDefaultUncaughtExceptionHandler
   (reify Thread$UncaughtExceptionHandler
     (uncaughtException [_ thread ex]
       (log/error ex "Uncaught exception on thread" (.getName thread)))))
  (System/setProperty "javax.net.ssl.trustStore"
                      (or (System/getenv "TRUST_STORE")
                          "tls/test-cacerts.jks"))
  (System/setProperty "javax.net.ssl.trustStoreType"
                      (or (System/getenv "TRUST_STORE_TYPE")
                          "JKS"))
  (System/setProperty "javax.net.ssl.trustStorePassword"
                      (or (System/getenv "TRUST_STORE_PASSWORD")
                          "changeit"))
  (System/setProperty "javax.net.ssl.keyStore"
                      (or (System/getenv "KEY_STORE")
                          "tls/test-keystore.p12"))
  (System/setProperty "javax.net.ssl.keyStoreType"
                      (or (System/getenv "KEY_STORE_TYPE")
                          "pkcs12"))
  (System/setProperty "javax.net.ssl.keyStorePassword"
                      (or (System/getenv "KEY_STORE_PASSWORD")
                          "somepass"))
  ;; todo: auto migrate flag?
  (component/start-system
   (make-spacon-server {:http-config {}
                        :mqtt-config {:broker-url (System/getenv "MQTT_BROKER_URL")}
                        :kafka-producer-config {:servers (System/getenv "BOOTSTRAP_SERVERS")
                                                :timeout-ms 2000}
                        :kafka-consumer-config {:servers (System/getenv "BOOTSTRAP_SERVERS")
                                                :group-id (System/getenv "GROUP_ID")}})))

add bootstrap server env var to producer config (#264)


;; Utility functions and functions for manipulating vector and scalar fields
(ns robinson.prism
  (:use
        robinson.common)
  (:require
            [robinson.noise :as rn]
            [taoensso.timbre :as timbre]))

(defn invert
  [f]
  (fn [[x y]]
    (+ 1 (- (f [x y])))))

(defn wrap-constant
  [c]
  (fn [& _]
    (constantly c)))

(defn wrap-arg
  [xy-or-fn]
  (cond
    (vector? xy-or-fn)
      (wrap-constant xy-or-fn)
    (fn? xy-or-fn)
      xy-or-fn))

(defn offset
  [xy-or-fn f]
  (cond
    (vector? xy-or-fn)
      (let [[x y] xy-or-fn]
        (fn [[xi yi]]
          (f [(+ xi x) (+ yi y)])))
    (fn? xy-or-fn)
      (fn [[xi yi]]
        (let [[x y] (xy-or-fn [xi yi])]
          (f [(+ xi x) (+ yi y)])))))

(defn scale [s f]
  (fn [[x y]]
    (f [(* s x) (* s y)])))

(defn center [f]
  (fn [[x y]]
    (offset [-0.5 -0.5] (scale 0.5 f))))

(defn radius []
  (fn [[x y]]
    #+clj  (Math/sqrt (+ (* x x) (* y y)))
    #+cljs (.sqrt js/Math (+ (* x x) (* y y)))))

(defn center-radius []
  (fn [[x y]]
    (center (radius (xy->pos x y)))))

(defn vsnoise
  [fnoise]
  (fn [[x y]]
    (vec(fnoise x y) (fnoise (+ x 12.301) (+ y 70.261)))))

(defn vnoise
  [noise]
  (fn [[x y]]
    (vec(rn/noise noise x y) (rn/noise noise (+ x -78.678) (+ y 7.6789)))))

(defn v+
  [xy-or-fn-0 xy-or-fn-1]
  (cond
    (and (vector xy-or-fn-0)
         (vector xy-or-fn-1))
      (mapv + xy-or-fn-0 xy-or-fn-1)
    (and (vector? xy-or-fn-0)
         (fn? xy-or-fn-1))
      (fn [[xi yi]]
        (let [[x0 y0] xy-or-fn-0
              [x1 y1] (xy-or-fn-1 xi yi)]
          [(+ x0 x1) (+ y0 y1)]))
    (and (fn? xy-or-fn-0)
         (vector? xy-or-fn-1))
      (fn [[xi yi]]
        (let [[x0 y0] (xy-or-fn-0 xi yi)
              [x1 y1] xy-or-fn-1]
          [(+ x0 x1) (+ y0 y1)]))
    (and (fn? xy-or-fn-0)
         (fn? xy-or-fn-1))
      (fn [[xi yi]]
        (let [[x0 y0] (xy-or-fn-0 xi yi)
              [x1 y1] (xy-or-fn-1 xi yi)]
          [(+ x0 x1) (+ y0 y1)]))))

(defn v*
  [s xy-or-f]
  (case
    (vector? xy-or-f)
      (let [[x y] xy-or-f]
        [(* s x) (* s y)])
    (fn? xy-or-f)
      (fn [[xi yi]]
        [(* s (xy-or-f xi)) (* s (xy-or-f yi))])))

(defn v-
  [xy-or-fn-0 xy-or-fn-1]
  (case
    (and (vector xy-or-fn-0)
         (vector xy-or-fn-1))
      (mapv - xy-or-fn-0 xy-or-fn-1)
    :else
      (v+ xy-or-fn-0 (v* -1 xy-or-fn-1))))

#_(defn sample-tree
  (offset [-0.5 -0.5] (v+ [-0.5 -0.5 -0.5] (scale 0.01 noise))))

#_(defn sample-island
  [noise x y]
  (cliskf/vectorize
    (cliskf/vlet [c  ((center (invert (offset (scale 0.43 (v* [0.5 0.5 0.5] (vsnoise noise) (radius)))))) x y)
                  c1 ((offset [0.5 0.5] (v+ [-0.5 -0.5 -0.5] (scale 0.06 noise))) x y)
                  c2 ((offset [-0.5 -0.5] (v+ [-0.5 -0.5 -0.5] (scale 0.08 noise))) x y)]
      (cond
        ;; interior biomes
        (> -0.55  c)
          (cond
            (and (pos? c1) (pos? c2) (> c1 c2))
            ;; interior jungle
            jungle
            (and (pos? c1) (pos? c2))
            heavy-forest
            (and (pos? c1) (neg? c2) (> c1 c2))
            light-forest
            (and (pos? c1) (neg? c2))
            bamboo-grove
            (and (neg? c1) (pos? c2) (> c1 c2))
            meadow
            (and (neg? c1) (pos? c2))
            rocky
            (and (neg? c1) (neg? c2) (> c1 c2))
            swamp
            :else
            dirt)
        ;; shore/yellow
        (> -0.5  c)
            sand
        ;; surf/light blue
        (> -0.42 c)
          surf
        ;; else ocean
        :else
          ocean))))

(defn coerce [f]
  (fn [x y]
    (f [x y])))

(defn -main [& args]
  (let [n (rn/create-noise)]
    #_(rn/print-fn (fn [x y] (rn/noise n x y)) 180 180)
    (rn/print-fn (coerce (invert (offset (vsnoise (partial rn/noise n))  (scale 0.2 (radius))))) 180 180)))

;; Utility functions and functions for manipulating vector and scalar fields
(ns robinson.prism
  (:use
        robinson.common)
  (:require
            [robinson.noise :as rn]
            [taoensso.timbre :as timbre]))

(defn invert
  [f]
  (fn [[x y]]
    (+ 1 (- (f [x y])))))

(defn wrap-constant
  [c]
  (fn [& _]
    (constantly c)))

(defn wrap-arg
  [xy-or-fn]
  (cond
    (vector? xy-or-fn)
      (wrap-constant xy-or-fn)
    (fn? xy-or-fn)
      xy-or-fn))

(defn coerce [f]
  (fn [x y]
    (f [x y])))

(defn noise [n]
  (fn [[x y]]
    (rn/noise n x y)))

(defn snoise [n]
  (fn [[x y]]
    (rn/snoise n x y)))

(defn offset
  [xy-or-fn f]
  (cond
    (vector? xy-or-fn)
      (let [[x y] xy-or-fn]
        (fn [[xi yi]]
          (f [(+ xi x) (+ yi y)])))
    (fn? xy-or-fn)
      (fn [[xi yi]]
        (let [[x y] (xy-or-fn [xi yi])]
          (f [(+ xi x) (+ yi y)])))))

(defn scale [s f]
  (fn [[x y]]
    (f [(* s x) (* s y)])))

(defn center [f]
  (fn [[x y]]
    (offset [-0.5 -0.5] (scale 0.5 f))))

(defn radius []
  (fn [[x y]]
    #+clj  (Math/sqrt (+ (* x x) (* y y)))
    #+cljs (.sqrt js/Math (+ (* x x) (* y y)))))

(defn center-radius []
  (fn [[x y]]
    (center (radius (xy->pos x y)))))

(defn vsnoise
  [fnoise]
  (fn [[x y]]
    (vec (fnoise x y) (fnoise (+ x 12.301) (+ y 70.261)))))

(defn vnoise
  [noise]
  (fn [[x y]]
    (vec (rn/noise noise x y) (rn/noise noise (+ x -78.678) (+ y 7.6789)))))

(defn v+
  [xy-or-fn-0 xy-or-fn-1]
  (cond
    (and (vector xy-or-fn-0)
         (vector xy-or-fn-1))
      (mapv + xy-or-fn-0 xy-or-fn-1)
    (and (vector? xy-or-fn-0)
         (fn? xy-or-fn-1))
      (fn [[xi yi]]
        (let [[x0 y0] xy-or-fn-0
              [x1 y1] (xy-or-fn-1 xi yi)]
          [(+ x0 x1) (+ y0 y1)]))
    (and (fn? xy-or-fn-0)
         (vector? xy-or-fn-1))
      (fn [[xi yi]]
        (let [[x0 y0] (xy-or-fn-0 xi yi)
              [x1 y1] xy-or-fn-1]
          [(+ x0 x1) (+ y0 y1)]))
    (and (fn? xy-or-fn-0)
         (fn? xy-or-fn-1))
      (fn [[xi yi]]
        (let [[x0 y0] (xy-or-fn-0 xi yi)
              [x1 y1] (xy-or-fn-1 xi yi)]
          [(+ x0 x1) (+ y0 y1)]))))

(defn v*
  [s xy-or-f]
  (case
    (vector? xy-or-f)
      (let [[x y] xy-or-f]
        [(* s x) (* s y)])
    (fn? xy-or-f)
      (fn [[xi yi]]
        [(* s (xy-or-f xi)) (* s (xy-or-f yi))])))

(defn v-
  [xy-or-fn-0 xy-or-fn-1]
  (case
    (and (vector xy-or-fn-0)
         (vector xy-or-fn-1))
      (mapv - xy-or-fn-0 xy-or-fn-1)
    :else
      (v+ xy-or-fn-0 (v* -1 xy-or-fn-1))))

(defn s+
  [s f]
  (fn [[x y]]
    (let [v (f [x y])]
      (+ s v))))

(defn sample-tree [n]
  (offset [-0.5 -0.5] (s+ -0.5 (scale 0.01 (noise n)))))

#_(defn sample-island
  [noise x y]
  (cliskf/vectorize
    (cliskf/vlet [c  ((center (invert (offset (scale 0.43 (v* [0.5 0.5 0.5] (vsnoise noise) (radius)))))) x y)
                  c1 ((offset [0.5 0.5] (v+ [-0.5 -0.5 -0.5] (scale 0.06 noise))) x y)
                  c2 ((offset [-0.5 -0.5] (v+ [-0.5 -0.5 -0.5] (scale 0.08 noise))) x y)]
      (cond
        ;; interior biomes
        (> -0.55  c)
          (cond
            (and (pos? c1) (pos? c2) (> c1 c2))
            ;; interior jungle
            jungle
            (and (pos? c1) (pos? c2))
            heavy-forest
            (and (pos? c1) (neg? c2) (> c1 c2))
            light-forest
            (and (pos? c1) (neg? c2))
            bamboo-grove
            (and (neg? c1) (pos? c2) (> c1 c2))
            meadow
            (and (neg? c1) (pos? c2))
            rocky
            (and (neg? c1) (neg? c2) (> c1 c2))
            swamp
            :else
            dirt)
        ;; shore/yellow
        (> -0.5  c)
            sand
        ;; surf/light blue
        (> -0.42 c)
          surf
        ;; else ocean
        :else
          ocean))))

(defn -main [& args]
  (let [n (rn/create-noise)]
    #_(rn/print-fn (fn [x y] (rn/noise n x y)) 180 180)
    (rn/print-fn (coerce (sample-tree n)) 180 180)
    #_(rn/print-fn (coerce (invert (offset (vsnoise (partial rn/noise n))  (scale 0.2 (radius))))) 180 180)))

Fix sample-tree

Fix sample-tree


;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns futura.stream.common
  "Defines a common subset of functions and hepers that
  works with all kind of subscription objects."
  (:require [futura.atomic :as atomic]
            [futura.promise :as p]
            [clojure.core.async :as async]
            [clojure.core.async.impl.protocols :as asyncp])
  (:import clojure.lang.Seqable
           org.reactivestreams.Publisher
           org.reactivestreams.Subscriber
           java.lang.AutoCloseable
           java.util.concurrent.Executor
           java.util.concurrent.Executors
           java.util.concurrent.CountDownLatch
           java.util.concurrent.ConcurrentLinkedQueue))

(declare runnable)

(def ^:dynamic
  *executor* (Executors/newSingleThreadExecutor))

(defn terminate
  "Mark a subscrition as terminated
  with provided exception."
  [sub e]
  (let [canceled (:canceled sub)
        subscriber (:subscriber sub)]
    (atomic/set! canceled true)
    (try
      (.onError subscriber e)
      (catch Throwable t
        (IllegalStateException. "Violated the Reactive Streams rule 2.13")))))

(defn schedule
  "Schedule the subscrption to be executed
  in builtin scheduler executor."
  [sub]
  (let [active (:active sub)
        canceled (:canceled sub)
        queue (:queue sub)]
    (when (atomic/compare-and-set! active false true)
      (try
        (.execute *executor* (runnable sub))
        (catch Throwable t
          (when (not @canceled)
            (atomic/set! canceled true)
            (try
              (terminate sub (IllegalStateException. "Unavailable executor."))
              (finally
                (.clear queue)
                (atomic/set! active false)))))))))

(defn- signal
  "Notify the subscription about specific event."
  [sub m]
  (let [queue (:queue sub)]
    (when (.offer queue m)
      (schedule sub))))

(defn signal-request
  "Signal the request event."
  [sub n]
  (signal sub {:type ::request :number n}))

(defn signal-send
  "Signal the send event."
  [sub]
  (signal sub {:type ::send}))

(defn signal-subscribe
  "Signal the subscribe event."
  [sub]
  (signal sub {:type ::subscribe}))

(defn signal-cancel
  "Signal the cancel event."
  [sub]
  (signal sub {:type ::cancel}))

(defmulti handle-send
  "A polymorphic method for handle send signal."
  class)

(defmulti handle-subscribe
  "A polymorphic method for handle send signal."
  class)

(defn handle-request
  "A generic implementation for request events
  handling for any type of subscriptions."
  [sub n]
  (let [demand (:demand sub)]
    (cond
      (< n 1)
      (terminate sub (IllegalStateException. "violated the Reactive Streams rule 3.9"))

      (< (+ @demand n) 1)
      (do
        (atomic/set! demand Long/MAX_VALUE)
        (handle-send sub))

      :else
      (do
        (atomic/get-and-add! demand n)
        (handle-send sub)))))

(defn handle-cancel
  "A generic implementation for handle cancel events
  for all types of subscriptions."
  [sub]
  (let [canceled (:canceled sub)]
    (atomic/set! canceled true)))

(defn runnable
  "A runnable constructor for schedule the subscription
  to handle events in a executor/event-loop."
  [sub]
  (let [queue (:queue sub)
        active (:active sub)
        canceled (:canceled sub)]
    (reify Runnable
      (^void run [_]
        (try
          (let [signal (.poll queue)]
            (when (not @canceled)
              (case (:type signal)
                ::request (handle-request sub (:number signal))
                ::send (handle-send sub)
                ::cancel (handle-cancel sub)
                ::subscribe (handle-subscribe sub))))
          (finally
            (atomic/set! active false)
            (when (not (.isEmpty queue))
              (schedule sub))))))))

(definterface IPullStream
  (pull [] "Pull a value from the stream."))

(defn take!
  "Takes a value from a stream, returning a deferred that yields the value
  when it is available or nil if the take fails."
  [^IPullStream p]
  (.pull p))

(defn- publisher->seq
  "Coerce a publisher in a blocking seq."
  [s]
  (lazy-seq
   (let [v @(take! s)]
     (if v
       (cons v (lazy-seq (publisher->seq s)))
       (.close ^AutoCloseable s)))))

(defn subscribe
  "Create a subscription to the given publisher instance.

  The returned subscription does not consumes the publisher
  data until is requested."
  [^Publisher p]
  (let [sr (async/chan)
        lc (CountDownLatch. 1)
        ss (atomic/ref nil)
        sb (reify Subscriber
             (onSubscribe [_ s]
               (.countDown lc)
               (atomic/set! ss s))
             (onNext [_ v]
               (async/put! sr v))
             (onError [_ e]
               (async/close! sr))
             (onComplete [_]
               (async/close! sr)))]
    (.subscribe p sb)
    (reify
      AutoCloseable
      (close [_]
        (.await lc)
        (.cancel @ss))

      Seqable
      (seq [this]
        (.await lc)
        (publisher->seq this))

      IPullStream
      (pull [_]
        (.await lc)
        (let [p (p/promise)]
          (async/take! sr #(p/deliver p %))
          (.request @ss 1)
          p))

      asyncp/ReadPort
      (take! [_ handler]
        (asyncp/take! sr handler)))))

(defn proxy-subscriber
  "Create a proxy subscriber.

  The main purpose of this proxy is apply some
  kind of transformations to the proxied publisher
  using transducers."
  [xform subscriber]
  (let [rf (xform (fn
                    ([s] s)
                    ([s v] (.onNext s v))))
        completed (atomic/boolean false)
        subscription (atomic/ref nil)]
    (reify Subscriber
      (onSubscribe [_ s]
        (atomic/set! subscription s)
        (.onSubscribe subscriber s))
      (onNext [_ v]
        (when-not @completed
          (let [res (rf subscriber v)]
            (cond
              (identical? res subscriber)
              (.request @subscription 1)

              (reduced? res)
              (do
                (.cancel @subscription)
                (.onComplete (rf subscriber))
                (atomic/set! completed true))))))
      (onError [_ e]
        (atomic/set! completed true)
        (rf subscriber)
        (.onError subscriber e))
      (onComplete [_]
        (when-not @completed
          (atomic/set! completed true)
          (rf subscriber)
          (.onComplete subscriber))))))

;; Copyright (c) 2015 Andrey Antukh <niwi@niwi.nz>
;; All rights reserved.
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; 1. Redistributions of source code must retain the above copyright
;;    notice, this list of conditions and the following disclaimer.
;; 2. Redistributions in binary form must reproduce the above copyright
;;    notice, this list of conditions and the following disclaimer in the
;;    documentation and/or other materials provided with the distribution.
;;
;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(ns futura.stream.common
  "Defines a common subset of functions and hepers that
  works with all kind of subscription objects."
  (:require [futura.atomic :as atomic]
            [futura.promise :as p]
            [clojure.core.async :as async]
            [clojure.core.async.impl.protocols :as asyncp])
  (:import clojure.lang.Seqable
           org.reactivestreams.Publisher
           org.reactivestreams.Subscriber
           java.lang.AutoCloseable
           java.util.Queue
           java.util.concurrent.ForkJoinPool
           java.util.concurrent.Executor
           java.util.concurrent.CountDownLatch
           java.util.concurrent.ConcurrentLinkedQueue))

(declare runnable)

(def ^:dynamic
  *executor* (ForkJoinPool/commonPool))

(defn terminate
  "Mark a subscrition as terminated
  with provided exception."
  [sub e]
  (let [canceled (:canceled sub)
        subscriber (:subscriber sub)]
    (atomic/set! canceled true)
    (try
      (.onError subscriber e)
      (catch Throwable t
        (IllegalStateException. "Violated the Reactive Streams rule 2.13")))))

(defn schedule
  "Schedule the subscrption to be executed
  in builtin scheduler executor."
  [sub]
  (let [active (:active sub)
        canceled (:canceled sub)
        queue (:queue sub)]
    (when (atomic/compare-and-set! active false true)
      (try
        (.execute *executor* (runnable sub))
        (catch Throwable t
          (when (not @canceled)
            (atomic/set! canceled true)
            (try
              (terminate sub (IllegalStateException. "Unavailable executor."))
              (finally
                (.clear queue)
                (atomic/set! active false)))))))))

(defn- signal
  "Notify the subscription about specific event."
  [sub m]
  (let [queue (:queue sub)]
    (when (.offer queue m)
      (schedule sub))))

(defn signal-request
  "Signal the request event."
  [sub n]
  (signal sub {:type ::request :number n}))

(defn signal-send
  "Signal the send event."
  [sub]
  (signal sub {:type ::send}))

(defn signal-subscribe
  "Signal the subscribe event."
  [sub]
  (signal sub {:type ::subscribe}))

(defn signal-cancel
  "Signal the cancel event."
  [sub]
  (signal sub {:type ::cancel}))

(defmulti handle-send
  "A polymorphic method for handle send signal."
  class)

(defmulti handle-subscribe
  "A polymorphic method for handle send signal."
  class)

(defn handle-request
  "A generic implementation for request events
  handling for any type of subscriptions."
  [sub n]
  (let [demand (:demand sub)]
    (cond
      (< n 1)
      (terminate sub (IllegalStateException. "violated the Reactive Streams rule 3.9"))

      (< (+ @demand n) 1)
      (do
        (atomic/set! demand Long/MAX_VALUE)
        (handle-send sub))

      :else
      (do
        (atomic/get-and-add! demand n)
        (handle-send sub)))))

(defn handle-cancel
  "A generic implementation for handle cancel events
  for all types of subscriptions."
  [sub]
  (let [canceled (:canceled sub)]
    (atomic/set! canceled true)))

(defn runnable
  "A runnable constructor for schedule the subscription
  to handle events in a executor/event-loop."
  [sub]
  (let [queue (:queue sub)
        active (:active sub)
        canceled (:canceled sub)]
    (reify Runnable
      (^void run [_]
        (try
          (let [signal (.poll queue)]
            (when (not @canceled)
              (case (:type signal)
                ::request (handle-request sub (:number signal))
                ::send (handle-send sub)
                ::cancel (handle-cancel sub)
                ::subscribe (handle-subscribe sub))))
          (finally
            (atomic/set! active false)
            (when (not (.isEmpty queue))
              (schedule sub))))))))

(definterface IPullStream
  (pull [] "Pull a value from the stream."))

(defn take!
  "Takes a value from a stream, returning a deferred that yields the value
  when it is available or nil if the take fails."
  [^IPullStream p]
  (.pull p))

(defn- publisher->seq
  "Coerce a publisher in a blocking seq."
  [s]
  (lazy-seq
   (let [v @(take! s)]
     (if v
       (cons v (lazy-seq (publisher->seq s)))
       (.close ^AutoCloseable s)))))

(defn subscribe
  "Create a subscription to the given publisher instance.

  The returned subscription does not consumes the publisher
  data until is requested."
  [^Publisher p]
  (let [sr (async/chan)
        lc (CountDownLatch. 1)
        ss (atomic/ref nil)
        sb (reify Subscriber
             (onSubscribe [_ s]
               (.countDown lc)
               (atomic/set! ss s))
             (onNext [_ v]
               (async/put! sr v))
             (onError [_ e]
               (async/close! sr))
             (onComplete [_]
               (async/close! sr)))]
    (.subscribe p sb)
    (reify
      AutoCloseable
      (close [_]
        (.await lc)
        (.cancel @ss))

      Seqable
      (seq [this]
        (.await lc)
        (publisher->seq this))

      IPullStream
      (pull [_]
        (.await lc)
        (let [p (p/promise)]
          (async/take! sr #(p/deliver p %))
          (.request @ss 1)
          p))

      asyncp/ReadPort
      (take! [_ handler]
        (asyncp/take! sr handler)))))

(defn proxy-subscriber
  "Create a proxy subscriber.

  The main purpose of this proxy is apply some
  kind of transformations to the proxied publisher
  using transducers."
  [xform subscriber]
  (let [rf (xform (fn
                    ([s] s)
                    ([s v] (.onNext s v))))
        completed (atomic/boolean false)
        subscription (atomic/ref nil)]
    (reify Subscriber
      (onSubscribe [_ s]
        (atomic/set! subscription s)
        (.onSubscribe subscriber s))
      (onNext [_ v]
        (when-not @completed
          (let [res (rf subscriber v)]
            (cond
              (identical? res subscriber)
              (.request @subscription 1)

              (reduced? res)
              (do
                (.cancel @subscription)
                (.onComplete (rf subscriber))
                (atomic/set! completed true))))))
      (onError [_ e]
        (atomic/set! completed true)
        (rf subscriber)
        (.onError subscriber e))
      (onComplete [_]
        (when-not @completed
          (atomic/set! completed true)
          (rf subscriber)
          (.onComplete subscriber))))))

Use ForkJoinPool/commonPool as default executor.


(ns org.akvo.flow-api.endpoint.utils
  (:require [clojure.string :as s])
  (:import [java.net.URLEncoder]))

(defn url-encode [s]
  (java.net.URLEncoder/encode (str s) "UTF-8"))

(defn query-params-str [m]
  (->> (for [[k v] m
             :when (some? v)]
         (format "%s=%s" (url-encode k)
                 (url-encode v)))
       (s/join "&")))

(defn url-builder
  ([api-root instance path]
   (url-builder api-root instance path nil))
  ([api-root instance path query-params]
   (let [base-url (format "%sorgs/%s/" api-root instance)
         path-url (str base-url path)
         full-url (if query-params
                    (str path-url "?" (query-params-str query-params))
                    path-url)]
     full-url)))

(ns org.akvo.flow-api.endpoint.utils
  (:require [clojure.string :as s])
  (:import [java.net.URLEncoder]))

(defn url-encode [s]
  (java.net.URLEncoder/encode (str s) "UTF-8"))

(defn query-params-str [m]
  (->> (for [[k v] m
             :when (some? v)]
         (format "%s=%s" (url-encode k)
                 (url-encode v)))
       (s/join "&")))

(defn get-api-root [request]
  (let [scheme (name (:scheme request))
        hostname (get (:headers request) "host")]
    (str scheme "://" hostname "/")))

(defn url-builder
  ([api-root instance path]
   (url-builder api-root instance path nil))
  ([api-root instance path query-params]
   (let [base-url (format "%sorgs/%s/" api-root instance)
         path-url (str base-url path)
         full-url (if query-params
                    (str path-url "?" (query-params-str query-params))
                    path-url)]
     full-url)))

Add (enpoint.utils/get-api-root req)

[#176] Add (enpoint.utils/get-api-root req)


(ns org.akvo.flow.dashboard.users.user-details
  (:require [org.akvo.flow.dashboard.components.bootstrap :as b]
            [org.akvo.flow.dashboard.dispatcher :refer (dispatch)]
            [org.akvo.flow.dashboard.ajax-helpers :refer (default-ajax-config)]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer-macros (html)]
            [ajax.core :refer (ajax-request GET POST PUT DELETE)]))

(defn panel-header [{:keys [on-save]} owner])

(defn update-input! [owner key]
  (fn [event]
    (om/set-state! owner key (-> event .-target .-value))))

(defn user-edit-section [{:keys [on-save user]} owner]
  (reify
    om/IInitState
    (init-state [this] user)

    om/IWillReceiveProps
    (will-receive-props [this {:keys [user]}]
      (om/set-state! owner user))

    om/IRenderState
    (render-state [this {:strs [userName emailAddress] :as state}]
      (html
       [:div.userEditSection.topMargin
        [:h2 "User info:"]
        [:form
         [:div.form-group
          [:label.control-label.text-left {:for "username"} "Name"]
          [:input.form-control {:value userName
                                :placeholder "Enter full name"
                                :on-change (update-input! owner "userName")}]]
         [:div.form-group
          [:label.control-label.text-left {:for "email"} "Email"]
          [:input.form-control {:value emailAddress
                                :placeholder "example@gmail.com"
                                :on-change (update-input! owner "emailAddress")}]]
         [:div.form-group
          (b/btn-primary {:class (when (= state user) "disabled")
                          :on-click #(on-save state)}
                         (b/icon :floppy-disk) " Save user info")]]]))))

(defn generate-apikeys [owner user]
  (POST (str "/rest/users/" (get user "keyId") "/apikeys")
        (merge default-ajax-config
               {:handler (fn [response]
                           (let [access-key (get-in response ["apikeys" "accessKey"])
                                 secret (get-in response ["apikeys" "secret"])]
                             (om/set-state! owner {:access-key access-key
                                                   :secret secret})
                             (dispatch :new-access-key {:access-key access-key
                                                        :user user})))})))

(defn revoke-apikeys [owner user]
  (DELETE (str "/rest/users/" (get user "keyId") "/apikeys")
          (merge default-ajax-config
                 {:handler (fn [response]
                             (om/set-state! owner {:access-key nil :secret nil})
                             (dispatch :new-access-key {:access-key nil :user user}))})))

(defn api-keys-section [{:keys [user]} owner]
  (reify
    om/IInitState
    (init-state [this]
      {:access-key (get user "accessKey")
       :secret nil})
    om/IWillReceiveProps
    (will-receive-props [this {:keys [user]}]
      (om/set-state! owner :access-key (get user "accessKey")))
    om/IRenderState
    (render-state [this {:keys [access-key secret]}]
      (html
       [:div.apiKeySection.topMargin
        [:h2 "Manage API key:"]
        [:p "You can (re)generate or revoke an api key for this user"]
        [:form
         [:div.form-group
          [:label.control-label.text-left "Access key"]
          [:input.form-control {:type "text"
                                :value access-key}]]
         [:div.btn-group
          [:button.btn.btn-default {:on-click #(generate-apikeys owner user)}
           (b/icon :refresh) " (Re)generate"]
          [:button.btn.btn-default {:on-click #(revoke-apikeys owner user)}
           (b/icon :ban-circle) " Revoke"]]]]))))

(defn user-details [{:keys [user projects]} owner]
  (om/component
   (html
    [:div
     #_(om/build panel-header {:user user})
     (om/build user-edit-section {:user user
                                  :on-save #(dispatch :edit-user %)})
     #_(om/build roles-and-permissions-section {:user user :projects projects})
     (om/build api-keys-section {:user user})])))

(ns org.akvo.flow.dashboard.users.user-details
  (:require [org.akvo.flow.dashboard.components.bootstrap :as b]
            [org.akvo.flow.dashboard.dispatcher :refer (dispatch)]
            [org.akvo.flow.dashboard.ajax-helpers :refer (default-ajax-config)]
            [om.core :as om :include-macros true]
            [sablono.core :as html :refer-macros (html)]
            [ajax.core :refer (ajax-request GET POST PUT DELETE)]))

(defn panel-header-section [{:keys [user]} owner]
  (om/component
   (html
    [:div.row.panelHeader
     [:div.col-xs-9.text-left.panelTitle
      [:h4
       (b/icon :pencil) " Edit " (get user "userName")]]
     [:div.col-xs-3.text-right
      [:button.btn.btn-primary
       (b/icon :circle-arrow-left) " Go back"]]])))

(defn update-input! [owner key]
  (fn [event]
    (om/set-state! owner key (-> event .-target .-value))))

(defn user-edit-section [{:keys [on-save user]} owner]
  (reify
    om/IInitState
    (init-state [this] user)

    om/IWillReceiveProps
    (will-receive-props [this {:keys [user]}]
      (om/set-state! owner user))

    om/IRenderState
    (render-state [this {:strs [userName emailAddress] :as state}]
      (html
       [:div.userEditSection.topMargin
        [:h2 "User info:"]
        [:form
         [:div.form-group
          [:label.control-label.text-left {:for "username"} "Name"]
          [:input.form-control {:value userName
                                :placeholder "Enter full name"
                                :on-change (update-input! owner "userName")}]]
         [:div.form-group
          [:label.control-label.text-left {:for "email"} "Email"]
          [:input.form-control {:value emailAddress
                                :placeholder "example@gmail.com"
                                :on-change (update-input! owner "emailAddress")}]]
         [:div.form-group
          (b/btn-primary {:class (when (= state user) "disabled")
                          :on-click #(on-save state)}
                         (b/icon :floppy-disk) " Save user info")]]]))))

(defn generate-apikeys [owner user]
  (POST (str "/rest/users/" (get user "keyId") "/apikeys")
        (merge default-ajax-config
               {:handler (fn [response]
                           (let [access-key (get-in response ["apikeys" "accessKey"])
                                 secret (get-in response ["apikeys" "secret"])]
                             (om/set-state! owner {:access-key access-key
                                                   :secret secret})
                             (dispatch :new-access-key {:access-key access-key
                                                        :user user})))})))

(defn revoke-apikeys [owner user]
  (DELETE (str "/rest/users/" (get user "keyId") "/apikeys")
          (merge default-ajax-config
                 {:handler (fn [response]
                             (om/set-state! owner {:access-key nil :secret nil})
                             (dispatch :new-access-key {:access-key nil :user user}))})))

(defn api-keys-section [{:keys [user]} owner]
  (reify
    om/IInitState
    (init-state [this]
      {:access-key (get user "accessKey")
       :secret nil})
    om/IWillReceiveProps
    (will-receive-props [this {:keys [user]}]
      (om/set-state! owner :access-key (get user "accessKey")))
    om/IRenderState
    (render-state [this {:keys [access-key secret]}]
      (html
       [:div.apiKeySection.topMargin
        [:h2 "Manage API key:"]
        [:p "You can (re)generate or revoke an api key for this user"]
        [:form
         [:div.form-group
          [:label.control-label.text-left "Access key"]
          [:input.form-control {:type "text"
                                :value access-key}]]
         [:div.btn-group
          [:button.btn.btn-default {:on-click #(generate-apikeys owner user)}
           (b/icon :refresh) " (Re)generate"]
          [:button.btn.btn-default {:on-click #(revoke-apikeys owner user)}
           (b/icon :ban-circle) " Revoke"]]]]))))

(defn user-details [{:keys [user projects]} owner]
  (om/component
   (html
    [:div
     (om/build panel-header-section {:user user})
     (om/build user-edit-section {:user user
                                  :on-save #(dispatch :edit-user %)})
     #_(om/build roles-and-permissions-section {:user user :projects projects})
     (om/build api-keys-section {:user user})])))

edit user panel header

[#818] edit user panel header