git.iko.soy/typeable/wai
on master help sign in
Merge pull request #794 from mheinzel/fix/request-swallows-body
e083f6eMichael Snoyman
wai-extra/ChangeLog.md+4
unifiedsplit
@@ -1,5 +1,9 @@
1# Changelog for wai-extra
1# Changelog for wai-extra
2
2
3+## 3.0.29.1
4+
5+* Fix `Network.Wai.Test.request` always sending an empty request body [#794](https://github.com/yesodweb/wai/pull/794)
6+
3## 3.0.29
7## 3.0.29
4
8
5* Export `Network.Wai.EventSource.eventStreamAppRaw` [#786](https://github.com/yesodweb/wai/pull/786)
9* Export `Network.Wai.EventSource.eventStreamAppRaw` [#786](https://github.com/yesodweb/wai/pull/786)
wai-extra/Network/Wai/Test.hs+22−14
@@ -99,6 +99,10 @@ runSession session app = ST.evalStateT (runReaderT session app) initState
99data SRequest = SRequest
99data SRequest = SRequest
100 { simpleRequest :: Request
100 { simpleRequest :: Request
101 , simpleRequestBody :: L.ByteString
101 , simpleRequestBody :: L.ByteString
102+ -- ^ Request body that will override the one set in 'simpleRequest'.
103+ --
104+ -- This is usually simpler than setting the body as a stateful IO-action
105+ -- in 'simpleRequest'.
102 }
106 }
103data SResponse = SResponse
107data SResponse = SResponse
104 { simpleStatus :: H.Status
108 { simpleStatus :: H.Status
@@ -106,8 +110,16 @@ data SResponse = SResponse
106 , simpleBody :: L.ByteString
110 , simpleBody :: L.ByteString
107 }
111 }
108 deriving (Show, Eq)
112 deriving (Show, Eq)
113+
109request :: Request -> Session SResponse
114request :: Request -> Session SResponse
110−request = srequest . flip SRequest L.empty
115+request req = do
116+ app <- ask
117+ req' <- addCookiesToRequest req
118+ response <- liftIO $ do
119+ ref <- newIORef $ error "runResponse gave no result"
120+ ResponseReceived <- app req' (runResponse ref)
121+ readIORef ref
122+ extractSetCookieFromSResponse response
111
123
112-- | Set whole path (request path + query string).
124-- | Set whole path (request path + query string).
113setPath :: Request -> S8.ByteString -> Request
125setPath :: Request -> S8.ByteString -> Request
@@ -166,22 +178,18 @@ extractSetCookieFromSResponse response = do
166 (Map.fromList [(Cookie.setCookieName c, c) | c <- newClientCookies ]))
178 (Map.fromList [(Cookie.setCookieName c, c) | c <- newClientCookies ]))
167 return response
179 return response
168
180
181+-- | Similar to 'request', but allows setting the request body as a plain
182+-- 'L.ByteString'.
169srequest :: SRequest -> Session SResponse
183srequest :: SRequest -> Session SResponse
170srequest (SRequest req bod) = do
184srequest (SRequest req bod) = do
171− app <- ask
172 refChunks <- liftIO $ newIORef $ L.toChunks bod
185 refChunks <- liftIO $ newIORef $ L.toChunks bod
186+ request $
173− let req' = req
187+ req
174− { requestBody = atomicModifyIORef refChunks $ \bss ->
188+ { requestBody = atomicModifyIORef refChunks $ \bss ->
175− case bss of
189+ case bss of
176− [] -> ([], S.empty)
190+ [] -> ([], S.empty)
177− x:y -> (y, x)
191+ x:y -> (y, x)
178− }
192+ }
179− req'' <- addCookiesToRequest req'
180− response <- liftIO $ do
181− ref <- newIORef $ error "runResponse gave no result"
182− ResponseReceived <- app req'' (runResponse ref)
183− readIORef ref
184− extractSetCookieFromSResponse response
185
193
186runResponse :: IORef SResponse -> Response -> IO ResponseReceived
194runResponse :: IORef SResponse -> Response -> IO ResponseReceived
187runResponse ref res = do
195runResponse ref res = do
wai-extra/test/Network/Wai/TestSpec.hs+41−11
@@ -3,6 +3,8 @@ module Network.Wai.TestSpec (main, spec) where
3
3
4import Control.Monad (void)
4import Control.Monad (void)
5
5
6+import qualified Data.IORef as IORef
7+
6import qualified Data.Text.Encoding as TE
8import qualified Data.Text.Encoding as TE
7
9
8import Data.Time.Calendar (fromGregorian)
10import Data.Time.Calendar (fromGregorian)
@@ -53,25 +55,53 @@ spec = do
53 it "sets rawQueryString to empty string" $ do
55 it "sets rawQueryString to empty string" $ do
54 rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
56 rawQueryString (setPath defaultRequest "/foo/bar/baz") `shouldBe` ""
55
57
58+ describe "srequest" $ do
59+
60+ let echoApp req respond = do
61+ reqBody <- L8.fromStrict <$> getRequestBodyChunk req
62+ let reqHeaders = requestHeaders req
63+ respond $
64+ responseLBS
65+ status200
66+ reqHeaders
67+ reqBody
68+
69+ it "returns the response body of an echo app" $ do
70+ sresp <- flip runSession echoApp $
71+ srequest $ SRequest defaultRequest "request body"
72+ simpleBody sresp `shouldBe` "request body"
73+
56 describe "request" $ do
74 describe "request" $ do
57
75
58− let simpleApp _req respond =
76+ let echoApp req respond = do
77+ reqBody <- L8.fromStrict <$> getRequestBodyChunk req
78+ let reqHeaders = requestHeaders req
59 respond $
79 respond $
60 responseLBS
80 responseLBS
61 status200
81 status200
62− [("foo", "bar")]
82+ reqHeaders
63− "simple"
83+ reqBody
64
84
65− it "returns the status code of a simple app on default request" $ do
85+ it "returns the status code of an echo app on default request" $ do
66− sresp <- runSession (request defaultRequest) simpleApp
86+ sresp <- runSession (request defaultRequest) echoApp
67 simpleStatus sresp `shouldBe` status200
87 simpleStatus sresp `shouldBe` status200
68
88
69− it "returns the response body of a simple app on default request" $ do
89+ it "returns the response body of an echo app" $ do
90+ bodyRef <- IORef.newIORef "request body"
91+ let getBodyChunk = IORef.atomicModifyIORef bodyRef $ \leftover -> ("", leftover)
92+ sresp <- flip runSession echoApp $
93+ request $
70− sresp <- runSession (request defaultRequest) simpleApp
94+ defaultRequest
95+ { requestBody = getBodyChunk
96+ }
71− simpleBody sresp `shouldBe` "simple"
97+ simpleBody sresp `shouldBe` "request body"
72−
98+
73− it "returns the response headers of a simple app on default request" $ do
99+ it "returns the response headers of an echo app" $ do
100+ sresp <- flip runSession echoApp $
101+ request $
74− sresp <- runSession (request defaultRequest) simpleApp
102+ defaultRequest
103+ { requestHeaders = [("foo", "bar")]
104+ }
75 simpleHeaders sresp `shouldBe` [("foo", "bar")]
105 simpleHeaders sresp `shouldBe` [("foo", "bar")]
76
106
77 let cookieApp req respond =
107 let cookieApp req respond =
wai-extra/wai-extra.cabal+1−1
@@ -1,5 +1,5 @@
1Name: wai-extra
1Name: wai-extra
2−Version: 3.0.29
2+Version: 3.0.29.1
3Synopsis: Provides some basic WAI handlers and middleware.
3Synopsis: Provides some basic WAI handlers and middleware.
4description:
4description:
5 Provides basic WAI handler and middleware functionality:
5 Provides basic WAI handler and middleware functionality: