{-# 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.GetRoutingControlState
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get the state for a routing control. A routing control is a simple
-- on\/off switch that you can use to route traffic to cells. When a
-- routing control state is On, traffic flows to a cell. When the state is
-- Off, traffic does not flow.
--
-- Before you can create a routing control, you must first create a
-- cluster, and then host the control in a control panel on the cluster.
-- For more information, see
-- <https://docs.aws.amazon.com/r53recovery/latest/dg/routing-control.create.html Create routing control structures>
-- in the Amazon Route 53 Application Recovery Controller Developer Guide.
-- You access one of the endpoints for the cluster to get or update the
-- routing control state to redirect traffic for your application.
--
-- /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.
--
-- Learn more about working with routing controls in the following topics
-- 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 in Route 53 ARC>
module Amazonka.Route53RecoveryCluster.GetRoutingControlState
  ( -- * Creating a Request
    GetRoutingControlState (..),
    newGetRoutingControlState,

    -- * Request Lenses
    getRoutingControlState_routingControlArn,

    -- * Destructuring the Response
    GetRoutingControlStateResponse (..),
    newGetRoutingControlStateResponse,

    -- * Response Lenses
    getRoutingControlStateResponse_routingControlName,
    getRoutingControlStateResponse_httpStatus,
    getRoutingControlStateResponse_routingControlArn,
    getRoutingControlStateResponse_routingControlState,
  )
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:/ 'newGetRoutingControlState' smart constructor.
data GetRoutingControlState = GetRoutingControlState'
  { -- | The Amazon Resource Name (ARN) for the routing control that you want to
    -- get the state for.
    GetRoutingControlState -> Text
routingControlArn :: Prelude.Text
  }
  deriving (GetRoutingControlState -> GetRoutingControlState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRoutingControlState -> GetRoutingControlState -> Bool
$c/= :: GetRoutingControlState -> GetRoutingControlState -> Bool
== :: GetRoutingControlState -> GetRoutingControlState -> Bool
$c== :: GetRoutingControlState -> GetRoutingControlState -> Bool
Prelude.Eq, ReadPrec [GetRoutingControlState]
ReadPrec GetRoutingControlState
Int -> ReadS GetRoutingControlState
ReadS [GetRoutingControlState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRoutingControlState]
$creadListPrec :: ReadPrec [GetRoutingControlState]
readPrec :: ReadPrec GetRoutingControlState
$creadPrec :: ReadPrec GetRoutingControlState
readList :: ReadS [GetRoutingControlState]
$creadList :: ReadS [GetRoutingControlState]
readsPrec :: Int -> ReadS GetRoutingControlState
$creadsPrec :: Int -> ReadS GetRoutingControlState
Prelude.Read, Int -> GetRoutingControlState -> ShowS
[GetRoutingControlState] -> ShowS
GetRoutingControlState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRoutingControlState] -> ShowS
$cshowList :: [GetRoutingControlState] -> ShowS
show :: GetRoutingControlState -> String
$cshow :: GetRoutingControlState -> String
showsPrec :: Int -> GetRoutingControlState -> ShowS
$cshowsPrec :: Int -> GetRoutingControlState -> ShowS
Prelude.Show, forall x. Rep GetRoutingControlState x -> GetRoutingControlState
forall x. GetRoutingControlState -> Rep GetRoutingControlState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRoutingControlState x -> GetRoutingControlState
$cfrom :: forall x. GetRoutingControlState -> Rep GetRoutingControlState x
Prelude.Generic)

-- |
-- Create a value of 'GetRoutingControlState' 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:
--
-- 'routingControlArn', 'getRoutingControlState_routingControlArn' - The Amazon Resource Name (ARN) for the routing control that you want to
-- get the state for.
newGetRoutingControlState ::
  -- | 'routingControlArn'
  Prelude.Text ->
  GetRoutingControlState
newGetRoutingControlState :: Text -> GetRoutingControlState
newGetRoutingControlState Text
pRoutingControlArn_ =
  GetRoutingControlState'
    { $sel:routingControlArn:GetRoutingControlState' :: Text
routingControlArn =
        Text
pRoutingControlArn_
    }

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

instance Core.AWSRequest GetRoutingControlState where
  type
    AWSResponse GetRoutingControlState =
      GetRoutingControlStateResponse
  request :: (Service -> Service)
-> GetRoutingControlState -> Request GetRoutingControlState
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 GetRoutingControlState
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetRoutingControlState)))
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
-> Int
-> Text
-> RoutingControlState
-> GetRoutingControlStateResponse
GetRoutingControlStateResponse'
            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
"RoutingControlName")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RoutingControlArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RoutingControlState")
      )

instance Prelude.Hashable GetRoutingControlState where
  hashWithSalt :: Int -> GetRoutingControlState -> Int
hashWithSalt Int
_salt GetRoutingControlState' {Text
routingControlArn :: Text
$sel:routingControlArn:GetRoutingControlState' :: GetRoutingControlState -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
routingControlArn

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

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

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

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

-- | /See:/ 'newGetRoutingControlStateResponse' smart constructor.
data GetRoutingControlStateResponse = GetRoutingControlStateResponse'
  { -- | The routing control name.
    GetRoutingControlStateResponse -> Maybe Text
routingControlName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetRoutingControlStateResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the response.
    GetRoutingControlStateResponse -> Text
routingControlArn :: Prelude.Text,
    -- | The state of the routing control.
    GetRoutingControlStateResponse -> RoutingControlState
routingControlState :: RoutingControlState
  }
  deriving (GetRoutingControlStateResponse
-> GetRoutingControlStateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRoutingControlStateResponse
-> GetRoutingControlStateResponse -> Bool
$c/= :: GetRoutingControlStateResponse
-> GetRoutingControlStateResponse -> Bool
== :: GetRoutingControlStateResponse
-> GetRoutingControlStateResponse -> Bool
$c== :: GetRoutingControlStateResponse
-> GetRoutingControlStateResponse -> Bool
Prelude.Eq, ReadPrec [GetRoutingControlStateResponse]
ReadPrec GetRoutingControlStateResponse
Int -> ReadS GetRoutingControlStateResponse
ReadS [GetRoutingControlStateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRoutingControlStateResponse]
$creadListPrec :: ReadPrec [GetRoutingControlStateResponse]
readPrec :: ReadPrec GetRoutingControlStateResponse
$creadPrec :: ReadPrec GetRoutingControlStateResponse
readList :: ReadS [GetRoutingControlStateResponse]
$creadList :: ReadS [GetRoutingControlStateResponse]
readsPrec :: Int -> ReadS GetRoutingControlStateResponse
$creadsPrec :: Int -> ReadS GetRoutingControlStateResponse
Prelude.Read, Int -> GetRoutingControlStateResponse -> ShowS
[GetRoutingControlStateResponse] -> ShowS
GetRoutingControlStateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRoutingControlStateResponse] -> ShowS
$cshowList :: [GetRoutingControlStateResponse] -> ShowS
show :: GetRoutingControlStateResponse -> String
$cshow :: GetRoutingControlStateResponse -> String
showsPrec :: Int -> GetRoutingControlStateResponse -> ShowS
$cshowsPrec :: Int -> GetRoutingControlStateResponse -> ShowS
Prelude.Show, forall x.
Rep GetRoutingControlStateResponse x
-> GetRoutingControlStateResponse
forall x.
GetRoutingControlStateResponse
-> Rep GetRoutingControlStateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRoutingControlStateResponse x
-> GetRoutingControlStateResponse
$cfrom :: forall x.
GetRoutingControlStateResponse
-> Rep GetRoutingControlStateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRoutingControlStateResponse' 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:
--
-- 'routingControlName', 'getRoutingControlStateResponse_routingControlName' - The routing control name.
--
-- 'httpStatus', 'getRoutingControlStateResponse_httpStatus' - The response's http status code.
--
-- 'routingControlArn', 'getRoutingControlStateResponse_routingControlArn' - The Amazon Resource Name (ARN) of the response.
--
-- 'routingControlState', 'getRoutingControlStateResponse_routingControlState' - The state of the routing control.
newGetRoutingControlStateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'routingControlArn'
  Prelude.Text ->
  -- | 'routingControlState'
  RoutingControlState ->
  GetRoutingControlStateResponse
