content: {-# LANGUAGE UndecidableInstances #-}
  
  -- | Core types and functions for HTTP
  module Mig.Core.Types.Http (
    -- * types
    Request (..),
    Response (..),
    ResponseBody (..),
    HeaderMap,
    QueryMap,
    ToText (..),
  
    -- * responses
    okResponse,
    badResponse,
    badRequest,
    setContent,
    noContentResponse,
  
    -- * utils
    setRespStatus,
    addRespHeaders,
    toFullPath,
  ) where
  
  import Data.ByteString (ByteString)
  import Data.ByteString.Lazy qualified as BL
  import Data.Map.Strict (Map)
  import Data.Map.Strict qualified as Map
  import Data.String
  import Data.Text (Text)
  import Data.Text qualified as Text
  import Data.Text.Encoding qualified as Text
  import Data.Text.Lazy qualified as TL
  import Mig.Core.Class.MediaType (MediaType, ToMediaType (..), ToRespBody (..))
  import Network.HTTP.Media.RenderHeader
  import Network.HTTP.Types.Header (HeaderName, ResponseHeaders)
  import Network.HTTP.Types.Method (Method)
  import Network.HTTP.Types.Status (Status, ok200, status500)
  
  -- | Http response
  data Response = Response
    { status :: Status
    -- ^ status
    , headers :: ResponseHeaders
    -- ^ headers
    , body :: ResponseBody
    -- ^ response body
    }
    deriving (Show, Eq)
  
  -- | Response with no content
  noContentResponse :: Status -> Response
  noContentResponse status = Response status [] (RawResp "*/*" "")
  
  -- | Http response body
  data ResponseBody
    = RawResp MediaType BL.ByteString
    | FileResp FilePath
    | StreamResp
    deriving (Show, Eq)
  
  -- | Http request
  data Request = Request
    { path :: [Text]
    -- ^ URI path
    , query :: QueryMap
    -- ^ query parameters
    , capture :: CaptureMap
    -- ^ capture from path
    , headers :: HeaderMap
    -- ^ request headers
    , method :: Method
    -- ^ request method
    , readBody :: IO (Either Text BL.ByteString)
    -- ^ lazy body reader. Error can happen if size is too big (configured on running the server)
    , isSecure :: Bool
    -- ^ was this request made over SSL connection
    }
  
  -- | Headers as map
  type HeaderMap = Map HeaderName ByteString
  
  -- | Captures as map
  type CaptureMap = Map Text Text
  
  -- | Map of query parameters for fast-access
  type QueryMap = Map ByteString (Maybe ByteString)
  
  -- | Bad request response
  badRequest :: forall media a. (ToRespBody media a) => a -> Response
  badRequest message = badResponse @media status500 message
  
  -- | Values convertible to lazy text
  class ToText a where
    toText :: a -> Text
  
  instance ToText TL.Text where
    toText = TL.toStrict
  
  instance ToText Text where
    toText = id
  
  instance ToText Int where
    toText = Text.pack . show
  
  instance ToText Float where
    toText = Text.pack . show
  
  instance ToText String where
    toText = fromString
  
  {-# INLINE setContent #-}
  
  -- | Headers to set content type
  setContent :: MediaType -> ResponseHeaders
  setContent media =
    [("Content-Type", renderHeader media)]
  
  -- | Sets response status
  setRespStatus :: Status -> Response -> Response
  setRespStatus status (Response _ headers body) = Response status headers body
  
  addRespHeaders :: ResponseHeaders -> Response -> Response
  addRespHeaders headers (Response status hs body) = Response status (headers <> hs) body
  
  -- | Respond with ok 200-status
  okResponse :: forall mime a. (ToRespBody mime a) => a -> Response
  okResponse = Response ok200 (setContent media) . RawResp media . toRespBody @mime
    where
      media = toMediaType @mime
  
  -- | Bad response qith given status
  badResponse :: forall mime a. (ToRespBody mime a) => Status -> a -> Response
  badResponse status = Response status (setContent media) . RawResp media . toRespBody @mime
    where
      media = toMediaType @mime
  
  toFullPath :: Request -> Text
  toFullPath req = Text.intercalate "/" req.path <> queries
    where
      queries
        | Map.null req.query = mempty
        | otherwise = "?" <> Text.intercalate "&" (fmap fromQuery (Map.toList req.query))
  
      fromQuery (name, mVal) = case mVal of
        Just val -> nameText <> "=" <> Text.decodeUtf8 val
        Nothing -> nameText
        where
          nameText = Text.decodeUtf8 name
  