eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Update IO content-type unrendering.

Browse source 
We no longer need to use unsafeInterleaveIO.
This commit is contained in:
Julian K. Arni 2016-08-17 14:36:24 -03:00
parent 10da6fd454
commit 9d9091f8e9
1 changed files with 9 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
servant-server/src/Servant/Server/Internal.hs
View file

@ -22,7 +22,7 @@ module Servant.Server.Internal
, module Servant.Server.Internal.ServantErr , module Servant.Server.Internal.ServantErr
) where ) where
import Control.Monad.Trans.Except (ExceptT, runExceptT) import Control.Monad.Trans.Except (runExceptT)
import Control.Monad.Trans (liftIO) import Control.Monad.Trans (liftIO)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Char8 as BC8
@ -43,7 +43,6 @@ import Network.Wai (Application, Request, Response,
responseLBS, vault) responseLBS, vault)
import Prelude () import Prelude ()
import Prelude.Compat import Prelude.Compat
import System.IO.Unsafe (unsafeInterleaveIO)
import Web.HttpApiData (FromHttpApiData) import Web.HttpApiData (FromHttpApiData)
import Web.HttpApiData.Internal (parseHeaderMaybe, import Web.HttpApiData.Internal (parseHeaderMaybe,
parseQueryParamMaybe, parseQueryParamMaybe,
@ -445,13 +444,15 @@ instance ( AllCTUnrender list a, HasServer api context
-- http://www.w3.org/2001/tag/2002/0129-mime -- http://www.w3.org/2001/tag/2002/0129-mime
let contentTypeH = fromMaybe "application/octet-stream" let contentTypeH = fromMaybe "application/octet-stream"
$ lookup hContentType $ requestHeaders request $ lookup hContentType $ requestHeaders request
lbody <- lazyRequestBody request lbody <- liftIO $ lazyRequestBody request
mrqbody <- traverse (liftIO . unsafeInterleaveIO . runExceptT) $ let mrqbody = handleCTypeH (Proxy :: Proxy list) (cs contentTypeH) lbody
handleCTypeH (Proxy :: Proxy list) (cs contentTypeH) lbody
case mrqbody of case mrqbody of
Nothing -> delayedFailFatal err415 Nothing -> delayedFailFatal err415
Just (Left e) -> delayedFailFatal err400 { errBody = cs e } Just run -> do
Just (Right v) -> return v val <- liftIO $ runExceptT run
case val of
Left e -> delayedFailFatal err400 { errBody = cs e }
Right v -> return v
-- | Make sure the incoming request starts with @"/path"@, strip it and -- | Make sure the incoming request starts with @"/path"@, strip it and
-- pass the rest of the request path to @api@. -- pass the rest of the request path to @api@.