{-# 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.DisassociateLink
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociates an existing device from a link. You must first
-- disassociate any customer gateways that are associated with the link.
module Amazonka.NetworkManager.DisassociateLink
  ( -- * Creating a Request
    DisassociateLink (..),
    newDisassociateLink,

    -- * Request Lenses
    disassociateLink_globalNetworkId,
    disassociateLink_deviceId,
    disassociateLink_linkId,

    -- * Destructuring the Response
    DisassociateLinkResponse (..),
    newDisassociateLinkResponse,

    -- * Response Lenses
    disassociateLinkResponse_linkAssociation,
    disassociateLinkResponse_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:/ 'newDisassociateLink' smart constructor.
data DisassociateLink = DisassociateLink'
  { -- | The ID of the global network.
    DisassociateLink -> Text
globalNetworkId :: Prelude.Text,
    -- | The ID of the device.
    DisassociateLink -> Text
deviceId :: Prelude.Text,
    -- | The ID of the link.
    DisassociateLink -> Text
linkId :: Prelude.Text
  }
  deriving (DisassociateLink -> DisassociateLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateLink -> DisassociateLink -> Bool
$c/= :: DisassociateLink -> DisassociateLink -> Bool
== :: DisassociateLink -> DisassociateLink -> Bool
$c== :: DisassociateLink -> DisassociateLink -> Bool
Prelude.Eq, ReadPrec [DisassociateLink]
ReadPrec DisassociateLink
Int -> ReadS DisassociateLink
ReadS [DisassociateLink]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateLink]
$creadListPrec :: ReadPrec [DisassociateLink]
readPrec :: ReadPrec DisassociateLink
$creadPrec :: ReadPrec DisassociateLink
readList :: ReadS [DisassociateLink]
$creadList :: ReadS [DisassociateLink]
readsPrec :: Int -> ReadS DisassociateLink
$creadsPrec :: Int -> ReadS DisassociateLink
Prelude.Read, Int -> DisassociateLink -> ShowS
[DisassociateLink] -> ShowS
DisassociateLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateLink] -> ShowS
$cshowList :: [DisassociateLink] -> ShowS
show :: DisassociateLink -> String
$cshow :: DisassociateLink -> String
showsPrec :: Int -> DisassociateLink -> ShowS
$cshowsPrec :: Int -> DisassociateLink -> ShowS
Prelude.Show, forall x. Rep DisassociateLink x -> DisassociateLink
forall x. DisassociateLink -> Rep DisassociateLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DisassociateLink x -> DisassociateLink
$cfrom :: forall x. DisassociateLink -> Rep DisassociateLink x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateLink' 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:
--
-- 'globalNetworkId', 'disassociateLink_globalNetworkId' - The ID of the global network.
--
-- 'deviceId', 'disassociateLink_deviceId' - The ID of the device.
--
-- 'linkId', 'disassociateLink_linkId' - The ID of the link.
newDisassociateLink ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  -- | 'deviceId'
  Prelude.Text ->
  -- | 'linkId'
  Prelude.Text ->
  DisassociateLink
newDisassociateLink :: Text -> Text -> Text -> DisassociateLink
newDisassociateLink
  Text
pGlobalNetworkId_
  Text
pDeviceId_
  Text
pLinkId_ =
    DisassociateLink'
      { $sel:globalNetworkId:DisassociateLink' :: Text
globalNetworkId =
          Text
pGlobalNetworkId_,
        $sel:deviceId:DisassociateLink' :: Text
deviceId = Text
pDeviceId_,
        $sel:linkId:DisassociateLink' :: Text
linkId = Text
pLinkId_
      }

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

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

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

instance Core.AWSRequest DisassociateLink where
  type
    AWSResponse DisassociateLink =
      DisassociateLinkResponse
  request :: (Service -> Service)
-> DisassociateLink -> Request DisassociateLink
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DisassociateLink
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DisassociateLink)))
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 LinkAssociation -> Int -> DisassociateLinkResponse
DisassociateLinkResponse'
            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
"LinkAssociation")
            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 DisassociateLink where
  hashWithSalt :: Int -> DisassociateLink -> Int
hashWithSalt Int
_salt DisassociateLink' {Text
linkId :: Text
deviceId :: Text
globalNetworkId :: Text
$sel:linkId:DisassociateLink' :: DisassociateLink -> Text
$sel:deviceId:DisassociateLink' :: DisassociateLink -> Text
$sel:globalNetworkId:DisassociateLink' :: DisassociateLink -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalNetworkId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
linkId

instance Prelude.NFData DisassociateLink where
  rnf :: DisassociateLink -> ()
rnf DisassociateLink' {Text
linkId :: Text
deviceId :: Text
globalNetworkId :: Text
$sel:linkId:DisassociateLink' :: DisassociateLink -> Text
$sel:deviceId:DisassociateLink' :: DisassociateLink -> Text
$sel:globalNetworkId:DisassociateLink' :: DisassociateLink -> Text
..} =
    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
deviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
linkId

instance Data.ToHeaders DisassociateLink where
  toHeaders :: DisassociateLink -> 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.ToPath DisassociateLink where
  toPath :: DisassociateLink -> ByteString
toPath DisassociateLink' {Text
linkId :: Text
deviceId :: Text
globalNetworkId :: Text
$sel:linkId:DisassociateLink' :: DisassociateLink -> Text
$sel:deviceId:DisassociateLink' :: DisassociateLink -> Text
$sel:globalNetworkId:DisassociateLink' :: DisassociateLink -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/link-associations"
      ]

instance Data.ToQuery DisassociateLink where
  toQuery :: DisassociateLink -> QueryString
toQuery DisassociateLink' {Text
linkId :: Text
deviceId :: Text
globalNetworkId :: Text
$sel:linkId:DisassociateLink' :: DisassociateLink -> Text
$sel:deviceId:DisassociateLink' :: DisassociateLink -> Text
$sel:globalNetworkId:DisassociateLink' :: DisassociateLink -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"deviceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
deviceId,
        ByteString
"linkId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
linkId
      ]

-- | /See:/ 'newDisassociateLinkResponse' smart constructor.
data DisassociateLinkResponse = DisassociateLinkResponse'
  { -- | Information about the link association.
    DisassociateLinkResponse -> Maybe LinkAssociation
linkAssociation :: Prelude.Maybe LinkAssociation,
    -- | The response's http status code.
    DisassociateLinkResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DisassociateLinkResponse -> DisassociateLinkResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateLinkResponse -> DisassociateLinkResponse -> Bool
$c/= :: DisassociateLinkResponse -> DisassociateLinkResponse -> Bool
== :: DisassociateLinkResponse -> DisassociateLinkResponse -> Bool
$c== :: DisassociateLinkResponse -> DisassociateLinkResponse -> Bool
Prelude.Eq, ReadPrec [DisassociateLinkResponse]
ReadPrec DisassociateLinkResponse
Int -> ReadS DisassociateLinkResponse
ReadS [DisassociateLinkResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateLinkResponse]
$creadListPrec :: ReadPrec [DisassociateLinkResponse]
readPrec :: ReadPrec DisassociateLinkResponse
$creadPrec :: ReadPrec DisassociateLinkResponse
readList :: ReadS [DisassociateLinkResponse]
$creadList :: ReadS [DisassociateLinkResponse]
readsPrec :: Int -> ReadS DisassociateLinkResponse
$creadsPrec :: Int -> ReadS DisassociateLinkResponse
Prelude.Read, Int -> DisassociateLinkResponse -> ShowS
[DisassociateLinkResponse] -> ShowS
DisassociateLinkResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateLinkResponse] -> ShowS
$cshowList :: [DisassociateLinkResponse] -> ShowS
show :: DisassociateLinkResponse -> String
$cshow :: DisassociateLinkResponse -> String
showsPrec :: Int -> DisassociateLinkResponse -> ShowS
$cshowsPrec :: Int -> DisassociateLinkResponse -> ShowS
Prelude.Show, forall x.
Rep DisassociateLinkResponse x -> DisassociateLinkResponse
forall x.
DisassociateLinkResponse -> Rep DisassociateLinkResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateLinkResponse x -> DisassociateLinkResponse
$cfrom :: forall x.
DisassociateLinkResponse -> Rep DisassociateLinkResponse x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateLinkResponse' 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:
--
-- 'linkAssociation', 'disassociateLinkResponse_linkAssociation' - Information about the link association.
--
-- 'httpStatus', 'disassociateLinkResponse_httpStatus' - The response's http status code.
newDisassociateLinkResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DisassociateLinkResponse
newDisassociateLinkResponse :: Int -> DisassociateLinkResponse
newDisassociateLinkResponse Int
pHttpStatus_ =
  DisassociateLinkResponse'
    { $sel:linkAssociation:DisassociateLinkResponse' :: Maybe LinkAssociation
linkAssociation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DisassociateLinkResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the link association.
disassociateLinkResponse_linkAssociation :: Lens.Lens' DisassociateLinkResponse (Prelude.Maybe LinkAssociation)
disassociateLinkResponse_linkAssociation :: Lens' DisassociateLinkResponse (Maybe LinkAssociation)
disassociateLinkResponse_linkAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateLinkResponse' {Maybe LinkAssociation
linkAssociation :: Maybe LinkAssociation
$sel:linkAssociation:DisassociateLinkResponse' :: DisassociateLinkResponse -> Maybe LinkAssociation
linkAssociation} -> Maybe LinkAssociation
linkAssociation) (\s :: DisassociateLinkResponse
s@DisassociateLinkResponse' {} Maybe LinkAssociation
a -> DisassociateLinkResponse
s {$sel:linkAssociation:DisassociateLinkResponse' :: Maybe LinkAssociation
linkAssociation = Maybe LinkAssociation
a} :: DisassociateLinkResponse)

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

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