  Copyright ( c )   . All rights reserved .
;; The use and distribution terms for this software are covered by the
  Eclipse Public License 1.0 ( -1.0.php )
;; which can be found in the file epl-v10.html at the root of this distribution.
;; By using this software in any fashion, you are agreeing to be bound by
;; the terms of this license.
;; You must not remove this notice, or any other, from this software.

(ns cljs.repl.server
  (:refer-clojure :exclude [loaded-libs])
  (:require [clojure.string :as str])
  (:import java.io.BufferedReader
           java.io.InputStreamReader
           java.io.ByteArrayOutputStream
           java.util.zip.GZIPOutputStream
           java.net.ServerSocket
           [java.util LinkedList]))

(def ^:dynamic state nil)
(def connq (LinkedList.))
(def promiseq (LinkedList.))
(def lock (Object.))

(defn connection
  "Promise to return a connection when one is available. If no connection is
   available put the promise into a FIFO queue to get the next available
   connection."
  []
  (locking lock
    (let [p (promise)
          conn (.poll connq)]
      (if (and conn (not (.isClosed conn)))
        (deliver p conn)
        (.offer promiseq p))
      p)))

(defn set-connection
  "Given a new available connection, poll the promise queue for and deliver
   the connection. Otherwise put the connection into a FIFO queue."
  [conn]
  (locking lock
    (if-let [p (.poll promiseq)]
      (deliver p conn)
      (.offer connq conn))))

(defonce handlers (atom {}))

