{-# 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.AppFlow.CreateConnectorProfile
-- 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 connector profile associated with your Amazon Web Services
-- account. There is a soft quota of 100 connector profiles per Amazon Web
-- Services account. If you need more connector profiles than this quota
-- allows, you can submit a request to the Amazon AppFlow team through the
-- Amazon AppFlow support channel. In each connector profile that you
-- create, you can provide the credentials and properties for only one
-- connector.
module Amazonka.AppFlow.CreateConnectorProfile
  ( -- * Creating a Request
    CreateConnectorProfile (..),
    newCreateConnectorProfile,

    -- * Request Lenses
    createConnectorProfile_connectorLabel,
    createConnectorProfile_kmsArn,
    createConnectorProfile_connectorProfileName,
    createConnectorProfile_connectorType,
    createConnectorProfile_connectionMode,
    createConnectorProfile_connectorProfileConfig,

    -- * Destructuring the Response
    CreateConnectorProfileResponse (..),
    newCreateConnectorProfileResponse,

    -- * Response Lenses
    createConnectorProfileResponse_connectorProfileArn,
    createConnectorProfileResponse_httpStatus,
  )
where

import Amazonka.AppFlow.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:/ 'newCreateConnectorProfile' smart constructor.
data CreateConnectorProfile = CreateConnectorProfile'
  { -- | The label of the connector. The label is unique for each
    -- @ConnectorRegistration@ in your Amazon Web Services account. Only needed
    -- if calling for CUSTOMCONNECTOR connector type\/.
    CreateConnectorProfile -> Maybe Text
connectorLabel :: Prelude.Maybe Prelude.Text,
    -- | The ARN (Amazon Resource Name) of the Key Management Service (KMS) key
    -- you provide for encryption. This is required if you do not want to use
    -- the Amazon AppFlow-managed KMS key. If you don\'t provide anything here,
    -- Amazon AppFlow uses the Amazon AppFlow-managed KMS key.
    CreateConnectorProfile -> Maybe Text
kmsArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the connector profile. The name is unique for each
    -- @ConnectorProfile@ in your Amazon Web Services account.
    CreateConnectorProfile -> Text
connectorProfileName :: Prelude.Text,
    -- | The type of connector, such as Salesforce, Amplitude, and so on.
    CreateConnectorProfile -> ConnectorType
connectorType :: ConnectorType,
    -- | Indicates the connection mode and specifies whether it is public or
    -- private. Private flows use Amazon Web Services PrivateLink to route data
    -- over Amazon Web Services infrastructure without exposing it to the
    -- public internet.
    CreateConnectorProfile -> ConnectionMode
connectionMode :: ConnectionMode,
    -- | Defines the connector-specific configuration and credentials.
    CreateConnectorProfile -> ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
  }
  deriving (CreateConnectorProfile -> CreateConnectorProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnectorProfile -> CreateConnectorProfile -> Bool
$c/= :: CreateConnectorProfile -> CreateConnectorProfile -> Bool
== :: CreateConnectorProfile -> CreateConnectorProfile -> Bool
$c== :: CreateConnectorProfile -> CreateConnectorProfile -> Bool
Prelude.Eq, Int -> CreateConnectorProfile -> ShowS
[CreateConnectorProfile] -> ShowS
CreateConnectorProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnectorProfile] -> ShowS
$cshowList :: [CreateConnectorProfile] -> ShowS
show :: CreateConnectorProfile -> String
$cshow :: CreateConnectorProfile -> String
showsPrec :: Int -> CreateConnectorProfile -> ShowS
$cshowsPrec :: Int -> CreateConnectorProfile -> ShowS
Prelude.Show, forall x. Rep CreateConnectorProfile x -> CreateConnectorProfile
forall x. CreateConnectorProfile -> Rep CreateConnectorProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateConnectorProfile x -> CreateConnectorProfile
$cfrom :: forall x. CreateConnectorProfile -> Rep CreateConnectorProfile x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnectorProfile' 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:
--
-- 'connectorLabel', 'createConnectorProfile_connectorLabel' - The label of the connector. The label is unique for each
-- @ConnectorRegistration@ in your Amazon Web Services account. Only needed
-- if calling for CUSTOMCONNECTOR connector type\/.
--
-- 'kmsArn', 'createConnectorProfile_kmsArn' - The ARN (Amazon Resource Name) of the Key Management Service (KMS) key
-- you provide for encryption. This is required if you do not want to use
-- the Amazon AppFlow-managed KMS key. If you don\'t provide anything here,
-- Amazon AppFlow uses the Amazon AppFlow-managed KMS key.
--
-- 'connectorProfileName', 'createConnectorProfile_connectorProfileName' - The name of the connector profile. The name is unique for each
-- @ConnectorProfile@ in your Amazon Web Services account.
--
-- 'connectorType', 'createConnectorProfile_connectorType' - The type of connector, such as Salesforce, Amplitude, and so on.
--
-- 'connectionMode', 'createConnectorProfile_connectionMode' - Indicates the connection mode and specifies whether it is public or
-- private. Private flows use Amazon Web Services PrivateLink to route data
-- over Amazon Web Services infrastructure without exposing it to the
-- public internet.
--
-- 'connectorProfileConfig', 'createConnectorProfile_connectorProfileConfig' - Defines the connector-specific configuration and credentials.
newCreateConnectorProfile ::
  -- | 'connectorProfileName'
  Prelude.Text ->
  -- | 'connectorType'
  ConnectorType ->
  -- | 'connectionMode'
  ConnectionMode ->
  -- | 'connectorProfileConfig'
  ConnectorProfileConfig ->
  CreateConnectorProfile
newCreateConnectorProfile :: Text
-> ConnectorType
-> ConnectionMode
-> ConnectorProfileConfig
-> CreateConnectorProfile
newCreateConnectorProfile
  Text
pConnectorProfileName_
  ConnectorType
pConnectorType_
  ConnectionMode
pConnectionMode_
  ConnectorProfileConfig
pConnectorProfileConfig_ =
    CreateConnectorProfile'
      { $sel:connectorLabel:CreateConnectorProfile' :: Maybe Text
connectorLabel =
          forall a. Maybe a
Prelude.Nothing,
        $sel:kmsArn:CreateConnectorProfile' :: Maybe Text
kmsArn = forall a. Maybe a
Prelude.Nothing,
        $sel:connectorProfileName:CreateConnectorProfile' :: Text
connectorProfileName = Text
pConnectorProfileName_,
        $sel:connectorType:CreateConnectorProfile' :: ConnectorType
connectorType = ConnectorType
pConnectorType_,
        $sel:connectionMode:CreateConnectorProfile' :: ConnectionMode
connectionMode = ConnectionMode
pConnectionMode_,
        $sel:connectorProfileConfig:CreateConnectorProfile' :: ConnectorProfileConfig
connectorProfileConfig = ConnectorProfileConfig
pConnectorProfileConfig_
      }

-- | The label of the connector. The label is unique for each
-- @ConnectorRegistration@ in your Amazon Web Services account. Only needed
-- if calling for CUSTOMCONNECTOR connector type\/.
createConnectorProfile_connectorLabel :: Lens.Lens' CreateConnectorProfile (Prelude.Maybe Prelude.Text)
createConnectorProfile_connectorLabel :: Lens' CreateConnectorProfile (Maybe Text)
createConnectorProfile_connectorLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorProfile' {Maybe Text
connectorLabel :: Maybe Text
$sel:connectorLabel:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
connectorLabel} -> Maybe Text
connectorLabel) (\s :: CreateConnectorProfile
s@CreateConnectorProfile' {} Maybe Text
a -> CreateConnectorProfile
s {$sel:connectorLabel:CreateConnectorProfile' :: Maybe Text
connectorLabel = Maybe Text
a} :: CreateConnectorProfile)

-- | The ARN (Amazon Resource Name) of the Key Management Service (KMS) key
-- you provide for encryption. This is required if you do not want to use
-- the Amazon AppFlow-managed KMS key. If you don\'t provide anything here,
-- Amazon AppFlow uses the Amazon AppFlow-managed KMS key.
createConnectorProfile_kmsArn :: Lens.Lens' CreateConnectorProfile (Prelude.Maybe Prelude.Text)
createConnectorProfile_kmsArn :: Lens' CreateConnectorProfile (Maybe Text)
createConnectorProfile_kmsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorProfile' {Maybe Text
kmsArn :: Maybe Text
$sel:kmsArn:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
kmsArn} -> Maybe Text
kmsArn) (\s :: CreateConnectorProfile
s@CreateConnectorProfile' {} Maybe Text
a -> CreateConnectorProfile
s {$sel:kmsArn:CreateConnectorProfile' :: Maybe Text
kmsArn = Maybe Text
a} :: CreateConnectorProfile)

-- | The name of the connector profile. The name is unique for each
-- @ConnectorProfile@ in your Amazon Web Services account.
createConnectorProfile_connectorProfileName :: Lens.Lens' CreateConnectorProfile Prelude.Text
createConnectorProfile_connectorProfileName :: Lens' CreateConnectorProfile Text
createConnectorProfile_connectorProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorProfile' {Text
connectorProfileName :: Text
$sel:connectorProfileName:CreateConnectorProfile' :: CreateConnectorProfile -> Text
connectorProfileName} -> Text
connectorProfileName) (\s :: CreateConnectorProfile
s@CreateConnectorProfile' {} Text
a -> CreateConnectorProfile
s {$sel:connectorProfileName:CreateConnectorProfile' :: Text
connectorProfileName = Text
a} :: CreateConnectorProfile)

-- | The type of connector, such as Salesforce, Amplitude, and so on.
createConnectorProfile_connectorType :: Lens.Lens' CreateConnectorProfile ConnectorType
createConnectorProfile_connectorType :: Lens' CreateConnectorProfile ConnectorType
createConnectorProfile_connectorType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorProfile' {ConnectorType
connectorType :: ConnectorType
$sel:connectorType:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorType
connectorType} -> ConnectorType
connectorType) (\s :: CreateConnectorProfile
s@CreateConnectorProfile' {} ConnectorType
a -> CreateConnectorProfile
s {$sel:connectorType:CreateConnectorProfile' :: ConnectorType
connectorType = ConnectorType
a} :: CreateConnectorProfile)

-- | Indicates the connection mode and specifies whether it is public or
-- private. Private flows use Amazon Web Services PrivateLink to route data
-- over Amazon Web Services infrastructure without exposing it to the
-- public internet.
createConnectorProfile_connectionMode :: Lens.Lens' CreateConnectorProfile ConnectionMode
createConnectorProfile_connectionMode :: Lens' CreateConnectorProfile ConnectionMode
createConnectorProfile_connectionMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorProfile' {ConnectionMode
connectionMode :: ConnectionMode
$sel:connectionMode:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectionMode
connectionMode} -> ConnectionMode
connectionMode) (\s :: CreateConnectorProfile
s@CreateConnectorProfile' {} ConnectionMode
a -> CreateConnectorProfile
s {$sel:connectionMode:CreateConnectorProfile' :: ConnectionMode
connectionMode = ConnectionMode
a} :: CreateConnectorProfile)

-- | Defines the connector-specific configuration and credentials.
createConnectorProfile_connectorProfileConfig :: Lens.Lens' CreateConnectorProfile ConnectorProfileConfig
createConnectorProfile_connectorProfileConfig :: Lens' CreateConnectorProfile ConnectorProfileConfig
createConnectorProfile_connectorProfileConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorProfile' {ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
$sel:connectorProfileConfig:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorProfileConfig
connectorProfileConfig} -> ConnectorProfileConfig
connectorProfileConfig) (\s :: CreateConnectorProfile
s@CreateConnectorProfile' {} ConnectorProfileConfig
a -> CreateConnectorProfile
s {$sel:connectorProfileConfig:CreateConnectorProfile' :: ConnectorProfileConfig
connectorProfileConfig = ConnectorProfileConfig
a} :: CreateConnectorProfile)

instance Core.AWSRequest CreateConnectorProfile where
  type
    AWSResponse CreateConnectorProfile =
      CreateConnectorProfileResponse
  request :: (Service -> Service)
-> CreateConnectorProfile -> Request CreateConnectorProfile
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 CreateConnectorProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateConnectorProfile)))
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 -> CreateConnectorProfileResponse
CreateConnectorProfileResponse'
            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
"connectorProfileArn")
            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 CreateConnectorProfile where
  hashWithSalt :: Int -> CreateConnectorProfile -> Int
