Refactor error handling and fix most warnings

This commit is contained in:
Aditya Manthramurthy 2017-01-10 01:43:01 +05:30
parent c9f6d666db
commit a7e70b9031
4 changed files with 27 additions and 33 deletions

View File

@ -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

View File

@ -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

View File

@ -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 {

View File

@ -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