{-# 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.SSO.ListAccounts
-- 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 AWS accounts assigned to the user. These AWS accounts are
-- assigned by the administrator of the account. For more information, see
-- <https://docs.aws.amazon.com/singlesignon/latest/userguide/useraccess.html#assignusers Assign User Access>
-- in the /IAM Identity Center User Guide/. This operation returns a
-- paginated response.
--
-- This operation returns paginated results.
module Amazonka.SSO.ListAccounts
  ( -- * Creating a Request
    ListAccounts (..),
    newListAccounts,

    -- * Request Lenses
    listAccounts_maxResults,
    listAccounts_nextToken,
    listAccounts_accessToken,

    -- * Destructuring the Response
    ListAccountsResponse (..),
    newListAccountsResponse,

    -- * Response Lenses
    listAccountsResponse_accountList,
    listAccountsResponse_nextToken,
    listAccountsResponse_httpStatus,
  )
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.SSO.Types

-- | /See:/ 'newListAccounts' smart constructor.
data ListAccounts = ListAccounts'
  { -- | This is the number of items clients can request per page.
    ListAccounts -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | (Optional) When requesting subsequent pages, this is the page token from
    -- the previous response output.
    ListAccounts -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The token issued by the @CreateToken@ API call. For more information,
    -- see
    -- <https://docs.aws.amazon.com/singlesignon/latest/OIDCAPIReference/API_CreateToken.html CreateToken>
    -- in the /IAM Identity Center OIDC API Reference Guide/.
    ListAccounts -> Sensitive Text
accessToken :: Data.Sensitive Prelude.Text
  }
  deriving (ListAccounts -> ListAccounts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAccounts -> ListAccounts -> Bool
$c/= :: ListAccounts -> ListAccounts -> Bool
== :: ListAccounts -> ListAccounts -> Bool
$c== :: ListAccounts -> ListAccounts -> Bool
Prelude.Eq, Int -> ListAccounts -> ShowS
[ListAccounts] -> ShowS
ListAccounts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAccounts] -> ShowS
$cshowList :: [ListAccounts] -> ShowS
show :: ListAccounts -> String
$cshow :: ListAccounts -> String
showsPrec :: Int -> ListAccounts -> ShowS
$cshowsPrec :: Int -> ListAccounts -> ShowS
Prelude.Show, forall x. Rep ListAccounts x -> ListAccounts
forall x. ListAccounts -> Rep ListAccounts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAccounts x -> ListAccounts
$cfrom :: forall x. ListAccounts -> Rep ListAccounts x
Prelude.Generic)

-- |
-- Create a value of 'ListAccounts' 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', 'listAccounts_maxResults' - This is the number of items clients can request per page.
--
-- 'nextToken', 'listAccounts_nextToken' - (Optional) When requesting subsequent pages, this is the page token from
-- the previous response output.
--
-- 'accessToken', 'listAccounts_accessToken' - The token issued by the @CreateToken@ API call. For more information,
-- see
-- <https://docs.aws.amazon.com/singlesignon/latest/OIDCAPIReference/API_CreateToken.html CreateToken>
-- in the /IAM Identity Center OIDC API Reference Guide/.
newListAccounts ::
  -- | 'accessToken'
  Prelude.Text ->
  ListAccounts
newListAccounts :: Text -> ListAccounts
newListAccounts Text
pAccessToken_ =
  ListAccounts'
    { $sel:maxResults:ListAccounts' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAccounts' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:accessToken:ListAccounts' :: Sensitive Text
accessToken = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pAccessToken_
    }

-- | This is the number of items clients can request per page.
listAccounts_maxResults :: Lens.Lens' ListAccounts (Prelude.Maybe Prelude.Natural)
listAccounts_maxResults :: Lens' ListAccounts (Maybe Natural)
listAccounts_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccounts' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListAccounts' :: ListAccounts -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListAccounts
s@ListAccounts' {} Maybe Natural
a -> ListAccounts
s {$sel:maxResults:ListAccounts' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListAccounts)

-- | (Optional) When requesting subsequent pages, this is the page token from
-- the previous response output.
listAccounts_nextToken :: Lens.Lens' ListAccounts (Prelude.Maybe Prelude.Text)
listAccounts_nextToken :: Lens' ListAccounts (Maybe Text)
listAccounts_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccounts' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAccounts' :: ListAccounts -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAccounts
s@ListAccounts' {} Maybe Text
a -> ListAccounts
s {$sel:nextToken:ListAccounts' :: Maybe Text
nextToken = Maybe Text
a} :: ListAccounts)

