{-# 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.GetObject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Downloads the object at the specified path. If the object’s upload
-- availability is set to @streaming@, AWS Elemental MediaStore downloads
-- the object even if it’s still uploading the object.
module Amazonka.MediaStoreData.GetObject
  ( -- * Creating a Request
    GetObject (..),
    newGetObject,

    -- * Request Lenses
    getObject_range,
    getObject_path,

    -- * Destructuring the Response
    GetObjectResponse (..),
    newGetObjectResponse,

    -- * Response Lenses
    getObjectResponse_cacheControl,
    getObjectResponse_contentLength,
    getObjectResponse_contentRange,
    getObjectResponse_contentType,
    getObjectResponse_eTag,
    getObjectResponse_lastModified,
    getObjectResponse_statusCode,
    getObjectResponse_body,
  )
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:/ 'newGetObject' smart constructor.
data GetObject = GetObject'
  { -- | The range bytes of an object to retrieve. For more information about the
    -- @Range@ header, see
    -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.35>. AWS
    -- Elemental MediaStore ignores this header for partially uploaded objects
    -- that have streaming upload availability.
    GetObject -> Maybe Text
range :: Prelude.Maybe Prelude.Text,
    -- | 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.
    GetObject -> Text
path :: Prelude.Text
  }
  deriving (GetObject -> GetObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObject -> GetObject -> Bool
$c/= :: GetObject -> GetObject -> Bool
== :: GetObject -> GetObject -> Bool
$c== :: GetObject -> GetObject -> Bool
Prelude.Eq, ReadPrec [GetObject]
ReadPrec GetObject
Int -> ReadS GetObject
ReadS [GetObject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetObject]
$creadListPrec :: ReadPrec [GetObject]
readPrec :: ReadPrec GetObject
$creadPrec :: ReadPrec GetObject
readList :: ReadS [GetObject]
$creadList :: ReadS [GetObject]
readsPrec :: Int -> ReadS GetObject
$creadsPrec :: Int -> ReadS GetObject
Prelude.Read, Int -> GetObject -> ShowS
[GetObject] -> ShowS
GetObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObject] -> ShowS
$cshowList :: [GetObject] -> ShowS
show :: GetObject -> String
$cshow :: GetObject -> String
showsPrec :: Int -> GetObject -> ShowS
$cshowsPrec :: Int -> GetObject -> ShowS
Prelude.Show, forall x. Rep GetObject x -> GetObject
forall x. GetObject -> Rep GetObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetObject x -> GetObject
$cfrom :: forall x. GetObject -> Rep GetObject x
Prelude.Generic)

-- |
-- Create a value of 'GetObject' 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:
--
-- 'range', 'getObject_range' - The range bytes of an object to retrieve. For more information about the
-- @Range@ header, see
-- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.35>. AWS
-- Elemental MediaStore ignores this header for partially uploaded objects
-- that have streaming upload availability.
--
-- 'path', 'getObject_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.
newGetObject ::
  -- | 'path'
  Prelude.Text ->
  GetObject
newGetObject :: Text -> GetObject
newGetObject Text
pPath_ =
  GetObject' {$sel:range:GetObject' :: Maybe Text
range = forall a. Maybe a
Prelude.Nothing, $sel:path:GetObject' :: Text
path = Text
pPath_}

-- | The range bytes of an object to retrieve. For more information about the
-- @Range@ header, see
-- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.35>. AWS
-- Elemental MediaStore ignores this header for partially uploaded objects
-- that have streaming upload availability.
getObject_range :: Lens.Lens' GetObject (Prelude.Maybe Prelude.Text)
getObject_range :: Lens' GetObject (Maybe Text)
getObject_range = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObject' {Maybe Text
range :: Maybe Text
$sel:range:GetObject' :: GetObject -> Maybe Text
range} -> Maybe Text
range) (\s :: GetObject
s@GetObject' {} Maybe Text
a -> GetObject
s {$sel:range:GetObject' :: Maybe Text
range = Maybe Text
a} :: GetObject)

-- | 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.
getObject_path :: Lens.Lens' GetObject Prelude.Text
getObject_path :: Lens' GetObject Text
getObject_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObject' {Text
path :: Text
$sel:path:GetObject' :: GetObject -> Text
path} -> Text
path) (\s :: GetObject
s@GetObject' {} Text
a -> GetObject
s {$sel:path:GetObject' :: Text
path = Text
a} :: GetObject)

instance Core.AWSRequest GetObject where
  type AWSResponse GetObject = GetObjectResponse
  request :: (Service -> Service) -> GetObject -> Request GetObject
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetObject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetObject)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBody
      ( \Int
s ResponseHeaders
h ResponseBody
x ->
          Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Int
-> ResponseBody
-> GetObjectResponse
GetObjectResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Cache-Control")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Length")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Range")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"ETag")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Last-Modified")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ResponseBody
x)
      )

instance Prelude.Hashable GetObject where
  hashWithSalt :: Int -> GetObject -> Int
hashWithSalt Int
_salt GetObject' {Maybe Text
Text
path :: Text
range :: Maybe Text
$sel:path:GetObject' :: GetObject -> Text
$sel:range:GetObject' :: GetObject -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
range
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
path

instance Prelude.NFData GetObject where
  rnf :: GetObject -> ()
rnf GetObject' {Maybe Text
Text
path :: Text
range :: Maybe Text
$sel:path:GetObject' :: GetObject -> Text
$sel:range:GetObject' :: GetObject -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
range seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
path

instance Data.ToHeaders GetObject where
  toHeaders :: GetObject -> ResponseHeaders
toHeaders GetObject' {Maybe Text
Text
path :: Text
range :: Maybe Text
$sel:path:GetObject' :: GetObject -> Text
$sel:range:GetObject' :: GetObject -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [HeaderName
"Range" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
range]

instance Data.ToPath GetObject where
  toPath :: GetObject -> ByteString
toPath GetObject' {Maybe Text
Text
path :: Text
range :: Maybe Text
$sel:path:GetObject' :: GetObject -> Text
$sel:range:GetObject' :: GetObject -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
path]

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

-- | /See:/ 'newGetObjectResponse' smart constructor.
data GetObjectResponse = GetObjectResponse'
  { -- | 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 spec at
    -- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.9>.
    --
    -- Headers with a custom user-defined value are also accepted.
    GetObjectResponse -> Maybe Text
cacheControl :: Prelude.Maybe Prelude.Text,
    -- | The length of the object in bytes.
    GetObjectResponse -> Maybe Natural
contentLength :: Prelude.Maybe Prelude.Natural,
    -- | The range of bytes to retrieve.
    GetObjectResponse -> Maybe Text
contentRange :: Prelude.Maybe Prelude.Text,
    -- | The content type of the object.
    GetObjectResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The ETag that represents a unique instance of the object.
    GetObjectResponse -> Maybe Text
eTag :: Prelude.Maybe Prelude.Text,
    -- | The date and time that the object was last modified.
    GetObjectResponse -> Maybe POSIX
lastModified :: Prelude.Maybe Data.POSIX,
    -- | The HTML status code of the request. Status codes ranging from 200 to
    -- 299 indicate success. All other status codes indicate the type of error
    -- that occurred.
    GetObjectResponse -> Int
statusCode :: Prelude.Int,
    -- | The bytes of the object.
    GetObjectResponse -> ResponseBody
body :: Data.ResponseBody
  }
  deriving (Int -> GetObjectResponse -> ShowS
[GetObjectResponse] -> ShowS
GetObjectResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectResponse] -> ShowS
$cshowList :: [GetObjectResponse] -> ShowS
show :: GetObjectResponse -> String
$cshow :: GetObjectResponse -> String
showsPrec :: Int -> GetObjectResponse -> ShowS
$cshowsPrec :: Int -> GetObjectResponse -> ShowS
Prelude.Show, forall x. Rep GetObjectResponse x -> GetObjectResponse
forall x. GetObjectResponse -> Rep GetObjectResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetObjectResponse x -> GetObjectResponse
$cfrom :: forall x. GetObjectResponse -> Rep GetObjectResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectResponse' 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', 'getObjectResponse_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 spec at
-- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.9>.
--
-- Headers with a custom user-defined value are also accepted.
--
-- 'contentLength', 'getObjectResponse_contentLength' - The length of the object in bytes.
--
-- 'contentRange', 'getObjectResponse_contentRange' - The range of bytes to retrieve.
--
-- 'contentType', 'getObjectResponse_contentType' - The content type of the object.
--
-- 'eTag', 'getObjectResponse_eTag' - The ETag that represents a unique instance of the object.
--
-- 'lastModified', 'getObjectResponse_lastModified' - The date and time that the object was last modified.
--
-- 'statusCode', 'getObjectResponse_statusCode' - The HTML status code of the request. Status codes ranging from 200 to
-- 299 indicate success. All other status codes indicate the type of error
-- that occurred.
--
-- 'body', 'getObjectResponse_body' - The bytes of the object.
newGetObjectResponse ::
  -- | 'statusCode'
  Prelude.Int ->
  -- | 'body'
  Data.ResponseBody ->
  GetObjectResponse
newGetObjectResponse :: Int -> ResponseBody -> GetObjectResponse
newGetObjectResponse Int
pStatusCode_ ResponseBody
pBody_ =
  GetObjectResponse'
    { $sel:cacheControl:GetObjectResponse' :: Maybe Text
cacheControl = forall a. Maybe a
Prelude.Nothing,
      $sel:contentLength:GetObjectResponse' :: Maybe Natural
contentLength = forall a. Maybe a
Prelude.Nothing,
      $sel:contentRange:GetObjectResponse' :: Maybe Text
contentRange = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:GetObjectResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:eTag:GetObjectResponse' :: Maybe Text
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModified:GetObjectResponse' :: Maybe POSIX
lastModified = forall a. Maybe a
Prelude.Nothing,
      $sel:statusCode:GetObjectResponse' :: Int
statusCode = Int
pStatusCode_,
      $sel:body:GetObjectResponse' :: ResponseBody
body = ResponseBody
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 spec at
-- <https://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html#sec14.9>.
--
-- Headers with a custom user-defined value are also accepted.
getObjectResponse_cacheControl :: Lens.Lens' GetObjectResponse (Prelude.Maybe Prelude.Text)
getObjectResponse_cacheControl :: Lens' GetObjectResponse (Maybe Text)
getObjectResponse_cacheControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectResponse' {Maybe Text
cacheControl :: Maybe Text
$sel:cacheControl:GetObjectResponse' :: GetObjectResponse -> Maybe Text
cacheControl} -> Maybe Text
cacheControl) (\s :: GetObjectResponse
s@GetObjectResponse' {} Maybe Text
a -> GetObjectResponse
s {$sel:cacheControl:GetObjectResponse' :: Maybe Text
cacheControl = Maybe Text
a} :: GetObjectResponse)

-- | The length of the object in bytes.
getObjectResponse_contentLength :: Lens.Lens' GetObjectResponse (Prelude.Maybe Prelude.Natural)
getObjectResponse_contentLength :: Lens' GetObjectResponse (Maybe Natural)
getObjectResponse_contentLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectResponse' {Maybe Natural
contentLength :: Maybe Natural
$sel:contentLength:GetObjectResponse' :: GetObjectResponse -> Maybe Natural
contentLength} -> Maybe Natural
contentLength) (\s :: GetObjectResponse
s@GetObjectResponse' {} Maybe Natural
a -> GetObjectResponse
s {$sel:contentLength:GetObjectResponse' :: Maybe Natural
contentLength = Maybe Natural
a} :: GetObjectResponse)

-- | The range of bytes to retrieve.
getObjectResponse_contentRange :: Lens.Lens' GetObjectResponse (Prelude.Maybe Prelude.Text)
getObjectResponse_contentRange :: Lens' GetObjectResponse (Maybe Text)
getObjectResponse_contentRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectResponse' {Maybe Text
contentRange :: Maybe Text
$sel:contentRange:GetObjectResponse' :: GetObjectResponse -> Maybe Text
contentRange} -> Maybe Text
contentRange) (\s :: GetObjectResponse
s@GetObjectResponse' {} Maybe Text
a -> GetObjectResponse
s {$sel:contentRange:GetObjectResponse' :: Maybe Text
contentRange = Maybe Text
a} :: GetObjectResponse)

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

-- | The ETag that represents a unique instance of the object.
getObjectResponse_eTag :: Lens.Lens' GetObjectResponse (Prelude.Maybe Prelude.Text)
getObjectResponse_eTag :: Lens' GetObjectResponse (Maybe Text)
getObjectResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectResponse' {Maybe Text
eTag :: Maybe Text
$sel:eTag:GetObjectResponse' :: GetObjectResponse -> Maybe Text
eTag} -> Maybe Text
eTag) (\s :: GetObjectResponse
s@GetObjectResponse' {} Maybe Text
a -> GetObjectResponse
s {$sel:eTag:GetObjectResponse' :: Maybe Text
eTag = Maybe Text
a} :: GetObjectResponse)

-- | The date and time that the object was last modified.
getObjectResponse_lastModified :: Lens.Lens' GetObjectResponse (Prelude.Maybe Prelude.UTCTime)
getObjectResponse_lastModified :: Lens' GetObjectResponse (Maybe UTCTime)
getObjectResponse_lastModified = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectResponse' {Maybe POSIX
lastModified :: Maybe POSIX
$sel:lastModified:GetObjectResponse' :: GetObjectResponse -> Maybe POSIX
lastModified} -> Maybe POSIX
lastModified) (\s :: GetObjectResponse
s@GetObjectResponse' {} Maybe POSIX
a -> GetObjectResponse
s {$sel:lastModified:GetObjectResponse' :: Maybe POSIX
lastModified = Maybe POSIX
a} :: GetObjectResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The HTML status code of the request. Status codes ranging from 200 to
-- 299 indicate success. All other status codes indicate the type of error
-- that occurred.
getObjectResponse_statusCode :: Lens.Lens' GetObjectResponse Prelude.Int
getObjectResponse_statusCode :: Lens' GetObjectResponse Int
getObjectResponse_statusCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectResponse' {Int
statusCode :: Int
$sel:statusCode:GetObjectResponse' :: GetObjectResponse -> Int
statusCode} -> Int
statusCode) (\s :: GetObjectResponse
s@GetObjectResponse' {} Int
a -> GetObjectResponse
s {$sel:statusCode:GetObjectResponse' :: Int
statusCode = Int
a} :: GetObjectResponse)

-- | The bytes of the object.
getObjectResponse_body :: Lens.Lens' GetObjectResponse Data.ResponseBody
getObjectResponse_body :: Lens' GetObjectResponse ResponseBody
getObjectResponse_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectResponse' {ResponseBody
body :: ResponseBody
$sel:body:GetObjectResponse' :: GetObjectResponse -> ResponseBody
body} -> ResponseBody
body) (\s :: GetObjectResponse
s@GetObjectResponse' {} ResponseBody
a -> GetObjectResponse
s {$sel:body:GetObjectResponse' :: ResponseBody
body = ResponseBody
a} :: GetObjectResponse)