{-# 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.GetBasePathMappings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Represents a collection of BasePathMapping resources.
--
-- This operation returns paginated results.
module Amazonka.APIGateway.GetBasePathMappings
  ( -- * Creating a Request
    GetBasePathMappings (..),
    newGetBasePathMappings,

    -- * Request Lenses
    getBasePathMappings_limit,
    getBasePathMappings_position,
    getBasePathMappings_domainName,

    -- * Destructuring the Response
    GetBasePathMappingsResponse (..),
    newGetBasePathMappingsResponse,

    -- * Response Lenses
    getBasePathMappingsResponse_items,
    getBasePathMappingsResponse_position,
    getBasePathMappingsResponse_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

-- | A request to get information about a collection of BasePathMapping
-- resources.
--
-- /See:/ 'newGetBasePathMappings' smart constructor.
data GetBasePathMappings = GetBasePathMappings'
  { -- | The maximum number of returned results per page. The default value is 25
    -- and the maximum value is 500.
    GetBasePathMappings -> Maybe Int
limit :: Prelude.Maybe Prelude.Int,
    -- | The current pagination position in the paged result set.
    GetBasePathMappings -> Maybe Text
position :: Prelude.Maybe Prelude.Text,
    -- | The domain name of a BasePathMapping resource.
    GetBasePathMappings -> Text
domainName :: Prelude.Text
  }
  deriving (GetBasePathMappings -> GetBasePathMappings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBasePathMappings -> GetBasePathMappings -> Bool
$c/= :: GetBasePathMappings -> GetBasePathMappings -> Bool
== :: GetBasePathMappings -> GetBasePathMappings -> Bool
$c== :: GetBasePathMappings -> GetBasePathMappings -> Bool
Prelude.Eq, ReadPrec [GetBasePathMappings]
ReadPrec GetBasePathMappings
Int -> ReadS GetBasePathMappings
ReadS [GetBasePathMappings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBasePathMappings]
$creadListPrec :: ReadPrec [GetBasePathMappings]
readPrec :: ReadPrec GetBasePathMappings
$creadPrec :: ReadPrec GetBasePathMappings
readList :: ReadS [GetBasePathMappings]
$creadList :: ReadS [GetBasePathMappings]
readsPrec :: Int -> ReadS GetBasePathMappings
$creadsPrec :: Int -> ReadS GetBasePathMappings
Prelude.Read, Int -> GetBasePathMappings -> ShowS
[GetBasePathMappings] -> ShowS
GetBasePathMappings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBasePathMappings] -> ShowS
$cshowList :: [GetBasePathMappings] -> ShowS
show :: GetBasePathMappings -> String
$cshow :: GetBasePathMappings -> String
showsPrec :: Int -> GetBasePathMappings -> ShowS
$cshowsPrec :: Int -> GetBasePathMappings -> ShowS
Prelude.Show, forall x. Rep GetBasePathMappings x -> GetBasePathMappings
forall x. GetBasePathMappings -> Rep GetBasePathMappings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBasePathMappings x -> GetBasePathMappings
$cfrom :: forall x. GetBasePathMappings -> Rep GetBasePathMappings x
Prelude.Generic)

-- |
-- Create a value of 'GetBasePathMappings' 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', 'getBasePathMappings_limit' - The maximum number of returned results per page. The default value is 25
-- and the maximum value is 500.
--
-- 'position', 'getBasePathMappings_position' - The current pagination position in the paged result set.
--
-- 'domainName', 'getBasePathMappings_domainName' - The domain name of a BasePathMapping resource.
newGetBasePathMappings ::
  -- | 'domainName'
  Prelude.Text ->
  GetBasePathMappings
newGetBasePathMappings :: Text -> GetBasePathMappings
newGetBasePathMappings Text
pDomainName_ =
  GetBasePathMappings'
    { $sel:limit:GetBasePathMappings' :: Maybe Int
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:position:GetBasePathMappings' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:GetBasePathMappings' :: Text
domainName = Text
pDomainName_
    }

-- | The maximum number of returned results per page. The default value is 25
-- and the maximum value is 500.
getBasePathMappings_limit :: Lens.Lens' GetBasePathMappings (Prelude.Maybe Prelude.Int)
getBasePathMappings_limit :: Lens' GetBasePathMappings (Maybe Int)
getBasePathMappings_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBasePathMappings' {Maybe Int
limit :: Maybe Int
$sel:limit:GetBasePathMappings' :: GetBasePathMappings -> Maybe Int
limit} -> Maybe Int
limit) (\s :: GetBasePathMappings
s@GetBasePathMappings' {} Maybe Int
a -> GetBasePathMappings
s {$sel:limit:GetBasePathMappings' :: Maybe Int
limit = Maybe Int
a} :: GetBasePathMappings)

-- | The current pagination position in the paged result set.
getBasePathMappings_position :: Lens.Lens' GetBasePathMappings (Prelude.Maybe Prelude.Text)
getBasePathMappings_position :: Lens' GetBasePathMappings (Maybe Text)
getBasePathMappings_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBasePathMappings' {Maybe Text
position :: Maybe Text
$sel:position:GetBasePathMappings' :: GetBasePathMappings -> Maybe Text
position} -> Maybe Text
position) (\s :: GetBasePathMappings
s@GetBasePathMappings' {} Maybe Text
a -> GetBasePathMappings
s {$sel:position:GetBasePathMappings' :: Maybe Text
position = Maybe Text
a} :: GetBasePathMappings)

-- | The domain name of a BasePathMapping resource.
getBasePathMappings_domainName :: Lens.Lens' GetBasePathMappings Prelude.Text
getBasePathMappings_domainName :: Lens' GetBasePathMappings Text
getBasePathMappings_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBasePathMappings' {Text
domainName :: Text
$sel:domainName:GetBasePathMappings' :: GetBasePathMappings -> Text
domainName} -> Text
domainName) (\s :: GetBasePathMappings
s@GetBasePathMappings' {} Text
a -> GetBasePathMappings
s {$sel:domainName:GetBasePathMappings' :: Text
domainName = Text
a} :: GetBasePathMappings)

instance Core.AWSPager GetBasePathMappings where
  page :: GetBasePathMappings
-> AWSResponse GetBasePathMappings -> Maybe GetBasePathMappings
page GetBasePathMappings
rq AWSResponse GetBasePathMappings
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetBasePathMappings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetBasePathMappingsResponse (Maybe Text)
getBasePathMappingsResponse_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 GetBasePathMappings
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetBasePathMappingsResponse (Maybe [BasePathMapping])
getBasePathMappingsResponse_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.$ GetBasePathMappings
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetBasePathMappings (Maybe Text)
getBasePathMappings_position
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetBasePathMappings
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetBasePathMappingsResponse (Maybe Text)
getBasePathMappingsResponse_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 GetBasePathMappings where
  type
    AWSResponse GetBasePathMappings =
      GetBasePathMappingsResponse
  request :: (Service -> Service)
-> GetBasePathMappings -> Request GetBasePathMappings
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 GetBasePathMappings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetBasePathMappings)))
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 [BasePathMapping]
-> Maybe Text -> Int -> GetBasePathMappingsResponse
GetBasePathMappingsResponse'
            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 GetBasePathMappings where
  hashWithSalt :: Int -> GetBasePathMappings -> Int
hashWithSalt Int
_salt GetBasePathMappings' {Maybe Int
Maybe Text
Text
domainName :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:domainName:GetBasePathMappings' :: GetBasePathMappings -> Text
$sel:position:GetBasePathMappings' :: GetBasePathMappings -> Maybe Text
$sel:limit:GetBasePathMappings' :: GetBasePathMappings -> 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
domainName

instance Prelude.NFData GetBasePathMappings where
  rnf :: GetBasePathMappings -> ()
rnf GetBasePathMappings' {Maybe Int
Maybe Text
Text
domainName :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:domainName:GetBasePathMappings' :: GetBasePathMappings -> Text
$sel:position:GetBasePathMappings' :: GetBasePathMappings -> Maybe Text
$sel:limit:GetBasePathMappings' :: GetBasePathMappings -> 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
domainName

instance Data.ToHeaders GetBasePathMappings where
  toHeaders :: GetBasePathMappings -> 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 GetBasePathMappings where
  toPath :: GetBasePathMappings -> ByteString
toPath GetBasePathMappings' {Maybe Int
Maybe Text
Text
domainName :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:domainName:GetBasePathMappings' :: GetBasePathMappings -> Text
$sel:position:GetBasePathMappings' :: GetBasePathMappings -> Maybe Text
$sel:limit:GetBasePathMappings' :: GetBasePathMappings -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domainnames/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/basepathmappings"
      ]

instance Data.ToQuery GetBasePathMappings where
  toQuery :: GetBasePathMappings -> QueryString
toQuery GetBasePathMappings' {Maybe Int
Maybe Text
Text
domainName :: Text
position :: Maybe Text
limit :: Maybe Int
$sel:domainName:GetBasePathMappings' :: GetBasePathMappings -> Text
$sel:position:GetBasePathMappings' :: GetBasePathMappings -> Maybe Text
$sel:limit:GetBasePathMappings' :: GetBasePathMappings -> 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]

-- | Represents a collection of BasePathMapping resources.
--
-- /See:/ 'newGetBasePathMappingsResponse' smart constructor.
data GetBasePathMappingsResponse = GetBasePathMappingsResponse'
  { -- | The current page of elements from this collection.
    GetBasePathMappingsResponse -> Maybe [BasePathMapping]
items :: Prelude.Maybe [BasePathMapping],
    GetBasePathMappingsResponse -> Maybe Text
position :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetBasePathMappingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBasePathMappingsResponse -> GetBasePathMappingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBasePathMappingsResponse -> GetBasePathMappingsResponse -> Bool
$c/= :: GetBasePathMappingsResponse -> GetBasePathMappingsResponse -> Bool
== :: GetBasePathMappingsResponse -> GetBasePathMappingsResponse -> Bool
$c== :: GetBasePathMappingsResponse -> GetBasePathMappingsResponse -> Bool
Prelude.Eq, ReadPrec [GetBasePathMappingsResponse]
ReadPrec GetBasePathMappingsResponse
Int -> ReadS GetBasePathMappingsResponse
ReadS [GetBasePathMappingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBasePathMappingsResponse]
$creadListPrec :: ReadPrec [GetBasePathMappingsResponse]
readPrec :: ReadPrec GetBasePathMappingsResponse
$creadPrec :: ReadPrec GetBasePathMappingsResponse
readList :: ReadS [GetBasePathMappingsResponse]
$creadList :: ReadS [GetBasePathMappingsResponse]
readsPrec :: Int -> ReadS GetBasePathMappingsResponse
$creadsPrec :: Int -> ReadS GetBasePathMappingsResponse
Prelude.Read, Int -> GetBasePathMappingsResponse -> ShowS
[GetBasePathMappingsResponse] -> ShowS
GetBasePathMappingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBasePathMappingsResponse] -> ShowS
$cshowList :: [GetBasePathMappingsResponse] -> ShowS
show :: GetBasePathMappingsResponse -> String
$cshow :: GetBasePathMappingsResponse -> String
showsPrec :: Int -> GetBasePathMappingsResponse -> ShowS
$cshowsPrec :: Int -> GetBasePathMappingsResponse -> ShowS
Prelude.Show, forall x.
Rep GetBasePathMappingsResponse x -> GetBasePathMappingsResponse
forall x.
GetBasePathMappingsResponse -> Rep GetBasePathMappingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetBasePathMappingsResponse x -> GetBasePathMappingsResponse
$cfrom :: forall x.
GetBasePathMappingsResponse -> Rep GetBasePathMappingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBasePathMappingsResponse' 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', 'getBasePathMappingsResponse_items' - The current page of elements from this collection.
--
-- 'position', 'getBasePathMappingsResponse_position' - Undocumented member.
--
-- 'httpStatus', 'getBasePathMappingsResponse_httpStatus' - The response's http status code.
newGetBasePathMappingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBasePathMappingsResponse
newGetBasePathMappingsResponse :: Int -> GetBasePathMappingsResponse
newGetBasePathMappingsResponse Int
pHttpStatus_ =
  GetBasePathMappingsResponse'
    { $sel:items:GetBasePathMappingsResponse' :: Maybe [BasePathMapping]
items =
        forall a. Maybe a
Prelude.Nothing,
      $sel:position:GetBasePathMappingsResponse' :: Maybe Text
position = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBasePathMappingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current page of elements from this collection.
getBasePathMappingsResponse_items :: Lens.Lens' GetBasePathMappingsResponse (Prelude.Maybe [BasePathMapping])
getBasePathMappingsResponse_items :: Lens' GetBasePathMappingsResponse (Maybe [BasePathMapping])
getBasePathMappingsResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBasePathMappingsResponse' {Maybe [BasePathMapping]
items :: Maybe [BasePathMapping]
$sel:items:GetBasePathMappingsResponse' :: GetBasePathMappingsResponse -> Maybe [BasePathMapping]
items} -> Maybe [BasePathMapping]
items) (\s :: GetBasePathMappingsResponse
s@GetBasePathMappingsResponse' {} Maybe [BasePathMapping]
a -> GetBasePathMappingsResponse
s {$sel:items:GetBasePathMappingsResponse' :: Maybe [BasePathMapping]
items = Maybe [BasePathMapping]
a} :: GetBasePathMappingsResponse) 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.
getBasePathMappingsResponse_position :: Lens.Lens' GetBasePathMappingsResponse (Prelude.Maybe Prelude.Text)
getBasePathMappingsResponse_position :: Lens' GetBasePathMappingsResponse (Maybe Text)
getBasePathMappingsResponse_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBasePathMappingsResponse' {Maybe Text
position :: Maybe Text
$sel:position:GetBasePathMappingsResponse' :: GetBasePathMappingsResponse -> Maybe Text
position} -> Maybe Text
position) (\s :: GetBasePathMappingsResponse
s@GetBasePathMappingsResponse' {} Maybe Text
a -> GetBasePathMappingsResponse
s {$sel:position:GetBasePathMappingsResponse' :: Maybe Text
position = Maybe Text
a} :: GetBasePathMappingsResponse)

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

instance Prelude.NFData GetBasePathMappingsResponse where
  rnf :: GetBasePathMappingsResponse -> ()
rnf GetBasePathMappingsResponse' {Int
Maybe [BasePathMapping]
Maybe Text
httpStatus :: Int
position :: Maybe Text
items :: Maybe [BasePathMapping]
$sel:httpStatus:GetBasePathMappingsResponse' :: GetBasePathMappingsResponse -> Int
$sel:position:GetBasePathMappingsResponse' :: GetBasePathMappingsResponse -> Maybe Text
$sel:items:GetBasePathMappingsResponse' :: GetBasePathMappingsResponse -> Maybe [BasePathMapping]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BasePathMapping]
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