{-# 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.Forecast.CreateDatasetImportJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports your training data to an Amazon Forecast dataset. You provide
-- the location of your training data in an Amazon Simple Storage Service
-- (Amazon S3) bucket and the Amazon Resource Name (ARN) of the dataset
-- that you want to import the data to.
--
-- You must specify a
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_DataSource.html DataSource>
-- object that includes an AWS Identity and Access Management (IAM) role
-- that Amazon Forecast can assume to access the data, as Amazon Forecast
-- makes a copy of your data and processes it in an internal AWS system.
-- For more information, see
-- <https://docs.aws.amazon.com/forecast/latest/dg/aws-forecast-iam-roles.html Set up permissions>.
--
-- The training data must be in CSV or Parquet format. The delimiter must
-- be a comma (,).
--
-- You can specify the path to a specific file, the S3 bucket, or to a
-- folder in the S3 bucket. For the latter two cases, Amazon Forecast
-- imports all files up to the limit of 10,000 files.
--
-- Because dataset imports are not aggregated, your most recent dataset
-- import is the one that is used when training a predictor or generating a
-- forecast. Make sure that your most recent dataset import contains all of
-- the data you want to model off of, and not just the new data collected
-- since the previous import.
--
-- To get a list of all your dataset import jobs, filtered by specified
-- criteria, use the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_ListDatasetImportJobs.html ListDatasetImportJobs>
-- operation.
module Amazonka.Forecast.CreateDatasetImportJob
  ( -- * Creating a Request
    CreateDatasetImportJob (..),
    newCreateDatasetImportJob,

    -- * Request Lenses
    createDatasetImportJob_format,
    createDatasetImportJob_geolocationFormat,
    createDatasetImportJob_tags,
    createDatasetImportJob_timeZone,
    createDatasetImportJob_timestampFormat,
    createDatasetImportJob_useGeolocationForTimeZone,
    createDatasetImportJob_datasetImportJobName,
    createDatasetImportJob_datasetArn,
    createDatasetImportJob_dataSource,

    -- * Destructuring the Response
    CreateDatasetImportJobResponse (..),
    newCreateDatasetImportJobResponse,

    -- * Response Lenses
    createDatasetImportJobResponse_datasetImportJobArn,
    createDatasetImportJobResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Forecast.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateDatasetImportJob' smart constructor.
data CreateDatasetImportJob = CreateDatasetImportJob'
  { -- | The format of the imported data, CSV or PARQUET. The default value is
    -- CSV.
    CreateDatasetImportJob -> Maybe Text
format :: Prelude.Maybe Prelude.Text,
    -- | The format of the geolocation attribute. The geolocation attribute can
    -- be formatted in one of two ways:
    --
    -- -   @LAT_LONG@ - the latitude and longitude in decimal format (Example:
    --     47.61_-122.33).
    --
    -- -   @CC_POSTALCODE@ (US Only) - the country code (US), followed by the
    --     5-digit ZIP code (Example: US_98121).
    CreateDatasetImportJob -> Maybe Text
geolocationFormat :: Prelude.Maybe Prelude.Text,
    -- | The optional metadata that you apply to the dataset import job to help
    -- you categorize and organize them. Each tag consists of a key and an
    -- optional value, both of which you define.
    --
    -- The following basic restrictions apply to tags:
    --
    -- -   Maximum number of tags per resource - 50.
    --
    -- -   For each resource, each tag key must be unique, and each tag key can
    --     have only one value.
    --
    -- -   Maximum key length - 128 Unicode characters in UTF-8.
    --
    -- -   Maximum value length - 256 Unicode characters in UTF-8.
    --
    -- -   If your tagging schema is used across multiple services and
    --     resources, remember that other services may have restrictions on
    --     allowed characters. Generally allowed characters are: letters,
    --     numbers, and spaces representable in UTF-8, and the following
    --     characters: + - = . _ : \/ \@.
    --
    -- -   Tag keys and values are case sensitive.
    --
    -- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
    --     such as a prefix for keys as it is reserved for AWS use. You cannot
    --     edit or delete tag keys with this prefix. Values can have this
    --     prefix. If a tag value has @aws@ as its prefix but the key does not,
    --     then Forecast considers it to be a user tag and will count against
    --     the limit of 50 tags. Tags with only the key prefix of @aws@ do not
    --     count against your tags per resource limit.
    CreateDatasetImportJob -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A single time zone for every item in your dataset. This option is ideal
    -- for datasets with all timestamps within a single time zone, or if all
    -- timestamps are normalized to a single time zone.
    --
    -- Refer to the
    -- <http://joda-time.sourceforge.net/timezones.html Joda-Time API> for a
    -- complete list of valid time zone names.
    CreateDatasetImportJob -> Maybe Text
timeZone :: Prelude.Maybe Prelude.Text,
    -- | The format of timestamps in the dataset. The format that you specify
    -- depends on the @DataFrequency@ specified when the dataset was created.
    -- The following formats are supported
    --
    -- -   \"yyyy-MM-dd\"
    --
    --     For the following data frequencies: Y, M, W, and D
    --
    -- -   \"yyyy-MM-dd HH:mm:ss\"
    --
    --     For the following data frequencies: H, 30min, 15min, and 1min; and
    --     optionally, for: Y, M, W, and D
    --
    -- If the format isn\'t specified, Amazon Forecast expects the format to be
    -- \"yyyy-MM-dd HH:mm:ss\".
    CreateDatasetImportJob -> Maybe Text
timestampFormat :: Prelude.Maybe Prelude.Text,
    -- | Automatically derive time zone information from the geolocation
    -- attribute. This option is ideal for datasets that contain timestamps in
    -- multiple time zones and those timestamps are expressed in local time.
    CreateDatasetImportJob -> Maybe Bool
useGeolocationForTimeZone :: Prelude.Maybe Prelude.Bool,
    -- | The name for the dataset import job. We recommend including the current
    -- timestamp in the name, for example, @20190721DatasetImport@. This can
    -- help you avoid getting a @ResourceAlreadyExistsException@ exception.
    CreateDatasetImportJob -> Text
datasetImportJobName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Amazon Forecast dataset that you
    -- want to import data to.
    CreateDatasetImportJob -> Text
datasetArn :: Prelude.Text,
    -- | The location of the training data to import and an AWS Identity and
    -- Access Management (IAM) role that Amazon Forecast can assume to access
    -- the data. The training data must be stored in an Amazon S3 bucket.
    --
    -- If encryption is used, @DataSource@ must include an AWS Key Management
    -- Service (KMS) key and the IAM role must allow Amazon Forecast permission
    -- to access the key. The KMS key and IAM role must match those specified
    -- in the @EncryptionConfig@ parameter of the
    -- <https://docs.aws.amazon.com/forecast/latest/dg/API_CreateDataset.html CreateDataset>
    -- operation.
    CreateDatasetImportJob -> DataSource
dataSource :: DataSource
  }
  deriving (CreateDatasetImportJob -> CreateDatasetImportJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDatasetImportJob -> CreateDatasetImportJob -> Bool
$c/= :: CreateDatasetImportJob -> CreateDatasetImportJob -> Bool
== :: CreateDatasetImportJob -> CreateDatasetImportJob -> Bool
$c== :: CreateDatasetImportJob -> CreateDatasetImportJob -> Bool
Prelude.Eq, Int -> CreateDatasetImportJob -> ShowS
[CreateDatasetImportJob] -> ShowS
CreateDatasetImportJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDatasetImportJob] -> ShowS
$cshowList :: [CreateDatasetImportJob] -> ShowS
show :: CreateDatasetImportJob -> String
$cshow :: CreateDatasetImportJob -> String
showsPrec :: Int -> CreateDatasetImportJob -> ShowS
$cshowsPrec :: Int -> CreateDatasetImportJob -> ShowS
Prelude.Show, forall x. Rep CreateDatasetImportJob x -> CreateDatasetImportJob
forall x. CreateDatasetImportJob -> Rep CreateDatasetImportJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDatasetImportJob x -> CreateDatasetImportJob
$cfrom :: forall x. CreateDatasetImportJob -> Rep CreateDatasetImportJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateDatasetImportJob' 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:
--
-- 'format', 'createDatasetImportJob_format' - The format of the imported data, CSV or PARQUET. The default value is
-- CSV.
--
-- 'geolocationFormat', 'createDatasetImportJob_geolocationFormat' - The format of the geolocation attribute. The geolocation attribute can
-- be formatted in one of two ways:
--
-- -   @LAT_LONG@ - the latitude and longitude in decimal format (Example:
--     47.61_-122.33).
--
-- -   @CC_POSTALCODE@ (US Only) - the country code (US), followed by the
--     5-digit ZIP code (Example: US_98121).
--
-- 'tags', 'createDatasetImportJob_tags' - The optional metadata that you apply to the dataset import job to help
-- you categorize and organize them. Each tag consists of a key and an
-- optional value, both of which you define.
--
-- The following basic restrictions apply to tags:
--
-- -   Maximum number of tags per resource - 50.
--
-- -   For each resource, each tag key must be unique, and each tag key can
--     have only one value.
--
-- -   Maximum key length - 128 Unicode characters in UTF-8.
--
-- -   Maximum value length - 256 Unicode characters in UTF-8.
--
-- -   If your tagging schema is used across multiple services and
--     resources, remember that other services may have restrictions on
--     allowed characters. Generally allowed characters are: letters,
--     numbers, and spaces representable in UTF-8, and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Tag keys and values are case sensitive.
--
-- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
--     such as a prefix for keys as it is reserved for AWS use. You cannot
--     edit or delete tag keys with this prefix. Values can have this
--     prefix. If a tag value has @aws@ as its prefix but the key does not,
--     then Forecast considers it to be a user tag and will count against
--     the limit of 50 tags. Tags with only the key prefix of @aws@ do not
--     count against your tags per resource limit.
--
-- 'timeZone', 'createDatasetImportJob_timeZone' - A single time zone for every item in your dataset. This option is ideal
-- for datasets with all timestamps within a single time zone, or if all
-- timestamps are normalized to a single time zone.
--
-- Refer to the
-- <http://joda-time.sourceforge.net/timezones.html Joda-Time API> for a
-- complete list of valid time zone names.
--
-- 'timestampFormat', 'createDatasetImportJob_timestampFormat' - The format of timestamps in the dataset. The format that you specify
-- depends on the @DataFrequency@ specified when the dataset was created.
-- The following formats are supported
--
-- -   \"yyyy-MM-dd\"
--
--     For the following data frequencies: Y, M, W, and D
--
-- -   \"yyyy-MM-dd HH:mm:ss\"
--
--     For the following data frequencies: H, 30min, 15min, and 1min; and
--     optionally, for: Y, M, W, and D
--
-- If the format isn\'t specified, Amazon Forecast expects the format to be
-- \"yyyy-MM-dd HH:mm:ss\".
--
-- 'useGeolocationForTimeZone', 'createDatasetImportJob_useGeolocationForTimeZone' - Automatically derive time zone information from the geolocation
-- attribute. This option is ideal for datasets that contain timestamps in
-- multiple time zones and those timestamps are expressed in local time.
--
-- 'datasetImportJobName', 'createDatasetImportJob_datasetImportJobName' - The name for the dataset import job. We recommend including the current
-- timestamp in the name, for example, @20190721DatasetImport@. This can
-- help you avoid getting a @ResourceAlreadyExistsException@ exception.
--
-- 'datasetArn', 'createDatasetImportJob_datasetArn' - The Amazon Resource Name (ARN) of the Amazon Forecast dataset that you
-- want to import data to.
--
-- 'dataSource', 'createDatasetImportJob_dataSource' - The location of the training data to import and an AWS Identity and
-- Access Management (IAM) role that Amazon Forecast can assume to access
-- the data. The training data must be stored in an Amazon S3 bucket.
--
-- If encryption is used, @DataSource@ must include an AWS Key Management
-- Service (KMS) key and the IAM role must allow Amazon Forecast permission
-- to access the key. The KMS key and IAM role must match those specified
-- in the @EncryptionConfig@ parameter of the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_CreateDataset.html CreateDataset>
-- operation.
newCreateDatasetImportJob ::
  -- | 'datasetImportJobName'
  Prelude.Text ->
  -- | 'datasetArn'
  Prelude.Text ->
  -- | 'dataSource'
  DataSource ->
  CreateDatasetImportJob
newCreateDatasetImportJob :: Text -> Text -> DataSource -> CreateDatasetImportJob
newCreateDatasetImportJob
  Text
pDatasetImportJobName_
  Text
pDatasetArn_
  DataSource
pDataSource_ =
    CreateDatasetImportJob'
      { $sel:format:CreateDatasetImportJob' :: Maybe Text
format = forall a. Maybe a
Prelude.Nothing,
        $sel:geolocationFormat:CreateDatasetImportJob' :: Maybe Text
geolocationFormat = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDatasetImportJob' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:timeZone:CreateDatasetImportJob' :: Maybe Text
timeZone = forall a. Maybe a
Prelude.Nothing,
        $sel:timestampFormat:CreateDatasetImportJob' :: Maybe Text
timestampFormat = forall a. Maybe a
Prelude.Nothing,
        $sel:useGeolocationForTimeZone:CreateDatasetImportJob' :: Maybe Bool
useGeolocationForTimeZone = forall a. Maybe a
Prelude.Nothing,
        $sel:datasetImportJobName:CreateDatasetImportJob' :: Text
datasetImportJobName = Text
pDatasetImportJobName_,
        $sel:datasetArn:CreateDatasetImportJob' :: Text
datasetArn = Text
pDatasetArn_,
        $sel:dataSource:CreateDatasetImportJob' :: DataSource
dataSource = DataSource
pDataSource_
      }

-- | The format of the imported data, CSV or PARQUET. The default value is
-- CSV.
createDatasetImportJob_format :: Lens.Lens' CreateDatasetImportJob (Prelude.Maybe Prelude.Text)
createDatasetImportJob_format :: Lens' CreateDatasetImportJob (Maybe Text)
createDatasetImportJob_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Maybe Text
format :: Maybe Text
$sel:format:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
format} -> Maybe Text
format) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Maybe Text
a -> CreateDatasetImportJob
s {$sel:format:CreateDatasetImportJob' :: Maybe Text
format = Maybe Text
a} :: CreateDatasetImportJob)

-- | The format of the geolocation attribute. The geolocation attribute can
-- be formatted in one of two ways:
--
-- -   @LAT_LONG@ - the latitude and longitude in decimal format (Example:
--     47.61_-122.33).
--
-- -   @CC_POSTALCODE@ (US Only) - the country code (US), followed by the
--     5-digit ZIP code (Example: US_98121).
createDatasetImportJob_geolocationFormat :: Lens.Lens' CreateDatasetImportJob (Prelude.Maybe Prelude.Text)
createDatasetImportJob_geolocationFormat :: Lens' CreateDatasetImportJob (Maybe Text)
createDatasetImportJob_geolocationFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Maybe Text
geolocationFormat :: Maybe Text
$sel:geolocationFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
geolocationFormat} -> Maybe Text
geolocationFormat) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Maybe Text
a -> CreateDatasetImportJob
s {$sel:geolocationFormat:CreateDatasetImportJob' :: Maybe Text
geolocationFormat = Maybe Text
a} :: CreateDatasetImportJob)

-- | The optional metadata that you apply to the dataset import job to help
-- you categorize and organize them. Each tag consists of a key and an
-- optional value, both of which you define.
--
-- The following basic restrictions apply to tags:
--
-- -   Maximum number of tags per resource - 50.
--
-- -   For each resource, each tag key must be unique, and each tag key can
--     have only one value.
--
-- -   Maximum key length - 128 Unicode characters in UTF-8.
--
-- -   Maximum value length - 256 Unicode characters in UTF-8.
--
-- -   If your tagging schema is used across multiple services and
--     resources, remember that other services may have restrictions on
--     allowed characters. Generally allowed characters are: letters,
--     numbers, and spaces representable in UTF-8, and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Tag keys and values are case sensitive.
--
-- -   Do not use @aws:@, @AWS:@, or any upper or lowercase combination of
--     such as a prefix for keys as it is reserved for AWS use. You cannot
--     edit or delete tag keys with this prefix. Values can have this
--     prefix. If a tag value has @aws@ as its prefix but the key does not,
--     then Forecast considers it to be a user tag and will count against
--     the limit of 50 tags. Tags with only the key prefix of @aws@ do not
--     count against your tags per resource limit.
createDatasetImportJob_tags :: Lens.Lens' CreateDatasetImportJob (Prelude.Maybe [Tag])
createDatasetImportJob_tags :: Lens' CreateDatasetImportJob (Maybe [Tag])
createDatasetImportJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Maybe [Tag]
a -> CreateDatasetImportJob
s {$sel:tags:CreateDatasetImportJob' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDatasetImportJob) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A single time zone for every item in your dataset. This option is ideal
-- for datasets with all timestamps within a single time zone, or if all
-- timestamps are normalized to a single time zone.
--
-- Refer to the
-- <http://joda-time.sourceforge.net/timezones.html Joda-Time API> for a
-- complete list of valid time zone names.
createDatasetImportJob_timeZone :: Lens.Lens' CreateDatasetImportJob (Prelude.Maybe Prelude.Text)
createDatasetImportJob_timeZone :: Lens' CreateDatasetImportJob (Maybe Text)
createDatasetImportJob_timeZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Maybe Text
timeZone :: Maybe Text
$sel:timeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
timeZone} -> Maybe Text
timeZone) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Maybe Text
a -> CreateDatasetImportJob
s {$sel:timeZone:CreateDatasetImportJob' :: Maybe Text
timeZone = Maybe Text
a} :: CreateDatasetImportJob)

-- | The format of timestamps in the dataset. The format that you specify
-- depends on the @DataFrequency@ specified when the dataset was created.
-- The following formats are supported
--
-- -   \"yyyy-MM-dd\"
--
--     For the following data frequencies: Y, M, W, and D
--
-- -   \"yyyy-MM-dd HH:mm:ss\"
--
--     For the following data frequencies: H, 30min, 15min, and 1min; and
--     optionally, for: Y, M, W, and D
--
-- If the format isn\'t specified, Amazon Forecast expects the format to be
-- \"yyyy-MM-dd HH:mm:ss\".
createDatasetImportJob_timestampFormat :: Lens.Lens' CreateDatasetImportJob (Prelude.Maybe Prelude.Text)
createDatasetImportJob_timestampFormat :: Lens' CreateDatasetImportJob (Maybe Text)
createDatasetImportJob_timestampFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Maybe Text
timestampFormat :: Maybe Text
$sel:timestampFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
timestampFormat} -> Maybe Text
timestampFormat) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Maybe Text
a -> CreateDatasetImportJob
s {$sel:timestampFormat:CreateDatasetImportJob' :: Maybe Text
timestampFormat = Maybe Text
a} :: CreateDatasetImportJob)

-- | Automatically derive time zone information from the geolocation
-- attribute. This option is ideal for datasets that contain timestamps in
-- multiple time zones and those timestamps are expressed in local time.
createDatasetImportJob_useGeolocationForTimeZone :: Lens.Lens' CreateDatasetImportJob (Prelude.Maybe Prelude.Bool)
createDatasetImportJob_useGeolocationForTimeZone :: Lens' CreateDatasetImportJob (Maybe Bool)
createDatasetImportJob_useGeolocationForTimeZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Maybe Bool
useGeolocationForTimeZone :: Maybe Bool
$sel:useGeolocationForTimeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Bool
useGeolocationForTimeZone} -> Maybe Bool
useGeolocationForTimeZone) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Maybe Bool
a -> CreateDatasetImportJob
s {$sel:useGeolocationForTimeZone:CreateDatasetImportJob' :: Maybe Bool
useGeolocationForTimeZone = Maybe Bool
a} :: CreateDatasetImportJob)

-- | The name for the dataset import job. We recommend including the current
-- timestamp in the name, for example, @20190721DatasetImport@. This can
-- help you avoid getting a @ResourceAlreadyExistsException@ exception.
createDatasetImportJob_datasetImportJobName :: Lens.Lens' CreateDatasetImportJob Prelude.Text
createDatasetImportJob_datasetImportJobName :: Lens' CreateDatasetImportJob Text
createDatasetImportJob_datasetImportJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Text
datasetImportJobName :: Text
$sel:datasetImportJobName:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
datasetImportJobName} -> Text
datasetImportJobName) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Text
a -> CreateDatasetImportJob
s {$sel:datasetImportJobName:CreateDatasetImportJob' :: Text
datasetImportJobName = Text
a} :: CreateDatasetImportJob)

-- | The Amazon Resource Name (ARN) of the Amazon Forecast dataset that you
-- want to import data to.
createDatasetImportJob_datasetArn :: Lens.Lens' CreateDatasetImportJob Prelude.Text
createDatasetImportJob_datasetArn :: Lens' CreateDatasetImportJob Text
createDatasetImportJob_datasetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {Text
datasetArn :: Text
$sel:datasetArn:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
datasetArn} -> Text
datasetArn) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} Text
a -> CreateDatasetImportJob
s {$sel:datasetArn:CreateDatasetImportJob' :: Text
datasetArn = Text
a} :: CreateDatasetImportJob)

-- | The location of the training data to import and an AWS Identity and
-- Access Management (IAM) role that Amazon Forecast can assume to access
-- the data. The training data must be stored in an Amazon S3 bucket.
--
-- If encryption is used, @DataSource@ must include an AWS Key Management
-- Service (KMS) key and the IAM role must allow Amazon Forecast permission
-- to access the key. The KMS key and IAM role must match those specified
-- in the @EncryptionConfig@ parameter of the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_CreateDataset.html CreateDataset>
-- operation.
createDatasetImportJob_dataSource :: Lens.Lens' CreateDatasetImportJob DataSource
createDatasetImportJob_dataSource :: Lens' CreateDatasetImportJob DataSource
createDatasetImportJob_dataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJob' {DataSource
dataSource :: DataSource
$sel:dataSource:CreateDatasetImportJob' :: CreateDatasetImportJob -> DataSource
dataSource} -> DataSource
dataSource) (\s :: CreateDatasetImportJob
s@CreateDatasetImportJob' {} DataSource
a -> CreateDatasetImportJob
s {$sel:dataSource:CreateDatasetImportJob' :: DataSource
dataSource = DataSource
a} :: CreateDatasetImportJob)

instance Core.AWSRequest CreateDatasetImportJob where
  type
    AWSResponse CreateDatasetImportJob =
      CreateDatasetImportJobResponse
  request :: (Service -> Service)
-> CreateDatasetImportJob -> Request CreateDatasetImportJob
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 CreateDatasetImportJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDatasetImportJob)))
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 -> CreateDatasetImportJobResponse
CreateDatasetImportJobResponse'
            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
"DatasetImportJobArn")
            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 CreateDatasetImportJob where
  hashWithSalt :: Int -> CreateDatasetImportJob -> Int
hashWithSalt Int
_salt CreateDatasetImportJob' {Maybe Bool
Maybe [Tag]
Maybe Text
Text
DataSource
dataSource :: DataSource
datasetArn :: Text
datasetImportJobName :: Text
useGeolocationForTimeZone :: Maybe Bool
timestampFormat :: Maybe Text
timeZone :: Maybe Text
tags :: Maybe [Tag]
geolocationFormat :: Maybe Text
format :: Maybe Text
$sel:dataSource:CreateDatasetImportJob' :: CreateDatasetImportJob -> DataSource
$sel:datasetArn:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
$sel:datasetImportJobName:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
$sel:useGeolocationForTimeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Bool
$sel:timestampFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:timeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:tags:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe [Tag]
$sel:geolocationFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:format:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
format
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
geolocationFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timeZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timestampFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useGeolocationForTimeZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetImportJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataSource
dataSource

instance Prelude.NFData CreateDatasetImportJob where
  rnf :: CreateDatasetImportJob -> ()
rnf CreateDatasetImportJob' {Maybe Bool
Maybe [Tag]
Maybe Text
Text
DataSource
dataSource :: DataSource
datasetArn :: Text
datasetImportJobName :: Text
useGeolocationForTimeZone :: Maybe Bool
timestampFormat :: Maybe Text
timeZone :: Maybe Text
tags :: Maybe [Tag]
geolocationFormat :: Maybe Text
format :: Maybe Text
$sel:dataSource:CreateDatasetImportJob' :: CreateDatasetImportJob -> DataSource
$sel:datasetArn:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
$sel:datasetImportJobName:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
$sel:useGeolocationForTimeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Bool
$sel:timestampFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:timeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:tags:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe [Tag]
$sel:geolocationFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:format:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
format
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
geolocationFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timeZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timestampFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
useGeolocationForTimeZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetImportJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DataSource
dataSource

instance Data.ToHeaders CreateDatasetImportJob where
  toHeaders :: CreateDatasetImportJob -> 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
"AmazonForecast.CreateDatasetImportJob" ::
                          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 CreateDatasetImportJob where
  toJSON :: CreateDatasetImportJob -> Value
toJSON CreateDatasetImportJob' {Maybe Bool
Maybe [Tag]
Maybe Text
Text
DataSource
dataSource :: DataSource
datasetArn :: Text
datasetImportJobName :: Text
useGeolocationForTimeZone :: Maybe Bool
timestampFormat :: Maybe Text
timeZone :: Maybe Text
tags :: Maybe [Tag]
geolocationFormat :: Maybe Text
format :: Maybe Text
$sel:dataSource:CreateDatasetImportJob' :: CreateDatasetImportJob -> DataSource
$sel:datasetArn:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
$sel:datasetImportJobName:CreateDatasetImportJob' :: CreateDatasetImportJob -> Text
$sel:useGeolocationForTimeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Bool
$sel:timestampFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:timeZone:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:tags:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe [Tag]
$sel:geolocationFormat:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
$sel:format:CreateDatasetImportJob' :: CreateDatasetImportJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Format" 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
format,
            (Key
"GeolocationFormat" 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
geolocationFormat,
            (Key
"Tags" 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 [Tag]
tags,
            (Key
"TimeZone" 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
timeZone,
            (Key
"TimestampFormat" 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
timestampFormat,
            (Key
"UseGeolocationForTimeZone" 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
useGeolocationForTimeZone,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DatasetImportJobName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
datasetImportJobName
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"DatasetArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
datasetArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"DataSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataSource
dataSource)
          ]
      )

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

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

-- | /See:/ 'newCreateDatasetImportJobResponse' smart constructor.
data CreateDatasetImportJobResponse = CreateDatasetImportJobResponse'
  { -- | The Amazon Resource Name (ARN) of the dataset import job.
    CreateDatasetImportJobResponse -> Maybe Text
datasetImportJobArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDatasetImportJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDatasetImportJobResponse
-> CreateDatasetImportJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDatasetImportJobResponse
-> CreateDatasetImportJobResponse -> Bool
$c/= :: CreateDatasetImportJobResponse
-> CreateDatasetImportJobResponse -> Bool
== :: CreateDatasetImportJobResponse
-> CreateDatasetImportJobResponse -> Bool
$c== :: CreateDatasetImportJobResponse
-> CreateDatasetImportJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateDatasetImportJobResponse]
ReadPrec CreateDatasetImportJobResponse
Int -> ReadS CreateDatasetImportJobResponse
ReadS [CreateDatasetImportJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDatasetImportJobResponse]
$creadListPrec :: ReadPrec [CreateDatasetImportJobResponse]
readPrec :: ReadPrec CreateDatasetImportJobResponse
$creadPrec :: ReadPrec CreateDatasetImportJobResponse
readList :: ReadS [CreateDatasetImportJobResponse]
$creadList :: ReadS [CreateDatasetImportJobResponse]
readsPrec :: Int -> ReadS CreateDatasetImportJobResponse
$creadsPrec :: Int -> ReadS CreateDatasetImportJobResponse
Prelude.Read, Int -> CreateDatasetImportJobResponse -> ShowS
[CreateDatasetImportJobResponse] -> ShowS
CreateDatasetImportJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDatasetImportJobResponse] -> ShowS
$cshowList :: [CreateDatasetImportJobResponse] -> ShowS
show :: CreateDatasetImportJobResponse -> String
$cshow :: CreateDatasetImportJobResponse -> String
showsPrec :: Int -> CreateDatasetImportJobResponse -> ShowS
$cshowsPrec :: Int -> CreateDatasetImportJobResponse -> ShowS
Prelude.Show, forall x.
Rep CreateDatasetImportJobResponse x
-> CreateDatasetImportJobResponse
forall x.
CreateDatasetImportJobResponse
-> Rep CreateDatasetImportJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateDatasetImportJobResponse x
-> CreateDatasetImportJobResponse
$cfrom :: forall x.
CreateDatasetImportJobResponse
-> Rep CreateDatasetImportJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDatasetImportJobResponse' 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:
--
-- 'datasetImportJobArn', 'createDatasetImportJobResponse_datasetImportJobArn' - The Amazon Resource Name (ARN) of the dataset import job.
--
-- 'httpStatus', 'createDatasetImportJobResponse_httpStatus' - The response's http status code.
newCreateDatasetImportJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDatasetImportJobResponse
newCreateDatasetImportJobResponse :: Int -> CreateDatasetImportJobResponse
newCreateDatasetImportJobResponse Int
pHttpStatus_ =
  CreateDatasetImportJobResponse'
    { $sel:datasetImportJobArn:CreateDatasetImportJobResponse' :: Maybe Text
datasetImportJobArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDatasetImportJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the dataset import job.
createDatasetImportJobResponse_datasetImportJobArn :: Lens.Lens' CreateDatasetImportJobResponse (Prelude.Maybe Prelude.Text)
createDatasetImportJobResponse_datasetImportJobArn :: Lens' CreateDatasetImportJobResponse (Maybe Text)
createDatasetImportJobResponse_datasetImportJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetImportJobResponse' {Maybe Text
datasetImportJobArn :: Maybe Text
$sel:datasetImportJobArn:CreateDatasetImportJobResponse' :: CreateDatasetImportJobResponse -> Maybe Text
datasetImportJobArn} -> Maybe Text
datasetImportJobArn) (\s :: CreateDatasetImportJobResponse
s@CreateDatasetImportJobResponse' {} Maybe Text
a -> CreateDatasetImportJobResponse
s {$sel:datasetImportJobArn:CreateDatasetImportJobResponse' :: Maybe Text
datasetImportJobArn = Maybe Text
a} :: CreateDatasetImportJobResponse)

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

instance
  Prelude.NFData
    CreateDatasetImportJobResponse
  where
  rnf :: CreateDatasetImportJobResponse -> ()
rnf CreateDatasetImportJobResponse' {Int
Maybe Text
httpStatus :: Int
datasetImportJobArn :: Maybe Text
$sel:httpStatus:CreateDatasetImportJobResponse' :: CreateDatasetImportJobResponse -> Int
$sel:datasetImportJobArn:CreateDatasetImportJobResponse' :: CreateDatasetImportJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
datasetImportJobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus