{-# 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.CreateRoutingControl
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new routing control.
--
-- A routing control has one of two states: ON and OFF. You can map the
-- routing control state to the state of an Amazon Route 53 health check,
-- which can be used to control traffic routing.
--
-- To get or update the routing control state, see the Recovery Cluster
-- (data plane) API actions for Amazon Route 53 Application Recovery
-- Controller.
module Amazonka.Route53RecoveryControlConfig.CreateRoutingControl
  ( -- * Creating a Request
    CreateRoutingControl (..),
    newCreateRoutingControl,

    -- * Request Lenses
    createRoutingControl_clientToken,
    createRoutingControl_controlPanelArn,
    createRoutingControl_clusterArn,
    createRoutingControl_routingControlName,

    -- * Destructuring the Response
    CreateRoutingControlResponse (..),
    newCreateRoutingControlResponse,

    -- * Response Lenses
    createRoutingControlResponse_routingControl,
    createRoutingControlResponse_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

-- | The details of the routing control that you\'re creating.
--
-- /See:/ 'newCreateRoutingControl' smart constructor.
data CreateRoutingControl = CreateRoutingControl'
  { -- | A unique, case-sensitive string of up to 64 ASCII characters. To make an
    -- idempotent API request with an action, specify a client token in the
    -- request.
    CreateRoutingControl -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the control panel that includes the
    -- routing control.
    CreateRoutingControl -> Maybe Text
controlPanelArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the cluster that includes the routing
    -- control.
    CreateRoutingControl -> Text
clusterArn :: Prelude.Text,
    -- | The name of the routing control.
    CreateRoutingControl -> Text
routingControlName :: Prelude.Text
  }
  deriving (CreateRoutingControl -> CreateRoutingControl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRoutingControl -> CreateRoutingControl -> Bool
$c/= :: CreateRoutingControl -> CreateRoutingControl -> Bool
== :: CreateRoutingControl -> CreateRoutingControl -> Bool
$c== :: CreateRoutingControl -> CreateRoutingControl -> Bool
Prelude.Eq, ReadPrec [CreateRoutingControl]
ReadPrec CreateRoutingControl
Int -> ReadS CreateRoutingControl
ReadS [CreateRoutingControl]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRoutingControl]
$creadListPrec :: ReadPrec [CreateRoutingControl]
readPrec :: ReadPrec CreateRoutingControl
$creadPrec :: ReadPrec CreateRoutingControl
readList :: ReadS [CreateRoutingControl]
$creadList :: ReadS [CreateRoutingControl]
readsPrec :: Int -> ReadS CreateRoutingControl
$creadsPrec :: Int -> ReadS CreateRoutingControl
Prelude.Read, Int -> CreateRoutingControl -> ShowS
[CreateRoutingControl] -> ShowS
CreateRoutingControl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRoutingControl] -> ShowS
$cshowList :: [CreateRoutingControl] -> ShowS
show :: CreateRoutingControl -> String
$cshow :: CreateRoutingControl -> String
showsPrec :: Int -> CreateRoutingControl -> ShowS
$cshowsPrec :: Int -> CreateRoutingControl -> ShowS
Prelude.Show, forall x. Rep CreateRoutingControl x -> CreateRoutingControl
forall x. CreateRoutingControl -> Rep CreateRoutingControl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRoutingControl x -> CreateRoutingControl
$cfrom :: forall x. CreateRoutingControl -> Rep CreateRoutingControl x
Prelude.Generic)

-- |
-- Create a value of 'CreateRoutingControl' 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:
--
-- 'clientToken', 'createRoutingControl_clientToken' - A unique, case-sensitive string of up to 64 ASCII characters. To make an
-- idempotent API request with an action, specify a client token in the
-- request.
--
-- 'controlPanelArn', 'createRoutingControl_controlPanelArn' - The Amazon Resource Name (ARN) of the control panel that includes the
-- routing control.
--
-- 'clusterArn', 'createRoutingControl_clusterArn' - The Amazon Resource Name (ARN) of the cluster that includes the routing
-- control.
--
-- 'routingControlName', 'createRoutingControl_routingControlName' - The name of the routing control.
newCreateRoutingControl ::
  -- | 'clusterArn'
  Prelude.Text ->
  -- | 'routingControlName'
  Prelude.Text ->
  CreateRoutingControl
newCreateRoutingControl :: Text -> Text -> CreateRoutingControl
newCreateRoutingControl
  Text
pClusterArn_
  Text
pRoutingControlName_ =
    CreateRoutingControl'
      { $sel:clientToken:CreateRoutingControl' :: Maybe Text
clientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:controlPanelArn:CreateRoutingControl' :: Maybe Text
controlPanelArn = forall a. Maybe a
Prelude.Nothing,
        $sel:clusterArn:CreateRoutingControl' :: Text
clusterArn = Text
pClusterArn_,
        $sel:routingControlName:CreateRoutingControl' :: Text
routingControlName = Text
pRoutingControlName_
      }

-- | A unique, case-sensitive string of up to 64 ASCII characters. To make an
-- idempotent API request with an action, specify a client token in the
-- request.
createRoutingControl_clientToken :: Lens.Lens' CreateRoutingControl (Prelude.Maybe Prelude.Text)
createRoutingControl_clientToken :: Lens' CreateRoutingControl (Maybe Text)
createRoutingControl_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoutingControl' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateRoutingControl
s@CreateRoutingControl' {} Maybe Text
a -> CreateRoutingControl
s {$sel:clientToken:CreateRoutingControl' :: Maybe Text
clientToken = Maybe Text
a} :: CreateRoutingControl)

-- | The Amazon Resource Name (ARN) of the control panel that includes the
-- routing control.
createRoutingControl_controlPanelArn :: Lens.Lens' CreateRoutingControl (Prelude.Maybe Prelude.Text)
createRoutingControl_controlPanelArn :: Lens' CreateRoutingControl (Maybe Text)
createRoutingControl_controlPanelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoutingControl' {Maybe Text
controlPanelArn :: Maybe Text
$sel:controlPanelArn:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
controlPanelArn} -> Maybe Text
controlPanelArn) (\s :: CreateRoutingControl
s@CreateRoutingControl' {} Maybe Text
a -> CreateRoutingControl
s {$sel:controlPanelArn:CreateRoutingControl' :: Maybe Text
controlPanelArn = Maybe Text
a} :: CreateRoutingControl)

-- | The Amazon Resource Name (ARN) of the cluster that includes the routing
-- control.
createRoutingControl_clusterArn :: Lens.Lens' CreateRoutingControl Prelude.Text
createRoutingControl_clusterArn :: Lens' CreateRoutingControl Text
createRoutingControl_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoutingControl' {Text
clusterArn :: Text
$sel:clusterArn:CreateRoutingControl' :: CreateRoutingControl -> Text
clusterArn} -> Text
clusterArn) (\s :: CreateRoutingControl
s@CreateRoutingControl' {} Text
a -> CreateRoutingControl
s {$sel:clusterArn:CreateRoutingControl' :: Text
clusterArn = Text
a} :: CreateRoutingControl)

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

instance Core.AWSRequest CreateRoutingControl where
  type
    AWSResponse CreateRoutingControl =
      CreateRoutingControlResponse
  request :: (Service -> Service)
-> CreateRoutingControl -> Request CreateRoutingControl
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 CreateRoutingControl
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateRoutingControl)))
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 RoutingControl -> Int -> CreateRoutingControlResponse
CreateRoutingControlResponse'
            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
"RoutingControl")
            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 CreateRoutingControl where
  hashWithSalt :: Int -> CreateRoutingControl -> Int
hashWithSalt Int
_salt CreateRoutingControl' {Maybe Text
Text
routingControlName :: Text
clusterArn :: Text
controlPanelArn :: Maybe Text
clientToken :: Maybe Text
$sel:routingControlName:CreateRoutingControl' :: CreateRoutingControl -> Text
$sel:clusterArn:CreateRoutingControl' :: CreateRoutingControl -> Text
$sel:controlPanelArn:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
$sel:clientToken:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
controlPanelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
routingControlName

instance Prelude.NFData CreateRoutingControl where
  rnf :: CreateRoutingControl -> ()
rnf CreateRoutingControl' {Maybe Text
Text
routingControlName :: Text
clusterArn :: Text
controlPanelArn :: Maybe Text
clientToken :: Maybe Text
$sel:routingControlName:CreateRoutingControl' :: CreateRoutingControl -> Text
$sel:clusterArn:CreateRoutingControl' :: CreateRoutingControl -> Text
$sel:controlPanelArn:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
$sel:clientToken:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
controlPanelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
routingControlName

instance Data.ToHeaders CreateRoutingControl where
  toHeaders :: CreateRoutingControl -> 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 CreateRoutingControl where
  toJSON :: CreateRoutingControl -> Value
toJSON CreateRoutingControl' {Maybe Text
Text
routingControlName :: Text
clusterArn :: Text
controlPanelArn :: Maybe Text
clientToken :: Maybe Text
$sel:routingControlName:CreateRoutingControl' :: CreateRoutingControl -> Text
$sel:clusterArn:CreateRoutingControl' :: CreateRoutingControl -> Text
$sel:controlPanelArn:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
$sel:clientToken:CreateRoutingControl' :: CreateRoutingControl -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (Key
"ControlPanelArn" 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
controlPanelArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RoutingControlName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
routingControlName)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateRoutingControlResponse' 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:
--
-- 'routingControl', 'createRoutingControlResponse_routingControl' - The routing control that is created.
--
-- 'httpStatus', 'createRoutingControlResponse_httpStatus' - The response's http status code.
newCreateRoutingControlResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateRoutingControlResponse
newCreateRoutingControlResponse :: Int -> CreateRoutingControlResponse
newCreateRoutingControlResponse Int
pHttpStatus_ =
  CreateRoutingControlResponse'
    { $sel:routingControl:CreateRoutingControlResponse' :: Maybe RoutingControl
routingControl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateRoutingControlResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The routing control that is created.
createRoutingControlResponse_routingControl :: Lens.Lens' CreateRoutingControlResponse (Prelude.Maybe RoutingControl)
createRoutingControlResponse_routingControl :: Lens' CreateRoutingControlResponse (Maybe RoutingControl)
createRoutingControlResponse_routingControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRoutingControlResponse' {Maybe RoutingControl
routingControl :: Maybe RoutingControl
$sel:routingControl:CreateRoutingControlResponse' :: CreateRoutingControlResponse -> Maybe RoutingControl
routingControl} -> Maybe RoutingControl
routingControl) (\s :: CreateRoutingControlResponse
s@CreateRoutingControlResponse' {} Maybe RoutingControl
a -> CreateRoutingControlResponse
s {$sel:routingControl:CreateRoutingControlResponse' :: Maybe RoutingControl
routingControl = Maybe RoutingControl
a} :: CreateRoutingControlResponse)

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

instance Prelude.NFData CreateRoutingControlResponse where
  rnf :: CreateRoutingControlResponse -> ()
rnf CreateRoutingControlResponse' {Int
Maybe RoutingControl
httpStatus :: Int
routingControl :: Maybe RoutingControl
$sel:httpStatus:CreateRoutingControlResponse' :: CreateRoutingControlResponse -> Int
$sel:routingControl:CreateRoutingControlResponse' :: CreateRoutingControlResponse -> Maybe RoutingControl
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RoutingControl
routingControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus