{-# 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.DeviceFarm.ListSuites
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about test suites for a given job.
--
-- This operation returns paginated results.
module Amazonka.DeviceFarm.ListSuites
  ( -- * Creating a Request
    ListSuites (..),
    newListSuites,

    -- * Request Lenses
    listSuites_nextToken,
    listSuites_arn,

    -- * Destructuring the Response
    ListSuitesResponse (..),
    newListSuitesResponse,

    -- * Response Lenses
    listSuitesResponse_nextToken,
    listSuitesResponse_suites,
    listSuitesResponse_httpStatus,
  )
where

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

-- | Represents a request to the list suites operation.
--
-- /See:/ 'newListSuites' smart constructor.
data ListSuites = ListSuites'
  { -- | An identifier that was returned from the previous call to this
    -- operation, which can be used to return the next set of items in the
    -- list.
    ListSuites -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The job\'s Amazon Resource Name (ARN).
    ListSuites -> Text
arn :: Prelude.Text
  }
  deriving (ListSuites -> ListSuites -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSuites -> ListSuites -> Bool
$c/= :: ListSuites -> ListSuites -> Bool
== :: ListSuites -> ListSuites -> Bool
$c== :: ListSuites -> ListSuites -> Bool
Prelude.Eq, ReadPrec [ListSuites]
ReadPrec ListSuites
Int -> ReadS ListSuites
ReadS [ListSuites]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSuites]
$creadListPrec :: ReadPrec [ListSuites]
readPrec :: ReadPrec ListSuites
$creadPrec :: ReadPrec ListSuites
readList :: ReadS [ListSuites]
$creadList :: ReadS [ListSuites]
readsPrec :: Int -> ReadS ListSuites
$creadsPrec :: Int -> ReadS ListSuites
Prelude.Read, Int -> ListSuites -> ShowS
[ListSuites] -> ShowS
ListSuites -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSuites] -> ShowS
$cshowList :: [ListSuites] -> ShowS
show :: ListSuites -> String
$cshow :: ListSuites -> String
showsPrec :: Int -> ListSuites -> ShowS
$cshowsPrec :: Int -> ListSuites -> ShowS
Prelude.Show, forall x. Rep ListSuites x -> ListSuites
forall x. ListSuites -> Rep ListSuites x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSuites x -> ListSuites
$cfrom :: forall x. ListSuites -> Rep ListSuites x
Prelude.Generic)

-- |
-- Create a value of 'ListSuites' 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', 'listSuites_nextToken' - An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
--
-- 'arn', 'listSuites_arn' - The job\'s Amazon Resource Name (ARN).
newListSuites ::
  -- | 'arn'
  Prelude.Text ->
  ListSuites
newListSuites :: Text -> ListSuites
newListSuites Text
pArn_ =
  ListSuites'
    { $sel:nextToken:ListSuites' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:ListSuites' :: Text
arn = Text
pArn_
    }

-- | An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
listSuites_nextToken :: Lens.Lens' ListSuites (Prelude.Maybe Prelude.Text)
listSuites_nextToken :: Lens' ListSuites (Maybe Text)
listSuites_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSuites' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSuites' :: ListSuites -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSuites
s@ListSuites' {} Maybe Text
a -> ListSuites
s {$sel:nextToken:ListSuites' :: Maybe Text
nextToken = Maybe Text
a} :: ListSuites)

-- | The job\'s Amazon Resource Name (ARN).
listSuites_arn :: Lens.Lens' ListSuites Prelude.Text
listSuites_arn :: Lens' ListSuites Text
listSuites_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSuites' {Text
arn :: Text
$sel:arn:ListSuites' :: ListSuites -> Text
arn} -> Text
arn) (\s :: ListSuites
s@ListSuites' {} Text
a -> ListSuites
s {$sel:arn:ListSuites' :: Text
arn = Text
a} :: ListSuites)

instance Core.AWSPager ListSuites where
  page :: ListSuites -> AWSResponse ListSuites -> Maybe ListSuites
page ListSuites
rq AWSResponse ListSuites
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSuites
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSuitesResponse (Maybe Text)
listSuitesResponse_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 ListSuites
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSuitesResponse (Maybe [Suite])
listSuitesResponse_suites
            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.$ ListSuites
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSuites (Maybe Text)
listSuites_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSuites
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSuitesResponse (Maybe Text)
listSuitesResponse_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 ListSuites where
  type AWSResponse ListSuites = ListSuitesResponse
  request :: (Service -> Service) -> ListSuites -> Request ListSuites
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 ListSuites
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListSuites)))
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 [Suite] -> Int -> ListSuitesResponse
ListSuitesResponse'
            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
"suites" 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 ListSuites where
  hashWithSalt :: Int -> ListSuites -> Int
hashWithSalt Int
_salt ListSuites' {Maybe Text
Text
arn :: Text
nextToken :: Maybe Text
$sel:arn:ListSuites' :: ListSuites -> Text
$sel:nextToken:ListSuites' :: ListSuites -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

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

instance Data.ToHeaders ListSuites where
  toHeaders :: ListSuites -> 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
"DeviceFarm_20150623.ListSuites" ::
                          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 ListSuites where
  toJSON :: ListSuites -> Value
toJSON ListSuites' {Maybe Text
Text
arn :: Text
nextToken :: Maybe Text
$sel:arn:ListSuites' :: ListSuites -> Text
$sel:nextToken:ListSuites' :: ListSuites -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)
          ]
      )

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

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

-- | Represents the result of a list suites request.
--
-- /See:/ 'newListSuitesResponse' smart constructor.
data ListSuitesResponse = ListSuitesResponse'
  { -- | If the number of items that are returned is significantly large, this is
    -- an identifier that is also returned. It can be used in a subsequent call
    -- to this operation to return the next set of items in the list.
    ListSuitesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the suites.
    ListSuitesResponse -> Maybe [Suite]
suites :: Prelude.Maybe [Suite],
    -- | The response's http status code.
    ListSuitesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListSuitesResponse -> ListSuitesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSuitesResponse -> ListSuitesResponse -> Bool
$c/= :: ListSuitesResponse -> ListSuitesResponse -> Bool
== :: ListSuitesResponse -> ListSuitesResponse -> Bool
$c== :: ListSuitesResponse -> ListSuitesResponse -> Bool
Prelude.Eq, ReadPrec [ListSuitesResponse]
ReadPrec ListSuitesResponse
Int -> ReadS ListSuitesResponse
ReadS [ListSuitesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSuitesResponse]
$creadListPrec :: ReadPrec [ListSuitesResponse]
readPrec :: ReadPrec ListSuitesResponse
$creadPrec :: ReadPrec ListSuitesResponse
readList :: ReadS [ListSuitesResponse]
$creadList :: ReadS [ListSuitesResponse]
readsPrec :: Int -> ReadS ListSuitesResponse
$creadsPrec :: Int -> ReadS ListSuitesResponse
Prelude.Read, Int -> ListSuitesResponse -> ShowS
[ListSuitesResponse] -> ShowS
ListSuitesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSuitesResponse] -> ShowS
$cshowList :: [ListSuitesResponse] -> ShowS
show :: ListSuitesResponse -> String
$cshow :: ListSuitesResponse -> String
showsPrec :: Int -> ListSuitesResponse -> ShowS
$cshowsPrec :: Int -> ListSuitesResponse -> ShowS
Prelude.Show, forall x. Rep ListSuitesResponse x -> ListSuitesResponse
forall x. ListSuitesResponse -> Rep ListSuitesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSuitesResponse x -> ListSuitesResponse
$cfrom :: forall x. ListSuitesResponse -> Rep ListSuitesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSuitesResponse' 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', 'listSuitesResponse_nextToken' - If the number of items that are returned is significantly large, this is
-- an identifier that is also returned. It can be used in a subsequent call
-- to this operation to return the next set of items in the list.
--
-- 'suites', 'listSuitesResponse_suites' - Information about the suites.
--
-- 'httpStatus', 'listSuitesResponse_httpStatus' - The response's http status code.
newListSuitesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSuitesResponse
newListSuitesResponse :: Int -> ListSuitesResponse
newListSuitesResponse Int
pHttpStatus_ =
  ListSuitesResponse'
    { $sel:nextToken:ListSuitesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:suites:ListSuitesResponse' :: Maybe [Suite]
suites = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSuitesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the number of items that are returned is significantly large, this is
-- an identifier that is also returned. It can be used in a subsequent call
-- to this operation to return the next set of items in the list.
listSuitesResponse_nextToken :: Lens.Lens' ListSuitesResponse (Prelude.Maybe Prelude.Text)
listSuitesResponse_nextToken :: Lens' ListSuitesResponse (Maybe Text)
listSuitesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSuitesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSuitesResponse' :: ListSuitesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSuitesResponse
s@ListSuitesResponse' {} Maybe Text
a -> ListSuitesResponse
s {$sel:nextToken:ListSuitesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSuitesResponse)

-- | Information about the suites.
listSuitesResponse_suites :: Lens.Lens' ListSuitesResponse (Prelude.Maybe [Suite])
listSuitesResponse_suites :: Lens' ListSuitesResponse (Maybe [Suite])
listSuitesResponse_suites = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSuitesResponse' {Maybe [Suite]
suites :: Maybe [Suite]
$sel:suites:ListSuitesResponse' :: ListSuitesResponse -> Maybe [Suite]
suites} -> Maybe [Suite]
suites) (\s :: ListSuitesResponse
s@ListSuitesResponse' {} Maybe [Suite]
a -> ListSuitesResponse
s {$sel:suites:ListSuitesResponse' :: Maybe [Suite]
suites = Maybe [Suite]
a} :: ListSuitesResponse) 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.
listSuitesResponse_httpStatus :: Lens.Lens' ListSuitesResponse Prelude.Int
listSuitesResponse_httpStatus :: Lens' ListSuitesResponse Int
listSuitesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSuitesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListSuitesResponse' :: ListSuitesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListSuitesResponse
s@ListSuitesResponse' {} Int
a -> ListSuitesResponse
s {$sel:httpStatus:ListSuitesResponse' :: Int
httpStatus = Int
a} :: ListSuitesResponse)

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