{-# 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.APIGateway.GetGatewayResponses
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the GatewayResponses collection on the given RestApi. If an API
-- developer has not added any definitions for gateway responses, the
-- result will be the API Gateway-generated default GatewayResponses
-- collection for the supported response types.
--
-- This operation returns paginated results.
module Amazonka.APIGateway.GetGatewayResponses
  ( -- * Creating a Request
    GetGatewayResponses (..),
    newGetGatewayResponses,

    -- * Request Lenses
    getGatewayResponses_limit,
    getGatewayResponses_position,
    getGatewayResponses_restApiId,

    -- * Destructuring the Response
    GetGatewayResponsesResponse (..),
    newGetGatewayResponsesResponse,

    -- * Response Lenses
    getGatewayResponsesResponse_items,
    getGatewayResponsesResponse_position,
    getGatewayResponsesResponse_httpStatus,
  )
where

import Amazonka.APIGateway.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

-- | Gets the GatewayResponses collection on the given RestApi. If an API
-- developer has not added any definitions for gateway responses, the
-- result will be the API Gateway-generated default GatewayResponses
-- collection for the supported response types.
--
-- /See:/ 'newGetGatewayResponses' smart constructor.
data GetGatewayResponses = GetGatewayResponses'
  { -- | The maximum number of returned results per page. The default value is 25
    -- and the maximum value is 500. The GatewayResponses collection does not
    -- support pagination and the limit does not apply here.
    GetGatewayResponses -> Maybe Int
limit :: Prelude.Maybe Prelude.Int,
    -- | The current pagination position in the paged result set. The
    -- GatewayResponse collection does not support pagination and the position
    -- does not apply here.
    GetGatewayResponses -> Maybe Text
position :: Prelude.Maybe Prelude.Text,
    -- | The string identifier of the associated RestApi.
    GetGatewayResponses -> Text
restApiId :: Prelude.Text
  }
  deriving (GetGatewayResponses -> GetGatewayResponses -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGatewayResponses -> GetGatewayResponses -> Bool
$c/= :: GetGatewayResponses -> GetGatewayResponses -> Bool
== :: GetGatewayResponses -> GetGatewayResponses -> Bool
$c== :: GetGatewayResponses -> GetGatewayResponses -> Bool
Prelude.Eq, ReadPrec [GetGatewayResponses]
ReadPrec GetGatewayResponses
Int -> ReadS GetGatewayResponses
ReadS [GetGatewayResponses]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGatewayResponses]
$creadListPrec :: ReadPrec [GetGatewayResponses]
readPrec :: ReadPrec GetGatewayResponses
$creadPrec :: ReadPrec GetGatewayResponses
readList :: ReadS [GetGatewayResponses]
$creadList :: ReadS [GetGatewayResponses]
readsPrec :: Int -> ReadS GetGatewayResponses
$creadsPrec :: Int -> ReadS GetGatewayResponses
Prelude.Read, Int -> GetGatewayResponses -> ShowS
[GetGatewayResponses] -> ShowS
GetGatewayResponses -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGatewayResponses] -> ShowS
$cshowList :: [GetGatewayResponses] -> ShowS
show :: GetGatewayResponses -> String
$cshow :: GetGatewayResponses -> String
showsPrec :: Int -> GetGatewayResponses -> ShowS
$cshowsPrec :: Int -> GetGatewayResponses -> ShowS
Prelude.Show, forall x. Rep GetGatewayResponses x -> GetGatewayResponses
forall x. GetGatewayResponses -> Rep GetGatewayResponses x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetGatewayResponses x -> GetGatewayResponses
$cfrom :: forall x. GetGatewayResponses -> Rep GetGatewayResponses x
Prelude.Generic)

-- |
-- Create a value of 'GetGatewayResponses' 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:
--
-- 'limit', 'getGatewayResponses_limit' - The maximum number of returned results per page. The default value is 25
-- and the maximum value is 500. The GatewayResponses collection does not
-- support pagination and the limit does not apply here.
--
-- 'position', 'getGatewayResponses_position' - The current pagination position in the paged result set. The
-- GatewayResponse collection does not support pagination and the position
-- does not apply here.
--
-- 'restApiId', 'getGatewayResponses_restApiId' - The string identifier of the associated RestApi.
newGetGatewayResponses ::
  -- | 'restApiId'
  Prelude.Text ->
  GetGatewayResponses
newGetGatewayResponses :: Text -> GetGatewayResponses
newGetGatewayResponses Text
pRestApiId_ =
  GetGatewayResponses'
    { $sel:limit:GetGatewayResponses' :: Maybe Int
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:position:GetGatewayResponses' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:GetGatewayResponses' :: Text
restApiId = Text
pRestApiId_
    }

-- | The maximum number of returned results per page. The default value is 25
-- and the maximum value is 500. The GatewayResponses collection does not
-- support pagination and the limit does not apply here.
getGatewayResponses_limit :: Lens.Lens' GetGatewayResponses (Prelude.Maybe Prelude.Int)
getGatewayResponses_limit :: Lens' GetGatewayResponses (Maybe Int)
getGatewayResponses_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGatewayResponses' {Maybe Int
limit :: Maybe Int
$sel:limit:GetGatewayResponses' :: GetGatewayResponses -> Maybe Int
limit} -> Maybe Int
limit) (\s :: GetGatewayResponses
s@GetGatewayResponses' {} Maybe Int
a -> GetGatewayResponses
s {$sel:limit:GetGatewayResponses' :: Maybe Int
limit = Maybe Int
a} :: GetGatewayResponses)

-- | The current pagination position in the paged result set. The
-- GatewayResponse collection does not support pagination and the position
-- does not apply here.
getGatewayResponses_position :: Lens.Lens' GetGatewayResponses (Prelude.Maybe Prelude.Text)
getGatewayResponses_position :: Lens' GetGatewayResponses (Maybe Text)
getGatewayResponses_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGatewayResponses' {Maybe Text
position :: Maybe Text
$sel:position:GetGatewayResponses' :: GetGatewayResponses -> Maybe Text
position} -> Maybe Text
position) (\s :: GetGatewayResponses
s@GetGatewayResponses' {} Maybe Text
a -> GetGatewayResponses
s {$sel:position:GetGatewayResponses' :: Maybe Text
position = Maybe Text
a} :: GetGatewayResponses)

-- | The string identifier of the associated RestApi.
getGatewayResponses_restApiId :: Lens.Lens' GetGatewayResponses Prelude.Text
getGatewayResponses_restApiId :: Lens' GetGatewayResponses Text
getGatewayResponses_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGatewayResponses' {Text
restApiId :: Text
$sel:restApiId:GetGatewayResponses' :: GetGatewayResponses -> Text
restApiId} -> Text
restApiId) (\s :: GetGatewayResponses
s@GetGatewayResponses' {} Text
a -> GetGatewayResponses
s {$sel:restApiId:GetGatewayResponses' :: Text
restApiId = Text
a} :: GetGatewayResponses)

instance Core.AWSPager GetGatewayResponses where
  page :: GetGatewayResponses
-> AWSResponse GetGatewayResponses -> Maybe GetGatewayResponses
page GetGatewayResponses
rq AWSResponse GetGatewayResponses
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetGatewayResponses
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetGatewayResponsesResponse (Maybe Text)
getGatewayResponsesResponse_position
            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 GetGatewayResponses
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetGatewayResponsesResponse (Maybe [GatewayResponse])
getGatewayResponsesResponse_items
            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.$ GetGatewayResponses
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetGatewayResponses (Maybe Text)
getGatewayResponses_position
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetGatewayResponses
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetGatewayResponsesResponse (Maybe Text)
getGatewayResponsesResponse_position
          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 GetGatewayResponses where
  type
    AWSResponse GetGatewayResponses =
      GetGatewayResponsesResponse
  request :: (Service -> Service)
-> GetGatewayResponses -> Request GetGatewayResponses
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 GetGatewayResponses
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetGatewayResponses)))
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 [GatewayResponse]
-> Maybe Text -> Int -> GetGatewayResponsesResponse
GetGatewayResponsesResponse'
            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
"item" 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
"position")
            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 GetGatewayResponses where
  hashWithSalt :: Int -> GetGatewayResponses -> Int
hashWithSalt Int
_salt GetGatewayResponses' {Maybe Int
Maybe Text
Text
restApiId :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:restApiId:GetGatewayResponses' :: GetGatewayResponses -> Text
$sel:position:GetGatewayResponses' :: GetGatewayResponses -> Maybe Text
$sel:limit:GetGatewayResponses' :: GetGatewayResponses -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
position
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId

instance Prelude.NFData GetGatewayResponses where
  rnf :: GetGatewayResponses -> ()
rnf GetGatewayResponses' {Maybe Int
Maybe Text
Text
restApiId :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:restApiId:GetGatewayResponses' :: GetGatewayResponses -> Text
$sel:position:GetGatewayResponses' :: GetGatewayResponses -> Maybe Text
$sel:limit:GetGatewayResponses' :: GetGatewayResponses -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId

instance Data.ToHeaders GetGatewayResponses where
  toHeaders :: GetGatewayResponses -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToPath GetGatewayResponses where
  toPath :: GetGatewayResponses -> ByteString
toPath GetGatewayResponses' {Maybe Int
Maybe Text
Text
restApiId :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:restApiId:GetGatewayResponses' :: GetGatewayResponses -> Text
$sel:position:GetGatewayResponses' :: GetGatewayResponses -> Maybe Text
$sel:limit:GetGatewayResponses' :: GetGatewayResponses -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/gatewayresponses"
      ]

instance Data.ToQuery GetGatewayResponses where
  toQuery :: GetGatewayResponses -> QueryString
toQuery GetGatewayResponses' {Maybe Int
Maybe Text
Text
restApiId :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:restApiId:GetGatewayResponses' :: GetGatewayResponses -> Text
$sel:position:GetGatewayResponses' :: GetGatewayResponses -> Maybe Text
$sel:limit:GetGatewayResponses' :: GetGatewayResponses -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"limit" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
limit, ByteString
"position" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
position]

-- | The collection of the GatewayResponse instances of a RestApi as a
-- @responseType@-to-GatewayResponse object map of key-value pairs. As
-- such, pagination is not supported for querying this collection.
--
-- /See:/ 'newGetGatewayResponsesResponse' smart constructor.
data GetGatewayResponsesResponse = GetGatewayResponsesResponse'
  { -- | Returns the entire collection, because of no pagination support.
    GetGatewayResponsesResponse -> Maybe [GatewayResponse]
items :: Prelude.Maybe [GatewayResponse],
    GetGatewayResponsesResponse -> Maybe Text
position :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetGatewayResponsesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetGatewayResponsesResponse -> GetGatewayResponsesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGatewayResponsesResponse -> GetGatewayResponsesResponse -> Bool
$c/= :: GetGatewayResponsesResponse -> GetGatewayResponsesResponse -> Bool
== :: GetGatewayResponsesResponse -> GetGatewayResponsesResponse -> Bool
$c== :: GetGatewayResponsesResponse -> GetGatewayResponsesResponse -> Bool
Prelude.Eq, ReadPrec [GetGatewayResponsesResponse]
ReadPrec GetGatewayResponsesResponse
Int -> ReadS GetGatewayResponsesResponse
ReadS [GetGatewayResponsesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGatewayResponsesResponse]
$creadListPrec :: ReadPrec [GetGatewayResponsesResponse]
readPrec :: ReadPrec GetGatewayResponsesResponse
$creadPrec :: ReadPrec GetGatewayResponsesResponse
readList :: ReadS [GetGatewayResponsesResponse]
$creadList :: ReadS [GetGatewayResponsesResponse]
readsPrec :: Int -> ReadS GetGatewayResponsesResponse
$creadsPrec :: Int -> ReadS GetGatewayResponsesResponse
Prelude.Read, Int -> GetGatewayResponsesResponse -> ShowS
[GetGatewayResponsesResponse] -> ShowS
GetGatewayResponsesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGatewayResponsesResponse] -> ShowS
$cshowList :: [GetGatewayResponsesResponse] -> ShowS
show :: GetGatewayResponsesResponse -> String
$cshow :: GetGatewayResponsesResponse -> String
showsPrec :: Int -> GetGatewayResponsesResponse -> ShowS
$cshowsPrec :: Int -> GetGatewayResponsesResponse -> ShowS
Prelude.Show, forall x.
Rep GetGatewayResponsesResponse x -> GetGatewayResponsesResponse
forall x.
GetGatewayResponsesResponse -> Rep GetGatewayResponsesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetGatewayResponsesResponse x -> GetGatewayResponsesResponse
$cfrom :: forall x.
GetGatewayResponsesResponse -> Rep GetGatewayResponsesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetGatewayResponsesResponse' 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:
--
-- 'items', 'getGatewayResponsesResponse_items' - Returns the entire collection, because of no pagination support.
--
-- 'position', 'getGatewayResponsesResponse_position' - Undocumented member.
--
-- 'httpStatus', 'getGatewayResponsesResponse_httpStatus' - The response's http status code.
newGetGatewayResponsesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetGatewayResponsesResponse
newGetGatewayResponsesResponse :: Int -> GetGatewayResponsesResponse
newGetGatewayResponsesResponse Int
pHttpStatus_ =
  GetGatewayResponsesResponse'
    { $sel:items:GetGatewayResponsesResponse' :: Maybe [GatewayResponse]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:position:GetGatewayResponsesResponse' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetGatewayResponsesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns the entire collection, because of no pagination support.
getGatewayResponsesResponse_items :: Lens.Lens' GetGatewayResponsesResponse (Prelude.Maybe [GatewayResponse])
getGatewayResponsesResponse_items :: Lens' GetGatewayResponsesResponse (Maybe [GatewayResponse])
getGatewayResponsesResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGatewayResponsesResponse' {Maybe [GatewayResponse]
items :: Maybe [GatewayResponse]
$sel:items:GetGatewayResponsesResponse' :: GetGatewayResponsesResponse -> Maybe [GatewayResponse]
items} -> Maybe [GatewayResponse]
items) (\s :: GetGatewayResponsesResponse
s@GetGatewayResponsesResponse' {} Maybe [GatewayResponse]
a -> GetGatewayResponsesResponse
s {$sel:items:GetGatewayResponsesResponse' :: Maybe [GatewayResponse]
items = Maybe [GatewayResponse]
a} :: GetGatewayResponsesResponse) 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

-- | Undocumented member.
getGatewayResponsesResponse_position :: Lens.Lens' GetGatewayResponsesResponse (Prelude.Maybe Prelude.Text)
getGatewayResponsesResponse_position :: Lens' GetGatewayResponsesResponse (Maybe Text)
getGatewayResponsesResponse_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGatewayResponsesResponse' {Maybe Text
position :: Maybe Text
$sel:position:GetGatewayResponsesResponse' :: GetGatewayResponsesResponse -> Maybe Text
position} -> Maybe Text
position) (\s :: GetGatewayResponsesResponse
s@GetGatewayResponsesResponse' {} Maybe Text
a -> GetGatewayResponsesResponse
s {$sel:position:GetGatewayResponsesResponse' :: Maybe Text
position = Maybe Text
a} :: GetGatewayResponsesResponse)

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

instance Prelude.NFData GetGatewayResponsesResponse where
  rnf :: GetGatewayResponsesResponse -> ()
rnf GetGatewayResponsesResponse' {Int
Maybe [GatewayResponse]
Maybe Text
httpStatus :: Int
position :: Maybe Text
items :: Maybe [GatewayResponse]
$sel:httpStatus:GetGatewayResponsesResponse' :: GetGatewayResponsesResponse -> Int
$sel:position:GetGatewayResponsesResponse' :: GetGatewayResponsesResponse -> Maybe Text
$sel:items:GetGatewayResponsesResponse' :: GetGatewayResponsesResponse -> Maybe [GatewayResponse]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [GatewayResponse]
items
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus