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