{-# 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.CreateDataSourceFromS3
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a @DataSource@ object. A @DataSource@ references data that can
-- be used to perform @CreateMLModel@, @CreateEvaluation@, or
-- @CreateBatchPrediction@ operations.
--
-- @CreateDataSourceFromS3@ is an asynchronous operation. In response to
-- @CreateDataSourceFromS3@, Amazon Machine Learning (Amazon ML)
-- immediately returns and sets the @DataSource@ status to @PENDING@. After
-- the @DataSource@ has been created and is ready for use, Amazon ML sets
-- the @Status@ parameter to @COMPLETED@. @DataSource@ in the @COMPLETED@
-- or @PENDING@ state can be used to perform only @CreateMLModel@,
-- @CreateEvaluation@ or @CreateBatchPrediction@ operations.
--
-- If Amazon ML can\'t accept the input source, it sets the @Status@
-- parameter to @FAILED@ and includes an error message in the @Message@
-- attribute of the @GetDataSource@ operation response.
--
-- The observation data used in a @DataSource@ should be ready to use; that
-- is, it should have a consistent structure, and missing data values
-- should be kept to a minimum. The observation data must reside in one or
-- more .csv files in an Amazon Simple Storage Service (Amazon S3)
-- location, along with a schema that describes the data items by name and
-- type. The same schema must be used for all of the data files referenced
-- by the @DataSource@.
--
-- After the @DataSource@ has been created, it\'s ready to use in
-- evaluations and batch predictions. If you plan to use the @DataSource@
-- to train an @MLModel@, the @DataSource@ also needs a recipe. A recipe
-- describes how each input variable will be used in training an @MLModel@.
-- Will the variable be included or excluded from training? Will the
-- variable be manipulated; for example, will it be combined with another
-- variable or will it be split apart into word combinations? The recipe
-- provides answers to these questions.
module Amazonka.MachineLearning.CreateDataSourceFromS3
  ( -- * Creating a Request
    CreateDataSourceFromS3 (..),
    newCreateDataSourceFromS3,

    -- * Request Lenses
    createDataSourceFromS3_computeStatistics,
    createDataSourceFromS3_dataSourceName,
    createDataSourceFromS3_dataSourceId,
    createDataSourceFromS3_dataSpec,

    -- * Destructuring the Response
    CreateDataSourceFromS3Response (..),
    newCreateDataSourceFromS3Response,

    -- * Response Lenses
    createDataSourceFromS3Response_dataSourceId,
    createDataSourceFromS3Response_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:/ 'newCreateDataSourceFromS3' smart constructor.
data CreateDataSourceFromS3 = CreateDataSourceFromS3'
  { -- | The compute statistics for a @DataSource@. The statistics are generated
    -- from the observation data referenced by a @DataSource@. Amazon ML uses
    -- the statistics internally during @MLModel@ training. This parameter must
    -- be set to @true@ if the DataSource needs to be used for @MLModel@
    -- training.
    CreateDataSourceFromS3 -> Maybe Bool
computeStatistics :: Prelude.Maybe Prelude.Bool,
    -- | A user-supplied name or description of the @DataSource@.
    CreateDataSourceFromS3 -> Maybe Text
dataSourceName :: Prelude.Maybe Prelude.Text,
    -- | A user-supplied identifier that uniquely identifies the @DataSource@.
    CreateDataSourceFromS3 -> Text
dataSourceId :: Prelude.Text,
    -- | The data specification of a @DataSource@:
    --
    -- -   DataLocationS3 - The Amazon S3 location of the observation data.
    --
    -- -   DataSchemaLocationS3 - The Amazon S3 location of the @DataSchema@.
    --
    -- -   DataSchema - A JSON string representing the schema. This is not
    --     required if @DataSchemaUri@ is specified.
    --
    -- -   DataRearrangement - A JSON string that represents the splitting and
    --     rearrangement requirements for the @Datasource@.
    --
    --     Sample -
    --     @ \"{\\\"splitting\\\":{\\\"percentBegin\\\":10,\\\"percentEnd\\\":60}}\"@
    CreateDataSourceFromS3 -> S3DataSpec
dataSpec :: S3DataSpec
  }
  deriving (CreateDataSourceFromS3 -> CreateDataSourceFromS3 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataSourceFromS3 -> CreateDataSourceFromS3 -> Bool
$c/= :: CreateDataSourceFromS3 -> CreateDataSourceFromS3 -> Bool
== :: CreateDataSourceFromS3 -> CreateDataSourceFromS3 -> Bool
$c== :: CreateDataSourceFromS3 -> CreateDataSourceFromS3 -> Bool
Prelude.Eq, ReadPrec [CreateDataSourceFromS3]
ReadPrec CreateDataSourceFromS3
Int -> ReadS CreateDataSourceFromS3
ReadS [CreateDataSourceFromS3]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataSourceFromS3]
$creadListPrec :: ReadPrec [CreateDataSourceFromS3]
readPrec :: ReadPrec CreateDataSourceFromS3
$creadPrec :: ReadPrec CreateDataSourceFromS3
readList :: ReadS [CreateDataSourceFromS3]
$creadList :: ReadS [CreateDataSourceFromS3]
readsPrec :: Int -> ReadS CreateDataSourceFromS3
$creadsPrec :: Int -> ReadS CreateDataSourceFromS3
Prelude.Read, Int -> CreateDataSourceFromS3 -> ShowS
[CreateDataSourceFromS3] -> ShowS
CreateDataSourceFromS3 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataSourceFromS3] -> ShowS
$cshowList :: [CreateDataSourceFromS3] -> ShowS
show :: CreateDataSourceFromS3 -> String
$cshow :: CreateDataSourceFromS3 -> String
showsPrec :: Int -> CreateDataSourceFromS3 -> ShowS
$cshowsPrec :: Int -> CreateDataSourceFromS3 -> ShowS
Prelude.Show, forall x. Rep CreateDataSourceFromS3 x -> CreateDataSourceFromS3
forall x. CreateDataSourceFromS3 -> Rep CreateDataSourceFromS3 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDataSourceFromS3 x -> CreateDataSourceFromS3
$cfrom :: forall x. CreateDataSourceFromS3 -> Rep CreateDataSourceFromS3 x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataSourceFromS3' 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', 'createDataSourceFromS3_computeStatistics' - The compute statistics for a @DataSource@. The statistics are generated
-- from the observation data referenced by a @DataSource@. Amazon ML uses
-- the statistics internally during @MLModel@ training. This parameter must
-- be set to @true@ if the DataSource needs to be used for @MLModel@
-- training.
--
-- 'dataSourceName', 'createDataSourceFromS3_dataSourceName' - A user-supplied name or description of the @DataSource@.
--
-- 'dataSourceId', 'createDataSourceFromS3_dataSourceId' - A user-supplied identifier that uniquely identifies the @DataSource@.
--
-- 'dataSpec', 'createDataSourceFromS3_dataSpec' - The data specification of a @DataSource@:
--
-- -   DataLocationS3 - The Amazon S3 location of the observation data.
--
-- -   DataSchemaLocationS3 - The Amazon S3 location of the @DataSchema@.
--
-- -   DataSchema - A JSON string representing the schema. This is not
--     required if @DataSchemaUri@ is specified.
--
-- -   DataRearrangement - A JSON string that represents the splitting and
--     rearrangement requirements for the @Datasource@.
--
--     Sample -
--     @ \"{\\\"splitting\\\":{\\\"percentBegin\\\":10,\\\"percentEnd\\\":60}}\"@
newCreateDataSourceFromS3 ::
  -- | 'dataSourceId'
  Prelude.Text ->
  -- | 'dataSpec'
  S3DataSpec ->
  CreateDataSourceFromS3
newCreateDataSourceFromS3 :: Text -> S3DataSpec -> CreateDataSourceFromS3
newCreateDataSourceFromS3 Text
pDataSourceId_ S3DataSpec
pDataSpec_ =
  CreateDataSourceFromS3'
    { $sel:computeStatistics:CreateDataSourceFromS3' :: Maybe Bool
computeStatistics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dataSourceName:CreateDataSourceFromS3' :: Maybe Text
dataSourceName = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSourceId:CreateDataSourceFromS3' :: Text
dataSourceId = Text
pDataSourceId_,
      $sel:dataSpec:CreateDataSourceFromS3' :: S3DataSpec
dataSpec = S3DataSpec
pDataSpec_
    }

-- | The compute statistics for a @DataSource@. The statistics are generated
-- from the observation data referenced by a @DataSource@. Amazon ML uses
-- the statistics internally during @MLModel@ training. This parameter must
-- be set to @true@ if the DataSource needs to be used for @MLModel@
-- training.
createDataSourceFromS3_computeStatistics :: Lens.Lens' CreateDataSourceFromS3 (Prelude.Maybe Prelude.Bool)
createDataSourceFromS3_computeStatistics :: Lens' CreateDataSourceFromS3 (Maybe Bool)
createDataSourceFromS3_computeStatistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataSourceFromS3' {Maybe Bool
computeStatistics :: Maybe Bool
$sel:computeStatistics:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Maybe Bool
computeStatistics} -> Maybe Bool
computeStatistics) (\s :: CreateDataSourceFromS3
s@CreateDataSourceFromS3' {} Maybe Bool
a -> CreateDataSourceFromS3
s {$sel:computeStatistics:CreateDataSourceFromS3' :: Maybe Bool
computeStatistics = Maybe Bool
a} :: CreateDataSourceFromS3)

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

-- | A user-supplied identifier that uniquely identifies the @DataSource@.
createDataSourceFromS3_dataSourceId :: Lens.Lens' CreateDataSourceFromS3 Prelude.Text
createDataSourceFromS3_dataSourceId :: Lens' CreateDataSourceFromS3 Text
createDataSourceFromS3_dataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataSourceFromS3' {Text
dataSourceId :: Text
$sel:dataSourceId:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Text
dataSourceId} -> Text
dataSourceId) (\s :: CreateDataSourceFromS3
s@CreateDataSourceFromS3' {} Text
a -> CreateDataSourceFromS3
s {$sel:dataSourceId:CreateDataSourceFromS3' :: Text
dataSourceId = Text
a} :: CreateDataSourceFromS3)

-- | The data specification of a @DataSource@:
--
-- -   DataLocationS3 - The Amazon S3 location of the observation data.
--
-- -   DataSchemaLocationS3 - The Amazon S3 location of the @DataSchema@.
--
-- -   DataSchema - A JSON string representing the schema. This is not
--     required if @DataSchemaUri@ is specified.
--
-- -   DataRearrangement - A JSON string that represents the splitting and
--     rearrangement requirements for the @Datasource@.
--
--     Sample -
--     @ \"{\\\"splitting\\\":{\\\"percentBegin\\\":10,\\\"percentEnd\\\":60}}\"@
createDataSourceFromS3_dataSpec :: Lens.Lens' CreateDataSourceFromS3 S3DataSpec
createDataSourceFromS3_dataSpec :: Lens' CreateDataSourceFromS3 S3DataSpec
createDataSourceFromS3_dataSpec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataSourceFromS3' {S3DataSpec
dataSpec :: S3DataSpec
$sel:dataSpec:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> S3DataSpec
dataSpec} -> S3DataSpec
dataSpec) (\s :: CreateDataSourceFromS3
s@CreateDataSourceFromS3' {} S3DataSpec
a -> CreateDataSourceFromS3
s {$sel:dataSpec:CreateDataSourceFromS3' :: S3DataSpec
dataSpec = S3DataSpec
a} :: CreateDataSourceFromS3)

instance Core.AWSRequest CreateDataSourceFromS3 where
  type
    AWSResponse CreateDataSourceFromS3 =
      CreateDataSourceFromS3Response
  request :: (Service -> Service)
-> CreateDataSourceFromS3 -> Request CreateDataSourceFromS3
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 CreateDataSourceFromS3
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDataSourceFromS3)))
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 Text -> Int -> CreateDataSourceFromS3Response
CreateDataSourceFromS3Response'
            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
"DataSourceId")
            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 CreateDataSourceFromS3 where
  hashWithSalt :: Int -> CreateDataSourceFromS3 -> Int
hashWithSalt Int
_salt CreateDataSourceFromS3' {Maybe Bool
Maybe Text
Text
S3DataSpec
dataSpec :: S3DataSpec
dataSourceId :: Text
dataSourceName :: Maybe Text
computeStatistics :: Maybe Bool
$sel:dataSpec:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> S3DataSpec
$sel:dataSourceId:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Text
$sel:dataSourceName:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Maybe Text
$sel:computeStatistics:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> 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 Text
dataSourceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataSourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3DataSpec
dataSpec

instance Prelude.NFData CreateDataSourceFromS3 where
  rnf :: CreateDataSourceFromS3 -> ()
rnf CreateDataSourceFromS3' {Maybe Bool
Maybe Text
Text
S3DataSpec
dataSpec :: S3DataSpec
dataSourceId :: Text
dataSourceName :: Maybe Text
computeStatistics :: Maybe Bool
$sel:dataSpec:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> S3DataSpec
$sel:dataSourceId:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Text
$sel:dataSourceName:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Maybe Text
$sel:computeStatistics:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> 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 Text
dataSourceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dataSourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3DataSpec
dataSpec

instance Data.ToHeaders CreateDataSourceFromS3 where
  toHeaders :: CreateDataSourceFromS3 -> 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.CreateDataSourceFromS3" ::
                          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 CreateDataSourceFromS3 where
  toJSON :: CreateDataSourceFromS3 -> Value
toJSON CreateDataSourceFromS3' {Maybe Bool
Maybe Text
Text
S3DataSpec
dataSpec :: S3DataSpec
dataSourceId :: Text
dataSourceName :: Maybe Text
computeStatistics :: Maybe Bool
$sel:dataSpec:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> S3DataSpec
$sel:dataSourceId:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Text
$sel:dataSourceName:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Maybe Text
$sel:computeStatistics:CreateDataSourceFromS3' :: CreateDataSourceFromS3 -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ComputeStatistics" 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
computeStatistics,
            (Key
"DataSourceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
dataSourceName,
            forall a. a -> Maybe a
Prelude.Just (Key
"DataSourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataSourceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"DataSpec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3DataSpec
dataSpec)
          ]
      )

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

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

-- | Represents the output of a @CreateDataSourceFromS3@ operation, and is an
-- acknowledgement that Amazon ML received the request.
--
-- The @CreateDataSourceFromS3@ operation is asynchronous. You can poll for
-- updates by using the @GetBatchPrediction@ operation and checking the
-- @Status@ parameter.
--
-- /See:/ 'newCreateDataSourceFromS3Response' smart constructor.
data CreateDataSourceFromS3Response = CreateDataSourceFromS3Response'
  { -- | A user-supplied ID that uniquely identifies the @DataSource@. This value
    -- should be identical to the value of the @DataSourceID@ in the request.
    CreateDataSourceFromS3Response -> Maybe Text
dataSourceId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDataSourceFromS3Response -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDataSourceFromS3Response
-> CreateDataSourceFromS3Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataSourceFromS3Response
-> CreateDataSourceFromS3Response -> Bool
$c/= :: CreateDataSourceFromS3Response
-> CreateDataSourceFromS3Response -> Bool
== :: CreateDataSourceFromS3Response
-> CreateDataSourceFromS3Response -> Bool
$c== :: CreateDataSourceFromS3Response
-> CreateDataSourceFromS3Response -> Bool
Prelude.Eq, ReadPrec [CreateDataSourceFromS3Response]
ReadPrec CreateDataSourceFromS3Response
Int -> ReadS CreateDataSourceFromS3Response
ReadS [CreateDataSourceFromS3Response]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataSourceFromS3Response]
$creadListPrec :: ReadPrec [CreateDataSourceFromS3Response]
readPrec :: ReadPrec CreateDataSourceFromS3Response
$creadPrec :: ReadPrec CreateDataSourceFromS3Response
readList :: ReadS [CreateDataSourceFromS3Response]
$creadList :: ReadS [CreateDataSourceFromS3Response]
readsPrec :: Int -> ReadS CreateDataSourceFromS3Response
$creadsPrec :: Int -> ReadS CreateDataSourceFromS3Response
Prelude.Read, Int -> CreateDataSourceFromS3Response -> ShowS
[CreateDataSourceFromS3Response] -> ShowS
CreateDataSourceFromS3Response -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataSourceFromS3Response] -> ShowS
$cshowList :: [CreateDataSourceFromS3Response] -> ShowS
show :: CreateDataSourceFromS3Response -> String
$cshow :: CreateDataSourceFromS3Response -> String
showsPrec :: Int -> CreateDataSourceFromS3Response -> ShowS
$cshowsPrec :: Int -> CreateDataSourceFromS3Response -> ShowS
Prelude.Show, forall x.
Rep CreateDataSourceFromS3Response x
-> CreateDataSourceFromS3Response
forall x.
CreateDataSourceFromS3Response
-> Rep CreateDataSourceFromS3Response x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDataSourceFromS3Response x
-> CreateDataSourceFromS3Response
$cfrom :: forall x.
CreateDataSourceFromS3Response
-> Rep CreateDataSourceFromS3Response x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataSourceFromS3Response' 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:
--
-- 'dataSourceId', 'createDataSourceFromS3Response_dataSourceId' - A user-supplied ID that uniquely identifies the @DataSource@. This value
-- should be identical to the value of the @DataSourceID@ in the request.
--
-- 'httpStatus', 'createDataSourceFromS3Response_httpStatus' - The response's http status code.
newCreateDataSourceFromS3Response ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDataSourceFromS3Response
newCreateDataSourceFromS3Response :: Int -> CreateDataSourceFromS3Response
newCreateDataSourceFromS3Response Int
pHttpStatus_ =
  CreateDataSourceFromS3Response'
    { $sel:dataSourceId:CreateDataSourceFromS3Response' :: Maybe Text
dataSourceId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDataSourceFromS3Response' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A user-supplied ID that uniquely identifies the @DataSource@. This value
-- should be identical to the value of the @DataSourceID@ in the request.
createDataSourceFromS3Response_dataSourceId :: Lens.Lens' CreateDataSourceFromS3Response (Prelude.Maybe Prelude.Text)
createDataSourceFromS3Response_dataSourceId :: Lens' CreateDataSourceFromS3Response (Maybe Text)
createDataSourceFromS3Response_dataSourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataSourceFromS3Response' {Maybe Text
dataSourceId :: Maybe Text
$sel:dataSourceId:CreateDataSourceFromS3Response' :: CreateDataSourceFromS3Response -> Maybe Text
dataSourceId} -> Maybe Text
dataSourceId) (\s :: CreateDataSourceFromS3Response
s@CreateDataSourceFromS3Response' {} Maybe Text
a -> CreateDataSourceFromS3Response
s {$sel:dataSourceId:CreateDataSourceFromS3Response' :: Maybe Text
dataSourceId = Maybe Text
a} :: CreateDataSourceFromS3Response)

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

instance
  Prelude.NFData
    CreateDataSourceFromS3Response
  where
  rnf :: CreateDataSourceFromS3Response -> ()
rnf CreateDataSourceFromS3Response' {Int
Maybe Text
httpStatus :: Int
dataSourceId :: Maybe Text
$sel:httpStatus:CreateDataSourceFromS3Response' :: CreateDataSourceFromS3Response -> Int
$sel:dataSourceId:CreateDataSourceFromS3Response' :: CreateDataSourceFromS3Response -> Maybe Text
..} =
    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 Int
httpStatus