newGetRoutingControlStateResponse :: Int
-> Text -> RoutingControlState -> GetRoutingControlStateResponse
newGetRoutingControlStateResponse
  Int
pHttpStatus_
  Text
pRoutingControlArn_
  RoutingControlState
pRoutingControlState_ =
    GetRoutingControlStateResponse'
      { $sel:routingControlName:GetRoutingControlStateResponse' :: Maybe Text
routingControlName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetRoutingControlStateResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:routingControlArn:GetRoutingControlStateResponse' :: Text
routingControlArn = Text
pRoutingControlArn_,
        $sel:routingControlState:GetRoutingControlStateResponse' :: RoutingControlState
routingControlState = RoutingControlState
pRoutingControlState_
      }

-- | The routing control name.
getRoutingControlStateResponse_routingControlName :: Lens.Lens' GetRoutingControlStateResponse (Prelude.Maybe Prelude.Text)
getRoutingControlStateResponse_routingControlName :: Lens' GetRoutingControlStateResponse (Maybe Text)
getRoutingControlStateResponse_routingControlName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRoutingControlStateResponse' {Maybe Text
routingControlName :: Maybe Text
$sel:routingControlName:GetRoutingControlStateResponse' :: GetRoutingControlStateResponse -> Maybe Text
routingControlName} -> Maybe Text
routingControlName) (\s :: GetRoutingControlStateResponse
s@GetRoutingControlStateResponse' {} Maybe Text
a -> GetRoutingControlStateResponse
s {$sel:routingControlName:GetRoutingControlStateResponse' :: Maybe Text
routingControlName = Maybe Text
a} :: GetRoutingControlStateResponse)

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

-- | The Amazon Resource Name (ARN) of the response.
getRoutingControlStateResponse_routingControlArn :: Lens.Lens' GetRoutingControlStateResponse Prelude.Text
getRoutingControlStateResponse_routingControlArn :: Lens' GetRoutingControlStateResponse Text
getRoutingControlStateResponse_routingControlArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRoutingControlStateResponse' {Text
routingControlArn :: Text
$sel:routingControlArn:GetRoutingControlStateResponse' :: GetRoutingControlStateResponse -> Text
routingControlArn} -> Text
routingControlArn) (\s :: GetRoutingControlStateResponse
s@GetRoutingControlStateResponse' {} Text
a -> GetRoutingControlStateResponse
s {$sel:routingControlArn:GetRoutingControlStateResponse' :: Text
routingControlArn = Text
a} :: GetRoutingControlStateResponse)

-- | The state of the routing control.
getRoutingControlStateResponse_routingControlState :: Lens.Lens' GetRoutingControlStateResponse RoutingControlState
getRoutingControlStateResponse_routingControlState :: Lens' GetRoutingControlStateResponse RoutingControlState
getRoutingControlStateResponse_routingControlState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRoutingControlStateResponse' {RoutingControlState
routingControlState :: RoutingControlState
$sel:routingControlState:GetRoutingControlStateResponse' :: GetRoutingControlStateResponse -> RoutingControlState
routingControlState} -> RoutingControlState
routingControlState) (\s :: GetRoutingControlStateResponse
s@GetRoutingControlStateResponse' {} RoutingControlState
a -> GetRoutingControlStateResponse
s {$sel:routingControlState:GetRoutingControlStateResponse' :: RoutingControlState
routingControlState = RoutingControlState
a} :: GetRoutingControlStateResponse)

instance
  Prelude.NFData
    GetRoutingControlStateResponse
  where
  rnf :: GetRoutingControlStateResponse -> ()
rnf GetRoutingControlStateResponse' {Int
Maybe Text
Text
RoutingControlState
routingControlState :: RoutingControlState
routingControlArn :: Text
httpStatus :: Int
routingControlName :: Maybe Text
$sel:routingControlState:GetRoutingControlStateResponse' :: GetRoutingControlStateResponse -> RoutingControlState
$sel:routingControlArn:GetRoutingControlStateResponse' :: GetRoutingControlStateResponse -> Text
$sel:httpStatus:GetRoutingControlStateResponse' :: GetRoutingControlStateResponse -> Int
$sel:routingControlName:GetRoutingControlStateResponse' :: GetRoutingControlStateResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
routingControlName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      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