{-# 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.AppRunner.DisassociateCustomDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disassociate a custom domain name from an App Runner service.
--
-- Certificates tracking domain validity are associated with a custom
-- domain and are stored in
-- <https://docs.aws.amazon.com/acm/latest/userguide AWS Certificate Manager (ACM)>.
-- These certificates aren\'t deleted as part of this action. App Runner
-- delays certificate deletion for 30 days after a domain is disassociated
-- from your service.
module Amazonka.AppRunner.DisassociateCustomDomain
  ( -- * Creating a Request
    DisassociateCustomDomain (..),
    newDisassociateCustomDomain,

    -- * Request Lenses
    disassociateCustomDomain_serviceArn,
    disassociateCustomDomain_domainName,

    -- * Destructuring the Response
    DisassociateCustomDomainResponse (..),
    newDisassociateCustomDomainResponse,

    -- * Response Lenses
    disassociateCustomDomainResponse_httpStatus,
    disassociateCustomDomainResponse_dNSTarget,
    disassociateCustomDomainResponse_serviceArn,
    disassociateCustomDomainResponse_customDomain,
    disassociateCustomDomainResponse_vpcDNSTargets,
  )
where

import Amazonka.AppRunner.Types
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

-- | /See:/ 'newDisassociateCustomDomain' smart constructor.
data DisassociateCustomDomain = DisassociateCustomDomain'
  { -- | The Amazon Resource Name (ARN) of the App Runner service that you want
    -- to disassociate a custom domain name from.
    DisassociateCustomDomain -> Text
serviceArn :: Prelude.Text,
    -- | The domain name that you want to disassociate from the App Runner
    -- service.
    DisassociateCustomDomain -> Text
domainName :: Prelude.Text
  }
  deriving (DisassociateCustomDomain -> DisassociateCustomDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateCustomDomain -> DisassociateCustomDomain -> Bool
$c/= :: DisassociateCustomDomain -> DisassociateCustomDomain -> Bool
== :: DisassociateCustomDomain -> DisassociateCustomDomain -> Bool
$c== :: DisassociateCustomDomain -> DisassociateCustomDomain -> Bool
Prelude.Eq, ReadPrec [DisassociateCustomDomain]
ReadPrec DisassociateCustomDomain
Int -> ReadS DisassociateCustomDomain
ReadS [DisassociateCustomDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateCustomDomain]
$creadListPrec :: ReadPrec [DisassociateCustomDomain]
readPrec :: ReadPrec DisassociateCustomDomain
$creadPrec :: ReadPrec DisassociateCustomDomain
readList :: ReadS [DisassociateCustomDomain]
$creadList :: ReadS [DisassociateCustomDomain]
readsPrec :: Int -> ReadS DisassociateCustomDomain
$creadsPrec :: Int -> ReadS DisassociateCustomDomain
Prelude.Read, Int -> DisassociateCustomDomain -> ShowS
[DisassociateCustomDomain] -> ShowS
DisassociateCustomDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateCustomDomain] -> ShowS
$cshowList :: [DisassociateCustomDomain] -> ShowS
show :: DisassociateCustomDomain -> String
$cshow :: DisassociateCustomDomain -> String
showsPrec :: Int -> DisassociateCustomDomain -> ShowS
$cshowsPrec :: Int -> DisassociateCustomDomain -> ShowS
Prelude.Show, forall x.
Rep DisassociateCustomDomain x -> DisassociateCustomDomain
forall x.
DisassociateCustomDomain -> Rep DisassociateCustomDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateCustomDomain x -> DisassociateCustomDomain
$cfrom :: forall x.
DisassociateCustomDomain -> Rep DisassociateCustomDomain x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateCustomDomain' 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:
--
-- 'serviceArn', 'disassociateCustomDomain_serviceArn' - The Amazon Resource Name (ARN) of the App Runner service that you want
-- to disassociate a custom domain name from.
--
-- 'domainName', 'disassociateCustomDomain_domainName' - The domain name that you want to disassociate from the App Runner
-- service.
newDisassociateCustomDomain ::
  -- | 'serviceArn'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  DisassociateCustomDomain
newDisassociateCustomDomain :: Text -> Text -> DisassociateCustomDomain
newDisassociateCustomDomain Text
pServiceArn_ Text
pDomainName_ =
  DisassociateCustomDomain'
    { $sel:serviceArn:DisassociateCustomDomain' :: Text
serviceArn =
        Text
pServiceArn_,
      $sel:domainName:DisassociateCustomDomain' :: Text
domainName = Text
pDomainName_
    }

-- | The Amazon Resource Name (ARN) of the App Runner service that you want
-- to disassociate a custom domain name from.
disassociateCustomDomain_serviceArn :: Lens.Lens' DisassociateCustomDomain Prelude.Text
disassociateCustomDomain_serviceArn :: Lens' DisassociateCustomDomain Text
disassociateCustomDomain_serviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateCustomDomain' {Text
serviceArn :: Text
$sel:serviceArn:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
serviceArn} -> Text
serviceArn) (\s :: DisassociateCustomDomain
s@DisassociateCustomDomain' {} Text
a -> DisassociateCustomDomain
s {$sel:serviceArn:DisassociateCustomDomain' :: Text
serviceArn = Text
a} :: DisassociateCustomDomain)

-- | The domain name that you want to disassociate from the App Runner
-- service.
disassociateCustomDomain_domainName :: Lens.Lens' DisassociateCustomDomain Prelude.Text
disassociateCustomDomain_domainName :: Lens' DisassociateCustomDomain Text
disassociateCustomDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateCustomDomain' {Text
domainName :: Text
$sel:domainName:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
domainName} -> Text
domainName) (\s :: DisassociateCustomDomain
s@DisassociateCustomDomain' {} Text
a -> DisassociateCustomDomain
s {$sel:domainName:DisassociateCustomDomain' :: Text
domainName = Text
a} :: DisassociateCustomDomain)

instance Core.AWSRequest DisassociateCustomDomain where
  type
    AWSResponse DisassociateCustomDomain =
      DisassociateCustomDomainResponse
  request :: (Service -> Service)
-> DisassociateCustomDomain -> Request DisassociateCustomDomain
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 DisassociateCustomDomain
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DisassociateCustomDomain)))
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 ->
          Int
-> Text
-> Text
-> CustomDomain
-> [VpcDNSTarget]
-> DisassociateCustomDomainResponse
DisassociateCustomDomainResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"DNSTarget")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ServiceArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"CustomDomain")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VpcDNSTargets" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable DisassociateCustomDomain where
  hashWithSalt :: Int -> DisassociateCustomDomain -> Int
hashWithSalt Int
_salt DisassociateCustomDomain' {Text
domainName :: Text
serviceArn :: Text
$sel:domainName:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
$sel:serviceArn:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData DisassociateCustomDomain where
  rnf :: DisassociateCustomDomain -> ()
rnf DisassociateCustomDomain' {Text
domainName :: Text
serviceArn :: Text
$sel:domainName:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
$sel:serviceArn:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
serviceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

instance Data.ToHeaders DisassociateCustomDomain where
  toHeaders :: DisassociateCustomDomain -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AppRunner.DisassociateCustomDomain" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DisassociateCustomDomain where
  toJSON :: DisassociateCustomDomain -> Value
toJSON DisassociateCustomDomain' {Text
domainName :: Text
serviceArn :: Text
$sel:domainName:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
$sel:serviceArn:DisassociateCustomDomain' :: DisassociateCustomDomain -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ServiceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName)
          ]
      )

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

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

-- | /See:/ 'newDisassociateCustomDomainResponse' smart constructor.
data DisassociateCustomDomainResponse = DisassociateCustomDomainResponse'
  { -- | The response's http status code.
    DisassociateCustomDomainResponse -> Int
httpStatus :: Prelude.Int,
    -- | The App Runner subdomain of the App Runner service. The disassociated
    -- custom domain name was mapped to this target name.
    DisassociateCustomDomainResponse -> Text
dNSTarget :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the App Runner service that a custom
    -- domain name is disassociated from.
    DisassociateCustomDomainResponse -> Text
serviceArn :: Prelude.Text,
    -- | A description of the domain name that\'s being disassociated.
    DisassociateCustomDomainResponse -> CustomDomain
customDomain :: CustomDomain,
    -- | DNS Target records for the custom domains of this Amazon VPC.
    DisassociateCustomDomainResponse -> [VpcDNSTarget]
vpcDNSTargets :: [VpcDNSTarget]
  }
  deriving (DisassociateCustomDomainResponse
-> DisassociateCustomDomainResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateCustomDomainResponse
-> DisassociateCustomDomainResponse -> Bool
$c/= :: DisassociateCustomDomainResponse
-> DisassociateCustomDomainResponse -> Bool
== :: DisassociateCustomDomainResponse
-> DisassociateCustomDomainResponse -> Bool
$c== :: DisassociateCustomDomainResponse
-> DisassociateCustomDomainResponse -> Bool
Prelude.Eq, ReadPrec [DisassociateCustomDomainResponse]
ReadPrec DisassociateCustomDomainResponse
Int -> ReadS DisassociateCustomDomainResponse
ReadS [DisassociateCustomDomainResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateCustomDomainResponse]
$creadListPrec :: ReadPrec [DisassociateCustomDomainResponse]
readPrec :: ReadPrec DisassociateCustomDomainResponse
$creadPrec :: ReadPrec DisassociateCustomDomainResponse
readList :: ReadS [DisassociateCustomDomainResponse]
$creadList :: ReadS [DisassociateCustomDomainResponse]
readsPrec :: Int -> ReadS DisassociateCustomDomainResponse
$creadsPrec :: Int -> ReadS DisassociateCustomDomainResponse
Prelude.Read, Int -> DisassociateCustomDomainResponse -> ShowS
[DisassociateCustomDomainResponse] -> ShowS
DisassociateCustomDomainResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateCustomDomainResponse] -> ShowS
$cshowList :: [DisassociateCustomDomainResponse] -> ShowS
show :: DisassociateCustomDomainResponse -> String
$cshow :: DisassociateCustomDomainResponse -> String
showsPrec :: Int -> DisassociateCustomDomainResponse -> ShowS
$cshowsPrec :: Int -> DisassociateCustomDomainResponse -> ShowS
Prelude.Show, forall x.
Rep DisassociateCustomDomainResponse x
-> DisassociateCustomDomainResponse
forall x.
DisassociateCustomDomainResponse
-> Rep DisassociateCustomDomainResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateCustomDomainResponse x
-> DisassociateCustomDomainResponse
$cfrom :: forall x.
DisassociateCustomDomainResponse
-> Rep DisassociateCustomDomainResponse x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateCustomDomainResponse' 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', 'disassociateCustomDomainResponse_httpStatus' - The response's http status code.
--
-- 'dNSTarget', 'disassociateCustomDomainResponse_dNSTarget' - The App Runner subdomain of the App Runner service. The disassociated
-- custom domain name was mapped to this target name.
--
-- 'serviceArn', 'disassociateCustomDomainResponse_serviceArn' - The Amazon Resource Name (ARN) of the App Runner service that a custom
-- domain name is disassociated from.
--
-- 'customDomain', 'disassociateCustomDomainResponse_customDomain' - A description of the domain name that\'s being disassociated.
--
-- 'vpcDNSTargets', 'disassociateCustomDomainResponse_vpcDNSTargets' - DNS Target records for the custom domains of this Amazon VPC.
newDisassociateCustomDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'dNSTarget'
  Prelude.Text ->
  -- | 'serviceArn'
  Prelude.Text ->
  -- | 'customDomain'
  CustomDomain ->
  DisassociateCustomDomainResponse
newDisassociateCustomDomainResponse :: Int
-> Text -> Text -> CustomDomain -> DisassociateCustomDomainResponse
newDisassociateCustomDomainResponse
  Int
pHttpStatus_
  Text
pDNSTarget_
  Text
pServiceArn_
  CustomDomain
pCustomDomain_ =
    DisassociateCustomDomainResponse'
      { $sel:httpStatus:DisassociateCustomDomainResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:dNSTarget:DisassociateCustomDomainResponse' :: Text
dNSTarget = Text
pDNSTarget_,
        $sel:serviceArn:DisassociateCustomDomainResponse' :: Text
serviceArn = Text
pServiceArn_,
        $sel:customDomain:DisassociateCustomDomainResponse' :: CustomDomain
customDomain = CustomDomain
pCustomDomain_,
        $sel:vpcDNSTargets:DisassociateCustomDomainResponse' :: [VpcDNSTarget]
vpcDNSTargets = forall a. Monoid a => a
Prelude.mempty
      }

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

-- | The App Runner subdomain of the App Runner service. The disassociated
-- custom domain name was mapped to this target name.
disassociateCustomDomainResponse_dNSTarget :: Lens.Lens' DisassociateCustomDomainResponse Prelude.Text
disassociateCustomDomainResponse_dNSTarget :: Lens' DisassociateCustomDomainResponse Text
disassociateCustomDomainResponse_dNSTarget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateCustomDomainResponse' {Text
dNSTarget :: Text
$sel:dNSTarget:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> Text
dNSTarget} -> Text
dNSTarget) (\s :: DisassociateCustomDomainResponse
s@DisassociateCustomDomainResponse' {} Text
a -> DisassociateCustomDomainResponse
s {$sel:dNSTarget:DisassociateCustomDomainResponse' :: Text
dNSTarget = Text
a} :: DisassociateCustomDomainResponse)

-- | The Amazon Resource Name (ARN) of the App Runner service that a custom
-- domain name is disassociated from.
disassociateCustomDomainResponse_serviceArn :: Lens.Lens' DisassociateCustomDomainResponse Prelude.Text
disassociateCustomDomainResponse_serviceArn :: Lens' DisassociateCustomDomainResponse Text
disassociateCustomDomainResponse_serviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateCustomDomainResponse' {Text
serviceArn :: Text
$sel:serviceArn:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> Text
serviceArn} -> Text
serviceArn) (\s :: DisassociateCustomDomainResponse
s@DisassociateCustomDomainResponse' {} Text
a -> DisassociateCustomDomainResponse
s {$sel:serviceArn:DisassociateCustomDomainResponse' :: Text
serviceArn = Text
a} :: DisassociateCustomDomainResponse)

-- | A description of the domain name that\'s being disassociated.
disassociateCustomDomainResponse_customDomain :: Lens.Lens' DisassociateCustomDomainResponse CustomDomain
disassociateCustomDomainResponse_customDomain :: Lens' DisassociateCustomDomainResponse CustomDomain
disassociateCustomDomainResponse_customDomain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateCustomDomainResponse' {CustomDomain
customDomain :: CustomDomain
$sel:customDomain:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> CustomDomain
customDomain} -> CustomDomain
customDomain) (\s :: DisassociateCustomDomainResponse
s@DisassociateCustomDomainResponse' {} CustomDomain
a -> DisassociateCustomDomainResponse
s {$sel:customDomain:DisassociateCustomDomainResponse' :: CustomDomain
customDomain = CustomDomain
a} :: DisassociateCustomDomainResponse)

-- | DNS Target records for the custom domains of this Amazon VPC.
disassociateCustomDomainResponse_vpcDNSTargets :: Lens.Lens' DisassociateCustomDomainResponse [VpcDNSTarget]
disassociateCustomDomainResponse_vpcDNSTargets :: Lens' DisassociateCustomDomainResponse [VpcDNSTarget]
disassociateCustomDomainResponse_vpcDNSTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateCustomDomainResponse' {[VpcDNSTarget]
vpcDNSTargets :: [VpcDNSTarget]
$sel:vpcDNSTargets:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> [VpcDNSTarget]
vpcDNSTargets} -> [VpcDNSTarget]
vpcDNSTargets) (\s :: DisassociateCustomDomainResponse
s@DisassociateCustomDomainResponse' {} [VpcDNSTarget]
a -> DisassociateCustomDomainResponse
s {$sel:vpcDNSTargets:DisassociateCustomDomainResponse' :: [VpcDNSTarget]
vpcDNSTargets = [VpcDNSTarget]
a} :: DisassociateCustomDomainResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Prelude.NFData
    DisassociateCustomDomainResponse
  where
  rnf :: DisassociateCustomDomainResponse -> ()
rnf DisassociateCustomDomainResponse' {Int
[VpcDNSTarget]
Text
CustomDomain
vpcDNSTargets :: [VpcDNSTarget]
customDomain :: CustomDomain
serviceArn :: Text
dNSTarget :: Text
httpStatus :: Int
$sel:vpcDNSTargets:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> [VpcDNSTarget]
$sel:customDomain:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> CustomDomain
$sel:serviceArn:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> Text
$sel:dNSTarget:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> Text
$sel:httpStatus:DisassociateCustomDomainResponse' :: DisassociateCustomDomainResponse -> 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 Text
dNSTarget
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf CustomDomain
customDomain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [VpcDNSTarget]
vpcDNSTargets