@@ -10,8 +10,10 @@ module Servant.Server.Internal where
1010import Control.Applicative
1111import Control.Monad.Trans.Either
1212import Data.Aeson
13+import qualified Data.ByteString as B
14+import qualified Data.ByteString.Lazy as BL
1315import Data.IORef
14−import Data.Maybe (catMaybes, fromMaybe)
16+import Data.Maybe (catMaybes)
1517import Data.Monoid
1618import Data.Proxy
1719import Data.String
@@ -24,13 +26,27 @@ import Network.Wai
2426import Servant.API
2527import Servant.Common.Text
2628
29+data ReqBodyState = Uncalled
30+ | Called B.ByteString
31+ | Done B.ByteString
32+
2733toApplication :: RoutingApplication -> Application
2834toApplication ra request respond = do
29− reqBodyRef <- newIORef Nothing
30− let memoReqBody = fromMaybe <$> (do
31− r <- requestBody request
32− writeIORef reqBodyRef $ Just r
33− return r ) <*> readIORef reqBodyRef
35+ reqBodyRef <- newIORef Uncalled
36+ let memoReqBody = do
37+ ior <- readIORef reqBodyRef
38+ case ior of
39+ Uncalled -> do
40+ r <- BL.toStrict <$> strictRequestBody request
41+ writeIORef reqBodyRef $ Done r
42+ return r
43+ Called bs -> do
44+ writeIORef reqBodyRef $ Done bs
45+ return bs
46+ Done bs -> do
47+ writeIORef reqBodyRef $ Called bs
48+ return B.empty
49+
3450 ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
3551 where
3652 routingRespond :: Either RouteMismatch Response -> IO ResponseReceived