module Webserver.Data.Response (
  ResponseBody (..),
  Response (..),
  response,
  withHeader,
  withHeaders,
  withBody,
  withJsonBody,
  withFileBody,
  toWaiResponse,
  ok,
  created,
  badRequest,
  unauthorized,
  forbidden,
  notFound,
  methodNotAllowed,
  requestTimeout,
  payloadTooLarge,
  unsupportedMediaType,
  imATeapot,
  tooManyRequests,
  internalServerError,
  respondBodyError,
)
where

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

import qualified Data.Aeson               as Aeson
import qualified Network.HTTP.Types       as Http
import qualified Network.Wai              as Wai
import           Webserver.Data.BodyError (BodyError (..))

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

-- | The body of a 'Response', either a lazy bytestring or a file path
data ResponseBody
  = LBSBody !Json
  | FileBody !String

data Response = Response
  { status  :: !Http.Status
  , headers :: !(List Http.Header)
  , body    :: !ResponseBody
  }

-- | Construct a 'Response' from a status code with no headers and an empty body
response :: Http.Status -> Response
response status_ =
  Response
    { status = status_
    , headers = []
    , body = LBSBody ""
    }

-- | Add a single header to a 'Response'
withHeader :: Http.Header -> Response -> Response
withHeader h r = r {headers = h : r.headers}

-- | Add multiple headers to a 'Response'
withHeaders :: List Http.Header -> Response -> Response
withHeaders hs r = r {headers = hs <> r.headers}

-- | Set the raw body of a 'Response'
withBody :: Json -> Response -> Response
withBody b r = r {body = LBSBody b}

-- | Set the body of a 'Response' by JSON-encoding a value
withJsonBody :: (Aeson.ToJSON a) => a -> Response -> Response
withJsonBody val r = r {body = LBSBody (Aeson.encode val)}

-- | Set the body of a 'Response' to a file path
withFileBody :: String -> Response -> Response
withFileBody path r = r {body = FileBody path}

-- | Convert a 'Response' into a WAI 'Wai.Response'
toWaiResponse :: Response -> Wai.Response
toWaiResponse r = case r.body of
  LBSBody lbs   -> Wai.responseLBS r.status r.headers lbs
  FileBody path -> Wai.responseFile r.status r.headers path Nothing

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

ok :: Response
ok = response Http.ok200 |> withBody "Ok"

created :: Response
created = response Http.created201 |> withBody "Created"

badRequest :: Response
badRequest = response Http.badRequest400 |> withBody "Bad Request"

unauthorized :: Response
unauthorized = response Http.unauthorized401 |> withBody "Not Authorized"

forbidden :: Response
forbidden = response Http.forbidden403 |> withBody "Forbidden"

notFound :: Response
notFound = response Http.notFound404 |> withBody "Not Found"

methodNotAllowed :: Response
methodNotAllowed = response Http.methodNotAllowed405 |> withBody "Method Not Allowed"

requestTimeout :: Response
requestTimeout = response Http.requestTimeout408 |> withBody "Request Timeout"

payloadTooLarge :: Response
payloadTooLarge = response Http.requestEntityTooLarge413 |> withBody "Payload Too Large"

unsupportedMediaType :: Response
unsupportedMediaType = response Http.unsupportedMediaType415 |> withBody "Unsupported Media Type"

imATeapot :: Response
imATeapot = response Http.imATeapot418 |> withBody "I'm a Teapot"

tooManyRequests :: Response
tooManyRequests = response Http.tooManyRequests429 |> withBody "Too Many Requests"

internalServerError :: Response
internalServerError = response Http.internalServerError500 |> withBody "Internal Server Error"

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

-- | Map a 'BodyError' to the appropriate 'Response'
respondBodyError :: BodyError -> Response
respondBodyError = \case
  UnsupportedContentType -> unsupportedMediaType
  BodyTooLarge -> payloadTooLarge
  DecodeFailed -> badRequest