{-# 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.CodeStarConnections.ListConnections
-- 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 the connections associated with your account.
module Amazonka.CodeStarConnections.ListConnections
  ( -- * Creating a Request
    ListConnections (..),
    newListConnections,

    -- * Request Lenses
    listConnections_hostArnFilter,
    listConnections_maxResults,
    listConnections_nextToken,
    listConnections_providerTypeFilter,

    -- * Destructuring the Response
    ListConnectionsResponse (..),
    newListConnectionsResponse,

    -- * Response Lenses
    listConnectionsResponse_connections,
    listConnectionsResponse_nextToken,
    listConnectionsResponse_httpStatus,
  )
where

import Amazonka.CodeStarConnections.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:/ 'newListConnections' smart constructor.
data ListConnections = ListConnections'
  { -- | Filters the list of connections to those associated with a specified
    -- host.
    ListConnections -> Maybe Text
hostArnFilter :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of results to return in a single call. To retrieve
    -- the remaining results, make another call with the returned @nextToken@
    -- value.
    ListConnections -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token that was returned from the previous @ListConnections@ call,
    -- which can be used to return the next set of connections in the list.
    ListConnections -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Filters the list of connections to those associated with a specified
    -- provider, such as Bitbucket.
    ListConnections -> Maybe ProviderType
providerTypeFilter :: Prelude.Maybe ProviderType
  }
  deriving (ListConnections -> ListConnections -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListConnections -> ListConnections -> Bool
$c/= :: ListConnections -> ListConnections -> Bool
== :: ListConnections -> ListConnections -> Bool
$c== :: ListConnections -> ListConnections -> Bool
Prelude.Eq, ReadPrec [ListConnections]
ReadPrec ListConnections
Int -> ReadS ListConnections
ReadS [ListConnections]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListConnections]
$creadListPrec :: ReadPrec [ListConnections]
readPrec :: ReadPrec ListConnections
$creadPrec :: ReadPrec ListConnections
readList :: ReadS [ListConnections]
$creadList :: ReadS [ListConnections]
readsPrec :: Int -> ReadS ListConnections
$creadsPrec :: Int -> ReadS ListConnections
Prelude.Read, Int -> ListConnections -> ShowS
[ListConnections] -> ShowS
ListConnections -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListConnections] -> ShowS
$cshowList :: [ListConnections] -> ShowS
show :: ListConnections -> String
$cshow :: ListConnections -> String
showsPrec :: Int -> ListConnections -> ShowS
$cshowsPrec :: Int -> ListConnections -> ShowS
Prelude.Show, forall x. Rep ListConnections x -> ListConnections
forall x. ListConnections -> Rep ListConnections x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListConnections x -> ListConnections
$cfrom :: forall x. ListConnections -> Rep ListConnections x
Prelude.Generic)

-- |
-- Create a value of 'ListConnections' 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:
--
-- 'hostArnFilter', 'listConnections_hostArnFilter' - Filters the list of connections to those associated with a specified
-- host.
--
-- 'maxResults', 'listConnections_maxResults' - The maximum number of results to return in a single call. To retrieve
-- the remaining results, make another call with the returned @nextToken@
-- value.
--
-- 'nextToken', 'listConnections_nextToken' - The token that was returned from the previous @ListConnections@ call,
-- which can be used to return the next set of connections in the list.
--
-- 'providerTypeFilter', 'listConnections_providerTypeFilter' - Filters the list of connections to those associated with a specified
-- provider, such as Bitbucket.
newListConnections ::
  ListConnections
newListConnections :: ListConnections
newListConnections =
  ListConnections'
    { $sel:hostArnFilter:ListConnections' :: Maybe Text
hostArnFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListConnections' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListConnections' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:providerTypeFilter:ListConnections' :: Maybe ProviderType
providerTypeFilter = forall a. Maybe a
Prelude.Nothing
    }

-- | Filters the list of connections to those associated with a specified
-- host.
listConnections_hostArnFilter :: Lens.Lens' ListConnections (Prelude.Maybe Prelude.Text)
listConnections_hostArnFilter :: Lens' ListConnections (Maybe Text)
listConnections_hostArnFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListConnections' {Maybe Text
hostArnFilter :: Maybe Text
$sel:hostArnFilter:ListConnections' :: ListConnections -> Maybe Text
hostArnFilter} -> Maybe Text
hostArnFilter) (\s :: ListConnections
s@ListConnections' {} Maybe Text
a -> ListConnections
s {$sel:hostArnFilter:ListConnections' :: Maybe Text
hostArnFilter = Maybe Text
a} :: ListConnections)

-- | The maximum number of results to return in a single call. To retrieve
-- the remaining results, make another call with the returned @nextToken@
-- value.
listConnections_maxResults :: Lens.Lens' ListConnections (Prelude.Maybe Prelude.Natural)
listConnections_maxResults :: Lens' ListConnections (Maybe Natural)
listConnections_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListConnections' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListConnections' :: ListConnections -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListConnections
s@ListConnections' {} Maybe Natural
a -> ListConnections
s {$sel:maxResults:ListConnections' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListConnections)

-- | The token that was returned from the previous @ListConnections@ call,
-- which can be used to return the next set of connections in the list.
listConnections_nextToken :: Lens.Lens' ListConnections (Prelude.Maybe Prelude.Text)
listConnections_nextToken :: Lens' ListConnections (Maybe Text)
listConnections_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListConnections' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListConnections' :: ListConnections -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListConnections
s@ListConnections' {} Maybe Text
a -> ListConnections
s {$sel:nextToken:ListConnections' :: Maybe Text
nextToken = Maybe Text
a} :: ListConnections)

-- | Filters the list of connections to those associated with a specified
-- provider, such as Bitbucket.
listConnections_providerTypeFilter :: Lens.Lens' ListConnections (Prelude.Maybe ProviderType)
listConnections_providerTypeFilter :: Lens' ListConnections (Maybe ProviderType)
listConnections_providerTypeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListConnections' {Maybe ProviderType
providerTypeFilter :: Maybe ProviderType
$sel:providerTypeFilter:ListConnections' :: ListConnections -> Maybe ProviderType
providerTypeFilter} -> Maybe ProviderType
providerTypeFilter) (\s :: ListConnections
s@ListConnections' {} Maybe ProviderType
a -> ListConnections
s {$sel:providerTypeFilter:ListConnections' :: Maybe ProviderType
providerTypeFilter = Maybe ProviderType
a} :: ListConnections)

instance Core.AWSRequest ListConnections where
  type
    AWSResponse ListConnections =
      ListConnectionsResponse
  request :: (Service -> Service) -> ListConnections -> Request ListConnections
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 ListConnections
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListConnections)))
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 [Connection] -> Maybe Text -> Int -> ListConnectionsResponse
ListConnectionsResponse'
            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
"Connections" 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 ListConnections where
  hashWithSalt :: Int -> ListConnections -> Int
hashWithSalt Int
_salt ListConnections' {Maybe Natural
Maybe Text
Maybe ProviderType
providerTypeFilter :: Maybe ProviderType
nextToken :: Maybe Text
maxResults :: Maybe Natural
hostArnFilter :: Maybe Text
$sel:providerTypeFilter:ListConnections' :: ListConnections -> Maybe ProviderType
$sel:nextToken:ListConnections' :: ListConnections -> Maybe Text
$sel:maxResults:ListConnections' :: ListConnections -> Maybe Natural
$sel:hostArnFilter:ListConnections' :: ListConnections -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostArnFilter
      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 ProviderType
providerTypeFilter

instance Prelude.NFData ListConnections where
  rnf :: ListConnections -> ()
rnf ListConnections' {Maybe Natural
Maybe Text
Maybe ProviderType
providerTypeFilter :: Maybe ProviderType
nextToken :: Maybe Text
maxResults :: Maybe Natural
hostArnFilter :: Maybe Text
$sel:providerTypeFilter:ListConnections' :: ListConnections -> Maybe ProviderType
$sel:nextToken:ListConnections' :: ListConnections -> Maybe Text
$sel:maxResults:ListConnections' :: ListConnections -> Maybe Natural
$sel:hostArnFilter:ListConnections' :: ListConnections -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostArnFilter
      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 ProviderType
providerTypeFilter

instance Data.ToHeaders ListConnections where
  toHeaders :: ListConnections -> 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
"com.amazonaws.codestar.connections.CodeStar_connections_20191201.ListConnections" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListConnections where
  toJSON :: ListConnections -> Value
toJSON ListConnections' {Maybe Natural
Maybe Text
Maybe ProviderType
providerTypeFilter :: Maybe ProviderType
nextToken :: Maybe Text
maxResults :: Maybe Natural
hostArnFilter :: Maybe Text
$sel:providerTypeFilter:ListConnections' :: ListConnections -> Maybe ProviderType
$sel:nextToken:ListConnections' :: ListConnections -> Maybe Text
$sel:maxResults:ListConnections' :: ListConnections -> Maybe Natural
$sel:hostArnFilter:ListConnections' :: ListConnections -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"HostArnFilter" 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
hostArnFilter,
            (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
"ProviderTypeFilter" 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 ProviderType
providerTypeFilter
          ]
      )

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

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

-- | /See:/ 'newListConnectionsResponse' smart constructor.
data ListConnectionsResponse = ListConnectionsResponse'
  { -- | A list of connections and the details for each connection, such as
    -- status, owner, and provider type.
    ListConnectionsResponse -> Maybe [Connection]
connections :: Prelude.Maybe [Connection],
    -- | A token that can be used in the next @ListConnections@ call. To view all
    -- items in the list, continue to call this operation with each subsequent
    -- token until no more @nextToken@ values are returned.
    ListConnectionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListConnectionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListConnectionsResponse -> ListConnectionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListConnectionsResponse -> ListConnectionsResponse -> Bool
$c/= :: ListConnectionsResponse -> ListConnectionsResponse -> Bool
== :: ListConnectionsResponse -> ListConnectionsResponse -> Bool
$c== :: ListConnectionsResponse -> ListConnectionsResponse -> Bool
Prelude.Eq, ReadPrec [ListConnectionsResponse]
ReadPrec ListConnectionsResponse
Int -> ReadS ListConnectionsResponse
ReadS [ListConnectionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListConnectionsResponse]
$creadListPrec :: ReadPrec [ListConnectionsResponse]
readPrec :: ReadPrec ListConnectionsResponse
$creadPrec :: ReadPrec ListConnectionsResponse
readList :: ReadS [ListConnectionsResponse]
$creadList :: ReadS [ListConnectionsResponse]
readsPrec :: Int -> ReadS ListConnectionsResponse
$creadsPrec :: Int -> ReadS ListConnectionsResponse
Prelude.Read, Int -> ListConnectionsResponse -> ShowS
[ListConnectionsResponse] -> ShowS
ListConnectionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListConnectionsResponse] -> ShowS
$cshowList :: [ListConnectionsResponse] -> ShowS
show :: ListConnectionsResponse -> String
$cshow :: ListConnectionsResponse -> String
showsPrec :: Int -> ListConnectionsResponse -> ShowS
$cshowsPrec :: Int -> ListConnectionsResponse -> ShowS
Prelude.Show, forall x. Rep ListConnectionsResponse x -> ListConnectionsResponse
forall x. ListConnectionsResponse -> Rep ListConnectionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListConnectionsResponse x -> ListConnectionsResponse
$cfrom :: forall x. ListConnectionsResponse -> Rep ListConnectionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListConnectionsResponse' 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:
--
-- 'connections', 'listConnectionsResponse_connections' - A list of connections and the details for each connection, such as
-- status, owner, and provider type.
--
-- 'nextToken', 'listConnectionsResponse_nextToken' - A token that can be used in the next @ListConnections@ call. To view all
-- items in the list, continue to call this operation with each subsequent
-- token until no more @nextToken@ values are returned.
--
-- 'httpStatus', 'listConnectionsResponse_httpStatus' - The response's http status code.
newListConnectionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListConnectionsResponse
newListConnectionsResponse :: Int -> ListConnectionsResponse
newListConnectionsResponse Int
pHttpStatus_ =
  ListConnectionsResponse'
    { $sel:connections:ListConnectionsResponse' :: Maybe [Connection]
connections =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListConnectionsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListConnectionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of connections and the details for each connection, such as
-- status, owner, and provider type.
listConnectionsResponse_connections :: Lens.Lens' ListConnectionsResponse (Prelude.Maybe [Connection])
listConnectionsResponse_connections :: Lens' ListConnectionsResponse (Maybe [Connection])
listConnectionsResponse_connections = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListConnectionsResponse' {Maybe [Connection]
connections :: Maybe [Connection]
$sel:connections:ListConnectionsResponse' :: ListConnectionsResponse -> Maybe [Connection]
connections} -> Maybe [Connection]
connections) (\s :: ListConnectionsResponse
s@ListConnectionsResponse' {} Maybe [Connection]
a -> ListConnectionsResponse
s {$sel:connections:ListConnectionsResponse' :: Maybe [Connection]
connections = Maybe [Connection]
a} :: ListConnectionsResponse) 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

-- | A token that can be used in the next @ListConnections@ call. To view all
-- items in the list, continue to call this operation with each subsequent
-- token until no more @nextToken@ values are returned.
listConnectionsResponse_nextToken :: Lens.Lens' ListConnectionsResponse (Prelude.Maybe Prelude.Text)
listConnectionsResponse_nextToken :: Lens' ListConnectionsResponse (Maybe Text)
listConnectionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListConnectionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListConnectionsResponse' :: ListConnectionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListConnectionsResponse
s@ListConnectionsResponse' {} Maybe Text
a -> ListConnectionsResponse
s {$sel:nextToken:ListConnectionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListConnectionsResponse)

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

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