{-# 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.Lightsail.CreateContainerService
-- 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 an Amazon Lightsail container service.
--
-- A Lightsail container service is a compute resource to which you can
-- deploy containers. For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-container-services Container services in Amazon Lightsail>
-- in the /Lightsail Dev Guide/.
module Amazonka.Lightsail.CreateContainerService
  ( -- * Creating a Request
    CreateContainerService (..),
    newCreateContainerService,

    -- * Request Lenses
    createContainerService_deployment,
    createContainerService_privateRegistryAccess,
    createContainerService_publicDomainNames,
    createContainerService_tags,
    createContainerService_serviceName,
    createContainerService_power,
    createContainerService_scale,

    -- * Destructuring the Response
    CreateContainerServiceResponse (..),
    newCreateContainerServiceResponse,

    -- * Response Lenses
    createContainerServiceResponse_containerService,
    createContainerServiceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateContainerService' smart constructor.
data CreateContainerService = CreateContainerService'
  { -- | An object that describes a deployment for the container service.
    --
    -- A deployment specifies the containers that will be launched on the
    -- container service and their settings, such as the ports to open, the
    -- environment variables to apply, and the launch command to run. It also
    -- specifies the container that will serve as the public endpoint of the
    -- deployment and its settings, such as the HTTP or HTTPS port to use, and
    -- the health check configuration.
    CreateContainerService -> Maybe ContainerServiceDeploymentRequest
deployment :: Prelude.Maybe ContainerServiceDeploymentRequest,
    -- | An object to describe the configuration for the container service to
    -- access private container image repositories, such as Amazon Elastic
    -- Container Registry (Amazon ECR) private repositories.
    --
    -- For more information, see
    -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-container-service-ecr-private-repo-access Configuring access to an Amazon ECR private repository for an Amazon Lightsail container service>
    -- in the /Amazon Lightsail Developer Guide/.
    CreateContainerService -> Maybe PrivateRegistryAccessRequest
privateRegistryAccess :: Prelude.Maybe PrivateRegistryAccessRequest,
    -- | The public domain names to use with the container service, such as
    -- @example.com@ and @www.example.com@.
    --
    -- You can specify up to four public domain names for a container service.
    -- The domain names that you specify are used when you create a deployment
    -- with a container configured as the public endpoint of your container
    -- service.
    --
    -- If you don\'t specify public domain names, then you can use the default
    -- domain of the container service.
    --
    -- You must create and validate an SSL\/TLS certificate before you can use
    -- public domain names with your container service. Use the
    -- @CreateCertificate@ action to create a certificate for the public domain
    -- names you want to use with your container service.
    --
    -- You can specify public domain names using a string to array map as shown
    -- in the example later on this page.
    CreateContainerService -> Maybe (HashMap Text [Text])
publicDomainNames :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | The tag keys and optional values to add to the container service during
    -- create.
    --
    -- Use the @TagResource@ action to tag a resource after it\'s created.
    --
    -- For more information about tags in Lightsail, see the
    -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-tags Amazon Lightsail Developer Guide>.
    CreateContainerService -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name for the container service.
    --
    -- The name that you specify for your container service will make up part
    -- of its default domain. The default domain of a container service is
    -- typically
    -- @https:\/\/\<ServiceName>.\<RandomGUID>.\<AWSRegion>.cs.amazonlightsail.com@.
    -- If the name of your container service is @container-service-1@, and
    -- it\'s located in the US East (Ohio) Amazon Web Services Region
    -- (@us-east-2@), then the domain for your container service will be like
    -- the following example:
    -- @https:\/\/container-service-1.ur4EXAMPLE2uq.us-east-2.cs.amazonlightsail.com@
    --
    -- The following are the requirements for container service names:
    --
    -- -   Must be unique within each Amazon Web Services Region in your
    --     Lightsail account.
    --
    -- -   Must contain 1 to 63 characters.
    --
    -- -   Must contain only alphanumeric characters and hyphens.
    --
    -- -   A hyphen (-) can separate words but cannot be at the start or end of
    --     the name.
    CreateContainerService -> Text
serviceName :: Prelude.Text,
    -- | The power specification for the container service.
    --
    -- The power specifies the amount of memory, vCPUs, and base monthly cost
    -- of each node of the container service. The @power@ and @scale@ of a
    -- container service makes up its configured capacity. To determine the
    -- monthly price of your container service, multiply the base price of the
    -- @power@ with the @scale@ (the number of nodes) of the service.
    --
    -- Use the @GetContainerServicePowers@ action to get a list of power
    -- options that you can specify using this parameter, and their base
    -- monthly cost.
    CreateContainerService -> ContainerServicePowerName
power :: ContainerServicePowerName,
    -- | The scale specification for the container service.
    --
    -- The scale specifies the allocated compute nodes of the container
    -- service. The @power@ and @scale@ of a container service makes up its
    -- configured capacity. To determine the monthly price of your container
    -- service, multiply the base price of the @power@ with the @scale@ (the
    -- number of nodes) of the service.
    CreateContainerService -> Natural
scale :: Prelude.Natural
  }
  deriving (CreateContainerService -> CreateContainerService -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContainerService -> CreateContainerService -> Bool
$c/= :: CreateContainerService -> CreateContainerService -> Bool
== :: CreateContainerService -> CreateContainerService -> Bool
$c== :: CreateContainerService -> CreateContainerService -> Bool
Prelude.Eq, ReadPrec [CreateContainerService]
ReadPrec CreateContainerService
Int -> ReadS CreateContainerService
ReadS [CreateContainerService]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContainerService]
$creadListPrec :: ReadPrec [CreateContainerService]
readPrec :: ReadPrec CreateContainerService
$creadPrec :: ReadPrec CreateContainerService
readList :: ReadS [CreateContainerService]
$creadList :: ReadS [CreateContainerService]
readsPrec :: Int -> ReadS CreateContainerService
$creadsPrec :: Int -> ReadS CreateContainerService
Prelude.Read, Int -> CreateContainerService -> ShowS
[CreateContainerService] -> ShowS
CreateContainerService -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContainerService] -> ShowS
$cshowList :: [CreateContainerService] -> ShowS
show :: CreateContainerService -> String
$cshow :: CreateContainerService -> String
showsPrec :: Int -> CreateContainerService -> ShowS
$cshowsPrec :: Int -> CreateContainerService -> ShowS
Prelude.Show, forall x. Rep CreateContainerService x -> CreateContainerService
forall x. CreateContainerService -> Rep CreateContainerService x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateContainerService x -> CreateContainerService
$cfrom :: forall x. CreateContainerService -> Rep CreateContainerService x
Prelude.Generic)

