(ns status-im.contacts.subs
  (:require-macros [reagent.ratom :refer [reaction]])
  (:require [re-frame.core :refer [register-sub subscribe]]
            [status-im.utils.identicon :refer [identicon]]
            [taoensso.timbre :as log]))

(register-sub :get-contacts
  (fn [db _]
    (let [contacts (reaction (:contacts @db))]
      (reaction @contacts))))

(defn sort-contacts [contacts]
  (->> (vals contacts)
       (sort (fn [c1 c2]
               (let [name1 (or (:name c1) (:address c1) (:whisper-identity c1))
                     name2 (or (:name c2) (:address c2) (:whisper-identity c2))]
                 (compare (clojure.string/lower-case name1)
                          (clojure.string/lower-case name2)))))))

(register-sub :all-added-contacts
  (fn [db _]
    (let [contacts (reaction (:contacts @db))]
      (->> (remove #(true? (:pending (second %))) @contacts)
           (sort-contacts)
           (reaction)))))

(register-sub :all-added-people
  (fn []
    (let [contacts (subscribe [:all-added-contacts])]
      (reaction (remove :dapp? @contacts)))))

(register-sub :all-added-dapps
  (fn []
    (let [contacts (subscribe [:all-added-contacts])]
      (reaction (filter :dapp? @contacts)))))

(register-sub :get-added-people-with-limit
  (fn [_ [_ limit]]
    (let [contacts (subscribe [:all-added-people])]
      (reaction (take limit @contacts)))))

(register-sub :get-added-dapps-with-limit
  (fn [_ [_ limit]]
    (let [contacts (subscribe [:all-added-dapps])]
      (reaction (take limit @contacts)))))

(register-sub :added-people-count
  (fn [_ _]
    (let [contacts (subscribe [:all-added-people])]
      (reaction (count @contacts)))))

(register-sub :added-dapps-count
  (fn [_ _]
    (let [contacts (subscribe [:all-added-dapps])]
      (reaction (count @contacts)))))

(defn get-contact-letter [contact]
  (when-let [letter (first (:name contact))]
    (clojure.string/upper-case letter)))

(register-sub :contacts-with-letters
  (fn [db _]
    (let [contacts (reaction (:contacts @db))
          pred     (subscribe [:get :contacts-filter])]
      (reaction
        (let [ordered (sort-contacts @contacts)
              ordered (if pred (filter @pred ordered) ordered)]
          (reduce (fn [prev cur]
                    (let [prev-letter (get-contact-letter (last prev))
                          cur-letter  (get-contact-letter cur)]
                      (conj prev
                            (if (not= prev-letter cur-letter)
                              (assoc cur :letter cur-letter)
                              cur))))
                  [] ordered))))))

(defn contacts-by-chat [fn db chat-id]
  (let [chat     (reaction (get-in @db [:chats chat-id]))
        contacts (reaction (:contacts @db))]
    (reaction
      (when @chat
        (let [current-participants (->> @chat
                                        :contacts
                                        (map :identity)
                                        set)]
          (fn #(current-participants (:whisper-identity %))
              (vals @contacts)))))))

(defn contacts-by-current-chat [fn db]
  (let [current-chat-id (:current-chat-id @db)]
    (contacts-by-chat fn db current-chat-id)))

(register-sub :contact
  (fn [db _]
    (let [identity (:contact-identity @db)]
      (reaction (get-in @db [:contacts identity])))))

(register-sub :contact-by-identity
  (fn [db [_ identity]]
    (reaction (get-in @db [:contacts identity]))))

(register-sub :all-new-contacts
  (fn [db _]
    (contacts-by-current-chat remove db)))

(register-sub :current-chat-contacts
  (fn [db _]
    (contacts-by-current-chat filter db)))

(register-sub :chat-photo
  (fn [db [_ chat-id]]
    (let [chat-id  (or chat-id (:current-chat-id @db))
          chat     (reaction (get-in @db [:chats chat-id]))
          contacts (contacts-by-chat filter db chat-id)]
      (reaction
        (when @chat
          (if (:group-chat @chat)
            ;; TODO return group chat icon
            nil
            (cond
              (:photo-path @chat)
              (:photo-path @chat)

              (pos? (count @contacts))
              (:photo-path (first @contacts))

              :else
              (identicon chat-id))))))))

(ns status-im.contacts.subs
  (:require-macros [reagent.ratom :refer [reaction]])
  (:require [re-frame.core :refer [register-sub subscribe]]
            [status-im.utils.identicon :refer [identicon]]
            [taoensso.timbre :as log]))

(register-sub :get-contacts
  (fn [db _]
    (let [contacts (reaction (:contacts @db))]
      (reaction @contacts))))

(defn sort-contacts [contacts]
  (->> (vals contacts)
       (sort (fn [c1 c2]
               (let [name1 (or (:name c1) (:address c1) (:whisper-identity c1))
                     name2 (or (:name c2) (:address c2) (:whisper-identity c2))]
                 (compare (clojure.string/lower-case name1)
                          (clojure.string/lower-case name2)))))))

(register-sub :all-added-contacts
  (fn [db _]
    (let [contacts (reaction (:contacts @db))]
      (->> (remove #(true? (:pending (second %))) @contacts)
           (sort-contacts)
           (reaction)))))

(register-sub :all-added-people
  (fn []
    (let [contacts (subscribe [:all-added-contacts])]
      (reaction (remove :dapp? @contacts)))))

(register-sub :all-added-dapps
  (fn []
    (let [contacts (subscribe [:all-added-contacts])]
      (reaction (filter :dapp? @contacts)))))

(register-sub :get-added-people-with-limit
  (fn [_ [_ limit]]
    (let [contacts (subscribe [:all-added-people])]
      (reaction (take limit @contacts)))))

(register-sub :get-added-dapps-with-limit
  (fn [_ [_ limit]]
    (let [contacts (subscribe [:all-added-dapps])]
      (reaction (take limit @contacts)))))

(register-sub :added-people-count
  (fn [_ _]
    (let [contacts (subscribe [:all-added-people])]
      (reaction (count @contacts)))))

(register-sub :added-dapps-count
  (fn [_ _]
    (let [contacts (subscribe [:all-added-dapps])]
      (reaction (count @contacts)))))

(defn get-contact-letter [contact]
  (when-let [letter (first (:name contact))]
    (clojure.string/upper-case letter)))

(register-sub :contacts-with-letters
  (fn [db _]
    (let [contacts (reaction (:contacts @db))
          pred     (subscribe [:get :contacts-filter])]
      (reaction
        (let [ordered (sort-contacts @contacts)
              ordered (if @pred (filter @pred ordered) ordered)]
          (reduce (fn [prev cur]
                    (let [prev-letter (get-contact-letter (last prev))
                          cur-letter  (get-contact-letter cur)]
                      (conj prev
                            (if (not= prev-letter cur-letter)
                              (assoc cur :letter cur-letter)
                              cur))))
                  [] ordered))))))

(defn contacts-by-chat [fn db chat-id]
  (let [chat     (reaction (get-in @db [:chats chat-id]))
        contacts (reaction (:contacts @db))]
    (reaction
      (when @chat
        (let [current-participants (->> @chat
                                        :contacts
                                        (map :identity)
                                        set)]
          (fn #(current-participants (:whisper-identity %))
              (vals @contacts)))))))

(defn contacts-by-current-chat [fn db]
  (let [current-chat-id (:current-chat-id @db)]
    (contacts-by-chat fn db current-chat-id)))

(register-sub :contact
  (fn [db _]
    (let [identity (:contact-identity @db)]
      (reaction (get-in @db [:contacts identity])))))

(register-sub :contact-by-identity
  (fn [db [_ identity]]
    (reaction (get-in @db [:contacts identity]))))

(register-sub :all-new-contacts
  (fn [db _]
    (contacts-by-current-chat remove db)))

(register-sub :current-chat-contacts
  (fn [db _]
    (contacts-by-current-chat filter db)))

(register-sub :chat-photo
  (fn [db [_ chat-id]]
    (let [chat-id  (or chat-id (:current-chat-id @db))
          chat     (reaction (get-in @db [:chats chat-id]))
          contacts (contacts-by-chat filter db chat-id)]
      (reaction
        (when @chat
          (if (:group-chat @chat)
            ;; TODO return group chat icon
            nil
            (cond
              (:photo-path @chat)
              (:photo-path @chat)

              (pos? (count @contacts))
              (:photo-path (first @contacts))

              :else
              (identicon chat-id))))))))

fix #475

fix #475


(ns buddy.test_buddy_core
  (:require [clojure.test :refer :all]
            [buddy.core.codecs :refer :all]
            [buddy.core.keys :refer :all]
            [buddy.core.hash :as hash]
            [buddy.core.hmac :refer [shmac-sha256]]
            [buddy.hashers.pbkdf2 :as pbkdf2]
            [buddy.hashers.bcrypt :as bcrypt]
            [buddy.hashers.sha256 :as sha256]
            [buddy.hashers.md5 :as md5]
            [buddy.hashers.scrypt :as scrypt]
            [buddy.core.mac.poly1305 :as poly]
            [buddy.core.crypto.chacha :as chacha]
            [buddy.core.kdf :as kdf]
            [clojure.java.io :as io])
  (:import buddy.Arrays))

(deftest buddy-core-codecs
  (testing "Hex encode/decode 01"
    (let [some-bytes  (str->bytes "FooBar")
          encoded     (bytes->hex some-bytes)
          decoded     (hex->bytes encoded)
          some-str    (bytes->str decoded)]
      (is (Arrays/equals decoded, some-bytes))
      (is (= some-str "FooBar"))))

  (testing "Hex encode/decode 02"
    (let [mybytes (into-array Byte/TYPE (range 10))
          encoded (bytes->hex mybytes)
          decoded (hex->bytes encoded)]
      (is (Arrays/equals decoded mybytes)))))

(deftest buddy-hashers
  (testing "Test low level api for encrypt/verify pbkdf2"
    (let [plain-password      "my-test-password"
          encrypted-password  (pbkdf2/make-password plain-password)]
      (is (pbkdf2/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify sha256"
    (let [plain-password      "my-test-password"
          encrypted-password  (sha256/make-password plain-password)]
      (is (sha256/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify md5"
    (let [plain-password      "my-test-password"
          encrypted-password  (md5/make-password plain-password)]
      (is (md5/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify bcrypt"
    (let [plain-password      "my-test-password"
          encrypted-password  (bcrypt/make-password plain-password)]
      (is (bcrypt/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify scrypt"
    (let [plain-password      "my-test-password"
          encrypted-password  (scrypt/make-password plain-password)]
      (is (scrypt/check-password plain-password encrypted-password)))))

(deftest buddy-core-hash
  (testing "SHA3 support test"
    (let [plain-text "FooBar"
          hashed     (-> (hash/sha3-256 plain-text)
                         (bytes->hex))]
      (is (= hashed "0a3c119a02a37e50fbaf8a3776559c76de7a969097c05bd0f41f60cf25210745"))))
  (testing "File hashing"
    (let [path       "test/_files/pubkey.ecdsa.pem"
          valid-hash "7aa01e35e65701c9a9d8f71c4cbf056acddc9be17fdff06b4c7af1b0b34ddc29"]
      (is (= (bytes->hex (hash/sha256 (io/input-stream path))) valid-hash)))))

(deftest buddy-core-codecs
  (testing "Safe base64 encode/decode"
    (let [output1 (str->safebase64 "foo")
          output2 (safebase64->str output1)]
      (is (= output1 "Zm9v"))
      (is (= output2 "foo")))))

(deftest buddy-core-mac-poly1305
  (let [iv        (byte-array 16) ;; 16 bytes array filled with 0
        plaintext "text"
        secretkey "secret"]
    (testing "Poly1305 encrypt/verify (using string key)"
      (let [mac-bytes1 (poly/poly1305 plaintext secretkey iv :aes)
            mac-bytes2 (poly/poly1305 plaintext secretkey iv :aes)]
      (is (= (Arrays/equals mac-bytes1 mac-bytes2)))))

  (testing "Poly1305 explicit encrypt/verify (using string key)"
    (let [mac-bytes1 (poly/poly1305 plaintext secretkey iv :aes)]
      (is (= (-> mac-bytes1 (bytes->hex)) "98a94ff88861bf9b96bcb7112b506579"))))

  (testing "Poly1305-AES enc/verify using key with good iv"
    (let [iv1      (make-random-bytes 16)
          iv2      (make-random-bytes 16)
          macbytes (poly/poly1305 plaintext secretkey iv1 :aes)]
      (is (poly/poly1305-verify plaintext macbytes secretkey iv1 :aes))
      (is (not (poly/poly1305-verify plaintext macbytes secretkey iv2 :aes)))))

  (testing "Poly1305-Twofish env/verify"
    (let [iv2 (make-random-bytes 16)
          signature (poly/poly1305-twofish plaintext secretkey iv2)]
      (is (poly/poly1305-twofish-verify plaintext signature secretkey iv2))
      (is (not (poly/poly1305-twofish-verify plaintext signature secretkey iv)))))

  (testing "Poly1305-Serpent env/verify"
    (let [iv2 (make-random-bytes 16)
          signature (poly/poly1305-serpent plaintext secretkey iv2)]
      (is (poly/poly1305-serpent-verify plaintext signature secretkey iv2))
      (is (not (poly/poly1305-serpent-verify plaintext signature secretkey iv)))))))

(deftest buddy-core-crypto-chacha
  (let [iv1    (make-random-bytes 8)
        iv2    (make-random-bytes 8)
        key1   (make-random-bytes 32)
        key2   (make-random-bytes 16)
        plain1 (make-random-bytes 100)]
    (testing "Enc/Dec simple text"
      (let [encrypted (chacha/encrypt plain1 key1 iv1)]
        (is (Arrays/equals plain1 (chacha/decrypt encrypted key1 iv1)))
        (is (not (Arrays/equals plain1 (chacha/decrypt encrypted key1 iv2))))
        (is (not (Arrays/equals plain1 (chacha/decrypt encrypted key2 iv1))))))))

(deftest buddy-core-kdf
  (let [key1 (make-random-bytes 32)
        key2 (make-random-bytes 16)
        salt (make-random-bytes 8)
        info (make-random-bytes 8)]
    (testing "HKDF with sha256 with info"
      (let [generator1 (kdf/hkdf key1 salt info :sha256)
            generator2 (kdf/hkdf key1 salt info :sha256)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))
    (testing "HKDF with sha256 without info"
      (let [generator1 (kdf/hkdf key1 salt nil :sha256)
            generator2 (kdf/hkdf key1 salt nil :sha256)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))))

    (testing "KDF1 with sha512"
      (let [generator1 (kdf/kdf1 key1 salt :sha512)
            generator2 (kdf/kdf1 key1 salt :sha512)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "KDF2 with sha512"
      (let [generator1 (kdf/kdf2 key1 salt :sha512)
            generator2 (kdf/kdf2 key1 salt :sha512)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "CMKDF with sha3-512"
      (let [generator1 (kdf/cmkdf key1 salt :sha3-512)
            generator2 (kdf/cmkdf key1 salt :sha3-512)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "FMKDF with tiger"
      (let [generator1 (kdf/fmkdf key1 salt :tiger)
            generator2 (kdf/fmkdf key1 salt :tiger)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "DPIMKDF with sha3-256"
      (let [generator1 (kdf/dpimkdf key1 salt :sha3-256)
            generator2 (kdf/dpimkdf key1 salt :sha3-256)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

))

(ns buddy.test_buddy_core
  (:require [clojure.test :refer :all]
            [buddy.core.codecs :refer :all]
            [buddy.core.keys :refer :all]
            [buddy.core.hash :as hash]
            [buddy.core.hmac :refer [shmac-sha256]]
            [buddy.hashers.pbkdf2 :as pbkdf2]
            [buddy.hashers.bcrypt :as bcrypt]
            [buddy.hashers.sha256 :as sha256]
            [buddy.hashers.md5 :as md5]
            [buddy.hashers.scrypt :as scrypt]
            [buddy.core.mac.poly1305 :as poly]
            [buddy.core.crypto.chacha :as chacha]
            [buddy.core.kdf :as kdf]
            [clojure.java.io :as io])
  (:import buddy.Arrays))

(deftest buddy-core-codecs
  (testing "Hex encode/decode 01"
    (let [some-bytes  (str->bytes "FooBar")
          encoded     (bytes->hex some-bytes)
          decoded     (hex->bytes encoded)
          some-str    (bytes->str decoded)]
      (is (Arrays/equals decoded, some-bytes))
      (is (= some-str "FooBar"))))

  (testing "Hex encode/decode 02"
    (let [mybytes (into-array Byte/TYPE (range 10))
          encoded (bytes->hex mybytes)
          decoded (hex->bytes encoded)]
      (is (Arrays/equals decoded mybytes)))))

(deftest buddy-hashers
  (testing "Test low level api for encrypt/verify pbkdf2"
    (let [plain-password      "my-test-password"
          encrypted-password  (pbkdf2/make-password plain-password)]
      (is (pbkdf2/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify sha256"
    (let [plain-password      "my-test-password"
          encrypted-password  (sha256/make-password plain-password)]
      (is (sha256/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify md5"
    (let [plain-password      "my-test-password"
          encrypted-password  (md5/make-password plain-password)]
      (is (md5/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify bcrypt"
    (let [plain-password      "my-test-password"
          encrypted-password  (bcrypt/make-password plain-password)]
      (is (bcrypt/check-password plain-password encrypted-password))))

  (testing "Test low level api for encrypt/verify scrypt"
    (let [plain-password      "my-test-password"
          encrypted-password  (scrypt/make-password plain-password)]
      (is (scrypt/check-password plain-password encrypted-password)))))

(deftest buddy-core-hash
  (testing "SHA3 support test"
    (let [plain-text "FooBar"
          hashed     (-> (hash/sha3-256 plain-text)
                         (bytes->hex))]
      (is (= hashed "0a3c119a02a37e50fbaf8a3776559c76de7a969097c05bd0f41f60cf25210745"))))
  (testing "File hashing"
    (let [path       "test/_files/pubkey.ecdsa.pem"
          valid-hash "7aa01e35e65701c9a9d8f71c4cbf056acddc9be17fdff06b4c7af1b0b34ddc29"]
      (is (= (bytes->hex (hash/sha256 (io/input-stream path))) valid-hash)))))

(deftest buddy-core-codecs
  (testing "Safe base64 encode/decode"
    (let [output1 (str->safebase64 "foo")
          output2 (safebase64->str output1)]
      (is (= output1 "Zm9v"))
      (is (= output2 "foo")))))

(deftest buddy-core-mac-poly1305
  (let [iv        (byte-array 16) ;; 16 bytes array filled with 0
        plaintext "text"
        secretkey "secret"]
    (testing "Poly1305 encrypt/verify (using string key)"
      (let [mac-bytes1 (poly/poly1305 plaintext secretkey iv :aes)
            mac-bytes2 (poly/poly1305 plaintext secretkey iv :aes)]
      (is (= (Arrays/equals mac-bytes1 mac-bytes2)))))

  (testing "Poly1305 explicit encrypt/verify (using string key)"
    (let [mac-bytes1 (poly/poly1305 plaintext secretkey iv :aes)]
      (is (= (-> mac-bytes1 (bytes->hex)) "98a94ff88861bf9b96bcb7112b506579"))))

  (testing "File mac"
    (let [path       "test/_files/pubkey.ecdsa.pem"
          macbytes   (poly/poly1305 (io/input-stream path) secretkey iv :aes)]
      (is (poly/poly1305-verify (io/input-stream path) macbytes secretkey iv :aes))))

  (testing "Poly1305-AES enc/verify using key with good iv"
    (let [iv1      (make-random-bytes 16)
          iv2      (make-random-bytes 16)
          macbytes1 (poly/poly1305 plaintext secretkey iv1 :aes)
          macbytes2 (poly/poly1305-aes plaintext secretkey iv1)]
      (is (poly/poly1305-verify plaintext macbytes1 secretkey iv1 :aes))
      (is (poly/poly1305-aes-verify plaintext macbytes2 secretkey iv1))
      (is (not (poly/poly1305-verify plaintext macbytes1 secretkey iv2 :aes)))))

  (testing "Poly1305-Twofish env/verify"
    (let [iv2 (make-random-bytes 16)
          signature (poly/poly1305-twofish plaintext secretkey iv2)]
      (is (poly/poly1305-twofish-verify plaintext signature secretkey iv2))
      (is (not (poly/poly1305-twofish-verify plaintext signature secretkey iv)))))

  (testing "Poly1305-Serpent env/verify"
    (let [iv2 (make-random-bytes 16)
          signature (poly/poly1305-serpent plaintext secretkey iv2)]
      (is (poly/poly1305-serpent-verify plaintext signature secretkey iv2))
      (is (not (poly/poly1305-serpent-verify plaintext signature secretkey iv)))))))

(deftest buddy-core-crypto-chacha
  (let [iv1    (make-random-bytes 8)
        iv2    (make-random-bytes 8)
        key1   (make-random-bytes 32)
        key2   (make-random-bytes 16)
        plain1 (make-random-bytes 100)]
    (testing "Enc/Dec simple text"
      (let [encrypted (chacha/encrypt plain1 key1 iv1)]
        (is (Arrays/equals plain1 (chacha/decrypt encrypted key1 iv1)))
        (is (not (Arrays/equals plain1 (chacha/decrypt encrypted key1 iv2))))
        (is (not (Arrays/equals plain1 (chacha/decrypt encrypted key2 iv1))))))))

(deftest buddy-core-kdf
  (let [key1 (make-random-bytes 32)
        key2 (make-random-bytes 16)
        salt (make-random-bytes 8)
        info (make-random-bytes 8)]
    (testing "HKDF with sha256 with info"
      (let [generator1 (kdf/hkdf key1 salt info :sha256)
            generator2 (kdf/hkdf key1 salt info :sha256)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))
    (testing "HKDF with sha256 without info"
      (let [generator1 (kdf/hkdf key1 salt nil :sha256)
            generator2 (kdf/hkdf key1 salt nil :sha256)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))))

    (testing "KDF1 with sha512"
      (let [generator1 (kdf/kdf1 key1 salt :sha512)
            generator2 (kdf/kdf1 key1 salt :sha512)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "KDF2 with sha512"
      (let [generator1 (kdf/kdf2 key1 salt :sha512)
            generator2 (kdf/kdf2 key1 salt :sha512)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "CMKDF with sha3-512"
      (let [generator1 (kdf/cmkdf key1 salt :sha3-512)
            generator2 (kdf/cmkdf key1 salt :sha3-512)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "FMKDF with tiger"
      (let [generator1 (kdf/fmkdf key1 salt :tiger)
            generator2 (kdf/fmkdf key1 salt :tiger)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

    (testing "DPIMKDF with sha3-256"
      (let [generator1 (kdf/dpimkdf key1 salt :sha3-256)
            generator2 (kdf/dpimkdf key1 salt :sha3-256)
            bytes1     (kdf/generate-bytes! generator1 8)
            bytes2     (kdf/generate-bytes! generator1 8)
            bytes3     (kdf/generate-bytes! generator1 8)
            bytes4     (kdf/generate-bytes! generator1 8)]
        (is (Arrays/equals bytes1 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes2 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes3 (kdf/generate-bytes! generator2 8)))
        (is (Arrays/equals bytes4 (kdf/generate-bytes! generator2 8)))))

))

Add test for file poly1305 mac.

Add test for file poly1305 mac.


(ns db-quiz-prep.core
  (:gen-class)
  (:require [db-quiz-prep.mustache :as mustache]
            [db-quiz-prep.util :refer [join-lines]]
            [db-quiz-prep.prepare :as prepare]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure.edn :as edn]
            [schema.core :as s]
            [schema-contrib.core :as sc]))

; ----- Schemata -----

(def ^:private positive-number (s/both s/Int (s/pred pos? 'pos?)))

(def ^:private Config
  {:sparql-endpoint {:url sc/URI
                     :username s/Str
                     :password s/Str
                     :page-size positive-number}
   :data {:class sc/URI
          :surface-forms [sc/URI]
          :source-graph sc/URI
          :target-graph sc/URI}
   (s/optional-key :start-from) positive-number})

; ----- Private functions -----

(defn- error-msg
  [errors]
  (str "The following errors occurred while parsing your command:\n\n"
       (join-lines errors)))

(defn- exit
  "Exit with @status and message `msg`.
  `status` 0 is OK, `status` 1 indicates error."
  [^Integer status
   ^String msg]
  {:pre [(#{0 1} status)]}
  (println msg)
  (System/exit status))

(defn- usage
  "Wrap usage `summary` in a description of the program."
  [summary]
  (join-lines ["Execute unlimited SPARQL!"
               "Options:\n"
               summary]))

(def ^:private validate-config
  "Validate configuration `config` according to its schema."
  (let [expected-structure (s/explain Config)]
    (fn [config]
      (try (s/validate Config config) nil
           (catch RuntimeException e (join-lines ["Invalid configuration:"
                                                  (.getMessage e)
                                                  "The expected structure of configuration is:"
                                                  expected-structure]))))))

; ----- Private vars -----

(def ^:private cli-options
  [["-c" "--config CONFIG" "Path to configuration file in EDN"
    :parse-fn #(edn/read-string (slurp %))]
   ["-h" "--help" "Display help message"]])

; ----- Public functions -----

(defn -main
  [& args]
  (let [{{:keys [config help]} :options
         :keys [errors summary]} (parse-opts args cli-options)]
    (cond help (exit 0 (usage summary))
          errors (exit 1 (error-msg errors))
          :else (if-let [error (validate-config config)]
                    (exit 1 error)
                    (prepare/execute config)))))

(ns db-quiz-prep.core
  (:gen-class)
  (:require [db-quiz-prep.mustache :as mustache]
            [db-quiz-prep.util :refer [join-lines]]
            [db-quiz-prep.prepare :as prepare]
            [clojure.tools.cli :refer [parse-opts]]
            [clojure.edn :as edn]
            [schema.core :as s]
            [schema-contrib.core :as sc]))

; ----- Schemata -----

(def ^:private positive-number (s/both s/Int (s/pred pos? 'pos?)))

(def ^:private degree (s/both positive-number (s/pred (partial >= 180) 'degree?)))

(def ^:private Config
  {:sparql-endpoint {:url sc/URI
                     :username s/Str
                     :password s/Str
                     :page-size positive-number}
   :data {:class sc/URI
          :surface-forms [sc/URI]
          :source-graph sc/URI
          :target-graph sc/URI}
   :split-angles {:easy degree
                  :normal degree}
   (s/optional-key :start-from) positive-number})

; ----- Private functions -----

(defn- error-msg
  [errors]
  (str "The following errors occurred while parsing your command:\n\n"
       (join-lines errors)))

(defn- exit
  "Exit with @status and message `msg`.
  `status` 0 is OK, `status` 1 indicates error."
  [^Integer status
   ^String msg]
  {:pre [(#{0 1} status)]}
  (println msg)
  (System/exit status))

(defn- usage
  "Wrap usage `summary` in a description of the program."
  [summary]
  (join-lines ["DB-quiz data pre-processing tool"
               "Options:\n"
               summary]))

(def ^:private validate-config
  "Validate configuration `config` according to its schema."
  (let [expected-structure (s/explain Config)]
    (fn [config]
      (try (s/validate Config config) nil
           (catch RuntimeException e (join-lines ["Invalid configuration:"
                                                  (.getMessage e)
                                                  "The expected structure of configuration is:"
                                                  expected-structure]))))))

; ----- Private vars -----

(def ^:private cli-options
  [["-c" "--config CONFIG" "Path to configuration file in EDN"
    :parse-fn #(edn/read-string (slurp %))]
   ["-t" "--task TASK" "Task to execute. Either 'questions' or 'difficulties'."
    :validate [#{"questions" "difficulties"} "Task to execute must be either 'questions' or 'difficulties'."]]
   ["-h" "--help" "Display help message"]])

; ----- Public functions -----

(defn -main
  [& args]
  (let [{{:keys [config help task]} :options
         :keys [errors summary]} (parse-opts args cli-options)]
    (cond help (exit 0 (usage summary))
          errors (exit 1 (error-msg errors))
          :else (if-let [error (validate-config config)]
                    (exit 1 error)
                    (prepare/execute config task)))))

Split materialization into tasks

Split materialization into tasks


(ns re-natal-esp32control-app.views.ble-control.magnetometer
  (:require [clojure.string :as str]
            [reagent.core :as r]
            [re-frame.core :refer [subscribe dispatch dispatch-sync]]
            [re-natal-esp32control-app.devices.magnetometer :as mag]
            [re-natal-esp32control-app.views.common :as v.common]))

(def box-w 150)
(def ball-r 20)

(defn compass-panel []
  (let [mag-values (subscribe [:mag-values])]
    (r/create-class
     {:reagent-render
      (fn []
        [v.common/view {:style {:width box-w :height box-w :background-color "#eee" :margin-bottom 10}}
         [v.common/view {:style {:width box-w :height box-w
                                 :position :absolute :top 0 :left 0
                                 :transform [{:rotate (str (or (- (:degree @mag-values) 90) 0) "deg")}]}}
          [v.common/view {:style {:top 0
                                  :left (/ box-w 4)
                                  :position "absolute"
                                  :width 0 :height 0
                                  :background-color "transparent"
                                  :border-style "solid"
                                  :border-left-width (/ box-w 4)
                                  :border-right-width (/ box-w 4)
                                  :border-bottom-width box-w
                                  :borderLeftColor "transparent"
                                  :borderRightColor "transparent"
                                  :border-bottom-color "#f77"}}]]
         [v.common/text (:x @mag-values)]
         [v.common/text (:y @mag-values)]
         [v.common/text (:degree @mag-values)]])
      :component-did-mount mag/start-monitoring
      :component-will-unmount mag/stop-monitoring})))

(defn mag-panel []
  [v.common/view {:style {:align-items "center"}}
   [compass-panel]])

(ns re-natal-esp32control-app.views.ble-control.magnetometer
  (:require [clojure.string :as str]
            [reagent.core :as r]
            [re-frame.core :refer [subscribe dispatch dispatch-sync]]
            [re-natal-esp32control-app.devices.magnetometer :as mag]
            [re-natal-esp32control-app.views.common :as v.common]))

(def box-w 150)
(def ball-r 20)

(defn compass-panel []
  (let [mag-values (subscribe [:mag-values])]
    (r/create-class
     {:reagent-render
      (fn []
        [v.common/view {:style {:width box-w :height box-w :background-color "#eee" :margin-bottom 10}}
         [v.common/view {:style {:width box-w :height box-w
                                 :position :absolute :top 0 :left 0
                                 :transform [{:rotate (str (or (+ (:degree @mag-values) 90) 0) "deg")}]}}
          [v.common/view {:style {:top 0
                                  :left (/ box-w 4)
                                  :position "absolute"
                                  :width 0 :height 0
                                  :background-color "transparent"
                                  :border-style "solid"
                                  :border-left-width (/ box-w 4)
                                  :border-right-width (/ box-w 4)
                                  :border-bottom-width box-w
                                  :borderLeftColor "transparent"
                                  :borderRightColor "transparent"
                                  :border-bottom-color "#f77"}}]]
         [v.common/text (:x @mag-values)]
         [v.common/text (:y @mag-values)]
         [v.common/text (:degree @mag-values)]])
      :component-did-mount mag/start-monitoring
      :component-will-unmount mag/stop-monitoring})))

(defn mag-panel []
  [v.common/view {:style {:align-items "center"}}
   [compass-panel]])

Correct compass arrow direction

Correct compass arrow direction


;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.view.ui.viewer.interactions
  (:require [uxbox.util.dom :as dom]
            [potok.core :as ptk]
            [uxbox.util.geom.matrix :as gmt]
            [uxbox.util.geom.point :as gpt]
            [uxbox.util.timers :as ts]
            [uxbox.main.geom :as geom]
            [uxbox.view.store :as st]
            [uxbox.view.data.viewer :as dv]
            [vendor.snapsvg])
  ;; Documentation about available events:
  ;; https://google.github.io/closure-library/api/goog.events.EventType.html
  (:import goog.events.EventType))

(defn- translate-trigger
  "Translates the interaction trigger name (keyword) into
  approriate dom event name (keyword)."
  [trigger]
  {:pre [(keyword? trigger)]}
  (case trigger
    :click EventType.CLICK
    :doubleclick EventType.DBLCLICK
    :rightclick EventType.CONTEXTMENU
    :mousein EventType.MOUSEENTER
    :mouseout EventType.MOUSELEAVE
    :hover ::hover
    (throw (ex-info "not supported at this moment" {:trigger trigger}))))

(defn- translate-ease
  "Translates the uxbox ease settings to one
  that are compatible with anime.js library."
  [ease]
  {:pre [(keyword? ease)]}
  (case ease
    :linear js/mina.linear
    :easein js/mina.easin
    :easeout js/mina.easout
    :easeinout js/mina.easeinout
    (throw (ex-info "invalid ease value" {:ease ease}))))

(defn- animate
  [& opts]
  (js/anime (clj->js (apply hash-map opts))))

(defn- animate*
  [dom {:keys [delay duration easing] :as opts}]
  (let [props (dissoc opts :delay :duration :easing)
        snap (js/Snap. dom)]
    (ts/schedule delay #(.animate snap (clj->js props) duration easing))))

;; --- Interactions to Animation Compilation

(defn- run-moveby-interaction
  [{:keys [element moveby-x moveby-y easing delay duration direction]}]
  (let [dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:transform (str "translate(" (- moveby-x)" " (- moveby-y) ")")
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration})
      (animate* dom {:transform (str "translate(" moveby-x " " moveby-y ")")
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration}))))

(declare run-hide-interaction)

(defn- run-show-interaction
  [{:keys [element easing delay duration
           animation direction] :as itx}]
  (let [dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (run-hide-interaction (dissoc itx :direction))
      (animate* dom {:fillOpacity "1"
                     :strokeOpacity "1"
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration}))))

(defn- run-hide-interaction
  [{:keys [element easing delay duration
           animation direction] :as itx}]
  (let [dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (run-show-interaction (dissoc itx :direction))
      (animate* dom {:fillOpacity "0"
                     :strokeOpacity "0"
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration}))))

(defn- run-opacity-interaction
  [{:keys [element opacity easing delay
           duration animation direction]}]
  (let [shape (get-in @st/state [:shapes element])
        dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:fillOpacity (:fill-opacity shape "1")
                     :strokeOpacity (:stroke-opacity shape "1")
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration})
      (animate* dom {:fillOpacity opacity
                     :strokeOpacity opacity
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration}))))

(defn- run-size-interaction-rect
  [{:keys [x1 y1 rotation] :as shape}
   {:keys [resize-width resize-height easing
           element delay duration direction] :as opts}]
  (let [{:keys [width height]} (geom/size shape)
        dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :width width
                     :height height})
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :width resize-width
                     :height resize-height}))))

(defn- run-size-interaction
  [{:keys [element] :as opts}]
  (let [shape (get-in @st/state [:shapes element])]
    (case (:type shape)
      :icon (run-size-interaction-rect shape opts)
      :image (run-size-interaction-rect shape opts)
      :rect (run-size-interaction-rect shape opts))))

(defn- run-gotourl-interaction
  [{:keys [url]}]
  (set! (.-href js/location) url))

(defn- run-gotopage-interaction
  [{:keys [page]}]
  (st/emit! (dv/select-page page)))

(defn- run-color-interaction
  [{:keys [element fill-color stroke-color direction easing delay duration]}]
  (let [shape (get-in @st/state [:shapes element])
        dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :fill (:fill shape "#000000")
                     :stroke (:stroke shape "#000000")})
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :fill fill-color
                     :stroke stroke-color}))))

;; (defn- run-rotate-interaction
;;   [{:keys [element rotation direction easing delay duration] :as opts}]
;;   (let [shape (get-in @st/state [:shapes element])
;;         {:keys [x1 y1 width height]} (geom/size shape)
;;
;;         dom (dom/get-element (str "shape-" element))
;;         mtx1 (geom/transformation-matrix (update shape :rotation + rotation))
;;         mtx2 (geom/transformation-matrix shape)]
;;     (if (= direction :reverse)
;;       (animate* dom {:easing (translate-ease easing)
;;                      :delay delay
;;                      :duration duration
;;                      :transform (str mtx2)})
;;       (animate* dom {:easing (translate-ease easing)
;;                      :delay delay
;;                      :duration duration
;;                      :transform (str mtx1)}))))

(defn- run-interaction
  "Given an interaction data structure return
  a precompiled animation."
  [{:keys [action] :as itx}]
  (case action
    :moveby (run-moveby-interaction itx)
    :show (run-show-interaction itx)
    :hide (run-hide-interaction itx)
    :size (run-size-interaction itx)
    :opacity (run-opacity-interaction itx)
    :color (run-color-interaction itx)
    ;; :rotate (run-rotate-interaction itx)
    :gotourl (run-gotourl-interaction itx)
    :gotopage (run-gotopage-interaction itx)
    (throw (ex-info "undefined interaction" {:action action}))))

;; --- Main Api

(defn- build-hover-evt
  "A special case for hover event."
  [itx]
  (letfn [(on-mouse-enter [event]
            (dom/prevent-default event)
            (run-interaction itx))
          (on-mouse-leave [event]
            (dom/prevent-default event)
            (run-interaction (assoc itx :direction :reverse)))]
    [[EventType.MOUSEENTER on-mouse-enter]
     [EventType.MOUSELEAVE on-mouse-leave]]))

(defn- build-generic-evt
  "A reducer function that compiles interaction data structures
  into apropriate event handler attributes."
  [evt itx]
  (letfn [(on-event [event]
            (dom/prevent-default event)
            (run-interaction itx))]
    [[evt on-event]]))

(defn build-events
  "Compile a sequence of interactions into a hash-map of event-handlers."
  [shape]
  (reduce (fn [acc itx]
            (let [evt (translate-trigger (:trigger itx))]
              (if (= evt ::hover)
                (into acc (build-hover-evt itx))
                (into acc (build-generic-evt evt itx)))))
          []
          (vals (:interactions shape))))

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

(ns uxbox.view.ui.viewer.interactions
  (:require [uxbox.util.dom :as dom]
            [potok.core :as ptk]
            [uxbox.util.geom.matrix :as gmt]
            [uxbox.util.geom.point :as gpt]
            [uxbox.util.timers :as ts]
            [uxbox.main.geom :as geom]
            [uxbox.view.store :as st]
            [uxbox.view.data.viewer :as dv]
            [vendor.snapsvg])
  ;; Documentation about available events:
  ;; https://google.github.io/closure-library/api/goog.events.EventType.html
  (:import goog.events.EventType))

(defn- translate-trigger
  "Translates the interaction trigger name (keyword) into
  approriate dom event name (keyword)."
  [trigger]
  {:pre [(keyword? trigger)]}
  (case trigger
    :click EventType.CLICK
    :doubleclick EventType.DBLCLICK
    :rightclick EventType.CONTEXTMENU
    :mousein EventType.MOUSEENTER
    :mouseout EventType.MOUSELEAVE
    :hover ::hover
    (throw (ex-info "not supported at this moment" {:trigger trigger}))))

(defn- translate-ease
  "Translates the uxbox ease settings to one
  that are compatible with anime.js library."
  [ease]
  {:pre [(keyword? ease)]}
  (case ease
    :linear js/mina.linear
    :easein js/mina.easin
    :easeout js/mina.easout
    :easeinout js/mina.easeinout
    (throw (ex-info "invalid ease value" {:ease ease}))))

(defn- animate
  [& opts]
  (js/anime (clj->js (apply hash-map opts))))

(defn- animate*
  [dom {:keys [delay duration easing] :as opts}]
  (let [props (dissoc opts :delay :duration :easing)
        snap (js/Snap. dom)]
    (ts/schedule delay #(.animate snap (clj->js props) duration easing))))

;; --- Interactions to Animation Compilation

(defn- run-moveby-interaction
  [{:keys [element moveby-x moveby-y easing delay duration direction]}]
  (let [dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:transform (str "translate(" (- moveby-x)" " (- moveby-y) ")")
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration})
      (animate* dom {:transform (str "translate(" moveby-x " " moveby-y ")")
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration}))))

(declare run-hide-interaction)

(defn- run-show-interaction
  [{:keys [element easing delay duration
           animation direction] :as itx}]
  (let [dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (run-hide-interaction (dissoc itx :direction))
      (animate* dom {:fillOpacity "1"
                     :strokeOpacity "1"
                     :easing (translate-ease easing)
                     :delay delay
                     :class "itx-displayed"
                     :duration duration}))))

(defn- run-hide-interaction
  [{:keys [element easing delay duration
           animation direction] :as itx}]
  (let [dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (run-show-interaction (dissoc itx :direction))
      (animate* dom {:fillOpacity "0"
                     :strokeOpacity "0"
                     :easing (translate-ease easing)
                     :delay delay
                     :class "itx-hidden"
                     :duration duration}))))

(defn- run-toggle-interaction
  [{:keys [element easing delay duration
           animation direction] :as itx}]
  (let [dom (dom/get-element (str "shape-" element))]
    (if (= (:class dom) "itx-hidden")
      (run-show-interaction itx)
      (run-hide-interaction itx))))

(defn- run-opacity-interaction
  [{:keys [element opacity easing delay
           duration animation direction]}]
  (let [shape (get-in @st/state [:shapes element])
        dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:fillOpacity (:fill-opacity shape "1")
                     :strokeOpacity (:stroke-opacity shape "1")
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration})
      (animate* dom {:fillOpacity opacity
                     :strokeOpacity opacity
                     :easing (translate-ease easing)
                     :delay delay
                     :duration duration}))))

(defn- run-size-interaction-rect
  [{:keys [x1 y1 rotation] :as shape}
   {:keys [resize-width resize-height easing
           element delay duration direction] :as opts}]
  (let [{:keys [width height]} (geom/size shape)
        dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :width width
                     :height height})
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :width resize-width
                     :height resize-height}))))

(defn- run-size-interaction-circle
  [{:keys [x1 y1 rotation] :as shape}
   {:keys [resize-width resize-height easing
           element delay duration direction] :as opts}]
  (let [{:keys [width height]} (geom/size shape)
        dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :rx width
                     :ry height})
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :rx resize-width
                     :ry resize-height}))))

(defn- run-size-interaction
  [{:keys [element] :as opts}]
  (let [shape (get-in @st/state [:shapes element])]
    (case (:type shape)
      :icon (run-size-interaction-rect shape opts)
      :image (run-size-interaction-rect shape opts)
      :rect (run-size-interaction-rect shape opts)
      :circle (run-size-interaction-circle shape opts))))

(defn- run-gotourl-interaction
  [{:keys [url]}]
  (set! (.-href js/location) url))

(defn- run-gotopage-interaction
  [{:keys [page]}]
  (st/emit! (dv/select-page page)))

(defn- run-color-interaction
  [{:keys [element fill-color stroke-color direction easing delay duration]}]
  (let [shape (get-in @st/state [:shapes element])
        dom (dom/get-element (str "shape-" element))]
    (if (= direction :reverse)
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :fill (:fill shape "#000000")
                     :stroke (:stroke shape "#000000")})
      (animate* dom {:easing (translate-ease easing)
                     :delay delay
                     :duration duration
                     :fill fill-color
                     :stroke stroke-color}))))

;; (defn- run-rotate-interaction
;;   [{:keys [element rotation direction easing delay duration] :as opts}]
;;   (let [shape (get-in @st/state [:shapes element])
;;         {:keys [x1 y1 width height]} (geom/size shape)
;;
;;         dom (dom/get-element (str "shape-" element))
;;         mtx1 (geom/transformation-matrix (update shape :rotation + rotation))
;;         mtx2 (geom/transformation-matrix shape)]
;;     (if (= direction :reverse)
;;       (animate* dom {:easing (translate-ease easing)
;;                      :delay delay
;;                      :duration duration
;;                      :transform (str mtx2)})
;;       (animate* dom {:easing (translate-ease easing)
;;                      :delay delay
;;                      :duration duration
;;                      :transform (str mtx1)}))))

(defn- run-interaction
  "Given an interaction data structure return
  a precompiled animation."
  [{:keys [action] :as itx}]
  (case action
    :moveby (run-moveby-interaction itx)
    :show (run-show-interaction itx)
    :hide (run-hide-interaction itx)
    :toggle (run-toggle-interaction itx)
    :size (run-size-interaction itx)
    :opacity (run-opacity-interaction itx)
    :color (run-color-interaction itx)
    ;; :rotate (run-rotate-interaction itx)
    :gotourl (run-gotourl-interaction itx)
    :gotopage (run-gotopage-interaction itx)
    (throw (ex-info "undefined interaction" {:action action}))))

;; --- Main Api

(defn- build-hover-evt
  "A special case for hover event."
  [itx]
  (letfn [(on-mouse-enter [event]
            (dom/prevent-default event)
            (run-interaction itx))
          (on-mouse-leave [event]
            (dom/prevent-default event)
            (run-interaction (assoc itx :direction :reverse)))]
    [[EventType.MOUSEENTER on-mouse-enter]
     [EventType.MOUSELEAVE on-mouse-leave]]))

(defn- build-generic-evt
  "A reducer function that compiles interaction data structures
  into apropriate event handler attributes."
  [evt itx]
  (letfn [(on-event [event]
            (dom/prevent-default event)
            (run-interaction itx))]
    [[evt on-event]]))

(defn build-events
  "Compile a sequence of interactions into a hash-map of event-handlers."
  [shape]
  (reduce (fn [acc itx]
            (let [evt (translate-trigger (:trigger itx))]
              (if (= evt ::hover)
                (into acc (build-hover-evt itx))
                (into acc (build-generic-evt evt itx)))))
          []
          (vals (:interactions shape))))

Add missing interactions to viewer

:bug: Add missing interactions to viewer


(ns icecap.store.mem-test
  (:require [caesium.crypto.util :refer [array-eq]]
            [icecap.store.api :refer :all]
            [icecap.store.mem :refer :all]
            [icecap.store.test-props :refer [store-roundtrip-prop]]
            [clojure.test :refer :all]
            [clojure.core.async :as a :refer [<!!]]
            [clojure.test.check.clojure-test :refer [defspec]]))

(defspec mem-store-roundtrip
  (store-roundtrip-prop (mem-store)))

(ns icecap.store.mem-test
  (:require [caesium.crypto.util :refer [array-eq]]
            [icecap.store.api :refer :all]
            [icecap.store.mem :refer :all]
            [icecap.store.test-props :refer :all]
            [clojure.test :refer :all]
            [clojure.core.async :as a :refer [<!!]]
            [clojure.test.check.clojure-test :refer [defspec]]))

(defspec mem-store-roundtrip
  (store-roundtrip-prop (mem-store)))

(defspec mem-store-delete
  (store-delete-prop (mem-store)))

Add roundtrip test to mem-store

Add roundtrip test to mem-store


(ns riemann.influxdb-test
  (:require
    [clojure.test :refer :all]
    [riemann.influxdb :refer [influxdb]]
    [riemann.logging :as logging]
    [riemann.time :refer [unix-time]]))

(logging/init)

(deftest ^:influxdb-8 ^:integration influxdb-test-8
  (let [k (influxdb {:block-start true})]
    (k {:host "riemann.local"
        :service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric -2
        :time (unix-time)}))

  (let [k (influxdb {:block-start true})]
    (k {:service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric 3.14159
        :time (unix-time)}))

  (let [k (influxdb {:block-start true})]
    (k {:host "no-service.riemann.local"
        :state "ok"
        :description "Missing service, not transmitted"
        :metric 4
        :time (unix-time)})))

(deftest ^:influxdb-9 ^:integration influxdb-test-9
  (let [k (influxdb {:version :0.9
                     :host (System/getenv "INFLUXDB_HOST")
                     :db "riemann_test"})]
    (k {:host "riemann.local"
        :service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric -2
        :time (unix-time)})
    (k {:service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric 3.14159
        :time (unix-time)})
    (k {:host "no-service.riemann.local"
        :state "ok"
        :description "Missing service, not transmitted"
        :metric 4
        :time (unix-time)})))

(ns riemann.influxdb-test
  (:require
    [clojure.test :refer :all]
    [riemann.influxdb :as influxdb]
    [riemann.logging :as logging]
    [riemann.time :refer [unix-time]]))

(logging/init)

(deftest ^:influxdb-8 ^:integration influxdb-test-8
  (let [k (influxdb/influxdb {:block-start true})]
    (k {:host "riemann.local"
        :service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric -2
        :time (unix-time)}))

  (let [k (influxdb/influxdb {:block-start true})]
    (k {:service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric 3.14159
        :time (unix-time)}))

  (let [k (influxdb/influxdb {:block-start true})]
    (k {:host "no-service.riemann.local"
        :state "ok"
        :description "Missing service, not transmitted"
        :metric 4
        :time (unix-time)})))

(deftest ^:influxdb-9 ^:integration influxdb-test-9
  (let [k (influxdb/influxdb
            {:version :0.9
             :host (System/getenv "INFLUXDB_HOST")
             :db "riemann_test"})]
    (k {:host "riemann.local"
        :service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric -2
        :time (unix-time)})
    (k {:service "influxdb test"
        :state "ok"
        :description "all clear, uh, situation normal"
        :metric 3.14159
        :time (unix-time)})
    (k {:host "no-service.riemann.local"
        :state "ok"
        :description "Missing service, not transmitted"
        :metric 4
        :time (unix-time)})))

(deftest point-conversion
  (is (nil? (influxdb/event->point-9 #{} {:service "foo test", :time 1}))
      "Event with no metric is converted to nil")
  (is (= {"name" "test service"
          "time" "2015-04-07T00:32:45.000Z"
          "tags" {"host" "host-01"}
          "fields" {"value" 42.08}}
         (influxdb/event->point-9
           #{:host}
           {:host "host-01"
            :service "test service"
            :time 1428366765
            :metric 42.08}))
      "Minimal event is converted to point fields")
  (is (= {"name" "service_api_req_latency"
          "time" "2015-04-06T21:15:41.000Z"
          "tags" {"host" "www-dev-app-01.sfo1.example.com"
                  "sys" "www"
                  "env" "dev"
                  "role" "app"
                  "loc" "sfo1"}
          "fields" {"value" 0.8025
                    "description" "A text description!"
                    "state" "ok"
                    "foo" "frobble"}}
         (influxdb/event->point-9
           #{:host :sys :env :role :loc}
           {:host "www-dev-app-01.sfo1.example.com"
            :service "service_api_req_latency"
            :time 1428354941
            :metric 0.8025
            :state "ok"
            :description "A text description!"
            :ttl 60
            :tags ["one" "two" "red"]
            :sys "www"
            :env "dev"
            :role "app"
            :loc "sfo1"
            :foo "frobble"}))
      "Full event is converted to point fields")
  (is (empty? (influxdb/events->points-9 #{} [{:service "foo test"}]))
      "Nil points are filtered from result"))

Add point-conversion unit tests for InfluxDB.


(ns runbld.test.main-test
  (:require [clojure.test :refer :all]
            [runbld.env :as env]
            [runbld.process :as proc]
            [runbld.publish :as publish]
            [runbld.version :as version])
  (:require [runbld.main :as main] :reload-all))

(deftest main
  ;; Change root bindings for these Vars, affects any execution no
  ;; matter what thread
  (with-redefs [;; Don't pollute the console
                main/log (fn [_] :noconsole)
                ;; Don't really kill the JVM
                main/really-die (fn [& args] :dontdie)
                ;; Don't really execute an external process
                proc/run (fn [& args] :bogus)
                ;; facter is too slow
                env/facter (fn [& args] {:some :fact})
                ;; Don't really publish things
                publish/publish* (fn [& args] {:published :not-really})]
    (testing "version"
      (is (.startsWith (main/-main "-v") (version/version))))

    (testing "usage"
      (is (.startsWith (main/-main) "runbld ")))

    (testing "bad config file"
      (is (.startsWith (main/-main "-c" "/tmp/noexist"
                                   "/path/to/script.bash") "config file ")))

    (testing "unexpected exception"
      (with-redefs [proc/run (fn [& args] (throw
                                           (Exception.
                                            "boy that was unexpected")))]
        (is (.startsWith (main/-main "-c" "test/runbld.yaml"
                                     "--job-name" "elastic,proj1,master"
                                     "/path/to/script.bash")
                         "#error {\n :cause boy that was "))))))

(deftest execution
  (testing "real execution all the way through"
    (with-redefs [main/log (fn [_] :noconsole)
                  env/facter (fn [& args] {:some :fact})
                  publish/publish* (fn [& args] {:published :not-really})]
      (is (= 0 (-> (main/-main "--job-name" "foo,bar,baz"
                               "test/success.bash") :process :status))))))

(ns runbld.test.main-test
  (:require [clojure.test :refer :all]
            [runbld.env :as env]
            [runbld.opts :as opts]
            [runbld.process :as proc]
            [runbld.publish :as publish]
            [runbld.vcs.git :as git]
            [runbld.version :as version])
  (:require [runbld.main :as main] :reload-all))

(deftest main
  ;; Change root bindings for these Vars, affects any execution no
  ;; matter what thread
  (with-redefs [;; Don't pollute the console
                main/log (fn [_] :noconsole)
                ;; Don't really kill the JVM
                main/really-die (fn [& args] :dontdie)
                ;; Don't really execute an external process
                proc/run (fn [& args] :bogus)
                ;; facter is too slow
                env/facter (fn [& args] {:some :fact})
                ;; Don't really publish things
                publish/publish* (fn [& args] {:published :not-really})]
    (testing "version"
      (is (.startsWith (main/-main "-v") (version/version))))

    (testing "usage"
      (is (.startsWith (main/-main) "runbld ")))

    (testing "bad config file"
      (is (.startsWith (main/-main "-c" "/tmp/noexist"
                                   "/path/to/script.bash") "config file ")))

    (testing "unexpected exception"
      (with-redefs [proc/run (fn [& args] (throw
                                           (Exception.
                                            "boy that was unexpected")))]
        (let [args ["-c" "test/runbld.yaml"
                    "--job-name" "elastic,proj1,master"
                    "/path/to/script.bash"]
              opts (opts/parse-args args)
              repo (git/init-test-repo (get-in opts [:profiles
                                                     :elastic-proj1-master
                                                     :git :remote]))
              res (apply main/-main args)]
          (is (.startsWith res "#error {\n :cause boy that was ")))))))

(deftest execution
  (testing "real execution all the way through"
    (with-redefs [main/log (fn [_] :noconsole)
                  env/facter (fn [& args] {:some :fact})
                  publish/publish* (fn [& args] {:published :not-really})]
      (is (= 0 (-> (main/-main "--job-name" "foo,bar,baz"
                               "test/success.bash") :process :status))))))

Make sure repo exists

Make sure repo exists


(ns stripe.transfer-test
  (:use clojure.test
        stripe.transfer)
  (:require [stripe.balance :as b]
            [stripe.charge :as c]
            [stripe.test :as t]
            [stripe.test-data :as td]))

(deftest transfer-test
  (t/with-customer [c td/customer-data]
    (t/with-recipient [r td/fake-individual-with-account]
      (let [pre-balance (b/get-balance)
            charge (c/create-charge {:amount 10000
                                     :customer (:id c)
                                     :expand :balance_transaction})
            commission 1000
            stripe-fee (-> charge :balance_transaction b/tx-fee)
            amt-to-transfer (-> charge :balance_transaction :net
                                (- commission))]

        "Charge 100 bucks, then transfer everything minus Stripe's
         fees and our 10 dollar commission. Then make two transfers."
        (let [to-them (create-transfer {:amount amt-to-transfer
                                        :currency "usd"
                                        :recipient (:id r)})
              to-us (create-transfer {:amount commission
                                      :currency "usd"
                                      :recipient "self"})
              post-balance (b/get-balance)
              amt-transferred (- (b/available-amount pre-balance)
                                 (b/available-amount post-balance))
              amt-incoming (- (b/pending-amount post-balance)
                              (b/pending-amount pre-balance))]
          (is (= (assoc to-them :status "paid")
                 (get-transfer (:id to-them)))
              "Getting a transfer returns the transfer.")

          (is (= (assoc to-us
                   :metadata {:foo "bar"}
                   :status "paid")
                 (update-transfer (:id to-us) {:metadata {:foo "bar"}}))
              "Updating metadata works. Note that the status changes to paid immediately.")

          (is (= amt-transferred
                 (+ amt-to-transfer commission 25))
              "Our available balance is decreased by the commission we
        send to our bank acct and the amount we send to the
        recipient's bank, plus 0.25 for the transfer to the
        recipient.")

          (is (= amt-incoming (+ amt-to-transfer commission))
              "The charge generated the proper amt in the pending
              balance. We add back in commission because
              amt-to-transfer subtracted it out to calculate the
              amount to send to the recipient.")

          (is (:error (cancel-transfer (:id to-us)))
              "You can't cancel a transaction that's already been
              submitted."))))))

(ns stripe.transfer-test
  (:use clojure.test
        stripe.transfer)
  (:require [stripe.balance :as b]
            [stripe.charge :as c]
            [stripe.test :as t]
            [stripe.test-data :as td]))

(deftest transfer-test
  (t/with-customer [c td/customer-data]
    (t/with-recipient [r td/fake-individual-with-account]
      (let [pre-balance (b/get-balance)
            charge (c/create-charge {:amount 10000
                                     :customer (:id c)
                                     :expand :balance_transaction})
            commission 1000
            stripe-fee (-> charge :balance_transaction b/tx-fee)
            amt-to-transfer (-> charge :balance_transaction :net
                                (- commission))]

        "Charge 100 bucks, then transfer everything minus Stripe's
         fees and our 10 dollar commission. Then make two transfers."
        (let [to-them (create-transfer {:amount amt-to-transfer
                                        :currency "usd"
                                        :recipient (:id r)})
              to-us (create-transfer {:amount commission
                                      :currency "usd"
                                      :recipient "self"})
              post-balance (b/get-balance)
              amt-transferred (- (b/available-amount pre-balance)
                                 (b/available-amount post-balance))
              amt-incoming (- (b/pending-amount post-balance)
                              (b/pending-amount pre-balance))]
          (is (= (assoc to-them :status "paid")
                 (get-transfer (:id to-them)))
              "Getting a transfer returns the transfer.")

          (is (= (assoc to-us
                   :metadata {:foo "bar"}
                   :status "paid")
                 (update-transfer (:id to-us) {:metadata {:foo "bar"}}))
              "Updating metadata works. Note that the status changes to paid immediately.")

          (is (= amt-transferred
                 (+ amt-to-transfer commission 25))
              "Our available balance is decreased by the commission we
        send to our bank acct and the amount we send to the
        recipient's bank, plus 0.25 for the transfer to the
        recipient.")

          (is (= amt-incoming (+ amt-to-transfer commission))
              "The charge generated the proper amt in the pending
              balance. We add back in commission because
              amt-to-transfer subtracted it out to calculate the
              amount to send to the recipient.")

          (is (:error (cancel-transfer (:id to-us)))
              "You can't cancel a transaction that's already been
              submitted.")

          (let [transfer-a (create-transfer {:amount amt-to-transfer
                                             :currency "usd"
                                             :recipient (:id r)
                                             :expand [:balance_transaction]})
                transfer-b (create-transfer {:amount amt-to-transfer
                                             :currency "usd"
                                             :recipient (:id r)}
                                            {:stripe-params
                                             {:expand [:balance_transaction]}})
                transfer-c (create-transfer {:amount 1000
                                             :currency "usd"
                                             :recipient (:id r)}
                                            {:stripe-params
                                             {:amount 2000}})
                remove-id-and-time #(dissoc % :created :source :id :available_on)]
            (is (= (remove-id-and-time (:balance_transaction transfer-a))
                   (remove-id-and-time (:balance_transaction transfer-b)))
                "You can specify the expand parameter in the first or
                second argument to create-transfer; they're
                equivalent.")
            (is (= (:amount transfer-c) 1000)
                "If you specify the same keyword in the first arg map
                and the second arg map's stripe params, the value in
                the first arg map wins.")))))))

add tests for merge of stripe-params in create-transfer


(ns zombie-run.game-test
  (:require [zombie-run.game :refer [make-game
                                     run-player-action
                                     run-zombie-actions
                                     action->coords
                                     player-position
                                     set-player
                                     zombie-health
                                     configure-player-weapon
                                     configure-zombie-weapon
                                     zombie-positions
                                     player-health]]
            [zombie-run.weapon :as weapon :refer [make-weapon]]
            [clojure.spec.test.alpha :as stest]

    #?(:cljs [cljs.test :refer-macros [is are deftest testing]]
       :clj
            [clojure.test :refer :all])))

(stest/instrument `zombie-run.game)

(defn example-game []
  (make-game {:player-pos [2 3]
              :world-size [5 5]
              :zombies    [[1 2] [0 2]]}))

(defn player-fire-times [game n]
  (last (take (inc n) (iterate #(run-player-action % :fire) game))))

(defn step-times [game n]
  (last (take (inc n) (iterate run-zombie-actions game))))

(deftest test-action->coords-only-allows-directions
  (is (thrown? AssertionError (action->coords :foo))))

(deftest test-action->coords-returns-an-action-for-movement
  (is (= [0 1] (action->coords :down))))

(deftest move-player-test
  (let [player-move (fn [game action] (-> game
                                          (run-player-action action)
                                          (run-zombie-actions)
                                          (player-position)))]
    (testing "player moves"
      (are [pos action] (= pos (-> (example-game)
                                   (player-move action)))
                        [3 3] :right
                        [1 3] :left
                        [2 2] :up
                        [2 4] :down))

    (testing "player doesn't move out of the world"
      (are [pos action] (= pos (-> (example-game)
                                   (set-player [0 4])
                                   (player-move action)))
                        [0 4] :left
                        [0 4] :down))

    (testing "player cannot move on if a terrain is blocked"
      (is (= [0 1] (-> (example-game)
                       (set-player [0 1])
                       (player-move :down)))))))

(deftest player-attack-test
  (testing "player attack doesn't hit the zombie"
    (let [game (-> (example-game)
                   (set-player [4 4])
                   (run-player-action :fire))]
      (is (= 10 (zombie-health game [1 2])))))

  (testing "player attack hits a zombie"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (run-player-action :fire))]
      (is (= 9 (zombie-health game [1 2])))))

  (testing "player attack kills a zombie"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon {::weapon/recharge-delay 0})
                   (player-fire-times 10))]
      (is (nil? (zombie-health game [1 2])))))

  (testing "zombie dies even if the damage bigger than the existing health"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon (make-weapon :musket))
                   (configure-player-weapon {::weapon/recharge-delay 0})
                   (player-fire-times 10))]
      (is (nil? (zombie-health game [1 2])))))

  (testing "player weapon has a recharge delay"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon {::weapon/recharge-delay 10000})
                   (player-fire-times 10))]
      (is (= 9 (zombie-health game [1 2])))))

  (testing "player weapon recharges also if it doesn't hit"
    (let [game (-> (example-game)
                   (set-player [3 4] :up-left)
                   (configure-player-weapon {::weapon/recharge-delay 10000})
                   (run-player-action :fire)
                   (run-player-action :up-left)
                   (player-fire-times 10))]
      (is (= 10 (zombie-health game [1 2])))))

  (testing "player weapons have different attack damage"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon (make-weapon :musket))
                   (run-player-action :fire))]
      (is (= 6 (zombie-health game [1 2]))))))

(deftest player-weapons-have-different-ranges
  (testing "player weapons have different ranges"
    (let [game (-> (make-game {:player-pos       [4 4]
                               :world-size       [5 5]
                               :zombies          [[1 1]]
                               :player-direction :up-left})
                   (configure-player-weapon (make-weapon :musket))
                   (run-player-action :fire))]
      (is (= 6 (zombie-health game [1 1]))))))

(deftest move-zombies-test
  (testing "zombies move towards player"
    (let [game (-> (example-game)
                   (set-player [3 4])
                   (run-zombie-actions))]
      (is (= [[1 3] [2 3]] (zombie-positions game)))))

  (testing "zombies cannot move on if a terrain is blocked"
    (let [game (-> (example-game)
                   (run-zombie-actions))]
      (is (= [[1 2] [1 3]] (zombie-positions game)))))

  (testing "if zombies move the player doesn't"
    (let [game (-> (example-game)
                   (run-zombie-actions))]
      (is (= [2 3] (player-position game)))))

  (testing "zombies do not accidentally occupy the same terrain"
    (let [game (-> (make-game {:player-pos [13 17]
                               :zombies    [[10 17] [10 18]]
                               :world-size [30 30]})
                   (run-zombie-actions))]

      (is (= [[10 18] [11 17]] (zombie-positions game))))))

(deftest zombies-attack-player-test
  (testing "no zombie can attack"
    (let [game (-> (example-game)
                   (set-player [3 4])
                   (run-zombie-actions))]
      (is (= 10 (player-health game)))))

  (testing "one zombie attacks"
    (let [game (-> (example-game)
                   (run-zombie-actions))]
      (is (= 8 (player-health game)))))

  (testing "zombies kill the player"
    (let [game (-> (example-game)
                   (configure-zombie-weapon [1 2] {::weapon/recharge-delay 0})
                   (configure-zombie-weapon [0 2] {::weapon/recharge-delay 0})
                   (step-times 6))]
      (is (nil? (player-health game)))
      (is (nil? (player-position game)))))

  (testing "zombie weapons have a recharge delay as well"
    (let [game (-> (example-game)
                   (run-zombie-actions)
                   (run-zombie-actions))]
      (is (= 6 (player-health game))))))

(ns zombie-run.game-test
  (:require [zombie-run.game :refer [make-game
                                     run-player-action
                                     run-zombie-actions
                                     action->coords
                                     player-position
                                     set-player
                                     zombie-health
                                     configure-player-weapon
                                     configure-zombie-weapon
                                     zombie-positions
                                     player-health]]
            [zombie-run.weapon :as weapon :refer [make-weapon]]
            [clojure.spec.test.alpha :as stest]

    #?(:cljs [cljs.test :refer-macros [is are deftest testing]]
       :clj
            [clojure.test :refer :all])))

(stest/instrument `zombie-run.game)

(defn example-game []
  (make-game {:player-pos [2 3]
              :world-size [5 5]
              :zombies    [[1 2] [0 2]]}))

(defn player-fire-times [game n]
  (last (take (inc n) (iterate #(run-player-action % :fire) game))))

(defn step-times [game n]
  (last (take (inc n) (iterate run-zombie-actions game))))

(deftest test-action->coords-only-allows-directions
  (is (thrown? #?(:clj AssertionError
                  :cljs js/Error)
               (action->coords :foo))))

(deftest test-action->coords-returns-an-action-for-movement
  (is (= [0 1] (action->coords :down))))

(deftest move-player-test
  (let [player-move (fn [game action] (-> game
                                          (run-player-action action)
                                          (run-zombie-actions)
                                          (player-position)))]
    (testing "player moves"
      (are [pos action] (= pos (-> (example-game)
                                   (player-move action)))
                        [3 3] :right
                        [1 3] :left
                        [2 2] :up
                        [2 4] :down))

    (testing "player doesn't move out of the world"
      (are [pos action] (= pos (-> (example-game)
                                   (set-player [0 4])
                                   (player-move action)))
                        [0 4] :left
                        [0 4] :down))

    (testing "player cannot move on if a terrain is blocked"
      (is (= [0 1] (-> (example-game)
                       (set-player [0 1])
                       (player-move :down)))))))

(deftest player-attack-test
  (testing "player attack doesn't hit the zombie"
    (let [game (-> (example-game)
                   (set-player [4 4])
                   (run-player-action :fire))]
      (is (= 10 (zombie-health game [1 2])))))

  (testing "player attack hits a zombie"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (run-player-action :fire))]
      (is (= 9 (zombie-health game [1 2])))))

  (testing "player attack kills a zombie"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon {::weapon/recharge-delay 0})
                   (player-fire-times 10))]
      (is (nil? (zombie-health game [1 2])))))

  (testing "zombie dies even if the damage bigger than the existing health"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon (make-weapon :musket))
                   (configure-player-weapon {::weapon/recharge-delay 0})
                   (player-fire-times 10))]
      (is (nil? (zombie-health game [1 2])))))

  (testing "player weapon has a recharge delay"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon {::weapon/recharge-delay 10000})
                   (player-fire-times 10))]
      (is (= 9 (zombie-health game [1 2])))))

  (testing "player weapon recharges also if it doesn't hit"
    (let [game (-> (example-game)
                   (set-player [3 4] :up-left)
                   (configure-player-weapon {::weapon/recharge-delay 10000})
                   (run-player-action :fire)
                   (run-player-action :up-left)
                   (player-fire-times 10))]
      (is (= 10 (zombie-health game [1 2])))))

  (testing "player weapons have different attack damage"
    (let [game (-> (example-game)
                   (set-player [2 3] :up-left)
                   (configure-player-weapon (make-weapon :musket))
                   (run-player-action :fire))]
      (is (= 6 (zombie-health game [1 2]))))))

(deftest player-weapons-have-different-ranges
  (testing "player weapons have different ranges"
    (let [game (-> (make-game {:player-pos       [4 4]
                               :world-size       [5 5]
                               :zombies          [[1 1]]
                               :player-direction :up-left})
                   (configure-player-weapon (make-weapon :musket))
                   (run-player-action :fire))]
      (is (= 6 (zombie-health game [1 1]))))))

(deftest move-zombies-test
  (testing "zombies move towards player"
    (let [game (-> (example-game)
                   (set-player [3 4])
                   (run-zombie-actions))]
      (is (= [[1 3] [2 3]] (zombie-positions game)))))

  (testing "zombies cannot move on if a terrain is blocked"
    (let [game (-> (example-game)
                   (run-zombie-actions))]
      (is (= [[1 2] [1 3]] (zombie-positions game)))))

  (testing "if zombies move the player doesn't"
    (let [game (-> (example-game)
                   (run-zombie-actions))]
      (is (= [2 3] (player-position game)))))

  (testing "zombies do not accidentally occupy the same terrain"
    (let [game (-> (make-game {:player-pos [13 17]
                               :zombies    [[10 17] [10 18]]
                               :world-size [30 30]})
                   (run-zombie-actions))]

      (is (= [[10 18] [11 17]] (zombie-positions game))))))

(deftest zombies-attack-player-test
  (testing "no zombie can attack"
    (let [game (-> (example-game)
                   (set-player [3 4])
                   (run-zombie-actions))]
      (is (= 10 (player-health game)))))

  (testing "one zombie attacks"
    (let [game (-> (example-game)
                   (run-zombie-actions))]
      (is (= 8 (player-health game)))))

  (testing "zombies kill the player"
    (let [game (-> (example-game)
                   (configure-zombie-weapon [1 2] {::weapon/recharge-delay 0})
                   (configure-zombie-weapon [0 2] {::weapon/recharge-delay 0})
                   (step-times 6))]
      (is (nil? (player-health game)))
      (is (nil? (player-position game)))))

  (testing "zombie weapons have a recharge delay as well"
    (let [game (-> (example-game)
                   (run-zombie-actions)
                   (run-zombie-actions))]
      (is (= 6 (player-health game))))))

fix assertion test for cljs

fix assertion test for cljs


(ns parinfer.formatter-test
  (:require
    [clojure.string :as string :refer [split-lines]]
    [parinfer.formatter :refer [format-text]]
    [cljs.test :refer-macros [is deftest]]
    ))

(def fs (js/require "fs"))

(defn error-msg
  [line-no msg]
  (str "error at test-case line #" line-no ": " msg))

(defmulti parse-line
  (fn [state [line-no line]]
    (cond
      (= "```" line)          :end-block
      (re-find #"^```" line)  :start-block
      (:block-key state)      :in-block
      :else                   :default)))

(defmethod parse-line :end-block
  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
  (if-not block-key
    (throw (error-msg line-no "opening block must have a name: 'in' or 'out'"))
    (let [test-case-done? (:out test-case)]
      (if test-case-done?

        ;; close test case
        (-> state
            (update-in [:test-cases] conj test-case)
            (assoc :block-key nil)
            (assoc :test-case {}))

        ;; close test block
        (assoc state :block-key nil)))))

(defmethod parse-line :start-block
  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
  (if block-key
    (throw (error-msg line-no "must close previous block before starting new one"))
    (let [block-name (second (re-find #"^```(.*)$" line))
          block-key (keyword block-name)]
      (cond

        (not (#{:in :out} block-key))
        (throw (error-msg line-no (str "block name " (pr-str block-name) "must be either 'in' or 'out'")))

        (and (= :in block-key) (:in test-case))
        (throw (error-msg line-no (str "there is already an 'in' block for this test case.")))

        (and (= :out block-key) (not (:in test-case)))
        (throw (error-msg line-no (str "must include an 'in' block before an 'out' block.")))

        :else
        (-> state
            (assoc :block-key block-key)
            (assoc-in [:test-case block-key] {:line-no line-no :text ""}))))))

(defmethod parse-line :in-block
  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
  (let [cursor-x (.indexOf line "|")
        cursor-line (when (and (= :in block-key)
                               (not= -1 cursor-x))
                      (- line-no (:line-no (:in test-case))))
        line (string/replace line "|" "")]
    (-> state
        (update-in [:test-case block-key :text] str "\n" line)
        (update-in [:test-case block-key :cursor-line] #(or % cursor-line)))))

(defmethod parse-line :default
  [state [line-no line]]
  state)

(defn parse-test-cases [text]
  (let [lines (split-lines text)
        initial-state {:test-cases []
                       :block-key nil ;; :in or :out
                       :test-case {:in nil, :out nil}}
        numbered-lines (map-indexed (fn [line-no line] [(inc line-no) line]) lines)
        state (reduce parse-line initial-state numbered-lines)]

    (when (:block-key state)
      (throw (error-msg "EOF" "code block not closed")))

    (when (not= {} (:test-case state))
      (throw (error-msg "EOF" "test case 'out' block not completed")))

    (:test-cases state)))

(deftest run-test-cases
  (let [text (.readFileSync fs "formatter-test.md")
        test-cases (parse-test-cases text)]
    (doseq [{:keys [in out]} test-cases]
      (let [cursor-line (:cursor-line in)]
        (is (= (:text out) (format-text {:cursor-line cursor-line} (:text in)))
            (cond-> (str "test case @ line #" (:line-no in))
              cursor-line (str " with cursor at line:" (pr-str cursor-line))))))))

(ns parinfer.formatter-test
  (:require
    [clojure.string :as string :refer [split-lines]]
    [parinfer.formatter :refer [format-text]]
    [cljs.test :refer-macros [is deftest]]
    ))

(def fs (js/require "fs"))

;; All test cases are parsed from this markdown file.
(def test-filepath "formatter-test.md")

(defn error-msg
  [line-no msg]
  (str "error at test-case line #" line-no ": " msg))

(defmulti parse-test-line
  (fn [state [line-no line]]
    (cond
      (= "```" line)          :end-block
      (re-find #"^```" line)  :start-block
      (:block-key state)      :in-block
      :else                   :default)))

(defmethod parse-test-line :end-block
  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
  (if-not block-key
    (throw (error-msg line-no "opening block must have a name: 'in' or 'out'"))
    (let [test-case-done? (:out test-case)]
      (if test-case-done?

        ;; close test case
        (-> state
            (update-in [:test-cases] conj test-case)
            (assoc :block-key nil)
            (assoc :test-case {}))

        ;; close test block
        (assoc state :block-key nil)))))

(defmethod parse-test-line :start-block
  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
  (if block-key
    (throw (error-msg line-no "must close previous block before starting new one"))
    (let [block-name (second (re-find #"^```(.*)$" line))
          block-key (keyword block-name)]
      (cond

        (not (#{:in :out} block-key))
        (throw (error-msg line-no (str "block name " (pr-str block-name) "must be either 'in' or 'out'")))

        (and (= :in block-key) (:in test-case))
        (throw (error-msg line-no (str "there is already an 'in' block for this test case.")))

        (and (= :out block-key) (not (:in test-case)))
        (throw (error-msg line-no (str "must include an 'in' block before an 'out' block.")))

        :else
        (-> state
            (assoc :block-key block-key)
            (assoc-in [:test-case block-key] {:line-no line-no :text ""}))))))

(defmethod parse-test-line :in-block
  [{:keys [block-key test-case test-cases] :as state} [line-no line]]
  (let [cursor-x (.indexOf line "|")
        cursor-line (when (and (= :in block-key)
                               (not= -1 cursor-x))
                      (- line-no (:line-no (:in test-case))))
        line (string/replace line "|" "")]
    (-> state
        (update-in [:test-case block-key :text] str "\n" line)
        (update-in [:test-case block-key :cursor-line] #(or % cursor-line)))))

(defmethod parse-test-line :default
  [state [line-no line]]
  state)

(defn parse-test-cases [text]
  (let [lines (split-lines text)
        initial-state {:test-cases []
                       :block-key nil ;; :in or :out
                       :test-case {:in nil, :out nil}}
        numbered-lines (map-indexed (fn [line-no line] [(inc line-no) line]) lines)
        state (reduce parse-test-line initial-state numbered-lines)]

    (when (:block-key state)
      (throw (error-msg "EOF" "code block not closed")))

    (when (not= {} (:test-case state))
      (throw (error-msg "EOF" "test case 'out' block not completed")))

    (:test-cases state)))

(deftest run-test-cases
  (let [text (.readFileSync fs test-filepath)
        test-cases (parse-test-cases text)]
    (doseq [{:keys [in out]} test-cases]
      (let [cursor-line (:cursor-line in)]
        (is (= (:text out) (format-text {:cursor-line cursor-line} (:text in)))
            (cond-> (str "test case @ line #" (:line-no in))
              cursor-line (str " with cursor at line:" (pr-str cursor-line))))))))

modify formatter test to make clear that we are parsing test cases from the markdown file


(ns vignette.storage.s3-test
  (:require (vignette.storage [protocols :refer :all]
                              [s3 :refer :all]
                              [common :as sc])
            (vignette.util [byte-streams :refer :all])
            [pantomime.mime :refer (mime-type-of)]
            [aws.sdk.s3 :as s3]
            [midje.sweet :refer :all]
            [clojure.java.io :as io])
  (:import [com.amazonaws.services.s3.model AmazonS3Exception]))

(facts :s3 :get-object
  (get-object (create-s3-object-storage ..creds..) "bucket" "a/ab/image.jpg") => ..object..
  (provided
    (safe-get-object ..creds.. "bucket" "a/ab/image.jpg") => {:content ..stream..
                                                              :metadata {:content-length ..length.. :content-type ..content-type..}}
    (read-byte-stream ..stream.. ..length..) => ..bytes..
    (sc/create-storage-object ..bytes.. ..content-type.. ..length..) => ..object..)

  (get-object (create-s3-object-storage ..creds..) "bucket" "a/ab/image.jpg") => falsey
  (provided
    (s3/get-object ..creds.. "bucket" "a/ab/image.jpg") => {})

  (get-object (create-s3-object-storage ..creds..) "bucket" "d/do/does-not-exist.jpg") => falsey
  (provided
    (s3/get-object ..creds.. "bucket" "d/do/does-not-exist.jpg") =throws=> (let [e (AmazonS3Exception. "foo")]
                                                                             (.setStatusCode e 404)
                                                                             e)))

(facts :s3 :put-object
  (put-object (create-s3-object-storage ..creds..) ..resource.. "bucket" "a/ab/image.jpg") => ..response..
  (provided
    (mime-type-of ..resource..) => ..content-type..
    (s3/put-object ..creds.. "bucket" "a/ab/image.jpg" ..resource.. {:content-type ..content-type..}) => ..response..)

  ; this may not be realistic. we'll probably get an error before we get nil
  (put-object (create-s3-object-storage ..creds..) ..resource.. "bucket" "a/ab/image.jpg") => nil
  (provided
    (mime-type-of ..resource..) => ..content-type..
    (s3/put-object ..creds.. "bucket" "a/ab/image.jpg" ..resource.. {:content-type ..content-type..}) => nil))

(ns vignette.storage.s3-test
  (:require (vignette.storage [protocols :refer :all]
                              [s3 :refer :all]
                              [common :as sc])
            (vignette.util [byte-streams :refer :all])
            [pantomime.mime :refer (mime-type-of)]
            [aws.sdk.s3 :as s3]
            [midje.sweet :refer :all]
            [clojure.java.io :as io])
  (:import [com.amazonaws.services.s3.model AmazonS3Exception]))

(facts :s3 :get-object
  (get-object (create-s3-object-storage ..creds..) "bucket" "a/ab/image.jpg") => ..object..
  (provided
    (safe-get-object ..creds.. "bucket" "a/ab/image.jpg") => {:content ..stream..
                                                              :metadata {:content-length ..length.. :content-type ..content-type..}}
    (sc/create-storage-object ..stream.. ..content-type.. ..length..) => ..object..)

  (get-object (create-s3-object-storage ..creds..) "bucket" "a/ab/image.jpg") => falsey
  (provided
    (s3/get-object ..creds.. "bucket" "a/ab/image.jpg") => {})

  (get-object (create-s3-object-storage ..creds..) "bucket" "d/do/does-not-exist.jpg") => falsey
  (provided
    (s3/get-object ..creds.. "bucket" "d/do/does-not-exist.jpg") =throws=> (let [e (AmazonS3Exception. "foo")]
                                                                             (.setStatusCode e 404)
                                                                             e)))

(facts :s3 :put-object
  (put-object (create-s3-object-storage ..creds..) ..resource.. "bucket" "a/ab/image.jpg") => ..response..
  (provided
    (mime-type-of ..resource..) => ..content-type..
    (s3/put-object ..creds.. "bucket" "a/ab/image.jpg" ..resource.. {:content-type ..content-type..}) => ..response..)

  ; this may not be realistic. we'll probably get an error before we get nil
  (put-object (create-s3-object-storage ..creds..) ..resource.. "bucket" "a/ab/image.jpg") => nil
  (provided
    (mime-type-of ..resource..) => ..content-type..
    (s3/put-object ..creds.. "bucket" "a/ab/image.jpg" ..resource.. {:content-type ..content-type..}) => nil))

Fix the unit tests.

Fix the unit tests.