{-# LANGUAGE CPP #-}
module Aws.S3.Commands.CopyObject
where

import           Aws.Core
import           Aws.S3.Core
import           Control.Applicative
import           Control.Arrow (second)
import           Control.Monad.Trans.Resource (throwM)
import qualified Data.ByteString as B
import qualified Data.CaseInsensitive as CI
import           Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import           Data.Time
import qualified Network.HTTP.Conduit as HTTP
import           Text.XML.Cursor (($/), (&|))
#if !MIN_VERSION_time(1,5,0)
import           System.Locale
#endif
import           Prelude

data CopyMetadataDirective = CopyMetadata | ReplaceMetadata [(T.Text,T.Text)]
  deriving (Int -> CopyMetadataDirective -> ShowS
[CopyMetadataDirective] -> ShowS
CopyMetadataDirective -> String
(Int -> CopyMetadataDirective -> ShowS)
-> (CopyMetadataDirective -> String)
-> ([CopyMetadataDirective] -> ShowS)
-> Show CopyMetadataDirective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyMetadataDirective -> ShowS
showsPrec :: Int -> CopyMetadataDirective -> ShowS
$cshow :: CopyMetadataDirective -> String
show :: CopyMetadataDirective -> String
$cshowList :: [CopyMetadataDirective] -> ShowS
showList :: [CopyMetadataDirective] -> ShowS
Show)

data CopyObject = CopyObject { CopyObject -> Text
coObjectName :: T.Text
                             , CopyObject -> Text
coBucket :: Bucket
                             , CopyObject -> ObjectId
coSource :: ObjectId
                             , CopyObject -> CopyMetadataDirective
coMetadataDirective :: CopyMetadataDirective
                             , CopyObject -> Maybe Text
coIfMatch :: Maybe T.Text
                             , CopyObject -> Maybe Text
coIfNoneMatch :: Maybe T.Text
                             , CopyObject -> Maybe UTCTime
coIfUnmodifiedSince :: Maybe UTCTime
                             , CopyObject -> Maybe UTCTime
coIfModifiedSince :: Maybe UTCTime
                             , CopyObject -> Maybe StorageClass
coStorageClass :: Maybe StorageClass
                             , CopyObject -> Maybe CannedAcl
coAcl :: Maybe CannedAcl
                             , CopyObject -> Maybe ByteString
coContentType :: Maybe B.ByteString
                             }
  deriving (Int -> CopyObject -> ShowS
[CopyObject] -> ShowS
CopyObject -> String
(Int -> CopyObject -> ShowS)
-> (CopyObject -> String)
-> ([CopyObject] -> ShowS)
-> Show CopyObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyObject -> ShowS
showsPrec :: Int -> CopyObject -> ShowS
$cshow :: CopyObject -> String
show :: CopyObject -> String
$cshowList :: [CopyObject] -> ShowS
showList :: [CopyObject] -> ShowS
Show)

copyObject :: Bucket -> T.Text -> ObjectId -> CopyMetadataDirective -> CopyObject
copyObject :: Text -> Text -> ObjectId -> CopyMetadataDirective -> CopyObject
copyObject Text
bucket Text
obj ObjectId
src CopyMetadataDirective
meta = Text
-> Text
-> ObjectId
-> CopyMetadataDirective
-> Maybe Text
-> Maybe Text
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe StorageClass
-> Maybe CannedAcl
-> Maybe ByteString
-> CopyObject
CopyObject Text
obj Text
bucket ObjectId
src CopyMetadataDirective
meta Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe UTCTime
forall a. Maybe a
Nothing Maybe StorageClass
forall a. Maybe a
Nothing Maybe CannedAcl
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing

data CopyObjectResponse
  = CopyObjectResponse {
      CopyObjectResponse -> Maybe Text
corVersionId :: Maybe T.Text
    , CopyObjectResponse -> UTCTime
corLastModified :: UTCTime
    , CopyObjectResponse -> Text
corETag :: T.Text
    }
  deriving (Int -> CopyObjectResponse -> ShowS
[CopyObjectResponse] -> ShowS
CopyObjectResponse -> String
(Int -> CopyObjectResponse -> ShowS)
-> (CopyObjectResponse -> String)
-> ([CopyObjectResponse] -> ShowS)
-> Show CopyObjectResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyObjectResponse -> ShowS
showsPrec :: Int -> CopyObjectResponse -> ShowS
$cshow :: CopyObjectResponse -> String
show :: CopyObjectResponse -> String
$cshowList :: [CopyObjectResponse] -> ShowS
showList :: [CopyObjectResponse] -> ShowS
Show)

-- | ServiceConfiguration: 'S3Configuration'
instance SignQuery CopyObject where
    type ServiceConfiguration CopyObject = S3Configuration
    signQuery :: forall queryType.
CopyObject
-> ServiceConfiguration CopyObject queryType
-> SignatureData
-> SignedQuery
signQuery CopyObject {Maybe Text
Maybe UTCTime
Maybe ByteString
Maybe StorageClass
Maybe CannedAcl
Text
ObjectId
CopyMetadataDirective
coObjectName :: CopyObject -> Text
coBucket :: CopyObject -> Text
coSource :: CopyObject -> ObjectId
coMetadataDirective :: CopyObject -> CopyMetadataDirective
coIfMatch :: CopyObject -> Maybe Text
coIfNoneMatch :: CopyObject -> Maybe Text
coIfUnmodifiedSince :: CopyObject -> Maybe UTCTime
coIfModifiedSince :: CopyObject -> Maybe UTCTime
coStorageClass :: CopyObject -> Maybe StorageClass
coAcl :: CopyObject -> Maybe CannedAcl
coContentType :: CopyObject -> Maybe ByteString
coObjectName :: Text
coBucket :: Text
coSource :: ObjectId
coMetadataDirective :: CopyMetadataDirective
coIfMatch :: Maybe Text
coIfNoneMatch :: Maybe Text
coIfUnmodifiedSince :: Maybe UTCTime
coIfModifiedSince :: Maybe UTCTime
coStorageClass :: Maybe StorageClass
coAcl :: Maybe CannedAcl
coContentType :: Maybe ByteString
..} = 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
$ Text -> ByteString
T.encodeUtf8 Text
coBucket
                               , 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
$ Text -> ByteString
T.encodeUtf8 Text
coObjectName
                               , s3QSubresources :: Query
s3QSubresources = []
                               , s3QQuery :: Query
s3QQuery = []
                               , s3QContentType :: Maybe ByteString
s3QContentType = Maybe ByteString
coContentType
                               , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5 = Maybe (Digest MD5)
forall a. Maybe a
Nothing
                               , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders = ((CI ByteString, Text) -> Header)
-> [(CI ByteString, Text)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ByteString) -> (CI ByteString, Text) -> 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 Text -> ByteString
T.encodeUtf8) ([(CI ByteString, Text)] -> RequestHeaders)
-> [(CI ByteString, Text)] -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ [Maybe (CI ByteString, Text)] -> [(CI ByteString, Text)]
forall a. [Maybe a] -> [a]
catMaybes [
                                   (CI ByteString, Text) -> Maybe (CI ByteString, Text)
forall a. a -> Maybe a
Just (CI ByteString
"x-amz-copy-source",
                                         Text
oidBucket Text -> Text -> Text
`T.append` Text
"/" Text -> Text -> Text
`T.append` Text
oidObject Text -> Text -> Text
`T.append`
                                         case Maybe Text
oidVersion of
                                           Maybe Text
Nothing -> Text
T.empty
                                           Just Text
v -> Text
"?versionId=" Text -> Text -> Text
`T.append` Text
v)
                                 , (CI ByteString, Text) -> Maybe (CI ByteString, Text)
forall a. a -> Maybe a
Just (CI ByteString
"x-amz-metadata-directive", case CopyMetadataDirective
coMetadataDirective of
                                            CopyMetadataDirective
CopyMetadata -> Text
"COPY"
                                            ReplaceMetadata [(Text, Text)]
_ -> Text
"REPLACE")
                                 , (CI ByteString
"x-amz-copy-source-if-match",)
                                   (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
coIfMatch
                                 , (CI ByteString
"x-amz-copy-source-if-none-match",)
                                   (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
coIfNoneMatch
                                 , (CI ByteString
"x-amz-copy-source-if-unmodified-since",)
                                   (Text -> (CI ByteString, Text))
-> (UTCTime -> Text) -> UTCTime -> (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> Text
textHttpDate (UTCTime -> (CI ByteString, Text))
-> Maybe UTCTime -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
coIfUnmodifiedSince
                                 , (CI ByteString
"x-amz-copy-source-if-modified-since",)
                                   (Text -> (CI ByteString, Text))
-> (UTCTime -> Text) -> UTCTime -> (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> Text
textHttpDate (UTCTime -> (CI ByteString, Text))
-> Maybe UTCTime -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
coIfModifiedSince
                                 , (CI ByteString
"x-amz-acl",)
                                   (Text -> (CI ByteString, Text))
-> (CannedAcl -> Text) -> CannedAcl -> (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CannedAcl -> Text
writeCannedAcl (CannedAcl -> (CI ByteString, Text))
-> Maybe CannedAcl -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CannedAcl
coAcl
                                 , (CI ByteString
"x-amz-storage-class",)
                                   (Text -> (CI ByteString, Text))
-> (StorageClass -> Text) -> StorageClass -> (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass -> Text
writeStorageClass (StorageClass -> (CI ByteString, Text))
-> Maybe StorageClass -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageClass
coStorageClass
                                 ] [(CI ByteString, Text)]
-> [(CI ByteString, Text)] -> [(CI ByteString, Text)]
forall a. [a] -> [a] -> [a]
++ ((Text, Text) -> (CI ByteString, Text))
-> [(Text, Text)] -> [(CI ByteString, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ( \(Text, Text)
x -> (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (Text -> ByteString) -> Text -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> CI ByteString) -> Text -> CI ByteString
forall a b. (a -> b) -> a -> b
$
                                                   [Text] -> Text
T.concat [Text
"x-amz-meta-", (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
x], (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
x))
                                          [(Text, Text)]
coMetadata
                               , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = ((CI ByteString, Text) -> Header)
-> [(CI ByteString, Text)] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> ByteString) -> (CI ByteString, Text) -> 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 Text -> ByteString
T.encodeUtf8) ([(CI ByteString, Text)] -> RequestHeaders)
-> [(CI ByteString, Text)] -> RequestHeaders
forall a b. (a -> b) -> a -> b
$ [Maybe (CI ByteString, Text)] -> [(CI ByteString, Text)]
forall a. [Maybe a] -> [a]
catMaybes []
                               , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = Maybe RequestBody
forall a. Maybe a
Nothing
                               }
      where coMetadata :: [(Text, Text)]
coMetadata = case CopyMetadataDirective
coMetadataDirective of
                           CopyMetadataDirective
CopyMetadata -> []
                           ReplaceMetadata [(Text, Text)]
xs -> [(Text, Text)]
xs
            ObjectId{Maybe Text
Text
oidBucket :: Text
oidObject :: Text
oidVersion :: Maybe Text
oidBucket :: ObjectId -> Text
oidObject :: ObjectId -> Text
oidVersion :: ObjectId -> Maybe Text
..} = ObjectId
coSource

instance ResponseConsumer CopyObject CopyObjectResponse where
    type ResponseMetadata CopyObjectResponse = S3Metadata
    responseConsumer :: Request
-> CopyObject
-> IORef (ResponseMetadata CopyObjectResponse)
-> HTTPResponseConsumer CopyObjectResponse
responseConsumer Request
_ CopyObject
_ IORef (ResponseMetadata CopyObjectResponse)
mref = (HTTPResponseConsumer CopyObjectResponse
 -> IORef S3Metadata -> HTTPResponseConsumer CopyObjectResponse)
-> IORef S3Metadata
-> HTTPResponseConsumer CopyObjectResponse
-> HTTPResponseConsumer CopyObjectResponse
forall a b c. (a -> b -> c) -> b -> a -> c
flip HTTPResponseConsumer CopyObjectResponse
-> IORef S3Metadata -> HTTPResponseConsumer CopyObjectResponse
forall a.
HTTPResponseConsumer a
-> IORef S3Metadata -> HTTPResponseConsumer a
s3ResponseConsumer IORef (ResponseMetadata CopyObjectResponse)
IORef S3Metadata
mref (HTTPResponseConsumer CopyObjectResponse
 -> HTTPResponseConsumer CopyObjectResponse)
-> HTTPResponseConsumer CopyObjectResponse
-> HTTPResponseConsumer CopyObjectResponse
forall a b. (a -> b) -> a -> b
$ \Response (ConduitM () ByteString (ResourceT IO) ())
resp -> do
        let vid :: Maybe Text
vid = ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
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)
        (UTCTime
lastMod, Text
etag) <- (Cursor -> Response S3Metadata (UTCTime, Text))
-> IORef S3Metadata -> HTTPResponseConsumer (UTCTime, Text)
forall m a.
Monoid m =>
(Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a
xmlCursorConsumer Cursor -> Response S3Metadata (UTCTime, Text)
forall {m :: * -> *} {a}.
(MonadThrow m, ParseTime a) =>
Cursor -> m (a, Text)
parse IORef (ResponseMetadata CopyObjectResponse)
IORef S3Metadata
mref Response (ConduitM () ByteString (ResourceT IO) ())
resp
        CopyObjectResponse -> ResourceT IO CopyObjectResponse
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CopyObjectResponse -> ResourceT IO CopyObjectResponse)
-> CopyObjectResponse -> ResourceT IO CopyObjectResponse
forall a b. (a -> b) -> a -> b
$ Maybe Text -> UTCTime -> Text -> CopyObjectResponse
CopyObjectResponse Maybe Text
vid UTCTime
lastMod Text
etag
      where parse :: Cursor -> m (a, Text)
parse Cursor
el = do
              let parseHttpDate' :: String -> m a
parseHttpDate' String
x = case Bool -> TimeLocale -> String -> String -> Maybe a
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
iso8601UtcDate String
x of
                                       Maybe a
Nothing -> XmlException -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (XmlException -> m a) -> XmlException -> m a
forall a b. (a -> b) -> a -> b
$ String -> XmlException
XmlException (String
"Invalid Last-Modified " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x)
                                       Just a
y -> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
              a
lastMod <- String -> [m a] -> m a
forall (m :: * -> *) a. MonadThrow m => String -> [m a] -> m a
forceM String
"Missing Last-Modified" ([m a] -> m a) -> [m a] -> m a
forall a b. (a -> b) -> a -> b
$ Cursor
el Cursor -> (Cursor -> [m a]) -> [m a]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Text]
elContent Text
"LastModified" (Cursor -> [Text]) -> (Text -> m a) -> Cursor -> [m a]
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| (String -> m a
forall {a} {m :: * -> *}.
(ParseTime a, MonadThrow m) =>
String -> m a
parseHttpDate' (String -> m a) -> (Text -> String) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
              Text
etag <- String -> [Text] -> m Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing ETag" ([Text] -> m Text) -> [Text] -> m Text
forall a b. (a -> b) -> a -> b
$ Cursor
el Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Text]
elContent Text
"ETag"
              (a, Text) -> m (a, Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
lastMod, Text
etag)


instance Transaction CopyObject CopyObjectResponse

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