(ns cljs-http.client
  (:refer-clojure :exclude [get])
  (:require [cljs-http.core :as core]
            [cljs-http.util :as util]
            [cljs.core.async :as async :refer [<! chan close! put!]]
            [cljs.reader :refer [read-string]]
            [clojure.string :refer [blank? join split]]
            [goog.Uri :as uri]
            [no.en.core :refer [url-encode url-decode]])
  (:require-macros [cljs.core.async.macros :refer [go]]))

(defn if-pos [v]
  (if (and v (pos? v)) v))

(defn- acc-param [o v]
  (cond
    (coll? o) (conj o v)
    (some? o) [o v]
    :else     v))

(defn parse-query-params
  "Parse `s` as query params and return a hash map."
  [s]
  (if-not (blank? s)
    (reduce
     #(let [[k v] (split %2 #"=")]
        (update %1
          (keyword (url-decode k))
          acc-param
          (url-decode v)))
     {} (split (str s) #"&"))))

(defn parse-url
  "Parse `url` into a hash map."
  [url]
  (if-not (blank? url)
    (let [uri (uri/parse url)
          query-data (.getQueryData uri)]
      {:scheme (keyword (.getScheme uri))
       :server-name (.getDomain uri)
       :server-port (if-pos (.getPort uri))
       :uri (.getPath uri)
       :query-string (if-not (.isEmpty query-data)
                       (str query-data))
       :query-params (if-not (.isEmpty query-data)
                       (parse-query-params (str query-data)))})))

(def unexceptional-status?
  #{200 201 202 203 204 205 206 207 300 301 302 303 307})

(defn- encode-val [k v]
  (str (url-encode (name k)) "=" (url-encode (str v))))

(defn- encode-vals [k vs]
  (->>
    vs
    (map #(encode-val k %))
    (join "&")))

(defn- encode-param [[k v]]
  (if (coll? v)
    (encode-vals k v)
    (encode-val k v)))

(defn generate-query-string [params]
  (->>
    params
    (map encode-param)
    (join "&")))

(def regex-char-esc-smap
  (let [esc-chars "()*&^%$#!+"]
    (zipmap esc-chars
            (map #(str "\\" %) esc-chars))))

(defn escape-special
  "Escape special characters -- for content-type."
  [string]
  (->> string
       (replace regex-char-esc-smap)
       (reduce str)))

(defn decode-body
  "Decocde the :body of `response` with `decode-fn` if the content type matches."
  [response decode-fn content-type request-method]
  (if (and (not= :head request-method)
           (not= 204 (:status response))
           (re-find (re-pattern (str "(?i)" (escape-special content-type)))
                    (str (clojure.core/get (:headers response) "content-type" ""))))
    (update-in response [:body] decode-fn)
    response))

(defn wrap-edn-params
  "Encode :edn-params in the `request` :body and set the appropriate
  Content Type header."
  [client]
  (fn [request]
    (if-let [params (:edn-params request)]
      (let [headers (merge {"content-type" "application/edn"} (:headers request))]
        (-> (dissoc request :edn-params)
            (assoc :body (pr-str params))
            (assoc :headers headers)
            (client)))
      (client request))))

(defn wrap-edn-response
  "Decode application/edn responses."
  [client]
  (fn [request]
    (-> #(decode-body % read-string "application/edn" (:request-method request))
        (async/map [(client request)]))))

(defn wrap-default-headers
  [client & [default-headers]]
  (fn [request]
    (if-let [default-headers (or (:default-headers request) default-headers)]
      (client (assoc request :default-headers default-headers))
      (client request))))

(defn wrap-accept
  [client & [accept]]
  (fn [request]
    (if-let [accept (or (:accept request) accept)]
      (client (assoc-in request [:headers "accept"] accept))
      (client request))))

(defn wrap-content-type
  [client & [content-type]]
  (fn [request]
    (if-let [content-type (or (:content-type request) content-type)]
      (client (assoc-in request [:headers "content-type"] content-type))
      (client request))))

(def ^{:private true} default-transit-opts
  {:encoding :json :encoding-opts {}
   :decoding :json :decoding-opts {}})

(defn wrap-transit-params
  "Encode :transit-params in the `request` :body and set the appropriate
  Content Type header.

  A :transit-opts map can be optionally provided with the following keys:

  :encoding                #{:json, :json-verbose}
  :decoding                #{:json, :json-verbose}
  :encoding/decoding-opts  appropriate map of options to be passed to
                           transit writer/reader, respectively."
  [client]
  (fn [request]
    (if-let [params (:transit-params request)]
      (let [{:keys [encoding encoding-opts]} (merge default-transit-opts
                                                    (:transit-opts request))
            headers (merge {"content-type" "application/transit+json"} (:headers request))]
        (-> (dissoc request :transit-params)
            (assoc :body (util/transit-encode params encoding encoding-opts))
            (assoc :headers headers)
            (client)))
      (client request))))

(defn wrap-transit-response
  "Decode application/transit+json responses."
  [client]
  (fn [request]
    (let [{:keys [decoding decoding-opts]} (merge default-transit-opts
                                                  (:transit-opts request))
          transit-decode #(util/transit-decode % decoding decoding-opts)]

      (-> #(decode-body % transit-decode "application/transit+json" (:request-method request))
          (async/map [(client request)])))))

(defn wrap-json-params
  "Encode :json-params in the `request` :body and set the appropriate
  Content Type header."
  [client]
  (fn [request]
    (if-let [params (:json-params request)]
      (let [headers (merge {"content-type" "application/json"} (:headers request))]
        (-> (dissoc request :json-params)
            (assoc :body (util/json-encode params))
            (assoc :headers headers)
            (client)))
      (client request))))

(defn wrap-json-response
  "Decode application/json responses."
  [client]
  (fn [request]
    (-> #(decode-body % util/json-decode "application/json" (:request-method request))
        (async/map [(client request)]))))

(defn wrap-query-params [client]
  (fn [{:keys [query-params] :as req}]
    (if query-params
      (client (-> req (dissoc :query-params)
                  (assoc :query-string
                    (generate-query-string query-params))))
      (client req))))

(defn wrap-form-params [client]
  (fn [{:keys [form-params request-method headers] :as request}]
    (if (and form-params (#{:post :put :patch :delete} request-method))
      (let [headers (merge {"content-type" "application/x-www-form-urlencoded"} headers)]
        (client (-> request
                    (dissoc :form-params)
                    (assoc :body (generate-query-string form-params))
                    (assoc :headers headers))))
      (client request))))

(defn generate-form-data [params]
  (let [form-data (js/FormData.)]
    (doseq [[k v] params]
      (if (coll? v)
        (.append form-data (name k) (first v) (second v))
        (.append form-data (name k) v)))
    form-data))

(defn wrap-multipart-params [client]
  (fn [{:keys [multipart-params request-method] :as request}]
    (if (and multipart-params (#{:post :put :patch :delete} request-method))
      (client (-> request
                  (dissoc :multipart-params)
                  (assoc :body (generate-form-data multipart-params))))
      (client request))))

(defn wrap-method [client]
  (fn [req]
    (if-let [m (:method req)]
      (client (-> req (dissoc :method)
                  (assoc :request-method m)))
      (client req))))

(defn wrap-server-name [client server-name]
  #(client (assoc %1 :server-name server-name)))

(defn wrap-url [client]
  (fn [{:keys [query-params] :as req}]
    (if-let [spec (parse-url (:url req))]
      (client (-> (merge req spec)
                  (dissoc :url)
                  (update-in [:query-params] #(merge %1 query-params))))
      (client req))))

(defn wrap-basic-auth
  "Middleware converting the :basic-auth option or `credentials` into
  an Authorization header."
  [client & [credentials]]
  (fn [req]
    (let [credentials (or (:basic-auth req) credentials)]
      (if-not (empty? credentials)
        (client (-> (dissoc req :basic-auth)
                    (assoc-in [:headers "authorization"] (util/basic-auth credentials))))
        (client req)))))

(defn wrap-oauth
  "Middleware converting the :oauth-token option into an Authorization header."
  [client]
  (fn [req]
    (if-let [oauth-token (:oauth-token req)]
      (client (-> req (dissoc :oauth-token)
                  (assoc-in [:headers "authorization"]
                            (str "Bearer " oauth-token))))
      (client req))))

(defn wrap-channel-from-request-map
  "Pipe the response-channel into the request-map's
   custom channel (e.g. to enable transducers)"
  [client]
  (fn [request]
    (if-let [custom-channel (:channel request)]
      (async/pipe (client request) custom-channel)
      (client request))))

(defn wrap-request
  "Returns a batteries-included HTTP request function coresponding to the given
   core client. See client/request"
  [request]
  (-> request
      wrap-accept
      wrap-form-params
      wrap-multipart-params
      wrap-edn-params
      wrap-edn-response
      wrap-transit-params
      wrap-transit-response
      wrap-json-params
      wrap-json-response
      wrap-content-type
      wrap-query-params
      wrap-basic-auth
      wrap-oauth
      wrap-method
      wrap-url
      wrap-channel-from-request-map
      wrap-default-headers))

(def #^{:doc
        "Executes the HTTP request corresponding to the given map and returns the
   response map for corresponding to the resulting HTTP response.

   In addition to the standard Ring request keys, the following keys are also
   recognized:
   * :url
   * :method
   * :query-params"}
  request (wrap-request core/request))

(defn delete
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :delete :url url})))

(defn get
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :get :url url})))

(defn head
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :head :url url})))

(defn jsonp
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :jsonp :url url})))

(defn move
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :move :url url})))

(defn options
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :options :url url})))

(defn patch
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :patch :url url})))

(defn post
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :post :url url})))

(defn put
  "Like #'request, but sets the :method and :url as appropriate."
  [url & [req]]
  (request (merge req {:method :put :url url})))

(comment

  (ns example.core
    (:require [cljs-http.client :as http]
              [cljs.core.async :refer [<!]])
    (:require-macros [cljs.core.async.macros :refer [go]]))

  (go (prn (map :login (:body (<! (get "https://api.github.com/users"))))))

  (go (prn (:status (<! (get "http://api.burningswell.dev/continents")))))

  (go (prn (map :name (:body (<! (get "http://api.burningswell.dev/continents"))))))

  (go (let [response (<! (get "https://api.github.com/users"))]
        (prn (:status response))
        (prn (map :login (:body response)))))

  (go (prn (<! (get "http://api.burningswell.dev/continents")))))