From a7e70b9031e5c1c9d03c316411f762b833d72135 Mon Sep 17 00:00:00 2001 From: Aditya Manthramurthy Date: Tue, 10 Jan 2017 01:43:01 +0530 Subject: [PATCH] Refactor error handling and fix most warnings --- src/Network/Minio.hs | 2 +- src/Network/Minio/API.hs | 17 +++++++++++++++-- src/Network/Minio/Data.hs | 15 +++++++-------- src/Network/Minio/S3API.hs | 26 ++++---------------------- 4 files changed, 27 insertions(+), 33 deletions(-) diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index 7cc1065..9bf570f 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -25,7 +25,7 @@ import System.FilePath import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB -import Lib.Prelude +-- import Lib.Prelude import Network.Minio.Data import Network.Minio.S3API diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 394d82e..acfdc44 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -13,6 +13,7 @@ import qualified Network.HTTP.Types as HT import Network.HTTP.Conduit (Response) import qualified Network.HTTP.Conduit as NC import Network.HTTP.Types (Method, Header, Query) +import qualified Data.ByteString.Lazy as LBS import Lib.Prelude @@ -59,19 +60,31 @@ buildRequest ri = do , NC.requestBody = NC.RequestBodyBS pload } +isFailureStatus :: Response body -> Bool +isFailureStatus resp = let s = HT.statusCode (NC.responseStatus resp) + in not (s >= 200 && s < 300) + executeRequest :: RequestInfo -> Minio (Response LByteString) executeRequest ri = do req <- buildRequest ri mgr <- asks mcConnManager - NC.httpLbs req mgr + resp <- NC.httpLbs req mgr + if (isFailureStatus resp) + then throwError $ MErrService $ LBS.toStrict $ NC.responseBody resp + else return resp + mkStreamRequest :: RequestInfo -> Minio (Response (C.ResumableSource Minio ByteString)) mkStreamRequest ri = do req <- buildRequest ri mgr <- asks mcConnManager + resp <- NC.http req mgr + if (isFailureStatus resp) + then do errResp <- NC.lbsResponse resp + throwError $ MErrService $ LBS.toStrict $ NC.responseBody errResp + else return resp - NC.http req mgr requestInfo :: Method -> Maybe Bucket -> Maybe Object -> Query -> [Header] -> Payload diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index 258db35..f53c356 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -15,18 +15,16 @@ module Network.Minio.Data , runMinio , defaultConnectInfo , connect - , Payload(..) + , Payload , s3Name ) where import qualified Data.ByteString as B -import qualified Data.Conduit as C import Network.HTTP.Client (defaultManagerSettings, HttpException) -import Network.HTTP.Types (Method, Header, Query, Status) +import Network.HTTP.Types (Method, Header, Query) import qualified Network.HTTP.Conduit as NC -import Control.Monad.Trans.Class (MonadTrans(..)) -import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT, ResIO) +import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT) import Control.Monad.Base (MonadBase(..)) import Text.XML @@ -79,9 +77,10 @@ getPathFromRI ri = B.concat $ parts getRegionFromRI :: RequestInfo -> Text getRegionFromRI ri = maybe "us-east-1" identity (riRegion ri) -data MinioErr = MErrMsg ByteString - | MErrHttp HttpException - | MErrXml ByteString +data MinioErr = MErrMsg ByteString -- generic + | MErrHttp HttpException -- http exceptions + | MErrXml ByteString -- XML parsing/generation errors + | MErrService ByteString -- error response from service deriving (Show) newtype Minio a = Minio { diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index c83ae9d..d0733a6 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -13,16 +13,12 @@ import qualified Data.Conduit as C import Lib.Prelude -import qualified Data.ByteString.Lazy as LBS import Network.Minio.Data import Network.Minio.API import Network.Minio.XmlParser import Network.Minio.XmlGenerator -status204 :: HT.Status -status204 = HT.Status{ HT.statusCode = 204, HT.statusMessage = "No Content" } - getService :: Minio [BucketInfo] getService = do resp <- executeRequest $ @@ -40,37 +36,23 @@ getObject :: Bucket -> Object -> HT.Query -> [HT.Header] -> Minio ([HT.Header], C.ResumableSource Minio ByteString) getObject bucket object queryParams headers = do resp <- mkStreamRequest reqInfo - let httpStatusCode = HT.statusCode $ NC.responseStatus resp - if httpStatusCode >= 200 && httpStatusCode < 300 - then return $ (NC.responseHeaders resp, NC.responseBody resp) - else do errMsg <- NC.lbsResponse resp - throwError $ MErrXml $ LBS.toStrict $ NC.responseBody errMsg + return $ (NC.responseHeaders resp, NC.responseBody resp) where reqInfo = requestInfo HT.methodGet (Just bucket) (Just object) queryParams headers Nothing putBucket :: Bucket -> Location -> Minio () putBucket bucket location = do - resp <- executeRequest $ + void $ executeRequest $ requestInfo HT.methodPut (Just bucket) Nothing [] [] $ Just $ mkCreateBucketConfig bucket location - let httpStatus = NC.responseStatus resp - when (httpStatus /= HT.ok200) $ - throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp - deleteBucket :: Bucket -> Minio () deleteBucket bucket = do - resp <- executeRequest $ + void $ executeRequest $ requestInfo HT.methodDelete (Just bucket) Nothing [] [] Nothing - let httpStatus = NC.responseStatus resp - when (httpStatus /= status204) $ - throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp deleteObject :: Bucket -> Object -> Minio () deleteObject bucket object = do - resp <- executeRequest $ + void $ executeRequest $ requestInfo HT.methodDelete (Just bucket) (Just object) [] [] Nothing - let httpStatus = NC.responseStatus resp - when (httpStatus /= status204) $ - throwError $ MErrXml $ LBS.toStrict $ NC.responseBody resp