{-# 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.UpdateConnectorProfile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a given connector profile associated with your account.
module Amazonka.AppFlow.UpdateConnectorProfile
  ( -- * Creating a Request
    UpdateConnectorProfile (..),
    newUpdateConnectorProfile,

    -- * Request Lenses
    updateConnectorProfile_connectorProfileName,
    updateConnectorProfile_connectionMode,
    updateConnectorProfile_connectorProfileConfig,

    -- * Destructuring the Response
    UpdateConnectorProfileResponse (..),
    newUpdateConnectorProfileResponse,

    -- * Response Lenses
    updateConnectorProfileResponse_connectorProfileArn,
    updateConnectorProfileResponse_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:/ 'newUpdateConnectorProfile' smart constructor.
data UpdateConnectorProfile = UpdateConnectorProfile'
  { -- | The name of the connector profile and is unique for each
    -- @ConnectorProfile@ in the Amazon Web Services account.
    UpdateConnectorProfile -> Text
connectorProfileName :: Prelude.Text,
    -- | Indicates the connection mode and if it is public or private.
    UpdateConnectorProfile -> ConnectionMode
connectionMode :: ConnectionMode,
    -- | Defines the connector-specific profile configuration and credentials.
    UpdateConnectorProfile -> ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
  }
  deriving (UpdateConnectorProfile -> UpdateConnectorProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateConnectorProfile -> UpdateConnectorProfile -> Bool
$c/= :: UpdateConnectorProfile -> UpdateConnectorProfile -> Bool
== :: UpdateConnectorProfile -> UpdateConnectorProfile -> Bool
$c== :: UpdateConnectorProfile -> UpdateConnectorProfile -> Bool
Prelude.Eq, Int -> UpdateConnectorProfile -> ShowS
[UpdateConnectorProfile] -> ShowS
UpdateConnectorProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateConnectorProfile] -> ShowS
$cshowList :: [UpdateConnectorProfile] -> ShowS
show :: UpdateConnectorProfile -> String
$cshow :: UpdateConnectorProfile -> String
showsPrec :: Int -> UpdateConnectorProfile -> ShowS
$cshowsPrec :: Int -> UpdateConnectorProfile -> ShowS
Prelude.Show, forall x. Rep UpdateConnectorProfile x -> UpdateConnectorProfile
forall x. UpdateConnectorProfile -> Rep UpdateConnectorProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateConnectorProfile x -> UpdateConnectorProfile
$cfrom :: forall x. UpdateConnectorProfile -> Rep UpdateConnectorProfile x
Prelude.Generic)

-- |
-- Create a value of 'UpdateConnectorProfile' 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:
--
-- 'connectorProfileName', 'updateConnectorProfile_connectorProfileName' - The name of the connector profile and is unique for each
-- @ConnectorProfile@ in the Amazon Web Services account.
--
-- 'connectionMode', 'updateConnectorProfile_connectionMode' - Indicates the connection mode and if it is public or private.
--
-- 'connectorProfileConfig', 'updateConnectorProfile_connectorProfileConfig' - Defines the connector-specific profile configuration and credentials.
newUpdateConnectorProfile ::
  -- | 'connectorProfileName'
  Prelude.Text ->
  -- | 'connectionMode'
  ConnectionMode ->
  -- | 'connectorProfileConfig'
  ConnectorProfileConfig ->
  UpdateConnectorProfile
newUpdateConnectorProfile :: Text
-> ConnectionMode
-> ConnectorProfileConfig
-> UpdateConnectorProfile
newUpdateConnectorProfile
  Text
pConnectorProfileName_
  ConnectionMode
pConnectionMode_
  ConnectorProfileConfig
pConnectorProfileConfig_ =
    UpdateConnectorProfile'
      { $sel:connectorProfileName:UpdateConnectorProfile' :: Text
connectorProfileName =
          Text
pConnectorProfileName_,
        $sel:connectionMode:UpdateConnectorProfile' :: ConnectionMode
connectionMode = ConnectionMode
pConnectionMode_,
        $sel:connectorProfileConfig:UpdateConnectorProfile' :: ConnectorProfileConfig
connectorProfileConfig = ConnectorProfileConfig
pConnectorProfileConfig_
      }

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

-- | Indicates the connection mode and if it is public or private.
updateConnectorProfile_connectionMode :: Lens.Lens' UpdateConnectorProfile ConnectionMode
updateConnectorProfile_connectionMode :: Lens' UpdateConnectorProfile ConnectionMode
updateConnectorProfile_connectionMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnectorProfile' {ConnectionMode
connectionMode :: ConnectionMode
$sel:connectionMode:UpdateConnectorProfile' :: UpdateConnectorProfile -> ConnectionMode
connectionMode} -> ConnectionMode
connectionMode) (\s :: UpdateConnectorProfile
s@UpdateConnectorProfile' {} ConnectionMode
a -> UpdateConnectorProfile
s {$sel:connectionMode:UpdateConnectorProfile' :: ConnectionMode
connectionMode = ConnectionMode
a} :: UpdateConnectorProfile)

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

instance Core.AWSRequest UpdateConnectorProfile where
  type
    AWSResponse UpdateConnectorProfile =
      UpdateConnectorProfileResponse
  request :: (Service -> Service)
-> UpdateConnectorProfile -> Request UpdateConnectorProfile
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 UpdateConnectorProfile
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateConnectorProfile)))
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 -> UpdateConnectorProfileResponse
UpdateConnectorProfileResponse'
            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 UpdateConnectorProfile where
  hashWithSalt :: Int -> UpdateConnectorProfile -> Int
hashWithSalt Int
_salt UpdateConnectorProfile' {Text
ConnectionMode
ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
connectionMode :: ConnectionMode
connectorProfileName :: Text
$sel:connectorProfileConfig:UpdateConnectorProfile' :: UpdateConnectorProfile -> ConnectorProfileConfig
$sel:connectionMode:UpdateConnectorProfile' :: UpdateConnectorProfile -> ConnectionMode
$sel:connectorProfileName:UpdateConnectorProfile' :: UpdateConnectorProfile -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectorProfileName
      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 UpdateConnectorProfile where
  rnf :: UpdateConnectorProfile -> ()
rnf UpdateConnectorProfile' {Text
ConnectionMode
ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
connectionMode :: ConnectionMode
connectorProfileName :: Text
$sel:connectorProfileConfig:UpdateConnectorProfile' :: UpdateConnectorProfile -> ConnectorProfileConfig
$sel:connectionMode:UpdateConnectorProfile' :: UpdateConnectorProfile -> ConnectionMode
$sel:connectorProfileName:UpdateConnectorProfile' :: UpdateConnectorProfile -> Text
..} =
    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 ConnectionMode
connectionMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConnectorProfileConfig
connectorProfileConfig

instance Data.ToHeaders UpdateConnectorProfile where
  toHeaders :: UpdateConnectorProfile -> 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 UpdateConnectorProfile where
  toJSON :: UpdateConnectorProfile -> Value
toJSON UpdateConnectorProfile' {Text
ConnectionMode
ConnectorProfileConfig
connectorProfileConfig :: ConnectorProfileConfig
connectionMode :: ConnectionMode
connectorProfileName :: Text
$sel:connectorProfileConfig:UpdateConnectorProfile' :: UpdateConnectorProfile -> ConnectorProfileConfig
$sel:connectionMode:UpdateConnectorProfile' :: UpdateConnectorProfile -> ConnectionMode
$sel:connectorProfileName:UpdateConnectorProfile' :: UpdateConnectorProfile -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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
"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 UpdateConnectorProfile where
  toPath :: UpdateConnectorProfile -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/update-connector-profile"

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

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

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

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

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

instance
  Prelude.NFData
    UpdateConnectorProfileResponse
  where
  rnf :: UpdateConnectorProfileResponse -> ()
rnf UpdateConnectorProfileResponse' {Int
Maybe Text
httpStatus :: Int
connectorProfileArn :: Maybe Text
$sel:httpStatus:UpdateConnectorProfileResponse' :: UpdateConnectorProfileResponse -> Int
$sel:connectorProfileArn:UpdateConnectorProfileResponse' :: UpdateConnectorProfileResponse -> 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