{-# 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 bucket :: Text
bucket obj :: Text
obj body :: 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 {..} = 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 [
                                              ("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
                                            , ("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
                                            , ("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
                                            , ("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 ("x-amz-auto-make-bucket", "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( \x :: (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 ["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 [
                                              ("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
                                            , ("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
                                            , ("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
                                            , ("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 ("Expect", "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 _ _ = HTTPResponseConsumer PutObjectResponse
-> IORef (ResponseMetadata PutObjectResponse)
-> HTTPResponseConsumer PutObjectResponse
forall a.
HTTPResponseConsumer a
-> IORef S3Metadata -> HTTPResponseConsumer a
s3ResponseConsumer (HTTPResponseConsumer PutObjectResponse
 -> IORef (ResponseMetadata PutObjectResponse)
 -> HTTPResponseConsumer PutObjectResponse)
-> HTTPResponseConsumer PutObjectResponse
-> IORef (ResponseMetadata PutObjectResponse)
-> HTTPResponseConsumer PutObjectResponse
forall a b. (a -> b) -> a -> b
$ \resp :: 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 "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 "" (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 "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