{-# 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.QuickSight.UpdateIpRestriction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the content and status of IP rules. To use this operation, you
-- need to provide the entire map of rules. You can use the
-- @DescribeIpRestriction@ operation to get the current rule map.
module Amazonka.QuickSight.UpdateIpRestriction
  ( -- * Creating a Request
    UpdateIpRestriction (..),
    newUpdateIpRestriction,

    -- * Request Lenses
    updateIpRestriction_enabled,
    updateIpRestriction_ipRestrictionRuleMap,
    updateIpRestriction_awsAccountId,

    -- * Destructuring the Response
    UpdateIpRestrictionResponse (..),
    newUpdateIpRestrictionResponse,

    -- * Response Lenses
    updateIpRestrictionResponse_awsAccountId,
    updateIpRestrictionResponse_requestId,
    updateIpRestrictionResponse_status,
  )
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 Amazonka.QuickSight.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateIpRestriction' smart constructor.
data UpdateIpRestriction = UpdateIpRestriction'
  { -- | A value that specifies whether IP rules are turned on.
    UpdateIpRestriction -> Maybe Bool
enabled :: Prelude.Maybe Prelude.Bool,
    -- | A map that describes the updated IP rules with CIDR ranges and
    -- descriptions.
    UpdateIpRestriction -> Maybe (HashMap Text Text)
ipRestrictionRuleMap :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ID of the Amazon Web Services account that contains the IP rules.
    UpdateIpRestriction -> Text
awsAccountId :: Prelude.Text
  }
  deriving (UpdateIpRestriction -> UpdateIpRestriction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIpRestriction -> UpdateIpRestriction -> Bool
$c/= :: UpdateIpRestriction -> UpdateIpRestriction -> Bool
== :: UpdateIpRestriction -> UpdateIpRestriction -> Bool
$c== :: UpdateIpRestriction -> UpdateIpRestriction -> Bool
Prelude.Eq, ReadPrec [UpdateIpRestriction]
ReadPrec UpdateIpRestriction
Int -> ReadS UpdateIpRestriction
ReadS [UpdateIpRestriction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateIpRestriction]
$creadListPrec :: ReadPrec [UpdateIpRestriction]
readPrec :: ReadPrec UpdateIpRestriction
$creadPrec :: ReadPrec UpdateIpRestriction
readList :: ReadS [UpdateIpRestriction]
$creadList :: ReadS [UpdateIpRestriction]
readsPrec :: Int -> ReadS UpdateIpRestriction
$creadsPrec :: Int -> ReadS UpdateIpRestriction
Prelude.Read, Int -> UpdateIpRestriction -> ShowS
[UpdateIpRestriction] -> ShowS
UpdateIpRestriction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIpRestriction] -> ShowS
$cshowList :: [UpdateIpRestriction] -> ShowS
show :: UpdateIpRestriction -> String
$cshow :: UpdateIpRestriction -> String
showsPrec :: Int -> UpdateIpRestriction -> ShowS
$cshowsPrec :: Int -> UpdateIpRestriction -> ShowS
Prelude.Show, forall x. Rep UpdateIpRestriction x -> UpdateIpRestriction
forall x. UpdateIpRestriction -> Rep UpdateIpRestriction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateIpRestriction x -> UpdateIpRestriction
$cfrom :: forall x. UpdateIpRestriction -> Rep UpdateIpRestriction x
Prelude.Generic)

-- |
-- Create a value of 'UpdateIpRestriction' 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:
--
-- 'enabled', 'updateIpRestriction_enabled' - A value that specifies whether IP rules are turned on.
--
-- 'ipRestrictionRuleMap', 'updateIpRestriction_ipRestrictionRuleMap' - A map that describes the updated IP rules with CIDR ranges and
-- descriptions.
--
-- 'awsAccountId', 'updateIpRestriction_awsAccountId' - The ID of the Amazon Web Services account that contains the IP rules.
newUpdateIpRestriction ::
  -- | 'awsAccountId'
  Prelude.Text ->
  UpdateIpRestriction
newUpdateIpRestriction :: Text -> UpdateIpRestriction
newUpdateIpRestriction Text
pAwsAccountId_ =
  UpdateIpRestriction'
    { $sel:enabled:UpdateIpRestriction' :: Maybe Bool
enabled = forall a. Maybe a
Prelude.Nothing,
      $sel:ipRestrictionRuleMap:UpdateIpRestriction' :: Maybe (HashMap Text Text)
ipRestrictionRuleMap = forall a. Maybe a
Prelude.Nothing,
      $sel:awsAccountId:UpdateIpRestriction' :: Text
awsAccountId = Text
pAwsAccountId_
    }

-- | A value that specifies whether IP rules are turned on.
updateIpRestriction_enabled :: Lens.Lens' UpdateIpRestriction (Prelude.Maybe Prelude.Bool)
updateIpRestriction_enabled :: Lens' UpdateIpRestriction (Maybe Bool)
updateIpRestriction_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIpRestriction' {Maybe Bool
enabled :: Maybe Bool
$sel:enabled:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe Bool
enabled} -> Maybe Bool
enabled) (\s :: UpdateIpRestriction
s@UpdateIpRestriction' {} Maybe Bool
a -> UpdateIpRestriction
s {$sel:enabled:UpdateIpRestriction' :: Maybe Bool
enabled = Maybe Bool
a} :: UpdateIpRestriction)

-- | A map that describes the updated IP rules with CIDR ranges and
-- descriptions.
updateIpRestriction_ipRestrictionRuleMap :: Lens.Lens' UpdateIpRestriction (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateIpRestriction_ipRestrictionRuleMap :: Lens' UpdateIpRestriction (Maybe (HashMap Text Text))
updateIpRestriction_ipRestrictionRuleMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIpRestriction' {Maybe (HashMap Text Text)
ipRestrictionRuleMap :: Maybe (HashMap Text Text)
$sel:ipRestrictionRuleMap:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe (HashMap Text Text)
ipRestrictionRuleMap} -> Maybe (HashMap Text Text)
ipRestrictionRuleMap) (\s :: UpdateIpRestriction
s@UpdateIpRestriction' {} Maybe (HashMap Text Text)
a -> UpdateIpRestriction
s {$sel:ipRestrictionRuleMap:UpdateIpRestriction' :: Maybe (HashMap Text Text)
ipRestrictionRuleMap = Maybe (HashMap Text Text)
a} :: UpdateIpRestriction) 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 ID of the Amazon Web Services account that contains the IP rules.
updateIpRestriction_awsAccountId :: Lens.Lens' UpdateIpRestriction Prelude.Text
updateIpRestriction_awsAccountId :: Lens' UpdateIpRestriction Text
updateIpRestriction_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIpRestriction' {Text
awsAccountId :: Text
$sel:awsAccountId:UpdateIpRestriction' :: UpdateIpRestriction -> Text
awsAccountId} -> Text
awsAccountId) (\s :: UpdateIpRestriction
s@UpdateIpRestriction' {} Text
a -> UpdateIpRestriction
s {$sel:awsAccountId:UpdateIpRestriction' :: Text
awsAccountId = Text
a} :: UpdateIpRestriction)

instance Core.AWSRequest UpdateIpRestriction where
  type
    AWSResponse UpdateIpRestriction =
      UpdateIpRestrictionResponse
  request :: (Service -> Service)
-> UpdateIpRestriction -> Request UpdateIpRestriction
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 UpdateIpRestriction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateIpRestriction)))
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 Text -> Maybe Text -> Int -> UpdateIpRestrictionResponse
UpdateIpRestrictionResponse'
            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
"AwsAccountId")
            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
"RequestId")
            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 UpdateIpRestriction where
  hashWithSalt :: Int -> UpdateIpRestriction -> Int
hashWithSalt Int
_salt UpdateIpRestriction' {Maybe Bool
Maybe (HashMap Text Text)
Text
awsAccountId :: Text
ipRestrictionRuleMap :: Maybe (HashMap Text Text)
enabled :: Maybe Bool
$sel:awsAccountId:UpdateIpRestriction' :: UpdateIpRestriction -> Text
$sel:ipRestrictionRuleMap:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe (HashMap Text Text)
$sel:enabled:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
ipRestrictionRuleMap
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId

instance Prelude.NFData UpdateIpRestriction where
  rnf :: UpdateIpRestriction -> ()
rnf UpdateIpRestriction' {Maybe Bool
Maybe (HashMap Text Text)
Text
awsAccountId :: Text
ipRestrictionRuleMap :: Maybe (HashMap Text Text)
enabled :: Maybe Bool
$sel:awsAccountId:UpdateIpRestriction' :: UpdateIpRestriction -> Text
$sel:ipRestrictionRuleMap:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe (HashMap Text Text)
$sel:enabled:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
ipRestrictionRuleMap
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId

instance Data.ToHeaders UpdateIpRestriction where
  toHeaders :: UpdateIpRestriction -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateIpRestriction where
  toJSON :: UpdateIpRestriction -> Value
toJSON UpdateIpRestriction' {Maybe Bool
Maybe (HashMap Text Text)
Text
awsAccountId :: Text
ipRestrictionRuleMap :: Maybe (HashMap Text Text)
enabled :: Maybe Bool
$sel:awsAccountId:UpdateIpRestriction' :: UpdateIpRestriction -> Text
$sel:ipRestrictionRuleMap:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe (HashMap Text Text)
$sel:enabled:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Enabled" 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 Bool
enabled,
            (Key
"IpRestrictionRuleMap" 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 (HashMap Text Text)
ipRestrictionRuleMap
          ]
      )

instance Data.ToPath UpdateIpRestriction where
  toPath :: UpdateIpRestriction -> ByteString
toPath UpdateIpRestriction' {Maybe Bool
Maybe (HashMap Text Text)
Text
awsAccountId :: Text
ipRestrictionRuleMap :: Maybe (HashMap Text Text)
enabled :: Maybe Bool
$sel:awsAccountId:UpdateIpRestriction' :: UpdateIpRestriction -> Text
$sel:ipRestrictionRuleMap:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe (HashMap Text Text)
$sel:enabled:UpdateIpRestriction' :: UpdateIpRestriction -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
awsAccountId,
        ByteString
"/ip-restriction"
      ]

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

-- | /See:/ 'newUpdateIpRestrictionResponse' smart constructor.
data UpdateIpRestrictionResponse = UpdateIpRestrictionResponse'
  { -- | The ID of the Amazon Web Services account that contains the IP rules.
    UpdateIpRestrictionResponse -> Maybe Text
awsAccountId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services request ID for this operation.
    UpdateIpRestrictionResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The HTTP status of the request.
    UpdateIpRestrictionResponse -> Int
status :: Prelude.Int
  }
  deriving (UpdateIpRestrictionResponse -> UpdateIpRestrictionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIpRestrictionResponse -> UpdateIpRestrictionResponse -> Bool
$c/= :: UpdateIpRestrictionResponse -> UpdateIpRestrictionResponse -> Bool
== :: UpdateIpRestrictionResponse -> UpdateIpRestrictionResponse -> Bool
$c== :: UpdateIpRestrictionResponse -> UpdateIpRestrictionResponse -> Bool
Prelude.Eq, ReadPrec [UpdateIpRestrictionResponse]
ReadPrec UpdateIpRestrictionResponse
Int -> ReadS UpdateIpRestrictionResponse
ReadS [UpdateIpRestrictionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateIpRestrictionResponse]
$creadListPrec :: ReadPrec [UpdateIpRestrictionResponse]
readPrec :: ReadPrec UpdateIpRestrictionResponse
$creadPrec :: ReadPrec UpdateIpRestrictionResponse
readList :: ReadS [UpdateIpRestrictionResponse]
$creadList :: ReadS [UpdateIpRestrictionResponse]
readsPrec :: Int -> ReadS UpdateIpRestrictionResponse
$creadsPrec :: Int -> ReadS UpdateIpRestrictionResponse
Prelude.Read, Int -> UpdateIpRestrictionResponse -> ShowS
[UpdateIpRestrictionResponse] -> ShowS
UpdateIpRestrictionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIpRestrictionResponse] -> ShowS
$cshowList :: [UpdateIpRestrictionResponse] -> ShowS
show :: UpdateIpRestrictionResponse -> String
$cshow :: UpdateIpRestrictionResponse -> String
showsPrec :: Int -> UpdateIpRestrictionResponse -> ShowS
$cshowsPrec :: Int -> UpdateIpRestrictionResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateIpRestrictionResponse x -> UpdateIpRestrictionResponse
forall x.
UpdateIpRestrictionResponse -> Rep UpdateIpRestrictionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateIpRestrictionResponse x -> UpdateIpRestrictionResponse
$cfrom :: forall x.
UpdateIpRestrictionResponse -> Rep UpdateIpRestrictionResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateIpRestrictionResponse' 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:
--
-- 'awsAccountId', 'updateIpRestrictionResponse_awsAccountId' - The ID of the Amazon Web Services account that contains the IP rules.
--
-- 'requestId', 'updateIpRestrictionResponse_requestId' - The Amazon Web Services request ID for this operation.
--
-- 'status', 'updateIpRestrictionResponse_status' - The HTTP status of the request.
newUpdateIpRestrictionResponse ::
  -- | 'status'
  Prelude.Int ->
  UpdateIpRestrictionResponse
newUpdateIpRestrictionResponse :: Int -> UpdateIpRestrictionResponse
newUpdateIpRestrictionResponse Int
pStatus_ =
  UpdateIpRestrictionResponse'
    { $sel:awsAccountId:UpdateIpRestrictionResponse' :: Maybe Text
awsAccountId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:UpdateIpRestrictionResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateIpRestrictionResponse' :: Int
status = Int
pStatus_
    }

-- | The ID of the Amazon Web Services account that contains the IP rules.
updateIpRestrictionResponse_awsAccountId :: Lens.Lens' UpdateIpRestrictionResponse (Prelude.Maybe Prelude.Text)
updateIpRestrictionResponse_awsAccountId :: Lens' UpdateIpRestrictionResponse (Maybe Text)
updateIpRestrictionResponse_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIpRestrictionResponse' {Maybe Text
awsAccountId :: Maybe Text
$sel:awsAccountId:UpdateIpRestrictionResponse' :: UpdateIpRestrictionResponse -> Maybe Text
awsAccountId} -> Maybe Text
awsAccountId) (\s :: UpdateIpRestrictionResponse
s@UpdateIpRestrictionResponse' {} Maybe Text
a -> UpdateIpRestrictionResponse
s {$sel:awsAccountId:UpdateIpRestrictionResponse' :: Maybe Text
awsAccountId = Maybe Text
a} :: UpdateIpRestrictionResponse)

-- | The Amazon Web Services request ID for this operation.
updateIpRestrictionResponse_requestId :: Lens.Lens' UpdateIpRestrictionResponse (Prelude.Maybe Prelude.Text)
updateIpRestrictionResponse_requestId :: Lens' UpdateIpRestrictionResponse (Maybe Text)
updateIpRestrictionResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIpRestrictionResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:UpdateIpRestrictionResponse' :: UpdateIpRestrictionResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: UpdateIpRestrictionResponse
s@UpdateIpRestrictionResponse' {} Maybe Text
a -> UpdateIpRestrictionResponse
s {$sel:requestId:UpdateIpRestrictionResponse' :: Maybe Text
requestId = Maybe Text
a} :: UpdateIpRestrictionResponse)

-- | The HTTP status of the request.
updateIpRestrictionResponse_status :: Lens.Lens' UpdateIpRestrictionResponse Prelude.Int
updateIpRestrictionResponse_status :: Lens' UpdateIpRestrictionResponse Int
updateIpRestrictionResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIpRestrictionResponse' {Int
status :: Int
$sel:status:UpdateIpRestrictionResponse' :: UpdateIpRestrictionResponse -> Int
status} -> Int
status) (\s :: UpdateIpRestrictionResponse
s@UpdateIpRestrictionResponse' {} Int
a -> UpdateIpRestrictionResponse
s {$sel:status:UpdateIpRestrictionResponse' :: Int
status = Int
a} :: UpdateIpRestrictionResponse)

instance Prelude.NFData UpdateIpRestrictionResponse where
  rnf :: UpdateIpRestrictionResponse -> ()
rnf UpdateIpRestrictionResponse' {Int
Maybe Text
status :: Int
requestId :: Maybe Text
awsAccountId :: Maybe Text
$sel:status:UpdateIpRestrictionResponse' :: UpdateIpRestrictionResponse -> Int
$sel:requestId:UpdateIpRestrictionResponse' :: UpdateIpRestrictionResponse -> Maybe Text
$sel:awsAccountId:UpdateIpRestrictionResponse' :: UpdateIpRestrictionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
awsAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
status