{-# 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.SNS.ListSubscriptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of the requester\'s subscriptions. Each call returns a
-- limited list of subscriptions, up to 100. If there are more
-- subscriptions, a @NextToken@ is also returned. Use the @NextToken@
-- parameter in a new @ListSubscriptions@ call to get further results.
--
-- This action is throttled at 30 transactions per second (TPS).
--
-- This operation returns paginated results.
module Amazonka.SNS.ListSubscriptions
  ( -- * Creating a Request
    ListSubscriptions (..),
    newListSubscriptions,

    -- * Request Lenses
    listSubscriptions_nextToken,

    -- * Destructuring the Response
    ListSubscriptionsResponse (..),
    newListSubscriptionsResponse,

    -- * Response Lenses
    listSubscriptionsResponse_nextToken,
    listSubscriptionsResponse_subscriptions,
    listSubscriptionsResponse_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.SNS.Types

-- | Input for ListSubscriptions action.
--
-- /See:/ 'newListSubscriptions' smart constructor.
data ListSubscriptions = ListSubscriptions'
  { -- | Token returned by the previous @ListSubscriptions@ request.
    ListSubscriptions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListSubscriptions -> ListSubscriptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSubscriptions -> ListSubscriptions -> Bool
$c/= :: ListSubscriptions -> ListSubscriptions -> Bool
== :: ListSubscriptions -> ListSubscriptions -> Bool
$c== :: ListSubscriptions -> ListSubscriptions -> Bool
Prelude.Eq, ReadPrec [ListSubscriptions]
ReadPrec ListSubscriptions
Int -> ReadS ListSubscriptions
ReadS [ListSubscriptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSubscriptions]
$creadListPrec :: ReadPrec [ListSubscriptions]
readPrec :: ReadPrec ListSubscriptions
$creadPrec :: ReadPrec ListSubscriptions
readList :: ReadS [ListSubscriptions]
$creadList :: ReadS [ListSubscriptions]
readsPrec :: Int -> ReadS ListSubscriptions
$creadsPrec :: Int -> ReadS ListSubscriptions
Prelude.Read, Int -> ListSubscriptions -> ShowS
[ListSubscriptions] -> ShowS
ListSubscriptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSubscriptions] -> ShowS
$cshowList :: [ListSubscriptions] -> ShowS
show :: ListSubscriptions -> String
$cshow :: ListSubscriptions -> String
showsPrec :: Int -> ListSubscriptions -> ShowS
$cshowsPrec :: Int -> ListSubscriptions -> ShowS
Prelude.Show, forall x. Rep ListSubscriptions x -> ListSubscriptions
forall x. ListSubscriptions -> Rep ListSubscriptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSubscriptions x -> ListSubscriptions
$cfrom :: forall x. ListSubscriptions -> Rep ListSubscriptions x
Prelude.Generic)

-- |
-- Create a value of 'ListSubscriptions' 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', 'listSubscriptions_nextToken' - Token returned by the previous @ListSubscriptions@ request.
newListSubscriptions ::
  ListSubscriptions
newListSubscriptions :: ListSubscriptions
newListSubscriptions =
  ListSubscriptions' {$sel:nextToken:ListSubscriptions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing}

-- | Token returned by the previous @ListSubscriptions@ request.
listSubscriptions_nextToken :: Lens.Lens' ListSubscriptions (Prelude.Maybe Prelude.Text)
listSubscriptions_nextToken :: Lens' ListSubscriptions (Maybe Text)
listSubscriptions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSubscriptions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSubscriptions' :: ListSubscriptions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSubscriptions
s@ListSubscriptions' {} Maybe Text
a -> ListSubscriptions
s {$sel:nextToken:ListSubscriptions' :: Maybe Text
nextToken = Maybe Text
a} :: ListSubscriptions)

instance Core.AWSPager ListSubscriptions where
  page :: ListSubscriptions
-> AWSResponse ListSubscriptions -> Maybe ListSubscriptions
page ListSubscriptions
rq AWSResponse ListSubscriptions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSubscriptions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSubscriptionsResponse (Maybe Text)
listSubscriptionsResponse_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 ListSubscriptions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSubscriptionsResponse (Maybe [Subscription])
listSubscriptionsResponse_subscriptions
            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.$ ListSubscriptions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSubscriptions (Maybe Text)
listSubscriptions_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSubscriptions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSubscriptionsResponse (Maybe Text)
listSubscriptionsResponse_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 ListSubscriptions where
  type
    AWSResponse ListSubscriptions =
      ListSubscriptionsResponse
  request :: (Service -> Service)
-> ListSubscriptions -> Request ListSubscriptions
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListSubscriptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListSubscriptions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ListSubscriptionsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [Subscription] -> Int -> ListSubscriptionsResponse
ListSubscriptionsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Subscriptions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            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 ListSubscriptions where
  hashWithSalt :: Int -> ListSubscriptions -> Int
hashWithSalt Int
_salt ListSubscriptions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSubscriptions' :: ListSubscriptions -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

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

instance Data.ToHeaders ListSubscriptions where
  toHeaders :: ListSubscriptions -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ListSubscriptions where
  toQuery :: ListSubscriptions -> QueryString
toQuery ListSubscriptions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSubscriptions' :: ListSubscriptions -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListSubscriptions" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | Response for ListSubscriptions action
--
-- /See:/ 'newListSubscriptionsResponse' smart constructor.
data ListSubscriptionsResponse = ListSubscriptionsResponse'
  { -- | Token to pass along to the next @ListSubscriptions@ request. This
    -- element is returned if there are more subscriptions to retrieve.
    ListSubscriptionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of subscriptions.
    ListSubscriptionsResponse -> Maybe [Subscription]
subscriptions :: Prelude.Maybe [Subscription],
    -- | The response's http status code.
    ListSubscriptionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListSubscriptionsResponse -> ListSubscriptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSubscriptionsResponse -> ListSubscriptionsResponse -> Bool
$c/= :: ListSubscriptionsResponse -> ListSubscriptionsResponse -> Bool
== :: ListSubscriptionsResponse -> ListSubscriptionsResponse -> Bool
$c== :: ListSubscriptionsResponse -> ListSubscriptionsResponse -> Bool
Prelude.Eq, ReadPrec [ListSubscriptionsResponse]
ReadPrec ListSubscriptionsResponse
Int -> ReadS ListSubscriptionsResponse
ReadS [ListSubscriptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSubscriptionsResponse]
$creadListPrec :: ReadPrec [ListSubscriptionsResponse]
readPrec :: ReadPrec ListSubscriptionsResponse
$creadPrec :: ReadPrec ListSubscriptionsResponse
readList :: ReadS [ListSubscriptionsResponse]
$creadList :: ReadS [ListSubscriptionsResponse]
readsPrec :: Int -> ReadS ListSubscriptionsResponse
$creadsPrec :: Int -> ReadS ListSubscriptionsResponse
Prelude.Read, Int -> ListSubscriptionsResponse -> ShowS
[ListSubscriptionsResponse] -> ShowS
ListSubscriptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSubscriptionsResponse] -> ShowS
$cshowList :: [ListSubscriptionsResponse] -> ShowS
show :: ListSubscriptionsResponse -> String
$cshow :: ListSubscriptionsResponse -> String
showsPrec :: Int -> ListSubscriptionsResponse -> ShowS
$cshowsPrec :: Int -> ListSubscriptionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListSubscriptionsResponse x -> ListSubscriptionsResponse
forall x.
ListSubscriptionsResponse -> Rep ListSubscriptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSubscriptionsResponse x -> ListSubscriptionsResponse
$cfrom :: forall x.
ListSubscriptionsResponse -> Rep ListSubscriptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSubscriptionsResponse' 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', 'listSubscriptionsResponse_nextToken' - Token to pass along to the next @ListSubscriptions@ request. This
-- element is returned if there are more subscriptions to retrieve.
--
-- 'subscriptions', 'listSubscriptionsResponse_subscriptions' - A list of subscriptions.
--
-- 'httpStatus', 'listSubscriptionsResponse_httpStatus' - The response's http status code.
newListSubscriptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSubscriptionsResponse
newListSubscriptionsResponse :: Int -> ListSubscriptionsResponse
newListSubscriptionsResponse Int
pHttpStatus_ =
  ListSubscriptionsResponse'
    { $sel:nextToken:ListSubscriptionsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:subscriptions:ListSubscriptionsResponse' :: Maybe [Subscription]
subscriptions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSubscriptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Token to pass along to the next @ListSubscriptions@ request. This
-- element is returned if there are more subscriptions to retrieve.
listSubscriptionsResponse_nextToken :: Lens.Lens' ListSubscriptionsResponse (Prelude.Maybe Prelude.Text)
listSubscriptionsResponse_nextToken :: Lens' ListSubscriptionsResponse (Maybe Text)
listSubscriptionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSubscriptionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSubscriptionsResponse' :: ListSubscriptionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSubscriptionsResponse
s@ListSubscriptionsResponse' {} Maybe Text
a -> ListSubscriptionsResponse
s {$sel:nextToken:ListSubscriptionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSubscriptionsResponse)

-- | A list of subscriptions.
listSubscriptionsResponse_subscriptions :: Lens.Lens' ListSubscriptionsResponse (Prelude.Maybe [Subscription])
listSubscriptionsResponse_subscriptions :: Lens' ListSubscriptionsResponse (Maybe [Subscription])
listSubscriptionsResponse_subscriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSubscriptionsResponse' {Maybe [Subscription]
subscriptions :: Maybe [Subscription]
$sel:subscriptions:ListSubscriptionsResponse' :: ListSubscriptionsResponse -> Maybe [Subscription]
subscriptions} -> Maybe [Subscription]
subscriptions) (\s :: ListSubscriptionsResponse
s@ListSubscriptionsResponse' {} Maybe [Subscription]
a -> ListSubscriptionsResponse
s {$sel:subscriptions:ListSubscriptionsResponse' :: Maybe [Subscription]
subscriptions = Maybe [Subscription]
a} :: ListSubscriptionsResponse) 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.
listSubscriptionsResponse_httpStatus :: Lens.Lens' ListSubscriptionsResponse Prelude.Int
listSubscriptionsResponse_httpStatus :: Lens' ListSubscriptionsResponse Int
listSubscriptionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSubscriptionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListSubscriptionsResponse' :: ListSubscriptionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListSubscriptionsResponse
s@ListSubscriptionsResponse' {} Int
a -> ListSubscriptionsResponse
s {$sel:httpStatus:ListSubscriptionsResponse' :: Int
httpStatus = Int
a} :: ListSubscriptionsResponse)

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