haskell/minio-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make minio-hs build with lts-8.5 (#33)

Browse Source
This commit is contained in:
Krishnan Parthasarathi 2017-03-17 14:53:24 +05:30 committed by Aditya Manthramurthy
parent aba4053965
commit 3d6d2d5d61
2 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Network/Minio/Utils.hs
View File

@ -24,14 +24,13 @@ import Control.Monad.Trans.Control (liftBaseOp_, StM)
import qualified Control.Monad.Trans.Resource as R import qualified Control.Monad.Trans.Resource as R
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.Conduit as C import qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.Binary as CB
import Data.Default (Default(..))
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
import Data.Text.Read (decimal) import Data.Text.Read (decimal)
import Data.Time import Data.Time
import qualified Network.HTTP.Client as NClient
import Network.HTTP.Conduit (Response) import Network.HTTP.Conduit (Response)
import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Conduit as NC
import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types as HT
@ -40,7 +39,6 @@ import qualified System.IO as IO
import Lib.Prelude import Lib.Prelude
import Network.Minio.Errors
import Network.Minio.XmlParser (parseErrResponse) import Network.Minio.XmlParser (parseErrResponse)
allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m, MonadCatch m) allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m, MonadCatch m)
@ -119,7 +117,7 @@ httpLbs :: (R.MonadThrow m, MonadIO m)
=> NC.Request -> NC.Manager => NC.Request -> NC.Manager
-> m (NC.Response LByteString) -> m (NC.Response LByteString)
httpLbs req mgr = do httpLbs req mgr = do
respE <- liftIO $ tryHttpEx $ (NClient.httpLbs req mgr) respE <- liftIO $ tryHttpEx $ (NC.httpLbs req mgr)
resp <- either throwM return respE resp <- either throwM return respE
unless (isSuccessStatus $ NC.responseStatus resp) $ unless (isSuccessStatus $ NC.responseStatus resp) $
case contentTypeMay resp of case contentTypeMay resp of
@ -127,14 +125,16 @@ httpLbs req mgr = do
sErr <- parseErrResponse $ NC.responseBody resp sErr <- parseErrResponse $ NC.responseBody resp
throwM sErr throwM sErr
_ -> throwM $ NC.StatusCodeException (NC.responseStatus resp) [] def _ -> throwM $ NC.HttpExceptionRequest req $
NC.StatusCodeException (const () <$> resp) (show resp)
return resp return resp
where where
tryHttpEx :: (IO (NC.Response LByteString)) tryHttpEx :: (IO (NC.Response LByteString))
-> IO (Either NC.HttpException (NC.Response LByteString)) -> IO (Either NC.HttpException (NC.Response LByteString))
tryHttpEx = try tryHttpEx = try
contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp contentTypeMay resp = lookupHeader Hdr.hContentType $
NC.responseHeaders resp
http :: (R.MonadResourceBase m, R.MonadResource m) http :: (R.MonadResourceBase m, R.MonadResource m)
=> NC.Request -> NC.Manager => NC.Request -> NC.Manager
@ -149,12 +149,16 @@ http req mgr = do
sErr <- parseErrResponse $ respBody sErr <- parseErrResponse $ respBody
throwM sErr throwM sErr
_ -> throwM $ NC.StatusCodeException (NC.responseStatus resp) [] def _ -> do
content <- LB.toStrict . NC.responseBody <$> NC.lbsResponse resp
throwM $ NC.HttpExceptionRequest req $
NC.StatusCodeException (const () <$> resp) $ content
return resp return resp
where where
tryHttpEx :: (R.MonadResourceBase m) => (m a) tryHttpEx :: (R.MonadResourceBase m) => (m a)
-> m (Either MinioErr a) -> m (Either NC.HttpException a)
tryHttpEx = ExL.try tryHttpEx = ExL.try
contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp contentTypeMay resp = lookupHeader Hdr.hContentType $ NC.responseHeaders resp

2
stack.yaml
View File

@ -15,7 +15,7 @@
# resolver: # resolver:
# name: custom-snapshot # name: custom-snapshot
# location: "./custom-snapshot.yaml" # location: "./custom-snapshot.yaml"
resolver: lts-6.27 resolver: lts-8.5
# User packages to be built. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.