{-# 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.AttachTypedLink
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Attaches a typed link to a specified source and target object. For more
-- information, see
-- <https://docs.aws.amazon.com/clouddirectory/latest/developerguide/directory_objects_links.html#directory_objects_links_typedlink Typed Links>.
module Amazonka.CloudDirectory.AttachTypedLink
  ( -- * Creating a Request
    AttachTypedLink (..),
    newAttachTypedLink,

    -- * Request Lenses
    attachTypedLink_directoryArn,
    attachTypedLink_sourceObjectReference,
    attachTypedLink_targetObjectReference,
    attachTypedLink_typedLinkFacet,
    attachTypedLink_attributes,

    -- * Destructuring the Response
    AttachTypedLinkResponse (..),
    newAttachTypedLinkResponse,

    -- * Response Lenses
    attachTypedLinkResponse_typedLinkSpecifier,
    attachTypedLinkResponse_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:/ 'newAttachTypedLink' smart constructor.
data AttachTypedLink = AttachTypedLink'
  { -- | The Amazon Resource Name (ARN) of the directory where you want to attach
    -- the typed link.
    AttachTypedLink -> Text
directoryArn :: Prelude.Text,
    -- | Identifies the source object that the typed link will attach to.
    AttachTypedLink -> ObjectReference
sourceObjectReference :: ObjectReference,
    -- | Identifies the target object that the typed link will attach to.
    AttachTypedLink -> ObjectReference
targetObjectReference :: ObjectReference,
    -- | Identifies the typed link facet that is associated with the typed link.
    AttachTypedLink -> TypedLinkSchemaAndFacetName
typedLinkFacet :: TypedLinkSchemaAndFacetName,
    -- | A set of attributes that are associated with the typed link.
    AttachTypedLink -> [AttributeNameAndValue]
attributes :: [AttributeNameAndValue]
  }
  deriving (AttachTypedLink -> AttachTypedLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachTypedLink -> AttachTypedLink -> Bool
$c/= :: AttachTypedLink -> AttachTypedLink -> Bool
== :: AttachTypedLink -> AttachTypedLink -> Bool
$c== :: AttachTypedLink -> AttachTypedLink -> Bool
Prelude.Eq, ReadPrec [AttachTypedLink]
ReadPrec AttachTypedLink
Int -> ReadS AttachTypedLink
ReadS [AttachTypedLink]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachTypedLink]
$creadListPrec :: ReadPrec [AttachTypedLink]
readPrec :: ReadPrec AttachTypedLink
$creadPrec :: ReadPrec AttachTypedLink
readList :: ReadS [AttachTypedLink]
$creadList :: ReadS [AttachTypedLink]
readsPrec :: Int -> ReadS AttachTypedLink
$creadsPrec :: Int -> ReadS AttachTypedLink
Prelude.Read, Int -> AttachTypedLink -> ShowS
[AttachTypedLink] -> ShowS
AttachTypedLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachTypedLink] -> ShowS
$cshowList :: [AttachTypedLink] -> ShowS
show :: AttachTypedLink -> String
$cshow :: AttachTypedLink -> String
showsPrec :: Int -> AttachTypedLink -> ShowS
$cshowsPrec :: Int -> AttachTypedLink -> ShowS
Prelude.Show, forall x. Rep AttachTypedLink x -> AttachTypedLink
forall x. AttachTypedLink -> Rep AttachTypedLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttachTypedLink x -> AttachTypedLink
$cfrom :: forall x. AttachTypedLink -> Rep AttachTypedLink x
Prelude.Generic)

-- |
-- Create a value of 'AttachTypedLink' 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:
--
-- 'directoryArn', 'attachTypedLink_directoryArn' - The Amazon Resource Name (ARN) of the directory where you want to attach
-- the typed link.
--
-- 'sourceObjectReference', 'attachTypedLink_sourceObjectReference' - Identifies the source object that the typed link will attach to.
--
-- 'targetObjectReference', 'attachTypedLink_targetObjectReference' - Identifies the target object that the typed link will attach to.
--
-- 'typedLinkFacet', 'attachTypedLink_typedLinkFacet' - Identifies the typed link facet that is associated with the typed link.
--
-- 'attributes', 'attachTypedLink_attributes' - A set of attributes that are associated with the typed link.
newAttachTypedLink ::
  -- | 'directoryArn'
  Prelude.Text ->
  -- | 'sourceObjectReference'
  ObjectReference ->
  -- | 'targetObjectReference'
  ObjectReference ->
  -- | 'typedLinkFacet'
  TypedLinkSchemaAndFacetName ->
  AttachTypedLink
newAttachTypedLink :: Text
-> ObjectReference
-> ObjectReference
-> TypedLinkSchemaAndFacetName
-> AttachTypedLink
newAttachTypedLink
  Text
pDirectoryArn_
  ObjectReference
pSourceObjectReference_
  ObjectReference
pTargetObjectReference_
  TypedLinkSchemaAndFacetName
pTypedLinkFacet_ =
    AttachTypedLink'
      { $sel:directoryArn:AttachTypedLink' :: Text
directoryArn = Text
pDirectoryArn_,
        $sel:sourceObjectReference:AttachTypedLink' :: ObjectReference
sourceObjectReference = ObjectReference
pSourceObjectReference_,
        $sel:targetObjectReference:AttachTypedLink' :: ObjectReference
targetObjectReference = ObjectReference
pTargetObjectReference_,
        $sel:typedLinkFacet:AttachTypedLink' :: TypedLinkSchemaAndFacetName
typedLinkFacet = TypedLinkSchemaAndFacetName
pTypedLinkFacet_,
        $sel:attributes:AttachTypedLink' :: [AttributeNameAndValue]
attributes = forall a. Monoid a => a
Prelude.mempty
      }

-- | The Amazon Resource Name (ARN) of the directory where you want to attach
-- the typed link.
attachTypedLink_directoryArn :: Lens.Lens' AttachTypedLink Prelude.Text
attachTypedLink_directoryArn :: Lens' AttachTypedLink Text
attachTypedLink_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachTypedLink' {Text
directoryArn :: Text
$sel:directoryArn:AttachTypedLink' :: AttachTypedLink -> Text
directoryArn} -> Text
directoryArn) (\s :: AttachTypedLink
s@AttachTypedLink' {} Text
a -> AttachTypedLink
s {$sel:directoryArn:AttachTypedLink' :: Text
directoryArn = Text
a} :: AttachTypedLink)

-- | Identifies the source object that the typed link will attach to.
attachTypedLink_sourceObjectReference :: Lens.Lens' AttachTypedLink ObjectReference
attachTypedLink_sourceObjectReference :: Lens' AttachTypedLink ObjectReference
attachTypedLink_sourceObjectReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachTypedLink' {ObjectReference
sourceObjectReference :: ObjectReference
$sel:sourceObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
sourceObjectReference} -> ObjectReference
sourceObjectReference) (\s :: AttachTypedLink
s@AttachTypedLink' {} ObjectReference
a -> AttachTypedLink
s {$sel:sourceObjectReference:AttachTypedLink' :: ObjectReference
sourceObjectReference = ObjectReference
a} :: AttachTypedLink)

-- | Identifies the target object that the typed link will attach to.
attachTypedLink_targetObjectReference :: Lens.Lens' AttachTypedLink ObjectReference
attachTypedLink_targetObjectReference :: Lens' AttachTypedLink ObjectReference
attachTypedLink_targetObjectReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachTypedLink' {ObjectReference
targetObjectReference :: ObjectReference
$sel:targetObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
targetObjectReference} -> ObjectReference
targetObjectReference) (\s :: AttachTypedLink
s@AttachTypedLink' {} ObjectReference
a -> AttachTypedLink
s {$sel:targetObjectReference:AttachTypedLink' :: ObjectReference
targetObjectReference = ObjectReference
a} :: AttachTypedLink)

-- | Identifies the typed link facet that is associated with the typed link.
attachTypedLink_typedLinkFacet :: Lens.Lens' AttachTypedLink TypedLinkSchemaAndFacetName
attachTypedLink_typedLinkFacet :: Lens' AttachTypedLink TypedLinkSchemaAndFacetName
attachTypedLink_typedLinkFacet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachTypedLink' {TypedLinkSchemaAndFacetName
typedLinkFacet :: TypedLinkSchemaAndFacetName
$sel:typedLinkFacet:AttachTypedLink' :: AttachTypedLink -> TypedLinkSchemaAndFacetName
typedLinkFacet} -> TypedLinkSchemaAndFacetName
typedLinkFacet) (\s :: AttachTypedLink
s@AttachTypedLink' {} TypedLinkSchemaAndFacetName
a -> AttachTypedLink
s {$sel:typedLinkFacet:AttachTypedLink' :: TypedLinkSchemaAndFacetName
typedLinkFacet = TypedLinkSchemaAndFacetName
a} :: AttachTypedLink)

-- | A set of attributes that are associated with the typed link.
attachTypedLink_attributes :: Lens.Lens' AttachTypedLink [AttributeNameAndValue]
attachTypedLink_attributes :: Lens' AttachTypedLink [AttributeNameAndValue]
attachTypedLink_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachTypedLink' {[AttributeNameAndValue]
attributes :: [AttributeNameAndValue]
$sel:attributes:AttachTypedLink' :: AttachTypedLink -> [AttributeNameAndValue]
attributes} -> [AttributeNameAndValue]
attributes) (\s :: AttachTypedLink
s@AttachTypedLink' {} [AttributeNameAndValue]
a -> AttachTypedLink
s {$sel:attributes:AttachTypedLink' :: [AttributeNameAndValue]
attributes = [AttributeNameAndValue]
a} :: AttachTypedLink) 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 AttachTypedLink where
  type
    AWSResponse AttachTypedLink =
      AttachTypedLinkResponse
  request :: (Service -> Service) -> AttachTypedLink -> Request AttachTypedLink
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy AttachTypedLink
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AttachTypedLink)))
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 TypedLinkSpecifier -> Int -> AttachTypedLinkResponse
AttachTypedLinkResponse'
            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
"TypedLinkSpecifier")
            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 AttachTypedLink where
  hashWithSalt :: Int -> AttachTypedLink -> Int
hashWithSalt Int
_salt AttachTypedLink' {[AttributeNameAndValue]
Text
ObjectReference
TypedLinkSchemaAndFacetName
attributes :: [AttributeNameAndValue]
typedLinkFacet :: TypedLinkSchemaAndFacetName
targetObjectReference :: ObjectReference
sourceObjectReference :: ObjectReference
directoryArn :: Text
$sel:attributes:AttachTypedLink' :: AttachTypedLink -> [AttributeNameAndValue]
$sel:typedLinkFacet:AttachTypedLink' :: AttachTypedLink -> TypedLinkSchemaAndFacetName
$sel:targetObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:sourceObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:directoryArn:AttachTypedLink' :: AttachTypedLink -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectReference
sourceObjectReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectReference
targetObjectReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TypedLinkSchemaAndFacetName
typedLinkFacet
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [AttributeNameAndValue]
attributes

instance Prelude.NFData AttachTypedLink where
  rnf :: AttachTypedLink -> ()
rnf AttachTypedLink' {[AttributeNameAndValue]
Text
ObjectReference
TypedLinkSchemaAndFacetName
attributes :: [AttributeNameAndValue]
typedLinkFacet :: TypedLinkSchemaAndFacetName
targetObjectReference :: ObjectReference
sourceObjectReference :: ObjectReference
directoryArn :: Text
$sel:attributes:AttachTypedLink' :: AttachTypedLink -> [AttributeNameAndValue]
$sel:typedLinkFacet:AttachTypedLink' :: AttachTypedLink -> TypedLinkSchemaAndFacetName
$sel:targetObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:sourceObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:directoryArn:AttachTypedLink' :: AttachTypedLink -> Text
..} =
    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
sourceObjectReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectReference
targetObjectReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TypedLinkSchemaAndFacetName
typedLinkFacet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AttributeNameAndValue]
attributes

instance Data.ToHeaders AttachTypedLink where
  toHeaders :: AttachTypedLink -> ResponseHeaders
toHeaders AttachTypedLink' {[AttributeNameAndValue]
Text
ObjectReference
TypedLinkSchemaAndFacetName
attributes :: [AttributeNameAndValue]
typedLinkFacet :: TypedLinkSchemaAndFacetName
targetObjectReference :: ObjectReference
sourceObjectReference :: ObjectReference
directoryArn :: Text
$sel:attributes:AttachTypedLink' :: AttachTypedLink -> [AttributeNameAndValue]
$sel:typedLinkFacet:AttachTypedLink' :: AttachTypedLink -> TypedLinkSchemaAndFacetName
$sel:targetObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:sourceObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:directoryArn:AttachTypedLink' :: AttachTypedLink -> Text
..} =
    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 AttachTypedLink where
  toJSON :: AttachTypedLink -> Value
toJSON AttachTypedLink' {[AttributeNameAndValue]
Text
ObjectReference
TypedLinkSchemaAndFacetName
attributes :: [AttributeNameAndValue]
typedLinkFacet :: TypedLinkSchemaAndFacetName
targetObjectReference :: ObjectReference
sourceObjectReference :: ObjectReference
directoryArn :: Text
$sel:attributes:AttachTypedLink' :: AttachTypedLink -> [AttributeNameAndValue]
$sel:typedLinkFacet:AttachTypedLink' :: AttachTypedLink -> TypedLinkSchemaAndFacetName
$sel:targetObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:sourceObjectReference:AttachTypedLink' :: AttachTypedLink -> ObjectReference
$sel:directoryArn:AttachTypedLink' :: AttachTypedLink -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"SourceObjectReference"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ObjectReference
sourceObjectReference
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"TargetObjectReference"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ObjectReference
targetObjectReference
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TypedLinkFacet" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TypedLinkSchemaAndFacetName
typedLinkFacet),
            forall a. a -> Maybe a
Prelude.Just (Key
"Attributes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [AttributeNameAndValue]
attributes)
          ]
      )

instance Data.ToPath AttachTypedLink where
  toPath :: AttachTypedLink -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/typedlink/attach"

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

-- | /See:/ 'newAttachTypedLinkResponse' smart constructor.
data AttachTypedLinkResponse = AttachTypedLinkResponse'
  { -- | Returns a typed link specifier as output.
    AttachTypedLinkResponse -> Maybe TypedLinkSpecifier
typedLinkSpecifier :: Prelude.Maybe TypedLinkSpecifier,
    -- | The response's http status code.
    AttachTypedLinkResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AttachTypedLinkResponse -> AttachTypedLinkResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachTypedLinkResponse -> AttachTypedLinkResponse -> Bool
$c/= :: AttachTypedLinkResponse -> AttachTypedLinkResponse -> Bool
== :: AttachTypedLinkResponse -> AttachTypedLinkResponse -> Bool
$c== :: AttachTypedLinkResponse -> AttachTypedLinkResponse -> Bool
Prelude.Eq, ReadPrec [AttachTypedLinkResponse]
ReadPrec AttachTypedLinkResponse
Int -> ReadS AttachTypedLinkResponse
ReadS [AttachTypedLinkResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttachTypedLinkResponse]
$creadListPrec :: ReadPrec [AttachTypedLinkResponse]
readPrec :: ReadPrec AttachTypedLinkResponse
$creadPrec :: ReadPrec AttachTypedLinkResponse
readList :: ReadS [AttachTypedLinkResponse]
$creadList :: ReadS [AttachTypedLinkResponse]
readsPrec :: Int -> ReadS AttachTypedLinkResponse
$creadsPrec :: Int -> ReadS AttachTypedLinkResponse
Prelude.Read, Int -> AttachTypedLinkResponse -> ShowS
[AttachTypedLinkResponse] -> ShowS
AttachTypedLinkResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachTypedLinkResponse] -> ShowS
$cshowList :: [AttachTypedLinkResponse] -> ShowS
show :: AttachTypedLinkResponse -> String
$cshow :: AttachTypedLinkResponse -> String
showsPrec :: Int -> AttachTypedLinkResponse -> ShowS
$cshowsPrec :: Int -> AttachTypedLinkResponse -> ShowS
Prelude.Show, forall x. Rep AttachTypedLinkResponse x -> AttachTypedLinkResponse
forall x. AttachTypedLinkResponse -> Rep AttachTypedLinkResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttachTypedLinkResponse x -> AttachTypedLinkResponse
$cfrom :: forall x. AttachTypedLinkResponse -> Rep AttachTypedLinkResponse x
Prelude.Generic)

-- |
-- Create a value of 'AttachTypedLinkResponse' 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:
--
-- 'typedLinkSpecifier', 'attachTypedLinkResponse_typedLinkSpecifier' - Returns a typed link specifier as output.
--
-- 'httpStatus', 'attachTypedLinkResponse_httpStatus' - The response's http status code.
newAttachTypedLinkResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AttachTypedLinkResponse
newAttachTypedLinkResponse :: Int -> AttachTypedLinkResponse
newAttachTypedLinkResponse Int
pHttpStatus_ =
  AttachTypedLinkResponse'
    { $sel:typedLinkSpecifier:AttachTypedLinkResponse' :: Maybe TypedLinkSpecifier
typedLinkSpecifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AttachTypedLinkResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns a typed link specifier as output.
attachTypedLinkResponse_typedLinkSpecifier :: Lens.Lens' AttachTypedLinkResponse (Prelude.Maybe TypedLinkSpecifier)
attachTypedLinkResponse_typedLinkSpecifier :: Lens' AttachTypedLinkResponse (Maybe TypedLinkSpecifier)
attachTypedLinkResponse_typedLinkSpecifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AttachTypedLinkResponse' {Maybe TypedLinkSpecifier
typedLinkSpecifier :: Maybe TypedLinkSpecifier
$sel:typedLinkSpecifier:AttachTypedLinkResponse' :: AttachTypedLinkResponse -> Maybe TypedLinkSpecifier
typedLinkSpecifier} -> Maybe TypedLinkSpecifier
typedLinkSpecifier) (\s :: AttachTypedLinkResponse
s@AttachTypedLinkResponse' {} Maybe TypedLinkSpecifier
a -> AttachTypedLinkResponse
s {$sel:typedLinkSpecifier:AttachTypedLinkResponse' :: Maybe TypedLinkSpecifier
typedLinkSpecifier = Maybe TypedLinkSpecifier
a} :: AttachTypedLinkResponse)

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

instance Prelude.NFData AttachTypedLinkResponse where
  rnf :: AttachTypedLinkResponse -> ()
rnf AttachTypedLinkResponse' {Int
Maybe TypedLinkSpecifier
httpStatus :: Int
typedLinkSpecifier :: Maybe TypedLinkSpecifier
$sel:httpStatus:AttachTypedLinkResponse' :: AttachTypedLinkResponse -> Int
$sel:typedLinkSpecifier:AttachTypedLinkResponse' :: AttachTypedLinkResponse -> Maybe TypedLinkSpecifier
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TypedLinkSpecifier
typedLinkSpecifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus