{-# 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.NetworkManager.AssociateConnectPeer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a core network Connect peer with a device and optionally,
-- with a link.
--
-- If you specify a link, it must be associated with the specified device.
-- You can only associate core network Connect peers that have been created
-- on a core network Connect attachment on a core network.
module Amazonka.NetworkManager.AssociateConnectPeer
  ( -- * Creating a Request
    AssociateConnectPeer (..),
    newAssociateConnectPeer,

    -- * Request Lenses
    associateConnectPeer_linkId,
    associateConnectPeer_globalNetworkId,
    associateConnectPeer_connectPeerId,
    associateConnectPeer_deviceId,

    -- * Destructuring the Response
    AssociateConnectPeerResponse (..),
    newAssociateConnectPeerResponse,

    -- * Response Lenses
    associateConnectPeerResponse_connectPeerAssociation,
    associateConnectPeerResponse_httpStatus,
  )
where

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

-- | /See:/ 'newAssociateConnectPeer' smart constructor.
data AssociateConnectPeer = AssociateConnectPeer'
  { -- | The ID of the link.
    AssociateConnectPeer -> Maybe Text
linkId :: Prelude.Maybe Prelude.Text,
    -- | The ID of your global network.
    AssociateConnectPeer -> Text
globalNetworkId :: Prelude.Text,
    -- | The ID of the Connect peer.
    AssociateConnectPeer -> Text
connectPeerId :: Prelude.Text,
    -- | The ID of the device.
    AssociateConnectPeer -> Text
deviceId :: Prelude.Text
  }
  deriving (AssociateConnectPeer -> AssociateConnectPeer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateConnectPeer -> AssociateConnectPeer -> Bool
$c/= :: AssociateConnectPeer -> AssociateConnectPeer -> Bool
== :: AssociateConnectPeer -> AssociateConnectPeer -> Bool
$c== :: AssociateConnectPeer -> AssociateConnectPeer -> Bool
Prelude.Eq, ReadPrec [AssociateConnectPeer]
ReadPrec AssociateConnectPeer
Int -> ReadS AssociateConnectPeer
ReadS [AssociateConnectPeer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateConnectPeer]
$creadListPrec :: ReadPrec [AssociateConnectPeer]
readPrec :: ReadPrec AssociateConnectPeer
$creadPrec :: ReadPrec AssociateConnectPeer
readList :: ReadS [AssociateConnectPeer]
$creadList :: ReadS [AssociateConnectPeer]
readsPrec :: Int -> ReadS AssociateConnectPeer
$creadsPrec :: Int -> ReadS AssociateConnectPeer
Prelude.Read, Int -> AssociateConnectPeer -> ShowS
[AssociateConnectPeer] -> ShowS
AssociateConnectPeer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateConnectPeer] -> ShowS
$cshowList :: [AssociateConnectPeer] -> ShowS
show :: AssociateConnectPeer -> String
$cshow :: AssociateConnectPeer -> String
showsPrec :: Int -> AssociateConnectPeer -> ShowS
$cshowsPrec :: Int -> AssociateConnectPeer -> ShowS
Prelude.Show, forall x. Rep AssociateConnectPeer x -> AssociateConnectPeer
forall x. AssociateConnectPeer -> Rep AssociateConnectPeer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateConnectPeer x -> AssociateConnectPeer
$cfrom :: forall x. AssociateConnectPeer -> Rep AssociateConnectPeer x
Prelude.Generic)

-- |
-- Create a value of 'AssociateConnectPeer' 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:
--
-- 'linkId', 'associateConnectPeer_linkId' - The ID of the link.
--
-- 'globalNetworkId', 'associateConnectPeer_globalNetworkId' - The ID of your global network.
--
-- 'connectPeerId', 'associateConnectPeer_connectPeerId' - The ID of the Connect peer.
--
-- 'deviceId', 'associateConnectPeer_deviceId' - The ID of the device.
newAssociateConnectPeer ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  -- | 'connectPeerId'
  Prelude.Text ->
  -- | 'deviceId'
  Prelude.Text ->
  AssociateConnectPeer
newAssociateConnectPeer :: Text -> Text -> Text -> AssociateConnectPeer
newAssociateConnectPeer
  Text
pGlobalNetworkId_
  Text
pConnectPeerId_
  Text
pDeviceId_ =
    AssociateConnectPeer'
      { $sel:linkId:AssociateConnectPeer' :: Maybe Text
linkId = forall a. Maybe a
Prelude.Nothing,
        $sel:globalNetworkId:AssociateConnectPeer' :: Text
globalNetworkId = Text
pGlobalNetworkId_,
        $sel:connectPeerId:AssociateConnectPeer' :: Text
connectPeerId = Text
pConnectPeerId_,
        $sel:deviceId:AssociateConnectPeer' :: Text
deviceId = Text
pDeviceId_
      }

-- | The ID of the link.
associateConnectPeer_linkId :: Lens.Lens' AssociateConnectPeer (Prelude.Maybe Prelude.Text)
associateConnectPeer_linkId :: Lens' AssociateConnectPeer (Maybe Text)
associateConnectPeer_linkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectPeer' {Maybe Text
linkId :: Maybe Text
$sel:linkId:AssociateConnectPeer' :: AssociateConnectPeer -> Maybe Text
linkId} -> Maybe Text
linkId) (\s :: AssociateConnectPeer
s@AssociateConnectPeer' {} Maybe Text
a -> AssociateConnectPeer
s {$sel:linkId:AssociateConnectPeer' :: Maybe Text
linkId = Maybe Text
a} :: AssociateConnectPeer)

-- | The ID of your global network.
associateConnectPeer_globalNetworkId :: Lens.Lens' AssociateConnectPeer Prelude.Text
associateConnectPeer_globalNetworkId :: Lens' AssociateConnectPeer Text
associateConnectPeer_globalNetworkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectPeer' {Text
globalNetworkId :: Text
$sel:globalNetworkId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
globalNetworkId} -> Text
globalNetworkId) (\s :: AssociateConnectPeer
s@AssociateConnectPeer' {} Text
a -> AssociateConnectPeer
s {$sel:globalNetworkId:AssociateConnectPeer' :: Text
globalNetworkId = Text
a} :: AssociateConnectPeer)

-- | The ID of the Connect peer.
associateConnectPeer_connectPeerId :: Lens.Lens' AssociateConnectPeer Prelude.Text
associateConnectPeer_connectPeerId :: Lens' AssociateConnectPeer Text
associateConnectPeer_connectPeerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectPeer' {Text
connectPeerId :: Text
$sel:connectPeerId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
connectPeerId} -> Text
connectPeerId) (\s :: AssociateConnectPeer
s@AssociateConnectPeer' {} Text
a -> AssociateConnectPeer
s {$sel:connectPeerId:AssociateConnectPeer' :: Text
connectPeerId = Text
a} :: AssociateConnectPeer)

-- | The ID of the device.
associateConnectPeer_deviceId :: Lens.Lens' AssociateConnectPeer Prelude.Text
associateConnectPeer_deviceId :: Lens' AssociateConnectPeer Text
associateConnectPeer_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectPeer' {Text
deviceId :: Text
$sel:deviceId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
deviceId} -> Text
deviceId) (\s :: AssociateConnectPeer
s@AssociateConnectPeer' {} Text
a -> AssociateConnectPeer
s {$sel:deviceId:AssociateConnectPeer' :: Text
deviceId = Text
a} :: AssociateConnectPeer)

instance Core.AWSRequest AssociateConnectPeer where
  type
    AWSResponse AssociateConnectPeer =
      AssociateConnectPeerResponse
  request :: (Service -> Service)
-> AssociateConnectPeer -> Request AssociateConnectPeer
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 AssociateConnectPeer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateConnectPeer)))
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 ConnectPeerAssociation -> Int -> AssociateConnectPeerResponse
AssociateConnectPeerResponse'
            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
"ConnectPeerAssociation")
            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 AssociateConnectPeer where
  hashWithSalt :: Int -> AssociateConnectPeer -> Int
hashWithSalt Int
_salt AssociateConnectPeer' {Maybe Text
Text
deviceId :: Text
connectPeerId :: Text
globalNetworkId :: Text
linkId :: Maybe Text
$sel:deviceId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:connectPeerId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:globalNetworkId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:linkId:AssociateConnectPeer' :: AssociateConnectPeer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
linkId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalNetworkId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectPeerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceId

instance Prelude.NFData AssociateConnectPeer where
  rnf :: AssociateConnectPeer -> ()
rnf AssociateConnectPeer' {Maybe Text
Text
deviceId :: Text
connectPeerId :: Text
globalNetworkId :: Text
linkId :: Maybe Text
$sel:deviceId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:connectPeerId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:globalNetworkId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:linkId:AssociateConnectPeer' :: AssociateConnectPeer -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
linkId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
globalNetworkId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectPeerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deviceId

instance Data.ToHeaders AssociateConnectPeer where
  toHeaders :: AssociateConnectPeer -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON AssociateConnectPeer where
  toJSON :: AssociateConnectPeer -> Value
toJSON AssociateConnectPeer' {Maybe Text
Text
deviceId :: Text
connectPeerId :: Text
globalNetworkId :: Text
linkId :: Maybe Text
$sel:deviceId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:connectPeerId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:globalNetworkId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:linkId:AssociateConnectPeer' :: AssociateConnectPeer -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"LinkId" 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 Text
linkId,
            forall a. a -> Maybe a
Prelude.Just (Key
"ConnectPeerId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectPeerId),
            forall a. a -> Maybe a
Prelude.Just (Key
"DeviceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deviceId)
          ]
      )

instance Data.ToPath AssociateConnectPeer where
  toPath :: AssociateConnectPeer -> ByteString
toPath AssociateConnectPeer' {Maybe Text
Text
deviceId :: Text
connectPeerId :: Text
globalNetworkId :: Text
linkId :: Maybe Text
$sel:deviceId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:connectPeerId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:globalNetworkId:AssociateConnectPeer' :: AssociateConnectPeer -> Text
$sel:linkId:AssociateConnectPeer' :: AssociateConnectPeer -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/connect-peer-associations"
      ]

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

-- | /See:/ 'newAssociateConnectPeerResponse' smart constructor.
data AssociateConnectPeerResponse = AssociateConnectPeerResponse'
  { -- | The response to the Connect peer request.
    AssociateConnectPeerResponse -> Maybe ConnectPeerAssociation
connectPeerAssociation :: Prelude.Maybe ConnectPeerAssociation,
    -- | The response's http status code.
    AssociateConnectPeerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateConnectPeerResponse
-> AssociateConnectPeerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateConnectPeerResponse
-> AssociateConnectPeerResponse -> Bool
$c/= :: AssociateConnectPeerResponse
-> AssociateConnectPeerResponse -> Bool
== :: AssociateConnectPeerResponse
-> AssociateConnectPeerResponse -> Bool
$c== :: AssociateConnectPeerResponse
-> AssociateConnectPeerResponse -> Bool
Prelude.Eq, ReadPrec [AssociateConnectPeerResponse]
ReadPrec AssociateConnectPeerResponse
Int -> ReadS AssociateConnectPeerResponse
ReadS [AssociateConnectPeerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateConnectPeerResponse]
$creadListPrec :: ReadPrec [AssociateConnectPeerResponse]
readPrec :: ReadPrec AssociateConnectPeerResponse
$creadPrec :: ReadPrec AssociateConnectPeerResponse
readList :: ReadS [AssociateConnectPeerResponse]
$creadList :: ReadS [AssociateConnectPeerResponse]
readsPrec :: Int -> ReadS AssociateConnectPeerResponse
$creadsPrec :: Int -> ReadS AssociateConnectPeerResponse
Prelude.Read, Int -> AssociateConnectPeerResponse -> ShowS
[AssociateConnectPeerResponse] -> ShowS
AssociateConnectPeerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateConnectPeerResponse] -> ShowS
$cshowList :: [AssociateConnectPeerResponse] -> ShowS
show :: AssociateConnectPeerResponse -> String
$cshow :: AssociateConnectPeerResponse -> String
showsPrec :: Int -> AssociateConnectPeerResponse -> ShowS
$cshowsPrec :: Int -> AssociateConnectPeerResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateConnectPeerResponse x -> AssociateConnectPeerResponse
forall x.
AssociateConnectPeerResponse -> Rep AssociateConnectPeerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateConnectPeerResponse x -> AssociateConnectPeerResponse
$cfrom :: forall x.
AssociateConnectPeerResponse -> Rep AssociateConnectPeerResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateConnectPeerResponse' 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:
--
-- 'connectPeerAssociation', 'associateConnectPeerResponse_connectPeerAssociation' - The response to the Connect peer request.
--
-- 'httpStatus', 'associateConnectPeerResponse_httpStatus' - The response's http status code.
newAssociateConnectPeerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateConnectPeerResponse
newAssociateConnectPeerResponse :: Int -> AssociateConnectPeerResponse
newAssociateConnectPeerResponse Int
pHttpStatus_ =
  AssociateConnectPeerResponse'
    { $sel:connectPeerAssociation:AssociateConnectPeerResponse' :: Maybe ConnectPeerAssociation
connectPeerAssociation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateConnectPeerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The response to the Connect peer request.
associateConnectPeerResponse_connectPeerAssociation :: Lens.Lens' AssociateConnectPeerResponse (Prelude.Maybe ConnectPeerAssociation)
associateConnectPeerResponse_connectPeerAssociation :: Lens' AssociateConnectPeerResponse (Maybe ConnectPeerAssociation)
associateConnectPeerResponse_connectPeerAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateConnectPeerResponse' {Maybe ConnectPeerAssociation
connectPeerAssociation :: Maybe ConnectPeerAssociation
$sel:connectPeerAssociation:AssociateConnectPeerResponse' :: AssociateConnectPeerResponse -> Maybe ConnectPeerAssociation
connectPeerAssociation} -> Maybe ConnectPeerAssociation
connectPeerAssociation) (\s :: AssociateConnectPeerResponse
s@AssociateConnectPeerResponse' {} Maybe ConnectPeerAssociation
a -> AssociateConnectPeerResponse
s {$sel:connectPeerAssociation:AssociateConnectPeerResponse' :: Maybe ConnectPeerAssociation
connectPeerAssociation = Maybe ConnectPeerAssociation
a} :: AssociateConnectPeerResponse)

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

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