37a7f50 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

move helpers into wai

37a7f50Greg Weber11 years ago

wai-extra/Network/Wai/Middleware/AddHeaders.hs+3−13

compare with master

unifiedsplit

@@ -3,11 +3,10 @@

3-- Since 3.0.3

4module Network.Wai.Middleware.AddHeaders

5 ( addHeaders

6− , mapResponseHeader

7 ) where

6 ) where

9import Network.HTTP.Types (ResponseHeaders, Header)

8import Network.HTTP.Types (ResponseHeaders, Header)

10−import Network.Wai (Middleware)

9+import Network.Wai (Middleware, modifyResponse, mapResponseHeaders)

11import Network.Wai.Internal (Response(..))

10import Network.Wai.Internal (Response(..))

12import Data.ByteString (ByteString)

11import Data.ByteString (ByteString)

@@ -19,16 +18,7 @@ addHeaders :: [(ByteString, ByteString)] -> Middleware

19--

18--

20-- Since 3.0.3

19-- Since 3.0.3

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)

24addHeaders' :: [Header] -> Response -> Response

23addHeaders' :: [Header] -> Response -> Response

25−addHeaders' h = mapResponseHeader (\hs -> h ++ hs)

24+addHeaders' h = mapResponseHeaders (\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−

wai-extra/Network/Wai/Middleware/StripHeaders.hs+3−11

@@ -14,27 +14,19 @@ module Network.Wai.Middleware.StripHeaders

14 , stripHeadersIf

15 ) where

17−import Network.Wai (Middleware, Request)

17+import Network.Wai (Middleware, Request, modifyResponse, mapResponseHeaders, ifRequest)

18import Network.Wai.Internal (Response)

19import Data.ByteString (ByteString)

20−import Network.Wai.Middleware.AddHeaders (mapResponseHeader)

22import qualified Data.CaseInsensitive as CI

21import qualified Data.CaseInsensitive as CI

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−

31stripHeader :: ByteString -> (Response -> Response)

23stripHeader :: 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))

34stripHeaders :: [ByteString] -> (Response -> Response)

26stripHeaders :: [ByteString] -> (Response -> Response)

35stripHeaders hs =

27stripHeaders hs =

36 let hnames = map CI.mk hs

28 let hnames = map CI.mk hs

37− in mapResponseHeader (filter (\ hdr -> fst hdr `notElem` hnames))

29+ in mapResponseHeaders (filter (\ hdr -> fst hdr `notElem` hnames))

39-- | If the request satisifes the provided predicate, strip headers matching

31-- | If the request satisifes the provided predicate, strip headers matching

40-- the provided header name.

32-- the provided header name.

wai-extra/test/Network/Wai/Middleware/StripHeadersSpec.hs+4−4

@@ -30,8 +30,8 @@ spec = describe "stripHeader" $ do

31 it "strips a specific header" $ do

32 resp1 <- runApp host (addHeaders testHeaders) defaultRequest

33− resp2 <- runApp host (stripHeader "Foo" (const False) . addHeaders testHeaders) defaultRequest

33+ resp2 <- runApp host (stripHeaderIf "Foo" (const False) . addHeaders testHeaders) defaultRequest

34− resp3 <- runApp host (stripHeader "Foo" (const True) . addHeaders testHeaders) defaultRequest

34+ resp3 <- runApp host (stripHeaderIf "Foo" (const True) . addHeaders testHeaders) defaultRequest

36 simpleHeaders resp1 `shouldBe` ciTestHeaders

37 simpleHeaders resp2 `shouldBe` ciTestHeaders

@@ -39,8 +39,8 @@ spec = describe "stripHeader" $ do

40 it "strips specific set of headers" $ do

41 resp1 <- runApp host (addHeaders testHeaders) defaultRequest

42− resp2 <- runApp host (stripHeaders ["Bar", "Foo"] (const False) . addHeaders testHeaders) defaultRequest

42+ resp2 <- runApp host (stripHeadersIf ["Bar", "Foo"] (const False) . addHeaders testHeaders) defaultRequest

43− resp3 <- runApp host (stripHeaders ["Bar", "Foo"] (const True) . addHeaders testHeaders) defaultRequest

43+ resp3 <- runApp host (stripHeadersIf ["Bar", "Foo"] (const True) . addHeaders testHeaders) defaultRequest

45 simpleHeaders resp1 `shouldBe` ciTestHeaders

46 simpleHeaders resp2 `shouldBe` ciTestHeaders

wai-extra/wai-extra.cabal+2−2

@@ -1,5 +1,5 @@

1Name: wai-extra

2−Version: 3.0.7.1

2+Version: 3.0.8.0

3Synopsis: Provides some basic WAI handlers and middleware.

4description:

5 Provides basic WAI handler and middleware functionality:

@@ -84,7 +84,7 @@ extra-source-files:

84Library

85 Build-Depends: base >= 4 && < 5

86 , bytestring >= 0.9.1.4

87− , wai >= 3.0 && < 3.1

87+ , wai >= 3.0.3.0 && < 3.1

88 , old-locale >= 1.0.0.2 && < 1.1

89 , time >= 1.1.4

90 , network >= 2.2.1.5

wai/Network/Wai.hs+43−16

@@ -71,10 +71,15 @@ module Network.Wai

71 , responseLBS

72 , responseStream

73 , responseRaw

74− -- * Response accessors

74+ -- ** Response accessors

75 , responseStatus

76 , responseHeaders

77+ -- ** Response modifiers

77 , responseToStream

78 , responseToStream

79+ , mapResponseHeaders

80+ -- * Middleware composition

81+ , ifRequest

82+ , modifyResponse

78 ) where

83 ) where

80import Blaze.ByteString.Builder (Builder, fromLazyByteString)

85import Blaze.ByteString.Builder (Builder, fromLazyByteString)

@@ -225,6 +230,13 @@ responseToStream (ResponseBuilder s h b) =

225 (s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b)

230 (s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b)

226responseToStream (ResponseRaw _ res) = responseToStream res

231responseToStream (ResponseRaw _ res) = responseToStream res

227

232

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+

228----------------------------------------------------------------

240----------------------------------------------------------------

229

241

230-- | The WAI application.

242-- | The WAI application.

@@ -242,21 +254,6 @@ responseToStream (ResponseRaw _ res) = responseToStream res

242-- @

254-- @

243type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

255type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

244

256

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

260

257

261-- | A default, blank request.

258-- | A default, blank request.

262--

259--

@@ -279,6 +276,36 @@ defaultRequest = Request

279 , requestHeaderRange = Nothing

276 , requestHeaderRange = Nothing

280 }

277 }

281

278

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+

282-- | Get the request body as a lazy ByteString. However, do /not/ use any lazy

309-- | Get the request body as a lazy ByteString. However, do /not/ use any lazy

283-- I\/O, instead reading the entire body into memory strictly.

310-- I\/O, instead reading the entire body into memory strictly.

284--

311--

wai/wai.cabal+1−1

@@ -1,5 +1,5 @@

1Name: wai

2−Version: 3.0.2.3

2+Version: 3.0.3.0

3Synopsis: Web Application Interface.

4Description: Provides a common protocol for communication between web applications and web servers.

5description: API docs and the README are available at <http://www.stackage.org/package/wai>.