(defn dispatch-on
  "Registers a handler to be dispatched based on a request method and a
  predicate.

  pred should be a function that accepts an options map, a connection,
  and a request map and returns a boolean value based on whether or not
  that request should be dispatched to the related handler."
  ([method pred handler]
    (dispatch-on method {:pred pred :handler handler}))
  ([method {:as m}]
    (swap! handlers
      (fn [old]
        (update-in old [method] #(conj (vec %) m))))))

(defn parse-file-parts [file]
  ;; This is a port of java.net.URL.Parts, which is package private.
  (let [ref-idx (str/index-of file "#")
        [file ref] (if ref-idx
                     [(subs file 0 ref-idx) (subs file (inc ref-idx))]
                     [file nil])
        q-idx (str/last-index-of file \?)]
    (merge {:ref ref}
           (if q-idx
             {:path (subs file 0 q-idx)
              :query-str (subs file (inc q-idx))}
             {:path file}))))

  assumes first line already consumed
(defn parse-headers
  "Parse the headers of an HTTP POST request."
  [header-lines]
  (apply hash-map
    (mapcat
      (fn [line]
        (let [[k v] (str/split line #":" 2)]
          [(keyword (str/lower-case k)) (str/triml v)]))
      header-lines)))

(defn read-headers [rdr]
  (loop [next-line (.readLine rdr) header-lines []]
    (if (= "" next-line)
      header-lines ;; we're done reading headers
      (recur
        (.readLine rdr)
        (conj header-lines next-line)))))

(defn read-post [line rdr]
  (let [[_ file _] (str/split line #" ")
        {:keys [path ref query-str]} (parse-file-parts file)
        headers (parse-headers (read-headers rdr))
        content-length (Integer/parseInt (:content-length headers))
        content (char-array content-length)]
    (io! (.read rdr content 0 content-length)
      {:method :post
       :path path
       :ref ref
       :query-str query-str
       :headers headers
       :content (String. content)})))

(defn read-get [line rdr]
  (let [[_ file _] (str/split line #" ")
        {:keys [path ref query-str]} (parse-file-parts file)
        headers (parse-headers (read-headers rdr))]
    {:method :get
     :path path
     :ref ref
     :query-str query-str
     :headers headers}))

(defn read-request [rdr]
  (if-let [line (.readLine rdr)]
    (cond
      (.startsWith line "POST") (read-post line rdr)
      (.startsWith line "GET") (read-get line rdr)
      :else {:method :unknown :content line})
    {:method :unknown :content nil}))

(defn- status-line [status]
  (case status
    200 "HTTP/1.1 200 OK"
    404 "HTTP/1.1 404 Not Found"
    "HTTP/1.1 500 Error"))

(defn ^bytes gzip [^bytes bytes]
  (let [baos (ByteArrayOutputStream. (count bytes))]
    (try
      (let [gzos (GZIPOutputStream. baos)]
        (try
          (.write gzos bytes)
          (finally
            (.close gzos))))
      (finally
        (.close baos)))
    (.toByteArray baos)))

(defn send-and-close
  "Use the passed connection to send a form to the browser. Send a
  proper HTTP response."
  ([conn status form]
    (send-and-close conn status form "text/html"))
  ([conn status form content-type]
    (send-and-close conn status form content-type "UTF-8"))
  ([conn status form content-type encoding]
    (send-and-close conn status form content-type encoding false))
  ([conn status form content-type encoding gzip?]
    (let [byte-form (cond-> (.getBytes form encoding) gzip? gzip)
          content-length (count byte-form)
          headers (map #(.getBytes (str % "\r\n"))
                    (cond->
                      [(status-line status)
                       "Server: ClojureScript REPL"
                       (if (not= content-type "application/wasm")
                         (str "Content-Type: "
                              content-type
                              "; charset=" encoding)
                         (str "Content-Type: "
                              content-type))
                       (str "Content-Length: " content-length)]
                      gzip? (conj "Content-Encoding: gzip")
                      true (conj "")))]
      (with-open [os (.getOutputStream conn)]
        (doseq [header headers]
          (.write os header 0 (count header)))
        (.write os byte-form 0 content-length)
        (.flush os)
        (.close conn)))))

(defn send-404 [conn path]
  (send-and-close conn 404
    (str
      "<html><body>"
      "<h2>Page not found</h2>"
      "No page " path " found on this server."
      "</body></html>")
    "text/html"))

(defn- dispatch-request [request conn opts]
  (try
    (if-let [handlers ((:method request) @handlers)]
      (if-let [handler
               (some (fn [{:keys [pred handler]}]
                       (when (pred request conn opts)
                         handler))
                     handlers)]
        (if (= :post (:method request))
          (handler (read-string (:content request)) conn opts )
          (handler request conn opts))
        (send-404 conn (:path request))))
    (catch Throwable t
      (try
        (send-and-close conn 500 (str "<html><body>"
                                      "<h2>Exception while handling</h2>"
                                      "</body></html>"))
        (catch Throwable _))
      (throw t))))

(defn- handle-connection
  [opts conn]
  (let [rdr (BufferedReader. (InputStreamReader. (.getInputStream conn)))]
    (if-let [request (read-request rdr)]
      (dispatch-request request conn opts)
      (.close conn))))

(defn- server-loop
  [opts server-socket]
  (when-let [conn (try (.accept server-socket) (catch Throwable _))]
    (.setKeepAlive conn true)
    (.start
      (Thread.
        ((ns-resolve 'clojure.core 'binding-conveyor-fn)
          (fn [] (handle-connection opts conn)))))
    (recur opts server-socket)))

(defn start
  "Start the server on the specified port."
  [opts]
  (let [ss (ServerSocket. (:port opts))]
    (.start
      (Thread.
        ((ns-resolve 'clojure.core 'binding-conveyor-fn)
          (fn [] (server-loop opts ss)))))
    (swap! state (fn [old] (assoc old :socket ss :port (:port opts))))))

(defn stop []
  (when-let [sock (:socket @state)]
    (when-not (.isClosed sock)
      (.close sock))))

 The use and distribution terms for this software are covered by the
 which can be found in the file epl-v10.html at the root of this distribution.
 By using this software in any fashion, you are agreeing to be bound by
 the terms of this license.
 You must not remove this notice, or any other, from this software.
 This is a port of java.net.URL.Parts, which is package private.
 we're done reading headers
  Copyright ( c )   . All rights reserved .
  Eclipse Public License 1.0 ( -1.0.php )

(ns cljs.repl.server
  (:refer-clojure :exclude [loaded-libs])
  (:require [clojure.string :as str])
  (:import java.io.BufferedReader
           java.io.InputStreamReader
           java.io.ByteArrayOutputStream
           java.util.zip.GZIPOutputStream
           java.net.ServerSocket
           [java.util LinkedList]))

(def ^:dynamic state nil)
(def connq (LinkedList.))
(def promiseq (LinkedList.))
(def lock (Object.))

(defn connection
  "Promise to return a connection when one is available. If no connection is
   available put the promise into a FIFO queue to get the next available
   connection."
  []
  (locking lock
    (let [p (promise)
          conn (.poll connq)]
      (if (and conn (not (.isClosed conn)))
        (deliver p conn)
        (.offer promiseq p))
      p)))

(defn set-connection
  "Given a new available connection, poll the promise queue for and deliver
   the connection. Otherwise put the connection into a FIFO queue."
  [conn]
  (locking lock
    (if-let [p (.poll promiseq)]
      (deliver p conn)
      (.offer connq conn))))

(defonce handlers (atom {}))

(defn dispatch-on
  "Registers a handler to be dispatched based on a request method and a
  predicate.

  pred should be a function that accepts an options map, a connection,
  and a request map and returns a boolean value based on whether or not
  that request should be dispatched to the related handler."
  ([method pred handler]
    (dispatch-on method {:pred pred :handler handler}))
  ([method {:as m}]
    (swap! handlers
      (fn [old]
        (update-in old [method] #(conj (vec %) m))))))

(defn parse-file-parts [file]
  (let [ref-idx (str/index-of file "#")
        [file ref] (if ref-idx
                     [(subs file 0 ref-idx) (subs file (inc ref-idx))]
                     [file nil])
        q-idx (str/last-index-of file \?)]
    (merge {:ref ref}
           (if q-idx
             {:path (subs file 0 q-idx)
              :query-str (subs file (inc q-idx))}
             {:path file}))))

  assumes first line already consumed
(defn parse-headers
  "Parse the headers of an HTTP POST request."
  [header-lines]
  (apply hash-map
    (mapcat
      (fn [line]
        (let [[k v] (str/split line #":" 2)]
          [(keyword (str/lower-case k)) (str/triml v)]))
      header-lines)))

(defn read-headers [rdr]
  (loop [next-line (.readLine rdr) header-lines []]
    (if (= "" next-line)
      (recur
        (.readLine rdr)
        (conj header-lines next-line)))))

(defn read-post [line rdr]
  (let [[_ file _] (str/split line #" ")
        {:keys [path ref query-str]} (parse-file-parts file)
        headers (parse-headers (read-headers rdr))
        content-length (Integer/parseInt (:content-length headers))
        content (char-array content-length)]
    (io! (.read rdr content 0 content-length)
      {:method :post
       :path path
       :ref ref
       :query-str query-str
       :headers headers
       :content (String. content)})))

(defn read-get [line rdr]
  (let [[_ file _] (str/split line #" ")
        {:keys [path ref query-str]} (parse-file-parts file)
        headers (parse-headers (read-headers rdr))]
    {:method :get
     :path path
     :ref ref
     :query-str query-str
     :headers headers}))

(defn read-request [rdr]
  (if-let [line (.readLine rdr)]
    (cond
      (.startsWith line "POST") (read-post line rdr)
      (.startsWith line "GET") (read-get line rdr)
      :else {:method :unknown :content line})
    {:method :unknown :content nil}))

(defn- status-line [status]
  (case status
    200 "HTTP/1.1 200 OK"
    404 "HTTP/1.1 404 Not Found"
    "HTTP/1.1 500 Error"))

(defn ^bytes gzip [^bytes bytes]
  (let [baos (ByteArrayOutputStream. (count bytes))]
    (try
      (let [gzos (GZIPOutputStream. baos)]
        (try
          (.write gzos bytes)
          (finally
            (.close gzos))))
      (finally
        (.close baos)))
    (.toByteArray baos)))

(defn send-and-close
  "Use the passed connection to send a form to the browser. Send a
  proper HTTP response."
  ([conn status form]
    (send-and-close conn status form "text/html"))
  ([conn status form content-type]
    (send-and-close conn status form content-type "UTF-8"))
  ([conn status form content-type encoding]
    (send-and-close conn status form content-type encoding false))
  ([conn status form content-type encoding gzip?]
    (let [byte-form (cond-> (.getBytes form encoding) gzip? gzip)
          content-length (count byte-form)
          headers (map #(.getBytes (str % "\r\n"))
                    (cond->
                      [(status-line status)
                       "Server: ClojureScript REPL"
                       (if (not= content-type "application/wasm")
                         (str "Content-Type: "
                              content-type
                              "; charset=" encoding)
                         (str "Content-Type: "
                              content-type))
                       (str "Content-Length: " content-length)]
                      gzip? (conj "Content-Encoding: gzip")
                      true (conj "")))]
      (with-open [os (.getOutputStream conn)]
        (doseq [header headers]
          (.write os header 0 (count header)))
        (.write os byte-form 0 content-length)
        (.flush os)
        (.close conn)))))

(defn send-404 [conn path]
  (send-and-close conn 404
    (str
      "<html><body>"
      "<h2>Page not found</h2>"
      "No page " path " found on this server."
      "</body></html>")
    "text/html"))

(defn- dispatch-request [request conn opts]
  (try
    (if-let [handlers ((:method request) @handlers)]
      (if-let [handler
               (some (fn [{:keys [pred handler]}]
                       (when (pred request conn opts)
                         handler))
                     handlers)]
        (if (= :post (:method request))
          (handler (read-string (:content request)) conn opts )
          (handler request conn opts))
        (send-404 conn (:path request))))
    (catch Throwable t
      (try
        (send-and-close conn 500 (str "<html><body>"
                                      "<h2>Exception while handling</h2>"
                                      "</body></html>"))
        (catch Throwable _))
      (throw t))))

(defn- handle-connection
  [opts conn]
  (let [rdr (BufferedReader. (InputStreamReader. (.getInputStream conn)))]
    (if-let [request (read-request rdr)]
      (dispatch-request request conn opts)
      (.close conn))))

(defn- server-loop
  [opts server-socket]
  (when-let [conn (try (.accept server-socket) (catch Throwable _))]
    (.setKeepAlive conn true)
    (.start
      (Thread.
        ((ns-resolve 'clojure.core 'binding-conveyor-fn)
          (fn [] (handle-connection opts conn)))))
    (recur opts server-socket)))

(defn start
  "Start the server on the specified port."
  [opts]
  (let [ss (ServerSocket. (:port opts))]
    (.start
      (Thread.
        ((ns-resolve 'clojure.core 'binding-conveyor-fn)
          (fn [] (server-loop opts ss)))))
    (swap! state (fn [old] (assoc old :socket ss :port (:port opts))))))

(defn stop []
  (when-let [sock (:socket @state)]
    (when-not (.isClosed sock)
      (.close sock))))
