{-# 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.AssociateClientVpnTargetNetwork
-- 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 target network with a Client VPN endpoint. A target network
-- is a subnet in a VPC. You can associate multiple subnets from the same
-- VPC with a Client VPN endpoint. You can associate only one subnet in
-- each Availability Zone. We recommend that you associate at least two
-- subnets to provide Availability Zone redundancy.
--
-- If you specified a VPC when you created the Client VPN endpoint or if
-- you have previous subnet associations, the specified subnet must be in
-- the same VPC. To specify a subnet that\'s in a different VPC, you must
-- first modify the Client VPN endpoint (ModifyClientVpnEndpoint) and
-- change the VPC that\'s associated with it.
module Amazonka.EC2.AssociateClientVpnTargetNetwork
  ( -- * Creating a Request
    AssociateClientVpnTargetNetwork (..),
    newAssociateClientVpnTargetNetwork,

    -- * Request Lenses
    associateClientVpnTargetNetwork_clientToken,
    associateClientVpnTargetNetwork_dryRun,
    associateClientVpnTargetNetwork_clientVpnEndpointId,
    associateClientVpnTargetNetwork_subnetId,

    -- * Destructuring the Response
    AssociateClientVpnTargetNetworkResponse (..),
    newAssociateClientVpnTargetNetworkResponse,

    -- * Response Lenses
    associateClientVpnTargetNetworkResponse_associationId,
    associateClientVpnTargetNetworkResponse_status,
    associateClientVpnTargetNetworkResponse_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:/ 'newAssociateClientVpnTargetNetwork' smart constructor.
data AssociateClientVpnTargetNetwork = AssociateClientVpnTargetNetwork'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
    AssociateClientVpnTargetNetwork -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | 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@.
    AssociateClientVpnTargetNetwork -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Client VPN endpoint.
    AssociateClientVpnTargetNetwork -> Text
clientVpnEndpointId :: Prelude.Text,
    -- | The ID of the subnet to associate with the Client VPN endpoint.
    AssociateClientVpnTargetNetwork -> Text
subnetId :: Prelude.Text
  }
  deriving (AssociateClientVpnTargetNetwork
-> AssociateClientVpnTargetNetwork -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateClientVpnTargetNetwork
-> AssociateClientVpnTargetNetwork -> Bool
$c/= :: AssociateClientVpnTargetNetwork
-> AssociateClientVpnTargetNetwork -> Bool
== :: AssociateClientVpnTargetNetwork
-> AssociateClientVpnTargetNetwork -> Bool
$c== :: AssociateClientVpnTargetNetwork
-> AssociateClientVpnTargetNetwork -> Bool
Prelude.Eq, ReadPrec [AssociateClientVpnTargetNetwork]
ReadPrec AssociateClientVpnTargetNetwork
Int -> ReadS AssociateClientVpnTargetNetwork
ReadS [AssociateClientVpnTargetNetwork]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateClientVpnTargetNetwork]
$creadListPrec :: ReadPrec [AssociateClientVpnTargetNetwork]
readPrec :: ReadPrec AssociateClientVpnTargetNetwork
$creadPrec :: ReadPrec AssociateClientVpnTargetNetwork
readList :: ReadS [AssociateClientVpnTargetNetwork]
$creadList :: ReadS [AssociateClientVpnTargetNetwork]
readsPrec :: Int -> ReadS AssociateClientVpnTargetNetwork
$creadsPrec :: Int -> ReadS AssociateClientVpnTargetNetwork
Prelude.Read, Int -> AssociateClientVpnTargetNetwork -> ShowS
[AssociateClientVpnTargetNetwork] -> ShowS
AssociateClientVpnTargetNetwork -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateClientVpnTargetNetwork] -> ShowS
$cshowList :: [AssociateClientVpnTargetNetwork] -> ShowS
show :: AssociateClientVpnTargetNetwork -> String
$cshow :: AssociateClientVpnTargetNetwork -> String
showsPrec :: Int -> AssociateClientVpnTargetNetwork -> ShowS
$cshowsPrec :: Int -> AssociateClientVpnTargetNetwork -> ShowS
Prelude.Show, forall x.
Rep AssociateClientVpnTargetNetwork x
-> AssociateClientVpnTargetNetwork
forall x.
AssociateClientVpnTargetNetwork
-> Rep AssociateClientVpnTargetNetwork x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateClientVpnTargetNetwork x
-> AssociateClientVpnTargetNetwork
$cfrom :: forall x.
AssociateClientVpnTargetNetwork
-> Rep AssociateClientVpnTargetNetwork x
Prelude.Generic)

-- |
-- Create a value of 'AssociateClientVpnTargetNetwork' 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:
--
-- 'clientToken', 'associateClientVpnTargetNetwork_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
--
-- 'dryRun', 'associateClientVpnTargetNetwork_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', 'associateClientVpnTargetNetwork_clientVpnEndpointId' - The ID of the Client VPN endpoint.
--
-- 'subnetId', 'associateClientVpnTargetNetwork_subnetId' - The ID of the subnet to associate with the Client VPN endpoint.
newAssociateClientVpnTargetNetwork ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  -- | 'subnetId'
  Prelude.Text ->
  AssociateClientVpnTargetNetwork
newAssociateClientVpnTargetNetwork :: Text -> Text -> AssociateClientVpnTargetNetwork
newAssociateClientVpnTargetNetwork
  Text
pClientVpnEndpointId_
  Text
pSubnetId_ =
    AssociateClientVpnTargetNetwork'
      { $sel:clientToken:AssociateClientVpnTargetNetwork' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dryRun:AssociateClientVpnTargetNetwork' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:clientVpnEndpointId:AssociateClientVpnTargetNetwork' :: Text
clientVpnEndpointId =
          Text
pClientVpnEndpointId_,
        $sel:subnetId:AssociateClientVpnTargetNetwork' :: Text
subnetId = Text
pSubnetId_
      }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
associateClientVpnTargetNetwork_clientToken :: Lens.Lens' AssociateClientVpnTargetNetwork (Prelude.Maybe Prelude.Text)
associateClientVpnTargetNetwork_clientToken :: Lens' AssociateClientVpnTargetNetwork (Maybe Text)
associateClientVpnTargetNetwork_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateClientVpnTargetNetwork' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: AssociateClientVpnTargetNetwork
s@AssociateClientVpnTargetNetwork' {} Maybe Text
a -> AssociateClientVpnTargetNetwork
s {$sel:clientToken:AssociateClientVpnTargetNetwork' :: Maybe Text
clientToken = Maybe Text
a} :: AssociateClientVpnTargetNetwork)

-- | 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@.
associateClientVpnTargetNetwork_dryRun :: Lens.Lens' AssociateClientVpnTargetNetwork (Prelude.Maybe Prelude.Bool)
associateClientVpnTargetNetwork_dryRun :: Lens' AssociateClientVpnTargetNetwork (Maybe Bool)
associateClientVpnTargetNetwork_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateClientVpnTargetNetwork' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: AssociateClientVpnTargetNetwork
s@AssociateClientVpnTargetNetwork' {} Maybe Bool
a -> AssociateClientVpnTargetNetwork
s {$sel:dryRun:AssociateClientVpnTargetNetwork' :: Maybe Bool
dryRun = Maybe Bool
a} :: AssociateClientVpnTargetNetwork)

-- | The ID of the Client VPN endpoint.
associateClientVpnTargetNetwork_clientVpnEndpointId :: Lens.Lens' AssociateClientVpnTargetNetwork Prelude.Text
associateClientVpnTargetNetwork_clientVpnEndpointId :: Lens' AssociateClientVpnTargetNetwork Text
associateClientVpnTargetNetwork_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateClientVpnTargetNetwork' {Text
clientVpnEndpointId :: Text
$sel:clientVpnEndpointId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
clientVpnEndpointId} -> Text
clientVpnEndpointId) (\s :: AssociateClientVpnTargetNetwork
s@AssociateClientVpnTargetNetwork' {} Text
a -> AssociateClientVpnTargetNetwork
s {$sel:clientVpnEndpointId:AssociateClientVpnTargetNetwork' :: Text
clientVpnEndpointId = Text
a} :: AssociateClientVpnTargetNetwork)

-- | The ID of the subnet to associate with the Client VPN endpoint.
associateClientVpnTargetNetwork_subnetId :: Lens.Lens' AssociateClientVpnTargetNetwork Prelude.Text
associateClientVpnTargetNetwork_subnetId :: Lens' AssociateClientVpnTargetNetwork Text
associateClientVpnTargetNetwork_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateClientVpnTargetNetwork' {Text
subnetId :: Text
$sel:subnetId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
subnetId} -> Text
subnetId) (\s :: AssociateClientVpnTargetNetwork
s@AssociateClientVpnTargetNetwork' {} Text
a -> AssociateClientVpnTargetNetwork
s {$sel:subnetId:AssociateClientVpnTargetNetwork' :: Text
subnetId = Text
a} :: AssociateClientVpnTargetNetwork)

instance
  Core.AWSRequest
    AssociateClientVpnTargetNetwork
  where
  type
    AWSResponse AssociateClientVpnTargetNetwork =
      AssociateClientVpnTargetNetworkResponse
  request :: (Service -> Service)
-> AssociateClientVpnTargetNetwork
-> Request AssociateClientVpnTargetNetwork
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 AssociateClientVpnTargetNetwork
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AssociateClientVpnTargetNetwork)))
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
-> AssociateClientVpnTargetNetworkResponse
AssociateClientVpnTargetNetworkResponse'
            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
    AssociateClientVpnTargetNetwork
  where
  hashWithSalt :: Int -> AssociateClientVpnTargetNetwork -> Int
hashWithSalt
    Int
_salt
    AssociateClientVpnTargetNetwork' {Maybe Bool
Maybe Text
Text
subnetId :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:subnetId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
$sel:clientVpnEndpointId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
$sel:dryRun:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Bool
$sel:clientToken:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
        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
subnetId

instance
  Prelude.NFData
    AssociateClientVpnTargetNetwork
  where
  rnf :: AssociateClientVpnTargetNetwork -> ()
rnf AssociateClientVpnTargetNetwork' {Maybe Bool
Maybe Text
Text
subnetId :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:subnetId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
$sel:clientVpnEndpointId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
$sel:dryRun:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Bool
$sel:clientToken:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
subnetId

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

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

instance Data.ToQuery AssociateClientVpnTargetNetwork where
  toQuery :: AssociateClientVpnTargetNetwork -> QueryString
toQuery AssociateClientVpnTargetNetwork' {Maybe Bool
Maybe Text
Text
subnetId :: Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
clientToken :: Maybe Text
$sel:subnetId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
$sel:clientVpnEndpointId:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Text
$sel:dryRun:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Bool
$sel:clientToken:AssociateClientVpnTargetNetwork' :: AssociateClientVpnTargetNetwork -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"AssociateClientVpnTargetNetwork" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        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
"SubnetId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
subnetId
      ]

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

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

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

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

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

instance
  Prelude.NFData
    AssociateClientVpnTargetNetworkResponse
  where
  rnf :: AssociateClientVpnTargetNetworkResponse -> ()
rnf AssociateClientVpnTargetNetworkResponse' {Int
Maybe Text
Maybe AssociationStatus
httpStatus :: Int
status :: Maybe AssociationStatus
associationId :: Maybe Text
$sel:httpStatus:AssociateClientVpnTargetNetworkResponse' :: AssociateClientVpnTargetNetworkResponse -> Int
$sel:status:AssociateClientVpnTargetNetworkResponse' :: AssociateClientVpnTargetNetworkResponse -> Maybe AssociationStatus
$sel:associationId:AssociateClientVpnTargetNetworkResponse' :: AssociateClientVpnTargetNetworkResponse -> 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