content: {-# 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 (Show)
  
  data CopyObject = CopyObject { coObjectName :: T.Text
                               , coBucket :: Bucket
                               , coSource :: ObjectId
                               , coMetadataDirective :: CopyMetadataDirective
                               , coIfMatch :: Maybe T.Text
                               , coIfNoneMatch :: Maybe T.Text
                               , coIfUnmodifiedSince :: Maybe UTCTime
                               , coIfModifiedSince :: Maybe UTCTime
                               , coStorageClass :: Maybe StorageClass
                               , coAcl :: Maybe CannedAcl
                               , coContentType :: Maybe B.ByteString
                               }
    deriving (Show)
  
  copyObject :: Bucket -> T.Text -> ObjectId -> CopyMetadataDirective -> CopyObject
  copyObject bucket obj src meta = CopyObject obj bucket src meta Nothing Nothing Nothing Nothing Nothing Nothing Nothing
  
  data CopyObjectResponse
    = CopyObjectResponse {
        corVersionId :: Maybe T.Text
      , corLastModified :: UTCTime
      , corETag :: T.Text
      }
    deriving (Show)
  
  -- | ServiceConfiguration: 'S3Configuration'
  instance SignQuery CopyObject where
      type ServiceConfiguration CopyObject = S3Configuration
      signQuery CopyObject {..} = s3SignQuery S3Query {
                                   s3QMethod = Put
                                 , s3QBucket = Just $ T.encodeUtf8 coBucket
                                 , s3QObject = Just $ T.encodeUtf8 coObjectName
                                 , s3QSubresources = []
                                 , s3QQuery = []
                                 , s3QContentType = coContentType
                                 , s3QContentMd5 = Nothing
                                 , s3QAmzHeaders = map (second T.encodeUtf8) $ catMaybes [
                                     Just ("x-amz-copy-source",
                                           oidBucket `T.append` "/" `T.append` oidObject `T.append`
                                           case oidVersion of
                                             Nothing -> T.empty
                                             Just v -> "?versionId=" `T.append` v)
                                   , Just ("x-amz-metadata-directive", case coMetadataDirective of
                                              CopyMetadata -> "COPY"
                                              ReplaceMetadata _ -> "REPLACE")
                                   , ("x-amz-copy-source-if-match",)
                                     <$> coIfMatch
                                   , ("x-amz-copy-source-if-none-match",)
                                     <$> coIfNoneMatch
                                   , ("x-amz-copy-source-if-unmodified-since",)
                                     <$> textHttpDate <$> coIfUnmodifiedSince
                                   , ("x-amz-copy-source-if-modified-since",)
                                     <$> textHttpDate <$> coIfModifiedSince
                                   , ("x-amz-acl",)
                                     <$> writeCannedAcl <$> coAcl
                                   , ("x-amz-storage-class",)
                                     <$> writeStorageClass <$> coStorageClass
                                   ] ++ map ( \x -> (CI.mk . T.encodeUtf8 $
                                                     T.concat ["x-amz-meta-", fst x], snd x))
                                            coMetadata
                                 , s3QOtherHeaders = map (second T.encodeUtf8) $ catMaybes []
                                 , s3QRequestBody = Nothing
                                 }
        where coMetadata = case coMetadataDirective of
                             CopyMetadata -> []
                             ReplaceMetadata xs -> xs
              ObjectId{..} = coSource
  
  instance ResponseConsumer CopyObject CopyObjectResponse where
      type ResponseMetadata CopyObjectResponse = S3Metadata
      responseConsumer _ _ mref = flip s3ResponseConsumer mref $ \resp -> do
          let vid = T.decodeUtf8 `fmap` lookup "x-amz-version-id" (HTTP.responseHeaders resp)
          (lastMod, etag) <- xmlCursorConsumer parse mref resp
          return $ CopyObjectResponse vid lastMod etag
        where parse el = do
                let parseHttpDate' x = case parseTimeM True defaultTimeLocale iso8601UtcDate x of
                                         Nothing -> throwM $ XmlException ("Invalid Last-Modified " ++ x)
                                         Just y -> return y
                lastMod <- forceM "Missing Last-Modified" $ el $/ elContent "LastModified" &| (parseHttpDate' . 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 = return
  