module Aws.S3.Commands.Multipart
where
import           Aws.Aws
import           Aws.Core
import           Aws.S3.Core
import           Control.Applicative
import           Control.Arrow         (second)
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Resource
import qualified Crypto.Hash           as CH
import           Data.ByteString.Char8 ({- IsString -})
import           Data.Conduit
import qualified Data.Conduit.List     as CL
import           Data.Maybe
import           Text.XML.Cursor       (($/))
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy  as BL
import qualified Data.CaseInsensitive  as CI
import qualified Data.Map              as M
import qualified Data.Text             as T
import qualified Data.Text.Encoding    as T
import qualified Network.HTTP.Conduit  as HTTP
import qualified Network.HTTP.Types    as HTTP
import qualified Text.XML              as XML
import           Prelude

{-
Aws supports following 6 api for Multipart-Upload.
Currently this code does not support number 3 and 6.

1. Initiate Multipart Upload
2. Upload Part
3. Upload Part - Copy
4. Complete Multipart Upload
5. Abort Multipart Upload
6. List Parts

-}

data InitiateMultipartUpload
  = InitiateMultipartUpload {
      InitiateMultipartUpload -> Bucket
imuBucket :: Bucket
    , InitiateMultipartUpload -> Bucket
imuObjectName :: Object
    , InitiateMultipartUpload -> Maybe Bucket
imuCacheControl :: Maybe T.Text
    , InitiateMultipartUpload -> Maybe Bucket
imuContentDisposition :: Maybe T.Text
    , InitiateMultipartUpload -> Maybe Bucket
imuContentEncoding :: Maybe T.Text
    , InitiateMultipartUpload -> Maybe Bucket
imuContentType :: Maybe T.Text
    , InitiateMultipartUpload -> Maybe Int
imuExpires :: Maybe Int
    , InitiateMultipartUpload -> [(Bucket, Bucket)]
imuMetadata :: [(T.Text,T.Text)]
    , InitiateMultipartUpload -> Maybe StorageClass
imuStorageClass :: Maybe StorageClass
    , InitiateMultipartUpload -> Maybe Bucket
imuWebsiteRedirectLocation :: Maybe T.Text
    , InitiateMultipartUpload -> Maybe CannedAcl
imuAcl :: Maybe CannedAcl
    , InitiateMultipartUpload -> Maybe ServerSideEncryption
imuServerSideEncryption :: Maybe ServerSideEncryption
    , InitiateMultipartUpload -> Bool
imuAutoMakeBucket :: Bool -- ^ Internet Archive S3 nonstandard extension
    }
  deriving (Int -> InitiateMultipartUpload -> ShowS
[InitiateMultipartUpload] -> ShowS
InitiateMultipartUpload -> String
(Int -> InitiateMultipartUpload -> ShowS)
-> (InitiateMultipartUpload -> String)
-> ([InitiateMultipartUpload] -> ShowS)
-> Show InitiateMultipartUpload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitiateMultipartUpload -> ShowS
showsPrec :: Int -> InitiateMultipartUpload -> ShowS
$cshow :: InitiateMultipartUpload -> String
show :: InitiateMultipartUpload -> String
$cshowList :: [InitiateMultipartUpload] -> ShowS
showList :: [InitiateMultipartUpload] -> ShowS
Show)

postInitiateMultipartUpload :: Bucket -> T.Text -> InitiateMultipartUpload
postInitiateMultipartUpload :: Bucket -> Bucket -> InitiateMultipartUpload
postInitiateMultipartUpload Bucket
b Bucket
o =
  Bucket
-> Bucket
-> Maybe Bucket
-> Maybe Bucket
-> Maybe Bucket
-> Maybe Bucket
-> Maybe Int
-> [(Bucket, Bucket)]
-> Maybe StorageClass
-> Maybe Bucket
-> Maybe CannedAcl
-> Maybe ServerSideEncryption
-> Bool
-> InitiateMultipartUpload
InitiateMultipartUpload
    Bucket
b Bucket
o
    Maybe Bucket
forall a. Maybe a
Nothing Maybe Bucket
forall a. Maybe a
Nothing Maybe Bucket
forall a. Maybe a
Nothing Maybe Bucket
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing
    [] Maybe StorageClass
forall a. Maybe a
Nothing Maybe Bucket
forall a. Maybe a
Nothing Maybe CannedAcl
forall a. Maybe a
Nothing Maybe ServerSideEncryption
forall a. Maybe a
Nothing
    Bool
False

data InitiateMultipartUploadResponse
  = InitiateMultipartUploadResponse {
      InitiateMultipartUploadResponse -> Bucket
imurBucket   :: !Bucket
    , InitiateMultipartUploadResponse -> Bucket
imurKey      :: !T.Text
    , InitiateMultipartUploadResponse -> Bucket
imurUploadId :: !T.Text
    }

-- | ServiceConfiguration: 'S3Configuration'
instance SignQuery InitiateMultipartUpload where
    type ServiceConfiguration InitiateMultipartUpload = S3Configuration
    signQuery :: forall queryType.
InitiateMultipartUpload
-> ServiceConfiguration InitiateMultipartUpload queryType
-> SignatureData
-> SignedQuery
signQuery InitiateMultipartUpload {Bool
[(Bucket, Bucket)]
Maybe Int
Maybe Bucket
Maybe ServerSideEncryption
Maybe StorageClass
Maybe CannedAcl
Bucket
imuBucket :: InitiateMultipartUpload -> Bucket
imuObjectName :: InitiateMultipartUpload -> Bucket
imuCacheControl :: InitiateMultipartUpload -> Maybe Bucket
imuContentDisposition :: InitiateMultipartUpload -> Maybe Bucket
imuContentEncoding :: InitiateMultipartUpload -> Maybe Bucket
imuContentType :: InitiateMultipartUpload -> Maybe Bucket
imuExpires :: InitiateMultipartUpload -> Maybe Int
imuMetadata :: InitiateMultipartUpload -> [(Bucket, Bucket)]
imuStorageClass :: InitiateMultipartUpload -> Maybe StorageClass
imuWebsiteRedirectLocation :: InitiateMultipartUpload -> Maybe Bucket
imuAcl :: InitiateMultipartUpload -> Maybe CannedAcl
imuServerSideEncryption :: InitiateMultipartUpload -> Maybe ServerSideEncryption
imuAutoMakeBucket :: InitiateMultipartUpload -> Bool
imuBucket :: Bucket
imuObjectName :: Bucket
imuCacheControl :: Maybe Bucket
imuContentDisposition :: Maybe Bucket
imuContentEncoding :: Maybe Bucket
imuContentType :: Maybe Bucket
imuExpires :: Maybe Int
imuMetadata :: [(Bucket, Bucket)]
imuStorageClass :: Maybe StorageClass
imuWebsiteRedirectLocation :: Maybe Bucket
imuAcl :: Maybe CannedAcl
imuServerSideEncryption :: Maybe ServerSideEncryption
imuAutoMakeBucket :: Bool
..} = S3Query
-> S3Configuration queryType -> SignatureData -> SignedQuery
forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query {
        s3QMethod :: Method
s3QMethod = Method
Post
      , s3QBucket :: Maybe ByteString
s3QBucket = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
imuBucket
      , s3QObject :: Maybe ByteString
s3QObject = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 (Bucket -> ByteString) -> Bucket -> ByteString
forall a b. (a -> b) -> a -> b
$ Bucket
imuObjectName
      , s3QSubresources :: [(ByteString, Maybe ByteString)]
s3QSubresources = [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. QueryLike a => a -> [(ByteString, Maybe ByteString)]
HTTP.toQuery[ (ByteString
"uploads" :: B8.ByteString , Maybe ByteString
forall a. Maybe a
Nothing :: Maybe B8.ByteString)]
      , s3QQuery :: [(ByteString, Maybe ByteString)]
s3QQuery = []
      , s3QContentType :: Maybe ByteString
s3QContentType = Bucket -> ByteString
T.encodeUtf8 (Bucket -> ByteString) -> Maybe Bucket -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
imuContentType
      , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5 = Maybe (Digest MD5)
forall a. Maybe a
Nothing
      , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders = ((CI ByteString, Bucket) -> Header)
-> [(CI ByteString, Bucket)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((Bucket -> ByteString) -> (CI ByteString, Bucket) -> Header
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Bucket -> ByteString
T.encodeUtf8) ([(CI ByteString, Bucket)] -> RequestHeaders)
-> [(CI ByteString, Bucket)] -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ [Maybe (CI ByteString, Bucket)] -> [(CI ByteString, Bucket)]
forall a. [Maybe a] -> [a]
catMaybes [
          (CI ByteString
"x-amz-acl",) (Bucket -> (CI ByteString, Bucket))
-> (CannedAcl -> Bucket) -> CannedAcl -> (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CannedAcl -> Bucket
writeCannedAcl (CannedAcl -> (CI ByteString, Bucket))
-> Maybe CannedAcl -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CannedAcl
imuAcl
        , (CI ByteString
"x-amz-storage-class",) (Bucket -> (CI ByteString, Bucket))
-> (StorageClass -> Bucket)
-> StorageClass
-> (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass -> Bucket
writeStorageClass (StorageClass -> (CI ByteString, Bucket))
-> Maybe StorageClass -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageClass
imuStorageClass
        , (CI ByteString
"x-amz-website-redirect-location",) (Bucket -> (CI ByteString, Bucket))
-> Maybe Bucket -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
imuWebsiteRedirectLocation
        , (CI ByteString
"x-amz-server-side-encryption",) (Bucket -> (CI ByteString, Bucket))
-> (ServerSideEncryption -> Bucket)
-> ServerSideEncryption
-> (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerSideEncryption -> Bucket
writeServerSideEncryption (ServerSideEncryption -> (CI ByteString, Bucket))
-> Maybe ServerSideEncryption -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ServerSideEncryption
imuServerSideEncryption
        , if Bool
imuAutoMakeBucket then (CI ByteString, Bucket) -> Maybe (CI ByteString, Bucket)
forall a. a -> Maybe a
Just (CI ByteString
"x-amz-auto-make-bucket", Bucket
"1")  else Maybe (CI ByteString, Bucket)
forall a. Maybe a
Nothing
        ] [(CI ByteString, Bucket)]
-> [(CI ByteString, Bucket)] -> [(CI ByteString, Bucket)]
forall a. [a] -> [a] -> [a]
++ ((Bucket, Bucket) -> (CI ByteString, Bucket))
-> [(Bucket, Bucket)] -> [(CI ByteString, Bucket)]
forall a b. (a -> b) -> [a] -> [b]
map( \(Bucket, Bucket)
x -> (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (Bucket -> ByteString) -> Bucket -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bucket -> ByteString
T.encodeUtf8 (Bucket -> CI ByteString) -> Bucket -> CI ByteString
forall a b. (a -> b) -> a -> b
$ [Bucket] -> Bucket
T.concat [Bucket
"x-amz-meta-", (Bucket, Bucket) -> Bucket
forall a b. (a, b) -> a
fst (Bucket, Bucket)
x], (Bucket, Bucket) -> Bucket
forall a b. (a, b) -> b
snd (Bucket, Bucket)
x)) [(Bucket, Bucket)]
imuMetadata
      , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = ((CI ByteString, Bucket) -> Header)
-> [(CI ByteString, Bucket)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((Bucket -> ByteString) -> (CI ByteString, Bucket) -> Header
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Bucket -> ByteString
T.encodeUtf8) ([(CI ByteString, Bucket)] -> RequestHeaders)
-> [(CI ByteString, Bucket)] -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ [Maybe (CI ByteString, Bucket)] -> [(CI ByteString, Bucket)]
forall a. [Maybe a] -> [a]
catMaybes [
          (CI ByteString
"Expires",) (Bucket -> (CI ByteString, Bucket))
-> (Int -> Bucket) -> Int -> (CI ByteString, Bucket)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bucket
T.pack (String -> Bucket) -> (Int -> String) -> Int -> Bucket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> (CI ByteString, Bucket))
-> Maybe Int -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
imuExpires
        , (CI ByteString
"Cache-Control",) (Bucket -> (CI ByteString, Bucket))
-> Maybe Bucket -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
imuCacheControl
        , (CI ByteString
"Content-Disposition",) (Bucket -> (CI ByteString, Bucket))
-> Maybe Bucket -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
imuContentDisposition
        , (CI ByteString
"Content-Encoding",) (Bucket -> (CI ByteString, Bucket))
-> Maybe Bucket -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
imuContentEncoding
        ]
      , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = Maybe RequestBody
forall a. Maybe a
Nothing
      }

instance ResponseConsumer r InitiateMultipartUploadResponse where
    type ResponseMetadata InitiateMultipartUploadResponse = S3Metadata

    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata InitiateMultipartUploadResponse)
-> HTTPResponseConsumer InitiateMultipartUploadResponse
responseConsumer Request
_ r
_ = (Cursor -> Response S3Metadata InitiateMultipartUploadResponse)
-> IORef S3Metadata
-> HTTPResponseConsumer InitiateMultipartUploadResponse
forall a.
(Cursor -> Response S3Metadata a)
-> IORef S3Metadata -> HTTPResponseConsumer a
s3XmlResponseConsumer Cursor -> Response S3Metadata InitiateMultipartUploadResponse
forall {m :: * -> *}.
MonadThrow m =>
Cursor -> m InitiateMultipartUploadResponse
parse
        where parse :: Cursor -> m InitiateMultipartUploadResponse
parse Cursor
cursor
                  = do Bucket
bucket <- String -> [Bucket] -> m Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Bucket Name" ([Bucket] -> m Bucket) -> [Bucket] -> m Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Bucket"
                       Bucket
key <- String -> [Bucket] -> m Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Key" ([Bucket] -> m Bucket) -> [Bucket] -> m Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Key"
                       Bucket
uploadId <- String -> [Bucket] -> m Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing UploadID" ([Bucket] -> m Bucket) -> [Bucket] -> m Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"UploadId"
                       InitiateMultipartUploadResponse
-> m InitiateMultipartUploadResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return InitiateMultipartUploadResponse{
                                                imurBucket :: Bucket
imurBucket         = Bucket
bucket
                                              , imurKey :: Bucket
imurKey            = Bucket
key
                                              , imurUploadId :: Bucket
imurUploadId       = Bucket
uploadId
                                              }

instance Transaction InitiateMultipartUpload InitiateMultipartUploadResponse

instance AsMemoryResponse InitiateMultipartUploadResponse where
    type MemoryResponse InitiateMultipartUploadResponse = InitiateMultipartUploadResponse
    loadToMemory :: InitiateMultipartUploadResponse
-> ResourceT IO (MemoryResponse InitiateMultipartUploadResponse)
loadToMemory = InitiateMultipartUploadResponse
-> ResourceT IO (MemoryResponse InitiateMultipartUploadResponse)
InitiateMultipartUploadResponse
-> ResourceT IO InitiateMultipartUploadResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return


----------------------------------



data UploadPart = UploadPart {
    UploadPart -> Bucket
upObjectName :: T.Text
  , UploadPart -> Bucket
upBucket :: Bucket
  , UploadPart -> Integer
upPartNumber :: Integer
  , UploadPart -> Bucket
upUploadId :: T.Text
  , UploadPart -> Maybe ByteString
upContentType :: Maybe B8.ByteString
  , UploadPart -> Maybe (Digest MD5)
upContentMD5 :: Maybe (CH.Digest CH.MD5)
  , UploadPart -> Maybe ServerSideEncryption
upServerSideEncryption :: Maybe ServerSideEncryption
  , UploadPart -> RequestBody
upRequestBody  :: HTTP.RequestBody
  , UploadPart -> Bool
upExpect100Continue :: Bool -- ^ Note: Requires http-client >= 0.4.10
}

uploadPart :: Bucket -> T.Text -> Integer -> T.Text -> HTTP.RequestBody -> UploadPart
uploadPart :: Bucket -> Bucket -> Integer -> Bucket -> RequestBody -> UploadPart
uploadPart Bucket
bucket Bucket
obj Integer
p Bucket
i RequestBody
body =
  Bucket
-> Bucket
-> Integer
-> Bucket
-> Maybe ByteString
-> Maybe (Digest MD5)
-> Maybe ServerSideEncryption
-> RequestBody
-> Bool
-> UploadPart
UploadPart Bucket
obj Bucket
bucket Integer
p Bucket
i
  Maybe ByteString
forall a. Maybe a
Nothing Maybe (Digest MD5)
forall a. Maybe a
Nothing Maybe ServerSideEncryption
forall a. Maybe a
Nothing RequestBody
body Bool
False

data UploadPartResponse
  = UploadPartResponse {
      UploadPartResponse -> Bucket
uprETag :: !T.Text
    }
  deriving (Int -> UploadPartResponse -> ShowS
[UploadPartResponse] -> ShowS
UploadPartResponse -> String
(Int -> UploadPartResponse -> ShowS)
-> (UploadPartResponse -> String)
-> ([UploadPartResponse] -> ShowS)
-> Show UploadPartResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UploadPartResponse -> ShowS
showsPrec :: Int -> UploadPartResponse -> ShowS
$cshow :: UploadPartResponse -> String
show :: UploadPartResponse -> String
$cshowList :: [UploadPartResponse] -> ShowS
showList :: [UploadPartResponse] -> ShowS
Show)

-- | ServiceConfiguration: 'S3Configuration'
instance SignQuery UploadPart where
    type ServiceConfiguration UploadPart = S3Configuration
    signQuery :: forall queryType.
UploadPart
-> ServiceConfiguration UploadPart queryType
-> SignatureData
-> SignedQuery
signQuery UploadPart {Bool
Integer
Maybe ByteString
Maybe (Digest MD5)
Maybe ServerSideEncryption
Bucket
RequestBody
upObjectName :: UploadPart -> Bucket
upBucket :: UploadPart -> Bucket
upPartNumber :: UploadPart -> Integer
upUploadId :: UploadPart -> Bucket
upContentType :: UploadPart -> Maybe ByteString
upContentMD5 :: UploadPart -> Maybe (Digest MD5)
upServerSideEncryption :: UploadPart -> Maybe ServerSideEncryption
upRequestBody :: UploadPart -> RequestBody
upExpect100Continue :: UploadPart -> Bool
upObjectName :: Bucket
upBucket :: Bucket
upPartNumber :: Integer
upUploadId :: Bucket
upContentType :: Maybe ByteString
upContentMD5 :: Maybe (Digest MD5)
upServerSideEncryption :: Maybe ServerSideEncryption
upRequestBody :: RequestBody
upExpect100Continue :: Bool
..} = S3Query
-> S3Configuration queryType -> SignatureData -> SignedQuery
forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query {
                                 s3QMethod :: Method
s3QMethod = Method
Put
                               , s3QBucket :: Maybe ByteString
s3QBucket = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
upBucket
                               , s3QObject :: Maybe ByteString
s3QObject = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
upObjectName
                               , s3QSubresources :: [(ByteString, Maybe ByteString)]
s3QSubresources = [(ByteString, Maybe Bucket)] -> [(ByteString, Maybe ByteString)]
forall a. QueryLike a => a -> [(ByteString, Maybe ByteString)]
HTTP.toQuery[
                                   (ByteString
"partNumber" :: B8.ByteString , Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just (String -> Bucket
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
upPartNumber)) :: Maybe T.Text)
                                 , (ByteString
"uploadId" :: B8.ByteString, Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just Bucket
upUploadId :: Maybe T.Text)
                                 ]
                               , s3QQuery :: [(ByteString, Maybe ByteString)]
s3QQuery = []
                               , s3QContentType :: Maybe ByteString
s3QContentType = Maybe ByteString
upContentType
                               , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5 = Maybe (Digest MD5)
upContentMD5
                               , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders = ((CI ByteString, Bucket) -> Header)
-> [(CI ByteString, Bucket)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((Bucket -> ByteString) -> (CI ByteString, Bucket) -> Header
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Bucket -> ByteString
T.encodeUtf8) ([(CI ByteString, Bucket)] -> RequestHeaders)
-> [(CI ByteString, Bucket)] -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ [Maybe (CI ByteString, Bucket)] -> [(CI ByteString, Bucket)]
forall a. [Maybe a] -> [a]
catMaybes [
                                   (CI ByteString
"x-amz-server-side-encryption",) (Bucket -> (CI ByteString, Bucket))
-> (ServerSideEncryption -> Bucket)
-> ServerSideEncryption
-> (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerSideEncryption -> Bucket
writeServerSideEncryption (ServerSideEncryption -> (CI ByteString, Bucket))
-> Maybe ServerSideEncryption -> Maybe (CI ByteString, Bucket)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ServerSideEncryption
upServerSideEncryption
                                 ]
                               , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = [Maybe Header] -> RequestHeaders
forall a. [Maybe a] -> [a]
catMaybes [
                                    if Bool
upExpect100Continue
                                        then Header -> Maybe Header
forall a. a -> Maybe a
Just (CI ByteString
"Expect", ByteString
"100-continue")
                                        else Maybe Header
forall a. Maybe a
Nothing
                                 ]
                               , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just RequestBody
upRequestBody
                               }

instance ResponseConsumer UploadPart UploadPartResponse where
    type ResponseMetadata UploadPartResponse = S3Metadata
    responseConsumer :: Request
-> UploadPart
-> IORef (ResponseMetadata UploadPartResponse)
-> HTTPResponseConsumer UploadPartResponse
responseConsumer Request
_ UploadPart
_ = HTTPResponseConsumer UploadPartResponse
-> IORef S3Metadata -> HTTPResponseConsumer UploadPartResponse
forall a.
HTTPResponseConsumer a
-> IORef S3Metadata -> HTTPResponseConsumer a
s3ResponseConsumer (HTTPResponseConsumer UploadPartResponse
 -> IORef S3Metadata -> HTTPResponseConsumer UploadPartResponse)
-> HTTPResponseConsumer UploadPartResponse
-> IORef S3Metadata
-> HTTPResponseConsumer UploadPartResponse
forall a b. (a -> b) -> a -> b
$ \Response (ConduitM () ByteString (ResourceT IO) ())
resp -> do
      let etag :: Bucket
etag = Bucket -> Maybe Bucket -> Bucket
forall a. a -> Maybe a -> a
fromMaybe Bucket
"" (Maybe Bucket -> Bucket) -> Maybe Bucket -> Bucket
forall a b. (a -> b) -> a -> b
$ ByteString -> Bucket
T.decodeUtf8 (ByteString -> Bucket) -> Maybe ByteString -> Maybe Bucket
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"ETag" (Response (ConduitM () ByteString (ResourceT IO) ())
-> RequestHeaders
forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
resp)
      UploadPartResponse -> ResourceT IO UploadPartResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UploadPartResponse -> ResourceT IO UploadPartResponse)
-> UploadPartResponse -> ResourceT IO UploadPartResponse
forall a b. (a -> b) -> a -> b
$ Bucket -> UploadPartResponse
UploadPartResponse Bucket
etag

instance Transaction UploadPart UploadPartResponse

instance AsMemoryResponse UploadPartResponse where
    type MemoryResponse UploadPartResponse = UploadPartResponse
    loadToMemory :: UploadPartResponse
-> ResourceT IO (MemoryResponse UploadPartResponse)
loadToMemory = UploadPartResponse
-> ResourceT IO (MemoryResponse UploadPartResponse)
UploadPartResponse -> ResourceT IO UploadPartResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

----------------------------



data CompleteMultipartUpload
  = CompleteMultipartUpload {
      CompleteMultipartUpload -> Bucket
cmuBucket :: Bucket
    , CompleteMultipartUpload -> Bucket
cmuObjectName :: Object
    , CompleteMultipartUpload -> Bucket
cmuUploadId :: T.Text
    , CompleteMultipartUpload -> [(Integer, Bucket)]
cmuPartNumberAndEtags :: [(Integer,T.Text)]
    , CompleteMultipartUpload -> Maybe Bucket
cmuExpiration :: Maybe T.Text
    , CompleteMultipartUpload -> Maybe Bucket
cmuServerSideEncryption :: Maybe T.Text
    , CompleteMultipartUpload -> Maybe Bucket
cmuServerSideEncryptionCustomerAlgorithm :: Maybe T.Text
    }
  deriving (Int -> CompleteMultipartUpload -> ShowS
[CompleteMultipartUpload] -> ShowS
CompleteMultipartUpload -> String
(Int -> CompleteMultipartUpload -> ShowS)
-> (CompleteMultipartUpload -> String)
-> ([CompleteMultipartUpload] -> ShowS)
-> Show CompleteMultipartUpload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompleteMultipartUpload -> ShowS
showsPrec :: Int -> CompleteMultipartUpload -> ShowS
$cshow :: CompleteMultipartUpload -> String
show :: CompleteMultipartUpload -> String
$cshowList :: [CompleteMultipartUpload] -> ShowS
showList :: [CompleteMultipartUpload] -> ShowS
Show)

postCompleteMultipartUpload :: Bucket -> T.Text -> T.Text -> [(Integer,T.Text)]-> CompleteMultipartUpload
postCompleteMultipartUpload :: Bucket
-> Bucket
-> Bucket
-> [(Integer, Bucket)]
-> CompleteMultipartUpload
postCompleteMultipartUpload Bucket
b Bucket
o Bucket
i [(Integer, Bucket)]
p = Bucket
-> Bucket
-> Bucket
-> [(Integer, Bucket)]
-> Maybe Bucket
-> Maybe Bucket
-> Maybe Bucket
-> CompleteMultipartUpload
CompleteMultipartUpload Bucket
b Bucket
o Bucket
i [(Integer, Bucket)]
p Maybe Bucket
forall a. Maybe a
Nothing  Maybe Bucket
forall a. Maybe a
Nothing  Maybe Bucket
forall a. Maybe a
Nothing

data CompleteMultipartUploadResponse
  = CompleteMultipartUploadResponse {
      CompleteMultipartUploadResponse -> Bucket
cmurLocation :: !T.Text
    , CompleteMultipartUploadResponse -> Bucket
cmurBucket   :: !Bucket
    , CompleteMultipartUploadResponse -> Bucket
cmurKey      :: !T.Text
    , CompleteMultipartUploadResponse -> Bucket
cmurETag     :: !T.Text
    , CompleteMultipartUploadResponse -> Maybe Bucket
cmurVersionId :: !(Maybe T.Text)
    } deriving (Int -> CompleteMultipartUploadResponse -> ShowS
[CompleteMultipartUploadResponse] -> ShowS
CompleteMultipartUploadResponse -> String
(Int -> CompleteMultipartUploadResponse -> ShowS)
-> (CompleteMultipartUploadResponse -> String)
-> ([CompleteMultipartUploadResponse] -> ShowS)
-> Show CompleteMultipartUploadResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompleteMultipartUploadResponse -> ShowS
showsPrec :: Int -> CompleteMultipartUploadResponse -> ShowS
$cshow :: CompleteMultipartUploadResponse -> String
show :: CompleteMultipartUploadResponse -> String
$cshowList :: [CompleteMultipartUploadResponse] -> ShowS
showList :: [CompleteMultipartUploadResponse] -> ShowS
Show)

-- | ServiceConfiguration: 'S3Configuration'
instance SignQuery CompleteMultipartUpload where
    type ServiceConfiguration CompleteMultipartUpload = S3Configuration
    signQuery :: forall queryType.
CompleteMultipartUpload
-> ServiceConfiguration CompleteMultipartUpload queryType
-> SignatureData
-> SignedQuery
signQuery CompleteMultipartUpload {[(Integer, Bucket)]
Maybe Bucket
Bucket
cmuBucket :: CompleteMultipartUpload -> Bucket
cmuObjectName :: CompleteMultipartUpload -> Bucket
cmuUploadId :: CompleteMultipartUpload -> Bucket
cmuPartNumberAndEtags :: CompleteMultipartUpload -> [(Integer, Bucket)]
cmuExpiration :: CompleteMultipartUpload -> Maybe Bucket
cmuServerSideEncryption :: CompleteMultipartUpload -> Maybe Bucket
cmuServerSideEncryptionCustomerAlgorithm :: CompleteMultipartUpload -> Maybe Bucket
cmuBucket :: Bucket
cmuObjectName :: Bucket
cmuUploadId :: Bucket
cmuPartNumberAndEtags :: [(Integer, Bucket)]
cmuExpiration :: Maybe Bucket
cmuServerSideEncryption :: Maybe Bucket
cmuServerSideEncryptionCustomerAlgorithm :: Maybe Bucket
..} = S3Query
-> S3Configuration queryType -> SignatureData -> SignedQuery
forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query {
      s3QMethod :: Method
s3QMethod = Method
Post
      , s3QBucket :: Maybe ByteString
s3QBucket = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
cmuBucket
      , s3QObject :: Maybe ByteString
s3QObject = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
cmuObjectName
      , s3QSubresources :: [(ByteString, Maybe ByteString)]
s3QSubresources = [(ByteString, Maybe Bucket)] -> [(ByteString, Maybe ByteString)]
forall a. QueryLike a => a -> [(ByteString, Maybe ByteString)]
HTTP.toQuery[
        (ByteString
"uploadId" :: B8.ByteString, Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just Bucket
cmuUploadId :: Maybe T.Text)
        ]
      , s3QQuery :: [(ByteString, Maybe ByteString)]
s3QQuery = []
      , s3QContentType :: Maybe ByteString
s3QContentType = Maybe ByteString
forall a. Maybe a
Nothing
      , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5 = Maybe (Digest MD5)
forall a. Maybe a
Nothing
      , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders = [Maybe Header] -> RequestHeaders
forall a. [Maybe a] -> [a]
catMaybes [ (CI ByteString
"x-amz-expiration",) (ByteString -> Header) -> Maybe ByteString -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bucket -> ByteString
T.encodeUtf8 (Bucket -> ByteString) -> Maybe Bucket -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
cmuExpiration)
                                  , (CI ByteString
"x-amz-server-side-encryption",) (ByteString -> Header) -> Maybe ByteString -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bucket -> ByteString
T.encodeUtf8 (Bucket -> ByteString) -> Maybe Bucket -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
cmuServerSideEncryption)
                                  , (CI ByteString
"x-amz-server-side-encryption-customer-algorithm",)
                                    (ByteString -> Header) -> Maybe ByteString -> Maybe Header
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bucket -> ByteString
T.encodeUtf8 (Bucket -> ByteString) -> Maybe Bucket -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bucket
cmuServerSideEncryptionCustomerAlgorithm)
                                  ]
      , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = []
      , s3QRequestBody :: Maybe RequestBody
s3QRequestBody  = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just (RequestBody -> Maybe RequestBody)
-> RequestBody -> Maybe RequestBody
forall a b. (a -> b) -> a -> b
$ ByteString -> RequestBody
HTTP.RequestBodyLBS ByteString
reqBody
      }
        where reqBody :: ByteString
reqBody = RenderSettings -> Document -> ByteString
XML.renderLBS RenderSettings
forall a. Default a => a
XML.def XML.Document {
                    documentPrologue :: Prologue
XML.documentPrologue = [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
XML.Prologue [] Maybe Doctype
forall a. Maybe a
Nothing []
                  , documentRoot :: Element
XML.documentRoot = Element
root
                  , documentEpilogue :: [Miscellaneous]
XML.documentEpilogue = []
                  }
              root :: Element
root = XML.Element {
                    elementName :: Name
XML.elementName = Name
"CompleteMultipartUpload"
                  , elementAttributes :: Map Name Bucket
XML.elementAttributes = Map Name Bucket
forall k a. Map k a
M.empty
                  , elementNodes :: [Node]
XML.elementNodes = ((Integer, Bucket) -> Node
forall {a}. Show a => (a, Bucket) -> Node
partNode ((Integer, Bucket) -> Node) -> [(Integer, Bucket)] -> [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Integer, Bucket)]
cmuPartNumberAndEtags)
                  }
              partNode :: (a, Bucket) -> Node
partNode (a
partNumber, Bucket
etag) = Element -> Node
XML.NodeElement XML.Element {
                    elementName :: Name
XML.elementName = Name
"Part"
                  , elementAttributes :: Map Name Bucket
XML.elementAttributes = Map Name Bucket
forall k a. Map k a
M.empty
                  , elementNodes :: [Node]
XML.elementNodes = [Bucket -> Node
keyNode (String -> Bucket
T.pack (a -> String
forall a. Show a => a -> String
show a
partNumber)),Bucket -> Node
etagNode Bucket
etag]
                  }
              etagNode :: Bucket -> Node
etagNode = Name -> Bucket -> Node
toNode Name
"ETag"
              keyNode :: Bucket -> Node
keyNode     = Name -> Bucket -> Node
toNode Name
"PartNumber"
              toNode :: Name -> Bucket -> Node
toNode Name
name Bucket
content = Element -> Node
XML.NodeElement XML.Element {
                    elementName :: Name
XML.elementName = Name
name
                  , elementAttributes :: Map Name Bucket
XML.elementAttributes = Map Name Bucket
forall k a. Map k a
M.empty
                  , elementNodes :: [Node]
XML.elementNodes = [Bucket -> Node
XML.NodeContent Bucket
content]
                  }

instance ResponseConsumer r CompleteMultipartUploadResponse where
    type ResponseMetadata CompleteMultipartUploadResponse = S3Metadata

    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata CompleteMultipartUploadResponse)
-> HTTPResponseConsumer CompleteMultipartUploadResponse
responseConsumer Request
_ r
_ IORef (ResponseMetadata CompleteMultipartUploadResponse)
metadata Response (ConduitM () ByteString (ResourceT IO) ())
resp = (Cursor -> Response S3Metadata CompleteMultipartUploadResponse)
-> IORef S3Metadata
-> HTTPResponseConsumer CompleteMultipartUploadResponse
forall a.
(Cursor -> Response S3Metadata a)
-> IORef S3Metadata -> HTTPResponseConsumer a
s3XmlResponseConsumer Cursor -> Response S3Metadata CompleteMultipartUploadResponse
parse IORef (ResponseMetadata CompleteMultipartUploadResponse)
IORef S3Metadata
metadata Response (ConduitM () ByteString (ResourceT IO) ())
resp
        where vid :: Maybe Bucket
vid = ByteString -> Bucket
T.decodeUtf8 (ByteString -> Bucket) -> Maybe ByteString -> Maybe Bucket
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CI ByteString -> RequestHeaders -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"x-amz-version-id" (Response (ConduitM () ByteString (ResourceT IO) ())
-> RequestHeaders
forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
resp)
              parse :: Cursor -> Response S3Metadata CompleteMultipartUploadResponse
parse Cursor
cursor
                  = do Bucket
location <- String -> [Bucket] -> Response S3Metadata Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Location" ([Bucket] -> Response S3Metadata Bucket)
-> [Bucket] -> Response S3Metadata Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Location"
                       Bucket
bucket <- String -> [Bucket] -> Response S3Metadata Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Bucket Name" ([Bucket] -> Response S3Metadata Bucket)
-> [Bucket] -> Response S3Metadata Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Bucket"
                       Bucket
key <- String -> [Bucket] -> Response S3Metadata Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing Key" ([Bucket] -> Response S3Metadata Bucket)
-> [Bucket] -> Response S3Metadata Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"Key"
                       Bucket
etag <- String -> [Bucket] -> Response S3Metadata Bucket
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing ETag" ([Bucket] -> Response S3Metadata Bucket)
-> [Bucket] -> Response S3Metadata Bucket
forall a b. (a -> b) -> a -> b
$ Cursor
cursor Cursor -> (Cursor -> [Bucket]) -> [Bucket]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Bucket -> Cursor -> [Bucket]
elContent Bucket
"ETag"
                       CompleteMultipartUploadResponse
-> Response S3Metadata CompleteMultipartUploadResponse
forall a. a -> Response S3Metadata a
forall (m :: * -> *) a. Monad m => a -> m a
return CompleteMultipartUploadResponse{
                                                cmurLocation :: Bucket
cmurLocation       = Bucket
location
                                              , cmurBucket :: Bucket
cmurBucket         = Bucket
bucket
                                              , cmurKey :: Bucket
cmurKey            = Bucket
key
                                              , cmurETag :: Bucket
cmurETag           = Bucket
etag
                                              , cmurVersionId :: Maybe Bucket
cmurVersionId      = Maybe Bucket
vid
                                              }

instance Transaction CompleteMultipartUpload CompleteMultipartUploadResponse

instance AsMemoryResponse CompleteMultipartUploadResponse where
    type MemoryResponse CompleteMultipartUploadResponse = CompleteMultipartUploadResponse
    loadToMemory :: CompleteMultipartUploadResponse
-> ResourceT IO (MemoryResponse CompleteMultipartUploadResponse)
loadToMemory = CompleteMultipartUploadResponse
-> ResourceT IO (MemoryResponse CompleteMultipartUploadResponse)
CompleteMultipartUploadResponse
-> ResourceT IO CompleteMultipartUploadResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

----------------------------



data AbortMultipartUpload
  = AbortMultipartUpload {
      AbortMultipartUpload -> Bucket
amuBucket :: Bucket
    , AbortMultipartUpload -> Bucket
amuObjectName :: Object
    , AbortMultipartUpload -> Bucket
amuUploadId :: T.Text
    }
  deriving (Int -> AbortMultipartUpload -> ShowS
[AbortMultipartUpload] -> ShowS
AbortMultipartUpload -> String
(Int -> AbortMultipartUpload -> ShowS)
-> (AbortMultipartUpload -> String)
-> ([AbortMultipartUpload] -> ShowS)
-> Show AbortMultipartUpload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbortMultipartUpload -> ShowS
showsPrec :: Int -> AbortMultipartUpload -> ShowS
$cshow :: AbortMultipartUpload -> String
show :: AbortMultipartUpload -> String
$cshowList :: [AbortMultipartUpload] -> ShowS
showList :: [AbortMultipartUpload] -> ShowS
Show)

postAbortMultipartUpload :: Bucket -> T.Text -> T.Text -> AbortMultipartUpload
postAbortMultipartUpload :: Bucket -> Bucket -> Bucket -> AbortMultipartUpload
postAbortMultipartUpload Bucket
b Bucket
o Bucket
i = Bucket -> Bucket -> Bucket -> AbortMultipartUpload
AbortMultipartUpload Bucket
b Bucket
o Bucket
i

data AbortMultipartUploadResponse
  = AbortMultipartUploadResponse {
    } deriving (Int -> AbortMultipartUploadResponse -> ShowS
[AbortMultipartUploadResponse] -> ShowS
AbortMultipartUploadResponse -> String
(Int -> AbortMultipartUploadResponse -> ShowS)
-> (AbortMultipartUploadResponse -> String)
-> ([AbortMultipartUploadResponse] -> ShowS)
-> Show AbortMultipartUploadResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbortMultipartUploadResponse -> ShowS
showsPrec :: Int -> AbortMultipartUploadResponse -> ShowS
$cshow :: AbortMultipartUploadResponse -> String
show :: AbortMultipartUploadResponse -> String
$cshowList :: [AbortMultipartUploadResponse] -> ShowS
showList :: [AbortMultipartUploadResponse] -> ShowS
Show)

-- | ServiceConfiguration: 'S3Configuration'
instance SignQuery AbortMultipartUpload where
    type ServiceConfiguration AbortMultipartUpload = S3Configuration
    signQuery :: forall queryType.
AbortMultipartUpload
-> ServiceConfiguration AbortMultipartUpload queryType
-> SignatureData
-> SignedQuery
signQuery AbortMultipartUpload {Bucket
amuBucket :: AbortMultipartUpload -> Bucket
amuObjectName :: AbortMultipartUpload -> Bucket
amuUploadId :: AbortMultipartUpload -> Bucket
amuBucket :: Bucket
amuObjectName :: Bucket
amuUploadId :: Bucket
..} = S3Query
-> S3Configuration queryType -> SignatureData -> SignedQuery
forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query {
      s3QMethod :: Method
s3QMethod = Method
Delete
      , s3QBucket :: Maybe ByteString
s3QBucket = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
amuBucket
      , s3QObject :: Maybe ByteString
s3QObject = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Bucket -> ByteString
T.encodeUtf8 Bucket
amuObjectName
      , s3QSubresources :: [(ByteString, Maybe ByteString)]
s3QSubresources = [(ByteString, Maybe Bucket)] -> [(ByteString, Maybe ByteString)]
forall a. QueryLike a => a -> [(ByteString, Maybe ByteString)]
HTTP.toQuery[
        (ByteString
"uploadId" :: B8.ByteString, Bucket -> Maybe Bucket
forall a. a -> Maybe a
Just Bucket
amuUploadId :: Maybe T.Text)
        ]
      , s3QQuery :: [(ByteString, Maybe ByteString)]
s3QQuery = []
      , s3QContentType :: Maybe ByteString
s3QContentType = Maybe ByteString
forall a. Maybe a
Nothing
      , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5 = Maybe (Digest MD5)
forall a. Maybe a
Nothing
      , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders = []
      , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = []
      , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = Maybe RequestBody
forall a. Maybe a
Nothing
      }

instance ResponseConsumer r AbortMultipartUploadResponse where
    type ResponseMetadata AbortMultipartUploadResponse = S3Metadata

    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata AbortMultipartUploadResponse)
-> HTTPResponseConsumer AbortMultipartUploadResponse
responseConsumer Request
_ r
_ = (Cursor -> Response S3Metadata AbortMultipartUploadResponse)
-> IORef S3Metadata
-> HTTPResponseConsumer AbortMultipartUploadResponse
forall a.
(Cursor -> Response S3Metadata a)
-> IORef S3Metadata -> HTTPResponseConsumer a
s3XmlResponseConsumer Cursor -> Response S3Metadata AbortMultipartUploadResponse
forall {m :: * -> *} {p}.
Monad m =>
p -> m AbortMultipartUploadResponse
parse
        where parse :: p -> m AbortMultipartUploadResponse
parse p
_cursor
                  = AbortMultipartUploadResponse -> m AbortMultipartUploadResponse
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return AbortMultipartUploadResponse {}

instance Transaction AbortMultipartUpload AbortMultipartUploadResponse


instance AsMemoryResponse AbortMultipartUploadResponse where
    type MemoryResponse AbortMultipartUploadResponse = AbortMultipartUploadResponse
    loadToMemory :: AbortMultipartUploadResponse
-> ResourceT IO (MemoryResponse AbortMultipartUploadResponse)
loadToMemory = AbortMultipartUploadResponse
-> ResourceT IO (MemoryResponse AbortMultipartUploadResponse)
AbortMultipartUploadResponse
-> ResourceT IO AbortMultipartUploadResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return


----------------------------

getUploadId ::
  Configuration
  -> S3Configuration NormalQuery
  -> HTTP.Manager
  -> T.Text
  -> T.Text
  -> IO T.Text
getUploadId :: Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> IO Bucket
getUploadId Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object = do
  InitiateMultipartUploadResponse {
      imurBucket :: InitiateMultipartUploadResponse -> Bucket
imurBucket = Bucket
_bucket
    , imurKey :: InitiateMultipartUploadResponse -> Bucket
imurKey = Bucket
_object'
    , imurUploadId :: InitiateMultipartUploadResponse -> Bucket
imurUploadId = Bucket
uploadId
    } <- Configuration
-> ServiceConfiguration InitiateMultipartUpload NormalQuery
-> Manager
-> InitiateMultipartUpload
-> IO (MemoryResponse InitiateMultipartUploadResponse)
forall r a (io :: * -> *).
(Transaction r a, AsMemoryResponse a, MonadIO io) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> io (MemoryResponse a)
memoryAws Configuration
cfg ServiceConfiguration InitiateMultipartUpload NormalQuery
S3Configuration NormalQuery
s3cfg Manager
mgr (InitiateMultipartUpload
 -> IO (MemoryResponse InitiateMultipartUploadResponse))
-> InitiateMultipartUpload
-> IO (MemoryResponse InitiateMultipartUploadResponse)
forall a b. (a -> b) -> a -> b
$ Bucket -> Bucket -> InitiateMultipartUpload
postInitiateMultipartUpload Bucket
bucket Bucket
object
  Bucket -> IO Bucket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bucket
uploadId


sendEtag  ::
  Configuration
  -> S3Configuration NormalQuery
  -> HTTP.Manager
  -> T.Text
  -> T.Text
  -> T.Text
  -> [T.Text]
  -> IO CompleteMultipartUploadResponse
sendEtag :: Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> [Bucket]
-> IO CompleteMultipartUploadResponse
sendEtag Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId [Bucket]
etags = do
  Configuration
-> ServiceConfiguration CompleteMultipartUpload NormalQuery
-> Manager
-> CompleteMultipartUpload
-> IO (MemoryResponse CompleteMultipartUploadResponse)
forall r a (io :: * -> *).
(Transaction r a, AsMemoryResponse a, MonadIO io) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> io (MemoryResponse a)
memoryAws Configuration
cfg ServiceConfiguration CompleteMultipartUpload NormalQuery
S3Configuration NormalQuery
s3cfg Manager
mgr (CompleteMultipartUpload
 -> IO (MemoryResponse CompleteMultipartUploadResponse))
-> CompleteMultipartUpload
-> IO (MemoryResponse CompleteMultipartUploadResponse)
forall a b. (a -> b) -> a -> b
$
       Bucket
-> Bucket
-> Bucket
-> [(Integer, Bucket)]
-> CompleteMultipartUpload
postCompleteMultipartUpload Bucket
bucket Bucket
object Bucket
uploadId ([Integer] -> [Bucket] -> [(Integer, Bucket)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Bucket]
etags)

putConduit ::
  MonadResource m =>
  Configuration
  -> S3Configuration NormalQuery
  -> HTTP.Manager
  -> T.Text
  -> T.Text
  -> T.Text
  -> ConduitT BL.ByteString T.Text m ()
putConduit :: forall (m :: * -> *).
MonadResource m =>
Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> ConduitT ByteString Bucket m ()
putConduit Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId = Integer -> ConduitT ByteString Bucket m ()
loop Integer
1
  where
    loop :: Integer -> ConduitT ByteString Bucket m ()
loop Integer
n = do
      Maybe ByteString
v' <- ConduitT ByteString Bucket m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
      case Maybe ByteString
v' of
        Just ByteString
v -> do
          UploadPartResponse Bucket
etag <- Configuration
-> ServiceConfiguration UploadPart NormalQuery
-> Manager
-> UploadPart
-> ConduitT ByteString Bucket m (MemoryResponse UploadPartResponse)
forall r a (io :: * -> *).
(Transaction r a, AsMemoryResponse a, MonadIO io) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> io (MemoryResponse a)
memoryAws Configuration
cfg ServiceConfiguration UploadPart NormalQuery
S3Configuration NormalQuery
s3cfg Manager
mgr (UploadPart
 -> ConduitT
      ByteString Bucket m (MemoryResponse UploadPartResponse))
-> UploadPart
-> ConduitT ByteString Bucket m (MemoryResponse UploadPartResponse)
forall a b. (a -> b) -> a -> b
$
            Bucket -> Bucket -> Integer -> Bucket -> RequestBody -> UploadPart
uploadPart Bucket
bucket Bucket
object Integer
n Bucket
uploadId (ByteString -> RequestBody
HTTP.RequestBodyLBS ByteString
v)
          Bucket -> ConduitT ByteString Bucket m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Bucket
etag
          Integer -> ConduitT ByteString Bucket m ()
loop (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
        Maybe ByteString
Nothing -> () -> ConduitT ByteString Bucket m ()
forall a. a -> ConduitT ByteString Bucket m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

chunkedConduit :: (MonadResource m) => Integer -> ConduitT B8.ByteString BL.ByteString m ()
chunkedConduit :: forall (m :: * -> *).
MonadResource m =>
Integer -> ConduitT ByteString ByteString m ()
chunkedConduit Integer
size = Integer -> [ByteString] -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Integer -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Integer
0 []
  where
    loop :: Monad m => Integer -> [B8.ByteString] -> ConduitT B8.ByteString BL.ByteString m ()
    loop :: forall (m :: * -> *).
Monad m =>
Integer -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Integer
cnt [ByteString]
str = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> (a -> ConduitT ByteString ByteString m b)
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([ByteString] -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i.
Monad m =>
[ByteString] -> ConduitT i ByteString m ()
yieldChunk [ByteString]
str) ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
ByteString -> ConduitT ByteString ByteString m ()
go
      where
        go :: Monad m => B8.ByteString -> ConduitT B8.ByteString BL.ByteString m ()
        go :: forall (m :: * -> *).
Monad m =>
ByteString -> ConduitT ByteString ByteString m ()
go ByteString
line
          | Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
len = [ByteString] -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i.
Monad m =>
[ByteString] -> ConduitT i ByteString m ()
yieldChunk [ByteString]
newStr ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b.
ConduitT ByteString ByteString m a
-> ConduitT ByteString ByteString m b
-> ConduitT ByteString ByteString m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> [ByteString] -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Integer -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Integer
0 []
          | Bool
otherwise   = Integer -> [ByteString] -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Integer -> [ByteString] -> ConduitT ByteString ByteString m ()
loop Integer
len [ByteString]
newStr
          where
            len :: Integer
len = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B8.length ByteString
line) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
cnt
            newStr :: [ByteString]
newStr = ByteString
lineByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
str

    yieldChunk :: Monad m => [B8.ByteString] -> ConduitT i BL.ByteString m ()
    yieldChunk :: forall (m :: * -> *) i.
Monad m =>
[ByteString] -> ConduitT i ByteString m ()
yieldChunk = ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (ByteString -> ConduitT i ByteString m ())
-> ([ByteString] -> ByteString)
-> [ByteString]
-> ConduitT i ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> ([ByteString] -> [ByteString]) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse

multipartUpload ::
  Configuration
  -> S3Configuration NormalQuery
  -> HTTP.Manager
  -> T.Text
  -> T.Text
  -> ConduitT () B8.ByteString (ResourceT IO) ()
  -> Integer
  -> ResourceT IO ()
multipartUpload :: Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> ConduitM () ByteString (ResourceT IO) ()
-> Integer
-> ResourceT IO ()
multipartUpload Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object ConduitM () ByteString (ResourceT IO) ()
src Integer
chunkSize = do
  Bucket
uploadId <- IO Bucket -> ResourceT IO Bucket
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bucket -> ResourceT IO Bucket)
-> IO Bucket -> ResourceT IO Bucket
forall a b. (a -> b) -> a -> b
$ Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> IO Bucket
getUploadId Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object
  [Bucket]
etags <- (ConduitM () ByteString (ResourceT IO) ()
src
           ConduitM () ByteString (ResourceT IO) ()
-> ConduitT ByteString Bucket (ResourceT IO) ()
-> ConduitT () Bucket (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Integer -> ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
Integer -> ConduitT ByteString ByteString m ()
chunkedConduit Integer
chunkSize
           ConduitT ByteString ByteString (ResourceT IO) ()
-> ConduitT ByteString Bucket (ResourceT IO) ()
-> ConduitT ByteString Bucket (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> ConduitT ByteString Bucket (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> ConduitT ByteString Bucket m ()
putConduit Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId
           ) ConduitT () Bucket (ResourceT IO) ()
-> ConduitT Bucket Void (ResourceT IO) [Bucket]
-> ResourceT IO [Bucket]
forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
`connect` ConduitT Bucket Void (ResourceT IO) [Bucket]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
  ResourceT IO CompleteMultipartUploadResponse -> ResourceT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT IO CompleteMultipartUploadResponse -> ResourceT IO ())
-> ResourceT IO CompleteMultipartUploadResponse -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ IO CompleteMultipartUploadResponse
-> ResourceT IO CompleteMultipartUploadResponse
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompleteMultipartUploadResponse
 -> ResourceT IO CompleteMultipartUploadResponse)
-> IO CompleteMultipartUploadResponse
-> ResourceT IO CompleteMultipartUploadResponse
forall a b. (a -> b) -> a -> b
$ Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> [Bucket]
-> IO CompleteMultipartUploadResponse
sendEtag Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId [Bucket]
etags

multipartUploadSink :: MonadResource m
  => Configuration
  -> S3Configuration NormalQuery
  -> HTTP.Manager
  -> T.Text    -- ^ Bucket name
  -> T.Text    -- ^ Object name
  -> Integer   -- ^ chunkSize (minimum: 5MB)
  -> ConduitT B8.ByteString Void m ()
multipartUploadSink :: forall (m :: * -> *).
MonadResource m =>
Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Integer
-> ConduitT ByteString Void m ()
multipartUploadSink Configuration
cfg S3Configuration NormalQuery
s3cfg = Configuration
-> S3Configuration NormalQuery
-> (Bucket -> Bucket -> InitiateMultipartUpload)
-> Manager
-> Bucket
-> Bucket
-> Integer
-> ConduitT ByteString Void m ()
forall (m :: * -> *).
MonadResource m =>
Configuration
-> S3Configuration NormalQuery
-> (Bucket -> Bucket -> InitiateMultipartUpload)
-> Manager
-> Bucket
-> Bucket
-> Integer
-> ConduitT ByteString Void m ()
multipartUploadSinkWithInitiator Configuration
cfg S3Configuration NormalQuery
s3cfg Bucket -> Bucket -> InitiateMultipartUpload
postInitiateMultipartUpload

multipartUploadWithInitiator ::
  Configuration
  -> S3Configuration NormalQuery
  -> (Bucket -> T.Text -> InitiateMultipartUpload)
  -> HTTP.Manager
  -> T.Text
  -> T.Text
  -> ConduitT () B8.ByteString (ResourceT IO) ()
  -> Integer
  -> ResourceT IO ()
multipartUploadWithInitiator :: Configuration
-> S3Configuration NormalQuery
-> (Bucket -> Bucket -> InitiateMultipartUpload)
-> Manager
-> Bucket
-> Bucket
-> ConduitM () ByteString (ResourceT IO) ()
-> Integer
-> ResourceT IO ()
multipartUploadWithInitiator Configuration
cfg S3Configuration NormalQuery
s3cfg Bucket -> Bucket -> InitiateMultipartUpload
initiator Manager
mgr Bucket
bucket Bucket
object ConduitM () ByteString (ResourceT IO) ()
src Integer
chunkSize = do
  Bucket
uploadId <- IO Bucket -> ResourceT IO Bucket
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bucket -> ResourceT IO Bucket)
-> IO Bucket -> ResourceT IO Bucket
forall a b. (a -> b) -> a -> b
$ InitiateMultipartUploadResponse -> Bucket
imurUploadId (InitiateMultipartUploadResponse -> Bucket)
-> IO InitiateMultipartUploadResponse -> IO Bucket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration
-> ServiceConfiguration InitiateMultipartUpload NormalQuery
-> Manager
-> InitiateMultipartUpload
-> IO (MemoryResponse InitiateMultipartUploadResponse)
forall r a (io :: * -> *).
(Transaction r a, AsMemoryResponse a, MonadIO io) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> io (MemoryResponse a)
memoryAws Configuration
cfg ServiceConfiguration InitiateMultipartUpload NormalQuery
S3Configuration NormalQuery
s3cfg Manager
mgr (Bucket -> Bucket -> InitiateMultipartUpload
initiator Bucket
bucket Bucket
object)
  [Bucket]
etags <- (ConduitM () ByteString (ResourceT IO) ()
src
           ConduitM () ByteString (ResourceT IO) ()
-> ConduitT ByteString Bucket (ResourceT IO) ()
-> ConduitT () Bucket (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Integer -> ConduitT ByteString ByteString (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
Integer -> ConduitT ByteString ByteString m ()
chunkedConduit Integer
chunkSize
           ConduitT ByteString ByteString (ResourceT IO) ()
-> ConduitT ByteString Bucket (ResourceT IO) ()
-> ConduitT ByteString Bucket (ResourceT IO) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> ConduitT ByteString Bucket (ResourceT IO) ()
forall (m :: * -> *).
MonadResource m =>
Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> ConduitT ByteString Bucket m ()
putConduit Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId
           ) ConduitT () Bucket (ResourceT IO) ()
-> ConduitT Bucket Void (ResourceT IO) [Bucket]
-> ResourceT IO [Bucket]
forall (m :: * -> *) a r.
Monad m =>
ConduitT () a m () -> ConduitT a Void m r -> m r
`connect` ConduitT Bucket Void (ResourceT IO) [Bucket]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
  ResourceT IO CompleteMultipartUploadResponse -> ResourceT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResourceT IO CompleteMultipartUploadResponse -> ResourceT IO ())
-> ResourceT IO CompleteMultipartUploadResponse -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ IO CompleteMultipartUploadResponse
-> ResourceT IO CompleteMultipartUploadResponse
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompleteMultipartUploadResponse
 -> ResourceT IO CompleteMultipartUploadResponse)
-> IO CompleteMultipartUploadResponse
-> ResourceT IO CompleteMultipartUploadResponse
forall a b. (a -> b) -> a -> b
$ Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> [Bucket]
-> IO CompleteMultipartUploadResponse
sendEtag Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId [Bucket]
etags

multipartUploadSinkWithInitiator :: MonadResource m
  => Configuration
  -> S3Configuration NormalQuery
  -> (Bucket -> T.Text -> InitiateMultipartUpload) -- ^ Initiator
  -> HTTP.Manager
  -> T.Text    -- ^ Bucket name
  -> T.Text    -- ^ Object name
  -> Integer   -- ^ chunkSize (minimum: 5MB)
  -> ConduitT B8.ByteString Void m ()
multipartUploadSinkWithInitiator :: forall (m :: * -> *).
MonadResource m =>
Configuration
-> S3Configuration NormalQuery
-> (Bucket -> Bucket -> InitiateMultipartUpload)
-> Manager
-> Bucket
-> Bucket
-> Integer
-> ConduitT ByteString Void m ()
multipartUploadSinkWithInitiator Configuration
cfg S3Configuration NormalQuery
s3cfg Bucket -> Bucket -> InitiateMultipartUpload
initiator Manager
mgr Bucket
bucket Bucket
object Integer
chunkSize = do
  Bucket
uploadId <- IO Bucket -> ConduitT ByteString Void m Bucket
forall a. IO a -> ConduitT ByteString Void m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bucket -> ConduitT ByteString Void m Bucket)
-> IO Bucket -> ConduitT ByteString Void m Bucket
forall a b. (a -> b) -> a -> b
$ InitiateMultipartUploadResponse -> Bucket
imurUploadId (InitiateMultipartUploadResponse -> Bucket)
-> IO InitiateMultipartUploadResponse -> IO Bucket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Configuration
-> ServiceConfiguration InitiateMultipartUpload NormalQuery
-> Manager
-> InitiateMultipartUpload
-> IO (MemoryResponse InitiateMultipartUploadResponse)
forall r a (io :: * -> *).
(Transaction r a, AsMemoryResponse a, MonadIO io) =>
Configuration
-> ServiceConfiguration r NormalQuery
-> Manager
-> r
-> io (MemoryResponse a)
memoryAws Configuration
cfg ServiceConfiguration InitiateMultipartUpload NormalQuery
S3Configuration NormalQuery
s3cfg Manager
mgr (Bucket -> Bucket -> InitiateMultipartUpload
initiator Bucket
bucket Bucket
object)
  [Bucket]
etags <- Integer -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadResource m =>
Integer -> ConduitT ByteString ByteString m ()
chunkedConduit Integer
chunkSize
           ConduitT ByteString ByteString m ()
-> ConduitT ByteString Void m [Bucket]
-> ConduitT ByteString Void m [Bucket]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> ConduitT ByteString Bucket m ()
forall (m :: * -> *).
MonadResource m =>
Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> ConduitT ByteString Bucket m ()
putConduit Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId
           ConduitT ByteString Bucket m ()
-> ConduitT Bucket Void m [Bucket]
-> ConduitT ByteString Void m [Bucket]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Bucket Void m [Bucket]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
  ConduitT ByteString Void m CompleteMultipartUploadResponse
-> ConduitT ByteString Void m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ConduitT ByteString Void m CompleteMultipartUploadResponse
 -> ConduitT ByteString Void m ())
-> ConduitT ByteString Void m CompleteMultipartUploadResponse
-> ConduitT ByteString Void m ()
forall a b. (a -> b) -> a -> b
$ IO CompleteMultipartUploadResponse
-> ConduitT ByteString Void m CompleteMultipartUploadResponse
forall a. IO a -> ConduitT ByteString Void m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CompleteMultipartUploadResponse
 -> ConduitT ByteString Void m CompleteMultipartUploadResponse)
-> IO CompleteMultipartUploadResponse
-> ConduitT ByteString Void m CompleteMultipartUploadResponse
forall a b. (a -> b) -> a -> b
$ Configuration
-> S3Configuration NormalQuery
-> Manager
-> Bucket
-> Bucket
-> Bucket
-> [Bucket]
-> IO CompleteMultipartUploadResponse
sendEtag Configuration
cfg S3Configuration NormalQuery
s3cfg Manager
mgr Bucket
bucket Bucket
object Bucket
uploadId [Bucket]
etags