{-# LANGUAGE OverloadedStrings #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- This program is free software: you can redistribute it and/or modify it under
-- the terms of the GNU Affero General Public License as published by the Free
-- Software Foundation, either version 3 of the License, or (at your option) any
-- later version.
--
-- This program is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
-- details.
--
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see <https://www.gnu.org/licenses/>.

module Network.Wai.Utilities.Response where

import Data.Aeson hiding (Error, json)
import Data.ByteString.Lazy qualified as Lazy
import Imports
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Internal
import Network.Wai.Utilities.Error

empty :: Response
empty :: Response
empty = ByteString -> Response
plain ByteString
""

plain :: Lazy.ByteString -> Response
plain :: ByteString -> Response
plain = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 [Header
plainContent]

plainContent :: Header
plainContent :: Header
plainContent = (HeaderName
hContentType, ByteString
"text/plain; charset=UTF-8")

json :: (ToJSON a) => a -> Response
json :: forall a. ToJSON a => a -> Response
json = Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
status200 [Header
jsonContent] (ByteString -> Response) -> (a -> ByteString) -> a -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode

jsonContent :: Header
jsonContent :: Header
jsonContent = (HeaderName
hContentType, ByteString
"application/json")

errorRs :: Error -> Response
errorRs :: Error -> Response
errorRs Error
e = Status -> Response -> Response
setStatus (Error -> Status
code Error
e) (Error -> Response
forall a. ToJSON a => a -> Response
json Error
e)

addHeader :: HeaderName -> ByteString -> Response -> Response
addHeader :: HeaderName -> ByteString -> Response -> Response
addHeader HeaderName
k ByteString
v (ResponseFile Status
s ResponseHeaders
h FilePath
f Maybe FilePart
ff) = Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
ResponseFile Status
s ((HeaderName
k, ByteString
v) Header -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
h) FilePath
f Maybe FilePart
ff
addHeader HeaderName
k ByteString
v (ResponseBuilder Status
s ResponseHeaders
h Builder
b) = Status -> ResponseHeaders -> Builder -> Response
ResponseBuilder Status
s ((HeaderName
k, ByteString
v) Header -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
h) Builder
b
addHeader HeaderName
k ByteString
v (ResponseStream Status
s ResponseHeaders
h StreamingBody
x) = Status -> ResponseHeaders -> StreamingBody -> Response
ResponseStream Status
s ((HeaderName
k, ByteString
v) Header -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
h) StreamingBody
x
addHeader HeaderName
k ByteString
v (ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
s Response
r) = (IO ByteString -> (ByteString -> IO ()) -> IO ())
-> Response -> Response
ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
s (HeaderName -> ByteString -> Response -> Response
addHeader HeaderName
k ByteString
v Response
r)

setStatus :: Status -> Response -> Response
setStatus :: Status -> Response -> Response
setStatus Status
s (ResponseBuilder Status
_ ResponseHeaders
h Builder
b) = Status -> ResponseHeaders -> Builder -> Response
ResponseBuilder Status
s ResponseHeaders
h Builder
b
setStatus Status
s (ResponseStream Status
_ ResponseHeaders
h StreamingBody
x) = Status -> ResponseHeaders -> StreamingBody -> Response
ResponseStream Status
s ResponseHeaders
h StreamingBody
x
setStatus Status
s (ResponseFile Status
_ ResponseHeaders
h FilePath
f Maybe FilePart
ff) = Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
ResponseFile Status
s ResponseHeaders
h FilePath
f Maybe FilePart
ff
setStatus Status
s (ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
x Response
r) = (IO ByteString -> (ByteString -> IO ()) -> IO ())
-> Response -> Response
ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
x (Status -> Response -> Response
setStatus Status
s Response
r)