{-# 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.AssociateCustomDomain
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associate your own domain name with the App Runner subdomain URL of your
-- App Runner service.
--
-- After you call @AssociateCustomDomain@ and receive a successful
-- response, use the information in the CustomDomain record that\'s
-- returned to add CNAME records to your Domain Name System (DNS). For each
-- mapped domain name, add a mapping to the target App Runner subdomain and
-- one or more certificate validation records. App Runner then performs DNS
-- validation to verify that you own or control the domain name that you
-- associated. App Runner tracks domain validity in a certificate stored in
-- <https://docs.aws.amazon.com/acm/latest/userguide AWS Certificate Manager (ACM)>.
module Amazonka.AppRunner.AssociateCustomDomain
  ( -- * Creating a Request
    AssociateCustomDomain (..),
    newAssociateCustomDomain,

    -- * Request Lenses
    associateCustomDomain_enableWWWSubdomain,
    associateCustomDomain_serviceArn,
    associateCustomDomain_domainName,

    -- * Destructuring the Response
    AssociateCustomDomainResponse (..),
    newAssociateCustomDomainResponse,

    -- * Response Lenses
    associateCustomDomainResponse_httpStatus,
    associateCustomDomainResponse_dNSTarget,
    associateCustomDomainResponse_serviceArn,
    associateCustomDomainResponse_customDomain,
    associateCustomDomainResponse_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:/ 'newAssociateCustomDomain' smart constructor.
data AssociateCustomDomain = AssociateCustomDomain'
  { -- | Set to @true@ to associate the subdomain @www.@/@DomainName@/@ @ with
    -- the App Runner service in addition to the base domain.
    --
    -- Default: @true@
    AssociateCustomDomain -> Maybe Bool
enableWWWSubdomain :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of the App Runner service that you want
    -- to associate a custom domain name with.
    AssociateCustomDomain -> Text
serviceArn :: Prelude.Text,
    -- | A custom domain endpoint to associate. Specify a root domain (for
    -- example, @example.com@), a subdomain (for example, @login.example.com@
    -- or @admin.login.example.com@), or a wildcard (for example,
    -- @*.example.com@).
    AssociateCustomDomain -> Text
domainName :: Prelude.Text
  }
  deriving (AssociateCustomDomain -> AssociateCustomDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateCustomDomain -> AssociateCustomDomain -> Bool
$c/= :: AssociateCustomDomain -> AssociateCustomDomain -> Bool
== :: AssociateCustomDomain -> AssociateCustomDomain -> Bool
$c== :: AssociateCustomDomain -> AssociateCustomDomain -> Bool
Prelude.Eq, ReadPrec [AssociateCustomDomain]
ReadPrec AssociateCustomDomain
Int -> ReadS AssociateCustomDomain
ReadS [AssociateCustomDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateCustomDomain]
$creadListPrec :: ReadPrec [AssociateCustomDomain]
readPrec :: ReadPrec AssociateCustomDomain
$creadPrec :: ReadPrec AssociateCustomDomain
readList :: ReadS [AssociateCustomDomain]
$creadList :: ReadS [AssociateCustomDomain]
readsPrec :: Int -> ReadS AssociateCustomDomain
$creadsPrec :: Int -> ReadS AssociateCustomDomain
Prelude.Read, Int -> AssociateCustomDomain -> ShowS
[AssociateCustomDomain] -> ShowS
AssociateCustomDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateCustomDomain] -> ShowS
$cshowList :: [AssociateCustomDomain] -> ShowS
show :: AssociateCustomDomain -> String
$cshow :: AssociateCustomDomain -> String
showsPrec :: Int -> AssociateCustomDomain -> ShowS
$cshowsPrec :: Int -> AssociateCustomDomain -> ShowS
Prelude.Show, forall x. Rep AssociateCustomDomain x -> AssociateCustomDomain
forall x. AssociateCustomDomain -> Rep AssociateCustomDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateCustomDomain x -> AssociateCustomDomain
$cfrom :: forall x. AssociateCustomDomain -> Rep AssociateCustomDomain x
Prelude.Generic)

-- |
-- Create a value of 'AssociateCustomDomain' 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:
--
-- 'enableWWWSubdomain', 'associateCustomDomain_enableWWWSubdomain' - Set to @true@ to associate the subdomain @www.@/@DomainName@/@ @ with
-- the App Runner service in addition to the base domain.
--
-- Default: @true@
--
-- 'serviceArn', 'associateCustomDomain_serviceArn' - The Amazon Resource Name (ARN) of the App Runner service that you want
-- to associate a custom domain name with.
--
-- 'domainName', 'associateCustomDomain_domainName' - A custom domain endpoint to associate. Specify a root domain (for
-- example, @example.com@), a subdomain (for example, @login.example.com@
-- or @admin.login.example.com@), or a wildcard (for example,
-- @*.example.com@).
newAssociateCustomDomain ::
  -- | 'serviceArn'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  AssociateCustomDomain
newAssociateCustomDomain :: Text -> Text -> AssociateCustomDomain
newAssociateCustomDomain Text
pServiceArn_ Text
pDomainName_ =
  AssociateCustomDomain'
    { $sel:enableWWWSubdomain:AssociateCustomDomain' :: Maybe Bool
enableWWWSubdomain =
        forall a. Maybe a
Prelude.Nothing,
      $sel:serviceArn:AssociateCustomDomain' :: Text
serviceArn = Text
pServiceArn_,
      $sel:domainName:AssociateCustomDomain' :: Text
domainName = Text
pDomainName_
    }

-- | Set to @true@ to associate the subdomain @www.@/@DomainName@/@ @ with
-- the App Runner service in addition to the base domain.
--
-- Default: @true@
associateCustomDomain_enableWWWSubdomain :: Lens.Lens' AssociateCustomDomain (Prelude.Maybe Prelude.Bool)
associateCustomDomain_enableWWWSubdomain :: Lens' AssociateCustomDomain (Maybe Bool)
associateCustomDomain_enableWWWSubdomain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCustomDomain' {Maybe Bool
enableWWWSubdomain :: Maybe Bool
$sel:enableWWWSubdomain:AssociateCustomDomain' :: AssociateCustomDomain -> Maybe Bool
enableWWWSubdomain} -> Maybe Bool
enableWWWSubdomain) (\s :: AssociateCustomDomain
s@AssociateCustomDomain' {} Maybe Bool
a -> AssociateCustomDomain
s {$sel:enableWWWSubdomain:AssociateCustomDomain' :: Maybe Bool
enableWWWSubdomain = Maybe Bool
a} :: AssociateCustomDomain)

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

-- | A custom domain endpoint to associate. Specify a root domain (for
-- example, @example.com@), a subdomain (for example, @login.example.com@
-- or @admin.login.example.com@), or a wildcard (for example,
-- @*.example.com@).
associateCustomDomain_domainName :: Lens.Lens' AssociateCustomDomain Prelude.Text
associateCustomDomain_domainName :: Lens' AssociateCustomDomain Text
associateCustomDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCustomDomain' {Text
domainName :: Text
$sel:domainName:AssociateCustomDomain' :: AssociateCustomDomain -> Text
domainName} -> Text
domainName) (\s :: AssociateCustomDomain
s@AssociateCustomDomain' {} Text
a -> AssociateCustomDomain
s {$sel:domainName:AssociateCustomDomain' :: Text
domainName = Text
a} :: AssociateCustomDomain)

instance Core.AWSRequest AssociateCustomDomain where
  type
    AWSResponse AssociateCustomDomain =
      AssociateCustomDomainResponse
  request :: (Service -> Service)
-> AssociateCustomDomain -> Request AssociateCustomDomain
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 AssociateCustomDomain
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateCustomDomain)))
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]
-> AssociateCustomDomainResponse
AssociateCustomDomainResponse'
            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 AssociateCustomDomain where
  hashWithSalt :: Int -> AssociateCustomDomain -> Int
hashWithSalt Int
_salt AssociateCustomDomain' {Maybe Bool
Text
domainName :: Text
serviceArn :: Text
enableWWWSubdomain :: Maybe Bool
$sel:domainName:AssociateCustomDomain' :: AssociateCustomDomain -> Text
$sel:serviceArn:AssociateCustomDomain' :: AssociateCustomDomain -> Text
$sel:enableWWWSubdomain:AssociateCustomDomain' :: AssociateCustomDomain -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableWWWSubdomain
      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 AssociateCustomDomain where
  rnf :: AssociateCustomDomain -> ()
rnf AssociateCustomDomain' {Maybe Bool
Text
domainName :: Text
serviceArn :: Text
enableWWWSubdomain :: Maybe Bool
$sel:domainName:AssociateCustomDomain' :: AssociateCustomDomain -> Text
$sel:serviceArn:AssociateCustomDomain' :: AssociateCustomDomain -> Text
$sel:enableWWWSubdomain:AssociateCustomDomain' :: AssociateCustomDomain -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableWWWSubdomain
      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 Text
domainName

instance Data.ToHeaders AssociateCustomDomain where
  toHeaders :: AssociateCustomDomain -> 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.AssociateCustomDomain" ::
                          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 AssociateCustomDomain where
  toJSON :: AssociateCustomDomain -> Value
toJSON AssociateCustomDomain' {Maybe Bool
Text
domainName :: Text
serviceArn :: Text
enableWWWSubdomain :: Maybe Bool
$sel:domainName:AssociateCustomDomain' :: AssociateCustomDomain -> Text
$sel:serviceArn:AssociateCustomDomain' :: AssociateCustomDomain -> Text
$sel:enableWWWSubdomain:AssociateCustomDomain' :: AssociateCustomDomain -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EnableWWWSubdomain" 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 Bool
enableWWWSubdomain,
            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 AssociateCustomDomain where
  toPath :: AssociateCustomDomain -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'AssociateCustomDomainResponse' 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', 'associateCustomDomainResponse_httpStatus' - The response's http status code.
--
-- 'dNSTarget', 'associateCustomDomainResponse_dNSTarget' - The App Runner subdomain of the App Runner service. The custom domain
-- name is mapped to this target name.
--
-- 'serviceArn', 'associateCustomDomainResponse_serviceArn' - The Amazon Resource Name (ARN) of the App Runner service with which a
-- custom domain name is associated.
--
-- 'customDomain', 'associateCustomDomainResponse_customDomain' - A description of the domain name that\'s being associated.
--
-- 'vpcDNSTargets', 'associateCustomDomainResponse_vpcDNSTargets' - DNS Target records for the custom domains of this Amazon VPC.
newAssociateCustomDomainResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'dNSTarget'
  Prelude.Text ->
  -- | 'serviceArn'
  Prelude.Text ->
  -- | 'customDomain'
  CustomDomain ->
  AssociateCustomDomainResponse
newAssociateCustomDomainResponse :: Int
-> Text -> Text -> CustomDomain -> AssociateCustomDomainResponse
newAssociateCustomDomainResponse
  Int
pHttpStatus_
  Text
pDNSTarget_
  Text
pServiceArn_
  CustomDomain
pCustomDomain_ =
    AssociateCustomDomainResponse'
      { $sel:httpStatus:AssociateCustomDomainResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:dNSTarget:AssociateCustomDomainResponse' :: Text
dNSTarget = Text
pDNSTarget_,
        $sel:serviceArn:AssociateCustomDomainResponse' :: Text
serviceArn = Text
pServiceArn_,
        $sel:customDomain:AssociateCustomDomainResponse' :: CustomDomain
customDomain = CustomDomain
pCustomDomain_,
        $sel:vpcDNSTargets:AssociateCustomDomainResponse' :: [VpcDNSTarget]
vpcDNSTargets = forall a. Monoid a => a
Prelude.mempty
      }

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

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

-- | The Amazon Resource Name (ARN) of the App Runner service with which a
-- custom domain name is associated.
associateCustomDomainResponse_serviceArn :: Lens.Lens' AssociateCustomDomainResponse Prelude.Text
associateCustomDomainResponse_serviceArn :: Lens' AssociateCustomDomainResponse Text
associateCustomDomainResponse_serviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCustomDomainResponse' {Text
serviceArn :: Text
$sel:serviceArn:AssociateCustomDomainResponse' :: AssociateCustomDomainResponse -> Text
serviceArn} -> Text
serviceArn) (\s :: AssociateCustomDomainResponse
s@AssociateCustomDomainResponse' {} Text
a -> AssociateCustomDomainResponse
s {$sel:serviceArn:AssociateCustomDomainResponse' :: Text
serviceArn = Text
a} :: AssociateCustomDomainResponse)

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

-- | DNS Target records for the custom domains of this Amazon VPC.
associateCustomDomainResponse_vpcDNSTargets :: Lens.Lens' AssociateCustomDomainResponse [VpcDNSTarget]
associateCustomDomainResponse_vpcDNSTargets :: Lens' AssociateCustomDomainResponse [VpcDNSTarget]
associateCustomDomainResponse_vpcDNSTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateCustomDomainResponse' {[VpcDNSTarget]
vpcDNSTargets :: [VpcDNSTarget]
$sel:vpcDNSTargets:AssociateCustomDomainResponse' :: AssociateCustomDomainResponse -> [VpcDNSTarget]
vpcDNSTargets} -> [VpcDNSTarget]
vpcDNSTargets) (\s :: AssociateCustomDomainResponse
s@AssociateCustomDomainResponse' {} [VpcDNSTarget]
a -> AssociateCustomDomainResponse
s {$sel:vpcDNSTargets:AssociateCustomDomainResponse' :: [VpcDNSTarget]
vpcDNSTargets = [VpcDNSTarget]
a} :: AssociateCustomDomainResponse) 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 AssociateCustomDomainResponse where
  rnf :: AssociateCustomDomainResponse -> ()
rnf AssociateCustomDomainResponse' {Int
[VpcDNSTarget]
Text
CustomDomain
vpcDNSTargets :: [VpcDNSTarget]
customDomain :: CustomDomain
serviceArn :: Text
dNSTarget :: Text
httpStatus :: Int
$sel:vpcDNSTargets:AssociateCustomDomainResponse' :: AssociateCustomDomainResponse -> [VpcDNSTarget]
$sel:customDomain:AssociateCustomDomainResponse' :: AssociateCustomDomainResponse -> CustomDomain
$sel:serviceArn:AssociateCustomDomainResponse' :: AssociateCustomDomainResponse -> Text
$sel:dNSTarget:AssociateCustomDomainResponse' :: AssociateCustomDomainResponse -> Text
$sel:httpStatus:AssociateCustomDomainResponse' :: AssociateCustomDomainResponse -> 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