{-# 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.EMRContainers.CreateManagedEndpoint
-- 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 managed endpoint. A managed endpoint is a gateway that
-- connects EMR Studio to Amazon EMR on EKS so that EMR Studio can
-- communicate with your virtual cluster.
module Amazonka.EMRContainers.CreateManagedEndpoint
  ( -- * Creating a Request
    CreateManagedEndpoint (..),
    newCreateManagedEndpoint,

    -- * Request Lenses
    createManagedEndpoint_certificateArn,
    createManagedEndpoint_configurationOverrides,
    createManagedEndpoint_tags,
    createManagedEndpoint_name,
    createManagedEndpoint_virtualClusterId,
    createManagedEndpoint_type,
    createManagedEndpoint_releaseLabel,
    createManagedEndpoint_executionRoleArn,
    createManagedEndpoint_clientToken,

    -- * Destructuring the Response
    CreateManagedEndpointResponse (..),
    newCreateManagedEndpointResponse,

    -- * Response Lenses
    createManagedEndpointResponse_arn,
    createManagedEndpointResponse_id,
    createManagedEndpointResponse_name,
    createManagedEndpointResponse_virtualClusterId,
    createManagedEndpointResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EMRContainers.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateManagedEndpoint' smart constructor.
data CreateManagedEndpoint = CreateManagedEndpoint'
  { -- | The certificate ARN provided by users for the managed endpoint. This
    -- field is under deprecation and will be removed in future releases.
    CreateManagedEndpoint -> Maybe Text
certificateArn :: Prelude.Maybe Prelude.Text,
    -- | The configuration settings that will be used to override existing
    -- configurations.
    CreateManagedEndpoint -> Maybe ConfigurationOverrides
configurationOverrides :: Prelude.Maybe ConfigurationOverrides,
    -- | The tags of the managed endpoint.
    CreateManagedEndpoint -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the managed endpoint.
    CreateManagedEndpoint -> Text
name :: Prelude.Text,
    -- | The ID of the virtual cluster for which a managed endpoint is created.
    CreateManagedEndpoint -> Text
virtualClusterId :: Prelude.Text,
    -- | The type of the managed endpoint.
    CreateManagedEndpoint -> Text
type' :: Prelude.Text,
    -- | The Amazon EMR release version.
    CreateManagedEndpoint -> Text
releaseLabel :: Prelude.Text,
    -- | The ARN of the execution role.
    CreateManagedEndpoint -> Text
executionRoleArn :: Prelude.Text,
    -- | The client idempotency token for this create call.
    CreateManagedEndpoint -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateManagedEndpoint -> CreateManagedEndpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateManagedEndpoint -> CreateManagedEndpoint -> Bool
$c/= :: CreateManagedEndpoint -> CreateManagedEndpoint -> Bool
== :: CreateManagedEndpoint -> CreateManagedEndpoint -> Bool
$c== :: CreateManagedEndpoint -> CreateManagedEndpoint -> Bool
Prelude.Eq, Int -> CreateManagedEndpoint -> ShowS
[CreateManagedEndpoint] -> ShowS
CreateManagedEndpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateManagedEndpoint] -> ShowS
$cshowList :: [CreateManagedEndpoint] -> ShowS
show :: CreateManagedEndpoint -> String
$cshow :: CreateManagedEndpoint -> String
showsPrec :: Int -> CreateManagedEndpoint -> ShowS
$cshowsPrec :: Int -> CreateManagedEndpoint -> ShowS
Prelude.Show, forall x. Rep CreateManagedEndpoint x -> CreateManagedEndpoint
forall x. CreateManagedEndpoint -> Rep CreateManagedEndpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateManagedEndpoint x -> CreateManagedEndpoint
$cfrom :: forall x. CreateManagedEndpoint -> Rep CreateManagedEndpoint x
Prelude.Generic)

-- |
-- Create a value of 'CreateManagedEndpoint' 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:
--
-- 'certificateArn', 'createManagedEndpoint_certificateArn' - The certificate ARN provided by users for the managed endpoint. This
-- field is under deprecation and will be removed in future releases.
--
-- 'configurationOverrides', 'createManagedEndpoint_configurationOverrides' - The configuration settings that will be used to override existing
-- configurations.
--
-- 'tags', 'createManagedEndpoint_tags' - The tags of the managed endpoint.
--
-- 'name', 'createManagedEndpoint_name' - The name of the managed endpoint.
--
-- 'virtualClusterId', 'createManagedEndpoint_virtualClusterId' - The ID of the virtual cluster for which a managed endpoint is created.
--
-- 'type'', 'createManagedEndpoint_type' - The type of the managed endpoint.
--
-- 'releaseLabel', 'createManagedEndpoint_releaseLabel' - The Amazon EMR release version.
--
-- 'executionRoleArn', 'createManagedEndpoint_executionRoleArn' - The ARN of the execution role.
--
-- 'clientToken', 'createManagedEndpoint_clientToken' - The client idempotency token for this create call.
newCreateManagedEndpoint ::
  -- | 'name'
  Prelude.Text ->
  -- | 'virtualClusterId'
  Prelude.Text ->
  -- | 'type''
  Prelude.Text ->
  -- | 'releaseLabel'
  Prelude.Text ->
  -- | 'executionRoleArn'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateManagedEndpoint
newCreateManagedEndpoint :: Text
-> Text -> Text -> Text -> Text -> Text -> CreateManagedEndpoint
newCreateManagedEndpoint
  Text
pName_
  Text
pVirtualClusterId_
  Text
pType_
  Text
pReleaseLabel_
  Text
pExecutionRoleArn_
  Text
pClientToken_ =
    CreateManagedEndpoint'
      { $sel:certificateArn:CreateManagedEndpoint' :: Maybe Text
certificateArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:configurationOverrides:CreateManagedEndpoint' :: Maybe ConfigurationOverrides
configurationOverrides = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateManagedEndpoint' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateManagedEndpoint' :: Text
name = Text
pName_,
        $sel:virtualClusterId:CreateManagedEndpoint' :: Text
virtualClusterId = Text
pVirtualClusterId_,
        $sel:type':CreateManagedEndpoint' :: Text
type' = Text
pType_,
        $sel:releaseLabel:CreateManagedEndpoint' :: Text
releaseLabel = Text
pReleaseLabel_,
        $sel:executionRoleArn:CreateManagedEndpoint' :: Text
executionRoleArn = Text
pExecutionRoleArn_,
        $sel:clientToken:CreateManagedEndpoint' :: Text
clientToken = Text
pClientToken_
      }

-- | The certificate ARN provided by users for the managed endpoint. This
-- field is under deprecation and will be removed in future releases.
createManagedEndpoint_certificateArn :: Lens.Lens' CreateManagedEndpoint (Prelude.Maybe Prelude.Text)
createManagedEndpoint_certificateArn :: Lens' CreateManagedEndpoint (Maybe Text)
createManagedEndpoint_certificateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Maybe Text
certificateArn :: Maybe Text
$sel:certificateArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe Text
certificateArn} -> Maybe Text
certificateArn) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Maybe Text
a -> CreateManagedEndpoint
s {$sel:certificateArn:CreateManagedEndpoint' :: Maybe Text
certificateArn = Maybe Text
a} :: CreateManagedEndpoint)

-- | The configuration settings that will be used to override existing
-- configurations.
createManagedEndpoint_configurationOverrides :: Lens.Lens' CreateManagedEndpoint (Prelude.Maybe ConfigurationOverrides)
createManagedEndpoint_configurationOverrides :: Lens' CreateManagedEndpoint (Maybe ConfigurationOverrides)
createManagedEndpoint_configurationOverrides = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Maybe ConfigurationOverrides
configurationOverrides :: Maybe ConfigurationOverrides
$sel:configurationOverrides:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe ConfigurationOverrides
configurationOverrides} -> Maybe ConfigurationOverrides
configurationOverrides) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Maybe ConfigurationOverrides
a -> CreateManagedEndpoint
s {$sel:configurationOverrides:CreateManagedEndpoint' :: Maybe ConfigurationOverrides
configurationOverrides = Maybe ConfigurationOverrides
a} :: CreateManagedEndpoint)

-- | The tags of the managed endpoint.
createManagedEndpoint_tags :: Lens.Lens' CreateManagedEndpoint (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createManagedEndpoint_tags :: Lens' CreateManagedEndpoint (Maybe (HashMap Text Text))
createManagedEndpoint_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Maybe (HashMap Text Text)
a -> CreateManagedEndpoint
s {$sel:tags:CreateManagedEndpoint' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateManagedEndpoint) 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 managed endpoint.
createManagedEndpoint_name :: Lens.Lens' CreateManagedEndpoint Prelude.Text
createManagedEndpoint_name :: Lens' CreateManagedEndpoint Text
createManagedEndpoint_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Text
name :: Text
$sel:name:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
name} -> Text
name) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Text
a -> CreateManagedEndpoint
s {$sel:name:CreateManagedEndpoint' :: Text
name = Text
a} :: CreateManagedEndpoint)

