{-# 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.Route53RecoveryControlConfig.UpdateSafetyRule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update a safety rule (an assertion rule or gating rule). You can only
-- update the name and the waiting period for a safety rule. To make other
-- updates, delete the safety rule and create a new one.
module Amazonka.Route53RecoveryControlConfig.UpdateSafetyRule
  ( -- * Creating a Request
    UpdateSafetyRule (..),
    newUpdateSafetyRule,

    -- * Request Lenses
    updateSafetyRule_assertionRuleUpdate,
    updateSafetyRule_gatingRuleUpdate,

    -- * Destructuring the Response
    UpdateSafetyRuleResponse (..),
    newUpdateSafetyRuleResponse,

    -- * Response Lenses
    updateSafetyRuleResponse_assertionRule,
    updateSafetyRuleResponse_gatingRule,
    updateSafetyRuleResponse_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.Route53RecoveryControlConfig.Types

-- | A rule that you add to Application Recovery Controller to ensure that
-- recovery actions don\'t accidentally impair your application\'s
-- availability.
--
-- /See:/ 'newUpdateSafetyRule' smart constructor.
data UpdateSafetyRule = UpdateSafetyRule'
  { -- | The assertion rule to update.
    UpdateSafetyRule -> Maybe AssertionRuleUpdate
assertionRuleUpdate :: Prelude.Maybe AssertionRuleUpdate,
    -- | The gating rule to update.
    UpdateSafetyRule -> Maybe GatingRuleUpdate
gatingRuleUpdate :: Prelude.Maybe GatingRuleUpdate
  }
  deriving (UpdateSafetyRule -> UpdateSafetyRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSafetyRule -> UpdateSafetyRule -> Bool
$c/= :: UpdateSafetyRule -> UpdateSafetyRule -> Bool
== :: UpdateSafetyRule -> UpdateSafetyRule -> Bool
$c== :: UpdateSafetyRule -> UpdateSafetyRule -> Bool
Prelude.Eq, ReadPrec [UpdateSafetyRule]
ReadPrec UpdateSafetyRule
Int -> ReadS UpdateSafetyRule
ReadS [UpdateSafetyRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSafetyRule]
$creadListPrec :: ReadPrec [UpdateSafetyRule]
readPrec :: ReadPrec UpdateSafetyRule
$creadPrec :: ReadPrec UpdateSafetyRule
readList :: ReadS [UpdateSafetyRule]
$creadList :: ReadS [UpdateSafetyRule]
readsPrec :: Int -> ReadS UpdateSafetyRule
$creadsPrec :: Int -> ReadS UpdateSafetyRule
Prelude.Read, Int -> UpdateSafetyRule -> ShowS
[UpdateSafetyRule] -> ShowS
UpdateSafetyRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSafetyRule] -> ShowS
$cshowList :: [UpdateSafetyRule] -> ShowS
show :: UpdateSafetyRule -> String
$cshow :: UpdateSafetyRule -> String
showsPrec :: Int -> UpdateSafetyRule -> ShowS
$cshowsPrec :: Int -> UpdateSafetyRule -> ShowS
Prelude.Show, forall x. Rep UpdateSafetyRule x -> UpdateSafetyRule
forall x. UpdateSafetyRule -> Rep UpdateSafetyRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSafetyRule x -> UpdateSafetyRule
$cfrom :: forall x. UpdateSafetyRule -> Rep UpdateSafetyRule x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSafetyRule' 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:
--
-- 'assertionRuleUpdate', 'updateSafetyRule_assertionRuleUpdate' - The assertion rule to update.
--
-- 'gatingRuleUpdate', 'updateSafetyRule_gatingRuleUpdate' - The gating rule to update.
newUpdateSafetyRule ::
  UpdateSafetyRule
newUpdateSafetyRule :: UpdateSafetyRule
newUpdateSafetyRule =
  UpdateSafetyRule'
    { $sel:assertionRuleUpdate:UpdateSafetyRule' :: Maybe AssertionRuleUpdate
assertionRuleUpdate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:gatingRuleUpdate:UpdateSafetyRule' :: Maybe GatingRuleUpdate
gatingRuleUpdate = forall a. Maybe a
Prelude.Nothing
    }

-- | The assertion rule to update.
updateSafetyRule_assertionRuleUpdate :: Lens.Lens' UpdateSafetyRule (Prelude.Maybe AssertionRuleUpdate)
updateSafetyRule_assertionRuleUpdate :: Lens' UpdateSafetyRule (Maybe AssertionRuleUpdate)
updateSafetyRule_assertionRuleUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSafetyRule' {Maybe AssertionRuleUpdate
assertionRuleUpdate :: Maybe AssertionRuleUpdate
$sel:assertionRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe AssertionRuleUpdate
assertionRuleUpdate} -> Maybe AssertionRuleUpdate
assertionRuleUpdate) (\s :: UpdateSafetyRule
s@UpdateSafetyRule' {} Maybe AssertionRuleUpdate
a -> UpdateSafetyRule
s {$sel:assertionRuleUpdate:UpdateSafetyRule' :: Maybe AssertionRuleUpdate
assertionRuleUpdate = Maybe AssertionRuleUpdate
a} :: UpdateSafetyRule)

-- | The gating rule to update.
updateSafetyRule_gatingRuleUpdate :: Lens.Lens' UpdateSafetyRule (Prelude.Maybe GatingRuleUpdate)
updateSafetyRule_gatingRuleUpdate :: Lens' UpdateSafetyRule (Maybe GatingRuleUpdate)
updateSafetyRule_gatingRuleUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSafetyRule' {Maybe GatingRuleUpdate
gatingRuleUpdate :: Maybe GatingRuleUpdate
$sel:gatingRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe GatingRuleUpdate
gatingRuleUpdate} -> Maybe GatingRuleUpdate
gatingRuleUpdate) (\s :: UpdateSafetyRule
s@UpdateSafetyRule' {} Maybe GatingRuleUpdate
a -> UpdateSafetyRule
s {$sel:gatingRuleUpdate:UpdateSafetyRule' :: Maybe GatingRuleUpdate
gatingRuleUpdate = Maybe GatingRuleUpdate
a} :: UpdateSafetyRule)

instance Core.AWSRequest UpdateSafetyRule where
  type
    AWSResponse UpdateSafetyRule =
      UpdateSafetyRuleResponse
  request :: (Service -> Service)
-> UpdateSafetyRule -> Request UpdateSafetyRule
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateSafetyRule
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateSafetyRule)))
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 AssertionRule
-> Maybe GatingRule -> Int -> UpdateSafetyRuleResponse
UpdateSafetyRuleResponse'
            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
"AssertionRule")
            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
"GatingRule")
            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 UpdateSafetyRule where
  hashWithSalt :: Int -> UpdateSafetyRule -> Int
hashWithSalt Int
_salt UpdateSafetyRule' {Maybe AssertionRuleUpdate
Maybe GatingRuleUpdate
gatingRuleUpdate :: Maybe GatingRuleUpdate
assertionRuleUpdate :: Maybe AssertionRuleUpdate
$sel:gatingRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe GatingRuleUpdate
$sel:assertionRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe AssertionRuleUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AssertionRuleUpdate
assertionRuleUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GatingRuleUpdate
gatingRuleUpdate

instance Prelude.NFData UpdateSafetyRule where
  rnf :: UpdateSafetyRule -> ()
rnf UpdateSafetyRule' {Maybe AssertionRuleUpdate
Maybe GatingRuleUpdate
gatingRuleUpdate :: Maybe GatingRuleUpdate
assertionRuleUpdate :: Maybe AssertionRuleUpdate
$sel:gatingRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe GatingRuleUpdate
$sel:assertionRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe AssertionRuleUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AssertionRuleUpdate
assertionRuleUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GatingRuleUpdate
gatingRuleUpdate

instance Data.ToHeaders UpdateSafetyRule where
  toHeaders :: UpdateSafetyRule -> 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 UpdateSafetyRule where
  toJSON :: UpdateSafetyRule -> Value
toJSON UpdateSafetyRule' {Maybe AssertionRuleUpdate
Maybe GatingRuleUpdate
gatingRuleUpdate :: Maybe GatingRuleUpdate
assertionRuleUpdate :: Maybe AssertionRuleUpdate
$sel:gatingRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe GatingRuleUpdate
$sel:assertionRuleUpdate:UpdateSafetyRule' :: UpdateSafetyRule -> Maybe AssertionRuleUpdate
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AssertionRuleUpdate" 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 AssertionRuleUpdate
assertionRuleUpdate,
            (Key
"GatingRuleUpdate" 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 GatingRuleUpdate
gatingRuleUpdate
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateSafetyRuleResponse' 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:
--
-- 'assertionRule', 'updateSafetyRuleResponse_assertionRule' - The assertion rule updated.
--
-- 'gatingRule', 'updateSafetyRuleResponse_gatingRule' - The gating rule updated.
--
-- 'httpStatus', 'updateSafetyRuleResponse_httpStatus' - The response's http status code.
newUpdateSafetyRuleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSafetyRuleResponse
newUpdateSafetyRuleResponse :: Int -> UpdateSafetyRuleResponse
newUpdateSafetyRuleResponse Int
pHttpStatus_ =
  UpdateSafetyRuleResponse'
    { $sel:assertionRule:UpdateSafetyRuleResponse' :: Maybe AssertionRule
assertionRule =
        forall a. Maybe a
Prelude.Nothing,
      $sel:gatingRule:UpdateSafetyRuleResponse' :: Maybe GatingRule
gatingRule = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateSafetyRuleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The assertion rule updated.
updateSafetyRuleResponse_assertionRule :: Lens.Lens' UpdateSafetyRuleResponse (Prelude.Maybe AssertionRule)
updateSafetyRuleResponse_assertionRule :: Lens' UpdateSafetyRuleResponse (Maybe AssertionRule)
updateSafetyRuleResponse_assertionRule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSafetyRuleResponse' {Maybe AssertionRule
assertionRule :: Maybe AssertionRule
$sel:assertionRule:UpdateSafetyRuleResponse' :: UpdateSafetyRuleResponse -> Maybe AssertionRule
assertionRule} -> Maybe AssertionRule
assertionRule) (\s :: UpdateSafetyRuleResponse
s@UpdateSafetyRuleResponse' {} Maybe AssertionRule
a -> UpdateSafetyRuleResponse
s {$sel:assertionRule:UpdateSafetyRuleResponse' :: Maybe AssertionRule
assertionRule = Maybe AssertionRule
a} :: UpdateSafetyRuleResponse)

-- | The gating rule updated.
updateSafetyRuleResponse_gatingRule :: Lens.Lens' UpdateSafetyRuleResponse (Prelude.Maybe GatingRule)
updateSafetyRuleResponse_gatingRule :: Lens' UpdateSafetyRuleResponse (Maybe GatingRule)
updateSafetyRuleResponse_gatingRule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSafetyRuleResponse' {Maybe GatingRule
gatingRule :: Maybe GatingRule
$sel:gatingRule:UpdateSafetyRuleResponse' :: UpdateSafetyRuleResponse -> Maybe GatingRule
gatingRule} -> Maybe GatingRule
gatingRule) (\s :: UpdateSafetyRuleResponse
s@UpdateSafetyRuleResponse' {} Maybe GatingRule
a -> UpdateSafetyRuleResponse
s {$sel:gatingRule:UpdateSafetyRuleResponse' :: Maybe GatingRule
gatingRule = Maybe GatingRule
a} :: UpdateSafetyRuleResponse)

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

instance Prelude.NFData UpdateSafetyRuleResponse where
  rnf :: UpdateSafetyRuleResponse -> ()
rnf UpdateSafetyRuleResponse' {Int
Maybe GatingRule
Maybe AssertionRule
httpStatus :: Int
gatingRule :: Maybe GatingRule
assertionRule :: Maybe AssertionRule
$sel:httpStatus:UpdateSafetyRuleResponse' :: UpdateSafetyRuleResponse -> Int
$sel:gatingRule:UpdateSafetyRuleResponse' :: UpdateSafetyRuleResponse -> Maybe GatingRule
$sel:assertionRule:UpdateSafetyRuleResponse' :: UpdateSafetyRuleResponse -> Maybe AssertionRule
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AssertionRule
assertionRule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GatingRule
gatingRule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus