--
-- 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64
0, Int64
srcSize) forall a. a -> a
identity Maybe (Int64, Int64)
rangeMay
      startOffset :: Int64
startOffset = forall a b. (a, b) -> a
fst (Int64, Int64)
range
      endOffset :: Int64
endOffset = forall a b. (a, b) -> b
snd (Int64, Int64)
range

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( forall a. Maybe a -> Bool
isJust Maybe (Int64, Int64)
rangeMay
        Bool -> Bool -> Bool
&& ( (Int64
startOffset forall a. Ord a => a -> a -> Bool
< Int64
0)
               Bool -> Bool -> Bool
|| (Int64
endOffset forall a. Ord a => a -> a -> Bool
< Int64
startOffset)
               Bool -> Bool -> Bool
|| (Int64
endOffset forall a. Ord a => a -> a -> Bool
>= Int64
srcSize)
           )
    )
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO
    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 forall a. Num a => a -> a -> a
- Int64
a forall a. Num a => a -> a -> a
+ Int64
1) forall a b. (a -> b) -> a -> b
$
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64
0, Int64
srcSize forall a. Num a => a -> a -> a
- Int64
1) forall a. a -> a
identity Maybe (Int64, Int64)
rangeMay

  if Int64
destSize forall a. Ord a => a -> a -> Bool
> Int64
minPartSize Bool -> Bool -> Bool
|| (Int64
endOffset forall a. Num a => a -> a -> a
- Int64
startOffset forall a. Num a => a -> a -> a
+ Int64
1 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 forall a b. (a, b) -> a
fst 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 = 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) =
  forall a b. [a] -> [b] -> [(a, b)]
zip [PartNumber]
pns forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int64
x Int64
y -> (Int64
st forall a. Num a => a -> a -> a
+ Int64
x, Int64
st forall a. Num a => a -> a -> a
+ Int64
x forall a. Num a => a -> a -> a
+ Int64
y forall a. Num a => a -> a -> a
- Int64
1)) [Int64]
startOffsets [Int64]
partSizes
  where
    size :: Int64
size = Int64
end forall a. Num a => a -> a -> a
- Int64
st forall a. Num a => a -> a -> a
+ Int64
1
    ([PartNumber]
pns, [Int64]
startOffsets, [Int64]
partSizes) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
List.unzip3 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64
0, Int64
srcSize forall a. Num a => a -> a -> a
- Int64
1) forall a. a -> a
identity 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 =
        forall a b. (a -> b) -> [a] -> [b]
map
          (\(PartNumber
x, (Int64
start, Int64
end)) -> (PartNumber
x, SourceInfo
cps {srcRange :: Maybe (Int64, Int64)
srcRange = 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 <-
    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 []
          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