{-# 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.Route53.CreateVPCAssociationAuthorization
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Authorizes the Amazon Web Services account that created a specified VPC
-- to submit an @AssociateVPCWithHostedZone@ request to associate the VPC
-- with a specified hosted zone that was created by a different account. To
-- submit a @CreateVPCAssociationAuthorization@ request, you must use the
-- account that created the hosted zone. After you authorize the
-- association, use the account that created the VPC to submit an
-- @AssociateVPCWithHostedZone@ request.
--
-- If you want to associate multiple VPCs that you created by using one
-- account with a hosted zone that you created by using a different
-- account, you must submit one authorization request for each VPC.
module Amazonka.Route53.CreateVPCAssociationAuthorization
  ( -- * Creating a Request
    CreateVPCAssociationAuthorization (..),
    newCreateVPCAssociationAuthorization,

    -- * Request Lenses
    createVPCAssociationAuthorization_hostedZoneId,
    createVPCAssociationAuthorization_vpc,

    -- * Destructuring the Response
    CreateVPCAssociationAuthorizationResponse (..),
    newCreateVPCAssociationAuthorizationResponse,

    -- * Response Lenses
    createVPCAssociationAuthorizationResponse_httpStatus,
    createVPCAssociationAuthorizationResponse_hostedZoneId,
    createVPCAssociationAuthorizationResponse_vpc,
  )
where

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

-- | A complex type that contains information about the request to authorize
-- associating a VPC with your private hosted zone. Authorization is only
-- required when a private hosted zone and a VPC were created by using
-- different accounts.
--
-- /See:/ 'newCreateVPCAssociationAuthorization' smart constructor.
data CreateVPCAssociationAuthorization = CreateVPCAssociationAuthorization'
  { -- | The ID of the private hosted zone that you want to authorize associating
    -- a VPC with.
    CreateVPCAssociationAuthorization -> ResourceId
hostedZoneId :: ResourceId,
    -- | A complex type that contains the VPC ID and region for the VPC that you
    -- want to authorize associating with your hosted zone.
    CreateVPCAssociationAuthorization -> VPC
vpc :: VPC
  }
  deriving (CreateVPCAssociationAuthorization
-> CreateVPCAssociationAuthorization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVPCAssociationAuthorization
-> CreateVPCAssociationAuthorization -> Bool
$c/= :: CreateVPCAssociationAuthorization
-> CreateVPCAssociationAuthorization -> Bool
== :: CreateVPCAssociationAuthorization
-> CreateVPCAssociationAuthorization -> Bool
$c== :: CreateVPCAssociationAuthorization
-> CreateVPCAssociationAuthorization -> Bool
Prelude.Eq, ReadPrec [CreateVPCAssociationAuthorization]
ReadPrec CreateVPCAssociationAuthorization
Int -> ReadS CreateVPCAssociationAuthorization
ReadS [CreateVPCAssociationAuthorization]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVPCAssociationAuthorization]
$creadListPrec :: ReadPrec [CreateVPCAssociationAuthorization]
readPrec :: ReadPrec CreateVPCAssociationAuthorization
$creadPrec :: ReadPrec CreateVPCAssociationAuthorization
readList :: ReadS [CreateVPCAssociationAuthorization]
$creadList :: ReadS [CreateVPCAssociationAuthorization]
readsPrec :: Int -> ReadS CreateVPCAssociationAuthorization
$creadsPrec :: Int -> ReadS CreateVPCAssociationAuthorization
Prelude.Read, Int -> CreateVPCAssociationAuthorization -> ShowS
[CreateVPCAssociationAuthorization] -> ShowS
CreateVPCAssociationAuthorization -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVPCAssociationAuthorization] -> ShowS
$cshowList :: [CreateVPCAssociationAuthorization] -> ShowS
show :: CreateVPCAssociationAuthorization -> String
$cshow :: CreateVPCAssociationAuthorization -> String
showsPrec :: Int -> CreateVPCAssociationAuthorization -> ShowS
$cshowsPrec :: Int -> CreateVPCAssociationAuthorization -> ShowS
Prelude.Show, forall x.
Rep CreateVPCAssociationAuthorization x
-> CreateVPCAssociationAuthorization
forall x.
CreateVPCAssociationAuthorization
-> Rep CreateVPCAssociationAuthorization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVPCAssociationAuthorization x
-> CreateVPCAssociationAuthorization
$cfrom :: forall x.
CreateVPCAssociationAuthorization
-> Rep CreateVPCAssociationAuthorization x
Prelude.Generic)

-- |
-- Create a value of 'CreateVPCAssociationAuthorization' 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:
--
-- 'hostedZoneId', 'createVPCAssociationAuthorization_hostedZoneId' - The ID of the private hosted zone that you want to authorize associating
-- a VPC with.
--
-- 'vpc', 'createVPCAssociationAuthorization_vpc' - A complex type that contains the VPC ID and region for the VPC that you
-- want to authorize associating with your hosted zone.
newCreateVPCAssociationAuthorization ::
  -- | 'hostedZoneId'
  ResourceId ->
  -- | 'vpc'
  VPC ->
  CreateVPCAssociationAuthorization
newCreateVPCAssociationAuthorization :: ResourceId -> VPC -> CreateVPCAssociationAuthorization
newCreateVPCAssociationAuthorization
  ResourceId
pHostedZoneId_
  VPC
pVPC_ =
    CreateVPCAssociationAuthorization'
      { $sel:hostedZoneId:CreateVPCAssociationAuthorization' :: ResourceId
hostedZoneId =
          ResourceId
pHostedZoneId_,
        $sel:vpc:CreateVPCAssociationAuthorization' :: VPC
vpc = VPC
pVPC_
      }

-- | The ID of the private hosted zone that you want to authorize associating
-- a VPC with.
createVPCAssociationAuthorization_hostedZoneId :: Lens.Lens' CreateVPCAssociationAuthorization ResourceId
createVPCAssociationAuthorization_hostedZoneId :: Lens' CreateVPCAssociationAuthorization ResourceId
createVPCAssociationAuthorization_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVPCAssociationAuthorization' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> ResourceId
hostedZoneId} -> ResourceId
hostedZoneId) (\s :: CreateVPCAssociationAuthorization
s@CreateVPCAssociationAuthorization' {} ResourceId
a -> CreateVPCAssociationAuthorization
s {$sel:hostedZoneId:CreateVPCAssociationAuthorization' :: ResourceId
hostedZoneId = ResourceId
a} :: CreateVPCAssociationAuthorization)

-- | A complex type that contains the VPC ID and region for the VPC that you
-- want to authorize associating with your hosted zone.
createVPCAssociationAuthorization_vpc :: Lens.Lens' CreateVPCAssociationAuthorization VPC
createVPCAssociationAuthorization_vpc :: Lens' CreateVPCAssociationAuthorization VPC
createVPCAssociationAuthorization_vpc = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVPCAssociationAuthorization' {VPC
vpc :: VPC
$sel:vpc:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> VPC
vpc} -> VPC
vpc) (\s :: CreateVPCAssociationAuthorization
s@CreateVPCAssociationAuthorization' {} VPC
a -> CreateVPCAssociationAuthorization
s {$sel:vpc:CreateVPCAssociationAuthorization' :: VPC
vpc = VPC
a} :: CreateVPCAssociationAuthorization)

instance
  Core.AWSRequest
    CreateVPCAssociationAuthorization
  where
  type
    AWSResponse CreateVPCAssociationAuthorization =
      CreateVPCAssociationAuthorizationResponse
  request :: (Service -> Service)
-> CreateVPCAssociationAuthorization
-> Request CreateVPCAssociationAuthorization
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.postXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateVPCAssociationAuthorization
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateVPCAssociationAuthorization)))
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 ->
          Int
-> ResourceId -> VPC -> CreateVPCAssociationAuthorizationResponse
CreateVPCAssociationAuthorizationResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"HostedZoneId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"VPC")
      )

instance
  Prelude.Hashable
    CreateVPCAssociationAuthorization
  where
  hashWithSalt :: Int -> CreateVPCAssociationAuthorization -> Int
hashWithSalt
    Int
_salt
    CreateVPCAssociationAuthorization' {ResourceId
VPC
vpc :: VPC
hostedZoneId :: ResourceId
$sel:vpc:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> VPC
$sel:hostedZoneId:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> ResourceId
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
hostedZoneId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` VPC
vpc

instance
  Prelude.NFData
    CreateVPCAssociationAuthorization
  where
  rnf :: CreateVPCAssociationAuthorization -> ()
rnf CreateVPCAssociationAuthorization' {ResourceId
VPC
vpc :: VPC
hostedZoneId :: ResourceId
$sel:vpc:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> VPC
$sel:hostedZoneId:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> ResourceId
..} =
    forall a. NFData a => a -> ()
Prelude.rnf ResourceId
hostedZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VPC
vpc

instance
  Data.ToElement
    CreateVPCAssociationAuthorization
  where
  toElement :: CreateVPCAssociationAuthorization -> Element
toElement =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{https://route53.amazonaws.com/doc/2013-04-01/}CreateVPCAssociationAuthorizationRequest"

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

instance
  Data.ToPath
    CreateVPCAssociationAuthorization
  where
  toPath :: CreateVPCAssociationAuthorization -> ByteString
toPath CreateVPCAssociationAuthorization' {ResourceId
VPC
vpc :: VPC
hostedZoneId :: ResourceId
$sel:vpc:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> VPC
$sel:hostedZoneId:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> ResourceId
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2013-04-01/hostedzone/",
        forall a. ToByteString a => a -> ByteString
Data.toBS ResourceId
hostedZoneId,
        ByteString
"/authorizevpcassociation"
      ]

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

instance Data.ToXML CreateVPCAssociationAuthorization where
  toXML :: CreateVPCAssociationAuthorization -> XML
toXML CreateVPCAssociationAuthorization' {ResourceId
VPC
vpc :: VPC
hostedZoneId :: ResourceId
$sel:vpc:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> VPC
$sel:hostedZoneId:CreateVPCAssociationAuthorization' :: CreateVPCAssociationAuthorization -> ResourceId
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [Name
"VPC" forall a. ToXML a => Name -> a -> XML
Data.@= VPC
vpc]

-- | A complex type that contains the response information from a
-- @CreateVPCAssociationAuthorization@ request.
--
-- /See:/ 'newCreateVPCAssociationAuthorizationResponse' smart constructor.
data CreateVPCAssociationAuthorizationResponse = CreateVPCAssociationAuthorizationResponse'
  { -- | The response's http status code.
    CreateVPCAssociationAuthorizationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the hosted zone that you authorized associating a VPC with.
    CreateVPCAssociationAuthorizationResponse -> ResourceId
hostedZoneId :: ResourceId,
    -- | The VPC that you authorized associating with a hosted zone.
    CreateVPCAssociationAuthorizationResponse -> VPC
vpc :: VPC
  }
  deriving (CreateVPCAssociationAuthorizationResponse
-> CreateVPCAssociationAuthorizationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateVPCAssociationAuthorizationResponse
-> CreateVPCAssociationAuthorizationResponse -> Bool
$c/= :: CreateVPCAssociationAuthorizationResponse
-> CreateVPCAssociationAuthorizationResponse -> Bool
== :: CreateVPCAssociationAuthorizationResponse
-> CreateVPCAssociationAuthorizationResponse -> Bool
$c== :: CreateVPCAssociationAuthorizationResponse
-> CreateVPCAssociationAuthorizationResponse -> Bool
Prelude.Eq, ReadPrec [CreateVPCAssociationAuthorizationResponse]
ReadPrec CreateVPCAssociationAuthorizationResponse
Int -> ReadS CreateVPCAssociationAuthorizationResponse
ReadS [CreateVPCAssociationAuthorizationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateVPCAssociationAuthorizationResponse]
$creadListPrec :: ReadPrec [CreateVPCAssociationAuthorizationResponse]
readPrec :: ReadPrec CreateVPCAssociationAuthorizationResponse
$creadPrec :: ReadPrec CreateVPCAssociationAuthorizationResponse
readList :: ReadS [CreateVPCAssociationAuthorizationResponse]
$creadList :: ReadS [CreateVPCAssociationAuthorizationResponse]
readsPrec :: Int -> ReadS CreateVPCAssociationAuthorizationResponse
$creadsPrec :: Int -> ReadS CreateVPCAssociationAuthorizationResponse
Prelude.Read, Int -> CreateVPCAssociationAuthorizationResponse -> ShowS
[CreateVPCAssociationAuthorizationResponse] -> ShowS
CreateVPCAssociationAuthorizationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateVPCAssociationAuthorizationResponse] -> ShowS
$cshowList :: [CreateVPCAssociationAuthorizationResponse] -> ShowS
show :: CreateVPCAssociationAuthorizationResponse -> String
$cshow :: CreateVPCAssociationAuthorizationResponse -> String
showsPrec :: Int -> CreateVPCAssociationAuthorizationResponse -> ShowS
$cshowsPrec :: Int -> CreateVPCAssociationAuthorizationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateVPCAssociationAuthorizationResponse x
-> CreateVPCAssociationAuthorizationResponse
forall x.
CreateVPCAssociationAuthorizationResponse
-> Rep CreateVPCAssociationAuthorizationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateVPCAssociationAuthorizationResponse x
-> CreateVPCAssociationAuthorizationResponse
$cfrom :: forall x.
CreateVPCAssociationAuthorizationResponse
-> Rep CreateVPCAssociationAuthorizationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateVPCAssociationAuthorizationResponse' 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:
--
-- 'httpStatus', 'createVPCAssociationAuthorizationResponse_httpStatus' - The response's http status code.
--
-- 'hostedZoneId', 'createVPCAssociationAuthorizationResponse_hostedZoneId' - The ID of the hosted zone that you authorized associating a VPC with.
--
-- 'vpc', 'createVPCAssociationAuthorizationResponse_vpc' - The VPC that you authorized associating with a hosted zone.
newCreateVPCAssociationAuthorizationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'hostedZoneId'
  ResourceId ->
  -- | 'vpc'
  VPC ->
  CreateVPCAssociationAuthorizationResponse
newCreateVPCAssociationAuthorizationResponse :: Int
-> ResourceId -> VPC -> CreateVPCAssociationAuthorizationResponse
newCreateVPCAssociationAuthorizationResponse
  Int
pHttpStatus_
  ResourceId
pHostedZoneId_
  VPC
pVPC_ =
    CreateVPCAssociationAuthorizationResponse'
      { $sel:httpStatus:CreateVPCAssociationAuthorizationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:hostedZoneId:CreateVPCAssociationAuthorizationResponse' :: ResourceId
hostedZoneId = ResourceId
pHostedZoneId_,
        $sel:vpc:CreateVPCAssociationAuthorizationResponse' :: VPC
vpc = VPC
pVPC_
      }

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

-- | The ID of the hosted zone that you authorized associating a VPC with.
createVPCAssociationAuthorizationResponse_hostedZoneId :: Lens.Lens' CreateVPCAssociationAuthorizationResponse ResourceId
createVPCAssociationAuthorizationResponse_hostedZoneId :: Lens' CreateVPCAssociationAuthorizationResponse ResourceId
createVPCAssociationAuthorizationResponse_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVPCAssociationAuthorizationResponse' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:CreateVPCAssociationAuthorizationResponse' :: CreateVPCAssociationAuthorizationResponse -> ResourceId
hostedZoneId} -> ResourceId
hostedZoneId) (\s :: CreateVPCAssociationAuthorizationResponse
s@CreateVPCAssociationAuthorizationResponse' {} ResourceId
a -> CreateVPCAssociationAuthorizationResponse
s {$sel:hostedZoneId:CreateVPCAssociationAuthorizationResponse' :: ResourceId
hostedZoneId = ResourceId
a} :: CreateVPCAssociationAuthorizationResponse)

-- | The VPC that you authorized associating with a hosted zone.
createVPCAssociationAuthorizationResponse_vpc :: Lens.Lens' CreateVPCAssociationAuthorizationResponse VPC
createVPCAssociationAuthorizationResponse_vpc :: Lens' CreateVPCAssociationAuthorizationResponse VPC
createVPCAssociationAuthorizationResponse_vpc = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateVPCAssociationAuthorizationResponse' {VPC
vpc :: VPC
$sel:vpc:CreateVPCAssociationAuthorizationResponse' :: CreateVPCAssociationAuthorizationResponse -> VPC
vpc} -> VPC
vpc) (\s :: CreateVPCAssociationAuthorizationResponse
s@CreateVPCAssociationAuthorizationResponse' {} VPC
a -> CreateVPCAssociationAuthorizationResponse
s {$sel:vpc:CreateVPCAssociationAuthorizationResponse' :: VPC
vpc = VPC
a} :: CreateVPCAssociationAuthorizationResponse)

instance
  Prelude.NFData
    CreateVPCAssociationAuthorizationResponse
  where
  rnf :: CreateVPCAssociationAuthorizationResponse -> ()
rnf CreateVPCAssociationAuthorizationResponse' {Int
ResourceId
VPC
vpc :: VPC
hostedZoneId :: ResourceId
httpStatus :: Int
$sel:vpc:CreateVPCAssociationAuthorizationResponse' :: CreateVPCAssociationAuthorizationResponse -> VPC
$sel:hostedZoneId:CreateVPCAssociationAuthorizationResponse' :: CreateVPCAssociationAuthorizationResponse -> ResourceId
$sel:httpStatus:CreateVPCAssociationAuthorizationResponse' :: CreateVPCAssociationAuthorizationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceId
hostedZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf VPC
vpc