-- |
--
-- Since 3.0.3
module Network.Wai.Middleware.AddHeaders (
    addHeaders,
) where

import Control.Arrow (first)
import Data.ByteString (ByteString)
import qualified Data.CaseInsensitive as CI
import Network.HTTP.Types (Header)
import Network.Wai (Middleware, mapResponseHeaders, modifyResponse)
import Network.Wai.Internal (Response (..))

addHeaders :: [(ByteString, ByteString)] -> Middleware
-- ^ Prepend a list of headers without any checks
--
-- Since 3.0.3
addHeaders :: [(ByteString, ByteString)] -> Middleware
addHeaders [(ByteString, ByteString)]
h = (Response -> Response) -> Middleware
modifyResponse ((Response -> Response) -> Middleware)
-> (Response -> Response) -> Middleware
forall a b. (a -> b) -> a -> b
$ [Header] -> Response -> Response
addHeaders' (((ByteString, ByteString) -> Header)
-> [(ByteString, ByteString)] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> HeaderName) -> (ByteString, ByteString) -> Header
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk) [(ByteString, ByteString)]
h)

addHeaders' :: [Header] -> Response -> Response
addHeaders' :: [Header] -> Response -> Response
addHeaders' [Header]
h = ([Header] -> [Header]) -> Response -> Response
mapResponseHeaders ([Header]
h [Header] -> [Header] -> [Header]
forall a. [a] -> [a] -> [a]
++)