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

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

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