@@ -10,13 +10,14 @@ module Servant.Server.Internal where
10import Control.Applicative
10import Control.Applicative
11import Control.Monad.Trans.Either
11import Control.Monad.Trans.Either
12import Data.Aeson
12import Data.Aeson
13−import Data.Maybe (catMaybes)
13+import Data.IORef
14+import Data.Maybe (catMaybes, fromMaybe)
14import Data.Monoid
15import Data.Monoid
15import Data.Proxy
16import Data.Proxy
16import Data.String
17import Data.String
17import Data.String.Conversions
18import Data.String.Conversions
18−import Data.Text (Text)
19import Data.Text.Encoding (decodeUtf8)
19import Data.Text.Encoding (decodeUtf8)
20+import Data.Text (Text)
20import GHC.TypeLits
21import GHC.TypeLits
21import Network.HTTP.Types hiding (Header)
22import Network.HTTP.Types hiding (Header)
22import Network.Wai
23import Network.Wai
@@ -25,7 +26,12 @@ import Servant.Common.Text
26toApplication :: RoutingApplication -> Application
27toApplication :: RoutingApplication -> Application
27toApplication ra request respond = do
28toApplication 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
28− ra request (routingRespond . routeResult)
34+ ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
30 routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
36 routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
31 routingRespond (Left NotFound) =
37 routingRespond (Left NotFound) =
@@ -44,7 +50,7 @@ data RouteMismatch =
44 | InvalidBody -- ^ an even more informative "your json request body wasn't valid" error
50 | InvalidBody -- ^ an even more informative "your json request body wasn't valid" error
45 deriving (Eq, Show)
51 deriving (Eq, Show)
49-- > mempty = NotFound
55-- > mempty = NotFound