{-# 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.OpsWorks.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)
--
-- Runs deployment or stack commands. For more information, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingapps-deploying.html Deploying Apps>
-- and
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingstacks-commands.html Run Stack Commands>.
--
-- __Required Permissions__: To use this action, an IAM user must have a
-- Deploy or Manage permissions level for the stack, or an attached policy
-- that explicitly grants permissions. For more information on user
-- permissions, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/opsworks-security-users.html Managing User Permissions>.
module Amazonka.OpsWorks.CreateDeployment
  ( -- * Creating a Request
    CreateDeployment (..),
    newCreateDeployment,

    -- * Request Lenses
    createDeployment_appId,
    createDeployment_comment,
    createDeployment_customJson,
    createDeployment_instanceIds,
    createDeployment_layerIds,
    createDeployment_stackId,
    createDeployment_command,

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

    -- * Response Lenses
    createDeploymentResponse_deploymentId,
    createDeploymentResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.OpsWorks.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'
  { -- | The app ID. This parameter is required for app deployments, but not for
    -- other deployment commands.
    CreateDeployment -> Maybe Text
appId :: Prelude.Maybe Prelude.Text,
    -- | A user-defined comment.
    CreateDeployment -> Maybe Text
comment :: Prelude.Maybe Prelude.Text,
    -- | A string that contains user-defined, custom JSON. You can use this
    -- parameter to override some corresponding default stack configuration
    -- JSON values. The string should be in the following format:
    --
    -- @\"{\\\"key1\\\": \\\"value1\\\", \\\"key2\\\": \\\"value2\\\",...}\"@
    --
    -- For more information about custom JSON, see
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingstacks-json.html Use Custom JSON to Modify the Stack Configuration Attributes>
    -- and
    -- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingcookbook-json-override.html Overriding Attributes With Custom JSON>.
    CreateDeployment -> Maybe Text
customJson :: Prelude.Maybe Prelude.Text,
    -- | The instance IDs for the deployment targets.
    CreateDeployment -> Maybe [Text]
instanceIds :: Prelude.Maybe [Prelude.Text],
    -- | The layer IDs for the deployment targets.
    CreateDeployment -> Maybe [Text]
layerIds :: Prelude.Maybe [Prelude.Text],
    -- | The stack ID.
    CreateDeployment -> Text
stackId :: Prelude.Text,
    -- | A @DeploymentCommand@ object that specifies the deployment command and
    -- any associated arguments.
    CreateDeployment -> DeploymentCommand
command :: DeploymentCommand
  }
  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:
--
-- 'appId', 'createDeployment_appId' - The app ID. This parameter is required for app deployments, but not for
-- other deployment commands.
--
-- 'comment', 'createDeployment_comment' - A user-defined comment.
--
-- 'customJson', 'createDeployment_customJson' - A string that contains user-defined, custom JSON. You can use this
-- parameter to override some corresponding default stack configuration
-- JSON values. The string should be in the following format:
--
-- @\"{\\\"key1\\\": \\\"value1\\\", \\\"key2\\\": \\\"value2\\\",...}\"@
--
-- For more information about custom JSON, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingstacks-json.html Use Custom JSON to Modify the Stack Configuration Attributes>
-- and
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingcookbook-json-override.html Overriding Attributes With Custom JSON>.
--
-- 'instanceIds', 'createDeployment_instanceIds' - The instance IDs for the deployment targets.
--
-- 'layerIds', 'createDeployment_layerIds' - The layer IDs for the deployment targets.
--
-- 'stackId', 'createDeployment_stackId' - The stack ID.
--
-- 'command', 'createDeployment_command' - A @DeploymentCommand@ object that specifies the deployment command and
-- any associated arguments.
newCreateDeployment ::
  -- | 'stackId'
  Prelude.Text ->
  -- | 'command'
  DeploymentCommand ->
  CreateDeployment
newCreateDeployment :: Text -> DeploymentCommand -> CreateDeployment
newCreateDeployment Text
pStackId_ DeploymentCommand
pCommand_ =
  CreateDeployment'
    { $sel:appId:CreateDeployment' :: Maybe Text
appId = forall a. Maybe a
Prelude.Nothing,
      $sel:comment:CreateDeployment' :: Maybe Text
comment = forall a. Maybe a
Prelude.Nothing,
      $sel:customJson:CreateDeployment' :: Maybe Text
customJson = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceIds:CreateDeployment' :: Maybe [Text]
instanceIds = forall a. Maybe a
Prelude.Nothing,
      $sel:layerIds:CreateDeployment' :: Maybe [Text]
layerIds = forall a. Maybe a
Prelude.Nothing,
      $sel:stackId:CreateDeployment' :: Text
stackId = Text
pStackId_,
      $sel:command:CreateDeployment' :: DeploymentCommand
command = DeploymentCommand
pCommand_
    }

-- | The app ID. This parameter is required for app deployments, but not for
-- other deployment commands.
createDeployment_appId :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_appId :: Lens' CreateDeployment (Maybe Text)
createDeployment_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
appId :: Maybe Text
$sel:appId:CreateDeployment' :: CreateDeployment -> Maybe Text
appId} -> Maybe Text
appId) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:appId:CreateDeployment' :: Maybe Text
appId = Maybe Text
a} :: CreateDeployment)

-- | A user-defined comment.
createDeployment_comment :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_comment :: Lens' CreateDeployment (Maybe Text)
createDeployment_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
comment :: Maybe Text
$sel:comment:CreateDeployment' :: CreateDeployment -> Maybe Text
comment} -> Maybe Text
comment) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:comment:CreateDeployment' :: Maybe Text
comment = Maybe Text
a} :: CreateDeployment)

-- | A string that contains user-defined, custom JSON. You can use this
-- parameter to override some corresponding default stack configuration
-- JSON values. The string should be in the following format:
--
-- @\"{\\\"key1\\\": \\\"value1\\\", \\\"key2\\\": \\\"value2\\\",...}\"@
--
-- For more information about custom JSON, see
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingstacks-json.html Use Custom JSON to Modify the Stack Configuration Attributes>
-- and
-- <https://docs.aws.amazon.com/opsworks/latest/userguide/workingcookbook-json-override.html Overriding Attributes With Custom JSON>.
createDeployment_customJson :: Lens.Lens' CreateDeployment (Prelude.Maybe Prelude.Text)
createDeployment_customJson :: Lens' CreateDeployment (Maybe Text)
createDeployment_customJson = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe Text
customJson :: Maybe Text
$sel:customJson:CreateDeployment' :: CreateDeployment -> Maybe Text
customJson} -> Maybe Text
customJson) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe Text
a -> CreateDeployment
s {$sel:customJson:CreateDeployment' :: Maybe Text
customJson = Maybe Text
a} :: CreateDeployment)

-- | The instance IDs for the deployment targets.
createDeployment_instanceIds :: Lens.Lens' CreateDeployment (Prelude.Maybe [Prelude.Text])
createDeployment_instanceIds :: Lens' CreateDeployment (Maybe [Text])
createDeployment_instanceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe [Text]
instanceIds :: Maybe [Text]
$sel:instanceIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
instanceIds} -> Maybe [Text]
instanceIds) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe [Text]
a -> CreateDeployment
s {$sel:instanceIds:CreateDeployment' :: Maybe [Text]
instanceIds = Maybe [Text]
a} :: CreateDeployment) 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 layer IDs for the deployment targets.
createDeployment_layerIds :: Lens.Lens' CreateDeployment (Prelude.Maybe [Prelude.Text])
createDeployment_layerIds :: Lens' CreateDeployment (Maybe [Text])
createDeployment_layerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Maybe [Text]
layerIds :: Maybe [Text]
$sel:layerIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
layerIds} -> Maybe [Text]
layerIds) (\s :: CreateDeployment
s@CreateDeployment' {} Maybe [Text]
a -> CreateDeployment
s {$sel:layerIds:CreateDeployment' :: Maybe [Text]
layerIds = Maybe [Text]
a} :: CreateDeployment) 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 stack ID.
createDeployment_stackId :: Lens.Lens' CreateDeployment Prelude.Text
createDeployment_stackId :: Lens' CreateDeployment Text
createDeployment_stackId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {Text
stackId :: Text
$sel:stackId:CreateDeployment' :: CreateDeployment -> Text
stackId} -> Text
stackId) (\s :: CreateDeployment
s@CreateDeployment' {} Text
a -> CreateDeployment
s {$sel:stackId:CreateDeployment' :: Text
stackId = Text
a} :: CreateDeployment)

-- | A @DeploymentCommand@ object that specifies the deployment command and
-- any associated arguments.
createDeployment_command :: Lens.Lens' CreateDeployment DeploymentCommand
createDeployment_command :: Lens' CreateDeployment DeploymentCommand
createDeployment_command = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeployment' {DeploymentCommand
command :: DeploymentCommand
$sel:command:CreateDeployment' :: CreateDeployment -> DeploymentCommand
command} -> DeploymentCommand
command) (\s :: CreateDeployment
s@CreateDeployment' {} DeploymentCommand
a -> CreateDeployment
s {$sel:command:CreateDeployment' :: DeploymentCommand
command = DeploymentCommand
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 ->
          Maybe Text -> Int -> CreateDeploymentResponse
CreateDeploymentResponse'
            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
"DeploymentId")
            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 CreateDeployment where
  hashWithSalt :: Int -> CreateDeployment -> Int
hashWithSalt Int
_salt CreateDeployment' {Maybe [Text]
Maybe Text
Text
DeploymentCommand
command :: DeploymentCommand
stackId :: Text
layerIds :: Maybe [Text]
instanceIds :: Maybe [Text]
customJson :: Maybe Text
comment :: Maybe Text
appId :: Maybe Text
$sel:command:CreateDeployment' :: CreateDeployment -> DeploymentCommand
$sel:stackId:CreateDeployment' :: CreateDeployment -> Text
$sel:layerIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
$sel:instanceIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
$sel:customJson:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:comment:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:appId:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
comment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customJson
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
instanceIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
layerIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DeploymentCommand
command

instance Prelude.NFData CreateDeployment where
  rnf :: CreateDeployment -> ()
rnf CreateDeployment' {Maybe [Text]
Maybe Text
Text
DeploymentCommand
command :: DeploymentCommand
stackId :: Text
layerIds :: Maybe [Text]
instanceIds :: Maybe [Text]
customJson :: Maybe Text
comment :: Maybe Text
appId :: Maybe Text
$sel:command:CreateDeployment' :: CreateDeployment -> DeploymentCommand
$sel:stackId:CreateDeployment' :: CreateDeployment -> Text
$sel:layerIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
$sel:instanceIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
$sel:customJson:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:comment:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:appId:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
comment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customJson
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
instanceIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
layerIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeploymentCommand
command

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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"OpsWorks_20130218.CreateDeployment" ::
                          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 CreateDeployment where
  toJSON :: CreateDeployment -> Value
toJSON CreateDeployment' {Maybe [Text]
Maybe Text
Text
DeploymentCommand
command :: DeploymentCommand
stackId :: Text
layerIds :: Maybe [Text]
instanceIds :: Maybe [Text]
customJson :: Maybe Text
comment :: Maybe Text
appId :: Maybe Text
$sel:command:CreateDeployment' :: CreateDeployment -> DeploymentCommand
$sel:stackId:CreateDeployment' :: CreateDeployment -> Text
$sel:layerIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
$sel:instanceIds:CreateDeployment' :: CreateDeployment -> Maybe [Text]
$sel:customJson:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:comment:CreateDeployment' :: CreateDeployment -> Maybe Text
$sel:appId:CreateDeployment' :: CreateDeployment -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AppId" 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
appId,
            (Key
"Comment" 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
comment,
            (Key
"CustomJson" 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
customJson,
            (Key
"InstanceIds" 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]
instanceIds,
            (Key
"LayerIds" 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]
layerIds,
            forall a. a -> Maybe a
Prelude.Just (Key
"StackId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stackId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Command" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DeploymentCommand
command)
          ]
      )

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

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

-- | Contains the response to a @CreateDeployment@ request.
--
-- /See:/ 'newCreateDeploymentResponse' smart constructor.
data CreateDeploymentResponse = CreateDeploymentResponse'
  { -- | The deployment ID, which can be used with other requests to identify the
    -- deployment.
    CreateDeploymentResponse -> Maybe Text
deploymentId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDeploymentResponse -> Int
httpStatus :: Prelude.Int
  }
  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:
--
-- 'deploymentId', 'createDeploymentResponse_deploymentId' - The deployment ID, which can be used with other requests to identify the
-- deployment.
--
-- 'httpStatus', 'createDeploymentResponse_httpStatus' - The response's http status code.
newCreateDeploymentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDeploymentResponse
newCreateDeploymentResponse :: Int -> CreateDeploymentResponse
newCreateDeploymentResponse Int
pHttpStatus_ =
  CreateDeploymentResponse'
    { $sel:deploymentId:CreateDeploymentResponse' :: Maybe Text
deploymentId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDeploymentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The deployment ID, which can be used with other requests to identify the
-- deployment.
createDeploymentResponse_deploymentId :: Lens.Lens' CreateDeploymentResponse (Prelude.Maybe Prelude.Text)
createDeploymentResponse_deploymentId :: Lens' CreateDeploymentResponse (Maybe Text)
createDeploymentResponse_deploymentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDeploymentResponse' {Maybe Text
deploymentId :: Maybe Text
$sel:deploymentId:CreateDeploymentResponse' :: CreateDeploymentResponse -> Maybe Text
deploymentId} -> Maybe Text
deploymentId) (\s :: CreateDeploymentResponse
s@CreateDeploymentResponse' {} Maybe Text
a -> CreateDeploymentResponse
s {$sel:deploymentId:CreateDeploymentResponse' :: Maybe Text
deploymentId = Maybe Text
a} :: CreateDeploymentResponse)

-- | 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)

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