 
 
 
-;; ## Generators
-
-(def gen-block
-  "Generator which constructs blocks with random content and one of the
-  available hashing functions."
-  (gen/fmap
-    (partial apply block/read!)
-    (gen/tuple
-      (gen/not-empty (gen/scale (partial * 10) gen/bytes))
-      (gen/elements (keys digest/functions)))))
-
+;; ## Result Checkers
+
+(defn- check-stat
+  "Checker for the response for block stats."
+  [model id result]
+  (if-let [block (get model id)]
+    (testing "for stored block"
+      (is (map? result))
+      (is (= (:id block) (:id result)))
+      (is (= (:size block) (:size result)))
+      (is (some? (:stored-at result))))
+    (testing "for missing block"
+      (is (nil? result)))))
+
+
+(defn- check-list
+  "Checker for the response for a list call."
+  [model {:keys [algorithm after limit]} result]
+  (let [expected-ids
+          (cond->> (keys model)
+            after
+              (filter #(pos? (compare (multihash/hex %) after)))
+            algorithm
+              (filter #(= algorithm (:algorithm %)))
+            true
+              (sort)
+            limit
+              (take limit))]
+    (is (sequential? result))
+    (is (= (count result) (count expected-ids))
+        "result should match the number of blocks expected")
+    (is (every? (partial apply check-stat model)
+                (map vector expected-ids result))
+        "all stat results are rturned")))
+
+
+
+;; ## Operation Generators
 
 (defn- gen-list-opts
   "Generator for options maps to pass into a block/list call."

    blocks.data.PersistentBytes))


(defn random-block
  "Creates a new block with random content at most `max-size` bytes long."
  [max-size]

        (gen/vector (gen/large-integer* {:min 0, :max (:size block)}) 2)))))


(def ^:private store-operations
  "Map of information about the various operations which the tests can perform
  on the block store."
  (let [choose-id (comp gen/elements keys)
        choose-block (comp gen/elements vals)]
    {:stat
     {:args choose-id
      :check check-stat}

     :list
     {:args gen-list-opts
      :check check-list}

     :get
     {:args choose-id
      :check (fn check-get
               [model id result]
               (if-let [block (get model id)]
                 (is (= block result)
                     "returned block should be equivalent to model")
                 (is (nil? result)
                     "missing block should return nil")))}

     :put!
     {:args choose-block
      :update (fn update-put
                [model block]
                (assoc model (:id block) block))
      :check (fn check-put
               [model block result]
               (is (= (:id block) (:id result)))
               (is (= (:size block) (:size result)))
               (is (= block result)))}

     :delete!
     {:args choose-id
      :update (fn update-delete
                [model id]
                (dissoc model id))
      :check (fn check-delete
               [model id result]
               (if (contains? model id)
                 (is (true? result)
                     "deleting a stored block should return true")
                 (is (false? result)
                     "deleting a missing block should return false")))}

     :get-batch
     {:args (comp gen/not-empty gen/set choose-id)
      :check (fn check-get-batch
               [model ids result]
               (let [expected-blocks (keep model (set ids))]
                 (is (coll? result))
                 (is (= (set expected-blocks) (set result)))))}

     :put-batch!
     {:args (comp gen/not-empty gen/set choose-block)
      :update (fn update-put-batch
                [model blocks]
                (into model (map (juxt :id identity) blocks)))
      :check (fn check-put-batch
               [model blocks result]
               (is (= (set blocks) (set result))))}

     :delete-batch!
     {:args (comp gen/not-empty gen/set choose-id)
      :update (fn update-delete-batch
                [model ids]
                (apply dissoc model ids))
      :check (fn check-delete-batch
               [model ids result]
               (let [contained-ids (keep (set ids) (keys model))]
                 (is (set? result))
                 (is (= (set contained-ids) result))))}

     :open-block
     {:args choose-id
      :apply block/get
      :check (fn check-open-block
               [model id result]
               (if-let [block (get model id)]
                 (is (bytes= (.open (.content block)) (block/open result)))
                 (is (nil? result))))}

     :open-block-range
     {:args gen-block-range
      :apply (fn [store args] (block/get store (first args)))
      :check (fn check-open-block-range
               [model [id start end] result]
               (if-let [block (get model id)]
                 (is (bytes= (@#'blocks.core/bounded-input-stream
                               (.open (.content block)) start end)
                             (block/open result start end)))
                 (is (nil? result))))}}))


(defn- gen-store-op
  "Test generator which creates a single operation against the store."
  [blocks]
  (gen/bind
    (gen/elements (keys store-operations))
    (fn [op-key]
      (gen/tuple
        (gen/return op-key)
        ((get-in store-operations [op-key :args]) blocks)))))



;; ## Operation Testing

(defn- apply-op!
  "Applies an operation to the store by using the op keyword to resolve a method
  in the `blocks.core` namespace. Returns the result of calling the method."
  [store [op-key args]]
  ;(println ">>" op-key (pr-str args))
  (if-let [method (or (get-in store-operations [op-key :apply])
                      (ns-resolve 'blocks.core (symbol (name op-key))))]
    (method store args)
    (throw (ex-info "No apply function available for operation!"
                    {:op-key op-key}))))


(defn- check-op
  "Checks that the result of an operation matches the model of the store's
  contents. Returns true if the operation and model match."
  [model [op-key args] result]
  (if-let [checker (get-in store-operations [op-key :check])]
    (checker model args result)
    (throw (ex-info "No check function available for operation!"
                    {:op-key op-key}))))


(defn- update-model
  "Updates the model after an operation has been applied to the store under
  test. Returns an updated version of the model."
  [model [op-key args]]
  (if-let [updater (get-in store-operations [op-key :update])]
    (updater model args)
    model))


(defn- valid-op-seq?
  "Determines whether the given sequence of operations produces valid results
  when applied to the store. Returns true if the store behavior is valid."
  [store ops]
  (loop [model {}
         ops ops]
