1{-# LANGUAGE CPP #-}
2module Aws.S3.Commands.CopyObject
3where
4
5import           Aws.Core
6import           Aws.S3.Core
7import           Control.Applicative
8import           Control.Arrow (second)
9import           Control.Monad.Trans.Resource (throwM)
10import qualified Data.ByteString as B
11import qualified Data.CaseInsensitive as CI
12import           Data.Maybe
13import qualified Data.Text as T
14import qualified Data.Text.Encoding as T
15import           Data.Time
16import qualified Network.HTTP.Conduit as HTTP
17import           Text.XML.Cursor (($/), (&|))
18#if !MIN_VERSION_time(1,5,0)
19import           System.Locale
20#endif
21import           Prelude
22
23data CopyMetadataDirective = CopyMetadata | ReplaceMetadata [(T.Text,T.Text)]
24  deriving (Show)
25
26data CopyObject = CopyObject { coObjectName :: T.Text
27                             , coBucket :: Bucket
28                             , coSource :: ObjectId
29                             , coMetadataDirective :: CopyMetadataDirective
30                             , coIfMatch :: Maybe T.Text
31                             , coIfNoneMatch :: Maybe T.Text
32                             , coIfUnmodifiedSince :: Maybe UTCTime
33                             , coIfModifiedSince :: Maybe UTCTime
34                             , coStorageClass :: Maybe StorageClass
35                             , coAcl :: Maybe CannedAcl
36                             , coContentType :: Maybe B.ByteString
37                             }
38  deriving (Show)
39
40copyObject :: Bucket -> T.Text -> ObjectId -> CopyMetadataDirective -> CopyObject
41copyObject bucket obj src meta = CopyObject obj bucket src meta Nothing Nothing Nothing Nothing Nothing Nothing Nothing
42
43data CopyObjectResponse
44  = CopyObjectResponse {
45      corVersionId :: Maybe T.Text
46    , corLastModified :: UTCTime
47    , corETag :: T.Text
48    }
49  deriving (Show)
50
51-- | ServiceConfiguration: 'S3Configuration'
52instance SignQuery CopyObject where
53    type ServiceConfiguration CopyObject = S3Configuration
54    signQuery CopyObject {..} = s3SignQuery S3Query {
55                                 s3QMethod = Put
56                               , s3QBucket = Just $ T.encodeUtf8 coBucket
57                               , s3QObject = Just $ T.encodeUtf8 coObjectName
58                               , s3QSubresources = []
59                               , s3QQuery = []
60                               , s3QContentType = coContentType
61                               , s3QContentMd5 = Nothing
62                               , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
63                                   Just ("x-amz-copy-source",
64                                         oidBucket `T.append` "/" `T.append` oidObject `T.append`
65                                         case oidVersion of
66                                           Nothing -> T.empty
67                                           Just v -> "?versionId=" `T.append` v)
68                                 , Just ("x-amz-metadata-directive", case coMetadataDirective of
69                                            CopyMetadata -> "COPY"
70                                            ReplaceMetadata _ -> "REPLACE")
71                                 , ("x-amz-copy-source-if-match",)
72                                   <$> coIfMatch
73                                 , ("x-amz-copy-source-if-none-match",)
74                                   <$> coIfNoneMatch
75                                 , ("x-amz-copy-source-if-unmodified-since",)
76                                   <$> textHttpDate <$> coIfUnmodifiedSince
77                                 , ("x-amz-copy-source-if-modified-since",)
78                                   <$> textHttpDate <$> coIfModifiedSince
79                                 , ("x-amz-acl",)
80                                   <$> writeCannedAcl <$> coAcl
81                                 , ("x-amz-storage-class",)
82                                   <$> writeStorageClass <$> coStorageClass
83                                 ] ++ map ( \x -> (CI.mk . T.encodeUtf8 $
84                                                   T.concat ["x-amz-meta-", fst x], snd x))
85                                          coMetadata
86                               , s3QOtherHeaders = map (second T.encodeUtf8) $ catMaybes []
87                               , s3QRequestBody = Nothing
88                               }
89      where coMetadata = case coMetadataDirective of
90                           CopyMetadata -> []
91                           ReplaceMetadata xs -> xs
92            ObjectId{..} = coSource
93
94instance ResponseConsumer CopyObject CopyObjectResponse where
95    type ResponseMetadata CopyObjectResponse = S3Metadata
96    responseConsumer _ _ mref = flip s3ResponseConsumer mref $ \resp -> do
97        let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp)
98        (lastMod, etag) <- xmlCursorConsumer parse mref resp
99        return $ CopyObjectResponse vid lastMod etag
100      where parse el = do
101              let parseHttpDate' x = case parseTimeM True defaultTimeLocale iso8601UtcDate x of
102                                       Nothing -> throwM $ XmlException ("Invalid Last-Modified " ++ x)
103                                       Just y -> return y
104              lastMod <- forceM "Missing Last-Modified" $ el $/ elContent "LastModified" &| (parseHttpDate' . T.unpack)
105              etag <- force "Missing ETag" $ el $/ elContent "ETag"
106              return (lastMod, etag)
107
108
109instance Transaction CopyObject CopyObjectResponse
110
111instance AsMemoryResponse CopyObjectResponse where
112    type MemoryResponse CopyObjectResponse = CopyObjectResponse
113    loadToMemory = return
114