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

Update servant-server

Browse source
This commit is contained in:
Nickolay Kudasov 2016-01-20 02:46:17 +03:00 • committed by Julian K. Arni
parent 372a6c7753
commit 10da6fd454
2 changed files with 6 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -22,6 +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 (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
@ -42,6 +43,7 @@ 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,
@ -443,8 +445,9 @@ 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
mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH) lbody <- lazyRequestBody request
<$> liftIO (lazyRequestBody request) mrqbody <- traverse (liftIO . unsafeInterleaveIO . runExceptT) $
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 (Left e) -> delayedFailFatal err400 { errBody = cs e }

2
servant-server/test/Servant/Server/ErrorSpec.hs
View file

@ -266,7 +266,7 @@ errorChoiceSpec = describe "Multiple handlers return errors"
-- * Instances {{{ -- * Instances {{{
instance MimeUnrender PlainText Int where instance MimeUnrender PlainText Int where
mimeUnrender _ x = maybe (Left "no parse") Right (readMay $ BCL.unpack x) mimeUnrender _ x = maybe (throwE "no parse") return (readMay $ BCL.unpack x)
instance MimeRender PlainText Int where instance MimeRender PlainText Int where
mimeRender _ = BCL.pack . show mimeRender _ = BCL.pack . show