A ring adapter for Clojure with no deps using `com.sun.net.httpserver`

deps.edn

;; ok, technically not no deps
;; but you can easily grab the ring.core.protocols/StreamableResponseBody impl and inline it if you don't care about geing a "real" ring adapter
{:deps {org.ring-clojure/ring-core-protocols {:mvn/version "1.15.5"}}}

exchange.clj

(ns lib.http.exchange
  (:require
   [ring.core.protocols :as protocols])
  (:import
   (com.sun.net.httpserver Headers HttpExchange)
   (java.io
    File
    FileInputStream
    InputStream
    OutputStream)
   (java.nio.charset StandardCharsets)))

(defprotocol ResponseEmitter
  "Streams one HTTP response, including after its Ring handler returns."
  (emit! [emitter data]
    "Writes `data` and flushes it to the client.

    The first Ring response map commits its status and headers. Any other
    value is written as a body chunk, committing a default `200` response
    when needed. Returns `true` on success and `false` after a client
    disconnects.")
  (close! [emitter]
    "Closes the response stream. Returns `true` once and `false` thereafter."))

(defn- set-response-headers [^Headers response-headers resp-headers]
  (reduce-kv (fn [^Headers h k v]
               (.add h
                     (if (string? k) k (name k))
                     (if (string? v) v (str v)))
               h)
             response-headers resp-headers))

(defn- emitter-response [data]
  (let [response (if (map? data) data {:body data})]
    (cond-> response
      (nil? (:headers response)) (assoc :headers {})
      (nil? (:status response)) (assoc :status 200))))

(defn- write-emitter-body! [^OutputStream out body response]
  (cond
    (nil? body) nil
    (instance? String body) (.write out (.getBytes ^String body StandardCharsets/UTF_8))
    (bytes? body) (.write out ^"[B" body)
    (instance? InputStream body) (with-open [in ^InputStream body]
                                   (.transferTo in out))
    (instance? File body) (with-open [in ^InputStream (FileInputStream. ^File body)]
                            (.transferTo in out))
    (sequential? body) (doseq [chunk body]
                         (write-emitter-body! out chunk response))
    (satisfies? protocols/StreamableResponseBody body)
    (protocols/write-body-to-stream body response out)
    :else (throw (ex-info "Unsupported response emitter body"
                          {:body-type (class body)}))))

(defn- commit-emitter! [^HttpExchange exchange response]
  (set-response-headers (.getResponseHeaders exchange) (:headers response))
  (.sendResponseHeaders exchange (:status response) 0)
  (.flush (.getResponseBody exchange)))

(defn- close-emitter! [^HttpExchange exchange state]
  (swap! state assoc :closed? true)
  (try
    (.close exchange)
    (catch Exception _)))

(deftype ExchangeEmitter [^HttpExchange exchange state]
  ResponseEmitter
  (emit! [_ data]
    (locking state
      (if (:closed? @state)
        false
        (try
          (let [response      (emitter-response data)
                committed?    (:committed? @state)
                write-response (or (not (map? data)) (not committed?))]
            (when-not committed?
              (commit-emitter! exchange response)
              (swap! state assoc :committed? true))
            (when write-response
              (when (contains? response :body)
                (write-emitter-body! (.getResponseBody exchange) (:body response) response))
              (.flush (.getResponseBody exchange)))
            true)
          (catch java.io.IOException _
            (close-emitter! exchange state)
            false)))))
  (close! [_]
    (locking state
      (if (:closed? @state)
        false
        (do
          (close-emitter! exchange state)
          true)))))

(defn response-emitter
  "Creates an emitter for an open [[com.sun.net.httpserver.HttpExchange]]."
  [^HttpExchange exchange]
  (ExchangeEmitter. exchange (atom {:closed? false :committed? false})))

(defn- send-file [^HttpExchange exchange ^OutputStream out body headers status]
  (with-open [in ^InputStream (FileInputStream. ^File body)
              out1 ^OutputStream out]
    (set-response-headers (.getResponseHeaders exchange) headers)
    (.sendResponseHeaders exchange status (.length ^File body))

    (.transferTo ^FileInputStream in out1)
    (.flush ^OutputStream out1))
  (.close exchange))

(defn- send-input-stream [^HttpExchange exchange ^OutputStream out body headers status]
  (with-open [in ^InputStream body
              out1 out]
    (set-response-headers (.getResponseHeaders exchange) headers)
    (.sendResponseHeaders exchange status 0)

    (.transferTo ^InputStream in out1)
    (.flush ^OutputStream out1))
  (.close exchange))

(defn- send-byte-array [^HttpExchange exchange ^OutputStream out body headers status]
  (with-open [out out]
    (set-response-headers (.getResponseHeaders exchange) headers)
    (.sendResponseHeaders exchange status (alength ^"[B" body))

    (.write out ^"[B" body)
    (.flush ^OutputStream out))
  (.close exchange))

(defn- send-string [^HttpExchange exchange ^OutputStream out ^String body headers status]
  (send-byte-array exchange out (.getBytes ^String body StandardCharsets/UTF_8) headers status))

(defn- maybe-streamable [^HttpExchange exchange ^OutputStream out body headers status]
  (with-open [out out]
    (set-response-headers (.getResponseHeaders exchange) headers)
    (.sendResponseHeaders exchange status 0)

    (protocols/write-body-to-stream body {:body    body
                                          :status  status
                                          :headers headers}
                                    out))
  (.close exchange))

(defn- send-error [^HttpExchange exchange]
  (send-string exchange
               (.getResponseBody exchange)
               "Internal Server Error"
               {"Content-type" "text/html"}
               500))

(defn- send-file-not-found [^HttpExchange exchange]
  (send-string exchange
               (.getResponseBody exchange)
               "File Not Found"
               {"Content-type" "text/html"}
               404))

(defn- if-not-file [exchange ^OutputStream out body headers status]
  (if (satisfies? protocols/StreamableResponseBody body)
    (maybe-streamable exchange out body headers status)
    (send-error exchange)))

(defn- if-not-byte-array [exchange ^OutputStream out body headers status]
  (if (instance? File body)
    (if (.exists ^File body)
      (send-file exchange out body headers status)
      (send-file-not-found exchange))
    (if-not-file exchange out body headers status)))

(defn- maybe-byte-array [exchange ^OutputStream out body headers status]
  (if (bytes? body)
    (send-byte-array exchange out body headers status)
    (if-not-byte-array exchange out body headers status)))

(defn- maybe-inputs-stream [exchange ^OutputStream out body headers status]
  (if (instance? InputStream body)
    (send-input-stream exchange out body headers status)
    (maybe-byte-array exchange out body headers status)))

(defn- send-nil-body [^HttpExchange exchange headers status]
  (set-response-headers (.getResponseHeaders exchange) headers)
  (.sendResponseHeaders exchange status -1)
  (.close exchange))

(defn- send-response [exchange out body headers status]
  (if (nil? body)
    (send-nil-body exchange headers status)
    (if (instance? String body)
      (send-string exchange out body headers status)
      (maybe-inputs-stream exchange out body headers status))))

(defn- send-emitter-response [{:keys [body status] :as response}]
  (when status
    (emitter/emit! body (dissoc response :body))))

(defn send-exchange-response [^HttpExchange exchange {:keys [body headers status] :as response}]
  (if response
    (if (satisfies? emitter/ResponseEmitter body)
      (send-emitter-response response)
      (send-response exchange (.getResponseBody exchange) body headers status))
    (send-error exchange)))

server.clj

(ns lib.http.server
  (:require
   [clojure.string :as str]
   [lib.http.exchange :as exchange])
  (:import
   [com.sun.net.httpserver HttpExchange HttpHandler HttpServer]
   java.net.InetSocketAddress
   [java.util Map]))

(defn strip-nils [m]
  (->> m (remove (comp nil? second)) (into {})))

(defn- request-headers [^HttpExchange exchange]
  (into {}
        (map (fn [[name values]]
               [(str/lower-case name)
                (if (= 1 (count values)) (first values) (vec values))]))
        (.entrySet (.getRequestHeaders exchange))))

(def ^:private method-cache ^Map (Map/of
                                  "POST" :post
                                  "QUERY" :query
                                  "PUT" :put
                                  "PATCH" :patch
                                  "DELETE" :delete
                                  "HEAD" :head
                                  "OPTIONS" :options
                                  "TRACE" :trace))

(defn method-or-default [^String method-string]
  (or (.get ^Map method-cache method-string)
      (keyword (.toLowerCase ^String method-string))))

(defn- server-port [^HttpExchange exchange]
  (some-> exchange .getLocalAddress .getPort))

(defn- remote-addr [^HttpExchange exchange]
  (some-> exchange .getRemoteAddress .getHostString))

(defn- ring-request [^HttpExchange exchange]
  (strip-nils
   {:body           (.getRequestBody exchange)
    :headers        (request-headers exchange)
    :protocol       (.getProtocol exchange)
    :query-string   (.getRawQuery (.getRequestURI exchange))
    :remote-addr    (remote-addr exchange)
    :request-method (-> exchange .getRequestMethod method-or-default)
    :scheme         :http
    :server-port    (server-port exchange)
    :uri            (.getRawPath (.getRequestURI exchange))}))

(defn http-handler ^HttpHandler [ring-handler]
  (reify HttpHandler
    (handle [_ exchange]
      (let [emitter (exchange/response-emitter exchange)
            request (assoc (ring-request exchange) :lib.http.emitter/emitter emitter)]
        (exchange/send-exchange-response exchange (ring-handler request))))))

(defn run-server
  [{:keys [handler host port]}]
  (let [address                     (if host
                                      (InetSocketAddress. ^String host (int port))
                                      (InetSocketAddress. (int port)))
        server                      (HttpServer/create address 0)]
    (.createContext server "/" (http-handler handler))
    (.setExecutor server nil)
    (.start server)
    server))

(defn stop-server [^HttpServer server]
  (.stop server 0))