(ns leiningen.jupyter.kernel
  (:require [cheshire.core :as cheshire]
            [leiningen.core.main]
            [leiningen.core.eval :as eval]
            [clojure.string :refer [lower-case includes?]]
            [clojure.java.io :as io]))

(defn run-kernel [project argv]
  (let [curr-deps (or (:dependencies project) [])
        new-deps (conj curr-deps ['clojupyter "0.1.0"])
        prj (assoc project :dependencies new-deps)]
    (eval/eval-in-project prj
                          (conj (list argv) `clojupyter.core/-main)
                          '(require 'clojupyter.core))))

(def python-kernel-script (-> "leinclojure.py" io/resource slurp))

(defn get-os []
  (let [os-name (-> "os.name" System/getProperty clojure.string/lower-case)]
       (cond
         (includes? os-name "mac") :mac
         (includes? os-name "win") :windows
         (includes? os-name "linux") :linux)))

(defn get-kernel-dir
  "Returns the directory where the kernel should be installed given the os"
  [os]
  (let [home (System/getenv "HOME")
        appdata (System/getenv "APPDATA")]
    (case os
      :mac (io/file home "Library/Jupyter/kernels/lein-clojure")
      :linux (io/file home ".local/share/jupyter/kernels/lein-clojure")
      :windows (io/file appdata "jupyter/kernels/lein-clojure"))))

(defn get-kernel-json [kernel-script-filename]
  (cheshire/generate-string {:display_name "Lein-Clojure"
                             :language "clojure"
                             :argv ["python3" (str kernel-script-filename) "{connection_file}"]}))

(defn create-kernel [kernel-dir]
  (let [kernel-json (io/file kernel-dir "kernel.json")
        kernel-script (io/file kernel-dir "leinclojure.py")]
    (io/make-parents kernel-json)
    (io/make-parents kernel-script)
    (spit (str kernel-json) (get-kernel-json kernel-script))
    (spit (str kernel-script) python-kernel-script)))

(defn install-kernel-on-linux []
  (let [kernel-dir (get-kernel-dir :linux)]
    (create-kernel kernel-dir)))

(defn install-kernel-on-mac []
  (let [kernel-dir (get-kernel-dir :mac)]
    (create-kernel kernel-dir)))

(defn install-kernel-on-windows []
  (let [kernel-dir (get-kernel-dir :windows)]
    (create-kernel kernel-dir)))

(def architecture-not-yet-supported "You system is not supported by lein jupyter.
the current supported systems are Linux Mac and Windows (In that order).")

(defn install-kernel
  "Install the lein-clojure kernel using the specifications at
  http://jupyter-client.readthedocs.io/en/latest/kernels.html"
  [& args]
  (case (get-os)
    :mac (install-kernel-on-mac)
    :linux (install-kernel-on-linux)
    :windows (install-kernel-on-windows)
    (leiningen.core.main/warn architecture-not-yet-supported)))

(defn kernel-installed?
  "return true is it is sensible to believe that kernel has properly been installed"
  []
  (let [kernel-dir (get-kernel-dir (get-os))]
    (.exists kernel-dir)))

(ns leiningen.jupyter.kernel
  (:require [cheshire.core :as cheshire]
            [leiningen.core.main]
            [leiningen.core.eval :as eval]
            [clojure.string :refer [lower-case includes?]]
            [clojure.java.io :as io]))

(defn run-kernel [project argv]
  (let [curr-deps (or (:dependencies project) [])
        new-deps (conj curr-deps ['org.clojars.didiercrunch/clojupyter "0.1.0"])
        prj (assoc project :dependencies new-deps)]
    (eval/eval-in-project prj
                          (conj (list argv) `clojupyter.core/-main)
                          '(require 'clojupyter.core))))

(def python-kernel-script (-> "leinclojure.py" io/resource slurp))

(defn get-os []
  (let [os-name (-> "os.name" System/getProperty clojure.string/lower-case)]
       (cond
         (includes? os-name "mac") :mac
         (includes? os-name "win") :windows
         (includes? os-name "linux") :linux)))

(defn get-kernel-dir
  "Returns the directory where the kernel should be installed given the os"
  [os]
  (let [home (System/getenv "HOME")
        appdata (System/getenv "APPDATA")]
    (case os
      :mac (io/file home "Library/Jupyter/kernels/lein-clojure")
      :linux (io/file home ".local/share/jupyter/kernels/lein-clojure")
      :windows (io/file appdata "jupyter/kernels/lein-clojure"))))

(defn get-kernel-json [kernel-script-filename]
  (cheshire/generate-string {:display_name "Lein-Clojure"
                             :language "clojure"
                             :argv ["python3" (str kernel-script-filename) "{connection_file}"]}))

(defn create-kernel [kernel-dir]
  (let [kernel-json (io/file kernel-dir "kernel.json")
        kernel-script (io/file kernel-dir "leinclojure.py")]
    (io/make-parents kernel-json)
    (io/make-parents kernel-script)
    (spit (str kernel-json) (get-kernel-json kernel-script))
    (spit (str kernel-script) python-kernel-script)))

(defn install-kernel-on-linux []
  (let [kernel-dir (get-kernel-dir :linux)]
    (create-kernel kernel-dir)))

(defn install-kernel-on-mac []
  (let [kernel-dir (get-kernel-dir :mac)]
    (create-kernel kernel-dir)))

(defn install-kernel-on-windows []
  (let [kernel-dir (get-kernel-dir :windows)]
    (create-kernel kernel-dir)))

(def architecture-not-yet-supported "You system is not supported by lein jupyter.
the current supported systems are Linux Mac and Windows (In that order).")

(defn install-kernel
  "Install the lein-clojure kernel using the specifications at
  http://jupyter-client.readthedocs.io/en/latest/kernels.html"
  [& args]
  (case (get-os)
    :mac (install-kernel-on-mac)
    :linux (install-kernel-on-linux)
    :windows (install-kernel-on-windows)
    (leiningen.core.main/warn architecture-not-yet-supported)))

(defn kernel-installed?
  "return true is it is sensible to believe that kernel has properly been installed"
  []
  (let [kernel-dir (get-kernel-dir (get-os))]
    (.exists kernel-dir)))

tweak to match the clojars namespace

tweak to match the clojars namespace


(ns poehub.dat-test
  (:require [clojure.test :refer :all]
            [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [poehub.dat :refer :all]))

(def test-file (.getPath (io/resource "Characters.dat")))

(def expected {"Unknown28" 77 "BaseStrength" 32 "BaseIntelligence" 14 "Unknown17" 2 "Unknown18" "Audio/Dialogue/Character/Str/Intro/Ma_01_Intro.ogg" "Unknown15" 6 "Row" 0 "Unknown27" 0 "Actor" "Metadata/Characters/Str/Str.act" "BaseMaxLife" 50 "BaseDexterity" 14 "Unknown16" 1 "Data0" '(3927) "Unknown14" 0 "Description" "I am a warrior, raised to honour my Ancestors, to die with a weapon in my hand and the Karui Way in my blood. \r\n\r\nOriath chained me, made me its slave. For three years I have lived without my family, my pride, my Way. \r\n\r\nI welcome Exile. I welcome Wraeclast. Hear me, Ancestors! A slave stands behind you. A warrior stands before you. \r\n\r\nAnd Death walks at our side." "Unknown11" 1341 "AnimatedObject" "Metadata/Characters/Str/Str.ao" "Icon" "" "BaseMaxMana" 40 "Unknown12" 0 "Name" "Marauder" "MinDamage" 2 "WeaponSpeed" 833 "MaxDamage" 8 "MaxAttackDistance" 4 "Id" "Metadata/Characters/Str/Str" "Unknown13" 0 "Unknown26" 590 "Unknown6" 1})

(deftest can-parse
  (let [parsed (first (parse test-file))]
    (log/info parsed)
    (is (= expected
           parsed))))

(deftest can-bytes-to-uint-le
  (is (= 352 (bytes-to-uint-le (into-array Byte/TYPE '(96 01 00 00))))))

(ns poehub.dat-test
  (:require [clojure.test :refer :all]
            [clojure.java.io :as io]
            [clojure.tools.logging :as log]
            [poehub.dat :refer :all]))

(def test-file (.getPath (io/resource "Characters.dat")))

(def expected {"Unknown13" 0, "BaseMaxLife" 50, "ACTFile" "Metadata/Characters/Str/Str.act", "StartWeapon_BaseItemTypesKey" 590, "BaseMaxMana" 40, "Unknown6" 1, "AOFile" "Metadata/Characters/Str/Str.ao", "IntroSoundFile" "Audio/Dialogue/Character/Str/Intro/Ma_01_Intro.ogg", "Unknown15" 6, "Row" 0, "Icon" "", "Keys0" '(3927), "Description" "I am a warrior, raised to honour my Ancestors, to die with a weapon in my hand and the Karui Way in my blood. \r\n\r\nOriath chained me, made me its slave. For three years I have lived without my family, my pride, my Way. \r\n\r\nI welcome Exile. I welcome Wraeclast. Hear me, Ancestors! A slave stands behind you. A warrior stands before you. \r\n\r\nAnd Death walks at our side.", "MinDamage" 2, "CharacterSize" 2, "BaseDexterity" 14, "Unknown28" 77, "WeaponSpeed" 833, "StartSkillGem_BaseItemTypesKey" 1341, "BaseIntelligence" 14, "Unknown16" 1, "Name" "Marauder", "BaseStrength" 32, "MaxAttackDistance" 4, "MaxDamage" 8, "Id" "Metadata/Characters/Str/Str", "Unknown14" 0})

(deftest can-parse
  (let [parsed (first (parse test-file))]
    (log/info parsed)
    (is (= expected
           parsed))))

(deftest can-bytes-to-uint-le
  (is (= 352 (bytes-to-uint-le (into-array Byte/TYPE '(96 01 00 00))))))

Fix tests

Fix tests


(ns ^:no-doc onyx.messaging.aeron.peer-manager
  "Fast way for peer group subscribers to multiplex via a short id to peer channels. "
  (:refer-clojure :exclude [assoc dissoc])
  (:require [taoensso.timbre :refer [fatal info] :as timbre])
  (:import [uk.co.real_logic.agrona.collections Int2ObjectHashMap Int2ObjectHashMap$EntryIterator]))

(defrecord PeerChannels [acking-ch inbound-ch release-ch retry-ch])

;; Note, slow to assoc/dissoc to as it clones with a lock on it.
;; Very fast to get from via peer-channels function - which is the main case, as dissoc/assoc
;; only occurs when peers join/leave
(defprotocol PeerManager
  (clone [this])
  (assoc [this k v])
  (dissoc [this k])
  (peer-channels [this k]))

(deftype VPeerManager [^Int2ObjectHashMap m]
  PeerManager
  (assoc [this k v]
    (let [vp ^VPeerManager (clone this)]
      (.put ^Int2ObjectHashMap (.m vp) (int k) ^PeerChannels v)
      vp))
  (dissoc [this k]
    (let [vp ^VPeerManager (clone this)]
      (.remove ^Int2ObjectHashMap (.m vp) (int k))
      vp))
  (peer-channels [this k]
    (.get m (int k)))
  (clone [this]
    ;; Unsure why a lock is needed, however concurrency bugs have shown up
    ;; Look into this later. Clone is a very infrequent operation
    (locking this
      (VPeerManager.
        (let [iterator (.iterator (.entrySet (.m this)))
              new-hm ^Int2ObjectHashMap (Int2ObjectHashMap.)]
          (while (.hasNext iterator)
            (let [kv ^Int2ObjectHashMap$EntryIterator (.next iterator)
                  k ^java.lang.Integer (.getKey kv)
                  v ^PeerChannels (.getValue kv)]
              (.put new-hm k v)))
          new-hm)))))

(defn vpeer-manager []
  (VPeerManager. (Int2ObjectHashMap.)))

(ns ^:no-doc onyx.messaging.aeron.peer-manager
  "Fast way for peer group subscribers to multiplex via a short id to peer channels. "
  (:refer-clojure :exclude [assoc dissoc])
  (:require [taoensso.timbre :refer [fatal info] :as timbre])
  (:import [uk.co.real_logic.agrona.collections Int2ObjectHashMap Int2ObjectHashMap$EntryIterator]))

(defrecord PeerChannels [acking-ch inbound-ch release-ch retry-ch])

;; Note, slow to assoc/dissoc to as it clones with a lock on it.
;; Very fast to get from via peer-channels function - which is the main case, as dissoc/assoc
;; only occurs when peers join/leave
(defprotocol PeerManager
  (clone [this])
  (assoc [this k v])
  (dissoc [this k])
  (peer-channels [this k]))

(deftype VPeerManager [^Int2ObjectHashMap m]
  PeerManager
  (assoc [this k v]
    (let [vp ^VPeerManager (clone this)]
      (.put ^Int2ObjectHashMap (.m vp) (int k) ^PeerChannels v)
      vp))
  (dissoc [this k]
    (let [vp ^VPeerManager (clone this)]
      (.remove ^Int2ObjectHashMap (.m vp) (int k))
      vp))
  (peer-channels [this k]
    (.get m (int k)))
  (clone [this]
    ;; Needs to be locked because we're using a deftype, not defrecord
    (locking this
      (VPeerManager.
        (let [iterator (.iterator (.entrySet (.m this)))
              new-hm ^Int2ObjectHashMap (Int2ObjectHashMap.)]
          (while (.hasNext iterator)
            (let [kv ^Int2ObjectHashMap$EntryIterator (.next iterator)
                  k ^java.lang.Integer (.getKey kv)
                  v ^PeerChannels (.getValue kv)]
              (.put new-hm k v)))
          new-hm)))))

(defn vpeer-manager []
  (VPeerManager. (Int2ObjectHashMap.)))

Improve comment on why lock is needed.

Improve comment on why lock is needed.


(ns mvMusic.file-ops
  (:use [mvMusic.global])
  (:require [clojure.java.io :as io]
            [clojure.string :as string]))

(def path-delimiter "<")
(def space-replacement " ")
(def dot-replacement ">")

(defn get-name [x]
  (.getName x))
(defn get-path [x]
  (.getPath x))

(defn pair-name-path [x]
  [(get-name x) (get-path x)])

(defn list-directories
  "return sorted a vector containing the filename and path of each direct
  non-hidden child directory of file"
  [file]
  (vec (->> (apply vector (.listFiles file))
            (filter #(and (not (.isHidden %1)) (.isDirectory %1)))
            (map pair-name-path))))

(defn list-files
  "return a vector containing the filename and path of each non-hidden file
  which is a direct child of the file"
  [file]
  (vec (->> (apply vector (.listFiles file))
            (filter #(and (not (.isHidden %1)) (.isFile %1)))
            (map pair-name-path))))

(defn to-relative
  "convert path to path relative to music folder"
  [path]
  (->>
    (.toURI (java.io.File. path))
    (.relativize (.toURI (java.io.File. (:music-folder cfg-map))))
    (.getPath)))

(defn remove-illegal
  "removes both forward and backward slashes and spaces from paths and replaces
  them with path delimiter"
  [path]
  (-> (string/replace path "/" path-delimiter)
      (string/replace  "\\" path-delimiter)
      (string/replace  " " space-replacement)
      (string/replace  "." dot-replacement)))

(defn file-list
  "Get list of direct children from path using function list-func which has had
  it's path made relative to music-folder and has had it's slashes removed"
  [path list-func]
  (->> (list-func path)
       (map #(vector (first %1) (to-relative (second %1))))
       (map #(vector (first %1) (remove-illegal (second %1))))
       (vec)))

(defn directory-url-list
  "Returns a vector containing a vector for each non-hidden child directory of
  of the passed path Each vector contains the filename and a url
  representation of the file."
  [path]
  (->> (list-directories (io/as-file path))
       (map #(vector (first %1) (to-relative (second %1))))
       (map #(vector (first %1) (remove-illegal (second %1))))
       (map #(vector (first %1) (str browse-path (second %1))))
       (vec)))

(defn file-url-list
  "Returns a vector containing a vector for each non-hidden child file of
  of the passed directory. Each vector contains the
  filename and a url representation of the file path."
  [path]
  (->> (list-files (io/as-file path))
       (map #(vector (first %1) (to-relative (second %1))))
       (map #(vector (first %1) (remove-illegal (second %1))))
       (map #(vector (first %1) (str browse-path (second %1))))
       (vec)))

(defn replace-url-chars
  "Converts url path characters back to file path characters."
  [path]
  (-> (string/replace path path-delimiter "/")
      (string/replace space-replacement " ")
      (string/replace dot-replacement ".")))

(defn sanitize
  "Tests for attempted unauthorized access. Returns empty string if unauthorized
  access detect. Otherwise returns the path."
  [path]
  (if
    (not= nil (re-find
        #"^\.\.[^a-z\ 0-9.]|[^a-z\ 0-9.]\.\.[^a-z\ 0-9.]|[^a-z\ 0-9.]\.\.$|^..$"
                path))  "/" path))

(defn clean
  "Takes url path parameter and returns safe, path parameter with url characters
  replaced"
  [path]
  (->> (sanitize (replace-url-chars path))
       (java.io.File. (io/as-file (:music-folder cfg-map)))))

(ns mvMusic.file-ops
  (:use [mvMusic.global])
  (:require [clojure.java.io :as io]
            [clojure.string :as string]))

(def path-delimiter "<")
(def space-replacement " ")
(def dot-replacement ">")

(defn get-name [x]
  (.getName x))
(defn get-path [x]
  (.getPath x))

(defn pair-name-path [x]
  [(get-name x) (get-path x)])

(defn list-directories
  "return sorted a vector containing the filename and path of each direct
  non-hidden child directory of file"
  [file]
  (vec (->> (apply vector (.listFiles file))
            (filter #(and (not (.isHidden %1)) (.isDirectory %1)))
            (map pair-name-path))))

(defn list-files
  "return a vector containing the filename and path of each non-hidden file
  which is a direct child of the file"
  [file]
  (vec (->> (apply vector (.listFiles file))
            (filter #(and (not (.isHidden %1)) (.isFile %1)))
            (map pair-name-path))))

(defn to-relative
  "convert path to path relative to music folder"
  [path]
  (->>
    (.toURI (java.io.File. path))
    (.relativize (.toURI (java.io.File. (:music-folder cfg-map))))
    (.getPath)))

(defn remove-illegal
  "removes both forward and backward slashes and spaces from paths and replaces
  them with path delimiter"
  [path]
  (-> (string/replace path "/" path-delimiter)
      (string/replace  "\\" path-delimiter)
      (string/replace  " " space-replacement)
      (string/replace  "." dot-replacement)))

(defn file-list
  "Get list of direct children from path using function list-func which has had
  it's path made relative to music-folder and has had it's slashes removed"
  [path list-func]
  (->> (list-func path)
       (map #(vector (first %1) (to-relative (second %1))))
       (map #(vector (first %1) (remove-illegal (second %1))))
       (vec)))

(defn directory-url-list
  "Returns a vector containing a vector for each non-hidden child directory of
  of the passed path Each vector contains the filename and a url
  representation of the file."
  [path]
  (->> (list-directories (io/as-file path))
       (map #(vector (first %1) (->> (to-relative (second %1))
                                     (remove-illegal)
                                     (str browse-path))))
       (vec)))

(defn file-url-list
  "Returns a vector containing a vector for each non-hidden child file of
  of the passed directory. Each vector contains the
  filename and a url representation of the file path."
  [path]
  (->> (list-files (io/as-file path))
       (map #(vector (first %1) (->> (to-relative (second %1))
                                     (map remove-illegal)
                                     (str browse-path))))
       (vec)))

(defn replace-url-chars
  "Converts url path characters back to file path characters."
  [path]
  (-> (string/replace path path-delimiter "/")
      (string/replace space-replacement " ")
      (string/replace dot-replacement ".")))

(defn sanitize
  "Tests for attempted unauthorized access. Returns empty string if unauthorized
  access detect. Otherwise returns the path."
  [path]
  (if
    (not= nil (re-find
        #"^\.\.[^a-z\ 0-9.]|[^a-z\ 0-9.]\.\.[^a-z\ 0-9.]|[^a-z\ 0-9.]\.\.$|^..$"
                path))  "/" path))

(defn clean
  "Takes url path parameter and returns safe, path parameter with url characters
  replaced"
  [path]
  (->> (sanitize (replace-url-chars path))
       (java.io.File. (io/as-file (:music-folder cfg-map)))))

make url-list functions more efficient

make url-list functions more efficient


(def +version+ "3.48-SNAPSHOT")

(defproject com.sixsq.slipstream/SlipStreamCljResourcesTests-jar "3.48-SNAPSHOT"

  :description "cimi server testing utilities"

  :url "https://github.com/slipstream/SlipStreamServer"

  :license {:name "Apache 2.0"
            :url "http://www.apache.org/licenses/LICENSE-2.0.txt"
            :distribution :repo}

  :plugins [[lein-parent "0.3.2"]]

  :parent-project {:coords  [sixsq/slipstream-parent "5.0.3"]
                   :inherit [:min-lein-version
                             :managed-dependencies
                             :repositories
                             :deploy-repositories]}

  :source-paths ["src"]

  :pom-location "target/"

  :dependencies [[com.sixsq.slipstream/SlipStreamDbBinding-jar ~+version+]
                 [com.sixsq.slipstream/SlipStreamDbTesting-jar ~+version+ :scope "compile"]
                 [org.apache.curator/curator-test :scope "compile"]
                 [peridot "0.5.0" :scope "compile"]
                 [org.clojure/data.json]
                 [compojure]
                 [com.cemerick/url]
                 [com.sixsq.slipstream/slipstream-ring-container ~+version+]])

(def +version+ "3.48-SNAPSHOT")

(defproject com.sixsq.slipstream/SlipStreamCljResourcesTests-jar "3.48-SNAPSHOT"

  :description "cimi server testing utilities"

  :url "https://github.com/slipstream/SlipStreamServer"

  :license {:name "Apache 2.0"
            :url "http://www.apache.org/licenses/LICENSE-2.0.txt"
            :distribution :repo}

  :plugins [[lein-parent "0.3.2"]]

  :parent-project {:coords  [sixsq/slipstream-parent "5.0.3"]
                   :inherit [:min-lein-version
                             :managed-dependencies
                             :repositories
                             :deploy-repositories]}

  :source-paths ["src"]

  :pom-location "target/"

  :dependencies [[com.sixsq.slipstream/SlipStreamDbBinding-jar ~+version+]
                 [com.sixsq.slipstream/SlipStreamDbTesting-jar ~+version+ :scope "compile"]
                 [org.apache.curator/curator-test :scope "compile"]
                 [peridot :scope "compile"]
                 [org.clojure/data.json]
                 [compojure]
                 [com.cemerick/url]
                 [com.sixsq.slipstream/slipstream-ring-container ~+version+]])

remove explicit dependency version number


(ns
    ^{:doc "Functions for returning information regarding the connected SC server"}
  overtone.sc.info
  (:use [overtone.libs event]
        [overtone.sc synth gens node server]
        [overtone.util lib]))

(defonce __SERVER-INFO__
  (defsynth snd-server-info
    []
    (send-reply (impulse 2) "/server-info" [(sample-rate)
                                            (sample-dur)
                                            (radians-per-sample)
                                            (control-rate)
                                            (control-dur)
                                            (subsample-offset)
                                            (num-output-buses)
                                            (num-input-buses)
                                            (num-audio-buses)
                                            (num-control-buses)
                                            (num-buffers)
                                            (num-running-synths)])))

(defn server-info
  []
  (when (disconnected?)
    (throw (Exception. "Please connect to a server before attempting to ask for server-info.o")))
  (let [prom (promise)]
    (on-event "/server-info"
              (fn [msg]
                (let [args (:args msg)
                      [nid nrid sr sd rps cr cd sso nob nib nab ncb nb nrs] args]
                  (deliver prom
                           {:sample-rate sr
                            :sample-dur sd
                            :radians-per-sample rps
                            :control-rate cr
                            :control-dur cd
                            :subsample-offset sso
                            :num-output-buses nob
                            :num-input-buses nib
                            :num-audio-buses nab
                            :num-buffers nb
                            :num-running-synths nrs})
                  :done))
              ::num-control-buses)
    (let [synth-id (snd-server-info)
          res (deref! prom)]
      (kill synth-id)
      res)))

(ns
    ^{:doc "Functions for returning information regarding the connected SC server"}
  overtone.sc.info
  (:use [overtone.libs event]
        [overtone.sc synth gens node server]
        [overtone.util lib]))

(defonce output-bus-count* (ref nil))
(defonce input-bus-count* (ref nil))
(defonce audio-bus-count* (ref nil))
(defonce buffer-count* (ref nil))

(defonce __SERVER-INFO__
  (defsynth snd-server-info
    []
    (send-reply (impulse 2) "/server-info" [(sample-rate)
                                            (sample-dur)
                                            (radians-per-sample)
                                            (control-rate)
                                            (control-dur)
                                            (subsample-offset)
                                            (num-output-buses)
                                            (num-input-buses)
                                            (num-audio-buses)
                                            (num-control-buses)
                                            (num-buffers)
                                            (num-running-synths)])))

(defn server-info
  []
  (when (disconnected?)
    (throw (Exception. "Please connect to a server before attempting to ask for server-info.")))
  (let [prom (promise)]
    (on-event "/server-info"
              (fn [msg]
                (let [args (:args msg)
                      [nid nrid sr sd rps cr cd sso nob nib nab ncb nb nrs] args]
                  (deliver prom
                           {:sample-rate sr
                            :sample-dur sd
                            :radians-per-sample rps
                            :control-rate cr
                            :control-dur cd
                            :subsample-offset sso
                            :num-output-buses nob
                            :num-input-buses nib
                            :num-audio-buses nab
                            :num-buffers nb
                            :num-running-synths nrs})
                  :done))
              ::num-control-buses)
    (let [synth-id (snd-server-info)
          res (deref! prom)]
      (kill synth-id)
      res)))

(defn server-num-output-buses
  "Returns the number of output buses accessible by the server. This number may change depending on host architecture but is static for a given running server for the duration of boot."
  []
  (if-let [cnt @output-bus-count*]
    cnt
    (let [info (server-info)]
      (dosync
       (ref-set output-bus-count*  (:num-output-buses info))))))

(defn server-num-input-buses
  "Returns the number of input buses accessible by the server. This number may change depending on host architecture but is static for a given running server for the duration of boot."
  []
  (if-let [cnt @input-bus-count*]
    cnt
    (let [info (server-info)]
      (dosync
       (ref-set input-bus-count*  (:num-input-buses info))))))

(defn server-num-audio-buses
  "Returns the number of audio buses accessible by the server. This number may change depending on host architecture but is static for a given running server for the duration of boot."
  []
  (if-let [cnt @audio-bus-count*]
    cnt
    (let [info (server-info)]
      (dosync
       (ref-set audio-bus-count*  (:num-audio-buses info))))))

(defn server-num-buffers
  "Returns the number of buffers accessible by the server. This number may change depending on host architecture but is static for a given running server for the duration of boot."
  []
  (if-let [cnt @buffer-count*]
    cnt
    (let [info (server-info)]
      (dosync
       (ref-set buffer-count*  (:num-buffers info))))))

(on-sync-event :shutdown #(dosync
                           (ref-set output-bus-count* nil)
                           (ref-set input-bus-count* nil)
                           (ref-set audio-bus-count* nil)
                           (ref-set buffer-count* nil))
               ::reset-cached-server-info)

Add individually cached server info fns

Add individually cached server info fns


(ns github-contributions.github-test
  (:require [clojure.test :refer :all]
            [github-contributions.service :as service]
            [conjure.core :refer :all]
            [tentacles.repos :as repos]
            [github-contributions.fixtures :as fixtures]
            [github-contributions.github :as github]))

(defn send-event-fn [& args])

(defn stream-contributions
  []
 (github/stream-contributions send-event-fn))

(defn yo [& args]
  "yo")

(deftest yo-test
  (mocking [yo]
           (yo :first)
           (yo :second)
           (verify-nth-call-args-for 1 yo :first)
           (verify-nth-call-args-for 2 yo :second)))

(deftest stream-contributions-receives-403-from-github
  []
  (with-redefs [repos/user-repos (constantly fixtures/response-403)]
    (mocking [send-event-fn]
             (github/stream-contributions send-event-fn {} "defunkt")
             (verify-nth-call-args-for 1 send-event-fn {} "error"
                                       "Rate limit has been exceeded for Github's API. Please try again later."))))

(deftest stream-contributions-receives-404-from-github
  []
  (with-redefs [repos/user-repos (constantly fixtures/response-404)]
    (mocking [send-event-fn]
             (github/stream-contributions send-event-fn {} "defunkt")
             (verify-nth-call-args-for 1 send-event-fn {} "error"
                                       "Received a 404 from Github. Please try again later."))))

;; because conjure only supports =
(def expected-row
  "
ajaxorg/ace (fork) 5188 stars	5 commits	1st of 2	Ajax.org Cloud9 Editor
")

(deftest stream-contributions-receives-200s-from-github
  []
  (with-redefs [repos/user-repos (constantly fixtures/response-user-repos)
                repos/specific-repo (constantly fixtures/response-specific-repo)
                repos/contributors (constantly fixtures/response-contributors)]
    (mocking [send-event-fn]
             (github/stream-contributions send-event-fn {} "defunkt")
             (verify-nth-call-args-for 1 send-event-fn {} "message"
                                       "defunkt has 1 forks. Fetching data...")
             (verify-nth-call-args-for 2 send-event-fn {} "results" expected-row)
             (verify-nth-call-args-for 3 send-event-fn {} "message"
                                       "defunkt has contributed to 1 of 1 forks.")
             (verify-nth-call-args-for 4 send-event-fn {} "end-message" "defunkt"))))
(deftest rank-ending-test
  (are [num ending]
       (is (= ending (github/rank-ending num)))
       "1" "st"
       "11" "th"
       "121" "st"
       "2" "nd"
       "12" "th"
       "122" "nd"
       "3" "rd"
       "13" "th"
       "123" "rd"
       "4" "th"))

(ns github-contributions.github-test
  (:require [clojure.test :refer :all]
            [github-contributions.service :as service]
            [conjure.core :refer :all]
            [tentacles.repos :as repos]
            [github-contributions.fixtures :as fixtures]
            [github-contributions.github :as github]))

(defn send-event-fn [& args])
(def sse-context {:request {}})

(defn stream-contributions
  []
  (github/stream-contributions send-event-fn sse-context "defunkt"))

(deftest stream-contributions-receives-403-from-github
  []
  (with-redefs [repos/user-repos (constantly fixtures/response-403)]
    (mocking [send-event-fn]
             (stream-contributions)
             (verify-nth-call-args-for 1 send-event-fn sse-context "error"
                                       "Rate limit has been exceeded for Github's API. Please try again later."))))

(deftest stream-contributions-receives-404-from-github
  []
  (with-redefs [repos/user-repos (constantly fixtures/response-404)]
    (mocking [send-event-fn]
             (stream-contributions)
             (verify-nth-call-args-for 1 send-event-fn sse-context "error"
                                       "Received a 404 from Github. Please try again later."))))

;; because conjure only supports =
(def expected-row
  "
ajaxorg/ace (fork) 5188 stars	5 commits	1st of 2	Ajax.org Cloud9 Editor
")

(deftest stream-contributions-receives-200s-from-github
  []
  (with-redefs [repos/user-repos (constantly fixtures/response-user-repos)
                repos/specific-repo (constantly fixtures/response-specific-repo)
                repos/contributors (constantly fixtures/response-contributors)]
    (mocking [send-event-fn]
             (stream-contributions)
             (verify-nth-call-args-for 1 send-event-fn sse-context "message"
                                       "defunkt has 1 forks. Fetching data...")
             (verify-nth-call-args-for 2 send-event-fn sse-context "results" expected-row)
             (verify-nth-call-args-for 3 send-event-fn sse-context "message"
                                       "defunkt has contributed to 1 of 1 forks.")
             (verify-nth-call-args-for 4 send-event-fn sse-context "end-message" "defunkt"))))

(deftest rank-ending-test
  (are [num ending]
       (is (= ending (github/rank-ending num)))
       "1" "st"
       "11" "th"
       "121" "st"
       "2" "nd"
       "12" "th"
       "122" "nd"
       "3" "rd"
       "13" "th"
       "123" "rd"
       "4" "th"))

test clean up, verify* refactor not worth the macro :shit: ing required


(ns midje.sweet.t-background-nesting
  (:use clojure.test)
  (:use [midje.sweet] :reload-all)
  (:use [midje.test-util])
  (:use clojure.contrib.pprint))

;; This is a separate file because we're making namespace-wide changes

(unfinished outermost middlemost innermost)

(deftest background-command-slams-new-background-in-place
  (in-separate-namespace
   (background (outermost ...o...) => 1)
   (fact (+ 1 (outermost ...o...)) => 2)
   (background (outermost ...o...) => -1)
   (fact (+ 1 (outermost ...o...)) => 0)))

(deftest background-command-is-shadowed-by-against-background
  (in-separate-namespace
   (background (outermost) => 2
	       (middlemost) => 'a)
   (against-background [ (middlemost) => 33]
		       (fact (+ (middlemost) (outermost)) => 35))))

(deftest three-levels-of-nesting
  (in-separate-namespace
   (background (outermost) => 2
	       (middlemost) => 'a)
   (against-background [ (middlemost) => 33
			 (innermost) => 'c]
		       (fact
			 (against-background (innermost) => 8)
			 (+ (middlemost) (outermost) (innermost)) => 43))))

(against-background [ (middlemost) => 33 ]
  (deftest spanning-deftest-does-not-work
      (fact
      (against-background (innermost) => 8)
      (+ (middlemost) (innermost)) => (throws java.lang.Error))))

(ns midje.sweet.t-background-nesting
  (:use clojure.test)
  (:use [midje.sweet] :reload-all)
  (:use [midje.test-util])
  (:use clojure.contrib.pprint))

;; This is a separate file because we're making namespace-wide changes

(unfinished outermost middlemost innermost)

(deftest background-command-slams-new-background-in-place
  (in-separate-namespace
   (background (outermost ...o...) => 1)
   (fact (+ 1 (outermost ...o...)) => 2)
   (background (outermost ...o...) => -1)
   (fact (+ 1 (outermost ...o...)) => 0)))

(deftest background-command-is-shadowed-by-against-background
  (in-separate-namespace
   (background (outermost) => 2
	       (middlemost) => 'a)
   (against-background [ (middlemost) => 33]
		       (fact (+ (middlemost) (outermost)) => 35))))

(deftest three-levels-of-nesting-one-duplicated
  (in-separate-namespace
   (background (outermost) => 2
	       (middlemost) => 'a)
   (against-background [ (middlemost 2) => 33
			 (innermost) => 'c]

     (against-background [ (middlemost 1) => -43 ]
       (fact
	 (against-background (innermost) => 8)
	 (+ (middlemost 2) (middlemost 1) (outermost) (innermost)) => 0)))))

(against-background [ (middlemost) => 33 ]
  (deftest spanning-deftest-does-not-work
      (fact
      (against-background (innermost) => 8)
      (+ (middlemost) (innermost)) => (throws java.lang.Error))))

document that against-background can be nested


(ns route-ccrs.active-routes
  (:require [clojure.java.jdbc :as jdbc]
            [yesql.core :refer [defquery]]))

(defquery active-routes "route_ccrs/sql/active_routes.sql")

(defn route-id [r]
  (select-keys r [:contract
                  :part_no
                  :bom_type_db
                  :routing_revision_no
                  :routing_alternative_no]))

(defn sorted-operations []
  (sorted-set-by
    (fn [x y]
      (compare (:operation_no x)
               (:operation_no y))) ))

(defn transduce-routes [step]
  (let [routes (volatile! {})]
    (fn
      ([] (step))
      ([r]
       (step (reduce step r @routes)))
      ([r o]
       (let [i (route-id o)
             route (conj (get @routes i (sorted-operations)) o)
             c (:operation_count o)]
         (if (and c (= (count route) c))
           (step r route)
           (do
             (vreset! routes (assoc @routes i route))
             r)))))))

(ns route-ccrs.active-routes
  (:require [clojure.java.jdbc :as jdbc]
            [yesql.core :refer [defquery]]))

(defquery active-routes "route_ccrs/sql/active_routes.sql")

(defn route-id [r]
  (select-keys r [:contract
                  :part_no
                  :lowest_level
                  :bom_type_db
                  :routing_revision_no
                  :routing_alternative_no]))

(defn sorted-operations []
  (sorted-set-by
    (fn [x y]
      (compare (:operation_no x)
               (:operation_no y))) ))

(defn transduce-routes [step]
  (let [routes (volatile! {})]
    (fn
      ([] (step))
      ([r]
       (step (reduce step r @routes)))
      ([r o]
       (let [i (route-id o)
             route (conj (get @routes i (sorted-operations)) o)
             c (:operation_count o)]
         (if (and c (= (count route) c))
           (step r route)
           (do
             (vreset! routes (assoc @routes i route))
             r)))))))

Include low level number in route ID

Include low level number in route ID


(ns salava.badge.ui.my
  (:require [reagent.core :refer [atom]]
            [reagent.session :as session]
            [reagent-modals.modals :as m]
            [clojure.set :as set :refer [intersection]]
            [clojure.string :refer [upper-case]]
            [salava.core.ui.ajax-utils :as ajax]
            [salava.core.ui.helper :as h :refer [unique-values navigate-to]]
            [salava.core.ui.layout :as layout]
            [salava.core.ui.grid :as g]
            [salava.badge.ui.settings :as s]
            [salava.badge.ui.helper :as bh]
            [salava.core.time :refer [unix-time date-from-unix-time]]
            [salava.core.i18n :as i18n :refer [t]]))

(defn visibility-select-values []
  [{:value "all" :title (t :core/All)}
   {:value "public"  :title (t :core/Public)}
   {:value "internal"  :title (t :core/Registeredusers)}
   {:value "private" :title (t :core/Onlyyou)}])

(defn order-radio-values []
  [{:value "mtime" :id "radio-date" :label (t :core/bydate)}
   {:value "name" :id "radio-name" :label (t :core/byname)}
   {:value "issuer_content_name" :id "radio-issuer" :label (t :core/byissuername)}
   {:value "expires_on" :id "radio-expiratio" :label (t :core/byexpirationdate)}])

(defn badge-grid-form [state]
  [:div {:id "grid-filter"
         :class "form-horizontal"}
   [g/grid-search-field (t :core/Search ":")  "badgesearch" (t :core/Searchbyname) :search state]
   [g/grid-select (t :core/Show ":")  "select-visibility" :visibility (visibility-select-values) state]
   [g/grid-buttons (t :core/Tags ":")  (unique-values :tags (:badges @state)) :tags-selected :tags-all state]
   [g/grid-radio-buttons (t :core/Order ":")  "order" (order-radio-values) :order state]])

(defn badge-visible? [element state]
  (if (and
        (or (= (:visibility @state) "all")
            (= (:visibility @state) (:visibility element)))
        (or (> (count
                 (intersection
                   (into #{} (:tags-selected @state))
                   (into #{} (:tags element))))
               0)
            (= (:tags-all @state)
               true))
        (or (empty? (:search @state))
            (not= (.indexOf
                    (.toLowerCase (:name element))
                    (.toLowerCase (:search @state)))
                  -1)))
    true false))

(defn show-settings-dialog [badge-id state]
  (ajax/GET
    (str "/obpv1/badge/settings/" badge-id)
    {:handler (fn [data]
                (swap! state assoc :badge-settings (hash-map :id badge-id
                                                             :visibility (:visibility data)
                                                             :tags (:tags data)
                                                             :evidence-url (:evidence_url data)
                                                             :rating (:rating data)
                                                             :new-tag ""))
                (m/modal! [s/settings-modal data state]
                          {:size :lg}))}))

(defn badge-grid-element [element-data state]
  (let [{:keys [id image_file name description visibility expires_on revoked]} element-data
        expired? (bh/badge-expired? expires_on)
        badge-link (str "/badge/info/" id)]
    [:div {:class "col-xs-12 col-sm-6 col-md-4"
           :key id}
     [:div {:class "media grid-container"}
      [:div {:class (str "media-content " (if expired? "media-expired"))}
       (if image_file
         [:div.media-left
          [:a {:href badge-link} [:img {:src (str "/" image_file)}]]])
       [:div.media-body
        [:div.media-heading
         [:a.heading-link {:href badge-link} name]]
        [:div.visibility-icon
         (case visibility
           "private" [:i {:class "fa fa-lock"
                          :title (t :badge/Private)}]
           "internal" [:i {:class "fa fa-group"
                           :title (t :badge/Shared)}]
           "public" [:i {:class "fa fa-globe"
                         :title (t :badge/Public)}]
           nil)]
        (if expires_on
          [:div.media-expires (if expired? (t :badge/Expiredon) (t :badge/Expireson)) ": " (date-from-unix-time (* expires_on 1000))])
        [:div.media-description
         description]]]
      [:div {:class "media-bottom"}
       (cond
         expired? [:div.expired [:i {:class "fa fa-history"}] " " (t :badge/Expired)]
         revoked [:div.expired [:i {:class "fa fa-ban"}] " " (t :badge/Revoked)]
         :else [:div
                [:a {:class "bottom-link" :href (str "/badge/info/" id)}
                 [:i {:class "fa fa-share-alt"}]
                 [:span (t :badge/Share)]]
                [:a {:class "bottom-link pull-right" :href "" :on-click #(show-settings-dialog id state)}
                 [:i {:class "fa fa-cog"}]
                 [:span (t :badge/Settings)]]])]]]))

(defn badge-grid [state]
  (let [badges (:badges @state)
        order (keyword (:order @state))
        badges (case order
                 (:mtime) (sort-by order > badges)
                 (:name :issuer_content_name) (sort-by (comp clojure.string/upper-case str order) badges)
                 (:expires_on) (->> badges
                                    (sort-by order)
                                    (partition-by #(nil? (% order)))
                                    reverse
                                    flatten)
                 badges)]
    (into [:div {:class "row"
                 :id    "grid"}]
          (for [element-data badges]
            (if (badge-visible? element-data state)
              (badge-grid-element element-data state))))))

(defn update-status [id new-status state]
  (ajax/POST
    (str "/obpv1/badge/set_status/" id)
    {:params  {:status new-status}
     :handler (fn []
                (let [badge (first (filter #(= id (:id %)) (:pending @state)))]
                  (swap! state assoc :pending (remove #(= badge %) (:pending @state)))
                  (if (= new-status "accepted")
                    (swap! state assoc :badges (conj (:badges @state) badge)))))}))

(defn badge-pending [{:keys [id image_file name description issuer_content_name issuer_content_url issued_on issued_by_obf verified_by_obf obf_url]} state]
  [:div.row {:key id}
   [:div.col-md-12
    [:div.badge-container-pending
     (if (or verified_by_obf issued_by_obf)
       (bh/issued-by-obf obf_url verified_by_obf issued_by_obf))
     [:div.row
      [:div.col-md-12
       [:div.media
        [:div.pull-left
         [:img.badge-image {:src (str "/" image_file)}]]
        [:div.media-body
         [:h4.media-heading
          name]
         [:div
          [:a {:href issuer_content_url :target "_blank"} issuer_content_name]]
         [:div (date-from-unix-time (* 1000 issued_on))]
         [:div
          description]]]]]
     [:div {:class "row button-row"}
      [:div.col-md-12
       [:button {:class "btn btn-primary"
                 :on-click #(update-status id "accepted" state)}
        (t :badge/Acceptbadge)]
       [:button {:class "btn btn-warning"
                 :on-click #(update-status id "declined" state)}
        (t :badge/Declinebadge)]]]]]])

(defn badges-pending [state]
  (into [:div {:id "pending-badges"}]
        (for [badge (:pending @state)]
          (badge-pending badge state))))

(defn welcome-text []
  [:div.panel
   [:div.panel-body
    [:h1.uppercase-header (t :core/WelcometoOpenBadgePassport)]
    [:div.text
     [:p "Using Open Badge Passport could not be easier:"]
     [:ol.welcome-text
      [:li
       "Add a " [:a {:href "/user/edit/profile"} "profile picture"]
       ", a short bio or contact information to your "
       [:a {:href "/user/edit"} "profile"] "."]
      [:li
       "Do you already have Open Badges saved to Mozilla Backpack? "
       [:a {:href "/badge/import"} "Import your badges"]
       " to Open Badge Passport. "
       [:b "NB! Remember to add your Backpack email to the " [:a {:href "/user/edit/email-addresses"} "email addresses"] "."]]
      [:li
       "No badges yet? "
       [:b "Earn your \"Open Badge Passport - Member\" badge " [:a {:href "/gallery/getbadge"} "here!"]]]
      [:li
       [:a {:href "/page/mypages"} "Create a page"]
       " to display your badges and share it with others in Social Media or in "
       [:a {:href "/gallery/pages"} "in the Gallery"] "."]]]]])

(defn content [state]
  [:div {:id "my-badges"}
   [m/modal-window]
   (if (:initializing @state)
     [:div.ajax-message
      [:i {:class "fa fa-cog fa-spin fa-2x "}]
      [:span (str (t :core/Loading) "...")]]
     (if (and (empty? (:pending @state)) (empty? (:badges @state)))
       [welcome-text]
       [:div
        [badges-pending state]
        [badge-grid-form state]
        [badge-grid state]]))])

(defn init-data [state]
  (ajax/GET
    "/obpv1/badge"
    {:handler (fn [data]
                (swap! state assoc :badges (filter #(= "accepted" (:status %)) data)
                                   :pending (filter #(= "pending" (:status %)) data)
                                   :initializing false))}))

(defn handler [site-navi]
  (let [state (atom {:badges []
                     :pending []
                     :visibility "all"
                     :order "mtime"
                     :tags-all true
                     :tags-selected []
                     :initializing true})]
    (init-data state)
    (fn []
      (layout/default site-navi (content state)))))

(ns salava.badge.ui.my
  (:require [reagent.core :refer [atom]]
            [reagent.session :as session]
            [reagent-modals.modals :as m]
            [clojure.set :as set :refer [intersection]]
            [clojure.string :refer [upper-case]]
            [salava.core.ui.ajax-utils :as ajax]
            [salava.core.ui.helper :as h :refer [unique-values navigate-to]]
            [salava.core.ui.layout :as layout]
            [salava.core.ui.grid :as g]
            [salava.badge.ui.settings :as s]
            [salava.badge.ui.helper :as bh]
            [salava.core.time :refer [unix-time date-from-unix-time]]
            [salava.core.i18n :as i18n :refer [t]]))

(defn visibility-select-values []
  [{:value "all" :title (t :core/All)}
   {:value "public"  :title (t :core/Public)}
   {:value "internal"  :title (t :core/Registeredusers)}
   {:value "private" :title (t :core/Onlyyou)}])

(defn order-radio-values []
  [{:value "mtime" :id "radio-date" :label (t :core/bydate)}
   {:value "name" :id "radio-name" :label (t :core/byname)}
   {:value "issuer_content_name" :id "radio-issuer" :label (t :core/byissuername)}
   {:value "expires_on" :id "radio-expiratio" :label (t :core/byexpirationdate)}])

(defn badge-grid-form [state]
  [:div {:id "grid-filter"
         :class "form-horizontal"}
   [g/grid-search-field (t :core/Search ":")  "badgesearch" (t :core/Searchbyname) :search state]
   [g/grid-select (t :core/Show ":")  "select-visibility" :visibility (visibility-select-values) state]
   [g/grid-buttons (t :core/Tags ":")  (unique-values :tags (:badges @state)) :tags-selected :tags-all state]
   [g/grid-radio-buttons (t :core/Order ":")  "order" (order-radio-values) :order state]])

(defn badge-visible? [element state]
  (if (and
        (or (= (:visibility @state) "all")
            (= (:visibility @state) (:visibility element)))
        (or (> (count
                 (intersection
                   (into #{} (:tags-selected @state))
                   (into #{} (:tags element))))
               0)
            (= (:tags-all @state)
               true))
        (or (empty? (:search @state))
            (not= (.indexOf
                    (.toLowerCase (:name element))
                    (.toLowerCase (:search @state)))
                  -1)))
    true false))

(defn show-settings-dialog [badge-id state]
  (ajax/GET
    (str "/obpv1/badge/settings/" badge-id)
    {:handler (fn [data]
                (swap! state assoc :badge-settings (hash-map :id badge-id
                                                             :visibility (:visibility data)
                                                             :tags (:tags data)
                                                             :evidence-url (:evidence_url data)
                                                             :rating (:rating data)
                                                             :new-tag ""))
                (m/modal! [s/settings-modal data state]
                          {:size :lg}))}))

(defn badge-grid-element [element-data state]
  (let [{:keys [id image_file name description visibility expires_on revoked]} element-data
        expired? (bh/badge-expired? expires_on)
        badge-link (str "/badge/info/" id)]
    [:div {:class "col-xs-12 col-sm-6 col-md-4"
           :key id}
     [:div {:class "media grid-container"}
      [:div {:class (str "media-content " (if expired? "media-expired"))}
       (if image_file
         [:div.media-left
          [:a {:href badge-link} [:img {:src (str "/" image_file)}]]])
       [:div.media-body
        [:div.media-heading
         [:a.heading-link {:href badge-link} name]]
        [:div.visibility-icon
         (case visibility
           "private" [:i {:class "fa fa-lock"
                          :title (t :badge/Private)}]
           "internal" [:i {:class "fa fa-group"
                           :title (t :badge/Shared)}]
           "public" [:i {:class "fa fa-globe"
                         :title (t :badge/Public)}]
           nil)]
        (if expires_on
          [:div.media-expires (if expired? (t :badge/Expiredon) (t :badge/Expireson)) ": " (date-from-unix-time (* expires_on 1000))])
        [:div.media-description
         description]]]
      [:div {:class "media-bottom"}
       (cond
         expired? [:div.expired [:i {:class "fa fa-history"}] " " (t :badge/Expired)]
         revoked [:div.expired [:i {:class "fa fa-ban"}] " " (t :badge/Revoked)]
         :else [:div
                [:a {:class "bottom-link" :href (str "/badge/info/" id)}
                 [:i {:class "fa fa-share-alt"}]
                 [:span (t :badge/Share)]]
                [:a {:class "bottom-link pull-right" :href "" :on-click #(show-settings-dialog id state)}
                 [:i {:class "fa fa-cog"}]
                 [:span (t :badge/Settings)]]])]]]))

(defn badge-grid [state]
  (let [badges (:badges @state)
        order (keyword (:order @state))
        badges (case order
                 (:mtime) (sort-by order > badges)
                 (:name :issuer_content_name) (sort-by (comp clojure.string/upper-case str order) badges)
                 (:expires_on) (->> badges
                                    (sort-by order)
                                    (partition-by #(nil? (% order)))
                                    reverse
                                    flatten)
                 badges)]
    (into [:div {:class "row"
                 :id    "grid"}]
          (for [element-data badges]
            (if (badge-visible? element-data state)
              (badge-grid-element element-data state))))))

(defn update-status [id new-status state]
  (ajax/POST
    (str "/obpv1/badge/set_status/" id)
    {:params  {:status new-status}
     :handler (fn []
                (let [badge (first (filter #(= id (:id %)) (:pending @state)))]
                  (swap! state assoc :pending (remove #(= badge %) (:pending @state)))
                  (if (= new-status "accepted")
                    (swap! state assoc :badges (conj (:badges @state) badge)))))}))

(defn badge-pending [{:keys [id image_file name description issuer_content_name issuer_content_url issued_on issued_by_obf verified_by_obf obf_url]} state]
  [:div.row {:key id}
   [:div.col-md-12
    [:div.badge-container-pending
     (if (or verified_by_obf issued_by_obf)
       (bh/issued-by-obf obf_url verified_by_obf issued_by_obf))
     [:div.row
      [:div.col-md-12
       [:div.media
        [:div.pull-left
         [:img.badge-image {:src (str "/" image_file)}]]
        [:div.media-body
         [:h4.media-heading
          name]
         [:div
          [:a {:href issuer_content_url :target "_blank"} issuer_content_name]]
         [:div (date-from-unix-time (* 1000 issued_on))]
         [:div
          description]]]]]
     [:div {:class "row button-row"}
      [:div.col-md-12
       [:button {:class "btn btn-primary"
                 :on-click #(update-status id "accepted" state)}
        (t :badge/Acceptbadge)]
       [:button {:class "btn btn-warning"
                 :on-click #(update-status id "declined" state)}
        (t :badge/Declinebadge)]]]]]])

(defn badges-pending [state]
  (into [:div {:id "pending-badges"}]
        (for [badge (:pending @state)]
          (badge-pending badge state))))

(defn welcome-text []
  [:div.panel
   [:div.panel-body
    [:h1.uppercase-header (t :core/WelcometoOpenBadgePassport)]
    [:div.text
     [:p "Using Open Badge Passport could not be easier:"]
     [:ol.welcome-text
      [:li
       "Add a " [:a {:href "/user/edit/profile"} "profile picture"]
       ", a short bio or contact information to your "
       [:a {:href (str "/user/profile/" (session/get-in [:user :id]))} "profile"] "."]
      [:li
       "Do you already have Open Badges saved to Mozilla Backpack? "
       [:a {:href "/badge/import"} "Import your badges"]
       " to Open Badge Passport. "
       [:b "NB! Remember to add your Backpack email to the " [:a {:href "/user/edit/email-addresses"} "email addresses"] "."]]
      [:li
       "No badges yet? "
       [:b "Earn your \"Open Badge Passport - Member\" badge " [:a {:href "/gallery/getbadge"} "here!"]]]
      [:li
       [:a {:href "/page/mypages"} "Create a page"]
       " to display your badges and share it with others in Social Media or in "
       [:a {:href "/gallery/pages"} "in the Gallery"] "."]]]]])

(defn content [state]
  [:div {:id "my-badges"}
   [m/modal-window]
   (if (:initializing @state)
     [:div.ajax-message
      [:i {:class "fa fa-cog fa-spin fa-2x "}]
      [:span (str (t :core/Loading) "...")]]
     (if (and (empty? (:pending @state)) (empty? (:badges @state)))
       [welcome-text]
       [:div
        [badges-pending state]
        [badge-grid-form state]
        [badge-grid state]]))])

(defn init-data [state]
  (ajax/GET
    "/obpv1/badge"
    {:handler (fn [data]
                (swap! state assoc :badges (filter #(= "accepted" (:status %)) data)
                                   :pending (filter #(= "pending" (:status %)) data)
                                   :initializing false))}))

(defn handler [site-navi]
  (let [state (atom {:badges []
                     :pending []
                     :visibility "all"
                     :order "mtime"
                     :tags-all true
                     :tags-selected []
                     :initializing true})]
    (init-data state)
    (fn []
      (layout/default site-navi (content state)))))

Fix link location in welcome page

Fix link location in welcome page


(ns spec-tools.core
  (:refer-clojure :exclude [any? some? number? integer? int? pos-int? neg-int? nat-int?
                            float? double? boolean? string? ident? simple-ident? qualified-ident?
                            keyword? simple-keyword? qualified-keyword? symbol? simple-symbol?
                            qualified-symbol? uuid? uri? bigdec? inst? seqable? indexed?
                            map? vector? list? seq? char? set? nil? false? true? zero?
                            rational? coll? empty? associative? sequential? ratio? bytes?
                            #?@(:cljs [Inst Keyword UUID])])
  #?(:cljs (:require-macros [spec-tools.core :refer [spec coll-spec]]))
  (:require [spec-tools.impl :as impl]
            [spec-tools.types :as types]
            [spec-tools.conform :as conform]
            [clojure.spec :as s]
    #?@(:clj  [
            [clojure.spec.gen :as gen]
            [clojure.edn]]
        :cljs [[goog.date.UtcDateTime]
               [cljs.reader]
               [goog.date.Date]
               [clojure.test.check.generators]
               [cljs.spec.impl.gen :as gen]]))
  (:import
    #?@(:clj
        [(clojure.lang AFn IFn Var)
         (java.io Writer)])))

;;
;; helpers
;;

(defn ^:skip-wiki registry
  ([]
   (s/registry))
  ([re]
   (->> (s/registry)
        (filter #(-> % first str (subs 1) (->> (re-matches re))))
        (into {}))))

(defn ^:skip-wiki eq [value]
  #{value})

(defn ^:skip-wiki set-of [value]
  (s/coll-of
    value
    :kind clojure.core/set?))

(defn ^:skip-wiki enum [& values]
  (s/spec (set values)))

(defn ^:skip-wiki serialize
  "Writes specs into a string that can be read by the reader.
  TODO: Should optionally write the realated Registry entries."
  [spec]
  (pr-str (s/form spec)))

(defn ^:skip-wiki deserialize
  "Reads specs from a string.
  TODO: Should optionally read the realated Registry entries."
  [s]
  #?(:clj  (clojure.edn/read-string s)
     :cljs (cljs.reader/read-string s)))

(def invalid '::s/invalid)

;;
;; Dynamic conforming
;;

(def ^:dynamic ^:private *conformers* nil)

(def json-conformers
  {:keyword conform/string->keyword
   :uuid conform/string->uuid
   :date conform/string->date
   :symbol conform/string->symbol
   ;; TODO: implement
   :uri nil
   :bigdec nil
   :ratio nil})

(def string-conformers
  (merge
    json-conformers
    {:long conform/string->long
     :double conform/string->double
     :boolean conform/string->boolean
     :nil conform/string->nil
     :string nil}))

(defn explain
  ([spec value]
   (explain spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (s/explain spec value))))

(defn explain-data
  ([spec value]
   (explain-data spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (s/explain-data spec value))))

(defn conform
  ([spec value]
   (conform spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (s/conform spec value))))

(defn conform!
  ([spec value]
   (conform! spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (let [conformed (s/conform spec value)]
       (if-not (= conformed invalid)
         conformed
         (let [problems (s/explain-data spec value)]
           (throw
             (ex-info
               "Spec conform error"
               (merge
                 problems
                 {:type :spec/problems
                  :spec spec
                  :value value})))))))))

;;
;; Spec Record
;;

(defn- extra-spec-map [t]
  (dissoc t :spec/form :pred))

(defn- fail-on-invoke [spec]
  (throw
    (ex-info
      (str
        "Can't invoke spec with a non-function predicate: " spec)
      {:spec spec})))

(defrecord Spec [pred]
  #?@(:clj
      [s/Specize
       (specize* [s] s)
       (specize* [s _] s)])

  s/Spec
  (conform* [this x]
    ;; function predicate
    (if (and (fn? pred) (pred x))
      x
      ;; there is a dynamic conformer
      (if-let [conformer (get *conformers* (:spec/type this))]
        (conformer this x)
        ;; spec predicate
        (if (s/spec? pred)
          (s/conform pred x)
          ;; invalid
          invalid))))
  (unform* [_ x]
    x)
  (explain* [this path via in x]
    (let [problems (if (s/spec? pred)
                     (s/explain* pred path via in (s/conform* this x))
                     (when (= invalid (if (and (fn? pred) (pred (s/conform* this x))) x invalid))
                       [{:path path
                         :pred (s/abbrev (:spec/form this))
                         :val x
                         :via via
                         :in in}]))
          spec-reason (:spec/reason this)
          with-reason (fn [{:keys [reason] :as problem}]
                        (cond-> problem
                                (and spec-reason (not reason))
                                (assoc :reason spec-reason)))]
      (if problems
        (map with-reason problems))))
  (gen* [this _ _ _]
    (if-let [gen (:spec/gen this)]
      (gen)
      (gen/gen-for-pred pred)))
  (with-gen* [this gfn]
    (assoc this :spec/gen gfn))
  (describe* [this]
    (let [info (extra-spec-map this)]
      `(spec ~(:spec/form this) ~info)))
  IFn
  #?(:clj  (invoke [this x] (if (fn? pred) (pred x) (fail-on-invoke this)))
     :cljs (-invoke [this x] (if (fn? pred) (pred x) (fail-on-invoke this)))))

#?(:clj
   (defmethod print-method Spec
     [^Spec t ^Writer w]
     (.write w (str "#Spec"
                    (merge
                      (select-keys t [:spec/form])
                      (if (:spec/type t) (select-keys t [:spec/type]))
                      (extra-spec-map t))))))

(defn spec? [x]
  (if (instance? Spec x) x))

;; TODO: use http://dev.clojure.org/jira/browse/CLJ-2112
(defn- extract-extra-info [form]
  (if (and
        (clojure.core/seq? form)
        (= 'clojure.spec/keys (impl/clojure-core-symbol-or-any (first form))))
    (if-let [m (some->> form
                        (rest)
                        (apply hash-map))]
      {:spec/keys (set
                    (concat
                      (:req m)
                      (:opt m)
                      (map (comp keyword name) (:req-un m))
                      (map (comp keyword name) (:opt-un m))))})))

(defn create-spec [m]
  (let [form (or (:spec/form m) (s/form (:pred m)))
        info (extract-extra-info form)
        type (if-not (contains? m :spec/type)
               (types/resolve-type form)
               (:spec/type m))]
    (map->Spec (merge m info {:spec/form form, :spec/type type}))))

#?(:clj
   (defmacro spec
     ([pred]
      `(spec ~pred {}))
     ([pred info]
      (if (impl/in-cljs? &env)
        `(let [info# ~info
               form# (if (clojure.core/symbol? '~pred)
                       '~(or (and (clojure.core/symbol? pred) (some->> pred (impl/cljs-resolve &env) impl/->sym)) pred))]
           (assert (clojure.core/map? info#) (str "spec info should be a map, was: " info#))
           (create-spec
             (merge
               ~info
               {:spec/form form#
                :pred ~pred})))
        `(let [info# ~info
               form# (if (clojure.core/symbol? '~pred)
                       '~(or (and (clojure.core/symbol? pred) (some->> pred resolve impl/->sym)) pred))]
           (assert (clojure.core/map? info#) (str "spec info should be a map, was: " info#))
           (create-spec
             (merge
               ~info
               {:spec/form form#
                :pred ~pred})))))))

#?(:clj
   (defmacro doc [pred info]
     `(spec ~pred (merge ~info {:spec/type nil}))))

;;
;; Map Spec
;;

(defrecord OptionalKey [k])
(defrecord RequiredKey [k])

(defn opt [k] (->OptionalKey k))
(defn req [k] (->RequiredKey k))

#?(:clj (declare ^:private coll-spec-fn))

(defn- -vector [env n v]
  (if-not (= 1 (count v))
    (throw
      (ex-info
        "only single maps allowed in nested vectors"
        {:k n :v v}))
    `(spec (s/coll-of ~(coll-spec-fn env n (first v)) :into []))))

(defn- -set [env n v]
  (if-not (= 1 (count v))
    (throw
      (ex-info
        "only single maps allowed in nested sets"
        {:k n :v v}))
    `(spec (s/coll-of ~(coll-spec-fn env n (first v)) :into #{}))))

#?(:clj
   (defn- -map [env n m]
     (let [resolve (if (impl/in-cljs? env) (partial impl/cljs-resolve env) resolve)
           resolved-opt (resolve `opt)
           resolved-req (resolve `req)]

       ;; predicate keys
       (if-let [key-spec (and (= 1 (count m))
                              (let [k (first (keys m))]
                                (and
                                  (not
                                    (or (clojure.core/keyword? k)
                                        (and (clojure.core/seq? k)
                                             (let [resolved (resolve (first k))]
                                               (#{resolved-opt resolved-req} resolved)))))
                                  k)))]
         `(spec (s/map-of ~key-spec ~(coll-spec-fn env n (first (vals m)))))
         ;; keyword keys
         (let [m (reduce-kv
                   (fn [acc k v]
                     (let [[req? kv] (if (clojure.core/seq? k) [(not= resolved-opt (resolve (first k))) (second k)] [true k])
                           k1 (if req? "req" "opt")
                           k2 (if-not (clojure.core/qualified-keyword? kv) "-un")
                           ak (keyword (str k1 k2))
                           [k' v'] (if (clojure.core/qualified-keyword? kv)
                                     [kv (if (not= kv v) v)]
                                     (let [k' (keyword (str (str (namespace n) "$" (name n)) "/" (name kv)))]
                                       [k' (if (or (clojure.core/map? v) (clojure.core/vector? v) (clojure.core/set? v))
                                             (coll-spec-fn env k' v) v)]))]
                       (-> acc
                           (update ak (fnil conj []) k')
                           (cond-> v' (update ::defs (fnil conj []) [k' v'])))))
                   {}
                   m)
               defs (::defs m)
               margs (apply concat (dissoc m ::defs))]
           `(do
              ~@(for [[k v] defs]
                  `(s/def ~k ~v))
              (spec (s/keys ~@margs))))))))

#?(:clj
   (defn- coll-spec-fn [env n m]
     (if-let [f (cond
                  (clojure.core/map? m) -map
                  (clojure.core/vector? m) -vector
                  (clojure.core/set? m) -set)]
       (f env n m)
       `~m)))

#?(:clj
   (defmacro coll-spec [n m]
     (coll-spec-fn &env n m)))

;;
;; clojure.core predicates as Specs
;;

(def any? (spec clojure.core/any?))
(def some? (spec clojure.core/some?))
(def number? (spec clojure.core/number?))
(def integer? (spec clojure.core/integer?))
(def int? (spec clojure.core/int?))
(def pos-int? (spec clojure.core/pos-int?))
(def neg-int? (spec clojure.core/neg-int?))
(def nat-int? (spec clojure.core/nat-int?))
(def float? (spec clojure.core/float?))
(def double? (spec clojure.core/double?))
(def boolean? (spec clojure.core/boolean?))
(def string? (spec clojure.core/string?))
(def ident? (spec clojure.core/ident?))
(def simple-ident? (spec clojure.core/simple-ident?))
(def qualified-ident? (spec clojure.core/qualified-ident?))
(def keyword? (spec clojure.core/keyword?))
(def simple-keyword? (spec clojure.core/simple-keyword?))
(def qualified-keyword? (spec clojure.core/qualified-keyword?))
(def symbol? (spec clojure.core/symbol?))
(def simple-symbol? (spec clojure.core/simple-symbol?))
(def qualified-symbol? (spec clojure.core/qualified-symbol?))
(def uuid? (spec clojure.core/uuid?))
#?(:clj (def uri? (spec clojure.core/uri?)))
#?(:clj (def bigdec? (spec clojure.core/bigdec?)))
(def inst? (spec clojure.core/inst?))
(def seqable? (spec clojure.core/seqable?))
(def indexed? (spec clojure.core/indexed?))
(def map? (spec clojure.core/map?))
(def vector? (spec clojure.core/vector?))
(def list? (spec clojure.core/list?))
(def seq? (spec clojure.core/seq?))
(def char? (spec clojure.core/char?))
(def set? (spec clojure.core/set?))
(def nil? (spec clojure.core/nil?))
(def false? (spec clojure.core/false?))
(def true? (spec clojure.core/true?))
(def zero? (spec clojure.core/zero?))
#?(:clj (def rational? (spec clojure.core/rational?)))
(def coll? (spec clojure.core/coll?))
(def empty? (spec clojure.core/empty?))
(def associative? (spec clojure.core/associative?))
(def sequential? (spec clojure.core/sequential?))
#?(:clj (def ratio? (spec clojure.core/ratio?)))
#?(:clj (def bytes? (spec clojure.core/bytes?)))

(ns spec-tools.core
  (:refer-clojure :exclude [any? some? number? integer? int? pos-int? neg-int? nat-int?
                            float? double? boolean? string? ident? simple-ident? qualified-ident?
                            keyword? simple-keyword? qualified-keyword? symbol? simple-symbol?
                            qualified-symbol? uuid? uri? bigdec? inst? seqable? indexed?
                            map? vector? list? seq? char? set? nil? false? true? zero?
                            rational? coll? empty? associative? sequential? ratio? bytes?
                            #?@(:cljs [Inst Keyword UUID])])
  #?(:cljs (:require-macros [spec-tools.core :refer [spec coll-spec]]))
  (:require [spec-tools.impl :as impl]
            [spec-tools.types :as types]
            [spec-tools.conform :as conform]
            [clojure.spec :as s]
    #?@(:clj  [
            [clojure.spec.gen :as gen]
            [clojure.edn]]
        :cljs [[goog.date.UtcDateTime]
               [cljs.reader]
               [goog.date.Date]
               [clojure.test.check.generators]
               [cljs.spec.impl.gen :as gen]]))
  (:import
    #?@(:clj
        [(clojure.lang AFn IFn Var)
         (java.io Writer)])))

;;
;; helpers
;;

(defn ^:skip-wiki registry
  ([]
   (s/registry))
  ([re]
   (->> (s/registry)
        (filter #(-> % first str (subs 1) (->> (re-matches re))))
        (into {}))))

(defn ^:skip-wiki eq [value]
  #{value})

(defn ^:skip-wiki set-of [value]
  (s/coll-of
    value
    :kind clojure.core/set?))

(defn ^:skip-wiki enum [& values]
  (s/spec (set values)))

(defn ^:skip-wiki serialize
  "Writes specs into a string that can be read by the reader.
  TODO: Should optionally write the realated Registry entries."
  [spec]
  (pr-str (s/form spec)))

(defn ^:skip-wiki deserialize
  "Reads specs from a string.
  TODO: Should optionally read the realated Registry entries."
  [s]
  #?(:clj  (clojure.edn/read-string s)
     :cljs (cljs.reader/read-string s)))

(def invalid '::s/invalid)

;;
;; Dynamic conforming
;;

(def ^:dynamic ^:private *conformers* nil)

(def json-conformers
  {:keyword conform/string->keyword
   :uuid conform/string->uuid
   :date conform/string->date
   :symbol conform/string->symbol
   ;; TODO: implement
   :uri nil
   :bigdec nil
   :ratio nil})

(def string-conformers
  (merge
    json-conformers
    {:long conform/string->long
     :double conform/string->double
     :boolean conform/string->boolean
     :nil conform/string->nil
     :string nil}))

(defn explain
  ([spec value]
   (explain spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (s/explain spec value))))

(defn explain-data
  ([spec value]
   (explain-data spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (s/explain-data spec value))))

(defn conform
  ([spec value]
   (conform spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (s/conform spec value))))

(defn conform!
  ([spec value]
   (conform! spec value nil))
  ([spec value conformers]
   (binding [*conformers* conformers]
     (let [conformed (s/conform spec value)]
       (if-not (= conformed invalid)
         conformed
         (let [problems (s/explain-data spec value)]
           (throw
             (ex-info
               "Spec conform error"
               (merge
                 problems
                 {:type :spec/problems
                  :spec spec
                  :value value})))))))))

;;
;; Spec Record
;;

(defn- extra-spec-map [t]
  (dissoc t :spec/form :pred))

(defn- fail-on-invoke [spec]
  (throw
    (ex-info
      (str
        "Can't invoke spec with a non-function predicate: " spec)
      {:spec spec})))

(defrecord Spec [pred]
  #?@(:clj
      [s/Specize
       (specize* [s] s)
       (specize* [s _] s)])

  s/Spec
  (conform* [this x]
    ;; function predicate
    (if (and (fn? pred) (pred x))
      x
      ;; there is a dynamic conformer
      (if-let [conformer (get *conformers* (:spec/type this))]
        (conformer this x)
        ;; spec predicate
        (if (s/spec? pred)
          (s/conform pred x)
          ;; invalid
          invalid))))
  (unform* [_ x]
    x)
  (explain* [this path via in x]
    (let [problems (if (s/spec? pred)
                     (s/explain* pred path via in (s/conform* this x))
                     (when (= invalid (if (and (fn? pred) (pred (s/conform* this x))) x invalid))
                       [{:path path
                         :pred (s/abbrev (:spec/form this))
                         :val x
                         :via via
                         :in in}]))
          spec-reason (:spec/reason this)
          with-reason (fn [{:keys [reason] :as problem}]
                        (cond-> problem
                                (and spec-reason (not reason))
                                (assoc :reason spec-reason)))]
      (if problems
        (map with-reason problems))))
  (gen* [this _ _ _]
    (if-let [gen (:spec/gen this)]
      (gen)
      (gen/gen-for-pred pred)))
  (with-gen* [this gfn]
    (assoc this :spec/gen gfn))
  (describe* [this]
    (let [info (extra-spec-map this)]
      `(spec ~(:spec/form this) ~info)))
  IFn
  #?(:clj  (invoke [this x] (if (fn? pred) (pred x) (fail-on-invoke this)))
     :cljs (-invoke [this x] (if (fn? pred) (pred x) (fail-on-invoke this)))))

#?(:clj
   (defmethod print-method Spec
     [^Spec t ^Writer w]
     (.write w (str "#Spec"
                    (merge
                      (select-keys t [:spec/form])
                      (if (:spec/type t) (select-keys t [:spec/type]))
                      (extra-spec-map t))))))

(defn spec? [x]
  (if (instance? Spec x) x))

;; TODO: use http://dev.clojure.org/jira/browse/CLJ-2112
(defn- extract-extra-info [form]
  (if (and
        (clojure.core/seq? form)
        (= 'clojure.spec/keys (impl/clojure-core-symbol-or-any (first form))))
    (if-let [m (some->> form
                        (rest)
                        (apply hash-map))]
      {:spec/keys (set
                    (concat
                      (:req m)
                      (:opt m)
                      (map (comp keyword name) (:req-un m))
                      (map (comp keyword name) (:opt-un m))))})))

(defn create-spec [m]
  (let [form (or (:spec/form m) (s/form (:pred m)))
        info (extract-extra-info form)
        type (if-not (contains? m :spec/type)
               (types/resolve-type form)
               (:spec/type m))]
    (map->Spec (merge m info {:spec/form form, :spec/type type}))))

#?(:clj
   (defmacro spec
     ([pred]
      `(spec ~pred {}))
     ([pred info]
      (if (impl/in-cljs? &env)
        `(let [info# ~info
               form# (if (clojure.core/symbol? '~pred)
                       '~(or (and (clojure.core/symbol? pred) (some->> pred (impl/cljs-resolve &env) impl/->sym)) pred))]
           (assert (clojure.core/map? info#) (str "spec info should be a map, was: " info#))
           (create-spec
             (merge
               ~info
               {:spec/form form#
                :pred ~pred})))
        `(let [info# ~info
               form# (if (clojure.core/symbol? '~pred)
                       '~(or (and (clojure.core/symbol? pred) (some->> pred resolve impl/->sym)) pred))]
           (assert (clojure.core/map? info#) (str "spec info should be a map, was: " info#))
           (create-spec
             (merge
               ~info
               {:spec/form form#
                :pred ~pred})))))))

#?(:clj
   (defmacro doc [pred info]
     `(spec ~pred (merge ~info {:spec/type nil}))))

;;
;; Map Spec
;;

(defrecord OptionalKey [k])
(defrecord RequiredKey [k])

(defn opt [k] (->OptionalKey k))
(defn req [k] (->RequiredKey k))

#?(:clj (declare ^:private coll-spec-fn))

#?(:clj
   (defn- -vector [env n v]
     (if-not (= 1 (count v))
       (throw
         (ex-info
           "only single maps allowed in nested vectors"
           {:k n :v v}))
       `(spec (s/coll-of ~(coll-spec-fn env n (first v)) :into [])))))

#?(:clj
   (defn- -set [env n v]
     (if-not (= 1 (count v))
       (throw
         (ex-info
           "only single maps allowed in nested sets"
           {:k n :v v}))
       `(spec (s/coll-of ~(coll-spec-fn env n (first v)) :into #{})))))

#?(:clj
   (defn- -map [env n m]
     (let [resolve (if (impl/in-cljs? env) (partial impl/cljs-resolve env) resolve)
           resolved-opt (resolve `opt)
           resolved-req (resolve `req)]

       ;; predicate keys
       (if-let [key-spec (and (= 1 (count m))
                              (let [k (first (keys m))]
                                (and
                                  (not
                                    (or (clojure.core/keyword? k)
                                        (and (clojure.core/seq? k)
                                             (let [resolved (resolve (first k))]
                                               (#{resolved-opt resolved-req} resolved)))))
                                  k)))]
         `(spec (s/map-of ~key-spec ~(coll-spec-fn env n (first (vals m)))))
         ;; keyword keys
         (let [m (reduce-kv
                   (fn [acc k v]
                     (let [[req? kv] (if (clojure.core/seq? k) [(not= resolved-opt (resolve (first k))) (second k)] [true k])
                           k1 (if req? "req" "opt")
                           k2 (if-not (clojure.core/qualified-keyword? kv) "-un")
                           ak (keyword (str k1 k2))
                           [k' v'] (if (clojure.core/qualified-keyword? kv)
                                     [kv (if (not= kv v) v)]
                                     (let [k' (keyword (str (str (namespace n) "$" (name n)) "/" (name kv)))]
                                       [k' (if (or (clojure.core/map? v) (clojure.core/vector? v) (clojure.core/set? v))
                                             (coll-spec-fn env k' v) v)]))]
                       (-> acc
                           (update ak (fnil conj []) k')
                           (cond-> v' (update ::defs (fnil conj []) [k' v'])))))
                   {}
                   m)
               defs (::defs m)
               margs (apply concat (dissoc m ::defs))]
           `(do
              ~@(for [[k v] defs]
                  `(s/def ~k ~v))
              (spec (s/keys ~@margs))))))))

#?(:clj
   (defn- coll-spec-fn [env n m]
     (if-let [f (cond
                  (clojure.core/map? m) -map
                  (clojure.core/vector? m) -vector
                  (clojure.core/set? m) -set)]
       (f env n m)
       `~m)))

#?(:clj
   (defmacro coll-spec [n m]
     (coll-spec-fn &env n m)))

;;
;; clojure.core predicates as Specs
;;

(def any? (spec clojure.core/any?))
(def some? (spec clojure.core/some?))
(def number? (spec clojure.core/number?))
(def integer? (spec clojure.core/integer?))
(def int? (spec clojure.core/int?))
(def pos-int? (spec clojure.core/pos-int?))
(def neg-int? (spec clojure.core/neg-int?))
(def nat-int? (spec clojure.core/nat-int?))
(def float? (spec clojure.core/float?))
(def double? (spec clojure.core/double?))
(def boolean? (spec clojure.core/boolean?))
(def string? (spec clojure.core/string?))
(def ident? (spec clojure.core/ident?))
(def simple-ident? (spec clojure.core/simple-ident?))
(def qualified-ident? (spec clojure.core/qualified-ident?))
(def keyword? (spec clojure.core/keyword?))
(def simple-keyword? (spec clojure.core/simple-keyword?))
(def qualified-keyword? (spec clojure.core/qualified-keyword?))
(def symbol? (spec clojure.core/symbol?))
(def simple-symbol? (spec clojure.core/simple-symbol?))
(def qualified-symbol? (spec clojure.core/qualified-symbol?))
(def uuid? (spec clojure.core/uuid?))
#?(:clj (def uri? (spec clojure.core/uri?)))
#?(:clj (def bigdec? (spec clojure.core/bigdec?)))
(def inst? (spec clojure.core/inst?))
(def seqable? (spec clojure.core/seqable?))
(def indexed? (spec clojure.core/indexed?))
(def map? (spec clojure.core/map?))
(def vector? (spec clojure.core/vector?))
(def list? (spec clojure.core/list?))
(def seq? (spec clojure.core/seq?))
(def char? (spec clojure.core/char?))
(def set? (spec clojure.core/set?))
(def nil? (spec clojure.core/nil?))
(def false? (spec clojure.core/false?))
(def true? (spec clojure.core/true?))
(def zero? (spec clojure.core/zero?))
#?(:clj (def rational? (spec clojure.core/rational?)))
(def coll? (spec clojure.core/coll?))
(def empty? (spec clojure.core/empty?))
(def associative? (spec clojure.core/associative?))
(def sequential? (spec clojure.core/sequential?))
#?(:clj (def ratio? (spec clojure.core/ratio?)))
#?(:clj (def bytes? (spec clojure.core/bytes?)))

Mark code only for clj

Mark code only for clj


(ns status-im.keycard.login
  (:require [status-im.ethereum.core :as ethereum]
            [status-im.navigation :as navigation]
            [status-im.utils.fx :as fx]
            [status-im.utils.types :as types]
            [taoensso.timbre :as log]
            [status-im.keycard.common :as common]
            [status-im.keycard.recovery :as recovery]
            [status-im.keycard.onboarding :as onboarding]
            status-im.keycard.fx
            [status-im.ui.components.bottom-sheet.core :as bottom-sheet]
            [status-im.signing.core :as signing.core]))

(fx/defn login-got-it-pressed
  {:events [:keycard.login.pin.ui/got-it-pressed
            :keycard.login.pin.ui/cancel-pressed]}
  [{:keys [db] :as cofx}]
  (fx/merge cofx
            {:db db}
            (navigation/navigate-to-cofx :multiaccounts nil)))

(fx/defn login-pin-more-icon-pressed
  {:events [:keycard.login.pin.ui/more-icon-pressed]}
  [cofx]
  (bottom-sheet/show-bottom-sheet cofx {:view :keycard.login/more}))

(fx/defn login-create-key-pressed
  {:events [:keycard.login.ui/create-new-key-pressed]}
  [cofx]
  (fx/merge cofx
            (bottom-sheet/hide-bottom-sheet)
            (onboarding/start-onboarding-flow)))

(fx/defn login-add-key-pressed
  {:events [:keycard.login.ui/add-key-pressed]}
  [cofx]
  (recovery/start-import-flow cofx))

(fx/defn login-remember-me-changed
  {:events [:keycard.login.ui/remember-me-changed]}
  [{:keys [db] :as cofx} value]
  (fx/merge cofx
            {:db (assoc-in db [:keycard :remember-me?] value)}))

(fx/defn login-pair-card-pressed
  {:events [:keycard.login.ui/pair-card-pressed]}
  [{:keys [db] :as cofx}]
  (log/debug "[keycard] load-pair-card-pressed")
  (fx/merge cofx
            {:db (assoc-in db [:keycard :flow] :login)}
            (navigation/navigate-to-cofx :keycard-recovery-pair nil)))

(fx/defn frozen-keycard-popup
  [{:keys [db]}]
  {:db (assoc db :popover/popover {:view :frozen-card})})

(fx/defn reset-pin
  {:events [::reset-pin]}
  [{:keys [db] :as cofx}]
  (fx/merge
   cofx
   {:db (assoc db :keycard/new-account-sheet? false)}
   (signing.core/discard)
   (fn [{:keys [db]}]
     {:db (-> db
              (dissoc :popover/popover)
              (update-in [:keycard :pin] dissoc
                         :reset :puk)
              (update-in [:keycard :pin] assoc
                         :enter-step :reset
                         :error nil
                         :status nil))})
   (when-not (:multiaccounts/login db)
     (navigation/navigate-to-cofx
      :profile-stack
      {:screen :keycard-pin}))))

(fx/defn dismiss-frozen-keycard-popover
  {:events [::frozen-keycard-popover-dismissed]}
  [{:keys [db]}]
  {:db (-> db
           (dissoc :popover/popover)
           (update :keycard dissoc :setup-step))})

(fx/defn login-with-keycard
  {:events [:keycard/login-with-keycard]}
  [{:keys [db] :as cofx}]
  (let [{:keys [:pin-retry-counter :puk-retry-counter]
         :as application-info}
        (get-in db [:keycard :application-info])

        key-uid                (get-in db [:keycard :application-info :key-uid])
        multiaccount           (get-in db [:multiaccounts/multiaccounts (get-in db [:multiaccounts/login :key-uid])])
        multiaccount-key-uid   (get multiaccount :key-uid)
        multiaccount-mismatch? (or (nil? multiaccount)
                                   (not= multiaccount-key-uid key-uid))
        pairing                (:keycard-pairing multiaccount)]
    (log/debug "[keycard] login-with-keycard"
               "empty application info" (empty? application-info)
               "no key-uid" (empty? key-uid)
               "multiaccount-mismatch?" multiaccount-mismatch?
               "no pairing" (empty? pairing))
    (cond
      (empty? application-info)
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :not-keycard nil))

      (empty? key-uid)
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :keycard-blank nil))

      multiaccount-mismatch?
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :keycard-wrong nil))

      (empty? pairing)
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :keycard-unpaired nil))

      (and (zero? pin-retry-counter)
           (or (nil? puk-retry-counter)
               (= 5 puk-retry-counter)))
      nil #_(frozen-keycard-popup cofx)

      :else
      (common/get-keys-from-keycard cofx))))

(fx/defn proceed-to-login
  {:events [::login-after-reset]}
  [cofx]
  (log/debug "[keycard] proceed-to-login")
  (common/show-connection-sheet
   cofx
   {:sheet-options     {:on-cancel [::common/cancel-sheet-confirm]}
    :on-card-connected :keycard/get-application-info
    :on-card-read      :keycard/login-with-keycard
    :handler           (common/get-application-info nil :keycard/login-with-keycard)}))

(fx/defn on-keycard-keychain-keys
  {:events [:multiaccounts.login.callback/get-keycard-keys-success]}
  [{:keys [db] :as cofx} key-uid [encryption-public-key whisper-private-key :as creds]]
  (if (nil? creds)
    (navigation/navigate-to-cofx cofx :keycard-login-pin nil)
    (let [{:keys [photo-path name]} (get-in db [:multiaccounts/multiaccounts key-uid])
          multiaccount-data         (types/clj->json {:name       name
                                                      :key-uid    key-uid
                                                      :photo-path photo-path})
          account-data {:key-uid               key-uid
                        :encryption-public-key encryption-public-key
                        :whisper-private-key   whisper-private-key}]
      {:db
       (-> db
           (assoc-in [:keycard :pin :status] nil)
           (assoc-in [:keycard :pin :login] [])
           (assoc-in [:keycard :multiaccount]
                     (update account-data :whisper-public-key ethereum/normalized-hex))
           (assoc-in [:keycard :flow] nil)
           (update :multiaccounts/login assoc
                   :password encryption-public-key
                   :key-uid key-uid
                   :photo-path photo-path
                   :name name
                   :save-password? true))
       :keycard/login-with-keycard
       {:multiaccount-data multiaccount-data
        :password          encryption-public-key
        :chat-key          whisper-private-key}})))

(fx/defn on-login-success
  {:events [:keycard.login.callback/login-success]}
  [_ result]
  (log/debug "loginWithKeycard success: " result))

(ns status-im.keycard.login
  (:require [status-im.ethereum.core :as ethereum]
            [status-im.navigation :as navigation]
            [status-im.utils.fx :as fx]
            [status-im.utils.types :as types]
            [taoensso.timbre :as log]
            [status-im.keycard.common :as common]
            [status-im.keycard.recovery :as recovery]
            [status-im.keycard.onboarding :as onboarding]
            status-im.keycard.fx
            [status-im.ui.components.bottom-sheet.core :as bottom-sheet]
            [status-im.signing.core :as signing.core]))

(fx/defn login-got-it-pressed
  {:events [:keycard.login.pin.ui/got-it-pressed
            :keycard.login.pin.ui/cancel-pressed]}
  [{:keys [db] :as cofx}]
  (fx/merge cofx
            {:db db}
            (navigation/navigate-to-cofx :multiaccounts nil)))

(fx/defn login-pin-more-icon-pressed
  {:events [:keycard.login.pin.ui/more-icon-pressed]}
  [cofx]
  (bottom-sheet/show-bottom-sheet cofx {:view :keycard.login/more}))

(fx/defn login-create-key-pressed
  {:events [:keycard.login.ui/create-new-key-pressed]}
  [cofx]
  (fx/merge cofx
            (bottom-sheet/hide-bottom-sheet)
            (onboarding/start-onboarding-flow)))

(fx/defn login-add-key-pressed
  {:events [:keycard.login.ui/add-key-pressed]}
  [cofx]
  (recovery/start-import-flow cofx))

(fx/defn login-remember-me-changed
  {:events [:keycard.login.ui/remember-me-changed]}
  [{:keys [db] :as cofx} value]
  (fx/merge cofx
            {:db (assoc-in db [:keycard :remember-me?] value)}))

(fx/defn login-pair-card-pressed
  {:events [:keycard.login.ui/pair-card-pressed]}
  [{:keys [db] :as cofx}]
  (log/debug "[keycard] load-pair-card-pressed")
  (fx/merge cofx
            {:db (assoc-in db [:keycard :flow] :login)}
            (navigation/navigate-to-cofx :keycard-recovery-pair nil)))

(fx/defn frozen-keycard-popup
  [{:keys [db]}]
  {:db (assoc db :popover/popover {:view :frozen-card})})

(fx/defn reset-pin
  {:events [::reset-pin]}
  [{:keys [db] :as cofx}]
  (fx/merge
   cofx
   {:db (assoc db :keycard/new-account-sheet? false)}
   (signing.core/discard)
   (fn [{:keys [db]}]
     {:db (-> db
              (dissoc :popover/popover)
              (update-in [:keycard :pin] dissoc
                         :reset :puk)
              (update-in [:keycard :pin] assoc
                         :enter-step :reset
                         :error nil
                         :status nil))})
   (when-not (:multiaccounts/login db)
     (navigation/navigate-to-cofx
      :profile-stack
      {:screen :keycard-pin}))))

(fx/defn dismiss-frozen-keycard-popover
  {:events [::frozen-keycard-popover-dismissed]}
  [{:keys [db]}]
  {:db (-> db
           (dissoc :popover/popover)
           (update :keycard dissoc :setup-step))})

(fx/defn login-with-keycard
  {:events [:keycard/login-with-keycard]}
  [{:keys [db] :as cofx}]
  (let [{:keys [:pin-retry-counter :puk-retry-counter]
         :as application-info}
        (get-in db [:keycard :application-info])

        key-uid                (get-in db [:keycard :application-info :key-uid])
        multiaccount           (get-in db [:multiaccounts/multiaccounts (get-in db [:multiaccounts/login :key-uid])])
        multiaccount-key-uid   (get multiaccount :key-uid)
        multiaccount-mismatch? (or (nil? multiaccount)
                                   (not= multiaccount-key-uid key-uid))
        pairing                (:keycard-pairing multiaccount)]
    (log/debug "[keycard] login-with-keycard"
               "empty application info" (empty? application-info)
               "no key-uid" (empty? key-uid)
               "multiaccount-mismatch?" multiaccount-mismatch?
               "no pairing" (empty? pairing))
    (cond
      (empty? application-info)
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :not-keycard nil))

      (empty? key-uid)
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :keycard-blank nil))

      multiaccount-mismatch?
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :keycard-wrong nil))

      (empty? pairing)
      (fx/merge cofx
                (common/hide-connection-sheet)
                (navigation/navigate-to-cofx :keycard-unpaired nil))

      (and (zero? pin-retry-counter)
           (or (nil? puk-retry-counter)
               (= 5 puk-retry-counter)))
      nil #_(frozen-keycard-popup cofx)

      :else
      (common/get-keys-from-keycard cofx))))

(fx/defn proceed-to-login
  {:events [::login-after-reset]}
  [cofx]
  (log/debug "[keycard] proceed-to-login")
  (common/show-connection-sheet
   cofx
   {:sheet-options     {:on-cancel [::common/cancel-sheet-confirm]}
    :on-card-connected :keycard/get-application-info
    :on-card-read      :keycard/login-with-keycard
    :handler           (common/get-application-info nil :keycard/login-with-keycard)}))

(fx/defn on-keycard-keychain-keys
  {:events [:multiaccounts.login.callback/get-keycard-keys-success]}
  [{:keys [db] :as cofx} key-uid [encryption-public-key whisper-private-key :as creds]]
  (if (nil? creds)
    (navigation/navigate-to-cofx cofx :keycard-login-pin nil)
    (let [{:keys [photo-path name]} (get-in db [:multiaccounts/multiaccounts key-uid])
          multiaccount-data         (types/clj->json {:name       name
                                                      :key-uid    key-uid
                                                      :photo-path photo-path})
          account-data {:key-uid               key-uid
                        :encryption-public-key encryption-public-key
                        :whisper-private-key   whisper-private-key}]
      {:db
       (-> db
           (assoc-in [:keycard :pin :status] nil)
           (assoc-in [:keycard :pin :login] [])
           (assoc-in [:keycard :multiaccount]
                     (update account-data :whisper-public-key ethereum/normalized-hex))
           (assoc-in [:keycard :flow] nil)
           (update :multiaccounts/login assoc
                   :password encryption-public-key
                   :key-uid key-uid
                   :photo-path photo-path
                   :name name
                   :save-password? true))
       :keycard/login-with-keycard
       {:multiaccount-data multiaccount-data
        :key-uid           key-uid
        :password          encryption-public-key
        :chat-key          whisper-private-key}})))

(fx/defn on-login-success
  {:events [:keycard.login.callback/login-success]}
  [_ result]
  (log/debug "loginWithKeycard success: " result))

[#10976] Fix crash on kk login with enabled fingerprint