hashWithSalt Int
_salt CreateConnectorProfile' {Maybe Text
Text
ConnectionMode
ConnectorType
ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
connectionMode :: ConnectionMode
connectorType :: ConnectorType
connectorProfileName :: Text
kmsArn :: Maybe Text
connectorLabel :: Maybe Text
$sel:connectorProfileConfig:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorProfileConfig
$sel:connectionMode:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectionMode
$sel:connectorType:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorType
$sel:connectorProfileName:CreateConnectorProfile' :: CreateConnectorProfile -> Text
$sel:kmsArn:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
$sel:connectorLabel:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectorLabel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectorProfileName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConnectorType
connectorType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConnectionMode
connectionMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConnectorProfileConfig
connectorProfileConfig

instance Prelude.NFData CreateConnectorProfile where
  rnf :: CreateConnectorProfile -> ()
rnf CreateConnectorProfile' {Maybe Text
Text
ConnectionMode
ConnectorType
ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
connectionMode :: ConnectionMode
connectorType :: ConnectorType
connectorProfileName :: Text
kmsArn :: Maybe Text
connectorLabel :: Maybe Text
$sel:connectorProfileConfig:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorProfileConfig
$sel:connectionMode:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectionMode
$sel:connectorType:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorType
$sel:connectorProfileName:CreateConnectorProfile' :: CreateConnectorProfile -> Text
$sel:kmsArn:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
$sel:connectorLabel:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectorLabel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectorProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConnectorType
connectorType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConnectionMode
connectionMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConnectorProfileConfig
connectorProfileConfig

instance Data.ToHeaders CreateConnectorProfile where
  toHeaders :: CreateConnectorProfile -> 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 CreateConnectorProfile where
  toJSON :: CreateConnectorProfile -> Value
toJSON CreateConnectorProfile' {Maybe Text
Text
ConnectionMode
ConnectorType
ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
connectionMode :: ConnectionMode
connectorType :: ConnectorType
connectorProfileName :: Text
kmsArn :: Maybe Text
connectorLabel :: Maybe Text
$sel:connectorProfileConfig:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorProfileConfig
$sel:connectionMode:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectionMode
$sel:connectorType:CreateConnectorProfile' :: CreateConnectorProfile -> ConnectorType
$sel:connectorProfileName:CreateConnectorProfile' :: CreateConnectorProfile -> Text
$sel:kmsArn:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
$sel:connectorLabel:CreateConnectorProfile' :: CreateConnectorProfile -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"connectorLabel" 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
connectorLabel,
            (Key
"kmsArn" 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
kmsArn,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"connectorProfileName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectorProfileName
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"connectorType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ConnectorType
connectorType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"connectionMode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ConnectionMode
connectionMode),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"connectorProfileConfig"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ConnectorProfileConfig
connectorProfileConfig
              )
          ]
      )

instance Data.ToPath CreateConnectorProfile where
  toPath :: CreateConnectorProfile -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/create-connector-profile"

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

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

-- |
-- Create a value of 'CreateConnectorProfileResponse' 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:
--
-- 'connectorProfileArn', 'createConnectorProfileResponse_connectorProfileArn' - The Amazon Resource Name (ARN) of the connector profile.
--
-- 'httpStatus', 'createConnectorProfileResponse_httpStatus' - The response's http status code.
newCreateConnectorProfileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateConnectorProfileResponse
newCreateConnectorProfileResponse :: Int -> CreateConnectorProfileResponse
newCreateConnectorProfileResponse Int
pHttpStatus_ =
  CreateConnectorProfileResponse'
    { $sel:connectorProfileArn:CreateConnectorProfileResponse' :: Maybe Text
connectorProfileArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateConnectorProfileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the connector profile.
createConnectorProfileResponse_connectorProfileArn :: Lens.Lens' CreateConnectorProfileResponse (Prelude.Maybe Prelude.Text)
createConnectorProfileResponse_connectorProfileArn :: Lens' CreateConnectorProfileResponse (Maybe Text)
createConnectorProfileResponse_connectorProfileArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorProfileResponse' {Maybe Text
connectorProfileArn :: Maybe Text
$sel:connectorProfileArn:CreateConnectorProfileResponse' :: CreateConnectorProfileResponse -> Maybe Text
connectorProfileArn} -> Maybe Text
connectorProfileArn) (\s :: CreateConnectorProfileResponse
s@CreateConnectorProfileResponse' {} Maybe Text
a -> CreateConnectorProfileResponse
s {$sel:connectorProfileArn:CreateConnectorProfileResponse' :: Maybe Text
connectorProfileArn = Maybe Text
a} :: CreateConnectorProfileResponse)

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

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