{-# 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.Glue.StartDataQualityRulesetEvaluationRun
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Once you have a ruleset definition (either recommended or your own), you
-- call this operation to evaluate the ruleset against a data source (Glue
-- table). The evaluation computes results which you can retrieve with the
-- @GetDataQualityResult@ API.
module Amazonka.Glue.StartDataQualityRulesetEvaluationRun
  ( -- * Creating a Request
    StartDataQualityRulesetEvaluationRun (..),
    newStartDataQualityRulesetEvaluationRun,

    -- * Request Lenses
    startDataQualityRulesetEvaluationRun_additionalRunOptions,
    startDataQualityRulesetEvaluationRun_clientToken,
    startDataQualityRulesetEvaluationRun_numberOfWorkers,
    startDataQualityRulesetEvaluationRun_timeout,
    startDataQualityRulesetEvaluationRun_dataSource,
    startDataQualityRulesetEvaluationRun_role,
    startDataQualityRulesetEvaluationRun_rulesetNames,

    -- * Destructuring the Response
    StartDataQualityRulesetEvaluationRunResponse (..),
    newStartDataQualityRulesetEvaluationRunResponse,

    -- * Response Lenses
    startDataQualityRulesetEvaluationRunResponse_runId,
    startDataQualityRulesetEvaluationRunResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartDataQualityRulesetEvaluationRun' smart constructor.
data StartDataQualityRulesetEvaluationRun = StartDataQualityRulesetEvaluationRun'
  { -- | Additional run options you can specify for an evaluation run.
    StartDataQualityRulesetEvaluationRun
-> Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions :: Prelude.Maybe DataQualityEvaluationRunAdditionalRunOptions,
    -- | Used for idempotency and is recommended to be set to a random ID (such
    -- as a UUID) to avoid creating or starting multiple instances of the same
    -- resource.
    StartDataQualityRulesetEvaluationRun -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The number of @G.1X@ workers to be used in the run. The default is 5.
    StartDataQualityRulesetEvaluationRun -> Maybe Int
numberOfWorkers :: Prelude.Maybe Prelude.Int,
    -- | The timeout for a run in minutes. This is the maximum time that a run
    -- can consume resources before it is terminated and enters @TIMEOUT@
    -- status. The default is 2,880 minutes (48 hours).
    StartDataQualityRulesetEvaluationRun -> Maybe Natural
timeout :: Prelude.Maybe Prelude.Natural,
    -- | The data source (Glue table) associated with this run.
    StartDataQualityRulesetEvaluationRun -> DataSource
dataSource :: DataSource,
    -- | An IAM role supplied to encrypt the results of the run.
    StartDataQualityRulesetEvaluationRun -> Text
role' :: Prelude.Text,
    -- | A list of ruleset names.
    StartDataQualityRulesetEvaluationRun -> NonEmpty Text
rulesetNames :: Prelude.NonEmpty Prelude.Text
  }
  deriving (StartDataQualityRulesetEvaluationRun
-> StartDataQualityRulesetEvaluationRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartDataQualityRulesetEvaluationRun
-> StartDataQualityRulesetEvaluationRun -> Bool
$c/= :: StartDataQualityRulesetEvaluationRun
-> StartDataQualityRulesetEvaluationRun -> Bool
== :: StartDataQualityRulesetEvaluationRun
-> StartDataQualityRulesetEvaluationRun -> Bool
$c== :: StartDataQualityRulesetEvaluationRun
-> StartDataQualityRulesetEvaluationRun -> Bool
Prelude.Eq, ReadPrec [StartDataQualityRulesetEvaluationRun]
ReadPrec StartDataQualityRulesetEvaluationRun
Int -> ReadS StartDataQualityRulesetEvaluationRun
ReadS [StartDataQualityRulesetEvaluationRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartDataQualityRulesetEvaluationRun]
$creadListPrec :: ReadPrec [StartDataQualityRulesetEvaluationRun]
readPrec :: ReadPrec StartDataQualityRulesetEvaluationRun
$creadPrec :: ReadPrec StartDataQualityRulesetEvaluationRun
readList :: ReadS [StartDataQualityRulesetEvaluationRun]
$creadList :: ReadS [StartDataQualityRulesetEvaluationRun]
readsPrec :: Int -> ReadS StartDataQualityRulesetEvaluationRun
$creadsPrec :: Int -> ReadS StartDataQualityRulesetEvaluationRun
Prelude.Read, Int -> StartDataQualityRulesetEvaluationRun -> ShowS
[StartDataQualityRulesetEvaluationRun] -> ShowS
StartDataQualityRulesetEvaluationRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartDataQualityRulesetEvaluationRun] -> ShowS
$cshowList :: [StartDataQualityRulesetEvaluationRun] -> ShowS
show :: StartDataQualityRulesetEvaluationRun -> String
$cshow :: StartDataQualityRulesetEvaluationRun -> String
showsPrec :: Int -> StartDataQualityRulesetEvaluationRun -> ShowS
$cshowsPrec :: Int -> StartDataQualityRulesetEvaluationRun -> ShowS
Prelude.Show, forall x.
Rep StartDataQualityRulesetEvaluationRun x
-> StartDataQualityRulesetEvaluationRun
forall x.
StartDataQualityRulesetEvaluationRun
-> Rep StartDataQualityRulesetEvaluationRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartDataQualityRulesetEvaluationRun x
-> StartDataQualityRulesetEvaluationRun
$cfrom :: forall x.
StartDataQualityRulesetEvaluationRun
-> Rep StartDataQualityRulesetEvaluationRun x
Prelude.Generic)

-- |
-- Create a value of 'StartDataQualityRulesetEvaluationRun' 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:
--
-- 'additionalRunOptions', 'startDataQualityRulesetEvaluationRun_additionalRunOptions' - Additional run options you can specify for an evaluation run.
--
-- 'clientToken', 'startDataQualityRulesetEvaluationRun_clientToken' - Used for idempotency and is recommended to be set to a random ID (such
-- as a UUID) to avoid creating or starting multiple instances of the same
-- resource.
--
-- 'numberOfWorkers', 'startDataQualityRulesetEvaluationRun_numberOfWorkers' - The number of @G.1X@ workers to be used in the run. The default is 5.
--
-- 'timeout', 'startDataQualityRulesetEvaluationRun_timeout' - The timeout for a run in minutes. This is the maximum time that a run
-- can consume resources before it is terminated and enters @TIMEOUT@
-- status. The default is 2,880 minutes (48 hours).
--
-- 'dataSource', 'startDataQualityRulesetEvaluationRun_dataSource' - The data source (Glue table) associated with this run.
--
-- 'role'', 'startDataQualityRulesetEvaluationRun_role' - An IAM role supplied to encrypt the results of the run.
--
-- 'rulesetNames', 'startDataQualityRulesetEvaluationRun_rulesetNames' - A list of ruleset names.
newStartDataQualityRulesetEvaluationRun ::
  -- | 'dataSource'
  DataSource ->
  -- | 'role''
  Prelude.Text ->
  -- | 'rulesetNames'
  Prelude.NonEmpty Prelude.Text ->
  StartDataQualityRulesetEvaluationRun
newStartDataQualityRulesetEvaluationRun :: DataSource
-> Text -> NonEmpty Text -> StartDataQualityRulesetEvaluationRun
newStartDataQualityRulesetEvaluationRun
  DataSource
pDataSource_
  Text
pRole_
  NonEmpty Text
pRulesetNames_ =
    StartDataQualityRulesetEvaluationRun'
      { $sel:additionalRunOptions:StartDataQualityRulesetEvaluationRun' :: Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientToken:StartDataQualityRulesetEvaluationRun' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:numberOfWorkers:StartDataQualityRulesetEvaluationRun' :: Maybe Int
numberOfWorkers = forall a. Maybe a
Prelude.Nothing,
        $sel:timeout:StartDataQualityRulesetEvaluationRun' :: Maybe Natural
timeout = forall a. Maybe a
Prelude.Nothing,
        $sel:dataSource:StartDataQualityRulesetEvaluationRun' :: DataSource
dataSource = DataSource
pDataSource_,
        $sel:role':StartDataQualityRulesetEvaluationRun' :: Text
role' = Text
pRole_,
        $sel:rulesetNames:StartDataQualityRulesetEvaluationRun' :: NonEmpty Text
rulesetNames =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pRulesetNames_
      }

-- | Additional run options you can specify for an evaluation run.
startDataQualityRulesetEvaluationRun_additionalRunOptions :: Lens.Lens' StartDataQualityRulesetEvaluationRun (Prelude.Maybe DataQualityEvaluationRunAdditionalRunOptions)
startDataQualityRulesetEvaluationRun_additionalRunOptions :: Lens'
  StartDataQualityRulesetEvaluationRun
  (Maybe DataQualityEvaluationRunAdditionalRunOptions)
startDataQualityRulesetEvaluationRun_additionalRunOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRun' {Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions :: Maybe DataQualityEvaluationRunAdditionalRunOptions
$sel:additionalRunOptions:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun
-> Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions} -> Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions) (\s :: StartDataQualityRulesetEvaluationRun
s@StartDataQualityRulesetEvaluationRun' {} Maybe DataQualityEvaluationRunAdditionalRunOptions
a -> StartDataQualityRulesetEvaluationRun
s {$sel:additionalRunOptions:StartDataQualityRulesetEvaluationRun' :: Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions = Maybe DataQualityEvaluationRunAdditionalRunOptions
a} :: StartDataQualityRulesetEvaluationRun)

-- | Used for idempotency and is recommended to be set to a random ID (such
-- as a UUID) to avoid creating or starting multiple instances of the same
-- resource.
startDataQualityRulesetEvaluationRun_clientToken :: Lens.Lens' StartDataQualityRulesetEvaluationRun (Prelude.Maybe Prelude.Text)
startDataQualityRulesetEvaluationRun_clientToken :: Lens' StartDataQualityRulesetEvaluationRun (Maybe Text)
startDataQualityRulesetEvaluationRun_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRun' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: StartDataQualityRulesetEvaluationRun
s@StartDataQualityRulesetEvaluationRun' {} Maybe Text
a -> StartDataQualityRulesetEvaluationRun
s {$sel:clientToken:StartDataQualityRulesetEvaluationRun' :: Maybe Text
clientToken = Maybe Text
a} :: StartDataQualityRulesetEvaluationRun)

-- | The number of @G.1X@ workers to be used in the run. The default is 5.
startDataQualityRulesetEvaluationRun_numberOfWorkers :: Lens.Lens' StartDataQualityRulesetEvaluationRun (Prelude.Maybe Prelude.Int)
startDataQualityRulesetEvaluationRun_numberOfWorkers :: Lens' StartDataQualityRulesetEvaluationRun (Maybe Int)
startDataQualityRulesetEvaluationRun_numberOfWorkers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRun' {Maybe Int
numberOfWorkers :: Maybe Int
$sel:numberOfWorkers:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Int
numberOfWorkers} -> Maybe Int
numberOfWorkers) (\s :: StartDataQualityRulesetEvaluationRun
s@StartDataQualityRulesetEvaluationRun' {} Maybe Int
a -> StartDataQualityRulesetEvaluationRun
s {$sel:numberOfWorkers:StartDataQualityRulesetEvaluationRun' :: Maybe Int
numberOfWorkers = Maybe Int
a} :: StartDataQualityRulesetEvaluationRun)

-- | The timeout for a run in minutes. This is the maximum time that a run
-- can consume resources before it is terminated and enters @TIMEOUT@
-- status. The default is 2,880 minutes (48 hours).
startDataQualityRulesetEvaluationRun_timeout :: Lens.Lens' StartDataQualityRulesetEvaluationRun (Prelude.Maybe Prelude.Natural)
startDataQualityRulesetEvaluationRun_timeout :: Lens' StartDataQualityRulesetEvaluationRun (Maybe Natural)
startDataQualityRulesetEvaluationRun_timeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRun' {Maybe Natural
timeout :: Maybe Natural
$sel:timeout:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Natural
timeout} -> Maybe Natural
timeout) (\s :: StartDataQualityRulesetEvaluationRun
s@StartDataQualityRulesetEvaluationRun' {} Maybe Natural
a -> StartDataQualityRulesetEvaluationRun
s {$sel:timeout:StartDataQualityRulesetEvaluationRun' :: Maybe Natural
timeout = Maybe Natural
a} :: StartDataQualityRulesetEvaluationRun)

-- | The data source (Glue table) associated with this run.
startDataQualityRulesetEvaluationRun_dataSource :: Lens.Lens' StartDataQualityRulesetEvaluationRun DataSource
startDataQualityRulesetEvaluationRun_dataSource :: Lens' StartDataQualityRulesetEvaluationRun DataSource
startDataQualityRulesetEvaluationRun_dataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRun' {DataSource
dataSource :: DataSource
$sel:dataSource:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> DataSource
dataSource} -> DataSource
dataSource) (\s :: StartDataQualityRulesetEvaluationRun
s@StartDataQualityRulesetEvaluationRun' {} DataSource
a -> StartDataQualityRulesetEvaluationRun
s {$sel:dataSource:StartDataQualityRulesetEvaluationRun' :: DataSource
dataSource = DataSource
a} :: StartDataQualityRulesetEvaluationRun)

-- | An IAM role supplied to encrypt the results of the run.
startDataQualityRulesetEvaluationRun_role :: Lens.Lens' StartDataQualityRulesetEvaluationRun Prelude.Text
startDataQualityRulesetEvaluationRun_role :: Lens' StartDataQualityRulesetEvaluationRun Text
startDataQualityRulesetEvaluationRun_role = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRun' {Text
role' :: Text
$sel:role':StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Text
role'} -> Text
role') (\s :: StartDataQualityRulesetEvaluationRun
s@StartDataQualityRulesetEvaluationRun' {} Text
a -> StartDataQualityRulesetEvaluationRun
s {$sel:role':StartDataQualityRulesetEvaluationRun' :: Text
role' = Text
a} :: StartDataQualityRulesetEvaluationRun)

-- | A list of ruleset names.
startDataQualityRulesetEvaluationRun_rulesetNames :: Lens.Lens' StartDataQualityRulesetEvaluationRun (Prelude.NonEmpty Prelude.Text)
startDataQualityRulesetEvaluationRun_rulesetNames :: Lens' StartDataQualityRulesetEvaluationRun (NonEmpty Text)
startDataQualityRulesetEvaluationRun_rulesetNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRun' {NonEmpty Text
rulesetNames :: NonEmpty Text
$sel:rulesetNames:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> NonEmpty Text
rulesetNames} -> NonEmpty Text
rulesetNames) (\s :: StartDataQualityRulesetEvaluationRun
s@StartDataQualityRulesetEvaluationRun' {} NonEmpty Text
a -> StartDataQualityRulesetEvaluationRun
s {$sel:rulesetNames:StartDataQualityRulesetEvaluationRun' :: NonEmpty Text
rulesetNames = NonEmpty Text
a} :: StartDataQualityRulesetEvaluationRun) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Core.AWSRequest
    StartDataQualityRulesetEvaluationRun
  where
  type
    AWSResponse StartDataQualityRulesetEvaluationRun =
      StartDataQualityRulesetEvaluationRunResponse
  request :: (Service -> Service)
-> StartDataQualityRulesetEvaluationRun
-> Request StartDataQualityRulesetEvaluationRun
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 StartDataQualityRulesetEvaluationRun
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse StartDataQualityRulesetEvaluationRun)))
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 -> StartDataQualityRulesetEvaluationRunResponse
StartDataQualityRulesetEvaluationRunResponse'
            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
"RunId")
            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
    StartDataQualityRulesetEvaluationRun
  where
  hashWithSalt :: Int -> StartDataQualityRulesetEvaluationRun -> Int
hashWithSalt
    Int
_salt
    StartDataQualityRulesetEvaluationRun' {Maybe Int
Maybe Natural
Maybe Text
Maybe DataQualityEvaluationRunAdditionalRunOptions
NonEmpty Text
Text
DataSource
rulesetNames :: NonEmpty Text
role' :: Text
dataSource :: DataSource
timeout :: Maybe Natural
numberOfWorkers :: Maybe Int
clientToken :: Maybe Text
additionalRunOptions :: Maybe DataQualityEvaluationRunAdditionalRunOptions
$sel:rulesetNames:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> NonEmpty Text
$sel:role':StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Text
$sel:dataSource:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> DataSource
$sel:timeout:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Natural
$sel:numberOfWorkers:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Int
$sel:clientToken:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Text
$sel:additionalRunOptions:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun
-> Maybe DataQualityEvaluationRunAdditionalRunOptions
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfWorkers
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeout
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataSource
dataSource
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
role'
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
rulesetNames

instance
  Prelude.NFData
    StartDataQualityRulesetEvaluationRun
  where
  rnf :: StartDataQualityRulesetEvaluationRun -> ()
rnf StartDataQualityRulesetEvaluationRun' {Maybe Int
Maybe Natural
Maybe Text
Maybe DataQualityEvaluationRunAdditionalRunOptions
NonEmpty Text
Text
DataSource
rulesetNames :: NonEmpty Text
role' :: Text
dataSource :: DataSource
timeout :: Maybe Natural
numberOfWorkers :: Maybe Int
clientToken :: Maybe Text
additionalRunOptions :: Maybe DataQualityEvaluationRunAdditionalRunOptions
$sel:rulesetNames:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> NonEmpty Text
$sel:role':StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Text
$sel:dataSource:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> DataSource
$sel:timeout:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Natural
$sel:numberOfWorkers:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Int
$sel:clientToken:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Text
$sel:additionalRunOptions:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun
-> Maybe DataQualityEvaluationRunAdditionalRunOptions
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
numberOfWorkers
      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 DataSource
dataSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
role'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
rulesetNames

instance
  Data.ToHeaders
    StartDataQualityRulesetEvaluationRun
  where
  toHeaders :: StartDataQualityRulesetEvaluationRun -> 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
"AWSGlue.StartDataQualityRulesetEvaluationRun" ::
                          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
    StartDataQualityRulesetEvaluationRun
  where
  toJSON :: StartDataQualityRulesetEvaluationRun -> Value
toJSON StartDataQualityRulesetEvaluationRun' {Maybe Int
Maybe Natural
Maybe Text
Maybe DataQualityEvaluationRunAdditionalRunOptions
NonEmpty Text
Text
DataSource
rulesetNames :: NonEmpty Text
role' :: Text
dataSource :: DataSource
timeout :: Maybe Natural
numberOfWorkers :: Maybe Int
clientToken :: Maybe Text
additionalRunOptions :: Maybe DataQualityEvaluationRunAdditionalRunOptions
$sel:rulesetNames:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> NonEmpty Text
$sel:role':StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Text
$sel:dataSource:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> DataSource
$sel:timeout:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Natural
$sel:numberOfWorkers:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Int
$sel:clientToken:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun -> Maybe Text
$sel:additionalRunOptions:StartDataQualityRulesetEvaluationRun' :: StartDataQualityRulesetEvaluationRun
-> Maybe DataQualityEvaluationRunAdditionalRunOptions
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AdditionalRunOptions" 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 DataQualityEvaluationRunAdditionalRunOptions
additionalRunOptions,
            (Key
"ClientToken" 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
clientToken,
            (Key
"NumberOfWorkers" 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
numberOfWorkers,
            (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"DataSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataSource
dataSource),
            forall a. a -> Maybe a
Prelude.Just (Key
"Role" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
role'),
            forall a. a -> Maybe a
Prelude.Just (Key
"RulesetNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
rulesetNames)
          ]
      )

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

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

-- | /See:/ 'newStartDataQualityRulesetEvaluationRunResponse' smart constructor.
data StartDataQualityRulesetEvaluationRunResponse = StartDataQualityRulesetEvaluationRunResponse'
  { -- | The unique run identifier associated with this run.
    StartDataQualityRulesetEvaluationRunResponse -> Maybe Text
runId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartDataQualityRulesetEvaluationRunResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartDataQualityRulesetEvaluationRunResponse
-> StartDataQualityRulesetEvaluationRunResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartDataQualityRulesetEvaluationRunResponse
-> StartDataQualityRulesetEvaluationRunResponse -> Bool
$c/= :: StartDataQualityRulesetEvaluationRunResponse
-> StartDataQualityRulesetEvaluationRunResponse -> Bool
== :: StartDataQualityRulesetEvaluationRunResponse
-> StartDataQualityRulesetEvaluationRunResponse -> Bool
$c== :: StartDataQualityRulesetEvaluationRunResponse
-> StartDataQualityRulesetEvaluationRunResponse -> Bool
Prelude.Eq, ReadPrec [StartDataQualityRulesetEvaluationRunResponse]
ReadPrec StartDataQualityRulesetEvaluationRunResponse
Int -> ReadS StartDataQualityRulesetEvaluationRunResponse
ReadS [StartDataQualityRulesetEvaluationRunResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartDataQualityRulesetEvaluationRunResponse]
$creadListPrec :: ReadPrec [StartDataQualityRulesetEvaluationRunResponse]
readPrec :: ReadPrec StartDataQualityRulesetEvaluationRunResponse
$creadPrec :: ReadPrec StartDataQualityRulesetEvaluationRunResponse
readList :: ReadS [StartDataQualityRulesetEvaluationRunResponse]
$creadList :: ReadS [StartDataQualityRulesetEvaluationRunResponse]
readsPrec :: Int -> ReadS StartDataQualityRulesetEvaluationRunResponse
$creadsPrec :: Int -> ReadS StartDataQualityRulesetEvaluationRunResponse
Prelude.Read, Int -> StartDataQualityRulesetEvaluationRunResponse -> ShowS
[StartDataQualityRulesetEvaluationRunResponse] -> ShowS
StartDataQualityRulesetEvaluationRunResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartDataQualityRulesetEvaluationRunResponse] -> ShowS
$cshowList :: [StartDataQualityRulesetEvaluationRunResponse] -> ShowS
show :: StartDataQualityRulesetEvaluationRunResponse -> String
$cshow :: StartDataQualityRulesetEvaluationRunResponse -> String
showsPrec :: Int -> StartDataQualityRulesetEvaluationRunResponse -> ShowS
$cshowsPrec :: Int -> StartDataQualityRulesetEvaluationRunResponse -> ShowS
Prelude.Show, forall x.
Rep StartDataQualityRulesetEvaluationRunResponse x
-> StartDataQualityRulesetEvaluationRunResponse
forall x.
StartDataQualityRulesetEvaluationRunResponse
-> Rep StartDataQualityRulesetEvaluationRunResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartDataQualityRulesetEvaluationRunResponse x
-> StartDataQualityRulesetEvaluationRunResponse
$cfrom :: forall x.
StartDataQualityRulesetEvaluationRunResponse
-> Rep StartDataQualityRulesetEvaluationRunResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartDataQualityRulesetEvaluationRunResponse' 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:
--
-- 'runId', 'startDataQualityRulesetEvaluationRunResponse_runId' - The unique run identifier associated with this run.
--
-- 'httpStatus', 'startDataQualityRulesetEvaluationRunResponse_httpStatus' - The response's http status code.
newStartDataQualityRulesetEvaluationRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartDataQualityRulesetEvaluationRunResponse
newStartDataQualityRulesetEvaluationRunResponse :: Int -> StartDataQualityRulesetEvaluationRunResponse
newStartDataQualityRulesetEvaluationRunResponse
  Int
pHttpStatus_ =
    StartDataQualityRulesetEvaluationRunResponse'
      { $sel:runId:StartDataQualityRulesetEvaluationRunResponse' :: Maybe Text
runId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:StartDataQualityRulesetEvaluationRunResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The unique run identifier associated with this run.
startDataQualityRulesetEvaluationRunResponse_runId :: Lens.Lens' StartDataQualityRulesetEvaluationRunResponse (Prelude.Maybe Prelude.Text)
startDataQualityRulesetEvaluationRunResponse_runId :: Lens' StartDataQualityRulesetEvaluationRunResponse (Maybe Text)
startDataQualityRulesetEvaluationRunResponse_runId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartDataQualityRulesetEvaluationRunResponse' {Maybe Text
runId :: Maybe Text
$sel:runId:StartDataQualityRulesetEvaluationRunResponse' :: StartDataQualityRulesetEvaluationRunResponse -> Maybe Text
runId} -> Maybe Text
runId) (\s :: StartDataQualityRulesetEvaluationRunResponse
s@StartDataQualityRulesetEvaluationRunResponse' {} Maybe Text
a -> StartDataQualityRulesetEvaluationRunResponse
s {$sel:runId:StartDataQualityRulesetEvaluationRunResponse' :: Maybe Text
runId = Maybe Text
a} :: StartDataQualityRulesetEvaluationRunResponse)

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

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