{-# 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.GetLinkAttributes
-- 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 that are associated with a typed link.
module Amazonka.CloudDirectory.GetLinkAttributes
  ( -- * Creating a Request
    GetLinkAttributes (..),
    newGetLinkAttributes,

    -- * Request Lenses
    getLinkAttributes_consistencyLevel,
    getLinkAttributes_directoryArn,
    getLinkAttributes_typedLinkSpecifier,
    getLinkAttributes_attributeNames,

    -- * Destructuring the Response
    GetLinkAttributesResponse (..),
    newGetLinkAttributesResponse,

    -- * Response Lenses
    getLinkAttributesResponse_attributes,
    getLinkAttributesResponse_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:/ 'newGetLinkAttributes' smart constructor.
data GetLinkAttributes = GetLinkAttributes'
  { -- | The consistency level at which to retrieve the attributes on a typed
    -- link.
    GetLinkAttributes -> Maybe ConsistencyLevel
consistencyLevel :: Prelude.Maybe ConsistencyLevel,
    -- | The Amazon Resource Name (ARN) that is associated with the Directory
    -- where the typed link resides. For more information, see arns or
    -- <https://docs.aws.amazon.com/clouddirectory/latest/developerguide/directory_objects_links.html#directory_objects_links_typedlink Typed Links>.
    GetLinkAttributes -> Text
directoryArn :: Prelude.Text,
    -- | Allows a typed link specifier to be accepted as input.
    GetLinkAttributes -> TypedLinkSpecifier
typedLinkSpecifier :: TypedLinkSpecifier,
    -- | A list of attribute names whose values will be retrieved.
    GetLinkAttributes -> [Text]
attributeNames :: [Prelude.Text]
  }
  deriving (GetLinkAttributes -> GetLinkAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLinkAttributes -> GetLinkAttributes -> Bool
$c/= :: GetLinkAttributes -> GetLinkAttributes -> Bool
== :: GetLinkAttributes -> GetLinkAttributes -> Bool
$c== :: GetLinkAttributes -> GetLinkAttributes -> Bool
Prelude.Eq, ReadPrec [GetLinkAttributes]
ReadPrec GetLinkAttributes
Int -> ReadS GetLinkAttributes
ReadS [GetLinkAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLinkAttributes]
$creadListPrec :: ReadPrec [GetLinkAttributes]
readPrec :: ReadPrec GetLinkAttributes
$creadPrec :: ReadPrec GetLinkAttributes
readList :: ReadS [GetLinkAttributes]
$creadList :: ReadS [GetLinkAttributes]
readsPrec :: Int -> ReadS GetLinkAttributes
$creadsPrec :: Int -> ReadS GetLinkAttributes
Prelude.Read, Int -> GetLinkAttributes -> ShowS
[GetLinkAttributes] -> ShowS
GetLinkAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLinkAttributes] -> ShowS
$cshowList :: [GetLinkAttributes] -> ShowS
show :: GetLinkAttributes -> String
$cshow :: GetLinkAttributes -> String
showsPrec :: Int -> GetLinkAttributes -> ShowS
$cshowsPrec :: Int -> GetLinkAttributes -> ShowS
Prelude.Show, forall x. Rep GetLinkAttributes x -> GetLinkAttributes
forall x. GetLinkAttributes -> Rep GetLinkAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLinkAttributes x -> GetLinkAttributes
$cfrom :: forall x. GetLinkAttributes -> Rep GetLinkAttributes x
Prelude.Generic)

-- |
-- Create a value of 'GetLinkAttributes' 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', 'getLinkAttributes_consistencyLevel' - The consistency level at which to retrieve the attributes on a typed
-- link.
--
-- 'directoryArn', 'getLinkAttributes_directoryArn' - The Amazon Resource Name (ARN) that is associated with the Directory
-- where the typed link resides. For more information, see arns or
-- <https://docs.aws.amazon.com/clouddirectory/latest/developerguide/directory_objects_links.html#directory_objects_links_typedlink Typed Links>.
--
-- 'typedLinkSpecifier', 'getLinkAttributes_typedLinkSpecifier' - Allows a typed link specifier to be accepted as input.
--
-- 'attributeNames', 'getLinkAttributes_attributeNames' - A list of attribute names whose values will be retrieved.
newGetLinkAttributes ::
  -- | 'directoryArn'
  Prelude.Text ->
  -- | 'typedLinkSpecifier'
  TypedLinkSpecifier ->
  GetLinkAttributes
newGetLinkAttributes :: Text -> TypedLinkSpecifier -> GetLinkAttributes
newGetLinkAttributes
  Text
pDirectoryArn_
  TypedLinkSpecifier
pTypedLinkSpecifier_ =
    GetLinkAttributes'
      { $sel:consistencyLevel:GetLinkAttributes' :: Maybe ConsistencyLevel
consistencyLevel =
          forall a. Maybe a
Prelude.Nothing,
        $sel:directoryArn:GetLinkAttributes' :: Text
directoryArn = Text
pDirectoryArn_,
        $sel:typedLinkSpecifier:GetLinkAttributes' :: TypedLinkSpecifier
typedLinkSpecifier = TypedLinkSpecifier
pTypedLinkSpecifier_,
        $sel:attributeNames:GetLinkAttributes' :: [Text]
attributeNames = forall a. Monoid a => a
Prelude.mempty
      }

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

-- | The Amazon Resource Name (ARN) that is associated with the Directory
-- where the typed link resides. For more information, see arns or
-- <https://docs.aws.amazon.com/clouddirectory/latest/developerguide/directory_objects_links.html#directory_objects_links_typedlink Typed Links>.
getLinkAttributes_directoryArn :: Lens.Lens' GetLinkAttributes Prelude.Text
getLinkAttributes_directoryArn :: Lens' GetLinkAttributes Text
getLinkAttributes_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAttributes' {Text
directoryArn :: Text
$sel:directoryArn:GetLinkAttributes' :: GetLinkAttributes -> Text
directoryArn} -> Text
directoryArn) (\s :: GetLinkAttributes
s@GetLinkAttributes' {} Text
a -> GetLinkAttributes
s {$sel:directoryArn:GetLinkAttributes' :: Text
directoryArn = Text
a} :: GetLinkAttributes)

-- | Allows a typed link specifier to be accepted as input.
getLinkAttributes_typedLinkSpecifier :: Lens.Lens' GetLinkAttributes TypedLinkSpecifier
getLinkAttributes_typedLinkSpecifier :: Lens' GetLinkAttributes TypedLinkSpecifier
getLinkAttributes_typedLinkSpecifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAttributes' {TypedLinkSpecifier
typedLinkSpecifier :: TypedLinkSpecifier
$sel:typedLinkSpecifier:GetLinkAttributes' :: GetLinkAttributes -> TypedLinkSpecifier
typedLinkSpecifier} -> TypedLinkSpecifier
typedLinkSpecifier) (\s :: GetLinkAttributes
s@GetLinkAttributes' {} TypedLinkSpecifier
a -> GetLinkAttributes
s {$sel:typedLinkSpecifier:GetLinkAttributes' :: TypedLinkSpecifier
typedLinkSpecifier = TypedLinkSpecifier
a} :: GetLinkAttributes)

-- | A list of attribute names whose values will be retrieved.
getLinkAttributes_attributeNames :: Lens.Lens' GetLinkAttributes [Prelude.Text]
getLinkAttributes_attributeNames :: Lens' GetLinkAttributes [Text]
getLinkAttributes_attributeNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAttributes' {[Text]
attributeNames :: [Text]
$sel:attributeNames:GetLinkAttributes' :: GetLinkAttributes -> [Text]
attributeNames} -> [Text]
attributeNames) (\s :: GetLinkAttributes
s@GetLinkAttributes' {} [Text]
a -> GetLinkAttributes
s {$sel:attributeNames:GetLinkAttributes' :: [Text]
attributeNames = [Text]
a} :: GetLinkAttributes) 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 GetLinkAttributes where
  type
    AWSResponse GetLinkAttributes =
      GetLinkAttributesResponse
  request :: (Service -> Service)
-> GetLinkAttributes -> Request GetLinkAttributes
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 GetLinkAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetLinkAttributes)))
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 -> GetLinkAttributesResponse
GetLinkAttributesResponse'
            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 GetLinkAttributes where
  hashWithSalt :: Int -> GetLinkAttributes -> Int
hashWithSalt Int
_salt GetLinkAttributes' {[Text]
Maybe ConsistencyLevel
Text
TypedLinkSpecifier
attributeNames :: [Text]
typedLinkSpecifier :: TypedLinkSpecifier
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetLinkAttributes' :: GetLinkAttributes -> [Text]
$sel:typedLinkSpecifier:GetLinkAttributes' :: GetLinkAttributes -> TypedLinkSpecifier
$sel:directoryArn:GetLinkAttributes' :: GetLinkAttributes -> Text
$sel:consistencyLevel:GetLinkAttributes' :: GetLinkAttributes -> 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` TypedLinkSpecifier
typedLinkSpecifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
attributeNames

instance Prelude.NFData GetLinkAttributes where
  rnf :: GetLinkAttributes -> ()
rnf GetLinkAttributes' {[Text]
Maybe ConsistencyLevel
Text
TypedLinkSpecifier
attributeNames :: [Text]
typedLinkSpecifier :: TypedLinkSpecifier
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetLinkAttributes' :: GetLinkAttributes -> [Text]
$sel:typedLinkSpecifier:GetLinkAttributes' :: GetLinkAttributes -> TypedLinkSpecifier
$sel:directoryArn:GetLinkAttributes' :: GetLinkAttributes -> Text
$sel:consistencyLevel:GetLinkAttributes' :: GetLinkAttributes -> 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 TypedLinkSpecifier
typedLinkSpecifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
attributeNames

instance Data.ToHeaders GetLinkAttributes where
  toHeaders :: GetLinkAttributes -> ResponseHeaders
toHeaders GetLinkAttributes' {[Text]
Maybe ConsistencyLevel
Text
TypedLinkSpecifier
attributeNames :: [Text]
typedLinkSpecifier :: TypedLinkSpecifier
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetLinkAttributes' :: GetLinkAttributes -> [Text]
$sel:typedLinkSpecifier:GetLinkAttributes' :: GetLinkAttributes -> TypedLinkSpecifier
$sel:directoryArn:GetLinkAttributes' :: GetLinkAttributes -> Text
$sel:consistencyLevel:GetLinkAttributes' :: GetLinkAttributes -> Maybe ConsistencyLevel
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amz-data-partition" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
directoryArn]

instance Data.ToJSON GetLinkAttributes where
  toJSON :: GetLinkAttributes -> Value
toJSON GetLinkAttributes' {[Text]
Maybe ConsistencyLevel
Text
TypedLinkSpecifier
attributeNames :: [Text]
typedLinkSpecifier :: TypedLinkSpecifier
directoryArn :: Text
consistencyLevel :: Maybe ConsistencyLevel
$sel:attributeNames:GetLinkAttributes' :: GetLinkAttributes -> [Text]
$sel:typedLinkSpecifier:GetLinkAttributes' :: GetLinkAttributes -> TypedLinkSpecifier
$sel:directoryArn:GetLinkAttributes' :: GetLinkAttributes -> Text
$sel:consistencyLevel:GetLinkAttributes' :: GetLinkAttributes -> Maybe ConsistencyLevel
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConsistencyLevel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ConsistencyLevel
consistencyLevel,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TypedLinkSpecifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TypedLinkSpecifier
typedLinkSpecifier),
            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 GetLinkAttributes where
  toPath :: GetLinkAttributes -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/typedlink/attributes/get"

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

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

-- |
-- Create a value of 'GetLinkAttributesResponse' 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', 'getLinkAttributesResponse_attributes' - The attributes that are associated with the typed link.
--
-- 'httpStatus', 'getLinkAttributesResponse_httpStatus' - The response's http status code.
newGetLinkAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLinkAttributesResponse
newGetLinkAttributesResponse :: Int -> GetLinkAttributesResponse
newGetLinkAttributesResponse Int
pHttpStatus_ =
  GetLinkAttributesResponse'
    { $sel:attributes:GetLinkAttributesResponse' :: Maybe [AttributeKeyAndValue]
attributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLinkAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The attributes that are associated with the typed link.
getLinkAttributesResponse_attributes :: Lens.Lens' GetLinkAttributesResponse (Prelude.Maybe [AttributeKeyAndValue])
getLinkAttributesResponse_attributes :: Lens' GetLinkAttributesResponse (Maybe [AttributeKeyAndValue])
getLinkAttributesResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAttributesResponse' {Maybe [AttributeKeyAndValue]
attributes :: Maybe [AttributeKeyAndValue]
$sel:attributes:GetLinkAttributesResponse' :: GetLinkAttributesResponse -> Maybe [AttributeKeyAndValue]
attributes} -> Maybe [AttributeKeyAndValue]
attributes) (\s :: GetLinkAttributesResponse
s@GetLinkAttributesResponse' {} Maybe [AttributeKeyAndValue]
a -> GetLinkAttributesResponse
s {$sel:attributes:GetLinkAttributesResponse' :: Maybe [AttributeKeyAndValue]
attributes = Maybe [AttributeKeyAndValue]
a} :: GetLinkAttributesResponse) 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.
getLinkAttributesResponse_httpStatus :: Lens.Lens' GetLinkAttributesResponse Prelude.Int
getLinkAttributesResponse_httpStatus :: Lens' GetLinkAttributesResponse Int
getLinkAttributesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLinkAttributesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetLinkAttributesResponse' :: GetLinkAttributesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetLinkAttributesResponse
s@GetLinkAttributesResponse' {} Int
a -> GetLinkAttributesResponse
s {$sel:httpStatus:GetLinkAttributesResponse' :: Int
httpStatus = Int
a} :: GetLinkAttributesResponse)

instance Prelude.NFData GetLinkAttributesResponse where
  rnf :: GetLinkAttributesResponse -> ()
rnf GetLinkAttributesResponse' {Int
Maybe [AttributeKeyAndValue]
httpStatus :: Int
attributes :: Maybe [AttributeKeyAndValue]
$sel:httpStatus:GetLinkAttributesResponse' :: GetLinkAttributesResponse -> Int
$sel:attributes:GetLinkAttributesResponse' :: GetLinkAttributesResponse -> 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