    {-# 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
    oidVersion :: ObjectId -> Maybe Text
    oidObject :: ObjectId -> Text
    oidBucket :: ObjectId -> 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)
            (lastMod, 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
            return $ CopyObjectResponse vid lastMod 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
                  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)
                  etag <- force "Missing ETag" $ el $/ elContent "ETag"
                  return (lastMod, 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