on master help sign in
move helpers into wai
commit37a7f5030b4571a5d51be43b8f1b46985d06d964 authorGreg Weber <greg@gregweber.info> dateSat 4 Jul 2015, 18:57 (11 years ago) parent68977f9
6 files changed+56−47
wai-extra/Network/Wai/Middleware/AddHeaders.hs+3−13 wai-extra/Network/Wai/Middleware/StripHeaders.hs+3−11 wai-extra/test/Network/Wai/Middleware/StripHeadersSpec.hs+4−4 wai-extra/wai-extra.cabal+2−2 wai/Network/Wai.hs+43−16 wai/wai.cabal+1−1
wai-extra/Network/Wai/Middleware/AddHeaders.hs+3−13
@@ -3,11 +3,10 @@
33-- Since 3.0.3
44module Network.Wai.Middleware.AddHeaders
55 ( addHeaders
6− , mapResponseHeader
76 ) where
87
98import Network.HTTP.Types (ResponseHeaders, Header)
10−import Network.Wai (Middleware)
9+import Network.Wai (Middleware, modifyResponse, mapResponseHeaders)
1110import Network.Wai.Internal (Response(..))
1211import Data.ByteString (ByteString)
1312
@@ -19,16 +18,7 @@ addHeaders :: [(ByteString, ByteString)] -> Middleware
1918--
2019-- Since 3.0.3
2120
22−addHeaders h app req respond = app req $ respond . addHeaders' (map (first CI.mk) h)
21+addHeaders h = modifyResponse $ addHeaders' (map (first CI.mk) h)
2322
2423addHeaders' :: [Header] -> Response -> Response
25−addHeaders' h = mapResponseHeader (\hs -> h ++ hs)
26−
27−
28−-- | Apply the provided function to the response header list of the Response.
29−mapResponseHeader :: (ResponseHeaders -> ResponseHeaders) -> Response -> Response
30−mapResponseHeader f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2
31−mapResponseHeader f (ResponseBuilder s h b) = ResponseBuilder s (f h) b
32−mapResponseHeader f (ResponseStream s h b) = ResponseStream s (f h) b
33−mapResponseHeader _ r@(ResponseRaw _ _) = r
34−
24+addHeaders' h = mapResponseHeaders (\hs -> h ++ hs)
wai-extra/Network/Wai/Middleware/StripHeaders.hs+3−11
@@ -14,27 +14,19 @@ module Network.Wai.Middleware.StripHeaders
1414 , stripHeadersIf
1515 ) where
1616
17−import Network.Wai (Middleware, Request)
17+import Network.Wai (Middleware, Request, modifyResponse, mapResponseHeaders, ifRequest)
1818import Network.Wai.Internal (Response)
1919import Data.ByteString (ByteString)
20−import Network.Wai.Middleware.AddHeaders (mapResponseHeader)
2120
2221import qualified Data.CaseInsensitive as CI
2322
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−
3123stripHeader :: ByteString -> (Response -> Response)
32−stripHeader h = mapResponseHeader (filter (\ hdr -> fst hdr /= CI.mk h))
24+stripHeader h = mapResponseHeaders (filter (\ hdr -> fst hdr /= CI.mk h))
3325
3426stripHeaders :: [ByteString] -> (Response -> Response)
3527stripHeaders hs =
3628 let hnames = map CI.mk hs
37− in mapResponseHeader (filter (\ hdr -> fst hdr `notElem` hnames))
29+ in mapResponseHeaders (filter (\ hdr -> fst hdr `notElem` hnames))
3830
3931-- | If the request satisifes the provided predicate, strip headers matching
4032-- the provided header name.
wai-extra/test/Network/Wai/Middleware/StripHeadersSpec.hs+4−4
@@ -30,8 +30,8 @@ spec = describe "stripHeader" $ do
3030
3131 it "strips a specific header" $ do
3232 resp1 <- runApp host (addHeaders testHeaders) defaultRequest
33− resp2 <- runApp host (stripHeader "Foo" (const False) . addHeaders testHeaders) defaultRequest
34− resp3 <- runApp host (stripHeader "Foo" (const True) . addHeaders testHeaders) defaultRequest
33+ resp2 <- runApp host (stripHeaderIf "Foo" (const False) . addHeaders testHeaders) defaultRequest
34+ resp3 <- runApp host (stripHeaderIf "Foo" (const True) . addHeaders testHeaders) defaultRequest
3535
3636 simpleHeaders resp1 `shouldBe` ciTestHeaders
3737 simpleHeaders resp2 `shouldBe` ciTestHeaders
@@ -39,8 +39,8 @@ spec = describe "stripHeader" $ do
3939
4040 it "strips specific set of headers" $ do
4141 resp1 <- runApp host (addHeaders testHeaders) defaultRequest
42− resp2 <- runApp host (stripHeaders ["Bar", "Foo"] (const False) . addHeaders testHeaders) defaultRequest
43− resp3 <- runApp host (stripHeaders ["Bar", "Foo"] (const True) . addHeaders testHeaders) defaultRequest
42+ resp2 <- runApp host (stripHeadersIf ["Bar", "Foo"] (const False) . addHeaders testHeaders) defaultRequest
43+ resp3 <- runApp host (stripHeadersIf ["Bar", "Foo"] (const True) . addHeaders testHeaders) defaultRequest
4444
4545 simpleHeaders resp1 `shouldBe` ciTestHeaders
4646 simpleHeaders resp2 `shouldBe` ciTestHeaders
wai-extra/wai-extra.cabal+2−2
@@ -1,5 +1,5 @@
11Name: wai-extra
2−Version: 3.0.7.1
2+Version: 3.0.8.0
33Synopsis: Provides some basic WAI handlers and middleware.
44description:
55 Provides basic WAI handler and middleware functionality:
@@ -84,7 +84,7 @@ extra-source-files:
8484Library
8585 Build-Depends: base >= 4 && < 5
8686 , bytestring >= 0.9.1.4
87− , wai >= 3.0 && < 3.1
87+ , wai >= 3.0.3.0 && < 3.1
8888 , old-locale >= 1.0.0.2 && < 1.1
8989 , time >= 1.1.4
9090 , network >= 2.2.1.5
wai/Network/Wai.hs+43−16
@@ -71,10 +71,15 @@ module Network.Wai
7171 , responseLBS
7272 , responseStream
7373 , responseRaw
74− -- * Response accessors
74+ -- ** Response accessors
7575 , responseStatus
7676 , responseHeaders
77+ -- ** Response modifiers
7778 , responseToStream
79+ , mapResponseHeaders
80+ -- * Middleware composition
81+ , ifRequest
82+ , modifyResponse
7883 ) where
7984
8085import Blaze.ByteString.Builder (Builder, fromLazyByteString)
@@ -225,6 +230,13 @@ responseToStream (ResponseBuilder s h b) =
225230 (s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b)
226231responseToStream (ResponseRaw _ res) = responseToStream res
227232
233+-- | Apply the provided function to the response header list of the Response.
234+mapResponseHeaders :: (H.ResponseHeaders -> H.ResponseHeaders) -> Response -> Response
235+mapResponseHeaders f (ResponseFile s h b1 b2) = ResponseFile s (f h) b1 b2
236+mapResponseHeaders f (ResponseBuilder s h b) = ResponseBuilder s (f h) b
237+mapResponseHeaders f (ResponseStream s h b) = ResponseStream s (f h) b
238+mapResponseHeaders _ r@(ResponseRaw _ _) = r
239+
228240----------------------------------------------------------------
229241
230242-- | The WAI application.
@@ -242,21 +254,6 @@ responseToStream (ResponseRaw _ res) = responseToStream res
242254-- @
243255type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
244256
245−-- | Middleware is a component that sits between the server and application. It
246−-- can do such tasks as GZIP encoding or response caching. What follows is the
247−-- general definition of middleware, though a middleware author should feel
248−-- free to modify this.
249−--
250−-- As an example of an alternate type for middleware, suppose you write a
251−-- function to load up session information. The session information is simply a
252−-- string map \[(String, String)\]. A logical type signature for this middleware
253−-- might be:
254−--
255−-- @ loadSession :: ([(String, String)] -> Application) -> Application @
256−--
257−-- Here, instead of taking a standard 'Application' as its first argument, the
258−-- middleware takes a function which consumes the session information as well.
259−type Middleware = Application -> Application
260257
261258-- | A default, blank request.
262259--
@@ -279,6 +276,36 @@ defaultRequest = Request
279276 , requestHeaderRange = Nothing
280277 }
281278
279+
280+-- | Middleware is a component that sits between the server and application. It
281+-- can do such tasks as GZIP encoding or response caching. What follows is the
282+-- general definition of middleware, though a middleware author should feel
283+-- free to modify this.
284+--
285+-- As an example of an alternate type for middleware, suppose you write a
286+-- function to load up session information. The session information is simply a
287+-- string map \[(String, String)\]. A logical type signature for this middleware
288+-- might be:
289+--
290+-- @ loadSession :: ([(String, String)] -> Application) -> Application @
291+--
292+-- Here, instead of taking a standard 'Application' as its first argument, the
293+-- middleware takes a function which consumes the session information as well.
294+type Middleware = Application -> Application
295+
296+
297+-- | apply a function that modifies a response as a 'Middleware'
298+modifyResponse :: (Response -> Response) -> Middleware
299+modifyResponse f app req respond = app req $ respond . f
300+
301+
302+-- | conditionally apply a 'Middleware'
303+ifRequest :: (Request -> Bool) -> Middleware -> Middleware
304+ifRequest rpred middle app req | rpred req = middle app req
305+ | otherwise = app req
306+
307+
308+
282309-- | Get the request body as a lazy ByteString. However, do /not/ use any lazy
283310-- I\/O, instead reading the entire body into memory strictly.
284311--
wai/wai.cabal+1−1
@@ -1,5 +1,5 @@
11Name: wai
2−Version: 3.0.2.3
2+Version: 3.0.3.0
33Synopsis: Web Application Interface.
44Description: Provides a common protocol for communication between web applications and web servers.
55description: API docs and the README are available at <http://www.stackage.org/package/wai>.