{-# 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.ListDataQualityRulesets
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a paginated list of rulesets for the specified list of Glue
-- tables.
module Amazonka.Glue.ListDataQualityRulesets
  ( -- * Creating a Request
    ListDataQualityRulesets (..),
    newListDataQualityRulesets,

    -- * Request Lenses
    listDataQualityRulesets_filter,
    listDataQualityRulesets_maxResults,
    listDataQualityRulesets_nextToken,
    listDataQualityRulesets_tags,

    -- * Destructuring the Response
    ListDataQualityRulesetsResponse (..),
    newListDataQualityRulesetsResponse,

    -- * Response Lenses
    listDataQualityRulesetsResponse_nextToken,
    listDataQualityRulesetsResponse_rulesets,
    listDataQualityRulesetsResponse_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:/ 'newListDataQualityRulesets' smart constructor.
data ListDataQualityRulesets = ListDataQualityRulesets'
  { -- | The filter criteria.
    ListDataQualityRulesets -> Maybe DataQualityRulesetFilterCriteria
filter' :: Prelude.Maybe DataQualityRulesetFilterCriteria,
    -- | The maximum number of results to return.
    ListDataQualityRulesets -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A paginated token to offset the results.
    ListDataQualityRulesets -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of key-value pair tags.
    ListDataQualityRulesets -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text)
  }
  deriving (ListDataQualityRulesets -> ListDataQualityRulesets -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDataQualityRulesets -> ListDataQualityRulesets -> Bool
$c/= :: ListDataQualityRulesets -> ListDataQualityRulesets -> Bool
== :: ListDataQualityRulesets -> ListDataQualityRulesets -> Bool
$c== :: ListDataQualityRulesets -> ListDataQualityRulesets -> Bool
Prelude.Eq, ReadPrec [ListDataQualityRulesets]
ReadPrec ListDataQualityRulesets
Int -> ReadS ListDataQualityRulesets
ReadS [ListDataQualityRulesets]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDataQualityRulesets]
$creadListPrec :: ReadPrec [ListDataQualityRulesets]
readPrec :: ReadPrec ListDataQualityRulesets
$creadPrec :: ReadPrec ListDataQualityRulesets
readList :: ReadS [ListDataQualityRulesets]
$creadList :: ReadS [ListDataQualityRulesets]
readsPrec :: Int -> ReadS ListDataQualityRulesets
$creadsPrec :: Int -> ReadS ListDataQualityRulesets
Prelude.Read, Int -> ListDataQualityRulesets -> ShowS
[ListDataQualityRulesets] -> ShowS
ListDataQualityRulesets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDataQualityRulesets] -> ShowS
$cshowList :: [ListDataQualityRulesets] -> ShowS
show :: ListDataQualityRulesets -> String
$cshow :: ListDataQualityRulesets -> String
showsPrec :: Int -> ListDataQualityRulesets -> ShowS
$cshowsPrec :: Int -> ListDataQualityRulesets -> ShowS
Prelude.Show, forall x. Rep ListDataQualityRulesets x -> ListDataQualityRulesets
forall x. ListDataQualityRulesets -> Rep ListDataQualityRulesets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListDataQualityRulesets x -> ListDataQualityRulesets
$cfrom :: forall x. ListDataQualityRulesets -> Rep ListDataQualityRulesets x
Prelude.Generic)

-- |
-- Create a value of 'ListDataQualityRulesets' 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:
--
-- 'filter'', 'listDataQualityRulesets_filter' - The filter criteria.
--
-- 'maxResults', 'listDataQualityRulesets_maxResults' - The maximum number of results to return.
--
-- 'nextToken', 'listDataQualityRulesets_nextToken' - A paginated token to offset the results.
--
-- 'tags', 'listDataQualityRulesets_tags' - A list of key-value pair tags.
newListDataQualityRulesets ::
  ListDataQualityRulesets
newListDataQualityRulesets :: ListDataQualityRulesets
newListDataQualityRulesets =
  ListDataQualityRulesets'
    { $sel:filter':ListDataQualityRulesets' :: Maybe DataQualityRulesetFilterCriteria
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListDataQualityRulesets' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListDataQualityRulesets' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ListDataQualityRulesets' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The filter criteria.
listDataQualityRulesets_filter :: Lens.Lens' ListDataQualityRulesets (Prelude.Maybe DataQualityRulesetFilterCriteria)
listDataQualityRulesets_filter :: Lens'
  ListDataQualityRulesets (Maybe DataQualityRulesetFilterCriteria)
listDataQualityRulesets_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDataQualityRulesets' {Maybe DataQualityRulesetFilterCriteria
filter' :: Maybe DataQualityRulesetFilterCriteria
$sel:filter':ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe DataQualityRulesetFilterCriteria
filter'} -> Maybe DataQualityRulesetFilterCriteria
filter') (\s :: ListDataQualityRulesets
s@ListDataQualityRulesets' {} Maybe DataQualityRulesetFilterCriteria
a -> ListDataQualityRulesets
s {$sel:filter':ListDataQualityRulesets' :: Maybe DataQualityRulesetFilterCriteria
filter' = Maybe DataQualityRulesetFilterCriteria
a} :: ListDataQualityRulesets)

-- | The maximum number of results to return.
listDataQualityRulesets_maxResults :: Lens.Lens' ListDataQualityRulesets (Prelude.Maybe Prelude.Natural)
listDataQualityRulesets_maxResults :: Lens' ListDataQualityRulesets (Maybe Natural)
listDataQualityRulesets_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDataQualityRulesets' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListDataQualityRulesets
s@ListDataQualityRulesets' {} Maybe Natural
a -> ListDataQualityRulesets
s {$sel:maxResults:ListDataQualityRulesets' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListDataQualityRulesets)

-- | A paginated token to offset the results.
listDataQualityRulesets_nextToken :: Lens.Lens' ListDataQualityRulesets (Prelude.Maybe Prelude.Text)
listDataQualityRulesets_nextToken :: Lens' ListDataQualityRulesets (Maybe Text)
listDataQualityRulesets_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDataQualityRulesets' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDataQualityRulesets
s@ListDataQualityRulesets' {} Maybe Text
a -> ListDataQualityRulesets
s {$sel:nextToken:ListDataQualityRulesets' :: Maybe Text
nextToken = Maybe Text
a} :: ListDataQualityRulesets)

-- | A list of key-value pair tags.
listDataQualityRulesets_tags :: Lens.Lens' ListDataQualityRulesets (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
listDataQualityRulesets_tags :: Lens' ListDataQualityRulesets (Maybe (HashMap Text Text))
listDataQualityRulesets_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDataQualityRulesets' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: ListDataQualityRulesets
s@ListDataQualityRulesets' {} Maybe (HashMap Text Text)
a -> ListDataQualityRulesets
s {$sel:tags:ListDataQualityRulesets' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: ListDataQualityRulesets) 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

instance Core.AWSRequest ListDataQualityRulesets where
  type
    AWSResponse ListDataQualityRulesets =
      ListDataQualityRulesetsResponse
  request :: (Service -> Service)
-> ListDataQualityRulesets -> Request ListDataQualityRulesets
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 ListDataQualityRulesets
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListDataQualityRulesets)))
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
-> Maybe [DataQualityRulesetListDetails]
-> Int
-> ListDataQualityRulesetsResponse
ListDataQualityRulesetsResponse'
            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
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Rulesets" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 ListDataQualityRulesets where
  hashWithSalt :: Int -> ListDataQualityRulesets -> Int
hashWithSalt Int
_salt ListDataQualityRulesets' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe DataQualityRulesetFilterCriteria
tags :: Maybe (HashMap Text Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe DataQualityRulesetFilterCriteria
$sel:tags:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe (HashMap Text Text)
$sel:nextToken:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Text
$sel:maxResults:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Natural
$sel:filter':ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe DataQualityRulesetFilterCriteria
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataQualityRulesetFilterCriteria
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags

instance Prelude.NFData ListDataQualityRulesets where
  rnf :: ListDataQualityRulesets -> ()
rnf ListDataQualityRulesets' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe DataQualityRulesetFilterCriteria
tags :: Maybe (HashMap Text Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe DataQualityRulesetFilterCriteria
$sel:tags:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe (HashMap Text Text)
$sel:nextToken:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Text
$sel:maxResults:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Natural
$sel:filter':ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe DataQualityRulesetFilterCriteria
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataQualityRulesetFilterCriteria
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags

instance Data.ToHeaders ListDataQualityRulesets where
  toHeaders :: ListDataQualityRulesets -> 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.ListDataQualityRulesets" ::
                          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 ListDataQualityRulesets where
  toJSON :: ListDataQualityRulesets -> Value
toJSON ListDataQualityRulesets' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe DataQualityRulesetFilterCriteria
tags :: Maybe (HashMap Text Text)
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe DataQualityRulesetFilterCriteria
$sel:tags:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe (HashMap Text Text)
$sel:nextToken:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Text
$sel:maxResults:ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe Natural
$sel:filter':ListDataQualityRulesets' :: ListDataQualityRulesets -> Maybe DataQualityRulesetFilterCriteria
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Filter" 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 DataQualityRulesetFilterCriteria
filter',
            (Key
"MaxResults" 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
maxResults,
            (Key
"NextToken" 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
nextToken,
            (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
          ]
      )

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

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

-- | /See:/ 'newListDataQualityRulesetsResponse' smart constructor.
data ListDataQualityRulesetsResponse = ListDataQualityRulesetsResponse'
  { -- | A pagination token, if more results are available.
    ListDataQualityRulesetsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A paginated list of rulesets for the specified list of Glue tables.
    ListDataQualityRulesetsResponse
-> Maybe [DataQualityRulesetListDetails]
rulesets :: Prelude.Maybe [DataQualityRulesetListDetails],
    -- | The response's http status code.
    ListDataQualityRulesetsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListDataQualityRulesetsResponse
-> ListDataQualityRulesetsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDataQualityRulesetsResponse
-> ListDataQualityRulesetsResponse -> Bool
$c/= :: ListDataQualityRulesetsResponse
-> ListDataQualityRulesetsResponse -> Bool
== :: ListDataQualityRulesetsResponse
-> ListDataQualityRulesetsResponse -> Bool
$c== :: ListDataQualityRulesetsResponse
-> ListDataQualityRulesetsResponse -> Bool
Prelude.Eq, ReadPrec [ListDataQualityRulesetsResponse]
ReadPrec ListDataQualityRulesetsResponse
Int -> ReadS ListDataQualityRulesetsResponse
ReadS [ListDataQualityRulesetsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDataQualityRulesetsResponse]
$creadListPrec :: ReadPrec [ListDataQualityRulesetsResponse]
readPrec :: ReadPrec ListDataQualityRulesetsResponse
$creadPrec :: ReadPrec ListDataQualityRulesetsResponse
readList :: ReadS [ListDataQualityRulesetsResponse]
$creadList :: ReadS [ListDataQualityRulesetsResponse]
readsPrec :: Int -> ReadS ListDataQualityRulesetsResponse
$creadsPrec :: Int -> ReadS ListDataQualityRulesetsResponse
Prelude.Read, Int -> ListDataQualityRulesetsResponse -> ShowS
[ListDataQualityRulesetsResponse] -> ShowS
ListDataQualityRulesetsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDataQualityRulesetsResponse] -> ShowS
$cshowList :: [ListDataQualityRulesetsResponse] -> ShowS
show :: ListDataQualityRulesetsResponse -> String
$cshow :: ListDataQualityRulesetsResponse -> String
showsPrec :: Int -> ListDataQualityRulesetsResponse -> ShowS
$cshowsPrec :: Int -> ListDataQualityRulesetsResponse -> ShowS
Prelude.Show, forall x.
Rep ListDataQualityRulesetsResponse x
-> ListDataQualityRulesetsResponse
forall x.
ListDataQualityRulesetsResponse
-> Rep ListDataQualityRulesetsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListDataQualityRulesetsResponse x
-> ListDataQualityRulesetsResponse
$cfrom :: forall x.
ListDataQualityRulesetsResponse
-> Rep ListDataQualityRulesetsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListDataQualityRulesetsResponse' 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:
--
-- 'nextToken', 'listDataQualityRulesetsResponse_nextToken' - A pagination token, if more results are available.
--
-- 'rulesets', 'listDataQualityRulesetsResponse_rulesets' - A paginated list of rulesets for the specified list of Glue tables.
--
-- 'httpStatus', 'listDataQualityRulesetsResponse_httpStatus' - The response's http status code.
newListDataQualityRulesetsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListDataQualityRulesetsResponse
newListDataQualityRulesetsResponse :: Int -> ListDataQualityRulesetsResponse
newListDataQualityRulesetsResponse Int
pHttpStatus_ =
  ListDataQualityRulesetsResponse'
    { $sel:nextToken:ListDataQualityRulesetsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:rulesets:ListDataQualityRulesetsResponse' :: Maybe [DataQualityRulesetListDetails]
rulesets = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListDataQualityRulesetsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A pagination token, if more results are available.
listDataQualityRulesetsResponse_nextToken :: Lens.Lens' ListDataQualityRulesetsResponse (Prelude.Maybe Prelude.Text)
listDataQualityRulesetsResponse_nextToken :: Lens' ListDataQualityRulesetsResponse (Maybe Text)
listDataQualityRulesetsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDataQualityRulesetsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDataQualityRulesetsResponse' :: ListDataQualityRulesetsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDataQualityRulesetsResponse
s@ListDataQualityRulesetsResponse' {} Maybe Text
a -> ListDataQualityRulesetsResponse
s {$sel:nextToken:ListDataQualityRulesetsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListDataQualityRulesetsResponse)

-- | A paginated list of rulesets for the specified list of Glue tables.
listDataQualityRulesetsResponse_rulesets :: Lens.Lens' ListDataQualityRulesetsResponse (Prelude.Maybe [DataQualityRulesetListDetails])
listDataQualityRulesetsResponse_rulesets :: Lens'
  ListDataQualityRulesetsResponse
  (Maybe [DataQualityRulesetListDetails])
listDataQualityRulesetsResponse_rulesets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDataQualityRulesetsResponse' {Maybe [DataQualityRulesetListDetails]
rulesets :: Maybe [DataQualityRulesetListDetails]
$sel:rulesets:ListDataQualityRulesetsResponse' :: ListDataQualityRulesetsResponse
-> Maybe [DataQualityRulesetListDetails]
rulesets} -> Maybe [DataQualityRulesetListDetails]
rulesets) (\s :: ListDataQualityRulesetsResponse
s@ListDataQualityRulesetsResponse' {} Maybe [DataQualityRulesetListDetails]
a -> ListDataQualityRulesetsResponse
s {$sel:rulesets:ListDataQualityRulesetsResponse' :: Maybe [DataQualityRulesetListDetails]
rulesets = Maybe [DataQualityRulesetListDetails]
a} :: ListDataQualityRulesetsResponse) 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 response's http status code.
listDataQualityRulesetsResponse_httpStatus :: Lens.Lens' ListDataQualityRulesetsResponse Prelude.Int
listDataQualityRulesetsResponse_httpStatus :: Lens' ListDataQualityRulesetsResponse Int
listDataQualityRulesetsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDataQualityRulesetsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListDataQualityRulesetsResponse' :: ListDataQualityRulesetsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListDataQualityRulesetsResponse
s@ListDataQualityRulesetsResponse' {} Int
a -> ListDataQualityRulesetsResponse
s {$sel:httpStatus:ListDataQualityRulesetsResponse' :: Int
httpStatus = Int
a} :: ListDataQualityRulesetsResponse)

instance
  Prelude.NFData
    ListDataQualityRulesetsResponse
  where
  rnf :: ListDataQualityRulesetsResponse -> ()
rnf ListDataQualityRulesetsResponse' {Int
Maybe [DataQualityRulesetListDetails]
Maybe Text
httpStatus :: Int
rulesets :: Maybe [DataQualityRulesetListDetails]
nextToken :: Maybe Text
$sel:httpStatus:ListDataQualityRulesetsResponse' :: ListDataQualityRulesetsResponse -> Int
$sel:rulesets:ListDataQualityRulesetsResponse' :: ListDataQualityRulesetsResponse
-> Maybe [DataQualityRulesetListDetails]
$sel:nextToken:ListDataQualityRulesetsResponse' :: ListDataQualityRulesetsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataQualityRulesetListDetails]
rulesets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus