diff --git a/minio-hs.cabal b/minio-hs.cabal index 9020244..d0fca26 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -38,6 +38,7 @@ library , containers , cryptonite , cryptonite-conduit + , data-default , filepath , http-client , http-conduit @@ -90,6 +91,7 @@ test-suite minio-hs-test , containers , cryptonite , cryptonite-conduit + , data-default , filepath , http-client , http-conduit diff --git a/src/Network/Minio/API.hs b/src/Network/Minio/API.hs index 82c3d6c..7f1dfb0 100644 --- a/src/Network/Minio/API.hs +++ b/src/Network/Minio/API.hs @@ -6,13 +6,11 @@ module Network.Minio.API , runMinio , executeRequest , mkStreamRequest - , requestInfo ) where 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.Conduit as C import Data.Conduit.Binary (sourceHandleRange) @@ -36,25 +34,32 @@ import Network.Minio.Utils -- -- print $ NC.requestBody r -- NC.httpLbs r mgr -payloadBodyWithHash :: (MonadIO m) => RequestInfo - -> m (ByteString, NC.RequestBody) -payloadBodyWithHash ri = case riPayload ri of - EPayload -> return (hashSHA256 "", NC.RequestBodyBS "") - PayloadBS bs -> return (hashSHA256 bs, NC.RequestBodyBS bs) - PayloadH h off size -> do - let offM = return . fromIntegral $ off - sizeM = return . fromIntegral $ size - hash <- hashSHA256FromSource $ sourceHandleRange h offM sizeM - return (hash, NC.requestBodySource (fromIntegral size) $ - sourceHandleRange h offM sizeM) +-- sha256Header :: :: HT.HeaderName +sha256Header :: ByteString -> HT.Header +sha256Header = ("x-amz-content-sha256", ) + +getPayloadSHA256Hash :: (MonadIO m) => Payload -> m ByteString +getPayloadSHA256Hash (PayloadBS bs) = return $ hashSHA256 bs +getPayloadSHA256Hash (PayloadH h off size) = hashSHA256FromSource $ + sourceHandleRange h + (return . fromIntegral $ off) + (return . fromIntegral $ size) + +getRequestBody :: Payload -> NC.RequestBody +getRequestBody (PayloadBS bs) = NC.RequestBodyBS bs +getRequestBody (PayloadH h off size) = + NC.requestBodySource (fromIntegral size) $ + sourceHandleRange h + (return . fromIntegral $ off) + (return . fromIntegral $ size) buildRequest :: (MonadIO m, MonadReader MinioConn m) => RequestInfo -> m NC.Request buildRequest ri = do - (phash, rbody) <- payloadBodyWithHash ri + sha256Hash <- getPayloadSHA256Hash (riPayload ri) let newRi = ri { - riPayloadHash = phash - , riHeaders = ("x-amz-content-sha256", phash) : (riHeaders ri) + riPayloadHash = sha256Hash + , riHeaders = sha256Header sha256Hash : (riHeaders ri) } ci <- asks mcConnInfo @@ -66,13 +71,12 @@ buildRequest ri = do , NC.secure = connectIsSecure ci , NC.host = encodeUtf8 $ connectHost ci , NC.port = connectPort ci - , NC.path = getPathFromRI ri - , NC.queryString = HT.renderQuery False $ riQueryParams ri + , NC.path = getPathFromRI newRi + , NC.queryString = HT.renderQuery False $ riQueryParams newRi , NC.requestHeaders = reqHeaders - , NC.requestBody = rbody + , NC.requestBody = getRequestBody (riPayload newRi) } - executeRequest :: RequestInfo -> Minio (Response LByteString) executeRequest ri = do req <- buildRequest ri @@ -86,9 +90,3 @@ mkStreamRequest ri = do req <- buildRequest ri mgr <- asks mcConnManager http req mgr - - -requestInfo :: Method -> Maybe Bucket -> Maybe Object - -> Query -> [Header] -> Payload - -> RequestInfo -requestInfo m b o q h p = RequestInfo m b o q h p "" Nothing diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index fee828b..51ea643 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -23,9 +23,9 @@ import qualified Data.ByteString as B import Network.HTTP.Client (defaultManagerSettings, HttpException) import Network.HTTP.Types (Method, Header, Query) import qualified Network.HTTP.Conduit as NC +import Data.Default (Default(..)) +import qualified Network.HTTP.Types as HT --- import Control.Monad.Trans.Resource (MonadThrow, MonadResource, ResourceT, --- MonadBaseControl(..)) import Control.Monad.Trans.Resource import Control.Monad.Trans.Control import Control.Monad.Base @@ -66,13 +66,14 @@ data BucketInfo = BucketInfo { , biCreationDate :: UTCTime } deriving (Show, Eq) - -data Payload = EPayload - | PayloadBS ByteString +data Payload = PayloadBS ByteString | PayloadH Handle Int64 -- offset Int64 -- size +instance Default Payload where + def = PayloadBS "" + data RequestInfo = RequestInfo { riMethod :: Method , riBucket :: Maybe Bucket @@ -84,6 +85,8 @@ data RequestInfo = RequestInfo { , riRegion :: Maybe Location } +instance Default RequestInfo where + def = RequestInfo HT.methodGet def def def def def "" def getPathFromRI :: RequestInfo -> ByteString getPathFromRI ri = B.concat $ parts diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 2164a4f..280dd9d 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -11,9 +11,7 @@ module Network.Minio.S3API import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Conduit as NC import qualified Data.Conduit as C --- import Control.Monad.Trans.Resource (MonadResource) --- import Data.Conduit.Binary (sinkLbs, sourceHandleRange) --- import qualified Data.ByteString.Lazy as LB +import Data.Default (def) import Lib.Prelude @@ -26,16 +24,15 @@ import Network.Minio.XmlGenerator -- | Fetch all buckets from the service. getService :: Minio [BucketInfo] getService = do - resp <- executeRequest $ - requestInfo HT.methodGet Nothing Nothing [] [] EPayload + resp <- executeRequest $ def parseListBuckets $ NC.responseBody resp -- | Fetch bucket location (region) getLocation :: Bucket -> Minio Text getLocation bucket = do - resp <- executeRequest $ - requestInfo HT.methodGet (Just bucket) Nothing [("location", Nothing)] [] - EPayload + resp <- executeRequest $ def { riBucket = Just bucket + , riQueryParams = [("location", Nothing)] + } parseLocation $ NC.responseBody resp -- | GET an object from the service and return the response headers @@ -46,22 +43,26 @@ getObject bucket object queryParams headers = do resp <- mkStreamRequest reqInfo return $ (NC.responseHeaders resp, NC.responseBody resp) where - reqInfo = requestInfo HT.methodGet (Just bucket) (Just object) - queryParams headers EPayload + reqInfo = def { riBucket = Just bucket + , riObject = Just object + , riQueryParams = queryParams + , riHeaders = headers} -- | Creates a bucket via a PUT bucket call. putBucket :: Bucket -> Location -> Minio () putBucket bucket location = do void $ executeRequest $ - requestInfo HT.methodPut (Just bucket) Nothing [] [] $ - PayloadBS $ mkCreateBucketConfig location + def { riMethod = HT.methodPut + , riBucket = Just bucket + , riPayload = PayloadBS $ mkCreateBucketConfig location + } -- | Single PUT object size. maxSinglePutObjectSizeBytes :: Int64 maxSinglePutObjectSizeBytes = 5 * 1024 * 1024 * 1024 -- | PUT an object into the service. This function performs a single --- PUT object calls, and so can only transfer objects upto 5GiB. +-- PUT object call, and so can only transfer objects upto 5GiB. putObject :: Bucket -> Object -> [HT.Header] -> Int64 -> Int64 -> Handle -> Minio () putObject bucket object headers offset size h = do @@ -71,17 +72,26 @@ putObject bucket object headers offset size h = do -- content-length header is automatically set by library. void $ executeRequest $ - requestInfo HT.methodPut (Just bucket) (Just object) [] headers $ - PayloadH h offset size + def { riMethod = HT.methodPut + , riBucket = Just bucket + , riObject = Just object + , riHeaders = headers + , riPayload = PayloadH h offset size + } -- | DELETE a bucket from the service. deleteBucket :: Bucket -> Minio () deleteBucket bucket = do void $ executeRequest $ - requestInfo HT.methodDelete (Just bucket) Nothing [] [] EPayload + def { riMethod = HT.methodDelete + , riBucket = Just bucket + } -- | DELETE an object from the service. deleteObject :: Bucket -> Object -> Minio () deleteObject bucket object = do void $ executeRequest $ - requestInfo HT.methodDelete (Just bucket) (Just object) [] [] EPayload + def { riMethod = HT.methodDelete + , riBucket = Just bucket + , riObject = Just object + }