{-# 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.MachineLearning.GetDataSource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a @DataSource@ that includes metadata and data file information,
-- as well as the current status of the @DataSource@.
--
-- @GetDataSource@ provides results in normal or verbose format. The
-- verbose format adds the schema description and the list of files pointed
-- to by the DataSource to the normal format.
module Amazonka.MachineLearning.GetDataSource
  ( -- * Creating a Request
    GetDataSource (..),
    newGetDataSource,

    -- * Request Lenses
    getDataSource_verbose,
    getDataSource_dataSourceId,

    -- * Destructuring the Response
    GetDataSourceResponse (..),
    newGetDataSourceResponse,

    -- * Response Lenses
    getDataSourceResponse_computeStatistics,
    getDataSourceResponse_computeTime,
    getDataSourceResponse_createdAt,
    getDataSourceResponse_createdByIamUser,
    getDataSourceResponse_dataLocationS3,
    getDataSourceResponse_dataRearrangement,
    getDataSourceResponse_dataSizeInBytes,
    getDataSourceResponse_dataSourceId,
    getDataSourceResponse_dataSourceSchema,
    getDataSourceResponse_finishedAt,
    getDataSourceResponse_lastUpdatedAt,
    getDataSourceResponse_logUri,
    getDataSourceResponse_message,
    getDataSourceResponse_name,
    getDataSourceResponse_numberOfFiles,
    getDataSourceResponse_rDSMetadata,
    getDataSourceResponse_redshiftMetadata,
    getDataSourceResponse_roleARN,
    getDataSourceResponse_startedAt,
    getDataSourceResponse_status,
    getDataSourceResponse_httpStatus,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetDataSource' smart constructor.
data GetDataSource = GetDataSource'
  { -- | Specifies whether the @GetDataSource@ operation should return
    -- @DataSourceSchema@.
    --
    -- If true, @DataSourceSchema@ is returned.
    --
    -- If false, @DataSourceSchema@ is not returned.
    GetDataSource -> Maybe Bool
verbose :: Prelude.Maybe Prelude.Bool,
    -- | The ID assigned to the @DataSource@ at creation.
    GetDataSource -> Text
dataSourceId :: Prelude.Text
  }
  deriving (GetDataSource -> GetDataSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDataSource -> GetDataSource -> Bool
$c/= :: GetDataSource -> GetDataSource -> Bool
== :: GetDataSource -> GetDataSource -> Bool
$c== :: GetDataSource -> GetDataSource -> Bool
Prelude.Eq, ReadPrec [GetDataSource]
ReadPrec GetDataSource
Int -> ReadS GetDataSource
ReadS [GetDataSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDataSource]
$creadListPrec :: ReadPrec [GetDataSource]
readPrec :: ReadPrec GetDataSource
$creadPrec :: ReadPrec GetDataSource
readList :: ReadS [GetDataSource]
$creadList :: ReadS [GetDataSource]
readsPrec :: Int -> ReadS GetDataSource
$creadsPrec :: Int -> ReadS GetDataSource
Prelude.Read, Int -> GetDataSource -> ShowS
[GetDataSource] -> ShowS
GetDataSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDataSource] -> ShowS
$cshowList :: [GetDataSource] -> ShowS
show :: GetDataSource -> String
$cshow :: GetDataSource -> String
showsPrec :: Int -> GetDataSource -> ShowS
$cshowsPrec :: Int -> GetDataSource -> ShowS
Prelude.Show, forall x. Rep GetDataSource x -> GetDataSource
forall x. GetDataSource -> Rep GetDataSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDataSource x -> GetDataSource
$cfrom :: forall x. GetDataSource -> Rep GetDataSource x
Prelude.Generic)

-- |
-- Create a value of 'GetDataSource' 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:
--
-- 'verbose', 'getDataSource_verbose' - Specifies whether the @GetDataSource@ operation should return
-- @DataSourceSchema@.
--
-- If true, @DataSourceSchema@ is returned.
--
-- If false, @DataSourceSchema@ is not returned.
--
-- 'dataSourceId', 'getDataSource_dataSourceId' - The ID assigned to the @DataSource@ at creation.
newGetDataSource ::
  -- | 'dataSourceId'
  Prelude.Text ->
  GetDataSource
newGetDataSource :: Text -> GetDataSource
newGetDataSource Text
pDataSourceId_ =
  GetDataSource'
    { $sel:verbose:GetDataSource' :: Maybe Bool
verbose = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSourceId:GetDataSource' :: Text
dataSourceId = Text
pDataSourceId_
    }

-- | Specifies whether the @GetDataSource@ operation should return
-- @DataSourceSchema@.
--
-- If true, @DataSourceSchema@ is returned.
--
-- If false, @DataSourceSchema@ is not returned.
getDataSource_verbose :: Lens.Lens' GetDataSource (Prelude.Maybe Prelude.Bool)
getDataSource_verbose :: Lens' GetDataSource (Maybe Bool)
getDataSource_verbose = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSource' {Maybe Bool
verbose :: Maybe Bool
$sel:verbose:GetDataSource' :: GetDataSource -> Maybe Bool
verbose} -> Maybe Bool
verbose) (\s :: GetDataSource
s@GetDataSource' {} Maybe Bool
a -> GetDataSource
s {$sel:verbose:GetDataSource' :: Maybe Bool
verbose = Maybe Bool
a} :: GetDataSource)

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

instance Core.AWSRequest GetDataSource where
  type
    AWSResponse GetDataSource =
      GetDataSourceResponse
  request :: (Service -> Service) -> GetDataSource -> Request GetDataSource
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 GetDataSource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDataSource)))
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 Bool
-> Maybe Integer
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe RDSMetadata
-> Maybe RedshiftMetadata
-> Maybe Text
-> Maybe POSIX
-> Maybe EntityStatus
-> Int
-> GetDataSourceResponse
GetDataSourceResponse'
            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
"ComputeStatistics")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"DataSourceSchema")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"LogUri")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"Status")
            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 GetDataSource where
  hashWithSalt :: Int -> GetDataSource -> Int
hashWithSalt Int
_salt GetDataSource' {Maybe Bool
Text
dataSourceId :: Text
verbose :: Maybe Bool
$sel:dataSourceId:GetDataSource' :: GetDataSource -> Text
$sel:verbose:GetDataSource' :: GetDataSource -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
verbose
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataSourceId

instance Prelude.NFData GetDataSource where
  rnf :: GetDataSource -> ()
rnf GetDataSource' {Maybe Bool
Text
dataSourceId :: Text
verbose :: Maybe Bool
$sel:dataSourceId:GetDataSource' :: GetDataSource -> Text
$sel:verbose:GetDataSource' :: GetDataSource -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
verbose
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dataSourceId

instance Data.ToHeaders GetDataSource where
  toHeaders :: GetDataSource -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonML_20141212.GetDataSource" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetDataSource where
  toJSON :: GetDataSource -> Value
toJSON GetDataSource' {Maybe Bool
Text
dataSourceId :: Text
verbose :: Maybe Bool
$sel:dataSourceId:GetDataSource' :: GetDataSource -> Text
$sel:verbose:GetDataSource' :: GetDataSource -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Verbose" 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
verbose,
            forall a. a -> Maybe a
Prelude.Just (Key
"DataSourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataSourceId)
          ]
      )

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

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

-- | Represents the output of a @GetDataSource@ operation and describes a
-- @DataSource@.
--
-- /See:/ 'newGetDataSourceResponse' smart constructor.
data GetDataSourceResponse = GetDataSourceResponse'
  { -- | The parameter is @true@ if statistics need to be generated from the
    -- observation data.
    GetDataSourceResponse -> Maybe Bool
computeStatistics :: Prelude.Maybe Prelude.Bool,
    -- | The approximate CPU time in milliseconds that Amazon Machine Learning
    -- spent processing the @DataSource@, normalized and scaled on computation
    -- resources. @ComputeTime@ is only available if the @DataSource@ is in the
    -- @COMPLETED@ state and the @ComputeStatistics@ is set to true.
    GetDataSourceResponse -> Maybe Integer
computeTime :: Prelude.Maybe Prelude.Integer,
    -- | The time that the @DataSource@ was created. The time is expressed in
    -- epoch time.
    GetDataSourceResponse -> 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.
    GetDataSourceResponse -> Maybe Text
createdByIamUser :: Prelude.Maybe Prelude.Text,
    -- | The location of the data file or directory in Amazon Simple Storage
    -- Service (Amazon S3).
    GetDataSourceResponse -> Maybe Text
dataLocationS3 :: Prelude.Maybe Prelude.Text,
    -- | A JSON string that represents the splitting and rearrangement
    -- requirement used when this @DataSource@ was created.
    GetDataSourceResponse -> Maybe Text
dataRearrangement :: Prelude.Maybe Prelude.Text,
    -- | The total size of observations in the data files.
    GetDataSourceResponse -> Maybe Integer
dataSizeInBytes :: Prelude.Maybe Prelude.Integer,
    -- | The ID assigned to the @DataSource@ at creation. This value should be
    -- identical to the value of the @DataSourceId@ in the request.
    GetDataSourceResponse -> Maybe Text
dataSourceId :: Prelude.Maybe Prelude.Text,
    -- | The schema used by all of the data files of this @DataSource@.
    --
    -- __Note:__ This parameter is provided as part of the verbose format.
    GetDataSourceResponse -> Maybe Text
dataSourceSchema :: Prelude.Maybe Prelude.Text,
    -- | The epoch time when Amazon Machine Learning marked the @DataSource@ as
    -- @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
    -- @DataSource@ is in the @COMPLETED@ or @FAILED@ state.
    GetDataSourceResponse -> Maybe POSIX
finishedAt :: Prelude.Maybe Data.POSIX,
    -- | The time of the most recent edit to the @DataSource@. The time is
    -- expressed in epoch time.
    GetDataSourceResponse -> Maybe POSIX
lastUpdatedAt :: Prelude.Maybe Data.POSIX,
    -- | A link to the file containing logs of @CreateDataSourceFrom*@
    -- operations.
    GetDataSourceResponse -> Maybe Text
logUri :: Prelude.Maybe Prelude.Text,
    -- | The user-supplied description of the most recent details about creating
    -- the @DataSource@.
    GetDataSourceResponse -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied name or description of the @DataSource@.
    GetDataSourceResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The number of data files referenced by the @DataSource@.
    GetDataSourceResponse -> Maybe Integer
numberOfFiles :: Prelude.Maybe Prelude.Integer,
    GetDataSourceResponse -> Maybe RDSMetadata
rDSMetadata :: Prelude.Maybe RDSMetadata,
    GetDataSourceResponse -> Maybe RedshiftMetadata
redshiftMetadata :: Prelude.Maybe RedshiftMetadata,
    GetDataSourceResponse -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text,
    -- | The epoch time when Amazon Machine Learning marked the @DataSource@ as
    -- @INPROGRESS@. @StartedAt@ isn\'t available if the @DataSource@ is in the
    -- @PENDING@ state.
    GetDataSourceResponse -> Maybe POSIX
startedAt :: Prelude.Maybe Data.POSIX,
    -- | The current status of the @DataSource@. This element can have one of the
    -- following values:
    --
    -- -   @PENDING@ - 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.
    GetDataSourceResponse -> Maybe EntityStatus
status :: Prelude.Maybe EntityStatus,
    -- | The response's http status code.
    GetDataSourceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDataSourceResponse -> GetDataSourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDataSourceResponse -> GetDataSourceResponse -> Bool
$c/= :: GetDataSourceResponse -> GetDataSourceResponse -> Bool
== :: GetDataSourceResponse -> GetDataSourceResponse -> Bool
$c== :: GetDataSourceResponse -> GetDataSourceResponse -> Bool
Prelude.Eq, ReadPrec [GetDataSourceResponse]
ReadPrec GetDataSourceResponse
Int -> ReadS GetDataSourceResponse
ReadS [GetDataSourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDataSourceResponse]
$creadListPrec :: ReadPrec [GetDataSourceResponse]
readPrec :: ReadPrec GetDataSourceResponse
$creadPrec :: ReadPrec GetDataSourceResponse
readList :: ReadS [GetDataSourceResponse]
$creadList :: ReadS [GetDataSourceResponse]
readsPrec :: Int -> ReadS GetDataSourceResponse
$creadsPrec :: Int -> ReadS GetDataSourceResponse
Prelude.Read, Int -> GetDataSourceResponse -> ShowS
[GetDataSourceResponse] -> ShowS
GetDataSourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDataSourceResponse] -> ShowS
$cshowList :: [GetDataSourceResponse] -> ShowS
show :: GetDataSourceResponse -> String
$cshow :: GetDataSourceResponse -> String
showsPrec :: Int -> GetDataSourceResponse -> ShowS
$cshowsPrec :: Int -> GetDataSourceResponse -> ShowS
Prelude.Show, forall x. Rep GetDataSourceResponse x -> GetDataSourceResponse
forall x. GetDataSourceResponse -> Rep GetDataSourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDataSourceResponse x -> GetDataSourceResponse
$cfrom :: forall x. GetDataSourceResponse -> Rep GetDataSourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDataSourceResponse' 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', 'getDataSourceResponse_computeStatistics' - The parameter is @true@ if statistics need to be generated from the
-- observation data.
--
-- 'computeTime', 'getDataSourceResponse_computeTime' - The approximate CPU time in milliseconds that Amazon Machine Learning
-- spent processing the @DataSource@, normalized and scaled on computation
-- resources. @ComputeTime@ is only available if the @DataSource@ is in the
-- @COMPLETED@ state and the @ComputeStatistics@ is set to true.
--
-- 'createdAt', 'getDataSourceResponse_createdAt' - The time that the @DataSource@ was created. The time is expressed in
-- epoch time.
--
-- 'createdByIamUser', 'getDataSourceResponse_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', 'getDataSourceResponse_dataLocationS3' - The location of the data file or directory in Amazon Simple Storage
-- Service (Amazon S3).
--
-- 'dataRearrangement', 'getDataSourceResponse_dataRearrangement' - A JSON string that represents the splitting and rearrangement
-- requirement used when this @DataSource@ was created.
--
-- 'dataSizeInBytes', 'getDataSourceResponse_dataSizeInBytes' - The total size of observations in the data files.
--
-- 'dataSourceId', 'getDataSourceResponse_dataSourceId' - The ID assigned to the @DataSource@ at creation. This value should be
-- identical to the value of the @DataSourceId@ in the request.
--
-- 'dataSourceSchema', 'getDataSourceResponse_dataSourceSchema' - The schema used by all of the data files of this @DataSource@.
--
-- __Note:__ This parameter is provided as part of the verbose format.
--
-- 'finishedAt', 'getDataSourceResponse_finishedAt' - The epoch time when Amazon Machine Learning marked the @DataSource@ as
-- @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
-- @DataSource@ is in the @COMPLETED@ or @FAILED@ state.
--
-- 'lastUpdatedAt', 'getDataSourceResponse_lastUpdatedAt' - The time of the most recent edit to the @DataSource@. The time is
-- expressed in epoch time.
--
-- 'logUri', 'getDataSourceResponse_logUri' - A link to the file containing logs of @CreateDataSourceFrom*@
-- operations.
--
-- 'message', 'getDataSourceResponse_message' - The user-supplied description of the most recent details about creating
-- the @DataSource@.
--
-- 'name', 'getDataSourceResponse_name' - A user-supplied name or description of the @DataSource@.
--
-- 'numberOfFiles', 'getDataSourceResponse_numberOfFiles' - The number of data files referenced by the @DataSource@.
--
-- 'rDSMetadata', 'getDataSourceResponse_rDSMetadata' - Undocumented member.
--
-- 'redshiftMetadata', 'getDataSourceResponse_redshiftMetadata' - Undocumented member.
--
-- 'roleARN', 'getDataSourceResponse_roleARN' - Undocumented member.
--
-- 'startedAt', 'getDataSourceResponse_startedAt' - The epoch time when Amazon Machine Learning marked the @DataSource@ as
-- @INPROGRESS@. @StartedAt@ isn\'t available if the @DataSource@ is in the
-- @PENDING@ state.
--
-- 'status', 'getDataSourceResponse_status' - The current status of the @DataSource@. This element can have one of the
-- following values:
--
-- -   @PENDING@ - 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.
--
-- 'httpStatus', 'getDataSourceResponse_httpStatus' - The response's http status code.
newGetDataSourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDataSourceResponse
newGetDataSourceResponse :: Int -> GetDataSourceResponse
newGetDataSourceResponse Int
pHttpStatus_ =
  GetDataSourceResponse'
    { $sel:computeStatistics:GetDataSourceResponse' :: Maybe Bool
computeStatistics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:computeTime:GetDataSourceResponse' :: Maybe Integer
computeTime = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:GetDataSourceResponse' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:createdByIamUser:GetDataSourceResponse' :: Maybe Text
createdByIamUser = forall a. Maybe a
Prelude.Nothing,
      $sel:dataLocationS3:GetDataSourceResponse' :: Maybe Text
dataLocationS3 = forall a. Maybe a
Prelude.Nothing,
      $sel:dataRearrangement:GetDataSourceResponse' :: Maybe Text
dataRearrangement = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSizeInBytes:GetDataSourceResponse' :: Maybe Integer
dataSizeInBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSourceId:GetDataSourceResponse' :: Maybe Text
dataSourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSourceSchema:GetDataSourceResponse' :: Maybe Text
dataSourceSchema = forall a. Maybe a
Prelude.Nothing,
      $sel:finishedAt:GetDataSourceResponse' :: Maybe POSIX
finishedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedAt:GetDataSourceResponse' :: Maybe POSIX
lastUpdatedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:logUri:GetDataSourceResponse' :: Maybe Text
logUri = forall a. Maybe a
Prelude.Nothing,
      $sel:message:GetDataSourceResponse' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetDataSourceResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfFiles:GetDataSourceResponse' :: Maybe Integer
numberOfFiles = forall a. Maybe a
Prelude.Nothing,
      $sel:rDSMetadata:GetDataSourceResponse' :: Maybe RDSMetadata
rDSMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:redshiftMetadata:GetDataSourceResponse' :: Maybe RedshiftMetadata
redshiftMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:GetDataSourceResponse' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing,
      $sel:startedAt:GetDataSourceResponse' :: Maybe POSIX
startedAt = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetDataSourceResponse' :: Maybe EntityStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDataSourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The approximate CPU time in milliseconds that Amazon Machine Learning
-- spent processing the @DataSource@, normalized and scaled on computation
-- resources. @ComputeTime@ is only available if the @DataSource@ is in the
-- @COMPLETED@ state and the @ComputeStatistics@ is set to true.
getDataSourceResponse_computeTime :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.Integer)
getDataSourceResponse_computeTime :: Lens' GetDataSourceResponse (Maybe Integer)
getDataSourceResponse_computeTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe Integer
computeTime :: Maybe Integer
$sel:computeTime:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Integer
computeTime} -> Maybe Integer
computeTime) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe Integer
a -> GetDataSourceResponse
s {$sel:computeTime:GetDataSourceResponse' :: Maybe Integer
computeTime = Maybe Integer
a} :: GetDataSourceResponse)

-- | The time that the @DataSource@ was created. The time is expressed in
-- epoch time.
getDataSourceResponse_createdAt :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.UTCTime)
getDataSourceResponse_createdAt :: Lens' GetDataSourceResponse (Maybe UTCTime)
getDataSourceResponse_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe POSIX
a -> GetDataSourceResponse
s {$sel:createdAt:GetDataSourceResponse' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: GetDataSourceResponse) 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.
getDataSourceResponse_createdByIamUser :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.Text)
getDataSourceResponse_createdByIamUser :: Lens' GetDataSourceResponse (Maybe Text)
getDataSourceResponse_createdByIamUser = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe Text
createdByIamUser :: Maybe Text
$sel:createdByIamUser:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
createdByIamUser} -> Maybe Text
createdByIamUser) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe Text
a -> GetDataSourceResponse
s {$sel:createdByIamUser:GetDataSourceResponse' :: Maybe Text
createdByIamUser = Maybe Text
a} :: GetDataSourceResponse)

-- | The location of the data file or directory in Amazon Simple Storage
-- Service (Amazon S3).
getDataSourceResponse_dataLocationS3 :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.Text)
getDataSourceResponse_dataLocationS3 :: Lens' GetDataSourceResponse (Maybe Text)
getDataSourceResponse_dataLocationS3 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe Text
dataLocationS3 :: Maybe Text
$sel:dataLocationS3:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
dataLocationS3} -> Maybe Text
dataLocationS3) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe Text
a -> GetDataSourceResponse
s {$sel:dataLocationS3:GetDataSourceResponse' :: Maybe Text
dataLocationS3 = Maybe Text
a} :: GetDataSourceResponse)

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

-- | The total size of observations in the data files.
getDataSourceResponse_dataSizeInBytes :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.Integer)
getDataSourceResponse_dataSizeInBytes :: Lens' GetDataSourceResponse (Maybe Integer)
getDataSourceResponse_dataSizeInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe Integer
dataSizeInBytes :: Maybe Integer
$sel:dataSizeInBytes:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Integer
dataSizeInBytes} -> Maybe Integer
dataSizeInBytes) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe Integer
a -> GetDataSourceResponse
s {$sel:dataSizeInBytes:GetDataSourceResponse' :: Maybe Integer
dataSizeInBytes = Maybe Integer
a} :: GetDataSourceResponse)

-- | The ID assigned to the @DataSource@ at creation. This value should be
-- identical to the value of the @DataSourceId@ in the request.
getDataSourceResponse_dataSourceId :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.Text)
getDataSourceResponse_dataSourceId :: Lens' GetDataSourceResponse (Maybe Text)
getDataSourceResponse_dataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe Text
dataSourceId :: Maybe Text
$sel:dataSourceId:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
dataSourceId} -> Maybe Text
dataSourceId) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe Text
a -> GetDataSourceResponse
s {$sel:dataSourceId:GetDataSourceResponse' :: Maybe Text
dataSourceId = Maybe Text
a} :: GetDataSourceResponse)

