{-# 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.CloudFormation.SignalResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sends a signal to the specified resource with a success or failure
-- status. You can use the @SignalResource@ operation in conjunction with a
-- creation policy or update policy. CloudFormation doesn\'t proceed with a
-- stack creation or update until resources receive the required number of
-- signals or the timeout period is exceeded. The @SignalResource@
-- operation is useful in cases where you want to send signals from
-- anywhere other than an Amazon EC2 instance.
module Amazonka.CloudFormation.SignalResource
  ( -- * Creating a Request
    SignalResource (..),
    newSignalResource,

    -- * Request Lenses
    signalResource_stackName,
    signalResource_logicalResourceId,
    signalResource_uniqueId,
    signalResource_status,

    -- * Destructuring the Response
    SignalResourceResponse (..),
    newSignalResourceResponse,
  )
where

import Amazonka.CloudFormation.Types
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

-- | The input for the SignalResource action.
--
-- /See:/ 'newSignalResource' smart constructor.
data SignalResource = SignalResource'
  { -- | The stack name or unique stack ID that includes the resource that you
    -- want to signal.
    SignalResource -> Text
stackName :: Prelude.Text,
    -- | The logical ID of the resource that you want to signal. The logical ID
    -- is the name of the resource that given in the template.
    SignalResource -> Text
logicalResourceId :: Prelude.Text,
    -- | A unique ID of the signal. When you signal Amazon EC2 instances or Auto
    -- Scaling groups, specify the instance ID that you are signaling as the
    -- unique ID. If you send multiple signals to a single resource (such as
    -- signaling a wait condition), each signal requires a different unique ID.
    SignalResource -> Text
uniqueId :: Prelude.Text,
    -- | The status of the signal, which is either success or failure. A failure
    -- signal causes CloudFormation to immediately fail the stack creation or
    -- update.
    SignalResource -> ResourceSignalStatus
status :: ResourceSignalStatus
  }
  deriving (SignalResource -> SignalResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalResource -> SignalResource -> Bool
$c/= :: SignalResource -> SignalResource -> Bool
== :: SignalResource -> SignalResource -> Bool
$c== :: SignalResource -> SignalResource -> Bool
Prelude.Eq, ReadPrec [SignalResource]
ReadPrec SignalResource
Int -> ReadS SignalResource
ReadS [SignalResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignalResource]
$creadListPrec :: ReadPrec [SignalResource]
readPrec :: ReadPrec SignalResource
$creadPrec :: ReadPrec SignalResource
readList :: ReadS [SignalResource]
$creadList :: ReadS [SignalResource]
readsPrec :: Int -> ReadS SignalResource
$creadsPrec :: Int -> ReadS SignalResource
Prelude.Read, Int -> SignalResource -> ShowS
[SignalResource] -> ShowS
SignalResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalResource] -> ShowS
$cshowList :: [SignalResource] -> ShowS
show :: SignalResource -> String
$cshow :: SignalResource -> String
showsPrec :: Int -> SignalResource -> ShowS
$cshowsPrec :: Int -> SignalResource -> ShowS
Prelude.Show, forall x. Rep SignalResource x -> SignalResource
forall x. SignalResource -> Rep SignalResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SignalResource x -> SignalResource
$cfrom :: forall x. SignalResource -> Rep SignalResource x
Prelude.Generic)

-- |
-- Create a value of 'SignalResource' 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:
--
-- 'stackName', 'signalResource_stackName' - The stack name or unique stack ID that includes the resource that you
-- want to signal.
--
-- 'logicalResourceId', 'signalResource_logicalResourceId' - The logical ID of the resource that you want to signal. The logical ID
-- is the name of the resource that given in the template.
--
-- 'uniqueId', 'signalResource_uniqueId' - A unique ID of the signal. When you signal Amazon EC2 instances or Auto
-- Scaling groups, specify the instance ID that you are signaling as the
-- unique ID. If you send multiple signals to a single resource (such as
-- signaling a wait condition), each signal requires a different unique ID.
--
-- 'status', 'signalResource_status' - The status of the signal, which is either success or failure. A failure
-- signal causes CloudFormation to immediately fail the stack creation or
-- update.
newSignalResource ::
  -- | 'stackName'
  Prelude.Text ->
  -- | 'logicalResourceId'
  Prelude.Text ->
  -- | 'uniqueId'
  Prelude.Text ->
  -- | 'status'
  ResourceSignalStatus ->
  SignalResource
newSignalResource :: Text -> Text -> Text -> ResourceSignalStatus -> SignalResource
newSignalResource
  Text
pStackName_
  Text
pLogicalResourceId_
  Text
pUniqueId_
  ResourceSignalStatus
pStatus_ =
    SignalResource'
      { $sel:stackName:SignalResource' :: Text
stackName = Text
pStackName_,
        $sel:logicalResourceId:SignalResource' :: Text
logicalResourceId = Text
pLogicalResourceId_,
        $sel:uniqueId:SignalResource' :: Text
uniqueId = Text
pUniqueId_,
        $sel:status:SignalResource' :: ResourceSignalStatus
status = ResourceSignalStatus
pStatus_
      }

-- | The stack name or unique stack ID that includes the resource that you
-- want to signal.
signalResource_stackName :: Lens.Lens' SignalResource Prelude.Text
signalResource_stackName :: Lens' SignalResource Text
signalResource_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SignalResource' {Text
stackName :: Text
$sel:stackName:SignalResource' :: SignalResource -> Text
stackName} -> Text
stackName) (\s :: SignalResource
s@SignalResource' {} Text
a -> SignalResource
s {$sel:stackName:SignalResource' :: Text
stackName = Text
a} :: SignalResource)

-- | The logical ID of the resource that you want to signal. The logical ID
-- is the name of the resource that given in the template.
signalResource_logicalResourceId :: Lens.Lens' SignalResource Prelude.Text
signalResource_logicalResourceId :: Lens' SignalResource Text
signalResource_logicalResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SignalResource' {Text
logicalResourceId :: Text
$sel:logicalResourceId:SignalResource' :: SignalResource -> Text
logicalResourceId} -> Text
logicalResourceId) (\s :: SignalResource
s@SignalResource' {} Text
a -> SignalResource
s {$sel:logicalResourceId:SignalResource' :: Text
logicalResourceId = Text
a} :: SignalResource)

-- | A unique ID of the signal. When you signal Amazon EC2 instances or Auto
-- Scaling groups, specify the instance ID that you are signaling as the
-- unique ID. If you send multiple signals to a single resource (such as
-- signaling a wait condition), each signal requires a different unique ID.
signalResource_uniqueId :: Lens.Lens' SignalResource Prelude.Text
signalResource_uniqueId :: Lens' SignalResource Text
signalResource_uniqueId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SignalResource' {Text
uniqueId :: Text
$sel:uniqueId:SignalResource' :: SignalResource -> Text
uniqueId} -> Text
uniqueId) (\s :: SignalResource
s@SignalResource' {} Text
a -> SignalResource
s {$sel:uniqueId:SignalResource' :: Text
uniqueId = Text
a} :: SignalResource)

-- | The status of the signal, which is either success or failure. A failure
-- signal causes CloudFormation to immediately fail the stack creation or
-- update.
signalResource_status :: Lens.Lens' SignalResource ResourceSignalStatus
signalResource_status :: Lens' SignalResource ResourceSignalStatus
signalResource_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SignalResource' {ResourceSignalStatus
status :: ResourceSignalStatus
$sel:status:SignalResource' :: SignalResource -> ResourceSignalStatus
status} -> ResourceSignalStatus
status) (\s :: SignalResource
s@SignalResource' {} ResourceSignalStatus
a -> SignalResource
s {$sel:status:SignalResource' :: ResourceSignalStatus
status = ResourceSignalStatus
a} :: SignalResource)

instance Core.AWSRequest SignalResource where
  type
    AWSResponse SignalResource =
      SignalResourceResponse
  request :: (Service -> Service) -> SignalResource -> Request SignalResource
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy SignalResource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse SignalResource)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull SignalResourceResponse
SignalResourceResponse'

instance Prelude.Hashable SignalResource where
  hashWithSalt :: Int -> SignalResource -> Int
hashWithSalt Int
_salt SignalResource' {Text
ResourceSignalStatus
status :: ResourceSignalStatus
uniqueId :: Text
logicalResourceId :: Text
stackName :: Text
$sel:status:SignalResource' :: SignalResource -> ResourceSignalStatus
$sel:uniqueId:SignalResource' :: SignalResource -> Text
$sel:logicalResourceId:SignalResource' :: SignalResource -> Text
$sel:stackName:SignalResource' :: SignalResource -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logicalResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
uniqueId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceSignalStatus
status

instance Prelude.NFData SignalResource where
  rnf :: SignalResource -> ()
rnf SignalResource' {Text
ResourceSignalStatus
status :: ResourceSignalStatus
uniqueId :: Text
logicalResourceId :: Text
stackName :: Text
$sel:status:SignalResource' :: SignalResource -> ResourceSignalStatus
$sel:uniqueId:SignalResource' :: SignalResource -> Text
$sel:logicalResourceId:SignalResource' :: SignalResource -> Text
$sel:stackName:SignalResource' :: SignalResource -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
stackName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
logicalResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uniqueId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceSignalStatus
status

instance Data.ToHeaders SignalResource where
  toHeaders :: SignalResource -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery SignalResource where
  toQuery :: SignalResource -> QueryString
toQuery SignalResource' {Text
ResourceSignalStatus
status :: ResourceSignalStatus
uniqueId :: Text
logicalResourceId :: Text
stackName :: Text
$sel:status:SignalResource' :: SignalResource -> ResourceSignalStatus
$sel:uniqueId:SignalResource' :: SignalResource -> Text
$sel:logicalResourceId:SignalResource' :: SignalResource -> Text
$sel:stackName:SignalResource' :: SignalResource -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"SignalResource" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackName,
        ByteString
"LogicalResourceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
logicalResourceId,
        ByteString
"UniqueId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
uniqueId,
        ByteString
"Status" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ResourceSignalStatus
status
      ]

-- | /See:/ 'newSignalResourceResponse' smart constructor.
data SignalResourceResponse = SignalResourceResponse'
  {
  }
  deriving (SignalResourceResponse -> SignalResourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignalResourceResponse -> SignalResourceResponse -> Bool
$c/= :: SignalResourceResponse -> SignalResourceResponse -> Bool
== :: SignalResourceResponse -> SignalResourceResponse -> Bool
$c== :: SignalResourceResponse -> SignalResourceResponse -> Bool
Prelude.Eq, ReadPrec [SignalResourceResponse]
ReadPrec SignalResourceResponse
Int -> ReadS SignalResourceResponse
ReadS [SignalResourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignalResourceResponse]
$creadListPrec :: ReadPrec [SignalResourceResponse]
readPrec :: ReadPrec SignalResourceResponse
$creadPrec :: ReadPrec SignalResourceResponse
readList :: ReadS [SignalResourceResponse]
$creadList :: ReadS [SignalResourceResponse]
readsPrec :: Int -> ReadS SignalResourceResponse
$creadsPrec :: Int -> ReadS SignalResourceResponse
Prelude.Read, Int -> SignalResourceResponse -> ShowS
[SignalResourceResponse] -> ShowS
SignalResourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignalResourceResponse] -> ShowS
$cshowList :: [SignalResourceResponse] -> ShowS
show :: SignalResourceResponse -> String
$cshow :: SignalResourceResponse -> String
showsPrec :: Int -> SignalResourceResponse -> ShowS
$cshowsPrec :: Int -> SignalResourceResponse -> ShowS
Prelude.Show, forall x. Rep SignalResourceResponse x -> SignalResourceResponse
forall x. SignalResourceResponse -> Rep SignalResourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SignalResourceResponse x -> SignalResourceResponse
$cfrom :: forall x. SignalResourceResponse -> Rep SignalResourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'SignalResourceResponse' 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.
newSignalResourceResponse ::
  SignalResourceResponse
newSignalResourceResponse :: SignalResourceResponse
newSignalResourceResponse = SignalResourceResponse
SignalResourceResponse'

instance Prelude.NFData SignalResourceResponse where
  rnf :: SignalResourceResponse -> ()
rnf SignalResourceResponse
_ = ()