{-# 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.Route53AutoNaming.CreateService
-- 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 service. This action defines the configuration for the
-- following entities:
--
-- -   For public and private DNS namespaces, one of the following
--     combinations of DNS records in Amazon Route 53:
--
--     -   @A@
--
--     -   @AAAA@
--
--     -   @A@ and @AAAA@
--
--     -   @SRV@
--
--     -   @CNAME@
--
-- -   Optionally, a health check
--
-- After you create the service, you can submit a
-- <https://docs.aws.amazon.com/cloud-map/latest/api/API_RegisterInstance.html RegisterInstance>
-- request, and Cloud Map uses the values in the configuration to create
-- the specified entities.
--
-- For the current quota on the number of instances that you can register
-- using the same namespace and using the same service, see
-- <https://docs.aws.amazon.com/cloud-map/latest/dg/cloud-map-limits.html Cloud Map quotas>
-- in the /Cloud Map Developer Guide/.
module Amazonka.Route53AutoNaming.CreateService
  ( -- * Creating a Request
    CreateService (..),
    newCreateService,

    -- * Request Lenses
    createService_creatorRequestId,
    createService_description,
    createService_dnsConfig,
    createService_healthCheckConfig,
    createService_healthCheckCustomConfig,
    createService_namespaceId,
    createService_tags,
    createService_type,
    createService_name,

    -- * Destructuring the Response
    CreateServiceResponse (..),
    newCreateServiceResponse,

    -- * Response Lenses
    createServiceResponse_service,
    createServiceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateService' smart constructor.
data CreateService = CreateService'
  { -- | A unique string that identifies the request and that allows failed
    -- @CreateService@ requests to be retried without the risk of running the
    -- operation twice. @CreatorRequestId@ can be any unique string (for
    -- example, a date\/timestamp).
    CreateService -> Maybe Text
creatorRequestId :: Prelude.Maybe Prelude.Text,
    -- | A description for the service.
    CreateService -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A complex type that contains information about the Amazon Route 53
    -- records that you want Cloud Map to create when you register an instance.
    CreateService -> Maybe DnsConfig
dnsConfig :: Prelude.Maybe DnsConfig,
    -- | /Public DNS and HTTP namespaces only./ A complex type that contains
    -- settings for an optional Route 53 health check. If you specify settings
    -- for a health check, Cloud Map associates the health check with all the
    -- Route 53 DNS records that you specify in @DnsConfig@.
    --
    -- If you specify a health check configuration, you can specify either
    -- @HealthCheckCustomConfig@ or @HealthCheckConfig@ but not both.
    --
    -- For information about the charges for health checks, see
    -- <http://aws.amazon.com/cloud-map/pricing/ Cloud Map Pricing>.
    CreateService -> Maybe HealthCheckConfig
healthCheckConfig :: Prelude.Maybe HealthCheckConfig,
    -- | A complex type that contains information about an optional custom health
    -- check.
    --
    -- If you specify a health check configuration, you can specify either
    -- @HealthCheckCustomConfig@ or @HealthCheckConfig@ but not both.
    --
    -- You can\'t add, update, or delete a @HealthCheckCustomConfig@
    -- configuration from an existing service.
    CreateService -> Maybe HealthCheckCustomConfig
healthCheckCustomConfig :: Prelude.Maybe HealthCheckCustomConfig,
    -- | The ID of the namespace that you want to use to create the service. The
    -- namespace ID must be specified, but it can be specified either here or
    -- in the @DnsConfig@ object.
    CreateService -> Maybe Text
namespaceId :: Prelude.Maybe Prelude.Text,
    -- | The tags to add to the service. Each tag consists of a key and an
    -- optional value that you define. Tags keys can be up to 128 characters in
    -- length, and tag values can be up to 256 characters in length.
    CreateService -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | If present, specifies that the service instances are only discoverable
    -- using the @DiscoverInstances@ API operation. No DNS records is
    -- registered for the service instances. The only valid value is @HTTP@.
    CreateService -> Maybe ServiceTypeOption
type' :: Prelude.Maybe ServiceTypeOption,
    -- | The name that you want to assign to the service.
    --
    -- Do not include sensitive information in the name if the namespace is
    -- discoverable by public DNS queries.
    --
    -- If you want Cloud Map to create an @SRV@ record when you register an
    -- instance and you\'re using a system that requires a specific @SRV@
    -- format, such as <http://www.haproxy.org/ HAProxy>, specify the following
    -- for @Name@:
    --
    -- -   Start the name with an underscore (_), such as @_exampleservice@.
    --
    -- -   End the name with /._protocol/, such as @._tcp@.
    --
    -- When you register an instance, Cloud Map creates an @SRV@ record and
    -- assigns a name to the record by concatenating the service name and the
    -- namespace name (for example,
    --
    -- @_exampleservice._tcp.example.com@).
    --
    -- For services that are accessible by DNS queries, you can\'t create
    -- multiple services with names that differ only by case (such as EXAMPLE
    -- and example). Otherwise, these services have the same DNS name and
    -- can\'t be distinguished. However, if you use a namespace that\'s only
    -- accessible by API calls, then you can create services that with names
    -- that differ only by case.
    CreateService -> Text
name :: Prelude.Text
  }
  deriving (CreateService -> CreateService -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateService -> CreateService -> Bool
$c/= :: CreateService -> CreateService -> Bool
== :: CreateService -> CreateService -> Bool
$c== :: CreateService -> CreateService -> Bool
Prelude.Eq, ReadPrec [CreateService]
ReadPrec CreateService
Int -> ReadS CreateService
ReadS [CreateService]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateService]
$creadListPrec :: ReadPrec [CreateService]
readPrec :: ReadPrec CreateService
$creadPrec :: ReadPrec CreateService
readList :: ReadS [CreateService]
$creadList :: ReadS [CreateService]
readsPrec :: Int -> ReadS CreateService
$creadsPrec :: Int -> ReadS CreateService
Prelude.Read, Int -> CreateService -> ShowS
[CreateService] -> ShowS
CreateService -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateService] -> ShowS
$cshowList :: [CreateService] -> ShowS
show :: CreateService -> String
$cshow :: CreateService -> String
showsPrec :: Int -> CreateService -> ShowS
$cshowsPrec :: Int -> CreateService -> ShowS
Prelude.Show, forall x. Rep CreateService x -> CreateService
forall x. CreateService -> Rep CreateService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateService x -> CreateService
$cfrom :: forall x. CreateService -> Rep CreateService x
Prelude.Generic)

-- |
-- Create a value of 'CreateService' 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:
--
-- 'creatorRequestId', 'createService_creatorRequestId' - A unique string that identifies the request and that allows failed
-- @CreateService@ requests to be retried without the risk of running the
-- operation twice. @CreatorRequestId@ can be any unique string (for
-- example, a date\/timestamp).
--
-- 'description', 'createService_description' - A description for the service.
--
-- 'dnsConfig', 'createService_dnsConfig' - A complex type that contains information about the Amazon Route 53
-- records that you want Cloud Map to create when you register an instance.
--
-- 'healthCheckConfig', 'createService_healthCheckConfig' - /Public DNS and HTTP namespaces only./ A complex type that contains
-- settings for an optional Route 53 health check. If you specify settings
-- for a health check, Cloud Map associates the health check with all the
-- Route 53 DNS records that you specify in @DnsConfig@.
--
-- If you specify a health check configuration, you can specify either
-- @HealthCheckCustomConfig@ or @HealthCheckConfig@ but not both.
--
-- For information about the charges for health checks, see
-- <http://aws.amazon.com/cloud-map/pricing/ Cloud Map Pricing>.
--
-- 'healthCheckCustomConfig', 'createService_healthCheckCustomConfig' - A complex type that contains information about an optional custom health
-- check.
--
-- If you specify a health check configuration, you can specify either
-- @HealthCheckCustomConfig@ or @HealthCheckConfig@ but not both.
--
-- You can\'t add, update, or delete a @HealthCheckCustomConfig@
-- configuration from an existing service.
--
-- 'namespaceId', 'createService_namespaceId' - The ID of the namespace that you want to use to create the service. The
-- namespace ID must be specified, but it can be specified either here or
-- in the @DnsConfig@ object.
--
-- 'tags', 'createService_tags' - The tags to add to the service. Each tag consists of a key and an
-- optional value that you define. Tags keys can be up to 128 characters in
-- length, and tag values can be up to 256 characters in length.
--
-- 'type'', 'createService_type' - If present, specifies that the service instances are only discoverable
-- using the @DiscoverInstances@ API operation. No DNS records is
-- registered for the service instances. The only valid value is @HTTP@.
--
-- 'name', 'createService_name' - The name that you want to assign to the service.
--
-- Do not include sensitive information in the name if the namespace is
-- discoverable by public DNS queries.
--
-- If you want Cloud Map to create an @SRV@ record when you register an
-- instance and you\'re using a system that requires a specific @SRV@
-- format, such as <http://www.haproxy.org/ HAProxy>, specify the following
-- for @Name@:
--
-- -   Start the name with an underscore (_), such as @_exampleservice@.
--
-- -   End the name with /._protocol/, such as @._tcp@.
--
-- When you register an instance, Cloud Map creates an @SRV@ record and
-- assigns a name to the record by concatenating the service name and the
-- namespace name (for example,
--
-- @_exampleservice._tcp.example.com@).
--
-- For services that are accessible by DNS queries, you can\'t create
-- multiple services with names that differ only by case (such as EXAMPLE
-- and example). Otherwise, these services have the same DNS name and
-- can\'t be distinguished. However, if you use a namespace that\'s only
-- accessible by API calls, then you can create services that with names
-- that differ only by case.
newCreateService ::
  -- | 'name'
  Prelude.Text ->
  CreateService
newCreateService :: Text -> CreateService
newCreateService Text
pName_ =
  CreateService'
    { $sel:creatorRequestId:CreateService' :: Maybe Text
creatorRequestId = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateService' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dnsConfig:CreateService' :: Maybe DnsConfig
dnsConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:healthCheckConfig:CreateService' :: Maybe HealthCheckConfig
healthCheckConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:healthCheckCustomConfig:CreateService' :: Maybe HealthCheckCustomConfig
healthCheckCustomConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:namespaceId:CreateService' :: Maybe Text
namespaceId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateService' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':CreateService' :: Maybe ServiceTypeOption
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateService' :: Text
name = Text
pName_
    }

-- | A unique string that identifies the request and that allows failed
-- @CreateService@ requests to be retried without the risk of running the
-- operation twice. @CreatorRequestId@ can be any unique string (for
-- example, a date\/timestamp).
createService_creatorRequestId :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_creatorRequestId :: Lens' CreateService (Maybe Text)
createService_creatorRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe Text
creatorRequestId :: Maybe Text
$sel:creatorRequestId:CreateService' :: CreateService -> Maybe Text
creatorRequestId} -> Maybe Text
creatorRequestId) (\s :: CreateService
s@CreateService' {} Maybe Text
a -> CreateService
s {$sel:creatorRequestId:CreateService' :: Maybe Text
creatorRequestId = Maybe Text
a} :: CreateService)

-- | A description for the service.
createService_description :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_description :: Lens' CreateService (Maybe Text)
createService_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe Text
description :: Maybe Text
$sel:description:CreateService' :: CreateService -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateService
s@CreateService' {} Maybe Text
a -> CreateService
s {$sel:description:CreateService' :: Maybe Text
description = Maybe Text
a} :: CreateService)

-- | A complex type that contains information about the Amazon Route 53
-- records that you want Cloud Map to create when you register an instance.
createService_dnsConfig :: Lens.Lens' CreateService (Prelude.Maybe DnsConfig)
createService_dnsConfig :: Lens' CreateService (Maybe DnsConfig)
createService_dnsConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe DnsConfig
dnsConfig :: Maybe DnsConfig
$sel:dnsConfig:CreateService' :: CreateService -> Maybe DnsConfig
dnsConfig} -> Maybe DnsConfig
dnsConfig) (\s :: CreateService
s@CreateService' {} Maybe DnsConfig
a -> CreateService
s {$sel:dnsConfig:CreateService' :: Maybe DnsConfig
dnsConfig = Maybe DnsConfig
a} :: CreateService)

-- | /Public DNS and HTTP namespaces only./ A complex type that contains
-- settings for an optional Route 53 health check. If you specify settings
-- for a health check, Cloud Map associates the health check with all the
-- Route 53 DNS records that you specify in @DnsConfig@.
--
-- If you specify a health check configuration, you can specify either
-- @HealthCheckCustomConfig@ or @HealthCheckConfig@ but not both.
--
-- For information about the charges for health checks, see
-- <http://aws.amazon.com/cloud-map/pricing/ Cloud Map Pricing>.
createService_healthCheckConfig :: Lens.Lens' CreateService (Prelude.Maybe HealthCheckConfig)
createService_healthCheckConfig :: Lens' CreateService (Maybe HealthCheckConfig)
createService_healthCheckConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe HealthCheckConfig
healthCheckConfig :: Maybe HealthCheckConfig
$sel:healthCheckConfig:CreateService' :: CreateService -> Maybe HealthCheckConfig
healthCheckConfig} -> Maybe HealthCheckConfig
healthCheckConfig) (\s :: CreateService
s@CreateService' {} Maybe HealthCheckConfig
a -> CreateService
s {$sel:healthCheckConfig:CreateService' :: Maybe HealthCheckConfig
healthCheckConfig = Maybe HealthCheckConfig
a} :: CreateService)

-- | A complex type that contains information about an optional custom health
-- check.
--
-- If you specify a health check configuration, you can specify either
-- @HealthCheckCustomConfig@ or @HealthCheckConfig@ but not both.
--
-- You can\'t add, update, or delete a @HealthCheckCustomConfig@
-- configuration from an existing service.
createService_healthCheckCustomConfig :: Lens.Lens' CreateService (Prelude.Maybe HealthCheckCustomConfig)
createService_healthCheckCustomConfig :: Lens' CreateService (Maybe HealthCheckCustomConfig)
createService_healthCheckCustomConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe HealthCheckCustomConfig
healthCheckCustomConfig :: Maybe HealthCheckCustomConfig
$sel:healthCheckCustomConfig:CreateService' :: CreateService -> Maybe HealthCheckCustomConfig
healthCheckCustomConfig} -> Maybe HealthCheckCustomConfig
healthCheckCustomConfig) (\s :: CreateService
s@CreateService' {} Maybe HealthCheckCustomConfig
a -> CreateService
s {$sel:healthCheckCustomConfig:CreateService' :: Maybe HealthCheckCustomConfig
healthCheckCustomConfig = Maybe HealthCheckCustomConfig
a} :: CreateService)

-- | The ID of the namespace that you want to use to create the service. The
-- namespace ID must be specified, but it can be specified either here or
-- in the @DnsConfig@ object.
createService_namespaceId :: Lens.Lens' CreateService (Prelude.Maybe Prelude.Text)
createService_namespaceId :: Lens' CreateService (Maybe Text)
createService_namespaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe Text
namespaceId :: Maybe Text
$sel:namespaceId:CreateService' :: CreateService -> Maybe Text
namespaceId} -> Maybe Text
namespaceId) (\s :: CreateService
s@CreateService' {} Maybe Text
a -> CreateService
s {$sel:namespaceId:CreateService' :: Maybe Text
namespaceId = Maybe Text
a} :: CreateService)

-- | The tags to add to the service. Each tag consists of a key and an
-- optional value that you define. Tags keys can be up to 128 characters in
-- length, and tag values can be up to 256 characters in length.
createService_tags :: Lens.Lens' CreateService (Prelude.Maybe [Tag])
createService_tags :: Lens' CreateService (Maybe [Tag])
createService_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateService
s@CreateService' {} Maybe [Tag]
a -> CreateService
s {$sel:tags:CreateService' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateService) 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

-- | If present, specifies that the service instances are only discoverable
-- using the @DiscoverInstances@ API operation. No DNS records is
-- registered for the service instances. The only valid value is @HTTP@.
createService_type :: Lens.Lens' CreateService (Prelude.Maybe ServiceTypeOption)
createService_type :: Lens' CreateService (Maybe ServiceTypeOption)
createService_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Maybe ServiceTypeOption
type' :: Maybe ServiceTypeOption
$sel:type':CreateService' :: CreateService -> Maybe ServiceTypeOption
type'} -> Maybe ServiceTypeOption
type') (\s :: CreateService
s@CreateService' {} Maybe ServiceTypeOption
a -> CreateService
s {$sel:type':CreateService' :: Maybe ServiceTypeOption
type' = Maybe ServiceTypeOption
a} :: CreateService)

-- | The name that you want to assign to the service.
--
-- Do not include sensitive information in the name if the namespace is
-- discoverable by public DNS queries.
--
-- If you want Cloud Map to create an @SRV@ record when you register an
-- instance and you\'re using a system that requires a specific @SRV@
-- format, such as <http://www.haproxy.org/ HAProxy>, specify the following
-- for @Name@:
--
-- -   Start the name with an underscore (_), such as @_exampleservice@.
--
-- -   End the name with /._protocol/, such as @._tcp@.
--
-- When you register an instance, Cloud Map creates an @SRV@ record and
-- assigns a name to the record by concatenating the service name and the
-- namespace name (for example,
--
-- @_exampleservice._tcp.example.com@).
--
-- For services that are accessible by DNS queries, you can\'t create
-- multiple services with names that differ only by case (such as EXAMPLE
-- and example). Otherwise, these services have the same DNS name and
-- can\'t be distinguished. However, if you use a namespace that\'s only
-- accessible by API calls, then you can create services that with names
-- that differ only by case.
createService_name :: Lens.Lens' CreateService Prelude.Text
createService_name :: Lens' CreateService Text
createService_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateService' {Text
name :: Text
$sel:name:CreateService' :: CreateService -> Text
name} -> Text
name) (\s :: CreateService
s@CreateService' {} Text
a -> CreateService
s {$sel:name:CreateService' :: Text
name = Text
a} :: CreateService)

instance Core.AWSRequest CreateService where
  type
    AWSResponse CreateService =
      CreateServiceResponse
  request :: (Service -> Service) -> CreateService -> Request CreateService
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 CreateService
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateService)))
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 ServiceInfo -> Int -> CreateServiceResponse
CreateServiceResponse'
            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
"Service")
            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 CreateService where
  hashWithSalt :: Int -> CreateService -> Int
hashWithSalt Int
_salt CreateService' {Maybe [Tag]
Maybe Text
Maybe HealthCheckCustomConfig
Maybe HealthCheckConfig
Maybe DnsConfig
Maybe ServiceTypeOption
Text
name :: Text
type' :: Maybe ServiceTypeOption
tags :: Maybe [Tag]
namespaceId :: Maybe Text
healthCheckCustomConfig :: Maybe HealthCheckCustomConfig
healthCheckConfig :: Maybe HealthCheckConfig
dnsConfig :: Maybe DnsConfig
description :: Maybe Text
creatorRequestId :: Maybe Text
$sel:name:CreateService' :: CreateService -> Text
$sel:type':CreateService' :: CreateService -> Maybe ServiceTypeOption
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
$sel:namespaceId:CreateService' :: CreateService -> Maybe Text
$sel:healthCheckCustomConfig:CreateService' :: CreateService -> Maybe HealthCheckCustomConfig
$sel:healthCheckConfig:CreateService' :: CreateService -> Maybe HealthCheckConfig
$sel:dnsConfig:CreateService' :: CreateService -> Maybe DnsConfig
$sel:description:CreateService' :: CreateService -> Maybe Text
$sel:creatorRequestId:CreateService' :: CreateService -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
creatorRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DnsConfig
dnsConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HealthCheckConfig
healthCheckConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HealthCheckCustomConfig
healthCheckCustomConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
namespaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServiceTypeOption
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateService where
  rnf :: CreateService -> ()
rnf CreateService' {Maybe [Tag]
Maybe Text
Maybe HealthCheckCustomConfig
Maybe HealthCheckConfig
Maybe DnsConfig
Maybe ServiceTypeOption
Text
name :: Text
type' :: Maybe ServiceTypeOption
tags :: Maybe [Tag]
namespaceId :: Maybe Text
healthCheckCustomConfig :: Maybe HealthCheckCustomConfig
healthCheckConfig :: Maybe HealthCheckConfig
dnsConfig :: Maybe DnsConfig
description :: Maybe Text
creatorRequestId :: Maybe Text
$sel:name:CreateService' :: CreateService -> Text
$sel:type':CreateService' :: CreateService -> Maybe ServiceTypeOption
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
$sel:namespaceId:CreateService' :: CreateService -> Maybe Text
$sel:healthCheckCustomConfig:CreateService' :: CreateService -> Maybe HealthCheckCustomConfig
$sel:healthCheckConfig:CreateService' :: CreateService -> Maybe HealthCheckConfig
$sel:dnsConfig:CreateService' :: CreateService -> Maybe DnsConfig
$sel:description:CreateService' :: CreateService -> Maybe Text
$sel:creatorRequestId:CreateService' :: CreateService -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
creatorRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DnsConfig
dnsConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HealthCheckConfig
healthCheckConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HealthCheckCustomConfig
healthCheckCustomConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
namespaceId
      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 ServiceTypeOption
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateService where
  toHeaders :: CreateService -> 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
"Route53AutoNaming_v20170314.CreateService" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateService where
  toJSON :: CreateService -> Value
toJSON CreateService' {Maybe [Tag]
Maybe Text
Maybe HealthCheckCustomConfig
Maybe HealthCheckConfig
Maybe DnsConfig
Maybe ServiceTypeOption
Text
name :: Text
type' :: Maybe ServiceTypeOption
tags :: Maybe [Tag]
namespaceId :: Maybe Text
healthCheckCustomConfig :: Maybe HealthCheckCustomConfig
healthCheckConfig :: Maybe HealthCheckConfig
dnsConfig :: Maybe DnsConfig
description :: Maybe Text
creatorRequestId :: Maybe Text
$sel:name:CreateService' :: CreateService -> Text
$sel:type':CreateService' :: CreateService -> Maybe ServiceTypeOption
$sel:tags:CreateService' :: CreateService -> Maybe [Tag]
$sel:namespaceId:CreateService' :: CreateService -> Maybe Text
$sel:healthCheckCustomConfig:CreateService' :: CreateService -> Maybe HealthCheckCustomConfig
$sel:healthCheckConfig:CreateService' :: CreateService -> Maybe HealthCheckConfig
$sel:dnsConfig:CreateService' :: CreateService -> Maybe DnsConfig
$sel:description:CreateService' :: CreateService -> Maybe Text
$sel:creatorRequestId:CreateService' :: CreateService -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CreatorRequestId" 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
creatorRequestId,
            (Key
"Description" 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
description,
            (Key
"DnsConfig" 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 DnsConfig
dnsConfig,
            (Key
"HealthCheckConfig" 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 HealthCheckConfig
healthCheckConfig,
            (Key
"HealthCheckCustomConfig" 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 HealthCheckCustomConfig
healthCheckCustomConfig,
            (Key
"NamespaceId" 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
namespaceId,
            (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
"Type" 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 ServiceTypeOption
type',
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateServiceResponse' smart constructor.
data CreateServiceResponse = CreateServiceResponse'
  { -- | A complex type that contains information about the new service.
    CreateServiceResponse -> Maybe ServiceInfo
service :: Prelude.Maybe ServiceInfo,
    -- | The response's http status code.
    CreateServiceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateServiceResponse -> CreateServiceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateServiceResponse -> CreateServiceResponse -> Bool
$c/= :: CreateServiceResponse -> CreateServiceResponse -> Bool
== :: CreateServiceResponse -> CreateServiceResponse -> Bool
$c== :: CreateServiceResponse -> CreateServiceResponse -> Bool
Prelude.Eq, ReadPrec [CreateServiceResponse]
ReadPrec CreateServiceResponse
Int -> ReadS CreateServiceResponse
ReadS [CreateServiceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateServiceResponse]
$creadListPrec :: ReadPrec [CreateServiceResponse]
readPrec :: ReadPrec CreateServiceResponse
$creadPrec :: ReadPrec CreateServiceResponse
readList :: ReadS [CreateServiceResponse]
$creadList :: ReadS [CreateServiceResponse]
readsPrec :: Int -> ReadS CreateServiceResponse
$creadsPrec :: Int -> ReadS CreateServiceResponse
Prelude.Read, Int -> CreateServiceResponse -> ShowS
[CreateServiceResponse] -> ShowS
CreateServiceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateServiceResponse] -> ShowS
$cshowList :: [CreateServiceResponse] -> ShowS
show :: CreateServiceResponse -> String
$cshow :: CreateServiceResponse -> String
showsPrec :: Int -> CreateServiceResponse -> ShowS
$cshowsPrec :: Int -> CreateServiceResponse -> ShowS
Prelude.Show, forall x. Rep CreateServiceResponse x -> CreateServiceResponse
forall x. CreateServiceResponse -> Rep CreateServiceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateServiceResponse x -> CreateServiceResponse
$cfrom :: forall x. CreateServiceResponse -> Rep CreateServiceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateServiceResponse' 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:
--
-- 'service', 'createServiceResponse_service' - A complex type that contains information about the new service.
--
-- 'httpStatus', 'createServiceResponse_httpStatus' - The response's http status code.
newCreateServiceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateServiceResponse
newCreateServiceResponse :: Int -> CreateServiceResponse
newCreateServiceResponse Int
pHttpStatus_ =
  CreateServiceResponse'
    { $sel:service:CreateServiceResponse' :: Maybe ServiceInfo
service = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateServiceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A complex type that contains information about the new service.
createServiceResponse_service :: Lens.Lens' CreateServiceResponse (Prelude.Maybe ServiceInfo)
createServiceResponse_service :: Lens' CreateServiceResponse (Maybe ServiceInfo)
createServiceResponse_service = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceResponse' {Maybe ServiceInfo
service :: Maybe ServiceInfo
$sel:service:CreateServiceResponse' :: CreateServiceResponse -> Maybe ServiceInfo
service} -> Maybe ServiceInfo
service) (\s :: CreateServiceResponse
s@CreateServiceResponse' {} Maybe ServiceInfo
a -> CreateServiceResponse
s {$sel:service:CreateServiceResponse' :: Maybe ServiceInfo
service = Maybe ServiceInfo
a} :: CreateServiceResponse)

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

instance Prelude.NFData CreateServiceResponse where
  rnf :: CreateServiceResponse -> ()
rnf CreateServiceResponse' {Int
Maybe ServiceInfo
httpStatus :: Int
service :: Maybe ServiceInfo
$sel:httpStatus:CreateServiceResponse' :: CreateServiceResponse -> Int
$sel:service:CreateServiceResponse' :: CreateServiceResponse -> Maybe ServiceInfo
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceInfo
service
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus