{-# 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.M2.CreateDeployment
-- 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 and starts a deployment to deploy an application into a runtime
-- environment.
module Amazonka.M2.CreateDeployment
  ( -- * Creating a Request
    CreateDeployment (..),
    newCreateDeployment,

    -- * Request Lenses
    createDeployment_clientToken,
    createDeployment_applicationId,
    createDeployment_applicationVersion,
    createDeployment_environmentId,

    -- * Destructuring the Response
    CreateDeploymentResponse (..),
    newCreateDeploymentResponse,

    -- * Response Lenses
    createDeploymentResponse_httpStatus,
    createDeploymentResponse_deploymentId,
  )
where

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

-- | /See:/ 'newCreateDeployment' smart constructor.
data CreateDeployment = CreateDeployment'
  { -- | Unique, case-sensitive identifier you provide to ensure the idempotency
    -- of the request to create a deployment. The service generates the
    -- clientToken when the API call is triggered. The token expires after one
    -- hour, so if you retry the API within this timeframe with the same
    -- clientToken, you will get the same response. The service also handles
    -- deleting the clientToken after it expires.
    CreateDeployment -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The application identifier.
    CreateDeployment -> Text
applicationId :: Prelude.Text,
    -- | The version of the application to deploy.
    CreateDeployment -> Natural
applicationVersion :: Prelude.Natural,
    -- | The identifier of the runtime environment where you want to deploy this
    -- application.
    CreateDeployment -> Text
environmentId :: Prelude.Text
  }
  deriving (CreateDeployment -> CreateDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDeployment -> CreateDeployment -> Bool
$c/= :: CreateDeployment -> CreateDeployment -> Bool
== :: CreateDeployment -> CreateDeployment -> Bool
$c== :: CreateDeployment -> CreateDeployment -> Bool
Prelude.Eq, ReadPrec [CreateDeployment]
ReadPrec CreateDeployment
Int -> ReadS CreateDeployment
ReadS [CreateDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDeployment]
$creadListPrec :: ReadPrec [CreateDeployment]
readPrec :: ReadPrec CreateDeployment
$creadPrec :: ReadPrec CreateDeployment
readList :: ReadS [CreateDeployment]
$creadList :: ReadS [CreateDeployment]
readsPrec :: Int -> ReadS CreateDeployment
$creadsPrec :: Int -> ReadS CreateDeployment
Prelude.Read, Int -> CreateDeployment -> ShowS
[CreateDeployment] -> ShowS
CreateDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDeployment] -> ShowS
$cshowList :: [CreateDeployment] -> ShowS
show :: CreateDeployment -> String
$cshow :: CreateDeployment -> String
showsPrec :: Int -> CreateDeployment -> ShowS
$cshowsPrec :: Int -> CreateDeployment -> ShowS
Prelude.Show, forall x. Rep CreateDeployment x -> CreateDeployment
forall x. CreateDeployment -> Rep CreateDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDeployment x -> CreateDeployment
$cfrom :: forall x. CreateDeployment -> Rep CreateDeployment x
Prelude.Generic)

-- |
-- Create a value of 'CreateDeployment' 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:
--
-- 'clientToken', 'createDeployment_clientToken' - Unique, case-sensitive identifier you provide to ensure the idempotency
-- of the request to create a deployment. The service generates the
-- clientToken when the API call is triggered. The token expires after one
-- hour, so if you retry the API within this timeframe with the same
-- clientToken, you will get the same response. The service also handles
-- deleting the clientToken after it expires.
--
-- 'applicationId', 'createDeployment_applicationId' - The application identifier.
--
-- 'applicationVersion', 'createDeployment_applicationVersion' - The version of the application to deploy.
--
-- 'environmentId', 'createDeployment_environmentId' - The identifier of the runtime environment where you want to deploy this
-- application.
newCreateDeployment ::
  -- | 'applicationId'
  Prelude.Text ->
  -- | 'applicationVersion'
  Prelude.Natural ->
  -- | 'environmentId'
  Prelude.Text ->
  CreateDeployment
newCreateDeployment :: Text -> Natural -> Text -> CreateDeployment
newCreateDeployment
  Text
pApplicationId_
  Natural
pApplicationVersion_
  Text
pEnvironmentId_ =
    CreateDeployment'
      { $sel:clientToken:CreateDeployment' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:applicationId:CreateDeployment' :: Text
applicationId = Text
pApplicationId_,
        $sel:applicationVersion:CreateDeployment' :: Natural
applicationVersion = Natural
pApplicationVersion_,
        $sel:environmentId:CreateDeployment' :: Text
environmentId = Text
pEnvironmentId_
      }

-- | Unique, case-sensitive identifier you provide to ensure the idempotency
-- of the request to create a deployment. The service generates the
-- clientToken when the API call is triggered. The token expires after one
-- hour, so if you retry the API within this timeframe with the same
-- clientToken, you will get the same response. The service also handles
-- deleting the clientToken after it expires.
createDeployment_clientToken :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_clientToken :: Lens' CreateDeployment (Maybe Text)
createDeployment_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:clientToken:CreateDeployment' :: Maybe Text
clientToken = Maybe Text
a} :: CreateDeployment)

-- | The application identifier.
createDeployment_applicationId :: Lens.Lens' CreateDeployment Prelude.Text
createDeployment_applicationId :: Lens' CreateDeployment Text
createDeployment_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Text
applicationId :: Text
$sel:applicationId:CreateDeployment' :: CreateDeployment -> Text
applicationId} -> Text
applicationId) (\s :: CreateDeployment
s@CreateDeployment' {} Text
a -> CreateDeployment
s {$sel:applicationId:CreateDeployment' :: Text
applicationId = Text
a} :: CreateDeployment)

-- | The version of the application to deploy.
createDeployment_applicationVersion :: Lens.Lens' CreateDeployment Prelude.Natural
createDeployment_applicationVersion :: Lens' CreateDeployment Natural
createDeployment_applicationVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Natural
applicationVersion :: Natural
$sel:applicationVersion:CreateDeployment' :: CreateDeployment -> Natural
applicationVersion} -> Natural
applicationVersion) (\s :: CreateDeployment
s@CreateDeployment' {} Natural
a -> CreateDeployment
s {$sel:applicationVersion:CreateDeployment' :: Natural
applicationVersion = Natural
a} :: CreateDeployment)

-- | The identifier of the runtime environment where you want to deploy this
-- application.
createDeployment_environmentId :: Lens.Lens' CreateDeployment Prelude.Text
createDeployment_environmentId :: Lens' CreateDeployment Text
createDeployment_environmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Text
environmentId :: Text
$sel:environmentId:CreateDeployment' :: CreateDeployment -> Text
environmentId} -> Text
environmentId) (\s :: CreateDeployment
s@CreateDeployment' {} Text
a -> CreateDeployment
s {$sel:environmentId:CreateDeployment' :: Text
environmentId = Text
a} :: CreateDeployment)

instance Core.AWSRequest CreateDeployment where
  type
    AWSResponse CreateDeployment =
      CreateDeploymentResponse
  request :: (Service -> Service)
-> CreateDeployment -> Request CreateDeployment
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 CreateDeployment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDeployment)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> CreateDeploymentResponse
CreateDeploymentResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"deploymentId")
      )

instance Prelude.Hashable CreateDeployment where
  hashWithSalt :: Int -> CreateDeployment -> Int
hashWithSalt Int
_salt CreateDeployment' {Natural
Maybe Text
Text
environmentId :: Text
applicationVersion :: Natural
applicationId :: Text
clientToken :: Maybe Text
$sel:environmentId:CreateDeployment' :: CreateDeployment -> Text
$sel:applicationVersion:CreateDeployment' :: CreateDeployment -> Natural
$sel:applicationId:CreateDeployment' :: CreateDeployment -> Text
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
applicationVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentId

instance Prelude.NFData CreateDeployment where
  rnf :: CreateDeployment -> ()
rnf CreateDeployment' {Natural
Maybe Text
Text
environmentId :: Text
applicationVersion :: Natural
applicationId :: Text
clientToken :: Maybe Text
$sel:environmentId:CreateDeployment' :: CreateDeployment -> Text
$sel:applicationVersion:CreateDeployment' :: CreateDeployment -> Natural
$sel:applicationId:CreateDeployment' :: CreateDeployment -> Text
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
applicationVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
environmentId

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

instance Data.ToJSON CreateDeployment where
  toJSON :: CreateDeployment -> Value
toJSON CreateDeployment' {Natural
Maybe Text
Text
environmentId :: Text
applicationVersion :: Natural
applicationId :: Text
clientToken :: Maybe Text
$sel:environmentId:CreateDeployment' :: CreateDeployment -> Text
$sel:applicationVersion:CreateDeployment' :: CreateDeployment -> Natural
$sel:applicationId:CreateDeployment' :: CreateDeployment -> Text
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"applicationVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
applicationVersion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"environmentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
environmentId)
          ]
      )

instance Data.ToPath CreateDeployment where
  toPath :: CreateDeployment -> ByteString
toPath CreateDeployment' {Natural
Maybe Text
Text
environmentId :: Text
applicationVersion :: Natural
applicationId :: Text
clientToken :: Maybe Text
$sel:environmentId:CreateDeployment' :: CreateDeployment -> Text
$sel:applicationVersion:CreateDeployment' :: CreateDeployment -> Natural
$sel:applicationId:CreateDeployment' :: CreateDeployment -> Text
$sel:clientToken:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/applications/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
applicationId,
        ByteString
"/deployments"
      ]

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

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

-- |
-- Create a value of 'CreateDeploymentResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'createDeploymentResponse_httpStatus' - The response's http status code.
--
-- 'deploymentId', 'createDeploymentResponse_deploymentId' - The unique identifier of the deployment.
newCreateDeploymentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'deploymentId'
  Prelude.Text ->
  CreateDeploymentResponse
newCreateDeploymentResponse :: Int -> Text -> CreateDeploymentResponse
newCreateDeploymentResponse
  Int
pHttpStatus_
  Text
pDeploymentId_ =
    CreateDeploymentResponse'
      { $sel:httpStatus:CreateDeploymentResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:deploymentId:CreateDeploymentResponse' :: Text
deploymentId = Text
pDeploymentId_
      }

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

-- | The unique identifier of the deployment.
createDeploymentResponse_deploymentId :: Lens.Lens' CreateDeploymentResponse Prelude.Text
createDeploymentResponse_deploymentId :: Lens' CreateDeploymentResponse Text
createDeploymentResponse_deploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentResponse' {Text
deploymentId :: Text
$sel:deploymentId:CreateDeploymentResponse' :: CreateDeploymentResponse -> Text
deploymentId} -> Text
deploymentId) (\s :: CreateDeploymentResponse
s@CreateDeploymentResponse' {} Text
a -> CreateDeploymentResponse
s {$sel:deploymentId:CreateDeploymentResponse' :: Text
deploymentId = Text
a} :: CreateDeploymentResponse)

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