-- |
-- Create a value of 'CreateContainerService' 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:
--
-- 'deployment', 'createContainerService_deployment' - An object that describes a deployment for the container service.
--
-- A deployment specifies the containers that will be launched on the
-- container service and their settings, such as the ports to open, the
-- environment variables to apply, and the launch command to run. It also
-- specifies the container that will serve as the public endpoint of the
-- deployment and its settings, such as the HTTP or HTTPS port to use, and
-- the health check configuration.
--
-- 'privateRegistryAccess', 'createContainerService_privateRegistryAccess' - An object to describe the configuration for the container service to
-- access private container image repositories, such as Amazon Elastic
-- Container Registry (Amazon ECR) private repositories.
--
-- For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-container-service-ecr-private-repo-access Configuring access to an Amazon ECR private repository for an Amazon Lightsail container service>
-- in the /Amazon Lightsail Developer Guide/.
--
-- 'publicDomainNames', 'createContainerService_publicDomainNames' - The public domain names to use with the container service, such as
-- @example.com@ and @www.example.com@.
--
-- You can specify up to four public domain names for a container service.
-- The domain names that you specify are used when you create a deployment
-- with a container configured as the public endpoint of your container
-- service.
--
-- If you don\'t specify public domain names, then you can use the default
-- domain of the container service.
--
-- You must create and validate an SSL\/TLS certificate before you can use
-- public domain names with your container service. Use the
-- @CreateCertificate@ action to create a certificate for the public domain
-- names you want to use with your container service.
--
-- You can specify public domain names using a string to array map as shown
-- in the example later on this page.
--
-- 'tags', 'createContainerService_tags' - The tag keys and optional values to add to the container service during
-- create.
--
-- Use the @TagResource@ action to tag a resource after it\'s created.
--
-- For more information about tags in Lightsail, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-tags Amazon Lightsail Developer Guide>.
--
-- 'serviceName', 'createContainerService_serviceName' - The name for the container service.
--
-- The name that you specify for your container service will make up part
-- of its default domain. The default domain of a container service is
-- typically
-- @https:\/\/\<ServiceName>.\<RandomGUID>.\<AWSRegion>.cs.amazonlightsail.com@.
-- If the name of your container service is @container-service-1@, and
-- it\'s located in the US East (Ohio) Amazon Web Services Region
-- (@us-east-2@), then the domain for your container service will be like
-- the following example:
-- @https:\/\/container-service-1.ur4EXAMPLE2uq.us-east-2.cs.amazonlightsail.com@
--
-- The following are the requirements for container service names:
--
-- -   Must be unique within each Amazon Web Services Region in your
--     Lightsail account.
--
-- -   Must contain 1 to 63 characters.
--
-- -   Must contain only alphanumeric characters and hyphens.
--
-- -   A hyphen (-) can separate words but cannot be at the start or end of
--     the name.
--
-- 'power', 'createContainerService_power' - The power specification for the container service.
--
-- The power specifies the amount of memory, vCPUs, and base monthly cost
-- of each node of the container service. The @power@ and @scale@ of a
-- container service makes up its configured capacity. To determine the
-- monthly price of your container service, multiply the base price of the
-- @power@ with the @scale@ (the number of nodes) of the service.
--
-- Use the @GetContainerServicePowers@ action to get a list of power
-- options that you can specify using this parameter, and their base
-- monthly cost.
--
-- 'scale', 'createContainerService_scale' - The scale specification for the container service.
--
-- The scale specifies the allocated compute nodes of the container
-- service. The @power@ and @scale@ of a container service makes up its
-- configured capacity. To determine the monthly price of your container
-- service, multiply the base price of the @power@ with the @scale@ (the
-- number of nodes) of the service.
newCreateContainerService ::
  -- | 'serviceName'
  Prelude.Text ->
  -- | 'power'
  ContainerServicePowerName ->
  -- | 'scale'
  Prelude.Natural ->
  CreateContainerService
newCreateContainerService :: Text
-> ContainerServicePowerName -> Natural -> CreateContainerService
newCreateContainerService
  Text
pServiceName_
  ContainerServicePowerName
pPower_
  Natural
pScale_ =
    CreateContainerService'
      { $sel:deployment:CreateContainerService' :: Maybe ContainerServiceDeploymentRequest
deployment =
          forall a. Maybe a
Prelude.Nothing,
        $sel:privateRegistryAccess:CreateContainerService' :: Maybe PrivateRegistryAccessRequest
privateRegistryAccess = forall a. Maybe a
Prelude.Nothing,
        $sel:publicDomainNames:CreateContainerService' :: Maybe (HashMap Text [Text])
publicDomainNames = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateContainerService' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:serviceName:CreateContainerService' :: Text
serviceName = Text
pServiceName_,
        $sel:power:CreateContainerService' :: ContainerServicePowerName
power = ContainerServicePowerName
pPower_,
        $sel:scale:CreateContainerService' :: Natural
scale = Natural
pScale_
      }

-- | An object that describes a deployment for the container service.
--
-- A deployment specifies the containers that will be launched on the
-- container service and their settings, such as the ports to open, the
-- environment variables to apply, and the launch command to run. It also
-- specifies the container that will serve as the public endpoint of the
-- deployment and its settings, such as the HTTP or HTTPS port to use, and
-- the health check configuration.
createContainerService_deployment :: Lens.Lens' CreateContainerService (Prelude.Maybe ContainerServiceDeploymentRequest)
createContainerService_deployment :: Lens'
  CreateContainerService (Maybe ContainerServiceDeploymentRequest)
createContainerService_deployment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerService' {Maybe ContainerServiceDeploymentRequest
deployment :: Maybe ContainerServiceDeploymentRequest
$sel:deployment:CreateContainerService' :: CreateContainerService -> Maybe ContainerServiceDeploymentRequest
deployment} -> Maybe ContainerServiceDeploymentRequest
deployment) (\s :: CreateContainerService
s@CreateContainerService' {} Maybe ContainerServiceDeploymentRequest
a -> CreateContainerService
s {$sel:deployment:CreateContainerService' :: Maybe ContainerServiceDeploymentRequest
deployment = Maybe ContainerServiceDeploymentRequest
a} :: CreateContainerService)

-- | An object to describe the configuration for the container service to
-- access private container image repositories, such as Amazon Elastic
-- Container Registry (Amazon ECR) private repositories.
--
-- For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-container-service-ecr-private-repo-access Configuring access to an Amazon ECR private repository for an Amazon Lightsail container service>
-- in the /Amazon Lightsail Developer Guide/.
createContainerService_privateRegistryAccess :: Lens.Lens' CreateContainerService (Prelude.Maybe PrivateRegistryAccessRequest)
createContainerService_privateRegistryAccess :: Lens' CreateContainerService (Maybe PrivateRegistryAccessRequest)
createContainerService_privateRegistryAccess = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerService' {Maybe PrivateRegistryAccessRequest
privateRegistryAccess :: Maybe PrivateRegistryAccessRequest
$sel:privateRegistryAccess:CreateContainerService' :: CreateContainerService -> Maybe PrivateRegistryAccessRequest
privateRegistryAccess} -> Maybe PrivateRegistryAccessRequest
privateRegistryAccess) (\s :: CreateContainerService
s@CreateContainerService' {} Maybe PrivateRegistryAccessRequest
a -> CreateContainerService
s {$sel:privateRegistryAccess:CreateContainerService' :: Maybe PrivateRegistryAccessRequest
privateRegistryAccess = Maybe PrivateRegistryAccessRequest
a} :: CreateContainerService)

-- | The public domain names to use with the container service, such as
-- @example.com@ and @www.example.com@.
--
-- You can specify up to four public domain names for a container service.
-- The domain names that you specify are used when you create a deployment
-- with a container configured as the public endpoint of your container
-- service.
--
-- If you don\'t specify public domain names, then you can use the default
-- domain of the container service.
--
-- You must create and validate an SSL\/TLS certificate before you can use
-- public domain names with your container service. Use the
-- @CreateCertificate@ action to create a certificate for the public domain
-- names you want to use with your container service.
--
-- You can specify public domain names using a string to array map as shown
-- in the example later on this page.
createContainerService_publicDomainNames :: Lens.Lens' CreateContainerService (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
createContainerService_publicDomainNames :: Lens' CreateContainerService (Maybe (HashMap Text [Text]))
createContainerService_publicDomainNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerService' {Maybe (HashMap Text [Text])
publicDomainNames :: Maybe (HashMap Text [Text])
$sel:publicDomainNames:CreateContainerService' :: CreateContainerService -> Maybe (HashMap Text [Text])
publicDomainNames} -> Maybe (HashMap Text [Text])
publicDomainNames) (\s :: CreateContainerService
s@CreateContainerService' {} Maybe (HashMap Text [Text])
a -> CreateContainerService
s {$sel:publicDomainNames:CreateContainerService' :: Maybe (HashMap Text [Text])
publicDomainNames = Maybe (HashMap Text [Text])
a} :: CreateContainerService) 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 tag keys and optional values to add to the container service during
-- create.
--
-- Use the @TagResource@ action to tag a resource after it\'s created.
--
-- For more information about tags in Lightsail, see the
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-tags Amazon Lightsail Developer Guide>.
createContainerService_tags :: Lens.Lens' CreateContainerService (Prelude.Maybe [Tag])
createContainerService_tags :: Lens' CreateContainerService (Maybe [Tag])
createContainerService_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerService' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateContainerService' :: CreateContainerService -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateContainerService
s@CreateContainerService' {} Maybe [Tag]
a -> CreateContainerService
s {$sel:tags:CreateContainerService' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateContainerService) 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 name for the container service.
--
-- The name that you specify for your container service will make up part
-- of its default domain. The default domain of a container service is
-- typically
-- @https:\/\/\<ServiceName>.\<RandomGUID>.\<AWSRegion>.cs.amazonlightsail.com@.
-- If the name of your container service is @container-service-1@, and
-- it\'s located in the US East (Ohio) Amazon Web Services Region
-- (@us-east-2@), then the domain for your container service will be like
-- the following example:
-- @https:\/\/container-service-1.ur4EXAMPLE2uq.us-east-2.cs.amazonlightsail.com@
--
-- The following are the requirements for container service names:
--
-- -   Must be unique within each Amazon Web Services Region in your
--     Lightsail account.
--
-- -   Must contain 1 to 63 characters.
--
-- -   Must contain only alphanumeric characters and hyphens.
--
-- -   A hyphen (-) can separate words but cannot be at the start or end of
--     the name.
createContainerService_serviceName :: Lens.Lens' CreateContainerService Prelude.Text
createContainerService_serviceName :: Lens' CreateContainerService Text
createContainerService_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerService' {Text
serviceName :: Text
$sel:serviceName:CreateContainerService' :: CreateContainerService -> Text
serviceName} -> Text
serviceName) (\s :: CreateContainerService
s@CreateContainerService' {} Text
a -> CreateContainerService
s {$sel:serviceName:CreateContainerService' :: Text
serviceName = Text
a} :: CreateContainerService)

-- | The power specification for the container service.
--
-- The power specifies the amount of memory, vCPUs, and base monthly cost
-- of each node of the container service. The @power@ and @scale@ of a
-- container service makes up its configured capacity. To determine the
-- monthly price of your container service, multiply the base price of the
-- @power@ with the @scale@ (the number of nodes) of the service.
--
-- Use the @GetContainerServicePowers@ action to get a list of power
-- options that you can specify using this parameter, and their base
-- monthly cost.
createContainerService_power :: Lens.Lens' CreateContainerService ContainerServicePowerName
createContainerService_power :: Lens' CreateContainerService ContainerServicePowerName
createContainerService_power = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerService' {ContainerServicePowerName
power :: ContainerServicePowerName
$sel:power:CreateContainerService' :: CreateContainerService -> ContainerServicePowerName
power} -> ContainerServicePowerName
power) (\s :: CreateContainerService
s@CreateContainerService' {} ContainerServicePowerName
a -> CreateContainerService
s {$sel:power:CreateContainerService' :: ContainerServicePowerName
power = ContainerServicePowerName
a} :: CreateContainerService)

-- | The scale specification for the container service.
--
-- The scale specifies the allocated compute nodes of the container
-- service. The @power@ and @scale@ of a container service makes up its
-- configured capacity. To determine the monthly price of your container
-- service, multiply the base price of the @power@ with the @scale@ (the
-- number of nodes) of the service.
createContainerService_scale :: Lens.Lens' CreateContainerService Prelude.Natural
createContainerService_scale :: Lens' CreateContainerService Natural
createContainerService_scale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerService' {Natural
scale :: Natural
$sel:scale:CreateContainerService' :: CreateContainerService -> Natural
scale} -> Natural
scale) (\s :: CreateContainerService
s@CreateContainerService' {} Natural
a -> CreateContainerService
s {$sel:scale:CreateContainerService' :: Natural
scale = Natural
a} :: CreateContainerService)

instance Core.AWSRequest CreateContainerService where
  type
    AWSResponse CreateContainerService =
      CreateContainerServiceResponse
  request :: (Service -> Service)
-> CreateContainerService -> Request CreateContainerService
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 CreateContainerService
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateContainerService)))
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 ContainerService -> Int -> CreateContainerServiceResponse
CreateContainerServiceResponse'
            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
"containerService")
            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 CreateContainerService where
  hashWithSalt :: Int -> CreateContainerService -> Int
hashWithSalt Int
_salt CreateContainerService' {Natural
Maybe [Tag]
Maybe (HashMap Text [Text])
Maybe ContainerServiceDeploymentRequest
Maybe PrivateRegistryAccessRequest
Text
ContainerServicePowerName
scale :: Natural
power :: ContainerServicePowerName
serviceName :: Text
tags :: Maybe [Tag]
publicDomainNames :: Maybe (HashMap Text [Text])
privateRegistryAccess :: Maybe PrivateRegistryAccessRequest
deployment :: Maybe ContainerServiceDeploymentRequest
$sel:scale:CreateContainerService' :: CreateContainerService -> Natural
$sel:power:CreateContainerService' :: CreateContainerService -> ContainerServicePowerName
$sel:serviceName:CreateContainerService' :: CreateContainerService -> Text
$sel:tags:CreateContainerService' :: CreateContainerService -> Maybe [Tag]
$sel:publicDomainNames:CreateContainerService' :: CreateContainerService -> Maybe (HashMap Text [Text])
$sel:privateRegistryAccess:CreateContainerService' :: CreateContainerService -> Maybe PrivateRegistryAccessRequest
$sel:deployment:CreateContainerService' :: CreateContainerService -> Maybe ContainerServiceDeploymentRequest
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContainerServiceDeploymentRequest
deployment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PrivateRegistryAccessRequest
privateRegistryAccess
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
publicDomainNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ContainerServicePowerName
power
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
scale

instance Prelude.NFData CreateContainerService where
  rnf :: CreateContainerService -> ()
rnf CreateContainerService' {Natural
Maybe [Tag]
Maybe (HashMap Text [Text])
Maybe ContainerServiceDeploymentRequest
Maybe PrivateRegistryAccessRequest
Text
ContainerServicePowerName
scale :: Natural
power :: ContainerServicePowerName
serviceName :: Text
tags :: Maybe [Tag]
publicDomainNames :: Maybe (HashMap Text [Text])
privateRegistryAccess :: Maybe PrivateRegistryAccessRequest
deployment :: Maybe ContainerServiceDeploymentRequest
$sel:scale:CreateContainerService' :: CreateContainerService -> Natural
$sel:power:CreateContainerService' :: CreateContainerService -> ContainerServicePowerName
$sel:serviceName:CreateContainerService' :: CreateContainerService -> Text
$sel:tags:CreateContainerService' :: CreateContainerService -> Maybe [Tag]
$sel:publicDomainNames:CreateContainerService' :: CreateContainerService -> Maybe (HashMap Text [Text])
$sel:privateRegistryAccess:CreateContainerService' :: CreateContainerService -> Maybe PrivateRegistryAccessRequest
$sel:deployment:CreateContainerService' :: CreateContainerService -> Maybe ContainerServiceDeploymentRequest
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ContainerServiceDeploymentRequest
deployment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PrivateRegistryAccessRequest
privateRegistryAccess
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
publicDomainNames
      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 Text
serviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ContainerServicePowerName
power
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
scale

instance Data.ToHeaders CreateContainerService where
  toHeaders :: CreateContainerService -> 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
"Lightsail_20161128.CreateContainerService" ::
                          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 CreateContainerService where
  toJSON :: CreateContainerService -> Value
toJSON CreateContainerService' {Natural
Maybe [Tag]
Maybe (HashMap Text [Text])
Maybe ContainerServiceDeploymentRequest
Maybe PrivateRegistryAccessRequest
Text
ContainerServicePowerName
scale :: Natural
power :: ContainerServicePowerName
serviceName :: Text
tags :: Maybe [Tag]
publicDomainNames :: Maybe (HashMap Text [Text])
privateRegistryAccess :: Maybe PrivateRegistryAccessRequest
deployment :: Maybe ContainerServiceDeploymentRequest
$sel:scale:CreateContainerService' :: CreateContainerService -> Natural
$sel:power:CreateContainerService' :: CreateContainerService -> ContainerServicePowerName
$sel:serviceName:CreateContainerService' :: CreateContainerService -> Text
$sel:tags:CreateContainerService' :: CreateContainerService -> Maybe [Tag]
$sel:publicDomainNames:CreateContainerService' :: CreateContainerService -> Maybe (HashMap Text [Text])
$sel:privateRegistryAccess:CreateContainerService' :: CreateContainerService -> Maybe PrivateRegistryAccessRequest
$sel:deployment:CreateContainerService' :: CreateContainerService -> Maybe ContainerServiceDeploymentRequest
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"deployment" 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 ContainerServiceDeploymentRequest
deployment,
            (Key
"privateRegistryAccess" 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 PrivateRegistryAccessRequest
privateRegistryAccess,
            (Key
"publicDomainNames" 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 (HashMap Text [Text])
publicDomainNames,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"serviceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceName),
            forall a. a -> Maybe a
Prelude.Just (Key
"power" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ContainerServicePowerName
power),
            forall a. a -> Maybe a
Prelude.Just (Key
"scale" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
scale)
          ]
      )

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

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

-- | /See:/ 'newCreateContainerServiceResponse' smart constructor.
data CreateContainerServiceResponse = CreateContainerServiceResponse'
  { -- | An object that describes a container service.
    CreateContainerServiceResponse -> Maybe ContainerService
containerService :: Prelude.Maybe ContainerService,
    -- | The response's http status code.
    CreateContainerServiceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateContainerServiceResponse
-> CreateContainerServiceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContainerServiceResponse
-> CreateContainerServiceResponse -> Bool
$c/= :: CreateContainerServiceResponse
-> CreateContainerServiceResponse -> Bool
== :: CreateContainerServiceResponse
-> CreateContainerServiceResponse -> Bool
$c== :: CreateContainerServiceResponse
-> CreateContainerServiceResponse -> Bool
Prelude.Eq, ReadPrec [CreateContainerServiceResponse]
ReadPrec CreateContainerServiceResponse
Int -> ReadS CreateContainerServiceResponse
ReadS [CreateContainerServiceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContainerServiceResponse]
$creadListPrec :: ReadPrec [CreateContainerServiceResponse]
readPrec :: ReadPrec CreateContainerServiceResponse
$creadPrec :: ReadPrec CreateContainerServiceResponse
readList :: ReadS [CreateContainerServiceResponse]
$creadList :: ReadS [CreateContainerServiceResponse]
readsPrec :: Int -> ReadS CreateContainerServiceResponse
$creadsPrec :: Int -> ReadS CreateContainerServiceResponse
Prelude.Read, Int -> CreateContainerServiceResponse -> ShowS
[CreateContainerServiceResponse] -> ShowS
CreateContainerServiceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContainerServiceResponse] -> ShowS
$cshowList :: [CreateContainerServiceResponse] -> ShowS
show :: CreateContainerServiceResponse -> String
$cshow :: CreateContainerServiceResponse -> String
showsPrec :: Int -> CreateContainerServiceResponse -> ShowS
$cshowsPrec :: Int -> CreateContainerServiceResponse -> ShowS
Prelude.Show, forall x.
Rep CreateContainerServiceResponse x
-> CreateContainerServiceResponse
forall x.
CreateContainerServiceResponse
-> Rep CreateContainerServiceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateContainerServiceResponse x
-> CreateContainerServiceResponse
$cfrom :: forall x.
CreateContainerServiceResponse
-> Rep CreateContainerServiceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateContainerServiceResponse' 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:
--
-- 'containerService', 'createContainerServiceResponse_containerService' - An object that describes a container service.
--
-- 'httpStatus', 'createContainerServiceResponse_httpStatus' - The response's http status code.
newCreateContainerServiceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateContainerServiceResponse
newCreateContainerServiceResponse :: Int -> CreateContainerServiceResponse
newCreateContainerServiceResponse Int
pHttpStatus_ =
  CreateContainerServiceResponse'
    { $sel:containerService:CreateContainerServiceResponse' :: Maybe ContainerService
containerService =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateContainerServiceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that describes a container service.
createContainerServiceResponse_containerService :: Lens.Lens' CreateContainerServiceResponse (Prelude.Maybe ContainerService)
createContainerServiceResponse_containerService :: Lens' CreateContainerServiceResponse (Maybe ContainerService)
createContainerServiceResponse_containerService = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerServiceResponse' {Maybe ContainerService
containerService :: Maybe ContainerService
$sel:containerService:CreateContainerServiceResponse' :: CreateContainerServiceResponse -> Maybe ContainerService
containerService} -> Maybe ContainerService
containerService) (\s :: CreateContainerServiceResponse
s@CreateContainerServiceResponse' {} Maybe ContainerService
a -> CreateContainerServiceResponse
s {$sel:containerService:CreateContainerServiceResponse' :: Maybe ContainerService
containerService = Maybe ContainerService
a} :: CreateContainerServiceResponse)

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

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