module Webserver.Control.Handler (
  Handler,
  Route,
  resolveHandler,
  handle,
  respond,
  serveHtml,
  require,
  requireJust,
  requireRight,
  throwResponse,
  readJsonBody,
  readJsonBodyWith,
  liftIO,
)
where

----------------------------------------------------------------------------------------------------

import           Control.Monad.IO.Class           (liftIO)
import           Control.Monad.Trans.Except       (ExceptT, runExceptT, throwE)
import           Data.Aeson                       (FromJSON)
import qualified Network.HTTP.Types               as Http
import qualified Network.Wai                      as Wai
import qualified System.Directory                 as Dir
import qualified Webserver.Control.Body           as Body
import           Webserver.Data.Context           (Context)
import qualified Webserver.Data.Response          as Response
import           Webserver.Data.Response          (Response, toWaiResponse)
import           Webserver.Data.Sql.Cache.Session (Sessions)

----------------------------------------------------------------------------------------------------

-- | A handler monad where the "error" channel is an HTTP response (early return)
type Handler = ExceptT Response IO

-- | A route handler that produces a 'Response' without needing the WAI callback
type Route = Sessions -> Context -> Wai.Request -> IO Response

-- | Collapse a 'Handler' computation into a plain 'IO Response'
resolveHandler :: Handler Response -> IO Response
resolveHandler handler =
  runExceptT handler >>= \case
    Left earlyReturn -> return earlyReturn
    Right result_ -> return result_

-- | Bridge a 'Route' into a full WAI handler by applying 'toWaiResponse' once
handle
  :: Route
  -> Sessions
  -> Context
  -> Wai.Request
  -> (Wai.Response -> IO Wai.ResponseReceived)
  -> IO Wai.ResponseReceived
handle route sn ctx request respondWith = do
  r <- route sn ctx request
  respondWith <| toWaiResponse r

-- | Use a pre-built 'Response' as a 'Route' (ignores session, context, request)
respond :: Response -> Route
respond r _ _ _ = return r

----------------------------------------------------------------------------------------------------

-- | Require a condition to be 'True', otherwise early-return the given response
require :: Bool -> Response -> Handler ()
require condition fallback =
  if condition
    then return ()
    else throwE fallback

{- | Unwrap a 'Just', otherwise early-return the given response.
  Response comes first to support @>>= requireJust badRequest@ chaining.
-}
requireJust :: Response -> Maybe a -> Handler a
requireJust fallback = \case
  Just val -> return val
  Nothing -> throwE fallback

-- | Unwrap a 'Right', otherwise map the error to a response and early-return
requireRight :: (e -> Response) -> Either e a -> Handler a
requireRight toResponse = \case
  Right val -> return val
  Left err -> throwE <| toResponse err

-- | Explicitly early-return a response
throwResponse :: Response -> Handler a
throwResponse = throwE

----------------------------------------------------------------------------------------------------

-- | Read and decode a JSON request body inside 'Handler', early-returning on errors
readJsonBody :: (FromJSON a) => Wai.Request -> Handler a
readJsonBody request = do
  result_ <- liftIO <| Body.readJsonBody request
  requireRight Response.respondBodyError result_

-- | Read and decode a JSON request body with a custom size limit inside 'Handler'
readJsonBodyWith :: (FromJSON a) => Int -> Wai.Request -> Handler a
readJsonBodyWith maxSize request = do
  result_ <- liftIO <| Body.readJsonBodyWith maxSize request
  requireRight Response.respondBodyError result_

----------------------------------------------------------------------------------------------------

{- | Serve an HTML file as a 'Handler Response'.
  Returns a 500 error response if the file doesn't exist.
-}
serveHtml :: String -> Handler Response
serveHtml filePath =
  let htmlDir = "./static/html"
      fullPath = htmlDir <> "/" <> filePath
      htmlHeaders = [("Content-Type", "text/html; charset=utf-8")]
      errorBody = "<!DOCTYPE html><html><body><h1>500 Internal Server Error</h1><p>Template file not found.</p></body></html>"
   in do
        exists <- liftIO <| Dir.doesFileExist fullPath
        if exists
          then
            return
              ( Response.response Http.ok200
                  |> Response.withHeaders htmlHeaders
                  |> Response.withFileBody fullPath
              )
          else
            return
              ( Response.response Http.internalServerError500
                  |> Response.withHeaders htmlHeaders
                  |> Response.withBody errorBody
              )