{-# 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.AppSync.UpdateDataSource
-- 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 @DataSource@ object.
module Amazonka.AppSync.UpdateDataSource
  ( -- * Creating a Request
    UpdateDataSource (..),
    newUpdateDataSource,

    -- * Request Lenses
    updateDataSource_description,
    updateDataSource_dynamodbConfig,
    updateDataSource_elasticsearchConfig,
    updateDataSource_httpConfig,
    updateDataSource_lambdaConfig,
    updateDataSource_openSearchServiceConfig,
    updateDataSource_relationalDatabaseConfig,
    updateDataSource_serviceRoleArn,
    updateDataSource_apiId,
    updateDataSource_name,
    updateDataSource_type,

    -- * Destructuring the Response
    UpdateDataSourceResponse (..),
    newUpdateDataSourceResponse,

    -- * Response Lenses
    updateDataSourceResponse_dataSource,
    updateDataSourceResponse_httpStatus,
  )
where

import Amazonka.AppSync.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:/ 'newUpdateDataSource' smart constructor.
data UpdateDataSource = UpdateDataSource'
  { -- | The new description for the data source.
    UpdateDataSource -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The new Amazon DynamoDB configuration.
    UpdateDataSource -> Maybe DynamodbDataSourceConfig
dynamodbConfig :: Prelude.Maybe DynamodbDataSourceConfig,
    -- | The new OpenSearch configuration.
    --
    -- As of September 2021, Amazon Elasticsearch service is Amazon OpenSearch
    -- Service. This configuration is deprecated. Instead, use
    -- UpdateDataSourceRequest$openSearchServiceConfig to update an OpenSearch
    -- data source.
    UpdateDataSource -> Maybe ElasticsearchDataSourceConfig
elasticsearchConfig :: Prelude.Maybe ElasticsearchDataSourceConfig,
    -- | The new HTTP endpoint configuration.
    UpdateDataSource -> Maybe HttpDataSourceConfig
httpConfig :: Prelude.Maybe HttpDataSourceConfig,
    -- | The new Lambda configuration.
    UpdateDataSource -> Maybe LambdaDataSourceConfig
lambdaConfig :: Prelude.Maybe LambdaDataSourceConfig,
    -- | The new OpenSearch configuration.
    UpdateDataSource -> Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig :: Prelude.Maybe OpenSearchServiceDataSourceConfig,
    -- | The new relational database configuration.
    UpdateDataSource -> Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig :: Prelude.Maybe RelationalDatabaseDataSourceConfig,
    -- | The new service role Amazon Resource Name (ARN) for the data source.
    UpdateDataSource -> Maybe Text
serviceRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The API ID.
    UpdateDataSource -> Text
apiId :: Prelude.Text,
    -- | The new name for the data source.
    UpdateDataSource -> Text
name :: Prelude.Text,
    -- | The new data source type.
    UpdateDataSource -> DataSourceType
type' :: DataSourceType
  }
  deriving (UpdateDataSource -> UpdateDataSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDataSource -> UpdateDataSource -> Bool
$c/= :: UpdateDataSource -> UpdateDataSource -> Bool
== :: UpdateDataSource -> UpdateDataSource -> Bool
$c== :: UpdateDataSource -> UpdateDataSource -> Bool
Prelude.Eq, ReadPrec [UpdateDataSource]
ReadPrec UpdateDataSource
Int -> ReadS UpdateDataSource
ReadS [UpdateDataSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDataSource]
$creadListPrec :: ReadPrec [UpdateDataSource]
readPrec :: ReadPrec UpdateDataSource
$creadPrec :: ReadPrec UpdateDataSource
readList :: ReadS [UpdateDataSource]
$creadList :: ReadS [UpdateDataSource]
readsPrec :: Int -> ReadS UpdateDataSource
$creadsPrec :: Int -> ReadS UpdateDataSource
Prelude.Read, Int -> UpdateDataSource -> ShowS
[UpdateDataSource] -> ShowS
UpdateDataSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDataSource] -> ShowS
$cshowList :: [UpdateDataSource] -> ShowS
show :: UpdateDataSource -> String
$cshow :: UpdateDataSource -> String
showsPrec :: Int -> UpdateDataSource -> ShowS
$cshowsPrec :: Int -> UpdateDataSource -> ShowS
Prelude.Show, forall x. Rep UpdateDataSource x -> UpdateDataSource
forall x. UpdateDataSource -> Rep UpdateDataSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDataSource x -> UpdateDataSource
$cfrom :: forall x. UpdateDataSource -> Rep UpdateDataSource x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDataSource' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'description', 'updateDataSource_description' - The new description for the data source.
--
-- 'dynamodbConfig', 'updateDataSource_dynamodbConfig' - The new Amazon DynamoDB configuration.
--
-- 'elasticsearchConfig', 'updateDataSource_elasticsearchConfig' - The new OpenSearch configuration.
--
-- As of September 2021, Amazon Elasticsearch service is Amazon OpenSearch
-- Service. This configuration is deprecated. Instead, use
-- UpdateDataSourceRequest$openSearchServiceConfig to update an OpenSearch
-- data source.
--
-- 'httpConfig', 'updateDataSource_httpConfig' - The new HTTP endpoint configuration.
--
-- 'lambdaConfig', 'updateDataSource_lambdaConfig' - The new Lambda configuration.
--
-- 'openSearchServiceConfig', 'updateDataSource_openSearchServiceConfig' - The new OpenSearch configuration.
--
-- 'relationalDatabaseConfig', 'updateDataSource_relationalDatabaseConfig' - The new relational database configuration.
--
-- 'serviceRoleArn', 'updateDataSource_serviceRoleArn' - The new service role Amazon Resource Name (ARN) for the data source.
--
-- 'apiId', 'updateDataSource_apiId' - The API ID.
--
-- 'name', 'updateDataSource_name' - The new name for the data source.
--
-- 'type'', 'updateDataSource_type' - The new data source type.
newUpdateDataSource ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'type''
  DataSourceType ->
  UpdateDataSource
newUpdateDataSource :: Text -> Text -> DataSourceType -> UpdateDataSource
newUpdateDataSource Text
pApiId_ Text
pName_ DataSourceType
pType_ =
  UpdateDataSource'
    { $sel:description:UpdateDataSource' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:dynamodbConfig:UpdateDataSource' :: Maybe DynamodbDataSourceConfig
dynamodbConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:elasticsearchConfig:UpdateDataSource' :: Maybe ElasticsearchDataSourceConfig
elasticsearchConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:httpConfig:UpdateDataSource' :: Maybe HttpDataSourceConfig
httpConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:lambdaConfig:UpdateDataSource' :: Maybe LambdaDataSourceConfig
lambdaConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:openSearchServiceConfig:UpdateDataSource' :: Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:relationalDatabaseConfig:UpdateDataSource' :: Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRoleArn:UpdateDataSource' :: Maybe Text
serviceRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:apiId:UpdateDataSource' :: Text
apiId = Text
pApiId_,
      $sel:name:UpdateDataSource' :: Text
name = Text
pName_,
      $sel:type':UpdateDataSource' :: DataSourceType
type' = DataSourceType
pType_
    }

-- | The new description for the data source.
updateDataSource_description :: Lens.Lens' UpdateDataSource (Prelude.Maybe Prelude.Text)
updateDataSource_description :: Lens' UpdateDataSource (Maybe Text)
updateDataSource_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe Text
description :: Maybe Text
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe Text
a -> UpdateDataSource
s {$sel:description:UpdateDataSource' :: Maybe Text
description = Maybe Text
a} :: UpdateDataSource)

-- | The new Amazon DynamoDB configuration.
updateDataSource_dynamodbConfig :: Lens.Lens' UpdateDataSource (Prelude.Maybe DynamodbDataSourceConfig)
updateDataSource_dynamodbConfig :: Lens' UpdateDataSource (Maybe DynamodbDataSourceConfig)
updateDataSource_dynamodbConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe DynamodbDataSourceConfig
dynamodbConfig :: Maybe DynamodbDataSourceConfig
$sel:dynamodbConfig:UpdateDataSource' :: UpdateDataSource -> Maybe DynamodbDataSourceConfig
dynamodbConfig} -> Maybe DynamodbDataSourceConfig
dynamodbConfig) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe DynamodbDataSourceConfig
a -> UpdateDataSource
s {$sel:dynamodbConfig:UpdateDataSource' :: Maybe DynamodbDataSourceConfig
dynamodbConfig = Maybe DynamodbDataSourceConfig
a} :: UpdateDataSource)

-- | The new OpenSearch configuration.
--
-- As of September 2021, Amazon Elasticsearch service is Amazon OpenSearch
-- Service. This configuration is deprecated. Instead, use
-- UpdateDataSourceRequest$openSearchServiceConfig to update an OpenSearch
-- data source.
updateDataSource_elasticsearchConfig :: Lens.Lens' UpdateDataSource (Prelude.Maybe ElasticsearchDataSourceConfig)
updateDataSource_elasticsearchConfig :: Lens' UpdateDataSource (Maybe ElasticsearchDataSourceConfig)
updateDataSource_elasticsearchConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe ElasticsearchDataSourceConfig
elasticsearchConfig :: Maybe ElasticsearchDataSourceConfig
$sel:elasticsearchConfig:UpdateDataSource' :: UpdateDataSource -> Maybe ElasticsearchDataSourceConfig
elasticsearchConfig} -> Maybe ElasticsearchDataSourceConfig
elasticsearchConfig) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe ElasticsearchDataSourceConfig
a -> UpdateDataSource
s {$sel:elasticsearchConfig:UpdateDataSource' :: Maybe ElasticsearchDataSourceConfig
elasticsearchConfig = Maybe ElasticsearchDataSourceConfig
a} :: UpdateDataSource)

-- | The new HTTP endpoint configuration.
updateDataSource_httpConfig :: Lens.Lens' UpdateDataSource (Prelude.Maybe HttpDataSourceConfig)
updateDataSource_httpConfig :: Lens' UpdateDataSource (Maybe HttpDataSourceConfig)
updateDataSource_httpConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe HttpDataSourceConfig
httpConfig :: Maybe HttpDataSourceConfig
$sel:httpConfig:UpdateDataSource' :: UpdateDataSource -> Maybe HttpDataSourceConfig
httpConfig} -> Maybe HttpDataSourceConfig
httpConfig) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe HttpDataSourceConfig
a -> UpdateDataSource
s {$sel:httpConfig:UpdateDataSource' :: Maybe HttpDataSourceConfig
httpConfig = Maybe HttpDataSourceConfig
a} :: UpdateDataSource)

-- | The new Lambda configuration.
updateDataSource_lambdaConfig :: Lens.Lens' UpdateDataSource (Prelude.Maybe LambdaDataSourceConfig)
updateDataSource_lambdaConfig :: Lens' UpdateDataSource (Maybe LambdaDataSourceConfig)
updateDataSource_lambdaConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe LambdaDataSourceConfig
lambdaConfig :: Maybe LambdaDataSourceConfig
$sel:lambdaConfig:UpdateDataSource' :: UpdateDataSource -> Maybe LambdaDataSourceConfig
lambdaConfig} -> Maybe LambdaDataSourceConfig
lambdaConfig) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe LambdaDataSourceConfig
a -> UpdateDataSource
s {$sel:lambdaConfig:UpdateDataSource' :: Maybe LambdaDataSourceConfig
lambdaConfig = Maybe LambdaDataSourceConfig
a} :: UpdateDataSource)

-- | The new OpenSearch configuration.
updateDataSource_openSearchServiceConfig :: Lens.Lens' UpdateDataSource (Prelude.Maybe OpenSearchServiceDataSourceConfig)
updateDataSource_openSearchServiceConfig :: Lens' UpdateDataSource (Maybe OpenSearchServiceDataSourceConfig)
updateDataSource_openSearchServiceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig :: Maybe OpenSearchServiceDataSourceConfig
$sel:openSearchServiceConfig:UpdateDataSource' :: UpdateDataSource -> Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig} -> Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe OpenSearchServiceDataSourceConfig
a -> UpdateDataSource
s {$sel:openSearchServiceConfig:UpdateDataSource' :: Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig = Maybe OpenSearchServiceDataSourceConfig
a} :: UpdateDataSource)

-- | The new relational database configuration.
updateDataSource_relationalDatabaseConfig :: Lens.Lens' UpdateDataSource (Prelude.Maybe RelationalDatabaseDataSourceConfig)
updateDataSource_relationalDatabaseConfig :: Lens' UpdateDataSource (Maybe RelationalDatabaseDataSourceConfig)
updateDataSource_relationalDatabaseConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig :: Maybe RelationalDatabaseDataSourceConfig
$sel:relationalDatabaseConfig:UpdateDataSource' :: UpdateDataSource -> Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig} -> Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe RelationalDatabaseDataSourceConfig
a -> UpdateDataSource
s {$sel:relationalDatabaseConfig:UpdateDataSource' :: Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig = Maybe RelationalDatabaseDataSourceConfig
a} :: UpdateDataSource)

-- | The new service role Amazon Resource Name (ARN) for the data source.
updateDataSource_serviceRoleArn :: Lens.Lens' UpdateDataSource (Prelude.Maybe Prelude.Text)
updateDataSource_serviceRoleArn :: Lens' UpdateDataSource (Maybe Text)
updateDataSource_serviceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe Text
serviceRoleArn :: Maybe Text
$sel:serviceRoleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
serviceRoleArn} -> Maybe Text
serviceRoleArn) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe Text
a -> UpdateDataSource
s {$sel:serviceRoleArn:UpdateDataSource' :: Maybe Text
serviceRoleArn = Maybe Text
a} :: UpdateDataSource)

-- | The API ID.
updateDataSource_apiId :: Lens.Lens' UpdateDataSource Prelude.Text
updateDataSource_apiId :: Lens' UpdateDataSource Text
updateDataSource_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Text
apiId :: Text
$sel:apiId:UpdateDataSource' :: UpdateDataSource -> Text
apiId} -> Text
apiId) (\s :: UpdateDataSource
s@UpdateDataSource' {} Text
a -> UpdateDataSource
s {$sel:apiId:UpdateDataSource' :: Text
apiId = Text
a} :: UpdateDataSource)

-- | The new name for the data source.
updateDataSource_name :: Lens.Lens' UpdateDataSource Prelude.Text
updateDataSource_name :: Lens' UpdateDataSource Text
updateDataSource_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Text
name :: Text
$sel:name:UpdateDataSource' :: UpdateDataSource -> Text
name} -> Text
name) (\s :: UpdateDataSource
s@UpdateDataSource' {} Text
a -> UpdateDataSource
s {$sel:name:UpdateDataSource' :: Text
name = Text
a} :: UpdateDataSource)

-- | The new data source type.
updateDataSource_type :: Lens.Lens' UpdateDataSource DataSourceType
updateDataSource_type :: Lens' UpdateDataSource DataSourceType
updateDataSource_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {DataSourceType
type' :: DataSourceType
$sel:type':UpdateDataSource' :: UpdateDataSource -> DataSourceType
type'} -> DataSourceType
type') (\s :: UpdateDataSource
s@UpdateDataSource' {} DataSourceType
a -> UpdateDataSource
s {$sel:type':UpdateDataSource' :: DataSourceType
type' = DataSourceType
a} :: UpdateDataSource)

instance Core.AWSRequest UpdateDataSource where
  type
    AWSResponse UpdateDataSource =
      UpdateDataSourceResponse
  request :: (Service -> Service)
-> UpdateDataSource -> Request UpdateDataSource
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 UpdateDataSource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDataSource)))
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 DataSource -> Int -> UpdateDataSourceResponse
UpdateDataSourceResponse'
            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
"dataSource")
            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 UpdateDataSource where
  hashWithSalt :: Int -> UpdateDataSource -> Int
hashWithSalt Int
_salt UpdateDataSource' {Maybe Text
Maybe DynamodbDataSourceConfig
Maybe ElasticsearchDataSourceConfig
Maybe HttpDataSourceConfig
Maybe LambdaDataSourceConfig
Maybe OpenSearchServiceDataSourceConfig
Maybe RelationalDatabaseDataSourceConfig
Text
DataSourceType
type' :: DataSourceType
name :: Text
apiId :: Text
serviceRoleArn :: Maybe Text
relationalDatabaseConfig :: Maybe RelationalDatabaseDataSourceConfig
openSearchServiceConfig :: Maybe OpenSearchServiceDataSourceConfig
lambdaConfig :: Maybe LambdaDataSourceConfig
httpConfig :: Maybe HttpDataSourceConfig
elasticsearchConfig :: Maybe ElasticsearchDataSourceConfig
dynamodbConfig :: Maybe DynamodbDataSourceConfig
description :: Maybe Text
$sel:type':UpdateDataSource' :: UpdateDataSource -> DataSourceType
$sel:name:UpdateDataSource' :: UpdateDataSource -> Text
$sel:apiId:UpdateDataSource' :: UpdateDataSource -> Text
$sel:serviceRoleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:relationalDatabaseConfig:UpdateDataSource' :: UpdateDataSource -> Maybe RelationalDatabaseDataSourceConfig
$sel:openSearchServiceConfig:UpdateDataSource' :: UpdateDataSource -> Maybe OpenSearchServiceDataSourceConfig
$sel:lambdaConfig:UpdateDataSource' :: UpdateDataSource -> Maybe LambdaDataSourceConfig
$sel:httpConfig:UpdateDataSource' :: UpdateDataSource -> Maybe HttpDataSourceConfig
$sel:elasticsearchConfig:UpdateDataSource' :: UpdateDataSource -> Maybe ElasticsearchDataSourceConfig
$sel:dynamodbConfig:UpdateDataSource' :: UpdateDataSource -> Maybe DynamodbDataSourceConfig
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DynamodbDataSourceConfig
dynamodbConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ElasticsearchDataSourceConfig
elasticsearchConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpDataSourceConfig
httpConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LambdaDataSourceConfig
lambdaConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataSourceType
type'

instance Prelude.NFData UpdateDataSource where
  rnf :: UpdateDataSource -> ()
rnf UpdateDataSource' {Maybe Text
Maybe DynamodbDataSourceConfig
Maybe ElasticsearchDataSourceConfig
Maybe HttpDataSourceConfig
Maybe LambdaDataSourceConfig
Maybe OpenSearchServiceDataSourceConfig
Maybe RelationalDatabaseDataSourceConfig
Text
DataSourceType
type' :: DataSourceType
name :: Text
apiId :: Text
serviceRoleArn :: Maybe Text
relationalDatabaseConfig :: Maybe RelationalDatabaseDataSourceConfig
openSearchServiceConfig :: Maybe OpenSearchServiceDataSourceConfig
lambdaConfig :: Maybe LambdaDataSourceConfig
httpConfig :: Maybe HttpDataSourceConfig
elasticsearchConfig :: Maybe ElasticsearchDataSourceConfig
dynamodbConfig :: Maybe DynamodbDataSourceConfig
description :: Maybe Text
$sel:type':UpdateDataSource' :: UpdateDataSource -> DataSourceType
$sel:name:UpdateDataSource' :: UpdateDataSource -> Text
$sel:apiId:UpdateDataSource' :: UpdateDataSource -> Text
$sel:serviceRoleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:relationalDatabaseConfig:UpdateDataSource' :: UpdateDataSource -> Maybe RelationalDatabaseDataSourceConfig
$sel:openSearchServiceConfig:UpdateDataSource' :: UpdateDataSource -> Maybe OpenSearchServiceDataSourceConfig
$sel:lambdaConfig:UpdateDataSource' :: UpdateDataSource -> Maybe LambdaDataSourceConfig
$sel:httpConfig:UpdateDataSource' :: UpdateDataSource -> Maybe HttpDataSourceConfig
$sel:elasticsearchConfig:UpdateDataSource' :: UpdateDataSource -> Maybe ElasticsearchDataSourceConfig
$sel:dynamodbConfig:UpdateDataSource' :: UpdateDataSource -> Maybe DynamodbDataSourceConfig
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DynamodbDataSourceConfig
dynamodbConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ElasticsearchDataSourceConfig
elasticsearchConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpDataSourceConfig
httpConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LambdaDataSourceConfig
lambdaConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OpenSearchServiceDataSourceConfig
openSearchServiceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RelationalDatabaseDataSourceConfig
relationalDatabaseConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
apiId
      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 DataSourceType
type'

instance Data.ToHeaders UpdateDataSource where
  toHeaders :: UpdateDataSource -> 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 UpdateDataSource where
  toJSON :: UpdateDataSource -> Value
toJSON UpdateDataSource' {Maybe Text
Maybe DynamodbDataSourceConfig
Maybe ElasticsearchDataSourceConfig
Maybe HttpDataSourceConfig
Maybe LambdaDataSourceConfig
Maybe OpenSearchServiceDataSourceConfig
Maybe RelationalDatabaseDataSourceConfig
Text
DataSourceType
type' :: DataSourceType
name :: Text
apiId :: Text
serviceRoleArn :: Maybe Text
relationalDatabaseConfig :: Maybe RelationalDatabaseDataSourceConfig
openSearchServiceConfig :: Maybe OpenSearchServiceDataSourceConfig
lambdaConfig :: Maybe LambdaDataSourceConfig
httpConfig :: Maybe HttpDataSourceConfig
elasticsearchConfig :: Maybe ElasticsearchDataSourceConfig
dynamodbConfig :: Maybe DynamodbDataSourceConfig
description :: Maybe Text
$sel:type':UpdateDataSource' :: UpdateDataSource -> DataSourceType
$sel:name:UpdateDataSource' :: UpdateDataSource -> Text
$sel:apiId:UpdateDataSource' :: UpdateDataSource -> Text
$sel:serviceRoleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:relationalDatabaseConfig:UpdateDataSource' :: UpdateDataSource -> Maybe RelationalDatabaseDataSourceConfig
$sel:openSearchServiceConfig:UpdateDataSource' :: UpdateDataSource -> Maybe OpenSearchServiceDataSourceConfig
$sel:lambdaConfig:UpdateDataSource' :: UpdateDataSource -> Maybe LambdaDataSourceConfig
$sel:httpConfig:UpdateDataSource' :: UpdateDataSource -> Maybe HttpDataSourceConfig
$sel:elasticsearchConfig:UpdateDataSource' :: UpdateDataSource -> Maybe ElasticsearchDataSourceConfig
$sel:dynamodbConfig:UpdateDataSource' :: UpdateDataSource -> Maybe DynamodbDataSourceConfig
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"dynamodbConfig" 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 DynamodbDataSourceConfig
dynamodbConfig,
            (Key
"elasticsearchConfig" 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 ElasticsearchDataSourceConfig
elasticsearchConfig,
            (Key
"httpConfig" 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 HttpDataSourceConfig
httpConfig,
            (Key
"lambdaConfig" 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 LambdaDataSourceConfig
lambdaConfig,
            (Key
"openSearchServiceConfig" 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 OpenSearchServiceDataSourceConfig
openSearchServiceConfig,
            (Key
"relationalDatabaseConfig" 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 RelationalDatabaseDataSourceConfig
relationalDatabaseConfig,
            (Key
"serviceRoleArn" 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
serviceRoleArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataSourceType
type')
          ]
      )

instance Data.ToPath UpdateDataSource where
  toPath :: UpdateDataSource -> ByteString
toPath UpdateDataSource' {Maybe Text
Maybe DynamodbDataSourceConfig
Maybe ElasticsearchDataSourceConfig
Maybe HttpDataSourceConfig
Maybe LambdaDataSourceConfig
Maybe OpenSearchServiceDataSourceConfig
Maybe RelationalDatabaseDataSourceConfig
Text
DataSourceType
type' :: DataSourceType
name :: Text
apiId :: Text
serviceRoleArn :: Maybe Text
relationalDatabaseConfig :: Maybe RelationalDatabaseDataSourceConfig
openSearchServiceConfig :: Maybe OpenSearchServiceDataSourceConfig
lambdaConfig :: Maybe LambdaDataSourceConfig
httpConfig :: Maybe HttpDataSourceConfig
elasticsearchConfig :: Maybe ElasticsearchDataSourceConfig
dynamodbConfig :: Maybe DynamodbDataSourceConfig
description :: Maybe Text
$sel:type':UpdateDataSource' :: UpdateDataSource -> DataSourceType
$sel:name:UpdateDataSource' :: UpdateDataSource -> Text
$sel:apiId:UpdateDataSource' :: UpdateDataSource -> Text
$sel:serviceRoleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:relationalDatabaseConfig:UpdateDataSource' :: UpdateDataSource -> Maybe RelationalDatabaseDataSourceConfig
$sel:openSearchServiceConfig:UpdateDataSource' :: UpdateDataSource -> Maybe OpenSearchServiceDataSourceConfig
$sel:lambdaConfig:UpdateDataSource' :: UpdateDataSource -> Maybe LambdaDataSourceConfig
$sel:httpConfig:UpdateDataSource' :: UpdateDataSource -> Maybe HttpDataSourceConfig
$sel:elasticsearchConfig:UpdateDataSource' :: UpdateDataSource -> Maybe ElasticsearchDataSourceConfig
$sel:dynamodbConfig:UpdateDataSource' :: UpdateDataSource -> Maybe DynamodbDataSourceConfig
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/datasources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name
      ]

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

-- | /See:/ 'newUpdateDataSourceResponse' smart constructor.
data UpdateDataSourceResponse = UpdateDataSourceResponse'
  { -- | The updated @DataSource@ object.
    UpdateDataSourceResponse -> Maybe DataSource
dataSource :: Prelude.Maybe DataSource,
    -- | The response's http status code.
    UpdateDataSourceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDataSourceResponse -> UpdateDataSourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDataSourceResponse -> UpdateDataSourceResponse -> Bool
$c/= :: UpdateDataSourceResponse -> UpdateDataSourceResponse -> Bool
== :: UpdateDataSourceResponse -> UpdateDataSourceResponse -> Bool
$c== :: UpdateDataSourceResponse -> UpdateDataSourceResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDataSourceResponse]
ReadPrec UpdateDataSourceResponse
Int -> ReadS UpdateDataSourceResponse
ReadS [UpdateDataSourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDataSourceResponse]
$creadListPrec :: ReadPrec [UpdateDataSourceResponse]
readPrec :: ReadPrec UpdateDataSourceResponse
$creadPrec :: ReadPrec UpdateDataSourceResponse
readList :: ReadS [UpdateDataSourceResponse]
$creadList :: ReadS [UpdateDataSourceResponse]
readsPrec :: Int -> ReadS UpdateDataSourceResponse
$creadsPrec :: Int -> ReadS UpdateDataSourceResponse
Prelude.Read, Int -> UpdateDataSourceResponse -> ShowS
[UpdateDataSourceResponse] -> ShowS
UpdateDataSourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDataSourceResponse] -> ShowS
$cshowList :: [UpdateDataSourceResponse] -> ShowS
show :: UpdateDataSourceResponse -> String
$cshow :: UpdateDataSourceResponse -> String
showsPrec :: Int -> UpdateDataSourceResponse -> ShowS
$cshowsPrec :: Int -> UpdateDataSourceResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateDataSourceResponse x -> UpdateDataSourceResponse
forall x.
UpdateDataSourceResponse -> Rep UpdateDataSourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDataSourceResponse x -> UpdateDataSourceResponse
$cfrom :: forall x.
UpdateDataSourceResponse -> Rep UpdateDataSourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDataSourceResponse' 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:
--
-- 'dataSource', 'updateDataSourceResponse_dataSource' - The updated @DataSource@ object.
--
-- 'httpStatus', 'updateDataSourceResponse_httpStatus' - The response's http status code.
newUpdateDataSourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDataSourceResponse
newUpdateDataSourceResponse :: Int -> UpdateDataSourceResponse
newUpdateDataSourceResponse Int
pHttpStatus_ =
  UpdateDataSourceResponse'
    { $sel:dataSource:UpdateDataSourceResponse' :: Maybe DataSource
dataSource =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDataSourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated @DataSource@ object.
updateDataSourceResponse_dataSource :: Lens.Lens' UpdateDataSourceResponse (Prelude.Maybe DataSource)
updateDataSourceResponse_dataSource :: Lens' UpdateDataSourceResponse (Maybe DataSource)
updateDataSourceResponse_dataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSourceResponse' {Maybe DataSource
dataSource :: Maybe DataSource
$sel:dataSource:UpdateDataSourceResponse' :: UpdateDataSourceResponse -> Maybe DataSource
dataSource} -> Maybe DataSource
dataSource) (\s :: UpdateDataSourceResponse
s@UpdateDataSourceResponse' {} Maybe DataSource
a -> UpdateDataSourceResponse
s {$sel:dataSource:UpdateDataSourceResponse' :: Maybe DataSource
dataSource = Maybe DataSource
a} :: UpdateDataSourceResponse)

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

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