{-# 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.ListHITs
-- 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 @ListHITs@ operation returns all of a Requester\'s HITs. The
-- operation returns HITs of any status, except for HITs that have been
-- deleted of with the DeleteHIT operation or that have been auto-deleted.
--
-- This operation returns paginated results.
module Amazonka.MechanicalTurk.ListHITs
  ( -- * Creating a Request
    ListHITs (..),
    newListHITs,

    -- * Request Lenses
    listHITs_maxResults,
    listHITs_nextToken,

    -- * Destructuring the Response
    ListHITsResponse (..),
    newListHITsResponse,

    -- * Response Lenses
    listHITsResponse_hITs,
    listHITsResponse_nextToken,
    listHITsResponse_numResults,
    listHITsResponse_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:/ 'newListHITs' smart constructor.
data ListHITs = ListHITs'
  { ListHITs -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Pagination token
    ListHITs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListHITs -> ListHITs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHITs -> ListHITs -> Bool
$c/= :: ListHITs -> ListHITs -> Bool
== :: ListHITs -> ListHITs -> Bool
$c== :: ListHITs -> ListHITs -> Bool
Prelude.Eq, ReadPrec [ListHITs]
ReadPrec ListHITs
Int -> ReadS ListHITs
ReadS [ListHITs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHITs]
$creadListPrec :: ReadPrec [ListHITs]
readPrec :: ReadPrec ListHITs
$creadPrec :: ReadPrec ListHITs
readList :: ReadS [ListHITs]
$creadList :: ReadS [ListHITs]
readsPrec :: Int -> ReadS ListHITs
$creadsPrec :: Int -> ReadS ListHITs
Prelude.Read, Int -> ListHITs -> ShowS
[ListHITs] -> ShowS
ListHITs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHITs] -> ShowS
$cshowList :: [ListHITs] -> ShowS
show :: ListHITs -> String
$cshow :: ListHITs -> String
showsPrec :: Int -> ListHITs -> ShowS
$cshowsPrec :: Int -> ListHITs -> ShowS
Prelude.Show, forall x. Rep ListHITs x -> ListHITs
forall x. ListHITs -> Rep ListHITs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHITs x -> ListHITs
$cfrom :: forall x. ListHITs -> Rep ListHITs x
Prelude.Generic)

-- |
-- Create a value of 'ListHITs' 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', 'listHITs_maxResults' - Undocumented member.
--
-- 'nextToken', 'listHITs_nextToken' - Pagination token
newListHITs ::
  ListHITs
newListHITs :: ListHITs
newListHITs =
  ListHITs'
    { $sel:maxResults:ListHITs' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListHITs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
listHITs_maxResults :: Lens.Lens' ListHITs (Prelude.Maybe Prelude.Natural)
listHITs_maxResults :: Lens' ListHITs (Maybe Natural)
listHITs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHITs' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListHITs' :: ListHITs -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListHITs
s@ListHITs' {} Maybe Natural
a -> ListHITs
s {$sel:maxResults:ListHITs' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListHITs)

-- | Pagination token
listHITs_nextToken :: Lens.Lens' ListHITs (Prelude.Maybe Prelude.Text)
listHITs_nextToken :: Lens' ListHITs (Maybe Text)
listHITs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHITs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListHITs' :: ListHITs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListHITs
s@ListHITs' {} Maybe Text
a -> ListHITs
s {$sel:nextToken:ListHITs' :: Maybe Text
nextToken = Maybe Text
a} :: ListHITs)

instance Core.AWSPager ListHITs where
  page :: ListHITs -> AWSResponse ListHITs -> Maybe ListHITs
page ListHITs
rq AWSResponse ListHITs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListHITs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHITsResponse (Maybe Text)
listHITsResponse_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 ListHITs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHITsResponse (Maybe [HIT])
listHITsResponse_hITs
            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.$ ListHITs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListHITs (Maybe Text)
listHITs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListHITs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListHITsResponse (Maybe Text)
listHITsResponse_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 ListHITs where
  type AWSResponse ListHITs = ListHITsResponse
  request :: (Service -> Service) -> ListHITs -> Request ListHITs
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 ListHITs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListHITs)))
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 [HIT] -> Maybe Text -> Maybe Int -> Int -> ListHITsResponse
ListHITsResponse'
            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
"HITs" 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.<*> (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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListHITs where
  hashWithSalt :: Int -> ListHITs -> Int
hashWithSalt Int
_salt ListHITs' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListHITs' :: ListHITs -> Maybe Text
$sel:maxResults:ListHITs' :: ListHITs -> 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 Text
nextToken

instance Prelude.NFData ListHITs where
  rnf :: ListHITs -> ()
rnf ListHITs' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListHITs' :: ListHITs -> Maybe Text
$sel:maxResults:ListHITs' :: ListHITs -> 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 Text
nextToken

instance Data.ToHeaders ListHITs where
  toHeaders :: ListHITs -> 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.ListHITs" ::
                          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 ListHITs where
  toJSON :: ListHITs -> Value
toJSON ListHITs' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListHITs' :: ListHITs -> Maybe Text
$sel:maxResults:ListHITs' :: ListHITs -> 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
"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
          ]
      )

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

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

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

-- |
-- Create a value of 'ListHITsResponse' 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:
--
-- 'hITs', 'listHITsResponse_hITs' - The list of HIT elements returned by the query.
--
-- 'nextToken', 'listHITsResponse_nextToken' - Undocumented member.
--
-- 'numResults', 'listHITsResponse_numResults' - The number of HITs on this page in the filtered results list, equivalent
-- to the number of HITs being returned by this call.
--
-- 'httpStatus', 'listHITsResponse_httpStatus' - The response's http status code.
newListHITsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListHITsResponse
newListHITsResponse :: Int -> ListHITsResponse
newListHITsResponse Int
pHttpStatus_ =
  ListHITsResponse'
    { $sel:hITs:ListHITsResponse' :: Maybe [HIT]
hITs = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListHITsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:numResults:ListHITsResponse' :: Maybe Int
numResults = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListHITsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of HIT elements returned by the query.
listHITsResponse_hITs :: Lens.Lens' ListHITsResponse (Prelude.Maybe [HIT])
listHITsResponse_hITs :: Lens' ListHITsResponse (Maybe [HIT])
listHITsResponse_hITs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHITsResponse' {Maybe [HIT]
hITs :: Maybe [HIT]
$sel:hITs:ListHITsResponse' :: ListHITsResponse -> Maybe [HIT]
hITs} -> Maybe [HIT]
hITs) (\s :: ListHITsResponse
s@ListHITsResponse' {} Maybe [HIT]
a -> ListHITsResponse
s {$sel:hITs:ListHITsResponse' :: Maybe [HIT]
hITs = Maybe [HIT]
a} :: ListHITsResponse) 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

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

-- | The number of HITs on this page in the filtered results list, equivalent
-- to the number of HITs being returned by this call.
listHITsResponse_numResults :: Lens.Lens' ListHITsResponse (Prelude.Maybe Prelude.Int)
listHITsResponse_numResults :: Lens' ListHITsResponse (Maybe Int)
listHITsResponse_numResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHITsResponse' {Maybe Int
numResults :: Maybe Int
$sel:numResults:ListHITsResponse' :: ListHITsResponse -> Maybe Int
numResults} -> Maybe Int
numResults) (\s :: ListHITsResponse
s@ListHITsResponse' {} Maybe Int
a -> ListHITsResponse
s {$sel:numResults:ListHITsResponse' :: Maybe Int
numResults = Maybe Int
a} :: ListHITsResponse)

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

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