{-# LANGUAGE CPP #-}
module Aws.S3.Commands.PutObject
where

import           Aws.Core
import           Aws.S3.Core
import           Control.Applicative
import           Control.Arrow         (second)
import qualified Crypto.Hash           as CH
import           Data.ByteString.Char8 ({- IsString -})
import           Data.Maybe
import qualified Data.ByteString.Char8 as B
import qualified Data.CaseInsensitive  as CI
import qualified Data.Text             as T
import qualified Data.Text.Encoding    as T
import           Prelude
import qualified Network.HTTP.Conduit  as HTTP

data PutObject = PutObject {
  PutObject -> Text
poObjectName :: T.Text,
  PutObject -> Text
poBucket :: Bucket,
  PutObject -> Maybe ByteString
poContentType :: Maybe B.ByteString,
  PutObject -> Maybe Text
poCacheControl :: Maybe T.Text,
  PutObject -> Maybe Text
poContentDisposition :: Maybe T.Text,
  PutObject -> Maybe Text
poContentEncoding :: Maybe T.Text,
  PutObject -> Maybe (Digest MD5)
poContentMD5 :: Maybe (CH.Digest CH.MD5),
  PutObject -> Maybe Int
poExpires :: Maybe Int,
  PutObject -> Maybe CannedAcl
poAcl :: Maybe CannedAcl,
  PutObject -> Maybe StorageClass
poStorageClass :: Maybe StorageClass,
  PutObject -> Maybe Text
poWebsiteRedirectLocation :: Maybe T.Text,
  PutObject -> Maybe ServerSideEncryption
poServerSideEncryption :: Maybe ServerSideEncryption,
  PutObject -> RequestBody
poRequestBody  :: HTTP.RequestBody,
  PutObject -> [(Text, Text)]
poMetadata :: [(T.Text,T.Text)],
  PutObject -> Bool
poAutoMakeBucket :: Bool, -- ^ Internet Archive S3 nonstandard extension
  PutObject -> Bool
poExpect100Continue :: Bool -- ^ Note: Requires http-client >= 0.4.10
}

putObject :: Bucket -> T.Text -> HTTP.RequestBody -> PutObject
putObject :: Text -> Text -> RequestBody -> PutObject
putObject Text
bucket Text
obj RequestBody
body = Text
-> Text
-> Maybe ByteString
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (Digest MD5)
-> Maybe Int
-> Maybe CannedAcl
-> Maybe StorageClass
-> Maybe Text
-> Maybe ServerSideEncryption
-> RequestBody
-> [(Text, Text)]
-> Bool
-> Bool
-> PutObject
PutObject Text
obj Text
bucket Maybe ByteString
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe (Digest MD5)
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe CannedAcl
forall a. Maybe a
Nothing Maybe StorageClass
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe ServerSideEncryption
forall a. Maybe a
Nothing RequestBody
body [] Bool
False Bool
False

data PutObjectResponse
  = PutObjectResponse
      { PutObjectResponse -> Maybe Text
porVersionId :: Maybe T.Text
      , PutObjectResponse -> Text
porETag :: T.Text
      }
  deriving (Int -> PutObjectResponse -> ShowS
[PutObjectResponse] -> ShowS
PutObjectResponse -> String
(Int -> PutObjectResponse -> ShowS)
-> (PutObjectResponse -> String)
-> ([PutObjectResponse] -> ShowS)
-> Show PutObjectResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutObjectResponse] -> ShowS
$cshowList :: [PutObjectResponse] -> ShowS
show :: PutObjectResponse -> String
$cshow :: PutObjectResponse -> String
showsPrec :: Int -> PutObjectResponse -> ShowS
$cshowsPrec :: Int -> PutObjectResponse -> ShowS
Show)

-- | ServiceConfiguration: 'S3Configuration'
instance SignQuery PutObject where
    type ServiceConfiguration PutObject = S3Configuration
    signQuery :: PutObject
-> ServiceConfiguration PutObject queryType
-> SignatureData
-> SignedQuery
signQuery PutObject {Bool
[(Text, Text)]
Maybe Int
Maybe ByteString
Maybe Text
Maybe (Digest MD5)
Maybe ServerSideEncryption
Maybe StorageClass
Maybe CannedAcl
Text
RequestBody
poExpect100Continue :: Bool
poAutoMakeBucket :: Bool
poMetadata :: [(Text, Text)]
poRequestBody :: RequestBody
poServerSideEncryption :: Maybe ServerSideEncryption
poWebsiteRedirectLocation :: Maybe Text
poStorageClass :: Maybe StorageClass
poAcl :: Maybe CannedAcl
poExpires :: Maybe Int
poContentMD5 :: Maybe (Digest MD5)
poContentEncoding :: Maybe Text
poContentDisposition :: Maybe Text
poCacheControl :: Maybe Text
poContentType :: Maybe ByteString
poBucket :: Text
poObjectName :: Text
poExpect100Continue :: PutObject -> Bool
poAutoMakeBucket :: PutObject -> Bool
poMetadata :: PutObject -> [(Text, Text)]
poRequestBody :: PutObject -> RequestBody
poServerSideEncryption :: PutObject -> Maybe ServerSideEncryption
poWebsiteRedirectLocation :: PutObject -> Maybe Text
poStorageClass :: PutObject -> Maybe StorageClass
poAcl :: PutObject -> Maybe CannedAcl
poExpires :: PutObject -> Maybe Int
poContentMD5 :: PutObject -> Maybe (Digest MD5)
poContentEncoding :: PutObject -> Maybe Text
poContentDisposition :: PutObject -> Maybe Text
poCacheControl :: PutObject -> Maybe Text
poContentType :: PutObject -> Maybe ByteString
poBucket :: PutObject -> Text
poObjectName :: PutObject -> Text
..} = S3Query
-> S3Configuration queryType -> SignatureData -> SignedQuery
forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query :: Method
-> Maybe ByteString
-> Maybe ByteString
-> Query
-> Query
-> Maybe ByteString
-> Maybe (Digest MD5)
-> RequestHeaders
-> RequestHeaders
-> Maybe RequestBody
-> S3Query
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
poBucket
                               , s3QSubresources :: Query
s3QSubresources = []
                               , s3QQuery :: Query
s3QQuery = []
                               , s3QContentType :: Maybe ByteString
s3QContentType = Maybe ByteString
poContentType
                               , s3QContentMd5 :: Maybe (Digest MD5)
s3QContentMd5 = Maybe (Digest MD5)
poContentMD5
                               , 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 (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
"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
poAcl
                                            , (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
poStorageClass
                                            , (CI ByteString
"x-amz-website-redirect-location",) (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poWebsiteRedirectLocation
                                            , (CI ByteString
"x-amz-server-side-encryption",) (Text -> (CI ByteString, Text))
-> (ServerSideEncryption -> Text)
-> ServerSideEncryption
-> (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerSideEncryption -> Text
writeServerSideEncryption (ServerSideEncryption -> (CI ByteString, Text))
-> Maybe ServerSideEncryption -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ServerSideEncryption
poServerSideEncryption
                                            , if Bool
poAutoMakeBucket then (CI ByteString, Text) -> Maybe (CI ByteString, Text)
forall a. a -> Maybe a
Just (CI ByteString
"x-amz-auto-make-bucket", Text
"1")  else Maybe (CI ByteString, Text)
forall a. Maybe a
Nothing
                                            ] [(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)]
poMetadata
                               , 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 (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
"Expires",) (Text -> (CI ByteString, Text))
-> (Int -> Text) -> Int -> (CI ByteString, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> (CI ByteString, Text))
-> Maybe Int -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
poExpires
                                            , (CI ByteString
"Cache-Control",) (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poCacheControl
                                            , (CI ByteString
"Content-Disposition",) (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poContentDisposition
                                            , (CI ByteString
"Content-Encoding",) (Text -> (CI ByteString, Text))
-> Maybe Text -> Maybe (CI ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poContentEncoding
                                            , if Bool
poExpect100Continue
                                                  then (CI ByteString, Text) -> Maybe (CI ByteString, Text)
forall a. a -> Maybe a
Just (CI ByteString
"Expect", Text
"100-continue")
                                                  else Maybe (CI ByteString, Text)
forall a. Maybe a
Nothing
                                            ]
                               , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = RequestBody -> Maybe RequestBody
forall a. a -> Maybe a
Just RequestBody
poRequestBody
                               , 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
poObjectName
                               }

instance ResponseConsumer PutObject PutObjectResponse where
    type ResponseMetadata PutObjectResponse = S3Metadata
    responseConsumer :: Request
-> PutObject
-> IORef (ResponseMetadata PutObjectResponse)
-> HTTPResponseConsumer PutObjectResponse
responseConsumer Request
_ PutObject
_ = HTTPResponseConsumer PutObjectResponse
-> IORef S3Metadata -> HTTPResponseConsumer PutObjectResponse
forall a.
HTTPResponseConsumer a
-> IORef S3Metadata -> HTTPResponseConsumer a
s3ResponseConsumer (HTTPResponseConsumer PutObjectResponse
 -> IORef S3Metadata -> HTTPResponseConsumer PutObjectResponse)
-> HTTPResponseConsumer PutObjectResponse
-> IORef S3Metadata
-> HTTPResponseConsumer PutObjectResponse
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 (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)
      let etag :: Text
etag = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> Maybe ByteString -> Maybe Text
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
"ETag" (Response (ConduitM () ByteString (ResourceT IO) ())
-> RequestHeaders
forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
resp)
      PutObjectResponse -> ResourceT IO PutObjectResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (PutObjectResponse -> ResourceT IO PutObjectResponse)
-> PutObjectResponse -> ResourceT IO PutObjectResponse
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> PutObjectResponse
PutObjectResponse Maybe Text
vid Text
etag

instance Transaction PutObject PutObjectResponse

instance AsMemoryResponse PutObjectResponse where
    type MemoryResponse PutObjectResponse = PutObjectResponse
    loadToMemory :: PutObjectResponse
-> ResourceT IO (MemoryResponse PutObjectResponse)
loadToMemory = PutObjectResponse
-> ResourceT IO (MemoryResponse PutObjectResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return