{-# 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.WorkSpaces.DescribeAccountModifications
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a list that describes modifications to the configuration of
-- Bring Your Own License (BYOL) for the specified account.
--
-- This operation returns paginated results.
module Amazonka.WorkSpaces.DescribeAccountModifications
  ( -- * Creating a Request
    DescribeAccountModifications (..),
    newDescribeAccountModifications,

    -- * Request Lenses
    describeAccountModifications_nextToken,

    -- * Destructuring the Response
    DescribeAccountModificationsResponse (..),
    newDescribeAccountModificationsResponse,

    -- * Response Lenses
    describeAccountModificationsResponse_accountModifications,
    describeAccountModificationsResponse_nextToken,
    describeAccountModificationsResponse_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.WorkSpaces.Types

-- | /See:/ 'newDescribeAccountModifications' smart constructor.
data DescribeAccountModifications = DescribeAccountModifications'
  { -- | If you received a @NextToken@ from a previous call that was paginated,
    -- provide this token to receive the next set of results.
    DescribeAccountModifications -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeAccountModifications
-> DescribeAccountModifications -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAccountModifications
-> DescribeAccountModifications -> Bool
$c/= :: DescribeAccountModifications
-> DescribeAccountModifications -> Bool
== :: DescribeAccountModifications
-> DescribeAccountModifications -> Bool
$c== :: DescribeAccountModifications
-> DescribeAccountModifications -> Bool
Prelude.Eq, ReadPrec [DescribeAccountModifications]
ReadPrec DescribeAccountModifications
Int -> ReadS DescribeAccountModifications
ReadS [DescribeAccountModifications]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAccountModifications]
$creadListPrec :: ReadPrec [DescribeAccountModifications]
readPrec :: ReadPrec DescribeAccountModifications
$creadPrec :: ReadPrec DescribeAccountModifications
readList :: ReadS [DescribeAccountModifications]
$creadList :: ReadS [DescribeAccountModifications]
readsPrec :: Int -> ReadS DescribeAccountModifications
$creadsPrec :: Int -> ReadS DescribeAccountModifications
Prelude.Read, Int -> DescribeAccountModifications -> ShowS
[DescribeAccountModifications] -> ShowS
DescribeAccountModifications -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAccountModifications] -> ShowS
$cshowList :: [DescribeAccountModifications] -> ShowS
show :: DescribeAccountModifications -> String
$cshow :: DescribeAccountModifications -> String
showsPrec :: Int -> DescribeAccountModifications -> ShowS
$cshowsPrec :: Int -> DescribeAccountModifications -> ShowS
Prelude.Show, forall x.
Rep DescribeAccountModifications x -> DescribeAccountModifications
forall x.
DescribeAccountModifications -> Rep DescribeAccountModifications x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeAccountModifications x -> DescribeAccountModifications
$cfrom :: forall x.
DescribeAccountModifications -> Rep DescribeAccountModifications x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAccountModifications' 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', 'describeAccountModifications_nextToken' - If you received a @NextToken@ from a previous call that was paginated,
-- provide this token to receive the next set of results.
newDescribeAccountModifications ::
  DescribeAccountModifications
newDescribeAccountModifications :: DescribeAccountModifications
newDescribeAccountModifications =
  DescribeAccountModifications'
    { $sel:nextToken:DescribeAccountModifications' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing
    }

-- | If you received a @NextToken@ from a previous call that was paginated,
-- provide this token to receive the next set of results.
describeAccountModifications_nextToken :: Lens.Lens' DescribeAccountModifications (Prelude.Maybe Prelude.Text)
describeAccountModifications_nextToken :: Lens' DescribeAccountModifications (Maybe Text)
describeAccountModifications_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccountModifications' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeAccountModifications' :: DescribeAccountModifications -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeAccountModifications
s@DescribeAccountModifications' {} Maybe Text
a -> DescribeAccountModifications
s {$sel:nextToken:DescribeAccountModifications' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeAccountModifications)

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

instance Prelude.NFData DescribeAccountModifications where
  rnf :: DescribeAccountModifications -> ()
rnf DescribeAccountModifications' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeAccountModifications' :: DescribeAccountModifications -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

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

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

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

-- | /See:/ 'newDescribeAccountModificationsResponse' smart constructor.
data DescribeAccountModificationsResponse = DescribeAccountModificationsResponse'
  { -- | The list of modifications to the configuration of BYOL.
    DescribeAccountModificationsResponse -> Maybe [AccountModification]
accountModifications :: Prelude.Maybe [AccountModification],
    -- | The token to use to retrieve the next page of results. This value is
    -- null when there are no more results to return.
    DescribeAccountModificationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeAccountModificationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeAccountModificationsResponse
-> DescribeAccountModificationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAccountModificationsResponse
-> DescribeAccountModificationsResponse -> Bool
$c/= :: DescribeAccountModificationsResponse
-> DescribeAccountModificationsResponse -> Bool
== :: DescribeAccountModificationsResponse
-> DescribeAccountModificationsResponse -> Bool
$c== :: DescribeAccountModificationsResponse
-> DescribeAccountModificationsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAccountModificationsResponse]
ReadPrec DescribeAccountModificationsResponse
Int -> ReadS DescribeAccountModificationsResponse
ReadS [DescribeAccountModificationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAccountModificationsResponse]
$creadListPrec :: ReadPrec [DescribeAccountModificationsResponse]
readPrec :: ReadPrec DescribeAccountModificationsResponse
$creadPrec :: ReadPrec DescribeAccountModificationsResponse
readList :: ReadS [DescribeAccountModificationsResponse]
$creadList :: ReadS [DescribeAccountModificationsResponse]
readsPrec :: Int -> ReadS DescribeAccountModificationsResponse
$creadsPrec :: Int -> ReadS DescribeAccountModificationsResponse
Prelude.Read, Int -> DescribeAccountModificationsResponse -> ShowS
[DescribeAccountModificationsResponse] -> ShowS
DescribeAccountModificationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAccountModificationsResponse] -> ShowS
$cshowList :: [DescribeAccountModificationsResponse] -> ShowS
show :: DescribeAccountModificationsResponse -> String
$cshow :: DescribeAccountModificationsResponse -> String
showsPrec :: Int -> DescribeAccountModificationsResponse -> ShowS
$cshowsPrec :: Int -> DescribeAccountModificationsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeAccountModificationsResponse x
-> DescribeAccountModificationsResponse
forall x.
DescribeAccountModificationsResponse
-> Rep DescribeAccountModificationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeAccountModificationsResponse x
-> DescribeAccountModificationsResponse
$cfrom :: forall x.
DescribeAccountModificationsResponse
-> Rep DescribeAccountModificationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAccountModificationsResponse' 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:
--
-- 'accountModifications', 'describeAccountModificationsResponse_accountModifications' - The list of modifications to the configuration of BYOL.
--
-- 'nextToken', 'describeAccountModificationsResponse_nextToken' - The token to use to retrieve the next page of results. This value is
-- null when there are no more results to return.
--
-- 'httpStatus', 'describeAccountModificationsResponse_httpStatus' - The response's http status code.
newDescribeAccountModificationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAccountModificationsResponse
newDescribeAccountModificationsResponse :: Int -> DescribeAccountModificationsResponse
newDescribeAccountModificationsResponse Int
pHttpStatus_ =
  DescribeAccountModificationsResponse'
    { $sel:accountModifications:DescribeAccountModificationsResponse' :: Maybe [AccountModification]
accountModifications =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeAccountModificationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAccountModificationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of modifications to the configuration of BYOL.
describeAccountModificationsResponse_accountModifications :: Lens.Lens' DescribeAccountModificationsResponse (Prelude.Maybe [AccountModification])
describeAccountModificationsResponse_accountModifications :: Lens'
  DescribeAccountModificationsResponse (Maybe [AccountModification])
describeAccountModificationsResponse_accountModifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccountModificationsResponse' {Maybe [AccountModification]
accountModifications :: Maybe [AccountModification]
$sel:accountModifications:DescribeAccountModificationsResponse' :: DescribeAccountModificationsResponse -> Maybe [AccountModification]
accountModifications} -> Maybe [AccountModification]
accountModifications) (\s :: DescribeAccountModificationsResponse
s@DescribeAccountModificationsResponse' {} Maybe [AccountModification]
a -> DescribeAccountModificationsResponse
s {$sel:accountModifications:DescribeAccountModificationsResponse' :: Maybe [AccountModification]
accountModifications = Maybe [AccountModification]
a} :: DescribeAccountModificationsResponse) 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 token to use to retrieve the next page of results. This value is
-- null when there are no more results to return.
describeAccountModificationsResponse_nextToken :: Lens.Lens' DescribeAccountModificationsResponse (Prelude.Maybe Prelude.Text)
describeAccountModificationsResponse_nextToken :: Lens' DescribeAccountModificationsResponse (Maybe Text)
describeAccountModificationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAccountModificationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeAccountModificationsResponse' :: DescribeAccountModificationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeAccountModificationsResponse
s@DescribeAccountModificationsResponse' {} Maybe Text
a -> DescribeAccountModificationsResponse
s {$sel:nextToken:DescribeAccountModificationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeAccountModificationsResponse)

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

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