on master help sign in
Wai.Test.request: fix swalling body
ef79e28Matthias Heinzel
wai-extra/Network/Wai/Test.hs+16−14
@@ -106,8 +106,16 @@ data SResponse = SResponse
106 , simpleBody :: L.ByteString
106 , simpleBody :: L.ByteString
107 }
107 }
108 deriving (Show, Eq)
108 deriving (Show, Eq)
109+
109request :: Request -> Session SResponse
110request :: Request -> Session SResponse
110−request = srequest . flip SRequest L.empty
111+request req = do
112+ app <- ask
113+ req' <- addCookiesToRequest req
114+ response <- liftIO $ do
115+ ref <- newIORef $ error "runResponse gave no result"
116+ ResponseReceived <- app req' (runResponse ref)
117+ readIORef ref
118+ extractSetCookieFromSResponse response
111
119
112-- | Set whole path (request path + query string).
120-- | Set whole path (request path + query string).
113setPath :: Request -> S8.ByteString -> Request
121setPath :: Request -> S8.ByteString -> Request
@@ -168,20 +176,14 @@ extractSetCookieFromSResponse response = do
168
176
169srequest :: SRequest -> Session SResponse
177srequest :: SRequest -> Session SResponse
170srequest (SRequest req bod) = do
178srequest (SRequest req bod) = do
171− app <- ask
172 refChunks <- liftIO $ newIORef $ L.toChunks bod
179 refChunks <- liftIO $ newIORef $ L.toChunks bod
180+ request $
173− let req' = req
181+ req
174− { requestBody = atomicModifyIORef refChunks $ \bss ->
182+ { requestBody = atomicModifyIORef refChunks $ \bss ->
175− case bss of
183+ case bss of
176− [] -> ([], S.empty)
184+ [] -> ([], S.empty)
177− x:y -> (y, x)
185+ x:y -> (y, x)
178− }
186+ }
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
187
186runResponse :: IORef SResponse -> Response -> IO ResponseReceived
188runResponse :: IORef SResponse -> Response -> IO ResponseReceived
187runResponse ref res = do
189runResponse ref res = do