{-# 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.EC2.DisassociateClientVpnTargetNetwork
-- 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 a target network from the specified Client VPN endpoint.
-- When you disassociate the last target network from a Client VPN, the
-- following happens:
--
-- -   The route that was automatically added for the VPC is deleted
--
-- -   All active client connections are terminated
--
-- -   New client connections are disallowed
--
-- -   The Client VPN endpoint\'s status changes to @pending-associate@
module Amazonka.EC2.DisassociateClientVpnTargetNetwork
  ( -- * Creating a Request
    DisassociateClientVpnTargetNetwork (..),
    newDisassociateClientVpnTargetNetwork,

    -- * Request Lenses
    disassociateClientVpnTargetNetwork_dryRun,
    disassociateClientVpnTargetNetwork_clientVpnEndpointId,
    disassociateClientVpnTargetNetwork_associationId,

    -- * Destructuring the Response
    DisassociateClientVpnTargetNetworkResponse (..),
    newDisassociateClientVpnTargetNetworkResponse,

    -- * Response Lenses
    disassociateClientVpnTargetNetworkResponse_associationId,
    disassociateClientVpnTargetNetworkResponse_status,
    disassociateClientVpnTargetNetworkResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDisassociateClientVpnTargetNetwork' smart constructor.
data DisassociateClientVpnTargetNetwork = DisassociateClientVpnTargetNetwork'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    DisassociateClientVpnTargetNetwork -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Client VPN endpoint from which to disassociate the target
    -- network.
    DisassociateClientVpnTargetNetwork -> Text
clientVpnEndpointId :: Prelude.Text,
    -- | The ID of the target network association.
    DisassociateClientVpnTargetNetwork -> Text
associationId :: Prelude.Text
  }
  deriving (DisassociateClientVpnTargetNetwork
-> DisassociateClientVpnTargetNetwork -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateClientVpnTargetNetwork
-> DisassociateClientVpnTargetNetwork -> Bool
$c/= :: DisassociateClientVpnTargetNetwork
-> DisassociateClientVpnTargetNetwork -> Bool
== :: DisassociateClientVpnTargetNetwork
-> DisassociateClientVpnTargetNetwork -> Bool
$c== :: DisassociateClientVpnTargetNetwork
-> DisassociateClientVpnTargetNetwork -> Bool
Prelude.Eq, ReadPrec [DisassociateClientVpnTargetNetwork]
ReadPrec DisassociateClientVpnTargetNetwork
Int -> ReadS DisassociateClientVpnTargetNetwork
ReadS [DisassociateClientVpnTargetNetwork]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateClientVpnTargetNetwork]
$creadListPrec :: ReadPrec [DisassociateClientVpnTargetNetwork]
readPrec :: ReadPrec DisassociateClientVpnTargetNetwork
$creadPrec :: ReadPrec DisassociateClientVpnTargetNetwork
readList :: ReadS [DisassociateClientVpnTargetNetwork]
$creadList :: ReadS [DisassociateClientVpnTargetNetwork]
readsPrec :: Int -> ReadS DisassociateClientVpnTargetNetwork
$creadsPrec :: Int -> ReadS DisassociateClientVpnTargetNetwork
Prelude.Read, Int -> DisassociateClientVpnTargetNetwork -> ShowS
[DisassociateClientVpnTargetNetwork] -> ShowS
DisassociateClientVpnTargetNetwork -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateClientVpnTargetNetwork] -> ShowS
$cshowList :: [DisassociateClientVpnTargetNetwork] -> ShowS
show :: DisassociateClientVpnTargetNetwork -> String
$cshow :: DisassociateClientVpnTargetNetwork -> String
showsPrec :: Int -> DisassociateClientVpnTargetNetwork -> ShowS
$cshowsPrec :: Int -> DisassociateClientVpnTargetNetwork -> ShowS
Prelude.Show, forall x.
Rep DisassociateClientVpnTargetNetwork x
-> DisassociateClientVpnTargetNetwork
forall x.
DisassociateClientVpnTargetNetwork
-> Rep DisassociateClientVpnTargetNetwork x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateClientVpnTargetNetwork x
-> DisassociateClientVpnTargetNetwork
$cfrom :: forall x.
DisassociateClientVpnTargetNetwork
-> Rep DisassociateClientVpnTargetNetwork x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateClientVpnTargetNetwork' 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:
--
-- 'dryRun', 'disassociateClientVpnTargetNetwork_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'clientVpnEndpointId', 'disassociateClientVpnTargetNetwork_clientVpnEndpointId' - The ID of the Client VPN endpoint from which to disassociate the target
-- network.
--
-- 'associationId', 'disassociateClientVpnTargetNetwork_associationId' - The ID of the target network association.
newDisassociateClientVpnTargetNetwork ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  -- | 'associationId'
  Prelude.Text ->
  DisassociateClientVpnTargetNetwork
newDisassociateClientVpnTargetNetwork :: Text -> Text -> DisassociateClientVpnTargetNetwork
newDisassociateClientVpnTargetNetwork
  Text
pClientVpnEndpointId_
  Text
pAssociationId_ =
    DisassociateClientVpnTargetNetwork'
      { $sel:dryRun:DisassociateClientVpnTargetNetwork' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientVpnEndpointId:DisassociateClientVpnTargetNetwork' :: Text
clientVpnEndpointId =
          Text
pClientVpnEndpointId_,
        $sel:associationId:DisassociateClientVpnTargetNetwork' :: Text
associationId = Text
pAssociationId_
      }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
disassociateClientVpnTargetNetwork_dryRun :: Lens.Lens' DisassociateClientVpnTargetNetwork (Prelude.Maybe Prelude.Bool)
disassociateClientVpnTargetNetwork_dryRun :: Lens' DisassociateClientVpnTargetNetwork (Maybe Bool)
disassociateClientVpnTargetNetwork_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateClientVpnTargetNetwork' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DisassociateClientVpnTargetNetwork
s@DisassociateClientVpnTargetNetwork' {} Maybe Bool
a -> DisassociateClientVpnTargetNetwork
s {$sel:dryRun:DisassociateClientVpnTargetNetwork' :: Maybe Bool
dryRun = Maybe Bool
a} :: DisassociateClientVpnTargetNetwork)

-- | The ID of the Client VPN endpoint from which to disassociate the target
-- network.
disassociateClientVpnTargetNetwork_clientVpnEndpointId :: Lens.Lens' DisassociateClientVpnTargetNetwork Prelude.Text
disassociateClientVpnTargetNetwork_clientVpnEndpointId :: Lens' DisassociateClientVpnTargetNetwork Text
disassociateClientVpnTargetNetwork_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateClientVpnTargetNetwork' {Text
clientVpnEndpointId :: Text
$sel:clientVpnEndpointId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
clientVpnEndpointId} -> Text
clientVpnEndpointId) (\s :: DisassociateClientVpnTargetNetwork
s@DisassociateClientVpnTargetNetwork' {} Text
a -> DisassociateClientVpnTargetNetwork
s {$sel:clientVpnEndpointId:DisassociateClientVpnTargetNetwork' :: Text
clientVpnEndpointId = Text
a} :: DisassociateClientVpnTargetNetwork)

-- | The ID of the target network association.
disassociateClientVpnTargetNetwork_associationId :: Lens.Lens' DisassociateClientVpnTargetNetwork Prelude.Text
disassociateClientVpnTargetNetwork_associationId :: Lens' DisassociateClientVpnTargetNetwork Text
disassociateClientVpnTargetNetwork_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateClientVpnTargetNetwork' {Text
associationId :: Text
$sel:associationId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
associationId} -> Text
associationId) (\s :: DisassociateClientVpnTargetNetwork
s@DisassociateClientVpnTargetNetwork' {} Text
a -> DisassociateClientVpnTargetNetwork
s {$sel:associationId:DisassociateClientVpnTargetNetwork' :: Text
associationId = Text
a} :: DisassociateClientVpnTargetNetwork)

instance
  Core.AWSRequest
    DisassociateClientVpnTargetNetwork
  where
  type
    AWSResponse DisassociateClientVpnTargetNetwork =
      DisassociateClientVpnTargetNetworkResponse
  request :: (Service -> Service)
-> DisassociateClientVpnTargetNetwork
-> Request DisassociateClientVpnTargetNetwork
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DisassociateClientVpnTargetNetwork
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DisassociateClientVpnTargetNetwork)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe AssociationStatus
-> Int
-> DisassociateClientVpnTargetNetworkResponse
DisassociateClientVpnTargetNetworkResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"associationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"status")
            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
    DisassociateClientVpnTargetNetwork
  where
  hashWithSalt :: Int -> DisassociateClientVpnTargetNetwork -> Int
hashWithSalt
    Int
_salt
    DisassociateClientVpnTargetNetwork' {Maybe Bool
Text
associationId :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:associationId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
$sel:clientVpnEndpointId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
$sel:dryRun:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientVpnEndpointId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
associationId

instance
  Prelude.NFData
    DisassociateClientVpnTargetNetwork
  where
  rnf :: DisassociateClientVpnTargetNetwork -> ()
rnf DisassociateClientVpnTargetNetwork' {Maybe Bool
Text
associationId :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:associationId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
$sel:clientVpnEndpointId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
$sel:dryRun:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientVpnEndpointId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
associationId

instance
  Data.ToHeaders
    DisassociateClientVpnTargetNetwork
  where
  toHeaders :: DisassociateClientVpnTargetNetwork -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance
  Data.ToPath
    DisassociateClientVpnTargetNetwork
  where
  toPath :: DisassociateClientVpnTargetNetwork -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance
  Data.ToQuery
    DisassociateClientVpnTargetNetwork
  where
  toQuery :: DisassociateClientVpnTargetNetwork -> QueryString
toQuery DisassociateClientVpnTargetNetwork' {Maybe Bool
Text
associationId :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:associationId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
$sel:clientVpnEndpointId:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Text
$sel:dryRun:DisassociateClientVpnTargetNetwork' :: DisassociateClientVpnTargetNetwork -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DisassociateClientVpnTargetNetwork" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"ClientVpnEndpointId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clientVpnEndpointId,
        ByteString
"AssociationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
associationId
      ]

-- | /See:/ 'newDisassociateClientVpnTargetNetworkResponse' smart constructor.
data DisassociateClientVpnTargetNetworkResponse = DisassociateClientVpnTargetNetworkResponse'
  { -- | The ID of the target network association.
    DisassociateClientVpnTargetNetworkResponse -> Maybe Text
associationId :: Prelude.Maybe Prelude.Text,
    -- | The current state of the target network association.
    DisassociateClientVpnTargetNetworkResponse
-> Maybe AssociationStatus
status :: Prelude.Maybe AssociationStatus,
    -- | The response's http status code.
    DisassociateClientVpnTargetNetworkResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DisassociateClientVpnTargetNetworkResponse
-> DisassociateClientVpnTargetNetworkResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateClientVpnTargetNetworkResponse
-> DisassociateClientVpnTargetNetworkResponse -> Bool
$c/= :: DisassociateClientVpnTargetNetworkResponse
-> DisassociateClientVpnTargetNetworkResponse -> Bool
== :: DisassociateClientVpnTargetNetworkResponse
-> DisassociateClientVpnTargetNetworkResponse -> Bool
$c== :: DisassociateClientVpnTargetNetworkResponse
-> DisassociateClientVpnTargetNetworkResponse -> Bool
Prelude.Eq, ReadPrec [DisassociateClientVpnTargetNetworkResponse]
ReadPrec DisassociateClientVpnTargetNetworkResponse
Int -> ReadS DisassociateClientVpnTargetNetworkResponse
ReadS [DisassociateClientVpnTargetNetworkResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateClientVpnTargetNetworkResponse]
$creadListPrec :: ReadPrec [DisassociateClientVpnTargetNetworkResponse]
readPrec :: ReadPrec DisassociateClientVpnTargetNetworkResponse
$creadPrec :: ReadPrec DisassociateClientVpnTargetNetworkResponse
readList :: ReadS [DisassociateClientVpnTargetNetworkResponse]
$creadList :: ReadS [DisassociateClientVpnTargetNetworkResponse]
readsPrec :: Int -> ReadS DisassociateClientVpnTargetNetworkResponse
$creadsPrec :: Int -> ReadS DisassociateClientVpnTargetNetworkResponse
Prelude.Read, Int -> DisassociateClientVpnTargetNetworkResponse -> ShowS
[DisassociateClientVpnTargetNetworkResponse] -> ShowS
DisassociateClientVpnTargetNetworkResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateClientVpnTargetNetworkResponse] -> ShowS
$cshowList :: [DisassociateClientVpnTargetNetworkResponse] -> ShowS
show :: DisassociateClientVpnTargetNetworkResponse -> String
$cshow :: DisassociateClientVpnTargetNetworkResponse -> String
showsPrec :: Int -> DisassociateClientVpnTargetNetworkResponse -> ShowS
$cshowsPrec :: Int -> DisassociateClientVpnTargetNetworkResponse -> ShowS
Prelude.Show, forall x.
Rep DisassociateClientVpnTargetNetworkResponse x
-> DisassociateClientVpnTargetNetworkResponse
forall x.
DisassociateClientVpnTargetNetworkResponse
-> Rep DisassociateClientVpnTargetNetworkResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateClientVpnTargetNetworkResponse x
-> DisassociateClientVpnTargetNetworkResponse
$cfrom :: forall x.
DisassociateClientVpnTargetNetworkResponse
-> Rep DisassociateClientVpnTargetNetworkResponse x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateClientVpnTargetNetworkResponse' 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:
--
-- 'associationId', 'disassociateClientVpnTargetNetworkResponse_associationId' - The ID of the target network association.
--
-- 'status', 'disassociateClientVpnTargetNetworkResponse_status' - The current state of the target network association.
--
-- 'httpStatus', 'disassociateClientVpnTargetNetworkResponse_httpStatus' - The response's http status code.
newDisassociateClientVpnTargetNetworkResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DisassociateClientVpnTargetNetworkResponse
newDisassociateClientVpnTargetNetworkResponse :: Int -> DisassociateClientVpnTargetNetworkResponse
newDisassociateClientVpnTargetNetworkResponse
  Int
pHttpStatus_ =
    DisassociateClientVpnTargetNetworkResponse'
      { $sel:associationId:DisassociateClientVpnTargetNetworkResponse' :: Maybe Text
associationId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:status:DisassociateClientVpnTargetNetworkResponse' :: Maybe AssociationStatus
status = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DisassociateClientVpnTargetNetworkResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The ID of the target network association.
disassociateClientVpnTargetNetworkResponse_associationId :: Lens.Lens' DisassociateClientVpnTargetNetworkResponse (Prelude.Maybe Prelude.Text)
disassociateClientVpnTargetNetworkResponse_associationId :: Lens' DisassociateClientVpnTargetNetworkResponse (Maybe Text)
disassociateClientVpnTargetNetworkResponse_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateClientVpnTargetNetworkResponse' {Maybe Text
associationId :: Maybe Text
$sel:associationId:DisassociateClientVpnTargetNetworkResponse' :: DisassociateClientVpnTargetNetworkResponse -> Maybe Text
associationId} -> Maybe Text
associationId) (\s :: DisassociateClientVpnTargetNetworkResponse
s@DisassociateClientVpnTargetNetworkResponse' {} Maybe Text
a -> DisassociateClientVpnTargetNetworkResponse
s {$sel:associationId:DisassociateClientVpnTargetNetworkResponse' :: Maybe Text
associationId = Maybe Text
a} :: DisassociateClientVpnTargetNetworkResponse)

-- | The current state of the target network association.
disassociateClientVpnTargetNetworkResponse_status :: Lens.Lens' DisassociateClientVpnTargetNetworkResponse (Prelude.Maybe AssociationStatus)
disassociateClientVpnTargetNetworkResponse_status :: Lens'
  DisassociateClientVpnTargetNetworkResponse
  (Maybe AssociationStatus)
disassociateClientVpnTargetNetworkResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateClientVpnTargetNetworkResponse' {Maybe AssociationStatus
status :: Maybe AssociationStatus
$sel:status:DisassociateClientVpnTargetNetworkResponse' :: DisassociateClientVpnTargetNetworkResponse
-> Maybe AssociationStatus
status} -> Maybe AssociationStatus
status) (\s :: DisassociateClientVpnTargetNetworkResponse
s@DisassociateClientVpnTargetNetworkResponse' {} Maybe AssociationStatus
a -> DisassociateClientVpnTargetNetworkResponse
s {$sel:status:DisassociateClientVpnTargetNetworkResponse' :: Maybe AssociationStatus
status = Maybe AssociationStatus
a} :: DisassociateClientVpnTargetNetworkResponse)

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

instance
  Prelude.NFData
    DisassociateClientVpnTargetNetworkResponse
  where
  rnf :: DisassociateClientVpnTargetNetworkResponse -> ()
rnf DisassociateClientVpnTargetNetworkResponse' {Int
Maybe Text
Maybe AssociationStatus
httpStatus :: Int
status :: Maybe AssociationStatus
associationId :: Maybe Text
$sel:httpStatus:DisassociateClientVpnTargetNetworkResponse' :: DisassociateClientVpnTargetNetworkResponse -> Int
$sel:status:DisassociateClientVpnTargetNetworkResponse' :: DisassociateClientVpnTargetNetworkResponse
-> Maybe AssociationStatus
$sel:associationId:DisassociateClientVpnTargetNetworkResponse' :: DisassociateClientVpnTargetNetworkResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
associationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AssociationStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus