{-# 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.Proton.CancelEnvironmentDeployment
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Attempts to cancel an environment deployment on an UpdateEnvironment
-- action, if the deployment is @IN_PROGRESS@. For more information, see
-- <https://docs.aws.amazon.com/proton/latest/userguide/ag-env-update.html Update an environment>
-- in the /Proton User guide/.
--
-- The following list includes potential cancellation scenarios.
--
-- -   If the cancellation attempt succeeds, the resulting deployment state
--     is @CANCELLED@.
--
-- -   If the cancellation attempt fails, the resulting deployment state is
--     @FAILED@.
--
-- -   If the current UpdateEnvironment action succeeds before the
--     cancellation attempt starts, the resulting deployment state is
--     @SUCCEEDED@ and the cancellation attempt has no effect.
module Amazonka.Proton.CancelEnvironmentDeployment
  ( -- * Creating a Request
    CancelEnvironmentDeployment (..),
    newCancelEnvironmentDeployment,

    -- * Request Lenses
    cancelEnvironmentDeployment_environmentName,

    -- * Destructuring the Response
    CancelEnvironmentDeploymentResponse (..),
    newCancelEnvironmentDeploymentResponse,

    -- * Response Lenses
    cancelEnvironmentDeploymentResponse_httpStatus,
    cancelEnvironmentDeploymentResponse_environment,
  )
where

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

-- | /See:/ 'newCancelEnvironmentDeployment' smart constructor.
data CancelEnvironmentDeployment = CancelEnvironmentDeployment'
  { -- | The name of the environment with the deployment to cancel.
    CancelEnvironmentDeployment -> Text
environmentName :: Prelude.Text
  }
  deriving (CancelEnvironmentDeployment -> CancelEnvironmentDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelEnvironmentDeployment -> CancelEnvironmentDeployment -> Bool
$c/= :: CancelEnvironmentDeployment -> CancelEnvironmentDeployment -> Bool
== :: CancelEnvironmentDeployment -> CancelEnvironmentDeployment -> Bool
$c== :: CancelEnvironmentDeployment -> CancelEnvironmentDeployment -> Bool
Prelude.Eq, ReadPrec [CancelEnvironmentDeployment]
ReadPrec CancelEnvironmentDeployment
Int -> ReadS CancelEnvironmentDeployment
ReadS [CancelEnvironmentDeployment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelEnvironmentDeployment]
$creadListPrec :: ReadPrec [CancelEnvironmentDeployment]
readPrec :: ReadPrec CancelEnvironmentDeployment
$creadPrec :: ReadPrec CancelEnvironmentDeployment
readList :: ReadS [CancelEnvironmentDeployment]
$creadList :: ReadS [CancelEnvironmentDeployment]
readsPrec :: Int -> ReadS CancelEnvironmentDeployment
$creadsPrec :: Int -> ReadS CancelEnvironmentDeployment
Prelude.Read, Int -> CancelEnvironmentDeployment -> ShowS
[CancelEnvironmentDeployment] -> ShowS
CancelEnvironmentDeployment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelEnvironmentDeployment] -> ShowS
$cshowList :: [CancelEnvironmentDeployment] -> ShowS
show :: CancelEnvironmentDeployment -> String
$cshow :: CancelEnvironmentDeployment -> String
showsPrec :: Int -> CancelEnvironmentDeployment -> ShowS
$cshowsPrec :: Int -> CancelEnvironmentDeployment -> ShowS
Prelude.Show, forall x.
Rep CancelEnvironmentDeployment x -> CancelEnvironmentDeployment
forall x.
CancelEnvironmentDeployment -> Rep CancelEnvironmentDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CancelEnvironmentDeployment x -> CancelEnvironmentDeployment
$cfrom :: forall x.
CancelEnvironmentDeployment -> Rep CancelEnvironmentDeployment x
Prelude.Generic)

-- |
-- Create a value of 'CancelEnvironmentDeployment' 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:
--
-- 'environmentName', 'cancelEnvironmentDeployment_environmentName' - The name of the environment with the deployment to cancel.
newCancelEnvironmentDeployment ::
  -- | 'environmentName'
  Prelude.Text ->
  CancelEnvironmentDeployment
newCancelEnvironmentDeployment :: Text -> CancelEnvironmentDeployment
newCancelEnvironmentDeployment Text
pEnvironmentName_ =
  CancelEnvironmentDeployment'
    { $sel:environmentName:CancelEnvironmentDeployment' :: Text
environmentName =
        Text
pEnvironmentName_
    }

-- | The name of the environment with the deployment to cancel.
cancelEnvironmentDeployment_environmentName :: Lens.Lens' CancelEnvironmentDeployment Prelude.Text
cancelEnvironmentDeployment_environmentName :: Lens' CancelEnvironmentDeployment Text
cancelEnvironmentDeployment_environmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelEnvironmentDeployment' {Text
environmentName :: Text
$sel:environmentName:CancelEnvironmentDeployment' :: CancelEnvironmentDeployment -> Text
environmentName} -> Text
environmentName) (\s :: CancelEnvironmentDeployment
s@CancelEnvironmentDeployment' {} Text
a -> CancelEnvironmentDeployment
s {$sel:environmentName:CancelEnvironmentDeployment' :: Text
environmentName = Text
a} :: CancelEnvironmentDeployment)

instance Core.AWSRequest CancelEnvironmentDeployment where
  type
    AWSResponse CancelEnvironmentDeployment =
      CancelEnvironmentDeploymentResponse
  request :: (Service -> Service)
-> CancelEnvironmentDeployment
-> Request CancelEnvironmentDeployment
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 CancelEnvironmentDeployment
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CancelEnvironmentDeployment)))
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 -> Environment -> CancelEnvironmentDeploymentResponse
CancelEnvironmentDeploymentResponse'
            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
"environment")
      )

instance Prelude.Hashable CancelEnvironmentDeployment where
  hashWithSalt :: Int -> CancelEnvironmentDeployment -> Int
hashWithSalt Int
_salt CancelEnvironmentDeployment' {Text
environmentName :: Text
$sel:environmentName:CancelEnvironmentDeployment' :: CancelEnvironmentDeployment -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
environmentName

instance Prelude.NFData CancelEnvironmentDeployment where
  rnf :: CancelEnvironmentDeployment -> ()
rnf CancelEnvironmentDeployment' {Text
environmentName :: Text
$sel:environmentName:CancelEnvironmentDeployment' :: CancelEnvironmentDeployment -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
environmentName

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

instance Data.ToJSON CancelEnvironmentDeployment where
  toJSON :: CancelEnvironmentDeployment -> Value
toJSON CancelEnvironmentDeployment' {Text
environmentName :: Text
$sel:environmentName:CancelEnvironmentDeployment' :: CancelEnvironmentDeployment -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"environmentName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
environmentName)
          ]
      )

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

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

-- | /See:/ 'newCancelEnvironmentDeploymentResponse' smart constructor.
data CancelEnvironmentDeploymentResponse = CancelEnvironmentDeploymentResponse'
  { -- | The response's http status code.
    CancelEnvironmentDeploymentResponse -> Int
httpStatus :: Prelude.Int,
    -- | The environment summary data that\'s returned by Proton.
    CancelEnvironmentDeploymentResponse -> Environment
environment :: Environment
  }
  deriving (CancelEnvironmentDeploymentResponse
-> CancelEnvironmentDeploymentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelEnvironmentDeploymentResponse
-> CancelEnvironmentDeploymentResponse -> Bool
$c/= :: CancelEnvironmentDeploymentResponse
-> CancelEnvironmentDeploymentResponse -> Bool
== :: CancelEnvironmentDeploymentResponse
-> CancelEnvironmentDeploymentResponse -> Bool
$c== :: CancelEnvironmentDeploymentResponse
-> CancelEnvironmentDeploymentResponse -> Bool
Prelude.Eq, Int -> CancelEnvironmentDeploymentResponse -> ShowS
[CancelEnvironmentDeploymentResponse] -> ShowS
CancelEnvironmentDeploymentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelEnvironmentDeploymentResponse] -> ShowS
$cshowList :: [CancelEnvironmentDeploymentResponse] -> ShowS
show :: CancelEnvironmentDeploymentResponse -> String
$cshow :: CancelEnvironmentDeploymentResponse -> String
showsPrec :: Int -> CancelEnvironmentDeploymentResponse -> ShowS
$cshowsPrec :: Int -> CancelEnvironmentDeploymentResponse -> ShowS
Prelude.Show, forall x.
Rep CancelEnvironmentDeploymentResponse x
-> CancelEnvironmentDeploymentResponse
forall x.
CancelEnvironmentDeploymentResponse
-> Rep CancelEnvironmentDeploymentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CancelEnvironmentDeploymentResponse x
-> CancelEnvironmentDeploymentResponse
$cfrom :: forall x.
CancelEnvironmentDeploymentResponse
-> Rep CancelEnvironmentDeploymentResponse x
Prelude.Generic)

-- |
-- Create a value of 'CancelEnvironmentDeploymentResponse' 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', 'cancelEnvironmentDeploymentResponse_httpStatus' - The response's http status code.
--
-- 'environment', 'cancelEnvironmentDeploymentResponse_environment' - The environment summary data that\'s returned by Proton.
newCancelEnvironmentDeploymentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'environment'
  Environment ->
  CancelEnvironmentDeploymentResponse
newCancelEnvironmentDeploymentResponse :: Int -> Environment -> CancelEnvironmentDeploymentResponse
newCancelEnvironmentDeploymentResponse
  Int
pHttpStatus_
  Environment
pEnvironment_ =
    CancelEnvironmentDeploymentResponse'
      { $sel:httpStatus:CancelEnvironmentDeploymentResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:environment:CancelEnvironmentDeploymentResponse' :: Environment
environment = Environment
pEnvironment_
      }

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

-- | The environment summary data that\'s returned by Proton.
cancelEnvironmentDeploymentResponse_environment :: Lens.Lens' CancelEnvironmentDeploymentResponse Environment
cancelEnvironmentDeploymentResponse_environment :: Lens' CancelEnvironmentDeploymentResponse Environment
cancelEnvironmentDeploymentResponse_environment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelEnvironmentDeploymentResponse' {Environment
environment :: Environment
$sel:environment:CancelEnvironmentDeploymentResponse' :: CancelEnvironmentDeploymentResponse -> Environment
environment} -> Environment
environment) (\s :: CancelEnvironmentDeploymentResponse
s@CancelEnvironmentDeploymentResponse' {} Environment
a -> CancelEnvironmentDeploymentResponse
s {$sel:environment:CancelEnvironmentDeploymentResponse' :: Environment
environment = Environment
a} :: CancelEnvironmentDeploymentResponse)

instance
  Prelude.NFData
    CancelEnvironmentDeploymentResponse
  where
  rnf :: CancelEnvironmentDeploymentResponse -> ()
rnf CancelEnvironmentDeploymentResponse' {Int
Environment
environment :: Environment
httpStatus :: Int
$sel:environment:CancelEnvironmentDeploymentResponse' :: CancelEnvironmentDeploymentResponse -> Environment
$sel:httpStatus:CancelEnvironmentDeploymentResponse' :: CancelEnvironmentDeploymentResponse -> 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 Environment
environment