@@ -10,13 +10,14 @@ module Servant.Server.Internal where
1010import Control.Applicative
1111import Control.Monad.Trans.Either
1212import Data.Aeson
13−import Data.Maybe (catMaybes)
13+import Data.IORef
14+import Data.Maybe (catMaybes, fromMaybe)
1415import Data.Monoid
1516import Data.Proxy
1617import Data.String
1718import Data.String.Conversions
18−import Data.Text (Text)
1919import Data.Text.Encoding (decodeUtf8)
20+import Data.Text (Text)
2021import GHC.TypeLits
2122import Network.HTTP.Types hiding (Header)
2223import Network.Wai
@@ -25,7 +26,12 @@ import Servant.Common.Text
2526
2627toApplication :: RoutingApplication -> Application
2728toApplication ra request respond = do
28− ra request (routingRespond . routeResult)
29+ reqBodyRef <- newIORef Nothing
30+ let memoReqBody = fromMaybe <$> (do
31+ r <- requestBody request
32+ writeIORef reqBodyRef $ Just r
33+ return r ) <*> readIORef reqBodyRef
34+ ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
2935 where
3036 routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
3137 routingRespond (Left NotFound) =
@@ -44,7 +50,7 @@ data RouteMismatch =
4450 | InvalidBody -- ^ an even more informative "your json request body wasn't valid" error
4551 deriving (Eq, Show)
4652
47−-- |
53+-- |
4854-- @
4955-- > mempty = NotFound
5056-- >