{-# 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.AlexaBusiness.ListSkills
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all enabled skills in a specific skill group.
--
-- This operation returns paginated results.
module Amazonka.AlexaBusiness.ListSkills
  ( -- * Creating a Request
    ListSkills (..),
    newListSkills,

    -- * Request Lenses
    listSkills_enablementType,
    listSkills_maxResults,
    listSkills_nextToken,
    listSkills_skillGroupArn,
    listSkills_skillType,

    -- * Destructuring the Response
    ListSkillsResponse (..),
    newListSkillsResponse,

    -- * Response Lenses
    listSkillsResponse_nextToken,
    listSkillsResponse_skillSummaries,
    listSkillsResponse_httpStatus,
  )
where

import Amazonka.AlexaBusiness.Types
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

-- | /See:/ 'newListSkills' smart constructor.
data ListSkills = ListSkills'
  { -- | Whether the skill is enabled under the user\'s account.
    ListSkills -> Maybe EnablementTypeFilter
enablementType :: Prelude.Maybe EnablementTypeFilter,
    -- | The maximum number of results to include in the response. If more
    -- results exist than the specified @MaxResults@ value, a token is included
    -- in the response so that the remaining results can be retrieved.
    ListSkills -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | An optional token returned from a prior request. Use this token for
    -- pagination of results from this action. If this parameter is specified,
    -- the response includes only results beyond the token, up to the value
    -- specified by @MaxResults@.
    ListSkills -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the skill group for which to list enabled skills.
    ListSkills -> Maybe Text
skillGroupArn :: Prelude.Maybe Prelude.Text,
    -- | Whether the skill is publicly available or is a private skill.
    ListSkills -> Maybe SkillTypeFilter
skillType :: Prelude.Maybe SkillTypeFilter
  }
  deriving (ListSkills -> ListSkills -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSkills -> ListSkills -> Bool
$c/= :: ListSkills -> ListSkills -> Bool
== :: ListSkills -> ListSkills -> Bool
$c== :: ListSkills -> ListSkills -> Bool
Prelude.Eq, ReadPrec [ListSkills]
ReadPrec ListSkills
Int -> ReadS ListSkills
ReadS [ListSkills]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSkills]
$creadListPrec :: ReadPrec [ListSkills]
readPrec :: ReadPrec ListSkills
$creadPrec :: ReadPrec ListSkills
readList :: ReadS [ListSkills]
$creadList :: ReadS [ListSkills]
readsPrec :: Int -> ReadS ListSkills
$creadsPrec :: Int -> ReadS ListSkills
Prelude.Read, Int -> ListSkills -> ShowS
[ListSkills] -> ShowS
ListSkills -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSkills] -> ShowS
$cshowList :: [ListSkills] -> ShowS
show :: ListSkills -> String
$cshow :: ListSkills -> String
showsPrec :: Int -> ListSkills -> ShowS
$cshowsPrec :: Int -> ListSkills -> ShowS
Prelude.Show, forall x. Rep ListSkills x -> ListSkills
forall x. ListSkills -> Rep ListSkills x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSkills x -> ListSkills
$cfrom :: forall x. ListSkills -> Rep ListSkills x
Prelude.Generic)

-- |
-- Create a value of 'ListSkills' 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:
--
-- 'enablementType', 'listSkills_enablementType' - Whether the skill is enabled under the user\'s account.
--
-- 'maxResults', 'listSkills_maxResults' - The maximum number of results to include in the response. If more
-- results exist than the specified @MaxResults@ value, a token is included
-- in the response so that the remaining results can be retrieved.
--
-- 'nextToken', 'listSkills_nextToken' - An optional token returned from a prior request. Use this token for
-- pagination of results from this action. If this parameter is specified,
-- the response includes only results beyond the token, up to the value
-- specified by @MaxResults@.
--
-- 'skillGroupArn', 'listSkills_skillGroupArn' - The ARN of the skill group for which to list enabled skills.
--
-- 'skillType', 'listSkills_skillType' - Whether the skill is publicly available or is a private skill.
newListSkills ::
  ListSkills
newListSkills :: ListSkills
newListSkills =
  ListSkills'
    { $sel:enablementType:ListSkills' :: Maybe EnablementTypeFilter
enablementType = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListSkills' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSkills' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:skillGroupArn:ListSkills' :: Maybe Text
skillGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:skillType:ListSkills' :: Maybe SkillTypeFilter
skillType = forall a. Maybe a
Prelude.Nothing
    }

-- | Whether the skill is enabled under the user\'s account.
listSkills_enablementType :: Lens.Lens' ListSkills (Prelude.Maybe EnablementTypeFilter)
listSkills_enablementType :: Lens' ListSkills (Maybe EnablementTypeFilter)
listSkills_enablementType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkills' {Maybe EnablementTypeFilter
enablementType :: Maybe EnablementTypeFilter
$sel:enablementType:ListSkills' :: ListSkills -> Maybe EnablementTypeFilter
enablementType} -> Maybe EnablementTypeFilter
enablementType) (\s :: ListSkills
s@ListSkills' {} Maybe EnablementTypeFilter
a -> ListSkills
s {$sel:enablementType:ListSkills' :: Maybe EnablementTypeFilter
enablementType = Maybe EnablementTypeFilter
a} :: ListSkills)

-- | The maximum number of results to include in the response. If more
-- results exist than the specified @MaxResults@ value, a token is included
-- in the response so that the remaining results can be retrieved.
listSkills_maxResults :: Lens.Lens' ListSkills (Prelude.Maybe Prelude.Natural)
listSkills_maxResults :: Lens' ListSkills (Maybe Natural)
listSkills_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkills' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListSkills' :: ListSkills -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListSkills
s@ListSkills' {} Maybe Natural
a -> ListSkills
s {$sel:maxResults:ListSkills' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListSkills)

-- | An optional token returned from a prior request. Use this token for
-- pagination of results from this action. If this parameter is specified,
-- the response includes only results beyond the token, up to the value
-- specified by @MaxResults@.
listSkills_nextToken :: Lens.Lens' ListSkills (Prelude.Maybe Prelude.Text)
listSkills_nextToken :: Lens' ListSkills (Maybe Text)
listSkills_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkills' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSkills' :: ListSkills -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSkills
s@ListSkills' {} Maybe Text
a -> ListSkills
s {$sel:nextToken:ListSkills' :: Maybe Text
nextToken = Maybe Text
a} :: ListSkills)

-- | The ARN of the skill group for which to list enabled skills.
listSkills_skillGroupArn :: Lens.Lens' ListSkills (Prelude.Maybe Prelude.Text)
listSkills_skillGroupArn :: Lens' ListSkills (Maybe Text)
listSkills_skillGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkills' {Maybe Text
skillGroupArn :: Maybe Text
$sel:skillGroupArn:ListSkills' :: ListSkills -> Maybe Text
skillGroupArn} -> Maybe Text
skillGroupArn) (\s :: ListSkills
s@ListSkills' {} Maybe Text
a -> ListSkills
s {$sel:skillGroupArn:ListSkills' :: Maybe Text
skillGroupArn = Maybe Text
a} :: ListSkills)

-- | Whether the skill is publicly available or is a private skill.
listSkills_skillType :: Lens.Lens' ListSkills (Prelude.Maybe SkillTypeFilter)
listSkills_skillType :: Lens' ListSkills (Maybe SkillTypeFilter)
listSkills_skillType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkills' {Maybe SkillTypeFilter
skillType :: Maybe SkillTypeFilter
$sel:skillType:ListSkills' :: ListSkills -> Maybe SkillTypeFilter
skillType} -> Maybe SkillTypeFilter
skillType) (\s :: ListSkills
s@ListSkills' {} Maybe SkillTypeFilter
a -> ListSkills
s {$sel:skillType:ListSkills' :: Maybe SkillTypeFilter
skillType = Maybe SkillTypeFilter
a} :: ListSkills)

instance Core.AWSPager ListSkills where
  page :: ListSkills -> AWSResponse ListSkills -> Maybe ListSkills
page ListSkills
rq AWSResponse ListSkills
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSkills
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSkillsResponse (Maybe Text)
listSkillsResponse_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 ListSkills
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSkillsResponse (Maybe [SkillSummary])
listSkillsResponse_skillSummaries
            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.$ ListSkills
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSkills (Maybe Text)
listSkills_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSkills
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSkillsResponse (Maybe Text)
listSkillsResponse_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 ListSkills where
  type AWSResponse ListSkills = ListSkillsResponse
  request :: (Service -> Service) -> ListSkills -> Request ListSkills
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 ListSkills
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListSkills)))
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 [SkillSummary] -> Int -> ListSkillsResponse
ListSkillsResponse'
            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
"SkillSummaries" 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 ListSkills where
  hashWithSalt :: Int -> ListSkills -> Int
hashWithSalt Int
_salt ListSkills' {Maybe Natural
Maybe Text
Maybe EnablementTypeFilter
Maybe SkillTypeFilter
skillType :: Maybe SkillTypeFilter
skillGroupArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
enablementType :: Maybe EnablementTypeFilter
$sel:skillType:ListSkills' :: ListSkills -> Maybe SkillTypeFilter
$sel:skillGroupArn:ListSkills' :: ListSkills -> Maybe Text
$sel:nextToken:ListSkills' :: ListSkills -> Maybe Text
$sel:maxResults:ListSkills' :: ListSkills -> Maybe Natural
$sel:enablementType:ListSkills' :: ListSkills -> Maybe EnablementTypeFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EnablementTypeFilter
enablementType
      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 Text
skillGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SkillTypeFilter
skillType

instance Prelude.NFData ListSkills where
  rnf :: ListSkills -> ()
rnf ListSkills' {Maybe Natural
Maybe Text
Maybe EnablementTypeFilter
Maybe SkillTypeFilter
skillType :: Maybe SkillTypeFilter
skillGroupArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
enablementType :: Maybe EnablementTypeFilter
$sel:skillType:ListSkills' :: ListSkills -> Maybe SkillTypeFilter
$sel:skillGroupArn:ListSkills' :: ListSkills -> Maybe Text
$sel:nextToken:ListSkills' :: ListSkills -> Maybe Text
$sel:maxResults:ListSkills' :: ListSkills -> Maybe Natural
$sel:enablementType:ListSkills' :: ListSkills -> Maybe EnablementTypeFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EnablementTypeFilter
enablementType
      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 Text
skillGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SkillTypeFilter
skillType

instance Data.ToHeaders ListSkills where
  toHeaders :: ListSkills -> 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
"AlexaForBusiness.ListSkills" ::
                          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 ListSkills where
  toJSON :: ListSkills -> Value
toJSON ListSkills' {Maybe Natural
Maybe Text
Maybe EnablementTypeFilter
Maybe SkillTypeFilter
skillType :: Maybe SkillTypeFilter
skillGroupArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
enablementType :: Maybe EnablementTypeFilter
$sel:skillType:ListSkills' :: ListSkills -> Maybe SkillTypeFilter
$sel:skillGroupArn:ListSkills' :: ListSkills -> Maybe Text
$sel:nextToken:ListSkills' :: ListSkills -> Maybe Text
$sel:maxResults:ListSkills' :: ListSkills -> Maybe Natural
$sel:enablementType:ListSkills' :: ListSkills -> Maybe EnablementTypeFilter
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EnablementType" 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 EnablementTypeFilter
enablementType,
            (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
"SkillGroupArn" 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
skillGroupArn,
            (Key
"SkillType" 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 SkillTypeFilter
skillType
          ]
      )

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

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

-- | /See:/ 'newListSkillsResponse' smart constructor.
data ListSkillsResponse = ListSkillsResponse'
  { -- | The token returned to indicate that there is more data available.
    ListSkillsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of enabled skills requested. Required.
    ListSkillsResponse -> Maybe [SkillSummary]
skillSummaries :: Prelude.Maybe [SkillSummary],
    -- | The response's http status code.
    ListSkillsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListSkillsResponse -> ListSkillsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSkillsResponse -> ListSkillsResponse -> Bool
$c/= :: ListSkillsResponse -> ListSkillsResponse -> Bool
== :: ListSkillsResponse -> ListSkillsResponse -> Bool
$c== :: ListSkillsResponse -> ListSkillsResponse -> Bool
Prelude.Eq, ReadPrec [ListSkillsResponse]
ReadPrec ListSkillsResponse
Int -> ReadS ListSkillsResponse
ReadS [ListSkillsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSkillsResponse]
$creadListPrec :: ReadPrec [ListSkillsResponse]
readPrec :: ReadPrec ListSkillsResponse
$creadPrec :: ReadPrec ListSkillsResponse
readList :: ReadS [ListSkillsResponse]
$creadList :: ReadS [ListSkillsResponse]
readsPrec :: Int -> ReadS ListSkillsResponse
$creadsPrec :: Int -> ReadS ListSkillsResponse
Prelude.Read, Int -> ListSkillsResponse -> ShowS
[ListSkillsResponse] -> ShowS
ListSkillsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSkillsResponse] -> ShowS
$cshowList :: [ListSkillsResponse] -> ShowS
show :: ListSkillsResponse -> String
$cshow :: ListSkillsResponse -> String
showsPrec :: Int -> ListSkillsResponse -> ShowS
$cshowsPrec :: Int -> ListSkillsResponse -> ShowS
Prelude.Show, forall x. Rep ListSkillsResponse x -> ListSkillsResponse
forall x. ListSkillsResponse -> Rep ListSkillsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSkillsResponse x -> ListSkillsResponse
$cfrom :: forall x. ListSkillsResponse -> Rep ListSkillsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSkillsResponse' 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', 'listSkillsResponse_nextToken' - The token returned to indicate that there is more data available.
--
-- 'skillSummaries', 'listSkillsResponse_skillSummaries' - The list of enabled skills requested. Required.
--
-- 'httpStatus', 'listSkillsResponse_httpStatus' - The response's http status code.
newListSkillsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSkillsResponse
newListSkillsResponse :: Int -> ListSkillsResponse
newListSkillsResponse Int
pHttpStatus_ =
  ListSkillsResponse'
    { $sel:nextToken:ListSkillsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:skillSummaries:ListSkillsResponse' :: Maybe [SkillSummary]
skillSummaries = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSkillsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token returned to indicate that there is more data available.
listSkillsResponse_nextToken :: Lens.Lens' ListSkillsResponse (Prelude.Maybe Prelude.Text)
listSkillsResponse_nextToken :: Lens' ListSkillsResponse (Maybe Text)
listSkillsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkillsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSkillsResponse' :: ListSkillsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSkillsResponse
s@ListSkillsResponse' {} Maybe Text
a -> ListSkillsResponse
s {$sel:nextToken:ListSkillsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSkillsResponse)

-- | The list of enabled skills requested. Required.
listSkillsResponse_skillSummaries :: Lens.Lens' ListSkillsResponse (Prelude.Maybe [SkillSummary])
listSkillsResponse_skillSummaries :: Lens' ListSkillsResponse (Maybe [SkillSummary])
listSkillsResponse_skillSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkillsResponse' {Maybe [SkillSummary]
skillSummaries :: Maybe [SkillSummary]
$sel:skillSummaries:ListSkillsResponse' :: ListSkillsResponse -> Maybe [SkillSummary]
skillSummaries} -> Maybe [SkillSummary]
skillSummaries) (\s :: ListSkillsResponse
s@ListSkillsResponse' {} Maybe [SkillSummary]
a -> ListSkillsResponse
s {$sel:skillSummaries:ListSkillsResponse' :: Maybe [SkillSummary]
skillSummaries = Maybe [SkillSummary]
a} :: ListSkillsResponse) 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.
listSkillsResponse_httpStatus :: Lens.Lens' ListSkillsResponse Prelude.Int
listSkillsResponse_httpStatus :: Lens' ListSkillsResponse Int
listSkillsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSkillsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListSkillsResponse' :: ListSkillsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListSkillsResponse
s@ListSkillsResponse' {} Int
a -> ListSkillsResponse
s {$sel:httpStatus:ListSkillsResponse' :: Int
httpStatus = Int
a} :: ListSkillsResponse)

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