{-# 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.EC2.ModifyVpcEndpointServicePayerResponsibility
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the payer responsibility for your VPC endpoint service.
module Amazonka.EC2.ModifyVpcEndpointServicePayerResponsibility
  ( -- * Creating a Request
    ModifyVpcEndpointServicePayerResponsibility (..),
    newModifyVpcEndpointServicePayerResponsibility,

    -- * Request Lenses
    modifyVpcEndpointServicePayerResponsibility_dryRun,
    modifyVpcEndpointServicePayerResponsibility_serviceId,
    modifyVpcEndpointServicePayerResponsibility_payerResponsibility,

    -- * Destructuring the Response
    ModifyVpcEndpointServicePayerResponsibilityResponse (..),
    newModifyVpcEndpointServicePayerResponsibilityResponse,

    -- * Response Lenses
    modifyVpcEndpointServicePayerResponsibilityResponse_returnValue,
    modifyVpcEndpointServicePayerResponsibilityResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newModifyVpcEndpointServicePayerResponsibility' smart constructor.
data ModifyVpcEndpointServicePayerResponsibility = ModifyVpcEndpointServicePayerResponsibility'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ModifyVpcEndpointServicePayerResponsibility -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the service.
    ModifyVpcEndpointServicePayerResponsibility -> Text
serviceId :: Prelude.Text,
    -- | The entity that is responsible for the endpoint costs. The default is
    -- the endpoint owner. If you set the payer responsibility to the service
    -- owner, you cannot set it back to the endpoint owner.
    ModifyVpcEndpointServicePayerResponsibility -> PayerResponsibility
payerResponsibility :: PayerResponsibility
  }
  deriving (ModifyVpcEndpointServicePayerResponsibility
-> ModifyVpcEndpointServicePayerResponsibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVpcEndpointServicePayerResponsibility
-> ModifyVpcEndpointServicePayerResponsibility -> Bool
$c/= :: ModifyVpcEndpointServicePayerResponsibility
-> ModifyVpcEndpointServicePayerResponsibility -> Bool
== :: ModifyVpcEndpointServicePayerResponsibility
-> ModifyVpcEndpointServicePayerResponsibility -> Bool
$c== :: ModifyVpcEndpointServicePayerResponsibility
-> ModifyVpcEndpointServicePayerResponsibility -> Bool
Prelude.Eq, ReadPrec [ModifyVpcEndpointServicePayerResponsibility]
ReadPrec ModifyVpcEndpointServicePayerResponsibility
Int -> ReadS ModifyVpcEndpointServicePayerResponsibility
ReadS [ModifyVpcEndpointServicePayerResponsibility]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVpcEndpointServicePayerResponsibility]
$creadListPrec :: ReadPrec [ModifyVpcEndpointServicePayerResponsibility]
readPrec :: ReadPrec ModifyVpcEndpointServicePayerResponsibility
$creadPrec :: ReadPrec ModifyVpcEndpointServicePayerResponsibility
readList :: ReadS [ModifyVpcEndpointServicePayerResponsibility]
$creadList :: ReadS [ModifyVpcEndpointServicePayerResponsibility]
readsPrec :: Int -> ReadS ModifyVpcEndpointServicePayerResponsibility
$creadsPrec :: Int -> ReadS ModifyVpcEndpointServicePayerResponsibility
Prelude.Read, Int -> ModifyVpcEndpointServicePayerResponsibility -> ShowS
[ModifyVpcEndpointServicePayerResponsibility] -> ShowS
ModifyVpcEndpointServicePayerResponsibility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVpcEndpointServicePayerResponsibility] -> ShowS
$cshowList :: [ModifyVpcEndpointServicePayerResponsibility] -> ShowS
show :: ModifyVpcEndpointServicePayerResponsibility -> String
$cshow :: ModifyVpcEndpointServicePayerResponsibility -> String
showsPrec :: Int -> ModifyVpcEndpointServicePayerResponsibility -> ShowS
$cshowsPrec :: Int -> ModifyVpcEndpointServicePayerResponsibility -> ShowS
Prelude.Show, forall x.
Rep ModifyVpcEndpointServicePayerResponsibility x
-> ModifyVpcEndpointServicePayerResponsibility
forall x.
ModifyVpcEndpointServicePayerResponsibility
-> Rep ModifyVpcEndpointServicePayerResponsibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyVpcEndpointServicePayerResponsibility x
-> ModifyVpcEndpointServicePayerResponsibility
$cfrom :: forall x.
ModifyVpcEndpointServicePayerResponsibility
-> Rep ModifyVpcEndpointServicePayerResponsibility x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVpcEndpointServicePayerResponsibility' 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:
--
-- 'dryRun', 'modifyVpcEndpointServicePayerResponsibility_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'serviceId', 'modifyVpcEndpointServicePayerResponsibility_serviceId' - The ID of the service.
--
-- 'payerResponsibility', 'modifyVpcEndpointServicePayerResponsibility_payerResponsibility' - The entity that is responsible for the endpoint costs. The default is
-- the endpoint owner. If you set the payer responsibility to the service
-- owner, you cannot set it back to the endpoint owner.
newModifyVpcEndpointServicePayerResponsibility ::
  -- | 'serviceId'
  Prelude.Text ->
  -- | 'payerResponsibility'
  PayerResponsibility ->
  ModifyVpcEndpointServicePayerResponsibility
newModifyVpcEndpointServicePayerResponsibility :: Text
-> PayerResponsibility
-> ModifyVpcEndpointServicePayerResponsibility
newModifyVpcEndpointServicePayerResponsibility
  Text
pServiceId_
  PayerResponsibility
pPayerResponsibility_ =
    ModifyVpcEndpointServicePayerResponsibility'
      { $sel:dryRun:ModifyVpcEndpointServicePayerResponsibility' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:serviceId:ModifyVpcEndpointServicePayerResponsibility' :: Text
serviceId = Text
pServiceId_,
        $sel:payerResponsibility:ModifyVpcEndpointServicePayerResponsibility' :: PayerResponsibility
payerResponsibility =
          PayerResponsibility
pPayerResponsibility_
      }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
modifyVpcEndpointServicePayerResponsibility_dryRun :: Lens.Lens' ModifyVpcEndpointServicePayerResponsibility (Prelude.Maybe Prelude.Bool)
modifyVpcEndpointServicePayerResponsibility_dryRun :: Lens' ModifyVpcEndpointServicePayerResponsibility (Maybe Bool)
modifyVpcEndpointServicePayerResponsibility_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcEndpointServicePayerResponsibility' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ModifyVpcEndpointServicePayerResponsibility
s@ModifyVpcEndpointServicePayerResponsibility' {} Maybe Bool
a -> ModifyVpcEndpointServicePayerResponsibility
s {$sel:dryRun:ModifyVpcEndpointServicePayerResponsibility' :: Maybe Bool
dryRun = Maybe Bool
a} :: ModifyVpcEndpointServicePayerResponsibility)

-- | The ID of the service.
modifyVpcEndpointServicePayerResponsibility_serviceId :: Lens.Lens' ModifyVpcEndpointServicePayerResponsibility Prelude.Text
modifyVpcEndpointServicePayerResponsibility_serviceId :: Lens' ModifyVpcEndpointServicePayerResponsibility Text
modifyVpcEndpointServicePayerResponsibility_serviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcEndpointServicePayerResponsibility' {Text
serviceId :: Text
$sel:serviceId:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Text
serviceId} -> Text
serviceId) (\s :: ModifyVpcEndpointServicePayerResponsibility
s@ModifyVpcEndpointServicePayerResponsibility' {} Text
a -> ModifyVpcEndpointServicePayerResponsibility
s {$sel:serviceId:ModifyVpcEndpointServicePayerResponsibility' :: Text
serviceId = Text
a} :: ModifyVpcEndpointServicePayerResponsibility)

-- | The entity that is responsible for the endpoint costs. The default is
-- the endpoint owner. If you set the payer responsibility to the service
-- owner, you cannot set it back to the endpoint owner.
modifyVpcEndpointServicePayerResponsibility_payerResponsibility :: Lens.Lens' ModifyVpcEndpointServicePayerResponsibility PayerResponsibility
modifyVpcEndpointServicePayerResponsibility_payerResponsibility :: Lens'
  ModifyVpcEndpointServicePayerResponsibility PayerResponsibility
modifyVpcEndpointServicePayerResponsibility_payerResponsibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcEndpointServicePayerResponsibility' {PayerResponsibility
payerResponsibility :: PayerResponsibility
$sel:payerResponsibility:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> PayerResponsibility
payerResponsibility} -> PayerResponsibility
payerResponsibility) (\s :: ModifyVpcEndpointServicePayerResponsibility
s@ModifyVpcEndpointServicePayerResponsibility' {} PayerResponsibility
a -> ModifyVpcEndpointServicePayerResponsibility
s {$sel:payerResponsibility:ModifyVpcEndpointServicePayerResponsibility' :: PayerResponsibility
payerResponsibility = PayerResponsibility
a} :: ModifyVpcEndpointServicePayerResponsibility)

instance
  Core.AWSRequest
    ModifyVpcEndpointServicePayerResponsibility
  where
  type
    AWSResponse
      ModifyVpcEndpointServicePayerResponsibility =
      ModifyVpcEndpointServicePayerResponsibilityResponse
  request :: (Service -> Service)
-> ModifyVpcEndpointServicePayerResponsibility
-> Request ModifyVpcEndpointServicePayerResponsibility
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 ModifyVpcEndpointServicePayerResponsibility
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse ModifyVpcEndpointServicePayerResponsibility)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Bool
-> Int -> ModifyVpcEndpointServicePayerResponsibilityResponse
ModifyVpcEndpointServicePayerResponsibilityResponse'
            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
"return")
            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
    ModifyVpcEndpointServicePayerResponsibility
  where
  hashWithSalt :: Int -> ModifyVpcEndpointServicePayerResponsibility -> Int
hashWithSalt
    Int
_salt
    ModifyVpcEndpointServicePayerResponsibility' {Maybe Bool
Text
PayerResponsibility
payerResponsibility :: PayerResponsibility
serviceId :: Text
dryRun :: Maybe Bool
$sel:payerResponsibility:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> PayerResponsibility
$sel:serviceId:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Text
$sel:dryRun:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PayerResponsibility
payerResponsibility

instance
  Prelude.NFData
    ModifyVpcEndpointServicePayerResponsibility
  where
  rnf :: ModifyVpcEndpointServicePayerResponsibility -> ()
rnf ModifyVpcEndpointServicePayerResponsibility' {Maybe Bool
Text
PayerResponsibility
payerResponsibility :: PayerResponsibility
serviceId :: Text
dryRun :: Maybe Bool
$sel:payerResponsibility:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> PayerResponsibility
$sel:serviceId:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Text
$sel:dryRun:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PayerResponsibility
payerResponsibility

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

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

instance
  Data.ToQuery
    ModifyVpcEndpointServicePayerResponsibility
  where
  toQuery :: ModifyVpcEndpointServicePayerResponsibility -> QueryString
toQuery
    ModifyVpcEndpointServicePayerResponsibility' {Maybe Bool
Text
PayerResponsibility
payerResponsibility :: PayerResponsibility
serviceId :: Text
dryRun :: Maybe Bool
$sel:payerResponsibility:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> PayerResponsibility
$sel:serviceId:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Text
$sel:dryRun:ModifyVpcEndpointServicePayerResponsibility' :: ModifyVpcEndpointServicePayerResponsibility -> Maybe Bool
..} =
      forall a. Monoid a => [a] -> a
Prelude.mconcat
        [ ByteString
"Action"
            forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ModifyVpcEndpointServicePayerResponsibility" ::
                        Prelude.ByteString
                    ),
          ByteString
"Version"
            forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
          ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
          ByteString
"ServiceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
serviceId,
          ByteString
"PayerResponsibility" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: PayerResponsibility
payerResponsibility
        ]

-- | /See:/ 'newModifyVpcEndpointServicePayerResponsibilityResponse' smart constructor.
data ModifyVpcEndpointServicePayerResponsibilityResponse = ModifyVpcEndpointServicePayerResponsibilityResponse'
  { -- | Returns @true@ if the request succeeds; otherwise, it returns an error.
    ModifyVpcEndpointServicePayerResponsibilityResponse -> Maybe Bool
returnValue :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    ModifyVpcEndpointServicePayerResponsibilityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyVpcEndpointServicePayerResponsibilityResponse
-> ModifyVpcEndpointServicePayerResponsibilityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyVpcEndpointServicePayerResponsibilityResponse
-> ModifyVpcEndpointServicePayerResponsibilityResponse -> Bool
$c/= :: ModifyVpcEndpointServicePayerResponsibilityResponse
-> ModifyVpcEndpointServicePayerResponsibilityResponse -> Bool
== :: ModifyVpcEndpointServicePayerResponsibilityResponse
-> ModifyVpcEndpointServicePayerResponsibilityResponse -> Bool
$c== :: ModifyVpcEndpointServicePayerResponsibilityResponse
-> ModifyVpcEndpointServicePayerResponsibilityResponse -> Bool
Prelude.Eq, ReadPrec [ModifyVpcEndpointServicePayerResponsibilityResponse]
ReadPrec ModifyVpcEndpointServicePayerResponsibilityResponse
Int -> ReadS ModifyVpcEndpointServicePayerResponsibilityResponse
ReadS [ModifyVpcEndpointServicePayerResponsibilityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyVpcEndpointServicePayerResponsibilityResponse]
$creadListPrec :: ReadPrec [ModifyVpcEndpointServicePayerResponsibilityResponse]
readPrec :: ReadPrec ModifyVpcEndpointServicePayerResponsibilityResponse
$creadPrec :: ReadPrec ModifyVpcEndpointServicePayerResponsibilityResponse
readList :: ReadS [ModifyVpcEndpointServicePayerResponsibilityResponse]
$creadList :: ReadS [ModifyVpcEndpointServicePayerResponsibilityResponse]
readsPrec :: Int -> ReadS ModifyVpcEndpointServicePayerResponsibilityResponse
$creadsPrec :: Int -> ReadS ModifyVpcEndpointServicePayerResponsibilityResponse
Prelude.Read, Int -> ModifyVpcEndpointServicePayerResponsibilityResponse -> ShowS
[ModifyVpcEndpointServicePayerResponsibilityResponse] -> ShowS
ModifyVpcEndpointServicePayerResponsibilityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyVpcEndpointServicePayerResponsibilityResponse] -> ShowS
$cshowList :: [ModifyVpcEndpointServicePayerResponsibilityResponse] -> ShowS
show :: ModifyVpcEndpointServicePayerResponsibilityResponse -> String
$cshow :: ModifyVpcEndpointServicePayerResponsibilityResponse -> String
showsPrec :: Int -> ModifyVpcEndpointServicePayerResponsibilityResponse -> ShowS
$cshowsPrec :: Int -> ModifyVpcEndpointServicePayerResponsibilityResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyVpcEndpointServicePayerResponsibilityResponse x
-> ModifyVpcEndpointServicePayerResponsibilityResponse
forall x.
ModifyVpcEndpointServicePayerResponsibilityResponse
-> Rep ModifyVpcEndpointServicePayerResponsibilityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyVpcEndpointServicePayerResponsibilityResponse x
-> ModifyVpcEndpointServicePayerResponsibilityResponse
$cfrom :: forall x.
ModifyVpcEndpointServicePayerResponsibilityResponse
-> Rep ModifyVpcEndpointServicePayerResponsibilityResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyVpcEndpointServicePayerResponsibilityResponse' 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:
--
-- 'returnValue', 'modifyVpcEndpointServicePayerResponsibilityResponse_returnValue' - Returns @true@ if the request succeeds; otherwise, it returns an error.
--
-- 'httpStatus', 'modifyVpcEndpointServicePayerResponsibilityResponse_httpStatus' - The response's http status code.
newModifyVpcEndpointServicePayerResponsibilityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyVpcEndpointServicePayerResponsibilityResponse
newModifyVpcEndpointServicePayerResponsibilityResponse :: Int -> ModifyVpcEndpointServicePayerResponsibilityResponse
newModifyVpcEndpointServicePayerResponsibilityResponse
  Int
pHttpStatus_ =
    ModifyVpcEndpointServicePayerResponsibilityResponse'
      { $sel:returnValue:ModifyVpcEndpointServicePayerResponsibilityResponse' :: Maybe Bool
returnValue =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ModifyVpcEndpointServicePayerResponsibilityResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

-- | Returns @true@ if the request succeeds; otherwise, it returns an error.
modifyVpcEndpointServicePayerResponsibilityResponse_returnValue :: Lens.Lens' ModifyVpcEndpointServicePayerResponsibilityResponse (Prelude.Maybe Prelude.Bool)
modifyVpcEndpointServicePayerResponsibilityResponse_returnValue :: Lens'
  ModifyVpcEndpointServicePayerResponsibilityResponse (Maybe Bool)
modifyVpcEndpointServicePayerResponsibilityResponse_returnValue = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyVpcEndpointServicePayerResponsibilityResponse' {Maybe Bool
returnValue :: Maybe Bool
$sel:returnValue:ModifyVpcEndpointServicePayerResponsibilityResponse' :: ModifyVpcEndpointServicePayerResponsibilityResponse -> Maybe Bool
returnValue} -> Maybe Bool
returnValue) (\s :: ModifyVpcEndpointServicePayerResponsibilityResponse
s@ModifyVpcEndpointServicePayerResponsibilityResponse' {} Maybe Bool
a -> ModifyVpcEndpointServicePayerResponsibilityResponse
s {$sel:returnValue:ModifyVpcEndpointServicePayerResponsibilityResponse' :: Maybe Bool
returnValue = Maybe Bool
a} :: ModifyVpcEndpointServicePayerResponsibilityResponse)

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

instance
  Prelude.NFData
    ModifyVpcEndpointServicePayerResponsibilityResponse
  where
  rnf :: ModifyVpcEndpointServicePayerResponsibilityResponse -> ()
rnf
    ModifyVpcEndpointServicePayerResponsibilityResponse' {Int
Maybe Bool
httpStatus :: Int
returnValue :: Maybe Bool
$sel:httpStatus:ModifyVpcEndpointServicePayerResponsibilityResponse' :: ModifyVpcEndpointServicePayerResponsibilityResponse -> Int
$sel:returnValue:ModifyVpcEndpointServicePayerResponsibilityResponse' :: ModifyVpcEndpointServicePayerResponsibilityResponse -> Maybe Bool
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
returnValue
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus