{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.MediaStoreData.PutObject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uploads an object to the specified path. Object sizes are limited to 25
-- MB for standard upload availability and 10 MB for streaming upload
-- availability.
module Amazonka.MediaStoreData.PutObject
  ( -- * Creating a Request
    PutObject (..),
    newPutObject,

    -- * Request Lenses
    putObject_cacheControl,
    putObject_contentType,
    putObject_storageClass,
    putObject_uploadAvailability,
    putObject_path,
    putObject_body,

    -- * Destructuring the Response
    PutObjectResponse (..),
    newPutObjectResponse,

    -- * Response Lenses
    putObjectResponse_contentSHA256,
    putObjectResponse_eTag,
    putObjectResponse_storageClass,
    putObjectResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaStoreData.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPutObject' smart constructor.
data PutObject = PutObject'
  { -- | An optional @CacheControl@ header that allows the caller to control the
    -- object\'s cache behavior. Headers can be passed in as specified in the
    -- HTTP at
    -- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.9>.
    --
    -- Headers with a custom user-defined value are also accepted.
    PutObject -> Maybe Text
cacheControl :: Prelude.Maybe Prelude.Text,
    -- | The content type of the object.
    PutObject -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | Indicates the storage class of a @Put@ request. Defaults to
    -- high-performance temporal storage class, and objects are persisted into
    -- durable storage shortly after being received.
    PutObject -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | Indicates the availability of an object while it is still uploading. If
    -- the value is set to @streaming@, the object is available for downloading
    -- after some initial buffering but before the object is uploaded
    -- completely. If the value is set to @standard@, the object is available
    -- for downloading only when it is uploaded completely. The default value
    -- for this header is @standard@.
    --
    -- To use this header, you must also set the HTTP @Transfer-Encoding@
    -- header to @chunked@.
    PutObject -> Maybe UploadAvailability
uploadAvailability :: Prelude.Maybe UploadAvailability,
    -- | The path (including the file name) where the object is stored in the
    -- container. Format: \<folder name>\/\<folder name>\/\<file name>
    --
    -- For example, to upload the file @mlaw.avi@ to the folder path
    -- @premium\\canada@ in the container @movies@, enter the path
    -- @premium\/canada\/mlaw.avi@.
    --
    -- Do not include the container name in this path.
    --
    -- If the path includes any folders that don\'t exist yet, the service
    -- creates them. For example, suppose you have an existing @premium\/usa@
    -- subfolder. If you specify @premium\/canada@, the service creates a
    -- @canada@ subfolder in the @premium@ folder. You then have two
    -- subfolders, @usa@ and @canada@, in the @premium@ folder.
    --
    -- There is no correlation between the path to the source and the path
    -- (folders) in the container in AWS Elemental MediaStore.
    --
    -- For more information about folders and how they exist in a container,
    -- see the
    -- <http://docs.aws.amazon.com/mediastore/latest/ug/ AWS Elemental MediaStore User Guide>.
    --
    -- The file name is the name that is assigned to the file that you upload.
    -- The file can have the same name inside and outside of AWS Elemental
    -- MediaStore, or it can have the same name. The file name can include or
    -- omit an extension.
    PutObject -> Text
path :: Prelude.Text,
    -- | The bytes to be stored.
    PutObject -> HashedBody
body :: Data.HashedBody
  }
  deriving (Int -> PutObject -> ShowS
[PutObject] -> ShowS
PutObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutObject] -> ShowS
$cshowList :: [PutObject] -> ShowS
show :: PutObject -> String
$cshow :: PutObject -> String
showsPrec :: Int -> PutObject -> ShowS
$cshowsPrec :: Int -> PutObject -> ShowS
Prelude.Show, forall x. Rep PutObject x -> PutObject
forall x. PutObject -> Rep PutObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutObject x -> PutObject
$cfrom :: forall x. PutObject -> Rep PutObject x
Prelude.Generic)

-- |
-- Create a value of 'PutObject' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'cacheControl', 'putObject_cacheControl' - An optional @CacheControl@ header that allows the caller to control the
-- object\'s cache behavior. Headers can be passed in as specified in the
-- HTTP at
-- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.9>.
--
-- Headers with a custom user-defined value are also accepted.
--
-- 'contentType', 'putObject_contentType' - The content type of the object.
--
-- 'storageClass', 'putObject_storageClass' - Indicates the storage class of a @Put@ request. Defaults to
-- high-performance temporal storage class, and objects are persisted into
-- durable storage shortly after being received.
--
-- 'uploadAvailability', 'putObject_uploadAvailability' - Indicates the availability of an object while it is still uploading. If
-- the value is set to @streaming@, the object is available for downloading
-- after some initial buffering but before the object is uploaded
-- completely. If the value is set to @standard@, the object is available
-- for downloading only when it is uploaded completely. The default value
-- for this header is @standard@.
--
-- To use this header, you must also set the HTTP @Transfer-Encoding@
-- header to @chunked@.
--
-- 'path', 'putObject_path' - The path (including the file name) where the object is stored in the
-- container. Format: \<folder name>\/\<folder name>\/\<file name>
--
-- For example, to upload the file @mlaw.avi@ to the folder path
-- @premium\\canada@ in the container @movies@, enter the path
-- @premium\/canada\/mlaw.avi@.
--
-- Do not include the container name in this path.
--
-- If the path includes any folders that don\'t exist yet, the service
-- creates them. For example, suppose you have an existing @premium\/usa@
-- subfolder. If you specify @premium\/canada@, the service creates a
-- @canada@ subfolder in the @premium@ folder. You then have two
-- subfolders, @usa@ and @canada@, in the @premium@ folder.
--
-- There is no correlation between the path to the source and the path
-- (folders) in the container in AWS Elemental MediaStore.
--
-- For more information about folders and how they exist in a container,
-- see the
-- <http://docs.aws.amazon.com/mediastore/latest/ug/ AWS Elemental MediaStore User Guide>.
--
-- The file name is the name that is assigned to the file that you upload.
-- The file can have the same name inside and outside of AWS Elemental
-- MediaStore, or it can have the same name. The file name can include or
-- omit an extension.
--
-- 'body', 'putObject_body' - The bytes to be stored.
newPutObject ::
  -- | 'path'
  Prelude.Text ->
  -- | 'body'
  Data.HashedBody ->
  PutObject
newPutObject :: Text -> HashedBody -> PutObject
newPutObject Text
pPath_ HashedBody
pBody_ =
  PutObject'
    { $sel:cacheControl:PutObject' :: Maybe Text
cacheControl = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:PutObject' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:PutObject' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:uploadAvailability:PutObject' :: Maybe UploadAvailability
uploadAvailability = forall a. Maybe a
Prelude.Nothing,
      $sel:path:PutObject' :: Text
path = Text
pPath_,
      $sel:body:PutObject' :: HashedBody
body = HashedBody
pBody_
    }

-- | An optional @CacheControl@ header that allows the caller to control the
-- object\'s cache behavior. Headers can be passed in as specified in the
-- HTTP at
-- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.9>.
--
-- Headers with a custom user-defined value are also accepted.
putObject_cacheControl :: Lens.Lens' PutObject (Prelude.Maybe Prelude.Text)
putObject_cacheControl :: Lens' PutObject (Maybe Text)
putObject_cacheControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObject' {Maybe Text
cacheControl :: Maybe Text
$sel:cacheControl:PutObject' :: PutObject -> Maybe Text
cacheControl} -> Maybe Text
cacheControl) (\s :: PutObject
s@PutObject' {} Maybe Text
a -> PutObject
s {$sel:cacheControl:PutObject' :: Maybe Text
cacheControl = Maybe Text
a} :: PutObject)

-- | The content type of the object.
putObject_contentType :: Lens.Lens' PutObject (Prelude.Maybe Prelude.Text)
putObject_contentType :: Lens' PutObject (Maybe Text)
putObject_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObject' {Maybe Text
contentType :: Maybe Text
$sel:contentType:PutObject' :: PutObject -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: PutObject
s@PutObject' {} Maybe Text
a -> PutObject
s {$sel:contentType:PutObject' :: Maybe Text
contentType = Maybe Text
a} :: PutObject)

-- | Indicates the storage class of a @Put@ request. Defaults to
-- high-performance temporal storage class, and objects are persisted into
-- durable storage shortly after being received.
putObject_storageClass :: Lens.Lens' PutObject (Prelude.Maybe StorageClass)
putObject_storageClass :: Lens' PutObject (Maybe StorageClass)
putObject_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObject' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:PutObject' :: PutObject -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: PutObject
s@PutObject' {} Maybe StorageClass
a -> PutObject
s {$sel:storageClass:PutObject' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: PutObject)

-- | Indicates the availability of an object while it is still uploading. If
-- the value is set to @streaming@, the object is available for downloading
-- after some initial buffering but before the object is uploaded
-- completely. If the value is set to @standard@, the object is available
-- for downloading only when it is uploaded completely. The default value
-- for this header is @standard@.
--
-- To use this header, you must also set the HTTP @Transfer-Encoding@
-- header to @chunked@.
putObject_uploadAvailability :: Lens.Lens' PutObject (Prelude.Maybe UploadAvailability)
putObject_uploadAvailability :: Lens' PutObject (Maybe UploadAvailability)
putObject_uploadAvailability = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObject' {Maybe UploadAvailability
uploadAvailability :: Maybe UploadAvailability
$sel:uploadAvailability:PutObject' :: PutObject -> Maybe UploadAvailability
uploadAvailability} -> Maybe UploadAvailability
uploadAvailability) (\s :: PutObject
s@PutObject' {} Maybe UploadAvailability
a -> PutObject
s {$sel:uploadAvailability:PutObject' :: Maybe UploadAvailability
uploadAvailability = Maybe UploadAvailability
a} :: PutObject)

-- | The path (including the file name) where the object is stored in the
-- container. Format: \<folder name>\/\<folder name>\/\<file name>
--
-- For example, to upload the file @mlaw.avi@ to the folder path
-- @premium\\canada@ in the container @movies@, enter the path
-- @premium\/canada\/mlaw.avi@.
--
-- Do not include the container name in this path.
--
-- If the path includes any folders that don\'t exist yet, the service
-- creates them. For example, suppose you have an existing @premium\/usa@
-- subfolder. If you specify @premium\/canada@, the service creates a
-- @canada@ subfolder in the @premium@ folder. You then have two
-- subfolders, @usa@ and @canada@, in the @premium@ folder.
--
-- There is no correlation between the path to the source and the path
-- (folders) in the container in AWS Elemental MediaStore.
--
-- For more information about folders and how they exist in a container,
-- see the
-- <http://docs.aws.amazon.com/mediastore/latest/ug/ AWS Elemental MediaStore User Guide>.
--
-- The file name is the name that is assigned to the file that you upload.
-- The file can have the same name inside and outside of AWS Elemental
-- MediaStore, or it can have the same name. The file name can include or
-- omit an extension.
putObject_path :: Lens.Lens' PutObject Prelude.Text
putObject_path :: Lens' PutObject Text
putObject_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObject' {Text
path :: Text
$sel:path:PutObject' :: PutObject -> Text
path} -> Text
path) (\s :: PutObject
s@PutObject' {} Text
a -> PutObject
s {$sel:path:PutObject' :: Text
path = Text
a} :: PutObject)

-- | The bytes to be stored.
putObject_body :: Lens.Lens' PutObject Data.HashedBody
putObject_body :: Lens' PutObject HashedBody
putObject_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObject' {HashedBody
body :: HashedBody
$sel:body:PutObject' :: PutObject -> HashedBody
body} -> HashedBody
body) (\s :: PutObject
s@PutObject' {} HashedBody
a -> PutObject
s {$sel:body:PutObject' :: HashedBody
body = HashedBody
a} :: PutObject)

instance Core.AWSRequest PutObject where
  type AWSResponse PutObject = PutObjectResponse
  request :: (Service -> Service) -> PutObject -> Request PutObject
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.putBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutObject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutObject)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text -> Maybe StorageClass -> Int -> PutObjectResponse
PutObjectResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ContentSHA256")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ETag")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StorageClass")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Data.ToBody PutObject where
  toBody :: PutObject -> RequestBody
toBody PutObject' {Maybe Text
Maybe StorageClass
Maybe UploadAvailability
Text
HashedBody
body :: HashedBody
path :: Text
uploadAvailability :: Maybe UploadAvailability
storageClass :: Maybe StorageClass
contentType :: Maybe Text
cacheControl :: Maybe Text
$sel:body:PutObject' :: PutObject -> HashedBody
$sel:path:PutObject' :: PutObject -> Text
$sel:uploadAvailability:PutObject' :: PutObject -> Maybe UploadAvailability
$sel:storageClass:PutObject' :: PutObject -> Maybe StorageClass
$sel:contentType:PutObject' :: PutObject -> Maybe Text
$sel:cacheControl:PutObject' :: PutObject -> Maybe Text
..} = forall a. ToBody a => a -> RequestBody
Data.toBody HashedBody
body

instance Data.ToHeaders PutObject where
  toHeaders :: PutObject -> ResponseHeaders
toHeaders PutObject' {Maybe Text
Maybe StorageClass
Maybe UploadAvailability
Text
HashedBody
body :: HashedBody
path :: Text
uploadAvailability :: Maybe UploadAvailability
storageClass :: Maybe StorageClass
contentType :: Maybe Text
cacheControl :: Maybe Text
$sel:body:PutObject' :: PutObject -> HashedBody
$sel:path:PutObject' :: PutObject -> Text
$sel:uploadAvailability:PutObject' :: PutObject -> Maybe UploadAvailability
$sel:storageClass:PutObject' :: PutObject -> Maybe StorageClass
$sel:contentType:PutObject' :: PutObject -> Maybe Text
$sel:cacheControl:PutObject' :: PutObject -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Cache-Control" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
cacheControl,
        HeaderName
"Content-Type" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
contentType,
        HeaderName
"x-amz-storage-class" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe StorageClass
storageClass,
        HeaderName
"x-amz-upload-availability"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe UploadAvailability
uploadAvailability
      ]

instance Data.ToPath PutObject where
  toPath :: PutObject -> ByteString
toPath PutObject' {Maybe Text
Maybe StorageClass
Maybe UploadAvailability
Text
HashedBody
body :: HashedBody
path :: Text
uploadAvailability :: Maybe UploadAvailability
storageClass :: Maybe StorageClass
contentType :: Maybe Text
cacheControl :: Maybe Text
$sel:body:PutObject' :: PutObject -> HashedBody
$sel:path:PutObject' :: PutObject -> Text
$sel:uploadAvailability:PutObject' :: PutObject -> Maybe UploadAvailability
$sel:storageClass:PutObject' :: PutObject -> Maybe StorageClass
$sel:contentType:PutObject' :: PutObject -> Maybe Text
$sel:cacheControl:PutObject' :: PutObject -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
path]

instance Data.ToQuery PutObject where
  toQuery :: PutObject -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newPutObjectResponse' smart constructor.
data PutObjectResponse = PutObjectResponse'
  { -- | The SHA256 digest of the object that is persisted.
    PutObjectResponse -> Maybe Text
contentSHA256 :: Prelude.Maybe Prelude.Text,
    -- | Unique identifier of the object in the container.
    PutObjectResponse -> Maybe Text
eTag :: Prelude.Maybe Prelude.Text,
    -- | The storage class where the object was persisted. The class should be
    -- “Temporal”.
    PutObjectResponse -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | The response's http status code.
    PutObjectResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutObjectResponse -> PutObjectResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutObjectResponse -> PutObjectResponse -> Bool
$c/= :: PutObjectResponse -> PutObjectResponse -> Bool
== :: PutObjectResponse -> PutObjectResponse -> Bool
$c== :: PutObjectResponse -> PutObjectResponse -> Bool
Prelude.Eq, ReadPrec [PutObjectResponse]
ReadPrec PutObjectResponse
Int -> ReadS PutObjectResponse
ReadS [PutObjectResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutObjectResponse]
$creadListPrec :: ReadPrec [PutObjectResponse]
readPrec :: ReadPrec PutObjectResponse
$creadPrec :: ReadPrec PutObjectResponse
readList :: ReadS [PutObjectResponse]
$creadList :: ReadS [PutObjectResponse]
readsPrec :: Int -> ReadS PutObjectResponse
$creadsPrec :: Int -> ReadS PutObjectResponse
Prelude.Read, 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
Prelude.Show, forall x. Rep PutObjectResponse x -> PutObjectResponse
forall x. PutObjectResponse -> Rep PutObjectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutObjectResponse x -> PutObjectResponse
$cfrom :: forall x. PutObjectResponse -> Rep PutObjectResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutObjectResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'contentSHA256', 'putObjectResponse_contentSHA256' - The SHA256 digest of the object that is persisted.
--
-- 'eTag', 'putObjectResponse_eTag' - Unique identifier of the object in the container.
--
-- 'storageClass', 'putObjectResponse_storageClass' - The storage class where the object was persisted. The class should be
-- “Temporal”.
--
-- 'httpStatus', 'putObjectResponse_httpStatus' - The response's http status code.
newPutObjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutObjectResponse
newPutObjectResponse :: Int -> PutObjectResponse
newPutObjectResponse Int
pHttpStatus_ =
  PutObjectResponse'
    { $sel:contentSHA256:PutObjectResponse' :: Maybe Text
contentSHA256 = forall a. Maybe a
Prelude.Nothing,
      $sel:eTag:PutObjectResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:PutObjectResponse' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutObjectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The SHA256 digest of the object that is persisted.
putObjectResponse_contentSHA256 :: Lens.Lens' PutObjectResponse (Prelude.Maybe Prelude.Text)
putObjectResponse_contentSHA256 :: Lens' PutObjectResponse (Maybe Text)
putObjectResponse_contentSHA256 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectResponse' {Maybe Text
contentSHA256 :: Maybe Text
$sel:contentSHA256:PutObjectResponse' :: PutObjectResponse -> Maybe Text
contentSHA256} -> Maybe Text
contentSHA256) (\s :: PutObjectResponse
s@PutObjectResponse' {} Maybe Text
a -> PutObjectResponse
s {$sel:contentSHA256:PutObjectResponse' :: Maybe Text
contentSHA256 = Maybe Text
a} :: PutObjectResponse)

-- | Unique identifier of the object in the container.
putObjectResponse_eTag :: Lens.Lens' PutObjectResponse (Prelude.Maybe Prelude.Text)
putObjectResponse_eTag :: Lens' PutObjectResponse (Maybe Text)
putObjectResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectResponse' {Maybe Text
eTag :: Maybe Text
$sel:eTag:PutObjectResponse' :: PutObjectResponse -> Maybe Text
eTag} -> Maybe Text
eTag) (\s :: PutObjectResponse
s@PutObjectResponse' {} Maybe Text
a -> PutObjectResponse
s {$sel:eTag:PutObjectResponse' :: Maybe Text
eTag = Maybe Text
a} :: PutObjectResponse)

-- | The storage class where the object was persisted. The class should be
-- “Temporal”.
putObjectResponse_storageClass :: Lens.Lens' PutObjectResponse (Prelude.Maybe StorageClass)
putObjectResponse_storageClass :: Lens' PutObjectResponse (Maybe StorageClass)
putObjectResponse_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectResponse' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:PutObjectResponse' :: PutObjectResponse -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: PutObjectResponse
s@PutObjectResponse' {} Maybe StorageClass
a -> PutObjectResponse
s {$sel:storageClass:PutObjectResponse' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: PutObjectResponse)

-- | The response's http status code.
putObjectResponse_httpStatus :: Lens.Lens' PutObjectResponse Prelude.Int
putObjectResponse_httpStatus :: Lens' PutObjectResponse Int
putObjectResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutObjectResponse' :: PutObjectResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutObjectResponse
s@PutObjectResponse' {} Int
a -> PutObjectResponse
s {$sel:httpStatus:PutObjectResponse' :: Int
httpStatus = Int
a} :: PutObjectResponse)

instance Prelude.NFData PutObjectResponse where
  rnf :: PutObjectResponse -> ()
rnf PutObjectResponse' {Int
Maybe Text
Maybe StorageClass
httpStatus :: Int
storageClass :: Maybe StorageClass
eTag :: Maybe Text
contentSHA256 :: Maybe Text
$sel:httpStatus:PutObjectResponse' :: PutObjectResponse -> Int
$sel:storageClass:PutObjectResponse' :: PutObjectResponse -> Maybe StorageClass
$sel:eTag:PutObjectResponse' :: PutObjectResponse -> Maybe Text
$sel:contentSHA256:PutObjectResponse' :: PutObjectResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentSHA256
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
eTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageClass
storageClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus