@@ -0,0 +1,26 @@
1+
2+module Network.Wai.Middleware.AddHeaders
3+ ( addHeaders
4+ ) where
5+
6+import Network.HTTP.Types (ResponseHeaders, Header)
7+import Network.Wai (Middleware)
8+import Network.Wai.Internal (Response(..))
9+import Data.ByteString (ByteString)
10+
11+import qualified Data.CaseInsensitive as CI
12+import Control.Arrow (first)
13+
14+addHeaders :: [(ByteString, ByteString)] -> Middleware
15+-- ^ Prepend a list of headers without any checks
16+
17+addHeaders h app req respond = app req $ respond . addHeaders' (map (first CI.mk) h)
18+
19+mapHeader :: (ResponseHeaders -> ResponseHeaders) -> Response -> Response
20+mapHeader f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2
21+mapHeader f (ResponseBuilder s h b) = ResponseBuilder s (f h) b
22+mapHeader f (ResponseStream s h b) = ResponseStream s (f h) b
23+mapHeader _ r@(ResponseRaw _ _) = r
24+
25+addHeaders' :: [Header] -> Response -> Response
26+addHeaders' h = mapHeader (\hs -> h ++ hs)