java_http.clj

(ns com.wsscode.pathom.diplomat.http.java-http
  (:require [com.wsscode.pathom.diplomat.http :as http]
            [clojure.spec.alpha :as s]
            [clojure.core.async :as async]
            [clojure.string :as string]
            [clojure.data.json :as json])
  (:import (java.net.http HttpResponse$BodyHandlers HttpRequest HttpClient HttpResponse HttpHeaders HttpRequest$BodyPublishers)
           (java.net URI)
           (java.util.function Function BiPredicate)
           (java.util Optional)))

(set! *warn-on-reflection* true)

(defn build-request
  [{::http/keys [url content-type accept as body headers form-params method]
    :or         {headers {}}
    :as         env}]
  (let [uri (URI/create url)
        method (string/upper-case (http/request-method env))
        version (Optional/empty)
        timeout (Optional/empty)
        headers (HttpHeaders/of (cond-> headers
                                        content-type (assoc "content-type" [(http/encode-type->header content-type)]))
                                (reify BiPredicate
                                  (test [this a b]
                                    true)))
        expect-continue false
        body-publisher (if form-params
                         (Optional/of
                           (HttpRequest$BodyPublishers/ofString
                             (json/write-str form-params)))
                         (Optional/empty))]
    (proxy [HttpRequest] []
      (uri [] uri)
      (method [] method)
      (version [] version)
      (timeout [] timeout)
      (headers [] headers)
      (expectContinue [] expect-continue)
      (bodyPublisher [] body-publisher))))

(defn build-response-map
  [{::http/keys [as]} ^HttpResponse response]
  (let [headers (into {}
                      (comp
                        (map (fn [[k v]]
                               [k (first v)])))
                      (.map (.headers response)))]
    {::http/status  (.statusCode response)
     ::http/body    (if (and (= as ::http/json)
                             (string/starts-with? (string/lower-case (get headers "content-type"))
                                                  "application/json"))
                      (json/read-str (.body response)
                                     :key-fn keyword)
                      (.body response))
     ::http/headers headers}))

(defn request
  []
  (let [client (HttpClient/newHttpClient)]
    (fn [env]
      (s/assert ::http/request env)
      (let [request (build-request env)]
        (build-response-map env (.send client request (HttpResponse$BodyHandlers/ofString)))))))

(defn request-async
  []
  (let [client (HttpClient/newHttpClient)]
    (fn [env]
      (s/assert ::http/request env)
      (let [request (build-request env)
            chan (async/promise-chan (map (partial build-response-map env)))]
        (doto (.sendAsync client request (HttpResponse$BodyHandlers/ofString))
          (.thenApply (reify Function
                        (apply [this response]
                          (async/put! chan response)))))
        chan))))

(comment
  (http/request {::http/driver       (request)
                 ::http/url          (str "https://api.github.com/graphql?access_token=" (System/getenv "GITHUB_TOKEN"))
                 ::http/as           ::http/json
                 ::http/content-type ::http/json
                 ::http/form-params  {:query "query { __schema { queryType { name } } }"}})
  => {::http/status  200,
      ::http/headers {"server" "GitHub.com",,,}
      ::http/body    {:data {:__schema {:queryType {:name "Query"}}}}})