{-# 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.DescribeCustomDomains
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Return a description of custom domain names that are associated with an
-- App Runner service.
module Amazonka.AppRunner.DescribeCustomDomains
  ( -- * Creating a Request
    DescribeCustomDomains (..),
    newDescribeCustomDomains,

    -- * Request Lenses
    describeCustomDomains_maxResults,
    describeCustomDomains_nextToken,
    describeCustomDomains_serviceArn,

    -- * Destructuring the Response
    DescribeCustomDomainsResponse (..),
    newDescribeCustomDomainsResponse,

    -- * Response Lenses
    describeCustomDomainsResponse_nextToken,
    describeCustomDomainsResponse_httpStatus,
    describeCustomDomainsResponse_dNSTarget,
    describeCustomDomainsResponse_serviceArn,
    describeCustomDomainsResponse_customDomains,
    describeCustomDomainsResponse_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:/ 'newDescribeCustomDomains' smart constructor.
data DescribeCustomDomains = DescribeCustomDomains'
  { -- | The maximum number of results that each response (result page) can
    -- include. It\'s used for a paginated request.
    --
    -- If you don\'t specify @MaxResults@, the request retrieves all available
    -- results in a single response.
    DescribeCustomDomains -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A token from a previous result page. It\'s used for a paginated request.
    -- The request retrieves the next result page. All other parameter values
    -- must be identical to the ones that are specified in the initial request.
    --
    -- If you don\'t specify @NextToken@, the request retrieves the first
    -- result page.
    DescribeCustomDomains -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the App Runner service that you want
    -- associated custom domain names to be described for.
    DescribeCustomDomains -> Text
serviceArn :: Prelude.Text
  }
  deriving (DescribeCustomDomains -> DescribeCustomDomains -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCustomDomains -> DescribeCustomDomains -> Bool
$c/= :: DescribeCustomDomains -> DescribeCustomDomains -> Bool
== :: DescribeCustomDomains -> DescribeCustomDomains -> Bool
$c== :: DescribeCustomDomains -> DescribeCustomDomains -> Bool
Prelude.Eq, ReadPrec [DescribeCustomDomains]
ReadPrec DescribeCustomDomains
Int -> ReadS DescribeCustomDomains
ReadS [DescribeCustomDomains]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCustomDomains]
$creadListPrec :: ReadPrec [DescribeCustomDomains]
readPrec :: ReadPrec DescribeCustomDomains
$creadPrec :: ReadPrec DescribeCustomDomains
readList :: ReadS [DescribeCustomDomains]
$creadList :: ReadS [DescribeCustomDomains]
readsPrec :: Int -> ReadS DescribeCustomDomains
$creadsPrec :: Int -> ReadS DescribeCustomDomains
Prelude.Read, Int -> DescribeCustomDomains -> ShowS
[DescribeCustomDomains] -> ShowS
DescribeCustomDomains -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCustomDomains] -> ShowS
$cshowList :: [DescribeCustomDomains] -> ShowS
show :: DescribeCustomDomains -> String
$cshow :: DescribeCustomDomains -> String
showsPrec :: Int -> DescribeCustomDomains -> ShowS
$cshowsPrec :: Int -> DescribeCustomDomains -> ShowS
Prelude.Show, forall x. Rep DescribeCustomDomains x -> DescribeCustomDomains
forall x. DescribeCustomDomains -> Rep DescribeCustomDomains x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeCustomDomains x -> DescribeCustomDomains
$cfrom :: forall x. DescribeCustomDomains -> Rep DescribeCustomDomains x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCustomDomains' 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:
--
-- 'maxResults', 'describeCustomDomains_maxResults' - The maximum number of results that each response (result page) can
-- include. It\'s used for a paginated request.
--
-- If you don\'t specify @MaxResults@, the request retrieves all available
-- results in a single response.
--
-- 'nextToken', 'describeCustomDomains_nextToken' - A token from a previous result page. It\'s used for a paginated request.
-- The request retrieves the next result page. All other parameter values
-- must be identical to the ones that are specified in the initial request.
--
-- If you don\'t specify @NextToken@, the request retrieves the first
-- result page.
--
-- 'serviceArn', 'describeCustomDomains_serviceArn' - The Amazon Resource Name (ARN) of the App Runner service that you want
-- associated custom domain names to be described for.
newDescribeCustomDomains ::
  -- | 'serviceArn'
  Prelude.Text ->
  DescribeCustomDomains
newDescribeCustomDomains :: Text -> DescribeCustomDomains
newDescribeCustomDomains Text
pServiceArn_ =
  DescribeCustomDomains'
    { $sel:maxResults:DescribeCustomDomains' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeCustomDomains' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceArn:DescribeCustomDomains' :: Text
serviceArn = Text
pServiceArn_
    }

-- | The maximum number of results that each response (result page) can
-- include. It\'s used for a paginated request.
--
-- If you don\'t specify @MaxResults@, the request retrieves all available
-- results in a single response.
describeCustomDomains_maxResults :: Lens.Lens' DescribeCustomDomains (Prelude.Maybe Prelude.Natural)
describeCustomDomains_maxResults :: Lens' DescribeCustomDomains (Maybe Natural)
describeCustomDomains_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCustomDomains' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeCustomDomains
s@DescribeCustomDomains' {} Maybe Natural
a -> DescribeCustomDomains
s {$sel:maxResults:DescribeCustomDomains' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeCustomDomains)

-- | A token from a previous result page. It\'s used for a paginated request.
-- The request retrieves the next result page. All other parameter values
-- must be identical to the ones that are specified in the initial request.
--
-- If you don\'t specify @NextToken@, the request retrieves the first
-- result page.
describeCustomDomains_nextToken :: Lens.Lens' DescribeCustomDomains (Prelude.Maybe Prelude.Text)
describeCustomDomains_nextToken :: Lens' DescribeCustomDomains (Maybe Text)
describeCustomDomains_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCustomDomains' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeCustomDomains
s@DescribeCustomDomains' {} Maybe Text
a -> DescribeCustomDomains
s {$sel:nextToken:DescribeCustomDomains' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeCustomDomains)

-- | The Amazon Resource Name (ARN) of the App Runner service that you want
-- associated custom domain names to be described for.
describeCustomDomains_serviceArn :: Lens.Lens' DescribeCustomDomains Prelude.Text
describeCustomDomains_serviceArn :: Lens' DescribeCustomDomains Text
describeCustomDomains_serviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCustomDomains' {Text
serviceArn :: Text
$sel:serviceArn:DescribeCustomDomains' :: DescribeCustomDomains -> Text
serviceArn} -> Text
serviceArn) (\s :: DescribeCustomDomains
s@DescribeCustomDomains' {} Text
a -> DescribeCustomDomains
s {$sel:serviceArn:DescribeCustomDomains' :: Text
serviceArn = Text
a} :: DescribeCustomDomains)

instance Core.AWSRequest DescribeCustomDomains where
  type
    AWSResponse DescribeCustomDomains =
      DescribeCustomDomainsResponse
  request :: (Service -> Service)
-> DescribeCustomDomains -> Request DescribeCustomDomains
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 DescribeCustomDomains
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeCustomDomains)))
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 Text
-> Int
-> Text
-> Text
-> [CustomDomain]
-> [VpcDNSTarget]
-> DescribeCustomDomainsResponse
DescribeCustomDomainsResponse'
            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
