spec.clj

(ns com.stuartsierra.ring.core.spec
  (:require [clojure.spec :as s]
            [clojure.spec.gen :as gen]
            [clojure.string :as str]
            [com.stuartsierra.ring.core.protocols :as p]
            [com.stuartsierra.ring.util.parsing :as parse]))

(defn- lower-case? [s]
  (= s (str/lower-case s)))

(defn- trimmed? [s]
  (= s (str/trim s)))

(defn- char-range [a b]
  (map char (range (int a) (int b))))

(def ^:private lower-case-chars
  (set (char-range \a \z)))

(def ^:private alphanumeric-chars
  (set (concat (char-range \A \Z) (char-range \a \z) (char-range \0 \9))))

(def ^:private uri-chars
  (into alphanumeric-chars #{\- \. \_ \~ \/ \+ \,}))

(def ^:private field-name-chars
  (into alphanumeric-chars #{\! \# \$ \% \& \' \* \+ \- \. \^ \_ \` \| \~}))

(def ^:private whitespace-chars
  #{0x09 0x20})

(def ^:private visible-chars
  (set (map char (range 0x21 0x7e))))

(def ^:private obs-text-chars
  (set (map char (range 0x80 0xff))))

(def ^:private field-value-chars*
  (into whitespace-chars visible-chars))

(def ^:private field-value-chars
  (into field-value-chars* obs-text-chars))

(defn- field-name-chars? [s]
  (every? field-name-chars s))

(defn- field-value-chars? [s]
  (every? field-value-chars s))

(defn- gen-string [chars]
  (gen/fmap str/join (gen/vector (gen/elements chars))))

(defn- gen-query-string []
  (->> (gen/tuple (gen/not-empty (gen/string-alphanumeric)) (gen-string uri-chars))
       (gen/fmap (fn [[k v]] (str k "=" v)))
       (gen/vector)
       (gen/fmap #(str/join "&" %))))

(defn- gen-method []
  (gen/fmap keyword (gen/not-empty (gen-string lower-case-chars))))

(defn- gen-input-stream []
  (gen/fmap #(java.io.ByteArrayInputStream. %) (gen/bytes)))

(defn- gen-exception []
  (gen/fmap (fn [s] (Exception. s)) (gen/string-alphanumeric)))

;; Internal

(s/def :com.stuartsierra.ring.core/error
  (-> #(instance? Throwable %) (s/with-gen gen-exception)))

(s/def :com.stuartsierra.ring.http/field-name
  (-> (s/and string? not-empty field-name-chars?)
      (s/with-gen #(gen/not-empty (gen-string field-name-chars)))))

(s/def :com.stuartsierra.ring.http/field-value
  (-> (s/and string? field-value-chars? trimmed?)
      (s/with-gen #(gen/fmap str/trim (gen-string field-value-chars*)))))

;; Request

(s/def :com.stuartsierra.ring.request/server-port (s/int-in 1 65535))
(s/def :com.stuartsierra.ring.request/server-name string?)
(s/def :com.stuartsierra.ring.request/remote-addr string?)

(s/def :com.stuartsierra.ring.request/uri
  (-> (s/and string? #(str/starts-with? % "/"))
      (s/with-gen (fn [] (gen/fmap #(str "/" %) (gen-string uri-chars))))))

(s/def :com.stuartsierra.ring.request/query-string
  (s/with-gen string? gen-query-string))

(s/def :com.stuartsierra.ring.request/scheme #{:http :https})

(s/def :com.stuartsierra.ring.request/request-method
  (-> (s/and keyword? (comp lower-case? name))
      (s/with-gen gen-method)))

(s/def :com.stuartsierra.ring.request/protocol
  (s/with-gen string? #(gen/return "HTTP/1.1")))

(s/def :com.stuartsierra.ring.request/header-name
  (-> (s/and :com.stuartsierra.ring.http/field-name lower-case?)
      (s/with-gen #(gen/fmap str/lower-case (s/gen :com.stuartsierra.ring.http/field-name)))))

(s/def :com.stuartsierra.ring.request/header-value :com.stuartsierra.ring.http/field-value)

(s/def :com.stuartsierra.ring.request/headers
  (s/map-of :com.stuartsierra.ring.request/header-name :com.stuartsierra.ring.request/header-value))

(s/def :com.stuartsierra.ring.request/body
  (s/with-gen #(instance? java.io.InputStream %) gen-input-stream))

(s/def :ring/request
  (s/keys :req-un [:com.stuartsierra.ring.request/server-port
                   :com.stuartsierra.ring.request/server-name
                   :com.stuartsierra.ring.request/remote-addr
                   :com.stuartsierra.ring.request/uri
                   :com.stuartsierra.ring.request/scheme
                   :com.stuartsierra.ring.request/protocol
                   :com.stuartsierra.ring.request/headers
                   :com.stuartsierra.ring.request/request-method]
          :opt-un [:com.stuartsierra.ring.request/query-string
                   :com.stuartsierra.ring.request/body]))

;; Response

(s/def :com.stuartsierra.ring.response/status (s/int-in 100 600))

(s/def :com.stuartsierra.ring.response/header-name :com.stuartsierra.ring.http/field-name)

(s/def :com.stuartsierra.ring.response/header-value
  (s/or :one :com.stuartsierra.ring.http/field-value :many (s/coll-of :com.stuartsierra.ring.http/field-value)))

(s/def :com.stuartsierra.ring.response/headers
  (s/map-of :com.stuartsierra.ring.response/header-name :com.stuartsierra.ring.response/header-value))

(s/def :com.stuartsierra.ring.response/body
  (-> #(satisfies? p/StreamableResponseBody %)
      (s/with-gen #(gen/one-of [(gen/return nil)
                                (gen/string-ascii)
                                (gen/list (gen/string-ascii))
                                (gen-input-stream)]))))

(s/def :ring/response
  (s/keys :req-un [:com.stuartsierra.ring.response/status
                   :com.stuartsierra.ring.response/headers]
          :opt-un [:com.stuartsierra.ring.response/body]))

;; Handler

(s/def :com.stuartsierra.ring.sync.handler/args
  (s/cat :request :ring/request))

(s/def :com.stuartsierra.ring.async.handler/args
  (s/cat :request :ring/request
         :respond (s/fspec :args (s/cat :response :ring/response) :ret any?)
         :raise   (s/fspec :args (s/cat :error :com.stuartsierra.ring.core/error) :ret any?)))

(s/def :com.stuartsierra.ring.sync.handler/ret  :ring/response)
(s/def :com.stuartsierra.ring.async.handler/ret any?)

(s/fdef :com.stuartsierra.ring.sync/handler
  :args :com.stuartsierra.ring.sync.handler/args
  :ret  :com.stuartsierra.ring.sync.handler/ret)

(s/fdef :com.stuartsierra.ring.async/handler
  :args :com.stuartsierra.ring.async.handler/args
  :ret  :com.stuartsierra.ring.async.handler/ret)

(s/fdef :com.stuartsierra.ring.sync+async/handler
  :args (s/or :sync  :com.stuartsierra.ring.sync.handler/args :async :com.stuartsierra.ring.async.handler/args)
  :ret  (s/or :async :com.stuartsierra.ring.sync.handler/ret  :async :com.stuartsierra.ring.async.handler/ret)
  :fn   (s/or :sync  (s/keys :req-un [:com.stuartsierra.ring.sync.handler/args :com.stuartsierra.ring.sync.handler/ret])
              :async (s/keys :req-un [:com.stuartsierra.ring.async.handler/args :com.stuartsierra.ring.async.handler/ret])))

(s/def :ring/handler
  (s/or :sync :com.stuartsierra.ring.sync/handler
        :async :com.stuartsierra.ring.async/handler
        :sync+async :com.stuartsierra.ring.sync+async/handler))