-- | The ID of the virtual cluster for which a managed endpoint is created.
createManagedEndpoint_virtualClusterId :: Lens.Lens' CreateManagedEndpoint Prelude.Text
createManagedEndpoint_virtualClusterId :: Lens' CreateManagedEndpoint Text
createManagedEndpoint_virtualClusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Text
virtualClusterId :: Text
$sel:virtualClusterId:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
virtualClusterId} -> Text
virtualClusterId) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Text
a -> CreateManagedEndpoint
s {$sel:virtualClusterId:CreateManagedEndpoint' :: Text
virtualClusterId = Text
a} :: CreateManagedEndpoint)

-- | The type of the managed endpoint.
createManagedEndpoint_type :: Lens.Lens' CreateManagedEndpoint Prelude.Text
createManagedEndpoint_type :: Lens' CreateManagedEndpoint Text
createManagedEndpoint_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Text
type' :: Text
$sel:type':CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
type'} -> Text
type') (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Text
a -> CreateManagedEndpoint
s {$sel:type':CreateManagedEndpoint' :: Text
type' = Text
a} :: CreateManagedEndpoint)

-- | The Amazon EMR release version.
createManagedEndpoint_releaseLabel :: Lens.Lens' CreateManagedEndpoint Prelude.Text
createManagedEndpoint_releaseLabel :: Lens' CreateManagedEndpoint Text
createManagedEndpoint_releaseLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Text
releaseLabel :: Text
$sel:releaseLabel:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
releaseLabel} -> Text
releaseLabel) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Text
a -> CreateManagedEndpoint
s {$sel:releaseLabel:CreateManagedEndpoint' :: Text
releaseLabel = Text
a} :: CreateManagedEndpoint)

-- | The ARN of the execution role.
createManagedEndpoint_executionRoleArn :: Lens.Lens' CreateManagedEndpoint Prelude.Text
createManagedEndpoint_executionRoleArn :: Lens' CreateManagedEndpoint Text
createManagedEndpoint_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Text
executionRoleArn :: Text
$sel:executionRoleArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
executionRoleArn} -> Text
executionRoleArn) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Text
a -> CreateManagedEndpoint
s {$sel:executionRoleArn:CreateManagedEndpoint' :: Text
executionRoleArn = Text
a} :: CreateManagedEndpoint)

-- | The client idempotency token for this create call.
createManagedEndpoint_clientToken :: Lens.Lens' CreateManagedEndpoint Prelude.Text
createManagedEndpoint_clientToken :: Lens' CreateManagedEndpoint Text
createManagedEndpoint_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpoint' {Text
clientToken :: Text
$sel:clientToken:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
clientToken} -> Text
clientToken) (\s :: CreateManagedEndpoint
s@CreateManagedEndpoint' {} Text
a -> CreateManagedEndpoint
s {$sel:clientToken:CreateManagedEndpoint' :: Text
clientToken = Text
a} :: CreateManagedEndpoint)

instance Core.AWSRequest CreateManagedEndpoint where
  type
    AWSResponse CreateManagedEndpoint =
      CreateManagedEndpointResponse
  request :: (Service -> Service)
-> CreateManagedEndpoint -> Request CreateManagedEndpoint
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 CreateManagedEndpoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateManagedEndpoint)))
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 Text
-> Maybe Text
-> Maybe Text
-> Int
-> CreateManagedEndpointResponse
CreateManagedEndpointResponse'
            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
"id")
            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
"virtualClusterId")
            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 CreateManagedEndpoint where
  hashWithSalt :: Int -> CreateManagedEndpoint -> Int
hashWithSalt Int
_salt CreateManagedEndpoint' {Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Text
clientToken :: Text
executionRoleArn :: Text
releaseLabel :: Text
type' :: Text
virtualClusterId :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
configurationOverrides :: Maybe ConfigurationOverrides
certificateArn :: Maybe Text
$sel:clientToken:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:executionRoleArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:releaseLabel:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:type':CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:virtualClusterId:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:name:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:tags:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe (HashMap Text Text)
$sel:configurationOverrides:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe ConfigurationOverrides
$sel:certificateArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificateArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConfigurationOverrides
configurationOverrides
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
virtualClusterId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
releaseLabel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateManagedEndpoint where
  rnf :: CreateManagedEndpoint -> ()
rnf CreateManagedEndpoint' {Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Text
clientToken :: Text
executionRoleArn :: Text
releaseLabel :: Text
type' :: Text
virtualClusterId :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
configurationOverrides :: Maybe ConfigurationOverrides
certificateArn :: Maybe Text
$sel:clientToken:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:executionRoleArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:releaseLabel:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:type':CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:virtualClusterId:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:name:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:tags:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe (HashMap Text Text)
$sel:configurationOverrides:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe ConfigurationOverrides
$sel:certificateArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigurationOverrides
configurationOverrides
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      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 Text
virtualClusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
releaseLabel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateManagedEndpoint where
  toHeaders :: CreateManagedEndpoint -> 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 CreateManagedEndpoint where
  toJSON :: CreateManagedEndpoint -> Value
toJSON CreateManagedEndpoint' {Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Text
clientToken :: Text
executionRoleArn :: Text
releaseLabel :: Text
type' :: Text
virtualClusterId :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
configurationOverrides :: Maybe ConfigurationOverrides
certificateArn :: Maybe Text
$sel:clientToken:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:executionRoleArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:releaseLabel:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:type':CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:virtualClusterId:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:name:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:tags:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe (HashMap Text Text)
$sel:configurationOverrides:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe ConfigurationOverrides
$sel:certificateArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"certificateArn" 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
certificateArn,
            (Key
"configurationOverrides" 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 ConfigurationOverrides
configurationOverrides,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            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
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
type'),
            forall a. a -> Maybe a
Prelude.Just (Key
"releaseLabel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
releaseLabel),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"executionRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
executionRoleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

instance Data.ToPath CreateManagedEndpoint where
  toPath :: CreateManagedEndpoint -> ByteString
toPath CreateManagedEndpoint' {Maybe Text
Maybe (HashMap Text Text)
Maybe ConfigurationOverrides
Text
clientToken :: Text
executionRoleArn :: Text
releaseLabel :: Text
type' :: Text
virtualClusterId :: Text
name :: Text
tags :: Maybe (HashMap Text Text)
configurationOverrides :: Maybe ConfigurationOverrides
certificateArn :: Maybe Text
$sel:clientToken:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:executionRoleArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:releaseLabel:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:type':CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:virtualClusterId:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:name:CreateManagedEndpoint' :: CreateManagedEndpoint -> Text
$sel:tags:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe (HashMap Text Text)
$sel:configurationOverrides:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe ConfigurationOverrides
$sel:certificateArn:CreateManagedEndpoint' :: CreateManagedEndpoint -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/virtualclusters/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
virtualClusterId,
        ByteString
"/endpoints"
      ]

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

-- | /See:/ 'newCreateManagedEndpointResponse' smart constructor.
data CreateManagedEndpointResponse = CreateManagedEndpointResponse'
  { -- | The output contains the ARN of the managed endpoint.
    CreateManagedEndpointResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The output contains the ID of the managed endpoint.
    CreateManagedEndpointResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The output contains the name of the managed endpoint.
    CreateManagedEndpointResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The output contains the ID of the virtual cluster.
    CreateManagedEndpointResponse -> Maybe Text
virtualClusterId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateManagedEndpointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateManagedEndpointResponse
-> CreateManagedEndpointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateManagedEndpointResponse
-> CreateManagedEndpointResponse -> Bool
$c/= :: CreateManagedEndpointResponse
-> CreateManagedEndpointResponse -> Bool
== :: CreateManagedEndpointResponse
-> CreateManagedEndpointResponse -> Bool
$c== :: CreateManagedEndpointResponse
-> CreateManagedEndpointResponse -> Bool
Prelude.Eq, ReadPrec [CreateManagedEndpointResponse]
ReadPrec CreateManagedEndpointResponse
Int -> ReadS CreateManagedEndpointResponse
ReadS [CreateManagedEndpointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateManagedEndpointResponse]
$creadListPrec :: ReadPrec [CreateManagedEndpointResponse]
readPrec :: ReadPrec CreateManagedEndpointResponse
$creadPrec :: ReadPrec CreateManagedEndpointResponse
readList :: ReadS [CreateManagedEndpointResponse]
$creadList :: ReadS [CreateManagedEndpointResponse]
readsPrec :: Int -> ReadS CreateManagedEndpointResponse
$creadsPrec :: Int -> ReadS CreateManagedEndpointResponse
Prelude.Read, Int -> CreateManagedEndpointResponse -> ShowS
[CreateManagedEndpointResponse] -> ShowS
CreateManagedEndpointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateManagedEndpointResponse] -> ShowS
$cshowList :: [CreateManagedEndpointResponse] -> ShowS
show :: CreateManagedEndpointResponse -> String
$cshow :: CreateManagedEndpointResponse -> String
showsPrec :: Int -> CreateManagedEndpointResponse -> ShowS
$cshowsPrec :: Int -> CreateManagedEndpointResponse -> ShowS
Prelude.Show, forall x.
Rep CreateManagedEndpointResponse x
-> CreateManagedEndpointResponse
forall x.
CreateManagedEndpointResponse
-> Rep CreateManagedEndpointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateManagedEndpointResponse x
-> CreateManagedEndpointResponse
$cfrom :: forall x.
CreateManagedEndpointResponse
-> Rep CreateManagedEndpointResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateManagedEndpointResponse' 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', 'createManagedEndpointResponse_arn' - The output contains the ARN of the managed endpoint.
--
-- 'id', 'createManagedEndpointResponse_id' - The output contains the ID of the managed endpoint.
--
-- 'name', 'createManagedEndpointResponse_name' - The output contains the name of the managed endpoint.
--
-- 'virtualClusterId', 'createManagedEndpointResponse_virtualClusterId' - The output contains the ID of the virtual cluster.
--
-- 'httpStatus', 'createManagedEndpointResponse_httpStatus' - The response's http status code.
newCreateManagedEndpointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateManagedEndpointResponse
newCreateManagedEndpointResponse :: Int -> CreateManagedEndpointResponse
newCreateManagedEndpointResponse Int
pHttpStatus_ =
  CreateManagedEndpointResponse'
    { $sel:arn:CreateManagedEndpointResponse' :: Maybe Text
arn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateManagedEndpointResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateManagedEndpointResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:virtualClusterId:CreateManagedEndpointResponse' :: Maybe Text
virtualClusterId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateManagedEndpointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The output contains the ARN of the managed endpoint.
createManagedEndpointResponse_arn :: Lens.Lens' CreateManagedEndpointResponse (Prelude.Maybe Prelude.Text)
createManagedEndpointResponse_arn :: Lens' CreateManagedEndpointResponse (Maybe Text)
createManagedEndpointResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpointResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateManagedEndpointResponse
s@CreateManagedEndpointResponse' {} Maybe Text
a -> CreateManagedEndpointResponse
s {$sel:arn:CreateManagedEndpointResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateManagedEndpointResponse)

-- | The output contains the ID of the managed endpoint.
createManagedEndpointResponse_id :: Lens.Lens' CreateManagedEndpointResponse (Prelude.Maybe Prelude.Text)
createManagedEndpointResponse_id :: Lens' CreateManagedEndpointResponse (Maybe Text)
createManagedEndpointResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpointResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateManagedEndpointResponse
s@CreateManagedEndpointResponse' {} Maybe Text
a -> CreateManagedEndpointResponse
s {$sel:id:CreateManagedEndpointResponse' :: Maybe Text
id = Maybe Text
a} :: CreateManagedEndpointResponse)

-- | The output contains the name of the managed endpoint.
createManagedEndpointResponse_name :: Lens.Lens' CreateManagedEndpointResponse (Prelude.Maybe Prelude.Text)
createManagedEndpointResponse_name :: Lens' CreateManagedEndpointResponse (Maybe Text)
createManagedEndpointResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpointResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateManagedEndpointResponse
s@CreateManagedEndpointResponse' {} Maybe Text
a -> CreateManagedEndpointResponse
s {$sel:name:CreateManagedEndpointResponse' :: Maybe Text
name = Maybe Text
a} :: CreateManagedEndpointResponse)

-- | The output contains the ID of the virtual cluster.
createManagedEndpointResponse_virtualClusterId :: Lens.Lens' CreateManagedEndpointResponse (Prelude.Maybe Prelude.Text)
createManagedEndpointResponse_virtualClusterId :: Lens' CreateManagedEndpointResponse (Maybe Text)
createManagedEndpointResponse_virtualClusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateManagedEndpointResponse' {Maybe Text
virtualClusterId :: Maybe Text
$sel:virtualClusterId:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Maybe Text
virtualClusterId} -> Maybe Text
virtualClusterId) (\s :: CreateManagedEndpointResponse
s@CreateManagedEndpointResponse' {} Maybe Text
a -> CreateManagedEndpointResponse
s {$sel:virtualClusterId:CreateManagedEndpointResponse' :: Maybe Text
virtualClusterId = Maybe Text
a} :: CreateManagedEndpointResponse)

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

instance Prelude.NFData CreateManagedEndpointResponse where
  rnf :: CreateManagedEndpointResponse -> ()
rnf CreateManagedEndpointResponse' {Int
Maybe Text
httpStatus :: Int
virtualClusterId :: Maybe Text
name :: Maybe Text
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Int
$sel:virtualClusterId:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Maybe Text
$sel:name:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Maybe Text
$sel:id:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> Maybe Text
$sel:arn:CreateManagedEndpointResponse' :: CreateManagedEndpointResponse -> 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 Text
id
      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 Text
virtualClusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus