{-# 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.CreateContainerServiceDeployment
-- 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 deployment for your Amazon Lightsail 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.
--
-- You can deploy containers to your container service using container
-- images from a public registry such as Amazon ECR Public, or from your
-- local machine. For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-creating-container-images Creating container images for your Amazon Lightsail container services>
-- in the /Amazon Lightsail Developer Guide/.
module Amazonka.Lightsail.CreateContainerServiceDeployment
  ( -- * Creating a Request
    CreateContainerServiceDeployment (..),
    newCreateContainerServiceDeployment,

    -- * Request Lenses
    createContainerServiceDeployment_containers,
    createContainerServiceDeployment_publicEndpoint,
    createContainerServiceDeployment_serviceName,

    -- * Destructuring the Response
    CreateContainerServiceDeploymentResponse (..),
    newCreateContainerServiceDeploymentResponse,

    -- * Response Lenses
    createContainerServiceDeploymentResponse_containerService,
    createContainerServiceDeploymentResponse_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:/ 'newCreateContainerServiceDeployment' smart constructor.
data CreateContainerServiceDeployment = CreateContainerServiceDeployment'
  { -- | An object that describes the settings of the containers that will be
    -- launched on the container service.
    CreateContainerServiceDeployment -> Maybe (HashMap Text Container)
containers :: Prelude.Maybe (Prelude.HashMap Prelude.Text Container),
    -- | An object that describes the settings of the public endpoint for the
    -- container service.
    CreateContainerServiceDeployment -> Maybe EndpointRequest
publicEndpoint :: Prelude.Maybe EndpointRequest,
    -- | The name of the container service for which to create the deployment.
    CreateContainerServiceDeployment -> Text
serviceName :: Prelude.Text
  }
  deriving (CreateContainerServiceDeployment
-> CreateContainerServiceDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateContainerServiceDeployment
-> CreateContainerServiceDeployment -> Bool
$c/= :: CreateContainerServiceDeployment
-> CreateContainerServiceDeployment -> Bool
== :: CreateContainerServiceDeployment
-> CreateContainerServiceDeployment -> Bool
$c== :: CreateContainerServiceDeployment
-> CreateContainerServiceDeployment -> Bool
Prelude.Eq, ReadPrec [CreateContainerServiceDeployment]
ReadPrec CreateContainerServiceDeployment
Int -> ReadS CreateContainerServiceDeployment
ReadS [CreateContainerServiceDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateContainerServiceDeployment]
$creadListPrec :: ReadPrec [CreateContainerServiceDeployment]
readPrec :: ReadPrec CreateContainerServiceDeployment
$creadPrec :: ReadPrec CreateContainerServiceDeployment
readList :: ReadS [CreateContainerServiceDeployment]
$creadList :: ReadS [CreateContainerServiceDeployment]
readsPrec :: Int -> ReadS CreateContainerServiceDeployment
$creadsPrec :: Int -> ReadS CreateContainerServiceDeployment
Prelude.Read, Int -> CreateContainerServiceDeployment -> ShowS
[CreateContainerServiceDeployment] -> ShowS
CreateContainerServiceDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateContainerServiceDeployment] -> ShowS
$cshowList :: [CreateContainerServiceDeployment] -> ShowS
show :: CreateContainerServiceDeployment -> String
$cshow :: CreateContainerServiceDeployment -> String
showsPrec :: Int -> CreateContainerServiceDeployment -> ShowS
$cshowsPrec :: Int -> CreateContainerServiceDeployment -> ShowS
Prelude.Show, forall x.
Rep CreateContainerServiceDeployment x
-> CreateContainerServiceDeployment
forall x.
CreateContainerServiceDeployment
-> Rep CreateContainerServiceDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateContainerServiceDeployment x
-> CreateContainerServiceDeployment
$cfrom :: forall x.
CreateContainerServiceDeployment
-> Rep CreateContainerServiceDeployment x
Prelude.Generic)

-- |
-- Create a value of 'CreateContainerServiceDeployment' 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:
--
-- 'containers', 'createContainerServiceDeployment_containers' - An object that describes the settings of the containers that will be
-- launched on the container service.
--
-- 'publicEndpoint', 'createContainerServiceDeployment_publicEndpoint' - An object that describes the settings of the public endpoint for the
-- container service.
--
-- 'serviceName', 'createContainerServiceDeployment_serviceName' - The name of the container service for which to create the deployment.
newCreateContainerServiceDeployment ::
  -- | 'serviceName'
  Prelude.Text ->
  CreateContainerServiceDeployment
newCreateContainerServiceDeployment :: Text -> CreateContainerServiceDeployment
newCreateContainerServiceDeployment Text
pServiceName_ =
  CreateContainerServiceDeployment'
    { $sel:containers:CreateContainerServiceDeployment' :: Maybe (HashMap Text Container)
containers =
        forall a. Maybe a
Prelude.Nothing,
      $sel:publicEndpoint:CreateContainerServiceDeployment' :: Maybe EndpointRequest
publicEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceName:CreateContainerServiceDeployment' :: Text
serviceName = Text
pServiceName_
    }

-- | An object that describes the settings of the containers that will be
-- launched on the container service.
createContainerServiceDeployment_containers :: Lens.Lens' CreateContainerServiceDeployment (Prelude.Maybe (Prelude.HashMap Prelude.Text Container))
createContainerServiceDeployment_containers :: Lens'
  CreateContainerServiceDeployment (Maybe (HashMap Text Container))
createContainerServiceDeployment_containers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerServiceDeployment' {Maybe (HashMap Text Container)
containers :: Maybe (HashMap Text Container)
$sel:containers:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe (HashMap Text Container)
containers} -> Maybe (HashMap Text Container)
containers) (\s :: CreateContainerServiceDeployment
s@CreateContainerServiceDeployment' {} Maybe (HashMap Text Container)
a -> CreateContainerServiceDeployment
s {$sel:containers:CreateContainerServiceDeployment' :: Maybe (HashMap Text Container)
containers = Maybe (HashMap Text Container)
a} :: CreateContainerServiceDeployment) 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

-- | An object that describes the settings of the public endpoint for the
-- container service.
createContainerServiceDeployment_publicEndpoint :: Lens.Lens' CreateContainerServiceDeployment (Prelude.Maybe EndpointRequest)
createContainerServiceDeployment_publicEndpoint :: Lens' CreateContainerServiceDeployment (Maybe EndpointRequest)
createContainerServiceDeployment_publicEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerServiceDeployment' {Maybe EndpointRequest
publicEndpoint :: Maybe EndpointRequest
$sel:publicEndpoint:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe EndpointRequest
publicEndpoint} -> Maybe EndpointRequest
publicEndpoint) (\s :: CreateContainerServiceDeployment
s@CreateContainerServiceDeployment' {} Maybe EndpointRequest
a -> CreateContainerServiceDeployment
s {$sel:publicEndpoint:CreateContainerServiceDeployment' :: Maybe EndpointRequest
publicEndpoint = Maybe EndpointRequest
a} :: CreateContainerServiceDeployment)

-- | The name of the container service for which to create the deployment.
createContainerServiceDeployment_serviceName :: Lens.Lens' CreateContainerServiceDeployment Prelude.Text
createContainerServiceDeployment_serviceName :: Lens' CreateContainerServiceDeployment Text
createContainerServiceDeployment_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateContainerServiceDeployment' {Text
serviceName :: Text
$sel:serviceName:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Text
serviceName} -> Text
serviceName) (\s :: CreateContainerServiceDeployment
s@CreateContainerServiceDeployment' {} Text
a -> CreateContainerServiceDeployment
s {$sel:serviceName:CreateContainerServiceDeployment' :: Text
serviceName = Text
a} :: CreateContainerServiceDeployment)

instance
  Core.AWSRequest
    CreateContainerServiceDeployment
  where
  type
    AWSResponse CreateContainerServiceDeployment =
      CreateContainerServiceDeploymentResponse
  request :: (Service -> Service)
-> CreateContainerServiceDeployment
-> Request CreateContainerServiceDeployment
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 CreateContainerServiceDeployment
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateContainerServiceDeployment)))
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 -> CreateContainerServiceDeploymentResponse
CreateContainerServiceDeploymentResponse'
            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
    CreateContainerServiceDeployment
  where
  hashWithSalt :: Int -> CreateContainerServiceDeployment -> Int
hashWithSalt
    Int
_salt
    CreateContainerServiceDeployment' {Maybe (HashMap Text Container)
Maybe EndpointRequest
Text
serviceName :: Text
publicEndpoint :: Maybe EndpointRequest
containers :: Maybe (HashMap Text Container)
$sel:serviceName:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Text
$sel:publicEndpoint:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe EndpointRequest
$sel:containers:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe (HashMap Text Container)
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Container)
containers
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointRequest
publicEndpoint
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceName

instance
  Prelude.NFData
    CreateContainerServiceDeployment
  where
  rnf :: CreateContainerServiceDeployment -> ()
rnf CreateContainerServiceDeployment' {Maybe (HashMap Text Container)
Maybe EndpointRequest
Text
serviceName :: Text
publicEndpoint :: Maybe EndpointRequest
containers :: Maybe (HashMap Text Container)
$sel:serviceName:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Text
$sel:publicEndpoint:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe EndpointRequest
$sel:containers:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe (HashMap Text Container)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Container)
containers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointRequest
publicEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceName

instance
  Data.ToHeaders
    CreateContainerServiceDeployment
  where
  toHeaders :: CreateContainerServiceDeployment -> 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.CreateContainerServiceDeployment" ::
                          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 CreateContainerServiceDeployment where
  toJSON :: CreateContainerServiceDeployment -> Value
toJSON CreateContainerServiceDeployment' {Maybe (HashMap Text Container)
Maybe EndpointRequest
Text
serviceName :: Text
publicEndpoint :: Maybe EndpointRequest
containers :: Maybe (HashMap Text Container)
$sel:serviceName:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Text
$sel:publicEndpoint:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe EndpointRequest
$sel:containers:CreateContainerServiceDeployment' :: CreateContainerServiceDeployment -> Maybe (HashMap Text Container)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"containers" 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 Container)
containers,
            (Key
"publicEndpoint" 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 EndpointRequest
publicEndpoint,
            forall a. a -> Maybe a
Prelude.Just (Key
"serviceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceName)
          ]
      )

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

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

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

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

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

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

instance
  Prelude.NFData
    CreateContainerServiceDeploymentResponse
  where
  rnf :: CreateContainerServiceDeploymentResponse -> ()
rnf CreateContainerServiceDeploymentResponse' {Int
Maybe ContainerService
httpStatus :: Int
containerService :: Maybe ContainerService
$sel:httpStatus:CreateContainerServiceDeploymentResponse' :: CreateContainerServiceDeploymentResponse -> Int
$sel:containerService:CreateContainerServiceDeploymentResponse' :: CreateContainerServiceDeploymentResponse -> 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