{-# 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.DataBrew.CreateProfileJob
-- 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 new job to analyze a dataset and create its data profile.
module Amazonka.DataBrew.CreateProfileJob
  ( -- * Creating a Request
    CreateProfileJob (..),
    newCreateProfileJob,

    -- * Request Lenses
    createProfileJob_configuration,
    createProfileJob_encryptionKeyArn,
    createProfileJob_encryptionMode,
    createProfileJob_jobSample,
    createProfileJob_logSubscription,
    createProfileJob_maxCapacity,
    createProfileJob_maxRetries,
    createProfileJob_tags,
    createProfileJob_timeout,
    createProfileJob_validationConfigurations,
    createProfileJob_datasetName,
    createProfileJob_name,
    createProfileJob_outputLocation,
    createProfileJob_roleArn,

    -- * Destructuring the Response
    CreateProfileJobResponse (..),
    newCreateProfileJobResponse,

    -- * Response Lenses
    createProfileJobResponse_httpStatus,
    createProfileJobResponse_name,
  )
where

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

-- | /See:/ 'newCreateProfileJob' smart constructor.
data CreateProfileJob = CreateProfileJob'
  { -- | Configuration for profile jobs. Used to select columns, do evaluations,
    -- and override default parameters of evaluations. When configuration is
    -- null, the profile job will run with default settings.
    CreateProfileJob -> Maybe ProfileConfiguration
configuration :: Prelude.Maybe ProfileConfiguration,
    -- | The Amazon Resource Name (ARN) of an encryption key that is used to
    -- protect the job.
    CreateProfileJob -> Maybe Text
encryptionKeyArn :: Prelude.Maybe Prelude.Text,
    -- | The encryption mode for the job, which can be one of the following:
    --
    -- -   @SSE-KMS@ - @SSE-KMS@ - Server-side encryption with KMS-managed
    --     keys.
    --
    -- -   @SSE-S3@ - Server-side encryption with keys managed by Amazon S3.
    CreateProfileJob -> Maybe EncryptionMode
encryptionMode :: Prelude.Maybe EncryptionMode,
    -- | Sample configuration for profile jobs only. Determines the number of
    -- rows on which the profile job will be executed. If a JobSample value is
    -- not provided, the default value will be used. The default value is
    -- CUSTOM_ROWS for the mode parameter and 20000 for the size parameter.
    CreateProfileJob -> Maybe JobSample
jobSample :: Prelude.Maybe JobSample,
    -- | Enables or disables Amazon CloudWatch logging for the job. If logging is
    -- enabled, CloudWatch writes one log stream for each job run.
    CreateProfileJob -> Maybe LogSubscription
logSubscription :: Prelude.Maybe LogSubscription,
    -- | The maximum number of nodes that DataBrew can use when the job processes
    -- data.
    CreateProfileJob -> Maybe Int
maxCapacity :: Prelude.Maybe Prelude.Int,
    -- | The maximum number of times to retry the job after a job run fails.
    CreateProfileJob -> Maybe Natural
maxRetries :: Prelude.Maybe Prelude.Natural,
    -- | Metadata tags to apply to this job.
    CreateProfileJob -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The job\'s timeout in minutes. A job that attempts to run longer than
    -- this timeout period ends with a status of @TIMEOUT@.
    CreateProfileJob -> Maybe Natural
timeout :: Prelude.Maybe Prelude.Natural,
    -- | List of validation configurations that are applied to the profile job.
    CreateProfileJob -> Maybe (NonEmpty ValidationConfiguration)
validationConfigurations :: Prelude.Maybe (Prelude.NonEmpty ValidationConfiguration),
    -- | The name of the dataset that this job is to act upon.
    CreateProfileJob -> Text
datasetName :: Prelude.Text,
    -- | The name of the job to be created. Valid characters are alphanumeric
    -- (A-Z, a-z, 0-9), hyphen (-), period (.), and space.
    CreateProfileJob -> Text
name :: Prelude.Text,
    CreateProfileJob -> S3Location
outputLocation :: S3Location,
    -- | The Amazon Resource Name (ARN) of the Identity and Access Management
    -- (IAM) role to be assumed when DataBrew runs the job.
    CreateProfileJob -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateProfileJob -> CreateProfileJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProfileJob -> CreateProfileJob -> Bool
$c/= :: CreateProfileJob -> CreateProfileJob -> Bool
== :: CreateProfileJob -> CreateProfileJob -> Bool
$c== :: CreateProfileJob -> CreateProfileJob -> Bool
Prelude.Eq, ReadPrec [CreateProfileJob]
ReadPrec CreateProfileJob
Int -> ReadS CreateProfileJob
ReadS [CreateProfileJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateProfileJob]
$creadListPrec :: ReadPrec [CreateProfileJob]
readPrec :: ReadPrec CreateProfileJob
$creadPrec :: ReadPrec CreateProfileJob
readList :: ReadS [CreateProfileJob]
$creadList :: ReadS [CreateProfileJob]
readsPrec :: Int -> ReadS CreateProfileJob
$creadsPrec :: Int -> ReadS CreateProfileJob
Prelude.Read, Int -> CreateProfileJob -> ShowS
[CreateProfileJob] -> ShowS
CreateProfileJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProfileJob] -> ShowS
$cshowList :: [CreateProfileJob] -> ShowS
show :: CreateProfileJob -> String
$cshow :: CreateProfileJob -> String
showsPrec :: Int -> CreateProfileJob -> ShowS
$cshowsPrec :: Int -> CreateProfileJob -> ShowS
Prelude.Show, forall x. Rep CreateProfileJob x -> CreateProfileJob
forall x. CreateProfileJob -> Rep CreateProfileJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateProfileJob x -> CreateProfileJob
$cfrom :: forall x. CreateProfileJob -> Rep CreateProfileJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateProfileJob' 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:
--
-- 'configuration', 'createProfileJob_configuration' - Configuration for profile jobs. Used to select columns, do evaluations,
-- and override default parameters of evaluations. When configuration is
-- null, the profile job will run with default settings.
--
-- 'encryptionKeyArn', 'createProfileJob_encryptionKeyArn' - The Amazon Resource Name (ARN) of an encryption key that is used to
-- protect the job.
--
-- 'encryptionMode', 'createProfileJob_encryptionMode' - The encryption mode for the job, which can be one of the following:
--
-- -   @SSE-KMS@ - @SSE-KMS@ - Server-side encryption with KMS-managed
--     keys.
--
-- -   @SSE-S3@ - Server-side encryption with keys managed by Amazon S3.
--
-- 'jobSample', 'createProfileJob_jobSample' - Sample configuration for profile jobs only. Determines the number of
-- rows on which the profile job will be executed. If a JobSample value is
-- not provided, the default value will be used. The default value is
-- CUSTOM_ROWS for the mode parameter and 20000 for the size parameter.
--
-- 'logSubscription', 'createProfileJob_logSubscription' - Enables or disables Amazon CloudWatch logging for the job. If logging is
-- enabled, CloudWatch writes one log stream for each job run.
--
-- 'maxCapacity', 'createProfileJob_maxCapacity' - The maximum number of nodes that DataBrew can use when the job processes
-- data.
--
-- 'maxRetries', 'createProfileJob_maxRetries' - The maximum number of times to retry the job after a job run fails.
--
-- 'tags', 'createProfileJob_tags' - Metadata tags to apply to this job.
--
-- 'timeout', 'createProfileJob_timeout' - The job\'s timeout in minutes. A job that attempts to run longer than
-- this timeout period ends with a status of @TIMEOUT@.
--
-- 'validationConfigurations', 'createProfileJob_validationConfigurations' - List of validation configurations that are applied to the profile job.
--
-- 'datasetName', 'createProfileJob_datasetName' - The name of the dataset that this job is to act upon.
--
-- 'name', 'createProfileJob_name' - The name of the job to be created. Valid characters are alphanumeric
-- (A-Z, a-z, 0-9), hyphen (-), period (.), and space.
--
-- 'outputLocation', 'createProfileJob_outputLocation' - Undocumented member.
--
-- 'roleArn', 'createProfileJob_roleArn' - The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role to be assumed when DataBrew runs the job.
newCreateProfileJob ::
  -- | 'datasetName'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'outputLocation'
  S3Location ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateProfileJob
newCreateProfileJob :: Text -> Text -> S3Location -> Text -> CreateProfileJob
newCreateProfileJob
  Text
pDatasetName_
  Text
pName_
  S3Location
pOutputLocation_
  Text
pRoleArn_ =
    CreateProfileJob'
      { $sel:configuration:CreateProfileJob' :: Maybe ProfileConfiguration
configuration = forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionKeyArn:CreateProfileJob' :: Maybe Text
encryptionKeyArn = forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionMode:CreateProfileJob' :: Maybe EncryptionMode
encryptionMode = forall a. Maybe a
Prelude.Nothing,
        $sel:jobSample:CreateProfileJob' :: Maybe JobSample
jobSample = forall a. Maybe a
Prelude.Nothing,
        $sel:logSubscription:CreateProfileJob' :: Maybe LogSubscription
logSubscription = forall a. Maybe a
Prelude.Nothing,
        $sel:maxCapacity:CreateProfileJob' :: Maybe Int
maxCapacity = forall a. Maybe a
Prelude.Nothing,
        $sel:maxRetries:CreateProfileJob' :: Maybe Natural
maxRetries = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateProfileJob' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:timeout:CreateProfileJob' :: Maybe Natural
timeout = forall a. Maybe a
Prelude.Nothing,
        $sel:validationConfigurations:CreateProfileJob' :: Maybe (NonEmpty ValidationConfiguration)
validationConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:datasetName:CreateProfileJob' :: Text
datasetName = Text
pDatasetName_,
        $sel:name:CreateProfileJob' :: Text
name = Text
pName_,
        $sel:outputLocation:CreateProfileJob' :: S3Location
outputLocation = S3Location
pOutputLocation_,
        $sel:roleArn:CreateProfileJob' :: Text
roleArn = Text
pRoleArn_
      }

-- | Configuration for profile jobs. Used to select columns, do evaluations,
-- and override default parameters of evaluations. When configuration is
-- null, the profile job will run with default settings.
createProfileJob_configuration :: Lens.Lens' CreateProfileJob (Prelude.Maybe ProfileConfiguration)
createProfileJob_configuration :: Lens' CreateProfileJob (Maybe ProfileConfiguration)
createProfileJob_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe ProfileConfiguration
configuration :: Maybe ProfileConfiguration
$sel:configuration:CreateProfileJob' :: CreateProfileJob -> Maybe ProfileConfiguration
configuration} -> Maybe ProfileConfiguration
configuration) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe ProfileConfiguration
a -> CreateProfileJob
s {$sel:configuration:CreateProfileJob' :: Maybe ProfileConfiguration
configuration = Maybe ProfileConfiguration
a} :: CreateProfileJob)

-- | The Amazon Resource Name (ARN) of an encryption key that is used to
-- protect the job.
createProfileJob_encryptionKeyArn :: Lens.Lens' CreateProfileJob (Prelude.Maybe Prelude.Text)
createProfileJob_encryptionKeyArn :: Lens' CreateProfileJob (Maybe Text)
createProfileJob_encryptionKeyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe Text
encryptionKeyArn :: Maybe Text
$sel:encryptionKeyArn:CreateProfileJob' :: CreateProfileJob -> Maybe Text
encryptionKeyArn} -> Maybe Text
encryptionKeyArn) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe Text
a -> CreateProfileJob
s {$sel:encryptionKeyArn:CreateProfileJob' :: Maybe Text
encryptionKeyArn = Maybe Text
a} :: CreateProfileJob)

-- | The encryption mode for the job, which can be one of the following:
--
-- -   @SSE-KMS@ - @SSE-KMS@ - Server-side encryption with KMS-managed
--     keys.
--
-- -   @SSE-S3@ - Server-side encryption with keys managed by Amazon S3.
createProfileJob_encryptionMode :: Lens.Lens' CreateProfileJob (Prelude.Maybe EncryptionMode)
createProfileJob_encryptionMode :: Lens' CreateProfileJob (Maybe EncryptionMode)
createProfileJob_encryptionMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe EncryptionMode
encryptionMode :: Maybe EncryptionMode
$sel:encryptionMode:CreateProfileJob' :: CreateProfileJob -> Maybe EncryptionMode
encryptionMode} -> Maybe EncryptionMode
encryptionMode) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe EncryptionMode
a -> CreateProfileJob
s {$sel:encryptionMode:CreateProfileJob' :: Maybe EncryptionMode
encryptionMode = Maybe EncryptionMode
a} :: CreateProfileJob)

-- | Sample configuration for profile jobs only. Determines the number of
-- rows on which the profile job will be executed. If a JobSample value is
-- not provided, the default value will be used. The default value is
-- CUSTOM_ROWS for the mode parameter and 20000 for the size parameter.
createProfileJob_jobSample :: Lens.Lens' CreateProfileJob (Prelude.Maybe JobSample)
createProfileJob_jobSample :: Lens' CreateProfileJob (Maybe JobSample)
createProfileJob_jobSample = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe JobSample
jobSample :: Maybe JobSample
$sel:jobSample:CreateProfileJob' :: CreateProfileJob -> Maybe JobSample
jobSample} -> Maybe JobSample
jobSample) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe JobSample
a -> CreateProfileJob
s {$sel:jobSample:CreateProfileJob' :: Maybe JobSample
jobSample = Maybe JobSample
a} :: CreateProfileJob)

-- | Enables or disables Amazon CloudWatch logging for the job. If logging is
-- enabled, CloudWatch writes one log stream for each job run.
createProfileJob_logSubscription :: Lens.Lens' CreateProfileJob (Prelude.Maybe LogSubscription)
createProfileJob_logSubscription :: Lens' CreateProfileJob (Maybe LogSubscription)
createProfileJob_logSubscription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe LogSubscription
logSubscription :: Maybe LogSubscription
$sel:logSubscription:CreateProfileJob' :: CreateProfileJob -> Maybe LogSubscription
logSubscription} -> Maybe LogSubscription
logSubscription) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe LogSubscription
a -> CreateProfileJob
s {$sel:logSubscription:CreateProfileJob' :: Maybe LogSubscription
logSubscription = Maybe LogSubscription
a} :: CreateProfileJob)

-- | The maximum number of nodes that DataBrew can use when the job processes
-- data.
createProfileJob_maxCapacity :: Lens.Lens' CreateProfileJob (Prelude.Maybe Prelude.Int)
createProfileJob_maxCapacity :: Lens' CreateProfileJob (Maybe Int)
createProfileJob_maxCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe Int
maxCapacity :: Maybe Int
$sel:maxCapacity:CreateProfileJob' :: CreateProfileJob -> Maybe Int
maxCapacity} -> Maybe Int
maxCapacity) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe Int
a -> CreateProfileJob
s {$sel:maxCapacity:CreateProfileJob' :: Maybe Int
maxCapacity = Maybe Int
a} :: CreateProfileJob)

-- | The maximum number of times to retry the job after a job run fails.
createProfileJob_maxRetries :: Lens.Lens' CreateProfileJob (Prelude.Maybe Prelude.Natural)
createProfileJob_maxRetries :: Lens' CreateProfileJob (Maybe Natural)
createProfileJob_maxRetries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe Natural
maxRetries :: Maybe Natural
$sel:maxRetries:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
maxRetries} -> Maybe Natural
maxRetries) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe Natural
a -> CreateProfileJob
s {$sel:maxRetries:CreateProfileJob' :: Maybe Natural
maxRetries = Maybe Natural
a} :: CreateProfileJob)

-- | Metadata tags to apply to this job.
createProfileJob_tags :: Lens.Lens' CreateProfileJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createProfileJob_tags :: Lens' CreateProfileJob (Maybe (HashMap Text Text))
createProfileJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateProfileJob' :: CreateProfileJob -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe (HashMap Text Text)
a -> CreateProfileJob
s {$sel:tags:CreateProfileJob' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateProfileJob) 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 job\'s timeout in minutes. A job that attempts to run longer than
-- this timeout period ends with a status of @TIMEOUT@.
createProfileJob_timeout :: Lens.Lens' CreateProfileJob (Prelude.Maybe Prelude.Natural)
createProfileJob_timeout :: Lens' CreateProfileJob (Maybe Natural)
createProfileJob_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe Natural
timeout :: Maybe Natural
$sel:timeout:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
timeout} -> Maybe Natural
timeout) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe Natural
a -> CreateProfileJob
s {$sel:timeout:CreateProfileJob' :: Maybe Natural
timeout = Maybe Natural
a} :: CreateProfileJob)