-- | The token issued by the @CreateToken@ API call. For more information,
-- see
-- <https://docs.aws.amazon.com/singlesignon/latest/OIDCAPIReference/API_CreateToken.html CreateToken>
-- in the /IAM Identity Center OIDC API Reference Guide/.
listAccounts_accessToken :: Lens.Lens' ListAccounts Prelude.Text
listAccounts_accessToken :: Lens' ListAccounts Text
listAccounts_accessToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccounts' {Sensitive Text
accessToken :: Sensitive Text
$sel:accessToken:ListAccounts' :: ListAccounts -> Sensitive Text
accessToken} -> Sensitive Text
accessToken) (\s :: ListAccounts
s@ListAccounts' {} Sensitive Text
a -> ListAccounts
s {$sel:accessToken:ListAccounts' :: Sensitive Text
accessToken = Sensitive Text
a} :: ListAccounts) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSPager ListAccounts where
  page :: ListAccounts -> AWSResponse ListAccounts -> Maybe ListAccounts
page ListAccounts
rq AWSResponse ListAccounts
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAccounts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccountsResponse (Maybe Text)
listAccountsResponse_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 ListAccounts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccountsResponse (Maybe [AccountInfo])
listAccountsResponse_accountList
            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.$ ListAccounts
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAccounts (Maybe Text)
listAccounts_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAccounts
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAccountsResponse (Maybe Text)
listAccountsResponse_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 ListAccounts where
  type AWSResponse ListAccounts = ListAccountsResponse
  request :: (Service -> Service) -> ListAccounts -> Request ListAccounts
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListAccounts
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListAccounts)))
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 [AccountInfo] -> Maybe Text -> Int -> ListAccountsResponse
ListAccountsResponse'
            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
"accountList" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListAccounts where
  hashWithSalt :: Int -> ListAccounts -> Int
hashWithSalt Int
_salt ListAccounts' {Maybe Natural
Maybe Text
Sensitive Text
accessToken :: Sensitive Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:accessToken:ListAccounts' :: ListAccounts -> Sensitive Text
$sel:nextToken:ListAccounts' :: ListAccounts -> Maybe Text
$sel:maxResults:ListAccounts' :: ListAccounts -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
accessToken

instance Prelude.NFData ListAccounts where
  rnf :: ListAccounts -> ()
rnf ListAccounts' {Maybe Natural
Maybe Text
Sensitive Text
accessToken :: Sensitive Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:accessToken:ListAccounts' :: ListAccounts -> Sensitive Text
$sel:nextToken:ListAccounts' :: ListAccounts -> Maybe Text
$sel:maxResults:ListAccounts' :: ListAccounts -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
accessToken

instance Data.ToHeaders ListAccounts where
  toHeaders :: ListAccounts -> ResponseHeaders
toHeaders ListAccounts' {Maybe Natural
Maybe Text
Sensitive Text
accessToken :: Sensitive Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:accessToken:ListAccounts' :: ListAccounts -> Sensitive Text
$sel:nextToken:ListAccounts' :: ListAccounts -> Maybe Text
$sel:maxResults:ListAccounts' :: ListAccounts -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-sso_bearer_token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Sensitive Text
accessToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

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

instance Data.ToQuery ListAccounts where
  toQuery :: ListAccounts -> QueryString
toQuery ListAccounts' {Maybe Natural
Maybe Text
Sensitive Text
accessToken :: Sensitive Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:accessToken:ListAccounts' :: ListAccounts -> Sensitive Text
$sel:nextToken:ListAccounts' :: ListAccounts -> Maybe Text
$sel:maxResults:ListAccounts' :: ListAccounts -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"max_result" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"next_token" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListAccountsResponse' smart constructor.
data ListAccountsResponse = ListAccountsResponse'
  { -- | A paginated response with the list of account information and the next
    -- token if more results are available.
    ListAccountsResponse -> Maybe [AccountInfo]
accountList :: Prelude.Maybe [AccountInfo],
    -- | The page token client that is used to retrieve the list of accounts.
    ListAccountsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAccountsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListAccountsResponse -> ListAccountsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAccountsResponse -> ListAccountsResponse -> Bool
$c/= :: ListAccountsResponse -> ListAccountsResponse -> Bool
== :: ListAccountsResponse -> ListAccountsResponse -> Bool
$c== :: ListAccountsResponse -> ListAccountsResponse -> Bool
Prelude.Eq, ReadPrec [ListAccountsResponse]
ReadPrec ListAccountsResponse
Int -> ReadS ListAccountsResponse
ReadS [ListAccountsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAccountsResponse]
$creadListPrec :: ReadPrec [ListAccountsResponse]
readPrec :: ReadPrec ListAccountsResponse
$creadPrec :: ReadPrec ListAccountsResponse
readList :: ReadS [ListAccountsResponse]
$creadList :: ReadS [ListAccountsResponse]
readsPrec :: Int -> ReadS ListAccountsResponse
$creadsPrec :: Int -> ReadS ListAccountsResponse
Prelude.Read, Int -> ListAccountsResponse -> ShowS
[ListAccountsResponse] -> ShowS
ListAccountsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAccountsResponse] -> ShowS
$cshowList :: [ListAccountsResponse] -> ShowS
show :: ListAccountsResponse -> String
$cshow :: ListAccountsResponse -> String
showsPrec :: Int -> ListAccountsResponse -> ShowS
$cshowsPrec :: Int -> ListAccountsResponse -> ShowS
Prelude.Show, forall x. Rep ListAccountsResponse x -> ListAccountsResponse
forall x. ListAccountsResponse -> Rep ListAccountsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAccountsResponse x -> ListAccountsResponse
$cfrom :: forall x. ListAccountsResponse -> Rep ListAccountsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAccountsResponse' 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:
--
-- 'accountList', 'listAccountsResponse_accountList' - A paginated response with the list of account information and the next
-- token if more results are available.
--
-- 'nextToken', 'listAccountsResponse_nextToken' - The page token client that is used to retrieve the list of accounts.
--
-- 'httpStatus', 'listAccountsResponse_httpStatus' - The response's http status code.
newListAccountsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAccountsResponse
newListAccountsResponse :: Int -> ListAccountsResponse
newListAccountsResponse Int
pHttpStatus_ =
  ListAccountsResponse'
    { $sel:accountList:ListAccountsResponse' :: Maybe [AccountInfo]
accountList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAccountsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAccountsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A paginated response with the list of account information and the next
-- token if more results are available.
listAccountsResponse_accountList :: Lens.Lens' ListAccountsResponse (Prelude.Maybe [AccountInfo])
listAccountsResponse_accountList :: Lens' ListAccountsResponse (Maybe [AccountInfo])
listAccountsResponse_accountList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccountsResponse' {Maybe [AccountInfo]
accountList :: Maybe [AccountInfo]
$sel:accountList:ListAccountsResponse' :: ListAccountsResponse -> Maybe [AccountInfo]
accountList} -> Maybe [AccountInfo]
accountList) (\s :: ListAccountsResponse
s@ListAccountsResponse' {} Maybe [AccountInfo]
a -> ListAccountsResponse
s {$sel:accountList:ListAccountsResponse' :: Maybe [AccountInfo]
accountList = Maybe [AccountInfo]
a} :: ListAccountsResponse) 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 page token client that is used to retrieve the list of accounts.
listAccountsResponse_nextToken :: Lens.Lens' ListAccountsResponse (Prelude.Maybe Prelude.Text)
listAccountsResponse_nextToken :: Lens' ListAccountsResponse (Maybe Text)
listAccountsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAccountsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAccountsResponse' :: ListAccountsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAccountsResponse
s@ListAccountsResponse' {} Maybe Text
a -> ListAccountsResponse
s {$sel:nextToken:ListAccountsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListAccountsResponse)

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

instance Prelude.NFData ListAccountsResponse where
  rnf :: ListAccountsResponse -> ()
rnf ListAccountsResponse' {Int
Maybe [AccountInfo]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
accountList :: Maybe [AccountInfo]
$sel:httpStatus:ListAccountsResponse' :: ListAccountsResponse -> Int
$sel:nextToken:ListAccountsResponse' :: ListAccountsResponse -> Maybe Text
$sel:accountList:ListAccountsResponse' :: ListAccountsResponse -> Maybe [AccountInfo]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AccountInfo]
accountList
      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 Int
httpStatus