@@ -10,34 +10,44 @@
1010module Network.Wai.Middleware.StripHeaders
1111 ( stripHeader
1212 , stripHeaders
13+ , stripHeaderIf
14+ , stripHeadersIf
1315 ) where
1416
1517import Network.Wai (Middleware, Request)
18+import Network.Wai.Internal (Response)
1619import Data.ByteString (ByteString)
1720import Network.Wai.Middleware.AddHeaders (mapResponseHeader)
1821
1922import qualified Data.CaseInsensitive as CI
2023
24+ifRequest :: (Request -> Bool) -> Middleware -> Middleware
25+ifRequest rpred middle app req | rpred req = middle app req
26+ | otherwise = app req
27+
28+modifyResponse :: (Response -> Response) -> Middleware
29+modifyResponse f app req respond = app req $ respond . f
30+
31+stripHeader :: ByteString -> (Response -> Response)
32+stripHeader h = mapResponseHeader (filter (\ hdr -> fst hdr /= CI.mk h))
33+
34+stripHeaders :: [ByteString] -> (Response -> Response)
35+stripHeaders hs =
36+ let hnames = map CI.mk hs
37+ in mapResponseHeader (filter (\ hdr -> fst hdr `notElem` hnames))
2138
2239-- | If the request satisifes the provided predicate, strip headers matching
2340-- the provided header name.
2441--
2542-- Since 3.0.8
26−
27−stripHeader :: ByteString -> (Request -> Bool) -> Middleware
28−stripHeader h rpred app req respond
29− | rpred req = app req $ respond . mapResponseHeader (filter (\ hdr -> fst hdr /= CI.mk h))
30− | otherwise = app req respond
31−
43+stripHeaderIf :: ByteString -> (Request -> Bool) -> Middleware
44+stripHeaderIf h rpred =
45+ ifRequest rpred (modifyResponse $ stripHeader h)
3246
3347-- | If the request satisifes the provided predicate, strip all headers whose
3448-- header name is in the list of provided header names.
3549--
3650-- Since 3.0.8
37−
38−stripHeaders :: [ByteString] -> (Request -> Bool) -> Middleware
39−stripHeaders hs rpred app req respond
40− | rpred req = do
41− let hnames = map CI.mk hs
42− app req $ respond . mapResponseHeader (filter (\ hdr -> fst hdr `notElem` hnames))
43− | otherwise = app req respond
51+stripHeadersIf :: [ByteString] -> (Request -> Bool) -> Middleware
52+stripHeadersIf hs rpred
53+ = ifRequest rpred (modifyResponse $ stripHeaders hs)