{-# 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.CloudDirectory.GetObjectAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves attributes within a facet that are associated with an object.
module Amazonka.CloudDirectory.GetObjectAttributes
  ( -- * Creating a Request
    GetObjectAttributes (..),
    newGetObjectAttributes,

    -- * Request Lenses
    getObjectAttributes_consistencyLevel,
    getObjectAttributes_directoryArn,
    getObjectAttributes_objectReference,
    getObjectAttributes_schemaFacet,
    getObjectAttributes_attributeNames,

    -- * Destructuring the Response
    GetObjectAttributesResponse (..),
    newGetObjectAttributesResponse,

    -- * Response Lenses
    getObjectAttributesResponse_attributes,
    getObjectAttributesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetObjectAttributes' smart constructor.
data GetObjectAttributes = GetObjectAttributes'
  { -- | The consistency level at which to retrieve the attributes on an object.
    GetObjectAttributes -> Maybe ConsistencyLevel
consistencyLevel :: Prelude.Maybe ConsistencyLevel,
    -- | The Amazon Resource Name (ARN) that is associated with the Directory
    -- where the object resides.
    GetObjectAttributes -> Text
directoryArn :: Prelude.Text,
    -- | Reference that identifies the object whose attributes will be retrieved.
    GetObjectAttributes -> ObjectReference
objectReference :: ObjectReference,
    -- | Identifier for the facet whose attributes will be retrieved. See
    -- SchemaFacet for details.
    GetObjectAttributes -> SchemaFacet
schemaFacet :: SchemaFacet,
    -- | List of attribute names whose values will be retrieved.
    GetObjectAttributes -> [Text]
attributeNames :: [Prelude.Text]
  }
  deriving (GetObjectAttributes -> GetObjectAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObjectAttributes -> GetObjectAttributes -> Bool
$c/= :: GetObjectAttributes -> GetObjectAttributes -> Bool
== :: GetObjectAttributes -> GetObjectAttributes -> Bool
$c== :: GetObjectAttributes -> GetObjectAttributes -> Bool
Prelude.Eq, ReadPrec [GetObjectAttributes]
ReadPrec GetObjectAttributes
Int -> ReadS GetObjectAttributes
ReadS [GetObjectAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetObjectAttributes]
$creadListPrec :: ReadPrec [GetObjectAttributes]
readPrec :: ReadPrec GetObjectAttributes
$creadPrec :: ReadPrec GetObjectAttributes
readList :: ReadS [GetObjectAttributes]
$creadList :: ReadS [GetObjectAttributes]
readsPrec :: Int -> ReadS GetObjectAttributes
$creadsPrec :: Int -> ReadS GetObjectAttributes
Prelude.Read, Int -> GetObjectAttributes -> ShowS
[GetObjectAttributes] -> ShowS
GetObjectAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectAttributes] -> ShowS
$cshowList :: [GetObjectAttributes] -> ShowS
show :: GetObjectAttributes -> String
$cshow :: GetObjectAttributes -> String
showsPrec :: Int -> GetObjectAttributes -> ShowS
$cshowsPrec :: Int -> GetObjectAttributes -> ShowS
Prelude.Show, forall x. Rep GetObjectAttributes x -> GetObjectAttributes
forall x. GetObjectAttributes -> Rep GetObjectAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetObjectAttributes x -> GetObjectAttributes
$cfrom :: forall x. GetObjectAttributes -> Rep GetObjectAttributes x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectAttributes' 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:
--
-- 'consistencyLevel', 'getObjectAttributes_consistencyLevel' - The consistency level at which to retrieve the attributes on an object.
--
-- 'directoryArn', 'getObjectAttributes_directoryArn' - The Amazon Resource Name (ARN) that is associated with the Directory
-- where the object resides.
--
-- 'objectReference', 'getObjectAttributes_objectReference' - Reference that identifies the object whose attributes will be retrieved.
--
-- 'schemaFacet', 'getObjectAttributes_schemaFacet' - Identifier for the facet whose attributes will be retrieved. See
-- SchemaFacet for details.
--
-- 'attributeNames', 'getObjectAttributes_attributeNames' - List of attribute names whose values will be retrieved.
newGetObjectAttributes ::
  -- | 'directoryArn'
  Prelude.Text ->
  -- | 'objectReference'
  ObjectReference ->
  -- | 'schemaFacet'
  SchemaFacet ->
  GetObjectAttributes
newGetObjectAttributes :: Text -> ObjectReference -> SchemaFacet -> GetObjectAttributes
newGetObjectAttributes
  Text
pDirectoryArn_
  ObjectReference
pObjectReference_
  SchemaFacet
pSchemaFacet_ =
    GetObjectAttributes'
      { $sel:consistencyLevel:GetObjectAttributes' :: Maybe ConsistencyLevel
consistencyLevel =
          forall a. Maybe a
Prelude.Nothing,
        $sel:directoryArn:GetObjectAttributes' :: Text
directoryArn = Text
pDirectoryArn_,
        $sel:objectReference:GetObjectAttributes' :: ObjectReference
objectReference = ObjectReference
pObjectReference_,
        $sel:schemaFacet:GetObjectAttributes' :: SchemaFacet
schemaFacet = SchemaFacet
pSchemaFacet_,
        $sel:attributeNames:GetObjectAttributes' :: [Text]
attributeNames = forall a. Monoid a => a
Prelude.mempty
      }

-- | The consistency level at which to retrieve the attributes on an object.
getObjectAttributes_consistencyLevel :: Lens.Lens' GetObjectAttributes (Prelude.Maybe ConsistencyLevel)
getObjectAttributes_consistencyLevel :: Lens' GetObjectAttributes (Maybe ConsistencyLevel)
getObjectAttributes_consistencyLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Maybe ConsistencyLevel
consistencyLevel :: Maybe ConsistencyLevel
$sel:consistencyLevel:GetObjectAttributes' :: GetObjectAttributes -> Maybe ConsistencyLevel
consistencyLevel} -> Maybe ConsistencyLevel
consistencyLevel) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Maybe ConsistencyLevel
a -> GetObjectAttributes
s {$sel:consistencyLevel:GetObjectAttributes' :: Maybe ConsistencyLevel
consistencyLevel = Maybe ConsistencyLevel
a} :: GetObjectAttributes)

-- | The Amazon Resource Name (ARN) that is associated with the Directory
-- where the object resides.
getObjectAttributes_directoryArn :: Lens.Lens' GetObjectAttributes Prelude.Text
getObjectAttributes_directoryArn :: Lens' GetObjectAttributes Text
getObjectAttributes_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Text
directoryArn :: Text
$sel:directoryArn:GetObjectAttributes' :: GetObjectAttributes -> Text
directoryArn} -> Text
directoryArn) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Text
a -> GetObjectAttributes
s {$sel:directoryArn:GetObjectAttributes' :: Text
directoryArn = Text
a} :: GetObjectAttributes)

-- | Reference that identifies the object whose attributes will be retrieved.
getObjectAttributes_objectReference :: Lens.Lens' GetObjectAttributes ObjectReference
getObjectAttributes_objectReference :: Lens' GetObjectAttributes ObjectReference
getObjectAttributes_objectReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {ObjectReference
objectReference :: ObjectReference
$sel:objectReference:GetObjectAttributes' :: GetObjectAttributes -> ObjectReference
objectReference} -> ObjectReference
objectReference) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} ObjectReference
a -> GetObjectAttributes
s {$sel:objectReference:GetObjectAttributes' :: ObjectReference
objectReference = ObjectReference
a} :: GetObjectAttributes)

-- | Identifier for the facet whose attributes will be retrieved. See
-- SchemaFacet for details.
getObjectAttributes_schemaFacet :: Lens.Lens' GetObjectAttributes SchemaFacet
getObjectAttributes_schemaFacet :: Lens' GetObjectAttributes SchemaFacet
getObjectAttributes_schemaFacet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {SchemaFacet
schemaFacet :: SchemaFacet
$sel:schemaFacet:GetObjectAttributes' :: GetObjectAttributes -> SchemaFacet
schemaFacet} -> SchemaFacet
schemaFacet) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} SchemaFacet
a -> GetObjectAttributes
s {$sel:schemaFacet:GetObjectAttributes' :: SchemaFacet
schemaFacet = SchemaFacet
a} :: GetObjectAttributes)

-- | List of attribute names whose values will be retrieved.
getObjectAttributes_attributeNames :: Lens.Lens' GetObjectAttributes [Prelude.Text]
getObjectAttributes_attributeNames :: Lens' GetObjectAttributes [Text]
getObjectAttributes_attributeNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {[Text]
attributeNames :: [Text]
$sel:attributeNames:GetObjectAttributes' :: GetObjectAttributes -> [Text]
attributeNames} -> [Text]
attributeNames) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} [Text]
a -> GetObjectAttributes
s {$sel:attributeNames:GetObjectAttributes' :: [Text]
attributeNames = [Text]
a} :: GetObjectAttributes) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest GetObjectAttributes where
  type
    AWSResponse GetObjectAttributes =
      GetObjectAttributesResponse
  request :: (Service -> Service)
-> GetObjectAttributes -> Request GetObjectAttributes
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetObjectAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetObjectAttributes)))
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 [AttributeKeyAndValue] -> Int -> GetObjectAttributesResponse
GetObjectAttributesResponse'
            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
"Attributes" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 Prelude.Hashable GetObjectAttributes where
  hashWithSalt :: Int -> GetObjectAttributes -> Int
hashWithSalt Int
_salt GetObjectAttributes' {[Text]
Maybe ConsistencyLevel
Text
ObjectReference
SchemaFacet
attributeNames :: [Text]
schemaFacet :: SchemaFacet
objectReference :: ObjectReference
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetObjectAttributes' :: GetObjectAttributes -> [Text]
$sel:schemaFacet:GetObjectAttributes' :: GetObjectAttributes -> SchemaFacet
$sel:objectReference:GetObjectAttributes' :: GetObjectAttributes -> ObjectReference
$sel:directoryArn:GetObjectAttributes' :: GetObjectAttributes -> Text
$sel:consistencyLevel:GetObjectAttributes' :: GetObjectAttributes -> Maybe ConsistencyLevel
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConsistencyLevel
consistencyLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectReference
objectReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SchemaFacet
schemaFacet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
attributeNames

instance Prelude.NFData GetObjectAttributes where
  rnf :: GetObjectAttributes -> ()
rnf GetObjectAttributes' {[Text]
Maybe ConsistencyLevel
Text
ObjectReference
SchemaFacet
attributeNames :: [Text]
schemaFacet :: SchemaFacet
objectReference :: ObjectReference
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetObjectAttributes' :: GetObjectAttributes -> [Text]
$sel:schemaFacet:GetObjectAttributes' :: GetObjectAttributes -> SchemaFacet
$sel:objectReference:GetObjectAttributes' :: GetObjectAttributes -> ObjectReference
$sel:directoryArn:GetObjectAttributes' :: GetObjectAttributes -> Text
$sel:consistencyLevel:GetObjectAttributes' :: GetObjectAttributes -> Maybe ConsistencyLevel
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConsistencyLevel
consistencyLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
directoryArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectReference
objectReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SchemaFacet
schemaFacet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
attributeNames

instance Data.ToHeaders GetObjectAttributes where
  toHeaders :: GetObjectAttributes -> ResponseHeaders
toHeaders GetObjectAttributes' {[Text]
Maybe ConsistencyLevel
Text
ObjectReference
SchemaFacet
attributeNames :: [Text]
schemaFacet :: SchemaFacet
objectReference :: ObjectReference
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetObjectAttributes' :: GetObjectAttributes -> [Text]
$sel:schemaFacet:GetObjectAttributes' :: GetObjectAttributes -> SchemaFacet
$sel:objectReference:GetObjectAttributes' :: GetObjectAttributes -> ObjectReference
$sel:directoryArn:GetObjectAttributes' :: GetObjectAttributes -> Text
$sel:consistencyLevel:GetObjectAttributes' :: GetObjectAttributes -> Maybe ConsistencyLevel
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-consistency-level" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ConsistencyLevel
consistencyLevel,
        HeaderName
"x-amz-data-partition" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
directoryArn
      ]

instance Data.ToJSON GetObjectAttributes where
  toJSON :: GetObjectAttributes -> Value
toJSON GetObjectAttributes' {[Text]
Maybe ConsistencyLevel
Text
ObjectReference
SchemaFacet
attributeNames :: [Text]
schemaFacet :: SchemaFacet
objectReference :: ObjectReference
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetObjectAttributes' :: GetObjectAttributes -> [Text]
$sel:schemaFacet:GetObjectAttributes' :: GetObjectAttributes -> SchemaFacet
$sel:objectReference:GetObjectAttributes' :: GetObjectAttributes -> ObjectReference
$sel:directoryArn:GetObjectAttributes' :: GetObjectAttributes -> Text
$sel:consistencyLevel:GetObjectAttributes' :: GetObjectAttributes -> Maybe ConsistencyLevel
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ObjectReference" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ObjectReference
objectReference),
            forall a. a -> Maybe a
Prelude.Just (Key
"SchemaFacet" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SchemaFacet
schemaFacet),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AttributeNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
attributeNames)
          ]
      )

instance Data.ToPath GetObjectAttributes where
  toPath :: GetObjectAttributes -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/object/attributes/get"

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

-- | /See:/ 'newGetObjectAttributesResponse' smart constructor.
data GetObjectAttributesResponse = GetObjectAttributesResponse'
  { -- | The attributes that are associated with the object.
    GetObjectAttributesResponse -> Maybe [AttributeKeyAndValue]
attributes :: Prelude.Maybe [AttributeKeyAndValue],
    -- | The response's http status code.
    GetObjectAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
$c/= :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
== :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
$c== :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
Prelude.Eq, ReadPrec [GetObjectAttributesResponse]
ReadPrec GetObjectAttributesResponse
Int -> ReadS GetObjectAttributesResponse
ReadS [GetObjectAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetObjectAttributesResponse]
$creadListPrec :: ReadPrec [GetObjectAttributesResponse]
readPrec :: ReadPrec GetObjectAttributesResponse
$creadPrec :: ReadPrec GetObjectAttributesResponse
readList :: ReadS [GetObjectAttributesResponse]
$creadList :: ReadS [GetObjectAttributesResponse]
readsPrec :: Int -> ReadS GetObjectAttributesResponse
$creadsPrec :: Int -> ReadS GetObjectAttributesResponse
Prelude.Read, Int -> GetObjectAttributesResponse -> ShowS
[GetObjectAttributesResponse] -> ShowS
GetObjectAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectAttributesResponse] -> ShowS
$cshowList :: [GetObjectAttributesResponse] -> ShowS
show :: GetObjectAttributesResponse -> String
$cshow :: GetObjectAttributesResponse -> String
showsPrec :: Int -> GetObjectAttributesResponse -> ShowS
$cshowsPrec :: Int -> GetObjectAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep GetObjectAttributesResponse x -> GetObjectAttributesResponse
forall x.
GetObjectAttributesResponse -> Rep GetObjectAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetObjectAttributesResponse x -> GetObjectAttributesResponse
$cfrom :: forall x.
GetObjectAttributesResponse -> Rep GetObjectAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectAttributesResponse' 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:
--
-- 'attributes', 'getObjectAttributesResponse_attributes' - The attributes that are associated with the object.
--
-- 'httpStatus', 'getObjectAttributesResponse_httpStatus' - The response's http status code.
newGetObjectAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetObjectAttributesResponse
newGetObjectAttributesResponse :: Int -> GetObjectAttributesResponse
newGetObjectAttributesResponse Int
pHttpStatus_ =
  GetObjectAttributesResponse'
    { $sel:attributes:GetObjectAttributesResponse' :: Maybe [AttributeKeyAndValue]
attributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetObjectAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The attributes that are associated with the object.
getObjectAttributesResponse_attributes :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe [AttributeKeyAndValue])
getObjectAttributesResponse_attributes :: Lens' GetObjectAttributesResponse (Maybe [AttributeKeyAndValue])
getObjectAttributesResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe [AttributeKeyAndValue]
attributes :: Maybe [AttributeKeyAndValue]
$sel:attributes:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe [AttributeKeyAndValue]
attributes} -> Maybe [AttributeKeyAndValue]
attributes) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe [AttributeKeyAndValue]
a -> GetObjectAttributesResponse
s {$sel:attributes:GetObjectAttributesResponse' :: Maybe [AttributeKeyAndValue]
attributes = Maybe [AttributeKeyAndValue]
a} :: GetObjectAttributesResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData GetObjectAttributesResponse where
  rnf :: GetObjectAttributesResponse -> ()
rnf GetObjectAttributesResponse' {Int
Maybe [AttributeKeyAndValue]
httpStatus :: Int
attributes :: Maybe [AttributeKeyAndValue]
$sel:httpStatus:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Int
$sel:attributes:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe [AttributeKeyAndValue]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttributeKeyAndValue]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus