{-# 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.S3OutputFormatConfig
-- 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.S3OutputFormatConfig where

import Amazonka.AppFlow.Types.AggregationConfig
import Amazonka.AppFlow.Types.FileType
import Amazonka.AppFlow.Types.PrefixConfig
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

-- | The configuration that determines how Amazon AppFlow should format the
-- flow output data when Amazon S3 is used as the destination.
--
-- /See:/ 'newS3OutputFormatConfig' smart constructor.
data S3OutputFormatConfig = S3OutputFormatConfig'
  { S3OutputFormatConfig -> Maybe AggregationConfig
aggregationConfig :: Prelude.Maybe AggregationConfig,
    -- | Indicates the file type that Amazon AppFlow places in the Amazon S3
    -- bucket.
    S3OutputFormatConfig -> Maybe FileType
fileType :: Prelude.Maybe FileType,
    -- | Determines the prefix that Amazon AppFlow applies to the folder name in
    -- the Amazon S3 bucket. You can name folders according to the flow
    -- frequency and date.
    S3OutputFormatConfig -> Maybe PrefixConfig
prefixConfig :: Prelude.Maybe PrefixConfig,
    -- | If your file output format is Parquet, use this parameter to set whether
    -- Amazon AppFlow preserves the data types in your source data when it
    -- writes the output to Amazon S3.
    --
    -- -   @true@: Amazon AppFlow preserves the data types when it writes to
    --     Amazon S3. For example, an integer or @1@ in your source data is
    --     still an integer in your output.
    --
    -- -   @false@: Amazon AppFlow converts all of the source data into strings
    --     when it writes to Amazon S3. For example, an integer of @1@ in your
    --     source data becomes the string @\"1\"@ in the output.
    S3OutputFormatConfig -> Maybe Bool
preserveSourceDataTyping :: Prelude.Maybe Prelude.Bool
  }
  deriving (S3OutputFormatConfig -> S3OutputFormatConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3OutputFormatConfig -> S3OutputFormatConfig -> Bool
$c/= :: S3OutputFormatConfig -> S3OutputFormatConfig -> Bool
== :: S3OutputFormatConfig -> S3OutputFormatConfig -> Bool
$c== :: S3OutputFormatConfig -> S3OutputFormatConfig -> Bool
Prelude.Eq, ReadPrec [S3OutputFormatConfig]
ReadPrec S3OutputFormatConfig
Int -> ReadS S3OutputFormatConfig
ReadS [S3OutputFormatConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [S3OutputFormatConfig]
$creadListPrec :: ReadPrec [S3OutputFormatConfig]
readPrec :: ReadPrec S3OutputFormatConfig
$creadPrec :: ReadPrec S3OutputFormatConfig
readList :: ReadS [S3OutputFormatConfig]
$creadList :: ReadS [S3OutputFormatConfig]
readsPrec :: Int -> ReadS S3OutputFormatConfig
$creadsPrec :: Int -> ReadS S3OutputFormatConfig
Prelude.Read, Int -> S3OutputFormatConfig -> ShowS
[S3OutputFormatConfig] -> ShowS
S3OutputFormatConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3OutputFormatConfig] -> ShowS
$cshowList :: [S3OutputFormatConfig] -> ShowS
show :: S3OutputFormatConfig -> String
$cshow :: S3OutputFormatConfig -> String
showsPrec :: Int -> S3OutputFormatConfig -> ShowS
$cshowsPrec :: Int -> S3OutputFormatConfig -> ShowS
Prelude.Show, forall x. Rep S3OutputFormatConfig x -> S3OutputFormatConfig
forall x. S3OutputFormatConfig -> Rep S3OutputFormatConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3OutputFormatConfig x -> S3OutputFormatConfig
$cfrom :: forall x. S3OutputFormatConfig -> Rep S3OutputFormatConfig x
Prelude.Generic)

-- |
-- Create a value of 'S3OutputFormatConfig' 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:
--
-- 'aggregationConfig', 's3OutputFormatConfig_aggregationConfig' - Undocumented member.
--
-- 'fileType', 's3OutputFormatConfig_fileType' - Indicates the file type that Amazon AppFlow places in the Amazon S3
-- bucket.
--
-- 'prefixConfig', 's3OutputFormatConfig_prefixConfig' - Determines the prefix that Amazon AppFlow applies to the folder name in
-- the Amazon S3 bucket. You can name folders according to the flow
-- frequency and date.
--
-- 'preserveSourceDataTyping', 's3OutputFormatConfig_preserveSourceDataTyping' - If your file output format is Parquet, use this parameter to set whether
-- Amazon AppFlow preserves the data types in your source data when it
-- writes the output to Amazon S3.
--
-- -   @true@: Amazon AppFlow preserves the data types when it writes to
--     Amazon S3. For example, an integer or @1@ in your source data is
--     still an integer in your output.
--
-- -   @false@: Amazon AppFlow converts all of the source data into strings
--     when it writes to Amazon S3. For example, an integer of @1@ in your
--     source data becomes the string @\"1\"@ in the output.
newS3OutputFormatConfig ::
  S3OutputFormatConfig
newS3OutputFormatConfig :: S3OutputFormatConfig
newS3OutputFormatConfig =
  S3OutputFormatConfig'
    { $sel:aggregationConfig:S3OutputFormatConfig' :: Maybe AggregationConfig
aggregationConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:fileType:S3OutputFormatConfig' :: Maybe FileType
fileType = forall a. Maybe a
Prelude.Nothing,
      $sel:prefixConfig:S3OutputFormatConfig' :: Maybe PrefixConfig
prefixConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:preserveSourceDataTyping:S3OutputFormatConfig' :: Maybe Bool
preserveSourceDataTyping = forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
s3OutputFormatConfig_aggregationConfig :: Lens.Lens' S3OutputFormatConfig (Prelude.Maybe AggregationConfig)
s3OutputFormatConfig_aggregationConfig :: Lens' S3OutputFormatConfig (Maybe AggregationConfig)
s3OutputFormatConfig_aggregationConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3OutputFormatConfig' {Maybe AggregationConfig
aggregationConfig :: Maybe AggregationConfig
$sel:aggregationConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe AggregationConfig
aggregationConfig} -> Maybe AggregationConfig
aggregationConfig) (\s :: S3OutputFormatConfig
s@S3OutputFormatConfig' {} Maybe AggregationConfig
a -> S3OutputFormatConfig
s {$sel:aggregationConfig:S3OutputFormatConfig' :: Maybe AggregationConfig
aggregationConfig = Maybe AggregationConfig
a} :: S3OutputFormatConfig)

-- | Indicates the file type that Amazon AppFlow places in the Amazon S3
-- bucket.
s3OutputFormatConfig_fileType :: Lens.Lens' S3OutputFormatConfig (Prelude.Maybe FileType)
s3OutputFormatConfig_fileType :: Lens' S3OutputFormatConfig (Maybe FileType)
s3OutputFormatConfig_fileType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3OutputFormatConfig' {Maybe FileType
fileType :: Maybe FileType
$sel:fileType:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe FileType
fileType} -> Maybe FileType
fileType) (\s :: S3OutputFormatConfig
s@S3OutputFormatConfig' {} Maybe FileType
a -> S3OutputFormatConfig
s {$sel:fileType:S3OutputFormatConfig' :: Maybe FileType
fileType = Maybe FileType
a} :: S3OutputFormatConfig)

-- | Determines the prefix that Amazon AppFlow applies to the folder name in
-- the Amazon S3 bucket. You can name folders according to the flow
-- frequency and date.
s3OutputFormatConfig_prefixConfig :: Lens.Lens' S3OutputFormatConfig (Prelude.Maybe PrefixConfig)
s3OutputFormatConfig_prefixConfig :: Lens' S3OutputFormatConfig (Maybe PrefixConfig)
s3OutputFormatConfig_prefixConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3OutputFormatConfig' {Maybe PrefixConfig
prefixConfig :: Maybe PrefixConfig
$sel:prefixConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe PrefixConfig
prefixConfig} -> Maybe PrefixConfig
prefixConfig) (\s :: S3OutputFormatConfig
s@S3OutputFormatConfig' {} Maybe PrefixConfig
a -> S3OutputFormatConfig
s {$sel:prefixConfig:S3OutputFormatConfig' :: Maybe PrefixConfig
prefixConfig = Maybe PrefixConfig
a} :: S3OutputFormatConfig)

-- | If your file output format is Parquet, use this parameter to set whether
-- Amazon AppFlow preserves the data types in your source data when it
-- writes the output to Amazon S3.
--
-- -   @true@: Amazon AppFlow preserves the data types when it writes to
--     Amazon S3. For example, an integer or @1@ in your source data is
--     still an integer in your output.
--
-- -   @false@: Amazon AppFlow converts all of the source data into strings
--     when it writes to Amazon S3. For example, an integer of @1@ in your
--     source data becomes the string @\"1\"@ in the output.
s3OutputFormatConfig_preserveSourceDataTyping :: Lens.Lens' S3OutputFormatConfig (Prelude.Maybe Prelude.Bool)
s3OutputFormatConfig_preserveSourceDataTyping :: Lens' S3OutputFormatConfig (Maybe Bool)
s3OutputFormatConfig_preserveSourceDataTyping = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3OutputFormatConfig' {Maybe Bool
preserveSourceDataTyping :: Maybe Bool
$sel:preserveSourceDataTyping:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe Bool
preserveSourceDataTyping} -> Maybe Bool
preserveSourceDataTyping) (\s :: S3OutputFormatConfig
s@S3OutputFormatConfig' {} Maybe Bool
a -> S3OutputFormatConfig
s {$sel:preserveSourceDataTyping:S3OutputFormatConfig' :: Maybe Bool
preserveSourceDataTyping = Maybe Bool
a} :: S3OutputFormatConfig)

instance Data.FromJSON S3OutputFormatConfig where
  parseJSON :: Value -> Parser S3OutputFormatConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"S3OutputFormatConfig"
      ( \Object
x ->
          Maybe AggregationConfig
-> Maybe FileType
-> Maybe PrefixConfig
-> Maybe Bool
-> S3OutputFormatConfig
S3OutputFormatConfig'
            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
"aggregationConfig")
            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
"fileType")
            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
"prefixConfig")
            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
"preserveSourceDataTyping")
      )

instance Prelude.Hashable S3OutputFormatConfig where
  hashWithSalt :: Int -> S3OutputFormatConfig -> Int
hashWithSalt Int
_salt S3OutputFormatConfig' {Maybe Bool
Maybe AggregationConfig
Maybe FileType
Maybe PrefixConfig
preserveSourceDataTyping :: Maybe Bool
prefixConfig :: Maybe PrefixConfig
fileType :: Maybe FileType
aggregationConfig :: Maybe AggregationConfig
$sel:preserveSourceDataTyping:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe Bool
$sel:prefixConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe PrefixConfig
$sel:fileType:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe FileType
$sel:aggregationConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe AggregationConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AggregationConfig
aggregationConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FileType
fileType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PrefixConfig
prefixConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
preserveSourceDataTyping

instance Prelude.NFData S3OutputFormatConfig where
  rnf :: S3OutputFormatConfig -> ()
rnf S3OutputFormatConfig' {Maybe Bool
Maybe AggregationConfig
Maybe FileType
Maybe PrefixConfig
preserveSourceDataTyping :: Maybe Bool
prefixConfig :: Maybe PrefixConfig
fileType :: Maybe FileType
aggregationConfig :: Maybe AggregationConfig
$sel:preserveSourceDataTyping:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe Bool
$sel:prefixConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe PrefixConfig
$sel:fileType:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe FileType
$sel:aggregationConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe AggregationConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AggregationConfig
aggregationConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FileType
fileType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PrefixConfig
prefixConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
preserveSourceDataTyping

instance Data.ToJSON S3OutputFormatConfig where
  toJSON :: S3OutputFormatConfig -> Value
toJSON S3OutputFormatConfig' {Maybe Bool
Maybe AggregationConfig
Maybe FileType
Maybe PrefixConfig
preserveSourceDataTyping :: Maybe Bool
prefixConfig :: Maybe PrefixConfig
fileType :: Maybe FileType
aggregationConfig :: Maybe AggregationConfig
$sel:preserveSourceDataTyping:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe Bool
$sel:prefixConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe PrefixConfig
$sel:fileType:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe FileType
$sel:aggregationConfig:S3OutputFormatConfig' :: S3OutputFormatConfig -> Maybe AggregationConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"aggregationConfig" 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 AggregationConfig
aggregationConfig,
            (Key
"fileType" 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 FileType
fileType,
            (Key
"prefixConfig" 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 PrefixConfig
prefixConfig,
            (Key
"preserveSourceDataTyping" 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 Bool
preserveSourceDataTyping
          ]
      )