diff --git a/docs/API.md b/docs/API.md index 08c91c1..213ca3f 100644 --- a/docs/API.md +++ b/docs/API.md @@ -557,31 +557,38 @@ main = do ``` -### copyObject :: Bucket -> Object -> CopyPartSource -> Minio () +### copyObject :: DestinationInfo -> SourceInfo -> Minio () Copies content of an object from the service to another __Parameters__ -In the expression `copyObject bucketName objectName cps` the parameters +In the expression `copyObject dstInfo srcInfo` the parameters are: |Param |Type |Description | |:---|:---| :---| -| `bucketName` | _Bucket_ (alias for `Text`) | Name of the bucket | -| `objectName` | _Object_ (alias for `Text`) | Name of the object | -| `cps` | _CopyPartSource_ | A value representing properties of the source object | +| `dstInfo` | _DestinationInfo_ | A value representing properties of the destination object | +| `srcInfo` | _SourceInfo_ | A value representing properties of the source object | -__CopyPartSource record type__ +__SourceInfo record type__ |Field |Type |Description | |:---|:---| :---| -| `cpSource` | `Text`| Name of source object formatted as "/srcBucket/srcObject" | -| `cpSourceRange` | `Maybe (Int64, Int64)` | Represents the byte range of source object. (0, 9) represents first ten bytes of source object| -| `cpSourceIfMatch` | `Maybe Text` | (Optional) ETag source object should match | -| `cpSourceIfNoneMatch` | `Maybe Text` | (Optional) ETag source object shouldn't match | -| `cpSourceIfUnmodifiedSince` | `Maybe UTCTime` | (Optional) Time since source object wasn't modified | -| `cpSourceIfModifiedSince` | `Maybe UTCTime` | (Optional) Time since source object was modified | +| `srcBucket` | `Bucket` | Name of source bucket | +| `srcObject` | `Object` | Name of source object | +| `srcRange` | `Maybe (Int64, Int64)` | (Optional) Represents the byte range of source object. (0, 9) represents first ten bytes of source object| +| `srcIfMatch` | `Maybe Text` | (Optional) ETag source object should match | +| `srcIfNoneMatch` | `Maybe Text` | (Optional) ETag source object shouldn't match | +| `srcIfUnmodifiedSince` | `Maybe UTCTime` | (Optional) Time since source object wasn't modified | +| `srcIfModifiedSince` | `Maybe UTCTime` | (Optional) Time since source object was modified | + +__Destination record type__ + +|Field |Type |Description | +|:---|:---| :---| +| `dstBucket` | `Bucket` | Name of destination bucket in server-side copyObject | +| `dstObject` | `Object` | Name of destination object in server-side copyObject | __Example__ @@ -594,13 +601,13 @@ main = do let bucket = "mybucket" object = "myobject" - srcObject = "/mybucket/srcObject" + objectCopy = "obj-copy" res <- runMinio minioPlayCI $ do - copyObject bucket object def { cpSource = srcObject } + copyObject def { dstBucket = bucket, dstObject = objectCopy } def { srcBucket = bucket, srcObject = object } case res of - Left e -> putStrLn $ "Failed to copyObject " ++ show srcObject" + Left e -> putStrLn $ "Failed to copyObject " ++ show bucket ++ show "/" ++ show object Right _ -> putStrLn "copyObject was successful" ``` diff --git a/examples/CopyObject.hs b/examples/CopyObject.hs index 15698d5..6665658 100755 --- a/examples/CopyObject.hs +++ b/examples/CopyObject.hs @@ -21,7 +21,6 @@ import Network.Minio import Control.Monad.Catch (catchIf) -import qualified Data.Text as T import Prelude -- | The following example uses minio's play server at @@ -50,10 +49,8 @@ main = do fPutObject bucket object localFile -- 3. Copy bucket/object to bucket/objectCopy. - copyObject bucket objectCopy def { - cpSource = T.concat ["/", bucket, "/", object] - } + copyObject def {dstBucket = bucket, dstObject = objectCopy} def { srcBucket = bucket , srcObject = object } case res1 of - Left e -> putStrLn $ "copyObject failed." ++ (show e) + Left e -> putStrLn $ "copyObject failed." ++ show e Right () -> putStrLn "copyObject succeeded." diff --git a/minio-hs.cabal b/minio-hs.cabal index 897cb35..f0c53d4 100644 --- a/minio-hs.cabal +++ b/minio-hs.cabal @@ -34,6 +34,7 @@ library , Network.Minio.Data.ByteString , Network.Minio.Data.Crypto , Network.Minio.Data.Time + , Network.Minio.CopyObject , Network.Minio.Errors , Network.Minio.ListOps , Network.Minio.PresignedOperations @@ -110,6 +111,7 @@ test-suite minio-hs-live-server-test other-modules: Lib.Prelude , Network.Minio , Network.Minio.API + , Network.Minio.CopyObject , Network.Minio.Data , Network.Minio.Data.ByteString , Network.Minio.Data.Crypto @@ -232,6 +234,7 @@ test-suite minio-hs-test , Network.Minio.Data.ByteString , Network.Minio.Data.Crypto , Network.Minio.Data.Time + , Network.Minio.CopyObject , Network.Minio.Errors , Network.Minio.ListOps , Network.Minio.PresignedOperations diff --git a/src/Network/Minio.hs b/src/Network/Minio.hs index e08fd77..f88bc49 100644 --- a/src/Network/Minio.hs +++ b/src/Network/Minio.hs @@ -91,8 +91,18 @@ module Network.Minio , getObject -- ** Server-side copying - , CopyPartSource(..) , copyObject + , SourceInfo + , srcBucket + , srcObject + , srcRange + , srcIfMatch + , srcIfNoneMatch + , srcIfModifiedSince + , srcIfUnmodifiedSince + , DestinationInfo + , dstBucket + , dstObject -- ** Querying , statObject @@ -146,6 +156,7 @@ import qualified Data.Map as Map import Lib.Prelude +import Network.Minio.CopyObject import Network.Minio.Data import Network.Minio.Errors import Network.Minio.ListOps @@ -178,12 +189,13 @@ putObject :: Bucket -> Object -> C.Producer Minio ByteString putObject bucket object src sizeMay = void $ putObjectInternal bucket object $ ODStream src sizeMay --- | Perform a server-side copy operation to create an object with the --- given bucket and object name from the source specification in --- CopyPartSource. This function performs a multipart copy operation --- if the new object is to be greater than 5GiB in size. -copyObject :: Bucket -> Object -> CopyPartSource -> Minio () -copyObject bucket object cps = void $ copyObjectInternal bucket object cps +-- | Perform a server-side copy operation to create an object based on +-- the destination specification in DestinationInfo from the source +-- specification in SourceInfo. This function performs a multipart +-- copy operation if the new object is to be greater than 5GiB in +-- size. +copyObject :: DestinationInfo -> SourceInfo -> Minio () +copyObject dstInfo srcInfo = void $ copyObjectInternal (dstBucket dstInfo) (dstObject dstInfo) srcInfo -- | Remove an object from the object store. removeObject :: Bucket -> Object -> Minio () diff --git a/src/Network/Minio/CopyObject.hs b/src/Network/Minio/CopyObject.hs new file mode 100644 index 0000000..e4a419e --- /dev/null +++ b/src/Network/Minio/CopyObject.hs @@ -0,0 +1,92 @@ +-- +-- Minio Haskell SDK, (C) 2017 Minio, Inc. +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. +-- + +module Network.Minio.CopyObject where + +import Data.Default (def) +import qualified Data.List as List + +import Lib.Prelude + +import Network.Minio.Data +import Network.Minio.Errors +import Network.Minio.S3API +import Network.Minio.Utils + + +-- | Copy an object using single or multipart copy strategy. +copyObjectInternal :: Bucket -> Object -> SourceInfo + -> Minio ETag +copyObjectInternal b' o srcInfo = do + let sBucket = srcBucket srcInfo + sObject = srcObject srcInfo + + -- get source object size with a head request + (ObjectInfo _ _ _ srcSize) <- headObject sBucket sObject + + -- check that byte offsets are valid if specified in cps + let rangeMay = srcRange srcInfo + range = maybe (0, srcSize) identity rangeMay + startOffset = fst range + endOffset = snd range + + when (isJust rangeMay && + or [startOffset < 0, endOffset < startOffset, + endOffset >= fromIntegral srcSize]) $ + throwM $ MErrVInvalidSrcObjByteRange range + + -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR + -- 2. If startOffset /= 0 use multipart copy + let destSize = (\(a, b) -> b - a + 1 ) $ + maybe (0, srcSize - 1) identity rangeMay + + if destSize > minPartSize || (endOffset - startOffset + 1 /= srcSize) + then multiPartCopyObject b' o srcInfo srcSize + + else fst <$> copyObjectSingle b' o srcInfo{srcRange = Nothing} [] + +-- | Given the input byte range of the source object, compute the +-- splits for a multipart copy object procedure. Minimum part size +-- used is minPartSize. +selectCopyRanges :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))] +selectCopyRanges (st, end) = zip pns $ + map (\(x, y) -> (st + x, st + x + y - 1)) $ zip startOffsets partSizes + where + size = end - st + 1 + (pns, startOffsets, partSizes) = List.unzip3 $ selectPartSizes size + +-- | Perform a multipart copy object action. Since we cannot verify +-- existing parts based on the source object, there is no resuming +-- copy action support. +multiPartCopyObject :: Bucket -> Object -> SourceInfo -> Int64 + -> Minio ETag +multiPartCopyObject b o cps srcSize = do + uid <- newMultipartUpload b o [] + + let byteRange = maybe (0, fromIntegral $ srcSize - 1) identity $ srcRange cps + partRanges = selectCopyRanges byteRange + partSources = map (\(x, (start, end)) -> (x, cps {srcRange = Just (start, end) })) + partRanges + dstInfo = def { dstBucket = b, dstObject = o} + + copiedParts <- limitedMapConcurrently 10 + (\(pn, cps') -> do + (etag, _) <- copyObjectPart dstInfo cps' uid pn [] + return (pn, etag) + ) + partSources + + completeMultipartUpload b o uid copiedParts diff --git a/src/Network/Minio/Data.hs b/src/Network/Minio/Data.hs index ddb6b0c..2766e06 100644 --- a/src/Network/Minio/Data.hs +++ b/src/Network/Minio/Data.hs @@ -14,31 +14,47 @@ -- limitations under the License. -- -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} module Network.Minio.Data where import Control.Monad.Base -import qualified Control.Monad.Catch as MC +import qualified Control.Monad.Catch as MC import Control.Monad.Trans.Control import Control.Monad.Trans.Resource -import qualified Data.ByteString as B -import Data.Default (Default(..)) -import qualified Data.Map as Map -import qualified Data.Text as T -import Data.Time (formatTime, defaultTimeLocale) -import Network.HTTP.Client (defaultManagerSettings) -import qualified Network.HTTP.Conduit as NC -import Network.HTTP.Types (Method, Header, Query) -import qualified Network.HTTP.Types as HT +import qualified Data.ByteString as B +import Data.Default (Default (..)) +import qualified Data.Map as Map +import qualified Data.Text as T +import Data.Time (defaultTimeLocale, formatTime) +import Network.HTTP.Client (defaultManagerSettings) +import qualified Network.HTTP.Conduit as NC +import Network.HTTP.Types (Header, Method, Query) +import qualified Network.HTTP.Types as HT import Network.Minio.Errors import Text.XML -import GHC.Show (Show(..)) +import GHC.Show (Show (..)) import Lib.Prelude +-- | max obj size is 5TiB +maxObjectSize :: Int64 +maxObjectSize = 5 * 1024 * 1024 * oneMiB + +-- | minimum size of parts used in multipart operations. +minPartSize :: Int64 +minPartSize = 64 * oneMiB + +oneMiB :: Int64 +oneMiB = 1024 * 1024 + +-- | maximum number of parts that can be uploaded for a single object. +maxMultipartParts :: Int64 +maxMultipartParts = 10000 + -- TODO: Add a type which provides typed constants for region. this -- type should have a IsString instance to infer the appropriate -- constant. @@ -65,12 +81,12 @@ awsRegionMap = Map.fromList [ -- of the provided smart constructors or override fields of the -- Default instance. data ConnectInfo = ConnectInfo { - connectHost :: Text - , connectPort :: Int - , connectAccessKey :: Text - , connectSecretKey :: Text - , connectIsSecure :: Bool - , connectRegion :: Region + connectHost :: Text + , connectPort :: Int + , connectAccessKey :: Text + , connectSecretKey :: Text + , connectIsSecure :: Bool + , connectRegion :: Region , connectAutoDiscoverRegion :: Bool } deriving (Eq, Show) @@ -169,7 +185,7 @@ type ETag = Text -- | -- BucketInfo returned for list buckets call data BucketInfo = BucketInfo { - biName :: Bucket + biName :: Bucket , biCreationDate :: UTCTime } deriving (Show, Eq) @@ -185,102 +201,85 @@ type PartTuple = (PartNumber, ETag) -- | Represents result from a listing of object parts of an ongoing -- multipart upload. data ListPartsResult = ListPartsResult { - lprHasMore :: Bool + lprHasMore :: Bool , lprNextPart :: Maybe Int - , lprParts :: [ObjectPartInfo] + , lprParts :: [ObjectPartInfo] } deriving (Show, Eq) -- | Represents information about an object part in an ongoing -- multipart upload. data ObjectPartInfo = ObjectPartInfo { - opiNumber :: PartNumber - , opiETag :: ETag - , opiSize :: Int64 + opiNumber :: PartNumber + , opiETag :: ETag + , opiSize :: Int64 , opiModTime :: UTCTime } deriving (Show, Eq) -- | Represents result from a listing of incomplete uploads to a -- bucket. data ListUploadsResult = ListUploadsResult { - lurHasMore :: Bool - , lurNextKey :: Maybe Text + lurHasMore :: Bool + , lurNextKey :: Maybe Text , lurNextUpload :: Maybe Text - , lurUploads :: [(Object, UploadId, UTCTime)] - , lurCPrefixes :: [Text] + , lurUploads :: [(Object, UploadId, UTCTime)] + , lurCPrefixes :: [Text] } deriving (Show, Eq) -- | Represents information about a multipart upload. data UploadInfo = UploadInfo { - uiKey :: Object + uiKey :: Object , uiUploadId :: UploadId , uiInitTime :: UTCTime - , uiSize :: Int64 + , uiSize :: Int64 } deriving (Show, Eq) -- | Represents result from a listing of objects in a bucket. data ListObjectsResult = ListObjectsResult { - lorHasMore :: Bool + lorHasMore :: Bool , lorNextToken :: Maybe Text - , lorObjects :: [ObjectInfo] + , lorObjects :: [ObjectInfo] , lorCPrefixes :: [Text] } deriving (Show, Eq) -- | Represents result from a listing of objects version 1 in a bucket. data ListObjectsV1Result = ListObjectsV1Result { - lorHasMore' :: Bool + lorHasMore' :: Bool , lorNextMarker :: Maybe Text - , lorObjects' :: [ObjectInfo] + , lorObjects' :: [ObjectInfo] , lorCPrefixes' :: [Text] } deriving (Show, Eq) -- | Represents information about an object. data ObjectInfo = ObjectInfo { - oiObject :: Object + oiObject :: Object , oiModTime :: UTCTime - , oiETag :: ETag - , oiSize :: Int64 + , oiETag :: ETag + , oiSize :: Int64 } deriving (Show, Eq) -data CopyPartSource = CopyPartSource { - -- | formatted like "\/sourceBucket\/sourceObject" - cpSource :: Text - -- | (0, 9) means first ten bytes of the source object - , cpSourceRange :: Maybe (Int64, Int64) - , cpSourceIfMatch :: Maybe Text - , cpSourceIfNoneMatch :: Maybe Text - , cpSourceIfUnmodifiedSince :: Maybe UTCTime - , cpSourceIfModifiedSince :: Maybe UTCTime +-- | Represents source object in server-side copy object +data SourceInfo = SourceInfo { + srcBucket :: Text + , srcObject :: Text + , srcRange :: Maybe (Int64, Int64) + , srcIfMatch :: Maybe Text + , srcIfNoneMatch :: Maybe Text + , srcIfModifiedSince :: Maybe UTCTime + , srcIfUnmodifiedSince :: Maybe UTCTime } deriving (Show, Eq) -instance Default CopyPartSource where - def = CopyPartSource "" def def def def def +instance Default SourceInfo where + def = SourceInfo "" "" def def def def def -cpsToHeaders :: CopyPartSource -> [HT.Header] -cpsToHeaders cps = ("x-amz-copy-source", encodeUtf8 $ cpSource cps) : - rangeHdr ++ zip names values - where - names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match", - "x-amz-copy-source-if-unmodified-since", - "x-amz-copy-source-if-modified-since"] - values = mapMaybe (fmap encodeUtf8 . (cps &)) - [cpSourceIfMatch, cpSourceIfNoneMatch, - fmap formatRFC1123 . cpSourceIfUnmodifiedSince, - fmap formatRFC1123 . cpSourceIfModifiedSince] - rangeHdr = ("x-amz-copy-source-range",) - . HT.renderByteRanges - . (:[]) - . uncurry HT.ByteRangeFromTo - <$> map (both fromIntegral) (maybeToList $ cpSourceRange cps) +-- | Represents destination object in server-side copy object +data DestinationInfo = DestinationInfo { + dstBucket :: Text + , dstObject :: Text + } deriving (Show, Eq) --- | Extract the source bucket and source object name. TODO: validate --- the bucket and object name extracted. -cpsToObject :: CopyPartSource -> Maybe (Bucket, Object) -cpsToObject cps = do - [_, bucket, object] <- Just splits - return (bucket, object) - where - splits = T.splitOn "/" $ cpSource cps +instance Default DestinationInfo where + def = DestinationInfo "" "" -- | A data-type for events that can occur in the object storage -- server. Reference: @@ -352,7 +351,7 @@ instance Default FilterRules where -- for objects having a suffix of ".jpg", and the `prefixRule` -- restricts it to objects having a prefix of "images/". data FilterRule = FilterRule - { frName :: Text + { frName :: Text , frValue :: Text } deriving (Show, Eq) @@ -362,8 +361,8 @@ type Arn = Text -- notification system. It could represent a Queue, Topic or Lambda -- Function configuration. data NotificationConfig = NotificationConfig - { ncId :: Text - , ncArn :: Arn + { ncId :: Text + , ncArn :: Arn , ncEvents :: [Event] , ncFilter :: Filter } deriving (Show, Eq) @@ -374,8 +373,8 @@ data NotificationConfig = NotificationConfig -- described at -- data Notification = Notification - { nQueueConfigurations :: [NotificationConfig] - , nTopicConfigurations :: [NotificationConfig] + { nQueueConfigurations :: [NotificationConfig] + , nTopicConfigurations :: [NotificationConfig] , nCloudFunctionConfigurations :: [NotificationConfig] } deriving (Eq, Show) @@ -393,14 +392,14 @@ instance Default Payload where def = PayloadBS "" data RequestInfo = RequestInfo { - riMethod :: Method - , riBucket :: Maybe Bucket - , riObject :: Maybe Object - , riQueryParams :: Query - , riHeaders :: [Header] - , riPayload :: Payload - , riPayloadHash :: Maybe ByteString - , riRegion :: Maybe Region + riMethod :: Method + , riBucket :: Maybe Bucket + , riObject :: Maybe Object + , riQueryParams :: Query + , riHeaders :: [Header] + , riPayload :: Payload + , riPayloadHash :: Maybe ByteString + , riRegion :: Maybe Region , riNeedsLocation :: Bool } @@ -445,7 +444,7 @@ instance MonadBaseControl IO Minio where -- | MinioConn holds connection info and a connection pool data MinioConn = MinioConn { - mcConnInfo :: ConnectInfo + mcConnInfo :: ConnectInfo , mcConnManager :: NC.Manager } diff --git a/src/Network/Minio/PutObject.hs b/src/Network/Minio/PutObject.hs index d5c00b5..1279ded 100644 --- a/src/Network/Minio/PutObject.hs +++ b/src/Network/Minio/PutObject.hs @@ -19,9 +19,6 @@ module Network.Minio.PutObject putObjectInternal , ObjectData(..) , selectPartSizes - , copyObjectInternal - , selectCopyRanges - , minPartSize ) where @@ -39,20 +36,6 @@ import Network.Minio.S3API import Network.Minio.Utils --- | max obj size is 5TiB -maxObjectSize :: Int64 -maxObjectSize = 5 * 1024 * 1024 * oneMiB - --- | minimum size of parts used in multipart operations. -minPartSize :: Int64 -minPartSize = 64 * oneMiB - -oneMiB :: Int64 -oneMiB = 1024 * 1024 - -maxMultipartParts :: Int64 -maxMultipartParts = 10000 - -- | A data-type to represent the source data for an object. A -- file-path or a producer-conduit may be provided. -- @@ -95,23 +78,6 @@ putObjectInternal b o (ODFile fp sizeMay) = do | otherwise -> sequentialMultipartUpload b o (Just size) $ CB.sourceFile fp --- | Select part sizes - the logic is that the minimum part-size will --- be 64MiB. -selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)] -selectPartSizes size = uncurry (List.zip3 [1..]) $ - List.unzip $ loop 0 size - where - ceil :: Double -> Int64 - ceil = ceiling - partSize = max minPartSize (ceil $ fromIntegral size / - fromIntegral maxMultipartParts) - - m = fromIntegral partSize - loop st sz - | st > sz = [] - | st + m >= sz = [(st, sz - st)] - | otherwise = (st, m) : loop (st + m) sz - parallelMultipartUpload :: Bucket -> Object -> FilePath -> Int64 -> Minio ETag parallelMultipartUpload b o filePath size = do @@ -163,69 +129,3 @@ sequentialMultipartUpload b o sizeMay src = do Just payload -> do pinfo <- lift $ putObjectPart b o uid pn [] payload C.yield pinfo uploadPart' uid pns - --- | Copy an object using single or multipart copy strategy. -copyObjectInternal :: Bucket -> Object -> CopyPartSource - -> Minio ETag -copyObjectInternal b' o cps = do - -- validate and extract the src bucket and object - (srcBucket, srcObject) <- maybe - (throwM $ MErrVInvalidSrcObjSpec $ cpSource cps) - return $ cpsToObject cps - - -- get source object size with a head request - (ObjectInfo _ _ _ srcSize) <- headObject srcBucket srcObject - - -- check that byte offsets are valid if specified in cps - when (isJust (cpSourceRange cps) && - or [fst range < 0, snd range < fst range, - snd range >= fromIntegral srcSize]) $ - throwM $ MErrVInvalidSrcObjByteRange range - - -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR - -- 2. If startOffset /= 0 use multipart copy - let destSize = (\(a, b) -> b - a + 1 ) $ - maybe (0, srcSize - 1) identity $ cpSourceRange cps - startOffset = maybe 0 fst $ cpSourceRange cps - endOffset = maybe (srcSize - 1) snd $ cpSourceRange cps - - if destSize > minPartSize || (endOffset - startOffset + 1 /= srcSize) - then multiPartCopyObject b' o cps srcSize - - else fst <$> copyObjectSingle b' o cps{cpSourceRange = Nothing} [] - - where - range = maybe (0, 0) identity $ cpSourceRange cps - --- | Given the input byte range of the source object, compute the --- splits for a multipart copy object procedure. Minimum part size --- used is minPartSize. -selectCopyRanges :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))] -selectCopyRanges (st, end) = zip pns $ - map (\(x, y) -> (st + x, st + x + y - 1)) $ zip startOffsets partSizes - where - size = end - st + 1 - (pns, startOffsets, partSizes) = List.unzip3 $ selectPartSizes size - --- | Perform a multipart copy object action. Since we cannot verify --- existing parts based on the source object, there is no resuming --- copy action support. -multiPartCopyObject :: Bucket -> Object -> CopyPartSource -> Int64 - -> Minio ETag -multiPartCopyObject b o cps srcSize = do - uid <- newMultipartUpload b o [] - - let byteRange = maybe (0, fromIntegral $ srcSize - 1) identity $ - cpSourceRange cps - partRanges = selectCopyRanges byteRange - partSources = map (\(x, y) -> (x, cps {cpSourceRange = Just y})) - partRanges - - copiedParts <- limitedMapConcurrently 10 - (\(pn, cps') -> do - (etag, _) <- copyObjectPart b o cps' uid pn [] - return (pn, etag) - ) - partSources - - completeMultipartUpload b o uid copiedParts diff --git a/src/Network/Minio/S3API.hs b/src/Network/Minio/S3API.hs index 3f11caa..b01ea02 100644 --- a/src/Network/Minio/S3API.hs +++ b/src/Network/Minio/S3API.hs @@ -51,7 +51,6 @@ module Network.Minio.S3API , PartTuple , Payload(..) , PartNumber - , CopyPartSource(..) , newMultipartUpload , putObjectPart , copyObjectPart @@ -252,17 +251,33 @@ putObjectPart bucket object uploadId partNumber headers payload = do , ("partNumber", Just $ show partNumber) ] +srcInfoToHeaders :: SourceInfo -> [HT.Header] +srcInfoToHeaders srcInfo = ("x-amz-copy-source", encodeUtf8 $ format "/{}/{}" [srcBucket srcInfo, srcObject srcInfo]) : + rangeHdr ++ zip names values + where + names = ["x-amz-copy-source-if-match", "x-amz-copy-source-if-none-match", + "x-amz-copy-source-if-unmodified-since", + "x-amz-copy-source-if-modified-since"] + values = mapMaybe (fmap encodeUtf8 . (srcInfo &)) + [srcIfMatch, srcIfNoneMatch, + fmap formatRFC1123 . srcIfUnmodifiedSince, + fmap formatRFC1123 . srcIfModifiedSince] + rangeHdr = maybe [] (\a -> [("x-amz-copy-source-range", HT.renderByteRanges [a])]) + $ toByteRange <$> srcRange srcInfo + toByteRange :: (Int64, Int64) -> HT.ByteRange + toByteRange (x, y) = HT.ByteRangeFromTo (fromIntegral x) (fromIntegral y) + -- | Performs server-side copy of an object or part of an object as an -- upload part of an ongoing multi-part upload. -copyObjectPart :: Bucket -> Object -> CopyPartSource -> UploadId +copyObjectPart :: DestinationInfo -> SourceInfo -> UploadId -> PartNumber -> [HT.Header] -> Minio (ETag, UTCTime) -copyObjectPart bucket object cps uploadId partNumber headers = do +copyObjectPart dstInfo srcInfo uploadId partNumber headers = do resp <- executeRequest $ def { riMethod = HT.methodPut - , riBucket = Just bucket - , riObject = Just object + , riBucket = Just $ dstBucket dstInfo + , riObject = Just $ dstObject dstInfo , riQueryParams = mkOptionalParams params - , riHeaders = headers ++ cpsToHeaders cps + , riHeaders = headers ++ srcInfoToHeaders srcInfo } parseCopyObjectResponse $ NC.responseBody resp @@ -275,17 +290,17 @@ copyObjectPart bucket object cps uploadId partNumber headers = do -- | Performs server-side copy of an object that is upto 5GiB in -- size. If the object is greater than 5GiB, this function throws the -- error returned by the server. -copyObjectSingle :: Bucket -> Object -> CopyPartSource -> [HT.Header] +copyObjectSingle :: Bucket -> Object -> SourceInfo -> [HT.Header] -> Minio (ETag, UTCTime) -copyObjectSingle bucket object cps headers = do - -- validate that cpSourceRange is Nothing for this API. - when (isJust $ cpSourceRange cps) $ +copyObjectSingle bucket object srcInfo headers = do + -- validate that srcRange is Nothing for this API. + when (isJust $ srcRange srcInfo) $ throwM MErrVCopyObjSingleNoRangeAccepted resp <- executeRequest $ def { riMethod = HT.methodPut , riBucket = Just bucket , riObject = Just object - , riHeaders = headers ++ cpsToHeaders cps + , riHeaders = headers ++ srcInfoToHeaders srcInfo } parseCopyObjectResponse $ NC.responseBody resp diff --git a/src/Network/Minio/Utils.hs b/src/Network/Minio/Utils.hs index a8e9673..dff95f3 100644 --- a/src/Network/Minio/Utils.hs +++ b/src/Network/Minio/Utils.hs @@ -24,8 +24,10 @@ import qualified Control.Monad.Trans.Resource as R import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB +import Data.CaseInsensitive (mk) import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB +import qualified Data.List as List import qualified Data.Text as T import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Read (decimal) @@ -35,11 +37,11 @@ import qualified Network.HTTP.Conduit as NC import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types.Header as Hdr import qualified System.IO as IO -import Data.CaseInsensitive (mk) import Lib.Prelude +import Network.Minio.Data import Network.Minio.XmlParser (parseErrResponse) allocateReadFile :: (R.MonadResource m, R.MonadResourceBase m, MonadCatch m) @@ -203,3 +205,20 @@ chunkBSConduit s = loop 0 [] s loop (fromIntegral $ B.length b) [b] sizes else loop (n + fromIntegral (B.length bs)) (readChunks ++ [bs]) (size:sizes) + +-- | Select part sizes - the logic is that the minimum part-size will +-- be 64MiB. +selectPartSizes :: Int64 -> [(PartNumber, Int64, Int64)] +selectPartSizes size = uncurry (List.zip3 [1..]) $ + List.unzip $ loop 0 size + where + ceil :: Double -> Int64 + ceil = ceiling + partSize = max minPartSize (ceil $ fromIntegral size / + fromIntegral maxMultipartParts) + + m = fromIntegral partSize + loop st sz + | st > sz = [] + | st + m >= sz = [(st, sz - st)] + | otherwise = (st, m) : loop (st + m) sz diff --git a/test/LiveServer.hs b/test/LiveServer.hs index 25e38a3..6d59990 100644 --- a/test/LiveServer.hs +++ b/test/LiveServer.hs @@ -42,7 +42,6 @@ import System.Environment (lookupEnv) import Network.Minio import Network.Minio.Data -import Network.Minio.ListOps import Network.Minio.PutObject import Network.Minio.S3API import Network.Minio.Utils @@ -57,8 +56,6 @@ tests = testGroup "Tests" [liveServerUnitTests] randomDataSrc :: MonadIO m => Int64 -> C.Producer m ByteString randomDataSrc s' = genBS s' where - oneMiB = 1024*1024 - concatIt bs n = BS.concat $ replicate (fromIntegral q) bs ++ [BS.take (fromIntegral r) bs] where (q, r) = n `divMod` fromIntegral (BS.length bs) @@ -166,7 +163,10 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $ (map oiObject objects) step "High-level listing of objects (version 1)" - objects <- listObjectsV1 bucket Nothing True $$ sinkList + objectsV1 <- listObjectsV1 bucket Nothing True $$ sinkList + + liftIO $ assertEqual "Objects match failed!" (sort expectedObjects) + (map oiObject objectsV1) step "Cleanup actions" forM_ expectedObjects $ @@ -226,14 +226,14 @@ listingTest = funTestWithBucket "Listing Test" $ \step bucket -> do (map oiObject $ lorObjects res) step "Simple list version 1" - res <- listObjectsV1' bucket Nothing Nothing Nothing Nothing + resV1 <- listObjectsV1' bucket Nothing Nothing Nothing Nothing let expected = sort $ map (T.concat . ("lsb-release":) . (\x -> [x]) . T.pack . show) [1..10::Int] liftIO $ assertEqual "Objects match failed!" expected - (map oiObject $ lorObjects' res) + (map oiObject $ lorObjects' resV1) step "Cleanup actions" forM_ objects $ \obj -> deleteObject bucket obj @@ -338,8 +338,8 @@ liveServerUnitTests = testGroup "Unit tests against a live server" fPutObject bucket object inputFile step "copy object" - let cps = def { cpSource = format "/{}/{}" [bucket, object] } - (etag, modTime) <- copyObjectSingle bucket objCopy cps [] + let srcInfo = def { srcBucket = bucket, srcObject = object} + (etag, modTime) <- copyObjectSingle bucket objCopy srcInfo [] -- retrieve obj info to check ObjectInfo _ t e s <- headObject bucket objCopy @@ -368,10 +368,11 @@ liveServerUnitTests = testGroup "Unit tests against a live server" liftIO $ (T.length uid > 0) @? "Got an empty multipartUpload Id." step "put object parts 1-3" - let cps' = def {cpSource = format "/{}/{}" [bucket, srcObj]} + let srcInfo' = def { srcBucket = bucket, srcObject = srcObj } + dstInfo' = def { dstBucket = bucket, dstObject = copyObj } parts <- forM [1..3] $ \p -> do - (etag', _) <- copyObjectPart bucket copyObj cps'{ - cpSourceRange = Just ((p-1)*mb5, (p-1)*mb5 + (mb5 - 1)) + (etag', _) <- copyObjectPart dstInfo' srcInfo'{ + srcRange = Just $ (,) ((p-1)*mb5) ((p-1)*mb5 + (mb5 - 1)) } uid (fromIntegral p) [] return (fromIntegral p, etag') @@ -398,7 +399,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server" step "make small and large object copy" forM_ (zip copyObjs srcs) $ \(cp, src) -> - copyObject bucket cp def{cpSource = format "/{}/{}" [bucket, src]} + copyObject def {dstBucket = bucket, dstObject = cp} def{srcBucket = bucket, srcObject = src} step "verify uploaded objects" uploadedSizes <- fmap oiSize <$> forM copyObjs (headObject bucket) @@ -415,9 +416,10 @@ liveServerUnitTests = testGroup "Unit tests against a live server" fPutObject bucket src =<< mkRandFile size step "copy last 10MiB of object" - copyObject bucket copyObj def{ - cpSource = format "/{}/{}" [bucket, src] - , cpSourceRange = Just (5 * 1024 * 1024, size - 1) + copyObject def { dstBucket = bucket, dstObject = copyObj } def{ + srcBucket = bucket + , srcObject = src + , srcRange = Just $ (,) (5 * 1024 * 1024) (size - 1) } step "verify uploaded object" diff --git a/test/Spec.hs b/test/Spec.hs index 91423e7..60e6e63 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -22,6 +22,8 @@ import qualified Data.List as L import Lib.Prelude import Network.Minio.API.Test +import Network.Minio.CopyObject +import Network.Minio.Data import Network.Minio.PutObject import Network.Minio.Utils.Test import Network.Minio.XmlGenerator.Test