{-# 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.MechanicalTurk.ListQualificationTypes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The @ListQualificationTypes@ operation returns a list of Qualification
-- types, filtered by an optional search term.
--
-- This operation returns paginated results.
module Amazonka.MechanicalTurk.ListQualificationTypes
  ( -- * Creating a Request
    ListQualificationTypes (..),
    newListQualificationTypes,

    -- * Request Lenses
    listQualificationTypes_maxResults,
    listQualificationTypes_mustBeOwnedByCaller,
    listQualificationTypes_nextToken,
    listQualificationTypes_query,
    listQualificationTypes_mustBeRequestable,

    -- * Destructuring the Response
    ListQualificationTypesResponse (..),
    newListQualificationTypesResponse,

    -- * Response Lenses
    listQualificationTypesResponse_nextToken,
    listQualificationTypesResponse_numResults,
    listQualificationTypesResponse_qualificationTypes,
    listQualificationTypesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListQualificationTypes' smart constructor.
data ListQualificationTypes = ListQualificationTypes'
  { -- | The maximum number of results to return in a single call.
    ListQualificationTypes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Specifies that only Qualification types that the Requester created are
    -- returned. If false, the operation returns all Qualification types.
    ListQualificationTypes -> Maybe Bool
mustBeOwnedByCaller :: Prelude.Maybe Prelude.Bool,
    ListQualificationTypes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A text query against all of the searchable attributes of Qualification
    -- types.
    ListQualificationTypes -> Maybe Text
query :: Prelude.Maybe Prelude.Text,
    -- | Specifies that only Qualification types that a user can request through
    -- the Amazon Mechanical Turk web site, such as by taking a Qualification
    -- test, are returned as results of the search. Some Qualification types,
    -- such as those assigned automatically by the system, cannot be requested
    -- directly by users. If false, all Qualification types, including those
    -- managed by the system, are considered. Valid values are True | False.
    ListQualificationTypes -> Bool
mustBeRequestable :: Prelude.Bool
  }
  deriving (ListQualificationTypes -> ListQualificationTypes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQualificationTypes -> ListQualificationTypes -> Bool
$c/= :: ListQualificationTypes -> ListQualificationTypes -> Bool
== :: ListQualificationTypes -> ListQualificationTypes -> Bool
$c== :: ListQualificationTypes -> ListQualificationTypes -> Bool
Prelude.Eq, ReadPrec [ListQualificationTypes]
ReadPrec ListQualificationTypes
Int -> ReadS ListQualificationTypes
ReadS [ListQualificationTypes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQualificationTypes]
$creadListPrec :: ReadPrec [ListQualificationTypes]
readPrec :: ReadPrec ListQualificationTypes
$creadPrec :: ReadPrec ListQualificationTypes
readList :: ReadS [ListQualificationTypes]
$creadList :: ReadS [ListQualificationTypes]
readsPrec :: Int -> ReadS ListQualificationTypes
$creadsPrec :: Int -> ReadS ListQualificationTypes
Prelude.Read, Int -> ListQualificationTypes -> ShowS
[ListQualificationTypes] -> ShowS
ListQualificationTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQualificationTypes] -> ShowS
$cshowList :: [ListQualificationTypes] -> ShowS
show :: ListQualificationTypes -> String
$cshow :: ListQualificationTypes -> String
showsPrec :: Int -> ListQualificationTypes -> ShowS
$cshowsPrec :: Int -> ListQualificationTypes -> ShowS
Prelude.Show, forall x. Rep ListQualificationTypes x -> ListQualificationTypes
forall x. ListQualificationTypes -> Rep ListQualificationTypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListQualificationTypes x -> ListQualificationTypes
$cfrom :: forall x. ListQualificationTypes -> Rep ListQualificationTypes x
Prelude.Generic)

-- |
-- Create a value of 'ListQualificationTypes' 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:
--
-- 'maxResults', 'listQualificationTypes_maxResults' - The maximum number of results to return in a single call.
--
-- 'mustBeOwnedByCaller', 'listQualificationTypes_mustBeOwnedByCaller' - Specifies that only Qualification types that the Requester created are
-- returned. If false, the operation returns all Qualification types.
--
-- 'nextToken', 'listQualificationTypes_nextToken' - Undocumented member.
--
-- 'query', 'listQualificationTypes_query' - A text query against all of the searchable attributes of Qualification
-- types.
--
-- 'mustBeRequestable', 'listQualificationTypes_mustBeRequestable' - Specifies that only Qualification types that a user can request through
-- the Amazon Mechanical Turk web site, such as by taking a Qualification
-- test, are returned as results of the search. Some Qualification types,
-- such as those assigned automatically by the system, cannot be requested
-- directly by users. If false, all Qualification types, including those
-- managed by the system, are considered. Valid values are True | False.
newListQualificationTypes ::
  -- | 'mustBeRequestable'
  Prelude.Bool ->
  ListQualificationTypes
newListQualificationTypes :: Bool -> ListQualificationTypes
newListQualificationTypes Bool
pMustBeRequestable_ =
  ListQualificationTypes'
    { $sel:maxResults:ListQualificationTypes' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:mustBeOwnedByCaller:ListQualificationTypes' :: Maybe Bool
mustBeOwnedByCaller = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListQualificationTypes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:query:ListQualificationTypes' :: Maybe Text
query = forall a. Maybe a
Prelude.Nothing,
      $sel:mustBeRequestable:ListQualificationTypes' :: Bool
mustBeRequestable = Bool
pMustBeRequestable_
    }

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

-- | Specifies that only Qualification types that the Requester created are
-- returned. If false, the operation returns all Qualification types.
listQualificationTypes_mustBeOwnedByCaller :: Lens.Lens' ListQualificationTypes (Prelude.Maybe Prelude.Bool)
listQualificationTypes_mustBeOwnedByCaller :: Lens' ListQualificationTypes (Maybe Bool)
listQualificationTypes_mustBeOwnedByCaller = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypes' {Maybe Bool
mustBeOwnedByCaller :: Maybe Bool
$sel:mustBeOwnedByCaller:ListQualificationTypes' :: ListQualificationTypes -> Maybe Bool
mustBeOwnedByCaller} -> Maybe Bool
mustBeOwnedByCaller) (\s :: ListQualificationTypes
s@ListQualificationTypes' {} Maybe Bool
a -> ListQualificationTypes
s {$sel:mustBeOwnedByCaller:ListQualificationTypes' :: Maybe Bool
mustBeOwnedByCaller = Maybe Bool
a} :: ListQualificationTypes)

-- | Undocumented member.
listQualificationTypes_nextToken :: Lens.Lens' ListQualificationTypes (Prelude.Maybe Prelude.Text)
listQualificationTypes_nextToken :: Lens' ListQualificationTypes (Maybe Text)
listQualificationTypes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQualificationTypes
s@ListQualificationTypes' {} Maybe Text
a -> ListQualificationTypes
s {$sel:nextToken:ListQualificationTypes' :: Maybe Text
nextToken = Maybe Text
a} :: ListQualificationTypes)

-- | A text query against all of the searchable attributes of Qualification
-- types.
listQualificationTypes_query :: Lens.Lens' ListQualificationTypes (Prelude.Maybe Prelude.Text)
listQualificationTypes_query :: Lens' ListQualificationTypes (Maybe Text)
listQualificationTypes_query = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypes' {Maybe Text
query :: Maybe Text
$sel:query:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
query} -> Maybe Text
query) (\s :: ListQualificationTypes
s@ListQualificationTypes' {} Maybe Text
a -> ListQualificationTypes
s {$sel:query:ListQualificationTypes' :: Maybe Text
query = Maybe Text
a} :: ListQualificationTypes)

-- | Specifies that only Qualification types that a user can request through
-- the Amazon Mechanical Turk web site, such as by taking a Qualification
-- test, are returned as results of the search. Some Qualification types,
-- such as those assigned automatically by the system, cannot be requested
-- directly by users. If false, all Qualification types, including those
-- managed by the system, are considered. Valid values are True | False.
listQualificationTypes_mustBeRequestable :: Lens.Lens' ListQualificationTypes Prelude.Bool
listQualificationTypes_mustBeRequestable :: Lens' ListQualificationTypes Bool
listQualificationTypes_mustBeRequestable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypes' {Bool
mustBeRequestable :: Bool
$sel:mustBeRequestable:ListQualificationTypes' :: ListQualificationTypes -> Bool
mustBeRequestable} -> Bool
mustBeRequestable) (\s :: ListQualificationTypes
s@ListQualificationTypes' {} Bool
a -> ListQualificationTypes
s {$sel:mustBeRequestable:ListQualificationTypes' :: Bool
mustBeRequestable = Bool
a} :: ListQualificationTypes)

instance Core.AWSPager ListQualificationTypes where
  page :: ListQualificationTypes
-> AWSResponse ListQualificationTypes
-> Maybe ListQualificationTypes
page ListQualificationTypes
rq AWSResponse ListQualificationTypes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListQualificationTypes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListQualificationTypesResponse (Maybe Text)
listQualificationTypesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListQualificationTypes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListQualificationTypesResponse (Maybe [QualificationType])
listQualificationTypesResponse_qualificationTypes
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListQualificationTypes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListQualificationTypes (Maybe Text)
listQualificationTypes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListQualificationTypes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListQualificationTypesResponse (Maybe Text)
listQualificationTypesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListQualificationTypes where
  type
    AWSResponse ListQualificationTypes =
      ListQualificationTypesResponse
  request :: (Service -> Service)
-> ListQualificationTypes -> Request ListQualificationTypes
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 ListQualificationTypes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListQualificationTypes)))
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 Int
-> Maybe [QualificationType]
-> Int
-> ListQualificationTypesResponse
ListQualificationTypesResponse'
            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
"NumResults")
            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
"QualificationTypes"
                            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 ListQualificationTypes where
  hashWithSalt :: Int -> ListQualificationTypes -> Int
hashWithSalt Int
_salt ListQualificationTypes' {Bool
Maybe Bool
Maybe Natural
Maybe Text
mustBeRequestable :: Bool
query :: Maybe Text
nextToken :: Maybe Text
mustBeOwnedByCaller :: Maybe Bool
maxResults :: Maybe Natural
$sel:mustBeRequestable:ListQualificationTypes' :: ListQualificationTypes -> Bool
$sel:query:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
$sel:nextToken:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
$sel:mustBeOwnedByCaller:ListQualificationTypes' :: ListQualificationTypes -> Maybe Bool
$sel:maxResults:ListQualificationTypes' :: ListQualificationTypes -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
mustBeOwnedByCaller
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
query
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
mustBeRequestable

instance Prelude.NFData ListQualificationTypes where
  rnf :: ListQualificationTypes -> ()
rnf ListQualificationTypes' {Bool
Maybe Bool
Maybe Natural
Maybe Text
mustBeRequestable :: Bool
query :: Maybe Text
nextToken :: Maybe Text
mustBeOwnedByCaller :: Maybe Bool
maxResults :: Maybe Natural
$sel:mustBeRequestable:ListQualificationTypes' :: ListQualificationTypes -> Bool
$sel:query:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
$sel:nextToken:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
$sel:mustBeOwnedByCaller:ListQualificationTypes' :: ListQualificationTypes -> Maybe Bool
$sel:maxResults:ListQualificationTypes' :: ListQualificationTypes -> Maybe Natural
..} =
    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 Bool
mustBeOwnedByCaller
      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 Text
query
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
mustBeRequestable

instance Data.ToHeaders ListQualificationTypes where
  toHeaders :: ListQualificationTypes -> 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
"MTurkRequesterServiceV20170117.ListQualificationTypes" ::
                          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 ListQualificationTypes where
  toJSON :: ListQualificationTypes -> Value
toJSON ListQualificationTypes' {Bool
Maybe Bool
Maybe Natural
Maybe Text
mustBeRequestable :: Bool
query :: Maybe Text
nextToken :: Maybe Text
mustBeOwnedByCaller :: Maybe Bool
maxResults :: Maybe Natural
$sel:mustBeRequestable:ListQualificationTypes' :: ListQualificationTypes -> Bool
$sel:query:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
$sel:nextToken:ListQualificationTypes' :: ListQualificationTypes -> Maybe Text
$sel:mustBeOwnedByCaller:ListQualificationTypes' :: ListQualificationTypes -> Maybe Bool
$sel:maxResults:ListQualificationTypes' :: ListQualificationTypes -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"MustBeOwnedByCaller" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
mustBeOwnedByCaller,
            (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
"Query" 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
query,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"MustBeRequestable" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
mustBeRequestable)
          ]
      )

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

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

-- | /See:/ 'newListQualificationTypesResponse' smart constructor.
data ListQualificationTypesResponse = ListQualificationTypesResponse'
  { ListQualificationTypesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The number of Qualification types on this page in the filtered results
    -- list, equivalent to the number of types this operation returns.
    ListQualificationTypesResponse -> Maybe Int
numResults :: Prelude.Maybe Prelude.Int,
    -- | The list of QualificationType elements returned by the query.
    ListQualificationTypesResponse -> Maybe [QualificationType]
qualificationTypes :: Prelude.Maybe [QualificationType],
    -- | The response's http status code.
    ListQualificationTypesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListQualificationTypesResponse
-> ListQualificationTypesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQualificationTypesResponse
-> ListQualificationTypesResponse -> Bool
$c/= :: ListQualificationTypesResponse
-> ListQualificationTypesResponse -> Bool
== :: ListQualificationTypesResponse
-> ListQualificationTypesResponse -> Bool
$c== :: ListQualificationTypesResponse
-> ListQualificationTypesResponse -> Bool
Prelude.Eq, ReadPrec [ListQualificationTypesResponse]
ReadPrec ListQualificationTypesResponse
Int -> ReadS ListQualificationTypesResponse
ReadS [ListQualificationTypesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQualificationTypesResponse]
$creadListPrec :: ReadPrec [ListQualificationTypesResponse]
readPrec :: ReadPrec ListQualificationTypesResponse
$creadPrec :: ReadPrec ListQualificationTypesResponse
readList :: ReadS [ListQualificationTypesResponse]
$creadList :: ReadS [ListQualificationTypesResponse]
readsPrec :: Int -> ReadS ListQualificationTypesResponse
$creadsPrec :: Int -> ReadS ListQualificationTypesResponse
Prelude.Read, Int -> ListQualificationTypesResponse -> ShowS
[ListQualificationTypesResponse] -> ShowS
ListQualificationTypesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQualificationTypesResponse] -> ShowS
$cshowList :: [ListQualificationTypesResponse] -> ShowS
show :: ListQualificationTypesResponse -> String
$cshow :: ListQualificationTypesResponse -> String
showsPrec :: Int -> ListQualificationTypesResponse -> ShowS
$cshowsPrec :: Int -> ListQualificationTypesResponse -> ShowS
Prelude.Show, forall x.
Rep ListQualificationTypesResponse x
-> ListQualificationTypesResponse
forall x.
ListQualificationTypesResponse
-> Rep ListQualificationTypesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListQualificationTypesResponse x
-> ListQualificationTypesResponse
$cfrom :: forall x.
ListQualificationTypesResponse
-> Rep ListQualificationTypesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListQualificationTypesResponse' 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', 'listQualificationTypesResponse_nextToken' - Undocumented member.
--
-- 'numResults', 'listQualificationTypesResponse_numResults' - The number of Qualification types on this page in the filtered results
-- list, equivalent to the number of types this operation returns.
--
-- 'qualificationTypes', 'listQualificationTypesResponse_qualificationTypes' - The list of QualificationType elements returned by the query.
--
-- 'httpStatus', 'listQualificationTypesResponse_httpStatus' - The response's http status code.
newListQualificationTypesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListQualificationTypesResponse
newListQualificationTypesResponse :: Int -> ListQualificationTypesResponse
newListQualificationTypesResponse Int
pHttpStatus_ =
  ListQualificationTypesResponse'
    { $sel:nextToken:ListQualificationTypesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:numResults:ListQualificationTypesResponse' :: Maybe Int
numResults = forall a. Maybe a
Prelude.Nothing,
      $sel:qualificationTypes:ListQualificationTypesResponse' :: Maybe [QualificationType]
qualificationTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListQualificationTypesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
listQualificationTypesResponse_nextToken :: Lens.Lens' ListQualificationTypesResponse (Prelude.Maybe Prelude.Text)
listQualificationTypesResponse_nextToken :: Lens' ListQualificationTypesResponse (Maybe Text)
listQualificationTypesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQualificationTypesResponse
s@ListQualificationTypesResponse' {} Maybe Text
a -> ListQualificationTypesResponse
s {$sel:nextToken:ListQualificationTypesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListQualificationTypesResponse)

-- | The number of Qualification types on this page in the filtered results
-- list, equivalent to the number of types this operation returns.
listQualificationTypesResponse_numResults :: Lens.Lens' ListQualificationTypesResponse (Prelude.Maybe Prelude.Int)
listQualificationTypesResponse_numResults :: Lens' ListQualificationTypesResponse (Maybe Int)
listQualificationTypesResponse_numResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypesResponse' {Maybe Int
numResults :: Maybe Int
$sel:numResults:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> Maybe Int
numResults} -> Maybe Int
numResults) (\s :: ListQualificationTypesResponse
s@ListQualificationTypesResponse' {} Maybe Int
a -> ListQualificationTypesResponse
s {$sel:numResults:ListQualificationTypesResponse' :: Maybe Int
numResults = Maybe Int
a} :: ListQualificationTypesResponse)

-- | The list of QualificationType elements returned by the query.
listQualificationTypesResponse_qualificationTypes :: Lens.Lens' ListQualificationTypesResponse (Prelude.Maybe [QualificationType])
listQualificationTypesResponse_qualificationTypes :: Lens' ListQualificationTypesResponse (Maybe [QualificationType])
listQualificationTypesResponse_qualificationTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypesResponse' {Maybe [QualificationType]
qualificationTypes :: Maybe [QualificationType]
$sel:qualificationTypes:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> Maybe [QualificationType]
qualificationTypes} -> Maybe [QualificationType]
qualificationTypes) (\s :: ListQualificationTypesResponse
s@ListQualificationTypesResponse' {} Maybe [QualificationType]
a -> ListQualificationTypesResponse
s {$sel:qualificationTypes:ListQualificationTypesResponse' :: Maybe [QualificationType]
qualificationTypes = Maybe [QualificationType]
a} :: ListQualificationTypesResponse) 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.
listQualificationTypesResponse_httpStatus :: Lens.Lens' ListQualificationTypesResponse Prelude.Int
listQualificationTypesResponse_httpStatus :: Lens' ListQualificationTypesResponse Int
listQualificationTypesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQualificationTypesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListQualificationTypesResponse
s@ListQualificationTypesResponse' {} Int
a -> ListQualificationTypesResponse
s {$sel:httpStatus:ListQualificationTypesResponse' :: Int
httpStatus = Int
a} :: ListQualificationTypesResponse)

instance
  Prelude.NFData
    ListQualificationTypesResponse
  where
  rnf :: ListQualificationTypesResponse -> ()
rnf ListQualificationTypesResponse' {Int
Maybe Int
Maybe [QualificationType]
Maybe Text
httpStatus :: Int
qualificationTypes :: Maybe [QualificationType]
numResults :: Maybe Int
nextToken :: Maybe Text
$sel:httpStatus:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> Int
$sel:qualificationTypes:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> Maybe [QualificationType]
$sel:numResults:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> Maybe Int
$sel:nextToken:ListQualificationTypesResponse' :: ListQualificationTypesResponse -> 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 Int
numResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [QualificationType]
qualificationTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus