--
-- 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 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 :: Bucket -> Bucket -> SourceInfo -> Minio Bucket
copyObjectInternal Bucket
b' Bucket
o SourceInfo
srcInfo = do
  let sBucket :: Bucket
sBucket = SourceInfo -> Bucket
srcBucket SourceInfo
srcInfo
      sObject :: Bucket
sObject = SourceInfo -> Bucket
srcObject SourceInfo
srcInfo

  -- get source object size with a head request
  ObjectInfo
oi <- Bucket -> Bucket -> [Header] -> Minio ObjectInfo
headObject Bucket
sBucket Bucket
sObject []
  let srcSize :: Int64
srcSize = ObjectInfo -> Int64
oiSize ObjectInfo
oi

  -- check that byte offsets are valid if specified in cps
  let rangeMay :: Maybe (Int64, Int64)
rangeMay = SourceInfo -> Maybe (Int64, Int64)
srcRange SourceInfo
srcInfo
      range :: (Int64, Int64)
range = (Int64, Int64)
-> ((Int64, Int64) -> (Int64, Int64))
-> Maybe (Int64, Int64)
-> (Int64, Int64)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64
0, Int64
srcSize) (Int64, Int64) -> (Int64, Int64)
forall a. a -> a
identity Maybe (Int64, Int64)
rangeMay
      startOffset :: Int64
startOffset = (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
range
      endOffset :: Int64
endOffset = (Int64, Int64) -> Int64
forall a b. (a, b) -> b
snd (Int64, Int64)
range

  Bool -> Minio () -> Minio ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( Maybe (Int64, Int64) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Int64, Int64)
rangeMay
        Bool -> Bool -> Bool
&& ( (Int64
startOffset Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0)
               Bool -> Bool -> Bool
|| (Int64
endOffset Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
startOffset)
               Bool -> Bool -> Bool
|| (Int64
endOffset Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
srcSize)
           )
    )
    (Minio () -> Minio ()) -> Minio () -> Minio ()
forall a b. (a -> b) -> a -> b
$ MErrV -> Minio ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO
    (MErrV -> Minio ()) -> MErrV -> Minio ()
forall a b. (a -> b) -> a -> b
$ (Int64, Int64) -> MErrV
MErrVInvalidSrcObjByteRange (Int64, Int64)
range

  -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR
  -- 2. If startOffset /= 0 use multipart copy
  let destSize :: Int64
destSize =
        (\(Int64
a, Int64
b) -> Int64
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
a Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1) ((Int64, Int64) -> Int64) -> (Int64, Int64) -> Int64
forall a b. (a -> b) -> a -> b
$
          (Int64, Int64)
-> ((Int64, Int64) -> (Int64, Int64))
-> Maybe (Int64, Int64)
-> (Int64, Int64)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64
0, Int64
srcSize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) (Int64, Int64) -> (Int64, Int64)
forall a. a -> a
identity Maybe (Int64, Int64)
rangeMay

  if Int64
destSize Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
minPartSize Bool -> Bool -> Bool
|| (Int64
endOffset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
startOffset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1 Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
srcSize)
    then Bucket -> Bucket -> SourceInfo -> Int64 -> Minio Bucket
multiPartCopyObject Bucket
b' Bucket
o SourceInfo
srcInfo Int64
srcSize
    else (Bucket, UTCTime) -> Bucket
forall a b. (a, b) -> a
fst ((Bucket, UTCTime) -> Bucket)
-> Minio (Bucket, UTCTime) -> Minio Bucket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bucket
-> Bucket -> SourceInfo -> [Header] -> Minio (Bucket, UTCTime)
copyObjectSingle Bucket
b' Bucket
o SourceInfo
srcInfo {srcRange :: Maybe (Int64, Int64)
srcRange = Maybe (Int64, Int64)
forall a. Maybe a
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 :: (Int64, Int64) -> [(PartNumber, (Int64, Int64))]
selectCopyRanges (Int64
st, Int64
end) =
  [PartNumber] -> [(Int64, Int64)] -> [(PartNumber, (Int64, Int64))]
forall a b. [a] -> [b] -> [(a, b)]
zip [PartNumber]
pns ([(Int64, Int64)] -> [(PartNumber, (Int64, Int64))])
-> [(Int64, Int64)] -> [(PartNumber, (Int64, Int64))]
forall a b. (a -> b) -> a -> b
$
    (Int64 -> Int64 -> (Int64, Int64))
-> [Int64] -> [Int64] -> [(Int64, Int64)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int64
x Int64
y -> (Int64
st Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x, Int64
st Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
x Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
y Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)) [Int64]
startOffsets [Int64]
partSizes
  where
    size :: Int64
size = Int64
end Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
st Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1
    ([PartNumber]
pns, [Int64]
startOffsets, [Int64]
partSizes) = [(PartNumber, Int64, Int64)] -> ([PartNumber], [Int64], [Int64])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
List.unzip3 ([(PartNumber, Int64, Int64)] -> ([PartNumber], [Int64], [Int64]))
-> [(PartNumber, Int64, Int64)] -> ([PartNumber], [Int64], [Int64])
forall a b. (a -> b) -> a -> b
$ Int64 -> [(PartNumber, Int64, Int64)]
selectPartSizes Int64
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 :: Bucket -> Bucket -> SourceInfo -> Int64 -> Minio Bucket
multiPartCopyObject Bucket
b Bucket
o SourceInfo
cps Int64
srcSize = do
  Bucket
uid <- Bucket -> Bucket -> [Header] -> Minio Bucket
newMultipartUpload Bucket
b Bucket
o []

  let byteRange :: (Int64, Int64)
byteRange = (Int64, Int64)
-> ((Int64, Int64) -> (Int64, Int64))
-> Maybe (Int64, Int64)
-> (Int64, Int64)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64
0, Int64
srcSize Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) (Int64, Int64) -> (Int64, Int64)
forall a. a -> a
identity (Maybe (Int64, Int64) -> (Int64, Int64))
-> Maybe (Int64, Int64) -> (Int64, Int64)
forall a b. (a -> b) -> a -> b
$ SourceInfo -> Maybe (Int64, Int64)
srcRange SourceInfo
cps
      partRanges :: [(PartNumber, (Int64, Int64))]
partRanges = (Int64, Int64) -> [(PartNumber, (Int64, Int64))]
selectCopyRanges (Int64, Int64)
byteRange
      partSources :: [(PartNumber, SourceInfo)]
partSources =
        ((PartNumber, (Int64, Int64)) -> (PartNumber, SourceInfo))
-> [(PartNumber, (Int64, Int64))] -> [(PartNumber, SourceInfo)]
forall a b. (a -> b) -> [a] -> [b]
map
          (\(PartNumber
x, (Int64
start, Int64
end)) -> (PartNumber
x, SourceInfo
cps {srcRange :: Maybe (Int64, Int64)
srcRange = (Int64, Int64) -> Maybe (Int64, Int64)
forall a. a -> Maybe a
Just (Int64
start, Int64
end)}))
          [(PartNumber, (Int64, Int64))]
partRanges
      dstInfo :: DestinationInfo
dstInfo = DestinationInfo
defaultDestinationInfo {dstBucket :: Bucket
dstBucket = Bucket
b, dstObject :: Bucket
dstObject = Bucket
o}

  [(PartNumber, Bucket)]
copiedParts <-
    Int
-> ((PartNumber, SourceInfo) -> Minio (PartNumber, Bucket))
-> [(PartNumber, SourceInfo)]
-> Minio [(PartNumber, Bucket)]
forall (m :: * -> *) t a.
MonadUnliftIO m =>
Int -> (t -> m a) -> [t] -> m [a]
limitedMapConcurrently
      Int
10
      ( \(PartNumber
pn, SourceInfo
cps') -> do
          (Bucket
etag, UTCTime
_) <- DestinationInfo
-> SourceInfo
-> Bucket
-> PartNumber
-> [Header]
-> Minio (Bucket, UTCTime)
copyObjectPart DestinationInfo
dstInfo SourceInfo
cps' Bucket
uid PartNumber
pn []
          (PartNumber, Bucket) -> Minio (PartNumber, Bucket)
forall (m :: * -> *) a. Monad m => a -> m a
return (PartNumber
pn, Bucket
etag)
      )
      [(PartNumber, SourceInfo)]
partSources

  Bucket
-> Bucket -> Bucket -> [(PartNumber, Bucket)] -> Minio Bucket
completeMultipartUpload Bucket
b Bucket
o Bucket
uid [(PartNumber, Bucket)]
copiedParts