Update IO content-type unrendering.
We no longer need to use unsafeInterleaveIO.
This commit is contained in:
parent
10da6fd454
commit
9d9091f8e9
1 changed files with 9 additions and 8 deletions
|
@ -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
|
||||
Nothing -> delayedFailFatal err415
|
||||
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@.
|
||||
|
|
Loading…
Reference in a new issue