{-# 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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing 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
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 :: forall queryType.
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
..} = forall qt.
S3Query -> S3Configuration qt -> SignatureData -> SignedQuery
s3SignQuery S3Query {
                                 s3QMethod :: Method
s3QMethod = Method
Put
                               , s3QBucket :: Maybe ByteString
s3QBucket = forall a. a -> Maybe a
Just 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 = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> ByteString
T.encodeUtf8) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [
                                              (CI ByteString
"x-amz-acl",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CannedAcl -> Text
writeCannedAcl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CannedAcl
poAcl
                                            , (CI ByteString
"x-amz-storage-class",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StorageClass -> Text
writeStorageClass forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StorageClass
poStorageClass
                                            , (CI ByteString
"x-amz-website-redirect-location",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poWebsiteRedirectLocation
                                            , (CI ByteString
"x-amz-server-side-encryption",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerSideEncryption -> Text
writeServerSideEncryption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ServerSideEncryption
poServerSideEncryption
                                            , if Bool
poAutoMakeBucket then forall a. a -> Maybe a
Just (CI ByteString
"x-amz-auto-make-bucket", Text
"1")  else forall a. Maybe a
Nothing
                                            ] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map( \(Text, Text)
x -> (forall s. FoldCase s => s -> CI s
CI.mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"x-amz-meta-", forall a b. (a, b) -> a
fst (Text, Text)
x], forall a b. (a, b) -> b
snd (Text, Text)
x)) [(Text, Text)]
poMetadata
                               , s3QOtherHeaders :: RequestHeaders
s3QOtherHeaders = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Text -> ByteString
T.encodeUtf8) forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [
                                              (CI ByteString
"Expires",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
poExpires
                                            , (CI ByteString
"Cache-Control",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poCacheControl
                                            , (CI ByteString
"Content-Disposition",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poContentDisposition
                                            , (CI ByteString
"Content-Encoding",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
poContentEncoding
                                            , if Bool
poExpect100Continue
                                                  then forall a. a -> Maybe a
Just (CI ByteString
"Expect", Text
"100-continue")
                                                  else forall a. Maybe a
Nothing
                                            ]
                               , s3QRequestBody :: Maybe RequestBody
s3QRequestBody = forall a. a -> Maybe a
Just RequestBody
poRequestBody
                               , s3QObject :: Maybe ByteString
s3QObject = forall a. a -> Maybe a
Just 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
_ = forall a.
HTTPResponseConsumer a
-> IORef S3Metadata -> HTTPResponseConsumer a
s3ResponseConsumer forall a b. (a -> b) -> a -> b
$ \Response (ConduitM () ByteString (ResourceT IO) ())
resp -> do
      let vid :: Maybe Text
vid = ByteString -> Text
T.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"x-amz-version-id" (forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
resp)
      let etag :: Text
etag = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"ETag" (forall body. Response body -> RequestHeaders
HTTP.responseHeaders Response (ConduitM () ByteString (ResourceT IO) ())
resp)
      forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (m :: * -> *) a. Monad m => a -> m a
return