{-# 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.Transfer.UpdateConnector
-- 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 some of the parameters for an existing connector. Provide the
-- @ConnectorId@ for the connector that you want to update, along with the
-- new values for the parameters to update.
module Amazonka.Transfer.UpdateConnector
  ( -- * Creating a Request
    UpdateConnector (..),
    newUpdateConnector,

    -- * Request Lenses
    updateConnector_accessRole,
    updateConnector_as2Config,
    updateConnector_loggingRole,
    updateConnector_url,
    updateConnector_connectorId,

    -- * Destructuring the Response
    UpdateConnectorResponse (..),
    newUpdateConnectorResponse,

    -- * Response Lenses
    updateConnectorResponse_httpStatus,
    updateConnectorResponse_connectorId,
  )
where

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

-- | /See:/ 'newUpdateConnector' smart constructor.
data UpdateConnector = UpdateConnector'
  { -- | With AS2, you can send files by calling @StartFileTransfer@ and
    -- specifying the file paths in the request parameter, @SendFilePaths@. We
    -- use the file’s parent directory (for example, for
    -- @--send-file-paths \/bucket\/dir\/file.txt@, parent directory is
    -- @\/bucket\/dir\/@) to temporarily store a processed AS2 message file,
    -- store the MDN when we receive them from the partner, and write a final
    -- JSON file containing relevant metadata of the transmission. So, the
    -- @AccessRole@ needs to provide read and write access to the parent
    -- directory of the file location used in the @StartFileTransfer@ request.
    -- Additionally, you need to provide read and write access to the parent
    -- directory of the files that you intend to send with @StartFileTransfer@.
    UpdateConnector -> Maybe Text
accessRole :: Prelude.Maybe Prelude.Text,
    -- | A structure that contains the parameters for a connector object.
    UpdateConnector -> Maybe As2ConnectorConfig
as2Config :: Prelude.Maybe As2ConnectorConfig,
    -- | The Amazon Resource Name (ARN) of the Identity and Access Management
    -- (IAM) role that allows a connector to turn on CloudWatch logging for
    -- Amazon S3 events. When set, you can view connector activity in your
    -- CloudWatch logs.
    UpdateConnector -> Maybe Text
loggingRole :: Prelude.Maybe Prelude.Text,
    -- | The URL of the partner\'s AS2 endpoint.
    UpdateConnector -> Maybe Text
url :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier for the connector.
    UpdateConnector -> Text
connectorId :: Prelude.Text
  }
  deriving (UpdateConnector -> UpdateConnector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateConnector -> UpdateConnector -> Bool
$c/= :: UpdateConnector -> UpdateConnector -> Bool
== :: UpdateConnector -> UpdateConnector -> Bool
$c== :: UpdateConnector -> UpdateConnector -> Bool
Prelude.Eq, ReadPrec [UpdateConnector]
ReadPrec UpdateConnector
Int -> ReadS UpdateConnector
ReadS [UpdateConnector]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateConnector]
$creadListPrec :: ReadPrec [UpdateConnector]
readPrec :: ReadPrec UpdateConnector
$creadPrec :: ReadPrec UpdateConnector
readList :: ReadS [UpdateConnector]
$creadList :: ReadS [UpdateConnector]
readsPrec :: Int -> ReadS UpdateConnector
$creadsPrec :: Int -> ReadS UpdateConnector
Prelude.Read, Int -> UpdateConnector -> ShowS
[UpdateConnector] -> ShowS
UpdateConnector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateConnector] -> ShowS
$cshowList :: [UpdateConnector] -> ShowS
show :: UpdateConnector -> String
$cshow :: UpdateConnector -> String
showsPrec :: Int -> UpdateConnector -> ShowS
$cshowsPrec :: Int -> UpdateConnector -> ShowS
Prelude.Show, forall x. Rep UpdateConnector x -> UpdateConnector
forall x. UpdateConnector -> Rep UpdateConnector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateConnector x -> UpdateConnector
$cfrom :: forall x. UpdateConnector -> Rep UpdateConnector x
Prelude.Generic)

-- |
-- Create a value of 'UpdateConnector' 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:
--
-- 'accessRole', 'updateConnector_accessRole' - With AS2, you can send files by calling @StartFileTransfer@ and
-- specifying the file paths in the request parameter, @SendFilePaths@. We
-- use the file’s parent directory (for example, for
-- @--send-file-paths \/bucket\/dir\/file.txt@, parent directory is
-- @\/bucket\/dir\/@) to temporarily store a processed AS2 message file,
-- store the MDN when we receive them from the partner, and write a final
-- JSON file containing relevant metadata of the transmission. So, the
-- @AccessRole@ needs to provide read and write access to the parent
-- directory of the file location used in the @StartFileTransfer@ request.
-- Additionally, you need to provide read and write access to the parent
-- directory of the files that you intend to send with @StartFileTransfer@.
--
-- 'as2Config', 'updateConnector_as2Config' - A structure that contains the parameters for a connector object.
--
-- 'loggingRole', 'updateConnector_loggingRole' - The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role that allows a connector to turn on CloudWatch logging for
-- Amazon S3 events. When set, you can view connector activity in your
-- CloudWatch logs.
--
-- 'url', 'updateConnector_url' - The URL of the partner\'s AS2 endpoint.
--
-- 'connectorId', 'updateConnector_connectorId' - The unique identifier for the connector.
newUpdateConnector ::
  -- | 'connectorId'
  Prelude.Text ->
  UpdateConnector
newUpdateConnector :: Text -> UpdateConnector
newUpdateConnector Text
pConnectorId_ =
  UpdateConnector'
    { $sel:accessRole:UpdateConnector' :: Maybe Text
accessRole = forall a. Maybe a
Prelude.Nothing,
      $sel:as2Config:UpdateConnector' :: Maybe As2ConnectorConfig
as2Config = forall a. Maybe a
Prelude.Nothing,
      $sel:loggingRole:UpdateConnector' :: Maybe Text
loggingRole = forall a. Maybe a
Prelude.Nothing,
      $sel:url:UpdateConnector' :: Maybe Text
url = forall a. Maybe a
Prelude.Nothing,
      $sel:connectorId:UpdateConnector' :: Text
connectorId = Text
pConnectorId_
    }

-- | With AS2, you can send files by calling @StartFileTransfer@ and
-- specifying the file paths in the request parameter, @SendFilePaths@. We
-- use the file’s parent directory (for example, for
-- @--send-file-paths \/bucket\/dir\/file.txt@, parent directory is
-- @\/bucket\/dir\/@) to temporarily store a processed AS2 message file,
-- store the MDN when we receive them from the partner, and write a final
-- JSON file containing relevant metadata of the transmission. So, the
-- @AccessRole@ needs to provide read and write access to the parent
-- directory of the file location used in the @StartFileTransfer@ request.
-- Additionally, you need to provide read and write access to the parent
-- directory of the files that you intend to send with @StartFileTransfer@.
updateConnector_accessRole :: Lens.Lens' UpdateConnector (Prelude.Maybe Prelude.Text)
updateConnector_accessRole :: Lens' UpdateConnector (Maybe Text)
updateConnector_accessRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnector' {Maybe Text
accessRole :: Maybe Text
$sel:accessRole:UpdateConnector' :: UpdateConnector -> Maybe Text
accessRole} -> Maybe Text
accessRole) (\s :: UpdateConnector
s@UpdateConnector' {} Maybe Text
a -> UpdateConnector
s {$sel:accessRole:UpdateConnector' :: Maybe Text
accessRole = Maybe Text
a} :: UpdateConnector)

-- | A structure that contains the parameters for a connector object.
updateConnector_as2Config :: Lens.Lens' UpdateConnector (Prelude.Maybe As2ConnectorConfig)
updateConnector_as2Config :: Lens' UpdateConnector (Maybe As2ConnectorConfig)
updateConnector_as2Config = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnector' {Maybe As2ConnectorConfig
as2Config :: Maybe As2ConnectorConfig
$sel:as2Config:UpdateConnector' :: UpdateConnector -> Maybe As2ConnectorConfig
as2Config} -> Maybe As2ConnectorConfig
as2Config) (\s :: UpdateConnector
s@UpdateConnector' {} Maybe As2ConnectorConfig
a -> UpdateConnector
s {$sel:as2Config:UpdateConnector' :: Maybe As2ConnectorConfig
as2Config = Maybe As2ConnectorConfig
a} :: UpdateConnector)

-- | The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role that allows a connector to turn on CloudWatch logging for
-- Amazon S3 events. When set, you can view connector activity in your
-- CloudWatch logs.
updateConnector_loggingRole :: Lens.Lens' UpdateConnector (Prelude.Maybe Prelude.Text)
updateConnector_loggingRole :: Lens' UpdateConnector (Maybe Text)
updateConnector_loggingRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnector' {Maybe Text
loggingRole :: Maybe Text
$sel:loggingRole:UpdateConnector' :: UpdateConnector -> Maybe Text
loggingRole} -> Maybe Text
loggingRole) (\s :: UpdateConnector
s@UpdateConnector' {} Maybe Text
a -> UpdateConnector
s {$sel:loggingRole:UpdateConnector' :: Maybe Text
loggingRole = Maybe Text
a} :: UpdateConnector)

-- | The URL of the partner\'s AS2 endpoint.
updateConnector_url :: Lens.Lens' UpdateConnector (Prelude.Maybe Prelude.Text)
updateConnector_url :: Lens' UpdateConnector (Maybe Text)
updateConnector_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnector' {Maybe Text
url :: Maybe Text
$sel:url:UpdateConnector' :: UpdateConnector -> Maybe Text
url} -> Maybe Text
url) (\s :: UpdateConnector
s@UpdateConnector' {} Maybe Text
a -> UpdateConnector
s {$sel:url:UpdateConnector' :: Maybe Text
url = Maybe Text
a} :: UpdateConnector)

-- | The unique identifier for the connector.
updateConnector_connectorId :: Lens.Lens' UpdateConnector Prelude.Text
updateConnector_connectorId :: Lens' UpdateConnector Text
updateConnector_connectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnector' {Text
connectorId :: Text
$sel:connectorId:UpdateConnector' :: UpdateConnector -> Text
connectorId} -> Text
connectorId) (\s :: UpdateConnector
s@UpdateConnector' {} Text
a -> UpdateConnector
s {$sel:connectorId:UpdateConnector' :: Text
connectorId = Text
a} :: UpdateConnector)

instance Core.AWSRequest UpdateConnector where
  type
    AWSResponse UpdateConnector =
      UpdateConnectorResponse
  request :: (Service -> Service) -> UpdateConnector -> Request UpdateConnector
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 UpdateConnector
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateConnector)))
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 ->
          Int -> Text -> UpdateConnectorResponse
UpdateConnectorResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ConnectorId")
      )

instance Prelude.Hashable UpdateConnector where
  hashWithSalt :: Int -> UpdateConnector -> Int
hashWithSalt Int
_salt UpdateConnector' {Maybe Text
Maybe As2ConnectorConfig
Text
connectorId :: Text
url :: Maybe Text
loggingRole :: Maybe Text
as2Config :: Maybe As2ConnectorConfig
accessRole :: Maybe Text
$sel:connectorId:UpdateConnector' :: UpdateConnector -> Text
$sel:url:UpdateConnector' :: UpdateConnector -> Maybe Text
$sel:loggingRole:UpdateConnector' :: UpdateConnector -> Maybe Text
$sel:as2Config:UpdateConnector' :: UpdateConnector -> Maybe As2ConnectorConfig
$sel:accessRole:UpdateConnector' :: UpdateConnector -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accessRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe As2ConnectorConfig
as2Config
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
loggingRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
url
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectorId

instance Prelude.NFData UpdateConnector where
  rnf :: UpdateConnector -> ()
rnf UpdateConnector' {Maybe Text
Maybe As2ConnectorConfig
Text
connectorId :: Text
url :: Maybe Text
loggingRole :: Maybe Text
as2Config :: Maybe As2ConnectorConfig
accessRole :: Maybe Text
$sel:connectorId:UpdateConnector' :: UpdateConnector -> Text
$sel:url:UpdateConnector' :: UpdateConnector -> Maybe Text
$sel:loggingRole:UpdateConnector' :: UpdateConnector -> Maybe Text
$sel:as2Config:UpdateConnector' :: UpdateConnector -> Maybe As2ConnectorConfig
$sel:accessRole:UpdateConnector' :: UpdateConnector -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accessRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe As2ConnectorConfig
as2Config
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
loggingRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
url
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectorId

instance Data.ToHeaders UpdateConnector where
  toHeaders :: UpdateConnector -> 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
"TransferService.UpdateConnector" ::
                          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 UpdateConnector where
  toJSON :: UpdateConnector -> Value
toJSON UpdateConnector' {Maybe Text
Maybe As2ConnectorConfig
Text
connectorId :: Text
url :: Maybe Text
loggingRole :: Maybe Text
as2Config :: Maybe As2ConnectorConfig
accessRole :: Maybe Text
$sel:connectorId:UpdateConnector' :: UpdateConnector -> Text
$sel:url:UpdateConnector' :: UpdateConnector -> Maybe Text
$sel:loggingRole:UpdateConnector' :: UpdateConnector -> Maybe Text
$sel:as2Config:UpdateConnector' :: UpdateConnector -> Maybe As2ConnectorConfig
$sel:accessRole:UpdateConnector' :: UpdateConnector -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessRole" 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
accessRole,
            (Key
"As2Config" 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 As2ConnectorConfig
as2Config,
            (Key
"LoggingRole" 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
loggingRole,
            (Key
"Url" 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
url,
            forall a. a -> Maybe a
Prelude.Just (Key
"ConnectorId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectorId)
          ]
      )

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

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

-- | /See:/ 'newUpdateConnectorResponse' smart constructor.
data UpdateConnectorResponse = UpdateConnectorResponse'
  { -- | The response's http status code.
    UpdateConnectorResponse -> Int
httpStatus :: Prelude.Int,
    -- | Returns the identifier of the connector object that you are updating.
    UpdateConnectorResponse -> Text
connectorId :: Prelude.Text
  }
  deriving (UpdateConnectorResponse -> UpdateConnectorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateConnectorResponse -> UpdateConnectorResponse -> Bool
$c/= :: UpdateConnectorResponse -> UpdateConnectorResponse -> Bool
== :: UpdateConnectorResponse -> UpdateConnectorResponse -> Bool
$c== :: UpdateConnectorResponse -> UpdateConnectorResponse -> Bool
Prelude.Eq, ReadPrec [UpdateConnectorResponse]
ReadPrec UpdateConnectorResponse
Int -> ReadS UpdateConnectorResponse
ReadS [UpdateConnectorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateConnectorResponse]
$creadListPrec :: ReadPrec [UpdateConnectorResponse]
readPrec :: ReadPrec UpdateConnectorResponse
$creadPrec :: ReadPrec UpdateConnectorResponse
readList :: ReadS [UpdateConnectorResponse]
$creadList :: ReadS [UpdateConnectorResponse]
readsPrec :: Int -> ReadS UpdateConnectorResponse
$creadsPrec :: Int -> ReadS UpdateConnectorResponse
Prelude.Read, Int -> UpdateConnectorResponse -> ShowS
[UpdateConnectorResponse] -> ShowS
UpdateConnectorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateConnectorResponse] -> ShowS
$cshowList :: [UpdateConnectorResponse] -> ShowS
show :: UpdateConnectorResponse -> String
$cshow :: UpdateConnectorResponse -> String
showsPrec :: Int -> UpdateConnectorResponse -> ShowS
$cshowsPrec :: Int -> UpdateConnectorResponse -> ShowS
Prelude.Show, forall x. Rep UpdateConnectorResponse x -> UpdateConnectorResponse
forall x. UpdateConnectorResponse -> Rep UpdateConnectorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateConnectorResponse x -> UpdateConnectorResponse
$cfrom :: forall x. UpdateConnectorResponse -> Rep UpdateConnectorResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateConnectorResponse' 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:
--
-- 'httpStatus', 'updateConnectorResponse_httpStatus' - The response's http status code.
--
-- 'connectorId', 'updateConnectorResponse_connectorId' - Returns the identifier of the connector object that you are updating.
newUpdateConnectorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'connectorId'
  Prelude.Text ->
  UpdateConnectorResponse
newUpdateConnectorResponse :: Int -> Text -> UpdateConnectorResponse
newUpdateConnectorResponse Int
pHttpStatus_ Text
pConnectorId_ =
  UpdateConnectorResponse'
    { $sel:httpStatus:UpdateConnectorResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:connectorId:UpdateConnectorResponse' :: Text
connectorId = Text
pConnectorId_
    }

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

-- | Returns the identifier of the connector object that you are updating.
updateConnectorResponse_connectorId :: Lens.Lens' UpdateConnectorResponse Prelude.Text
updateConnectorResponse_connectorId :: Lens' UpdateConnectorResponse Text
updateConnectorResponse_connectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnectorResponse' {Text
connectorId :: Text
$sel:connectorId:UpdateConnectorResponse' :: UpdateConnectorResponse -> Text
connectorId} -> Text
connectorId) (\s :: UpdateConnectorResponse
s@UpdateConnectorResponse' {} Text
a -> UpdateConnectorResponse
s {$sel:connectorId:UpdateConnectorResponse' :: Text
connectorId = Text
a} :: UpdateConnectorResponse)

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