{-# 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.UpdateRoutingControlState
-- 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 the state of the routing control to reroute traffic. You can set the
-- value to be On or Off. When the state is On, traffic flows to a cell.
-- When the state is 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.UpdateRoutingControlState
  ( -- * Creating a Request
    UpdateRoutingControlState (..),
    newUpdateRoutingControlState,

    -- * Request Lenses
    updateRoutingControlState_safetyRulesToOverride,
    updateRoutingControlState_routingControlArn,
    updateRoutingControlState_routingControlState,

    -- * Destructuring the Response
    UpdateRoutingControlStateResponse (..),
    newUpdateRoutingControlStateResponse,

    -- * Response Lenses
    updateRoutingControlStateResponse_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:/ 'newUpdateRoutingControlState' smart constructor.
data UpdateRoutingControlState = UpdateRoutingControlState'
  { -- | The Amazon Resource Names (ARNs) for the safety rules that you want to
    -- override when you\'re updating the state of a routing control. 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.
    UpdateRoutingControlState -> Maybe [Text]
safetyRulesToOverride :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Resource Name (ARN) for the routing control that you want to
    -- update the state for.
    UpdateRoutingControlState -> Text
routingControlArn :: Prelude.Text,
    -- | The state of the routing control. You can set the value to be On or Off.
    UpdateRoutingControlState -> RoutingControlState
routingControlState :: RoutingControlState
  }
  deriving (UpdateRoutingControlState -> UpdateRoutingControlState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoutingControlState -> UpdateRoutingControlState -> Bool
$c/= :: UpdateRoutingControlState -> UpdateRoutingControlState -> Bool
== :: UpdateRoutingControlState -> UpdateRoutingControlState -> Bool
$c== :: UpdateRoutingControlState -> UpdateRoutingControlState -> Bool
Prelude.Eq, ReadPrec [UpdateRoutingControlState]
ReadPrec UpdateRoutingControlState
Int -> ReadS UpdateRoutingControlState
ReadS [UpdateRoutingControlState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoutingControlState]
$creadListPrec :: ReadPrec [UpdateRoutingControlState]
readPrec :: ReadPrec UpdateRoutingControlState
$creadPrec :: ReadPrec UpdateRoutingControlState
readList :: ReadS [UpdateRoutingControlState]
$creadList :: ReadS [UpdateRoutingControlState]
readsPrec :: Int -> ReadS UpdateRoutingControlState
$creadsPrec :: Int -> ReadS UpdateRoutingControlState
Prelude.Read, Int -> UpdateRoutingControlState -> ShowS
[UpdateRoutingControlState] -> ShowS
UpdateRoutingControlState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoutingControlState] -> ShowS
$cshowList :: [UpdateRoutingControlState] -> ShowS
show :: UpdateRoutingControlState -> String
$cshow :: UpdateRoutingControlState -> String
showsPrec :: Int -> UpdateRoutingControlState -> ShowS
$cshowsPrec :: Int -> UpdateRoutingControlState -> ShowS
Prelude.Show, forall x.
Rep UpdateRoutingControlState x -> UpdateRoutingControlState
forall x.
UpdateRoutingControlState -> Rep UpdateRoutingControlState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRoutingControlState x -> UpdateRoutingControlState
$cfrom :: forall x.
UpdateRoutingControlState -> Rep UpdateRoutingControlState x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoutingControlState' 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', 'updateRoutingControlState_safetyRulesToOverride' - The Amazon Resource Names (ARNs) for the safety rules that you want to
-- override when you\'re updating the state of a routing control. 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.
--
-- 'routingControlArn', 'updateRoutingControlState_routingControlArn' - The Amazon Resource Name (ARN) for the routing control that you want to
-- update the state for.
--
-- 'routingControlState', 'updateRoutingControlState_routingControlState' - The state of the routing control. You can set the value to be On or Off.
newUpdateRoutingControlState ::
  -- | 'routingControlArn'
  Prelude.Text ->
  -- | 'routingControlState'
  RoutingControlState ->
  UpdateRoutingControlState
newUpdateRoutingControlState :: Text -> RoutingControlState -> UpdateRoutingControlState
newUpdateRoutingControlState
  Text
pRoutingControlArn_
  RoutingControlState
pRoutingControlState_ =
    UpdateRoutingControlState'
      { $sel:safetyRulesToOverride:UpdateRoutingControlState' :: Maybe [Text]
safetyRulesToOverride =
          forall a. Maybe a
Prelude.Nothing,
        $sel:routingControlArn:UpdateRoutingControlState' :: Text
routingControlArn = Text
pRoutingControlArn_,
        $sel:routingControlState:UpdateRoutingControlState' :: RoutingControlState
routingControlState = RoutingControlState
pRoutingControlState_
      }

-- | The Amazon Resource Names (ARNs) for the safety rules that you want to
-- override when you\'re updating the state of a routing control. 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.
updateRoutingControlState_safetyRulesToOverride :: Lens.Lens' UpdateRoutingControlState (Prelude.Maybe [Prelude.Text])
updateRoutingControlState_safetyRulesToOverride :: Lens' UpdateRoutingControlState (Maybe [Text])
updateRoutingControlState_safetyRulesToOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoutingControlState' {Maybe [Text]
safetyRulesToOverride :: Maybe [Text]
$sel:safetyRulesToOverride:UpdateRoutingControlState' :: UpdateRoutingControlState -> Maybe [Text]
safetyRulesToOverride} -> Maybe [Text]
safetyRulesToOverride) (\s :: UpdateRoutingControlState
s@UpdateRoutingControlState' {} Maybe [Text]
a -> UpdateRoutingControlState
s {$sel:safetyRulesToOverride:UpdateRoutingControlState' :: Maybe [Text]
safetyRulesToOverride = Maybe [Text]
a} :: UpdateRoutingControlState) 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

-- | The Amazon Resource Name (ARN) for the routing control that you want to
-- update the state for.
updateRoutingControlState_routingControlArn :: Lens.Lens' UpdateRoutingControlState Prelude.Text
updateRoutingControlState_routingControlArn :: Lens' UpdateRoutingControlState Text
updateRoutingControlState_routingControlArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoutingControlState' {Text
routingControlArn :: Text
$sel:routingControlArn:UpdateRoutingControlState' :: UpdateRoutingControlState -> Text
routingControlArn} -> Text
routingControlArn) (\s :: UpdateRoutingControlState
s@UpdateRoutingControlState' {} Text
a -> UpdateRoutingControlState
s {$sel:routingControlArn:UpdateRoutingControlState' :: Text
routingControlArn = Text
a} :: UpdateRoutingControlState)

-- | The state of the routing control. You can set the value to be On or Off.
updateRoutingControlState_routingControlState :: Lens.Lens' UpdateRoutingControlState RoutingControlState
updateRoutingControlState_routingControlState :: Lens' UpdateRoutingControlState RoutingControlState
updateRoutingControlState_routingControlState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoutingControlState' {RoutingControlState
routingControlState :: RoutingControlState
$sel:routingControlState:UpdateRoutingControlState' :: UpdateRoutingControlState -> RoutingControlState
routingControlState} -> RoutingControlState
routingControlState) (\s :: UpdateRoutingControlState
s@UpdateRoutingControlState' {} RoutingControlState
a -> UpdateRoutingControlState
s {$sel:routingControlState:UpdateRoutingControlState' :: RoutingControlState
routingControlState = RoutingControlState
a} :: UpdateRoutingControlState)

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

instance Prelude.NFData UpdateRoutingControlState where
  rnf :: UpdateRoutingControlState -> ()
rnf UpdateRoutingControlState' {Maybe [Text]
Text
RoutingControlState
routingControlState :: RoutingControlState
routingControlArn :: Text
safetyRulesToOverride :: Maybe [Text]
$sel:routingControlState:UpdateRoutingControlState' :: UpdateRoutingControlState -> RoutingControlState
$sel:routingControlArn:UpdateRoutingControlState' :: UpdateRoutingControlState -> Text
$sel:safetyRulesToOverride:UpdateRoutingControlState' :: UpdateRoutingControlState -> 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 Text
routingControlArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RoutingControlState
routingControlState

instance Data.ToHeaders UpdateRoutingControlState where
  toHeaders :: UpdateRoutingControlState -> 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.UpdateRoutingControlState" ::
                          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 UpdateRoutingControlState where
  toJSON :: UpdateRoutingControlState -> Value
toJSON UpdateRoutingControlState' {Maybe [Text]
Text
RoutingControlState
routingControlState :: RoutingControlState
routingControlArn :: Text
safetyRulesToOverride :: Maybe [Text]
$sel:routingControlState:UpdateRoutingControlState' :: UpdateRoutingControlState -> RoutingControlState
$sel:routingControlArn:UpdateRoutingControlState' :: UpdateRoutingControlState -> Text
$sel:safetyRulesToOverride:UpdateRoutingControlState' :: UpdateRoutingControlState -> 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
"RoutingControlArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
routingControlArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RoutingControlState" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RoutingControlState
routingControlState)
          ]
      )

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

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

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

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

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

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