@@ -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−
4036toApplication :: 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