-- | The schema used by all of the data files of this @DataSource@.
--
-- __Note:__ This parameter is provided as part of the verbose format.
getDataSourceResponse_dataSourceSchema :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.Text)
getDataSourceResponse_dataSourceSchema :: Lens' GetDataSourceResponse (Maybe Text)
getDataSourceResponse_dataSourceSchema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe Text
dataSourceSchema :: Maybe Text
$sel:dataSourceSchema:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
dataSourceSchema} -> Maybe Text
dataSourceSchema) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe Text
a -> GetDataSourceResponse
s {$sel:dataSourceSchema:GetDataSourceResponse' :: Maybe Text
dataSourceSchema = Maybe Text
a} :: GetDataSourceResponse)

-- | The epoch time when Amazon Machine Learning marked the @DataSource@ as
-- @COMPLETED@ or @FAILED@. @FinishedAt@ is only available when the
-- @DataSource@ is in the @COMPLETED@ or @FAILED@ state.
getDataSourceResponse_finishedAt :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.UTCTime)
getDataSourceResponse_finishedAt :: Lens' GetDataSourceResponse (Maybe UTCTime)
getDataSourceResponse_finishedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe POSIX
finishedAt :: Maybe POSIX
$sel:finishedAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
finishedAt} -> Maybe POSIX
finishedAt) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe POSIX
a -> GetDataSourceResponse
s {$sel:finishedAt:GetDataSourceResponse' :: Maybe POSIX
finishedAt = Maybe POSIX
a} :: GetDataSourceResponse) 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 @DataSource@. The time is
-- expressed in epoch time.
getDataSourceResponse_lastUpdatedAt :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.UTCTime)
getDataSourceResponse_lastUpdatedAt :: Lens' GetDataSourceResponse (Maybe UTCTime)
getDataSourceResponse_lastUpdatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe POSIX
lastUpdatedAt :: Maybe POSIX
$sel:lastUpdatedAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
lastUpdatedAt} -> Maybe POSIX
lastUpdatedAt) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe POSIX
a -> GetDataSourceResponse
s {$sel:lastUpdatedAt:GetDataSourceResponse' :: Maybe POSIX
lastUpdatedAt = Maybe POSIX
a} :: GetDataSourceResponse) 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 link to the file containing logs of @CreateDataSourceFrom*@
-- operations.
getDataSourceResponse_logUri :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.Text)
getDataSourceResponse_logUri :: Lens' GetDataSourceResponse (Maybe Text)
getDataSourceResponse_logUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe Text
logUri :: Maybe Text
$sel:logUri:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
logUri} -> Maybe Text
logUri) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe Text
a -> GetDataSourceResponse
s {$sel:logUri:GetDataSourceResponse' :: Maybe Text
logUri = Maybe Text
a} :: GetDataSourceResponse)

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

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

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

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

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

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

-- | The epoch time when Amazon Machine Learning marked the @DataSource@ as
-- @INPROGRESS@. @StartedAt@ isn\'t available if the @DataSource@ is in the
-- @PENDING@ state.
getDataSourceResponse_startedAt :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe Prelude.UTCTime)
getDataSourceResponse_startedAt :: Lens' GetDataSourceResponse (Maybe UTCTime)
getDataSourceResponse_startedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe POSIX
startedAt :: Maybe POSIX
$sel:startedAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
startedAt} -> Maybe POSIX
startedAt) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe POSIX
a -> GetDataSourceResponse
s {$sel:startedAt:GetDataSourceResponse' :: Maybe POSIX
startedAt = Maybe POSIX
a} :: GetDataSourceResponse) 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 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.
getDataSourceResponse_status :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe EntityStatus)
getDataSourceResponse_status :: Lens' GetDataSourceResponse (Maybe EntityStatus)
getDataSourceResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe EntityStatus
status :: Maybe EntityStatus
$sel:status:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe EntityStatus
status} -> Maybe EntityStatus
status) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe EntityStatus
a -> GetDataSourceResponse
s {$sel:status:GetDataSourceResponse' :: Maybe EntityStatus
status = Maybe EntityStatus
a} :: GetDataSourceResponse)

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

instance Prelude.NFData GetDataSourceResponse where
  rnf :: GetDataSourceResponse -> ()
rnf GetDataSourceResponse' {Int
Maybe Bool
Maybe Integer
Maybe Text
Maybe POSIX
Maybe EntityStatus
Maybe RDSMetadata
Maybe RedshiftMetadata
httpStatus :: Int
status :: Maybe EntityStatus
startedAt :: Maybe POSIX
roleARN :: Maybe Text
redshiftMetadata :: Maybe RedshiftMetadata
rDSMetadata :: Maybe RDSMetadata
numberOfFiles :: Maybe Integer
name :: Maybe Text
message :: Maybe Text
logUri :: Maybe Text
lastUpdatedAt :: Maybe POSIX
finishedAt :: Maybe POSIX
dataSourceSchema :: Maybe Text
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:httpStatus:GetDataSourceResponse' :: GetDataSourceResponse -> Int
$sel:status:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe EntityStatus
$sel:startedAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
$sel:roleARN:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:redshiftMetadata:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe RedshiftMetadata
$sel:rDSMetadata:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe RDSMetadata
$sel:numberOfFiles:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Integer
$sel:name:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:message:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:logUri:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:lastUpdatedAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
$sel:finishedAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
$sel:dataSourceSchema:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:dataSourceId:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:dataSizeInBytes:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Integer
$sel:dataRearrangement:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:dataLocationS3:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:createdByIamUser:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Text
$sel:createdAt:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe POSIX
$sel:computeTime:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe Integer
$sel:computeStatistics:GetDataSourceResponse' :: GetDataSourceResponse -> 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 Text
dataSourceSchema
      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
logUri
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus