{-# 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.Amplify.CreateDomainAssociation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new domain association for an Amplify app. This action
-- associates a custom domain with the Amplify app
module Amazonka.Amplify.CreateDomainAssociation
  ( -- * Creating a Request
    CreateDomainAssociation (..),
    newCreateDomainAssociation,

    -- * Request Lenses
    createDomainAssociation_autoSubDomainCreationPatterns,
    createDomainAssociation_autoSubDomainIAMRole,
    createDomainAssociation_enableAutoSubDomain,
    createDomainAssociation_appId,
    createDomainAssociation_domainName,
    createDomainAssociation_subDomainSettings,

    -- * Destructuring the Response
    CreateDomainAssociationResponse (..),
    newCreateDomainAssociationResponse,

    -- * Response Lenses
    createDomainAssociationResponse_httpStatus,
    createDomainAssociationResponse_domainAssociation,
  )
where

import Amazonka.Amplify.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

-- | The request structure for the create domain association request.
--
-- /See:/ 'newCreateDomainAssociation' smart constructor.
data CreateDomainAssociation = CreateDomainAssociation'
  { -- | Sets the branch patterns for automatic subdomain creation.
    CreateDomainAssociation -> Maybe [Text]
autoSubDomainCreationPatterns :: Prelude.Maybe [Prelude.Text],
    -- | The required AWS Identity and Access Management (IAM) service role for
    -- the Amazon Resource Name (ARN) for automatically creating subdomains.
    CreateDomainAssociation -> Maybe Text
autoSubDomainIAMRole :: Prelude.Maybe Prelude.Text,
    -- | Enables the automated creation of subdomains for branches.
    CreateDomainAssociation -> Maybe Bool
enableAutoSubDomain :: Prelude.Maybe Prelude.Bool,
    -- | The unique ID for an Amplify app.
    CreateDomainAssociation -> Text
appId :: Prelude.Text,
    -- | The domain name for the domain association.
    CreateDomainAssociation -> Text
domainName :: Prelude.Text,
    -- | The setting for the subdomain.
    CreateDomainAssociation -> [SubDomainSetting]
subDomainSettings :: [SubDomainSetting]
  }
  deriving (CreateDomainAssociation -> CreateDomainAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDomainAssociation -> CreateDomainAssociation -> Bool
$c/= :: CreateDomainAssociation -> CreateDomainAssociation -> Bool
== :: CreateDomainAssociation -> CreateDomainAssociation -> Bool
$c== :: CreateDomainAssociation -> CreateDomainAssociation -> Bool
Prelude.Eq, ReadPrec [CreateDomainAssociation]
ReadPrec CreateDomainAssociation
Int -> ReadS CreateDomainAssociation
ReadS [CreateDomainAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDomainAssociation]
$creadListPrec :: ReadPrec [CreateDomainAssociation]
readPrec :: ReadPrec CreateDomainAssociation
$creadPrec :: ReadPrec CreateDomainAssociation
readList :: ReadS [CreateDomainAssociation]
$creadList :: ReadS [CreateDomainAssociation]
readsPrec :: Int -> ReadS CreateDomainAssociation
$creadsPrec :: Int -> ReadS CreateDomainAssociation
Prelude.Read, Int -> CreateDomainAssociation -> ShowS
[CreateDomainAssociation] -> ShowS
CreateDomainAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDomainAssociation] -> ShowS
$cshowList :: [CreateDomainAssociation] -> ShowS
show :: CreateDomainAssociation -> String
$cshow :: CreateDomainAssociation -> String
showsPrec :: Int -> CreateDomainAssociation -> ShowS
$cshowsPrec :: Int -> CreateDomainAssociation -> ShowS
Prelude.Show, forall x. Rep CreateDomainAssociation x -> CreateDomainAssociation
forall x. CreateDomainAssociation -> Rep CreateDomainAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDomainAssociation x -> CreateDomainAssociation
$cfrom :: forall x. CreateDomainAssociation -> Rep CreateDomainAssociation x
Prelude.Generic)

-- |
-- Create a value of 'CreateDomainAssociation' 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:
--
-- 'autoSubDomainCreationPatterns', 'createDomainAssociation_autoSubDomainCreationPatterns' - Sets the branch patterns for automatic subdomain creation.
--
-- 'autoSubDomainIAMRole', 'createDomainAssociation_autoSubDomainIAMRole' - The required AWS Identity and Access Management (IAM) service role for
-- the Amazon Resource Name (ARN) for automatically creating subdomains.
--
-- 'enableAutoSubDomain', 'createDomainAssociation_enableAutoSubDomain' - Enables the automated creation of subdomains for branches.
--
-- 'appId', 'createDomainAssociation_appId' - The unique ID for an Amplify app.
--
-- 'domainName', 'createDomainAssociation_domainName' - The domain name for the domain association.
--
-- 'subDomainSettings', 'createDomainAssociation_subDomainSettings' - The setting for the subdomain.
newCreateDomainAssociation ::
  -- | 'appId'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  CreateDomainAssociation
newCreateDomainAssociation :: Text -> Text -> CreateDomainAssociation
newCreateDomainAssociation Text
pAppId_ Text
pDomainName_ =
  CreateDomainAssociation'
    { $sel:autoSubDomainCreationPatterns:CreateDomainAssociation' :: Maybe [Text]
autoSubDomainCreationPatterns =
        forall a. Maybe a
Prelude.Nothing,
      $sel:autoSubDomainIAMRole:CreateDomainAssociation' :: Maybe Text
autoSubDomainIAMRole = forall a. Maybe a
Prelude.Nothing,
      $sel:enableAutoSubDomain:CreateDomainAssociation' :: Maybe Bool
enableAutoSubDomain = forall a. Maybe a
Prelude.Nothing,
      $sel:appId:CreateDomainAssociation' :: Text
appId = Text
pAppId_,
      $sel:domainName:CreateDomainAssociation' :: Text
domainName = Text
pDomainName_,
      $sel:subDomainSettings:CreateDomainAssociation' :: [SubDomainSetting]
subDomainSettings = forall a. Monoid a => a
Prelude.mempty
    }

-- | Sets the branch patterns for automatic subdomain creation.
createDomainAssociation_autoSubDomainCreationPatterns :: Lens.Lens' CreateDomainAssociation (Prelude.Maybe [Prelude.Text])
createDomainAssociation_autoSubDomainCreationPatterns :: Lens' CreateDomainAssociation (Maybe [Text])
createDomainAssociation_autoSubDomainCreationPatterns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainAssociation' {Maybe [Text]
autoSubDomainCreationPatterns :: Maybe [Text]
$sel:autoSubDomainCreationPatterns:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe [Text]
autoSubDomainCreationPatterns} -> Maybe [Text]
autoSubDomainCreationPatterns) (\s :: CreateDomainAssociation
s@CreateDomainAssociation' {} Maybe [Text]
a -> CreateDomainAssociation
s {$sel:autoSubDomainCreationPatterns:CreateDomainAssociation' :: Maybe [Text]
autoSubDomainCreationPatterns = Maybe [Text]
a} :: CreateDomainAssociation) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The required AWS Identity and Access Management (IAM) service role for
-- the Amazon Resource Name (ARN) for automatically creating subdomains.
createDomainAssociation_autoSubDomainIAMRole :: Lens.Lens' CreateDomainAssociation (Prelude.Maybe Prelude.Text)
createDomainAssociation_autoSubDomainIAMRole :: Lens' CreateDomainAssociation (Maybe Text)
createDomainAssociation_autoSubDomainIAMRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainAssociation' {Maybe Text
autoSubDomainIAMRole :: Maybe Text
$sel:autoSubDomainIAMRole:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Text
autoSubDomainIAMRole} -> Maybe Text
autoSubDomainIAMRole) (\s :: CreateDomainAssociation
s@CreateDomainAssociation' {} Maybe Text
a -> CreateDomainAssociation
s {$sel:autoSubDomainIAMRole:CreateDomainAssociation' :: Maybe Text
autoSubDomainIAMRole = Maybe Text
a} :: CreateDomainAssociation)

-- | Enables the automated creation of subdomains for branches.
createDomainAssociation_enableAutoSubDomain :: Lens.Lens' CreateDomainAssociation (Prelude.Maybe Prelude.Bool)
createDomainAssociation_enableAutoSubDomain :: Lens' CreateDomainAssociation (Maybe Bool)
createDomainAssociation_enableAutoSubDomain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainAssociation' {Maybe Bool
enableAutoSubDomain :: Maybe Bool
$sel:enableAutoSubDomain:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Bool
enableAutoSubDomain} -> Maybe Bool
enableAutoSubDomain) (\s :: CreateDomainAssociation
s@CreateDomainAssociation' {} Maybe Bool
a -> CreateDomainAssociation
s {$sel:enableAutoSubDomain:CreateDomainAssociation' :: Maybe Bool
enableAutoSubDomain = Maybe Bool
a} :: CreateDomainAssociation)

-- | The unique ID for an Amplify app.
createDomainAssociation_appId :: Lens.Lens' CreateDomainAssociation Prelude.Text
createDomainAssociation_appId :: Lens' CreateDomainAssociation Text
createDomainAssociation_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainAssociation' {Text
appId :: Text
$sel:appId:CreateDomainAssociation' :: CreateDomainAssociation -> Text
appId} -> Text
appId) (\s :: CreateDomainAssociation
s@CreateDomainAssociation' {} Text
a -> CreateDomainAssociation
s {$sel:appId:CreateDomainAssociation' :: Text
appId = Text
a} :: CreateDomainAssociation)

-- | The domain name for the domain association.
createDomainAssociation_domainName :: Lens.Lens' CreateDomainAssociation Prelude.Text
createDomainAssociation_domainName :: Lens' CreateDomainAssociation Text
createDomainAssociation_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainAssociation' {Text
domainName :: Text
$sel:domainName:CreateDomainAssociation' :: CreateDomainAssociation -> Text
domainName} -> Text
domainName) (\s :: CreateDomainAssociation
s@CreateDomainAssociation' {} Text
a -> CreateDomainAssociation
s {$sel:domainName:CreateDomainAssociation' :: Text
domainName = Text
a} :: CreateDomainAssociation)

-- | The setting for the subdomain.
createDomainAssociation_subDomainSettings :: Lens.Lens' CreateDomainAssociation [SubDomainSetting]
createDomainAssociation_subDomainSettings :: Lens' CreateDomainAssociation [SubDomainSetting]
createDomainAssociation_subDomainSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainAssociation' {[SubDomainSetting]
subDomainSettings :: [SubDomainSetting]
$sel:subDomainSettings:CreateDomainAssociation' :: CreateDomainAssociation -> [SubDomainSetting]
subDomainSettings} -> [SubDomainSetting]
subDomainSettings) (\s :: CreateDomainAssociation
s@CreateDomainAssociation' {} [SubDomainSetting]
a -> CreateDomainAssociation
s {$sel:subDomainSettings:CreateDomainAssociation' :: [SubDomainSetting]
subDomainSettings = [SubDomainSetting]
a} :: CreateDomainAssociation) 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 Core.AWSRequest CreateDomainAssociation where
  type
    AWSResponse CreateDomainAssociation =
      CreateDomainAssociationResponse
  request :: (Service -> Service)
-> CreateDomainAssociation -> Request CreateDomainAssociation
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 CreateDomainAssociation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDomainAssociation)))
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 -> DomainAssociation -> CreateDomainAssociationResponse
CreateDomainAssociationResponse'
            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
"domainAssociation")
      )

instance Prelude.Hashable CreateDomainAssociation where
  hashWithSalt :: Int -> CreateDomainAssociation -> Int
hashWithSalt Int
_salt CreateDomainAssociation' {[SubDomainSetting]
Maybe Bool
Maybe [Text]
Maybe Text
Text
subDomainSettings :: [SubDomainSetting]
domainName :: Text
appId :: Text
enableAutoSubDomain :: Maybe Bool
autoSubDomainIAMRole :: Maybe Text
autoSubDomainCreationPatterns :: Maybe [Text]
$sel:subDomainSettings:CreateDomainAssociation' :: CreateDomainAssociation -> [SubDomainSetting]
$sel:domainName:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:appId:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:enableAutoSubDomain:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Bool
$sel:autoSubDomainIAMRole:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Text
$sel:autoSubDomainCreationPatterns:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
autoSubDomainCreationPatterns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
autoSubDomainIAMRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableAutoSubDomain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [SubDomainSetting]
subDomainSettings

instance Prelude.NFData CreateDomainAssociation where
  rnf :: CreateDomainAssociation -> ()
rnf CreateDomainAssociation' {[SubDomainSetting]
Maybe Bool
Maybe [Text]
Maybe Text
Text
subDomainSettings :: [SubDomainSetting]
domainName :: Text
appId :: Text
enableAutoSubDomain :: Maybe Bool
autoSubDomainIAMRole :: Maybe Text
autoSubDomainCreationPatterns :: Maybe [Text]
$sel:subDomainSettings:CreateDomainAssociation' :: CreateDomainAssociation -> [SubDomainSetting]
$sel:domainName:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:appId:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:enableAutoSubDomain:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Bool
$sel:autoSubDomainIAMRole:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Text
$sel:autoSubDomainCreationPatterns:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
autoSubDomainCreationPatterns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
autoSubDomainIAMRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableAutoSubDomain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [SubDomainSetting]
subDomainSettings

instance Data.ToHeaders CreateDomainAssociation where
  toHeaders :: CreateDomainAssociation -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateDomainAssociation where
  toJSON :: CreateDomainAssociation -> Value
toJSON CreateDomainAssociation' {[SubDomainSetting]
Maybe Bool
Maybe [Text]
Maybe Text
Text
subDomainSettings :: [SubDomainSetting]
domainName :: Text
appId :: Text
enableAutoSubDomain :: Maybe Bool
autoSubDomainIAMRole :: Maybe Text
autoSubDomainCreationPatterns :: Maybe [Text]
$sel:subDomainSettings:CreateDomainAssociation' :: CreateDomainAssociation -> [SubDomainSetting]
$sel:domainName:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:appId:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:enableAutoSubDomain:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Bool
$sel:autoSubDomainIAMRole:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Text
$sel:autoSubDomainCreationPatterns:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"autoSubDomainCreationPatterns" 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]
autoSubDomainCreationPatterns,
            (Key
"autoSubDomainIAMRole" 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
autoSubDomainIAMRole,
            (Key
"enableAutoSubDomain" 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
enableAutoSubDomain,
            forall a. a -> Maybe a
Prelude.Just (Key
"domainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"subDomainSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [SubDomainSetting]
subDomainSettings)
          ]
      )

instance Data.ToPath CreateDomainAssociation where
  toPath :: CreateDomainAssociation -> ByteString
toPath CreateDomainAssociation' {[SubDomainSetting]
Maybe Bool
Maybe [Text]
Maybe Text
Text
subDomainSettings :: [SubDomainSetting]
domainName :: Text
appId :: Text
enableAutoSubDomain :: Maybe Bool
autoSubDomainIAMRole :: Maybe Text
autoSubDomainCreationPatterns :: Maybe [Text]
$sel:subDomainSettings:CreateDomainAssociation' :: CreateDomainAssociation -> [SubDomainSetting]
$sel:domainName:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:appId:CreateDomainAssociation' :: CreateDomainAssociation -> Text
$sel:enableAutoSubDomain:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Bool
$sel:autoSubDomainIAMRole:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe Text
$sel:autoSubDomainCreationPatterns:CreateDomainAssociation' :: CreateDomainAssociation -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/apps/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
appId, ByteString
"/domains"]

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

-- | The result structure for the create domain association request.
--
-- /See:/ 'newCreateDomainAssociationResponse' smart constructor.
data CreateDomainAssociationResponse = CreateDomainAssociationResponse'
  { -- | The response's http status code.
    CreateDomainAssociationResponse -> Int
httpStatus :: Prelude.Int,
    -- | Describes the structure of a domain association, which associates a
    -- custom domain with an Amplify app.
    CreateDomainAssociationResponse -> DomainAssociation
domainAssociation :: DomainAssociation
  }
  deriving (CreateDomainAssociationResponse
-> CreateDomainAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDomainAssociationResponse
-> CreateDomainAssociationResponse -> Bool
$c/= :: CreateDomainAssociationResponse
-> CreateDomainAssociationResponse -> Bool
== :: CreateDomainAssociationResponse
-> CreateDomainAssociationResponse -> Bool
$c== :: CreateDomainAssociationResponse
-> CreateDomainAssociationResponse -> Bool
Prelude.Eq, ReadPrec [CreateDomainAssociationResponse]
ReadPrec CreateDomainAssociationResponse
Int -> ReadS CreateDomainAssociationResponse
ReadS [CreateDomainAssociationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDomainAssociationResponse]
$creadListPrec :: ReadPrec [CreateDomainAssociationResponse]
readPrec :: ReadPrec CreateDomainAssociationResponse
$creadPrec :: ReadPrec CreateDomainAssociationResponse
readList :: ReadS [CreateDomainAssociationResponse]
$creadList :: ReadS [CreateDomainAssociationResponse]
readsPrec :: Int -> ReadS CreateDomainAssociationResponse
$creadsPrec :: Int -> ReadS CreateDomainAssociationResponse
Prelude.Read, Int -> CreateDomainAssociationResponse -> ShowS
[CreateDomainAssociationResponse] -> ShowS
CreateDomainAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDomainAssociationResponse] -> ShowS
$cshowList :: [CreateDomainAssociationResponse] -> ShowS
show :: CreateDomainAssociationResponse -> String
$cshow :: CreateDomainAssociationResponse -> String
showsPrec :: Int -> CreateDomainAssociationResponse -> ShowS
$cshowsPrec :: Int -> CreateDomainAssociationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDomainAssociationResponse x
-> CreateDomainAssociationResponse
forall x.
CreateDomainAssociationResponse
-> Rep CreateDomainAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDomainAssociationResponse x
-> CreateDomainAssociationResponse
$cfrom :: forall x.
CreateDomainAssociationResponse
-> Rep CreateDomainAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDomainAssociationResponse' 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', 'createDomainAssociationResponse_httpStatus' - The response's http status code.
--
-- 'domainAssociation', 'createDomainAssociationResponse_domainAssociation' - Describes the structure of a domain association, which associates a
-- custom domain with an Amplify app.
newCreateDomainAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'domainAssociation'
  DomainAssociation ->
  CreateDomainAssociationResponse
newCreateDomainAssociationResponse :: Int -> DomainAssociation -> CreateDomainAssociationResponse
newCreateDomainAssociationResponse
  Int
pHttpStatus_
  DomainAssociation
pDomainAssociation_ =
    CreateDomainAssociationResponse'
      { $sel:httpStatus:CreateDomainAssociationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:domainAssociation:CreateDomainAssociationResponse' :: DomainAssociation
domainAssociation = DomainAssociation
pDomainAssociation_
      }

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

-- | Describes the structure of a domain association, which associates a
-- custom domain with an Amplify app.
createDomainAssociationResponse_domainAssociation :: Lens.Lens' CreateDomainAssociationResponse DomainAssociation
createDomainAssociationResponse_domainAssociation :: Lens' CreateDomainAssociationResponse DomainAssociation
createDomainAssociationResponse_domainAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainAssociationResponse' {DomainAssociation
domainAssociation :: DomainAssociation
$sel:domainAssociation:CreateDomainAssociationResponse' :: CreateDomainAssociationResponse -> DomainAssociation
domainAssociation} -> DomainAssociation
domainAssociation) (\s :: CreateDomainAssociationResponse
s@CreateDomainAssociationResponse' {} DomainAssociation
a -> CreateDomainAssociationResponse
s {$sel:domainAssociation:CreateDomainAssociationResponse' :: DomainAssociation
domainAssociation = DomainAssociation
a} :: CreateDomainAssociationResponse)

instance
  Prelude.NFData
    CreateDomainAssociationResponse
  where
  rnf :: CreateDomainAssociationResponse -> ()
rnf CreateDomainAssociationResponse' {Int
DomainAssociation
domainAssociation :: DomainAssociation
httpStatus :: Int
$sel:domainAssociation:CreateDomainAssociationResponse' :: CreateDomainAssociationResponse -> DomainAssociation
$sel:httpStatus:CreateDomainAssociationResponse' :: CreateDomainAssociationResponse -> 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 DomainAssociation
domainAssociation