(ns beckon
  (:import [com.hypirion.beckon SignalAtoms]
           [sun.misc Signal]))

(defn signal-atom [signal-name]
  (SignalAtoms/getSignalAtom signal-name))

(defn raise! [signal-name]
  (Signal/raise (Signal. signal-name)))

(defn true!
  "Takes a function of no arguments, and returns a function taking no arguments
  which calls f and returns true. f has presumably side effects."
  [f]
  (fn [] (f) true))

(defn false!
  "Takes a function of no arguments, and returns a function taking no arguments
  which calls f and returns false. f has presumably side effects."
  [f]
  (fn [] (f) true))

Add mockup of beckon.

Add mockup of beckon.


(ns clojush.random
  (:use [clojush globals translate])
  (:require [clj-random.core :as random]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; random functions

(def ^:dynamic *thread-local-random-generator* (random/make-mersennetwister-rng))

(def lrand-int random/lrand-int)

(def lrand random/lrand)

(def lrand-nth random/lrand-nth)

(def lshuffle random/lshuffle)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; random plush genome generator

(defn random-closes
  "Returns a random number of closes based on close-parens-probabilities, which
   defaults to [0.772 0.206 0.021 0.001]. This is roughly equivalent to each selection
   coming from  a binomial distribution with n=4 and p=1/16.
      (see http://www.wolframalpha.com/input/?i=binomial+distribution+4+0.0625)
   This results in the following probabilities:
     p(0) = 0.772
     p(1) = 0.206
     p(2) = 0.021
     p(3) = 0.001"
  [close-parens-probabilities]
  (let [prob (lrand)]
    (loop [parens 0
           probabilities (concat (reductions + close-parens-probabilities)
                                 '(1.0))]
      (if (<= prob (first probabilities))
        parens
        (recur (inc parens)
               (rest probabilities))))))

(defn random-plush-instruction-map
  "Returns a random instruction map given the atom-generators and the required
   epigenetic-markers."
  ([atom-generators]
   (random-plush-instruction-map atom-generators {}))
  ([atom-generators argmap]
   (random-plush-instruction-map atom-generators false argmap))
  ([atom-generators random-insertion {:keys [epigenetic-markers
                                             close-parens-probabilities
                                             silent-instruction-probability]
                                      :or {epigenetic-markers []
                                           close-parens-probabilities [0.772 0.206 0.021 0.001]
                                           silent-instruction-probability 0}}]
   (let [markers (concat epigenetic-markers
                         [:instruction]
                         (if random-insertion [:random-insertion]))]
     (zipmap markers
             (map (fn [marker]
                    (case marker
                      :instruction (let [element (lrand-nth atom-generators)]
                                     (if (fn? element)
                                       (let [fn-element (element)]
                                         (if (fn? fn-element)
                                           (fn-element)
                                           fn-element))
                                       element))
                      :close (random-closes close-parens-probabilities)
                      :silent (if (< (lrand) silent-instruction-probability)
                                true
                                false)
                      :random-insertion true
                      ))
                  markers)))))

(defn random-plush-genome-with-size
  "Returns a random Plush genome containing the given number of points."
  ([genome-size atom-generators argmap]
   (random-plush-genome-with-size genome-size atom-generators false argmap))
  ([genome-size atom-generators random-insertion argmap]
   (repeatedly genome-size
               #(random-plush-instruction-map
                 atom-generators
                 random-insertion
                 argmap))))

(defn random-plush-genome
  "Returns a random Plush genome with size limited by max-genome-size."
  ([max-genome-size atom-generators]
    (random-plush-genome max-genome-size atom-generators {}))
  ([max-genome-size atom-generators argmap]
   (random-plush-genome max-genome-size atom-generators false argmap))
  ([max-genome-size atom-generators random-insertion argmap]
    (random-plush-genome-with-size (inc (lrand-int max-genome-size))
                           atom-generators
                           random-insertion
                           argmap)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; random Push code generator

(defn random-push-code
  "Returns a random Push expression with size limited by max-points."
  ([max-points atom-generators]
    (random-push-code max-points atom-generators {:max-points @global-max-points}))
  ([max-points atom-generators argmap]
    (translate-plush-genome-to-push-program
      {:genome (random-plush-genome (max (int (/ max-points 4)) 1)
                                    atom-generators
                                    argmap)}
      argmap)))

(ns clojush.random
  (:use [clojush globals translate])
  (:require [clj-random.core :as random]))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; random functions

(def ^:dynamic *thread-local-random-generator* (random/make-mersennetwister-rng))

(def lrand-int random/lrand-int)

(def lrand random/lrand)

(def lrand-nth random/lrand-nth)

(def lshuffle random/lshuffle)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; random plush genome generator

(defn random-closes
  "Returns a random number of closes based on close-parens-probabilities, which
   defaults to [0.772 0.206 0.021 0.001]. This is roughly equivalent to each selection
   coming from  a binomial distribution with n=4 and p=1/16.
      (see http://www.wolframalpha.com/input/?i=binomial+distribution+4+0.0625)
   This results in the following probabilities:
     p(0) = 0.772
     p(1) = 0.206
     p(2) = 0.021
     p(3) = 0.001"
  [close-parens-probabilities]
  (let [prob (lrand)]
    (loop [parens 0
           probabilities (concat (reductions + close-parens-probabilities)
                                 '(1.0))]
      (if (<= prob (first probabilities))
        parens
        (recur (inc parens)
               (rest probabilities))))))

(defn random-plush-instruction-map
  "Returns a random instruction map given the atom-generators and the required
   epigenetic-markers."
  ([atom-generators]
   (random-plush-instruction-map atom-generators {}))
  ([atom-generators argmap]
   (random-plush-instruction-map atom-generators false argmap))
  ([atom-generators random-insertion {:keys [epigenetic-markers
                                             close-parens-probabilities
                                             silent-instruction-probability]
                                      :or {epigenetic-markers []
                                           close-parens-probabilities [0.772 0.206 0.021 0.001]
                                           silent-instruction-probability 0}}]
   (let [markers (concat epigenetic-markers
                         [:instruction :uuid]
                         (if random-insertion [:random-insertion]))]
     (zipmap markers
             (map (fn [marker]
                    (case marker
                      :instruction (let [element (lrand-nth atom-generators)]
                                     (if (fn? element)
                                       (let [fn-element (element)]
                                         (if (fn? fn-element)
                                           (fn-element)
                                           fn-element))
                                       element))
                      :close (random-closes close-parens-probabilities)
                      :silent (if (< (lrand) silent-instruction-probability)
                                true
                                false)
                      :random-insertion true
                      :uuid (java.util.UUID/randomUUID)
                      ))
                  markers)))))

(defn random-plush-genome-with-size
  "Returns a random Plush genome containing the given number of points."
  ([genome-size atom-generators argmap]
   (random-plush-genome-with-size genome-size atom-generators false argmap))
  ([genome-size atom-generators random-insertion argmap]
   (repeatedly genome-size
               #(random-plush-instruction-map
                 atom-generators
                 random-insertion
                 argmap))))

(defn random-plush-genome
  "Returns a random Plush genome with size limited by max-genome-size."
  ([max-genome-size atom-generators]
    (random-plush-genome max-genome-size atom-generators {}))
  ([max-genome-size atom-generators argmap]
   (random-plush-genome max-genome-size atom-generators false argmap))
  ([max-genome-size atom-generators random-insertion argmap]
    (random-plush-genome-with-size (inc (lrand-int max-genome-size))
                           atom-generators
                           random-insertion
                           argmap)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; random Push code generator

(defn random-push-code
  "Returns a random Push expression with size limited by max-points."
  ([max-points atom-generators]
    (random-push-code max-points atom-generators {:max-points @global-max-points}))
  ([max-points atom-generators argmap]
    (translate-plush-genome-to-push-program
      {:genome (random-plush-genome (max (int (/ max-points 4)) 1)
                                    atom-generators
                                    argmap)}
      argmap)))

Add UUIDs to instruction maps

Add UUIDs to instruction maps


(ns onyx-java.wrapper.entity
    (:gen-class)
    (:require [onyx-java.utils.object :as o]))

(defn add-parameter-factory [object-name object-map]
    ;; Creates a parameter adding factory for an object created from the
    ;; specified classname.
    (let [c object-name]
    (fn [parameter-vector] (.addParameter (deref (get-in object-map [c :ref]))
        (get parameter-vector 0) (get parameter-vector 1)))))

(defn add-parameter [object-name object-map parameter-vector]
    ;; Adds a single parameter to an entity derived object.
    ;; Parameters should be of the form [key value]
    (def add (add-parameter-factory object-name object-map))
    (add parameter-vector))

(defn add-parameters [object-name object-map parameter-vectors]
    ;; Adds an arbitrary number of parameters to an entity derived object.
    ;; Parameters should be of the form [[k1 v1] [k2 v2] [k3 v3]]
    (def add (add-parameter-factory object-name object-map))
    (dorun (map add parameter-vectors)))

(defn get-clojure-map [object-map object-name]
    ;; Converts the entity content map into its clojure corrected form
    ;; and returns the result.
    (.toCljMap (deref (get-in object-map [object-name :ref]))))

(defn get-clojure-entry [object-map]
    ;; Converts the entity content map into its clojure corrected form
    ;; and returns the result.
    (fn [object-name]
        (hash-map object-name (get-clojure-map object-map object-name))))

(ns onyx-java.wrapper.entity
    (:gen-class))

(defn add-parameter-factory [object-name object-map]
    ;; Creates a parameter adding factory for an object created from the
    ;; specified classname.
    (let [c object-name]
    (fn [parameter-vector] (.addParameter (deref (get-in object-map [c :ref]))
        (get parameter-vector 0) (get parameter-vector 1)))))

(defn add-parameter [object-name object-map parameter-vector]
    ;; Adds a single parameter to an entity derived object.
    ;; Parameters should be of the form [key value]
    (def add (add-parameter-factory object-name object-map))
    (add parameter-vector))

(defn add-parameters [object-name object-map parameter-vectors]
    ;; Adds an arbitrary number of parameters to an entity derived object.
    ;; Parameters should be of the form [[k1 v1] [k2 v2] [k3 v3]]
    (def add (add-parameter-factory object-name object-map))
    (dorun (map add parameter-vectors)))

(defn get-clojure-map [object-map object-name]
    ;; Converts the entity content map into its clojure corrected form
    ;; and returns the result.
    (.toCljMap (deref (get-in object-map [object-name :ref]))))

(defn get-clojure-entry [object-map]
    ;; Converts the entity content map into its clojure corrected form
    ;; and returns the result.
    (fn [object-name]
        (hash-map object-name (get-clojure-map object-map object-name))))

remove unused require

remove unused require


(ns frontend.components.aside
  (:require [clojure.set :as set]
            [clojure.string :as str]
            [datascript :as d]
            [frontend.async :refer [put!]]
            [frontend.components.common :as common]
            [frontend.datascript :as ds]
            [frontend.state :as state]
            [frontend.utils :as utils :include-macros true]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true])
  (:require-macros [frontend.utils :refer [html]])
  (:import [goog.ui IdGenerator]))

(defn chat-aside [{:keys [db chat-body client-uuid aside-menu-opened chat-bot]} owner]
  (reify
    om/IInitState
    (init-state [_]
      {:listener-key (.getNextUniqueId (.getInstance IdGenerator))
       :touch-enabled? false})
    om/IDidMount
    (did-mount [_]
      (om/set-state! owner :touch-enabled? (.hasOwnProperty js/window "ontouchstart"))
      (d/listen! (om/get-shared owner :db)
                 (om/get-state owner :listener-key)
                 (fn [tx-report]
                   ;; TODO: better way to check if state changed
                   (when-let [chat-datoms (seq (filter #(= :chat/body (:a %)) (:tx-data tx-report)))]
                     (om/refresh! owner)))))
    om/IWillUnmount
    (will-unmount [_]
      (d/unlisten! (om/get-shared owner :db) (om/get-state owner :listener-key)))
    om/IWillUpdate
    (will-update [_ _ _]
      ;; check for scrolled all of the way down
      (let [node (om/get-node owner "chat-messages")]
        (om/set-state! owner :auto-scroll (= (- (.-scrollHeight node) (.-scrollTop node))
                                             (.-clientHeight node)))))
    om/IDidUpdate
    (did-update [_ _ _]
      (when (om/get-state owner :auto-scroll)
        (set! (.-scrollTop (om/get-node owner "chat-messages"))
              10000000)))
    om/IRender
    (render [_]
      (let [{:keys [cast!]} (om/get-shared owner)
            chats (ds/touch-all '[:find ?t :where [?t :chat/body]] @db)
            dummy-chat {:chat/body (str "Welcome to Precursor! "
                                        "Create fast prototypes and share your url to collaborate. "
                                        "Chat "
                                        (str "@" (str/lower-case chat-bot))
                                        " for help.")
                        :chat/color "#00b233"
                        :session/uuid chat-bot
                        :server/timestamp (js/Date. 0)}]
        (html
         [:section.aside-chat
          [:div.chat-messages {:ref "chat-messages"}
           (for [chat (sort-by :server/timestamp (concat chats [dummy-chat]))
                 :let [id (apply str (take 6 (str (:session/uuid chat))))
                       name (or (:chat/cust-name chat)
                                (if (= (str (:session/uuid chat))
                                       client-uuid)
                                  "You"
                                  id))]]
             (html [:div.message {:key (:db/id chat)}
                    [:span {:style {:color (or (:chat/color chat) (str "#" id))}}
                     name]
                    (str " " (:chat/body chat))]))]
          [:form {:on-submit #(do (cast! :chat-submitted)
                                  false)
                  :on-key-down #(when (and (= "Enter" (.-key %))
                                           (not (.-shiftKey %))
                                           (not (.-ctrlKey %))
                                           (not (.-metaKey %))
                                           (not (.-altKey %)))
                                  (cast! :chat-submitted)
                                  false)}
           [:textarea {:id "chat-box"
                       :tab-index "1"
                       :type "text"
                       :value (or chat-body "")
                       :placeholder "Send a message..."
                       :on-change #(cast! :chat-body-changed {:value (.. % -target -value)})}]]])))))

(defn menu [app owner]
  (reify
    om/IInitState (init-state [_] {:editing-name? false
                                   :new-name ""})
    om/IDidUpdate
    (did-update [_ _ _]
      (when (and (om/get-state owner :editing-name?)
                 (om/get-node owner "name-edit"))
        (.focus (om/get-node owner "name-edit"))))
    om/IRenderState
    (render-state [_ {:keys [editing-name? new-name]}]
      (let [{:keys [cast!]} (om/get-shared owner)
            controls-ch (om/get-shared owner [:comms :controls])
            client-id (:client-uuid app)
            aside-opened? (get-in app state/aside-menu-opened-path)
            chat-mobile-open? (get-in app state/chat-mobile-opened-path)
            document-id (get-in app [:document/id])
            can-edit? (not (empty? (:cust app)))]
        (html
         [:aside.app-aside {:class (concat
                                    (when-not aside-opened? ["closed"])
                                    (if chat-mobile-open? ["show-chat-on-mobile"] ["show-people-on-mobile"]))
                            :style {:width (if aside-opened?
                                             (get-in app state/aside-width-path)
                                             0)}}
          [:button.aside-switcher {:on-click #(cast! :chat-mobile-toggled)
                                   ;; :class (if chat-mobile-open? "chat-mobile" "people-mobile")
                                   }
           [:span.aside-switcher-option {:class (when-not chat-mobile-open? "toggled")} "People"]
           [:span.aside-switcher-option {:class (when     chat-mobile-open? "toggled")} "Chat"]]
          [:section.aside-people
           (let [show-mouse? (get-in app [:subscribers client-id :show-mouse?])]
             [:a {:key client-id
                  :title "You're viewing this document. Try inviting others. Click to toggle sharing your mouse position."
                  :class (if can-edit?
                           "editable"
                           "uneditable")
                  :role "button"
                  :on-click #(when can-edit?
                               (om/set-state! owner :editing-name? true))}
              (common/icon :user (when show-mouse? {:path-props
                                                    {:style
                                                     {:stroke (get-in app [:subscribers client-id :color])}}}))

              (if editing-name?
                [:form {:on-submit #(do (cast! :self-updated {:name new-name})
                                        (om/set-state! owner :editing-name? false)
                                        false)
                        :on-blur #(do (cast! :self-updated {:name new-name})
                                      (om/set-state! owner :editing-name? false)
                                      false)
                        :on-key-down #(when (= "Escape" (.-key %))
                                        (om/set-state! owner :editing-name? false)
                                        (om/set-state! owner :new-name "")
                                        false)}
                 [:input {:type "text"
                          :ref "name-edit"
                          :tab-index 1
                          :on-change #(om/set-state! owner :new-name (.. % -target -value))}]]
                [:span (or (get-in app [:cust :name]) "You")])])
           (for [[id {:keys [show-mouse? color cust-name]}] (dissoc (:subscribers app) client-id)
                 :let [id-str (or cust-name (apply str (take 6 id)))]]
             [:a {:title "An anonymous user is viewing this document. Click to toggle showing their mouse position."
                  :role "button"
                  :key id
                  :on-click #(cast! :aside-user-clicked {:id-str id-str})}
              (common/icon :user (when show-mouse? {:path-props {:style {:stroke color}}}))
              [:span id-str]])]
          ;; XXX better name here
          (om/build chat-aside {:db (:db app)
                                :client-uuid (:client-uuid app)
                                :chat-body (get-in app [:chat :body])
                                :chat-bot (get-in app (state/doc-chat-bot-path document-id))
                                :aside-menu-opened (get-in app state/aside-menu-opened-path)})])))))

(ns frontend.components.aside
  (:require [clojure.set :as set]
            [clojure.string :as str]
            [datascript :as d]
            [frontend.async :refer [put!]]
            [frontend.components.common :as common]
            [frontend.datascript :as ds]
            [frontend.state :as state]
            [frontend.utils :as utils :include-macros true]
            [om.core :as om :include-macros true]
            [om.dom :as dom :include-macros true])
  (:require-macros [frontend.utils :refer [html]])
  (:import [goog.ui IdGenerator]))

(defn chat-aside [{:keys [db chat-body client-uuid aside-menu-opened chat-bot]} owner]
  (reify
    om/IInitState
    (init-state [_]
      {:listener-key (.getNextUniqueId (.getInstance IdGenerator))
       :touch-enabled? false})
    om/IDidMount
    (did-mount [_]
      (om/set-state! owner :touch-enabled? (.hasOwnProperty js/window "ontouchstart"))
      (d/listen! (om/get-shared owner :db)
                 (om/get-state owner :listener-key)
                 (fn [tx-report]
                   ;; TODO: better way to check if state changed
                   (when-let [chat-datoms (seq (filter #(= :chat/body (:a %)) (:tx-data tx-report)))]
                     (om/refresh! owner)))))
    om/IWillUnmount
    (will-unmount [_]
      (d/unlisten! (om/get-shared owner :db) (om/get-state owner :listener-key)))
    om/IWillUpdate
    (will-update [_ _ _]
      ;; check for scrolled all of the way down
      (let [node (om/get-node owner "chat-messages")]
        (om/set-state! owner :auto-scroll (= (- (.-scrollHeight node) (.-scrollTop node))
                                             (.-clientHeight node)))))
    om/IDidUpdate
    (did-update [_ _ _]
      (when (om/get-state owner :auto-scroll)
        (set! (.-scrollTop (om/get-node owner "chat-messages"))
              10000000)))
    om/IRender
    (render [_]
      (let [{:keys [cast!]} (om/get-shared owner)
            chats (ds/touch-all '[:find ?t :where [?t :chat/body]] @db)
            dummy-chat {:chat/body [:span "Welcome to Precursor! "
                                          "Create fast prototypes and share your url to collaborate. "
                                          "Chat "
                                          [:a {:on-click #(cast! :aside-user-clicked {:id-str (str/lower-case chat-bot)})
                                               :role "button"}
                                           (str "@" (str/lower-case chat-bot))]
                                          " for help."]
                        :chat/color "#00b233"
                        :session/uuid chat-bot
                        :server/timestamp (js/Date. 0)}]
        (html
         [:section.aside-chat
          [:div.chat-messages {:ref "chat-messages"}
           (for [chat (sort-by :server/timestamp (concat chats [dummy-chat]))
                 :let [id (apply str (take 6 (str (:session/uuid chat))))
                       name (or (:chat/cust-name chat)
                                (if (= (str (:session/uuid chat))
                                       client-uuid)
                                  "You"
                                  id))]]
             (html [:div.message {:key (:db/id chat)}
                    [:span {:style {:color (or (:chat/color chat) (str "#" id))}}
                     name]
                    " "
                    (:chat/body chat)]))]
          [:form {:on-submit #(do (cast! :chat-submitted)
                                  false)
                  :on-key-down #(when (and (= "Enter" (.-key %))
                                           (not (.-shiftKey %))
                                           (not (.-ctrlKey %))
                                           (not (.-metaKey %))
                                           (not (.-altKey %)))
                                  (cast! :chat-submitted)
                                  false)}
           [:textarea {:id "chat-box"
                       :tab-index "1"
                       :type "text"
                       :value (or chat-body "")
                       :placeholder "Send a message..."
                       :on-change #(cast! :chat-body-changed {:value (.. % -target -value)})}]]])))))

(defn menu [app owner]
  (reify
    om/IInitState (init-state [_] {:editing-name? false
                                   :new-name ""})
    om/IDidUpdate
    (did-update [_ _ _]
      (when (and (om/get-state owner :editing-name?)
                 (om/get-node owner "name-edit"))
        (.focus (om/get-node owner "name-edit"))))
    om/IRenderState
    (render-state [_ {:keys [editing-name? new-name]}]
      (let [{:keys [cast!]} (om/get-shared owner)
            controls-ch (om/get-shared owner [:comms :controls])
            client-id (:client-uuid app)
            aside-opened? (get-in app state/aside-menu-opened-path)
            chat-mobile-open? (get-in app state/chat-mobile-opened-path)
            document-id (get-in app [:document/id])
            can-edit? (not (empty? (:cust app)))]
        (html
         [:aside.app-aside {:class (concat
                                    (when-not aside-opened? ["closed"])
                                    (if chat-mobile-open? ["show-chat-on-mobile"] ["show-people-on-mobile"]))
                            :style {:width (if aside-opened?
                                             (get-in app state/aside-width-path)
                                             0)}}
          [:button.aside-switcher {:on-click #(cast! :chat-mobile-toggled)
                                   ;; :class (if chat-mobile-open? "chat-mobile" "people-mobile")
                                   }
           [:span.aside-switcher-option {:class (when-not chat-mobile-open? "toggled")} "People"]
           [:span.aside-switcher-option {:class (when     chat-mobile-open? "toggled")} "Chat"]]
          [:section.aside-people
           (let [show-mouse? (get-in app [:subscribers client-id :show-mouse?])]
             [:a {:key client-id
                  :title "You're viewing this document. Try inviting others. Click to toggle sharing your mouse position."
                  :class (if can-edit?
                           "editable"
                           "uneditable")
                  :role "button"
                  :on-click #(when can-edit?
                               (om/set-state! owner :editing-name? true))}
              (common/icon :user (when show-mouse? {:path-props
                                                    {:style
                                                     {:stroke (get-in app [:subscribers client-id :color])}}}))

              (if editing-name?
                [:form {:on-submit #(do (cast! :self-updated {:name new-name})
                                        (om/set-state! owner :editing-name? false)
                                        false)
                        :on-blur #(do (cast! :self-updated {:name new-name})
                                      (om/set-state! owner :editing-name? false)
                                      false)
                        :on-key-down #(when (= "Escape" (.-key %))
                                        (om/set-state! owner :editing-name? false)
                                        (om/set-state! owner :new-name "")
                                        false)}
                 [:input {:type "text"
                          :ref "name-edit"
                          :tab-index 1
                          :on-change #(om/set-state! owner :new-name (.. % -target -value))}]]
                [:span (or (get-in app [:cust :name]) "You")])])
           (for [[id {:keys [show-mouse? color cust-name]}] (dissoc (:subscribers app) client-id)
                 :let [id-str (or cust-name (apply str (take 6 id)))]]
             [:a {:title "An anonymous user is viewing this document. Click to toggle showing their mouse position."
                  :role "button"
                  :key id
                  :on-click #(cast! :aside-user-clicked {:id-str id-str})}
              (common/icon :user (when show-mouse? {:path-props {:style {:stroke color}}}))
              [:span id-str]])]
          ;; XXX better name here
          (om/build chat-aside {:db (:db app)
                                :client-uuid (:client-uuid app)
                                :chat-body (get-in app [:chat :body])
                                :chat-bot (get-in app (state/doc-chat-bot-path document-id))
                                :aside-menu-opened (get-in app state/aside-menu-opened-path)})])))))

add link inside dummy chat text to autofill ping


(ns cljss.core
  (:require [cljss.utils :refer [build-css escape-val]]
            [cljss.font-face :as ff]
            [cljss.inject-global :as ig]
            [cljss.builder :refer [status? dynamic? build-styles]]
            [clojure.string :as cstr]
            [sablono.cljss-compiler]))

(defn- ->status-styles [styles]
  (let [status (filterv status? styles)
        sprops (keys status)]
    (->> status
         (map (fn [[prop styles]]
                (->> styles
                     (map (fn [[rule value]] [rule prop value])))))
         (mapcat identity)
         (group-by first)
         (map (fn [[rule states]]
                (let [svals (map last states)
                      args  (mapv (fn [_] (gensym "var")) svals)]
                  [rule
                   `(with-meta
                      (fn ~args
                        (cond ~@(->> svals
                                     (map-indexed (fn [idx value]
                                                    [(nth args idx) value]))
                                     (mapcat identity)
                                     ((fn [coll] (concat coll [:else (get styles rule)]))))))
                      (list ~@(mapv second states)))])))
         (into {})
         (merge styles)
         (#(apply dissoc % sprops)))))

(defmacro var->cls-name [sym]
  `(-> ~'&env :ns :name (clojure.core/str "/" ~sym) (clojure.string/replace "." "_") (clojure.string/replace "/" "__")))

(defmacro defstyles
  "Takes var name, a vector of arguments and a hash map of styles definition.
   Generates class name, static and dynamic parts of styles.
   Returns a function that calls `cljss.core/css` to inject styles at runtime
   and returns generated class name."
  [var args styles]
  (let [cls-name# (var->cls-name var)
        [_ static# vals#] (build-styles cls-name# styles)]
    `(defn ~var ~args
       (cljss.core/css ~cls-name# ~static# ~vals#))))

(defn- vals->array [vals]
  (let [arrseq (mapv (fn [[var val]] `(cljs.core/array ~var ~val)) vals)]
    `(cljs.core/array ~@arrseq)))

(defn ->styled
  "Takes var name, HTML tag name and a hash map of styles definition.
   Returns a var bound to the result of calling `cljss.core/styled`,
   which produces React element and injects styles."
  [tag styles cls]
  (let [tag    (name tag)
        styles (->status-styles styles)
        [_ static values] (build-styles cls styles)
        values (vals->array values)
        attrs  (->> styles vals (filterv keyword?))]
    [tag static values `(cljs.core/array ~@attrs)]))

(defmacro make-styled []
  '(defn styled [cls static vars attrs create-element]
     (let [clsn   (str cls "-" (gensym))
           static (if ^boolean goog.DEBUG
                    (clojure.string/replace static cls clsn)
                    static)
           vars   (if ^boolean goog.DEBUG
                    (->> vars (map (fn [[k v]] [(clojure.string/replace k cls clsn) v])))
                    vars)
           cls    (if ^boolean goog.DEBUG clsn cls)]
       (fn [props & children]
         (let [[props children] (if (map? props)
                                  (array props children)
                                  (array {} (apply array props children)))
               var-class  (->> vars
                               (map (fn [[cls v]]
                                      (cond
                                        (and (ifn? v) (satisfies? IWithMeta v))
                                        (->> v meta list flatten (select-keys props) vals (apply v) (list cls))

                                        (ifn? v)
                                        (list cls (v props))

                                        :else (list cls v))))
                               (cljss.core/css cls static))
               meta-attrs (->> vars
                               (map second)
                               (filter #(satisfies? IWithMeta %))
                               (map meta)
                               flatten
                               set)
               className  (:className props)
               className  (str (when className (str className " ")) var-class)
               props      (assoc props :className className)
               props      (apply dissoc props (concat attrs meta-attrs))]
           (create-element props children))))))

(defn- keyframes-styles [idx styles]
  (let [dynamic (filterv dynamic? styles)
        static  (filterv (comp not dynamic?) styles)
        [vars idx]
        (reduce
          (fn [[vars idx] [rule]]
            [(conj vars [rule idx])
             (inc idx)])
          [[] idx]
          dynamic)
        vals    (mapv (fn [[_ var] [_ exp]] [(str "var(" var ")") exp]) vars dynamic)
        static  (->> vars
                     (map (fn [[rule var]] [rule (str "var(" var ")")]))
                     (concat static)
                     (map (fn [[rule val]] (str (name rule) ":" (escape-val rule val) ";")))
                     (cstr/join "")
                     (#(str "{" % "}")))]
    [static vals idx]))

(defn- ->ks-key [k]
  (cond
    (keyword? k) (name k)
    (number? k) (str k "%")
    (vector? k) (->> k (map ->ks-key) (cstr/join ","))
    :else k))

(defn- build-keyframes [keyframes]
  (let [[ks [statics vals]]
        (->> keyframes
             (reduce
               (fn [[ks [static vals idx]] [k styles]]
                 (let [[s v idx] (keyframes-styles idx styles)]
                   [(conj ks (->ks-key k))
                    [(conj static s) (into vals v) idx]]))
               [[] [[] [] 1]]))]
    [(->> (interleave ks statics)
          (apply str))
     `(cljs.core/array ~@(map (fn [v] `(cljs.core/array ~@v)) vals))]))

(defmacro defkeyframes
  "Takes var name, a vector of arguments and a hash map of CSS keyframes definition.
  Returns a function that calls `cljss.core/css-keyframes` to inject styles at runtime\n
  and returns generated CSS animation name that can be used in CSS `animation` rule.

  (defkeyframes spin [start end]\n    {:from {:transform (str \"rotate(\" start \"deg)\")}\n     :to   {:transform (str \"rotate(\" end \"deg)\")}})

  (defstyled Spinner :div\n    {:animation (str (spin 0 180) \" 1s ease infinite\")})"
  [var args keyframes]
  (let [cls# (var->cls-name var)
        [keyframes# vals#] (build-keyframes keyframes)]
    `(defn ~var ~args
       (cljss.core/css-keyframes ~cls# ~keyframes# ~vals#))))

(defmacro font-face
  "Takes a hash of font descriptors and produces CSS string of @font-face declaration.
  Returns a function that injects styles at runtime."
  [descriptors]
  (let [css# (ff/font-face descriptors)
        cls# (hash css#)]
    `(cljss.core/css ~cls# ~css# [])))

(defmacro inject-global
  "Takes a hash of global styles definitions and produces CSS string.
  Returns a sequence of calls to inject styles at runtime."
  [css]
  (let [css (ig/inject-global css)]
    `(do ~@(->> css (map (fn [[cls# css#]] `(cljss.core/css ~cls# ~css# [])))))))

(ns cljss.core
  (:require [cljss.utils :refer [build-css escape-val]]
            [cljss.font-face :as ff]
            [cljss.inject-global :as ig]
            [cljss.builder :refer [status? dynamic? build-styles]]
            [clojure.string :as cstr]
            [sablono.cljss-compiler]))

(defn- ->status-styles [styles]
  (let [status (filterv status? styles)
        sprops (keys status)]
    (->> status
         (map (fn [[prop styles]]
                (->> styles
                     (map (fn [[rule value]] [rule prop value])))))
         (mapcat identity)
         (group-by first)
         (map (fn [[rule states]]
                (let [svals (map last states)
                      args  (mapv (fn [_] (gensym "var")) svals)]
                  [rule
                   `(with-meta
                      (fn ~args
                        (cond ~@(->> svals
                                     (map-indexed (fn [idx value]
                                                    [(nth args idx) value]))
                                     (mapcat identity)
                                     ((fn [coll] (concat coll [:else (get styles rule)]))))))
                      (list ~@(mapv second states)))])))
         (into {})
         (merge styles)
         (#(apply dissoc % sprops)))))

(defmacro var->cls-name [sym]
  `(-> ~'&env :ns :name (clojure.core/str "/" ~sym) (clojure.string/replace "." "_") (clojure.string/replace "/" "__")))

(defmacro defstyles
  "Takes var name, a vector of arguments and a hash map of styles definition.
   Generates class name, static and dynamic parts of styles.
   Returns a function that calls `cljss.core/css` to inject styles at runtime
   and returns generated class name."
  [var args styles]
  (let [cls-name# (var->cls-name var)
        [_ static# vals#] (build-styles cls-name# styles)]
    `(defn ~var ~args
       (cljss.core/css ~cls-name# ~static# ~vals#))))

(defn- vals->array [vals]
  (let [arrseq (mapv (fn [[var val]] `(cljs.core/array ~var ~val)) vals)]
    `(cljs.core/array ~@arrseq)))

(defn ->styled
  "Takes var name, HTML tag name and a hash map of styles definition.
   Returns a var bound to the result of calling `cljss.core/styled`,
   which produces React element and injects styles."
  [tag styles cls]
  (let [tag    (name tag)
        styles (->status-styles styles)
        [_ static values] (build-styles cls styles)
        values (vals->array values)
        attrs  (->> styles vals (filterv keyword?))]
    [tag static values `(cljs.core/array ~@attrs)]))

(defmacro make-styled []
  '(defn styled [cls static vars attrs create-element]
     (let [clsn   (str cls "-" (gensym))
           static (if ^boolean goog.DEBUG
                    (clojure.string/replace static cls clsn)
                    static)
           vars   (if ^boolean goog.DEBUG
                    (->> vars (map (fn [[k v]] [(clojure.string/replace k cls clsn) v])))
                    vars)
           cls    (if ^boolean goog.DEBUG clsn cls)]
       (fn [props & children]
         (let [[props children] (if (map? props)
                                  (array props children)
                                  (array {} (apply array props children)))
               var-class  (->> vars
                               (map (fn [[cls v]]
                                      (cond
                                        (and (ifn? v) (satisfies? IWithMeta v))
                                        (->> v meta list flatten (select-keys props) vals (apply v) (list cls))

                                        (ifn? v)
                                        (list cls (v props))

                                        :else (list cls v))))
                               (cljss.core/css cls static))
               meta-attrs (->> vars
                               (map second)
                               (filter #(satisfies? IWithMeta %))
                               (map meta)
                               flatten
                               set)
               className  (-> props (select-keys [:className :class :class-name]) vals (filter identity))
               className  (str (when (seq className)
                                 (str (cstr/join " " className) " "))
                               var-class)
               props      (apply dissoc props (concat attrs meta-attrs [:class :class-name :className]))
               props      (assoc props :className className)]
           (create-element props children))))))

(defn- keyframes-styles [idx styles]
  (let [dynamic (filterv dynamic? styles)
        static  (filterv (comp not dynamic?) styles)
        [vars idx]
        (reduce
          (fn [[vars idx] [rule]]
            [(conj vars [rule idx])
             (inc idx)])
          [[] idx]
          dynamic)
        vals    (mapv (fn [[_ var] [_ exp]] [(str "var(" var ")") exp]) vars dynamic)
        static  (->> vars
                     (map (fn [[rule var]] [rule (str "var(" var ")")]))
                     (concat static)
                     (map (fn [[rule val]] (str (name rule) ":" (escape-val rule val) ";")))
                     (cstr/join "")
                     (#(str "{" % "}")))]
    [static vals idx]))

(defn- ->ks-key [k]
  (cond
    (keyword? k) (name k)
    (number? k) (str k "%")
    (vector? k) (->> k (map ->ks-key) (cstr/join ","))
    :else k))

(defn- build-keyframes [keyframes]
  (let [[ks [statics vals]]
        (->> keyframes
             (reduce
               (fn [[ks [static vals idx]] [k styles]]
                 (let [[s v idx] (keyframes-styles idx styles)]
                   [(conj ks (->ks-key k))
                    [(conj static s) (into vals v) idx]]))
               [[] [[] [] 1]]))]
    [(->> (interleave ks statics)
          (apply str))
     `(cljs.core/array ~@(map (fn [v] `(cljs.core/array ~@v)) vals))]))

(defmacro defkeyframes
  "Takes var name, a vector of arguments and a hash map of CSS keyframes definition.
  Returns a function that calls `cljss.core/css-keyframes` to inject styles at runtime\n
  and returns generated CSS animation name that can be used in CSS `animation` rule.

  (defkeyframes spin [start end]\n    {:from {:transform (str \"rotate(\" start \"deg)\")}\n     :to   {:transform (str \"rotate(\" end \"deg)\")}})

  (defstyled Spinner :div\n    {:animation (str (spin 0 180) \" 1s ease infinite\")})"
  [var args keyframes]
  (let [cls# (var->cls-name var)
        [keyframes# vals#] (build-keyframes keyframes)]
    `(defn ~var ~args
       (cljss.core/css-keyframes ~cls# ~keyframes# ~vals#))))

(defmacro font-face
  "Takes a hash of font descriptors and produces CSS string of @font-face declaration.
  Returns a function that injects styles at runtime."
  [descriptors]
  (let [css# (ff/font-face descriptors)
        cls# (hash css#)]
    `(cljss.core/css ~cls# ~css# [])))

(defmacro inject-global
  "Takes a hash of global styles definitions and produces CSS string.
  Returns a sequence of calls to inject styles at runtime."
  [css]
  (let [css (ig/inject-global css)]
    `(do ~@(->> css (map (fn [[cls# css#]] `(cljss.core/css ~cls# ~css# [])))))))

handle known className attr variants in defstyled


(ns clojars.db
  (:require [cemerick.friend.credentials :as creds]
            [clj-time.coerce :as time.coerce]
            [clj-time.core :as time]
            [clojars.config :refer [config]]
            [clojars.db.sql :as sql]
            [clojars.maven :as mvn]
            [clojure.edn :as edn]
            [clojure.set :as set]
            [clojure.string :as str])
  (:import java.security.SecureRandom
           (java.sql Timestamp)))

(def reserved-names
  #{"clojure" "clojars" "clojar" "register" "login"
    "pages" "logout" "password" "username" "user"
    "repo" "repos" "jar" "jars" "about" "help" "doc"
    "docs" "images" "js" "css" "maven" "api"
    "download" "create" "new" "upload" "contact" "terms"
    "group" "groups" "browse" "status" "blog" "search"
    "email" "welcome" "devel" "development" "test" "testing"
    "prod" "production" "admin" "administrator" "root"
    "webmaster" "profile" "dashboard" "settings" "options"
    "index" "files" "releases" "snapshots"})

(defn get-time []
  (Timestamp. (System/currentTimeMillis)))

(defn bcrypt [s]
  (creds/hash-bcrypt s :work-factor (:bcrypt-work-factor (config))))

(defn find-user [db username]
  (sql/find-user {:username username}
                 {:connection db
                  :result-set-fn first}))

(defn find-user-by-user-or-email [db username-or-email]
  (sql/find-user-by-user-or-email {:username_or_email username-or-email}
                                  {:connection db
                                   :result-set-fn first}))

(defn find-user-by-password-reset-code [db reset-code]
  (sql/find-user-by-password-reset-code {:reset_code reset-code
                                         :reset_code_created_at
                                         (-> 1 time/days time/ago time.coerce/to-sql-date)}
                                        {:connection db
                                         :result-set-fn first}))

(defn find-groupnames [db username]
  (sql/find-groupnames {:username username}
                       {:connection db
                        :row-fn :name}))

(defn group-membernames [db groupname]
  (sql/group-membernames {:groupname groupname}
                         {:connection db
                          :row-fn :user}))

(defn group-adminnames [db groupname]
  (sql/group-adminnames {:groupname groupname}
                         {:connection db
                          :row-fn :user}))

(defn group-activenames [db groupname]
  (sql/group-activenames {:groupname groupname}
                         {:connection db
                          :row-fn :user}))

(defn group-allnames [db groupname]
  (sql/group-actives {:groupname groupname}
                     {:connection db
                      :row-fn :user}))

(defn group-actives [db groupname]
  (sql/group-actives {:groupname groupname}
                     {:connection db}))

(defn jars-by-username [db username]
  (sql/jars-by-username {:username username}
                        {:connection db}))

(defn jars-by-groupname [db groupname]
  (sql/jars-by-groupname {:groupname groupname}
                         {:connection db}))

(defn recent-versions
  ([db groupname jarname]
   (sql/recent-versions {:groupname groupname
                         :jarname jarname}
                        {:connection db
                         :row-fn #(select-keys % [:version])}))
  ([db groupname jarname num]
   (sql/recent-versions-limit {:groupname groupname
                               :jarname jarname
                               :num num}
                              {:connection db
                               :row-fn #(select-keys % [:version])})))

(defn count-versions [db groupname jarname]
  (sql/count-versions {:groupname groupname
                       :jarname jarname}
                      {:connection db
                       :result-set-fn first
                       :row-fn :count}))

(defn max-jars-id
  [db]
  (sql/max-jars-id {} {:connection db
                       :row-fn :max_id
                       :result-set-fn first}))

(defn recent-jars [db]
  (sql/recent-jars {} {:connection db}))

(defn jar-exists [db groupname jarname]
  (sql/jar-exists {:groupname groupname
                   :jarname jarname}
                  {:connection db
                   :result-set-fn first
                   :row-fn :exist}))

(let [read-field (fn [m field] (update m field (fnil edn/read-string "nil")))
      read-edn-fields #(when %
                        (-> %
                            (read-field :licenses)
                            (read-field :scm)))]
  (defn find-jar
    ([db groupname jarname]
     (read-edn-fields
       (sql/find-jar {:groupname groupname
                      :jarname   jarname}
                     {:connection    db
                      :result-set-fn first})))
    ([db groupname jarname version]
     (read-edn-fields
       (sql/find-jar-versioned {:groupname groupname
                                :jarname   jarname
                                :version   version}
                               {:connection    db
                                :result-set-fn first}))))
  (defn all-jars [db]
    (map read-edn-fields
         (sql/all-jars {} {:connection db}))))

(defn find-dependencies
  [db groupname jarname version]
  (sql/find-dependencies {:groupname groupname
                          :jarname   jarname
                          :version   version}
                         {:connection db}))

(defn all-projects [db offset-num limit-num]
  (sql/all-projects {:num limit-num
                     :offset offset-num}
                    {:connection db}))

(defn count-all-projects [db]
  (sql/count-all-projects {}
                          {:connection db
                           :result-set-fn first
                           :row-fn :count}))

(defn count-projects-before [db s]
  (sql/count-projects-before {:s s}
                             {:connection db
                              :result-set-fn first
                              :row-fn :count}))

(defn browse-projects [db current-page per-page]
  (vec
   (map
    #(find-jar db (:group_name %) (:jar_name %))
    (all-projects db
     (* (dec current-page) per-page)
     per-page))))

(defn add-user [db email username password]
  (let [record {:email email, :username username, :password (bcrypt password),
                :created (get-time)}
        groupname (str "org.clojars." username)]
    (sql/insert-user! record
                      {:connection db})
    (sql/add-member! {:groupname groupname
                      :username username
                      :admin true
                      :added_by "clojars"}
                     {:connection db})
    record))

(defn update-user [db account email username password]
  (let [fields {:email email
                :username username
                :account account}]
    (if (empty? password)
      (sql/update-user! fields {:connection db})
      (sql/update-user-with-password!
        (assoc fields :password
               (bcrypt password))
        {:connection db}))
    fields))

(defn reset-user-password [db username reset-code password]
  (assert (not (str/blank? reset-code)))
  (assert (some? username))
  (sql/reset-user-password! {:password (bcrypt password)
                             :reset_code reset-code
                             :username username}
                            {:connection db}))

  ;; Password resets
  ;; Reference:
  ;; https://github.com/xavi/noir-auth-app/blob/master/src/noir_auth_app/models/user.clj
  ;; https://github.com/weavejester/crypto-random/blob/master/src/crypto/random.clj
  ;; https://jira.atlassian.com/browse/CWD-1897?focusedCommentId=196759&page=com.atlassian.jira.plugin.system.issuetabpanels:comment-tabpanel#comment-196759
(defn generate-secure-token [size]
  (let [seed (byte-array size)]
    ;; http://docs.oracle.com/javase/6/docs/api/java/security/SecureRandom.html
    (.nextBytes (SecureRandom/getInstance "SHA1PRNG") seed)
    seed))

(defn hexadecimalize [byte-array]
                                        ; converts byte array to hex string
                                        ; http://stackoverflow.com/a/8015558/974795
  (str/lower-case (apply str (map #(format "%02X" %) byte-array))))

(defn set-password-reset-code! [db username]
  (let [reset-code (hexadecimalize (generate-secure-token 20))]
    (sql/set-password-reset-code! {:reset_code reset-code
                                   :reset_code_created_at (get-time)
                                   :username username}
                                  {:connection db})
    reset-code))

(defn add-member [db groupname username added-by]
  (sql/inactivate-member! {:groupname groupname
                           :username username
                           :inactivated_by added-by}
                          {:connection db})
  (sql/add-member! {:groupname groupname
                    :username username
                    :admin false
                    :added_by added-by}
                   {:connection db}))

(defn add-admin [db groupname username added-by]
  (sql/inactivate-member! {:groupname groupname
                           :username username
                           :inactivated_by added-by}
                          {:connection db})
  (sql/add-member! {:groupname groupname
                    :username username
                    :admin true
                    :added_by added-by}
                   {:connection db}))

(defn inactivate-member [db groupname username inactivated-by]
  (sql/inactivate-member! {:groupname groupname
                           :username username
                           :inactivated_by inactivated-by}
                          {:connection db}))

(defn check-group
  "Throws if the group is invalid or not accessible to the account"
  [actives account groupname]
  (let [err (fn [msg]
              (throw (ex-info msg {:account account
                                   :group groupname})))]
    (when (reserved-names groupname)
      (err (format "The group name '%s' is reserved" groupname)))
    (when (and (seq actives)
            (not (some #{account} actives)))
      (err (format "You don't have access to the '%s' group" groupname)))))

(defn check-and-add-group [db account groupname]
  (let [actives (group-activenames db groupname)]
    (check-group actives account groupname)
    (when (empty? actives)
      (add-admin db groupname account "clojars"))))

(defn add-jar [db account {:keys [group name version description homepage authors packaging licenses scm dependencies]}]
  (check-and-add-group db account group)
  (sql/add-jar! {:groupname   group
                 :jarname     name
                 :version     version
                 :user        account
                 :created     (get-time)
                 :description description
                 :homepage    homepage
                 :packaging   (when packaging (clojure.core/name packaging))
                 :licenses    (when licenses (pr-str licenses))
                 :scm         (when scm (pr-str scm))
                 :authors     (str/join ", " (map #(.replace % "," "")
                                                  authors))}
                {:connection db})
  (when (mvn/snapshot-version? version)
    (sql/delete-dependencies-version!
      {:group_id group
       :jar_id name
       :version version}
      {:connection db}))
  (doseq [dep dependencies]
    (sql/add-dependency! (-> dep
                             (set/rename-keys {:group_name :dep_groupname
                                               :jar_name   :dep_jarname
                                               :version    :dep_version
                                               :scope      :dep_scope})
                             (assoc :groupname group
                                    :jarname   name
                                    :version   version))
                         {:connection db})))

(defn delete-jars [db group-id & [jar-id version]]
  (let [coords {:group_id group-id}]
    (if jar-id
      (let [coords (assoc coords :jar_id jar-id)]
        (if version
          (let [coords' (assoc coords :version version)]
            (sql/delete-jar-version! coords'
                                     {:connection db})
            (sql/delete-dependencies-version! coords'
                                              {:connection db}))
          (do
            (sql/delete-jars! coords
                              {:connection db})
            (sql/delete-dependencies! coords
                                      {:connection db}))))
      (do
        (sql/delete-groups-jars! coords
                                 {:connection db})
        (sql/delete-groups-dependencies! coords
                                         {:connection db})))))

;; does not delete jars in the group. should it?
(defn delete-groups [db group-id]
  (sql/delete-group! {:group_id group-id}
                     {:connection db}))

(defn find-jars-information
  ([db group-id]
   (find-jars-information db group-id nil))
  ([db group-id artifact-id]
   (if artifact-id
     (sql/find-jars-information {:group_id group-id
                                 :artifact_id artifact-id}
                                {:connection db})
     (sql/find-groups-jars-information {:group_id group-id}
                                       {:connection db}))))

(ns clojars.db
  (:require [cemerick.friend.credentials :as creds]
            [clj-time.coerce :as time.coerce]
            [clj-time.core :as time]
            [clojars.config :refer [config]]
            [clojars.db.sql :as sql]
            [clojars.maven :as mvn]
            [clojure.edn :as edn]
            [clojure.set :as set]
            [clojure.string :as str])
  (:import java.security.SecureRandom
           (java.sql Timestamp)))

(def reserved-names
  #{"about"
    "admin"
    "administrator"
    "api"
    "blog"
    "browse"
    "clojar"
    "clojars"
    "clojure"
    "contact"
    "create"
    "css"
    "dashboard"
    "devel"
    "development"
    "doc"
    "docs"
    "download"
    "email"
    "files"
    "group"
    "groups"
    "help"
    "images"
    "index"
    "jar"
    "jars"
    "js"
    "login"
    "logout"
    "maven"
    "new"
    "options"
    "pages"
    "password"
    "prod"
    "production"
    "profile"
    "register"
    "releases"
    "repo"
    "repos"
    "root"
    "search"
    "settings"
    "snapshots"
    "status"
    "terms"
    "test"
    "testing"
    "upload"
    "user"
    "username"
    "webmaster"
    "welcome"})

(defn get-time []
  (Timestamp. (System/currentTimeMillis)))

(defn bcrypt [s]
  (creds/hash-bcrypt s :work-factor (:bcrypt-work-factor (config))))

(defn find-user [db username]
  (sql/find-user {:username username}
                 {:connection db
                  :result-set-fn first}))

(defn find-user-by-user-or-email [db username-or-email]
  (sql/find-user-by-user-or-email {:username_or_email username-or-email}
                                  {:connection db
                                   :result-set-fn first}))

(defn find-user-by-password-reset-code [db reset-code]
  (sql/find-user-by-password-reset-code {:reset_code reset-code
                                         :reset_code_created_at
                                         (-> 1 time/days time/ago time.coerce/to-sql-date)}
                                        {:connection db
                                         :result-set-fn first}))

(defn find-groupnames [db username]
  (sql/find-groupnames {:username username}
                       {:connection db
                        :row-fn :name}))

(defn group-membernames [db groupname]
  (sql/group-membernames {:groupname groupname}
                         {:connection db
                          :row-fn :user}))

(defn group-adminnames [db groupname]
  (sql/group-adminnames {:groupname groupname}
                         {:connection db
                          :row-fn :user}))

(defn group-activenames [db groupname]
  (sql/group-activenames {:groupname groupname}
                         {:connection db
                          :row-fn :user}))

(defn group-allnames [db groupname]
  (sql/group-actives {:groupname groupname}
                     {:connection db
                      :row-fn :user}))

(defn group-actives [db groupname]
  (sql/group-actives {:groupname groupname}
                     {:connection db}))

(defn jars-by-username [db username]
  (sql/jars-by-username {:username username}
                        {:connection db}))

(defn jars-by-groupname [db groupname]
  (sql/jars-by-groupname {:groupname groupname}
                         {:connection db}))

(defn recent-versions
  ([db groupname jarname]
   (sql/recent-versions {:groupname groupname
                         :jarname jarname}
                        {:connection db
                         :row-fn #(select-keys % [:version])}))
  ([db groupname jarname num]
   (sql/recent-versions-limit {:groupname groupname
                               :jarname jarname
                               :num num}
                              {:connection db
                               :row-fn #(select-keys % [:version])})))

(defn count-versions [db groupname jarname]
  (sql/count-versions {:groupname groupname
                       :jarname jarname}
                      {:connection db
                       :result-set-fn first
                       :row-fn :count}))

(defn max-jars-id
  [db]
  (sql/max-jars-id {} {:connection db
                       :row-fn :max_id
                       :result-set-fn first}))

(defn recent-jars [db]
  (sql/recent-jars {} {:connection db}))

(defn jar-exists [db groupname jarname]
  (sql/jar-exists {:groupname groupname
                   :jarname jarname}
                  {:connection db
                   :result-set-fn first
                   :row-fn :exist}))

(let [read-field (fn [m field] (update m field (fnil edn/read-string "nil")))
      read-edn-fields #(when %
                        (-> %
                            (read-field :licenses)
                            (read-field :scm)))]
  (defn find-jar
    ([db groupname jarname]
     (read-edn-fields
       (sql/find-jar {:groupname groupname
                      :jarname   jarname}
                     {:connection    db
                      :result-set-fn first})))
    ([db groupname jarname version]
     (read-edn-fields
       (sql/find-jar-versioned {:groupname groupname
                                :jarname   jarname
                                :version   version}
                               {:connection    db
                                :result-set-fn first}))))
  (defn all-jars [db]
    (map read-edn-fields
         (sql/all-jars {} {:connection db}))))

(defn find-dependencies
  [db groupname jarname version]
  (sql/find-dependencies {:groupname groupname
                          :jarname   jarname
                          :version   version}
                         {:connection db}))

(defn all-projects [db offset-num limit-num]
  (sql/all-projects {:num limit-num
                     :offset offset-num}
                    {:connection db}))

(defn count-all-projects [db]
  (sql/count-all-projects {}
                          {:connection db
                           :result-set-fn first
                           :row-fn :count}))

(defn count-projects-before [db s]
  (sql/count-projects-before {:s s}
                             {:connection db
                              :result-set-fn first
                              :row-fn :count}))

(defn browse-projects [db current-page per-page]
  (vec
   (map
    #(find-jar db (:group_name %) (:jar_name %))
    (all-projects db
     (* (dec current-page) per-page)
     per-page))))

(defn add-user [db email username password]
  (let [record {:email email, :username username, :password (bcrypt password),
                :created (get-time)}
        groupname (str "org.clojars." username)]
    (sql/insert-user! record
                      {:connection db})
    (sql/add-member! {:groupname groupname
                      :username username
                      :admin true
                      :added_by "clojars"}
                     {:connection db})
    record))

(defn update-user [db account email username password]
  (let [fields {:email email
                :username username
                :account account}]
    (if (empty? password)
      (sql/update-user! fields {:connection db})
      (sql/update-user-with-password!
        (assoc fields :password
               (bcrypt password))
        {:connection db}))
    fields))

(defn reset-user-password [db username reset-code password]
  (assert (not (str/blank? reset-code)))
  (assert (some? username))
  (sql/reset-user-password! {:password (bcrypt password)
                             :reset_code reset-code
                             :username username}
                            {:connection db}))

  ;; Password resets
  ;; Reference:
  ;; https://github.com/xavi/noir-auth-app/blob/master/src/noir_auth_app/models/user.clj
  ;; https://github.com/weavejester/crypto-random/blob/master/src/crypto/random.clj
  ;; https://jira.atlassian.com/browse/CWD-1897?focusedCommentId=196759&page=com.atlassian.jira.plugin.system.issuetabpanels:comment-tabpanel#comment-196759
(defn generate-secure-token [size]
  (let [seed (byte-array size)]
    ;; http://docs.oracle.com/javase/6/docs/api/java/security/SecureRandom.html
    (.nextBytes (SecureRandom/getInstance "SHA1PRNG") seed)
    seed))

(defn hexadecimalize [byte-array]
                                        ; converts byte array to hex string
                                        ; http://stackoverflow.com/a/8015558/974795
  (str/lower-case (apply str (map #(format "%02X" %) byte-array))))

(defn set-password-reset-code! [db username]
  (let [reset-code (hexadecimalize (generate-secure-token 20))]
    (sql/set-password-reset-code! {:reset_code reset-code
                                   :reset_code_created_at (get-time)
                                   :username username}
                                  {:connection db})
    reset-code))

(defn add-member [db groupname username added-by]
  (sql/inactivate-member! {:groupname groupname
                           :username username
                           :inactivated_by added-by}
                          {:connection db})
  (sql/add-member! {:groupname groupname
                    :username username
                    :admin false
                    :added_by added-by}
                   {:connection db}))

(defn add-admin [db groupname username added-by]
  (sql/inactivate-member! {:groupname groupname
                           :username username
                           :inactivated_by added-by}
                          {:connection db})
  (sql/add-member! {:groupname groupname
                    :username username
                    :admin true
                    :added_by added-by}
                   {:connection db}))

(defn inactivate-member [db groupname username inactivated-by]
  (sql/inactivate-member! {:groupname groupname
                           :username username
                           :inactivated_by inactivated-by}
                          {:connection db}))

(defn check-group
  "Throws if the group is invalid or not accessible to the account"
  [actives account groupname]
  (let [err (fn [msg]
              (throw (ex-info msg {:account account
                                   :group groupname})))]
    (when (reserved-names groupname)
      (err (format "The group name '%s' is reserved" groupname)))
    (when (and (seq actives)
            (not (some #{account} actives)))
      (err (format "You don't have access to the '%s' group" groupname)))))

(defn check-and-add-group [db account groupname]
  (let [actives (group-activenames db groupname)]
    (check-group actives account groupname)
    (when (empty? actives)
      (add-admin db groupname account "clojars"))))

(defn add-jar [db account {:keys [group name version description homepage authors packaging licenses scm dependencies]}]
  (check-and-add-group db account group)
  (sql/add-jar! {:groupname   group
                 :jarname     name
                 :version     version
                 :user        account
                 :created     (get-time)
                 :description description
                 :homepage    homepage
                 :packaging   (when packaging (clojure.core/name packaging))
                 :licenses    (when licenses (pr-str licenses))
                 :scm         (when scm (pr-str scm))
                 :authors     (str/join ", " (map #(.replace % "," "")
                                                  authors))}
                {:connection db})
  (when (mvn/snapshot-version? version)
    (sql/delete-dependencies-version!
      {:group_id group
       :jar_id name
       :version version}
      {:connection db}))
  (doseq [dep dependencies]
    (sql/add-dependency! (-> dep
                             (set/rename-keys {:group_name :dep_groupname
                                               :jar_name   :dep_jarname
                                               :version    :dep_version
                                               :scope      :dep_scope})
                             (assoc :groupname group
                                    :jarname   name
                                    :version   version))
                         {:connection db})))

(defn delete-jars [db group-id & [jar-id version]]
  (let [coords {:group_id group-id}]
    (if jar-id
      (let [coords (assoc coords :jar_id jar-id)]
        (if version
          (let [coords' (assoc coords :version version)]
            (sql/delete-jar-version! coords'
                                     {:connection db})
            (sql/delete-dependencies-version! coords'
                                              {:connection db}))
          (do
            (sql/delete-jars! coords
                              {:connection db})
            (sql/delete-dependencies! coords
                                      {:connection db}))))
      (do
        (sql/delete-groups-jars! coords
                                 {:connection db})
        (sql/delete-groups-dependencies! coords
                                         {:connection db})))))

;; does not delete jars in the group. should it?
(defn delete-groups [db group-id]
  (sql/delete-group! {:group_id group-id}
                     {:connection db}))

(defn find-jars-information
  ([db group-id]
   (find-jars-information db group-id nil))
  ([db group-id artifact-id]
   (if artifact-id
     (sql/find-jars-information {:group_id group-id
                                 :artifact_id artifact-id}
                                {:connection db})
     (sql/find-groups-jars-information {:group_id group-id}
                                       {:connection db}))))

Sort reserved-names list for easier reading


(ns clucy.core
  (:require [clojure.java.io :as io])
  (:import java.io.File
           java.io.StringReader
           org.apache.lucene.document.Document
           (org.apache.lucene.document Field Field$Store Field$Index)
           (org.apache.lucene.index IndexWriter IndexWriter$MaxFieldLength)
           org.apache.lucene.analysis.standard.StandardAnalyzer
           org.apache.lucene.queryParser.QueryParser
           org.apache.lucene.search.IndexSearcher
           (org.apache.lucene.store RAMDirectory NIOFSDirectory)
           org.apache.lucene.util.Version
           org.apache.lucene.search.BooleanQuery
           org.apache.lucene.search.BooleanClause
           org.apache.lucene.search.BooleanClause$Occur
           org.apache.lucene.search.highlight.QueryScorer
           org.apache.lucene.search.highlight.Highlighter
           org.apache.lucene.search.highlight.SimpleHTMLFormatter
           org.apache.lucene.index.Term
           org.apache.lucene.search.TermQuery))

(def *version*  Version/LUCENE_30)
(def *analyzer* (StandardAnalyzer. *version*))
(def *optimize-frequency* 1)

(defn as-str [x]
  (if (keyword? x)
    (name x)
    (str x)))

(defstruct
    #^{:doc "Structure for clucy indexes."}
    clucy-index :index :optimize-frequency :updates)

;; flag to indicate a default "_content" field should be maintained
(def *content* true)

(defn memory-index
  "Create a new index in RAM."
  []
  (atom (struct-map clucy-index
          :index (RAMDirectory.)
          :optimize-frequency *optimize-frequency*
          :updates 0)))

(defn disk-index
  "Create a new index in a directory on disk."
  [dir-path]
  (atom (struct-map clucy-index
          :index (NIOFSDirectory. (io/file dir-path))
          :optimize-frequency *optimize-frequency*
          :updates 0)))

(defn- index-writer
  "Create an IndexWriter."
  [index]
  (IndexWriter. (:index @index)
                *analyzer*
                IndexWriter$MaxFieldLength/UNLIMITED))

(defn- optimize-index
  "Optimized the provided index if the number of updates matches or
  exceeds the optimize frequency."
  [index]
  (if (<= (:optimize-frequency @index) (:updates @index))
    (with-open [writer (index-writer index)]
      (.optimize writer)
      (swap! index assoc :updates 0))
    index))

(defn- add-field
  "Add a Field to a Document."
  ([document key value]
     (add-field document key value {}))

  ([document key value meta-map]
       (.add document
             (Field. (as-str key) (as-str value)
                     (if (and meta-map (= false (:stored meta-map)))
                       Field$Store/NO
                       Field$Store/YES)
                     (if (and meta-map (= false (:indexed meta-map)))
                       Field$Index/NO
                       Field$Index/ANALYZED)))))

(defn- map-stored
  "Returns a hash-map containing all of the values in the map that
  will be stored in the search index."
  [map-in]
  (merge {}
         (filter (complement nil?)
                 (map (fn [item]
                        (if (or (= nil (meta map-in))
                                (not= false
                                      (:stored ((first item) (meta map-in)))))
                          item)) map-in))))

(defn- concat-values
  "Concatenate all the maps values being stored into a single string."
  [map-in]
  (apply str (interpose " " (vals (map-stored map-in)))))

(defn- map->document
  "Create a Document from a map."
  [map]
  (let [document (Document.)]
    (doseq [[key value] map]
      (add-field document key value (key (meta map))))
    (if *content*
      (add-field document :_content (concat-values map)))
    document))

(defn add
  "Add hash-maps to the search index."
  [index & maps]
  (with-open [writer (index-writer index)]
    (doseq [m maps]
      (swap! index assoc :updates (inc (:updates @index)))
      (.addDocument writer (map->document m))))
  (optimize-index index))

(defn delete
  "Deletes hash-maps from the search index."
  [index & maps]
  (with-open [writer (index-writer index)]
    (doseq [m maps]
      (let [query (BooleanQuery.)]
        (doseq [[key value] m]
          (.add query
                (BooleanClause.
                 (TermQuery. (Term. (.toLowerCase (as-str key))
                                    (.toLowerCase (as-str value))))
                 BooleanClause$Occur/MUST)))
        (.deleteDocuments writer query))
      (swap! index assoc :updates (inc (:updates @index)))))
  (optimize-index index))

(defn- document->map
  "Turn a Document object into a map."
  [document]
  (with-meta
    (-> (into {}
              (for [f (.getFields document)]
                [(keyword (.name f)) (.stringValue f)]))
        (dissoc :_content))
    (-> (into {}
              (for [f (.getFields document)]
                [(keyword (.name f))
                 {:indexed (.isIndexed f)
                  :stored (.isStored f)
                  :tokenized (.isTokenized f)}]))
        (dissoc :_content))))

(defn- make-highlighter
  "Create a highlighter function which will take a map and return the map with
highlighted results appended. Highlighting is configured by passing the config
map."
  [query searcher config]
  (if config
    (let [indexReader (.getIndexReader searcher)
          scorer (QueryScorer. (.rewrite query indexReader))
          config (merge {:max-fragments 5
                         :separator "..."
                         :fragments-key :fragments
                         :pre "<b>"
                         :post "</b>"}
                        config)
          {:keys [field max-fragments separator fragments-key pre post]} config
          highlighter (Highlighter. (SimpleHTMLFormatter. pre post) scorer)]
      (fn [m]
        (let [str (field m)
              token-stream (.tokenStream *analyzer*
                                         (name field)
                                         (StringReader. str))
              best-fragments (.getBestFragments highlighter
                                                token-stream
                                                str
                                                max-fragments
                                                separator)]
          (assoc m fragments-key best-fragments))))
    identity))

(defn search
  "Search the supplied index with a query string."
  [index query max-results & {:keys [highlight default-field]}]
  (if (every? false? [default-field *content*])
    (throw (Exception. "No default search field specified"))
    (let [default-field (or default-field :_content)]
      (with-open [searcher (IndexSearcher. (:index @index))]
        (let [parser (QueryParser. *version* (as-str default-field) *analyzer*)
              query  (.parse parser query)
              hits   (.search searcher query max-results)
              highlighter (make-highlighter query searcher highlight)]
          (doall
           (for [hit (.scoreDocs hits)]
             (highlighter (document->map (.doc searcher (.doc hit)))))))))))

(defn search-and-delete
  "Search the supplied index with a query string and then delete all
of the results."
  ([index query]
     (if *content*
       (search-and-delete index query :_content)
       (throw (Exception. "No default search field specified"))))
  ([index query default-field]
    (with-open [writer (index-writer index)]
      (let [parser (QueryParser. *version* (as-str default-field) *analyzer*)
            query  (.parse parser query)]
        (.deleteDocuments writer query)
        (swap! index assoc :updates (inc (:updates @index)))))
    (optimize-index index)))

(ns clucy.core
  (:require [clojure.java.io :as io])
  (:import java.io.File
           java.io.StringReader
           org.apache.lucene.document.Document
           (org.apache.lucene.document Field Field$Store Field$Index)
           (org.apache.lucene.index IndexWriter IndexWriter$MaxFieldLength)
           org.apache.lucene.analysis.standard.StandardAnalyzer
           org.apache.lucene.queryParser.QueryParser
           org.apache.lucene.search.IndexSearcher
           (org.apache.lucene.store RAMDirectory NIOFSDirectory)
           org.apache.lucene.util.Version
           org.apache.lucene.search.BooleanQuery
           org.apache.lucene.search.BooleanClause
           org.apache.lucene.search.BooleanClause$Occur
           org.apache.lucene.search.highlight.QueryScorer
           org.apache.lucene.search.highlight.Highlighter
           org.apache.lucene.search.highlight.SimpleHTMLFormatter
           org.apache.lucene.index.Term
           org.apache.lucene.search.TermQuery))

(def *version*  Version/LUCENE_30)
(def *analyzer* (StandardAnalyzer. *version*))
(def *optimize-frequency* 1)

(defn as-str [x]
  (if (keyword? x)
    (name x)
    (str x)))

(defstruct
    #^{:doc "Structure for clucy indexes."}
    clucy-index :index :optimize-frequency :updates)

;; flag to indicate a default "_content" field should be maintained
(def *content* true)

(defn memory-index
  "Create a new index in RAM."
  []
  (atom (struct-map clucy-index
          :index (RAMDirectory.)
          :optimize-frequency *optimize-frequency*
          :updates 0)))

(defn disk-index
  "Create a new index in a directory on disk."
  [dir-path]
  (atom (struct-map clucy-index
          :index (NIOFSDirectory. (io/file dir-path))
          :optimize-frequency *optimize-frequency*
          :updates 0)))

(defn- index-writer
  "Create an IndexWriter."
  [index]
  (IndexWriter. (:index @index)
                *analyzer*
                IndexWriter$MaxFieldLength/UNLIMITED))

(defn- optimize-index
  "Optimized the provided index if the number of updates matches or
  exceeds the optimize frequency."
  [index]
  (if (<= (:optimize-frequency @index) (:updates @index))
    (with-open [writer (index-writer index)]
      (.optimize writer)
      (swap! index assoc :updates 0))
    index))

(defn- add-field
  "Add a Field to a Document."
  ([document key value]
     (add-field document key value {}))

  ([document key value meta-map]
       (.add document
             (Field. (as-str key) (as-str value)
                     (if (and meta-map (= false (:stored meta-map)))
                       Field$Store/NO
                       Field$Store/YES)
                     (if (and meta-map (= false (:indexed meta-map)))
                       Field$Index/NO
                       Field$Index/ANALYZED)))))

(defn- map-stored
  "Returns a hash-map containing all of the values in the map that
  will be stored in the search index."
  [map-in]
  (merge {}
         (filter (complement nil?)
                 (map (fn [item]
                        (if (or (= nil (meta map-in))
                                (not= false
                                      (:stored ((first item) (meta map-in)))))
                          item)) map-in))))

(defn- concat-values
  "Concatenate all the maps values being stored into a single string."
  [map-in]
  (apply str (interpose " " (vals (map-stored map-in)))))

(defn- map->document
  "Create a Document from a map."
  [map]
  (let [document (Document.)]
    (doseq [[key value] map]
      (add-field document key value (key (meta map))))
    (if *content*
      (add-field document :_content (concat-values map)))
    document))

(defn add
  "Add hash-maps to the search index."
  [index & maps]
  (with-open [writer (index-writer index)]
    (doseq [m maps]
      (swap! index assoc :updates (inc (:updates @index)))
      (.addDocument writer (map->document m))))
  (optimize-index index))

(defn delete
  "Deletes hash-maps from the search index."
  [index & maps]
  (with-open [writer (index-writer index)]
    (doseq [m maps]
      (let [query (BooleanQuery.)]
        (doseq [[key value] m]
          (.add query
                (BooleanClause.
                 (TermQuery. (Term. (.toLowerCase (as-str key))
                                    (.toLowerCase (as-str value))))
                 BooleanClause$Occur/MUST)))
        (.deleteDocuments writer query))
      (swap! index assoc :updates (inc (:updates @index)))))
  (optimize-index index))

(defn- document->map
  "Turn a Document object into a map."
  ([document]
     (document->map document identity))
  ([document highlighter]
     (with-meta
       (-> (into {}
                 (for [f (.getFields document)]
                   [(keyword (.name f)) (.stringValue f)]))
           highlighter
           (dissoc :_content))
       (-> (into {}
                 (for [f (.getFields document)]
                   [(keyword (.name f))
                    {:indexed (.isIndexed f)
                     :stored (.isStored f)
                     :tokenized (.isTokenized f)}]))
           (dissoc :_content)))))

(defn- make-highlighter
  "Create a highlighter function which will take a map and return the map with
highlighted results appended."
  [query searcher config]
  (if config
    (let [indexReader (.getIndexReader searcher)
          scorer (QueryScorer. (.rewrite query indexReader))
          config (merge {:max-fragments 5
                         :separator "..."
                         :fragments-key :fragments
                         :pre "<b>"
                         :post "</b>"}
                        config)
          {:keys [field max-fragments separator fragments-key pre post]} config
          highlighter (Highlighter. (SimpleHTMLFormatter. pre post) scorer)]
      (fn [m]
        (let [str (field m)
              token-stream (.tokenStream *analyzer*
                                         (name field)
                                         (StringReader. str))
              best-fragments (.getBestFragments highlighter
                                                token-stream
                                                str
                                                max-fragments
                                                separator)]
          (assoc m fragments-key best-fragments))))
    identity))

(defn search
  "Search the supplied index with a query string."
  [index query max-results & {:keys [highlight default-field]}]
  (if (every? false? [default-field *content*])
    (throw (Exception. "No default search field specified"))
    (let [default-field (or default-field :_content)]
      (with-open [searcher (IndexSearcher. (:index @index))]
        (let [parser (QueryParser. *version* (as-str default-field) *analyzer*)
              query  (.parse parser query)
              hits   (.search searcher query max-results)
              highlighter (make-highlighter query searcher highlight)]
          (doall
           (for [hit (.scoreDocs hits)]
             (document->map (.doc searcher (.doc hit)) highlighter))))))))

(defn search-and-delete
  "Search the supplied index with a query string and then delete all
of the results."
  ([index query]
     (if *content*
       (search-and-delete index query :_content)
       (throw (Exception. "No default search field specified"))))
  ([index query default-field]
    (with-open [writer (index-writer index)]
      (let [parser (QueryParser. *version* (as-str default-field) *analyzer*)
            query  (.parse parser query)]
        (.deleteDocuments writer query)
        (swap! index assoc :updates (inc (:updates @index)))))
    (optimize-index index)))

Move highlighting so that the :_content field can be highlighted.


(ns frontend.proxy
  (:require [clojure.string :as string]
            [org.httpkit.server :refer [with-channel send!]]
            [org.httpkit.client :refer [request]]))

(defn query-string-with-om-build-id [req]
  (cond
    (:query-string req) (str "?om-build-id=dev&" (:query-string req))
    (= :get (:request-method req)) "?om-build-id=dev"
    :else nil))

(defn proxy-request [req {:keys [backend-lookup-fn] :as options}]
  (let [backend (backend-lookup-fn req)]
    (assert backend)
    {:url (str (:proto backend) "://"
               (:host backend)
               (:uri req)
               (query-string-with-om-build-id req))
     :timeout 120000 ;ms
     :method (:request-method req)
     :headers (assoc (:headers req)
                     "host" (:host backend)
                     "x-circleci-assets-proto" "https"
                     "x-circleci-assets-host" (get-in req [:headers "host"]))
     :body (:body req)
     :follow-redirects false}))

(defn rewrite-error [{:keys [error] :as response}]
  {:status 503
   :headers {"Content-Type" "text/plain"}
   :body (str "Cannot access backend\n" error)})

(defn strip-secure-cookie [header-val]
  (cond (string? header-val) (string/replace header-val #";(\s)*Secure" "")
        (coll? header-val) (map strip-secure-cookie header-val)))

(defn strip-secure [headers]
  (if (headers "set-cookie")
    (update-in headers ["set-cookie"] strip-secure-cookie)
    headers))

(defn rewrite-success
  "Patches up the proxied response with some ugly hacks. Documented within."
  [{:keys [status headers body] :as response}]
  (let [headers (-> (zipmap (map name (keys headers)) (vals headers))
                    ;; httpkit will decode the body, so hide the
                    ;; fact that the backend was gzipped.
                    (dissoc "content-encoding")
                    ;; avoid setting two Dates!  httpkit here will insert another Date
                    (dissoc "date")
                    ;; The production server insists on secure cookies, but
                    ;; the development proxy does not support SSL.
                    strip-secure
                    ;; Silence pagespeed warnings
                    (assoc "Vary" "Accept-Encoding"))]

    {:status status
     :headers headers
     :body body}))

(defn wrap-handler [handler options]
  (fn [req]
    (or (when (and (contains? #{:get :head} (:request-method req))
                   (nil? (:body req)))
          ;; local frontend doesn't really handle POSTs and avoid consuming request body
          (let [local-response (handler req)]
            (when (not= 404 (:status local-response))
              local-response)))
        (with-channel req channel
          (request (proxy-request req options)
                   (fn [response]
                     (let [rewrite (if (:error response) rewrite-error rewrite-success)]
                       (send! channel (rewrite response)))))))))

(ns frontend.proxy
  (:require [clojure.string :as string]
            [org.httpkit.server :refer [with-channel send!]]
            [org.httpkit.client :refer [request]]))

(defn query-string-with-om-build-id [req]
  (cond
    (:query-string req) (str "?om-build-id=dev&" (:query-string req))
    (= :get (:request-method req)) "?om-build-id=dev"
    :else nil))

(defn proxy-request [req {:keys [backend-lookup-fn] :as options}]
  (let [backend (backend-lookup-fn req)]
    (assert backend)
    {:url (str (:proto backend) "://"
               (:host backend)
               (:uri req)
               (query-string-with-om-build-id req))
     :timeout 120000 ;ms
     :method (:request-method req)
     :headers (assoc (:headers req)
                     "host" (:host backend)
                     "x-circleci-assets-proto" "https"
                     "x-circleci-assets-host" (get-in req [:headers "host"]))
     :body (:body req)
     :follow-redirects false}))

(defn rewrite-error [{:keys [error] :as response}]
  {:status 503
   :headers {"Content-Type" "text/plain"}
   :body (str "Cannot access backend\n" error)})

(defn strip-secure-cookie [header-val]
  (cond (string? header-val) (string/replace header-val #";(\s)*Secure" "")
        (coll? header-val) (map strip-secure-cookie header-val)))

(defn strip-secure [headers]
  (if (headers "set-cookie")
    (update-in headers ["set-cookie"] strip-secure-cookie)
    headers))

(defn rewrite-success
  "Patches up the proxied response with some ugly hacks. Documented within."
  [{:keys [status headers body] :as response}]
  (let [headers (-> (zipmap (map name (keys headers)) (vals headers))
                    ;; httpkit will decode the body, so hide the
                    ;; fact that the backend was gzipped.
                    (dissoc "content-encoding")
                    ;; avoid setting two Dates!  httpkit here will insert another Date
                    (dissoc "date")
                    ;; The production server insists on secure cookies, but
                    ;; the development proxy does not support SSL.
                    strip-secure
                    ;; Silence pagespeed warnings
                    (assoc "Vary" "Accept-Encoding"))]

    {:status status
     :headers headers
     :body body}))

;; When developing a new page, the URL may not be recognized by the backend yet.
;; That makes it impossible to develop against production. When that happens,
;; add the URL (path) to this set (eg, "/projects"). The proxy will fetch
;; /dashboard from the backend instead, which will load the frontend app.
;; Meanwhile, the browser will see your new URL, so the frontend will dispatch
;; on that.
;;
;; This is for development only. Do not commit code with values in this set.
;; Instead, add the route to the backend. (And while you're there, add it to the
;; nginx config if necessary.)
(def new-urls #{})

(defn with-new-url-mapping [handler]
  (fn [req]
    (handler (cond-> req
               (contains? new-urls (:uri req))
               (assoc :uri "/dashboard")))))

(defn with-proxy [handler options]
  (fn [req]
    (or (when (and (contains? #{:get :head} (:request-method req))
                   (nil? (:body req)))
          ;; local frontend doesn't really handle POSTs and avoid consuming request body
          (let [local-response (handler req)]
            (when (not= 404 (:status local-response))
              local-response)))
        (with-channel req channel
          (request (proxy-request req options)
                   (fn [response]
                     (let [rewrite (if (:error response) rewrite-error rewrite-success)]
                       (send! channel (rewrite response)))))))))

(defn wrap-handler [handler options]
  (-> handler
      (with-proxy options)
      with-new-url-mapping))

Add dev-time middleware for new URLs

Add dev-time middleware for new URLs


(ns gol.styles
  (:require [garden.def :refer [defstyles]]
            [garden.def :refer [defrule defkeyframes]]
            [garden.units :refer [px percent s]]
            [garden.color :refer [hex->rgb rgba rgb]]
  )
)

(def cell-size 12)

(defstyles styles
  [:html {
    :height (percent 100) }]

  [:body {
    :display "table"
    :min-width (px 980)
    :width (percent 100)
    :height (percent 100)
    :margin 0
    :background-color (hex->rgb "#fdfdfd") }]

  [:#app {
    :display "table-cell"
    :vertical-align "middle"
    :text-align "center" }]

  [:.cell-area {
    :display "inline-block"
    :margin 0
    :padding [[(px 1) (px 1) 0 0]]
    :list-style "none"
    :font-size 0
    :line-height 0 }

    [:&:hover
      [:b {:border-color (hex->rgb "#ccc")}] ]

    [:b {
      :display "inline-block"
      :width (px cell-size)
      :height (px cell-size)
      :padding (px 1)
      :margin [[(px -1) 0 0 (px -1)]]
      :border [[(px 1) "dotted" "transparent"]]
      :vertical-align "top"
      :white-space "nowrap" }

      [:i {
        :position "relative"
        :display "block"
        :width (percent 100)
        :height (percent 100)
        :border [[(px 2) "dashed" (hex->rgb "#90E9FF")]]
        :background-color (hex->rgb "#B2F3FF") }

        [:& ^:prefix {
          :border-radius (percent 50)
          :box-shadow [[0 0 (px 10) (rgba 0 0 0 0.2)]] }]

        [:&:after {
          :position "absolute"
          :top (percent 50)
          :left (percent 50)
          :width (percent 15)
          :height (percent 15)
          :background-color (hex->rgb "#00D7FF")
          :content "\"\""}
          [:& ^:prefix {
            :border-radius (percent 50)
            :box-shadow [[0 0 (px 3) (rgba 0 0 0 0.5)]] }] ]]]]
)

(ns gol.styles
  (:require [garden.def :refer [defstyles]]
            [garden.def :refer [defrule defkeyframes]]
            [garden.units :refer [px percent s]]
            [garden.color :refer [hex->rgb rgba rgb]]))

(def cell-size 20)

(defstyles styles
  [:#app {
    :display "table-cell"
    :vertical-align "middle"
    :text-align "center" }]

  [:.cell-area {
    :display "inline-block"
    :margin 0
    :padding [[(px 1) (px 1) 0 0]]
    :list-style "none"
    :font-size 0
    :line-height 0 }

    [:&:hover
      [:b {:border-color (hex->rgb "#ccc")}] ]

    [:b {
      :display "inline-block"
      :width (px cell-size)
      :height (px cell-size)
      :padding (px 1)
      :margin [[(px -1) 0 0 (px -1)]]
      :border [[(px 1) "dotted" "transparent"]]
      :vertical-align "top"
      :white-space "nowrap" }

      [:i {
        :position "relative"
        :display "block"
        :width (percent 100)
        :height (percent 100)
        :border [[(px 2) "dashed" (hex->rgb "#90E9FF")]]
        :background-color (hex->rgb "#B2F3FF") }

        [:& ^:prefix {
          :border-radius (percent 50)
          :box-shadow [[0 0 (px 10) (rgba 0 0 0 0.2)]] }]

        [:&:after {
          :position "absolute"
          :top (percent 50)
          :left (percent 50)
          :width (percent 15)
          :height (percent 15)
          :background-color (hex->rgb "#00D7FF")
          :content "\"\""}
          [:& ^:prefix {
            :border-radius (percent 50)
            :box-shadow [[0 0 (px 3) (rgba 0 0 0 0.5)]] }] ]]]])

Change cell size, remove top level styles