{-# 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.Synthetics.StopCanary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops the canary to prevent all future runs. If the canary is currently
-- running,the run that is in progress completes on its own, publishes
-- metrics, and uploads artifacts, but it is not recorded in Synthetics as
-- a completed run.
--
-- You can use @StartCanary@ to start it running again with the canary’s
-- current schedule at any point in the future.
module Amazonka.Synthetics.StopCanary
  ( -- * Creating a Request
    StopCanary (..),
    newStopCanary,

    -- * Request Lenses
    stopCanary_name,

    -- * Destructuring the Response
    StopCanaryResponse (..),
    newStopCanaryResponse,

    -- * Response Lenses
    stopCanaryResponse_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.Synthetics.Types

-- | /See:/ 'newStopCanary' smart constructor.
data StopCanary = StopCanary'
  { -- | The name of the canary that you want to stop. To find the names of your
    -- canaries, use
    -- <https://docs.aws.amazon.com/AmazonSynthetics/latest/APIReference/API_DescribeCanaries.html ListCanaries>.
    StopCanary -> Text
name :: Prelude.Text
  }
  deriving (StopCanary -> StopCanary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopCanary -> StopCanary -> Bool
$c/= :: StopCanary -> StopCanary -> Bool
== :: StopCanary -> StopCanary -> Bool
$c== :: StopCanary -> StopCanary -> Bool
Prelude.Eq, ReadPrec [StopCanary]
ReadPrec StopCanary
Int -> ReadS StopCanary
ReadS [StopCanary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopCanary]
$creadListPrec :: ReadPrec [StopCanary]
readPrec :: ReadPrec StopCanary
$creadPrec :: ReadPrec StopCanary
readList :: ReadS [StopCanary]
$creadList :: ReadS [StopCanary]
readsPrec :: Int -> ReadS StopCanary
$creadsPrec :: Int -> ReadS StopCanary
Prelude.Read, Int -> StopCanary -> ShowS
[StopCanary] -> ShowS
StopCanary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopCanary] -> ShowS
$cshowList :: [StopCanary] -> ShowS
show :: StopCanary -> String
$cshow :: StopCanary -> String
showsPrec :: Int -> StopCanary -> ShowS
$cshowsPrec :: Int -> StopCanary -> ShowS
Prelude.Show, forall x. Rep StopCanary x -> StopCanary
forall x. StopCanary -> Rep StopCanary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopCanary x -> StopCanary
$cfrom :: forall x. StopCanary -> Rep StopCanary x
Prelude.Generic)

-- |
-- Create a value of 'StopCanary' 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:
--
-- 'name', 'stopCanary_name' - The name of the canary that you want to stop. To find the names of your
-- canaries, use
-- <https://docs.aws.amazon.com/AmazonSynthetics/latest/APIReference/API_DescribeCanaries.html ListCanaries>.
newStopCanary ::
  -- | 'name'
  Prelude.Text ->
  StopCanary
newStopCanary :: Text -> StopCanary
newStopCanary Text
pName_ = StopCanary' {$sel:name:StopCanary' :: Text
name = Text
pName_}

-- | The name of the canary that you want to stop. To find the names of your
-- canaries, use
-- <https://docs.aws.amazon.com/AmazonSynthetics/latest/APIReference/API_DescribeCanaries.html ListCanaries>.
stopCanary_name :: Lens.Lens' StopCanary Prelude.Text
stopCanary_name :: Lens' StopCanary Text
stopCanary_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopCanary' {Text
name :: Text
$sel:name:StopCanary' :: StopCanary -> Text
name} -> Text
name) (\s :: StopCanary
s@StopCanary' {} Text
a -> StopCanary
s {$sel:name:StopCanary' :: Text
name = Text
a} :: StopCanary)

instance Core.AWSRequest StopCanary where
  type AWSResponse StopCanary = StopCanaryResponse
  request :: (Service -> Service) -> StopCanary -> Request StopCanary
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 StopCanary
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopCanary)))
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 -> StopCanaryResponse
StopCanaryResponse'
            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 StopCanary where
  hashWithSalt :: Int -> StopCanary -> Int
hashWithSalt Int
_salt StopCanary' {Text
name :: Text
$sel:name:StopCanary' :: StopCanary -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders StopCanary where
  toHeaders :: StopCanary -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StopCanary where
  toJSON :: StopCanary -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath StopCanary where
  toPath :: StopCanary -> ByteString
toPath StopCanary' {Text
name :: Text
$sel:name:StopCanary' :: StopCanary -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/canary/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name, ByteString
"/stop"]

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

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

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

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

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