{-# 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.AssociateCustomerGateway
-- 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 customer gateway 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 customer gateways that are connected to a VPN
-- attachment on a transit gateway or core network registered in your
-- global network. When you register a transit gateway or core network,
-- customer gateways that are connected to the transit gateway are
-- automatically included in the global network. To list customer gateways
-- that are connected to a transit gateway, use the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_DescribeVpnConnections.html DescribeVpnConnections>
-- EC2 API and filter by @transit-gateway-id@.
--
-- You cannot associate a customer gateway with more than one device and
-- link.
module Amazonka.NetworkManager.AssociateCustomerGateway
  ( -- * Creating a Request
    AssociateCustomerGateway (..),
    newAssociateCustomerGateway,

    -- * Request Lenses
    associateCustomerGateway_linkId,
    associateCustomerGateway_customerGatewayArn,
    associateCustomerGateway_globalNetworkId,
    associateCustomerGateway_deviceId,

    -- * Destructuring the Response
    AssociateCustomerGatewayResponse (..),
    newAssociateCustomerGatewayResponse,

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

-- |
-- Create a value of 'AssociateCustomerGateway' 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', 'associateCustomerGateway_linkId' - The ID of the link.
--
-- 'customerGatewayArn', 'associateCustomerGateway_customerGatewayArn' - The Amazon Resource Name (ARN) of the customer gateway.
--
-- 'globalNetworkId', 'associateCustomerGateway_globalNetworkId' - The ID of the global network.
--
-- 'deviceId', 'associateCustomerGateway_deviceId' - The ID of the device.
newAssociateCustomerGateway ::
  -- | 'customerGatewayArn'
  Prelude.Text ->
  -- | 'globalNetworkId'
  Prelude.Text ->
  -- | 'deviceId'
  Prelude.Text ->
  AssociateCustomerGateway
newAssociateCustomerGateway :: Text -> Text -> Text -> AssociateCustomerGateway
newAssociateCustomerGateway
  Text
pCustomerGatewayArn_
  Text
pGlobalNetworkId_
  Text
pDeviceId_ =
    AssociateCustomerGateway'
      { $sel:linkId:AssociateCustomerGateway' :: Maybe Text
linkId = forall a. Maybe a
Prelude.Nothing,
        $sel:customerGatewayArn:AssociateCustomerGateway' :: Text
customerGatewayArn = Text
pCustomerGatewayArn_,
        $sel:globalNetworkId:AssociateCustomerGateway' :: Text
globalNetworkId = Text
pGlobalNetworkId_,
        $sel:deviceId:AssociateCustomerGateway' :: Text
deviceId = Text
pDeviceId_
      }

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

-- | The Amazon Resource Name (ARN) of the customer gateway.
associateCustomerGateway_customerGatewayArn :: Lens.Lens' AssociateCustomerGateway Prelude.Text
associateCustomerGateway_customerGatewayArn :: Lens' AssociateCustomerGateway Text
associateCustomerGateway_customerGatewayArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCustomerGateway' {Text
customerGatewayArn :: Text
$sel:customerGatewayArn:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
customerGatewayArn} -> Text
customerGatewayArn) (\s :: AssociateCustomerGateway
s@AssociateCustomerGateway' {} Text
a -> AssociateCustomerGateway
s {$sel:customerGatewayArn:AssociateCustomerGateway' :: Text
customerGatewayArn = Text
a} :: AssociateCustomerGateway)

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

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

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

instance Prelude.NFData AssociateCustomerGateway where
  rnf :: AssociateCustomerGateway -> ()
rnf AssociateCustomerGateway' {Maybe Text
Text
deviceId :: Text
globalNetworkId :: Text
customerGatewayArn :: Text
linkId :: Maybe Text
$sel:deviceId:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:globalNetworkId:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:customerGatewayArn:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:linkId:AssociateCustomerGateway' :: AssociateCustomerGateway -> 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
customerGatewayArn
      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
deviceId

instance Data.ToHeaders AssociateCustomerGateway where
  toHeaders :: AssociateCustomerGateway -> 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 AssociateCustomerGateway where
  toJSON :: AssociateCustomerGateway -> Value
toJSON AssociateCustomerGateway' {Maybe Text
Text
deviceId :: Text
globalNetworkId :: Text
customerGatewayArn :: Text
linkId :: Maybe Text
$sel:deviceId:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:globalNetworkId:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:customerGatewayArn:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:linkId:AssociateCustomerGateway' :: AssociateCustomerGateway -> 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
"CustomerGatewayArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
customerGatewayArn),
            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 AssociateCustomerGateway where
  toPath :: AssociateCustomerGateway -> ByteString
toPath AssociateCustomerGateway' {Maybe Text
Text
deviceId :: Text
globalNetworkId :: Text
customerGatewayArn :: Text
linkId :: Maybe Text
$sel:deviceId:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:globalNetworkId:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:customerGatewayArn:AssociateCustomerGateway' :: AssociateCustomerGateway -> Text
$sel:linkId:AssociateCustomerGateway' :: AssociateCustomerGateway -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/customer-gateway-associations"
      ]

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

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

-- |
-- Create a value of 'AssociateCustomerGatewayResponse' 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:
--
-- 'customerGatewayAssociation', 'associateCustomerGatewayResponse_customerGatewayAssociation' - The customer gateway association.
--
-- 'httpStatus', 'associateCustomerGatewayResponse_httpStatus' - The response's http status code.
newAssociateCustomerGatewayResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateCustomerGatewayResponse
newAssociateCustomerGatewayResponse :: Int -> AssociateCustomerGatewayResponse
newAssociateCustomerGatewayResponse Int
pHttpStatus_ =
  AssociateCustomerGatewayResponse'
    { $sel:customerGatewayAssociation:AssociateCustomerGatewayResponse' :: Maybe CustomerGatewayAssociation
customerGatewayAssociation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateCustomerGatewayResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The customer gateway association.
associateCustomerGatewayResponse_customerGatewayAssociation :: Lens.Lens' AssociateCustomerGatewayResponse (Prelude.Maybe CustomerGatewayAssociation)
associateCustomerGatewayResponse_customerGatewayAssociation :: Lens'
  AssociateCustomerGatewayResponse (Maybe CustomerGatewayAssociation)
associateCustomerGatewayResponse_customerGatewayAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCustomerGatewayResponse' {Maybe CustomerGatewayAssociation
customerGatewayAssociation :: Maybe CustomerGatewayAssociation
$sel:customerGatewayAssociation:AssociateCustomerGatewayResponse' :: AssociateCustomerGatewayResponse
-> Maybe CustomerGatewayAssociation
customerGatewayAssociation} -> Maybe CustomerGatewayAssociation
customerGatewayAssociation) (\s :: AssociateCustomerGatewayResponse
s@AssociateCustomerGatewayResponse' {} Maybe CustomerGatewayAssociation
a -> AssociateCustomerGatewayResponse
s {$sel:customerGatewayAssociation:AssociateCustomerGatewayResponse' :: Maybe CustomerGatewayAssociation
customerGatewayAssociation = Maybe CustomerGatewayAssociation
a} :: AssociateCustomerGatewayResponse)

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

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