{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.SourceFlowConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.AppFlow.Types.SourceFlowConfig where

import Amazonka.AppFlow.Types.ConnectorType
import Amazonka.AppFlow.Types.IncrementalPullConfig
import Amazonka.AppFlow.Types.SourceConnectorProperties
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

-- | Contains information about the configuration of the source connector
-- used in the flow.
--
-- /See:/ 'newSourceFlowConfig' smart constructor.
data SourceFlowConfig = SourceFlowConfig'
  { -- | The API version of the connector when it\'s used as a source in the
    -- flow.
    SourceFlowConfig -> Maybe Text
apiVersion :: Prelude.Maybe Prelude.Text,
    -- | The name of the connector profile. This name must be unique for each
    -- connector profile in the Amazon Web Services account.
    SourceFlowConfig -> Maybe Text
connectorProfileName :: Prelude.Maybe Prelude.Text,
    -- | Defines the configuration for a scheduled incremental data pull. If a
    -- valid configuration is provided, the fields specified in the
    -- configuration are used when querying for the incremental data pull.
    SourceFlowConfig -> Maybe IncrementalPullConfig
incrementalPullConfig :: Prelude.Maybe IncrementalPullConfig,
    -- | The type of connector, such as Salesforce, Amplitude, and so on.
    SourceFlowConfig -> ConnectorType
connectorType :: ConnectorType,
    -- | Specifies the information that is required to query a particular source
    -- connector.
    SourceFlowConfig -> SourceConnectorProperties
sourceConnectorProperties :: SourceConnectorProperties
  }
  deriving (SourceFlowConfig -> SourceFlowConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceFlowConfig -> SourceFlowConfig -> Bool
$c/= :: SourceFlowConfig -> SourceFlowConfig -> Bool
== :: SourceFlowConfig -> SourceFlowConfig -> Bool
$c== :: SourceFlowConfig -> SourceFlowConfig -> Bool
Prelude.Eq, ReadPrec [SourceFlowConfig]
ReadPrec SourceFlowConfig
Int -> ReadS SourceFlowConfig
ReadS [SourceFlowConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceFlowConfig]
$creadListPrec :: ReadPrec [SourceFlowConfig]
readPrec :: ReadPrec SourceFlowConfig
$creadPrec :: ReadPrec SourceFlowConfig
readList :: ReadS [SourceFlowConfig]
$creadList :: ReadS [SourceFlowConfig]
readsPrec :: Int -> ReadS SourceFlowConfig
$creadsPrec :: Int -> ReadS SourceFlowConfig
Prelude.Read, Int -> SourceFlowConfig -> ShowS
[SourceFlowConfig] -> ShowS
SourceFlowConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceFlowConfig] -> ShowS
$cshowList :: [SourceFlowConfig] -> ShowS
show :: SourceFlowConfig -> String
$cshow :: SourceFlowConfig -> String
showsPrec :: Int -> SourceFlowConfig -> ShowS
$cshowsPrec :: Int -> SourceFlowConfig -> ShowS
Prelude.Show, forall x. Rep SourceFlowConfig x -> SourceFlowConfig
forall x. SourceFlowConfig -> Rep SourceFlowConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceFlowConfig x -> SourceFlowConfig
$cfrom :: forall x. SourceFlowConfig -> Rep SourceFlowConfig x
Prelude.Generic)

-- |
-- Create a value of 'SourceFlowConfig' 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:
--
-- 'apiVersion', 'sourceFlowConfig_apiVersion' - The API version of the connector when it\'s used as a source in the
-- flow.
--
-- 'connectorProfileName', 'sourceFlowConfig_connectorProfileName' - The name of the connector profile. This name must be unique for each
-- connector profile in the Amazon Web Services account.
--
-- 'incrementalPullConfig', 'sourceFlowConfig_incrementalPullConfig' - Defines the configuration for a scheduled incremental data pull. If a
-- valid configuration is provided, the fields specified in the
-- configuration are used when querying for the incremental data pull.
--
-- 'connectorType', 'sourceFlowConfig_connectorType' - The type of connector, such as Salesforce, Amplitude, and so on.
--
-- 'sourceConnectorProperties', 'sourceFlowConfig_sourceConnectorProperties' - Specifies the information that is required to query a particular source
-- connector.
newSourceFlowConfig ::
  -- | 'connectorType'
  ConnectorType ->
  -- | 'sourceConnectorProperties'
  SourceConnectorProperties ->
  SourceFlowConfig
newSourceFlowConfig :: ConnectorType -> SourceConnectorProperties -> SourceFlowConfig
newSourceFlowConfig
  ConnectorType
pConnectorType_
  SourceConnectorProperties
pSourceConnectorProperties_ =
    SourceFlowConfig'
      { $sel:apiVersion:SourceFlowConfig' :: Maybe Text
apiVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:connectorProfileName:SourceFlowConfig' :: Maybe Text
connectorProfileName = forall a. Maybe a
Prelude.Nothing,
        $sel:incrementalPullConfig:SourceFlowConfig' :: Maybe IncrementalPullConfig
incrementalPullConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:connectorType:SourceFlowConfig' :: ConnectorType
connectorType = ConnectorType
pConnectorType_,
        $sel:sourceConnectorProperties:SourceFlowConfig' :: SourceConnectorProperties
sourceConnectorProperties =
          SourceConnectorProperties
pSourceConnectorProperties_
      }

-- | The API version of the connector when it\'s used as a source in the
-- flow.
sourceFlowConfig_apiVersion :: Lens.Lens' SourceFlowConfig (Prelude.Maybe Prelude.Text)
sourceFlowConfig_apiVersion :: Lens' SourceFlowConfig (Maybe Text)
sourceFlowConfig_apiVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SourceFlowConfig' {Maybe Text
apiVersion :: Maybe Text
$sel:apiVersion:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
apiVersion} -> Maybe Text
apiVersion) (\s :: SourceFlowConfig
s@SourceFlowConfig' {} Maybe Text
a -> SourceFlowConfig
s {$sel:apiVersion:SourceFlowConfig' :: Maybe Text
apiVersion = Maybe Text
a} :: SourceFlowConfig)

-- | The name of the connector profile. This name must be unique for each
-- connector profile in the Amazon Web Services account.
sourceFlowConfig_connectorProfileName :: Lens.Lens' SourceFlowConfig (Prelude.Maybe Prelude.Text)
sourceFlowConfig_connectorProfileName :: Lens' SourceFlowConfig (Maybe Text)
sourceFlowConfig_connectorProfileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SourceFlowConfig' {Maybe Text
connectorProfileName :: Maybe Text
$sel:connectorProfileName:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
connectorProfileName} -> Maybe Text
connectorProfileName) (\s :: SourceFlowConfig
s@SourceFlowConfig' {} Maybe Text
a -> SourceFlowConfig
s {$sel:connectorProfileName:SourceFlowConfig' :: Maybe Text
connectorProfileName = Maybe Text
a} :: SourceFlowConfig)

-- | Defines the configuration for a scheduled incremental data pull. If a
-- valid configuration is provided, the fields specified in the
-- configuration are used when querying for the incremental data pull.
sourceFlowConfig_incrementalPullConfig :: Lens.Lens' SourceFlowConfig (Prelude.Maybe IncrementalPullConfig)
sourceFlowConfig_incrementalPullConfig :: Lens' SourceFlowConfig (Maybe IncrementalPullConfig)
sourceFlowConfig_incrementalPullConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SourceFlowConfig' {Maybe IncrementalPullConfig
incrementalPullConfig :: Maybe IncrementalPullConfig
$sel:incrementalPullConfig:SourceFlowConfig' :: SourceFlowConfig -> Maybe IncrementalPullConfig
incrementalPullConfig} -> Maybe IncrementalPullConfig
incrementalPullConfig) (\s :: SourceFlowConfig
s@SourceFlowConfig' {} Maybe IncrementalPullConfig
a -> SourceFlowConfig
s {$sel:incrementalPullConfig:SourceFlowConfig' :: Maybe IncrementalPullConfig
incrementalPullConfig = Maybe IncrementalPullConfig
a} :: SourceFlowConfig)

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

-- | Specifies the information that is required to query a particular source
-- connector.
sourceFlowConfig_sourceConnectorProperties :: Lens.Lens' SourceFlowConfig SourceConnectorProperties
sourceFlowConfig_sourceConnectorProperties :: Lens' SourceFlowConfig SourceConnectorProperties
sourceFlowConfig_sourceConnectorProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SourceFlowConfig' {SourceConnectorProperties
sourceConnectorProperties :: SourceConnectorProperties
$sel:sourceConnectorProperties:SourceFlowConfig' :: SourceFlowConfig -> SourceConnectorProperties
sourceConnectorProperties} -> SourceConnectorProperties
sourceConnectorProperties) (\s :: SourceFlowConfig
s@SourceFlowConfig' {} SourceConnectorProperties
a -> SourceFlowConfig
s {$sel:sourceConnectorProperties:SourceFlowConfig' :: SourceConnectorProperties
sourceConnectorProperties = SourceConnectorProperties
a} :: SourceFlowConfig)

instance Data.FromJSON SourceFlowConfig where
  parseJSON :: Value -> Parser SourceFlowConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SourceFlowConfig"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe IncrementalPullConfig
-> ConnectorType
-> SourceConnectorProperties
-> SourceFlowConfig
SourceFlowConfig'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"apiVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"connectorProfileName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"incrementalPullConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"connectorType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"sourceConnectorProperties")
      )

instance Prelude.Hashable SourceFlowConfig where
  hashWithSalt :: Int -> SourceFlowConfig -> Int
hashWithSalt Int
_salt SourceFlowConfig' {Maybe Text
Maybe IncrementalPullConfig
ConnectorType
SourceConnectorProperties
sourceConnectorProperties :: SourceConnectorProperties
connectorType :: ConnectorType
incrementalPullConfig :: Maybe IncrementalPullConfig
connectorProfileName :: Maybe Text
apiVersion :: Maybe Text
$sel:sourceConnectorProperties:SourceFlowConfig' :: SourceFlowConfig -> SourceConnectorProperties
$sel:connectorType:SourceFlowConfig' :: SourceFlowConfig -> ConnectorType
$sel:incrementalPullConfig:SourceFlowConfig' :: SourceFlowConfig -> Maybe IncrementalPullConfig
$sel:connectorProfileName:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
$sel:apiVersion:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
apiVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectorProfileName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IncrementalPullConfig
incrementalPullConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConnectorType
connectorType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SourceConnectorProperties
sourceConnectorProperties

instance Prelude.NFData SourceFlowConfig where
  rnf :: SourceFlowConfig -> ()
rnf SourceFlowConfig' {Maybe Text
Maybe IncrementalPullConfig
ConnectorType
SourceConnectorProperties
sourceConnectorProperties :: SourceConnectorProperties
connectorType :: ConnectorType
incrementalPullConfig :: Maybe IncrementalPullConfig
connectorProfileName :: Maybe Text
apiVersion :: Maybe Text
$sel:sourceConnectorProperties:SourceFlowConfig' :: SourceFlowConfig -> SourceConnectorProperties
$sel:connectorType:SourceFlowConfig' :: SourceFlowConfig -> ConnectorType
$sel:incrementalPullConfig:SourceFlowConfig' :: SourceFlowConfig -> Maybe IncrementalPullConfig
$sel:connectorProfileName:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
$sel:apiVersion:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
apiVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectorProfileName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IncrementalPullConfig
incrementalPullConfig
      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 SourceConnectorProperties
sourceConnectorProperties

instance Data.ToJSON SourceFlowConfig where
  toJSON :: SourceFlowConfig -> Value
toJSON SourceFlowConfig' {Maybe Text
Maybe IncrementalPullConfig
ConnectorType
SourceConnectorProperties
sourceConnectorProperties :: SourceConnectorProperties
connectorType :: ConnectorType
incrementalPullConfig :: Maybe IncrementalPullConfig
connectorProfileName :: Maybe Text
apiVersion :: Maybe Text
$sel:sourceConnectorProperties:SourceFlowConfig' :: SourceFlowConfig -> SourceConnectorProperties
$sel:connectorType:SourceFlowConfig' :: SourceFlowConfig -> ConnectorType
$sel:incrementalPullConfig:SourceFlowConfig' :: SourceFlowConfig -> Maybe IncrementalPullConfig
$sel:connectorProfileName:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
$sel:apiVersion:SourceFlowConfig' :: SourceFlowConfig -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"apiVersion" 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
apiVersion,
            (Key
"connectorProfileName" 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
connectorProfileName,
            (Key
"incrementalPullConfig" 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 IncrementalPullConfig
incrementalPullConfig,
            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
"sourceConnectorProperties"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SourceConnectorProperties
sourceConnectorProperties
              )
          ]
      )