{-# 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.SageMaker.ListWorkforces
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this operation to list all private and vendor workforces in an
-- Amazon Web Services Region. Note that you can only have one private
-- workforce per Amazon Web Services Region.
--
-- This operation returns paginated results.
module Amazonka.SageMaker.ListWorkforces
  ( -- * Creating a Request
    ListWorkforces (..),
    newListWorkforces,

    -- * Request Lenses
    listWorkforces_maxResults,
    listWorkforces_nameContains,
    listWorkforces_nextToken,
    listWorkforces_sortBy,
    listWorkforces_sortOrder,

    -- * Destructuring the Response
    ListWorkforcesResponse (..),
    newListWorkforcesResponse,

    -- * Response Lenses
    listWorkforcesResponse_nextToken,
    listWorkforcesResponse_httpStatus,
    listWorkforcesResponse_workforces,
  )
where

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

-- | /See:/ 'newListWorkforces' smart constructor.
data ListWorkforces = ListWorkforces'
  { -- | The maximum number of workforces returned in the response.
    ListWorkforces -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A filter you can use to search for workforces using part of the
    -- workforce name.
    ListWorkforces -> Maybe Text
nameContains :: Prelude.Maybe Prelude.Text,
    -- | A token to resume pagination.
    ListWorkforces -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Sort workforces using the workforce name or creation date.
    ListWorkforces -> Maybe ListWorkforcesSortByOptions
sortBy :: Prelude.Maybe ListWorkforcesSortByOptions,
    -- | Sort workforces in ascending or descending order.
    ListWorkforces -> Maybe SortOrder
sortOrder :: Prelude.Maybe SortOrder
  }
  deriving (ListWorkforces -> ListWorkforces -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListWorkforces -> ListWorkforces -> Bool
$c/= :: ListWorkforces -> ListWorkforces -> Bool
== :: ListWorkforces -> ListWorkforces -> Bool
$c== :: ListWorkforces -> ListWorkforces -> Bool
Prelude.Eq, ReadPrec [ListWorkforces]
ReadPrec ListWorkforces
Int -> ReadS ListWorkforces
ReadS [ListWorkforces]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListWorkforces]
$creadListPrec :: ReadPrec [ListWorkforces]
readPrec :: ReadPrec ListWorkforces
$creadPrec :: ReadPrec ListWorkforces
readList :: ReadS [ListWorkforces]
$creadList :: ReadS [ListWorkforces]
readsPrec :: Int -> ReadS ListWorkforces
$creadsPrec :: Int -> ReadS ListWorkforces
Prelude.Read, Int -> ListWorkforces -> ShowS
[ListWorkforces] -> ShowS
ListWorkforces -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListWorkforces] -> ShowS
$cshowList :: [ListWorkforces] -> ShowS
show :: ListWorkforces -> String
$cshow :: ListWorkforces -> String
showsPrec :: Int -> ListWorkforces -> ShowS
$cshowsPrec :: Int -> ListWorkforces -> ShowS
Prelude.Show, forall x. Rep ListWorkforces x -> ListWorkforces
forall x. ListWorkforces -> Rep ListWorkforces x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListWorkforces x -> ListWorkforces
$cfrom :: forall x. ListWorkforces -> Rep ListWorkforces x
Prelude.Generic)

-- |
-- Create a value of 'ListWorkforces' 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', 'listWorkforces_maxResults' - The maximum number of workforces returned in the response.
--
-- 'nameContains', 'listWorkforces_nameContains' - A filter you can use to search for workforces using part of the
-- workforce name.
--
-- 'nextToken', 'listWorkforces_nextToken' - A token to resume pagination.
--
-- 'sortBy', 'listWorkforces_sortBy' - Sort workforces using the workforce name or creation date.
--
-- 'sortOrder', 'listWorkforces_sortOrder' - Sort workforces in ascending or descending order.
newListWorkforces ::
  ListWorkforces
newListWorkforces :: ListWorkforces
newListWorkforces =
  ListWorkforces'
    { $sel:maxResults:ListWorkforces' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nameContains:ListWorkforces' :: Maybe Text
nameContains = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListWorkforces' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListWorkforces' :: Maybe ListWorkforcesSortByOptions
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:ListWorkforces' :: Maybe SortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of workforces returned in the response.
listWorkforces_maxResults :: Lens.Lens' ListWorkforces (Prelude.Maybe Prelude.Natural)
listWorkforces_maxResults :: Lens' ListWorkforces (Maybe Natural)
listWorkforces_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListWorkforces' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListWorkforces' :: ListWorkforces -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListWorkforces
s@ListWorkforces' {} Maybe Natural
a -> ListWorkforces
s {$sel:maxResults:ListWorkforces' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListWorkforces)

-- | A filter you can use to search for workforces using part of the
-- workforce name.
listWorkforces_nameContains :: Lens.Lens' ListWorkforces (Prelude.Maybe Prelude.Text)
listWorkforces_nameContains :: Lens' ListWorkforces (Maybe Text)
listWorkforces_nameContains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListWorkforces' {Maybe Text
nameContains :: Maybe Text
$sel:nameContains:ListWorkforces' :: ListWorkforces -> Maybe Text
nameContains} -> Maybe Text
nameContains) (\s :: ListWorkforces
s@ListWorkforces' {} Maybe Text
a -> ListWorkforces
s {$sel:nameContains:ListWorkforces' :: Maybe Text
nameContains = Maybe Text
a} :: ListWorkforces)

-- | A token to resume pagination.
listWorkforces_nextToken :: Lens.Lens' ListWorkforces (Prelude.Maybe Prelude.Text)
listWorkforces_nextToken :: Lens' ListWorkforces (Maybe Text)
listWorkforces_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListWorkforces' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListWorkforces' :: ListWorkforces -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListWorkforces
s@ListWorkforces' {} Maybe Text
a -> ListWorkforces
s {$sel:nextToken:ListWorkforces' :: Maybe Text
nextToken = Maybe Text
a} :: ListWorkforces)

-- | Sort workforces using the workforce name or creation date.
listWorkforces_sortBy :: Lens.Lens' ListWorkforces (Prelude.Maybe ListWorkforcesSortByOptions)
listWorkforces_sortBy :: Lens' ListWorkforces (Maybe ListWorkforcesSortByOptions)
listWorkforces_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListWorkforces' {Maybe ListWorkforcesSortByOptions
sortBy :: Maybe ListWorkforcesSortByOptions
$sel:sortBy:ListWorkforces' :: ListWorkforces -> Maybe ListWorkforcesSortByOptions
sortBy} -> Maybe ListWorkforcesSortByOptions
sortBy) (\s :: ListWorkforces
s@ListWorkforces' {} Maybe ListWorkforcesSortByOptions
a -> ListWorkforces
s {$sel:sortBy:ListWorkforces' :: Maybe ListWorkforcesSortByOptions
sortBy = Maybe ListWorkforcesSortByOptions
a} :: ListWorkforces)

-- | Sort workforces in ascending or descending order.
listWorkforces_sortOrder :: Lens.Lens' ListWorkforces (Prelude.Maybe SortOrder)
listWorkforces_sortOrder :: Lens' ListWorkforces (Maybe SortOrder)
listWorkforces_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListWorkforces' {Maybe SortOrder
sortOrder :: Maybe SortOrder
$sel:sortOrder:ListWorkforces' :: ListWorkforces -> Maybe SortOrder
sortOrder} -> Maybe SortOrder
sortOrder) (\s :: ListWorkforces
s@ListWorkforces' {} Maybe SortOrder
a -> ListWorkforces
s {$sel:sortOrder:ListWorkforces' :: Maybe SortOrder
sortOrder = Maybe SortOrder
a} :: ListWorkforces)

instance Core.AWSPager ListWorkforces where
  page :: ListWorkforces
-> AWSResponse ListWorkforces -> Maybe ListWorkforces
page ListWorkforces
rq AWSResponse ListWorkforces
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListWorkforces
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListWorkforcesResponse (Maybe Text)
listWorkforcesResponse_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 ListWorkforces
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListWorkforcesResponse [Workforce]
listWorkforcesResponse_workforces) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListWorkforces
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListWorkforces (Maybe Text)
listWorkforces_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListWorkforces
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListWorkforcesResponse (Maybe Text)
listWorkforcesResponse_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 ListWorkforces where
  type
    AWSResponse ListWorkforces =
      ListWorkforcesResponse
  request :: (Service -> Service) -> ListWorkforces -> Request ListWorkforces
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 ListWorkforces
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListWorkforces)))
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 -> [Workforce] -> ListWorkforcesResponse
ListWorkforcesResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            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
"Workforces" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ListWorkforces where
  hashWithSalt :: Int -> ListWorkforces -> Int
hashWithSalt Int
_salt ListWorkforces' {Maybe Natural
Maybe Text
Maybe ListWorkforcesSortByOptions
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe ListWorkforcesSortByOptions
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
$sel:sortOrder:ListWorkforces' :: ListWorkforces -> Maybe SortOrder
$sel:sortBy:ListWorkforces' :: ListWorkforces -> Maybe ListWorkforcesSortByOptions
$sel:nextToken:ListWorkforces' :: ListWorkforces -> Maybe Text
$sel:nameContains:ListWorkforces' :: ListWorkforces -> Maybe Text
$sel:maxResults:ListWorkforces' :: ListWorkforces -> 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
nameContains
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ListWorkforcesSortByOptions
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrder
sortOrder

instance Prelude.NFData ListWorkforces where
  rnf :: ListWorkforces -> ()
rnf ListWorkforces' {Maybe Natural
Maybe Text
Maybe ListWorkforcesSortByOptions
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe ListWorkforcesSortByOptions
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
$sel:sortOrder:ListWorkforces' :: ListWorkforces -> Maybe SortOrder
$sel:sortBy:ListWorkforces' :: ListWorkforces -> Maybe ListWorkforcesSortByOptions
$sel:nextToken:ListWorkforces' :: ListWorkforces -> Maybe Text
$sel:nameContains:ListWorkforces' :: ListWorkforces -> Maybe Text
$sel:maxResults:ListWorkforces' :: ListWorkforces -> 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
nameContains
      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 ListWorkforcesSortByOptions
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrder
sortOrder

instance Data.ToHeaders ListWorkforces where
  toHeaders :: ListWorkforces -> 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
"SageMaker.ListWorkforces" :: 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 ListWorkforces where
  toJSON :: ListWorkforces -> Value
toJSON ListWorkforces' {Maybe Natural
Maybe Text
Maybe ListWorkforcesSortByOptions
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe ListWorkforcesSortByOptions
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
$sel:sortOrder:ListWorkforces' :: ListWorkforces -> Maybe SortOrder
$sel:sortBy:ListWorkforces' :: ListWorkforces -> Maybe ListWorkforcesSortByOptions
$sel:nextToken:ListWorkforces' :: ListWorkforces -> Maybe Text
$sel:nameContains:ListWorkforces' :: ListWorkforces -> Maybe Text
$sel:maxResults:ListWorkforces' :: ListWorkforces -> 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
"NameContains" 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
nameContains,
            (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
"SortBy" 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 ListWorkforcesSortByOptions
sortBy,
            (Key
"SortOrder" 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 SortOrder
sortOrder
          ]
      )

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

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

-- | /See:/ 'newListWorkforcesResponse' smart constructor.
data ListWorkforcesResponse = ListWorkforcesResponse'
  { -- | A token to resume pagination.
    ListWorkforcesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListWorkforcesResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list containing information about your workforce.
    ListWorkforcesResponse -> [Workforce]
workforces :: [Workforce]
  }
  deriving (ListWorkforcesResponse -> ListWorkforcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListWorkforcesResponse -> ListWorkforcesResponse -> Bool
$c/= :: ListWorkforcesResponse -> ListWorkforcesResponse -> Bool
== :: ListWorkforcesResponse -> ListWorkforcesResponse -> Bool
$c== :: ListWorkforcesResponse -> ListWorkforcesResponse -> Bool
Prelude.Eq, ReadPrec [ListWorkforcesResponse]
ReadPrec ListWorkforcesResponse
Int -> ReadS ListWorkforcesResponse
ReadS [ListWorkforcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListWorkforcesResponse]
$creadListPrec :: ReadPrec [ListWorkforcesResponse]
readPrec :: ReadPrec ListWorkforcesResponse
$creadPrec :: ReadPrec ListWorkforcesResponse
readList :: ReadS [ListWorkforcesResponse]
$creadList :: ReadS [ListWorkforcesResponse]
readsPrec :: Int -> ReadS ListWorkforcesResponse
$creadsPrec :: Int -> ReadS ListWorkforcesResponse
Prelude.Read, Int -> ListWorkforcesResponse -> ShowS
[ListWorkforcesResponse] -> ShowS
ListWorkforcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListWorkforcesResponse] -> ShowS
$cshowList :: [ListWorkforcesResponse] -> ShowS
show :: ListWorkforcesResponse -> String
$cshow :: ListWorkforcesResponse -> String
showsPrec :: Int -> ListWorkforcesResponse -> ShowS
$cshowsPrec :: Int -> ListWorkforcesResponse -> ShowS
Prelude.Show, forall x. Rep ListWorkforcesResponse x -> ListWorkforcesResponse
forall x. ListWorkforcesResponse -> Rep ListWorkforcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListWorkforcesResponse x -> ListWorkforcesResponse
$cfrom :: forall x. ListWorkforcesResponse -> Rep ListWorkforcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListWorkforcesResponse' 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', 'listWorkforcesResponse_nextToken' - A token to resume pagination.
--
-- 'httpStatus', 'listWorkforcesResponse_httpStatus' - The response's http status code.
--
-- 'workforces', 'listWorkforcesResponse_workforces' - A list containing information about your workforce.
newListWorkforcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListWorkforcesResponse
newListWorkforcesResponse :: Int -> ListWorkforcesResponse
newListWorkforcesResponse Int
pHttpStatus_ =
  ListWorkforcesResponse'
    { $sel:nextToken:ListWorkforcesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListWorkforcesResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:workforces:ListWorkforcesResponse' :: [Workforce]
workforces = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token to resume pagination.
listWorkforcesResponse_nextToken :: Lens.Lens' ListWorkforcesResponse (Prelude.Maybe Prelude.Text)
listWorkforcesResponse_nextToken :: Lens' ListWorkforcesResponse (Maybe Text)
listWorkforcesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListWorkforcesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListWorkforcesResponse' :: ListWorkforcesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListWorkforcesResponse
s@ListWorkforcesResponse' {} Maybe Text
a -> ListWorkforcesResponse
s {$sel:nextToken:ListWorkforcesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListWorkforcesResponse)

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

-- | A list containing information about your workforce.
listWorkforcesResponse_workforces :: Lens.Lens' ListWorkforcesResponse [Workforce]
listWorkforcesResponse_workforces :: Lens' ListWorkforcesResponse [Workforce]
listWorkforcesResponse_workforces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListWorkforcesResponse' {[Workforce]
workforces :: [Workforce]
$sel:workforces:ListWorkforcesResponse' :: ListWorkforcesResponse -> [Workforce]
workforces} -> [Workforce]
workforces) (\s :: ListWorkforcesResponse
s@ListWorkforcesResponse' {} [Workforce]
a -> ListWorkforcesResponse
s {$sel:workforces:ListWorkforcesResponse' :: [Workforce]
workforces = [Workforce]
a} :: ListWorkforcesResponse) 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 Prelude.NFData ListWorkforcesResponse where
  rnf :: ListWorkforcesResponse -> ()
rnf ListWorkforcesResponse' {Int
[Workforce]
Maybe Text
workforces :: [Workforce]
httpStatus :: Int
nextToken :: Maybe Text
$sel:workforces:ListWorkforcesResponse' :: ListWorkforcesResponse -> [Workforce]
$sel:httpStatus:ListWorkforcesResponse' :: ListWorkforcesResponse -> Int
$sel:nextToken:ListWorkforcesResponse' :: ListWorkforcesResponse -> 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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Workforce]
workforces