{-# 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.CloudWatchEvents.CancelReplay
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels the specified replay.
module Amazonka.CloudWatchEvents.CancelReplay
  ( -- * Creating a Request
    CancelReplay (..),
    newCancelReplay,

    -- * Request Lenses
    cancelReplay_replayName,

    -- * Destructuring the Response
    CancelReplayResponse (..),
    newCancelReplayResponse,

    -- * Response Lenses
    cancelReplayResponse_replayArn,
    cancelReplayResponse_state,
    cancelReplayResponse_stateReason,
    cancelReplayResponse_httpStatus,
  )
where

import Amazonka.CloudWatchEvents.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

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

-- |
-- Create a value of 'CancelReplay' 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:
--
-- 'replayName', 'cancelReplay_replayName' - The name of the replay to cancel.
newCancelReplay ::
  -- | 'replayName'
  Prelude.Text ->
  CancelReplay
newCancelReplay :: Text -> CancelReplay
newCancelReplay Text
pReplayName_ =
  CancelReplay' {$sel:replayName:CancelReplay' :: Text
replayName = Text
pReplayName_}

-- | The name of the replay to cancel.
cancelReplay_replayName :: Lens.Lens' CancelReplay Prelude.Text
cancelReplay_replayName :: Lens' CancelReplay Text
cancelReplay_replayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelReplay' {Text
replayName :: Text
$sel:replayName:CancelReplay' :: CancelReplay -> Text
replayName} -> Text
replayName) (\s :: CancelReplay
s@CancelReplay' {} Text
a -> CancelReplay
s {$sel:replayName:CancelReplay' :: Text
replayName = Text
a} :: CancelReplay)

instance Core.AWSRequest CancelReplay where
  type AWSResponse CancelReplay = CancelReplayResponse
  request :: (Service -> Service) -> CancelReplay -> Request CancelReplay
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 CancelReplay
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CancelReplay)))
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
-> Maybe ReplayState -> Maybe Text -> Int -> CancelReplayResponse
CancelReplayResponse'
            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
"ReplayArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"State")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StateReason")
            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 CancelReplay where
  hashWithSalt :: Int -> CancelReplay -> Int
hashWithSalt Int
_salt CancelReplay' {Text
replayName :: Text
$sel:replayName:CancelReplay' :: CancelReplay -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
replayName

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

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

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

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

-- | /See:/ 'newCancelReplayResponse' smart constructor.
data CancelReplayResponse = CancelReplayResponse'
  { -- | The ARN of the replay to cancel.
    CancelReplayResponse -> Maybe Text
replayArn :: Prelude.Maybe Prelude.Text,
    -- | The current state of the replay.
    CancelReplayResponse -> Maybe ReplayState
state :: Prelude.Maybe ReplayState,
    -- | The reason that the replay is in the current state.
    CancelReplayResponse -> Maybe Text
stateReason :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CancelReplayResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CancelReplayResponse -> CancelReplayResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelReplayResponse -> CancelReplayResponse -> Bool
$c/= :: CancelReplayResponse -> CancelReplayResponse -> Bool
== :: CancelReplayResponse -> CancelReplayResponse -> Bool
$c== :: CancelReplayResponse -> CancelReplayResponse -> Bool
Prelude.Eq, ReadPrec [CancelReplayResponse]
ReadPrec CancelReplayResponse
Int -> ReadS CancelReplayResponse
ReadS [CancelReplayResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelReplayResponse]
$creadListPrec :: ReadPrec [CancelReplayResponse]
readPrec :: ReadPrec CancelReplayResponse
$creadPrec :: ReadPrec CancelReplayResponse
readList :: ReadS [CancelReplayResponse]
$creadList :: ReadS [CancelReplayResponse]
readsPrec :: Int -> ReadS CancelReplayResponse
$creadsPrec :: Int -> ReadS CancelReplayResponse
Prelude.Read, Int -> CancelReplayResponse -> ShowS
[CancelReplayResponse] -> ShowS
CancelReplayResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelReplayResponse] -> ShowS
$cshowList :: [CancelReplayResponse] -> ShowS
show :: CancelReplayResponse -> String
$cshow :: CancelReplayResponse -> String
showsPrec :: Int -> CancelReplayResponse -> ShowS
$cshowsPrec :: Int -> CancelReplayResponse -> ShowS
Prelude.Show, forall x. Rep CancelReplayResponse x -> CancelReplayResponse
forall x. CancelReplayResponse -> Rep CancelReplayResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelReplayResponse x -> CancelReplayResponse
$cfrom :: forall x. CancelReplayResponse -> Rep CancelReplayResponse x
Prelude.Generic)

-- |
-- Create a value of 'CancelReplayResponse' 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:
--
-- 'replayArn', 'cancelReplayResponse_replayArn' - The ARN of the replay to cancel.
--
-- 'state', 'cancelReplayResponse_state' - The current state of the replay.
--
-- 'stateReason', 'cancelReplayResponse_stateReason' - The reason that the replay is in the current state.
--
-- 'httpStatus', 'cancelReplayResponse_httpStatus' - The response's http status code.
newCancelReplayResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelReplayResponse
newCancelReplayResponse :: Int -> CancelReplayResponse
newCancelReplayResponse Int
pHttpStatus_ =
  CancelReplayResponse'
    { $sel:replayArn:CancelReplayResponse' :: Maybe Text
replayArn = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CancelReplayResponse' :: Maybe ReplayState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:stateReason:CancelReplayResponse' :: Maybe Text
stateReason = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CancelReplayResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the replay to cancel.
cancelReplayResponse_replayArn :: Lens.Lens' CancelReplayResponse (Prelude.Maybe Prelude.Text)
cancelReplayResponse_replayArn :: Lens' CancelReplayResponse (Maybe Text)
cancelReplayResponse_replayArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelReplayResponse' {Maybe Text
replayArn :: Maybe Text
$sel:replayArn:CancelReplayResponse' :: CancelReplayResponse -> Maybe Text
replayArn} -> Maybe Text
replayArn) (\s :: CancelReplayResponse
s@CancelReplayResponse' {} Maybe Text
a -> CancelReplayResponse
s {$sel:replayArn:CancelReplayResponse' :: Maybe Text
replayArn = Maybe Text
a} :: CancelReplayResponse)

-- | The current state of the replay.
cancelReplayResponse_state :: Lens.Lens' CancelReplayResponse (Prelude.Maybe ReplayState)
cancelReplayResponse_state :: Lens' CancelReplayResponse (Maybe ReplayState)
cancelReplayResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelReplayResponse' {Maybe ReplayState
state :: Maybe ReplayState
$sel:state:CancelReplayResponse' :: CancelReplayResponse -> Maybe ReplayState
state} -> Maybe ReplayState
state) (\s :: CancelReplayResponse
s@CancelReplayResponse' {} Maybe ReplayState
a -> CancelReplayResponse
s {$sel:state:CancelReplayResponse' :: Maybe ReplayState
state = Maybe ReplayState
a} :: CancelReplayResponse)

-- | The reason that the replay is in the current state.
cancelReplayResponse_stateReason :: Lens.Lens' CancelReplayResponse (Prelude.Maybe Prelude.Text)
cancelReplayResponse_stateReason :: Lens' CancelReplayResponse (Maybe Text)
cancelReplayResponse_stateReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelReplayResponse' {Maybe Text
stateReason :: Maybe Text
$sel:stateReason:CancelReplayResponse' :: CancelReplayResponse -> Maybe Text
stateReason} -> Maybe Text
stateReason) (\s :: CancelReplayResponse
s@CancelReplayResponse' {} Maybe Text
a -> CancelReplayResponse
s {$sel:stateReason:CancelReplayResponse' :: Maybe Text
stateReason = Maybe Text
a} :: CancelReplayResponse)

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

instance Prelude.NFData CancelReplayResponse where
  rnf :: CancelReplayResponse -> ()
rnf CancelReplayResponse' {Int
Maybe Text
Maybe ReplayState
httpStatus :: Int
stateReason :: Maybe Text
state :: Maybe ReplayState
replayArn :: Maybe Text
$sel:httpStatus:CancelReplayResponse' :: CancelReplayResponse -> Int
$sel:stateReason:CancelReplayResponse' :: CancelReplayResponse -> Maybe Text
$sel:state:CancelReplayResponse' :: CancelReplayResponse -> Maybe ReplayState
$sel:replayArn:CancelReplayResponse' :: CancelReplayResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
replayArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplayState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stateReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus