(ns blocks.core
  "Block storage protocol and utilities. Functions which may cause IO to occur
  are marked with bangs; for example `(read! \"foo\")` doesn't have
  side-effects, but `(read! some-input-stream)` will consume bytes from the
  stream.

  When blocks are returned from a block store, they may include 'stat' metadata
  about the blocks, including:

  - `:stored-at`   time block was added to the store
  - `:origin`      resource location for the block
  "
  (:refer-clojure :exclude [get list])
  (:require
    [blocks.data :as data]
    [blocks.data.conversions]
    [byte-streams :as bytes]
    [clojure.java.io :as io]
    [clojure.set :as set]
    [clojure.string :as str]
    [multihash.core :as multihash])
  (:import
    blocks.data.Block
    blocks.data.PersistentBytes
    java.io.File
    java.io.IOException
    multihash.core.Multihash))

;; ## Block IO

(defn from-file
  "Creates a lazy block from a local file. The file is read once to calculate
  the identifier."
  ([file]
   (from-file file :sha2-256))
  ([file algorithm]
   (let [file (io/file file)
         hash-fn (data/checked-hash algorithm)
         reader #(io/input-stream file)
         id (hash-fn (reader))]
     (data/lazy-block id (.length file) reader))))

(defn open
  "Opens an input stream to read the content of the block. Returns nil for empty
  blocks."
  ^java.io.InputStream
  [^Block block]
  (let [content ^PersistentBytes (.content block)
        reader (.reader block)]
    (cond
      content (.open content)
      reader  (reader)
      :else   (throw (IOException.
                        (str "Cannot open empty block " (:id block)))))))

(defn read!
  "Reads data into memory from the given source and hashes it to identify the
  block. Defaults to sha2-256 if no algorithm is specified."
  ([source]
   (read! source :sha2-256))
  ([source algorithm]
   (data/read-block source algorithm)))

(defn write!
  "Writes block data to an output stream."
  [block out]
  (with-open [stream (open block)]
    (bytes/transfer stream out)))

(defn load!
  "Returns a literal block corresponding to the block given. If the block is
  lazy, the stream is read into memory and returned as a  If the block is
  already realized, it is returned unchanged."
  [^Block block]
  (if (realized? block)
    block
    (let [block' (with-open [stream (open block)]
                   (data/literal-block (:id block) stream))]
      (Block. (:id block')
              (:size block')
              (.content block')
              nil
              (._attrs block)
              (meta block)))))

(defn validate!
  "Checks a block to verify that it confirms to the expected schema and has a
  valid identifier for its content. Returns nil if the block is valid, or
  throws an exception on any error."
  [block]
  (let [id (:id block)
        size (:size block)]
    (when-not (instance? Multihash id)
      (throw (IllegalStateException.
               (str "Block id is not a multihash: " (pr-str id)))))
    (when (neg? size)
      (throw (IllegalStateException.
               (str "Block " id " has negative size: " size))))
    ; TODO: check size correctness later with a counting-input-stream?
    (when (realized? block)
      (let [actual-size (count @block)]
        (when (not= size actual-size)
          (throw (IllegalStateException.
                   (str "Block " id " reports size " size
                        " but has actual size " actual-size))))))
    (with-open [stream (open block)]
      (when-not (multihash/test id stream)
        (throw (IllegalStateException.
                 (str "Block " id " has mismatched content")))))))

;; ## Storage Interface

(defprotocol BlockStore
  "Protocol for content-addressable storage keyed by multihash identifiers."

  (stat
    [store id]
    "Returns a map with an `:id` and `:size` but no content. The returned map
    may contain additional data like the date stored. Returns nil if the store
    does not contain the identified block.")

  (-list
    [store opts]
    "Lists the blocks contained in the store. Returns a lazy sequence of stat
    metadata about each block. See `list` for the supported options.")

  (-get
    [store id]
    "Returns the identified block if it is stored, otherwise nil. The block
    should include stat metadata. Typically clients should use `get` instead,
    which validates arguments and the returned block record.")

  (put!
    [store block]
    "Saves a block into the store. Returns the block record, updated with stat
    metadata.")

  (delete!
    [store id]
    "Removes a block from the store. Returns true if the block was stored."))

; TODO: BlockEnumerator
; Protocol which returns a lazy sequence of every block in the store, along with
; an opaque marker which can be used to resume the stream in the same position.
; Blocks are explicitly **not** returned in any defined order; it is assumed the
; store will enumerate them in the most efficient order available.

(defn list
  "Enumerates the stored blocks, returning a lazy sequence of block stats.
  Iterating over the list may result in additional operations to read from the
  backing data store.

  - `:algorithm`  only return blocks using this hash algorithm
  - `:after`      list blocks whose id (in hex) lexically follows this string
  - `:limit`      restrict the maximum number of results returned
  "
  ([store & opts]
   (let [allowed-keys #{:algorithm :after :limit}
         opts-map (cond
                    (empty? opts) nil
                    (and (= 1 (count opts)) (map? (first opts))) (first opts)
                    :else (apply hash-map opts))
         bad-opts (set/difference (set (keys opts-map)) allowed-keys)]
     (when (not-empty bad-opts)
       (throw (IllegalArgumentException.
                (str "Invalid options passed to list: "
                     (str/join " " bad-opts)))))
     (when-let [algorithm (:algorithm opts-map)]
       (when-not (keyword? algorithm)
         (throw (IllegalArgumentException.
                  (str ":algorithm option must be a keyword: "
                       (pr-str algorithm))))))
     (when-let [after (:after opts-map)]
       (when-not (and (string? after) (re-matches #"^[0-9a-fA-F]*$" after))
         (throw (IllegalArgumentException.
                  (str ":after option must be a hex string: "
                       (pr-str after))))))
     (when-let [limit (:limit opts-map)]
       (when-not (and (integer? limit) (pos? limit))
         (throw (IllegalArgumentException.
                  (str ":limit option must be a positive integer: "
                       (pr-str limit))))))
     (-list store opts-map))))

(defn get
  "Loads content for a multihash and returns a block record. Returns nil if no
  block is stored. The returned block is checked to make sure the id matches the
  requested hash."
  [store id]
  (when-not (instance? Multihash id)
    (throw (IllegalArgumentException.
             (str "Id value must be a multihash, got: " (pr-str id)))))
  (when-let [block (-get store id)]
    (when-not (= id (:id block))
      (throw (RuntimeException.
               (str "Asked for block " id " but got " (:id block)))))
    block))

(defn store!
  "Stores content from a byte source in a block store and returns the block
  record. This function reads the content into memory, so may not be suitable
  for large sources."
  [store source]
  (when-let [block (read! source)]
    (put! store block)))

;; ## Utility Functions

(defn with-stats
  "Adds stat information to a block's metadata."
  [block stats]
  (vary-meta block assoc :block/stats stats))

(defn meta-stats
  "Returns stat information from a block's metadata, if present."
  [block]
  (:block/stats (meta block)))

(defn select-stats
  "Selects block stats from a sequence based on the criteria spported in
  `list`."
  [opts stats]
  (let [{:keys [algorithm after limit]} opts]
    (cond->> stats
      algorithm
        (filter (comp #{algorithm} :algorithm :id))
      after
        (drop-while #(pos? (compare after (multihash/hex (:id %)))))
      limit
        (take limit))))

(defn scan-size
  "Scans the blocks in a store to determine the total stored content size."
  [store]
  (->> (-list store nil)
       (map (comp :size (partial stat store)))
       (reduce + 0N)))

(ns blocks.core
  "Block storage protocol and utilities. Functions which may cause IO to occur
  are marked with bangs; for example `(read! \"foo\")` doesn't have
  side-effects, but `(read! some-input-stream)` will consume bytes from the
  stream.

  When blocks are returned from a block store, they may include 'stat' metadata
  about the blocks, including:

  - `:stored-at`   time block was added to the store
  - `:origin`      resource location for the block
  "
  (:refer-clojure :exclude [get list])
  (:require
    [blocks.data :as data]
    [blocks.data.conversions]
    [byte-streams :as bytes]
    [clojure.java.io :as io]
    [clojure.set :as set]
    [clojure.string :as str]
    [multihash.core :as multihash])
  (:import
    blocks.data.Block
    blocks.data.PersistentBytes
    java.io.File
    java.io.IOException
    multihash.core.Multihash))

;; ## Block IO

(defn from-file
  "Creates a lazy block from a local file. The file is read once to calculate
  the identifier."
  ([file]
   (from-file file :sha2-256))
  ([file algorithm]
   (let [file (io/file file)
         hash-fn (data/checked-hash algorithm)
         reader #(io/input-stream file)
         id (hash-fn (reader))]
     (data/lazy-block id (.length file) reader))))

(defn open
  "Opens an input stream to read the content of the block. Returns nil for empty
  blocks."
  ^java.io.InputStream
  [^Block block]
  (let [content ^PersistentBytes (.content block)
        reader (.reader block)]
    (cond
      content (.open content)
      reader  (reader)
      :else   (throw (IOException.
                        (str "Cannot open empty block " (:id block)))))))

(defn read!
  "Reads data into memory from the given source and hashes it to identify the
  block. Defaults to sha2-256 if no algorithm is specified."
  ([source]
   (read! source :sha2-256))
  ([source algorithm]
   (data/read-block source algorithm)))

(defn write!
  "Writes block data to an output stream."
  [block out]
  (with-open [stream (open block)]
    (bytes/transfer stream out)))

(defn load!
  "Returns a literal block corresponding to the block given. If the block is
  lazy, the stream is read into memory and returned as a  If the block is
  already realized, it is returned unchanged."
  [^Block block]
  (if (realized? block)
    block
    (let [content (with-open [stream (open block)]
                    (bytes/to-byte-array stream))]
      (Block. (:id block)
              (count content)
              (PersistentBytes/wrap content)
              nil
              (._attrs block)
              (meta block)))))

(defn validate!
  "Checks a block to verify that it confirms to the expected schema and has a
  valid identifier for its content. Returns nil if the block is valid, or
  throws an exception on any error."
  [block]
  (let [id (:id block)
        size (:size block)]
    (when-not (instance? Multihash id)
      (throw (IllegalStateException.
               (str "Block id is not a multihash: " (pr-str id)))))
    (when (neg? size)
      (throw (IllegalStateException.
               (str "Block " id " has negative size: " size))))
    ; TODO: check size correctness later with a counting-input-stream?
    (when (realized? block)
      (let [actual-size (count @block)]
        (when (not= size actual-size)
          (throw (IllegalStateException.
                   (str "Block " id " reports size " size
                        " but has actual size " actual-size))))))
    (with-open [stream (open block)]
      (when-not (multihash/test id stream)
        (throw (IllegalStateException.
                 (str "Block " id " has mismatched content")))))))

;; ## Storage Interface

(defprotocol BlockStore
  "Protocol for content-addressable storage keyed by multihash identifiers."

  (stat
    [store id]
    "Returns a map with an `:id` and `:size` but no content. The returned map
    may contain additional data like the date stored. Returns nil if the store
    does not contain the identified block.")

  (-list
    [store opts]
    "Lists the blocks contained in the store. Returns a lazy sequence of stat
    metadata about each block. See `list` for the supported options.")

  (-get
    [store id]
    "Returns the identified block if it is stored, otherwise nil. The block
    should include stat metadata. Typically clients should use `get` instead,
    which validates arguments and the returned block record.")

  (put!
    [store block]
    "Saves a block into the store. Returns the block record, updated with stat
    metadata.")

  (delete!
    [store id]
    "Removes a block from the store. Returns true if the block was stored."))

; TODO: BlockEnumerator
; Protocol which returns a lazy sequence of every block in the store, along with
; an opaque marker which can be used to resume the stream in the same position.
; Blocks are explicitly **not** returned in any defined order; it is assumed the
; store will enumerate them in the most efficient order available.

(defn list
  "Enumerates the stored blocks, returning a lazy sequence of block stats.
  Iterating over the list may result in additional operations to read from the
  backing data store.

  - `:algorithm`  only return blocks using this hash algorithm
  - `:after`      list blocks whose id (in hex) lexically follows this string
  - `:limit`      restrict the maximum number of results returned
  "
  ([store & opts]
   (let [allowed-keys #{:algorithm :after :limit}
         opts-map (cond
                    (empty? opts) nil
                    (and (= 1 (count opts)) (map? (first opts))) (first opts)
                    :else (apply hash-map opts))
         bad-opts (set/difference (set (keys opts-map)) allowed-keys)]
     (when (not-empty bad-opts)
       (throw (IllegalArgumentException.
                (str "Invalid options passed to list: "
                     (str/join " " bad-opts)))))
     (when-let [algorithm (:algorithm opts-map)]
       (when-not (keyword? algorithm)
         (throw (IllegalArgumentException.
                  (str ":algorithm option must be a keyword: "
                       (pr-str algorithm))))))
     (when-let [after (:after opts-map)]
       (when-not (and (string? after) (re-matches #"^[0-9a-fA-F]*$" after))
         (throw (IllegalArgumentException.
                  (str ":after option must be a hex string: "
                       (pr-str after))))))
     (when-let [limit (:limit opts-map)]
       (when-not (and (integer? limit) (pos? limit))
         (throw (IllegalArgumentException.
                  (str ":limit option must be a positive integer: "
                       (pr-str limit))))))
     (-list store opts-map))))

(defn get
  "Loads content for a multihash and returns a block record. Returns nil if no
  block is stored. The returned block is checked to make sure the id matches the
  requested hash."
  [store id]
  (when-not (instance? Multihash id)
    (throw (IllegalArgumentException.
             (str "Id value must be a multihash, got: " (pr-str id)))))
  (when-let [block (-get store id)]
    (when-not (= id (:id block))
      (throw (RuntimeException.
               (str "Asked for block " id " but got " (:id block)))))
    block))

(defn store!
  "Stores content from a byte source in a block store and returns the block
  record. If the source is a file, it will be streamed into the store.
  Otherwise, the content is read into memory, so this may not be suitable for
  large sources."
  [store source]
  (put! store (if (instance? File source)
                (from-file source)
                (read! source))))

;; ## Utility Functions

(defn with-stats
  "Adds stat information to a block's metadata."
  [block stats]
  (vary-meta block assoc :block/stats stats))

(defn meta-stats
  "Returns stat information from a block's metadata, if present."
  [block]
  (:block/stats (meta block)))

(defn select-stats
  "Selects block stats from a sequence based on the criteria spported in
  `list`."
  [opts stats]
  (let [{:keys [algorithm after limit]} opts]
    (cond->> stats
      algorithm
        (filter (comp #{algorithm} :algorithm :id))
      after
        (drop-while #(pos? (compare after (multihash/hex (:id %)))))
      limit
        (take limit))))

(defn scan-size
  "Scans the blocks in a store to determine the total stored content size."
  [store]
  (->> (-list store nil)
       (map (comp :size (partial stat store)))
       (reduce + 0N)))

Make store! smart about files.

Make store! smart about files.


(ns circle.ruby
  (:refer-clojure :exclude [eval send methods])
  (:import org.jruby.RubySymbol)
  (:import java.lang.ref.WeakReference)
  (:use [circle.util.except :only (throw-if-not)])
  (:require fs))

(declare eval ruby get-class get-module send)

(defn new-runtime []
  (let [config (doto (org.jruby.RubyInstanceConfig.)
                 (.setCompatVersion org.jruby.CompatVersion/RUBY1_9)
                 (.setJRubyHome (format "%s/.rvm/rubies/%s" (System/getenv "HOME") (System/getenv "rvm_ruby_string"))))]
    (org.jruby.Ruby/newInstance config)))

(defn eval
  ([s]
     (eval (ruby) s))
  ([runtime s]
     (try
       (-> runtime (.evalScriptlet s))
       (catch Exception e
         (.printStackTrace e)
         (throw e)))))

(defn ruby-require
  ([package]
     (ruby-require (ruby) package))
  ([runtime package]
     (eval runtime (format "require '%s'" (clojure.core/name package)))))

(defn add-loadpath [runtime path]
  (eval runtime (format "$LOAD_PATH << '%s/%s'" (System/getProperty "user.dir") path)))

(defn require-rails
  "Require rails, but don't start the webapp"
  []
  (ruby-require (ruby) (format "%s/config/environment" (System/getProperty "user.dir"))))

;; This is the runtime all ruby requests will go through. It's
;; unlikely that Rails' runtime will be returned by getGlobalRuntime,
;; meaning that all rails instance variables will not be
;; visible. To make them visible, call init from rails first.

;; Use a weakref to prevent this atom from keeping the ruby instance alive
(defonce runtime (atom (WeakReference. nil)))

(defn init
  "Call this from the rails runtime, passing in JRuby.runtime. This
  will be used for all calls."
  [r]
  (swap! runtime (constantly (WeakReference. r))))

(defn ensure-runtime []
  (when (not (-> runtime deref (.get)))
    (println "setting default runtime")
    (swap! runtime (constantly (WeakReference. (new-runtime))))))

(defn ruby []
  (ensure-runtime)
  (-> runtime deref (.get)))

(defmulti ->ruby
  "Convert Ruby data to Clojure data"
  class)

(defmethod ->ruby
  clojure.lang.IPersistentMap [m]
  (let [new-h (org.jruby.RubyHash. (ruby))]
    (->> m
         (map (fn [[k v]] [(->ruby k) (->ruby v)]))
         (into {})
         (.putAll new-h))
    new-h))

(defmethod ->ruby
  clojure.lang.Keyword [k]
  (RubySymbol/newSymbol (ruby) (name k)))

(defmethod ->ruby
  org.jruby.runtime.builtin.IRubyObject [e]
  e)

;; RaiseException wraps an exception for Java, but isn't an IRubyObject.
(defmethod ->ruby
  org.jruby.exceptions.RaiseException [e]
  (.getException e))

(defmethod ->ruby
  java.lang.Exception [e]
  e)

(defmethod ->ruby
  clojure.lang.Sequential [v]
  (let [new-a (org.jruby.RubyArray/newArray (ruby) [])
        values (map ->ruby v)]
    (.addAll new-a values)
    new-a))

(defmethod ->ruby
  java.lang.String [s]
  (org.jruby.RubyString/newString (ruby) s))

(defmethod ->ruby
  org.bson.types.ObjectId [id]
  (send (get-class (get-module "BSON") "ObjectId") :from_string (.toString id)))

(defmethod ->ruby
  java.lang.Float [n]
  (org.jruby.RubyFloat. (ruby) n))

(defmethod ->ruby
  java.lang.Double [n]
  (org.jruby.RubyFloat. (ruby) n))

(defmethod ->ruby
  java.lang.Integer [n]
  (org.jruby.RubyFixnum. (ruby) n))

(defmethod ->ruby
  java.lang.Long [n]
  (org.jruby.RubyFixnum. (ruby) n))

(defmethod ->ruby
  java.lang.Boolean [b]
  (if b
    (-> (ruby) (.getTrue))
    (-> (ruby) (.getFalse))))

(defmethod ->ruby
  nil [n]
  (-> (ruby) (.getNil)))

(def sample-objectid-string "4ee6911fe4b05e6a4d3605fe")

(defn rspec
  "runs rspec. Useful from clojure repl.

Note that rspec will run in whatever RAILS_ENV you started in, so you
  probably want to start in RAILS_ENV=test, or rspec will clear your
  DB, or tests will fail because they assume the DB cleaner runs."
  [& subdirs]
  (let [subdirs (if (empty? subdirs) [""] subdirs)
        subdirs (map #(fs/join "spec" %) subdirs)
        command (format "
require 'rubygems'
require 'rspec/core/rake_task'

RSpec::Core::Runner.run(%s)
" (vec subdirs))]
    (eval command)))

(defn get-kernel
  "Returns the Kernel module. Used for 'core' functions like puts"
  []
  (.getKernel (ruby)))

(defn get-class
  "Returns the class/module with the given name. With one arg, looks for a class in the root namespace. With two args, looks for a class/module defined under another class, like Foo::Bar"
  ([name]
     (.getClass (ruby) name))
  ([parent name]
     (.getClass parent name)))

(defn send
  "Call a method on a ruby object"
  [obj method & args]
  (throw-if-not obj "Can't call methods on nil")
  (.callMethod obj (name method) (into-array org.jruby.runtime.builtin.IRubyObject (map ->ruby args))))

(defn get-module
  ([name]
     (.getModule (ruby) name))
  ([parent module-name]
     (send parent :const_get module-name)))

(defn methods
  "Returns the list of ruby methods on the obj"
  [obj]
  (seq (send obj :methods)))

(ns circle.ruby
  (:refer-clojure :exclude [eval send methods])
  (:import org.jruby.RubySymbol)
  (:import java.io.PrintWriter)
  (:import java.io.StringWriter)
  (:import java.lang.ref.WeakReference)
  (:use [circle.util.except :only (throw-if-not)])
  (:require fs))

(declare eval ruby get-class get-module send)

(defn new-runtime []
  (let [config (doto (org.jruby.RubyInstanceConfig.)
                 (.setCompatVersion org.jruby.CompatVersion/RUBY1_9)
                 (.setJRubyHome (format "%s/.rvm/rubies/%s" (System/getenv "HOME") (System/getenv "rvm_ruby_string"))))]
    (org.jruby.Ruby/newInstance config)))

(defn eval
  ([s]
     (eval (ruby) s))
  ([runtime s]
     (try
       (-> runtime (.evalScriptlet s))
       (catch Exception e
         (.printStackTrace e)
         (throw e)))))

(defn ruby-require
  ([package]
     (ruby-require (ruby) package))
  ([runtime package]
     (eval runtime (format "require '%s'" (clojure.core/name package)))))

(defn add-loadpath [runtime path]
  (eval runtime (format "$LOAD_PATH << '%s/%s'" (System/getProperty "user.dir") path)))

(defn require-rails
  "Require rails, but don't start the webapp"
  []
  (ruby-require (ruby) (format "%s/config/environment" (System/getProperty "user.dir"))))

;; This is the runtime all ruby requests will go through. It's
;; unlikely that Rails' runtime will be returned by getGlobalRuntime,
;; meaning that all rails instance variables will not be
;; visible. To make them visible, call init from rails first.

;; Use a weakref to prevent this atom from keeping the ruby instance alive
(defonce runtime (atom (WeakReference. nil)))

(defn init
  "Call this from the rails runtime, passing in JRuby.runtime. This
  will be used for all calls."
  [r]
  (swap! runtime (constantly (WeakReference. r))))

(defn ensure-runtime []
  (when (not (-> runtime deref (.get)))
    (println "setting default runtime")
    (swap! runtime (constantly (WeakReference. (new-runtime))))))

(defn ruby []
  (ensure-runtime)
  (-> runtime deref (.get)))

;; Each of these must return an IRubyObject.
(defmulti ->ruby
  "Convert Ruby data to Clojure data"
  class)

(defmethod ->ruby
  clojure.lang.IPersistentMap [m]
  (let [new-h (org.jruby.RubyHash. (ruby))]
    (->> m
         (map (fn [[k v]] [(->ruby k) (->ruby v)]))
         (into {})
         (.putAll new-h))
    new-h))

(defmethod ->ruby
  clojure.lang.Keyword [k]
  (RubySymbol/newSymbol (ruby) (name k)))

(defmethod ->ruby
  org.jruby.runtime.builtin.IRubyObject [e]
  e)

;; RaiseException wraps an exception for Java, but isn't an IRubyObject.
(defmethod ->ruby
  org.jruby.exceptions.RaiseException [e]
  (.getException e))

;; Exceptions aren't IRubyObjects
(defmethod ->ruby
  java.lang.Exception [e]
  (let [w (StringWriter.)
        pw (PrintWriter. w)]
    (.printStackTrace e pw)
    (.toString w)))

(defmethod ->ruby
  clojure.lang.Sequential [v]
  (let [new-a (org.jruby.RubyArray/newArray (ruby) [])
        values (map ->ruby v)]
    (.addAll new-a values)
    new-a))

(defmethod ->ruby
  java.lang.String [s]
  (org.jruby.RubyString/newString (ruby) s))

(defmethod ->ruby
  org.bson.types.ObjectId [id]
  (send (get-class (get-module "BSON") "ObjectId") :from_string (.toString id)))

(defmethod ->ruby
  java.lang.Float [n]
  (org.jruby.RubyFloat. (ruby) n))

(defmethod ->ruby
  java.lang.Double [n]
  (org.jruby.RubyFloat. (ruby) n))

(defmethod ->ruby
  java.lang.Integer [n]
  (org.jruby.RubyFixnum. (ruby) n))

(defmethod ->ruby
  java.lang.Long [n]
  (org.jruby.RubyFixnum. (ruby) n))

(defmethod ->ruby
  java.lang.Boolean [b]
  (if b
    (-> (ruby) (.getTrue))
    (-> (ruby) (.getFalse))))

(defmethod ->ruby
  nil [n]
  (-> (ruby) (.getNil)))

(defmethod ->ruby
  :default [val]
  (org.jruby.RubyString/newString (ruby) (format "Uncastable values: %s" val)))

(def sample-objectid-string "4ee6911fe4b05e6a4d3605fe")

(defn rspec
  "runs rspec. Useful from clojure repl.

Note that rspec will run in whatever RAILS_ENV you started in, so you
  probably want to start in RAILS_ENV=test, or rspec will clear your
  DB, or tests will fail because they assume the DB cleaner runs."
  [& subdirs]
  (let [subdirs (if (empty? subdirs) [""] subdirs)
        subdirs (map #(fs/join "spec" %) subdirs)
        command (format "
require 'rubygems'
require 'rspec/core/rake_task'

RSpec::Core::Runner.run(%s)
" (vec subdirs))]
    (eval command)))

(defn get-kernel
  "Returns the Kernel module. Used for 'core' functions like puts"
  []
  (.getKernel (ruby)))

(defn get-class
  "Returns the class/module with the given name. With one arg, looks for a class in the root namespace. With two args, looks for a class/module defined under another class, like Foo::Bar"
  ([name]
     (.getClass (ruby) name))
  ([parent name]
     (.getClass parent name)))

(defn send
  "Call a method on a ruby object"
  [obj method & args]
  (throw-if-not obj "Can't call methods on nil")
  (.callMethod obj (name method) (into-array org.jruby.runtime.builtin.IRubyObject (map ->ruby args))))

(defn get-module
  ([name]
     (.getModule (ruby) name))
  ([parent module-name]
     (send parent :const_get module-name)))

(defn methods
  "Returns the list of ruby methods on the obj"
  [obj]
  (seq (send obj :methods)))

Fix ->ruby for Exceptions and unhandled types.


;; Copyright 2014 Andrey Antukh <niwi@niwi.be>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns buddy.test-buddy-sign
  (:require [clojure.test :refer :all]
            [buddy.core.codecs :refer :all]
            [buddy.core.keys :refer :all]
            [buddy.sign.generic :as gsign]
            [buddy.sign.jws :as jws]
            [clj-time.coerce :as jodac]
            [clj-time.core :as jodat]
            [clojure.java.io :as io])
  (:import java.util.Arrays))

(def secret "test")

(deftest buddy-sign-generic
  (testing "Signing/Unsigning with default keys"
    (let [signed (gsign/sign "foo" secret)]
      (Thread/sleep 1000)
      (is (not= (gsign/sign "foo" secret) signed))
      (is (= (gsign/unsign signed secret) "foo"))))

  (testing "Signing/Unsigning timestamped"
    (let [signed  (gsign/sign "foo" secret)
          result1 (gsign/unsign signed secret {:max-age 20})
          _       (Thread/sleep 700)
          result2 (gsign/unsign signed secret {:max-age -1})]
      (is (= "foo" result1))
      (is (nil? result2))))

  (testing "Try sing with invalid alg"
    (is (thrown? AssertionError (gsign/sign "foo" secret {:alg :invalid}))))

  (testing "Use custom algorithm for sign/unsign"
    (let [rsa-privkey (private-key "test/_files/privkey.3des.rsa.pem" "secret")
          rsa-pubkey  (public-key "test/_files/pubkey.3des.rsa.pem")
          signed      (gsign/sign "foo" rsa-privkey {:alg :rs256})]
      (Thread/sleep 20)
      (is (not= (gsign/sign "foo" rsa-privkey {:alg :rs256}) signed))
      (is (= "foo" (gsign/unsign signed rsa-pubkey {:alg :rs256})))
      (Thread/sleep 1000)
      (is (= nil (gsign/unsign signed rsa-pubkey {:alg :rs256 :max-age 1})))))

  (testing "Signing/Unsigning complex clojure data"
    (let [signed (gsign/dumps {:foo 2 :bar 1} secret)]
      (is (= {:foo 2 :bar 1} (gsign/loads signed secret))))))

(deftest buddy-sign-jws
  (let [plainkey "secret"]
    (testing "Pass exp as claim or parameter shoult return same result"
      (let [candidate1 {"iss" "joe" :exp 1300819380}
            candidate2 {"iss" "joe"}
            result1    (jws/sign candidate1 plainkey)
            result2    (jws/sign candidate2 plainkey {:exp 1300819380})]
        (is (= result1 result2))))

    (testing "Unsing simple jws"
      (let [candidate1 {:foo "bar"}
            signed1    (jws/sign candidate1 plainkey)
            unsigned1   (jws/unsign signed1 plainkey)]
        (is (= unsigned1 candidate1))))

    (testing "Unsigning jws with exp"
      (let [candidate1 {:foo "bar"}
            now        (-> (jodat/now) (jws/to-timestamp))
            exp        (+ now 2)
            signed1    (jws/sign candidate1 plainkey {:exp exp})]
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (= unsigned1 (assoc candidate1 :exp exp))))
        (Thread/sleep 2100)
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (nil? unsigned1)))))

    (testing "Unsigning jws with nbf"
      (let [candidate1 {:foo "bar"}
            now        (-> (jodat/now) (jws/to-timestamp))
            nbf        (+ now 2)
            signed1    (jws/sign candidate1 plainkey {:nbf nbf})]
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (= unsigned1 (assoc candidate1 :nbf nbf))))
        (Thread/sleep 2100)
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (nil? unsigned1)))))
))

;; Copyright 2014 Andrey Antukh <niwi@niwi.be>
;;
;; Licensed under the Apache License, Version 2.0 (the "License")
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(ns buddy.test-buddy-sign
  (:require [clojure.test :refer :all]
            [buddy.core.codecs :refer :all]
            [buddy.core.keys :refer :all]
            [buddy.sign.generic :as gsign]
            [buddy.sign.jws :as jws]
            [clj-time.coerce :as jodac]
            [clj-time.core :as jodat]
            [clojure.java.io :as io])
  (:import java.util.Arrays))

(def secret "test")

(deftest buddy-sign-generic
  (testing "Signing/Unsigning with default keys"
    (let [signed (gsign/sign "foo" secret)]
      (Thread/sleep 1000)
      (is (not= (gsign/sign "foo" secret) signed))
      (is (= (gsign/unsign signed secret) "foo"))))

  (testing "Signing/Unsigning timestamped"
    (let [signed  (gsign/sign "foo" secret)
          result1 (gsign/unsign signed secret {:max-age 20})
          _       (Thread/sleep 700)
          result2 (gsign/unsign signed secret {:max-age -1})]
      (is (= "foo" result1))
      (is (nil? result2))))

  (testing "Try sing with invalid alg"
    (is (thrown? AssertionError (gsign/sign "foo" secret {:alg :invalid}))))

  (testing "Use custom algorithm for sign/unsign"
    (let [rsa-privkey (private-key "test/_files/privkey.3des.rsa.pem" "secret")
          rsa-pubkey  (public-key "test/_files/pubkey.3des.rsa.pem")
          signed      (gsign/sign "foo" rsa-privkey {:alg :rs256})]
      (Thread/sleep 20)
      (is (not= (gsign/sign "foo" rsa-privkey {:alg :rs256}) signed))
      (is (= "foo" (gsign/unsign signed rsa-pubkey {:alg :rs256})))
      (Thread/sleep 1000)
      (is (= nil (gsign/unsign signed rsa-pubkey {:alg :rs256 :max-age 1})))))

  (testing "Signing/Unsigning complex clojure data"
    (let [signed (gsign/dumps {:foo 2 :bar 1} secret)]
      (is (= {:foo 2 :bar 1} (gsign/loads signed secret))))))

(deftest buddy-sign-jws
  (let [plainkey "secret"
        rsa-privkey (private-key "test/_files/privkey.3des.rsa.pem" "secret")
        rsa-pubkey  (public-key "test/_files/pubkey.3des.rsa.pem")
        ec-privkey  (private-key "test/_files/privkey.ecdsa.pem" "secret")
        ec-pubkey   (public-key "test/_files/pubkey.ecdsa.pem")]

    (testing "Pass exp as claim or parameter shoult return same result"
      (let [candidate1 {"iss" "joe" :exp 1300819380}
            candidate2 {"iss" "joe"}
            result1    (jws/sign candidate1 plainkey)
            result2    (jws/sign candidate2 plainkey {:exp 1300819380})]
        (is (= result1 result2))))

    (testing "Unsing simple jws"
      (let [candidate1 {:foo "bar"}
            signed1    (jws/sign candidate1 plainkey)
            unsigned1   (jws/unsign signed1 plainkey)]
        (is (= unsigned1 candidate1))))

    (testing "Unsigning jws with exp"
      (let [candidate1 {:foo "bar"}
            now        (-> (jodat/now) (jws/to-timestamp))
            exp        (+ now 2)
            signed1    (jws/sign candidate1 plainkey {:exp exp})]
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (= unsigned1 (assoc candidate1 :exp exp))))
        (Thread/sleep 2100)
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (nil? unsigned1)))))

    (testing "Unsigning jws with nbf"
      (let [candidate1 {:foo "bar"}
            now        (-> (jodat/now) (jws/to-timestamp))
            nbf        (+ now 2)
            signed1    (jws/sign candidate1 plainkey {:nbf nbf})]
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (= unsigned1 (assoc candidate1 :nbf nbf))))
        (Thread/sleep 2100)
        (let [unsigned1 (jws/unsign signed1 plainkey)]
          (is (nil? unsigned1)))))

    (testing "Using :rs256 digital signature"
      (let [candidate1  {:foo "bar"}
            signed1     (jws/sign candidate1 rsa-privkey {:alg :rs256})
            unsigned1   (jws/unsign signed1 rsa-pubkey {:alg :rs256})]
        (is (= unsigned1 candidate1))))

    (testing "Using :ps512 digital signature"
      (let [candidate1  {:foo "bar"}
            signed1     (jws/sign candidate1 rsa-privkey {:alg :ps512})
            unsigned1   (jws/unsign signed1 rsa-pubkey {:alg :ps512})]
        (is (= unsigned1 candidate1))))

    (testing "Using :ec512 digital signature"
      (let [candidate1 {:foo "bar"}
            signed1    (jws/sign candidate1 ec-privkey {:alg :es512})
            unsigned1  (jws/unsign signed1 ec-pubkey {:alg :es512})]
        (is (= unsigned1 candidate1))))
))

Add more tests for jws/jwt.

Add more tests for jws/jwt.


(ns devtools.test.format
  (:require [cljs.test :refer-macros [deftest testing is]]
            [devtools.utils.test :refer [js-equals is-header want? is-body has-body? unroll]]
            [devtools.format :as f]))

(deftest wants
  (testing "these simple values should not be processed by our custom formatter"
    (want? "some string" false)
    (want? 0 false)
    (want? 1000 false)
    (want? -1000 false)
    (want? 0.5 false)
    (want? 0.0 false)
    (want? -0.5 false)
    (want? true false)
    (want? false false)
    (want? nil false)
    (want? #(.-document js/window) false))
  (testing "these values should be processed by our custom formatter"
    (want? :keyword true)
    (want? ::auto-namespaced-keyword true)
    (want? :devtools.tes/fully-qualified-keyword true)
    (want? 'symbol true)
    (want? [] true)
    (want? '() true)
    (want? {} true)
    (want? #{} true)))

(deftest bodies
  (testing "these values should not have body"
    (has-body? "some string" false)
    (has-body? 0 false)
    (has-body? 1000 false)
    (has-body? -1000 false)
    (has-body? 0.5 false)
    (has-body? 0.0 false)
    (has-body? -0.5 false)
    (has-body? true false)
    (has-body? false false)
    (has-body? nil false)
    (has-body? #(.-document js/window) false)
    (has-body? :keyword false)
    (has-body? ::auto-namespaced-keyword false)
    (has-body? :devtools.tes/fully-qualified-keyword false)
    (has-body? 'symbol false)
    (has-body? [] false)
    (has-body? '() false)
    (has-body? {} false)
    (has-body? #{} false)
    (has-body? (range f/max-number-body-items) false)))

(deftest test-simple-atomic-values
  (testing "keywords"
    (is-header :keyword
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/keyword-style} ":keyword"]])
    (is-header ::auto-namespaced-keyword
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/keyword-style} ":devtools.test.format/auto-namespaced-keyword"]])
    (is-header :devtools.tes/fully-qualified-keyword
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/keyword-style} ":devtools.tes/fully-qualified-keyword"]]))
  (testing "symbols"
    (is-header 'symbol
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/symbol-style} "symbol"]])))

(deftest test-strings
  (testing "short strings"
    (is-header "some short string"
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/string-style} (str f/dq "some short string" f/dq)]])
    (is-header "line1\nline2\n\nline4"
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/string-style} (str f/dq "line1" f/new-line-string-replacer "line2" f/new-line-string-replacer f/new-line-string-replacer "line4" f/dq)]]))
  (testing "long strings"
    (is-header "123456789012345678901234567890123456789012345678901234567890"
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {"style" f/string-style} (str f/dq "12345678901234567890" f/string-abbreviation-marker "12345678901234567890" f/dq)]])))
    (is-header "1234\n6789012345678901234567890123456789012345678901234\n67890"
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {"style" f/string-style}
            (str
              f/dq
              "1234" f/new-line-string-replacer "678901234567890"
              f/string-abbreviation-marker
              "12345678901234" f/new-line-string-replacer "67890"
              f/dq)]])
        (is-body ref
          ["ol" {"style" f/standard-ol-style}
           ["li" {"style" f/standard-li-style}
            ["span" {"style" f/string-style}
             (str
               f/dq
               "1234" f/new-line-string-replacer
               "\n6789012345678901234567890123456789012345678901234" f/new-line-string-replacer
               "\n67890"
               f/dq)]]])))))

(deftest test-collections
  (testing "vectors"
    (is-header [1 2 3]
      ["span" {"style" f/general-cljs-land-style}
       "["
       ["span" {"style" f/integer-style} 1] f/spacer
       ["span" {"style" f/integer-style} 2] f/spacer
       ["span" {"style" f/integer-style} 3]
       "]"])
    (is (= 5 f/max-header-elements))
    (is-header [1 2 3 4 5]
      ["span" {"style" f/general-cljs-land-style}
       "["
       (unroll (fn [i] [["span" {"style" f/integer-style} (+ i 1)] f/spacer]) (range 4))
       ["span" {"style" f/integer-style} 5]
       "]"])
    (is-header [1 2 3 4 5 6]
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {}
            "["
            (unroll (fn [i] [["span" {"style" f/integer-style} (+ i 1)] f/spacer]) (range 5))
            f/more-marker
            "]"]])
        (has-body? ref true)
        (is-body ref
          ["ol" {"style" f/standard-ol-style}
           (unroll (fn [i] [["li" {"style" f/standard-li-style}
                             ["span" {"style" f/index-style} i f/line-index-separator]
                             f/spacer
                             ["span" {"style" f/general-cljs-land-style}
                              ["span" {"style" f/integer-style} (+ i 1)]]]]) (range 6))]))))
  (testing "ranges"
    (is (> 10 f/max-header-elements))
    (is-header (range 10)
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (has-body? ref true)
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {}
            "("
            (unroll (fn [i] [["span" {"style" f/integer-style} i] f/spacer]) (range f/max-header-elements))
            f/more-marker
            ")"]])))))

(deftest test-continuations
  (testing "long range"
    (is-header (range (+ f/max-number-body-items 1))
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (has-body? ref true)
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {}
            "("
            (unroll (fn [i] [["span" {"style" f/integer-style} i] f/spacer]) (range f/max-header-elements))
            f/more-marker
            ")"]])
        (is-body ref
          ["ol" {"style" f/standard-ol-style}
           (unroll (fn [i] [["li" {"style" f/standard-li-style}
                             ["span" {"style" f/index-style} i f/line-index-separator]
                             f/spacer
                             ["span" {"style" f/general-cljs-land-style}
                              ["span" {"style" f/integer-style} i]]]]) (range f/max-number-body-items))
           ["li" {"style" f/standard-li-style}
            ["object" {"object" "##REF##"}]]]
          (fn [ref]
            (is (f/surrogate? ref))
            (has-body? ref true)
            (is-header ref
              ["span" {"style" f/general-cljs-land-style} f/body-items-more-label])
            (is-body ref
              ["ol" {"style" f/standard-ol-no-margin-style}
               (unroll (fn [i] [["li" {"style" f/standard-li-no-margin-style}
                                 ["span" {"style" f/index-style} f/max-number-body-items f/line-index-separator]
                                 f/spacer
                                 ["span" {"style" f/general-cljs-land-style}
                                  ["span" {"style" f/integer-style} (+ i f/max-number-body-items)]]]]) (range 1))])))))))

(ns devtools.test.format
  (:require [cljs.test :refer-macros [deftest testing is]]
            [devtools.utils.test :refer [js-equals is-header want? is-body has-body? unroll]]
            [devtools.format :as f]))

(deftest wants
  (testing "these simple values should not be processed by our custom formatter"
    (want? "some string" false)
    (want? 0 false)
    (want? 1000 false)
    (want? -1000 false)
    (want? 0.5 false)
    (want? 0.0 false)
    (want? -0.5 false)
    (want? true false)
    (want? false false)
    (want? nil false)
    (want? #(.-document js/window) false))
  (testing "these values should be processed by our custom formatter"
    (want? :keyword true)
    (want? ::auto-namespaced-keyword true)
    (want? :devtools/fully-qualified-keyword true)
    (want? 'symbol true)
    (want? [] true)
    (want? '() true)
    (want? {} true)
    (want? #{} true)))

(deftest bodies
  (testing "these values should not have body"
    (has-body? "some string" false)
    (has-body? 0 false)
    (has-body? 1000 false)
    (has-body? -1000 false)
    (has-body? 0.5 false)
    (has-body? 0.0 false)
    (has-body? -0.5 false)
    (has-body? true false)
    (has-body? false false)
    (has-body? nil false)
    (has-body? #(.-document js/window) false)
    (has-body? :keyword false)
    (has-body? ::auto-namespaced-keyword false)
    (has-body? :devtools/fully-qualified-keyword false)
    (has-body? 'symbol false)
    (has-body? [] false)
    (has-body? '() false)
    (has-body? {} false)
    (has-body? #{} false)
    (has-body? (range f/max-number-body-items) false)))

(deftest test-simple-atomic-values
  (testing "keywords"
    (is-header :keyword
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/keyword-style} ":keyword"]])
    (is-header ::auto-namespaced-keyword
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/keyword-style} ":devtools.test.format/auto-namespaced-keyword"]])
    (is-header :devtools/fully-qualified-keyword
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/keyword-style} ":devtools/fully-qualified-keyword"]]))
  (testing "symbols"
    (is-header 'symbol
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/symbol-style} "symbol"]])))

(deftest test-strings
  (testing "short strings"
    (is-header "some short string"
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/string-style} (str f/dq "some short string" f/dq)]])
    (is-header "line1\nline2\n\nline4"
      ["span" {"style" f/general-cljs-land-style}
       ["span" {"style" f/string-style} (str f/dq "line1" f/new-line-string-replacer "line2" f/new-line-string-replacer f/new-line-string-replacer "line4" f/dq)]]))
  (testing "long strings"
    (is-header "123456789012345678901234567890123456789012345678901234567890"
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {"style" f/string-style} (str f/dq "12345678901234567890" f/string-abbreviation-marker "12345678901234567890" f/dq)]])))
    (is-header "1234\n6789012345678901234567890123456789012345678901234\n67890"
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {"style" f/string-style}
            (str
              f/dq
              "1234" f/new-line-string-replacer "678901234567890"
              f/string-abbreviation-marker
              "12345678901234" f/new-line-string-replacer "67890"
              f/dq)]])
        (is-body ref
          ["ol" {"style" f/standard-ol-style}
           ["li" {"style" f/standard-li-style}
            ["span" {"style" f/string-style}
             (str
               f/dq
               "1234" f/new-line-string-replacer
               "\n6789012345678901234567890123456789012345678901234" f/new-line-string-replacer
               "\n67890"
               f/dq)]]])))))

(deftest test-collections
  (testing "vectors"
    (is-header [1 2 3]
      ["span" {"style" f/general-cljs-land-style}
       "["
       ["span" {"style" f/integer-style} 1] f/spacer
       ["span" {"style" f/integer-style} 2] f/spacer
       ["span" {"style" f/integer-style} 3]
       "]"])
    (is (= 5 f/max-header-elements))
    (is-header [1 2 3 4 5]
      ["span" {"style" f/general-cljs-land-style}
       "["
       (unroll (fn [i] [["span" {"style" f/integer-style} (+ i 1)] f/spacer]) (range 4))
       ["span" {"style" f/integer-style} 5]
       "]"])
    (is-header [1 2 3 4 5 6]
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {}
            "["
            (unroll (fn [i] [["span" {"style" f/integer-style} (+ i 1)] f/spacer]) (range 5))
            f/more-marker
            "]"]])
        (has-body? ref true)
        (is-body ref
          ["ol" {"style" f/standard-ol-style}
           (unroll (fn [i] [["li" {"style" f/standard-li-style}
                             ["span" {"style" f/index-style} i f/line-index-separator]
                             f/spacer
                             ["span" {"style" f/general-cljs-land-style}
                              ["span" {"style" f/integer-style} (+ i 1)]]]]) (range 6))]))))
  (testing "ranges"
    (is (> 10 f/max-header-elements))
    (is-header (range 10)
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (has-body? ref true)
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {}
            "("
            (unroll (fn [i] [["span" {"style" f/integer-style} i] f/spacer]) (range f/max-header-elements))
            f/more-marker
            ")"]])))))

(deftest test-continuations
  (testing "long range"
    (is-header (range (+ f/max-number-body-items 1))
      ["span" {"style" f/general-cljs-land-style}
       ["object" {"object" "##REF##"}]]
      (fn [ref]
        (is (f/surrogate? ref))
        (has-body? ref true)
        (is-header ref
          ["span" {"style" f/general-cljs-land-style}
           ["span" {}
            "("
            (unroll (fn [i] [["span" {"style" f/integer-style} i] f/spacer]) (range f/max-header-elements))
            f/more-marker
            ")"]])
        (is-body ref
          ["ol" {"style" f/standard-ol-style}
           (unroll (fn [i] [["li" {"style" f/standard-li-style}
                             ["span" {"style" f/index-style} i f/line-index-separator]
                             f/spacer
                             ["span" {"style" f/general-cljs-land-style}
                              ["span" {"style" f/integer-style} i]]]]) (range f/max-number-body-items))
           ["li" {"style" f/standard-li-style}
            ["object" {"object" "##REF##"}]]]
          (fn [ref]
            (is (f/surrogate? ref))
            (has-body? ref true)
            (is-header ref
              ["span" {"style" f/general-cljs-land-style} f/body-items-more-label])
            (is-body ref
              ["ol" {"style" f/standard-ol-no-margin-style}
               (unroll (fn [i] [["li" {"style" f/standard-li-no-margin-style}
                                 ["span" {"style" f/index-style} f/max-number-body-items f/line-index-separator]
                                 f/spacer
                                 ["span" {"style" f/general-cljs-land-style}
                                  ["span" {"style" f/integer-style} (+ i f/max-number-body-items)]]]]) (range 1))])))))))

Fix a typo

Fix a typo


(ns crison.main
  (:require [clojure.edn :refer [read-string]]
            [clj-time.core :as t]
            [clj-time.format :as f]
            [clj-time.local :as l]
            [environ.core :refer [env]]
            [clojure.test :refer :all]
            [webdriver.core :as wc]
            [webdriver.form :as wf])
  (:gen-class))

(System/setProperty "phantomjs.binary.path" (env :phantom-path))

(def driver (wc/new-webdriver {:browser :phantomjs}))
(def built-in-formatter (f/formatters :basic-date-time))

(defn formatlocal [n offset]
  (let [nlocal (t/to-time-zone n (t/time-zone-for-offset offset))]
    (f/unparse (f/formatter-local "yyyy-MM-dd_hh:mm")
               nlocal)))
(def f-date (formatlocal (t/now) -0))

(defn title [] (wc/title driver))

(defn title? [x] (is (= x (title)) x))

(defn go [x] (wc/to driver x))

(defn el [x] (-> driver (wc/find-element x)))

;; currently a catchall from the multimethod
(defn ? [x] (is (-> driver (wc/find-element x) wc/exists?) (str "Fail on : " x)))

(defn text? [x]
  (is (= (:text? x)
        (wc/text (-> driver (wc/find-element (dissoc x :text?)))))))

(defmulti decode (fn[x] (ffirst x)))

(defmethod decode :url! [x] (go (:url! x)))

(defmethod decode :click! [x]
  (let [e (:click! x)]
    (if (string? e)
      (-> driver (wc/find-element {:id e}) wc/click)
      (-> driver (wc/find-element e) wc/click))
    (Thread/sleep 2000)))

(defmethod decode :submit! [{:keys [submit!]}]
  (let [input (first submit!)
        v (:text! input)
        srch (dissoc input :text!)]
        (-> driver (wc/find-element srch) (wc/input-text v))
        (-> driver (wc/find-element (last submit!)) wc/click)))

(defmethod decode :search! [x]
  (wf/quick-fill-submit driver (:search! x)) (Thread/sleep 2000))

(defmethod decode :title [x] (title? (:title x)))

(defmethod decode :text? [x] (text? x))

(defmethod decode :default [x] (? x))

(def screenshot-file (str f-date "-screenshot_test.png"))
(defn take-screenshot
  [driver]
  (is (string? (wc/get-screenshot driver :base64)))
  (is (> (count (wc/get-screenshot driver :bytes)) 0))
  (is (= (class (wc/get-screenshot driver :file)) java.io.File))
  (is (= (class (wc/get-screenshot driver :file screenshot-file)) java.io.File))
  ;; the following will throw an exception if deletion fails, hence our test
  ;(clojure.java.io/delete-file screenshot-file)
  )

(deftest tests
  (wc/resize driver {:width 1024 :height 800})
  (let [fs (file-seq (clojure.java.io/file "resources"))]
    (doseq [f (next fs)]
      (doseq [t (read-string (slurp f))] (decode t))
      (take-screenshot driver))))

(def test-file (clojure.java.io/writer (str f-date "-tests.txt")))

(defn -main [& args]
  (binding [*test-out* test-file]
    (run-tests 'crison.main)))

(ns crison.main
  (:require [clojure.edn :refer [read-string]]
            [clj-time.core :as t]
            [clj-time.format :as f]
            [clj-time.local :as l]
            [environ.core :refer [env]]
            [clojure.test :refer :all]
            [webdriver.core :as wc]
            [webdriver.form :as wf])
  (:gen-class))

(System/setProperty "phantomjs.binary.path" (env :phantom-path))

(def driver (wc/new-webdriver {:browser :phantomjs}))
(def built-in-formatter (f/formatters :basic-date-time))

(defn date []
  (let [nlocal (t/to-time-zone (t/now) (t/time-zone-for-offset -0))]
    (f/unparse (f/formatter-local "yyyy-MM-dd_hh:mm")
               nlocal)))
(def f-date (date))

(defn title [] (wc/title driver))

(defn title? [x] (is (= x (title)) x))

(defn go [x] (wc/to driver x))

(defn el [x] (-> driver (wc/find-element x)))

;; currently a catchall from the multimethod
(defn ? [x] (is (-> driver (wc/find-element x) wc/exists?) (str "Fail on : " x)))

(defn text? [x]
  (is (= (:text? x)
        (wc/text (-> driver (wc/find-element (dissoc x :text?)))))))

(defmulti decode (fn[x] (ffirst x)))

(defmethod decode :url! [x] (go (:url! x)))

(defmethod decode :click! [x]
  (let [e (:click! x)]
    (if (string? e)
      (-> driver (wc/find-element {:id e}) wc/click)
      (-> driver (wc/find-element e) wc/click))
    (Thread/sleep 2000)))

(defmethod decode :submit! [{:keys [submit!]}]
  (let [input (first submit!)
        v (:text! input)
        srch (dissoc input :text!)]
        (-> driver (wc/find-element srch) (wc/input-text v))
        (-> driver (wc/find-element (last submit!)) wc/click)))

(defmethod decode :search! [x]
  (wf/quick-fill-submit driver (:search! x)) (Thread/sleep 2000))

(defmethod decode :title [x] (title? (:title x)))

(defmethod decode :text? [x] (text? x))

(defmethod decode :default [x] (? x))

(defn take-screenshot
  [driver f]
  (let [s-file (str (date) "_" (.getName f) "-screenshot.png")]
    (is (string? (wc/get-screenshot driver :base64)))
    (is (> (count (wc/get-screenshot driver :bytes)) 0))
    (is (= (class (wc/get-screenshot driver :file)) java.io.File))
    (is (= (class (wc/get-screenshot driver :file s-file)) java.io.File)))

  ;; the following will throw an exception if deletion fails, hence our test
  ;(clojure.java.io/delete-file screenshot-file)
  )

(deftest tests
  (wc/resize driver {:width 1024 :height 800})
  (let [fs (file-seq (clojure.java.io/file "resources"))]
    (doseq [f (next fs)]
      (doseq [t (read-string (slurp f))] (decode t))
      (take-screenshot driver f))))

(def test-file (clojure.java.io/writer (str (date) "-tests.txt")))

(defn -main [& args]
  (binding [*test-out* test-file]
    (run-tests 'crison.main)))

improve output filenames

improve output filenames


(ns domshot.core
  (:require [goog.dom]))

(enable-console-print!)

;; ---- Node validators ---- ;;

(def node-invalidators
  "An atom of a list of predicates. Each takes the current node as its only arg.
  Predicates should return `true` if you want `snapshot` to ignore the node."
  (atom ()))

(defn include-node? [node]
  (not-any? false? (map #(% node) @node-invalidators)))

(def attr-invalidators
  "An atom of a list of predicates. Each takes an attr name and val as its
  args. Predicates should return `true` if you want `snapshot` to ignore the
  attr name-val pair."
  (atom ()))

(defn include-attr? [name val]
  (not-any? false? (map #(% name val) @attr-invalidators)))

(defmulti add-invalidator (fn [_ invalidator-type] invalidator-type))

(defmethod add-invalidator :attribute [fn]
  (swap! attr-invalidators conj fn))

(defmethod add-invalidator :default [fn]
  (swap! attr-invalidators conj fn))

;; ---- Serializing the dom ---- ;;

(defn get-attrs [node]
  (if (.-attributes node)
    (into {}
          (let [attrs (.-attributes node)]
            (for [i (range (.-length attrs))
                  :let [attr  (aget attrs i)
                        name  (.-name attr)
                        value (.-value attr)]
                  :when (include-attr? name value)]
              [name value])))
    {}))

(defn handle-special-nodes
  "Fills in important node-specific key-val pairs"
  [node-map native-node]
  (let [node-types goog.dom/NodeType]
    (condp = (.-nodeType native-node)
      (.-TEXT node-types) (assoc node-map :text (.-nodeValue native-node))
      node-map)))

(defn gen-basic-node-map [node]
  {:node-name  (.-nodeName node)
   :attributes (get-attrs node)})

(defn snapshot
  "Recursively serialize validated nodes into a clojure data structure"
  ([]
   (let [all-html (.-documentElement (goog.dom/getDocument))]
     (snapshot all-html)))
  ([node]
   (let [node-map (-> node gen-basic-node-map (handle-special-nodes node))]
     (assoc node-map
       :children (if (not (.hasChildNodes node))
                   []
                   (vec (for [index (range (-> node .-childNodes .-length))
                              :let [child (aget (.-childNodes node) index)]
                              :when (include-node? child)]
                          (snapshot child))))))))

;; ---- Building the dom ---- ;;

(defn build
  "Takes a structure produced by `snapshot` as its only arg.
  Returns a dom tree reflecting the given structure."
  [structure]
  (let [node-name (:node-name structure)]
    (if (= "#text" node-name)
      (goog.dom/createTextNode (:text structure))
      (goog.dom/createDom node-name
                          (clj->js (:attributes structure))
                          (when (< 0 (count (:children structure)))
                            (clj->js (for [i (range (count (:children structure)))
                                           :let [child (nth (:children structure) i)]]
                                       (build child))))))))

(ns domshot.core
  (:require [goog.dom]))

(enable-console-print!)

;; ---- Qualifiers ---- ;;

(def node-qualifiers
  "An atom of a list of predicates. Each takes the current node as its only arg.
  All predicates should return `true` if you want `snapshot` to include the node."
  (atom ()))

(defn include-node? [node]
  (not-any? false? (map #(% node) @node-qualifiers)))

(def attr-qualifiers
  "An atom of a list of predicates. Each takes an attr name and val as its
  args. All predicates should return `true` if you want `snapshot` to include the
  attr name-val pair."
  (atom ()))

(defn include-attr? [name val]
  (not-any? false? (map #(% name val) @attr-qualifiers)))

(defmulti add-qualifier (fn [_ qualifier-type] qualifier-type))

(defmethod add-qualifier :attribute [fn]
  (swap! attr-qualifiers conj fn))

(defmethod add-qualifier :default [fn]
  (swap! attr-qualifiers conj fn))

;; ---- Serializing the dom ---- ;;

(defn get-attrs [node]
  (if (.-attributes node)
    (into {}
          (let [attrs (.-attributes node)]
            (for [i (range (.-length attrs))
                  :let [attr  (aget attrs i)
                        name  (.-name attr)
                        value (.-value attr)]
                  :when (include-attr? name value)]
              [name value])))
    {}))

(defn handle-special-nodes
  "Fills in important node-specific key-val pairs"
  [node-map native-node]
  (let [node-types goog.dom/NodeType]
    (condp = (.-nodeType native-node)
      (.-TEXT node-types) (assoc node-map :text (.-nodeValue native-node))
      node-map)))

(defn gen-basic-node-map [node]
  {:node-name  (.-nodeName node)
   :attributes (get-attrs node)})

(defn snapshot
  "Recursively serialize validated nodes into a clojure data structure"
  ([]
   (let [all-html (.-documentElement (goog.dom/getDocument))]
     (snapshot all-html)))
  ([node]
   (let [node-map (-> node gen-basic-node-map (handle-special-nodes node))]
     (assoc node-map
       :children (if (not (.hasChildNodes node))
                   []
                   (vec (for [index (range (-> node .-childNodes .-length))
                              :let [child (aget (.-childNodes node) index)]
                              :when (include-node? child)]
                          (snapshot child))))))))

;; ---- Building the dom ---- ;;

(defn build
  "Takes a structure produced by `snapshot` as its only arg.
  Returns a dom tree reflecting the given structure."
  [structure]
  (let [node-name (:node-name structure)]
    (if (= "#text" node-name)
      (goog.dom/createTextNode (:text structure))
      (goog.dom/createDom node-name
                          (clj->js (:attributes structure))
                          (when (< 0 (count (:children structure)))
                            (clj->js (for [i (range (count (:children structure)))
                                           :let [child (nth (:children structure) i)]]
                                       (build child))))))))

change invalidator to qualifier to simplify logic


(ns misaki.server
  "Development server

  Listen *port* to publish developing blog,
  and watch template updates.
  "
  (:use
    [misaki core config template]
    [misaki.util.file :only [add-path-slash has-extension? file?]]
    [misaki.util.string :only [blue red]]
    watchtower.core
    [compojure.core :only [routes]]
    [compojure.route :only [files]]
    [ring.adapter.jetty :only [run-jetty]]))

; =print-result
(defn print-compile-result
  "Print colored compile result."
  [#^String message result]
  (let [text (case result
               true (blue "DONE")
               false (red "FAIL")
               (blue "SKIP"))]
    (println (str " * compiling " message ": ... " text))))

;; ## Dev Compiler

; =do-all-compile
(defn do-all-compile
  "Compile all templates"
  []
  (print-compile-result "all templates" (compile-all-templates))
  (print-compile-result "all tags" (compile-all-tags))
  (print-compile-result "clojurescripts" (compile-clojurescripts)))

; =do-compile
(defn do-compile
  "Compile templte file and print status"
  [#^java.io.File file]
  {:pre [(file? file)]}
  (cond
    ; clojurescript
    (has-extension? ".cljs" file)
    (print-compile-result "clojurescript" (compile-clojurescripts))

    ; layout or config
    (or (layout-file? file) (config-file? file))
    (do-all-compile)

    ; else
    :else
    (do
      (print-compile-result "template" (compile-template file))
      (when (post-file? file)
        ; compile with posts
        (if *compile-with-post*
          (doseq [tmpl-name *compile-with-post*]
            (do-compile (template-name->file tmpl-name))))
        ; compile tag
        (if-let [tags (-> file parse-template-option :tag)]
          (doseq [{tag-name :name} tags]
            (print-compile-result "tag" (compile-tag tag-name))))))))

;; ## Template Watcher

; =start-watcher
(defn start-watcher
  "Start watchtower watcher to compile changed templates"
  []
  ; compile all templates at first
  (do-all-compile)

  (watcher
    [*template-dir*
     (str *base-dir* *config-file*)]
    (rate 50)
    (change-first? false) ; do not compile each templates at first
    (file-filter ignore-dotfiles)
    (file-filter (extensions :clj :cljs))
    (on-change #(doseq [file %]
                  ; use `wrap-config` to apply config file updates
                  (with-config (do-compile file))))))

;; ## main

; =main
(defn -main [& [dir :as args]]
  (binding [*base-dir* (add-path-slash dir)]
    (with-config
      (if (contains? (set args) "--compile")
        ; compile all only if '--compile' option is specified
        (do-all-compile)
        ; start watching and server
        (do (start-watcher)
            (run-jetty
              (routes (files "/" {:root *public-dir*}))
              {:port *port*}))))))

(ns misaki.server
  "Development server

  Listen *port* to publish developing blog,
  and watch template updates.
  "
  (:use
    [misaki core config template]
    [misaki.util.file   :only [add-path-slash has-extension? file?]]
    [misaki.util.string :only [blue red]]
    watchtower.core
    [compojure.core     :only [routes]]
    [compojure.route    :only [files]]
    [ring.adapter.jetty :only [run-jetty]]))

; =print-result
(defn print-compile-result
  "Print colored compile result."
  [#^String message, result]
  (let [text (case result
               true  (blue "DONE")
               false (red "FAIL")
               (blue "SKIP"))]
    (println (str " * compiling " message ": ... " text))))

;; ## Dev Compiler

; =do-all-compile
(defn do-all-compile
  "Compile all templates"
  []
  (print-compile-result "all templates"  (compile-all-templates))
  (print-compile-result "all tags"       (compile-all-tags))
  (print-compile-result "clojurescripts" (compile-clojurescripts)))

; =do-compile
(defn do-compile
  "Compile templte file and print status"
  [#^java.io.File file]
  {:pre [(file? file)]}
  (cond
    ; clojurescript
    (has-extension? ".cljs" file)
    (print-compile-result "clojurescript" (compile-clojurescripts))

    ; layout or config
    (or (layout-file? file) (config-file? file))
    (do-all-compile)

    ; else
    :else
    (do
      (print-compile-result "template" (compile-template file))
      (when (post-file? file)
        ; compile with posts
        (if *compile-with-post*
          (doseq [tmpl-name *compile-with-post*]
            (do-compile (template-name->file tmpl-name))))
        ; compile tag
        (if-let [tags (-> file parse-template-option :tag)]
          (doseq [{tag-name :name} tags]
            (print-compile-result "tag" (compile-tag tag-name))))))))

;; ## Template Watcher

; =start-watcher
(defn start-watcher
  "Start watchtower watcher to compile changed templates"
  []
  ; compile all templates at first
  (do-all-compile)

  (watcher
    [*template-dir*
     (str *base-dir* *config-file*)]
    (rate 50)
    (change-first? false) ; do not compile each templates at first
    (file-filter ignore-dotfiles)
    (file-filter (extensions :clj :cljs))
    (on-change #(doseq [file %]
                  ; use `wrap-config` to apply config file updates
                  (with-config (do-compile file))))))

;; ## main

; =main
(defn -main [& [dir :as args]]
  (binding [*base-dir* (add-path-slash dir)]
    (with-config
      (if (contains? (set args) "--compile")
        ; compile all only if '--compile' option is specified
        (do-all-compile)
        ; start watching and server
        (do (start-watcher)
            (run-jetty
              (routes (files "/" {:root *public-dir*}))
              {:port *port*}))))))

maintain misaki.server

maintain misaki.server


;; -*- comment-column: 35; -*-
(ns metabase.core
  (:gen-class)
  (:require [clojure.string :as s]
            [clojure.tools.logging :as log]
            environ.core
            [ring.adapter.jetty :as ring-jetty]
            (ring.middleware [cookies :refer [wrap-cookies]]
                             [gzip :refer [wrap-gzip]]
                             [json :refer [wrap-json-response
                                           wrap-json-body]]
                             [keyword-params :refer [wrap-keyword-params]]
                             [params :refer [wrap-params]]
                             [session :refer [wrap-session]])
            [medley.core :as m]
            (metabase [config :as config]
                      [db :as db]
                      [driver :as driver]
                      [events :as events]
                      [logger :as logger]
                      [metabot :as metabot]
                      [middleware :as mb-middleware]
                      [plugins :as plugins]
                      [routes :as routes]
                      [sample-data :as sample-data]
                      [setup :as setup]
                      [task :as task]
                      [util :as u])
            (metabase.models [setting :refer [defsetting]]
                             [user :refer [User]])))

;;; CONFIG

(def ^:private app
  "The primary entry point to the Ring HTTP server."
  (-> routes/routes
      mb-middleware/log-api-call
      mb-middleware/add-security-headers ; Add HTTP headers to API responses to prevent them from being cached
      (wrap-json-body                    ; extracts json POST body and makes it avaliable on request
        {:keywords? true})
      wrap-json-response                 ; middleware to automatically serialize suitable objects as JSON in responses
      wrap-keyword-params                ; converts string keys in :params to keyword keys
      wrap-params                        ; parses GET and POST params as :query-params/:form-params and both as :params
      mb-middleware/bind-current-user    ; Binds *current-user* and *current-user-id* if :metabase-user-id is non-nil
      mb-middleware/wrap-current-user-id ; looks for :metabase-session-id and sets :metabase-user-id if Session ID is valid
      mb-middleware/wrap-api-key         ; looks for a Metabase API Key on the request and assocs as :metabase-api-key
      mb-middleware/wrap-session-id      ; looks for a Metabase Session ID and assoc as :metabase-session-id
      wrap-cookies                       ; Parses cookies in the request map and assocs as :cookies
      wrap-session                       ; reads in current HTTP session and sets :session/key
      wrap-gzip))                        ; GZIP response if client can handle it

;;; ## ---------------------------------------- LIFECYCLE ----------------------------------------

(defonce ^:private metabase-initialization-progress
  (atom 0))

(defn initialized?
  "Is Metabase initialized and ready to be served?"
  []
  (= @metabase-initialization-progress 1.0))

(defn initialization-progress
  "Get the current progress of Metabase initialization."
  []
  @metabase-initialization-progress)

(defn initialization-complete!
  "Complete the Metabase initialization by setting its progress to 100%."
  []
  (reset! metabase-initialization-progress 1.0))

(defn- -init-create-setup-token
  "Create and set a new setup token and log it."
  []
  (let [setup-token (setup/create-token!)                    ; we need this here to create the initial token
        hostname    (or (config/config-str :mb-jetty-host) "localhost")
        port        (config/config-int :mb-jetty-port)
        setup-url   (str "http://"
                         (or hostname "localhost")
                         (when-not (= 80 port) (str ":" port))
                         "/setup/")]
    (log/info (u/format-color 'green "Please use the following url to setup your Metabase installation:\n\n%s\n\n"
                              setup-url))))

(defn- destroy!
  "General application shutdown function which should be called once at application shuddown."
  []
  (log/info "Metabase Shutting Down ...")
  (task/stop-scheduler!)
  (log/info "Metabase Shutdown COMPLETE"))

(defn init!
  "General application initialization function which should be run once at application startup."
  []
  (log/info (format "Starting Metabase version %s ..." config/mb-version-string))
  (log/info (format "System timezone is '%s' ..." (System/getProperty "user.timezone")))
  (reset! metabase-initialization-progress 0.1)

  ;; First of all, lets register a shutdown hook that will tidy things up for us on app exit
  (.addShutdownHook (Runtime/getRuntime) (Thread. ^Runnable destroy!))
  (reset! metabase-initialization-progress 0.2)

  ;; load any plugins as needed
  (plugins/load-plugins!)
  (reset! metabase-initialization-progress 0.3)

  ;; Load up all of our Database drivers, which are used for app db work
  (driver/find-and-load-drivers!)
  (reset! metabase-initialization-progress 0.4)

  ;; startup database.  validates connection & runs any necessary migrations
  (db/setup-db! :auto-migrate (config/config-bool :mb-db-automigrate))
  (reset! metabase-initialization-progress 0.5)

  ;; run a very quick check to see if we are doing a first time installation
  ;; the test we are using is if there is at least 1 User in the database
  (let [new-install (not (db/exists? User))]

    ;; Bootstrap the event system
    (events/initialize-events!)
    (reset! metabase-initialization-progress 0.7)

    ;; Now start the task runner
    (task/start-scheduler!)
    (reset! metabase-initialization-progress 0.8)

    (when new-install
      (log/info "Looks like this is a new installation ... preparing setup wizard")
      ;; create setup token
      (-init-create-setup-token)
      ;; publish install event
      (events/publish-event :install {}))
    (reset! metabase-initialization-progress 0.9)

    ;; deal with our sample dataset as needed
    (if new-install
      ;; add the sample dataset DB for fresh installs
      (sample-data/add-sample-dataset!)
      ;; otherwise update if appropriate
      (sample-data/update-sample-dataset-if-needed!))

    ;; start the metabot thread
    (metabot/start-metabot!))

  (initialization-complete!)
  (log/info "Metabase Initialization COMPLETE"))

;;; ## ---------------------------------------- Jetty (Web) Server ----------------------------------------

(def ^:private jetty-instance
  (atom nil))

(defn start-jetty!
  "Start the embedded Jetty web server."
  []
  (when-not @jetty-instance
    (let [jetty-ssl-config (m/filter-vals identity {:ssl-port       (config/config-int :mb-jetty-ssl-port)
                                                    :keystore       (config/config-str :mb-jetty-ssl-keystore)
                                                    :key-password   (config/config-str :mb-jetty-ssl-keystore-password)
                                                    :truststore     (config/config-str :mb-jetty-ssl-truststore)
                                                    :trust-password (config/config-str :mb-jetty-ssl-truststore-password)})
          jetty-config     (cond-> (m/filter-vals identity {:port          (config/config-int :mb-jetty-port)
                                                            :host          (config/config-str :mb-jetty-host)
                                                            :max-threads   (config/config-int :mb-jetty-maxthreads)
                                                            :min-threads   (config/config-int :mb-jetty-minthreads)
                                                            :max-queued    (config/config-int :mb-jetty-maxqueued)
                                                            :max-idle-time (config/config-int :mb-jetty-maxidletime)})
                             (config/config-str :mb-jetty-daemon) (assoc :daemon? (config/config-bool :mb-jetty-daemon))
                             (config/config-str :mb-jetty-ssl)    (-> (assoc :ssl? true)
                                                                      (merge jetty-ssl-config)))]
      (log/info "Launching Embedded Jetty Webserver with config:\n" (with-out-str (clojure.pprint/pprint (m/filter-keys (fn [k] (not (re-matches #".*password.*" (str k)))) jetty-config))))
      ;; NOTE: we always start jetty w/ join=false so we can start the server first then do init in the background
      (->> (ring-jetty/run-jetty app (assoc jetty-config :join? false))
           (reset! jetty-instance)))))

(defn stop-jetty!
  "Stop the embedded Jetty web server."
  []
  (when @jetty-instance
    (log/info "Shutting Down Embedded Jetty Webserver")
    (.stop ^org.eclipse.jetty.server.Server @jetty-instance)
    (reset! jetty-instance nil)))

;;; ## ---------------------------------------- Normal Start ----------------------------------------

(defn- start-normally []
  (log/info "Starting Metabase in STANDALONE mode")
  (try
    ;; launch embedded webserver async
    (start-jetty!)
    ;; run our initialization process
    (init!)
    ;; Ok, now block forever while Jetty does its thing
    (when (config/config-bool :mb-jetty-join)
      (.join ^org.eclipse.jetty.server.Server @jetty-instance))
    (catch Throwable e
      (.printStackTrace e)
      (log/error "Metabase Initialization FAILED: " (.getMessage e))
      (System/exit 1))))

;;; ---------------------------------------- Special Commands ----------------------------------------

(defn ^:command migrate
  "Run database migrations. Valid options for DIRECTION are `up`, `force`, `down-one`, `print`, or `release-locks`."
  [direction]
  (db/migrate! @db/db-connection-details (keyword direction)))

(defn ^:command load-from-h2
  "Transfer data from existing H2 database to the newly created MySQL or Postgres DB specified by env vars."
  ([]
   (load-from-h2 nil))
  ([h2-connection-string]
   (require 'metabase.cmd.load-from-h2)
   ((resolve 'metabase.cmd.load-from-h2/load-from-h2!) h2-connection-string)))

(defn ^:command profile
  "Start Metabase the usual way and exit. Useful for profiling Metabase launch time."
  []
  ;; override env var that would normally make Jetty block forever
  (intern 'environ.core 'env (assoc environ.core/env :mb-jetty-join "false"))
  (u/profile "start-normally" (start-normally)))

(defn ^:command help
  "Show this help message listing valid Metabase commands."
  []
  (println "Valid commands are:")
  (doseq [[symb varr] (sort (ns-interns 'metabase.core))
          :when       (:command (meta varr))]
    (println symb (s/join " " (:arglists (meta varr))))
    (println "\t" (:doc (meta varr)))))

(defn- cmd->fn [command-name]
  (or (when (seq command-name)
        (when-let [varr (ns-resolve 'metabase.core (symbol command-name))]
          (when (:command (meta varr))
            @varr)))
      (do (println (u/format-color 'red "Unrecognized command: %s" command-name))
          (help)
          (System/exit 1))))

(defn- run-cmd [cmd & args]
  (try (apply (cmd->fn cmd) args)
       (catch Throwable e
         (.printStackTrace e)
         (println (u/format-color 'red "Command failed with exception: %s" (.getMessage e)))
         (System/exit 1)))
  (System/exit 0))

;;; ---------------------------------------- App Entry Point ----------------------------------------

(defn -main
  "Launch Metabase in standalone mode."
  [& [cmd & args]]
  (if cmd
    (apply run-cmd cmd args) ; run a command like `java -jar metabase.jar migrate release-locks` or `lein run migrate release-locks`
    (start-normally)))       ; with no command line args just start Metabase normally

;; -*- comment-column: 35; -*-
(ns metabase.core
  (:gen-class)
  (:require [clojure.string :as s]
            [clojure.tools.logging :as log]
            environ.core
            [ring.adapter.jetty :as ring-jetty]
            (ring.middleware [cookies :refer [wrap-cookies]]
                             [gzip :refer [wrap-gzip]]
                             [json :refer [wrap-json-response
                                           wrap-json-body]]
                             [keyword-params :refer [wrap-keyword-params]]
                             [params :refer [wrap-params]]
                             [session :refer [wrap-session]])
            [medley.core :as m]
            (metabase [config :as config]
                      [db :as db]
                      [driver :as driver]
                      [events :as events]
                      [logger :as logger]
                      [metabot :as metabot]
                      [middleware :as mb-middleware]
                      [plugins :as plugins]
                      [routes :as routes]
                      [sample-data :as sample-data]
                      [setup :as setup]
                      [task :as task]
                      [util :as u])
            [metabase.models.user :refer [User]]))

;;; CONFIG

(def ^:private app
  "The primary entry point to the Ring HTTP server."
  (-> routes/routes
      mb-middleware/log-api-call
      mb-middleware/add-security-headers ; Add HTTP headers to API responses to prevent them from being cached
      (wrap-json-body                    ; extracts json POST body and makes it avaliable on request
        {:keywords? true})
      wrap-json-response                 ; middleware to automatically serialize suitable objects as JSON in responses
      wrap-keyword-params                ; converts string keys in :params to keyword keys
      wrap-params                        ; parses GET and POST params as :query-params/:form-params and both as :params
      mb-middleware/bind-current-user    ; Binds *current-user* and *current-user-id* if :metabase-user-id is non-nil
      mb-middleware/wrap-current-user-id ; looks for :metabase-session-id and sets :metabase-user-id if Session ID is valid
      mb-middleware/wrap-api-key         ; looks for a Metabase API Key on the request and assocs as :metabase-api-key
      mb-middleware/wrap-session-id      ; looks for a Metabase Session ID and assoc as :metabase-session-id
      wrap-cookies                       ; Parses cookies in the request map and assocs as :cookies
      wrap-session                       ; reads in current HTTP session and sets :session/key
      wrap-gzip))                        ; GZIP response if client can handle it

;;; ## ---------------------------------------- LIFECYCLE ----------------------------------------

(defonce ^:private metabase-initialization-progress
  (atom 0))

(defn initialized?
  "Is Metabase initialized and ready to be served?"
  []
  (= @metabase-initialization-progress 1.0))

(defn initialization-progress
  "Get the current progress of Metabase initialization."
  []
  @metabase-initialization-progress)

(defn initialization-complete!
  "Complete the Metabase initialization by setting its progress to 100%."
  []
  (reset! metabase-initialization-progress 1.0))

(defn- -init-create-setup-token
  "Create and set a new setup token and log it."
  []
  (let [setup-token (setup/create-token!)                    ; we need this here to create the initial token
        hostname    (or (config/config-str :mb-jetty-host) "localhost")
        port        (config/config-int :mb-jetty-port)
        setup-url   (str "http://"
                         (or hostname "localhost")
                         (when-not (= 80 port) (str ":" port))
                         "/setup/")]
    (log/info (u/format-color 'green "Please use the following url to setup your Metabase installation:\n\n%s\n\n"
                              setup-url))))

(defn- destroy!
  "General application shutdown function which should be called once at application shuddown."
  []
  (log/info "Metabase Shutting Down ...")
  (task/stop-scheduler!)
  (log/info "Metabase Shutdown COMPLETE"))

(defn init!
  "General application initialization function which should be run once at application startup."
  []
  (log/info (format "Starting Metabase version %s ..." config/mb-version-string))
  (log/info (format "System timezone is '%s' ..." (System/getProperty "user.timezone")))
  (reset! metabase-initialization-progress 0.1)

  ;; First of all, lets register a shutdown hook that will tidy things up for us on app exit
  (.addShutdownHook (Runtime/getRuntime) (Thread. ^Runnable destroy!))
  (reset! metabase-initialization-progress 0.2)

  ;; load any plugins as needed
  (plugins/load-plugins!)
  (reset! metabase-initialization-progress 0.3)

  ;; Load up all of our Database drivers, which are used for app db work
  (driver/find-and-load-drivers!)
  (reset! metabase-initialization-progress 0.4)

  ;; startup database.  validates connection & runs any necessary migrations
  (db/setup-db! :auto-migrate (config/config-bool :mb-db-automigrate))
  (reset! metabase-initialization-progress 0.5)

  ;; run a very quick check to see if we are doing a first time installation
  ;; the test we are using is if there is at least 1 User in the database
  (let [new-install (not (db/exists? User))]

    ;; Bootstrap the event system
    (events/initialize-events!)
    (reset! metabase-initialization-progress 0.7)

    ;; Now start the task runner
    (task/start-scheduler!)
    (reset! metabase-initialization-progress 0.8)

    (when new-install
      (log/info "Looks like this is a new installation ... preparing setup wizard")
      ;; create setup token
      (-init-create-setup-token)
      ;; publish install event
      (events/publish-event :install {}))
    (reset! metabase-initialization-progress 0.9)

    ;; deal with our sample dataset as needed
    (if new-install
      ;; add the sample dataset DB for fresh installs
      (sample-data/add-sample-dataset!)
      ;; otherwise update if appropriate
      (sample-data/update-sample-dataset-if-needed!))

    ;; start the metabot thread
    (metabot/start-metabot!))

  (initialization-complete!)
  (log/info "Metabase Initialization COMPLETE"))

;;; ## ---------------------------------------- Jetty (Web) Server ----------------------------------------

(def ^:private jetty-instance
  (atom nil))

(defn start-jetty!
  "Start the embedded Jetty web server."
  []
  (when-not @jetty-instance
    (let [jetty-ssl-config (m/filter-vals identity {:ssl-port       (config/config-int :mb-jetty-ssl-port)
                                                    :keystore       (config/config-str :mb-jetty-ssl-keystore)
                                                    :key-password   (config/config-str :mb-jetty-ssl-keystore-password)
                                                    :truststore     (config/config-str :mb-jetty-ssl-truststore)
                                                    :trust-password (config/config-str :mb-jetty-ssl-truststore-password)})
          jetty-config     (cond-> (m/filter-vals identity {:port          (config/config-int :mb-jetty-port)
                                                            :host          (config/config-str :mb-jetty-host)
                                                            :max-threads   (config/config-int :mb-jetty-maxthreads)
                                                            :min-threads   (config/config-int :mb-jetty-minthreads)
                                                            :max-queued    (config/config-int :mb-jetty-maxqueued)
                                                            :max-idle-time (config/config-int :mb-jetty-maxidletime)})
                             (config/config-str :mb-jetty-daemon) (assoc :daemon? (config/config-bool :mb-jetty-daemon))
                             (config/config-str :mb-jetty-ssl)    (-> (assoc :ssl? true)
                                                                      (merge jetty-ssl-config)))]
      (log/info "Launching Embedded Jetty Webserver with config:\n" (with-out-str (clojure.pprint/pprint (m/filter-keys (fn [k] (not (re-matches #".*password.*" (str k)))) jetty-config))))
      ;; NOTE: we always start jetty w/ join=false so we can start the server first then do init in the background
      (->> (ring-jetty/run-jetty app (assoc jetty-config :join? false))
           (reset! jetty-instance)))))

(defn stop-jetty!
  "Stop the embedded Jetty web server."
  []
  (when @jetty-instance
    (log/info "Shutting Down Embedded Jetty Webserver")
    (.stop ^org.eclipse.jetty.server.Server @jetty-instance)
    (reset! jetty-instance nil)))

;;; ## ---------------------------------------- Normal Start ----------------------------------------

(defn- start-normally []
  (log/info "Starting Metabase in STANDALONE mode")
  (try
    ;; launch embedded webserver async
    (start-jetty!)
    ;; run our initialization process
    (init!)
    ;; Ok, now block forever while Jetty does its thing
    (when (config/config-bool :mb-jetty-join)
      (.join ^org.eclipse.jetty.server.Server @jetty-instance))
    (catch Throwable e
      (.printStackTrace e)
      (log/error "Metabase Initialization FAILED: " (.getMessage e))
      (System/exit 1))))

;;; ---------------------------------------- Special Commands ----------------------------------------

(defn ^:command migrate
  "Run database migrations. Valid options for DIRECTION are `up`, `force`, `down-one`, `print`, or `release-locks`."
  [direction]
  (db/migrate! @db/db-connection-details (keyword direction)))

(defn ^:command load-from-h2
  "Transfer data from existing H2 database to the newly created MySQL or Postgres DB specified by env vars."
  ([]
   (load-from-h2 nil))
  ([h2-connection-string]
   (require 'metabase.cmd.load-from-h2)
   ((resolve 'metabase.cmd.load-from-h2/load-from-h2!) h2-connection-string)))

(defn ^:command profile
  "Start Metabase the usual way and exit. Useful for profiling Metabase launch time."
  []
  ;; override env var that would normally make Jetty block forever
  (intern 'environ.core 'env (assoc environ.core/env :mb-jetty-join "false"))
  (u/profile "start-normally" (start-normally)))

(defn ^:command help
  "Show this help message listing valid Metabase commands."
  []
  (println "Valid commands are:")
  (doseq [[symb varr] (sort (ns-interns 'metabase.core))
          :when       (:command (meta varr))]
    (println symb (s/join " " (:arglists (meta varr))))
    (println "\t" (:doc (meta varr)))))

(defn- cmd->fn [command-name]
  (or (when (seq command-name)
        (when-let [varr (ns-resolve 'metabase.core (symbol command-name))]
          (when (:command (meta varr))
            @varr)))
      (do (println (u/format-color 'red "Unrecognized command: %s" command-name))
          (help)
          (System/exit 1))))

(defn- run-cmd [cmd & args]
  (try (apply (cmd->fn cmd) args)
       (catch Throwable e
         (.printStackTrace e)
         (println (u/format-color 'red "Command failed with exception: %s" (.getMessage e)))
         (System/exit 1)))
  (System/exit 0))

;;; ---------------------------------------- App Entry Point ----------------------------------------

(defn -main
  "Launch Metabase in standalone mode."
  [& [cmd & args]]
  (if cmd
    (apply run-cmd cmd args) ; run a command like `java -jar metabase.jar migrate release-locks` or `lein run migrate release-locks`
    (start-normally)))       ; with no command line args just start Metabase normally

Remove unused :require in metabase.core :racing_car:


(ns quoridor.core
  (:gen-class)
  (:require [quoridor.board :as board]
            [clojure.string :as s]))

(def ^{:private true} black-white (cycle ["black" "white"]))

(defn- to-digit [n] (Character/digit n 10))

(defn- valid-move?
  [move]
  (let [col (first move)
        row (second move)]
    (and (contains? (board/char-range \a \h) col)
         (contains? (board/char-range \1 \8) row))))

(defn- right
  ([pos] (right pos 1))
  ([pos n]
   (let [right-pos (str (char (+ (int (first pos)) n)) (second pos))]
     (if (valid-move? right-pos)
       right-pos
       ""))))

(defn- left
  ([pos] (right pos -1))
  ([pos n] (right pos (- n))))

(defn- up
  ([pos] (up pos 1))
  ([pos n]
   (let [up-pos (str (first pos) (+ (to-digit (second pos)) n))]
     (if (valid-move? up-pos)
       up-pos
       ""))))

(defn- down
  ([pos] (up pos -1))
  ([pos n] (up pos (- n))))

(defn- above?
  [other-pos pos]
  (= (up pos) other-pos))

(defn- below?
  [other-pos pos]
  (= (down pos) other-pos))

(defn- right?
  [other-pos pos]
  (= (right pos) other-pos))

(defn- left?
  [other-pos pos]
  (= (left pos) other-pos))

(defn- jump
  [state]
  (let [current-player (state :current)
        other-player (if (= current-player "black") "white" "black")
        current-pos (state (keyword current-player))
        other-pos (state (keyword other-player))]
    (cond
      (above? other-pos current-pos) (up current-pos 2)
      (below? other-pos current-pos) (down current-pos 2)
      (right? other-pos current-pos) (right current-pos 2)
      (left? other-pos current-pos) (left current-pos 2))))

(defn- allowed-pawn-move?
  [state move]
  (let [current-position (state (keyword (state :current)))
        other-position (if (= (state :current) "black") (state :white) (state :black))
        col (first current-position)
        row (to-digit (second current-position))
        up-move (str col (+ row 1))
        down-move (str col (- row 1))
        left-move (str (-> col int (- 1) char) row)
        right-move (str (-> col int (+ 1) char) row)
        jump-move (jump state)]
    (and (contains? (set (filter valid-move? [up-move
                                              down-move
                                              left-move
                                              right-move
                                              jump-move]))
                    move)
         (not (contains? (set [current-position other-position]) move)))))

(defn- black-won?
  [state]
  (= (Character/digit (second (state :black)) 10) 8))

(defn- white-won?
  [state]
  (= (Character/digit (second (state :white)) 10) 1))

(defn- game-over?
  [state]
  (or (black-won? state) (white-won? state)))

(defn- winner
  [state]
  (cond
    (black-won? state) "black"
    (white-won? state) "white"
    :else nil))

(defn- print-game-over
  [state]
  (println (str "Congrats " (winner state) ", you won!")))

(defn -main
  [& args]
  (loop [current (first black-white)
         next (rest black-white)
         state { :black "e1" :white "e8" :walls #{} :current current }]
    (println (board/render state))
    (if (game-over? state)
      (print-game-over state)
      (do (println (str current "'s move: "))
          (let [move (s/trim (read-line))]
            (cond
              (= move "q") (println "Thanks for playing!")
              (allowed-pawn-move? state move) (let [next-player (first next)]
                                           (recur next-player
                                                  (rest next)
                                                  (-> state
                                                      (assoc (keyword current) move)
                                                      (assoc :current next-player))))
              :else (do (println (str "Sorry, " move " is not a valid move"))
                        (recur current next state))))))))

fix indentation

fix indentation