{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyMetadataDirective] -> ShowS
$cshowList :: [CopyMetadataDirective] -> ShowS
show :: CopyMetadataDirective -> String
$cshow :: CopyMetadataDirective -> String
showsPrec :: Int -> CopyMetadataDirective -> ShowS
$cshowsPrec :: Int -> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyObject] -> ShowS
$cshowList :: [CopyObject] -> ShowS
show :: CopyObject -> String
$cshow :: CopyObject -> String
showsPrec :: Int -> CopyObject -> ShowS
$cshowsPrec :: Int -> 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyObjectResponse] -> ShowS
$cshowList :: [CopyObjectResponse] -> ShowS
show :: CopyObjectResponse -> String
$cshow :: CopyObjectResponse -> String
showsPrec :: Int -> CopyObjectResponse -> ShowS
$cshowsPrec :: Int -> 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 UTCTime
Maybe ByteString
Maybe Text
Maybe StorageClass
Maybe CannedAcl
Text
ObjectId
CopyMetadataDirective
coContentType :: Maybe ByteString
coAcl :: Maybe CannedAcl
coStorageClass :: Maybe StorageClass
coIfModifiedSince :: Maybe UTCTime
coIfUnmodifiedSince :: Maybe UTCTime
coIfNoneMatch :: Maybe Text
coIfMatch :: Maybe Text
coMetadataDirective :: CopyMetadataDirective
coSource :: ObjectId
coBucket :: Text
coObjectName :: Text
coContentType :: CopyObject -> Maybe ByteString
coAcl :: CopyObject -> Maybe CannedAcl
coStorageClass :: CopyObject -> Maybe StorageClass
coIfModifiedSince :: CopyObject -> Maybe UTCTime
coIfUnmodifiedSince :: CopyObject -> Maybe UTCTime
coIfNoneMatch :: CopyObject -> Maybe Text
coIfMatch :: CopyObject -> Maybe Text
coMetadataDirective :: CopyObject -> CopyMetadataDirective
coSource :: CopyObject -> ObjectId
coBucket :: CopyObject -> Text
coObjectName :: CopyObject -> Text
..} = forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query {
                                 s3QMethod :: Method
s3QMethod = Method
Put
                               , s3QBucket :: Maybe ByteString
s3QBucket = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
coBucket
                               , s3QObject :: Maybe ByteString
s3QObject = forall a. a -> Maybe a
Just 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 = forall a. Maybe a
Nothing
                               , s3QAmzHeaders :: RequestHeaders
s3QAmzHeaders = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> ByteString
T.encodeUtf8) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [
                                   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)
                                 , 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",)
                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
coIfMatch
                                 , (CI ByteString
"x-amz-copy-source-if-none-match",)
                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
coIfNoneMatch
                                 , (CI ByteString
"x-amz-copy-source-if-unmodified-since",)
                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> Text
textHttpDate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
coIfUnmodifiedSince
                                 , (CI ByteString
"x-amz-copy-source-if-modified-since",)
                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> Text
textHttpDate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
coIfModifiedSince
                                 , (CI ByteString
"x-amz-acl",)
                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CannedAcl -> Text
writeCannedAcl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CannedAcl
coAcl
                                 , (CI ByteString
"x-amz-storage-class",)
                                   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass -> Text
writeStorageClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageClass
coStorageClass
                                 ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map ( \(Text, Text)
x -> (forall s. FoldCase s => s -> CI s
CI.mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$
                                                   [Text] -> Text
T.concat [Text
"x-amz-meta-", forall a b. (a, b) -> a
fst (Text, Text)
x], forall a b. (a, b) -> b
snd (Text, Text)
x))
                                          [(Text, Text)]
coMetadata
                               , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> ByteString
T.encodeUtf8) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes []
                               , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = 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
oidVersion :: ObjectId -> Maybe Text
oidObject :: ObjectId -> Text
oidBucket :: ObjectId -> Text
oidVersion :: Maybe Text
oidObject :: Text
oidBucket :: 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a.
HTTPResponseConsumer a
-> IORef S3Metadata -> HTTPResponseConsumer a
s3ResponseConsumer IORef (ResponseMetadata CopyObjectResponse)
mref forall a b. (a -> b) -> a -> b
$ \Response (ConduitM () ByteString (ResourceT IO) ())
resp -> do
        let vid :: Maybe Text
vid = ByteString -> Text
T.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"x-amz-version-id" (forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
resp)
        (UTCTime
lastMod, Text
etag) <- forall m a.
Monoid m =>
(Cursor -> Response m a) -> IORef m -> HTTPResponseConsumer a
xmlCursorConsumer forall {m :: * -> *} {a}.
(MonadThrow m, ParseTime a) =>
Cursor -> m (a, Text)
parse IORef (ResponseMetadata CopyObjectResponse)
mref Response (ConduitM () ByteString (ResourceT IO) ())
resp
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 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 -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> XmlException
XmlException (String
"Invalid Last-Modified " forall a. [a] -> [a] -> [a]
++ String
x)
                                       Just a
y -> forall (m :: * -> *) a. Monad m => a -> m a
return a
y
              a
lastMod <- forall (m :: * -> *) a. MonadThrow m => String -> [m a] -> m a
forceM String
"Missing Last-Modified" forall a b. (a -> b) -> a -> b
$ Cursor
el forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Text]
elContent Text
"LastModified" forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| (forall {a} {m :: * -> *}.
(ParseTime a, MonadThrow m) =>
String -> m a
parseHttpDate' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
              Text
etag <- forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force String
"Missing ETag" forall a b. (a -> b) -> a -> b
$ Cursor
el forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Text -> Cursor -> [Text]
elContent Text
"ETag"
              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 = forall (m :: * -> *) a. Monad m => a -> m a
return