a minimal http 1.1 impl in clojure

http.clj

(ns http
  "a minimal http 1.1 impl in clojure"
  (:require [clojure.string :as str])
  (:import
   (java.io BufferedInputStream OutputStream OutputStreamWriter BufferedWriter)
   (java.nio.charset StandardCharsets)
   (java.time ZonedDateTime ZoneId)
   (java.time.format DateTimeFormatter)
   (java.util Locale)))

(def ^DateTimeFormatter rfc-1123
  (.withLocale DateTimeFormatter/RFC_1123_DATE_TIME Locale/US))

(defn http-date []
  (.format rfc-1123 (ZonedDateTime/now (ZoneId/of "GMT"))))

(def ^long ^:const MAX_LINE 8192)
(def ^long ^:const MAX_HEADER_BYTES 65536)
(def ^long ^:const MAX_HEADER_LINES 200)

(defn read-line ^String [^java.io.BufferedInputStream bin]
  (let [ba (java.io.ByteArrayOutputStream.)]
    (loop [n 0]
      (when (> n MAX_LINE)
        (throw (ex-info "Request line too long" {:type :line-too-long})))
      (let [b (.read bin)]
        (cond
          ;; EOF: return nil if nothing read, else the partial line
          (= b -1)
          (when (> (.size ba) 0)
            (.toString ba "ISO-8859-1"))
          ;; LF => end of line (CR, if any, was skipped)
          (= b 10) ; \n
          (.toString ba "ISO-8859-1")
          ;; skip CR explicitly so we never include it
          (= b 13) ; \r
          (recur (inc n))
          :else
          (do (.write ba b)
              (recur (inc n))))))))

(defn read-headers [^java.io.BufferedInputStream bin]
  (loop [m {} total 0 lines 0]
    (when (or (> total MAX_HEADER_BYTES) (> lines MAX_HEADER_LINES))
      (throw (ex-info "Headers too large" {:type :headers-too-large
                                           :bytes total :lines lines})))
    (let [line (read-line bin)]
      (when (nil? line)
        (throw (ex-info "EOF while reading headers" {:type :eof-headers})))
      (if (clojure.string/blank? line)
        m
        (let [i (.indexOf line ":")]
          (when (neg? i)
            (throw (ex-info "Malformed header line (no colon)" {:line line})))
          (let [k (-> (subs line 0 i) clojure.string/trim clojure.string/lower-case)
                v (-> (subs line (inc i)) clojure.string/trim)
                n-total (+ total (count line) 2)] ; account for CRLF we consumed
            (recur (assoc m k v) n-total (inc lines))))))))

(defn parse-req-line [^String line]
  ;; e.g. "GET /path?x=1 HTTP/1.1"
  (let [[request-method uri protocol & _] (.split line " " 3)]
    {:request-method (-> (or request-method "") str/lower-case keyword)
     :uri            (or uri "")
     :protocol       (or protocol "")}))

(defn read-bytes
  "Read exactly n bytes from a BufferedInputStream."
  [^BufferedInputStream bin ^long n]
  (let [buf (byte-array n)]
    (loop [off 0]
      (if (= off n)
        buf
        (let [r (.read bin buf off (- n off))]
          (if (neg? r)
            (byte-array 0)
            (recur (+ off r))))))))

(defn write!
  [^BufferedWriter w ^String s]
  (.write w s)
  (.flush w))

(defn write-bytes!
  "Write bytes to OutputStream."
  [^OutputStream out ^bytes b]
  (.write out b 0 (alength b)))

(defn status-line [code]
  (str "HTTP/1.1 " code " "
       (case code
         200 "OK"
         201 "Created"
         204 "No Content"
         301 "Moved Permanently"
         304 "Not Modified"
         400 "Bad Request"
         404 "Not Found"
         405 "Method Not Allowed"
         411 "Length Required"
         413 "Payload Too Large"
         500 "Internal Server Error"
         501 "Not Implemented"
         505 "HTTP Version Not Supported"
         "NOT OK LMAO")
       "\r\n"))

(defn send-response!
  [^BufferedWriter w ^OutputStream out {:keys [status headers body]}]
  (write! w (status-line status))
  (doseq [[k v] (merge {"Date" (http-date)
                        "Server" "bare-clj/0"
                        "Connection" "close"}
                       headers)]
    (write! w (str k ": " v "\r\n")))
  (write! w "\r\n")
  (.flush w)
  (when (and body (pos? (alength ^bytes body)))
    (write-bytes! out body)
    (.flush out)))

(defn read-request
  "Parse one HTTP/1.1 request from a BufferedInputStream (byte-level only).
   Returns {:request-method :uri :protocol :headers :body-bytes}.

   Limitations (by design):
   * Only supports bodies with Content-Length (no chunked).
   * Ignores trailers.
  "
  ^{:inline-arities #{1}}
  [^BufferedInputStream bin]
  (let [req-line (read-line bin)]
    (when (nil? req-line)
      (throw (ex-info "EOF before request line" {:type :eof})))
    (let [{:as line :keys [request-method uri protocol]} (parse-req-line req-line)
          ;; read headers as lowercase keys
          headers                                        (read-headers bin)
          ;; disallow chunked: we only do Content-Length
          te                                             (some-> (get headers "transfer-encoding") clojure.string/trim clojure.string/lower-case)]
      (when (and te (not= te "identity"))
        (throw (ex-info "Unsupported transfer-encoding" {:type :unsupported-te :transfer-encoding te})))
      (let [cl   (some-> (get headers "content-length") clojure.string/trim Long/parseLong)
            body (if (and cl (pos? cl))
                   (read-bytes bin cl)
                   (byte-array 0))]
        {:request-method request-method
         :uri            uri
         :protocol       protocol
         :headers        headers
         :body           body}))))

;; ---------- ENTRYPOINT ----------

(def server-error {:status 500 :headers {"content-type" "text/plain"} :body "internal server errror"})
(def bad-request-error {:status 400 :headers {"content-type" "text/plain"} :body "bad request"})

(defn handle-connection
  "Handle a single HTTP/1.1 request on given streams, then close.
   args:
     - in  : java.io.InputStream  (from the accepted socket)
     - out : java.io.OutputStream (to the accepted socket)
     - opts:
              :handler (fn [req-map] resp-map) ;; ring-ish handler
              :server-name
              :server-port
              :remote-addr"
  [^java.io.InputStream in ^java.io.OutputStream out {:keys [handler server-name server-port remote-addr]}]
  (let [handler (or handler (fn [_] {:status 404 :headers {"content-type" "text/plain"} :body "not found"}))
        bin     (BufferedInputStream. in)
        w       (BufferedWriter. (OutputStreamWriter. out StandardCharsets/ISO_8859_1))]
    (try
      (let [req  (read-request bin)
            resp (try
                   (handler (assoc req :server-name server-name :server-port server-port :remote-addr remote-addr))
                   (catch Throwable t
                     server-error))]
        ;; ensure Content-Length exists if body present
        (let [body (:body resp)
              resp (if (and body (nil? (get-in resp [:headers "content-length"])))
                     (update resp :headers assoc "Content-Length" (str (alength ^bytes body)))
                     resp)]
          (send-response! w out resp)))
      (catch Throwable t
        ;; parse error
        (try
          (send-response! w out bad-request-error)
          (catch Throwable _)))
      (finally
        (try (.close w) (catch Throwable _))
        (try (.close out) (catch Throwable _))
        (try (.close in) (catch Throwable _))))
    (try (.close w) (catch Throwable _))
    (try (.close out) (catch Throwable _))
    (try (.close in) (catch Throwable _))))

;; ---------- demo ----------
;; in your ns do something like this
;; important limitations:
;; - handler :body must be nil or a byte array
;; - returned headers must be lower case

(defn handler [{:keys [request-method body] :as req}]
  (println req)
  (case request-method
    :get  {:status  200
           :headers {"content-type" "text/html"}
           :body    (.getBytes "<h1>lulz</h1>")}
    :post {:status  200
           :headers {"content-type"   "application/octect-stream"
                     "content-length" (str (alength body))}
           :body    body}))

(while true
  (with-open [sock (java.net.ServerSocket. 8082)
              s    (.accept sock)]
    (handle-connection (.getInputStream s) (.getOutputStream s)
                       {:handler handler
                        :server-name "localhost"
                        :remote-addr (.getHostAddress (.getInetAddress s))
                        :server-port 8082})))

;; to run
;; clj http.clj
;; in other terinal
;; curl -v http://localhost:8082/
;; curl -v http://localhost:8082/ -X POST --data-binary '{"msg": "hi"}'