;
;  (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.rest-api
    "Handler for all REST API calls.")

(require '[ring.util.response           :as http-response])
(require '[clojure.pprint               :as pprint])
(require '[clojure.data.json            :as json])

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

(defn read-request-body
    [request]
    (file-utils/slurp- (:body request)))

(defn body->results
    [body]
    (json/read-str body))

(defn body->job-info
    [body]
    (json/read-str body :key-fn clojure.core/keyword))

(defn get-job-name
    [json]
    (if json
        (get json :name)))

(defn get-job-name-from-body
    [request]
    (try
        (-> (read-request-body request)
            body->job-info
            get-job-name)
        (catch Exception e
            nil)))

(defn send-response
    [response request]
    (if (config/pretty-print? request)
        (-> (http-response/response (with-out-str (json/pprint response)))
            (http-response/content-type "application/json"))
        (-> (http-response/response (json/write-str response))
            (http-response/content-type "application/json"))))

(defn send-error-response
    [response request]
    (if (config/pretty-print? request)
        (-> (http-response/response (with-out-str (json/pprint response)))
            (http-response/content-type "application/json")
            (http-response/status 400))
        (-> (http-response/response (json/write-str response))
            (http-response/content-type "application/json")
            (http-response/status 400))))

(defn send-plain-response
    [response]
    (-> (http-response/response response)
        (http-response/content-type "application/json")))

(defn info-handler
    [request hostname]
    (let [response {:name       "Emender Jenkins Service"
                    :version    (config/get-version request)
                    :api_prefix (config/get-api-prefix request)
                    :hostname   hostname :test "/api"}]
        (send-response response request)))

(defn configuration-handler
    [request]
    (let [response (-> request :configuration)]
        (send-response response request)))

(defn system-banners
    [request uri]
    (if (= uri "/api/system/banners")
        (let [response {:message "Alpha version"
                        :type    "Warning"}]
        (send-response response request))))

(defn reload-job-list
    [previous-response request]
    (results/reload-all-results (:configuration request))
    previous-response)

(defn reload-all-results
    [request]
    (results/reload-all-results (:configuration request))
    (let [response @results/results]
        (send-response response request)))

(defn error-response
    [job-name command message]
    {:status "error"
     :job-name job-name
     :command command
     :message message})

(defn job-does-not-exist-response
    [job-name command]
    (error-response job-name command "Job does not exist"))

(defn job-already-exist-response
    [job-name command]
    (error-response job-name command "Job already exist"))

(defn start-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/start-job (config/get-jenkins-url request)
                                       (config/get-jenkins-auth request)
                                       job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "start")
                (send-error-response request)))))

(defn enable-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/enable-job (config/get-jenkins-url request)
                                        (config/get-jenkins-auth request)
                                        job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "enable")
                (send-error-response request)))))

(defn disable-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/disable-job (config/get-jenkins-url request)
                                         (config/get-jenkins-auth request)
                                         job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "enable")
                (send-error-response request)))))

(defn delete-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/delete-job (config/get-jenkins-url request)
                                        (config/get-jenkins-auth request)
                                        job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "delete")
                (send-error-response request)))))

(defn create-job
    [request]
    (let [input-data (-> (read-request-body request)
                         body->job-info)
          job-name   (get input-data :name)
          git-repo   (get input-data :url_to_repo)
          branch     (get input-data :branch)]
        (if (results/job-exists? job-name)
            (-> (job-already-exist-response job-name "create")
                (send-response request))
            (if (and job-name git-repo branch)
                (-> (jenkins-api/create-job (config/get-jenkins-url request)
                                            (config/get-jenkins-auth request)
                                            job-name git-repo branch)
                    (reload-job-list request)
                    (send-response request))
                (-> (error-response (or job-name "not set!") "create" "invalid input")
                    (send-error-response request))))))

(defn uri->job-name
    [uri prefix]
    (try
        (let [secondPart (subs uri (count prefix))
              job-name
                 (-> secondPart
                     clojure.string/trim
                     (.replaceAll "%20" " "))]
                 (if (empty? job-name) nil job-name))
        (catch IndexOutOfBoundsException e
             nil)))

(defn get-job
    [request uri]
    (let [job-name (uri->job-name uri "/api/get_job/")]
        (if job-name
            (let [job-metadata (results/find-job-with-name job-name)]
                 (send-response job-metadata request)))))

(defn update-job
    [request]
    (let [input-data (-> (read-request-body request)
                         body->job-info)
          job-name   (get input-data :name)
          git-repo   (get input-data :url_to_repo)
          branch     (get input-data :branch)]
        (if (results/job-exists? job-name)
            (if (and job-name git-repo branch)
                (-> (jenkins-api/update-job (config/get-jenkins-url request)
                                            (config/get-jenkins-auth request)
                                            job-name git-repo branch)
                    ;(reload-job-list request)
                    (send-response request))
                (-> (error-response (or job-name "not set!") "update" "invalid input")
                    (send-error-response request)))
            (-> (job-does-not-exist-response job-name "update")
                (send-error-response request)))))

(defn get-jobs
    [request]
    (let [params  (:params request)
          product (get params "product")
          version (get params "version")
          results (results/get-job-results product version)]
        (send-response results request)))

(defn get-job-results
    [request uri]
    (let [job-name (uri->job-name uri "/api/get_job_results/")]
        (if (results/job-exists? job-name)
            (let [job-results   (jenkins-api/read-job-results (config/get-jenkins-url request) job-name)]
                 (if job-results
                     (send-plain-response job-results)
                     (-> (error-response job-name "get_job_results" "can not read test results")
                         (send-response request))))
            (-> (job-does-not-exist-response job-name "get_job_results")
                (send-error-response request)))))

(defn job-started-handler
    [request]
    (println "job-started")
    (send-response {:status "ok"} request))

(defn job-finished-handler
    [request]
    (println "job-finished")
    (send-response {:status "ok"} request))

(defn job-results
    [request]
    (println "job-results")
    (send-response {:status "ok"} request))

(defn unknown-call-handler
    [request uri method]
    (let [response {:status :error
                    :error "Unknown API call"
                    :uri uri
                    :method method}]
        (send-response response request)))

;
;  (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.rest-api
    "Handler for all REST API calls.")

(require '[ring.util.response           :as http-response])
(require '[clojure.pprint               :as pprint])
(require '[clojure.data.json            :as json])

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

(defn read-request-body
    [request]
    (file-utils/slurp- (:body request)))

(defn body->results
    [body]
    (json/read-str body))

(defn body->job-info
    [body]
    (json/read-str body :key-fn clojure.core/keyword))

(defn get-job-name
    [json]
    (if json
        (get json :name)))

(defn get-job-name-from-body
    [request]
    (try
        (-> (read-request-body request)
            body->job-info
            get-job-name)
        (catch Exception e
            nil)))

(defn send-response
    [response request]
    (if (config/pretty-print? request)
        (-> (http-response/response (with-out-str (json/pprint response)))
            (http-response/content-type "application/json"))
        (-> (http-response/response (json/write-str response))
            (http-response/content-type "application/json"))))

(defn send-error-response
    [response request]
    (if (config/pretty-print? request)
        (-> (http-response/response (with-out-str (json/pprint response)))
            (http-response/content-type "application/json")
            (http-response/status 400))
        (-> (http-response/response (json/write-str response))
            (http-response/content-type "application/json")
            (http-response/status 400))))

(defn send-plain-response
    [response]
    (-> (http-response/response response)
        (http-response/content-type "application/json")))

(defn info-handler
    [request hostname]
    (let [response {:name       "Emender Jenkins Service"
                    :version    (config/get-version request)
                    :api_prefix (config/get-api-prefix request)
                    :hostname   hostname :test "/api"}]
        (send-response response request)))

(defn configuration-handler
    [request]
    (let [response (-> request :configuration)]
        (send-response response request)))

(defn system-banners
    [request uri]
    (if (= uri "/api/system/banners")
        (let [response {:message "Alpha version"
                        :type    "Warning"}]
        (send-response response request))))

(defn reload-job-list
    [previous-response request]
    (results/reload-all-results (:configuration request))
    previous-response)

(defn reload-all-results
    [request]
    (results/reload-all-results (:configuration request))
    (let [response @results/results]
        (send-response response request)))

(defn error-response
    [job-name command message]
    {:status "error"
     :job-name job-name
     :command command
     :message message})

(defn job-does-not-exist-response
    [job-name command]
    (error-response job-name command "Job does not exist"))

(defn job-already-exist-response
    [job-name command]
    (error-response job-name command "Job already exist"))

(defn start-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/start-job (config/get-jenkins-url request)
                                       (config/get-jenkins-auth request)
                                       job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "start")
                (send-error-response request)))))

(defn enable-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/enable-job (config/get-jenkins-url request)
                                        (config/get-jenkins-auth request)
                                        job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "enable")
                (send-error-response request)))))

(defn disable-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/disable-job (config/get-jenkins-url request)
                                         (config/get-jenkins-auth request)
                                         job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "enable")
                (send-error-response request)))))

(defn delete-job
    [request]
    (let [job-name (get-job-name-from-body request)]
        (if (results/job-exists? job-name)
            (-> (jenkins-api/delete-job (config/get-jenkins-url request)
                                        (config/get-jenkins-auth request)
                                        job-name)
                (reload-job-list request)
                (send-response request))
            (-> (job-does-not-exist-response job-name "delete")
                (send-error-response request)))))

(defn create-job
    [request]
    (let [input-data (-> (read-request-body request)
                         body->job-info)
          job-name   (get input-data :name)
          git-repo   (get input-data :url_to_repo)
          branch     (get input-data :branch)]
        (if (results/job-exists? job-name)
            (-> (job-already-exist-response job-name "create")
                (send-response request))
            (if (and job-name git-repo branch)
                (-> (jenkins-api/create-job (config/get-jenkins-url request)
                                            (config/get-jenkins-auth request)
                                            job-name git-repo branch)
                    (reload-job-list request)
                    (send-response request))
                (-> (error-response (or job-name "not set!") "create" "invalid input")
                    (send-error-response request))))))

(defn uri->job-name
    [uri prefix]
    (try
        (let [secondPart (subs uri (count prefix))
              job-name
                 (-> secondPart
                     clojure.string/trim
                     (.replaceAll "%20" " "))]
                 (if (empty? job-name) nil job-name))
        (catch IndexOutOfBoundsException e
             nil)))

(defn get-job
    [request uri]
    (let [job-name (uri->job-name uri "/api/get_job/")]
        (if job-name
            (let [job-metadata (results/find-job-with-name job-name)]
                 (send-response job-metadata request)))))

(defn update-job
    [request]
    (try
        (let [input-data (-> (read-request-body request)
                             body->job-info)
              job-name   (get input-data :name)
              git-repo   (get input-data :url_to_repo)
              branch     (get input-data :branch)]
            (if (results/job-exists? job-name)
                (if (and job-name git-repo branch)
                    (-> (jenkins-api/update-job (config/get-jenkins-url request)
                                                (config/get-jenkins-auth request)
                                                job-name git-repo branch)
                        ;(reload-job-list request)
                        (send-response request))
                    (-> (error-response (or job-name "not set!") "update" "invalid input")
                        (send-error-response request)))
                (-> (job-does-not-exist-response job-name "update")
                    (send-error-response request))))
        (catch Exception e
                (-> (error-response "not set!" "update" "invalid input")
                    (send-error-response request)))))

(defn get-jobs
    [request]
    (let [params  (:params request)
          product (get params "product")
          version (get params "version")
          results (results/get-job-results product version)]
        (send-response results request)))

(defn get-job-results
    [request uri]
    (let [job-name (uri->job-name uri "/api/get_job_results/")]
        (if (results/job-exists? job-name)
            (let [job-results   (jenkins-api/read-job-results (config/get-jenkins-url request) job-name)]
                 (if job-results
                     (send-plain-response job-results)
                     (-> (error-response job-name "get_job_results" "can not read test results")
                         (send-response request))))
            (-> (job-does-not-exist-response job-name "get_job_results")
                (send-error-response request)))))

(defn job-started-handler
    [request]
    (println "job-started")
    (send-response {:status "ok"} request))

(defn job-finished-handler
    [request]
    (println "job-finished")
    (send-response {:status "ok"} request))

(defn job-results
    [request]
    (println "job-results")
    (send-response {:status "ok"} request))

(defn unknown-call-handler
    [request uri method]
    (let [response {:status :error
                    :error "Unknown API call"
                    :uri uri
                    :method method}]
        (send-response response request)))

Update job REST API call does not fail with NPE for missing input


(defproject plastic "0.1.0-SNAPSHOT"
  :description "Plastic - Experimental ClojureScript editor component for Atom"
  :url "http://github.com/darwin/plastic"

  :dependencies
  [[org.clojure/clojure "1.7.0"]
   [org.clojure/clojurescript "1.7.107"]
   [org.clojure/tools.reader "0.10.0-SNAPSHOT"]
   [org.clojure/core.async "0.1.346.0-17112a-alpha"]
   [com.cognitect/transit-cljs "0.8.220"]
   [re-frame "0.4.1"]
   [rewrite-cljs "0.3.1"]
   [binaryage/devtools "0.1.2"]                                                                                ; Electron 0.28.2 has old Blink, we have to stick with this old version of devtools for now
   [figwheel "0.3.7"]
   [rm-hull/inkspot "0.0.1-SNAPSHOT"]
   [spellhouse/phalanges "0.1.6"]
   [funcool/cuerdas "0.6.0"]
   [prismatic/schema "0.4.4"]
   [reagent "0.5.0" :exclusions [cljsjs/react]]
   [cljsjs/react "0.13.3-1"]]

  :plugins
  [[lein-cljsbuild "1.0.6"]
   [lein-figwheel "0.3.3"]]

  :source-paths
  ["src/macros"
   "src/env"
   "target/classes"]

  :clean-targets ^{:protect false} ["../lib/_build" "target" ".tmp"]

  :figwheel
  {:server-port    7000
   :nrepl-port     7777
   :server-logfile ".tmp/figwheel_server.log"}

  :cljsbuild
  {:builds
   {:dev
    {:source-paths ["checkouts/re-frame/src"
                    "checkouts/reagent/src"
                    "checkouts/rewrite-cljs/src"
                    "src/macros"
                    "src/env"
                    "src/dev"
                    "src/common"
                    "src/main"
                    "src/worker"]
     :compiler     {:main            plastic.main
                    :closure-defines {"plastic.env.run_worker_on_main_thread" true
                                      "plastic.env.validate_dbs"              true
                                      "plastic.env.log_all_dispatches"        true}
                    :output-to       "../lib/_dev_build/main/plastic.js"
                    :output-dir      "../lib/_dev_build/main"
                    :optimizations   :none
                    :target          :nodejs
                    :compiler-stats  true
                    :cache-analysis  true
                    :figwheel        true
                    :source-map      true}}
    :main
    {:source-paths ["checkouts/re-frame/src"
                    "checkouts/reagent/src"
                    "src/macros"
                    "src/env"
                    "src/dev"
                    "src/common"
                    "src/main"]
     :compiler     {:main           plastic.main
                    :output-to      "../lib/_build/main/plastic.js"
                    :output-dir     "../lib/_build/main"
                    :optimizations  :none
                    :target         :nodejs
                    :compiler-stats true
                    :cache-analysis true
                    :figwheel       true
                    :source-map     true}}
    :worker
    {:source-paths ["checkouts/re-frame/src"
                    "checkouts/rewrite-cljs/src"
                    "src/macros"
                    "src/env"
                    "src/dev"
                    "src/common"
                    "src/worker"]
     :compiler     {:main           plastic.worker
                    :output-to      "../lib/_build/worker/plastic.js"
                    :output-dir     "../lib/_build/worker"
                    :optimizations  :none
                    :target         :nodejs
                    :compiler-stats true
                    :cache-analysis true
                    :figwheel       true
                    :source-map     true}}}})

(defproject plastic "0.1.0-SNAPSHOT"
  :description "Plastic - Experimental ClojureScript editor component for Atom"
  :url "http://github.com/darwin/plastic"

  :dependencies
  [[org.clojure/clojure "1.7.0"]
   [org.clojure/clojurescript "1.7.107"]
   [org.clojure/tools.reader "0.10.0-SNAPSHOT"]
   [org.clojure/core.async "0.1.346.0-17112a-alpha"]
   [com.cognitect/transit-cljs "0.8.220"]
   [re-frame "0.4.1"]
   [rewrite-cljs "0.3.1"]
   [binaryage/devtools "0.1.2"]                                                                                ; Electron 0.28.2 has old Blink, we have to stick with this old version of devtools for now
   [figwheel "0.3.7"]
   [rm-hull/inkspot "0.0.1-SNAPSHOT"]
   [spellhouse/phalanges "0.1.6"]
   [funcool/cuerdas "0.6.0"]
   [prismatic/schema "0.4.4"]
   [reagent "0.5.0" :exclusions [cljsjs/react]]
   [cljsjs/react "0.13.3-1"]]

  :plugins
  [[lein-cljsbuild "1.1.0"]
   [lein-figwheel "0.3.3"]]

  :source-paths
  ["src/macros"
   "src/env"
   "target/classes"]

  :clean-targets ^{:protect false} ["../lib/_build" "target" ".tmp"]

  :figwheel
  {:server-port    7000
   :nrepl-port     7777
   :server-logfile ".tmp/figwheel_server.log"}

  :cljsbuild
  {:builds
   {:dev
    {:source-paths ["checkouts/re-frame/src"
                    "checkouts/reagent/src"
                    "checkouts/rewrite-cljs/src"
                    "src/macros"
                    "src/env"
                    "src/dev"
                    "src/common"
                    "src/main"
                    "src/worker"]
     :compiler     {:main            plastic.main
                    :closure-defines {"plastic.env.run_worker_on_main_thread" true
                                      "plastic.env.validate_dbs"              true
                                      "plastic.env.log_all_dispatches"        true}
                    :output-to       "../lib/_dev_build/main/plastic.js"
                    :output-dir      "../lib/_dev_build/main"
                    :optimizations   :none
                    :target          :nodejs
                    :compiler-stats  true
                    :cache-analysis  true
                    :figwheel        true
                    :source-map      true}}
    :main
    {:source-paths ["checkouts/re-frame/src"
                    "checkouts/reagent/src"
                    "src/macros"
                    "src/env"
                    "src/dev"
                    "src/common"
                    "src/main"]
     :compiler     {:main           plastic.main
                    :output-to      "../lib/_build/main/plastic.js"
                    :output-dir     "../lib/_build/main"
                    :optimizations  :none
                    :target         :nodejs
                    :compiler-stats true
                    :cache-analysis true
                    :figwheel       true
                    :source-map     true}}
    :worker
    {:source-paths ["checkouts/re-frame/src"
                    "checkouts/rewrite-cljs/src"
                    "src/macros"
                    "src/env"
                    "src/dev"
                    "src/common"
                    "src/worker"]
     :compiler     {:main           plastic.worker
                    :output-to      "../lib/_build/worker/plastic.js"
                    :output-dir     "../lib/_build/worker"
                    :optimizations  :none
                    :target         :nodejs
                    :compiler-stats true
                    :cache-analysis true
                    :figwheel       true
                    :source-map     true}}}})

bump lein-cljsbuild to 1.1.0

bump lein-cljsbuild to 1.1.0


(ns kixi.hecuba.api.profiles
  (:require
   [bidi.bidi :as bidi]
   [cheshire.core :as json]
   [clojure.tools.logging :as log]
   [kixi.hecuba.protocols :as hecuba]
   [kixi.hecuba.security :as sec]
   [kixi.hecuba.webutil :as util]
   [kixi.hecuba.webutil :refer (decode-body authorized? stringify-values sha1-regex)]
   [liberator.core :refer (defresource)]
   [liberator.representation :refer (ring-response)]))

(defn index-exists? [querier ctx]
  (let [request       (:request ctx)
        method        (:request-method request)
        route-params  (:route-params request)
        entity-id     (:entity-id route-params)
        entity        (hecuba/item querier :entity entity-id)
        _ (println "Looking for entity" entity)]
    (case method
      :post (not (nil? entity))
      :get (let [items (hecuba/items querier :profile [[= :entity-id entity-id]])]
             {::items items}))))

(defn index-malformed? [ctx]
  (let [request (:request ctx)
        {:keys [route-params request-method]} request
        entity-id (:entity-id route-params)]
    (case request-method
      :post (let [body (decode-body request)]
              ;; We need to assert a few things
              (if
                (or
                  (not= (:entity-id body) entity-id))
                true                  ; it's malformed, game over
                [false {:body body}]  ; it's not malformed, return the body now we've read it
                ))
      false)))

(defn index-post! [querier commander ctx]
  (let [{:keys [request body]} ctx
        entity-id     (-> request :route-params :entity-id)
        [username _]  (sec/get-username-password request querier)
        user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)]

    (when-not (empty? (first (hecuba/items querier :entity [[= :id entity-id]])))
      (let [profile   (-> body
                          (assoc :user-id user-id)
                          ;; here goes the list of "stuff" associated with profiles
                          ;(update-in [:thermal-images] json/encode)
                          ;(update-in [:storeys] json/encode)
                          ;(update-in [:walls] json/encode)
                          ;(update-in [:roofs] json/encode)
                          stringify-values)
            profile-id (hecuba/upsert! commander :profile profile)]
        {:profile-id profile-id}))))

(defn index-handle-ok [ctx]
  (let [{items ::items
         {mime :media-type} :representation
         {routes :modular.bidi/routes
          route-params :route-params} :request} ctx]
    (util/render-items ctx (->> items
                                (map #(dissoc % :user-id))
                                (map #(update-in % [:thermal-images] json/decode))
                                (map #(update-in % [:storeys] json/decode))
                                (map #(update-in % [:walls] json/decode))
                                (map #(update-in % [:roofs] json/decode))
                                (map util/downcast-to-json)
                                (map util/camelify)
                                json/encode))))

(defn index-handle-created [handlers ctx]
  (let [{{routes :modular.bidi/routes {entity-id :entity-id} :route-params} :request
         profile-id :profile-id} ctx]
    (if-not (empty? profile-id)
      (let [location
            (bidi/path-for routes (:profile @handlers)
                           :entity-id entity-id
                           :profile-id profile-id)]
        (when-not location
          (throw (ex-info "No path resolved for Location header"
                          {:entity-id entity-id
                           :profile-id profile-id})))
        (ring-response {:headers {"Location" location}
                        :body (json/encode {:location location
                                            :status "OK"
                                            :version "4"})}))
      (ring-response {:status 422
                      :body "Provide valid projectId and propertyCode."}))))

(defn resource-exists? [querier ctx]
  (let [{{{:keys [entity-id profile-id]} :route-params} :request} ctx
        item (hecuba/item querier :profile profile-id)]
    (if-not (empty? item)
      {::item (-> item
                  (assoc :profile-id profile-id)
                  (dissoc :id))}
      false)))

(defn resource-delete-enacted? [commander ctx]
  (let [{item ::item} ctx
        device-id (:device-id item)
        entity-id (:entity-id item)
        response1 (hecuba/delete! commander :device [[= :id device-id]])
        response2 (hecuba/delete! commander :sensor [[= :device-id device-id]])
        response3 (hecuba/delete! commander :sensor-metadata [[= :device-id device-id]])
        response4 (hecuba/delete! commander :entity {:devices device-id} [[= :id entity-id]])]
    (every? empty? [response1 response2 response3 response4])))

(defn resource-put! [commander querier ctx]
  (let [{request :request} ctx]
    (if-let [item (::item ctx)]
      (let [body          (decode-body request)
            entity-id     (-> item :entity-id)
            [username _]  (sec/get-username-password request querier)
            user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)
            profile-id     (-> item :profile-id)]
        (hecuba/upsert! commander :profile (-> body
                                               (assoc :id profile-id)
                                               (assoc :user-id user-id)
                                               ;; TODO: add storeys, walls, etc.
                                               stringify-values)))
      (ring-response {:status 404 :body "Please provide valid entityId and timestamp"}))))

(defn resource-handle-ok [querier ctx]
  (let [{item ::item} ctx]
    (-> item
        (dissoc :user-id)
        ;; TODO add storeys, walls, etc.
        util/downcast-to-json
        util/camelify
        json/encode)))

(defn resource-respond-with-entity [ctx]
  (let [request (:request ctx)
        method  (:request-method request)]
    (cond
     (= method :delete) false
      :else true)))

(defresource index [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :post}
  :available-media-types #{"application/json"}
  :known-content-type? #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial index-exists? querier)
  :malformed? index-malformed?
  :post! (partial index-post! querier commander)
  :handle-ok (partial index-handle-ok)
  :handle-created (partial index-handle-created handlers))

(defresource resource [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :delete :putj}
  :available-media-types #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial resource-exists? querier)
  :delete-enacted? (partial resource-delete-enacted? commander)
  :respond-with-entity? (partial resource-respond-with-entity)
  :new? (constantly false)
  :can-put-to-missing? (constantly false)
  :put! (partial resource-put! commander querier)
  :handle-ok (partial resource-handle-ok querier))

(ns kixi.hecuba.api.profiles
  (:require
   [bidi.bidi :as bidi]
   [cheshire.core :as json]
   [clojure.tools.logging :as log]
   [kixi.hecuba.protocols :as hecuba]
   [kixi.hecuba.security :as sec]
   [kixi.hecuba.webutil :as util]
   [kixi.hecuba.webutil :refer (decode-body authorized? stringify-values sha1-regex)]
   [liberator.core :refer (defresource)]
   [liberator.representation :refer (ring-response)]))

(defn index-exists? [querier ctx]
  (let [request       (:request ctx)
        method        (:request-method request)
        route-params  (:route-params request)
        entity-id     (:entity-id route-params)
        entity        (hecuba/item querier :entity entity-id)]
    (case method
      :post (not (nil? entity))
      :get (let [items (hecuba/items querier :profile [[= :entity-id entity-id]])]
             {::items items}))))

(defn index-malformed? [ctx]
  (let [request (:request ctx)
        {:keys [route-params request-method]} request
        entity-id (:entity-id route-params)]
    (case request-method
      :post (let [body (decode-body request)]
              ;; We need to assert a few things
              (if
                (or
                  (not= (:entity-id body) entity-id))
                true                  ; it's malformed, game over
                [false {:body body}]  ; it's not malformed, return the body now we've read it
                ))
      false)))

(defn json-list [items]
  (map json/encode items))

(defn update-when-available [body [selector]]
  (if
    (selector body)
    (update-in body [selector] json-list)
    (assoc body selector nil)))

(defn index-post! [querier commander ctx]
  (let [{:keys [request body]} ctx
        entity-id     (-> request :route-params :entity-id)
        [username _]  (sec/get-username-password request querier)
        user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)]

    (when-not (empty? (first (hecuba/items querier :entity [[= :id entity-id]])))
      (let [profile   (-> body
                          (assoc :user-id user-id)
                          (update-in [:profile-data] json/encode)
                          ;; here goes the list of "stuff" associated with profiles
                          (update-when-available [:airflow_measurements])
                          (update-when-available [:chps])
                          (update-when-available [:conservatories])
                          (update-when-available [:door_sets])
                          (update-when-available [:extensions])
                          (update-when-available [:floors])
                          (update-when-available [:heat_pumps])
                          (update-when-available [:heating_systems])
                          (update-when-available [:hot_water_systems])
                          (update-when-available [:low_energy_lights])
                          (update-when-available [:photovoltaics])
                          (update-when-available [:roof_rooms])
                          (update-when-available [:roofs])
                          (update-when-available [:small_hydros])
                          (update-when-available [:solar_thermals])
                          (update-when-available [:storeys])
                          (update-when-available [:thermal-images])
                          (update-when-available [:walls])
                          (update-when-available [:wind_turbines])
                          (update-when-available [:window_sets]))
            profile-id (hecuba/upsert! commander :profile profile)]
        {:profile-id profile-id}))))

(defn index-handle-ok [ctx]
  (let [{items ::items
         {mime :media-type} :representation
         {routes :modular.bidi/routes
          route-params :route-params} :request} ctx]
    (util/render-items ctx (->> items
                                (map #(dissoc % :user-id))
                                (map #(update-in % [:thermal-images] json/decode))
                                (map #(update-in % [:storeys] json/decode))
                                (map #(update-in % [:walls] json/decode))
                                (map #(update-in % [:roofs] json/decode))
                                (map util/downcast-to-json)
                                (map util/camelify)
                                json/encode))))

(defn index-handle-created [handlers ctx]
  (let [{{routes :modular.bidi/routes {entity-id :entity-id} :route-params} :request
         profile-id :profile-id} ctx]
    (if-not (empty? profile-id)
      (let [location
            (bidi/path-for routes (:profile @handlers)
                           :entity-id entity-id
                           :profile-id profile-id)]
        (when-not location
          (throw (ex-info "No path resolved for Location header"
                          {:entity-id entity-id
                           :profile-id profile-id})))
        (ring-response {:headers {"Location" location}
                        :body (json/encode {:location location
                                            :status "OK"
                                            :version "4"})}))
      (ring-response {:status 422
                      :body "Provide valid projectId and propertyCode."}))))

(defn resource-exists? [querier ctx]
  (let [{{{:keys [entity-id profile-id]} :route-params} :request} ctx
        item (hecuba/item querier :profile profile-id)]
    (if-not (empty? item)
      {::item (-> item
                  (assoc :profile-id profile-id)
                  (dissoc :id))}
      false)))

(defn resource-delete-enacted? [commander ctx]
  (let [{item ::item} ctx
        device-id (:device-id item)
        entity-id (:entity-id item)
        response1 (hecuba/delete! commander :device [[= :id device-id]])
        response2 (hecuba/delete! commander :sensor [[= :device-id device-id]])
        response3 (hecuba/delete! commander :sensor-metadata [[= :device-id device-id]])
        response4 (hecuba/delete! commander :entity {:devices device-id} [[= :id entity-id]])]
    (every? empty? [response1 response2 response3 response4])))

(defn resource-put! [commander querier ctx]
  (let [{request :request} ctx]
    (if-let [item (::item ctx)]
      (let [body          (decode-body request)
            entity-id     (-> item :entity-id)
            [username _]  (sec/get-username-password request querier)
            user-id       (-> (hecuba/items querier :user [[= :username username]]) first :id)
            profile-id     (-> item :profile-id)]
        (hecuba/upsert! commander :profile (-> body
                                               (assoc :id profile-id)
                                               (assoc :user-id user-id)
                                               ;; TODO: add storeys, walls, etc.
                                               stringify-values)))
      (ring-response {:status 404 :body "Please provide valid entityId and timestamp"}))))

(defn resource-handle-ok [querier ctx]
  (let [{item ::item} ctx]
    (-> item
        (dissoc :user-id)
        ;; TODO add storeys, walls, etc.
        util/downcast-to-json
        util/camelify
        json/encode)))

(defn resource-respond-with-entity [ctx]
  (let [request (:request ctx)
        method  (:request-method request)]
    (cond
     (= method :delete) false
      :else true)))

(defresource index [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :post}
  :available-media-types #{"application/json"}
  :known-content-type? #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial index-exists? querier)
  :malformed? index-malformed?
  :post! (partial index-post! querier commander)
  :handle-ok (partial index-handle-ok)
  :handle-created (partial index-handle-created handlers))

(defresource resource [{:keys [commander querier]} handlers]
  :allowed-methods #{:get :delete :putj}
  :available-media-types #{"application/json"}
  :authorized? (authorized? querier :profile)
  :exists? (partial resource-exists? querier)
  :delete-enacted? (partial resource-delete-enacted? commander)
  :respond-with-entity? (partial resource-respond-with-entity)
  :new? (constantly false)
  :can-put-to-missing? (constantly false)
  :put! (partial resource-put! commander querier)
  :handle-ok (partial resource-handle-ok querier))

Add support for list attributes

Add support for list attributes


(ns leiningen.droid.manifest
  "Contains functions to manipulate AndroidManifest.xml file"
  (:require [clojure.data.zip.xml :refer :all]
            [clojure.xml :as xml]
            [clojure.java.io :as jio]
            [clojure.zip :refer [up xml-zip]]
            [clostache.parser :as clostache]
            [leiningen.core.main :refer [info debug]]
            [leiningen.droid.aar :refer [get-aar-files]]
            [leiningen.droid.utils :refer [dev-build?]]
            [leiningen.release :refer [parse-semantic-version]])
  (:import com.android.manifmerger.ManifestMerger
           com.android.manifmerger.MergerLog
           [com.android.utils StdLogger StdLogger$Level]))

;; ### Constants

;; Name of the category for the launcher activities.
(def ^{:private true} launcher-category "android.intent.category.LAUNCHER")

;; Attribute name for target SDK version.
(def ^:private target-sdk-attribute (keyword :android:targetSdkVersion))

;; Attribute name for minimal SDK version.
(def ^:private min-sdk-attribute (keyword :android:minSdkVersion))

;; Attribute name for project version name.
(def ^:private version-name-attribute (keyword :android:versionName))

;; ### Local functions

(defn- load-manifest
  "Parses given XML manifest file and creates a zipper from it."
  [manifest-path]
  (xml-zip (xml/parse manifest-path)))

(defn- get-all-launcher-activities
  "Returns a list of zipper trees of Activities which belong to the
  _launcher_ category."
  [manifest]
  (xml-> manifest :application :activity :intent-filter :category
         (attr= :android:name launcher-category)))

;; ### Public functions

(defn get-package-name
  "Returns the name of the application's package."
  [manifest-path]
  (first (xml-> (load-manifest manifest-path) (attr :package))))

(defn get-launcher-activity
  "Returns the package-qualified name of the first activity from the
  manifest that belongs to the _launcher_ category."
  [{{:keys [manifest-path rename-manifest-package]} :android}]
  (let [manifest (load-manifest manifest-path)
        [activity-name] (some-> manifest
                            get-all-launcher-activities
                            first
                            up up
                            (xml-> (attr :android:name)))
        pkg-name (first (xml-> manifest (attr :package)))]
    (when activity-name
      (str (or rename-manifest-package pkg-name) "/"
           (str pkg-name activity-name)))))

(defn get-target-sdk-version
  "Extracts the target SDK version from the provided manifest file. If
  target SDK is not specified returns minimal SDK."
  [manifest-path]
  (let [[uses-sdk] (xml-> (load-manifest manifest-path) :uses-sdk)
        [target-sdk] (xml-> uses-sdk (attr target-sdk-attribute))]
    (or target-sdk
        (first (xml-> uses-sdk (attr min-sdk-attribute))))))

(defn get-project-version
  "Extracts the project version name from the provided manifest file."
  [manifest-path]
  (first (xml-> (load-manifest manifest-path) (attr version-name-attribute))))

(def ^:private version-bit-sizes [9 9 9 5])

(def ^:private version-maximums
  (mapv (partial bit-shift-left 1) version-bit-sizes))

(def ^:private version-coefficients
  (mapv (fn [offset] (bit-shift-left 1 (- 32 offset)))
        (reductions + version-bit-sizes)))

(defn- assert>
  "Asserts that a>b in version segments"
  [a b]
  (assert (> a b) (str "Version number segment too large to fit in the
  version-code scheme " b ">" a ", maximum version in each segment
  is " (clojure.string/join "." version-maximums)))
  b)

(defn version-code
  "Given a version map containing :major :minor :patch
   :build and :priority version numbers, returns an integer which is
   guaranteed to be greater for semantically larger version numbers.

   Splitting the 32 bit version code into 5 segments such that each
   semantically greater version will have a larger version code. The
   segments represent major, minor, patch, build and package
   priority (multiple builds of the same android apk where one takes
   precedence over another, for instance in the case where higher
   resolution assets are available, but a fallback is made available
   for devices which do not support the configuration).

   Largest possible version number: v512.512.512 (32)"
  [version-map]
  (->> version-map
       ((juxt :major :minor :patch :priority))
       (map (fnil assert> 0 0) version-maximums)
       (map * version-coefficients)
       (reduce +)))

(defn merge-manifests
  "Merges the main application manifest file with manifests from AAR files."
  [{{:keys [manifest-path manifest-main-app-path]} :android :as project}]
  (let [merger (ManifestMerger. (MergerLog/wrapSdkLog
                                 (StdLogger. StdLogger$Level/VERBOSE)) nil)
        lib-manifests (get-aar-files project "AndroidManifest.xml")]
    (debug "Merging secondary manifests:" lib-manifests)
    (.process merger (jio/file manifest-path) (jio/file manifest-main-app-path)
              (into-array lib-manifests) nil nil)))

(defn generate-manifest
  "If a :manifest-template-path is specified, perform template substitution with
  the values in :android :manifest, including the version-name and version-code
  which are automatically generated, placing the output in :manifest-path."
  [{{:keys [manifest-path manifest-template-path manifest-options manifest-main-app-path
            target-path]} :android, version :version :as project}]
  (info "Generating manifest...")
  (let [full-manifest-map (merge {:version-name version
                                  :version-code (-> version
                                                    parse-semantic-version
                                                    version-code)
                                  :debug-build (dev-build? project)}
                                 manifest-options)]
    (jio/make-parents manifest-path)
    (->> full-manifest-map
         (clostache/render (slurp manifest-template-path))
         (spit manifest-main-app-path))
    (merge-manifests project)))

(ns leiningen.droid.manifest
  "Contains functions to manipulate AndroidManifest.xml file"
  (:require [clojure.data.zip.xml :refer :all]
            [clojure.xml :as xml]
            [clojure.java.io :as jio]
            [clojure.zip :refer [up xml-zip]]
            [clostache.parser :as clostache]
            [leiningen.core.main :refer [info debug]]
            [leiningen.droid.aar :refer [get-aar-files]]
            [leiningen.droid.utils :refer [dev-build?]]
            [leiningen.release :refer [parse-semantic-version]])
  (:import com.android.manifmerger.ManifestMerger
           com.android.manifmerger.MergerLog
           [com.android.utils StdLogger StdLogger$Level]))

;; ### Constants

;; Name of the category for the launcher activities.
(def ^{:private true} launcher-category "android.intent.category.LAUNCHER")

;; Attribute name for target SDK version.
(def ^:private target-sdk-attribute (keyword :android:targetSdkVersion))

;; Attribute name for minimal SDK version.
(def ^:private min-sdk-attribute (keyword :android:minSdkVersion))

;; Attribute name for project version name.
(def ^:private version-name-attribute (keyword :android:versionName))

;; ### Local functions

(defn- load-manifest
  "Parses given XML manifest file and creates a zipper from it."
  [manifest-path]
  (xml-zip (xml/parse manifest-path)))

(defn- get-all-launcher-activities
  "Returns a list of zipper trees of Activities which belong to the
  _launcher_ category."
  [manifest]
  (xml-> manifest :application :activity :intent-filter :category
         (attr= :android:name launcher-category)))

;; ### Public functions

(defn get-package-name
  "Returns the name of the application's package."
  [manifest-path]
  (first (xml-> (load-manifest manifest-path) (attr :package))))

(defn get-launcher-activity
  "Returns the package-qualified name of the first activity from the
  manifest that belongs to the _launcher_ category."
  [{{:keys [manifest-path rename-manifest-package]} :android}]
  (let [manifest (load-manifest manifest-path)
        [activity-name] (some-> manifest
                            get-all-launcher-activities
                            first
                            up up
                            (xml-> (attr :android:name)))
        pkg-name (first (xml-> manifest (attr :package)))]
    (when activity-name
      (str (or rename-manifest-package pkg-name) "/"
           (if (.startsWith activity-name ".")
             (str pkg-name activity-name)
             activity-name)))))

(defn get-target-sdk-version
  "Extracts the target SDK version from the provided manifest file. If
  target SDK is not specified returns minimal SDK."
  [manifest-path]
  (let [[uses-sdk] (xml-> (load-manifest manifest-path) :uses-sdk)
        [target-sdk] (xml-> uses-sdk (attr target-sdk-attribute))]
    (or target-sdk
        (first (xml-> uses-sdk (attr min-sdk-attribute))))))

(defn get-project-version
  "Extracts the project version name from the provided manifest file."
  [manifest-path]
  (first (xml-> (load-manifest manifest-path) (attr version-name-attribute))))

(def ^:private version-bit-sizes [9 9 9 5])

(def ^:private version-maximums
  (mapv (partial bit-shift-left 1) version-bit-sizes))

(def ^:private version-coefficients
  (mapv (fn [offset] (bit-shift-left 1 (- 32 offset)))
        (reductions + version-bit-sizes)))

(defn- assert>
  "Asserts that a>b in version segments"
  [a b]
  (assert (> a b) (str "Version number segment too large to fit in the
  version-code scheme " b ">" a ", maximum version in each segment
  is " (clojure.string/join "." version-maximums)))
  b)

(defn version-code
  "Given a version map containing :major :minor :patch
   :build and :priority version numbers, returns an integer which is
   guaranteed to be greater for semantically larger version numbers.

   Splitting the 32 bit version code into 5 segments such that each
   semantically greater version will have a larger version code. The
   segments represent major, minor, patch, build and package
   priority (multiple builds of the same android apk where one takes
   precedence over another, for instance in the case where higher
   resolution assets are available, but a fallback is made available
   for devices which do not support the configuration).

   Largest possible version number: v512.512.512 (32)"
  [version-map]
  (->> version-map
       ((juxt :major :minor :patch :priority))
       (map (fnil assert> 0 0) version-maximums)
       (map * version-coefficients)
       (reduce +)))

(defn merge-manifests
  "Merges the main application manifest file with manifests from AAR files."
  [{{:keys [manifest-path manifest-main-app-path]} :android :as project}]
  (let [merger (ManifestMerger. (MergerLog/wrapSdkLog
                                 (StdLogger. StdLogger$Level/VERBOSE)) nil)
        lib-manifests (get-aar-files project "AndroidManifest.xml")]
    (debug "Merging secondary manifests:" lib-manifests)
    (.process merger (jio/file manifest-path) (jio/file manifest-main-app-path)
              (into-array lib-manifests) nil nil)))

(defn generate-manifest
  "If a :manifest-template-path is specified, perform template substitution with
  the values in :android :manifest, including the version-name and version-code
  which are automatically generated, placing the output in :manifest-path."
  [{{:keys [manifest-path manifest-template-path manifest-options manifest-main-app-path
            target-path]} :android, version :version :as project}]
  (info "Generating manifest...")
  (let [full-manifest-map (merge {:version-name version
                                  :version-code (-> version
                                                    parse-semantic-version
                                                    version-code)
                                  :debug-build (dev-build? project)}
                                 manifest-options)]
    (jio/make-parents manifest-path)
    (->> full-manifest-map
         (clostache/render (slurp manifest-template-path))
         (spit manifest-main-app-path))
    (merge-manifests project)))

fix broken 'droid run' again

[l.d.deploy] fix broken 'droid run' again


(ns dynamodb-expression.core
  (:refer-clojure :rename {remove core-remove})
  (:require [clojure.string :as st]))

(defn- sanitize-placeholder [ph]
  (st/replace ph #"[^0-9a-zA-Z_]" "_"))

(defn update-expr [key]
  {:ops []
   :key key})

(defn field->str [f]
  (cond (or (keyword? f) (symbol? f) (string? f)) (name f)
        (number? f)                               (str "[" f "]")
        :default                                  (str f)))

(defn- new-op [op field val expr-part-fn]
  (let [f         (if (sequential? field)
                    (st/join "_" (map field->str field))
                    (field->str field))
        sym       (sanitize-placeholder (str (gensym (str f "_"))))
        expr-name (str "#n" sym)
        expr-val  (str ":v" sym)
        o         {:op        op
                   :field     (field->str (if (sequential? field) (last field) field))
                   :val       val
                   :expr-name expr-name
                   :expr-val  expr-val}]
    (if expr-part-fn
      (assoc o :expr-part (expr-part-fn o))
      o)))

#_ (defn part-> [f & args]
     #(apply f % args))

(defn- include-op
  ([expr op]
   (update-in expr [:ops] conj op))
  ([expr op field val expr-part-fn]
   (if (sequential? field)
     (->> (reductions conj [] (butlast field))
          (core-remove empty?)
          (map #(new-op op % nil nil))
          (concat [(new-op op field val expr-part-fn)])
          (reduce include-op expr))
     (include-op expr (new-op op field val expr-part-fn)))))

(defn add [expr field val]
  (include-op expr :add field val #(str (:expr-name %) " " (:expr-val %))))

(def ^:private operator->str {'+ "+"
                              '- "-"
                              +  "+"
                              -  "-"
                              :+ "+"
                              :- "-"})

(defn set
  ([expr field val]
   (include-op expr :set field val #(str (:expr-name %) " = " (:expr-val %))))
  ([expr field operator val]
   (include-op expr :set field val #(str (:expr-name %) " = " (:expr-name %) " " (operator->str operator operator) " " (:expr-val %))))
  ([expr field other-field operator val]
   (let [other-op (new-op :set other-field nil nil)]
     (-> expr
         (include-op :set field val #(str (:expr-name %) " = " (:expr-name other-op) " " (operator->str operator operator) " " (:expr-val %)))
         (include-op other-op)))))

(defn delete [expr field val]
  (include-op expr :delete field val #(str (:expr-name %) " " (:expr-val %))))

(defn remove [expr field]
  (include-op expr :remove field nil :expr-name))

(defn- build-expression [ops]
  (->> ops
       (partition-by :op)
       (reduce (fn [ex [{:keys [op]} :as ops]]
                 (->> ops
                      (keep :expr-part)
                      (st/join ", ")
                      (str ex (when ex " ") (st/upper-case (name op)) " ")))
               nil)))

(defn- attr-map [name-or-value key ops]
  (->> ops
       (map (juxt name-or-value key))
       (core-remove #(some nil? %))
       (into {})))

(defn expr [{:keys [key ops] :as expr}]
  {:update-expression (build-expression ops)
   :expression-attribute-names (attr-map :expr-name :field ops)
   :expression-attribute-values (attr-map :expr-val :val ops)
   :key key})

(ns dynamodb-expression.core
  (:refer-clojure :rename {remove core-remove set core-set})
  (:require [clojure.string :as st]))

(defn- sanitize-placeholder [ph]
  (st/replace ph #"[^0-9a-zA-Z_]" "_"))

(defn update-expr [key]
  {:ops []
   :key key})

(defn field->str [f]
  (cond (or (keyword? f) (symbol? f) (string? f)) (name f)
        (number? f)                               (str "[" f "]")
        :default                                  (str f)))

(defn- new-op [op field val expr-part-fn]
  (let [f         (if (sequential? field)
                    (st/join "_" (map field->str field))
                    (field->str field))
        sym       (sanitize-placeholder (str (gensym (str f "_"))))
        expr-name (str "#n" sym)
        expr-val  (str ":v" sym)
        o         {:op        op
                   :field     (field->str (if (sequential? field) (last field) field))
                   :val       val
                   :expr-name expr-name
                   :expr-val  expr-val}]
    (if expr-part-fn
      (assoc o :expr-part (expr-part-fn o))
      o)))

#_ (defn part-> [f & args]
     #(apply f % args))

(defn- include-op
  ([expr op]
   (update-in expr [:ops] conj op))
  ([expr op field val expr-part-fn]
   (if (sequential? field)
     (->> (reductions conj [] (butlast field))
          (core-remove empty?)
          (map #(new-op op % nil nil))
          (concat [(new-op op field val expr-part-fn)])
          (reduce include-op expr))
     (include-op expr (new-op op field val expr-part-fn)))))

(defn add [expr field val]
  (include-op expr :add field val #(str (:expr-name %) " " (:expr-val %))))

(def ^:private operator->str {'+ "+"
                              '- "-"
                              +  "+"
                              -  "-"
                              :+ "+"
                              :- "-"})

(defn set
  ([expr field val]
   (include-op expr :set field val #(str (:expr-name %) " = " (:expr-val %))))
  ([expr field operator val]
   (include-op expr :set field val #(str (:expr-name %) " = " (:expr-name %) " " (operator->str operator operator) " " (:expr-val %))))
  ([expr field other-field operator val]
   (let [other-op (new-op :set other-field nil nil)]
     (-> expr
         (include-op :set field val #(str (:expr-name %) " = " (:expr-name other-op) " " (operator->str operator operator) " " (:expr-val %)))
         (include-op other-op)))))

(defn delete [expr field val]
  (include-op expr :delete field val #(str (:expr-name %) " " (:expr-val %))))

(defn remove [expr field]
  (include-op expr :remove field nil :expr-name))

(defn- build-expression [ops]
  (->> ops
       (partition-by :op)
       (reduce (fn [ex [{:keys [op]} :as ops]]
                 (->> ops
                      (keep :expr-part)
                      (st/join ", ")
                      (str ex (when ex " ") (st/upper-case (name op)) " ")))
               nil)))

(defn- attr-map [name-or-value key ops]
  (->> ops
       (map (juxt name-or-value key))
       (core-remove #(some nil? %))
       (into {})))

(defn expr [{:keys [key ops] :as expr}]
  {:update-expression (build-expression ops)
   :expression-attribute-names (attr-map :expr-name :field ops)
   :expression-attribute-values (attr-map :expr-val :val ops)
   :key key})

fix import

fix import


(ns norman-sicily-static.web
  (:require [optimus.assets :as assets]
            [optimus.export]
            [optimus.link :as link]
            [optimus.optimizations :as optimizations]
            [optimus.prime :as optimus]
            [optimus.strategies :refer [serve-live-assets]]
            [optimus-less.core]
            [clojure.java.io :as io]
            [clojure.string :as str]
            [hiccup.page :refer [html5 include-css include-js]]
            [hiccup.element :refer [javascript-tag]]
            [stasis.core :as stasis]
            [norman-sicily-static.util :as util]))

(defn get-assets []
  (concat
    (assets/load-assets "public" [#"/icons/.*"])
    (assets/load-assets "public" [#"/images/.*"])
    (assets/load-assets "public" ["/scripts/app.js" "/scripts/bootstrap.min.js"])
    (assets/load-bundle "public" "app.css" ["/styles/app.less"])
    (assets/load-assets "public" [#"/svg/.*"])))

(defn layout-page [request page]
  (html5
    {:lang "en"}
    [:head
     [:meta {:charset "utf-8"}]
     [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]
     [:meta {:name "viewport"
             :content "width=device-width, initial-scale=1.0"}]
     [:title "The Norman Sicily Project"]
     (include-css (link/file-path request "/bundles/app.css"))
     (javascript-tag (str
                       "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
                       (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
                       m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
                       })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

                       ga('create', 'UA-75482271-1', 'auto');
                       ga('require', 'linkid');
                       ga('send', 'pageview');"))]
    [:body
     [:div.body
      (util/render-navbar)
      page]
     (util/render-footer)
     [:script
      {:src "https://code.jquery.com/jquery-3.2.1.slim.min.js"
       :integrity "sha256-k2WSCIexGzOj3Euiig+TlR8gA0EmPjuc79OEeY5L45g="
       :crossorigin "anonymous"}]
     (include-js (link/file-path request "/scripts/bootstrap.min.js"))
     (include-js (link/file-path request "/scripts/app.js"))]))

(defn partial-pages [pages]
  (zipmap (keys pages)
          (map #(fn [req] (layout-page req %)) (vals pages))))

(defn get-raw-pages []
  (stasis/merge-page-sources
    {:public
     (stasis/slurp-directory "resources/public" #".*\.(html|css|js)$")
     :partials
     (partial-pages (stasis/slurp-directory "resources/partials" #".*\.html$"))}))

(defn prepare-page [page req]
  (-> (if (string? page) page (page req))))

(defn prepare-pages [pages]
  (zipmap (keys pages)
          (map #(partial prepare-page %) (vals pages))))

(defn get-pages []
  (prepare-pages (get-raw-pages)))

(def app (optimus/wrap (stasis/serve-pages get-pages)
                       get-assets
                       optimizations/all
                       serve-live-assets))

(def export-dir "dist")

(defn export []
  (let [assets (optimizations/all (get-assets) {})]
    (println assets)
    (stasis/empty-directory! export-dir)
    (optimus.export/save-assets assets export-dir)
    (stasis/export-pages (get-pages) export-dir {:optimus-assets assets})))

(ns norman-sicily-static.web
  (:require [optimus.assets :as assets]
            [optimus.html]
            [optimus.export]
            [optimus.link :as link]
            [optimus.optimizations :as optimizations]
            [optimus.prime :as optimus]
            [optimus.strategies :refer [serve-live-assets]]
            [optimus-less.core]
            [clojure.java.io :as io]
            [clojure.string :as str]
            [hiccup.page :refer [html5 include-css include-js]]
            [hiccup.element :refer [javascript-tag]]
            [stasis.core :as stasis]
            [norman-sicily-static.util :as util]))

(defn get-assets []
  (concat
    (assets/load-assets "public" [#"/icons/.*"])
    (assets/load-assets "public" [#"/images/.*"])
    (assets/load-assets "public" ["/scripts/app.js" "/scripts/bootstrap.min.js"])
    (assets/load-bundle "public" "app.css" ["/styles/app.less"])
    (assets/load-assets "public" [#"/svg/.*"])))

(defn layout-page [request page]
  (html5
    {:lang "en"}
    [:head
     [:meta {:charset "utf-8"}]
     [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]
     [:meta {:name "viewport"
             :content "width=device-width, initial-scale=1.0"}]
     [:title "The Norman Sicily Project"]
     (optimus.html/link-to-css-bundles request ["app.css"])
     (javascript-tag (str
                       "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
                       (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
                       m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
                       })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');

                       ga('create', 'UA-75482271-1', 'auto');
                       ga('require', 'linkid');
                       ga('send', 'pageview');"))]
    [:body
     [:div.body
      (util/render-navbar)
      page]
     (util/render-footer)
     [:script
      {:src "https://code.jquery.com/jquery-3.2.1.slim.min.js"
       :integrity "sha256-k2WSCIexGzOj3Euiig+TlR8gA0EmPjuc79OEeY5L45g="
       :crossorigin "anonymous"}]
     (include-js (link/file-path request "/scripts/bootstrap.min.js"))
     (include-js (link/file-path request "/scripts/app.js"))]))

(defn partial-pages [pages]
  (zipmap (keys pages)
          (map #(fn [req] (layout-page req %)) (vals pages))))

(defn get-raw-pages []
  (stasis/merge-page-sources
    {:public
     (stasis/slurp-directory "resources/public" #".*\.(html|css|js)$")
     :partials
     (partial-pages (stasis/slurp-directory "resources/partials" #".*\.html$"))}))

(defn prepare-page [page req]
  (-> (if (string? page) page (page req))))

(defn prepare-pages [pages]
  (zipmap (keys pages)
          (map #(partial prepare-page %) (vals pages))))

(defn get-pages []
  (prepare-pages (get-raw-pages)))

(def app (optimus/wrap (stasis/serve-pages get-pages)
                       get-assets
                       optimizations/all
                       serve-live-assets))

(def export-dir "dist")

(defn export []
  (let [assets (optimizations/all (get-assets) {})]
    (stasis/empty-directory! export-dir)
    (optimus.export/save-assets assets export-dir)
    (stasis/export-pages (get-pages) export-dir {:optimus-assets assets})))

Tweak css link code

Tweak css link code


(ns net.sekao.nightcode.core
  (:require [clojure.java.io :as io]
            [net.sekao.nightcode.controller :as c]
            [net.sekao.nightcode.editors :as e]
            [net.sekao.nightcode.projects :as p]
            [net.sekao.nightcode.shortcuts :as shortcuts]
            [net.sekao.nightcode.state :refer [pref-state runtime-state]]
            [clojure.spec :as s])
  (:import [javafx.application Application]
           [javafx.fxml FXMLLoader]
           [javafx.stage Stage StageBuilder]
           [javafx.scene Scene])
  (:gen-class :extends javafx.application.Application))

(def actions {:#start c/show-start-menu!
              :#import_project c/import!
              :#rename c/rename!
              :#remove c/remove!
              :#up c/up!
              :#save c/save!
              :#undo c/undo!
              :#redo c/redo!
              :#instarepl c/toggle-instarepl!
              :#find c/focus-on-find!
              :#close c/close!
              :.run c/run-normal!
              :.run-with-repl c/run-with-repl!
              :.reload c/reload!
              :.build c/build!
              :.clean c/clean!
              :.stop c/stop!})

(defn -start [^net.sekao.nightcode.core app ^Stage stage]
  (let [root (FXMLLoader/load (io/resource "main.fxml"))
        scene (Scene. root 1242 768)
        project-tree (.lookup scene "#project_tree")
        content (.lookup scene "#content")]
    (swap! runtime-state assoc :stage stage)
    (doto stage
      (.setTitle "Nightcode 2.0.0-alpha1")
      (.setScene scene)
      (.show))
    (shortcuts/init-tabs! scene)
    (shortcuts/add-tooltips! scene [:#project_tree :#start :#import_project :#rename :#remove])
    (-> content .getChildren .clear)
    ; create listeners
    (p/set-selection-listener! pref-state runtime-state stage)
    (p/set-focused-listener! pref-state stage project-tree)
    (p/set-project-key-listener! stage pref-state runtime-state)
    (shortcuts/set-shortcut-listeners! stage pref-state runtime-state actions)
    ; update the ui
    (p/update-project-tree! pref-state project-tree)
    (p/update-project-buttons! @pref-state scene)
    ; set the theme and font size
    (let [theme-buttons (->> (.lookup scene "#start")
                             .getItems
                             (filter #(= "theme_buttons" (.getId %)))
                             first
                             .getContent
                             .getChildren)]
      (case (:theme @pref-state)
        :dark (.fire (.get theme-buttons 0))
        :light (.fire (.get theme-buttons 1))
        nil))
    (c/font! scene)))

(defn -main [& args]
  (swap! runtime-state assoc :web-port (e/start-web-server!))
  (Application/launch net.sekao.nightcode.core (into-array String args)))

(defn dev-main [& args]
  (s/instrument-all)
  (apply -main args))

(ns net.sekao.nightcode.core
  (:require [clojure.java.io :as io]
            [net.sekao.nightcode.controller :as c]
            [net.sekao.nightcode.editors :as e]
            [net.sekao.nightcode.projects :as p]
            [net.sekao.nightcode.shortcuts :as shortcuts]
            [net.sekao.nightcode.state :refer [pref-state runtime-state]]
            [clojure.spec :as s])
  (:import [javafx.application Application]
           [javafx.fxml FXMLLoader]
           [javafx.stage Stage StageBuilder]
           [javafx.scene Scene])
  (:gen-class :extends javafx.application.Application))

(def actions {:#start c/show-start-menu!
              :#import_project c/import!
              :#rename c/rename!
              :#remove c/remove!
              :#up c/up!
              :#save c/save!
              :#undo c/undo!
              :#redo c/redo!
              :#instarepl c/toggle-instarepl!
              :#find c/focus-on-find!
              :#close c/close!
              :.run c/run-normal!
              :.run-with-repl c/run-with-repl!
              :.reload c/reload!
              :.build c/build!
              :.clean c/clean!
              :.stop c/stop!})

(defn -start [^net.sekao.nightcode.core app ^Stage stage]
  (let [root (FXMLLoader/load (io/resource "main.fxml"))
        scene (Scene. root 1242 768)
        project-tree (.lookup scene "#project_tree")
        content (.lookup scene "#content")]
    (swap! runtime-state assoc :stage stage)
    (doto stage
      (.setTitle "Nightcode 2.0.0-SNAPSHOT")
      (.setScene scene)
      (.show))
    (shortcuts/init-tabs! scene)
    (shortcuts/add-tooltips! scene [:#project_tree :#start :#import_project :#rename :#remove])
    (-> content .getChildren .clear)
    ; create listeners
    (p/set-selection-listener! pref-state runtime-state stage)
    (p/set-focused-listener! pref-state stage project-tree)
    (p/set-project-key-listener! stage pref-state runtime-state)
    (shortcuts/set-shortcut-listeners! stage pref-state runtime-state actions)
    ; update the ui
    (p/update-project-tree! pref-state project-tree)
    (p/update-project-buttons! @pref-state scene)
    ; set the theme and font size
    (let [theme-buttons (->> (.lookup scene "#start")
                             .getItems
                             (filter #(= "theme_buttons" (.getId %)))
                             first
                             .getContent
                             .getChildren)]
      (case (:theme @pref-state)
        :dark (.fire (.get theme-buttons 0))
        :light (.fire (.get theme-buttons 1))
        nil))
    (c/font! scene)))

(defn -main [& args]
  (swap! runtime-state assoc :web-port (e/start-web-server!))
  (Application/launch net.sekao.nightcode.core (into-array String args)))

(defn dev-main [& args]
  (s/instrument-all)
  (apply -main args))

Change alpha1 to SNAPSHOT

Change alpha1 to SNAPSHOT


(ns vault.index.search.brute
  (:require
    [vault.blob.core :as blob]
    [vault.index.search :as search]))

;;;;; BRUTE-FORCE INDEX ;;;;;

(defrecord BruteForceIndex
  [blob-store projection])

(extend-type BruteForceIndex
  search/SearchEngine

  (init!
    [this]
    ; no-op
    this)

  (update!
    [this record]
    ; no-op
    this)

  (search*
    [this pattern opts]
    ; Exhaustively search projections of stored blobs.
    (filter (partial search/matches? pattern)
            (mapcat (:projection this)
                    (blob/list (:blob-store this))))))

(defn brute-force-index
  [blob-store projection]
  (BruteForceIndex. blob-store projection))

(ns vault.index.search.brute
  (:require
    [vault.blob.core :as blob]
    [vault.index.search :as search]))

;;;;; BRUTE-FORCE INDEX ;;;;;

(defrecord BruteForceEngine
  [store projection]

  search/SearchEngine

  (update!
    [this record]
    ; no-op
    this)

  (search*
    [this pattern opts]
    ; Exhaustively search projections of stored blobs.
    (filter (partial search/matches? pattern)
            (mapcat projection (blob/list store)))))

(defn brute-force-engine
  [blob-store projection]
  (BruteForceEngine. blob-store projection))

Change names in index.search.brute engine.


;;;
;;;   Copyright 2015 Ruediger Gad
;;;
;;;   This software is released under the terms of the Eclipse Public License
;;;   (EPL) 1.0. You can find a copy of the EPL at:
;;;   http://opensource.org/licenses/eclipse-1.0.php
;;;

(ns
  ^{:author "Ruediger Gad",
    :doc "Helper that are primarily used during experiments"}
  dsbdp.experiment-helper
  (:require
    [clojure.walk :refer :all]
    [clojure.pprint :refer :all]
    [dsbdp.byte-array-conversion :refer :all]
    [dsbdp.data-processing-dsl :refer :all])
  (:import
    (java.util HashMap Map)
    (org.apache.commons.math3.util CombinatoricsUtils)))

(def pcap-byte-array-test-data
  "The byte array representation of a UDP packet for being used as dummy data."
  (byte-array
    (map byte [-5 -106 -57 84   15 -54 14 0   58 0 0 0   58 0 0 0                ; 16 byte pcap header
               -1 -2 -3 -14 -15 -16 1 2 3 4 5 6 8 0                              ; 14 byte Ethernet header
               69 0 0 44   0 3 64 0   7 17 115 -57   1 2 3 4   -4 -3 -2 -1       ; 20 byte IP header
               8 0 16 0 0 16 -25 -26                                              ; 8 byte UDP header
               97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112])))  ; 16 byte data "abcdefghijklmnop"

(defn create-proc-fns
  [fn-1 fn-n n]
  (loop [fns (prewalk-replace {:_idx_ 0} [fn-1])]
    (if (< (count fns) n)
      (recur (conj fns (prewalk-replace {:_idx_ (count fns)} fn-n)))
      (do
        (println "proc-fns-full:" fns)
        (println "proc-fns-short:" (.replaceAll (str fns) "(?<=\\()([a-zA-Z\\.\\-]++/)" ""))
        (println "proc-fns-pretty:\n" (.replaceAll (str (with-out-str (pprint fns))) "(?<=\\()([a-zA-Z\\.\\-]++/)" ""))
        (vec
          (map eval fns))))))

(defn create-no-op-proc-fns
  [n]
  (create-proc-fns
    '(fn [_ _] 0)
    '(fn [_ _] 1)
    n))

(defn create-inc-proc-fns
  [n]
  (create-proc-fns
    '(fn [i _] (inc i))
    '(fn [_ o] (inc o))
    n))

(defn create-hashmap-inc-put-proc-fns
  [n]
  (let [o-sym 'o]
    (let [o-meta (vary-meta o-sym assoc :tag 'java.util.Map)]
     (create-proc-fns
       '(fn [i _] (doto (java.util.HashMap.) (.put (str :_idx_) (inc i))))
       '(fn [_ o-meta] (.put o-meta (str :_idx_) (inc (.get o-meta (str (dec :_idx_))))))
       n))))

(defn factorial
  ([n]
    (factorial 1N 1N n))
  ([result i n]
    (if (<= i n)
      (recur (* result i) (inc i) n)
      result)))

(defn create-factorial-proc-fns
  [n]
  (create-proc-fns
    '(fn [i _] (dsbdp.experiment-helper/factorial i))
    '(fn [i _] (dsbdp.experiment-helper/factorial i))
     n))

(def sample-pcap-processing-definition-rules
  [['timestamp '(timestamp-str-be 0) :string]
   ['capture-length '(int32be 8)]
   ['eth-src '(eth-mac-addr-str 22) :string]
   ['eth-dst '(eth-mac-addr-str 16) :string]
   ['ip-src '(ipv4-addr-str 42) :string]
   ['ip-dst '(ipv4-addr-str 46) :string]
   ['ip-ver '(int4h 30)]
   ['ip-length '(float (/ (int16 32) 65535))]
   ['ip-id '(float (/ (int16 34) 65535))]
   ['ip-ttl '(float (/ (int8 38) 255))]
   ['ip-protocol '(float (/ (int8 39) 255))]
   ['ip-checksum '(float (/ (int16 40) 65535))]
   ['udp-src '(float (/ (int16 50) 65535))]
   ['udp-dst '(float (/ (int16 52) 65535))]
   ['udp-length '(float (/ (int16 54) 65535))]
   ['udp-checksum '(float (/ (int16 56) 65535))]
   ['udp-payload '(ba-to-str 58 16) :string]])

(def sample-pcap-processing-definition-json
  {:output-type :json-str
   :rules sample-pcap-processing-definition-rules})

(def sample-pcap-processing-definition-clj-map
  {:output-type :clj-map
   :rules sample-pcap-processing-definition-rules})

Add clj-map pcap sample.

Add clj-map pcap sample.


{:user {
        :aliases {
                  "lint" ["do" ["cljfmt" "check"] "kibit"]
                  "fix" ["do" ["cljfmt" "fix"] ["kibit" "--replace" "--interactive"]]}
        :plugins [
                  [lein-drip "0.1.1-SNAPSHOT"];; faster JVM
                  [venantius/ultra "0.6.0" :exclusions [org.clojure/clojure org.clojure/core.rrb-vector]];; pretty print
                  [lein-auto "0.1.3"];; watch tasks
                  [lein-try "0.4.3"];; REPL experimenting
                  ;; Project Scaffolding
                  [chestnut/lein-template "0.15.2"]
                  ;; Dependency Management
                  [com.livingsocial/lein-dependency-check "0.2.2"]
                  [lein-ancient "0.6.10"]
                  [lein-nvd "0.3.1"];; National Vulnerability Database dependency-checker
                  ;; Code Quality
                  [lein-cljfmt "0.5.7"]
                  [lein-kibit "0.1.5"]
                  [lein-bikeshed "0.4.1"]
                  ;; Testing
                  [lein-cloverage "1.0.9"]]}}

{:user {
        :aliases {
                  "lint" ["do" ["cljfmt" "check"] "kibit"]
                  "fix" ["do" ["cljfmt" "fix"] ["kibit" "--replace" "--interactive"]]}
        :plugins [
                  [lein-drip "0.1.1-SNAPSHOT"];; faster JVM
                  ;; Ultra is awesome, but v0.6.0 has issues with JDK v11
                ;   [venantius/ultra "0.6.0"];; pretty print and stuff
                  [lein-auto "0.1.3"];; watch tasks
                  [lein-try "0.4.3"];; REPL experimenting
                  ;; Project Scaffolding
                  [chestnut/lein-template "0.15.2"]
                  ;; Dependency Management
                  [com.livingsocial/lein-dependency-check "0.2.2"]
                  [lein-ancient "0.6.10"]
                  [lein-nvd "0.3.1"];; National Vulnerability Database dependency-checker
                  ;; Code Quality
                  [lein-cljfmt "0.5.7"]
                  [lein-kibit "0.1.5"]
                  [lein-bikeshed "0.4.1"]
                  ;; Testing
                  [lein-cloverage "1.0.9"]]}}

Comment out ultra until it is fixed

fix: Comment out ultra until it is fixed