{-# 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.CreateDatasetGroup
-- 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 dataset group, which holds a collection of related datasets.
-- You can add datasets to the dataset group when you create the dataset
-- group, or later by using the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_UpdateDatasetGroup.html UpdateDatasetGroup>
-- operation.
--
-- After creating a dataset group and adding datasets, you use the dataset
-- group when you create a predictor. For more information, see
-- <https://docs.aws.amazon.com/forecast/latest/dg/howitworks-datasets-groups.html Dataset groups>.
--
-- To get a list of all your datasets groups, use the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_ListDatasetGroups.html ListDatasetGroups>
-- operation.
--
-- The @Status@ of a dataset group must be @ACTIVE@ before you can use the
-- dataset group to create a predictor. To get the status, use the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_DescribeDatasetGroup.html DescribeDatasetGroup>
-- operation.
module Amazonka.Forecast.CreateDatasetGroup
  ( -- * Creating a Request
    CreateDatasetGroup (..),
    newCreateDatasetGroup,

    -- * Request Lenses
    createDatasetGroup_datasetArns,
    createDatasetGroup_tags,
    createDatasetGroup_datasetGroupName,
    createDatasetGroup_domain,

    -- * Destructuring the Response
    CreateDatasetGroupResponse (..),
    newCreateDatasetGroupResponse,

    -- * Response Lenses
    createDatasetGroupResponse_datasetGroupArn,
    createDatasetGroupResponse_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:/ 'newCreateDatasetGroup' smart constructor.
data CreateDatasetGroup = CreateDatasetGroup'
  { -- | An array of Amazon Resource Names (ARNs) of the datasets that you want
    -- to include in the dataset group.
    CreateDatasetGroup -> Maybe [Text]
datasetArns :: Prelude.Maybe [Prelude.Text],
    -- | The optional metadata that you apply to the dataset group 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.
    CreateDatasetGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A name for the dataset group.
    CreateDatasetGroup -> Text
datasetGroupName :: Prelude.Text,
    -- | The domain associated with the dataset group. When you add a dataset to
    -- a dataset group, this value and the value specified for the @Domain@
    -- parameter of the
    -- <https://docs.aws.amazon.com/forecast/latest/dg/API_CreateDataset.html CreateDataset>
    -- operation must match.
    --
    -- The @Domain@ and @DatasetType@ that you choose determine the fields that
    -- must be present in training data that you import to a dataset. For
    -- example, if you choose the @RETAIL@ domain and @TARGET_TIME_SERIES@ as
    -- the @DatasetType@, Amazon Forecast requires that @item_id@, @timestamp@,
    -- and @demand@ fields are present in your data. For more information, see
    -- <https://docs.aws.amazon.com/forecast/latest/dg/howitworks-datasets-groups.html Dataset groups>.
    CreateDatasetGroup -> Domain
domain :: Domain
  }
  deriving (CreateDatasetGroup -> CreateDatasetGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDatasetGroup -> CreateDatasetGroup -> Bool
$c/= :: CreateDatasetGroup -> CreateDatasetGroup -> Bool
== :: CreateDatasetGroup -> CreateDatasetGroup -> Bool
$c== :: CreateDatasetGroup -> CreateDatasetGroup -> Bool
Prelude.Eq, Int -> CreateDatasetGroup -> ShowS
[CreateDatasetGroup] -> ShowS
CreateDatasetGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDatasetGroup] -> ShowS
$cshowList :: [CreateDatasetGroup] -> ShowS
show :: CreateDatasetGroup -> String
$cshow :: CreateDatasetGroup -> String
showsPrec :: Int -> CreateDatasetGroup -> ShowS
$cshowsPrec :: Int -> CreateDatasetGroup -> ShowS
Prelude.Show, forall x. Rep CreateDatasetGroup x -> CreateDatasetGroup
forall x. CreateDatasetGroup -> Rep CreateDatasetGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDatasetGroup x -> CreateDatasetGroup
$cfrom :: forall x. CreateDatasetGroup -> Rep CreateDatasetGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateDatasetGroup' 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:
--
-- 'datasetArns', 'createDatasetGroup_datasetArns' - An array of Amazon Resource Names (ARNs) of the datasets that you want
-- to include in the dataset group.
--
-- 'tags', 'createDatasetGroup_tags' - The optional metadata that you apply to the dataset group 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.
--
-- 'datasetGroupName', 'createDatasetGroup_datasetGroupName' - A name for the dataset group.
--
-- 'domain', 'createDatasetGroup_domain' - The domain associated with the dataset group. When you add a dataset to
-- a dataset group, this value and the value specified for the @Domain@
-- parameter of the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_CreateDataset.html CreateDataset>
-- operation must match.
--
-- The @Domain@ and @DatasetType@ that you choose determine the fields that
-- must be present in training data that you import to a dataset. For
-- example, if you choose the @RETAIL@ domain and @TARGET_TIME_SERIES@ as
-- the @DatasetType@, Amazon Forecast requires that @item_id@, @timestamp@,
-- and @demand@ fields are present in your data. For more information, see
-- <https://docs.aws.amazon.com/forecast/latest/dg/howitworks-datasets-groups.html Dataset groups>.
newCreateDatasetGroup ::
  -- | 'datasetGroupName'
  Prelude.Text ->
  -- | 'domain'
  Domain ->
  CreateDatasetGroup
newCreateDatasetGroup :: Text -> Domain -> CreateDatasetGroup
newCreateDatasetGroup Text
pDatasetGroupName_ Domain
pDomain_ =
  CreateDatasetGroup'
    { $sel:datasetArns:CreateDatasetGroup' :: Maybe [Text]
datasetArns = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDatasetGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:datasetGroupName:CreateDatasetGroup' :: Text
datasetGroupName = Text
pDatasetGroupName_,
      $sel:domain:CreateDatasetGroup' :: Domain
domain = Domain
pDomain_
    }

-- | An array of Amazon Resource Names (ARNs) of the datasets that you want
-- to include in the dataset group.
createDatasetGroup_datasetArns :: Lens.Lens' CreateDatasetGroup (Prelude.Maybe [Prelude.Text])
createDatasetGroup_datasetArns :: Lens' CreateDatasetGroup (Maybe [Text])
createDatasetGroup_datasetArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetGroup' {Maybe [Text]
datasetArns :: Maybe [Text]
$sel:datasetArns:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Text]
datasetArns} -> Maybe [Text]
datasetArns) (\s :: CreateDatasetGroup
s@CreateDatasetGroup' {} Maybe [Text]
a -> CreateDatasetGroup
s {$sel:datasetArns:CreateDatasetGroup' :: Maybe [Text]
datasetArns = Maybe [Text]
a} :: CreateDatasetGroup) 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

-- | The optional metadata that you apply to the dataset group 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.
createDatasetGroup_tags :: Lens.Lens' CreateDatasetGroup (Prelude.Maybe [Tag])
createDatasetGroup_tags :: Lens' CreateDatasetGroup (Maybe [Tag])
createDatasetGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDatasetGroup
s@CreateDatasetGroup' {} Maybe [Tag]
a -> CreateDatasetGroup
s {$sel:tags:CreateDatasetGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDatasetGroup) 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 name for the dataset group.
createDatasetGroup_datasetGroupName :: Lens.Lens' CreateDatasetGroup Prelude.Text
createDatasetGroup_datasetGroupName :: Lens' CreateDatasetGroup Text
createDatasetGroup_datasetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetGroup' {Text
datasetGroupName :: Text
$sel:datasetGroupName:CreateDatasetGroup' :: CreateDatasetGroup -> Text
datasetGroupName} -> Text
datasetGroupName) (\s :: CreateDatasetGroup
s@CreateDatasetGroup' {} Text
a -> CreateDatasetGroup
s {$sel:datasetGroupName:CreateDatasetGroup' :: Text
datasetGroupName = Text
a} :: CreateDatasetGroup)

-- | The domain associated with the dataset group. When you add a dataset to
-- a dataset group, this value and the value specified for the @Domain@
-- parameter of the
-- <https://docs.aws.amazon.com/forecast/latest/dg/API_CreateDataset.html CreateDataset>
-- operation must match.
--
-- The @Domain@ and @DatasetType@ that you choose determine the fields that
-- must be present in training data that you import to a dataset. For
-- example, if you choose the @RETAIL@ domain and @TARGET_TIME_SERIES@ as
-- the @DatasetType@, Amazon Forecast requires that @item_id@, @timestamp@,
-- and @demand@ fields are present in your data. For more information, see
-- <https://docs.aws.amazon.com/forecast/latest/dg/howitworks-datasets-groups.html Dataset groups>.
createDatasetGroup_domain :: Lens.Lens' CreateDatasetGroup Domain
createDatasetGroup_domain :: Lens' CreateDatasetGroup Domain
createDatasetGroup_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetGroup' {Domain
domain :: Domain
$sel:domain:CreateDatasetGroup' :: CreateDatasetGroup -> Domain
domain} -> Domain
domain) (\s :: CreateDatasetGroup
s@CreateDatasetGroup' {} Domain
a -> CreateDatasetGroup
s {$sel:domain:CreateDatasetGroup' :: Domain
domain = Domain
a} :: CreateDatasetGroup)

instance Core.AWSRequest CreateDatasetGroup where
  type
    AWSResponse CreateDatasetGroup =
      CreateDatasetGroupResponse
  request :: (Service -> Service)
-> CreateDatasetGroup -> Request CreateDatasetGroup
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 CreateDatasetGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDatasetGroup)))
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 -> CreateDatasetGroupResponse
CreateDatasetGroupResponse'
            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
"DatasetGroupArn")
            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 CreateDatasetGroup where
  hashWithSalt :: Int -> CreateDatasetGroup -> Int
hashWithSalt Int
_salt CreateDatasetGroup' {Maybe [Text]
Maybe [Tag]
Text
Domain
domain :: Domain
datasetGroupName :: Text
tags :: Maybe [Tag]
datasetArns :: Maybe [Text]
$sel:domain:CreateDatasetGroup' :: CreateDatasetGroup -> Domain
$sel:datasetGroupName:CreateDatasetGroup' :: CreateDatasetGroup -> Text
$sel:tags:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Tag]
$sel:datasetArns:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
datasetArns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Domain
domain

instance Prelude.NFData CreateDatasetGroup where
  rnf :: CreateDatasetGroup -> ()
rnf CreateDatasetGroup' {Maybe [Text]
Maybe [Tag]
Text
Domain
domain :: Domain
datasetGroupName :: Text
tags :: Maybe [Tag]
datasetArns :: Maybe [Text]
$sel:domain:CreateDatasetGroup' :: CreateDatasetGroup -> Domain
$sel:datasetGroupName:CreateDatasetGroup' :: CreateDatasetGroup -> Text
$sel:tags:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Tag]
$sel:datasetArns:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
datasetArns
      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 Text
datasetGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Domain
domain

instance Data.ToHeaders CreateDatasetGroup where
  toHeaders :: CreateDatasetGroup -> 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.CreateDatasetGroup" ::
                          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 CreateDatasetGroup where
  toJSON :: CreateDatasetGroup -> Value
toJSON CreateDatasetGroup' {Maybe [Text]
Maybe [Tag]
Text
Domain
domain :: Domain
datasetGroupName :: Text
tags :: Maybe [Tag]
datasetArns :: Maybe [Text]
$sel:domain:CreateDatasetGroup' :: CreateDatasetGroup -> Domain
$sel:datasetGroupName:CreateDatasetGroup' :: CreateDatasetGroup -> Text
$sel:tags:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Tag]
$sel:datasetArns:CreateDatasetGroup' :: CreateDatasetGroup -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DatasetArns" 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]
datasetArns,
            (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DatasetGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
datasetGroupName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Domain
domain)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateDatasetGroupResponse' 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:
--
-- 'datasetGroupArn', 'createDatasetGroupResponse_datasetGroupArn' - The Amazon Resource Name (ARN) of the dataset group.
--
-- 'httpStatus', 'createDatasetGroupResponse_httpStatus' - The response's http status code.
newCreateDatasetGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDatasetGroupResponse
newCreateDatasetGroupResponse :: Int -> CreateDatasetGroupResponse
newCreateDatasetGroupResponse Int
pHttpStatus_ =
  CreateDatasetGroupResponse'
    { $sel:datasetGroupArn:CreateDatasetGroupResponse' :: Maybe Text
datasetGroupArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDatasetGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the dataset group.
createDatasetGroupResponse_datasetGroupArn :: Lens.Lens' CreateDatasetGroupResponse (Prelude.Maybe Prelude.Text)
createDatasetGroupResponse_datasetGroupArn :: Lens' CreateDatasetGroupResponse (Maybe Text)
createDatasetGroupResponse_datasetGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatasetGroupResponse' {Maybe Text
datasetGroupArn :: Maybe Text
$sel:datasetGroupArn:CreateDatasetGroupResponse' :: CreateDatasetGroupResponse -> Maybe Text
datasetGroupArn} -> Maybe Text
datasetGroupArn) (\s :: CreateDatasetGroupResponse
s@CreateDatasetGroupResponse' {} Maybe Text
a -> CreateDatasetGroupResponse
s {$sel:datasetGroupArn:CreateDatasetGroupResponse' :: Maybe Text
datasetGroupArn = Maybe Text
a} :: CreateDatasetGroupResponse)

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

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