Skip to content

Commit 1aeee3e

Browse files
committed
Remove memoReqBody.
1 parent b9fb80a commit 1aeee3e

File tree

2 files changed

+2
-28
lines changed

2 files changed

+2
-28
lines changed

servant-server/src/Servant/Server/Internal.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -158,7 +158,7 @@ methodCheck method request
158158
acceptCheck :: (AllMime list) => Proxy list -> B.ByteString -> IO (RouteResult ())
159159
acceptCheck proxy accH
160160
| canHandleAcceptH proxy (AcceptHeader accH) = return $ Route ()
161-
| otherwise = return $ Fail err406
161+
| otherwise = return $ FailFatal err406
162162

163163
methodRouter :: (AllCTRender ctypes a)
164164
=> Method -> Proxy ctypes -> Status

servant-server/src/Servant/Server/Internal/RoutingApplication.hs

Lines changed: 1 addition & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -33,34 +33,8 @@ data RouteResult a =
3333
| Route !a
3434
deriving (Eq, Show, Read, Functor)
3535

36-
data ReqBodyState = Uncalled
37-
| Called !B.ByteString
38-
| Done !B.ByteString
39-
4036
toApplication :: RoutingApplication -> Application
41-
toApplication ra request respond = do
42-
reqBodyRef <- newIORef Uncalled
43-
-- We may need to consume the requestBody more than once. In order to
44-
-- maintain the illusion that 'requestBody' works as expected,
45-
-- 'ReqBodyState' is introduced, and the complete body is memoized and
46-
-- returned as many times as requested with empty "Done" marker chunks in
47-
-- between.
48-
-- See https://github.com/haskell-servant/servant/issues/3
49-
let memoReqBody = do
50-
ior <- readIORef reqBodyRef
51-
case ior of
52-
Uncalled -> do
53-
r <- BL.toStrict <$> strictRequestBody request
54-
writeIORef reqBodyRef $ Done r
55-
return r
56-
Called bs -> do
57-
writeIORef reqBodyRef $ Done bs
58-
return bs
59-
Done bs -> do
60-
writeIORef reqBodyRef $ Called bs
61-
return B.empty
62-
63-
ra request{ requestBody = memoReqBody } routingRespond
37+
toApplication ra request respond = ra request routingRespond
6438
where
6539
routingRespond :: RouteResult Response -> IO ResponseReceived
6640
routingRespond (Fail err) = respond $ responseServantErr err

0 commit comments

Comments
 (0)