module Webserver.Control.Body (
  readJsonBody,
  readJsonBodyWith,
  readRawBody,
)
where

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

import           Data.Aeson               (FromJSON)
import qualified Data.Aeson               as Aeson
import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as BS
import           Data.List                (lookup, reverse)
import           Data.Word                (Word8)
import qualified Network.HTTP.Types       as Http
import qualified Network.Wai              as Wai
import           Webserver.Data.BodyError (BodyError (..), defaultMaxBodySize)

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

-- | Read and decode a JSON request body, enforcing Content-Type and a 1 MiB size limit
readJsonBody :: (FromJSON a) => Wai.Request -> IO (Either BodyError a)
readJsonBody = readJsonBodyWith defaultMaxBodySize

-- | Read and decode a JSON request body with a custom size limit
readJsonBodyWith :: (FromJSON a) => Int -> Wai.Request -> IO (Either BodyError a)
readJsonBodyWith maxSize request =
  if not (isJsonContentType request)
    then return <| Left UnsupportedContentType
    else
      readRawBody maxSize request >>= \case
        Left err -> return <| Left err
        Right bytes ->
          case Aeson.decodeStrict bytes of
            Nothing  -> return <| Left DecodeFailed
            Just val -> return <| Right val

-- | Read all chunks from a request body into a single strict ByteString, enforcing a size limit
readRawBody :: Int -> Wai.Request -> IO (Either BodyError ByteString)
readRawBody maxSize request =
  let accumulate :: [ByteString] -> Int -> IO (Either BodyError ByteString)
      accumulate acc accSize = do
        chunk <- Wai.getRequestBodyChunk request
        if BS.null chunk
          then return <| Right (BS.concat (reverse acc))
          else
            let newSize = accSize + BS.length chunk
             in if newSize > maxSize
                  then return <| Left BodyTooLarge
                  else accumulate (chunk : acc) newSize
   in accumulate [] 0

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

-- | Check whether a request's Content-Type header indicates application/json
isJsonContentType :: Wai.Request -> Bool
isJsonContentType request =
  case lookup Http.hContentType (Wai.requestHeaders request) of
    Nothing -> False
    Just ct ->
      let mediaType =
            ct
              |> BS.takeWhile (/= semicolon)
              |> BS.dropWhileEnd (== space)
              |> BS.map toLowerByte
       in mediaType == "application/json"

toLowerByte :: Word8 -> Word8
toLowerByte w
  | w >= 0x41 && w <= 0x5A = w + 32
  | otherwise = w

semicolon :: Word8
semicolon = 0x3B

space :: Word8
space = 0x20