koi.carp

(Project.config "cflag" "-pthread")
(load "src/deps.carp")

(load "src/models.carp")
(load "src/void.carp")
(load "src/thread.carp")
(load "src/res.carp")
(load "src/req.carp")
(load "src/static.carp")

(use Socket)

(defmodule Koi
  (sig not-found (Fn [Req] Res))
  (defn not-found [req]
    (Res.send (HttpStatus.NotFound)
              @"text/html"
              @"<h1>Not Found</h1>"))

  (sig internal-server-error (Fn [Req] Res))
  (defn internal-server-error [req]
    (Res.send (HttpStatus.InternalServerError)
              @"text/html"
              @"<h1>Internal Server Error</h1>"))

  (sig bad-request (Fn [] Res))
  (defn bad-request []
    (Res.send (HttpStatus.BadRequest)
              @"text/plain"
              @"Bad Request"))

  (hidden get-handler-from-routes)
  (private get-handler-from-routes)
  (sig get-handler-from-routes (Fn [(Ref Req) (Ref (Array Route))] (Fn [Req] Res)))
  (defn get-handler-from-routes [req routes]
    (let [verb @(Req.verb req)
          path (URI.str (Req.uri req))]
     (match (Array.find
             &(fn [route]
               (and
                (= &verb (Route.verb route))
                (= &path (Route.path route))))
             routes)
      (Maybe.Just route) @(Route.handler &route)
      (Maybe.Nothing)    not-found)))

  (hidden get-res-from-routes)
  (private get-res-from-routes)
  (sig get-res-from-routes (Fn [String (Ref (Array Route))] Res))
  (defn get-res-from-routes [req-str routes]
    (match (Req.parse &req-str)
      (Result.Success req) ((get-handler-from-routes &req routes) req)
      (Result.Error err)   (do
                            (Clog.error &err)
                            (bad-request))))

  (hidden print-registered-routes)
  (private print-registered-routes)
  (sig print-registered-routes (Fn [&(Array Route)] ()))
  (defn print-registered-routes [routes]
    (do
      (Clog.info "Registered routes:")
      (foreach [route routes]
       (Clog.info (fmt "  %s" &(str route))))))

  (defn-do serve-client [pool]
    (let [routes (Pool.get-routes pool)]
      (while true
        (let [client (Pool.pop-client-sock pool)]
          (let-do [req (read &client)]
            (Clog.debug &(fmt "---REQUEST---\n%s" &req))
            (let-do [res (Res.str &(get-res-from-routes req &routes))]
              (Clog.debug &(fmt "---RESPONSE---\n%s" &res))
              (send &client &res))
            (Socket.close client))))))

  (defn spawn-worker-threads [thread-count pool callback]
   (for [i 1 (inc thread-count)]
    (let-do [success (Thread.create &(Thread.init) callback pool)]
      (if success
        (Clog.info &(fmt "Created worker thread %i" i))
        (Clog.fatal &(fmt "Failed to create worker thread %i" i))))))

  (defn get-worker-count []
    (match (IO.getenv "KOI_WORKER_COUNT")
      Maybe.Nothing (get-cpu-count)
      (Maybe.Just count-str)
      (match (Int.from-string &count-str)
        (Maybe.Just count)
        (if (> count 0)
          count
          (Clog.fatal &(fmt "Worker count supplied is too low: %s" &count-str)))
        Maybe.Nothing
        (Clog.fatal &(fmt "Worker count supplied is not a valid number: %s" &count-str)))))

  (sig serve (Fn [(Ref String) Int (Array Route)] ()))
  (defn-do serve [ip port routes]
    (print-registered-routes &routes)
    (Socket.with-server server ip port
      (let-do  [pool (Pool.new routes)]
        (spawn-worker-threads (get-worker-count) &pool &serve-client)
        (listen &server)
        (Clog.info (fmt "Listening on %s:%i" ip port))
        (while true
          (Pool.push-client-sock &pool (accept &server)))))))