{-# 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.Route53RecoveryCluster.UpdateRoutingControlStates
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Set multiple routing control states. You can set the value for each
-- state to be On or Off. When the state is On, traffic flows to a cell.
-- When it\'s Off, traffic does not flow.
--
-- With Route 53 ARC, you can add safety rules for routing controls, which
-- are safeguards for routing control state updates that help prevent
-- unexpected outcomes, like fail open traffic routing. However, there are
-- scenarios when you might want to bypass the routing control safeguards
-- that are enforced with safety rules that you\'ve configured. For
-- example, you might want to fail over quickly for disaster recovery, and
-- one or more safety rules might be unexpectedly preventing you from
-- updating a routing control state to reroute traffic. In a \"break
-- glass\" scenario like this, you can override one or more safety rules to
-- change a routing control state and fail over your application.
--
-- The @SafetyRulesToOverride@ property enables you override one or more
-- safety rules and update routing control states. For more information,
-- see
-- <https://docs.aws.amazon.com/r53recovery/latest/dg/routing-control.override-safety-rule.html Override safety rules to reroute traffic>
-- in the Amazon Route 53 Application Recovery Controller Developer Guide.
--
-- /You must specify Regional endpoints when you work with API cluster
-- operations to get or update routing control states in Route 53 ARC./
--
-- To see a code example for getting a routing control state, including
-- accessing Regional cluster endpoints in sequence, see
-- <https://docs.aws.amazon.com/r53recovery/latest/dg/service_code_examples_actions.html API examples>
-- in the Amazon Route 53 Application Recovery Controller Developer Guide.
--
-- -   <https://docs.aws.amazon.com/r53recovery/latest/dg/routing-control.update.html Viewing and updating routing control states>
--
-- -   <https://docs.aws.amazon.com/r53recovery/latest/dg/routing-control.html Working with routing controls overall>
module Amazonka.Route53RecoveryCluster.UpdateRoutingControlStates
  ( -- * Creating a Request
    UpdateRoutingControlStates (..),
    newUpdateRoutingControlStates,

    -- * Request Lenses
    updateRoutingControlStates_safetyRulesToOverride,
    updateRoutingControlStates_updateRoutingControlStateEntries,

    -- * Destructuring the Response
    UpdateRoutingControlStatesResponse (..),
    newUpdateRoutingControlStatesResponse,

    -- * Response Lenses
    updateRoutingControlStatesResponse_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.Route53RecoveryCluster.Types

-- | /See:/ 'newUpdateRoutingControlStates' smart constructor.
data UpdateRoutingControlStates = UpdateRoutingControlStates'
  { -- | The Amazon Resource Names (ARNs) for the safety rules that you want to
    -- override when you\'re updating routing control states. You can override
    -- one safety rule or multiple safety rules by including one or more ARNs,
    -- separated by commas.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/r53recovery/latest/dg/routing-control.override-safety-rule.html Override safety rules to reroute traffic>
    -- in the Amazon Route 53 Application Recovery Controller Developer Guide.
    UpdateRoutingControlStates -> Maybe [Text]
safetyRulesToOverride :: Prelude.Maybe [Prelude.Text],
    -- | A set of routing control entries that you want to update.
    UpdateRoutingControlStates -> [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries :: [UpdateRoutingControlStateEntry]
  }
  deriving (UpdateRoutingControlStates -> UpdateRoutingControlStates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoutingControlStates -> UpdateRoutingControlStates -> Bool
$c/= :: UpdateRoutingControlStates -> UpdateRoutingControlStates -> Bool
== :: UpdateRoutingControlStates -> UpdateRoutingControlStates -> Bool
$c== :: UpdateRoutingControlStates -> UpdateRoutingControlStates -> Bool
Prelude.Eq, ReadPrec [UpdateRoutingControlStates]
ReadPrec UpdateRoutingControlStates
Int -> ReadS UpdateRoutingControlStates
ReadS [UpdateRoutingControlStates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoutingControlStates]
$creadListPrec :: ReadPrec [UpdateRoutingControlStates]
readPrec :: ReadPrec UpdateRoutingControlStates
$creadPrec :: ReadPrec UpdateRoutingControlStates
readList :: ReadS [UpdateRoutingControlStates]
$creadList :: ReadS [UpdateRoutingControlStates]
readsPrec :: Int -> ReadS UpdateRoutingControlStates
$creadsPrec :: Int -> ReadS UpdateRoutingControlStates
Prelude.Read, Int -> UpdateRoutingControlStates -> ShowS
[UpdateRoutingControlStates] -> ShowS
UpdateRoutingControlStates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoutingControlStates] -> ShowS
$cshowList :: [UpdateRoutingControlStates] -> ShowS
show :: UpdateRoutingControlStates -> String
$cshow :: UpdateRoutingControlStates -> String
showsPrec :: Int -> UpdateRoutingControlStates -> ShowS
$cshowsPrec :: Int -> UpdateRoutingControlStates -> ShowS
Prelude.Show, forall x.
Rep UpdateRoutingControlStates x -> UpdateRoutingControlStates
forall x.
UpdateRoutingControlStates -> Rep UpdateRoutingControlStates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRoutingControlStates x -> UpdateRoutingControlStates
$cfrom :: forall x.
UpdateRoutingControlStates -> Rep UpdateRoutingControlStates x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoutingControlStates' 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:
--
-- 'safetyRulesToOverride', 'updateRoutingControlStates_safetyRulesToOverride' - The Amazon Resource Names (ARNs) for the safety rules that you want to
-- override when you\'re updating routing control states. You can override
-- one safety rule or multiple safety rules by including one or more ARNs,
-- separated by commas.
--
-- For more information, see
-- <https://docs.aws.amazon.com/r53recovery/latest/dg/routing-control.override-safety-rule.html Override safety rules to reroute traffic>
-- in the Amazon Route 53 Application Recovery Controller Developer Guide.
--
-- 'updateRoutingControlStateEntries', 'updateRoutingControlStates_updateRoutingControlStateEntries' - A set of routing control entries that you want to update.
newUpdateRoutingControlStates ::
  UpdateRoutingControlStates
newUpdateRoutingControlStates :: UpdateRoutingControlStates
newUpdateRoutingControlStates =
  UpdateRoutingControlStates'
    { $sel:safetyRulesToOverride:UpdateRoutingControlStates' :: Maybe [Text]
safetyRulesToOverride =
        forall a. Maybe a
Prelude.Nothing,
      $sel:updateRoutingControlStateEntries:UpdateRoutingControlStates' :: [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | The Amazon Resource Names (ARNs) for the safety rules that you want to
-- override when you\'re updating routing control states. You can override
-- one safety rule or multiple safety rules by including one or more ARNs,
-- separated by commas.
--
-- For more information, see
-- <https://docs.aws.amazon.com/r53recovery/latest/dg/routing-control.override-safety-rule.html Override safety rules to reroute traffic>
-- in the Amazon Route 53 Application Recovery Controller Developer Guide.
updateRoutingControlStates_safetyRulesToOverride :: Lens.Lens' UpdateRoutingControlStates (Prelude.Maybe [Prelude.Text])
updateRoutingControlStates_safetyRulesToOverride :: Lens' UpdateRoutingControlStates (Maybe [Text])
updateRoutingControlStates_safetyRulesToOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoutingControlStates' {Maybe [Text]
safetyRulesToOverride :: Maybe [Text]
$sel:safetyRulesToOverride:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> Maybe [Text]
safetyRulesToOverride} -> Maybe [Text]
safetyRulesToOverride) (\s :: UpdateRoutingControlStates
s@UpdateRoutingControlStates' {} Maybe [Text]
a -> UpdateRoutingControlStates
s {$sel:safetyRulesToOverride:UpdateRoutingControlStates' :: Maybe [Text]
safetyRulesToOverride = Maybe [Text]
a} :: UpdateRoutingControlStates) 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

-- | A set of routing control entries that you want to update.
updateRoutingControlStates_updateRoutingControlStateEntries :: Lens.Lens' UpdateRoutingControlStates [UpdateRoutingControlStateEntry]
updateRoutingControlStates_updateRoutingControlStateEntries :: Lens' UpdateRoutingControlStates [UpdateRoutingControlStateEntry]
updateRoutingControlStates_updateRoutingControlStateEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoutingControlStates' {[UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries :: [UpdateRoutingControlStateEntry]
$sel:updateRoutingControlStateEntries:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries} -> [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries) (\s :: UpdateRoutingControlStates
s@UpdateRoutingControlStates' {} [UpdateRoutingControlStateEntry]
a -> UpdateRoutingControlStates
s {$sel:updateRoutingControlStateEntries:UpdateRoutingControlStates' :: [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries = [UpdateRoutingControlStateEntry]
a} :: UpdateRoutingControlStates) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest UpdateRoutingControlStates where
  type
    AWSResponse UpdateRoutingControlStates =
      UpdateRoutingControlStatesResponse
  request :: (Service -> Service)
-> UpdateRoutingControlStates -> Request UpdateRoutingControlStates
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 UpdateRoutingControlStates
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateRoutingControlStates)))
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 -> UpdateRoutingControlStatesResponse
UpdateRoutingControlStatesResponse'
            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 UpdateRoutingControlStates where
  hashWithSalt :: Int -> UpdateRoutingControlStates -> Int
hashWithSalt Int
_salt UpdateRoutingControlStates' {[UpdateRoutingControlStateEntry]
Maybe [Text]
updateRoutingControlStateEntries :: [UpdateRoutingControlStateEntry]
safetyRulesToOverride :: Maybe [Text]
$sel:updateRoutingControlStateEntries:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> [UpdateRoutingControlStateEntry]
$sel:safetyRulesToOverride:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
safetyRulesToOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries

instance Prelude.NFData UpdateRoutingControlStates where
  rnf :: UpdateRoutingControlStates -> ()
rnf UpdateRoutingControlStates' {[UpdateRoutingControlStateEntry]
Maybe [Text]
updateRoutingControlStateEntries :: [UpdateRoutingControlStateEntry]
safetyRulesToOverride :: Maybe [Text]
$sel:updateRoutingControlStateEntries:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> [UpdateRoutingControlStateEntry]
$sel:safetyRulesToOverride:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
safetyRulesToOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries

instance Data.ToHeaders UpdateRoutingControlStates where
  toHeaders :: UpdateRoutingControlStates -> 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
"ToggleCustomerAPI.UpdateRoutingControlStates" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateRoutingControlStates where
  toJSON :: UpdateRoutingControlStates -> Value
toJSON UpdateRoutingControlStates' {[UpdateRoutingControlStateEntry]
Maybe [Text]
updateRoutingControlStateEntries :: [UpdateRoutingControlStateEntry]
safetyRulesToOverride :: Maybe [Text]
$sel:updateRoutingControlStateEntries:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> [UpdateRoutingControlStateEntry]
$sel:safetyRulesToOverride:UpdateRoutingControlStates' :: UpdateRoutingControlStates -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"SafetyRulesToOverride" 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]
safetyRulesToOverride,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"UpdateRoutingControlStateEntries"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [UpdateRoutingControlStateEntry]
updateRoutingControlStateEntries
              )
          ]
      )

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

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

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

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

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

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