git.iko.soy/servant
on master help sign in
Cycle through ByteString.
ecb1da0Julian K. Arni
src/Servant/Server/Internal.hs+22−6
compare with master
unifiedsplit
@@ -10,8 +10,10 @@ 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 qualified Data.ByteString as B
14+import qualified Data.ByteString.Lazy as BL
13import Data.IORef
15import Data.IORef
14−import Data.Maybe (catMaybes, fromMaybe)
16+import Data.Maybe (catMaybes)
15import Data.Monoid
17import Data.Monoid
16import Data.Proxy
18import Data.Proxy
17import Data.String
19import Data.String
@@ -24,13 +26,27 @@ import Network.Wai
24import Servant.API
26import Servant.API
25import Servant.Common.Text
27import Servant.Common.Text
26
28
29+data ReqBodyState = Uncalled
30+ | Called B.ByteString
31+ | Done B.ByteString
32+
27toApplication :: RoutingApplication -> Application
33toApplication :: RoutingApplication -> Application
28toApplication ra request respond = do
34toApplication ra request respond = do
29− reqBodyRef <- newIORef Nothing
35+ reqBodyRef <- newIORef Uncalled
30− let memoReqBody = fromMaybe <$> (do
36+ let memoReqBody = do
31− r <- requestBody request
37+ ior <- readIORef reqBodyRef
38+ case ior of
39+ Uncalled -> do
40+ r <- BL.toStrict <$> strictRequestBody request
32− writeIORef reqBodyRef $ Just r
41+ writeIORef reqBodyRef $ Done r
33− return r ) <*> readIORef reqBodyRef
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+
34 ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
50 ra request{ requestBody = memoReqBody } (routingRespond . routeResult)
35 where
51 where
36 routingRespond :: Either RouteMismatch Response -> IO ResponseReceived
52 routingRespond :: Either RouteMismatch Response -> IO ResponseReceived