(defmacro debug [form]
  `(let [x# ~form]
     (println (str "Debug: `" (quote ~form)
                   "` is `" (pr-str x#)
                   "`"))
     x#))

(defmacro
  prefer
  [thing other]
  `(let [x# ~thing]
     (if x# x# ~other)))

(defn assoc-conj
  [mp k v]
  (if (empty? mp)
    {k [v]}
    (if (empty? (get mp k))
      (assoc mp k [v])
      (assoc mp k
             (conj
              (mp k)
              v)))))

(defn spec-call [f v]
  (f v))

(def safe-spec-call
  (fnil spec-call (fn [v] true)))

(defn- first-successful
  [result]
  (match
   result
   [:successful _] result
   :else nil))

(defn- resolve-deps
  [repo
   present-packages
   found-packages
   absent-specs
   clauses]
  (if (empty? clauses)
    [:successful (set (vals found-packages))]
    (let [fclause (first clauses)
          rclauses (rest clauses)
          unsuccessful [:unsuccessful fclause]]
      (if (empty? fclause)
        unsuccessful
        (prefer
         (some
          first-successful
          (map
           (fn try-requirement
             [requirement]
             (let [{status :status id :id spec :spec} requirement
                   present-package (get present-packages id)]
               (cond
                 (not (nil? present-package))
                   (if
                       (or (and (= status :absent)
                                (not (safe-spec-call spec present-package)))
                           (and (= status :present)
                                (safe-spec-call spec present-package)))
                     (resolve-deps
                      repo
                      present-packages
                      found-packages
                      absent-specs
                      rclauses)
                     [:forbidden id])
                 (= status :absent)
                 (resolve-deps
                  repo
                  present-packages
                  found-packages
                  (assoc-conj absent-specs id spec)
                  rclauses)
                 (= status :present)
                 (some
                  first-successful
                  (let [candidates (repo id)]
                    (map
                     (fn try-candidate
                       [candidate]
                       (resolve-deps
                        repo
                        (assoc present-packages id candidate)
                        (assoc found-packages id candidate)
                        absent-specs
                        (into rclauses (:requirements candidate))))
                     (filter
                      (fn vet-candidate
                        [candidate]
                        (and
                         (safe-spec-call spec candidate)
                         (reduce (fn [x y]
                          (and x (not (safe-spec-call y candidate))))
                          true
                          (get absent-specs id))))
                      candidates))))
                 :else nil)))
           ;; Hoisting
           (if (= 1 (count fclause))
             fclause
             (let [partn
                   (group-by
                    (fn [term]
                      (let [id (get term :id)]
                        (cond
                          (get
                           absent-specs
                           id)
                          :absent
                          (get
                           present-packages
                           id)
                          :present
                          :else
                          :unspecified)))
                    fclause)]
               (concat (:absent partn) (:present partn) (:unspecified partn))))))
         unsuccessful)))))

(defn resolve-dependencies
  [specs
   query & thing]
  (let [{:keys [present-packages
           conflicts]
          :or {present-packages {}
               conflicts {}}} thing]
  (resolve-deps
   query
   present-packages
   {}
   conflicts
   specs)))

#_(defn -main
    "I don't do a whole lot ... yet."
    [& args]
    (println "Hello, World!"))

(defmacro debug [form]
  `(let [x# ~form]
     (println (str "Debug: `" (quote ~form)
                   "` is `" (pr-str x#)
                   "`"))
     x#))

(defmacro
  prefer
  [thing other]
  `(let [x# ~thing]
     (if x# x# ~other)))

(defn assoc-conj
  [mp k v]
  (if (empty? mp)
    {k [v]}
    (if (empty? (get mp k))
      (assoc mp k [v])
      (assoc mp k
             (conj
              (mp k)
              v)))))

(defn spec-call [f v]
  (f v))

(def safe-spec-call
  (fnil spec-call (fn [v] true)))

(defn- first-successful
  [result]
  (match
   result
   [:successful _] result
   :else nil))

(defn- resolve-deps
  [repo
   present-packages
   found-packages
   absent-specs
   clauses]
  (if (empty? clauses)
    [:successful (set (vals found-packages))]
    (let [fclause (first clauses)
          rclauses (rest clauses)
          unsuccessful [:unsuccessful fclause]]
      (if (empty? fclause)
        unsuccessful
        (prefer
         (some
          first-successful
          (map
           (fn try-requirement
             [requirement]
             (let [{status :status id :id spec :spec} requirement
                   present-package (get present-packages id)]
               (cond
                 (not (nil? present-package))
                   (when
                       (or (and (= status :absent)
                                (not (safe-spec-call spec present-package)))
                           (and (= status :present)
                                (safe-spec-call spec present-package)))
                     (resolve-deps
                      repo
                      present-packages
                      found-packages
                      absent-specs
                      rclauses))
                 (= status :absent)
                 (resolve-deps
                  repo
                  present-packages
                  found-packages
                  (assoc-conj absent-specs id spec)
                  rclauses)
                 (= status :present)
                 (some
                  first-successful
                  (let [candidates (repo id)]
                    (map
                     (fn try-candidate
                       [candidate]
                       (resolve-deps
                        repo
                        (assoc present-packages id candidate)
                        (assoc found-packages id candidate)
                        absent-specs
                        (into rclauses (:requirements candidate))))
                     (filter
                      (fn vet-candidate
                        [candidate]
                        (and
                         (safe-spec-call spec candidate)
                         (reduce (fn [x y]
                          (and x (not (safe-spec-call y candidate))))
                          true
                          (get absent-specs id))))
                      candidates))))
                 :else nil)))
           ;; Hoisting
           (if (= 1 (count fclause))
             fclause
             (let [partn
                   (group-by
                    (fn [term]
                      (let [id (get term :id)]
                        (cond
                          (get
                           absent-specs
                           id)
                          :absent
                          (get
                           present-packages
                           id)
                          :present
                          :else
                          :unspecified)))
                    fclause)]
               (concat (:absent partn) (:present partn) (:unspecified partn))))))
         unsuccessful)))))

(defn resolve-dependencies
  [specs
   query & thing]
  (let [{:keys [present-packages
           conflicts]
          :or {present-packages {}
               conflicts {}}} thing]
  (resolve-deps
   query
   present-packages
   {}
   conflicts
   specs)))

#_(defn -main
    "I don't do a whole lot ... yet."
    [& args]
    (println "Hello, World!"))

Revert "Start adding forbidden again, running all tests"

This reverts commit 5a96a7cfba4e9e2c1e3f9fe93a03fb9dce44e00e.


;
;  (C) Copyright 2016  Pavel Tisnovsky
;
;  All rights reserved. This program and the accompanying materials
;  are made available under the terms of the Eclipse Public License v1.0
;  which accompanies this distribution, and is available at
;  http://www.eclipse.org/legal/epl-v10.html
;
;  Contributors:
;      Pavel Tisnovsky
;

(ns emender-jenkins.results)

(require '[clojure.pprint :as pprint])

(require '[emender-jenkins.file-utils  :as file-utils])
(require '[emender-jenkins.jenkins-api :as jenkins-api])
(require '[emender-jenkins.config      :as config])

(def results (atom nil))

(defn render-edn-data
    "Render EDN data to be used for debugging purposes etc."
    [output-data pretty-print?]
    (if pretty-print?
        (with-out-str (pprint/pprint output-data))
        (with-out-str (println output-data))))

(defn add-new-results
    [job-name new-results]
    (swap! results assoc job-name new-results))

(defn store-results
    [pretty-print?]
    (let [edn-data (render-edn-data @results pretty-print?)]
        (spit "results2.edn" edn-data)
        ; rename files atomically (on the same filesystem)
        (file-utils/mv-file "results2.edn" "results.edn")))

(defn job-name->product-name
    [job-name]
    (let [name-version (clojure.string/split job-name #"-")
          product-name (second name-version)]
          (if product-name
              (clojure.string/replace product-name "_" " "))))

(defn job-name->version
    [job-name]
    (let [name-version (clojure.string/split job-name #"-")
          version      (get name-version 2)]
          (if (and version (re-matches #"[0-9.]+" version))
              version
              "unknown")))

(defn job-name->book-name
    [job-name]
    (let [name-version (clojure.string/split job-name #"-")
          book-name    (get name-version 3)]
          (if book-name
              (clojure.string/replace book-name "_" " ")
              "unknown")))

(defn job-name->environment
    [job-name preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix]
    (cond
        (.endsWith job-name preview-jobs-suffix) :preview
        (.endsWith job-name stage-jobs-suffix)   :stage
        (.endsWith job-name prod-jobs-suffix)    :prod))

(defn compute-job-status
    [jenkins-job-status buildable?]
    ; check if the 'disabled' option is set in job config
    (if (not buildable?)
        :disabled
        (if jenkins-job-status ; job is buildable, so let's check the icon
            (cond (= jenkins-job-status "blue")     :ok
                  (= jenkins-job-status "yellow")   :unstable
                  (= jenkins-job-status "disabled") :disabled ; should it happen?
                  :else                             :failure)
            :does-not-exists)))

(defn compute-job-disabled
    [jenkins-job-status buildable?]
    ; check if the 'disabled' option is set in job config
    (if (not buildable?)
        true
        (if jenkins-job-status ; job is buildable, so let's check the icon
            (cond (= jenkins-job-status "blue")     false
                  (= jenkins-job-status "yellow")   false
                  (= jenkins-job-status "disabled") true
                  :else                             false)
            true)))

(defn parse-int
    [string]
    (java.lang.Integer/parseInt string))

(defn parse-test-results
    [message]
    (if message
        (let [parsed (re-matches #"Total: ([0-9]+)  Passed: ([0-9]+)  Failed: ([0-9]+)" message)]
            (if (= (count parsed) 4)
                {:total  (parse-int (get parsed 1))
                 :passed (parse-int (get parsed 2))
                 :failed (parse-int (get parsed 3))}))))

(defn read-update-job-info
    [job-list preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix]
    (for [job job-list]
        (let [job-name (get job "name")
              job-color  (get job "color")
              buildable? (get job "buildable")
              message    (-> (get job "lastSuccessfulBuild")
                             (get "description"))]
            {:job-name    job-name
             :product     (job-name->product-name job-name)
             :version     (job-name->version job-name)
             :environment (job-name->environment job-name preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)
             :book-name   (job-name->book-name job-name)
             :job-status  (compute-job-status job-color buildable?)
             :disabled    (compute-job-disabled job-color buildable?)
             :message     message
             :results     (parse-test-results message)
            })))

(defn reload-all-results
    [configuration]
    (let [preview-jobs-suffix (-> configuration :jobs    :preview-test-jobs-suffix)
          stage-jobs-suffix   (-> configuration :jobs    :stage-test-jobs-suffix)
          prod-jobs-suffix    (-> configuration :jobs    :prod-test-jobs-suffix)
          job-list (jenkins-api/read-list-of-test-jobs (-> configuration :jenkins :jenkins-url)
                                                       (-> configuration :jenkins :jenkins-job-list-url)
                                                       preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)
          job-results (read-update-job-info job-list   preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)]
          (clojure.pprint/pprint job-results)
          ;(spit "test.edn" (with-out-str (clojure.pprint/pprint job-results)))
          ;job-results (read-all-test-results configuration job-list)]
          (reset! results job-results)
          ;job-results))
))

(defn select-jobs
    [results pred]
    (into []
        (filter pred results)))

(defn read-job-results
    [product version]
    (cond
        (and product version) (select-jobs @results #(and (= product (:product %)) (= version (:version %))))
        product               (select-jobs @results #(= product (:product %)))
        :else                 (into [] @results)))

(defn all-products
    "Returns set containing names of all products taken from results."
    [results]
    (into #{} (for [result results] (:product result))))

(defn versions-per-products
    "Returns set containing versions for given product."
    [product results]
    (into #{} (for [result results :when (= (:product result) product)] (:version result))))

(defn books-for-product-version
    [results product version]
    (into #{}
    (for [job (select-jobs results #(and (= product (:product %)) (= version (:version %))))]
        (:book-name job))))

(defn job-for-environment
    [product version book-name environment results]
    (-> (select-jobs results #(and (= product (:product %))
                                   (= version (:version %))
                                   (= book-name (:book-name %))
                                   (= environment (:environment %))))
        first))

(defn select-results-for-book
    "Select results for given book and return them as a map with results separated for preview, stage, prod."
    [product version book-name results]
    {:preview (job-for-environment product version book-name :preview results)
     :stage   (job-for-environment product version book-name :stage   results)
     :prod    (job-for-environment product version book-name :prod    results)})

(defn select-results-for-product-version
    "Select results for all books for given product and version."
    [product version results]
    (into {}
          (for [book (books-for-product-version results product version)]
               [book (select-results-for-book product version book results)])))

(defn select-results-for-product
    "Select results for all books for given product."
    [product results]
    (into {}
          (for [version (versions-per-products product results)]
               [version (select-results-for-product-version product version results)])))

(defn get-job-results
    [product version]
    (let [results  (read-job-results product version)
          products (all-products results)] ; set of all products read from test results
          (into {}
                (for [product products]
                     [product (select-results-for-product product results)]))))

(defn find-job-with-name
    [job-name]
    (some #(if (= job-name (:job-name %)) %) @results))

(defn job-exists?
    [job-name]
    (if job-name
        (some #(= job-name (:job-name %)) @results)))

; REPL testing
;(def results (atom (clojure.edn/read-string (slurp "x.edn"))))

;
;  (C) Copyright 2016  Pavel Tisnovsky
;
;  All rights reserved. This program and the accompanying materials
;  are made available under the terms of the Eclipse Public License v1.0
;  which accompanies this distribution, and is available at
;  http://www.eclipse.org/legal/epl-v10.html
;
;  Contributors:
;      Pavel Tisnovsky
;

(ns emender-jenkins.results)

(require '[clojure.pprint :as pprint])

(require '[emender-jenkins.file-utils  :as file-utils])
(require '[emender-jenkins.jenkins-api :as jenkins-api])
(require '[emender-jenkins.config      :as config])

(def results (atom nil))

(defn render-edn-data
    "Render EDN data to be used for debugging purposes etc."
    [output-data pretty-print?]
    (if pretty-print?
        (with-out-str (pprint/pprint output-data))
        (with-out-str (println output-data))))

(defn add-new-results
    [job-name new-results]
    (swap! results assoc job-name new-results))

(defn store-results
    [pretty-print?]
    (let [edn-data (render-edn-data @results pretty-print?)]
        (spit "results2.edn" edn-data)
        ; rename files atomically (on the same filesystem)
        (file-utils/mv-file "results2.edn" "results.edn")))

(defn job-name->product-name
    [job-name]
    (let [name-version (clojure.string/split job-name #"-")
          product-name (second name-version)]
          (if product-name
              (clojure.string/replace product-name "_" " "))))

(defn job-name->version
    [job-name]
    (let [name-version (clojure.string/split job-name #"-")
          version      (get name-version 2)]
          (if (and version (re-matches #"[0-9.]+" version))
              version
              "unknown")))

(defn job-name->book-name
    [job-name]
    (let [name-version (clojure.string/split job-name #"-")
          book-name    (get name-version 3)]
          (if book-name
              (clojure.string/replace book-name "_" " ")
              "unknown")))

(defn job-name->environment
    [job-name preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix]
    (cond
        (.endsWith job-name preview-jobs-suffix) :preview
        (.endsWith job-name stage-jobs-suffix)   :stage
        (.endsWith job-name prod-jobs-suffix)    :prod))

(defn compute-job-status
    [jenkins-job-status buildable?]
    ; check if the 'disabled' option is set in job config
    (if (not buildable?)
        :disabled
        (if jenkins-job-status ; job is buildable, so let's check the icon
            (cond (= jenkins-job-status "blue")     :ok
                  (= jenkins-job-status "yellow")   :unstable
                  (= jenkins-job-status "disabled") :disabled ; should it happen?
                  :else                             :failure)
            :does-not-exists)))

(defn compute-job-disabled
    [jenkins-job-status buildable?]
    ; check if the 'disabled' option is set in job config
    (if (not buildable?)
        true
        (if jenkins-job-status ; job is buildable, so let's check the icon
            (cond (= jenkins-job-status "blue")     false
                  (= jenkins-job-status "yellow")   false
                  (= jenkins-job-status "disabled") true
                  :else                             false)
            true)))

(defn parse-int
    [string]
    (java.lang.Integer/parseInt string))

(defn parse-test-results
    [message]
    (if message
        (let [parsed (re-matches #"Total: ([0-9]+)  Passed: ([0-9]+)  Failed: ([0-9]+)" message)]
            (if (= (count parsed) 4)
                {:total  (parse-int (get parsed 1))
                 :passed (parse-int (get parsed 2))
                 :failed (parse-int (get parsed 3))}))))

(defn read-update-job-info
    [job-list preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix]
    (for [job job-list]
        (let [job-name (get job "name")
              job-color  (get job "color")
              buildable? (get job "buildable")
              message    (-> (get job "lastSuccessfulBuild")
                             (get "description"))]
            {:job-name    job-name
             :product     (job-name->product-name job-name)
             :version     (job-name->version job-name)
             :environment (job-name->environment job-name preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)
             :book-name   (job-name->book-name job-name)
             :job-status  (compute-job-status job-color buildable?)
             :disabled    (compute-job-disabled job-color buildable?)
             :message     message
             :results     (parse-test-results message)
            })))

(defn reload-all-results
    [configuration]
    (let [preview-jobs-suffix (-> configuration :jobs    :preview-test-jobs-suffix)
          stage-jobs-suffix   (-> configuration :jobs    :stage-test-jobs-suffix)
          prod-jobs-suffix    (-> configuration :jobs    :prod-test-jobs-suffix)
          job-list (jenkins-api/read-list-of-test-jobs (-> configuration :jenkins :jenkins-url)
                                                       (-> configuration :jenkins :jenkins-job-list-url)
                                                       preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)
          job-results (read-update-job-info job-list   preview-jobs-suffix stage-jobs-suffix prod-jobs-suffix)]
          (clojure.pprint/pprint job-results)
          ;(spit "test.edn" (with-out-str (clojure.pprint/pprint job-results)))
          ;job-results (read-all-test-results configuration job-list)]
          (reset! results job-results)
          ;job-results))
))

(defn select-jobs
    [results pred]
    (into []
        (filter pred results)))

(defn read-job-results
    [product version]
    (cond
        (and product version) (select-jobs @results #(and (= product (:product %)) (= version (:version %))))
        product               (select-jobs @results #(= product (:product %)))
        :else                 (into [] @results)))

(defn all-products
    "Returns set containing names of all products taken from results."
    [results]
    (into #{} (for [result results] (:product result))))

(defn versions-per-products
    "Returns set containing versions for given product."
    [product results]
    (into #{} (for [result results :when (= (:product result) product)] (:version result))))

(defn books-for-product-version
    [results product version]
    (into #{}
    (for [job (select-jobs results #(and (= product (:product %)) (= version (:version %))))]
        (:book-name job))))

(defn job-for-environment
    [product version book-name environment results]
    (-> (select-jobs results #(and (= product (:product %))
                                   (= version (:version %))
                                   (= book-name (:book-name %))
                                   (= environment (:environment %))))
        first))

(defn select-results-for-book
    "Select results for given book and return them as a map with results separated for preview, stage, prod."
    [product version book-name results]
    {:jobs
        {:preview (job-for-environment product version book-name :preview results)
         :stage   (job-for-environment product version book-name :stage   results)
         :prod    (job-for-environment product version book-name :prod    results)}})

(defn select-results-for-product-version
    "Select results for all books for given product and version."
    [product version results]
    {:books
        (into {}
              (for [book (books-for-product-version results product version)]
                   [book (select-results-for-book product version book results)]))})

(defn select-results-for-product
    "Select results for all books for given product."
    [product results]
    {:versions
        (into {}
              (for [version (versions-per-products product results)]
                   [version (select-results-for-product-version product version results)]))})

(defn get-job-results
    [product version]
    (let [results  (read-job-results product version)
          products (all-products results)] ; set of all products read from test results
          {:products
              (into {}
                    (for [product products]
                         [product (select-results-for-product product results)]))}))

(defn find-job-with-name
    [job-name]
    (some #(if (= job-name (:job-name %)) %) @results))

(defn job-exists?
    [job-name]
    (if job-name
        (some #(= job-name (:job-name %)) @results)))

; REPL testing
; (require '[clojure.pprint :as pprint])
; (require '[clojure.edn])
; (def results (atom (clojure.edn/read-string (slurp "x.edn"))))

; (clojure.pprint/pprint
; (get-job-results "Red Hat Enterprise Linux" "6")
; )

Use proper metadata-like format for get_jobs


(ns com.sixsq.slipstream.ssclj.resources.common.utils-expectations-test
  (:require
    [com.sixsq.slipstream.ssclj.resources.common.utils :refer :all]
    [expectations :refer :all]
    [com.sixsq.slipstream.ssclj.resources.common.utils :as u]))

;;
;; Base64 encoding
;;

(let [round-trip (comp decode-base64 encode-base64)
      values     ["alpha"
                  2
                  true
                  3.14
                  {:alpha "alpha"}]]

  (expect (from-each [v values]
                     (= v (round-trip v)))))

(expect "" (u/de-camelcase ""))
(expect "abc" (u/de-camelcase "Abc"))
(expect "abc-def" (u/de-camelcase "AbcDef"))

;; given string must be lisp-cased, if not empty string returned
(expect "" (u/lisp-to-camelcase "Abc"))
(expect "" (u/lisp-to-camelcase "-"))
(expect "" (u/lisp-to-camelcase "abc-"))
(expect "" (u/lisp-to-camelcase "abc--def"))
(expect "" (u/lisp-to-camelcase "abc-Def-ghi"))
(expect "" (u/lisp-to-camelcase ""))

(expect "Abc" (u/lisp-to-camelcase "abc"))
(expect "AbcDef" (u/lisp-to-camelcase "abc-def"))

(expect "{\"http:\\/\\/example.org\\/a\\/b.json\":\"truc\"}\n"
        (u/serialize {:http://example.org/a/b.json "truc"}))

(expect "{\"http:\\/\\/example.org\\/a\\/b.json\":\"truc\"}\n"
        (u/serialize {"http://example.org/a/b.json" "truc"}))

(run-all-tests)

(ns com.sixsq.slipstream.ssclj.resources.common.utils-expectations-test
  (:require
    [clojure.test :refer [deftest are is]]
    [com.sixsq.slipstream.ssclj.resources.common.utils :refer :all]
    [com.sixsq.slipstream.ssclj.resources.common.utils :as u]))

(deftest check-encoding
  (let [round-trip (comp decode-base64 encode-base64)
        values ["alpha"
                2
                true
                3.14
                {:alpha "alpha"}]]

    (doseq [v values]
           (is (= v (round-trip v))))))

(deftest check-de-camelcase
  (are [expect arg] (= expect (u/de-camelcase arg))
                    "" ""
                    "abc" "Abc"
                    "abc-def" "AbcDef"))

;; given string must be lisp-cased, if not empty string returned
(deftest check-list-to-camelcase
  (are [expect arg] (= expect (u/lisp-to-camelcase arg))
                    "" "Abc"
                    "" "-"
                    "" "abc-"
                    "" "abc--def"
                    "" "abc-Def-ghi"
                    "" ""
                    "Abc" "abc"
                    "AbcDef" "abc-def"))

(deftest check-serialize
  (is (= "{\"http:\\/\\/example.org\\/a\\/b.json\":\"truc\"}\n"
         (u/serialize {:http://example.org/a/b.json "truc"})))
  (is (= "{\"http:\\/\\/example.org\\/a\\/b.json\":\"truc\"}\n"
         (u/serialize {"http://example.org/a/b.json" "truc"}))))

remove expectations

remove expectations


(ns clj-money.web.attachments
  (:refer-clojure :exclude [update])
  (:require [clojure.tools.logging :as log]
            [clojure.pprint :refer [pprint]]
            [clojure.string :refer [blank?]]
            [environ.core :refer [env]]
            [hiccup.core :refer :all]
            [hiccup.page :refer :all]
            [ring.util.response :refer :all]
            [ring.util.codec :refer [url-encode]]
            [cemerick.friend :as friend]
            [clj-money.io :refer [read-bytes]]
            [clj-money.pagination :as pagination]
            [clj-money.validation :as validation]
            [clj-money.models.images :as images]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.attachments :as attachments])
  (:use [clj-money.web.shared :refer :all]))

(defn- attachment-row
  [attachment]
  [:tr
   [:td
    [:a {:href (format "/images/%s" (:image-id attachment))
         :target "_blank"}
     (:caption attachment)]]
   [:td.text-center
    [:div.btn-group
     [:a.btn.btn-xs.btn-danger
      {:href (format "/attachments/%s/delete" (:id attachment))
       :title "Click here to remove this attachment"
       :data-method "POST"
       :data-confirm "Are you sure you want to remove this attachment?" }
      [:span.glyphicon.glyphicon-remove {:aria-hidden true}]]]]])

(defn index
  [{{transaction-id :transaction-id} :params}]
  (let [transaction (transactions/find-by-id (env :db)
                                             (Integer. transaction-id))
        attachments (attachments/search
                      (env :db)
                      {:transaction-id (:id transaction)})]
    (with-layout "Attachments" {}
      [:div.row
       [:div.col-md-4
        [:table.table.table-striped
         [:tr
          [:th "Caption"]
          [:th " "]]
         (map attachment-row attachments)]]]
      [:a.btn.btn-primary {:href (format "/transactions/%s/attachments/new" transaction-id)}
       "Add"]
      " "
      ; TODO Fix this hack, we need to know the correct account to go back to
      [:a.btn.btn-default
       {:href (format "/accounts/%s"
                      (-> transaction :items first :account-id))}
       "Back"])))

(defn new-attachment
  ([{{transaction-id :transaction-id} :params :as req}]
   (new-attachment req {:transaction-id (Integer. transaction-id)}))
  ([_ attachment]
   (with-layout "New attachment" {}
     [:div.row
      [:div.col-md-6
       [:pre (prn-str attachment)]
       (form (format "/transactions/%s/attachments"
                     (:transaction-id attachment)) {:enctype "multipart/form-data"}
             (text-input-field attachment :caption {:autofocus true})
             (file-input-field attachment :source-file)
             [:button.btn.btn-primary {:type :submit}
              "Submit"])]])))

(defn- prepare-file-data
  [params]
  (let [user (friend/current-authentication)
        image (images/find-or-create (env :db)
                                     {:user-id (:id user)
                                      :original-filename (-> params
                                                             :source-file
                                                             :filename)
                                      :body (-> params
                                                :source-file
                                                :tempfile
                                                read-bytes)})]
    (cond-> params
      true
      (assoc :image-id (:id image)
             :content-type (-> params :source-file :content-type))

      (blank? (:caption params))
      (assoc :caption (-> params :source-file :filename)))))

(defn create
  [{params :params}]
  (let [attachment (->> params
                        prepare-file-data
                        (attachments/create (env :db)))]
    (if (seq (validation/error-messages attachment))
      (new-attachment nil attachment)
      (redirect (format "/transactions/%s/attachments"
                        (:transaction-id params))))))

(defn edit
  [req]
  "edit")

(defn update
  [req]
  "update")

(defn delete
  [{params :params}]
  (let [attachment (attachments/find-by-id (env :db) (Integer. (:id params)))]
    (attachments/delete (env :db) attachment)
    (redirect (format "/transactions/%s/attachments"
                      (:transaction-id attachment)))))

(ns clj-money.web.attachments
  (:refer-clojure :exclude [update])
  (:require [clojure.tools.logging :as log]
            [clojure.pprint :refer [pprint]]
            [clojure.string :refer [blank?]]
            [environ.core :refer [env]]
            [hiccup.core :refer :all]
            [hiccup.page :refer :all]
            [ring.util.response :refer :all]
            [ring.util.codec :refer [url-encode]]
            [cemerick.friend :as friend]
            [clj-money.io :refer [read-bytes]]
            [clj-money.pagination :as pagination]
            [clj-money.validation :as validation]
            [clj-money.models.images :as images]
            [clj-money.models.transactions :as transactions]
            [clj-money.models.attachments :as attachments])
  (:use [clj-money.web.shared :refer :all]))

(defn- attachment-row
  [attachment]
  [:tr
   [:td
    [:a {:href (format "/images/%s" (:image-id attachment))
         :target "_blank"}
     (:caption attachment)]]
   [:td.text-center
    [:div.btn-group
     [:a.btn.btn-xs.btn-danger
      {:href (format "/attachments/%s/delete" (:id attachment))
       :title "Click here to remove this attachment"
       :data-method "POST"
       :data-confirm "Are you sure you want to remove this attachment?" }
      [:span.glyphicon.glyphicon-remove {:aria-hidden true}]]]]])

(defn index
  [{{transaction-id :transaction-id} :params}]
  (let [transaction (transactions/find-by-id (env :db)
                                             (Integer. transaction-id))
        attachments (attachments/search
                      (env :db)
                      {:transaction-id (:id transaction)})]
    (with-layout "Attachments" {}
      [:div.row
       [:div.col-md-4
        [:table.table.table-striped
         [:tr
          [:th "Caption"]
          [:th " "]]
         (map attachment-row attachments)]]]
      [:a.btn.btn-primary {:href (format "/transactions/%s/attachments/new" transaction-id)}
       "Add"]
      " "
      ; TODO Fix this hack, we need to know the correct account to go back to
      [:a.btn.btn-default
       {:href (format "/accounts/%s"
                      (-> transaction :items first :account-id))}
       "Back"])))

(defn new-attachment
  ([{{transaction-id :transaction-id} :params :as req}]
   (new-attachment req {:transaction-id (Integer. transaction-id)}))
  ([_ attachment]
   (with-layout "New attachment" {}
     [:div.row
      [:div.col-md-6
       (form (format "/transactions/%s/attachments"
                     (:transaction-id attachment)) {:enctype "multipart/form-data"}
             (text-input-field attachment :caption {:autofocus true})
             (file-input-field attachment :source-file)
             [:button.btn.btn-primary {:type :submit}
              "Submit"])]])))

(defn- prepare-file-data
  [params]
  (let [user (friend/current-authentication)
        image (images/find-or-create (env :db)
                                     {:user-id (:id user)
                                      :original-filename (-> params
                                                             :source-file
                                                             :filename)
                                      :body (-> params
                                                :source-file
                                                :tempfile
                                                read-bytes)})]
    (cond-> params
      true
      (assoc :image-id (:id image)
             :content-type (-> params :source-file :content-type))

      (blank? (:caption params))
      (assoc :caption (-> params :source-file :filename)))))

(defn create
  [{params :params}]
  (let [attachment (->> params
                        prepare-file-data
                        (attachments/create (env :db)))]
    (if (seq (validation/error-messages attachment))
      (new-attachment nil attachment)
      (redirect (format "/transactions/%s/attachments"
                        (:transaction-id params))))))

(defn edit
  [req]
  "edit")

(defn update
  [req]
  "update")

(defn delete
  [{params :params}]
  (let [attachment (attachments/find-by-id (env :db) (Integer. (:id params)))]
    (attachments/delete (env :db) attachment)
    (redirect (format "/transactions/%s/attachments"
                      (:transaction-id attachment)))))

remove trace content

remove trace content


;;  Copyright (c) Rich Hickey. All rights reserved.
;;  The use and distribution terms for this software are covered by the
;;  Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;;  which can be found in the file epl-v10.html at the root of this distribution.
;;  By using this software in any fashion, you are agreeing to be bound by
;;  the terms of this license.
;;  You must not remove this notice, or any other, from this software.

(ns ^{:doc "Network communication library, wrapping goog.net.
Includes a common API over XhrIo, CrossPageChannel, and Websockets."
      :author "Bobby Calderwood and Alex Redington"}
  clojure.browser.net
  (:require [clojure.browser.event :as event]
            [goog.json :as gjson])
  (:import (goog.net XhrIo EventType)
           (goog.net.xpc CfgFields CrossPageChannel)
           goog.Uri))

(def *timeout* 10000)

(def event-types
  (into {}
        (map
         (fn [[k v]]
           [(keyword (.toLowerCase k))
            v])
         (merge
          (js->clj EventType)))))

(defprotocol IConnection
  (connect
    [this]
    [this opt1]
    [this opt1 opt2]
    [this opt1 opt2 opt3])
  (transmit
    [this opt]
    [this opt opt2]
    [this opt opt2 opt3]
    [this opt opt2 opt3 opt4]
    [this opt opt2 opt3 opt4 opt5])
  (close [this]))

(extend-type XhrIo

  IConnection
  (transmit
    ([this uri]
       (transmit this uri "GET"  nil nil *timeout*))
    ([this uri method]
       (transmit this uri method nil nil *timeout*))
    ([this uri method content]
       (transmit this uri method content nil *timeout*))
    ([this uri method content headers]
       (transmit this uri method content headers *timeout*))
    ([this uri method content headers timeout]
       (.setTimeoutInterval this timeout)
       (.send this uri method content headers)))

  event/EventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (.toLowerCase k))
              v])
           (merge
            (js->clj EventType))))))

;; TODO jQuery/sinatra/RestClient style API: (get [uri]), (post [uri payload]), (put [uri payload]), (delete [uri])

(def xpc-config-fields
  (into {}
        (map
         (fn [[k v]]
           [(keyword (.toLowerCase k))
            v])
         (js->clj CfgFields))))

(defn xhr-connection
  "Returns an XhrIo connection"
  []
  (XhrIo.))

(defprotocol ICrossPageChannel
  (register-service [this service-name fn] [this service-name fn encode-json?]))

(extend-type CrossPageChannel

  ICrossPageChannel
  (register-service
    ([this service-name fn]
       (register-service this service-name fn false))
    ([this service-name fn encode-json?]
       (.registerService this (name service-name) fn encode-json?)))

  IConnection
  (connect
    ([this]
       (connect this nil))
    ([this on-connect-fn]
       (.connect this on-connect-fn))
    ([this on-connect-fn config-iframe-fn]
       (connect this on-connect-fn config-iframe-fn (.-body js/document)))
    ([this on-connect-fn config-iframe-fn iframe-parent]
       (.createPeerIframe this iframe-parent config-iframe-fn)
       (.connect this on-connect-fn)))

  (transmit [this service-name payload]
    (.send this (name service-name) payload))

  (close [this]
    (.close this)))

(defn xpc-connection
  "When passed with a config hash-map, returns a parent
  CrossPageChannel object. Keys in the config hash map are downcased
  versions of the goog.net.xpc.CfgFields enum keys,
  e.g. goog.net.xpc.CfgFields.PEER_URI becomes :peer_uri in the config
  hash.

  When passed with no args, creates a child CrossPageChannel object,
  and the config is automatically taken from the URL param 'xpc', as
  per the CrossPageChannel API."
  ([]
     (when-let [config (.getParameterValue
                        (Uri. (.-href (.-location js/window)))
                        "xpc")]
       (CrossPageChannel. (gjson/parse config))))
  ([config]
     (CrossPageChannel.
      (reduce (fn [sum [k v]]
                (if-let [field (get xpc-config-fields k)]
                  (doto sum (aset field v))
                  sum))
              (js-obj)
              config))))

;; WebSocket is not supported in the 3/23/11 release of Google
;; Closure, but will be included in the next release.

#_(defprotocol IWebSocket
    (open? [this]))

#_(extend-type goog.net.WebSocket

  IWebSocket
  (open? [this]
    (.isOpen this ()))

  IConnection
  (connect
    ([this url]
       (connect this url nil))
    ([this url protocol]
       (.open this url protocol)))

  (transmit [this message]
    (.send this message))

  (close [this]
    (.close this ()))

  event/EventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (. k (toLowerCase)))
              v])
           (merge
            (js->clj goog.net.WebSocket/EventType))))))

#_(defn websocket-connection
  ([]
     (websocket-connection nil nil))
  ([auto-reconnect?]
     (websocket-connection auto-reconnect? nil))
  ([auto-reconnect? next-reconnect-fn]
     (goog.net.WebSocket. auto-reconnect? next-reconnect-fn)))

;;  Copyright (c) Rich Hickey. All rights reserved.
;;  The use and distribution terms for this software are covered by the
;;  Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;;  which can be found in the file epl-v10.html at the root of this distribution.
;;  By using this software in any fashion, you are agreeing to be bound by
;;  the terms of this license.
;;  You must not remove this notice, or any other, from this software.

(ns ^{:doc "Network communication library, wrapping goog.net.
Includes a common API over XhrIo, CrossPageChannel, and Websockets."
      :author "Bobby Calderwood and Alex Redington"}
  clojure.browser.net
  (:require [clojure.browser.event :as event]
            [goog.json :as gjson])
  (:import (goog.net XhrIo EventType)
           (goog.net.xpc CfgFields CrossPageChannel)
           goog.Uri))

(def *timeout* 10000)

(def event-types
  (into {}
        (map
         (fn [[k v]]
           [(keyword (.toLowerCase k))
            v])
         (merge
          (js->clj EventType)))))

(defprotocol IConnection
  (connect
    [this]
    [this opt1]
    [this opt1 opt2]
    [this opt1 opt2 opt3])
  (transmit
    [this opt]
    [this opt opt2]
    [this opt opt2 opt3]
    [this opt opt2 opt3 opt4]
    [this opt opt2 opt3 opt4 opt5])
  (close [this]))

(extend-type XhrIo

  IConnection
  (transmit
    ([this uri]
       (transmit this uri "GET"  nil nil *timeout*))
    ([this uri method]
       (transmit this uri method nil nil *timeout*))
    ([this uri method content]
       (transmit this uri method content nil *timeout*))
    ([this uri method content headers]
       (transmit this uri method content headers *timeout*))
    ([this uri method content headers timeout]
       (.setTimeoutInterval this timeout)
       (.send this uri method content headers)))

  event/IEventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (.toLowerCase k))
              v])
           (merge
            (js->clj EventType))))))

;; TODO jQuery/sinatra/RestClient style API: (get [uri]), (post [uri payload]), (put [uri payload]), (delete [uri])

(def xpc-config-fields
  (into {}
        (map
         (fn [[k v]]
           [(keyword (.toLowerCase k))
            v])
         (js->clj CfgFields))))

(defn xhr-connection
  "Returns an XhrIo connection"
  []
  (XhrIo.))

(defprotocol ICrossPageChannel
  (register-service [this service-name fn] [this service-name fn encode-json?]))

(extend-type CrossPageChannel

  ICrossPageChannel
  (register-service
    ([this service-name fn]
       (register-service this service-name fn false))
    ([this service-name fn encode-json?]
       (.registerService this (name service-name) fn encode-json?)))

  IConnection
  (connect
    ([this]
       (connect this nil))
    ([this on-connect-fn]
       (.connect this on-connect-fn))
    ([this on-connect-fn config-iframe-fn]
       (connect this on-connect-fn config-iframe-fn (.-body js/document)))
    ([this on-connect-fn config-iframe-fn iframe-parent]
       (.createPeerIframe this iframe-parent config-iframe-fn)
       (.connect this on-connect-fn)))

  (transmit [this service-name payload]
    (.send this (name service-name) payload))

  (close [this]
    (.close this)))

(defn xpc-connection
  "When passed with a config hash-map, returns a parent
  CrossPageChannel object. Keys in the config hash map are downcased
  versions of the goog.net.xpc.CfgFields enum keys,
  e.g. goog.net.xpc.CfgFields.PEER_URI becomes :peer_uri in the config
  hash.

  When passed with no args, creates a child CrossPageChannel object,
  and the config is automatically taken from the URL param 'xpc', as
  per the CrossPageChannel API."
  ([]
     (when-let [config (.getParameterValue
                        (Uri. (.-href (.-location js/window)))
                        "xpc")]
       (CrossPageChannel. (gjson/parse config))))
  ([config]
     (CrossPageChannel.
      (reduce (fn [sum [k v]]
                (if-let [field (get xpc-config-fields k)]
                  (doto sum (aset field v))
                  sum))
              (js-obj)
              config))))

;; WebSocket is not supported in the 3/23/11 release of Google
;; Closure, but will be included in the next release.

#_(defprotocol IWebSocket
    (open? [this]))

#_(extend-type goog.net.WebSocket

  IWebSocket
  (open? [this]
    (.isOpen this ()))

  IConnection
  (connect
    ([this url]
       (connect this url nil))
    ([this url protocol]
       (.open this url protocol)))

  (transmit [this message]
    (.send this message))

  (close [this]
    (.close this ()))

  event/EventType
  (event-types [this]
    (into {}
          (map
           (fn [[k v]]
             [(keyword (. k (toLowerCase)))
              v])
           (merge
            (js->clj goog.net.WebSocket/EventType))))))

#_(defn websocket-connection
  ([]
     (websocket-connection nil nil))
  ([auto-reconnect?]
     (websocket-connection auto-reconnect? nil))
  ([auto-reconnect? next-reconnect-fn]
     (goog.net.WebSocket. auto-reconnect? next-reconnect-fn)))

fix protocol typo, event/EventType -> event/IEventType


(ns leiningen.new
  "Create a new project skeleton.
lein new [group-id/]artifact-id [project-dir]
Group-id is optional. Project-dir defaults to artifact-id if not given.
Neither group-id nor artifact-id may contain slashes."
  (:use [clojure.contrib.duck-streams :only [spit]]
        [clojure.contrib.java-utils :only [file]]
        [clojure.contrib.str-utils :only [str-join]]))

(defn str-replace [subs s]
  (apply str (replace subs s)))

(defn new [project-name & [project-dir]]
  (println project-name project-dir)
  (let [project-name (symbol project-name)
        group-id (namespace project-name)
        artifact-id (name project-name)
        project-dir (or project-dir artifact-id)]
    (.mkdirs (file project-dir))
    ;; TODO: pretty-print this
    (spit (file project-dir "project.clj")
          (pr-str (list 'defproject project-name "1.0.0-SNAPSHOT"
                        :description "FIXME: write"
                        :dependencies [['org.clojure/clojure
                                        "1.1.0-alpha-SNAPSHOT"]
                                       ['org.clojure/clojure-contrib
                                        "1.0-SNAPSHOT"]])))
    (let [starter-clj-ns   (str-replace {\/ \.} (str project-name))
          starter-clj (str (str-replace {\- \_ \. \/} starter-clj-ns) ".clj")
          starter-clj-dir  (.getParent (file starter-clj))]
      (doseq [d [(str "src/" starter-clj-dir) "test" "lib" "classes"]]
        (.mkdirs (file project-dir d)))
      ;; maybe keep this somewhere else?
      (spit (file project-dir "src" starter-clj)
            (str "(ns " starter-clj-ns ")\n"))
      (spit (file project-dir ".gitignore")
            (str-join "\n" ["pom-generated.xml"
                            "Manifest.txt"
                            (str artifact-id ".jar")]))
      (spit (file project-dir "lib" ".gitignore") "*")
      (spit (file project-dir "classes" ".gitignore") "*")
      (spit (file project-dir "README")
            (str-join "\n\n" [(str "# " project-name)
                              "FIXME: write description"
                              "## Usage" "FIXME: write"
                              "## Installation" "FIXME: write"
                              "## License" "FIXME: write\n"]))
      (println "Created new project in:" project-dir))))

(ns leiningen.new
  "Create a new project skeleton.
lein new [group-id/]artifact-id [project-dir]
Group-id is optional. Project-dir defaults to artifact-id if not given.
Neither group-id nor artifact-id may contain slashes."
  (:use [clojure.contrib.duck-streams :only [spit]]
        [clojure.contrib.java-utils :only [file]]
        [clojure.contrib.str-utils :only [str-join]]))

(defn new [project-name & [project-dir]]
  (println project-name project-dir)
  (let [project-name (symbol project-name)
        group-id (namespace project-name)
        artifact-id (name project-name)
        project-dir (or project-dir artifact-id)]
    (.mkdirs (file project-dir))
    ;; TODO: pretty-print this
    (spit (file project-dir "project.clj")
          (pr-str (list 'defproject project-name "1.0.0-SNAPSHOT"
                        :description "FIXME: write"
                        :dependencies [['org.clojure/clojure
                                        "1.1.0-alpha-SNAPSHOT"]
                                       ['org.clojure/clojure-contrib
                                        "1.0-SNAPSHOT"]])))
    (let [project-ns  (.replace (str project-name) "/" ".")
          project-clj (str (.replace (str project-name) "-" "_") ".clj")]
      (.mkdirs (file project-dir "test"))
      (.mkdirs (.getParentFile (file project-dir "src" project-clj)))
      (spit (file project-dir "src" project-clj)
            (str "(ns " project-ns ")\n"))
      (spit (file project-dir ".gitignore")
            (str-join "\n" ["pom-generated.xml"
                            "Manifest.txt"
                            (str artifact-id ".jar")
                            "lib" "classes"]))
      (spit (file project-dir "README")
            (str-join "\n\n" [(str "# " artifact-id)
                              "FIXME: write description"
                              "## Usage" "FIXME: write"
                              "## Installation" "FIXME: write"
                              "## License" "FIXME: write\n"]))
      (println "Created new project in:" project-dir))))

Call .replace instead of str-replace. Don't create lib or classes, just ignore.


(ns discuss.components.items
  (:require [om.next :as om :refer-macros [defui]]
            [clojure.string :as string]
            [sablono.core :as html :refer-macros [html]]
            [discuss.communication.lib :as comlib]
            [discuss.translations :refer [translate] :rename {translate t}]
            [discuss.utils.common :as lib]
            [discuss.utils.views :as vlib]))

(defui Item
  static om/IQuery
  (query [this] [:htmls :url])
  Object
  (render [this]
          (let [{:keys [htmls url]} (om/props this)]
            (html [:div.radio
                   [:label
                    [:input {:type "radio"
                             :className (lib/prefix-name "dialog-items")
                             :name (lib/prefix-name "dialog-items-group")
                             :onClick #(comlib/ajax-get url nil comlib/process-discussion-step)
                             :value url}]
                    " "
                    (vlib/safe-html (string/join (str " <i>" (t :common :and) "</i> ") htmls))]]))))
(def item (om/factory Item {:keyfn :url}))

(defui Items
  static om/IQuery
  (query [this]
         `[{:discussion/items ~(om/get-query Item)}])
  Object
  (render [this]
          (let [{:keys [discussion/items]} (om/props this)]
            (html [:div (map item items)]))))
(def items (om/factory Items))

(ns discuss.components.items
  (:require [om.next :as om :refer-macros [defui]]
            [clojure.string :as string]
            [sablono.core :as html :refer-macros [html]]
            [discuss.communication.lib :as comlib]
            [discuss.translations :refer [translate] :rename {translate t}]
            [discuss.utils.common :as lib]
            [discuss.utils.views :as vlib]
            [cljs.spec.alpha :as s]))

(defn- dispatch-click-fn
  "Dispatch which function should be applied if there is a click on an item."
  [url]
  (case url
    "login" (lib/change-view-next! :login)
    "back" (.log js/console "Not yet implemented")
    (comlib/ajax-get url nil comlib/process-discussion-step)))

(s/fdef dispatch-click-fn
  :args (s/cat :url string?))

(defui Item
  static om/IQuery
  (query [this] [:htmls :url])
  Object
  (render [this]
          (let [{:keys [htmls url]} (om/props this)]
            (html [:div.radio
                   [:label
                    [:input {:type "radio"
                             :className (lib/prefix-name "dialog-items")
                             :name (lib/prefix-name "dialog-items-group")
                             :onClick (partial dispatch-click-fn url)
                             :value url}]
                    " "
                    (vlib/safe-html (string/join (str " <i>" (t :common :and) "</i> ") htmls))]]))))
(def item (om/factory Item {:keyfn :url}))

(defui Items
  static om/IQuery
  (query [this]
         `[{:discussion/items ~(om/get-query Item)}])
  Object
  (render [this]
          (let [{:keys [discussion/items]} (om/props this)]
            (html [:div (map item items)]))))
(def items (om/factory Items))

Add dispatch fn for items

Add dispatch fn for items


(ns dbquery.core
  (:gen-class)
  (:require [cheshire.generate :refer [add-encoder]]
            [clojure.core.cache :as cache]
            [clojure.data.csv :as csv]
            [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [compojure.core :refer :all]
            [compojure.route :as route]
            [crypto.password.bcrypt :as password]
            [dbquery.databases :as db :refer :all]
            [dbquery.model :as model :refer :all]
            [dbquery.utils :refer :all]
            [korma.core :as k]
            [liberator.core :refer [defresource]]
            [liberator.dev :refer [wrap-trace]]
            [org.httpkit.server :refer [run-server]]
            [ring.middleware.defaults :refer :all]
            [ring.middleware.json :refer :all]
            [ring.middleware.multipart-params :as mp]
            [ring.middleware.reload :as reload]
            [ring.util.response :refer [redirect]]
            [clojure.string :as str])
  (:import java.awt.Desktop
           java.io.FileReader
           java.net.URI
           java.text.SimpleDateFormat
           java.util.Date))

;; custom json encoder for dates
(defn- date-time-encoder [fmt]
  (fn [d jsonGenerator]
    (let [sdf (SimpleDateFormat. fmt)]
      (.writeString jsonGenerator (.format sdf d)))))

(defn- add-encoders []
  (add-encoder (Class/forName "[B") #(.writeString %2 "<binary>"))
  (add-encoder java.sql.Blob #(.writeString %2 "<binary>"))
  (add-encoder java.util.Date (date-time-encoder "dd/MM/yyyy"))
  (add-encoder java.sql.Date (date-time-encoder "dd/MM/yyyy"))
  (add-encoder java.sql.Timestamp (date-time-encoder "dd/MM/yyyy HH:mm:ss"))
  (add-encoder java.sql.RowId #(.writeString %2 %1))
  (add-encoder java.sql.Array #(.writeString %2 (str/join ", " (.getArray %1))))
  (try
    (add-encoder (Class/forName "oracle.sql.ROWID") #(.writeString %2 (.stringValue %1)))
    (catch Exception e
      (log/warn "failed registering encoder for oracle.sql.ROWID. Add Oracle JDBC driver to the classpath if using Oracle DB"))))

(def ds-cache (atom (cache/lru-cache-factory {})))

(def session-count (atom 0))

(defn with-cache [cref item value-fn]
  (cache/lookup (if (cache/has? @cref item)
                  (swap! cref #(cache/hit % item))
                  (swap! cref #(cache/miss % item (value-fn item))))
                item))

(defn expire-cache [cache-ref entry-id]
  (log/info "expiring cache entry:" entry-id)
  (when-let [ds (cache/lookup @cache-ref entry-id)]
    (swap! cache-ref cache/evict entry-id)
    (future (-> ds :datasource .close))))

(defn get-ds [ds-id]
  (with-cache ds-cache ds-id
    #(let [ds-details (first (k/select data_source (k/fields [:password]) (k/where {:id %})))]
       {:datasource (mk-ds ds-details)
        :schema (:schema ds-details)
        :dbms (:dbms ds-details)})))

(def common-opts {:available-media-types ["application/json"]})

(defn wrap-exception [handler]
  (fn [req]
    (try
      (handler req)
      (catch Exception e
        (log/error e "Exception handling request")
        {:status 500 :body (assoc (ex-data e )
                                  :error (or (.getMessage e) "Unknown internal error"))}))))

(defn current-user [ctx]
  (if-let [user-id (get-in ctx [:request :session :user :id])]
    {:user-id user-id}))

;; ds checker middleware

;; handlers
(defn handle-exec-query [req ds-id]
  (let [ds (get-ds ds-id)
        params (:body req)
        res (exec-query ds params)]
    {:body res}))

(def download-jobs (atom {}))

(defn create-download [req ds-id]
  (let [id (rand-int 10000)]
    (swap! download-jobs assoc id (future (handle-exec-query req ds-id)))
    {:body {:download-id id}}))

(defn handle-login [req]
  (log/info "handling login...")
  (let [{user-name :userName pass :password} (:body req)
        session (:session req)]
    (try-let
     [user (login user-name pass)]
     (if (some? user)
       {:body user
        :session (assoc session
                        :user (assoc user :session-id (swap! session-count inc)))}
       {:status 401 :body "invalid user or password"})
     (fn [e]
       (log/error e "failed login")
       {:status 500 :body (.getMessage e)}))))

(defn read-csv [file separator has-header]
  (let [csv (csv/read-csv (FileReader. file) :separator separator)
        first (first csv)]
    {:header (if has-header first (for [i (range  (count first))] (str "Col" i)))
     :rows (if has-header (rest csv) csv)}))

(defn handle-file-upload [{{file :file separator :separator has-header :hasHeader} :params}]
  ;; extract
  (log/info "separator:" separator)
  (let [{header :header rows :rows} (read-csv (file :tempfile) (.charAt separator 0) (some? has-header))]
    {:body {:header header :rows (take 4 rows) :file (.getName (file :tempfile))}}))

(defn query-id [q-id ds-id req]
  (str q-id  "/" ds-id "/" (get-in req [:session :user :session-id])))

(defn parse-sql-meta [sql]
  (let [[query-name meta] (rest (re-find #"(?m)\s*--\s*#\s*([^@\n]+)(@.+)?$" sql))]
    (when query-name
      {:name query-name
       :label (or (and meta (second (re-find #"@label:([\w]+)" meta))) "default")
       :shared (or (nil? (and meta (re-find #"@private" meta))) false)})))

(defn handle-exec-sql [req ds-id]
  (let [{:keys [sql] :as opts} (:body req)
        ds (get-ds ds-id)
        r (execute ds sql (update opts :id query-id ds-id req))]
    (future
      (try
        (when-let [meta (parse-sql-meta sql)]
          (model/save-query (assoc meta :sql sql :app_user_id (:user-id (current-user req)))))
        (catch Exception e
          (log/error e "failed saving query"))))
    {:body r}))

(defn handle-exec-query-by-id [id ds-id]
  (if-let [q (first (k/select query (k/fields [:sql]) (k/where {:id id})))]
    (let [r (execute (get-ds ds-id) (:sql q))]
      {:body r})
    {:status 404 :body "no such query exists!"}))

(defn handle-list-tables [req ds-id]
  (let [tables  (k/select ds_table (k/where {:data_source_id ds-id}))]
    (if (empty? tables)
      (let [ds (get-ds ds-id)]
        (log/info "table metadata not found. fallback to quick table list...")
        (future (load-metadata ds ds-id))
        (get-tables ds))
      (if (= "true" (get-in req [:params :refresh]))
        (sync-tables (get-ds ds-id) ds-id)
        tables))))

(defn handle-table-meta [{{refresh :refresh} :params} ds-id table]
  (if-let [table-id (-> (k/select ds_table (k/fields ::* :id)
                                  (k/where {:name table})) first :id)]
    {:columns (if (= "true" refresh)
                (let [cols (table-cols (get-ds ds-id) table)]
                  (sync-table-cols table-id cols)
                  cols)
                (k/select ds_column (k/where {:table_id table-id}) (k/order :id)))}))

(defn handle-data-import [ds-id {{:keys [file separator hasHeader dest]} :body}]
  (let [ds (get-ds ds-id)
        table (if (= "_" (:table dest))
                (create-table ds (dest :newTable) (dest :columns) nil)
                (dest :table))
        filePath (str (System/getProperty "java.io.tmpdir") "/" file)
        data (read-csv (java.io.File. filePath) (.charAt separator 0) hasHeader)
        result (load-data ds table data (dest :mappings))]
    {:body result}))

(defn handle-download [ds-id query]
  (log/info "downloading query output" query)
  (let [ds (get-ds ds-id)
        os (java.io.PipedOutputStream.)
        is (java.io.PipedInputStream. os)
        writer (java.io.OutputStreamWriter. os)]
    (future
      (try
        (db/execute ds query {:rs-reader #(db/rs-to-csv %1 writer %2)})
        (catch Exception e (log/error "failed exporting to CSV" e)))
      (.close writer))
    {:body is
     :headers { ;;"Transfer-Encoding" "chunked"
               "Content-Disposition" "attachment; filename=data.csv"} }))

(defn with-body [b]
  (cond
    (or (instance? Number b) (instance? Boolean b)) {:body {:result b}}
    (nil? b) {:status 404}
    true {:body b}))

;; resources

(defresource data-sources-list common-opts
  :allowed-methods [:get :post]
  :allowed? #(if-let [user-id (get-in % [:request :session :user :id])]
               {:user-id user-id})
  :post! #(let [ds-data (get-in %1 [:request :body])
                _ (mk-ds ds-data)
                user-id (:user-id %1)
                id (k/insert data_source (k/values (assoc ds-data :app_user_id user-id)))]
            {::id (first (vals id))})
  :post-redirect? (fn [ctx] {:location (format "/data-sources/%s" (::id ctx))})
  :handle-ok #(user-data-sources (:user-id %)))

(defresource data-sources-entry [id] common-opts
  :allowed-methods [:get :put :delete]
  :exists? (if-let [ds (first (k/select data_source (k/where {:id id})))]
             {:the-ds ds})
  ;; :allowed? #(let [ds (first (k/select data_source (k/where {:id id})))
  ;;                  user-id (get-in %1 [:request :session :user :id])]
  ;;              (if (= user-id (:app_user_id ds))
  ;;                {:the-ds ds}))
  :handle-ok #(:the-ds %)
  :new? false
  :delete! (fn [_]
             (k/delete data_source (k/where {:id id}))
             (expire-cache ds-cache id))
  :put! (fn [{{ds-data :body} :request}]
          (mk-ds ds-data)
          (k/update data_source (k/set-fields ds-data) (k/where {:id id}))
          (expire-cache ds-cache id)
          nil))

(defresource queries-list common-opts
  :allowed-methods [:get :post]
  :allowed? current-user
  :post! #(let [{{data :body} :request user-id :user-id} %
                id (first (vals (k/insert query (k/values (assoc data :app_user_id user-id)))))]
            {::id id})
  :post-redirect? (fn [ctx] {:location (format "/queries/%s" (::id ctx))})
  :handle-ok (k/select query))

(defresource queries-entry [id] common-opts
  :allowed-methods [:get :put :delete]
  :exists? (if-let [q (get-query id)]
             {:the-query q})
  :new? false
  :respond-with-entity? true
  :handle-ok #(:the-query %)
  :put! #(k/update query (k/set-fields (get-in % [:request :body]))
                   (k/where {:id id}))
  :delete! (fn [_] (k/delete query (k/where {:id id}))))

(defresource users common-opts
  :allowed-methods [:get :post]
  :allowed? #(or (= :post (-> % :request :request-method))
                 (current-user %))
  :post! #(let [data (-> % :request :body)
                id (-> app_user (k/insert (k/values (update data :password password/encrypt)))
                       vals first)]
            {::id id})
  :handle-ok (k/select app_user))

(defroutes static
  (route/resources "/")
  (GET "/ping" [] (fn [req] (format "replied at %s" (Date.)))))

(defroutes api
  (GET "/" [] (slurp (io/resource "public/index.html")))

  (POST "/login" req (handle-login req))
  (wrap-exception (mp/wrap-multipart-params
                   (POST "/upload" req (handle-file-upload req))))
  (GET "/logout" req (assoc (redirect "/") :session nil))
  (GET "/user" req (if-let [user (get-in req [:session :user])]
                     {:body user}
                     {:status 401 :body "user not logged in"}))

  (ANY "/users" [] users)

  (ANY "/data-sources" [] data-sources-list)
  (ANY "/data-sources/:id" [id] (data-sources-entry id))
  (ANY "/queries" [] queries-list)
  (ANY "/queries/:id" [id] (queries-entry id))
  (PUT "/queries/:id/data-source/:ds" [id ds]
       (with-body (assoc-query-datasource ds id)))
  (POST "/queries/:id/data-sources" [id]
        #(with-body (assoc-query-datasource id (get-in % [:body :ds-ids]))))
  (DELETE "/queries/:id/data-sources" [id]
          #(with-body (dissoc-query-datasource id (get-in % [:body :ds-ids]))))
  (GET "/queries/:id/data-source" [id] (with-body (query-assocs id)))

  (context "/ds/:ds-id" [ds-id]
           (POST "/exec-sql" req (handle-exec-sql req ds-id))
           (POST "/download" req (create-download req ds-id))
           (POST "/cancel-sql/:id" [id] (fn[req]
                                          (cancel-query (query-id id ds-id req))
                                          {:status 201}))
           (GET "/tables" req (with-body (handle-list-tables req ds-id)))
           (GET "/tables/:name" [name] (fn [req]
                                         (with-body (handle-table-meta req ds-id name))))
           (GET "/data-types" req (with-body (data-types (get-ds ds-id))))
           (POST "/import-data" req (handle-data-import ds-id req))
           (GET "/queries" req (with-body (ds-queries ds-id)))
           ;; (GET "/related/:tables" [tables] (with-body (get-related-tables ds-id (s/split tables #",\s*"))))
           (GET "/download" req (handle-download ds-id (get-in req [:params :query])))))

(defroutes app
  static
  (-> api
      (wrap-exception)
      (wrap-json-response)
      (wrap-json-body {:keywords? true})
      (wrap-trace :header :ui)
      (wrap-defaults (assoc site-defaults :security {:anti-forgery false}))))
;;
(defn start-server [port]
  ;; (sync-db "dev")
  (add-encoders)
  (run-server (reload/wrap-reload #'app)
              {:port port :thread 50}))

(defn -main [& args]
  (let [port (or (some-> args first Integer/parseInt) 3001)]
    (start-server port)
    (if (Desktop/isDesktopSupported)
      (try
        (doto (Desktop/getDesktop)
          (.browse (URI. (str "http://localhost:" port))))
        (catch Exception e
          (log/warn "failed to open browser" e))))))

(ns dbquery.core
  (:gen-class)
  (:require [cheshire.generate :refer [add-encoder]]
            [clojure.core.cache :as cache]
            [clojure.data.csv :as csv]
            [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [compojure.core :refer :all]
            [compojure.route :as route]
            [crypto.password.bcrypt :as password]
            [dbquery.databases :as db :refer :all]
            [dbquery.model :as model :refer :all]
            [dbquery.utils :refer :all]
            [korma.core :as k]
            [liberator.core :refer [defresource]]
            [liberator.dev :refer [wrap-trace]]
            [org.httpkit.server :refer [run-server]]
            [ring.middleware.defaults :refer :all]
            [ring.middleware.json :refer :all]
            [ring.middleware.multipart-params :as mp]
            [ring.middleware.reload :as reload]
            [ring.util.response :refer [redirect]]
            [clojure.string :as str])
  (:import java.awt.Desktop
           java.io.FileReader
           java.net.URI
           java.text.SimpleDateFormat
           java.util.Date))

;; custom json encoder for dates
(defn- date-time-encoder [fmt]
  (fn [d jsonGenerator]
    (let [sdf (SimpleDateFormat. fmt)]
      (.writeString jsonGenerator (.format sdf d)))))

(defn- add-encoders []
  (add-encoder (Class/forName "[B") #(.writeString %2 "<binary>"))
  (add-encoder java.sql.Blob #(.writeString %2 "<binary>"))
  (add-encoder java.util.Date (date-time-encoder "dd/MM/yyyy"))
  (add-encoder java.sql.Date (date-time-encoder "dd/MM/yyyy"))
  (add-encoder java.sql.Timestamp (date-time-encoder "dd/MM/yyyy HH:mm:ss"))
  (add-encoder java.sql.RowId #(.writeString %2 %1))
  (add-encoder java.sql.Array #(.writeString %2 (str/join ", " (.getArray %1))))
  (try
    (add-encoder (Class/forName "oracle.sql.ROWID") #(.writeString %2 (.stringValue %1)))
    (catch Exception e
      (log/warn "failed registering encoder for oracle.sql.ROWID. Add Oracle JDBC driver to the classpath if using Oracle DB"))))

(def ds-cache (atom (cache/lru-cache-factory {})))

(def session-count (atom 0))

(defn with-cache [cref item value-fn]
  (cache/lookup (if (cache/has? @cref item)
                  (swap! cref #(cache/hit % item))
                  (swap! cref #(cache/miss % item (value-fn item))))
                item))

(defn expire-cache [cache-ref entry-id]
  (log/info "expiring cache entry:" entry-id)
  (when-let [ds (cache/lookup @cache-ref entry-id)]
    (swap! cache-ref cache/evict entry-id)
    (future (-> ds :datasource .close))))

(defn get-ds [ds-id]
  (with-cache ds-cache ds-id
    #(let [ds-details (first (k/select data_source (k/fields [:password]) (k/where {:id %})))]
       {:datasource (mk-ds ds-details)
        :schema (:schema ds-details)
        :dbms (:dbms ds-details)})))

(def common-opts {:available-media-types ["application/json"]})

(defn wrap-exception [handler]
  (fn [req]
    (try
      (handler req)
      (catch Exception e
        (log/error e "Exception handling request")
        {:status 500 :body (assoc (ex-data e )
                                  :error (or (.getMessage e) "Unknown internal error"))}))))

(defn current-user [ctx]
  (if-let [user-id (get-in ctx [:request :session :user :id])]
    {:user-id user-id}))

;; ds checker middleware

;; handlers
(defn handle-exec-query [req ds-id]
  (let [ds (get-ds ds-id)
        params (:body req)
        res (exec-query ds params)]
    {:body res}))

(def download-jobs (atom {}))

(defn create-download [req ds-id]
  (let [id (rand-int 10000)]
    (swap! download-jobs assoc id (future (handle-exec-query req ds-id)))
    {:body {:download-id id}}))

(defn handle-login [req]
  (log/info "handling login...")
  (let [{user-name :userName pass :password} (:body req)
        session (:session req)]
    (try-let
     [user (login user-name pass)]
     (if (some? user)
       {:body user
        :session (assoc session
                        :user (assoc user :session-id (swap! session-count inc)))}
       {:status 401 :body "invalid user or password"})
     (fn [e]
       (log/error e "failed login")
       {:status 500 :body (.getMessage e)}))))

(defn read-csv [file separator has-header]
  (let [csv (csv/read-csv (FileReader. file) :separator separator)
        first (first csv)]
    {:header (if has-header first (for [i (range  (count first))] (str "Col" i)))
     :rows (if has-header (rest csv) csv)}))

(defn handle-file-upload [{{file :file separator :separator has-header :hasHeader} :params}]
  ;; extract
  (log/info "separator:" separator)
  (let [{header :header rows :rows} (read-csv (file :tempfile) (.charAt separator 0) (some? has-header))]
    {:body {:header header :rows (take 4 rows) :file (.getName (file :tempfile))}}))

(defn query-id [q-id ds-id req]
  (str q-id  "/" ds-id "/" (get-in req [:session :user :session-id])))

(defn parse-sql-meta [sql]
  (let [[query-name meta] (rest (re-find #"(?m)\s*--\s*#\s*([^@\n]+)(@.+)?$" sql))]
    (when query-name
      {:name query-name
       :label (or (and meta (second (re-find #"@label:([\w]+)" meta))) "default")
       :shared (or (nil? (and meta (re-find #"@private" meta))) false)})))

(defn handle-exec-sql [req ds-id]
  (let [{:keys [sql] :as opts} (:body req)
        ds (get-ds ds-id)
        r (execute ds sql (update opts :id query-id ds-id req))]
    (future
      (try
        (when-let [meta (parse-sql-meta sql)]
          (model/save-query (assoc meta :sql sql :app_user_id (:user-id (current-user req)))))
        (catch Exception e
          (log/error e "failed saving query"))))
    {:body r}))

(defn handle-exec-query-by-id [id ds-id]
  (if-let [q (first (k/select query (k/fields [:sql]) (k/where {:id id})))]
    (let [r (execute (get-ds ds-id) (:sql q))]
      {:body r})
    {:status 404 :body "no such query exists!"}))

(defn handle-list-tables [req ds-id]
  (let [tables  (k/select ds_table (k/where {:data_source_id ds-id}))]
    (if (empty? tables)
      (let [ds (get-ds ds-id)]
        (log/info "table metadata not found. fallback to quick table list...")
        (future (load-metadata ds ds-id))
        (get-tables ds))
      (if (= "true" (get-in req [:params :refresh]))
        (sync-tables (get-ds ds-id) ds-id)
        tables))))

(defn handle-table-meta [{{refresh :refresh} :params} ds-id table]
  (if-let [table-id (-> (k/select ds_table (k/fields ::* :id)
                                  (k/where {:name table})) first :id)]
    {:columns (if (= "true" refresh)
                (let [cols (table-cols (get-ds ds-id) table)]
                  (sync-table-cols table-id cols)
                  cols)
                (k/select ds_column (k/where {:table_id table-id}) (k/order :id)))}))

(defn handle-data-import [ds-id {{:keys [file separator hasHeader dest]} :body}]
  (let [ds (get-ds ds-id)
        table (if (= "_" (:table dest))
                (create-table ds (dest :newTable) (dest :columns) nil)
                (dest :table))
        filePath (str (System/getProperty "java.io.tmpdir") "/" file)
        data (read-csv (java.io.File. filePath) (.charAt separator 0) hasHeader)
        result (load-data ds table data (dest :mappings))]
    {:body result}))

(defn handle-download [ds-id query]
  (log/info "downloading query output" query)
  (let [ds (get-ds ds-id)
        os (java.io.PipedOutputStream.)
        is (java.io.PipedInputStream. os)
        writer (java.io.OutputStreamWriter. os)]
    (future
      (try
        (db/execute ds query {:rs-reader #(db/rs-to-csv %1 writer %2)})
        (catch Exception e (log/error "failed exporting to CSV" e)))
      (.close writer))
    {:body is
     :headers { ;;"Transfer-Encoding" "chunked"
               "Content-Disposition" "attachment; filename=data.csv"} }))

(defn with-body [b]
  (cond
    (or (instance? Number b) (instance? Boolean b)) {:body {:result b}}
    (nil? b) {:status 404}
    true {:body b}))

;; resources

(defresource data-sources-list common-opts
  :allowed-methods [:get :post]
  :allowed? #(if-let [user-id (get-in % [:request :session :user :id])]
               {:user-id user-id})
  :post! #(let [ds-data (get-in %1 [:request :body])
                _ (mk-ds ds-data)
                user-id (:user-id %1)
                id (k/insert data_source (k/values (assoc ds-data :app_user_id user-id)))]
            {::id (first (vals id))})
  :post-redirect? (fn [ctx] {:location (format "/data-sources/%s" (::id ctx))})
  :handle-ok #(user-data-sources (:user-id %)))

(defresource data-sources-entry [id] common-opts
  :allowed-methods [:get :put :delete]
  :exists? (if-let [ds (first (k/select data_source (k/where {:id id})))]
             {:the-ds ds})
  ;; :allowed? #(let [ds (first (k/select data_source (k/where {:id id})))
  ;;                  user-id (get-in %1 [:request :session :user :id])]
  ;;              (if (= user-id (:app_user_id ds))
  ;;                {:the-ds ds}))
  :handle-ok #(:the-ds %)
  :new? false
  :delete! (fn [_]
             (k/delete data_source (k/where {:id id}))
             (expire-cache ds-cache id))
  :put! (fn [{{ds-data :body} :request}]
          (mk-ds ds-data)
          (k/update data_source (k/set-fields ds-data) (k/where {:id id}))
          (expire-cache ds-cache id)
          nil))

(defresource queries-list common-opts
  :allowed-methods [:get :post]
  :allowed? current-user
  :post! #(let [{{data :body} :request user-id :user-id} %
                id (first (vals (k/insert query (k/values (assoc data :app_user_id user-id)))))]
            {::id id})
  :post-redirect? (fn [ctx] {:location (format "/queries/%s" (::id ctx))})
  :handle-ok (k/select query))

(defresource queries-entry [id] common-opts
  :allowed-methods [:get :put :delete]
  :exists? (if-let [q (get-query id)]
             {:the-query q})
  :new? false
  :respond-with-entity? true
  :handle-ok #(:the-query %)
  :put! #(k/update query (k/set-fields (get-in % [:request :body]))
                   (k/where {:id id}))
  :delete! (fn [_] (k/delete query (k/where {:id id}))))

(defresource users common-opts
  :allowed-methods [:get :post]
  :allowed? #(or (= :post (-> % :request :request-method))
                 (current-user %))
  :post! #(let [data (-> % :request :body)
                id (-> app_user (k/insert (k/values (update data :password password/encrypt)))
                       vals first)]
            {::id id})
  :handle-ok (k/select app_user))

(defroutes static
  (route/resources "/")
  (GET "/ping" [] (fn [req] (format "replied at %s" (Date.)))))

(defroutes api
  (GET "/" [] (slurp (io/resource "public/index.html")))

  (POST "/login" req (handle-login req))
  (wrap-exception (mp/wrap-multipart-params
                   (POST "/upload" req (handle-file-upload req))))
  (GET "/logout" req (assoc (redirect "/") :session nil))
  (GET "/user" req (if-let [user (get-in req [:session :user])]
                     {:body user}
                     {:status 401 :body "user not logged in"}))

  (ANY "/users" [] users)

  (ANY "/data-sources" [] data-sources-list)
  (ANY "/data-sources/:id" [id] (data-sources-entry id))
  (ANY "/queries" [] queries-list)
  (ANY "/queries/:id" [id] (queries-entry id))
  (PUT "/queries/:id/data-source/:ds" [id ds]
       (with-body (assoc-query-datasource ds id)))
  (POST "/queries/:id/data-sources" [id]
        #(with-body (assoc-query-datasource id (get-in % [:body :ds-ids]))))
  (DELETE "/queries/:id/data-sources" [id]
          #(with-body (dissoc-query-datasource id (get-in % [:body :ds-ids]))))
  (GET "/queries/:id/data-source" [id] (with-body (query-assocs id)))

  (context "/ds/:ds-id" [ds-id]
           (POST "/exec-sql" req (handle-exec-sql req ds-id))
           (POST "/download" req (create-download req ds-id))
           (POST "/cancel-sql/:id" [id] (fn[req]
                                          (cancel-query (query-id id ds-id req))
                                          {:status 201}))
           (GET "/tables" req (with-body (handle-list-tables req ds-id)))
           (GET "/tables/:name" [name] (fn [req]
                                         (with-body (handle-table-meta req ds-id name))))
           (GET "/data-types" req (with-body (data-types (get-ds ds-id))))
           (POST "/import-data" req (handle-data-import ds-id req))
           (GET "/queries" req (with-body (ds-queries ds-id)))
           ;; (GET "/related/:tables" [tables] (with-body (get-related-tables ds-id (s/split tables #",\s*"))))
           (GET "/download" req (handle-download ds-id (get-in req [:params :query])))))

(defroutes app
  static
  (-> api
      (wrap-exception)
      (wrap-json-response)
      (wrap-json-body {:keywords? true})
      (wrap-trace :header :ui)
      (wrap-defaults (assoc site-defaults :security {:anti-forgery false}))))
;;
(defn start-server [port]
  (model/upgrade-db)
  (add-encoders)
  (run-server (reload/wrap-reload #'app)
              {:port port :thread 50}))

(defn -main [& args]
  (let [port (or (some-> args first Integer/parseInt) 3001)]
    (start-server port)
    (if (Desktop/isDesktopSupported)
      (try
        (doto (Desktop/getDesktop)
          (.browse (URI. (str "http://localhost:" port))))
        (catch Exception e
          (log/warn "failed to open browser" e))))))

Enable DB migration

Enable DB migration


(ns clj.medusa.alert
  (:require [amazonica.aws.simpleemail :as ses]
            [amazonica.core :as aws]
            [clojure.string :as string]
            [clj.medusa.config :as config]
            [clj.medusa.db :as db]
            [clj.medusa.config :as config]))

(defn send-email [subject body destinations]
  (when-not (:dry-run @config/state)
    (ses/send-email :destination {:to-addresses destinations}
                    :source "telemetry-alerts@mozilla.com"
                    :message {:subject subject
                              :body {:html (str "" body "")}})))

(defn notify-subscribers [{:keys [metric_id date emails]}]
  (let [{:keys [hostname]} @config/state
        foreign_subscribers (when (seq emails) (string/split emails #","))
        {metric_name :name,
         detector_id :detector_id
         metric_id :id} (db/get-metric metric_id)
        {detector_name :name} (db/get-detector detector_id)
        subscribers (db/get-subscribers-for-metric metric_id)]
    (send-email (str "Alert for " metric_name " (" detector_name ") on the " date)
                (str "http://" hostname "/index.html#/detectors/" detector_id "/"
                     "metrics/" metric_id "/alerts/?from=" date "&to=" date)
                (concat subscribers foreign_subscribers ["dev-telemetry-alerts@lists.mozilla.org"]))))

(ns clj.medusa.alert
  (:require [amazonica.aws.simpleemail :as ses]
            [amazonica.core :as aws]
            [clojure.string :as string]
            [clj.medusa.config :as config]
            [clj.medusa.db :as db]
            [clj.medusa.config :as config]))

(defn send-email [subject body destinations]
  (when-not (:dry-run @config/state)
    (ses/send-email :destination {:to-addresses destinations}
                    :source "telemetry-alerts@mozilla.com"
                    :message {:subject subject
                              :body {:text body}})))

(defn notify-subscribers [{:keys [metric_id date emails]}]
  (let [{:keys [hostname]} @config/state
        foreign_subscribers (when (seq emails) (string/split emails #","))
        {metric_name :name,
         detector_id :detector_id
         metric_id :id} (db/get-metric metric_id)
        {detector_name :name} (db/get-detector detector_id)
        subscribers (db/get-subscribers-for-metric metric_id)]
    (send-email (str "Alert for " metric_name " (" detector_name ") on the " date)
                (str "http://" hostname "/index.html#/detectors/" detector_id "/"
                     "metrics/" metric_id "/alerts/?from=" date "&to=" date)
                (concat subscribers foreign_subscribers ["dev-telemetry-alerts@lists.mozilla.org"]))))

Send plain text alerts.

Send plain text alerts.


(ns cmr.common.cache
  "A system level cache based on clojure.core.cache library.
  Follows basic usage pattern as given in - https://github.com/clojure/core.cache/wiki/Using"
  (:require [cmr.common.log :as log :refer (debug info warn error)]
            [clojure.core.cache :as cc]))

(def general-cache-key
  "The key used to store the general cache in the system cache map."
  :general)

(defn context->cache
  "Get the cache for the given key from the context"
  [context cache-key]
  (get-in context [:system :caches cache-key]))

(defn cache-lookup
  "Looks up the value of the cached item using the key. If there is a cache miss it will invoke
  the function given with no arguments, save the value in the cache and return the value."
  [cmr-cache key f]
  (-> (swap! (:atom cmr-cache)
             (fn [cache]
               (if (cc/has? cache key)
                 (cc/hit cache key)
                 (cc/miss cache key (f)))))
      (get key)))

(defmulti create-core-cache
  "Create a cache using cmr.core-cache of the given type."
  (fn [type value opts]
    type))

(defmethod create-core-cache :default
  [type value opts]
  (cc/basic-cache-factory value))

(defmethod create-core-cache :lru
  [type value opts]
  (apply cc/lru-cache-factory value (flatten opts)))

(defmethod create-core-cache :ttl
  [type value opts]
  (apply cc/ttl-cache-factory value (flatten opts)))

(defn create-cache
  "Create system level cache. The currently supported cache types are :defalut and :lru.
  The :default type does not do cache evictions - cache items must be explicitly removed.
  The :lru (Least Recently Used) cache evicts items that have not been used recently when
  the cache size exceeds the threshold (default 32). This threshold can be set using the
  :threshold key in the opts parameter."
  ([]
   (create-cache :default {} {}))
  ([cache-type]
   (create-cache cache-type {} {}))
  ([cache-type initial-cache-value]
   (create-cache cache-type initial-cache-value {}))
  ([cache-type initial-cache-value opts]
   (let [initial-cache (create-core-cache cache-type initial-cache-value opts)]
     {:initial initial-cache
      :atom (atom initial-cache)})))

(defn reset-cache
  [cmr-cache]
  (reset! (:atom cmr-cache) (:initial cmr-cache)))

(defn reset-caches
  "Clear all caches."
  [context]
  (doseq [[k v] (get-in context [:system :caches])]
    (fn [[k v]]
      (debug "Clearing cache " k)
      (reset-cache v))))

(defn update-cache
  "Update the cache contents with the output of the given function, f. f takes the
  current cache as its input and returns the new cache."
  [cmr-cache f]
  (swap! (:atom cmr-cache) f)
  cmr-cache)

(ns cmr.common.cache
  "A system level cache based on clojure.core.cache library.
  Follows basic usage pattern as given in - https://github.com/clojure/core.cache/wiki/Using"
  (:require [cmr.common.log :as log :refer (debug info warn error)]
            [clojure.core.cache :as cc]))

(def general-cache-key
  "The key used to store the general cache in the system cache map."
  :general)

(defn cache-from-context
  "Get the cache for the given key from the context"
  [context cache-key]
  (get-in context [:system :caches cache-key]))

(defn cache-lookup
  "Looks up the value of the cached item using the key. If there is a cache miss it will invoke
  the function given with no arguments, save the value in the cache and return the value."
  [cmr-cache key f]
  (-> (swap! (:atom cmr-cache)
             (fn [cache]
               (if (cc/has? cache key)
                 (cc/hit cache key)
                 (cc/miss cache key (f)))))
      (get key)))

(defmulti create-core-cache
  "Create a cache using cmr.core-cache of the given type."
  (fn [type value opts]
    type))

(defmethod create-core-cache :default
  [type value opts]
  (cc/basic-cache-factory value))

(defmethod create-core-cache :lru
  [type value opts]
  (apply cc/lru-cache-factory value (flatten opts)))

(defmethod create-core-cache :ttl
  [type value opts]
  (apply cc/ttl-cache-factory value (flatten opts)))

(defn create-cache
  "Create system level cache. The currently supported cache types are :defalut and :lru.
  The :default type does not do cache evictions - cache items must be explicitly removed.
  The :lru (Least Recently Used) cache evicts items that have not been used recently when
  the cache size exceeds the threshold (default 32). This threshold can be set using the
  :threshold key in the opts parameter."
  ([]
   (create-cache :default {} {}))
  ([cache-type]
   (create-cache cache-type {} {}))
  ([cache-type initial-cache-value]
   (create-cache cache-type initial-cache-value {}))
  ([cache-type initial-cache-value opts]
   (let [initial-cache (create-core-cache cache-type initial-cache-value opts)]
     {:initial initial-cache
      :atom (atom initial-cache)})))

(defn reset-cache
  [cmr-cache]
  (reset! (:atom cmr-cache) (:initial cmr-cache)))

(defn reset-caches
  "Clear all caches."
  [context]
  (doall (map (fn [[k v]]
                (debug "Clearing cache " k)
                (reset-cache v))
              (get-in context [:system :caches]))))

(defn update-cache
  "Update the cache contents with the output of the given funciton, f. f takes the
  current cache as its input and returns the new cache."
  [cmr-cache f]
  (swap! (:atom cmr-cache) f)
  cmr-cache)

Revert "CMR-183: Renamed function to use -> convention and replace doall + map with doseq."

This reverts commit 5d60b715371acc8c0db4bdbcde0e21312e043a2e.