From 10da6fd454d6b85f215e33af57328c16435b94c3 Mon Sep 17 00:00:00 2001
From: Nickolay Kudasov <nickolay.kudasov@gmail.com>
Date: Wed, 20 Jan 2016 02:46:17 +0300
Subject: [PATCH] Update servant-server

---
 servant-server/src/Servant/Server/Internal.hs   | 7 +++++--
 servant-server/test/Servant/Server/ErrorSpec.hs | 2 +-
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index de4a237a..bdbe9779 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -22,6 +22,7 @@ module Servant.Server.Internal
   , module Servant.Server.Internal.ServantErr
   ) where
 
+import           Control.Monad.Trans.Except (ExceptT, runExceptT)
 import           Control.Monad.Trans        (liftIO)
 import qualified Data.ByteString            as B
 import qualified Data.ByteString.Char8      as BC8
@@ -42,6 +43,7 @@ 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,
@@ -443,8 +445,9 @@ 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
-        mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
-               <$> liftIO (lazyRequestBody request)
+        lbody <- lazyRequestBody request
+        mrqbody <- traverse (liftIO . unsafeInterleaveIO . runExceptT) $
+          handleCTypeH (Proxy :: Proxy list) (cs contentTypeH) lbody
         case mrqbody of
           Nothing        -> delayedFailFatal err415
           Just (Left e)  -> delayedFailFatal err400 { errBody = cs e }
diff --git a/servant-server/test/Servant/Server/ErrorSpec.hs b/servant-server/test/Servant/Server/ErrorSpec.hs
index 39a71721..bd31943c 100644
--- a/servant-server/test/Servant/Server/ErrorSpec.hs
+++ b/servant-server/test/Servant/Server/ErrorSpec.hs
@@ -266,7 +266,7 @@ errorChoiceSpec = describe "Multiple handlers return errors"
 -- * Instances {{{
 
 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
     mimeRender _ = BCL.pack . show