(ns cerber.stores.authcode
  (:require [mount.core :refer [defstate]]
            [cerber
             [db :as db]
             [helpers :as helpers]
             [config :refer [app-config]]
             [store :refer :all]]
            [failjure.core :as f]
            [cerber.stores.user :as user]
            [cerber.error :as error]))

(defn default-valid-for []
  (-> app-config :authcodes :valid-for))

(declare ->map)

(defrecord AuthCode [client-id login code scope redirect-uri expires-at created-at])

(defrecord SqlAuthCodeStore []
  Store
  (fetch-one [this [code]]
    (->map (first (db/find-authcode {:code code}))))
  (revoke-one! [this [code]]
    (db/delete-authcode {:code code}))
  (store! [this k authcode]
    (when (= 1 (db/insert-authcode authcode)) authcode))
  (purge! [this]
    (db/clear-authcodes)))

(defmulti create-authcode-store identity)

(defmacro with-authcode-store
  "Changes default binding to default authcode store."
  [store & body]
  `(binding [*authcode-store* ~store] ~@body))

(defstate ^:dynamic *authcode-store*
  :start (create-authcode-store (-> app-config :authcodes :store))
  :stop  (helpers/stop-periodic *authcode-store*))

(defmethod create-authcode-store :in-memory [_]
  (->MemoryStore "authcodes" (atom {})))

(defmethod create-authcode-store :redis [_]
  (->RedisStore "authcodes" (:redis-spec app-config)))

(defmethod create-authcode-store :sql [_]
  (helpers/with-periodic-fn
    (->SqlAuthCodeStore) db/clear-expired-authcodes 8000))

(defn revoke-authcode
  "Revokes previously generated authcode."
  [authcode]
  (revoke-one! *authcode-store* [(:code authcode)]) nil)

(defn create-authcode
  "Creates new auth code"
  [client user scope redirect-uri & [ttl]]
  (let [authcode (helpers/reset-ttl
                  {:client-id (:id client)
                   :login (:login user)
                   :scope scope
                   :code (helpers/generate-secret)
                   :redirect-uri redirect-uri
                   :created-at (helpers/now)}
                  (or ttl (default-valid-for)))]

    (if (store! *authcode-store* [:code] authcode)
      (map->AuthCode authcode)
      (error/internal-error "Cannot store authcode"))))

(defn find-authcode [code]
  (if-let [authcode (fetch-one *authcode-store* [code])]
    (when-not (helpers/expired? authcode)
      (map->AuthCode authcode))))

(defn purge-authcodes
  []
  "Removes auth code from store. Used for tests only."
  (purge! *authcode-store*))

(defn ->map [result]
  (when-let [{:keys [client_id login code scope redirect_uri created_at expires_at]} result]
    {:client-id client_id
     :login login
     :code code
     :scope scope
     :redirect-uri redirect_uri
     :expires-at expires_at
     :created-at created_at}))

(ns cerber.stores.authcode
  (:require [mount.core :refer [defstate]]
            [cerber
             [db :as db]
             [helpers :as helpers]
             [config :refer [app-config]]
             [store :refer :all]]
            [failjure.core :as f]
            [cerber.stores.user :as user]
            [cerber.error :as error]
            [clojure.string :refer [join split]]))

(defn default-valid-for []
  (-> app-config :authcodes :valid-for))

(declare ->map)

(defrecord AuthCode [client-id login code scope redirect-uri expires-at created-at])

(defrecord SqlAuthCodeStore []
  Store
  (fetch-one [this [code]]
    (->map (first (db/find-authcode {:code code}))))
  (revoke-one! [this [code]]
    (db/delete-authcode {:code code}))
  (store! [this k authcode]
    (let [scope (join " " (:scope authcode))]
      (when (= 1 (db/insert-authcode (assoc authcode :scope scope))) authcode)))
  (purge! [this]
    (db/clear-authcodes)))

(defmulti create-authcode-store identity)

(defmacro with-authcode-store
  "Changes default binding to default authcode store."
  [store & body]
  `(binding [*authcode-store* ~store] ~@body))

(defstate ^:dynamic *authcode-store*
  :start (create-authcode-store (-> app-config :authcodes :store))
  :stop  (helpers/stop-periodic *authcode-store*))

(defmethod create-authcode-store :in-memory [_]
  (->MemoryStore "authcodes" (atom {})))

(defmethod create-authcode-store :redis [_]
  (->RedisStore "authcodes" (:redis-spec app-config)))

(defmethod create-authcode-store :sql [_]
  (helpers/with-periodic-fn
    (->SqlAuthCodeStore) db/clear-expired-authcodes 8000))

(defn revoke-authcode
  "Revokes previously generated authcode."
  [authcode]
  (revoke-one! *authcode-store* [(:code authcode)]) nil)

(defn create-authcode
  "Creates new auth code"
  [client user scope redirect-uri & [ttl]]
  (let [authcode (helpers/reset-ttl
                  {:client-id (:id client)
                   :login (:login user)
                   :scope scope
                   :code (helpers/generate-secret)
                   :redirect-uri redirect-uri
                   :created-at (helpers/now)}
                  (or ttl (default-valid-for)))]

    (if (store! *authcode-store* [:code] authcode)
      (map->AuthCode authcode)
      (error/internal-error "Cannot store authcode"))))

(defn find-authcode [code]
  (if-let [authcode (fetch-one *authcode-store* [code])]
    (when-not (helpers/expired? authcode)
      (map->AuthCode authcode))))

(defn purge-authcodes
  []
  "Removes auth code from store. Used for tests only."
  (purge! *authcode-store*))

(defn ->map [result]
  (when-let [{:keys [client_id login code scope redirect_uri created_at expires_at]} result]
    {:client-id client_id
     :login login
     :code code
     :scope (set (split scope #" "))
     :redirect-uri redirect_uri
     :expires-at expires_at
     :created-at created_at}))

Fix issue: #9

Fix issue: #9


(ns salava.core.layout
  (:require [clojure.pprint :refer [pprint]]
            [compojure.api.sweet :refer :all]
            [ring.util.http-response :refer [ok content-type]]
            [schema.core :as s]
            [clojure.java.io :as io]
            [clojure.data.json :as json]
            [salava.core.helper :refer [dump plugin-str private?]]
            [salava.core.util :refer [get-site-url plugin-fun get-plugins]]
            [clojure.string :refer [join split capitalize]]
            [salava.user.db :as u]
            [salava.badge.main :as b]
            [salava.page.main :as p]
            [salava.gallery.db :as g]
            [hiccup.page :refer [html5 include-css include-js]]
   [salava.extra.application.db :as app]
   salava.core.restructure))

(def asset-css
  ["/assets/bootstrap/css/bootstrap.min.css"
   "/assets/bootstrap/css/bootstrap-theme.min.css"
   "/assets/font-awesome/css/font-awesome.min.css"
   "/assets/leaflet/leaflet.css"
   "/css/rateit/rateit.css"
   "/css/simplemde.min.css"])

(def asset-js
  ["/assets/jquery/jquery.min.js"
   "/assets/bootstrap/js/bootstrap.min.js"
   "/assets/leaflet/leaflet.js"
   "/js/ckeditor/ckeditor.js"])

(defn with-version [ctx resource-name]
  (let [version (get-in ctx [:config :core :asset-version])]
    (str resource-name "?_=" (or version (System/currentTimeMillis)))))

(defn css-list [ctx]
  (let [plugins (get-in ctx [:config :core :plugins])
        coll (mapcat #(get-in ctx [:config % :css] []) plugins)]
    (if-not (empty? coll)
      ; If any plugin defines a list of css files, use those as-is
      (map #(with-version ctx %) (concat asset-css coll))
      ; Otherwise, create the list using plugin names
      (->> plugins
           (cons :core)
           (map plugin-str)
           (map    #(str "/css/" % ".css"))
           (filter #(io/resource (str "public" %)))
           (concat asset-css)
           (map #(with-version ctx %))))))

(defn js-list [ctx]
    (map #(with-version ctx %) (conj asset-js "/js/salava.js")))

(defn context-js [ctx]
  (let [site-name (get-in ctx [:config :core :site-name])
        share     {:site-name (get-in ctx [:config :core :share :site-name] site-name)
                   :hashtag   (get-in ctx [:config :core :share :hashtag] (->> (split site-name #" ")
                                                                               (map capitalize)
                                                                               join)) }
        ctx-out   {:plugins         {:all (map plugin-str (get-in ctx [:config :core :plugins]))}
                   :user            (:user ctx)
                   :flash-message   (:flash-message ctx)
                   :site-url        (get-in ctx [:config :core :site-url])
                   :site-name       site-name
                   :share           share
                   :base-path       (get-in ctx [:config :core :base-path])
                   :facebook-app-id (get-in ctx [:config :oauth :facebook :app-id])
                   :linkedin-app-id (get-in ctx [:config :oauth :linkedin :app-id])
                   :languages       (map name (get-in ctx [:config :core :languages]))
                   :private         (private? ctx)
                   :footer          (get-in ctx [:config :extra/theme :footer] nil)
                   :factory-url     (get-in ctx [:config :factory :url])
                   :show-terms?     (get-in ctx [:config :core :show-terms?] false)
                   :filter-options  (first (mapcat #(get-in ctx [:config % :filter-options] []) (get-plugins ctx)))
                   }]
    (str "function salavaCoreCtx() { return " (json/write-str ctx-out) "; }")))

(defn include-meta-tags [ctx tags]
  (if tags
    (let [{:keys [title description image]} tags]
      [[:meta {:property "og:title" :content title}]
       [:meta {:property "og:description" :content description}]
       [:meta {:name "description" :content description}]
       [:meta {:property "og:image" :content (str (get-site-url ctx) "/" image)}]])))

(defn favicon [ctx]
  (let [favicon-url (first (plugin-fun (get-plugins ctx) "block" "favicon"))]
    (if favicon-url
      (favicon-url ctx)
      {:icon "/img/favicon.icon"
       :png  "/img/favicon.png"})))

(defn html-attributes [ctx]
  (let [attrib (-> {:dir "ltr"}
                   (cons (map (fn [f] (f ctx)) (plugin-fun (get-plugins ctx) "layout" "html-attributes"))))]
    (apply merge attrib)))

(defn main-view
  ([ctx] (main-view ctx nil))
  ([ctx meta-tags]
   (let [favicons (favicon ctx)
         attrib (html-attributes ctx)]
    (html5 {:dir (:dir attrib)}
     [:head
      [:title (get-in ctx [:config :core :site-name])]
      [:meta {:charset "utf-8"}]
      [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]
      [:meta {:name "viewport" :content "width=device-width, initial-scale=1.0"}]
      [:meta {:property "og:sitename" :content (get-in ctx [:config :core :site-name])}]
      (seq (include-meta-tags ctx meta-tags))
      (when (:json-oembed meta-tags)
        (:json-oembed meta-tags))
      (apply include-css (css-list ctx))
      [:link {:type "text/css" :href "/css/custom.css" :rel "stylesheet" :media "screen"}]
      [:link {:type "text/css" :href "/css/print.css" :rel "stylesheet" :media "print"}]
      [:link {:type "text/css", :href "https://fonts.googleapis.com/css?family=Halant:300,400,600,700|Dosis:300,400,600,700,800|Gochi+Hand|Coming+Soon|Oswald:400,300,700|Dancing+Script:400,700|Archivo+Black|Archivo+Narrow|Open+Sans:700,300,600,800,400|Open+Sans+Condensed:300,700|Cinzel:400,700&subset=latin,latin-ext", :rel "stylesheet"}]
      [:link {:rel "shortcut icon" :href (:icon favicons)}]
      [:link {:rel "icon" :type "image/png" :href  (:png favicons)}]

      [:script {:type "text/javascript"} (context-js ctx)]]
     [:body {:class (if (and (nil? (get-in ctx [:user])) (nil? (:no-anon meta-tags))) "anon")}
      [:div#app]
      "<!--[if lt IE 10]>"
      (include-js "/assets/es5-shim/es5-shim.min.js" "/assets/es5-shim/es5-sham.min.js")
      "<![endif]-->"
      (include-js "/assets/es6-shim/es6-shim.min.js" "/assets/es6-shim/es6-sham.min.js")
      (apply include-js (js-list ctx))]))))

(defn main-response [ctx current-user flash-message meta-tags]
  (let [user (if current-user (-> (u/user-information ctx (:id current-user))
                                  (assoc :terms (:status (u/get-accepted-terms-by-id ctx (:id current-user))))
                                  (assoc  :real-id (:real-id current-user) ;;real-id is for admin login as user
                                          :last-visited (:last-visited current-user))))] ;;user's previous visit
    (-> (main-view (assoc ctx :user user :flash-message flash-message) meta-tags)
        (ok)
        (content-type "text/html; charset=\"UTF-8\""))))

(defn main [ctx path]
  (GET path []
    :no-doc true
    :summary "Main HTML layout"
    :current-user current-user
    :flash-message flash-message
    (main-response ctx current-user flash-message nil)))

(defn main-meta [ctx path plugin]
  (GET path []
    :no-doc true
    :path-params [id :- s/Any]
    :summary "Main with meta tags"
    :current-user current-user
    :flash-message flash-message
    (let [meta-tags (case plugin
                      :badge (b/meta-tags ctx id)
                      :page (p/meta-tags ctx id)
                      :user (u/meta-tags ctx id)
                      :gallery (g/meta-tags ctx id))]
      (main-response ctx current-user flash-message meta-tags))))

(defn main-meta+
 "Process plugin paths with meta-tags and no path id."
 [ctx path plugin]
 (GET path []
   :no-doc true
   :summary "Main with meta tags"
   :current-user current-user
   :flash-message flash-message
   (let [meta-tags (case plugin
                    :application (app/meta-tags ctx))]
     (main-response ctx current-user flash-message meta-tags))))

(ns salava.core.layout
  (:require [clojure.pprint :refer [pprint]]
            [compojure.api.sweet :refer :all]
            [ring.util.http-response :refer [ok content-type]]
            [schema.core :as s]
            [clojure.java.io :as io]
            [clojure.data.json :as json]
            [salava.core.helper :refer [dump plugin-str private?]]
            [salava.core.util :refer [get-site-url plugin-fun get-plugins]]
            [clojure.string :refer [join split capitalize]]
            [salava.user.db :as u]
            [salava.badge.main :as b]
            [salava.page.main :as p]
            [salava.gallery.db :as g]
            [hiccup.page :refer [html5 include-css include-js]]
            salava.core.restructure))

(def asset-css
  ["/assets/bootstrap/css/bootstrap.min.css"
   "/assets/bootstrap/css/bootstrap-theme.min.css"
   "/assets/font-awesome/css/font-awesome.min.css"
   "/assets/leaflet/leaflet.css"
   "/css/rateit/rateit.css"
   "/css/simplemde.min.css"])

(def asset-js
  ["/assets/jquery/jquery.min.js"
   "/assets/bootstrap/js/bootstrap.min.js"
   "/assets/leaflet/leaflet.js"
   "/js/ckeditor/ckeditor.js"])

(defn with-version [ctx resource-name]
  (let [version (get-in ctx [:config :core :asset-version])]
    (str resource-name "?_=" (or version (System/currentTimeMillis)))))

(defn css-list [ctx]
  (let [plugins (get-in ctx [:config :core :plugins])
        coll (mapcat #(get-in ctx [:config % :css] []) plugins)]
    (if-not (empty? coll)
      ; If any plugin defines a list of css files, use those as-is
      (map #(with-version ctx %) (concat asset-css coll))
      ; Otherwise, create the list using plugin names
      (->> plugins
           (cons :core)
           (map plugin-str)
           (map    #(str "/css/" % ".css"))
           (filter #(io/resource (str "public" %)))
           (concat asset-css)
           (map #(with-version ctx %))))))

(defn js-list [ctx]
  (map #(with-version ctx %) (conj asset-js "/js/salava.js")))

(defn context-js [ctx]
  (let [site-name (get-in ctx [:config :core :site-name])
        share     {:site-name (get-in ctx [:config :core :share :site-name] site-name)
                   :hashtag   (get-in ctx [:config :core :share :hashtag] (->> (split site-name #" ")
                                                                               (map capitalize)
                                                                               join))}
        ctx-out   {:plugins         {:all (map plugin-str (get-in ctx [:config :core :plugins]))}
                   :user            (:user ctx)
                   :flash-message   (:flash-message ctx)
                   :site-url        (get-in ctx [:config :core :site-url])
                   :site-name       site-name
                   :share           share
                   :base-path       (get-in ctx [:config :core :base-path])
                   :facebook-app-id (get-in ctx [:config :oauth :facebook :app-id])
                   :linkedin-app-id (get-in ctx [:config :oauth :linkedin :app-id])
                   :languages       (map name (get-in ctx [:config :core :languages]))
                   :private         (private? ctx)
                   :footer          (get-in ctx [:config :extra/theme :footer] nil)
                   :factory-url     (get-in ctx [:config :factory :url])
                   :show-terms?     (get-in ctx [:config :core :show-terms?] false)
                   :filter-options  (first (mapcat #(get-in ctx [:config % :filter-options] []) (get-plugins ctx)))}]
    (str "function salavaCoreCtx() { return " (json/write-str ctx-out) "; }")))

(defn include-meta-tags [ctx tags]
  (if tags
    (let [{:keys [title description image]} tags]
      [[:meta {:property "og:title" :content title}]
       [:meta {:property "og:description" :content description}]
       [:meta {:name "description" :content description}]
       [:meta {:property "og:image" :content (str (get-site-url ctx) "/" image)}]])))

(defn favicon [ctx]
  (let [favicon-url (first (plugin-fun (get-plugins ctx) "block" "favicon"))]
    (if favicon-url
      (favicon-url ctx)
      {:icon "/img/favicon.icon"
       :png  "/img/favicon.png"})))

(defn html-attributes [ctx]
  (let [attrib (-> {:dir "ltr"}
                   (cons (map (fn [f] (f ctx)) (plugin-fun (get-plugins ctx) "layout" "html-attributes"))))]
    (apply merge attrib)))

(defn main-view
  ([ctx] (main-view ctx nil))
  ([ctx meta-tags]
   (let [favicons (favicon ctx)
         attrib (html-attributes ctx)]
     (html5 {:dir (:dir attrib)}
            [:head
             [:title (get-in ctx [:config :core :site-name])]
             [:meta {:charset "utf-8"}]
             [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]
             [:meta {:name "viewport" :content "width=device-width, initial-scale=1.0"}]
             [:meta {:property "og:sitename" :content (get-in ctx [:config :core :site-name])}]
             (seq (include-meta-tags ctx meta-tags))
             (when (:json-oembed meta-tags)
               (:json-oembed meta-tags))
             (apply include-css (css-list ctx))
             [:link {:type "text/css" :href "/css/custom.css" :rel "stylesheet" :media "screen"}]
             [:link {:type "text/css" :href "/css/print.css" :rel "stylesheet" :media "print"}]
             [:link {:type "text/css", :href "https://fonts.googleapis.com/css?family=Halant:300,400,600,700|Dosis:300,400,600,700,800|Gochi+Hand|Coming+Soon|Oswald:400,300,700|Dancing+Script:400,700|Archivo+Black|Archivo+Narrow|Open+Sans:700,300,600,800,400|Open+Sans+Condensed:300,700|Cinzel:400,700&subset=latin,latin-ext", :rel "stylesheet"}]
             [:link {:rel "shortcut icon" :href (:icon favicons)}]
             [:link {:rel "icon" :type "image/png" :href  (:png favicons)}]

             [:script {:type "text/javascript"} (context-js ctx)]]
            [:body {:class (if (nil? (get-in ctx [:user])) "anon")}
             [:div#app]
             "<!--[if lt IE 10]>"
             (include-js "/assets/es5-shim/es5-shim.min.js" "/assets/es5-shim/es5-sham.min.js")
             "<![endif]-->"
             (include-js "/assets/es6-shim/es6-shim.min.js" "/assets/es6-shim/es6-sham.min.js")
             (apply include-js (js-list ctx))]))))

(defn main-response [ctx current-user flash-message meta-tags]
  (let [user (if current-user (-> (u/user-information ctx (:id current-user))
                                  (assoc :terms (:status (u/get-accepted-terms-by-id ctx (:id current-user))))
                                  (assoc  :real-id (:real-id current-user) ;;real-id is for admin login as user
                                          :last-visited (:last-visited current-user))))] ;;user's previous visit
    (-> (main-view (assoc ctx :user user :flash-message flash-message) meta-tags)
        (ok)
        (content-type "text/html; charset=\"UTF-8\""))))

(defn main [ctx path]
  (GET path []
       :no-doc true
       :summary "Main HTML layout"
       :current-user current-user
       :flash-message flash-message
       (main-response ctx current-user flash-message nil)))

(defn main-meta [ctx path plugin]
  (GET path []
       :no-doc true
       :path-params [id :- s/Any]
       :summary "Main with meta tags"
       :current-user current-user
       :flash-message flash-message
       (let [meta-tags (case plugin
                         :badge (b/meta-tags ctx id)
                         :page (p/meta-tags ctx id)
                         :user (u/meta-tags ctx id)
                         :gallery (g/meta-tags ctx id))]
         (main-response ctx current-user flash-message meta-tags))))

revert changes to layout, format code

revert changes to layout, format code


(ns transom.document
  (:require [transom.core :as transom]
            [transom.utils :refer [dissocv]])
  #+clj
  (:import (clojure.lang IPersistentVector)))

(defprotocol IDocument
  (patch [this edit version])
  (update [this path new-value]))

(defprotocol IHistory
  (version [this])
  (collect [this version])
  (add [this edit]))

(defrecord Document [state history]
  IHistory
  (version [_] (version history))
  (collect [_ version] (collect history version))
  (add [_ edit] (add history edit))
  IDocument
  (patch [this edit version]
    (let [edits (collect history version)
          edit (reduce
                 (fn [yours mine] (second (transom/transform state mine yours)))
                 edit
                 edits)]
      (Document. (transom/patch state edit) (add history edit))))
  (update [this path new-value]
    (let [old-value (if (empty? path) state (get-in state path))
          new-state (if (empty? path) new-value (assoc-in state path new-value))
          edit (transom/diff old-value new-value)]
      (Document. new-state (add history {path edit})))))

(extend-type #+clj IPersistentVector #+cljs PersistentVector
  IHistory
  (version [this] (count this))
  (collect [this version] (subvec this version))
  (add [this edit] (conj this edit)))

(defn document
  []
  (atom (Document. {} [])))

(defn update!
  [doc path new-value]
  (swap! doc update path new-value))

(defn transact!
  [doc path f & args]
  (swap! doc (fn [doc] (update doc path (apply f (get-in (:state doc) path) args)))))

;; TODO(brian): Do I need to sort paths before deleting? Ugh my brain.
(defn delete!
  ([doc path]
   (assert (vector? path) "Paths are always vectors!")
   (swap! doc
     (fn [doc]
       (let [state (:state doc)
             target-ref (peek path)
             target-path (pop path)
             target (get-in state target-path)
             target' (cond (vector? target) (dissocv target target-ref)
                           (map? target) (dissoc target target-ref))]
         (update doc target-path target')))))
  ([doc path & paths]
    ;; TODO(brian): batch edits together so they don't muck up history?
    (reduce delete! doc (delete! doc path) paths)))

(defn patch!
  [doc edit version]
  (swap! doc patch edit version))

(comment
  (def pizza (document))
  (get @pizza :state)
  (get @pizza :history)
  (deref pizza)
  (update! pizza [] {:foo "bar" :diff "please" :bar "baz"})
  (update! pizza [:foo] "barbies")
  (transact! pizza [:foo] (fn [foo] (str "what is the deal " foo " are the best")))
  (transact! pizza [] (fn [old] (assoc old :vec ["a"])))
  (transact! pizza [:vec] (fn [v] (vec (remove #(= % "a") v))))
  (transact! pizza [:vec] (fn [v] (into v ["foo" "bar" ",,"])))
  (apply transom/compose nil (:history @pizza))
  )

add comment for example document usage

add comment for example document usage


(ns cornwalltechjam.layout
  (:require [hiccup.page :refer [html5]]
            [optimus.link :as link]))

(def navigation-items
  [{:title "Home", :path "/index.html"}
   {:title "Photos from April", :path "/photos/20160409.html"}
   {:title "Photos from March", :path "/photos/20160312.html"}
   {:title "Finding us", :path "/locations/cornwall-college.html"}
;;   {:title "Finding us", :path "/locations/bodmin-library.html"}
;;   {:title "Finding us", :path "/locations/penwith-college.html"}
;;   {:title "Finding us", :path "/locations/headforwards.html"}
   {:title "Newsletter", :path "/newsletter.html"}
   {:title "Future Jams", :path "/futurejams.html"}
   ;; {:title "Contact us", :path ".html"}
   ])

(defn- nav-props [item path]
  (let [props {}]
    (if (= path (:path item))
      (assoc props :class "active")
      props)))

(defn- navigation [path]
  (map
   (fn [item]
     [:li (nav-props item path)
      [:a {:href (:path item)} (:title item )]
      ])
   navigation-items))

(defn- extra-javascript [javascript]
  (if (= javascript "carousels")
    [:script {:src "/assets/js/carousels.js"}]))

(defn layout-page-simple [request page]
  (html5
   [:head
    [:meta {:charset "utf-8"}]
    [:meta {:name "viewport"
            :content "width=device-width, initial-scale=1.0"}]
    [:title "Cornwall Tech Jam"]
    [:link {:rel "stylesheet" :href (link/file-path request "/css/style.css")}]]
   [:body
    [:div.logo "cornwalltechjam.uk"]
    [:div.body page]]))

(defn
  layout-page-main [request {:keys [title description javascript path content]}]
  (html5
   [:head

    [:meta {:charset "UTF-8"}]
    [:meta {:name "viewport", :content "width=device-width, initial-scale=1"}]
    [:meta {:name "viewport", :content "width=device-width, initial-scale=1.0, minimum-scale=1.0, maximum-scale=1.0, user-scalable=no"}]
    [:title {} title]
    [:link {:rel "shortcut icon", :href "/assets/img/favicon.png"}]
    [:meta {:name "description", :content description}]
    [:link {:href "http://fonts.googleapis.com/css?family=Lato:100,300,400|Open+Sans:400italic,400,600|Muli:300|Indie+Flower:400|Oswald:400,700,300" :rel "stylesheet"}]
    [:link {:href "/assets/css/bootstrap.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/bootstrap-switch.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/font-awesome.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/animate.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/slidebars.min.css", :rel "stylesheet"}]
    ;; [:link {:href "/assets/css/lightbox.css", :rel "stylesheet"}]
    ;; [:link {:href "/assets/css/jquery.bxslider.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/buttons.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/syntaxhighlighter/shCore.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/style-blue.css", :rel "stylesheet", :title "default"}]
    [:link {:href "/assets/css/width-full.css", :rel "stylesheet", :title "default"}]
    [:link {:href "/assets/css/techjam.css", :rel "stylesheet"}]
    [:meta {:name "twitter:card", :content "summary"}]
    [:meta {:name "twitter:site", :content "@cornwalltechjam"}]
    [:meta {:name "twitter:title", :content title}]
    [:meta {:name "twitter:description", :content description}]
    [:meta {:name "twitter:image", :content "https://avatars1.githubusercontent.com/u/18351576"}]
    "<!-- HTML5 shim and Respond.js IE8 support of HTML5 elements and media queries -->" "\n    " "<!--
[if lt IE 9]>\n        <script src=\"/assets/js/html5shiv.min.js\"></script>\n        <script src=\"/assets/js/respond.min.js\"></script>\n    <!
[endif]-->" "\n"]

   [:body {}
    [:div {:id "sb-site"}
     [:div {:class "boxed"}
      [:header {:id "header-full-top", :class "hidden-xs header-full"}
       [:div {:class "container"}
        [:div {:class "header-full-title"}
         [:h1 {:class "animated fadeInRight"}
          [:a {:href "/index.html"} "Cornwall "
           [:span {} "Tech Jam"]]]
         [:p {:class "animated fadeInRight"} "Raspberry Pi's, Pasties and Programming"]]
        [:nav {:class "top-nav"}
         [:ul {:class "top-nav-social hidden-sm"}
          [:li {}
           [:a {:href "https://twitter.com/cornwalltechjam", :class "animated fadeIn animation-delay-7 twitter"}
            [:i {:class "fa fa-twitter"}]]]
          [:li {}
           [:a {:href "https://www.facebook.com/cornwalltechjam", :class "animated fadeIn animation-delay-8 facebook"}
            [:i {:class "fa fa-facebook"}]]]
          [:li {}
           [:a {:href "https://www.meetup.com/Cornwall-Digital/events/245647278/", :class "animated fadeIn animation-delay-9 meetup"}
            [:img {:src "/assets/img/meetup-logo.svg"}]]]]
         [:div {:class "dropdown animated fadeInDown animation-delay-11"}
          [:a {:href "/index.html", :class "dropdown-toggle", :data-toggle "dropdown"}
           [:i {:class "fa fa-bullhorn"}] " Next Tech Jam: 31st May"]]]]]

      [:nav {:class "navbar navbar-default navbar-header-full navbar-dark yamm navbar-static-top", :role "navigation", :id "header"}
       [:div {:class "container"}
        "<!-- Brand and toggle get grouped for better mobile display -->"
        [:div {:class "navbar-header"}
         [:button {:type "button", :class "navbar-toggle", :data-toggle "collapse", :data-target "#bs-example-navbar-collapse-1"}
          [:span {:class "sr-only"} "Toggle navigation"]
          [:i {:class "fa fa-bars"}]]
         [:a {:id "ar-brand", :class "navbar-brand hidden-lg hidden-md hidden-sm", :href "/index.html"} "Cornwall "
          [:span {} "Tech Jam"]]]

        [:div {:class "collapse navbar-collapse", :id "bs-example-navbar-collapse-1"}
         [:ul {:class "nav navbar-nav"}

          (navigation path)]]]]

      content

      [:aside {:id "footer-widgets"}
       [:div {:class "container"}
        [:div {:class "row"}

         [:div {:class "col-md-4"}
          [:div {:class "footer-widget"}
           [:h3 {:class "footer-widget-title"} "Through the keyhole"]
           [:div {:class "row"}
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "The infamous Mission to Mars rover", :class "img-responsive", :src "/assets/img/footer/tj_mission_to_mars_rover.jpg"}]]]
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "Close up of an ESP8266 module connect to a breadboard", :class "img-responsive", :src "/assets/img/footer/eot_esp_8266_close_up.jpg"}]]]
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "Mike Trebilcock interfacing with the Cornish programmer's fuel of choice (a pasty)", :class "img-responsive", :src "/assets/img/footer/tj_mike_pasty.jpg"}]]]
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "Hard at work soldering at the Eden of Things project", :class "img-responsive", :src "/assets/img/footer/eot_soldering.jpg"}]]]]]]

         [:div {:class "col-md-4"}
          [:div {:class "footer-widget footer-swcornwall"}
           [:a {:href "http://www.softwarecornwall.org" :title "Proud to be part of Software Cornwall"}
            [:img {:src "/assets/img/software_cornwall_logo_square.png" :alt "Software Cornwall logo"}]]]]

         [:div {:class "col-md-4"}
          [:div {:class "footer-widget footer-about"}
           [:h3 {:class "footer-widget-title"} "A little bit about the Tech Jam"]
           [:p "Cornwall's Tech Jams are run by volunteers working in IT and education throughout Cornwall, in association with Software Cornwall and local businesses."]
           [:p "Except where otherwise noted, content on this site is licensed under a " [:a {:href "http://creativecommons.org/licenses/by/4.0/"} "Creative Commons Attribution 4.0 International license"] "."]
           [:p  "Powered by " [:a {:href "https://clojure.org/"} "Clojure"] " and " [:a {:href "https://github.com/magnars/stasis"} "Stasis"] ", created with " [:a {:href "https://www.gnu.org/software/emacs/"} "Emacs"] ", source code on " [:a {:href "https://github.com/CornwallTechJam"} "GitHub"] "."]

        ]]
]
        " " "<!-- row -->" ]
       " " "<!-- container -->" ]

      [:footer {:id "footer"}
       [:p "We're hosted on"]
       [:a {:href "https://github.com/CornwallTechJam"} [:img {:src "/assets/img/github_pages.svg"}]]]]

     [:div {:id "back-top"}  [:a {:href "#header"} [:i {:class "fa fa-chevron-up"}]]]

     ;; "\n\n" "<!-- Scripts -->"  "<!-- Compiled in vendors.js -->"  "<!--\n<script src=\"/assets/js/jquery.min.js\"></script>\n<script src=\"/assets/js/jquery.cookie.js\"></script>\n<script src=\"/assets/js/imagesloaded.pkgd.min.js\"></script>\n<script src=\"/assets/js/bootstrap.min.js\"></script>\n<script src=\"/assets/js/bootstrap-switch.min.js\"></script>\n<script src=\"/assets/js/wow.min.js\"></script>\n<script src=\"/assets/js/slidebars.min.js\"></script>\n<script src=\"/assets/js/jquery.bxslider.min.js\"></script>\n<script src=\"/assets/js/holder.js\"></script>\n<script src=\"/assets/js/buttons.js\"></script>\n<script src=\"/assets/js/jquery.mixitup.min.js\"></script>\n<script src=\"/assets/js/circles.min.js\"></script>\n<script src=\"/assets/js/masonry.pkgd.min.js\"></script>\n<script src=\"/assets/js/jquery.matchHeight-min.js\"></script>\n-->" "\n\n"

     [:script {:src "/assets/js/vendors.js"}]

     ;; "\n\n" "<!--<script type=\"text/javascript\" src=\"/assets/js/jquery.themepunch.tools.min.js?rev=5.0\"></script>\n<script type=\"text/javascript\" src=\"/assets/js/jquery.themepunch.revolution.min.js?rev=5.0\"></script>-->" "\n\n\n" "<!-- Syntaxhighlighter -->"

     [:script {:src "/assets/js/syntaxhighlighter/shCore.js"}]
     [:script {:src "/assets/js/syntaxhighlighter/shBrushXml.js"}]
     [:script {:src "/assets/js/syntaxhighlighter/shBrushJScript.js"}]
     "\n\n" [:script {:src "/assets/js/DropdownHover.js"}]
     [:script {:src "/assets/js/app.js"}]
     [:script {:src "/assets/js/holder.js"}]

     (extra-javascript javascript)]]))

(ns cornwalltechjam.layout
  (:require [hiccup.page :refer [html5]]
            [optimus.link :as link]))

(def navigation-items
  [{:title "Home", :path "/index.html"}
   {:title "Photos from April", :path "/photos/20160409.html"}
   {:title "Photos from March", :path "/photos/20160312.html"}
   {:title "Finding us", :path "/locations/cornwall-college.html"}
;;   {:title "Finding us", :path "/locations/bodmin-library.html"}
;;   {:title "Finding us", :path "/locations/penwith-college.html"}
;;   {:title "Finding us", :path "/locations/headforwards.html"}
   {:title "Newsletter", :path "/newsletter.html"}
   {:title "Future Jams", :path "/futurejams.html"}
   ;; {:title "Contact us", :path ".html"}
   ])

(defn- nav-props [item path]
  (let [props {}]
    (if (= path (:path item))
      (assoc props :class "active")
      props)))

(defn- navigation [path]
  (map
   (fn [item]
     [:li (nav-props item path)
      [:a {:href (:path item)} (:title item )]
      ])
   navigation-items))

(defn- extra-javascript [javascript]
  (if (= javascript "carousels")
    [:script {:src "/assets/js/carousels.js"}]))

(defn layout-page-simple [request page]
  (html5
   [:head
    [:meta {:charset "utf-8"}]
    [:meta {:name "viewport"
            :content "width=device-width, initial-scale=1.0"}]
    [:title "Cornwall Tech Jam"]
    [:link {:rel "stylesheet" :href (link/file-path request "/css/style.css")}]]
   [:body
    [:div.logo "cornwalltechjam.uk"]
    [:div.body page]]))

(defn
  layout-page-main [request {:keys [title description javascript path content]}]
  (html5
   [:head

    [:meta {:charset "UTF-8"}]
    [:meta {:name "viewport", :content "width=device-width, initial-scale=1"}]
    [:meta {:name "viewport", :content "width=device-width, initial-scale=1.0, minimum-scale=1.0, maximum-scale=1.0, user-scalable=no"}]
    [:title {} title]
    [:link {:rel "shortcut icon", :href "/assets/img/favicon.png"}]
    [:meta {:name "description", :content description}]
    [:link {:href "https://fonts.googleapis.com/css?family=Lato:100,300,400|Open+Sans:400italic,400,600|Muli:300|Indie+Flower:400|Oswald:400,700,300" :rel "stylesheet"}]
    [:link {:href "/assets/css/bootstrap.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/bootstrap-switch.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/font-awesome.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/animate.min.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/slidebars.min.css", :rel "stylesheet"}]
    ;; [:link {:href "/assets/css/lightbox.css", :rel "stylesheet"}]
    ;; [:link {:href "/assets/css/jquery.bxslider.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/buttons.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/syntaxhighlighter/shCore.css", :rel "stylesheet"}]
    [:link {:href "/assets/css/style-blue.css", :rel "stylesheet", :title "default"}]
    [:link {:href "/assets/css/width-full.css", :rel "stylesheet", :title "default"}]
    [:link {:href "/assets/css/techjam.css", :rel "stylesheet"}]
    [:meta {:name "twitter:card", :content "summary"}]
    [:meta {:name "twitter:site", :content "@cornwalltechjam"}]
    [:meta {:name "twitter:title", :content title}]
    [:meta {:name "twitter:description", :content description}]
    [:meta {:name "twitter:image", :content "https://avatars1.githubusercontent.com/u/18351576"}]
    "<!-- HTML5 shim and Respond.js IE8 support of HTML5 elements and media queries -->" "\n    " "<!--
[if lt IE 9]>\n        <script src=\"/assets/js/html5shiv.min.js\"></script>\n        <script src=\"/assets/js/respond.min.js\"></script>\n    <!
[endif]-->" "\n"]

   [:body {}
    [:div {:id "sb-site"}
     [:div {:class "boxed"}
      [:header {:id "header-full-top", :class "hidden-xs header-full"}
       [:div {:class "container"}
        [:div {:class "header-full-title"}
         [:h1 {:class "animated fadeInRight"}
          [:a {:href "/index.html"} "Cornwall "
           [:span {} "Tech Jam"]]]
         [:p {:class "animated fadeInRight"} "Raspberry Pi's, Pasties and Programming"]]
        [:nav {:class "top-nav"}
         [:ul {:class "top-nav-social hidden-sm"}
          [:li {}
           [:a {:href "https://twitter.com/cornwalltechjam", :class "animated fadeIn animation-delay-7 twitter"}
            [:i {:class "fa fa-twitter"}]]]
          [:li {}
           [:a {:href "https://www.facebook.com/cornwalltechjam", :class "animated fadeIn animation-delay-8 facebook"}
            [:i {:class "fa fa-facebook"}]]]
          [:li {}
           [:a {:href "https://www.meetup.com/Cornwall-Digital/events/245647278/", :class "animated fadeIn animation-delay-9 meetup"}
            [:img {:src "/assets/img/meetup-logo.svg"}]]]]
         [:div {:class "dropdown animated fadeInDown animation-delay-11"}
          [:a {:href "/index.html", :class "dropdown-toggle", :data-toggle "dropdown"}
           [:i {:class "fa fa-bullhorn"}] " Next Tech Jam: 31st May"]]]]]

      [:nav {:class "navbar navbar-default navbar-header-full navbar-dark yamm navbar-static-top", :role "navigation", :id "header"}
       [:div {:class "container"}
        "<!-- Brand and toggle get grouped for better mobile display -->"
        [:div {:class "navbar-header"}
         [:button {:type "button", :class "navbar-toggle", :data-toggle "collapse", :data-target "#bs-example-navbar-collapse-1"}
          [:span {:class "sr-only"} "Toggle navigation"]
          [:i {:class "fa fa-bars"}]]
         [:a {:id "ar-brand", :class "navbar-brand hidden-lg hidden-md hidden-sm", :href "/index.html"} "Cornwall "
          [:span {} "Tech Jam"]]]

        [:div {:class "collapse navbar-collapse", :id "bs-example-navbar-collapse-1"}
         [:ul {:class "nav navbar-nav"}

          (navigation path)]]]]

      content

      [:aside {:id "footer-widgets"}
       [:div {:class "container"}
        [:div {:class "row"}

         [:div {:class "col-md-4"}
          [:div {:class "footer-widget"}
           [:h3 {:class "footer-widget-title"} "Through the keyhole"]
           [:div {:class "row"}
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "The infamous Mission to Mars rover", :class "img-responsive", :src "/assets/img/footer/tj_mission_to_mars_rover.jpg"}]]]
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "Close up of an ESP8266 module connect to a breadboard", :class "img-responsive", :src "/assets/img/footer/eot_esp_8266_close_up.jpg"}]]]
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "Mike Trebilcock interfacing with the Cornish programmer's fuel of choice (a pasty)", :class "img-responsive", :src "/assets/img/footer/tj_mike_pasty.jpg"}]]]
            [:div {:class "col-lg-6 col-md-6 col-sm-3 col-xs-6"}
             [:div.thumbnail [:img {:alt "Hard at work soldering at the Eden of Things project", :class "img-responsive", :src "/assets/img/footer/eot_soldering.jpg"}]]]]]]

         [:div {:class "col-md-4"}
          [:div {:class "footer-widget footer-swcornwall"}
           [:a {:href "http://www.softwarecornwall.org" :title "Proud to be part of Software Cornwall"}
            [:img {:src "/assets/img/software_cornwall_logo_square.png" :alt "Software Cornwall logo"}]]]]

         [:div {:class "col-md-4"}
          [:div {:class "footer-widget footer-about"}
           [:h3 {:class "footer-widget-title"} "A little bit about the Tech Jam"]
           [:p "Cornwall's Tech Jams are run by volunteers working in IT and education throughout Cornwall, in association with Software Cornwall and local businesses."]
           [:p "Except where otherwise noted, content on this site is licensed under a " [:a {:href "http://creativecommons.org/licenses/by/4.0/"} "Creative Commons Attribution 4.0 International license"] "."]
           [:p  "Powered by " [:a {:href "https://clojure.org/"} "Clojure"] " and " [:a {:href "https://github.com/magnars/stasis"} "Stasis"] ", created with " [:a {:href "https://www.gnu.org/software/emacs/"} "Emacs"] ", source code on " [:a {:href "https://github.com/CornwallTechJam"} "GitHub"] "."]

        ]]
]
        " " "<!-- row -->" ]
       " " "<!-- container -->" ]

      [:footer {:id "footer"}
       [:p "We're hosted on"]
       [:a {:href "https://github.com/CornwallTechJam"} [:img {:src "/assets/img/github_pages.svg"}]]]]

     [:div {:id "back-top"}  [:a {:href "#header"} [:i {:class "fa fa-chevron-up"}]]]

     ;; "\n\n" "<!-- Scripts -->"  "<!-- Compiled in vendors.js -->"  "<!--\n<script src=\"/assets/js/jquery.min.js\"></script>\n<script src=\"/assets/js/jquery.cookie.js\"></script>\n<script src=\"/assets/js/imagesloaded.pkgd.min.js\"></script>\n<script src=\"/assets/js/bootstrap.min.js\"></script>\n<script src=\"/assets/js/bootstrap-switch.min.js\"></script>\n<script src=\"/assets/js/wow.min.js\"></script>\n<script src=\"/assets/js/slidebars.min.js\"></script>\n<script src=\"/assets/js/jquery.bxslider.min.js\"></script>\n<script src=\"/assets/js/holder.js\"></script>\n<script src=\"/assets/js/buttons.js\"></script>\n<script src=\"/assets/js/jquery.mixitup.min.js\"></script>\n<script src=\"/assets/js/circles.min.js\"></script>\n<script src=\"/assets/js/masonry.pkgd.min.js\"></script>\n<script src=\"/assets/js/jquery.matchHeight-min.js\"></script>\n-->" "\n\n"

     [:script {:src "/assets/js/vendors.js"}]

     ;; "\n\n" "<!--<script type=\"text/javascript\" src=\"/assets/js/jquery.themepunch.tools.min.js?rev=5.0\"></script>\n<script type=\"text/javascript\" src=\"/assets/js/jquery.themepunch.revolution.min.js?rev=5.0\"></script>-->" "\n\n\n" "<!-- Syntaxhighlighter -->"

     [:script {:src "/assets/js/syntaxhighlighter/shCore.js"}]
     [:script {:src "/assets/js/syntaxhighlighter/shBrushXml.js"}]
     [:script {:src "/assets/js/syntaxhighlighter/shBrushJScript.js"}]
     "\n\n" [:script {:src "/assets/js/DropdownHover.js"}]
     [:script {:src "/assets/js/app.js"}]
     [:script {:src "/assets/js/holder.js"}]

     (extra-javascript javascript)]]))

Change http link to use https for fonts

Change http link to use https for fonts


(ns ctia.stores.es.mapping)

;; This provides a reasonable default mapping for all of our entities.
;; It aschews nested objects since they are performance risks, and
;; restricts the _all to a minimal set.

;; not that fields with the same name, nee to have the same mapping,
;; even in different entities.  That means

(def ts {:type "date" :format "date_time"})

(def string {:type "string" :index "not_analyzed"})
(def all_string {:type "string"
                 :index "not_analyzed"
                 :include_in_all true})

(def text {:type "string"})
(def all_text {:type "string" :copy_to "_all"})

(def related
  {:confidence string
   :source string
   :relationship string})

(def valid-time
  {:properties
   {:start_time ts
    :end_time ts}})

(def attack-pattern
  {:properties
   {:description all_text
    :capec_id string}})

(def malware-instance
  {:properties
   {:description all_text
    :type string
    :malware_type string}})

(def observable
  {:type "object"
   :properties
   {:type string
    :value all_string}})

(def nested-observable
  {:type "nested"
   :include_in_all true
   :properties
   {:type string
    :value all_string}})

(def behavior
  {:properties
   {:attack_patterns attack-pattern
    :malware_type malware-instance}})

(def tool
  {:properties
   {:description all_text
    :type string
    :references string
    :vendor string
    :version string
    :schema_version string
    :service_pack string}})

(def infrastructure
  {:properties
   {:description all_text
    :type string}})

(def related-identities
  {:properties (assoc related
                      :identity all_string
                      :information_source string)})

(def related-actors
  {:properties (assoc related
                      :actor_id all_string)})

(def tg-identity
  {:properties
   {:description all_text
    :related_identities related-identities}})

(def victim-targeting
  {:properties
   {:identity tg-identity
    :targeted_systems string
    :targeted_information string
    :targeted_observables observable}})

(def resource
  {:properties
   {:tools tool
    :infrastructure infrastructure
    :providers tg-identity}})

(def activity
  {:properties
   {:date_time ts
    :description all_text}})

(def related-indicators
  {:properties
   (assoc related
          :indicator_id all_string)})

(def related-judgements
  {:properties
   (assoc related
          :judgement_id all_string)})

(def related-coas
  {:properties
   (assoc related
          :COA_id all_string)})

(def related-campaigns
  {:properties
   (assoc related
          :campaign_id all_string)})

(def related-exploit-targets
  {:properties (assoc related
                      :exploit_target_id all_string)})
(def related-ttps
  {:properties (assoc related
                      :ttp_id all_string)})

(def related-incidents
  {:properties (assoc related
                      :incident_id all_string)})

(def related-sightings
  {:properties (assoc related
                      :sighting_id all_string)})

(def specifications
  {:properties
   {:type string
    :judgements string
    :required_judgements related-judgements
    :query string
    :variables string
    :snort_sig string
    :SIOC string
    :open_IOC string}})

(def incident-time
  {:properties
   {:first_malicious_action ts
    :initial_compromise ts
    :first_data_exfiltration ts
    :incident_discovery ts
    :incident_opened ts
    :containment_achieved ts
    :restoration_achieved ts
    :incident_reported ts
    :incident_closed ts}})

(def non-public-data-compromised
  {:properties
   {:security_compromise string
    :data_encrypted {:type "boolean"}}})

(def property-affected
  {:properties
   {:property string
    :description_of_effect text
    :type_of_availability_loss string
    :duration_of_availability_loss string
    :non_public_data_compromised non-public-data-compromised}})

(def affected-asset
  {:properties
   {:type string
    :description all_text
    :ownership_class string
    :management_class string
    :location_class string
    :property_affected property-affected
    :identifying_observables observable}})

(def direct-impact-summary
  {:properties
   {:asset_losses string
    :business_mission_distruption string
    :response_and_recovery_costs string}})

(def indirect-impact-summary
  {:properties
   {:loss_of_competitive_advantage string
    :brand_and_market_damage string
    :increased_operating_costs string
    :local_and_regulatory_costs string}})

(def loss-estimation
  {:properties
   {:amount {:type "long"}
    :iso_currency_code string}})

(def total-loss-estimation
  {:properties
   {:initial_reported_total_loss_estimation loss-estimation
    :actual_total_loss_estimation loss-estimation
    :impact_qualification string
    :effects string}})

(def impact-assessment
  {:properties
   {:direct_impact_summary direct-impact-summary
    :indirect_impact_summary indirect-impact-summary
    :total_loss_estimation total-loss-estimation
    :impact_qualification string
    :effects string}})

(def contributor
  {:properties
   {:role string
    :name string
    :email string
    :phone string
    :organization string
    :date ts
    :contribution_location string}})

(def coa-requested
  {:properties
   {:time ts
    :contributors contributor
    :COA all_string}})

(def history
  {:properties
   {:action_entry coa-requested
    :journal_entry string}})

(def vulnerability
  {:properties
   {:title all_string
    :description all_text
    :is_known {:type "boolean"}
    :is_public_acknowledged {:type "boolean"}
    :short_description all_text
    :cve_id string
    :osvdb_id string
    :source string
    :discovered_datetime ts
    :published_datetime ts
    :affected_software string
    :references string}})

(def weakness
  {:properties
   {:description all_text
    :cwe_id string}})

(def configuration
  {:properties
   {:description all_text
    :short_description all_text
    :cce_id string}})

(def sighting
  {:properties
   {:timestamp ts
    :source string
    :reference string
    :confidence string
    :description all_text
    :related_judgements related-judgements}})

(def judgement-mapping
  {"judgement"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id string
     :external_ids string
     :type string
     :tlp string
     :uri string
     :source_uri string
     :revision {:type "long"}
     :timestamp ts
     :schema_version string
     :language string
     :observable observable
     :disposition {:type "long"}
     :disposition_name string
     :source string
     :priority {:type "long"}
     :confidence string
     :severity {:type "long"}
     :valid_time valid-time
     :reason all_text
     :reason_uri string
     :indicators related-indicators
     :owner string
     :created ts
     :modified ts}}})

(def verdict-mapping
  {"verdict"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id string
     :type string
     :schema_version string
     :judgement_id string
     :observable observable
     :disposition {:type "long"}
     :disposition_name string
     :owner string
     :created ts}}})

(def feedback-mapping
  {"feedback"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id string
     :external_ids string
     :uri string
     :source_uri string
     :language string
     :timestamp ts
     :type string
     :tlp string
     :revision {:type "long"}
     :schema_version string
     :entity_id string
     :source string
     :feedback {:type "integer"}
     :reason all_text
     :owner string
     :created ts
     :modified ts}}})

(def indicator-mapping
  {"indicator"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id string
     :external_ids string
     :type string
     :timestamp ts
     :tlp string
     :source_uri string
     :schema_version string
     :revision {:type "long"}
     :short_description all_text
     :valid_time valid-time
     :uri string
     :title all_string
     :description all_text
     :alternate_ids all_string
     :negate {:type "boolean"}
     :indicator_type string
     :language string
     :tags string
     :observable observable
     :judgements related-judgements
     :composite_indicator_expression {:type "nested"
                                      :properties
                                      {:operator string
                                       :indicator_ids string}}
     :indicated_TTP related-ttps
     :likely_impact string
     :suggested_COAs related-coas
     :confidence string
     :sightings related-sightings
     :related_indicators related-indicators
     :related_campaigns related-campaigns
     :related_COAs related-coas
     :kill_chain_phases string
     :test_mechanisms string
     :producer string
     :specifications specifications
     :owner string
     :created ts
     :modified ts
     :source string}}})

(def ttp-mapping
  {"ttp"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id all_string
     :external_ids string
     :title all_string
     :uri string
     :source_uri string
     :language string
     :revision {:type "long"}
     :timestamp ts
     :description all_text
     :short_description all_text
     :type string
     :tlp string
     :schema_version string
     :ttp string
     :valid_time valid-time
     :intended_effect string
     :behavior behavior
     :resources resource
     :victim_targeting victim-targeting
     :exploit_targets related-exploit-targets
     :related_TTPs related-ttps
     :source string
     :ttp_type string
     :expires ts
     :indicators related-indicators
     :owner string
     :created ts
     :modified ts}}})

(def actor-mapping
  {"actor"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id all_string
     :external_ids string
     :title all_string
     :tlp string
     :schema_version string
     :uri string
     :source_uri string
     :revision {:type "long"}
     :timestamp ts
     :language string
     :description all_text
     :short_description all_text
     :type string
     :valid_time valid-time
     :actor_type string
     :source string
     :identity tg-identity
     :motivation string
     :sophistication string
     :intended_effect string
     :planning_and_operational_support string
     :observed_TTPs related-ttps
     :associated_campaigns related-campaigns
     :associated_actors related-actors
     :confidence string
     :owner string
     :created ts
     :modified ts}}})

(def campaign-mapping
  {"campaign"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id all_string
     :external_ids string
     :uri string
     :source_uri string
     :language string
     :timestamp ts
     :type string
     :tlp string
     :revision {:type "long"}
     :schema_version string
     :title all_string
     :description all_text
     :short_description all_text
     :valid_time valid-time
     :names all_string
     :intended_effect string
     :status string
     :related_TTPs related-ttps
     :related_incidents related-incidents
     :attribution related-actors
     :associated_campaigns related-campaigns
     :confidence string
     :activity activity
     :source string
     :campaign_type string
     :indicators related-indicators
     :owner string
     :created ts
     :modified ts}}})

(def coa-mapping
  {"coa"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id all_string
     :external_ids string
     :uri string
     :source_uri string
     :language string
     :timestamp ts
     :type string
     :tlp string
     :schema_version string
     :revision {:type "long"}
     :title all_string
     :description all_text
     :short_description all_text
     :valid_time valid-time
     :stage string
     :coa_type string
     :objective string
     :impact string
     :cost string
     :efficacy string
     :source string
     :related_COAs related-coas
     :owner string
     :created ts
     :modified ts}}})

(def incident-mapping
  {"incident"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id all_string
     :external_ids string
     :type string
     :tlp string
     :revision {:type "long"}
     :uri string
     :source_uri string
     :timestamp ts
     :schema_version string
     :language string
     :title all_string
     :description all_text
     :short_description all_text
     :valid_time valid-time
     :confidence string
     :status string
     :incident_time incident-time
     :categories string
     :reporter string
     :responder string
     :coordinator string
     :victim string
     :affected_assets affected-asset
     :impact_assessment impact-assessment
     :source string
     :security_compromise string
     :discovery_method string
     :COA_requested coa-requested
     :COA_taken coa-requested
     :contact string
     :history history
     :related_indicators related-indicators
     :related_observables observable
     :leveraged_TTPs related-ttps
     :attributed_actors related-actors
     :related_incidents related-incidents
     :intended_effect string
     :owner string
     :created ts
     :modified ts}}})

(def exploit-target-mapping
  {"exploit-target"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id all_string
     :external_ids string
     :type string
     :tlp string
     :uri string
     :source_uri string
     :language string
     :timestamp ts
     :revision {:type "long"}
     :schema_version string
     :title all_string
     :description all_text
     :short_description all_text
     :valid_time valid-time
     :vulnerability vulnerability
     :weakness weakness
     :configuration configuration
     :potential_COAs related-coas
     :source string
     :related_exploit_targets related-exploit-targets
     :owner string
     :created ts
     :modified ts}}})

(def identity-mapping
  {"identity"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:id string
     :role string
     :capabilities string
     :login string}}})

(def observed-relation
  {:dynamic "strict"
   :properties
   {:id string
    :timestamp ts
    :origin string
    :origin_uri string
    :relation string
    :relation_info {:type "object"
                    :include_in_all false
                    :dynamic true}
    :source observable
    :related observable}})

(def sighting-mapping
  {"sighting"
   {:dynamic "strict"
    :include_in_all false
    :properties
    {:type string
     :id string
     :external_ids string
     :timestamp ts
     :title string
     :uri string
     :revision {:type "long"}
     :language string
     :description all_text
     :short_description all_text
     :tlp string
     :observed_time valid-time
     :count {:type "long"}
     :schema_version string
     :source string
     :source_uri string
     :sensor string
     :reference string
     :confidence string
     :observables observable
     :observables_hash string
     :indicators related-indicators
     :incidents related-incidents
     :relations observed-relation
     :owner string
     :created ts
     :modified ts}}})

(def store-mappings
  (merge {}
         judgement-mapping
         verdict-mapping
         indicator-mapping
         ttp-mapping
         feedback-mapping
         actor-mapping
         campaign-mapping
         coa-mapping
         incident-mapping
         exploit-target-mapping
         sighting-mapping
         identity-mapping))

(keys  incident-mapping)

clean leftover debug line

clean leftover debug line


(ns app-macros.props)

(defn pad-by
  "Add pad in between any two consecutive values in coll for which
   pred returns the same result. As an example, assume the following
   use:

       (pad-by type :same-type [:foo :bar [1 2] {3 4} {5 6}])

   The result would be

       [:foo :same-type :bar [1 2] {3 4} :same-type {5 6}].

   If called without coll, returns a transducer."
  ([pred pad]
   (fn [rf]
     (let [pv (volatile! nil)]
       (fn
         ([] (rf))
         ([result] (rf result))
         ([result input]
          (let [prior @pv]
            (vreset! pv input)
            (if (pred prior input)
              (rf (rf result pad) input)
              (rf result input))))))))
  ([pred pad coll] (sequence (pad-by pred pad) coll)))

(defn value?
  "Returns true if x is considered a basic EDN value."
  [x]
  (or (number? x) (string? x) (keyword? x) (= x '_)))

(def property-types
  "Property types supported by the properties parser."
  [{:type  :property
    :test  #(symbol? %)
    :name  #(name %)
    :query #(keyword (:name %))}
   {:type  :link
    :test  #(and (vector? %)
                 (= 2 (count %))
                 (value? (second %)))
    :name  #(first %)
    :query #(-> [(keyword (:name %)) (:target %)])}
   {:type  :join
    :test  #(and (map? %)
                 (= 1 (count %)))
    :name  #(first (keys %))
    :query #(-> {(keyword (:name %))
                 (let [target (:target %)]
                   (cond
                     (= target '...) '...
                     (number? target) target
                     :else `(~'om.next/get-query ~target)))})}])

(defn- property-resolve
  "Given a property prop, resolves the field :type or :name into
   the corresponding property type or name."
  [prop field]
  (let [match (first (filter (fn [info]
                               (or ((:test info) prop)
                                   (and (map? prop)
                                        (= (:type info)
                                           (:type prop)))))
                             property-types))]
    (if (fn? (get match field))
      ((get match field) prop)
      (get match field))))

(defn property-type
  "Returns the property type for prop."
  [prop]
  (property-resolve prop :type))

(defn property-name
  "Returns a property name for prop. If passed a parent != nil,
   the property name is namespaced according to the parent property
   name."
  [parent prop]
  (symbol (some-> parent (property-resolve :name) name)
          (some-> prop (property-resolve :name) name)))

(defn property-query
  "Returns an Om Next query expression for prop."
  [prop]
  (property-resolve prop :query))

(defn parse
  "Parses a properties specification like
   [user [name email {friends User}] [current-user _]] into
   a flat collection with the following structure:

   [{:name user/name :type :property}
    {:name user/email :type :property}
    {:name user/friends :type :join :target User}
    {:name current-user :type :link :target _}].

   From this it is trivial to generate keys for destructuring
   view props and an Om Next query."
  [spec]
  (letfn [(parse-prop [parent p]
            (let [name (property-name parent p)
                  type (property-type p)]
              (case type
                :property {:name name :type type}
                :link     {:name name :type type
                           :target (second p)}
                :join     {:name name :type type
                           :target (first (vals p))}
                :else     nil)))
          (parse-step [result [p children]]
            (concat result
                    (cond
                      (nil? children)    [(parse-prop nil p)]
                      (vector? children) (mapv #(parse-prop p %)
                                               children))))]
    (->> (pad-by #(= (property-type %1) (property-type %2)) nil spec)
         (partition-all 2 2)
         (reduce parse-step [])
         (into []))))

(defn om-query
  "Generates an Om Next query from a parsed properties specification."
  [props]
  (into [] (map property-query) props))

(defn map-keys
  "Generates keys for destructuring a map of properties from a parsed
   properties specification."
  [props]
  (into [] (map :name) props))

(ns app-macros.props)

(defn pad-by
  "Add pad in between any two consecutive values in coll for which
   pred returns the same result. As an example, assume the following
   use:

       (pad-by type :same-type [:foo :bar [1 2] {3 4} {5 6}])

   The result would be

       [:foo :same-type :bar [1 2] {3 4} :same-type {5 6}].

   If called without coll, returns a transducer."
  ([pred pad]
   (fn [rf]
     (let [pv (volatile! nil)]
       (fn
         ([] (rf))
         ([result] (rf result))
         ([result input]
          (let [prior @pv]
            (vreset! pv input)
            (if (pred prior input)
              (rf (rf result pad) input)
              (rf result input))))))))
  ([pred pad coll] (sequence (pad-by pred pad) coll)))

(defn value?
  "Returns true if x is considered a basic EDN value."
  [x]
  (or (number? x) (string? x) (keyword? x) (= x '_)))

(def property-types
  "Property types supported by the properties parser."
  [{:type  :property
    :test  #(symbol? %)
    :name  #(name %)
    :query #(keyword (:name %))}
   {:type  :link
    :test  #(and (vector? %)
                 (= 2 (count %))
                 (value? (second %)))
    :name  #(first %)
    :query #(-> [(keyword (:name %))
                 (let [target (:target %)]
                   (cond
                     (= target '_) ''_
                     :else target))])}
   {:type  :join
    :test  #(and (map? %)
                 (= 1 (count %)))
    :name  #(first (keys %))
    :query #(-> {(keyword (:name %))
                 (let [target (:target %)]
                   (cond
                     (= target '...) ''...
                     (number? target) target
                     :else `(~'om.next/get-query ~target)))})}])

(defn- property-resolve
  "Given a property prop, resolves the field :type or :name into
   the corresponding property type or name."
  [prop field]
  (let [match (first (filter (fn [info]
                               (or ((:test info) prop)
                                   (and (map? prop)
                                        (= (:type info)
                                           (:type prop)))))
                             property-types))]
    (if (fn? (get match field))
      ((get match field) prop)
      (get match field))))

(defn property-type
  "Returns the property type for prop."
  [prop]
  (property-resolve prop :type))

(defn property-name
  "Returns a property name for prop. If passed a parent != nil,
   the property name is namespaced according to the parent property
   name."
  [parent prop]
  (symbol (some-> parent (property-resolve :name) name)
          (some-> prop (property-resolve :name) name)))

(defn property-query
  "Returns an Om Next query expression for prop."
  [prop]
  (property-resolve prop :query))

(defn parse
  "Parses a properties specification like
   [user [name email {friends User}] [current-user _]] into
   a flat collection with the following structure:

   [{:name user/name :type :property}
    {:name user/email :type :property}
    {:name user/friends :type :join :target User}
    {:name current-user :type :link :target _}].

   From this it is trivial to generate keys for destructuring
   view props and an Om Next query."
  [spec]
  (letfn [(parse-prop [parent p]
            (let [name (property-name parent p)
                  type (property-type p)]
              (case type
                :property {:name name :type type}
                :link     {:name name :type type
                           :target (second p)}
                :join     {:name name :type type
                           :target (first (vals p))}
                :else     nil)))
          (parse-step [result [p children]]
            (concat result
                    (cond
                      (nil? children)    [(parse-prop nil p)]
                      (vector? children) (mapv #(parse-prop p %)
                                               children))))]
    (->> (pad-by #(= (property-type %1) (property-type %2)) nil spec)
         (partition-all 2 2)
         (reduce parse-step [])
         (into []))))

(defn om-query
  "Generates an Om Next query from a parsed properties specification."
  [props]
  (into [] (map property-query) props))

(defn map-keys
  "Generates keys for destructuring a map of properties from a parsed
   properties specification."
  [props]
  (into [] (map :name) props))

Fix ... and _ not being quoted when returned to CLJS


(ns ^:no-doc onyx.peer.window-state
    (:require [com.stuartsierra.component :as component]
              [taoensso.timbre :refer [info error warn trace fatal] :as timbre]
              [schema.core :as s]
              [clojure.core.async :refer [alts!! <!! >!! <! >! timeout chan close! thread go]]
              [onyx.schema :refer [TriggerState WindowExtension Window Event]]
              [onyx.monitoring.measurements :refer [emit-latency emit-latency-value]]
              [onyx.windowing.window-extensions :as we]
              [onyx.lifecycles.lifecycle-invoke :as lc]
              [onyx.types :refer [->Ack ->Results ->MonitorEvent dec-count! inc-count! map->Event map->Compiled]]
              [onyx.state.ack :as st-ack]
              [onyx.state.state-extensions :as state-extensions]
              [onyx.static.default-vals :refer [defaults arg-or-default]]))

(s/defn default-state-value
  [init-fn window state-value]
  (or state-value (init-fn window)))

(defprotocol WindowStateKeyed
  (keyed-state [this k]))

(defprotocol StateEventReducer
  (trigger-extent [this])
  (trigger [this])
  (triggers [this])
  (extent-state [this])
  (apply-extents [this])
  (apply-event [this])
  (aggregate-state [this])
  (log-entries [this])
  (state [this])
  (play-trigger-entry [this entry])
  (play-triggers-entry [this entry])
  (play-extent-entry [this entry])
  (play-aggregation-entry [this entry])
  (play-entry [this entry]))

(defrecord StateEvent
  [event-type task-event segment grouped? group-key lower-bound upper-bound log-type trigger-update aggregation-update window next-state])

(s/defn new-state-event
  [event-type task-event :- Event]
  (->StateEvent event-type task-event nil nil nil nil nil nil nil nil nil nil))

(defn state-event->log-entry [{:keys [log-type] :as state-event}]
  (case log-type
    :trigger (list log-type (:trigger-index state-event) (:extent state-event) (:trigger-update state-event))
    :aggregation (list log-type (:extent state-event) (:aggregation-update state-event))))

(defn clean
  "Used to clean up the window state so we don't have recursive event printing
  problems and excess memory usage"
  [window-state]
  (assoc window-state :event-results nil :state-event nil))

(defrecord WindowGrouped
  [window-extension trigger-states grouping-fn window state new-window-state-fn
   init-fn create-state-update apply-state-update super-agg-fn state-event event-results]

  WindowStateKeyed
  (keyed-state [this k]
    (-> (get state k)
        (or (new-window-state-fn))
        (assoc :state-event (assoc state-event :group-key k))))

  StateEventReducer
  (apply-event [this]
    (let [ks (if (= :new-segment (:event-type state-event))
               (list (:group-key state-event))
               (keys state))]
      (reduce (fn [t k]
                (let [kstate (apply-event (keyed-state t k))]
                  (-> t
                      (update :state assoc k (clean kstate))
                      (update :event-results conj kstate))))
              this
              ks)))

  (log-entries [this]
    (->> event-results
         (map (juxt (comp :group-key :state-event) log-entries))
         (remove (comp empty? second))
         (doall)))

  (state [this]
    state)

  (play-entry [this entry]
    (reduce (fn [t [k e]]
              (assoc-in t
                        [:state k]
                        (play-entry (keyed-state t k) e)))
            this
            entry)))

(defrecord WindowUngrouped
  [window-extension trigger-states window state init-fn
   create-state-update apply-state-update super-agg-fn state-event event-results]
  StateEventReducer
  (play-trigger-entry [this [trigger-index extent transition-entry]]
    (let [{:keys [trigger apply-state-update] :as trigger-state} (trigger-states trigger-index)]
      (assoc this
             :state
             (update state
                     extent
                     (fn [extent-state]
                       (apply-state-update trigger extent-state transition-entry))))))

  (play-aggregation-entry [this [extent transition-entry]]
    (assoc this
           :state
           (update state
                   extent
                   (fn [extent-state]
                     (apply-state-update window extent-state transition-entry)))))

  (play-entry [this entries]
    (reduce (fn [t [entry-type & rst]]
              (case entry-type
                :trigger (play-trigger-entry t rst)
                :aggregation (play-aggregation-entry t rst)))
            this
            entries))

  (trigger-extent [this]
    (let [{:keys [trigger-state extent]} state-event
          {:keys [sync-fn trigger create-state-update apply-state-update]} trigger-state
          extent-state (get state extent)
          entry (create-state-update trigger extent-state state-event)
          new-extent-state (apply-state-update trigger extent-state entry)
          [lower-bound upper-bound] (we/bounds window-extension extent)
          state-event* (-> state-event
                           (assoc :window window)
                           (assoc :lower-bound lower-bound)
                           (assoc :upper-bound upper-bound)
                           (assoc :extent-state extent-state)
                           (assoc :trigger-update entry)
                           (assoc :next-state new-extent-state))]
      (sync-fn (:task-event state-event*) window trigger state-event* extent-state)
      (assoc this
             :state (assoc state extent new-extent-state)
             :event-results (if (= extent-state new-extent-state)
                              event-results
                              (conj event-results state-event*)))))

  (trigger [this]
    (let [{:keys [trigger-index trigger-state]} state-event
          {:keys [trigger next-trigger-state trigger-fire? fire-all-extents?]} trigger-state
          new-trigger-state (next-trigger-state trigger (:state trigger-state) state-event)
          ;; TODO, scope this via :trigger/scope
          fire? (trigger-fire? trigger new-trigger-state state-event)
          fire-all? (or fire-all-extents? (not= (:event-type state-event) :segment))
          fire-extents (if fire?
                         (if fire-all?
                           (keys state)
                           (:extents state-event))
                         [])]
      (reduce (fn [t extent]
                (trigger-extent (assoc t
                                       :state-event
                                       (assoc state-event :extent extent))))
              (assoc-in this [:trigger-states trigger-index :state] new-trigger-state)
              fire-extents)))

  (triggers [this]
    ;; index by trigger index in order to store the trigger index in the log entry
    (reduce (fn [t [trigger-index trigger-state]]
              (trigger (assoc t :state-event (-> state-event
                                                 (assoc :log-type :trigger)
                                                 (assoc :trigger-index trigger-index)
                                                 (assoc :trigger-state trigger-state)))))
            this
            (map-indexed list trigger-states)))

  (extent-state [this]
    (let [{:keys [extent segment]} state-event
          extent-state (->> (get state extent)
                            (default-state-value init-fn window))
          transition-entry (create-state-update window extent-state segment)
          new-extent-state (apply-state-update window extent-state transition-entry)
          new-state-event (-> state-event
                              (assoc :next-extent-state new-extent-state)
                              (assoc :log-type :aggregation)
                              (assoc :aggregation-update transition-entry))]
      (assoc this
             :state (assoc state extent new-extent-state)
             :event-results (conj event-results new-state-event))))

  (state [this]
    state)

  (log-entries [this]
    (doall (map state-event->log-entry event-results)))

  (apply-extents [this]
    (let [{:keys [segment]} state-event
          segment-coerced (we/uniform-units window-extension segment)
          state* (we/speculate-update window-extension state segment-coerced)
          state** (we/merge-extents window-extension state* super-agg-fn segment-coerced)
          extents (we/extents window-extension (keys state**) segment-coerced)]
      (-> this
          (assoc :state state**)
          (assoc :state-event (assoc state-event :extents extents)))))

  (aggregate-state [this]
    (reduce (fn [t extent]
              (extent-state (assoc t :state-event (assoc state-event :extent extent))))
            this
            (:extents state-event)))

  (apply-event [this]
    (if (= (:event-type state-event) :new-segment)
      (-> this
          apply-extents
          aggregate-state
          triggers)
      (triggers this))))

(defn clean-windows-states
  "Cleans window states of anything they no longer require after reduction
  e.g. event maps, log entries"
  [windows-state]
  (mapv clean windows-state))

(defn fire-state-event [windows-state state-event]
  (mapv (fn [ws]
          (apply-event (assoc ws
                              :state-event state-event
                              :state-results [])))
        windows-state))

(defn process-segment
  [{:keys [peer-replica-view acking-state grouping-fn monitoring messenger uniqueness-task? uniqueness-key] :as compiled}
   {:keys [task-event] :as state-event}]
  (let [{:keys [onyx.core/windows-state onyx.core/filter-state onyx.core/state-log onyx.core/results]} task-event
        grouped? (not (nil? grouping-fn))
        state-event* (assoc state-event :grouped? grouped?)
        start-time (System/currentTimeMillis)
        rs (doall
             (mapcat
               (fn [leaf fused-ack]
                 (map
                   (fn [message]
                     (let [segment (:message message)
                           state-event** (cond-> (assoc state-event* :segment segment)
                                           grouped? (assoc :group-key (grouping-fn segment)))
                           unique-id (if uniqueness-task? (get segment uniqueness-key))
                           process? (not (and uniqueness-task?
                                              (state-extensions/filter? @filter-state task-event unique-id)))]
                       ;; Always update the filter, to freshen up the fact that the id has been re-seen
                       (when uniqueness-task?
                         (swap! filter-state state-extensions/apply-filter-id task-event unique-id))
                       (if process?
                         (let [_ (st-ack/prepare acking-state unique-id fused-ack)
                               updated (swap! windows-state fire-state-event state-event**)
                               _ (swap! windows-state clean-windows-states)]
                           (list #(st-ack/ack acking-state unique-id fused-ack)
                                 (list unique-id (doall (map log-entries updated)))))
                         (list #(st-ack/defer acking-state unique-id fused-ack)))))
                   (:leaves leaf)))
               (:tree results)
               (:acks results)))
        ack-fns (doall (map first rs))
        success-fn (fn []
                     (run! (fn [f] (f)) (map first rs))
                     (run! (fn [f] (f)) ack-fns)
                     (emit-latency-value :window-log-write-entry
                                         monitoring
                                         (- (System/currentTimeMillis) start-time)))
        log-entry (keep second rs)]
    (state-extensions/store-log-entry state-log task-event success-fn log-entry)))
    (when-not (empty? log-entry)
      (state-extensions/store-log-entry state-log task-event success-fn log-entry))))

(defn process-event [compiled {:keys [task-event] :as state-event}]
  (let [{:keys [onyx.core/windows-state onyx.core/state-log]} task-event
        new-ws (swap! windows-state fire-state-event state-event)
        log-entry (remove empty? (map log-entries new-ws))]
    (when-not (empty? log-entry)
      ;; nil filter-id as this is not in response to a segment
      (state-extensions/store-log-entry state-log task-event (fn []) (list nil log-entry)))))

(defn process-state
  [compiled {:keys [event-type task-event] :as state-event}]
  (if (= event-type :new-segment)
    (process-segment compiled state-event)
    (process-event compiled state-event)))

(defn process-state-loop [{:keys [onyx.core/state-ch onyx.core/compiled onyx.core/peer-opts] :as event} ex-f]
  (try
    (let [timer-resolution (arg-or-default :onyx.peer/trigger-timer-resolution peer-opts)]
      (loop [timer-tick-ch (timeout timer-resolution)]
        (let [[[event-type task-event ack-batch] ch] (alts!! [timer-tick-ch state-ch] :priority true)]
          (cond (= ch state-ch)
                (when event-type
                  (lc/invoke-assign-windows process-state compiled (new-state-event event-type task-event))
                  ;; It's safe to ack the batch as it has been processed by the process event loop
                  ;; Will only ack if the batch has not been acked by ack-segments in the task lifecycle
                  (ack-batch)
                  (recur timer-tick-ch))

                (= ch timer-tick-ch)
                (do
                  (lc/invoke-assign-windows process-state compiled (new-state-event :timer-tick event))
                  (recur (timeout timer-resolution)))))))
    (catch Throwable t
      (ex-f t)
      (error t "Error in process state loop."))))

(ns ^:no-doc onyx.peer.window-state
    (:require [com.stuartsierra.component :as component]
              [taoensso.timbre :refer [info error warn trace fatal] :as timbre]
              [schema.core :as s]
              [clojure.core.async :refer [alts!! <!! >!! <! >! timeout chan close! thread go]]
              [onyx.schema :refer [TriggerState WindowExtension Window Event]]
              [onyx.monitoring.measurements :refer [emit-latency emit-latency-value]]
              [onyx.windowing.window-extensions :as we]
              [onyx.lifecycles.lifecycle-invoke :as lc]
              [onyx.types :refer [->Ack ->Results ->MonitorEvent dec-count! inc-count! map->Event map->Compiled]]
              [onyx.state.ack :as st-ack]
              [onyx.state.state-extensions :as state-extensions]
              [onyx.static.default-vals :refer [defaults arg-or-default]]))

(s/defn default-state-value
  [init-fn window state-value]
  (or state-value (init-fn window)))

(defprotocol WindowStateKeyed
  (keyed-state [this k]))

(defprotocol StateEventReducer
  (trigger-extent [this])
  (trigger [this])
  (triggers [this])
  (extent-state [this])
  (apply-extents [this])
  (apply-event [this])
  (aggregate-state [this])
  (log-entries [this])
  (state [this])
  (play-trigger-entry [this entry])
  (play-triggers-entry [this entry])
  (play-extent-entry [this entry])
  (play-aggregation-entry [this entry])
  (play-entry [this entry]))

(defrecord StateEvent
  [event-type task-event segment grouped? group-key lower-bound upper-bound log-type trigger-update aggregation-update window next-state])

(s/defn new-state-event
  [event-type task-event :- Event]
  (->StateEvent event-type task-event nil nil nil nil nil nil nil nil nil nil))

(defn state-event->log-entry [{:keys [log-type] :as state-event}]
  (case log-type
    :trigger (list log-type (:trigger-index state-event) (:extent state-event) (:trigger-update state-event))
    :aggregation (list log-type (:extent state-event) (:aggregation-update state-event))))

(defn clean
  "Used to clean up the window state so we don't have recursive event printing
  problems and excess memory usage"
  [window-state]
  (assoc window-state :event-results nil :state-event nil))

(defrecord WindowGrouped
  [window-extension trigger-states grouping-fn window state new-window-state-fn
   init-fn create-state-update apply-state-update super-agg-fn state-event event-results]

  WindowStateKeyed
  (keyed-state [this k]
    (-> (get state k)
        (or (new-window-state-fn))
        (assoc :state-event (assoc state-event :group-key k))))

  StateEventReducer
  (apply-event [this]
    (let [ks (if (= :new-segment (:event-type state-event))
               (list (:group-key state-event))
               (keys state))]
      (reduce (fn [t k]
                (let [kstate (apply-event (keyed-state t k))]
                  (-> t
                      (update :state assoc k (clean kstate))
                      (update :event-results conj kstate))))
              this
              ks)))

  (log-entries [this]
    (->> event-results
         (map (juxt (comp :group-key :state-event) log-entries))
         (remove (comp empty? second))
         (doall)))

  (state [this]
    state)

  (play-entry [this entry]
    (reduce (fn [t [k e]]
              (assoc-in t
                        [:state k]
                        (play-entry (keyed-state t k) e)))
            this
            entry)))

(defrecord WindowUngrouped
  [window-extension trigger-states window state init-fn
   create-state-update apply-state-update super-agg-fn state-event event-results]
  StateEventReducer
  (play-trigger-entry [this [trigger-index extent transition-entry]]
    (let [{:keys [trigger apply-state-update] :as trigger-state} (trigger-states trigger-index)]
      (assoc this
             :state
             (update state
                     extent
                     (fn [extent-state]
                       (apply-state-update trigger extent-state transition-entry))))))

  (play-aggregation-entry [this [extent transition-entry]]
    (assoc this
           :state
           (update state
                   extent
                   (fn [extent-state]
                     (apply-state-update window extent-state transition-entry)))))

  (play-entry [this entries]
    (reduce (fn [t [entry-type & rst]]
              (case entry-type
                :trigger (play-trigger-entry t rst)
                :aggregation (play-aggregation-entry t rst)))
            this
            entries))

  (trigger-extent [this]
    (let [{:keys [trigger-state extent]} state-event
          {:keys [sync-fn trigger create-state-update apply-state-update]} trigger-state
          extent-state (get state extent)
          entry (create-state-update trigger extent-state state-event)
          new-extent-state (apply-state-update trigger extent-state entry)
          [lower-bound upper-bound] (we/bounds window-extension extent)
          state-event* (-> state-event
                           (assoc :window window)
                           (assoc :lower-bound lower-bound)
                           (assoc :upper-bound upper-bound)
                           (assoc :extent-state extent-state)
                           (assoc :trigger-update entry)
                           (assoc :next-state new-extent-state))]
      (sync-fn (:task-event state-event*) window trigger state-event* extent-state)
      (assoc this
             :state (assoc state extent new-extent-state)
             :event-results (if (= extent-state new-extent-state)
                              event-results
                              (conj event-results state-event*)))))

  (trigger [this]
    (let [{:keys [trigger-index trigger-state]} state-event
          {:keys [trigger next-trigger-state trigger-fire? fire-all-extents?]} trigger-state
          new-trigger-state (next-trigger-state trigger (:state trigger-state) state-event)
          ;; TODO, scope this via :trigger/scope
          fire? (trigger-fire? trigger new-trigger-state state-event)
          fire-all? (or fire-all-extents? (not= (:event-type state-event) :segment))
          fire-extents (if fire?
                         (if fire-all?
                           (keys state)
                           (:extents state-event))
                         [])]
      (reduce (fn [t extent]
                (trigger-extent (assoc t
                                       :state-event
                                       (assoc state-event :extent extent))))
              (assoc-in this [:trigger-states trigger-index :state] new-trigger-state)
              fire-extents)))

  (triggers [this]
    ;; index by trigger index in order to store the trigger index in the log entry
    (reduce (fn [t [trigger-index trigger-state]]
              (trigger (assoc t :state-event (-> state-event
                                                 (assoc :log-type :trigger)
                                                 (assoc :trigger-index trigger-index)
                                                 (assoc :trigger-state trigger-state)))))
            this
            (map-indexed list trigger-states)))

  (extent-state [this]
    (let [{:keys [extent segment]} state-event
          extent-state (->> (get state extent)
                            (default-state-value init-fn window))
          transition-entry (create-state-update window extent-state segment)
          new-extent-state (apply-state-update window extent-state transition-entry)
          new-state-event (-> state-event
                              (assoc :next-extent-state new-extent-state)
                              (assoc :log-type :aggregation)
                              (assoc :aggregation-update transition-entry))]
      (assoc this
             :state (assoc state extent new-extent-state)
             :event-results (conj event-results new-state-event))))

  (state [this]
    state)

  (log-entries [this]
    (doall (map state-event->log-entry event-results)))

  (apply-extents [this]
    (let [{:keys [segment]} state-event
          segment-coerced (we/uniform-units window-extension segment)
          state* (we/speculate-update window-extension state segment-coerced)
          state** (we/merge-extents window-extension state* super-agg-fn segment-coerced)
          extents (we/extents window-extension (keys state**) segment-coerced)]
      (-> this
          (assoc :state state**)
          (assoc :state-event (assoc state-event :extents extents)))))

  (aggregate-state [this]
    (reduce (fn [t extent]
              (extent-state (assoc t :state-event (assoc state-event :extent extent))))
            this
            (:extents state-event)))

  (apply-event [this]
    (if (= (:event-type state-event) :new-segment)
      (-> this
          apply-extents
          aggregate-state
          triggers)
      (triggers this))))

(defn clean-windows-states
  "Cleans window states of anything they no longer require after reduction
  e.g. event maps, log entries"
  [windows-state]
  (mapv clean windows-state))

(defn fire-state-event [windows-state state-event]
  (mapv (fn [ws]
          (apply-event (assoc ws
                              :state-event state-event
                              :state-results [])))
        windows-state))

(defn process-segment
  [{:keys [peer-replica-view acking-state grouping-fn monitoring messenger uniqueness-task? uniqueness-key] :as compiled}
   {:keys [task-event] :as state-event}]
  (let [{:keys [onyx.core/windows-state onyx.core/filter-state onyx.core/state-log onyx.core/results]} task-event
        grouped? (not (nil? grouping-fn))
        state-event* (assoc state-event :grouped? grouped?)
        start-time (System/currentTimeMillis)
        rs (doall
             (mapcat
               (fn [leaf fused-ack]
                 (map
                   (fn [message]
                     (let [segment (:message message)
                           state-event** (cond-> (assoc state-event* :segment segment)
                                           grouped? (assoc :group-key (grouping-fn segment)))
                           unique-id (if uniqueness-task? (get segment uniqueness-key))
                           process? (not (and uniqueness-task?
                                              (state-extensions/filter? @filter-state task-event unique-id)))]
                       ;; Always update the filter, to freshen up the fact that the id has been re-seen
                       (when uniqueness-task?
                         (swap! filter-state state-extensions/apply-filter-id task-event unique-id))
                       (if process?
                         (let [_ (st-ack/prepare acking-state unique-id fused-ack)
                               updated (swap! windows-state fire-state-event state-event**)
                               _ (swap! windows-state clean-windows-states)]
                           (list #(st-ack/ack acking-state unique-id fused-ack)
                                 (list unique-id (doall (map log-entries updated)))))
                         (list #(st-ack/defer acking-state unique-id fused-ack)))))
                   (:leaves leaf)))
               (:tree results)
               (:acks results)))
        ack-fns (doall (map first rs))
        success-fn (fn []
                     (run! (fn [f] (f)) (map first rs))
                     (run! (fn [f] (f)) ack-fns)
                     (emit-latency-value :window-log-write-entry
                                         monitoring
                                         (- (System/currentTimeMillis) start-time)))
        log-entry (keep second rs)]
    (when-not (empty? log-entry)
      (state-extensions/store-log-entry state-log task-event success-fn log-entry))))

(defn process-event [compiled {:keys [task-event] :as state-event}]
  (let [{:keys [onyx.core/windows-state onyx.core/state-log]} task-event
        new-ws (swap! windows-state fire-state-event state-event)
        log-entry (remove empty? (map log-entries new-ws))]
    (when-not (empty? log-entry)
      ;; nil filter-id as this is not in response to a segment
      (state-extensions/store-log-entry state-log task-event (fn []) (list nil log-entry)))))

(defn process-state
  [compiled {:keys [event-type task-event] :as state-event}]
  (if (= event-type :new-segment)
    (process-segment compiled state-event)
    (process-event compiled state-event)))

(defn process-state-loop [{:keys [onyx.core/state-ch onyx.core/compiled onyx.core/peer-opts] :as event} ex-f]
  (try
    (let [timer-resolution (arg-or-default :onyx.peer/trigger-timer-resolution peer-opts)]
      (loop [timer-tick-ch (timeout timer-resolution)]
        (let [[[event-type task-event ack-batch] ch] (alts!! [timer-tick-ch state-ch] :priority true)]
          (cond (= ch state-ch)
                (when event-type
                  (lc/invoke-assign-windows process-state compiled (new-state-event event-type task-event))
                  ;; It's safe to ack the batch as it has been processed by the process event loop
                  ;; Will only ack if the batch has not been acked by ack-segments in the task lifecycle
                  (ack-batch)
                  (recur timer-tick-ch))

                (= ch timer-tick-ch)
                (do
                  (lc/invoke-assign-windows process-state compiled (new-state-event :timer-tick event))
                  (recur (timeout timer-resolution)))))))
    (catch Throwable t
      (ex-f t)
      (error t "Error in process state loop."))))

Remove extra store log entry

Remove extra store log entry