{-# 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.CloudWatchEvents.CreateEndpoint
-- 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 global endpoint. Global endpoints improve your application\'s
-- availability by making it regional-fault tolerant. To do this, you
-- define a primary and secondary Region with event buses in each Region.
-- You also create a Amazon Route 53 health check that will tell
-- EventBridge to route events to the secondary Region when an
-- \"unhealthy\" state is encountered and events will be routed back to the
-- primary Region when the health check reports a \"healthy\" state.
module Amazonka.CloudWatchEvents.CreateEndpoint
  ( -- * Creating a Request
    CreateEndpoint (..),
    newCreateEndpoint,

    -- * Request Lenses
    createEndpoint_description,
    createEndpoint_replicationConfig,
    createEndpoint_roleArn,
    createEndpoint_name,
    createEndpoint_routingConfig,
    createEndpoint_eventBuses,

    -- * Destructuring the Response
    CreateEndpointResponse (..),
    newCreateEndpointResponse,

    -- * Response Lenses
    createEndpointResponse_arn,
    createEndpointResponse_eventBuses,
    createEndpointResponse_name,
    createEndpointResponse_replicationConfig,
    createEndpointResponse_roleArn,
    createEndpointResponse_routingConfig,
    createEndpointResponse_state,
    createEndpointResponse_httpStatus,
  )
where

import Amazonka.CloudWatchEvents.Types
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

-- | /See:/ 'newCreateEndpoint' smart constructor.
data CreateEndpoint = CreateEndpoint'
  { -- | A description of the global endpoint.
    CreateEndpoint -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Enable or disable event replication.
    CreateEndpoint -> Maybe ReplicationConfig
replicationConfig :: Prelude.Maybe ReplicationConfig,
    -- | The ARN of the role used for replication.
    CreateEndpoint -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the global endpoint. For example,
    -- @\"Name\":\"us-east-2-custom_bus_A-endpoint\"@.
    CreateEndpoint -> Text
name :: Prelude.Text,
    -- | Configure the routing policy, including the health check and secondary
    -- Region..
    CreateEndpoint -> RoutingConfig
routingConfig :: RoutingConfig,
    -- | Define the event buses used.
    --
    -- The names of the event buses must be identical in each Region.
    CreateEndpoint -> NonEmpty EndpointEventBus
eventBuses :: Prelude.NonEmpty EndpointEventBus
  }
  deriving (CreateEndpoint -> CreateEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEndpoint -> CreateEndpoint -> Bool
$c/= :: CreateEndpoint -> CreateEndpoint -> Bool
== :: CreateEndpoint -> CreateEndpoint -> Bool
$c== :: CreateEndpoint -> CreateEndpoint -> Bool
Prelude.Eq, ReadPrec [CreateEndpoint]
ReadPrec CreateEndpoint
Int -> ReadS CreateEndpoint
ReadS [CreateEndpoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEndpoint]
$creadListPrec :: ReadPrec [CreateEndpoint]
readPrec :: ReadPrec CreateEndpoint
$creadPrec :: ReadPrec CreateEndpoint
readList :: ReadS [CreateEndpoint]
$creadList :: ReadS [CreateEndpoint]
readsPrec :: Int -> ReadS CreateEndpoint
$creadsPrec :: Int -> ReadS CreateEndpoint
Prelude.Read, Int -> CreateEndpoint -> ShowS
[CreateEndpoint] -> ShowS
CreateEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEndpoint] -> ShowS
$cshowList :: [CreateEndpoint] -> ShowS
show :: CreateEndpoint -> String
$cshow :: CreateEndpoint -> String
showsPrec :: Int -> CreateEndpoint -> ShowS
$cshowsPrec :: Int -> CreateEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateEndpoint x -> CreateEndpoint
forall x. CreateEndpoint -> Rep CreateEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEndpoint x -> CreateEndpoint
$cfrom :: forall x. CreateEndpoint -> Rep CreateEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateEndpoint' 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:
--
-- 'description', 'createEndpoint_description' - A description of the global endpoint.
--
-- 'replicationConfig', 'createEndpoint_replicationConfig' - Enable or disable event replication.
--
-- 'roleArn', 'createEndpoint_roleArn' - The ARN of the role used for replication.
--
-- 'name', 'createEndpoint_name' - The name of the global endpoint. For example,
-- @\"Name\":\"us-east-2-custom_bus_A-endpoint\"@.
--
-- 'routingConfig', 'createEndpoint_routingConfig' - Configure the routing policy, including the health check and secondary
-- Region..
--
-- 'eventBuses', 'createEndpoint_eventBuses' - Define the event buses used.
--
-- The names of the event buses must be identical in each Region.
newCreateEndpoint ::
  -- | 'name'
  Prelude.Text ->
  -- | 'routingConfig'
  RoutingConfig ->
  -- | 'eventBuses'
  Prelude.NonEmpty EndpointEventBus ->
  CreateEndpoint
newCreateEndpoint :: Text
-> RoutingConfig -> NonEmpty EndpointEventBus -> CreateEndpoint
newCreateEndpoint Text
pName_ RoutingConfig
pRoutingConfig_ NonEmpty EndpointEventBus
pEventBuses_ =
  CreateEndpoint'
    { $sel:description:CreateEndpoint' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationConfig:CreateEndpoint' :: Maybe ReplicationConfig
replicationConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:CreateEndpoint' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateEndpoint' :: Text
name = Text
pName_,
      $sel:routingConfig:CreateEndpoint' :: RoutingConfig
routingConfig = RoutingConfig
pRoutingConfig_,
      $sel:eventBuses:CreateEndpoint' :: NonEmpty EndpointEventBus
eventBuses = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty EndpointEventBus
pEventBuses_
    }

-- | A description of the global endpoint.
createEndpoint_description :: Lens.Lens' CreateEndpoint (Prelude.Maybe Prelude.Text)
createEndpoint_description :: Lens' CreateEndpoint (Maybe Text)
createEndpoint_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Maybe Text
description :: Maybe Text
$sel:description:CreateEndpoint' :: CreateEndpoint -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateEndpoint
s@CreateEndpoint' {} Maybe Text
a -> CreateEndpoint
s {$sel:description:CreateEndpoint' :: Maybe Text
description = Maybe Text
a} :: CreateEndpoint)

-- | Enable or disable event replication.
createEndpoint_replicationConfig :: Lens.Lens' CreateEndpoint (Prelude.Maybe ReplicationConfig)
createEndpoint_replicationConfig :: Lens' CreateEndpoint (Maybe ReplicationConfig)
createEndpoint_replicationConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Maybe ReplicationConfig
replicationConfig :: Maybe ReplicationConfig
$sel:replicationConfig:CreateEndpoint' :: CreateEndpoint -> Maybe ReplicationConfig
replicationConfig} -> Maybe ReplicationConfig
replicationConfig) (\s :: CreateEndpoint
s@CreateEndpoint' {} Maybe ReplicationConfig
a -> CreateEndpoint
s {$sel:replicationConfig:CreateEndpoint' :: Maybe ReplicationConfig
replicationConfig = Maybe ReplicationConfig
a} :: CreateEndpoint)

-- | The ARN of the role used for replication.
createEndpoint_roleArn :: Lens.Lens' CreateEndpoint (Prelude.Maybe Prelude.Text)
createEndpoint_roleArn :: Lens' CreateEndpoint (Maybe Text)
createEndpoint_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:CreateEndpoint' :: CreateEndpoint -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: CreateEndpoint
s@CreateEndpoint' {} Maybe Text
a -> CreateEndpoint
s {$sel:roleArn:CreateEndpoint' :: Maybe Text
roleArn = Maybe Text
a} :: CreateEndpoint)

-- | The name of the global endpoint. For example,
-- @\"Name\":\"us-east-2-custom_bus_A-endpoint\"@.
createEndpoint_name :: Lens.Lens' CreateEndpoint Prelude.Text
createEndpoint_name :: Lens' CreateEndpoint Text
createEndpoint_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {Text
name :: Text
$sel:name:CreateEndpoint' :: CreateEndpoint -> Text
name} -> Text
name) (\s :: CreateEndpoint
s@CreateEndpoint' {} Text
a -> CreateEndpoint
s {$sel:name:CreateEndpoint' :: Text
name = Text
a} :: CreateEndpoint)

-- | Configure the routing policy, including the health check and secondary
-- Region..
createEndpoint_routingConfig :: Lens.Lens' CreateEndpoint RoutingConfig
createEndpoint_routingConfig :: Lens' CreateEndpoint RoutingConfig
createEndpoint_routingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {RoutingConfig
routingConfig :: RoutingConfig
$sel:routingConfig:CreateEndpoint' :: CreateEndpoint -> RoutingConfig
routingConfig} -> RoutingConfig
routingConfig) (\s :: CreateEndpoint
s@CreateEndpoint' {} RoutingConfig
a -> CreateEndpoint
s {$sel:routingConfig:CreateEndpoint' :: RoutingConfig
routingConfig = RoutingConfig
a} :: CreateEndpoint)

-- | Define the event buses used.
--
-- The names of the event buses must be identical in each Region.
createEndpoint_eventBuses :: Lens.Lens' CreateEndpoint (Prelude.NonEmpty EndpointEventBus)
createEndpoint_eventBuses :: Lens' CreateEndpoint (NonEmpty EndpointEventBus)
createEndpoint_eventBuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpoint' {NonEmpty EndpointEventBus
eventBuses :: NonEmpty EndpointEventBus
$sel:eventBuses:CreateEndpoint' :: CreateEndpoint -> NonEmpty EndpointEventBus
eventBuses} -> NonEmpty EndpointEventBus
eventBuses) (\s :: CreateEndpoint
s@CreateEndpoint' {} NonEmpty EndpointEventBus
a -> CreateEndpoint
s {$sel:eventBuses:CreateEndpoint' :: NonEmpty EndpointEventBus
eventBuses = NonEmpty EndpointEventBus
a} :: CreateEndpoint) 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 CreateEndpoint where
  type
    AWSResponse CreateEndpoint =
      CreateEndpointResponse
  request :: (Service -> Service) -> CreateEndpoint -> Request CreateEndpoint
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 CreateEndpoint
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateEndpoint)))
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
-> Maybe (NonEmpty EndpointEventBus)
-> Maybe Text
-> Maybe ReplicationConfig
-> Maybe Text
-> Maybe RoutingConfig
-> Maybe EndpointState
-> Int
-> CreateEndpointResponse
CreateEndpointResponse'
            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
"Arn")
            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
"EventBuses")
            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
"Name")
            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
"ReplicationConfig")
            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
"RoleArn")
            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
"RoutingConfig")
            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
"State")
            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 CreateEndpoint where
  hashWithSalt :: Int -> CreateEndpoint -> Int
hashWithSalt Int
_salt CreateEndpoint' {Maybe Text
Maybe ReplicationConfig
NonEmpty EndpointEventBus
Text
RoutingConfig
eventBuses :: NonEmpty EndpointEventBus
routingConfig :: RoutingConfig
name :: Text
roleArn :: Maybe Text
replicationConfig :: Maybe ReplicationConfig
description :: Maybe Text
$sel:eventBuses:CreateEndpoint' :: CreateEndpoint -> NonEmpty EndpointEventBus
$sel:routingConfig:CreateEndpoint' :: CreateEndpoint -> RoutingConfig
$sel:name:CreateEndpoint' :: CreateEndpoint -> Text
$sel:roleArn:CreateEndpoint' :: CreateEndpoint -> Maybe Text
$sel:replicationConfig:CreateEndpoint' :: CreateEndpoint -> Maybe ReplicationConfig
$sel:description:CreateEndpoint' :: CreateEndpoint -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReplicationConfig
replicationConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RoutingConfig
routingConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty EndpointEventBus
eventBuses

instance Prelude.NFData CreateEndpoint where
  rnf :: CreateEndpoint -> ()
rnf CreateEndpoint' {Maybe Text
Maybe ReplicationConfig
NonEmpty EndpointEventBus
Text
RoutingConfig
eventBuses :: NonEmpty EndpointEventBus
routingConfig :: RoutingConfig
name :: Text
roleArn :: Maybe Text
replicationConfig :: Maybe ReplicationConfig
description :: Maybe Text
$sel:eventBuses:CreateEndpoint' :: CreateEndpoint -> NonEmpty EndpointEventBus
$sel:routingConfig:CreateEndpoint' :: CreateEndpoint -> RoutingConfig
$sel:name:CreateEndpoint' :: CreateEndpoint -> Text
$sel:roleArn:CreateEndpoint' :: CreateEndpoint -> Maybe Text
$sel:replicationConfig:CreateEndpoint' :: CreateEndpoint -> Maybe ReplicationConfig
$sel:description:CreateEndpoint' :: CreateEndpoint -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicationConfig
replicationConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RoutingConfig
routingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty EndpointEventBus
eventBuses

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

instance Data.ToJSON CreateEndpoint where
  toJSON :: CreateEndpoint -> Value
toJSON CreateEndpoint' {Maybe Text
Maybe ReplicationConfig
NonEmpty EndpointEventBus
Text
RoutingConfig
eventBuses :: NonEmpty EndpointEventBus
routingConfig :: RoutingConfig
name :: Text
roleArn :: Maybe Text
replicationConfig :: Maybe ReplicationConfig
description :: Maybe Text
$sel:eventBuses:CreateEndpoint' :: CreateEndpoint -> NonEmpty EndpointEventBus
$sel:routingConfig:CreateEndpoint' :: CreateEndpoint -> RoutingConfig
$sel:name:CreateEndpoint' :: CreateEndpoint -> Text
$sel:roleArn:CreateEndpoint' :: CreateEndpoint -> Maybe Text
$sel:replicationConfig:CreateEndpoint' :: CreateEndpoint -> Maybe ReplicationConfig
$sel:description:CreateEndpoint' :: CreateEndpoint -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"ReplicationConfig" 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 ReplicationConfig
replicationConfig,
            (Key
"RoleArn" 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
roleArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoutingConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RoutingConfig
routingConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"EventBuses" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty EndpointEventBus
eventBuses)
          ]
      )

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

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

-- | /See:/ 'newCreateEndpointResponse' smart constructor.
data CreateEndpointResponse = CreateEndpointResponse'
  { -- | The ARN of the endpoint that was created by this request.
    CreateEndpointResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The event buses used by this request.
    CreateEndpointResponse -> Maybe (NonEmpty EndpointEventBus)
eventBuses :: Prelude.Maybe (Prelude.NonEmpty EndpointEventBus),
    -- | The name of the endpoint that was created by this request.
    CreateEndpointResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Whether event replication was enabled or disabled by this request.
    CreateEndpointResponse -> Maybe ReplicationConfig
replicationConfig :: Prelude.Maybe ReplicationConfig,
    -- | The ARN of the role used by event replication for this request.
    CreateEndpointResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The routing configuration defined by this request.
    CreateEndpointResponse -> Maybe RoutingConfig
routingConfig :: Prelude.Maybe RoutingConfig,
    -- | The state of the endpoint that was created by this request.
    CreateEndpointResponse -> Maybe EndpointState
state :: Prelude.Maybe EndpointState,
    -- | The response's http status code.
    CreateEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateEndpointResponse -> CreateEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateEndpointResponse -> CreateEndpointResponse -> Bool
$c/= :: CreateEndpointResponse -> CreateEndpointResponse -> Bool
== :: CreateEndpointResponse -> CreateEndpointResponse -> Bool
$c== :: CreateEndpointResponse -> CreateEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateEndpointResponse]
ReadPrec CreateEndpointResponse
Int -> ReadS CreateEndpointResponse
ReadS [CreateEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateEndpointResponse]
$creadListPrec :: ReadPrec [CreateEndpointResponse]
readPrec :: ReadPrec CreateEndpointResponse
$creadPrec :: ReadPrec CreateEndpointResponse
readList :: ReadS [CreateEndpointResponse]
$creadList :: ReadS [CreateEndpointResponse]
readsPrec :: Int -> ReadS CreateEndpointResponse
$creadsPrec :: Int -> ReadS CreateEndpointResponse
Prelude.Read, Int -> CreateEndpointResponse -> ShowS
[CreateEndpointResponse] -> ShowS
CreateEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateEndpointResponse] -> ShowS
$cshowList :: [CreateEndpointResponse] -> ShowS
show :: CreateEndpointResponse -> String
$cshow :: CreateEndpointResponse -> String
showsPrec :: Int -> CreateEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateEndpointResponse -> ShowS
Prelude.Show, forall x. Rep CreateEndpointResponse x -> CreateEndpointResponse
forall x. CreateEndpointResponse -> Rep CreateEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateEndpointResponse x -> CreateEndpointResponse
$cfrom :: forall x. CreateEndpointResponse -> Rep CreateEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateEndpointResponse' 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:
--
-- 'arn', 'createEndpointResponse_arn' - The ARN of the endpoint that was created by this request.
--
-- 'eventBuses', 'createEndpointResponse_eventBuses' - The event buses used by this request.
--
-- 'name', 'createEndpointResponse_name' - The name of the endpoint that was created by this request.
--
-- 'replicationConfig', 'createEndpointResponse_replicationConfig' - Whether event replication was enabled or disabled by this request.
--
-- 'roleArn', 'createEndpointResponse_roleArn' - The ARN of the role used by event replication for this request.
--
-- 'routingConfig', 'createEndpointResponse_routingConfig' - The routing configuration defined by this request.
--
-- 'state', 'createEndpointResponse_state' - The state of the endpoint that was created by this request.
--
-- 'httpStatus', 'createEndpointResponse_httpStatus' - The response's http status code.
newCreateEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateEndpointResponse
newCreateEndpointResponse :: Int -> CreateEndpointResponse
newCreateEndpointResponse Int
pHttpStatus_ =
  CreateEndpointResponse'
    { $sel:arn:CreateEndpointResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:eventBuses:CreateEndpointResponse' :: Maybe (NonEmpty EndpointEventBus)
eventBuses = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateEndpointResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationConfig:CreateEndpointResponse' :: Maybe ReplicationConfig
replicationConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:CreateEndpointResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:routingConfig:CreateEndpointResponse' :: Maybe RoutingConfig
routingConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CreateEndpointResponse' :: Maybe EndpointState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the endpoint that was created by this request.
createEndpointResponse_arn :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe Prelude.Text)
createEndpointResponse_arn :: Lens' CreateEndpointResponse (Maybe Text)
createEndpointResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe Text
a -> CreateEndpointResponse
s {$sel:arn:CreateEndpointResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateEndpointResponse)

-- | The event buses used by this request.
createEndpointResponse_eventBuses :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe (Prelude.NonEmpty EndpointEventBus))
createEndpointResponse_eventBuses :: Lens' CreateEndpointResponse (Maybe (NonEmpty EndpointEventBus))
createEndpointResponse_eventBuses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe (NonEmpty EndpointEventBus)
eventBuses :: Maybe (NonEmpty EndpointEventBus)
$sel:eventBuses:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe (NonEmpty EndpointEventBus)
eventBuses} -> Maybe (NonEmpty EndpointEventBus)
eventBuses) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe (NonEmpty EndpointEventBus)
a -> CreateEndpointResponse
s {$sel:eventBuses:CreateEndpointResponse' :: Maybe (NonEmpty EndpointEventBus)
eventBuses = Maybe (NonEmpty EndpointEventBus)
a} :: CreateEndpointResponse) 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 name of the endpoint that was created by this request.
createEndpointResponse_name :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe Prelude.Text)
createEndpointResponse_name :: Lens' CreateEndpointResponse (Maybe Text)
createEndpointResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe Text
a -> CreateEndpointResponse
s {$sel:name:CreateEndpointResponse' :: Maybe Text
name = Maybe Text
a} :: CreateEndpointResponse)

-- | Whether event replication was enabled or disabled by this request.
createEndpointResponse_replicationConfig :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe ReplicationConfig)
createEndpointResponse_replicationConfig :: Lens' CreateEndpointResponse (Maybe ReplicationConfig)
createEndpointResponse_replicationConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe ReplicationConfig
replicationConfig :: Maybe ReplicationConfig
$sel:replicationConfig:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe ReplicationConfig
replicationConfig} -> Maybe ReplicationConfig
replicationConfig) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe ReplicationConfig
a -> CreateEndpointResponse
s {$sel:replicationConfig:CreateEndpointResponse' :: Maybe ReplicationConfig
replicationConfig = Maybe ReplicationConfig
a} :: CreateEndpointResponse)

-- | The ARN of the role used by event replication for this request.
createEndpointResponse_roleArn :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe Prelude.Text)
createEndpointResponse_roleArn :: Lens' CreateEndpointResponse (Maybe Text)
createEndpointResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe Text
a -> CreateEndpointResponse
s {$sel:roleArn:CreateEndpointResponse' :: Maybe Text
roleArn = Maybe Text
a} :: CreateEndpointResponse)

-- | The routing configuration defined by this request.
createEndpointResponse_routingConfig :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe RoutingConfig)
createEndpointResponse_routingConfig :: Lens' CreateEndpointResponse (Maybe RoutingConfig)
createEndpointResponse_routingConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe RoutingConfig
routingConfig :: Maybe RoutingConfig
$sel:routingConfig:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe RoutingConfig
routingConfig} -> Maybe RoutingConfig
routingConfig) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe RoutingConfig
a -> CreateEndpointResponse
s {$sel:routingConfig:CreateEndpointResponse' :: Maybe RoutingConfig
routingConfig = Maybe RoutingConfig
a} :: CreateEndpointResponse)

-- | The state of the endpoint that was created by this request.
createEndpointResponse_state :: Lens.Lens' CreateEndpointResponse (Prelude.Maybe EndpointState)
createEndpointResponse_state :: Lens' CreateEndpointResponse (Maybe EndpointState)
createEndpointResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateEndpointResponse' {Maybe EndpointState
state :: Maybe EndpointState
$sel:state:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe EndpointState
state} -> Maybe EndpointState
state) (\s :: CreateEndpointResponse
s@CreateEndpointResponse' {} Maybe EndpointState
a -> CreateEndpointResponse
s {$sel:state:CreateEndpointResponse' :: Maybe EndpointState
state = Maybe EndpointState
a} :: CreateEndpointResponse)

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

instance Prelude.NFData CreateEndpointResponse where
  rnf :: CreateEndpointResponse -> ()
rnf CreateEndpointResponse' {Int
Maybe (NonEmpty EndpointEventBus)
Maybe Text
Maybe EndpointState
Maybe ReplicationConfig
Maybe RoutingConfig
httpStatus :: Int
state :: Maybe EndpointState
routingConfig :: Maybe RoutingConfig
roleArn :: Maybe Text
replicationConfig :: Maybe ReplicationConfig
name :: Maybe Text
eventBuses :: Maybe (NonEmpty EndpointEventBus)
arn :: Maybe Text
$sel:httpStatus:CreateEndpointResponse' :: CreateEndpointResponse -> Int
$sel:state:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe EndpointState
$sel:routingConfig:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe RoutingConfig
$sel:roleArn:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe Text
$sel:replicationConfig:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe ReplicationConfig
$sel:name:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe Text
$sel:eventBuses:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe (NonEmpty EndpointEventBus)
$sel:arn:CreateEndpointResponse' :: CreateEndpointResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty EndpointEventBus)
eventBuses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReplicationConfig
replicationConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RoutingConfig
routingConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus