{-# 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.MachineLearning.Types.DataSource
-- 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.MachineLearning.Types.DataSource where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MachineLearning.Types.EntityStatus
import Amazonka.MachineLearning.Types.RDSMetadata
import Amazonka.MachineLearning.Types.RedshiftMetadata
import qualified Amazonka.Prelude as Prelude

-- | Represents the output of the @GetDataSource@ operation.
--
-- The content consists of the detailed metadata and data file information
-- and the current status of the @DataSource@.
--
-- /See:/ 'newDataSource' smart constructor.
data DataSource = DataSource'
  { -- | The parameter is @true@ if statistics need to be generated from the
    -- observation data.
    DataSource -> Maybe Bool
computeStatistics :: Prelude.Maybe Prelude.Bool,
    DataSource -> Maybe Integer
computeTime :: Prelude.Maybe Prelude.Integer,
    -- | The time that the @DataSource@ was created. The time is expressed in
    -- epoch time.
    DataSource -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | The AWS user account from which the @DataSource@ was created. The
    -- account type can be either an AWS root account or an AWS Identity and
    -- Access Management (IAM) user account.
    DataSource -> Maybe Text
createdByIamUser :: Prelude.Maybe Prelude.Text,
    -- | The location and name of the data in Amazon Simple Storage Service
    -- (Amazon S3) that is used by a @DataSource@.
    DataSource -> Maybe Text
dataLocationS3 :: Prelude.Maybe Prelude.Text,
    -- | A JSON string that represents the splitting and rearrangement
    -- requirement used when this @DataSource@ was created.
    DataSource -> Maybe Text
dataRearrangement :: Prelude.Maybe Prelude.Text,
    -- | The total number of observations contained in the data files that the
    -- @DataSource@ references.
    DataSource -> Maybe Integer
dataSizeInBytes :: Prelude.Maybe Prelude.Integer,
    -- | The ID that is assigned to the @DataSource@ during creation.
    DataSource -> Maybe Text
dataSourceId :: Prelude.Maybe Prelude.Text,
    DataSource -> Maybe POSIX
finishedAt :: Prelude.Maybe Data.POSIX,
    -- | The time of the most recent edit to the @BatchPrediction@. The time is
    -- expressed in epoch time.
    DataSource -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | A description of the most recent details about creating the
    -- @DataSource@.
    DataSource -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied name or description of the @DataSource@.
    DataSource -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The number of data files referenced by the @DataSource@.
    DataSource -> Maybe Integer
numberOfFiles :: Prelude.Maybe Prelude.Integer,
    DataSource -> Maybe RDSMetadata
rDSMetadata :: Prelude.Maybe RDSMetadata,
    DataSource -> Maybe RedshiftMetadata
redshiftMetadata :: Prelude.Maybe RedshiftMetadata,
    DataSource -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text,
    DataSource -> Maybe POSIX
startedAt :: Prelude.Maybe Data.POSIX,
    -- | The current status of the @DataSource@. This element can have one of the
    -- following values:
    --
    -- -   PENDING - Amazon Machine Learning (Amazon ML) submitted a request to
    --     create a @DataSource@.
    --
    -- -   INPROGRESS - The creation process is underway.
    --
    -- -   FAILED - The request to create a @DataSource@ did not run to
    --     completion. It is not usable.
    --
    -- -   COMPLETED - The creation process completed successfully.
    --
    -- -   DELETED - The @DataSource@ is marked as deleted. It is not usable.
    DataSource -> Maybe EntityStatus
status :: Prelude.Maybe EntityStatus
  }
  deriving (DataSource -> DataSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataSource -> DataSource -> Bool
$c/= :: DataSource -> DataSource -> Bool
== :: DataSource -> DataSource -> Bool
$c== :: DataSource -> DataSource -> Bool
Prelude.Eq, ReadPrec [DataSource]
ReadPrec DataSource
Int -> ReadS DataSource
ReadS [DataSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataSource]
$creadListPrec :: ReadPrec [DataSource]
readPrec :: ReadPrec DataSource
$creadPrec :: ReadPrec DataSource
readList :: ReadS [DataSource]
$creadList :: ReadS [DataSource]
readsPrec :: Int -> ReadS DataSource
$creadsPrec :: Int -> ReadS DataSource
Prelude.Read, Int -> DataSource -> ShowS
[DataSource] -> ShowS
DataSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataSource] -> ShowS
$cshowList :: [DataSource] -> ShowS
show :: DataSource -> String
$cshow :: DataSource -> String
showsPrec :: Int -> DataSource -> ShowS
$cshowsPrec :: Int -> DataSource -> ShowS
Prelude.Show, forall x. Rep DataSource x -> DataSource
forall x. DataSource -> Rep DataSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataSource x -> DataSource
$cfrom :: forall x. DataSource -> Rep DataSource x
Prelude.Generic)

-- |
-- Create a value of 'DataSource' 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:
--
-- 'computeStatistics', 'dataSource_computeStatistics' - The parameter is @true@ if statistics need to be generated from the
-- observation data.
--
-- 'computeTime', 'dataSource_computeTime' - Undocumented member.
--
-- 'createdAt', 'dataSource_createdAt' - The time that the @DataSource@ was created. The time is expressed in
-- epoch time.
--
-- 'createdByIamUser', 'dataSource_createdByIamUser' - The AWS user account from which the @DataSource@ was created. The
-- account type can be either an AWS root account or an AWS Identity and
-- Access Management (IAM) user account.
--
-- 'dataLocationS3', 'dataSource_dataLocationS3' - The location and name of the data in Amazon Simple Storage Service
-- (Amazon S3) that is used by a @DataSource@.
--
-- 'dataRearrangement', 'dataSource_dataRearrangement' - A JSON string that represents the splitting and rearrangement
-- requirement used when this @DataSource@ was created.
--
-- 'dataSizeInBytes', 'dataSource_dataSizeInBytes' - The total number of observations contained in the data files that the
-- @DataSource@ references.
--
-- 'dataSourceId', 'dataSource_dataSourceId' - The ID that is assigned to the @DataSource@ during creation.
--
-- 'finishedAt', 'dataSource_finishedAt' - Undocumented member.
--
-- 'lastUpdatedAt', 'dataSource_lastUpdatedAt' - The time of the most recent edit to the @BatchPrediction@. The time is
-- expressed in epoch time.
--
-- 'message', 'dataSource_message' - A description of the most recent details about creating the
-- @DataSource@.
--
-- 'name', 'dataSource_name' - A user-supplied name or description of the @DataSource@.
--
-- 'numberOfFiles', 'dataSource_numberOfFiles' - The number of data files referenced by the @DataSource@.
--
-- 'rDSMetadata', 'dataSource_rDSMetadata' - Undocumented member.
--
-- 'redshiftMetadata', 'dataSource_redshiftMetadata' - Undocumented member.
--
-- 'roleARN', 'dataSource_roleARN' - Undocumented member.
--
-- 'startedAt', 'dataSource_startedAt' - Undocumented member.
--
-- 'status', 'dataSource_status' - The current status of the @DataSource@. This element can have one of the
-- following values:
--
-- -   PENDING - Amazon Machine Learning (Amazon ML) submitted a request to
--     create a @DataSource@.
--
-- -   INPROGRESS - The creation process is underway.
--
-- -   FAILED - The request to create a @DataSource@ did not run to
--     completion. It is not usable.
--
-- -   COMPLETED - The creation process completed successfully.
--
-- -   DELETED - The @DataSource@ is marked as deleted. It is not usable.
newDataSource ::
  DataSource
newDataSource :: DataSource
newDataSource =
  DataSource'
    { $sel:computeStatistics:DataSource' :: Maybe Bool
computeStatistics = forall a. Maybe a
Prelude.Nothing,
      $sel:computeTime:DataSource' :: Maybe Integer
computeTime = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:DataSource' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:createdByIamUser:DataSource' :: Maybe Text
createdByIamUser = forall a. Maybe a
Prelude.Nothing,
      $sel:dataLocationS3:DataSource' :: Maybe Text
dataLocationS3 = forall a. Maybe a
Prelude.Nothing,
      $sel:dataRearrangement:DataSource' :: Maybe Text
dataRearrangement = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSizeInBytes:DataSource' :: Maybe Integer
dataSizeInBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSourceId:DataSource' :: Maybe Text
dataSourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:finishedAt:DataSource' :: Maybe POSIX
finishedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:DataSource' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:message:DataSource' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DataSource' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfFiles:DataSource' :: Maybe Integer
numberOfFiles = forall a. Maybe a
Prelude.Nothing,
      $sel:rDSMetadata:DataSource' :: Maybe RDSMetadata
rDSMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:redshiftMetadata:DataSource' :: Maybe RedshiftMetadata
redshiftMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:DataSource' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing,
      $sel:startedAt:DataSource' :: Maybe POSIX
startedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DataSource' :: Maybe EntityStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The parameter is @true@ if statistics need to be generated from the
-- observation data.
dataSource_computeStatistics :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Bool)
dataSource_computeStatistics :: Lens' DataSource (Maybe Bool)
dataSource_computeStatistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Bool
computeStatistics :: Maybe Bool
$sel:computeStatistics:DataSource' :: DataSource -> Maybe Bool
computeStatistics} -> Maybe Bool
computeStatistics) (\s :: DataSource
s@DataSource' {} Maybe Bool
a -> DataSource
s {$sel:computeStatistics:DataSource' :: Maybe Bool
computeStatistics = Maybe Bool
a} :: DataSource)

-- | Undocumented member.
dataSource_computeTime :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Integer)
dataSource_computeTime :: Lens' DataSource (Maybe Integer)
dataSource_computeTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Integer
computeTime :: Maybe Integer
$sel:computeTime:DataSource' :: DataSource -> Maybe Integer
computeTime} -> Maybe Integer
computeTime) (\s :: DataSource
s@DataSource' {} Maybe Integer
a -> DataSource
s {$sel:computeTime:DataSource' :: Maybe Integer
computeTime = Maybe Integer
a} :: DataSource)

-- | The time that the @DataSource@ was created. The time is expressed in
-- epoch time.
dataSource_createdAt :: Lens.Lens' DataSource (Prelude.Maybe Prelude.UTCTime)
dataSource_createdAt :: Lens' DataSource (Maybe UTCTime)
dataSource_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:DataSource' :: DataSource -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: DataSource
s@DataSource' {} Maybe POSIX
a -> DataSource
s {$sel:createdAt:DataSource' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: DataSource) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The AWS user account from which the @DataSource@ was created. The
-- account type can be either an AWS root account or an AWS Identity and
-- Access Management (IAM) user account.
dataSource_createdByIamUser :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Text)
dataSource_createdByIamUser :: Lens' DataSource (Maybe Text)
dataSource_createdByIamUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Text
createdByIamUser :: Maybe Text
$sel:createdByIamUser:DataSource' :: DataSource -> Maybe Text
createdByIamUser} -> Maybe Text
createdByIamUser) (\s :: DataSource
s@DataSource' {} Maybe Text
a -> DataSource
s {$sel:createdByIamUser:DataSource' :: Maybe Text
createdByIamUser = Maybe Text
a} :: DataSource)

-- | The location and name of the data in Amazon Simple Storage Service
-- (Amazon S3) that is used by a @DataSource@.
dataSource_dataLocationS3 :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Text)
dataSource_dataLocationS3 :: Lens' DataSource (Maybe Text)
dataSource_dataLocationS3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Text
dataLocationS3 :: Maybe Text
$sel:dataLocationS3:DataSource' :: DataSource -> Maybe Text
dataLocationS3} -> Maybe Text
dataLocationS3) (\s :: DataSource
s@DataSource' {} Maybe Text
a -> DataSource
s {$sel:dataLocationS3:DataSource' :: Maybe Text
dataLocationS3 = Maybe Text
a} :: DataSource)

-- | A JSON string that represents the splitting and rearrangement
-- requirement used when this @DataSource@ was created.
dataSource_dataRearrangement :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Text)
dataSource_dataRearrangement :: Lens' DataSource (Maybe Text)
dataSource_dataRearrangement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Text
dataRearrangement :: Maybe Text
$sel:dataRearrangement:DataSource' :: DataSource -> Maybe Text
dataRearrangement} -> Maybe Text
dataRearrangement) (\s :: DataSource
s@DataSource' {} Maybe Text
a -> DataSource
s {$sel:dataRearrangement:DataSource' :: Maybe Text
dataRearrangement = Maybe Text
a} :: DataSource)

-- | The total number of observations contained in the data files that the
-- @DataSource@ references.
dataSource_dataSizeInBytes :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Integer)
dataSource_dataSizeInBytes :: Lens' DataSource (Maybe Integer)
dataSource_dataSizeInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Integer
dataSizeInBytes :: Maybe Integer
$sel:dataSizeInBytes:DataSource' :: DataSource -> Maybe Integer
dataSizeInBytes} -> Maybe Integer
dataSizeInBytes) (\s :: DataSource
s@DataSource' {} Maybe Integer
a -> DataSource
s {$sel:dataSizeInBytes:DataSource' :: Maybe Integer
dataSizeInBytes = Maybe Integer
a} :: DataSource)

-- | The ID that is assigned to the @DataSource@ during creation.
dataSource_dataSourceId :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Text)
dataSource_dataSourceId :: Lens' DataSource (Maybe Text)
dataSource_dataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Text
dataSourceId :: Maybe Text
$sel:dataSourceId:DataSource' :: DataSource -> Maybe Text
dataSourceId} -> Maybe Text
dataSourceId) (\s :: DataSource
s@DataSource' {} Maybe Text
a -> DataSource
s {$sel:dataSourceId:DataSource' :: Maybe Text
dataSourceId = Maybe Text
a} :: DataSource)

-- | Undocumented member.
dataSource_finishedAt :: Lens.Lens' DataSource (Prelude.Maybe Prelude.UTCTime)
dataSource_finishedAt :: Lens' DataSource (Maybe UTCTime)
dataSource_finishedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe POSIX
finishedAt :: Maybe POSIX
$sel:finishedAt:DataSource' :: DataSource -> Maybe POSIX
finishedAt} -> Maybe POSIX
finishedAt) (\s :: DataSource
s@DataSource' {} Maybe POSIX
a -> DataSource
s {$sel:finishedAt:DataSource' :: Maybe POSIX
finishedAt = Maybe POSIX
a} :: DataSource) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The time of the most recent edit to the @BatchPrediction@. The time is
-- expressed in epoch time.
dataSource_lastUpdatedAt :: Lens.Lens' DataSource (Prelude.Maybe Prelude.UTCTime)
dataSource_lastUpdatedAt :: Lens' DataSource (Maybe UTCTime)
dataSource_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:DataSource' :: DataSource -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: DataSource
s@DataSource' {} Maybe POSIX
a -> DataSource
s {$sel:lastUpdatedAt:DataSource' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: DataSource) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A description of the most recent details about creating the
-- @DataSource@.
dataSource_message :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Text)
dataSource_message :: Lens' DataSource (Maybe Text)
dataSource_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Text
message :: Maybe Text
$sel:message:DataSource' :: DataSource -> Maybe Text
message} -> Maybe Text
message) (\s :: DataSource
s@DataSource' {} Maybe Text
a -> DataSource
s {$sel:message:DataSource' :: Maybe Text
message = Maybe Text
a} :: DataSource)

-- | A user-supplied name or description of the @DataSource@.
dataSource_name :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Text)
dataSource_name :: Lens' DataSource (Maybe Text)
dataSource_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Text
name :: Maybe Text
$sel:name:DataSource' :: DataSource -> Maybe Text
name} -> Maybe Text
name) (\s :: DataSource
s@DataSource' {} Maybe Text
a -> DataSource
s {$sel:name:DataSource' :: Maybe Text
name = Maybe Text
a} :: DataSource)

-- | The number of data files referenced by the @DataSource@.
dataSource_numberOfFiles :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Integer)
dataSource_numberOfFiles :: Lens' DataSource (Maybe Integer)
dataSource_numberOfFiles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Integer
numberOfFiles :: Maybe Integer
$sel:numberOfFiles:DataSource' :: DataSource -> Maybe Integer
numberOfFiles} -> Maybe Integer
numberOfFiles) (\s :: DataSource
s@DataSource' {} Maybe Integer
a -> DataSource
s {$sel:numberOfFiles:DataSource' :: Maybe Integer
numberOfFiles = Maybe Integer
a} :: DataSource)

-- | Undocumented member.
dataSource_rDSMetadata :: Lens.Lens' DataSource (Prelude.Maybe RDSMetadata)
dataSource_rDSMetadata :: Lens' DataSource (Maybe RDSMetadata)
dataSource_rDSMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe RDSMetadata
rDSMetadata :: Maybe RDSMetadata
$sel:rDSMetadata:DataSource' :: DataSource -> Maybe RDSMetadata
rDSMetadata} -> Maybe RDSMetadata
rDSMetadata) (\s :: DataSource
s@DataSource' {} Maybe RDSMetadata
a -> DataSource
s {$sel:rDSMetadata:DataSource' :: Maybe RDSMetadata
rDSMetadata = Maybe RDSMetadata
a} :: DataSource)

-- | Undocumented member.
dataSource_redshiftMetadata :: Lens.Lens' DataSource (Prelude.Maybe RedshiftMetadata)
dataSource_redshiftMetadata :: Lens' DataSource (Maybe RedshiftMetadata)
dataSource_redshiftMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe RedshiftMetadata
redshiftMetadata :: Maybe RedshiftMetadata
$sel:redshiftMetadata:DataSource' :: DataSource -> Maybe RedshiftMetadata
redshiftMetadata} -> Maybe RedshiftMetadata
redshiftMetadata) (\s :: DataSource
s@DataSource' {} Maybe RedshiftMetadata
a -> DataSource
s {$sel:redshiftMetadata:DataSource' :: Maybe RedshiftMetadata
redshiftMetadata = Maybe RedshiftMetadata
a} :: DataSource)

-- | Undocumented member.
dataSource_roleARN :: Lens.Lens' DataSource (Prelude.Maybe Prelude.Text)
dataSource_roleARN :: Lens' DataSource (Maybe Text)
dataSource_roleARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe Text
roleARN :: Maybe Text
$sel:roleARN:DataSource' :: DataSource -> Maybe Text
roleARN} -> Maybe Text
roleARN) (\s :: DataSource
s@DataSource' {} Maybe Text
a -> DataSource
s {$sel:roleARN:DataSource' :: Maybe Text
roleARN = Maybe Text
a} :: DataSource)

-- | Undocumented member.
dataSource_startedAt :: Lens.Lens' DataSource (Prelude.Maybe Prelude.UTCTime)
dataSource_startedAt :: Lens' DataSource (Maybe UTCTime)
dataSource_startedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe POSIX
startedAt :: Maybe POSIX
$sel:startedAt:DataSource' :: DataSource -> Maybe POSIX
startedAt} -> Maybe POSIX
startedAt) (\s :: DataSource
s@DataSource' {} Maybe POSIX
a -> DataSource
s {$sel:startedAt:DataSource' :: Maybe POSIX
startedAt = Maybe POSIX
a} :: DataSource) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The current status of the @DataSource@. This element can have one of the
-- following values:
--
-- -   PENDING - Amazon Machine Learning (Amazon ML) submitted a request to
--     create a @DataSource@.
--
-- -   INPROGRESS - The creation process is underway.
--
-- -   FAILED - The request to create a @DataSource@ did not run to
--     completion. It is not usable.
--
-- -   COMPLETED - The creation process completed successfully.
--
-- -   DELETED - The @DataSource@ is marked as deleted. It is not usable.
dataSource_status :: Lens.Lens' DataSource (Prelude.Maybe EntityStatus)
dataSource_status :: Lens' DataSource (Maybe EntityStatus)
dataSource_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSource' {Maybe EntityStatus
status :: Maybe EntityStatus
$sel:status:DataSource' :: DataSource -> Maybe EntityStatus
status} -> Maybe EntityStatus
status) (\s :: DataSource
s@DataSource' {} Maybe EntityStatus
a -> DataSource
s {$sel:status:DataSource' :: Maybe EntityStatus
status = Maybe EntityStatus
a} :: DataSource)

instance Data.FromJSON DataSource where
  parseJSON :: Value -> Parser DataSource
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DataSource"
      ( \Object
x ->
          Maybe Bool
-> Maybe Integer
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe RDSMetadata
-> Maybe RedshiftMetadata
-> Maybe Text
-> Maybe POSIX
-> Maybe EntityStatus
-> DataSource
DataSource'
            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
"ComputeStatistics")
            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
"ComputeTime")
            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
"CreatedAt")
            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
"CreatedByIamUser")
            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
"DataLocationS3")
            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
"DataRearrangement")
            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
"DataSizeInBytes")
            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
"DataSourceId")
            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
"FinishedAt")
            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
"LastUpdatedAt")
            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
"Message")
            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
"Name")
            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
"NumberOfFiles")
            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
"RDSMetadata")
            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
"RedshiftMetadata")
            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
"RoleARN")
            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
"StartedAt")
            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
"Status")
      )

instance Prelude.Hashable DataSource where
  hashWithSalt :: Int -> DataSource -> Int
hashWithSalt Int
_salt DataSource' {Maybe Bool
Maybe Integer
Maybe Text
Maybe POSIX
Maybe EntityStatus
Maybe RDSMetadata
Maybe RedshiftMetadata
status :: Maybe EntityStatus
startedAt :: Maybe POSIX
roleARN :: Maybe Text
redshiftMetadata :: Maybe RedshiftMetadata
rDSMetadata :: Maybe RDSMetadata
numberOfFiles :: Maybe Integer
name :: Maybe Text
message :: Maybe Text
lastUpdatedAt :: Maybe POSIX
finishedAt :: Maybe POSIX
dataSourceId :: Maybe Text
dataSizeInBytes :: Maybe Integer
dataRearrangement :: Maybe Text
dataLocationS3 :: Maybe Text
createdByIamUser :: Maybe Text
createdAt :: Maybe POSIX
computeTime :: Maybe Integer
computeStatistics :: Maybe Bool
$sel:status:DataSource' :: DataSource -> Maybe EntityStatus
$sel:startedAt:DataSource' :: DataSource -> Maybe POSIX
$sel:roleARN:DataSource' :: DataSource -> Maybe Text
$sel:redshiftMetadata:DataSource' :: DataSource -> Maybe RedshiftMetadata
$sel:rDSMetadata:DataSource' :: DataSource -> Maybe RDSMetadata
$sel:numberOfFiles:DataSource' :: DataSource -> Maybe Integer
$sel:name:DataSource' :: DataSource -> Maybe Text
$sel:message:DataSource' :: DataSource -> Maybe Text
$sel:lastUpdatedAt:DataSource' :: DataSource -> Maybe POSIX
$sel:finishedAt:DataSource' :: DataSource -> Maybe POSIX
$sel:dataSourceId:DataSource' :: DataSource -> Maybe Text
$sel:dataSizeInBytes:DataSource' :: DataSource -> Maybe Integer
$sel:dataRearrangement:DataSource' :: DataSource -> Maybe Text
$sel:dataLocationS3:DataSource' :: DataSource -> Maybe Text
$sel:createdByIamUser:DataSource' :: DataSource -> Maybe Text
$sel:createdAt:DataSource' :: DataSource -> Maybe POSIX
$sel:computeTime:DataSource' :: DataSource -> Maybe Integer
$sel:computeStatistics:DataSource' :: DataSource -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
computeStatistics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
computeTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
createdByIamUser
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dataLocationS3
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dataRearrangement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
dataSizeInBytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dataSourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
finishedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdatedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
message
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
numberOfFiles
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RDSMetadata
rDSMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RedshiftMetadata
redshiftMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startedAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EntityStatus
status

instance Prelude.NFData DataSource where
  rnf :: DataSource -> ()
rnf DataSource' {Maybe Bool
Maybe Integer
Maybe Text
Maybe POSIX
Maybe EntityStatus
Maybe RDSMetadata
Maybe RedshiftMetadata
status :: Maybe EntityStatus
startedAt :: Maybe POSIX
roleARN :: Maybe Text
redshiftMetadata :: Maybe RedshiftMetadata
rDSMetadata :: Maybe RDSMetadata
numberOfFiles :: Maybe Integer
name :: Maybe Text
message :: Maybe Text
lastUpdatedAt :: Maybe POSIX
finishedAt :: Maybe POSIX
dataSourceId :: Maybe Text
dataSizeInBytes :: Maybe Integer
dataRearrangement :: Maybe Text
dataLocationS3 :: Maybe Text
createdByIamUser :: Maybe Text
createdAt :: Maybe POSIX
computeTime :: Maybe Integer
computeStatistics :: Maybe Bool
$sel:status:DataSource' :: DataSource -> Maybe EntityStatus
$sel:startedAt:DataSource' :: DataSource -> Maybe POSIX
$sel:roleARN:DataSource' :: DataSource -> Maybe Text
$sel:redshiftMetadata:DataSource' :: DataSource -> Maybe RedshiftMetadata
$sel:rDSMetadata:DataSource' :: DataSource -> Maybe RDSMetadata
$sel:numberOfFiles:DataSource' :: DataSource -> Maybe Integer
$sel:name:DataSource' :: DataSource -> Maybe Text
$sel:message:DataSource' :: DataSource -> Maybe Text
$sel:lastUpdatedAt:DataSource' :: DataSource -> Maybe POSIX
$sel:finishedAt:DataSource' :: DataSource -> Maybe POSIX
$sel:dataSourceId:DataSource' :: DataSource -> Maybe Text
$sel:dataSizeInBytes:DataSource' :: DataSource -> Maybe Integer
$sel:dataRearrangement:DataSource' :: DataSource -> Maybe Text
$sel:dataLocationS3:DataSource' :: DataSource -> Maybe Text
$sel:createdByIamUser:DataSource' :: DataSource -> Maybe Text
$sel:createdAt:DataSource' :: DataSource -> Maybe POSIX
$sel:computeTime:DataSource' :: DataSource -> Maybe Integer
$sel:computeStatistics:DataSource' :: DataSource -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
computeStatistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
computeTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
createdByIamUser
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataLocationS3
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataRearrangement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
dataSizeInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataSourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
finishedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
numberOfFiles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RDSMetadata
rDSMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RedshiftMetadata
redshiftMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startedAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EntityStatus
status