"NextToken")
            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))
            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 (Maybe a)
Data..?> Key
"CustomDomains" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 DescribeCustomDomains where
  hashWithSalt :: Int -> DescribeCustomDomains -> Int
hashWithSalt Int
_salt DescribeCustomDomains' {Maybe Natural
Maybe Text
Text
serviceArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:serviceArn:DescribeCustomDomains' :: DescribeCustomDomains -> Text
$sel:nextToken:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Text
$sel:maxResults:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceArn

instance Prelude.NFData DescribeCustomDomains where
  rnf :: DescribeCustomDomains -> ()
rnf DescribeCustomDomains' {Maybe Natural
Maybe Text
Text
serviceArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:serviceArn:DescribeCustomDomains' :: DescribeCustomDomains -> Text
$sel:nextToken:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Text
$sel:maxResults:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceArn

instance Data.ToHeaders DescribeCustomDomains where
  toHeaders :: DescribeCustomDomains -> 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.DescribeCustomDomains" ::
                          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 DescribeCustomDomains where
  toJSON :: DescribeCustomDomains -> Value
toJSON DescribeCustomDomains' {Maybe Natural
Maybe Text
Text
serviceArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:serviceArn:DescribeCustomDomains' :: DescribeCustomDomains -> Text
$sel:nextToken:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Text
$sel:maxResults:DescribeCustomDomains' :: DescribeCustomDomains -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"ServiceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceArn)
          ]
      )

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

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

-- | /See:/ 'newDescribeCustomDomainsResponse' smart constructor.
data DescribeCustomDomainsResponse = DescribeCustomDomainsResponse'
  { -- | The token that you can pass in a subsequent request to get the next
    -- result page. It\'s returned in a paginated request.
    DescribeCustomDomainsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeCustomDomainsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The App Runner subdomain of the App Runner service. The associated
    -- custom domain names are mapped to this target name.
    DescribeCustomDomainsResponse -> Text
dNSTarget :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the App Runner service whose
    -- associated custom domain names you want to describe.
    DescribeCustomDomainsResponse -> Text
serviceArn :: Prelude.Text,
    -- | A list of descriptions of custom domain names that are associated with
    -- the service. In a paginated request, the request returns up to
    -- @MaxResults@ records per call.
    DescribeCustomDomainsResponse -> [CustomDomain]
customDomains :: [CustomDomain],
    -- | DNS Target records for the custom domains of this Amazon VPC.
    DescribeCustomDomainsResponse -> [VpcDNSTarget]
vpcDNSTargets :: [VpcDNSTarget]
  }
  deriving (DescribeCustomDomainsResponse
-> DescribeCustomDomainsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCustomDomainsResponse
-> DescribeCustomDomainsResponse -> Bool
$c/= :: DescribeCustomDomainsResponse
-> DescribeCustomDomainsResponse -> Bool
== :: DescribeCustomDomainsResponse
-> DescribeCustomDomainsResponse -> Bool
$c== :: DescribeCustomDomainsResponse
-> DescribeCustomDomainsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeCustomDomainsResponse]
ReadPrec DescribeCustomDomainsResponse
Int -> ReadS DescribeCustomDomainsResponse
ReadS [DescribeCustomDomainsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCustomDomainsResponse]
$creadListPrec :: ReadPrec [DescribeCustomDomainsResponse]
readPrec :: ReadPrec DescribeCustomDomainsResponse
$creadPrec :: ReadPrec DescribeCustomDomainsResponse
readList :: ReadS [DescribeCustomDomainsResponse]
$creadList :: ReadS [DescribeCustomDomainsResponse]
readsPrec :: Int -> ReadS DescribeCustomDomainsResponse
$creadsPrec :: Int -> ReadS DescribeCustomDomainsResponse
Prelude.Read, Int -> DescribeCustomDomainsResponse -> ShowS
[DescribeCustomDomainsResponse] -> ShowS
DescribeCustomDomainsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCustomDomainsResponse] -> ShowS
$cshowList :: [DescribeCustomDomainsResponse] -> ShowS
show :: DescribeCustomDomainsResponse -> String
$cshow :: DescribeCustomDomainsResponse -> String
showsPrec :: Int -> DescribeCustomDomainsResponse -> ShowS
$cshowsPrec :: Int -> DescribeCustomDomainsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeCustomDomainsResponse x
-> DescribeCustomDomainsResponse
forall x.
DescribeCustomDomainsResponse
-> Rep DescribeCustomDomainsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeCustomDomainsResponse x
-> DescribeCustomDomainsResponse
$cfrom :: forall x.
DescribeCustomDomainsResponse
-> Rep DescribeCustomDomainsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCustomDomainsResponse' 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:
--
-- 'nextToken', 'describeCustomDomainsResponse_nextToken' - The token that you can pass in a subsequent request to get the next
-- result page. It\'s returned in a paginated request.
--
-- 'httpStatus', 'describeCustomDomainsResponse_httpStatus' - The response's http status code.
--
-- 'dNSTarget', 'describeCustomDomainsResponse_dNSTarget' - The App Runner subdomain of the App Runner service. The associated
-- custom domain names are mapped to this target name.
--
-- 'serviceArn', 'describeCustomDomainsResponse_serviceArn' - The Amazon Resource Name (ARN) of the App Runner service whose
-- associated custom domain names you want to describe.
--
-- 'customDomains', 'describeCustomDomainsResponse_customDomains' - A list of descriptions of custom domain names that are associated with
-- the service. In a paginated request, the request returns up to
-- @MaxResults@ records per call.
--
-- 'vpcDNSTargets', 'describeCustomDomainsResponse_vpcDNSTargets' - DNS Target records for the custom domains of this Amazon VPC.
newDescribeCustomDomainsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'dNSTarget'
  Prelude.Text ->
  -- | 'serviceArn'
  Prelude.Text ->
  DescribeCustomDomainsResponse
newDescribeCustomDomainsResponse :: Int -> Text -> Text -> DescribeCustomDomainsResponse
newDescribeCustomDomainsResponse
  Int
pHttpStatus_
  Text
pDNSTarget_
  Text
pServiceArn_ =
    DescribeCustomDomainsResponse'
      { $sel:nextToken:DescribeCustomDomainsResponse' :: Maybe Text
nextToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeCustomDomainsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:dNSTarget:DescribeCustomDomainsResponse' :: Text
dNSTarget = Text
pDNSTarget_,
        $sel:serviceArn:DescribeCustomDomainsResponse' :: Text
serviceArn = Text
pServiceArn_,
        $sel:customDomains:DescribeCustomDomainsResponse' :: [CustomDomain]
customDomains = forall a. Monoid a => a
Prelude.mempty,
        $sel:vpcDNSTargets:DescribeCustomDomainsResponse' :: [VpcDNSTarget]
vpcDNSTargets = forall a. Monoid a => a
Prelude.mempty
      }

-- | The token that you can pass in a subsequent request to get the next
-- result page. It\'s returned in a paginated request.
describeCustomDomainsResponse_nextToken :: Lens.Lens' DescribeCustomDomainsResponse (Prelude.Maybe Prelude.Text)
describeCustomDomainsResponse_nextToken :: Lens' DescribeCustomDomainsResponse (Maybe Text)
describeCustomDomainsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCustomDomainsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeCustomDomainsResponse' :: DescribeCustomDomainsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeCustomDomainsResponse
s@DescribeCustomDomainsResponse' {} Maybe Text
a -> DescribeCustomDomainsResponse
s {$sel:nextToken:DescribeCustomDomainsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeCustomDomainsResponse)

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

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

-- | The Amazon Resource Name (ARN) of the App Runner service whose
-- associated custom domain names you want to describe.
describeCustomDomainsResponse_serviceArn :: Lens.Lens' DescribeCustomDomainsResponse Prelude.Text
describeCustomDomainsResponse_serviceArn :: Lens' DescribeCustomDomainsResponse Text
describeCustomDomainsResponse_serviceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCustomDomainsResponse' {Text
serviceArn :: Text
$sel:serviceArn:DescribeCustomDomainsResponse' :: DescribeCustomDomainsResponse -> Text
serviceArn} -> Text
serviceArn) (\s :: DescribeCustomDomainsResponse
s@DescribeCustomDomainsResponse' {} Text
a -> DescribeCustomDomainsResponse
s {$sel:serviceArn:DescribeCustomDomainsResponse' :: Text
serviceArn = Text
a} :: DescribeCustomDomainsResponse)

-- | A list of descriptions of custom domain names that are associated with
-- the service. In a paginated request, the request returns up to
-- @MaxResults@ records per call.
describeCustomDomainsResponse_customDomains :: Lens.Lens' DescribeCustomDomainsResponse [CustomDomain]
describeCustomDomainsResponse_customDomains :: Lens' DescribeCustomDomainsResponse [CustomDomain]
describeCustomDomainsResponse_customDomains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCustomDomainsResponse' {[CustomDomain]
customDomains :: [CustomDomain]
$sel:customDomains:DescribeCustomDomainsResponse' :: DescribeCustomDomainsResponse -> [CustomDomain]
customDomains} -> [CustomDomain]
customDomains) (\s :: DescribeCustomDomainsResponse
s@DescribeCustomDomainsResponse' {} [CustomDomain]
a -> DescribeCustomDomainsResponse
s {$sel:customDomains:DescribeCustomDomainsResponse' :: [CustomDomain]
customDomains = [CustomDomain]
a} :: DescribeCustomDomainsResponse) 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

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