-- | List of validation configurations that are applied to the profile job.
createProfileJob_validationConfigurations :: Lens.Lens' CreateProfileJob (Prelude.Maybe (Prelude.NonEmpty ValidationConfiguration))
createProfileJob_validationConfigurations :: Lens' CreateProfileJob (Maybe (NonEmpty ValidationConfiguration))
createProfileJob_validationConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Maybe (NonEmpty ValidationConfiguration)
validationConfigurations :: Maybe (NonEmpty ValidationConfiguration)
$sel:validationConfigurations:CreateProfileJob' :: CreateProfileJob -> Maybe (NonEmpty ValidationConfiguration)
validationConfigurations} -> Maybe (NonEmpty ValidationConfiguration)
validationConfigurations) (\s :: CreateProfileJob
s@CreateProfileJob' {} Maybe (NonEmpty ValidationConfiguration)
a -> CreateProfileJob
s {$sel:validationConfigurations:CreateProfileJob' :: Maybe (NonEmpty ValidationConfiguration)
validationConfigurations = Maybe (NonEmpty ValidationConfiguration)
a} :: CreateProfileJob) 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 name of the dataset that this job is to act upon.
createProfileJob_datasetName :: Lens.Lens' CreateProfileJob Prelude.Text
createProfileJob_datasetName :: Lens' CreateProfileJob Text
createProfileJob_datasetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Text
datasetName :: Text
$sel:datasetName:CreateProfileJob' :: CreateProfileJob -> Text
datasetName} -> Text
datasetName) (\s :: CreateProfileJob
s@CreateProfileJob' {} Text
a -> CreateProfileJob
s {$sel:datasetName:CreateProfileJob' :: Text
datasetName = Text
a} :: CreateProfileJob)

-- | The name of the job to be created. Valid characters are alphanumeric
-- (A-Z, a-z, 0-9), hyphen (-), period (.), and space.
createProfileJob_name :: Lens.Lens' CreateProfileJob Prelude.Text
createProfileJob_name :: Lens' CreateProfileJob Text
createProfileJob_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Text
name :: Text
$sel:name:CreateProfileJob' :: CreateProfileJob -> Text
name} -> Text
name) (\s :: CreateProfileJob
s@CreateProfileJob' {} Text
a -> CreateProfileJob
s {$sel:name:CreateProfileJob' :: Text
name = Text
a} :: CreateProfileJob)

-- | Undocumented member.
createProfileJob_outputLocation :: Lens.Lens' CreateProfileJob S3Location
createProfileJob_outputLocation :: Lens' CreateProfileJob S3Location
createProfileJob_outputLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {S3Location
outputLocation :: S3Location
$sel:outputLocation:CreateProfileJob' :: CreateProfileJob -> S3Location
outputLocation} -> S3Location
outputLocation) (\s :: CreateProfileJob
s@CreateProfileJob' {} S3Location
a -> CreateProfileJob
s {$sel:outputLocation:CreateProfileJob' :: S3Location
outputLocation = S3Location
a} :: CreateProfileJob)

-- | The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role to be assumed when DataBrew runs the job.
createProfileJob_roleArn :: Lens.Lens' CreateProfileJob Prelude.Text
createProfileJob_roleArn :: Lens' CreateProfileJob Text
createProfileJob_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJob' {Text
roleArn :: Text
$sel:roleArn:CreateProfileJob' :: CreateProfileJob -> Text
roleArn} -> Text
roleArn) (\s :: CreateProfileJob
s@CreateProfileJob' {} Text
a -> CreateProfileJob
s {$sel:roleArn:CreateProfileJob' :: Text
roleArn = Text
a} :: CreateProfileJob)

instance Core.AWSRequest CreateProfileJob where
  type
    AWSResponse CreateProfileJob =
      CreateProfileJobResponse
  request :: (Service -> Service)
-> CreateProfileJob -> Request CreateProfileJob
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 CreateProfileJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateProfileJob)))
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 ->
          Int -> Text -> CreateProfileJobResponse
CreateProfileJobResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Name")
      )

instance Prelude.Hashable CreateProfileJob where
  hashWithSalt :: Int -> CreateProfileJob -> Int
hashWithSalt Int
_salt CreateProfileJob' {Maybe Int
Maybe Natural
Maybe (NonEmpty ValidationConfiguration)
Maybe Text
Maybe (HashMap Text Text)
Maybe EncryptionMode
Maybe LogSubscription
Maybe JobSample
Maybe ProfileConfiguration
Text
S3Location
roleArn :: Text
outputLocation :: S3Location
name :: Text
datasetName :: Text
validationConfigurations :: Maybe (NonEmpty ValidationConfiguration)
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
maxRetries :: Maybe Natural
maxCapacity :: Maybe Int
logSubscription :: Maybe LogSubscription
jobSample :: Maybe JobSample
encryptionMode :: Maybe EncryptionMode
encryptionKeyArn :: Maybe Text
configuration :: Maybe ProfileConfiguration
$sel:roleArn:CreateProfileJob' :: CreateProfileJob -> Text
$sel:outputLocation:CreateProfileJob' :: CreateProfileJob -> S3Location
$sel:name:CreateProfileJob' :: CreateProfileJob -> Text
$sel:datasetName:CreateProfileJob' :: CreateProfileJob -> Text
$sel:validationConfigurations:CreateProfileJob' :: CreateProfileJob -> Maybe (NonEmpty ValidationConfiguration)
$sel:timeout:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
$sel:tags:CreateProfileJob' :: CreateProfileJob -> Maybe (HashMap Text Text)
$sel:maxRetries:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
$sel:maxCapacity:CreateProfileJob' :: CreateProfileJob -> Maybe Int
$sel:logSubscription:CreateProfileJob' :: CreateProfileJob -> Maybe LogSubscription
$sel:jobSample:CreateProfileJob' :: CreateProfileJob -> Maybe JobSample
$sel:encryptionMode:CreateProfileJob' :: CreateProfileJob -> Maybe EncryptionMode
$sel:encryptionKeyArn:CreateProfileJob' :: CreateProfileJob -> Maybe Text
$sel:configuration:CreateProfileJob' :: CreateProfileJob -> Maybe ProfileConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProfileConfiguration
configuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
encryptionKeyArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionMode
encryptionMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobSample
jobSample
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogSubscription
logSubscription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxRetries
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ValidationConfiguration)
validationConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` S3Location
outputLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateProfileJob where
  rnf :: CreateProfileJob -> ()
rnf CreateProfileJob' {Maybe Int
Maybe Natural
Maybe (NonEmpty ValidationConfiguration)
Maybe Text
Maybe (HashMap Text Text)
Maybe EncryptionMode
Maybe LogSubscription
Maybe JobSample
Maybe ProfileConfiguration
Text
S3Location
roleArn :: Text
outputLocation :: S3Location
name :: Text
datasetName :: Text
validationConfigurations :: Maybe (NonEmpty ValidationConfiguration)
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
maxRetries :: Maybe Natural
maxCapacity :: Maybe Int
logSubscription :: Maybe LogSubscription
jobSample :: Maybe JobSample
encryptionMode :: Maybe EncryptionMode
encryptionKeyArn :: Maybe Text
configuration :: Maybe ProfileConfiguration
$sel:roleArn:CreateProfileJob' :: CreateProfileJob -> Text
$sel:outputLocation:CreateProfileJob' :: CreateProfileJob -> S3Location
$sel:name:CreateProfileJob' :: CreateProfileJob -> Text
$sel:datasetName:CreateProfileJob' :: CreateProfileJob -> Text
$sel:validationConfigurations:CreateProfileJob' :: CreateProfileJob -> Maybe (NonEmpty ValidationConfiguration)
$sel:timeout:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
$sel:tags:CreateProfileJob' :: CreateProfileJob -> Maybe (HashMap Text Text)
$sel:maxRetries:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
$sel:maxCapacity:CreateProfileJob' :: CreateProfileJob -> Maybe Int
$sel:logSubscription:CreateProfileJob' :: CreateProfileJob -> Maybe LogSubscription
$sel:jobSample:CreateProfileJob' :: CreateProfileJob -> Maybe JobSample
$sel:encryptionMode:CreateProfileJob' :: CreateProfileJob -> Maybe EncryptionMode
$sel:encryptionKeyArn:CreateProfileJob' :: CreateProfileJob -> Maybe Text
$sel:configuration:CreateProfileJob' :: CreateProfileJob -> Maybe ProfileConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ProfileConfiguration
configuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
encryptionKeyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionMode
encryptionMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobSample
jobSample
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogSubscription
logSubscription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxRetries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
timeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ValidationConfiguration)
validationConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf S3Location
outputLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

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

instance Data.ToJSON CreateProfileJob where
  toJSON :: CreateProfileJob -> Value
toJSON CreateProfileJob' {Maybe Int
Maybe Natural
Maybe (NonEmpty ValidationConfiguration)
Maybe Text
Maybe (HashMap Text Text)
Maybe EncryptionMode
Maybe LogSubscription
Maybe JobSample
Maybe ProfileConfiguration
Text
S3Location
roleArn :: Text
outputLocation :: S3Location
name :: Text
datasetName :: Text
validationConfigurations :: Maybe (NonEmpty ValidationConfiguration)
timeout :: Maybe Natural
tags :: Maybe (HashMap Text Text)
maxRetries :: Maybe Natural
maxCapacity :: Maybe Int
logSubscription :: Maybe LogSubscription
jobSample :: Maybe JobSample
encryptionMode :: Maybe EncryptionMode
encryptionKeyArn :: Maybe Text
configuration :: Maybe ProfileConfiguration
$sel:roleArn:CreateProfileJob' :: CreateProfileJob -> Text
$sel:outputLocation:CreateProfileJob' :: CreateProfileJob -> S3Location
$sel:name:CreateProfileJob' :: CreateProfileJob -> Text
$sel:datasetName:CreateProfileJob' :: CreateProfileJob -> Text
$sel:validationConfigurations:CreateProfileJob' :: CreateProfileJob -> Maybe (NonEmpty ValidationConfiguration)
$sel:timeout:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
$sel:tags:CreateProfileJob' :: CreateProfileJob -> Maybe (HashMap Text Text)
$sel:maxRetries:CreateProfileJob' :: CreateProfileJob -> Maybe Natural
$sel:maxCapacity:CreateProfileJob' :: CreateProfileJob -> Maybe Int
$sel:logSubscription:CreateProfileJob' :: CreateProfileJob -> Maybe LogSubscription
$sel:jobSample:CreateProfileJob' :: CreateProfileJob -> Maybe JobSample
$sel:encryptionMode:CreateProfileJob' :: CreateProfileJob -> Maybe EncryptionMode
$sel:encryptionKeyArn:CreateProfileJob' :: CreateProfileJob -> Maybe Text
$sel:configuration:CreateProfileJob' :: CreateProfileJob -> Maybe ProfileConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Configuration" 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 ProfileConfiguration
configuration,
            (Key
"EncryptionKeyArn" 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
encryptionKeyArn,
            (Key
"EncryptionMode" 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 EncryptionMode
encryptionMode,
            (Key
"JobSample" 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 JobSample
jobSample,
            (Key
"LogSubscription" 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 LogSubscription
logSubscription,
            (Key
"MaxCapacity" 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 Int
maxCapacity,
            (Key
"MaxRetries" 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 Natural
maxRetries,
            (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 (HashMap Text Text)
tags,
            (Key
"Timeout" 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 Natural
timeout,
            (Key
"ValidationConfigurations" 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 (NonEmpty ValidationConfiguration)
validationConfigurations,
            forall a. a -> Maybe a
Prelude.Just (Key
"DatasetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
datasetName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OutputLocation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= S3Location
outputLocation),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateProfileJobResponse' 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:
--
-- 'httpStatus', 'createProfileJobResponse_httpStatus' - The response's http status code.
--
-- 'name', 'createProfileJobResponse_name' - The name of the job that was created.
newCreateProfileJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  CreateProfileJobResponse
newCreateProfileJobResponse :: Int -> Text -> CreateProfileJobResponse
newCreateProfileJobResponse Int
pHttpStatus_ Text
pName_ =
  CreateProfileJobResponse'
    { $sel:httpStatus:CreateProfileJobResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:name:CreateProfileJobResponse' :: Text
name = Text
pName_
    }

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

-- | The name of the job that was created.
createProfileJobResponse_name :: Lens.Lens' CreateProfileJobResponse Prelude.Text
createProfileJobResponse_name :: Lens' CreateProfileJobResponse Text
createProfileJobResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProfileJobResponse' {Text
name :: Text
$sel:name:CreateProfileJobResponse' :: CreateProfileJobResponse -> Text
name} -> Text
name) (\s :: CreateProfileJobResponse
s@CreateProfileJobResponse' {} Text
a -> CreateProfileJobResponse
s {$sel:name:CreateProfileJobResponse' :: Text
name = Text
a} :: CreateProfileJobResponse)

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