{-# 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.SSM.CancelCommand
-- 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 the command specified by the Command ID. There is no
-- guarantee that the command will be terminated and the underlying process
-- stopped.
module Amazonka.SSM.CancelCommand
  ( -- * Creating a Request
    CancelCommand (..),
    newCancelCommand,

    -- * Request Lenses
    cancelCommand_instanceIds,
    cancelCommand_commandId,

    -- * Destructuring the Response
    CancelCommandResponse (..),
    newCancelCommandResponse,

    -- * Response Lenses
    cancelCommandResponse_httpStatus,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SSM.Types

-- |
--
-- /See:/ 'newCancelCommand' smart constructor.
data CancelCommand = CancelCommand'
  { -- | (Optional) A list of managed node IDs on which you want to cancel the
    -- command. If not provided, the command is canceled on every node on which
    -- it was requested.
    CancelCommand -> Maybe [Text]
instanceIds :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the command you want to cancel.
    CancelCommand -> Text
commandId :: Prelude.Text
  }
  deriving (CancelCommand -> CancelCommand -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelCommand -> CancelCommand -> Bool
$c/= :: CancelCommand -> CancelCommand -> Bool
== :: CancelCommand -> CancelCommand -> Bool
$c== :: CancelCommand -> CancelCommand -> Bool
Prelude.Eq, ReadPrec [CancelCommand]
ReadPrec CancelCommand
Int -> ReadS CancelCommand
ReadS [CancelCommand]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelCommand]
$creadListPrec :: ReadPrec [CancelCommand]
readPrec :: ReadPrec CancelCommand
$creadPrec :: ReadPrec CancelCommand
readList :: ReadS [CancelCommand]
$creadList :: ReadS [CancelCommand]
readsPrec :: Int -> ReadS CancelCommand
$creadsPrec :: Int -> ReadS CancelCommand
Prelude.Read, Int -> CancelCommand -> ShowS
[CancelCommand] -> ShowS
CancelCommand -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelCommand] -> ShowS
$cshowList :: [CancelCommand] -> ShowS
show :: CancelCommand -> String
$cshow :: CancelCommand -> String
showsPrec :: Int -> CancelCommand -> ShowS
$cshowsPrec :: Int -> CancelCommand -> ShowS
Prelude.Show, forall x. Rep CancelCommand x -> CancelCommand
forall x. CancelCommand -> Rep CancelCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelCommand x -> CancelCommand
$cfrom :: forall x. CancelCommand -> Rep CancelCommand x
Prelude.Generic)

-- |
-- Create a value of 'CancelCommand' 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:
--
-- 'instanceIds', 'cancelCommand_instanceIds' - (Optional) A list of managed node IDs on which you want to cancel the
-- command. If not provided, the command is canceled on every node on which
-- it was requested.
--
-- 'commandId', 'cancelCommand_commandId' - The ID of the command you want to cancel.
newCancelCommand ::
  -- | 'commandId'
  Prelude.Text ->
  CancelCommand
newCancelCommand :: Text -> CancelCommand
newCancelCommand Text
pCommandId_ =
  CancelCommand'
    { $sel:instanceIds:CancelCommand' :: Maybe [Text]
instanceIds = forall a. Maybe a
Prelude.Nothing,
      $sel:commandId:CancelCommand' :: Text
commandId = Text
pCommandId_
    }

-- | (Optional) A list of managed node IDs on which you want to cancel the
-- command. If not provided, the command is canceled on every node on which
-- it was requested.
cancelCommand_instanceIds :: Lens.Lens' CancelCommand (Prelude.Maybe [Prelude.Text])
cancelCommand_instanceIds :: Lens' CancelCommand (Maybe [Text])
cancelCommand_instanceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelCommand' {Maybe [Text]
instanceIds :: Maybe [Text]
$sel:instanceIds:CancelCommand' :: CancelCommand -> Maybe [Text]
instanceIds} -> Maybe [Text]
instanceIds) (\s :: CancelCommand
s@CancelCommand' {} Maybe [Text]
a -> CancelCommand
s {$sel:instanceIds:CancelCommand' :: Maybe [Text]
instanceIds = Maybe [Text]
a} :: CancelCommand) 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 ID of the command you want to cancel.
cancelCommand_commandId :: Lens.Lens' CancelCommand Prelude.Text
cancelCommand_commandId :: Lens' CancelCommand Text
cancelCommand_commandId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelCommand' {Text
commandId :: Text
$sel:commandId:CancelCommand' :: CancelCommand -> Text
commandId} -> Text
commandId) (\s :: CancelCommand
s@CancelCommand' {} Text
a -> CancelCommand
s {$sel:commandId:CancelCommand' :: Text
commandId = Text
a} :: CancelCommand)

instance Core.AWSRequest CancelCommand where
  type
    AWSResponse CancelCommand =
      CancelCommandResponse
  request :: (Service -> Service) -> CancelCommand -> Request CancelCommand
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 CancelCommand
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CancelCommand)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> CancelCommandResponse
CancelCommandResponse'
            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))
      )

instance Prelude.Hashable CancelCommand where
  hashWithSalt :: Int -> CancelCommand -> Int
hashWithSalt Int
_salt CancelCommand' {Maybe [Text]
Text
commandId :: Text
instanceIds :: Maybe [Text]
$sel:commandId:CancelCommand' :: CancelCommand -> Text
$sel:instanceIds:CancelCommand' :: CancelCommand -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
instanceIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
commandId

instance Prelude.NFData CancelCommand where
  rnf :: CancelCommand -> ()
rnf CancelCommand' {Maybe [Text]
Text
commandId :: Text
instanceIds :: Maybe [Text]
$sel:commandId:CancelCommand' :: CancelCommand -> Text
$sel:instanceIds:CancelCommand' :: CancelCommand -> Maybe [Text]
..} =
    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 Text
commandId

instance Data.ToHeaders CancelCommand where
  toHeaders :: CancelCommand -> 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
"AmazonSSM.CancelCommand" :: 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 CancelCommand where
  toJSON :: CancelCommand -> Value
toJSON CancelCommand' {Maybe [Text]
Text
commandId :: Text
instanceIds :: Maybe [Text]
$sel:commandId:CancelCommand' :: CancelCommand -> Text
$sel:instanceIds:CancelCommand' :: CancelCommand -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"CommandId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
commandId)
          ]
      )

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

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

-- | Whether or not the command was successfully canceled. There is no
-- guarantee that a request can be canceled.
--
-- /See:/ 'newCancelCommandResponse' smart constructor.
data CancelCommandResponse = CancelCommandResponse'
  { -- | The response's http status code.
    CancelCommandResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CancelCommandResponse -> CancelCommandResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelCommandResponse -> CancelCommandResponse -> Bool
$c/= :: CancelCommandResponse -> CancelCommandResponse -> Bool
== :: CancelCommandResponse -> CancelCommandResponse -> Bool
$c== :: CancelCommandResponse -> CancelCommandResponse -> Bool
Prelude.Eq, ReadPrec [CancelCommandResponse]
ReadPrec CancelCommandResponse
Int -> ReadS CancelCommandResponse
ReadS [CancelCommandResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelCommandResponse]
$creadListPrec :: ReadPrec [CancelCommandResponse]
readPrec :: ReadPrec CancelCommandResponse
$creadPrec :: ReadPrec CancelCommandResponse
readList :: ReadS [CancelCommandResponse]
$creadList :: ReadS [CancelCommandResponse]
readsPrec :: Int -> ReadS CancelCommandResponse
$creadsPrec :: Int -> ReadS CancelCommandResponse
Prelude.Read, Int -> CancelCommandResponse -> ShowS
[CancelCommandResponse] -> ShowS
CancelCommandResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelCommandResponse] -> ShowS
$cshowList :: [CancelCommandResponse] -> ShowS
show :: CancelCommandResponse -> String
$cshow :: CancelCommandResponse -> String
showsPrec :: Int -> CancelCommandResponse -> ShowS
$cshowsPrec :: Int -> CancelCommandResponse -> ShowS
Prelude.Show, forall x. Rep CancelCommandResponse x -> CancelCommandResponse
forall x. CancelCommandResponse -> Rep CancelCommandResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelCommandResponse x -> CancelCommandResponse
$cfrom :: forall x. CancelCommandResponse -> Rep CancelCommandResponse x
Prelude.Generic)

-- |
-- Create a value of 'CancelCommandResponse' 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', 'cancelCommandResponse_httpStatus' - The response's http status code.
newCancelCommandResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelCommandResponse
newCancelCommandResponse :: Int -> CancelCommandResponse
newCancelCommandResponse Int
pHttpStatus_ =
  CancelCommandResponse' {$sel:httpStatus:CancelCommandResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData CancelCommandResponse where
  rnf :: CancelCommandResponse -> ()
rnf CancelCommandResponse' {Int
httpStatus :: Int
$sel:httpStatus:CancelCommandResponse' :: CancelCommandResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus