{-# 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.IoT.CreateDomainConfiguration
-- 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 domain configuration.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateDomainConfiguration>
-- action.
module Amazonka.IoT.CreateDomainConfiguration
  ( -- * Creating a Request
    CreateDomainConfiguration (..),
    newCreateDomainConfiguration,

    -- * Request Lenses
    createDomainConfiguration_authorizerConfig,
    createDomainConfiguration_domainName,
    createDomainConfiguration_serverCertificateArns,
    createDomainConfiguration_serviceType,
    createDomainConfiguration_tags,
    createDomainConfiguration_validationCertificateArn,
    createDomainConfiguration_domainConfigurationName,

    -- * Destructuring the Response
    CreateDomainConfigurationResponse (..),
    newCreateDomainConfigurationResponse,

    -- * Response Lenses
    createDomainConfigurationResponse_domainConfigurationArn,
    createDomainConfigurationResponse_domainConfigurationName,
    createDomainConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateDomainConfiguration' smart constructor.
data CreateDomainConfiguration = CreateDomainConfiguration'
  { -- | An object that specifies the authorization service for a domain.
    CreateDomainConfiguration -> Maybe AuthorizerConfig
authorizerConfig :: Prelude.Maybe AuthorizerConfig,
    -- | The name of the domain.
    CreateDomainConfiguration -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text,
    -- | The ARNs of the certificates that IoT passes to the device during the
    -- TLS handshake. Currently you can specify only one certificate ARN. This
    -- value is not required for Amazon Web Services-managed domains.
    CreateDomainConfiguration -> Maybe [Text]
serverCertificateArns :: Prelude.Maybe [Prelude.Text],
    -- | The type of service delivered by the endpoint.
    --
    -- Amazon Web Services IoT Core currently supports only the @DATA@ service
    -- type.
    CreateDomainConfiguration -> Maybe ServiceType
serviceType :: Prelude.Maybe ServiceType,
    -- | Metadata which can be used to manage the domain configuration.
    --
    -- For URI Request parameters use format: ...key1=value1&key2=value2...
    --
    -- For the CLI command-line parameter use format: &&tags
    -- \"key1=value1&key2=value2...\"
    --
    -- For the cli-input-json file use format: \"tags\":
    -- \"key1=value1&key2=value2...\"
    CreateDomainConfiguration -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The certificate used to validate the server certificate and prove domain
    -- name ownership. This certificate must be signed by a public certificate
    -- authority. This value is not required for Amazon Web Services-managed
    -- domains.
    CreateDomainConfiguration -> Maybe Text
validationCertificateArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain configuration. This value must be unique to a
    -- region.
    CreateDomainConfiguration -> Text
domainConfigurationName :: Prelude.Text
  }
  deriving (CreateDomainConfiguration -> CreateDomainConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDomainConfiguration -> CreateDomainConfiguration -> Bool
$c/= :: CreateDomainConfiguration -> CreateDomainConfiguration -> Bool
== :: CreateDomainConfiguration -> CreateDomainConfiguration -> Bool
$c== :: CreateDomainConfiguration -> CreateDomainConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateDomainConfiguration]
ReadPrec CreateDomainConfiguration
Int -> ReadS CreateDomainConfiguration
ReadS [CreateDomainConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDomainConfiguration]
$creadListPrec :: ReadPrec [CreateDomainConfiguration]
readPrec :: ReadPrec CreateDomainConfiguration
$creadPrec :: ReadPrec CreateDomainConfiguration
readList :: ReadS [CreateDomainConfiguration]
$creadList :: ReadS [CreateDomainConfiguration]
readsPrec :: Int -> ReadS CreateDomainConfiguration
$creadsPrec :: Int -> ReadS CreateDomainConfiguration
Prelude.Read, Int -> CreateDomainConfiguration -> ShowS
[CreateDomainConfiguration] -> ShowS
CreateDomainConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDomainConfiguration] -> ShowS
$cshowList :: [CreateDomainConfiguration] -> ShowS
show :: CreateDomainConfiguration -> String
$cshow :: CreateDomainConfiguration -> String
showsPrec :: Int -> CreateDomainConfiguration -> ShowS
$cshowsPrec :: Int -> CreateDomainConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateDomainConfiguration x -> CreateDomainConfiguration
forall x.
CreateDomainConfiguration -> Rep CreateDomainConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDomainConfiguration x -> CreateDomainConfiguration
$cfrom :: forall x.
CreateDomainConfiguration -> Rep CreateDomainConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateDomainConfiguration' 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:
--
-- 'authorizerConfig', 'createDomainConfiguration_authorizerConfig' - An object that specifies the authorization service for a domain.
--
-- 'domainName', 'createDomainConfiguration_domainName' - The name of the domain.
--
-- 'serverCertificateArns', 'createDomainConfiguration_serverCertificateArns' - The ARNs of the certificates that IoT passes to the device during the
-- TLS handshake. Currently you can specify only one certificate ARN. This
-- value is not required for Amazon Web Services-managed domains.
--
-- 'serviceType', 'createDomainConfiguration_serviceType' - The type of service delivered by the endpoint.
--
-- Amazon Web Services IoT Core currently supports only the @DATA@ service
-- type.
--
-- 'tags', 'createDomainConfiguration_tags' - Metadata which can be used to manage the domain configuration.
--
-- For URI Request parameters use format: ...key1=value1&key2=value2...
--
-- For the CLI command-line parameter use format: &&tags
-- \"key1=value1&key2=value2...\"
--
-- For the cli-input-json file use format: \"tags\":
-- \"key1=value1&key2=value2...\"
--
-- 'validationCertificateArn', 'createDomainConfiguration_validationCertificateArn' - The certificate used to validate the server certificate and prove domain
-- name ownership. This certificate must be signed by a public certificate
-- authority. This value is not required for Amazon Web Services-managed
-- domains.
--
-- 'domainConfigurationName', 'createDomainConfiguration_domainConfigurationName' - The name of the domain configuration. This value must be unique to a
-- region.
newCreateDomainConfiguration ::
  -- | 'domainConfigurationName'
  Prelude.Text ->
  CreateDomainConfiguration
newCreateDomainConfiguration :: Text -> CreateDomainConfiguration
newCreateDomainConfiguration
  Text
pDomainConfigurationName_ =
    CreateDomainConfiguration'
      { $sel:authorizerConfig:CreateDomainConfiguration' :: Maybe AuthorizerConfig
authorizerConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:domainName:CreateDomainConfiguration' :: Maybe Text
domainName = forall a. Maybe a
Prelude.Nothing,
        $sel:serverCertificateArns:CreateDomainConfiguration' :: Maybe [Text]
serverCertificateArns = forall a. Maybe a
Prelude.Nothing,
        $sel:serviceType:CreateDomainConfiguration' :: Maybe ServiceType
serviceType = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDomainConfiguration' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:validationCertificateArn:CreateDomainConfiguration' :: Maybe Text
validationCertificateArn = forall a. Maybe a
Prelude.Nothing,
        $sel:domainConfigurationName:CreateDomainConfiguration' :: Text
domainConfigurationName =
          Text
pDomainConfigurationName_
      }

-- | An object that specifies the authorization service for a domain.
createDomainConfiguration_authorizerConfig :: Lens.Lens' CreateDomainConfiguration (Prelude.Maybe AuthorizerConfig)
createDomainConfiguration_authorizerConfig :: Lens' CreateDomainConfiguration (Maybe AuthorizerConfig)
createDomainConfiguration_authorizerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfiguration' {Maybe AuthorizerConfig
authorizerConfig :: Maybe AuthorizerConfig
$sel:authorizerConfig:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe AuthorizerConfig
authorizerConfig} -> Maybe AuthorizerConfig
authorizerConfig) (\s :: CreateDomainConfiguration
s@CreateDomainConfiguration' {} Maybe AuthorizerConfig
a -> CreateDomainConfiguration
s {$sel:authorizerConfig:CreateDomainConfiguration' :: Maybe AuthorizerConfig
authorizerConfig = Maybe AuthorizerConfig
a} :: CreateDomainConfiguration)

-- | The name of the domain.
createDomainConfiguration_domainName :: Lens.Lens' CreateDomainConfiguration (Prelude.Maybe Prelude.Text)
createDomainConfiguration_domainName :: Lens' CreateDomainConfiguration (Maybe Text)
createDomainConfiguration_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfiguration' {Maybe Text
domainName :: Maybe Text
$sel:domainName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
domainName} -> Maybe Text
domainName) (\s :: CreateDomainConfiguration
s@CreateDomainConfiguration' {} Maybe Text
a -> CreateDomainConfiguration
s {$sel:domainName:CreateDomainConfiguration' :: Maybe Text
domainName = Maybe Text
a} :: CreateDomainConfiguration)

-- | The ARNs of the certificates that IoT passes to the device during the
-- TLS handshake. Currently you can specify only one certificate ARN. This
-- value is not required for Amazon Web Services-managed domains.
createDomainConfiguration_serverCertificateArns :: Lens.Lens' CreateDomainConfiguration (Prelude.Maybe [Prelude.Text])
createDomainConfiguration_serverCertificateArns :: Lens' CreateDomainConfiguration (Maybe [Text])
createDomainConfiguration_serverCertificateArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfiguration' {Maybe [Text]
serverCertificateArns :: Maybe [Text]
$sel:serverCertificateArns:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Text]
serverCertificateArns} -> Maybe [Text]
serverCertificateArns) (\s :: CreateDomainConfiguration
s@CreateDomainConfiguration' {} Maybe [Text]
a -> CreateDomainConfiguration
s {$sel:serverCertificateArns:CreateDomainConfiguration' :: Maybe [Text]
serverCertificateArns = Maybe [Text]
a} :: CreateDomainConfiguration) 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 type of service delivered by the endpoint.
--
-- Amazon Web Services IoT Core currently supports only the @DATA@ service
-- type.
createDomainConfiguration_serviceType :: Lens.Lens' CreateDomainConfiguration (Prelude.Maybe ServiceType)
createDomainConfiguration_serviceType :: Lens' CreateDomainConfiguration (Maybe ServiceType)
createDomainConfiguration_serviceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfiguration' {Maybe ServiceType
serviceType :: Maybe ServiceType
$sel:serviceType:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe ServiceType
serviceType} -> Maybe ServiceType
serviceType) (\s :: CreateDomainConfiguration
s@CreateDomainConfiguration' {} Maybe ServiceType
a -> CreateDomainConfiguration
s {$sel:serviceType:CreateDomainConfiguration' :: Maybe ServiceType
serviceType = Maybe ServiceType
a} :: CreateDomainConfiguration)

-- | Metadata which can be used to manage the domain configuration.
--
-- For URI Request parameters use format: ...key1=value1&key2=value2...
--
-- For the CLI command-line parameter use format: &&tags
-- \"key1=value1&key2=value2...\"
--
-- For the cli-input-json file use format: \"tags\":
-- \"key1=value1&key2=value2...\"
createDomainConfiguration_tags :: Lens.Lens' CreateDomainConfiguration (Prelude.Maybe [Tag])
createDomainConfiguration_tags :: Lens' CreateDomainConfiguration (Maybe [Tag])
createDomainConfiguration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfiguration' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDomainConfiguration
s@CreateDomainConfiguration' {} Maybe [Tag]
a -> CreateDomainConfiguration
s {$sel:tags:CreateDomainConfiguration' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDomainConfiguration) 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 certificate used to validate the server certificate and prove domain
-- name ownership. This certificate must be signed by a public certificate
-- authority. This value is not required for Amazon Web Services-managed
-- domains.
createDomainConfiguration_validationCertificateArn :: Lens.Lens' CreateDomainConfiguration (Prelude.Maybe Prelude.Text)
createDomainConfiguration_validationCertificateArn :: Lens' CreateDomainConfiguration (Maybe Text)
createDomainConfiguration_validationCertificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfiguration' {Maybe Text
validationCertificateArn :: Maybe Text
$sel:validationCertificateArn:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
validationCertificateArn} -> Maybe Text
validationCertificateArn) (\s :: CreateDomainConfiguration
s@CreateDomainConfiguration' {} Maybe Text
a -> CreateDomainConfiguration
s {$sel:validationCertificateArn:CreateDomainConfiguration' :: Maybe Text
validationCertificateArn = Maybe Text
a} :: CreateDomainConfiguration)

-- | The name of the domain configuration. This value must be unique to a
-- region.
createDomainConfiguration_domainConfigurationName :: Lens.Lens' CreateDomainConfiguration Prelude.Text
createDomainConfiguration_domainConfigurationName :: Lens' CreateDomainConfiguration Text
createDomainConfiguration_domainConfigurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfiguration' {Text
domainConfigurationName :: Text
$sel:domainConfigurationName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Text
domainConfigurationName} -> Text
domainConfigurationName) (\s :: CreateDomainConfiguration
s@CreateDomainConfiguration' {} Text
a -> CreateDomainConfiguration
s {$sel:domainConfigurationName:CreateDomainConfiguration' :: Text
domainConfigurationName = Text
a} :: CreateDomainConfiguration)

instance Core.AWSRequest CreateDomainConfiguration where
  type
    AWSResponse CreateDomainConfiguration =
      CreateDomainConfigurationResponse
  request :: (Service -> Service)
-> CreateDomainConfiguration -> Request CreateDomainConfiguration
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 CreateDomainConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDomainConfiguration)))
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
-> Maybe Text -> Int -> CreateDomainConfigurationResponse
CreateDomainConfigurationResponse'
            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
"domainConfigurationArn")
            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
"domainConfigurationName")
            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))
      )

instance Prelude.Hashable CreateDomainConfiguration where
  hashWithSalt :: Int -> CreateDomainConfiguration -> Int
hashWithSalt Int
_salt CreateDomainConfiguration' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe AuthorizerConfig
Maybe ServiceType
Text
domainConfigurationName :: Text
validationCertificateArn :: Maybe Text
tags :: Maybe [Tag]
serviceType :: Maybe ServiceType
serverCertificateArns :: Maybe [Text]
domainName :: Maybe Text
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Text
$sel:validationCertificateArn:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:tags:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Tag]
$sel:serviceType:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe ServiceType
$sel:serverCertificateArns:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Text]
$sel:domainName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:authorizerConfig:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuthorizerConfig
authorizerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
serverCertificateArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServiceType
serviceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
validationCertificateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainConfigurationName

instance Prelude.NFData CreateDomainConfiguration where
  rnf :: CreateDomainConfiguration -> ()
rnf CreateDomainConfiguration' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe AuthorizerConfig
Maybe ServiceType
Text
domainConfigurationName :: Text
validationCertificateArn :: Maybe Text
tags :: Maybe [Tag]
serviceType :: Maybe ServiceType
serverCertificateArns :: Maybe [Text]
domainName :: Maybe Text
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Text
$sel:validationCertificateArn:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:tags:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Tag]
$sel:serviceType:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe ServiceType
$sel:serverCertificateArns:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Text]
$sel:domainName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:authorizerConfig:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthorizerConfig
authorizerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
serverCertificateArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceType
serviceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
validationCertificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainConfigurationName

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

instance Data.ToJSON CreateDomainConfiguration where
  toJSON :: CreateDomainConfiguration -> Value
toJSON CreateDomainConfiguration' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe AuthorizerConfig
Maybe ServiceType
Text
domainConfigurationName :: Text
validationCertificateArn :: Maybe Text
tags :: Maybe [Tag]
serviceType :: Maybe ServiceType
serverCertificateArns :: Maybe [Text]
domainName :: Maybe Text
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Text
$sel:validationCertificateArn:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:tags:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Tag]
$sel:serviceType:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe ServiceType
$sel:serverCertificateArns:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Text]
$sel:domainName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:authorizerConfig:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"authorizerConfig" 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 AuthorizerConfig
authorizerConfig,
            (Key
"domainName" 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
domainName,
            (Key
"serverCertificateArns" 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]
serverCertificateArns,
            (Key
"serviceType" 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 ServiceType
serviceType,
            (Key
"tags" 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 [Tag]
tags,
            (Key
"validationCertificateArn" 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
validationCertificateArn
          ]
      )

instance Data.ToPath CreateDomainConfiguration where
  toPath :: CreateDomainConfiguration -> ByteString
toPath CreateDomainConfiguration' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe AuthorizerConfig
Maybe ServiceType
Text
domainConfigurationName :: Text
validationCertificateArn :: Maybe Text
tags :: Maybe [Tag]
serviceType :: Maybe ServiceType
serverCertificateArns :: Maybe [Text]
domainName :: Maybe Text
authorizerConfig :: Maybe AuthorizerConfig
$sel:domainConfigurationName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Text
$sel:validationCertificateArn:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:tags:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Tag]
$sel:serviceType:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe ServiceType
$sel:serverCertificateArns:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe [Text]
$sel:domainName:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe Text
$sel:authorizerConfig:CreateDomainConfiguration' :: CreateDomainConfiguration -> Maybe AuthorizerConfig
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domainConfigurations/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainConfigurationName
      ]

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

-- | /See:/ 'newCreateDomainConfigurationResponse' smart constructor.
data CreateDomainConfigurationResponse = CreateDomainConfigurationResponse'
  { -- | The ARN of the domain configuration.
    CreateDomainConfigurationResponse -> Maybe Text
domainConfigurationArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the domain configuration.
    CreateDomainConfigurationResponse -> Maybe Text
domainConfigurationName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDomainConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDomainConfigurationResponse
-> CreateDomainConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDomainConfigurationResponse
-> CreateDomainConfigurationResponse -> Bool
$c/= :: CreateDomainConfigurationResponse
-> CreateDomainConfigurationResponse -> Bool
== :: CreateDomainConfigurationResponse
-> CreateDomainConfigurationResponse -> Bool
$c== :: CreateDomainConfigurationResponse
-> CreateDomainConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [CreateDomainConfigurationResponse]
ReadPrec CreateDomainConfigurationResponse
Int -> ReadS CreateDomainConfigurationResponse
ReadS [CreateDomainConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDomainConfigurationResponse]
$creadListPrec :: ReadPrec [CreateDomainConfigurationResponse]
readPrec :: ReadPrec CreateDomainConfigurationResponse
$creadPrec :: ReadPrec CreateDomainConfigurationResponse
readList :: ReadS [CreateDomainConfigurationResponse]
$creadList :: ReadS [CreateDomainConfigurationResponse]
readsPrec :: Int -> ReadS CreateDomainConfigurationResponse
$creadsPrec :: Int -> ReadS CreateDomainConfigurationResponse
Prelude.Read, Int -> CreateDomainConfigurationResponse -> ShowS
[CreateDomainConfigurationResponse] -> ShowS
CreateDomainConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDomainConfigurationResponse] -> ShowS
$cshowList :: [CreateDomainConfigurationResponse] -> ShowS
show :: CreateDomainConfigurationResponse -> String
$cshow :: CreateDomainConfigurationResponse -> String
showsPrec :: Int -> CreateDomainConfigurationResponse -> ShowS
$cshowsPrec :: Int -> CreateDomainConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDomainConfigurationResponse x
-> CreateDomainConfigurationResponse
forall x.
CreateDomainConfigurationResponse
-> Rep CreateDomainConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDomainConfigurationResponse x
-> CreateDomainConfigurationResponse
$cfrom :: forall x.
CreateDomainConfigurationResponse
-> Rep CreateDomainConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDomainConfigurationResponse' 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:
--
-- 'domainConfigurationArn', 'createDomainConfigurationResponse_domainConfigurationArn' - The ARN of the domain configuration.
--
-- 'domainConfigurationName', 'createDomainConfigurationResponse_domainConfigurationName' - The name of the domain configuration.
--
-- 'httpStatus', 'createDomainConfigurationResponse_httpStatus' - The response's http status code.
newCreateDomainConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDomainConfigurationResponse
newCreateDomainConfigurationResponse :: Int -> CreateDomainConfigurationResponse
newCreateDomainConfigurationResponse Int
pHttpStatus_ =
  CreateDomainConfigurationResponse'
    { $sel:domainConfigurationArn:CreateDomainConfigurationResponse' :: Maybe Text
domainConfigurationArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainConfigurationName:CreateDomainConfigurationResponse' :: Maybe Text
domainConfigurationName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDomainConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the domain configuration.
createDomainConfigurationResponse_domainConfigurationArn :: Lens.Lens' CreateDomainConfigurationResponse (Prelude.Maybe Prelude.Text)
createDomainConfigurationResponse_domainConfigurationArn :: Lens' CreateDomainConfigurationResponse (Maybe Text)
createDomainConfigurationResponse_domainConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfigurationResponse' {Maybe Text
domainConfigurationArn :: Maybe Text
$sel:domainConfigurationArn:CreateDomainConfigurationResponse' :: CreateDomainConfigurationResponse -> Maybe Text
domainConfigurationArn} -> Maybe Text
domainConfigurationArn) (\s :: CreateDomainConfigurationResponse
s@CreateDomainConfigurationResponse' {} Maybe Text
a -> CreateDomainConfigurationResponse
s {$sel:domainConfigurationArn:CreateDomainConfigurationResponse' :: Maybe Text
domainConfigurationArn = Maybe Text
a} :: CreateDomainConfigurationResponse)

-- | The name of the domain configuration.
createDomainConfigurationResponse_domainConfigurationName :: Lens.Lens' CreateDomainConfigurationResponse (Prelude.Maybe Prelude.Text)
createDomainConfigurationResponse_domainConfigurationName :: Lens' CreateDomainConfigurationResponse (Maybe Text)
createDomainConfigurationResponse_domainConfigurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDomainConfigurationResponse' {Maybe Text
domainConfigurationName :: Maybe Text
$sel:domainConfigurationName:CreateDomainConfigurationResponse' :: CreateDomainConfigurationResponse -> Maybe Text
domainConfigurationName} -> Maybe Text
domainConfigurationName) (\s :: CreateDomainConfigurationResponse
s@CreateDomainConfigurationResponse' {} Maybe Text
a -> CreateDomainConfigurationResponse
s {$sel:domainConfigurationName:CreateDomainConfigurationResponse' :: Maybe Text
domainConfigurationName = Maybe Text
a} :: CreateDomainConfigurationResponse)

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

instance
  Prelude.NFData
    CreateDomainConfigurationResponse
  where
  rnf :: CreateDomainConfigurationResponse -> ()
rnf CreateDomainConfigurationResponse' {Int
Maybe Text
httpStatus :: Int
domainConfigurationName :: Maybe Text
domainConfigurationArn :: Maybe Text
$sel:httpStatus:CreateDomainConfigurationResponse' :: CreateDomainConfigurationResponse -> Int
$sel:domainConfigurationName:CreateDomainConfigurationResponse' :: CreateDomainConfigurationResponse -> Maybe Text
$sel:domainConfigurationArn:CreateDomainConfigurationResponse' :: CreateDomainConfigurationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainConfigurationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainConfigurationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus