{-# 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.MediaLive.UpdateInputSecurityGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update an Input Security Group\'s Whilelists.
module Amazonka.MediaLive.UpdateInputSecurityGroup
  ( -- * Creating a Request
    UpdateInputSecurityGroup (..),
    newUpdateInputSecurityGroup,

    -- * Request Lenses
    updateInputSecurityGroup_tags,
    updateInputSecurityGroup_whitelistRules,
    updateInputSecurityGroup_inputSecurityGroupId,

    -- * Destructuring the Response
    UpdateInputSecurityGroupResponse (..),
    newUpdateInputSecurityGroupResponse,

    -- * Response Lenses
    updateInputSecurityGroupResponse_securityGroup,
    updateInputSecurityGroupResponse_httpStatus,
  )
where

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

-- | The request to update some combination of the Input Security Group name
-- and the IPv4 CIDRs the Input Security Group should allow.
--
-- /See:/ 'newUpdateInputSecurityGroup' smart constructor.
data UpdateInputSecurityGroup = UpdateInputSecurityGroup'
  { -- | A collection of key-value pairs.
    UpdateInputSecurityGroup -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | List of IPv4 CIDR addresses to whitelist
    UpdateInputSecurityGroup -> Maybe [InputWhitelistRuleCidr]
whitelistRules :: Prelude.Maybe [InputWhitelistRuleCidr],
    -- | The id of the Input Security Group to update.
    UpdateInputSecurityGroup -> Text
inputSecurityGroupId :: Prelude.Text
  }
  deriving (UpdateInputSecurityGroup -> UpdateInputSecurityGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateInputSecurityGroup -> UpdateInputSecurityGroup -> Bool
$c/= :: UpdateInputSecurityGroup -> UpdateInputSecurityGroup -> Bool
== :: UpdateInputSecurityGroup -> UpdateInputSecurityGroup -> Bool
$c== :: UpdateInputSecurityGroup -> UpdateInputSecurityGroup -> Bool
Prelude.Eq, ReadPrec [UpdateInputSecurityGroup]
ReadPrec UpdateInputSecurityGroup
Int -> ReadS UpdateInputSecurityGroup
ReadS [UpdateInputSecurityGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateInputSecurityGroup]
$creadListPrec :: ReadPrec [UpdateInputSecurityGroup]
readPrec :: ReadPrec UpdateInputSecurityGroup
$creadPrec :: ReadPrec UpdateInputSecurityGroup
readList :: ReadS [UpdateInputSecurityGroup]
$creadList :: ReadS [UpdateInputSecurityGroup]
readsPrec :: Int -> ReadS UpdateInputSecurityGroup
$creadsPrec :: Int -> ReadS UpdateInputSecurityGroup
Prelude.Read, Int -> UpdateInputSecurityGroup -> ShowS
[UpdateInputSecurityGroup] -> ShowS
UpdateInputSecurityGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateInputSecurityGroup] -> ShowS
$cshowList :: [UpdateInputSecurityGroup] -> ShowS
show :: UpdateInputSecurityGroup -> String
$cshow :: UpdateInputSecurityGroup -> String
showsPrec :: Int -> UpdateInputSecurityGroup -> ShowS
$cshowsPrec :: Int -> UpdateInputSecurityGroup -> ShowS
Prelude.Show, forall x.
Rep UpdateInputSecurityGroup x -> UpdateInputSecurityGroup
forall x.
UpdateInputSecurityGroup -> Rep UpdateInputSecurityGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateInputSecurityGroup x -> UpdateInputSecurityGroup
$cfrom :: forall x.
UpdateInputSecurityGroup -> Rep UpdateInputSecurityGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateInputSecurityGroup' 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:
--
-- 'tags', 'updateInputSecurityGroup_tags' - A collection of key-value pairs.
--
-- 'whitelistRules', 'updateInputSecurityGroup_whitelistRules' - List of IPv4 CIDR addresses to whitelist
--
-- 'inputSecurityGroupId', 'updateInputSecurityGroup_inputSecurityGroupId' - The id of the Input Security Group to update.
newUpdateInputSecurityGroup ::
  -- | 'inputSecurityGroupId'
  Prelude.Text ->
  UpdateInputSecurityGroup
newUpdateInputSecurityGroup :: Text -> UpdateInputSecurityGroup
newUpdateInputSecurityGroup Text
pInputSecurityGroupId_ =
  UpdateInputSecurityGroup'
    { $sel:tags:UpdateInputSecurityGroup' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:whitelistRules:UpdateInputSecurityGroup' :: Maybe [InputWhitelistRuleCidr]
whitelistRules = forall a. Maybe a
Prelude.Nothing,
      $sel:inputSecurityGroupId:UpdateInputSecurityGroup' :: Text
inputSecurityGroupId = Text
pInputSecurityGroupId_
    }

-- | A collection of key-value pairs.
updateInputSecurityGroup_tags :: Lens.Lens' UpdateInputSecurityGroup (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateInputSecurityGroup_tags :: Lens' UpdateInputSecurityGroup (Maybe (HashMap Text Text))
updateInputSecurityGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInputSecurityGroup' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: UpdateInputSecurityGroup
s@UpdateInputSecurityGroup' {} Maybe (HashMap Text Text)
a -> UpdateInputSecurityGroup
s {$sel:tags:UpdateInputSecurityGroup' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: UpdateInputSecurityGroup) 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

-- | List of IPv4 CIDR addresses to whitelist
updateInputSecurityGroup_whitelistRules :: Lens.Lens' UpdateInputSecurityGroup (Prelude.Maybe [InputWhitelistRuleCidr])
updateInputSecurityGroup_whitelistRules :: Lens' UpdateInputSecurityGroup (Maybe [InputWhitelistRuleCidr])
updateInputSecurityGroup_whitelistRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInputSecurityGroup' {Maybe [InputWhitelistRuleCidr]
whitelistRules :: Maybe [InputWhitelistRuleCidr]
$sel:whitelistRules:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe [InputWhitelistRuleCidr]
whitelistRules} -> Maybe [InputWhitelistRuleCidr]
whitelistRules) (\s :: UpdateInputSecurityGroup
s@UpdateInputSecurityGroup' {} Maybe [InputWhitelistRuleCidr]
a -> UpdateInputSecurityGroup
s {$sel:whitelistRules:UpdateInputSecurityGroup' :: Maybe [InputWhitelistRuleCidr]
whitelistRules = Maybe [InputWhitelistRuleCidr]
a} :: UpdateInputSecurityGroup) 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 Input Security Group to update.
updateInputSecurityGroup_inputSecurityGroupId :: Lens.Lens' UpdateInputSecurityGroup Prelude.Text
updateInputSecurityGroup_inputSecurityGroupId :: Lens' UpdateInputSecurityGroup Text
updateInputSecurityGroup_inputSecurityGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInputSecurityGroup' {Text
inputSecurityGroupId :: Text
$sel:inputSecurityGroupId:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Text
inputSecurityGroupId} -> Text
inputSecurityGroupId) (\s :: UpdateInputSecurityGroup
s@UpdateInputSecurityGroup' {} Text
a -> UpdateInputSecurityGroup
s {$sel:inputSecurityGroupId:UpdateInputSecurityGroup' :: Text
inputSecurityGroupId = Text
a} :: UpdateInputSecurityGroup)

instance Core.AWSRequest UpdateInputSecurityGroup where
  type
    AWSResponse UpdateInputSecurityGroup =
      UpdateInputSecurityGroupResponse
  request :: (Service -> Service)
-> UpdateInputSecurityGroup -> Request UpdateInputSecurityGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateInputSecurityGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateInputSecurityGroup)))
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 InputSecurityGroup -> Int -> UpdateInputSecurityGroupResponse
UpdateInputSecurityGroupResponse'
            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
"securityGroup")
            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 UpdateInputSecurityGroup where
  hashWithSalt :: Int -> UpdateInputSecurityGroup -> Int
hashWithSalt Int
_salt UpdateInputSecurityGroup' {Maybe [InputWhitelistRuleCidr]
Maybe (HashMap Text Text)
Text
inputSecurityGroupId :: Text
whitelistRules :: Maybe [InputWhitelistRuleCidr]
tags :: Maybe (HashMap Text Text)
$sel:inputSecurityGroupId:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Text
$sel:whitelistRules:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe [InputWhitelistRuleCidr]
$sel:tags:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InputWhitelistRuleCidr]
whitelistRules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputSecurityGroupId

instance Prelude.NFData UpdateInputSecurityGroup where
  rnf :: UpdateInputSecurityGroup -> ()
rnf UpdateInputSecurityGroup' {Maybe [InputWhitelistRuleCidr]
Maybe (HashMap Text Text)
Text
inputSecurityGroupId :: Text
whitelistRules :: Maybe [InputWhitelistRuleCidr]
tags :: Maybe (HashMap Text Text)
$sel:inputSecurityGroupId:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Text
$sel:whitelistRules:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe [InputWhitelistRuleCidr]
$sel:tags:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InputWhitelistRuleCidr]
whitelistRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
inputSecurityGroupId

instance Data.ToHeaders UpdateInputSecurityGroup where
  toHeaders :: UpdateInputSecurityGroup -> 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.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateInputSecurityGroup where
  toJSON :: UpdateInputSecurityGroup -> Value
toJSON UpdateInputSecurityGroup' {Maybe [InputWhitelistRuleCidr]
Maybe (HashMap Text Text)
Text
inputSecurityGroupId :: Text
whitelistRules :: Maybe [InputWhitelistRuleCidr]
tags :: Maybe (HashMap Text Text)
$sel:inputSecurityGroupId:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Text
$sel:whitelistRules:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe [InputWhitelistRuleCidr]
$sel:tags:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"tags" 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)
tags,
            (Key
"whitelistRules" 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 [InputWhitelistRuleCidr]
whitelistRules
          ]
      )

instance Data.ToPath UpdateInputSecurityGroup where
  toPath :: UpdateInputSecurityGroup -> ByteString
toPath UpdateInputSecurityGroup' {Maybe [InputWhitelistRuleCidr]
Maybe (HashMap Text Text)
Text
inputSecurityGroupId :: Text
whitelistRules :: Maybe [InputWhitelistRuleCidr]
tags :: Maybe (HashMap Text Text)
$sel:inputSecurityGroupId:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Text
$sel:whitelistRules:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe [InputWhitelistRuleCidr]
$sel:tags:UpdateInputSecurityGroup' :: UpdateInputSecurityGroup -> Maybe (HashMap Text Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/prod/inputSecurityGroups/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
inputSecurityGroupId
      ]

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

-- | Placeholder documentation for UpdateInputSecurityGroupResponse
--
-- /See:/ 'newUpdateInputSecurityGroupResponse' smart constructor.
data UpdateInputSecurityGroupResponse = UpdateInputSecurityGroupResponse'
  { UpdateInputSecurityGroupResponse -> Maybe InputSecurityGroup
securityGroup :: Prelude.Maybe InputSecurityGroup,
    -- | The response's http status code.
    UpdateInputSecurityGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateInputSecurityGroupResponse
-> UpdateInputSecurityGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateInputSecurityGroupResponse
-> UpdateInputSecurityGroupResponse -> Bool
$c/= :: UpdateInputSecurityGroupResponse
-> UpdateInputSecurityGroupResponse -> Bool
== :: UpdateInputSecurityGroupResponse
-> UpdateInputSecurityGroupResponse -> Bool
$c== :: UpdateInputSecurityGroupResponse
-> UpdateInputSecurityGroupResponse -> Bool
Prelude.Eq, ReadPrec [UpdateInputSecurityGroupResponse]
ReadPrec UpdateInputSecurityGroupResponse
Int -> ReadS UpdateInputSecurityGroupResponse
ReadS [UpdateInputSecurityGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateInputSecurityGroupResponse]
$creadListPrec :: ReadPrec [UpdateInputSecurityGroupResponse]
readPrec :: ReadPrec UpdateInputSecurityGroupResponse
$creadPrec :: ReadPrec UpdateInputSecurityGroupResponse
readList :: ReadS [UpdateInputSecurityGroupResponse]
$creadList :: ReadS [UpdateInputSecurityGroupResponse]
readsPrec :: Int -> ReadS UpdateInputSecurityGroupResponse
$creadsPrec :: Int -> ReadS UpdateInputSecurityGroupResponse
Prelude.Read, Int -> UpdateInputSecurityGroupResponse -> ShowS
[UpdateInputSecurityGroupResponse] -> ShowS
UpdateInputSecurityGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateInputSecurityGroupResponse] -> ShowS
$cshowList :: [UpdateInputSecurityGroupResponse] -> ShowS
show :: UpdateInputSecurityGroupResponse -> String
$cshow :: UpdateInputSecurityGroupResponse -> String
showsPrec :: Int -> UpdateInputSecurityGroupResponse -> ShowS
$cshowsPrec :: Int -> UpdateInputSecurityGroupResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateInputSecurityGroupResponse x
-> UpdateInputSecurityGroupResponse
forall x.
UpdateInputSecurityGroupResponse
-> Rep UpdateInputSecurityGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateInputSecurityGroupResponse x
-> UpdateInputSecurityGroupResponse
$cfrom :: forall x.
UpdateInputSecurityGroupResponse
-> Rep UpdateInputSecurityGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateInputSecurityGroupResponse' 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:
--
-- 'securityGroup', 'updateInputSecurityGroupResponse_securityGroup' - Undocumented member.
--
-- 'httpStatus', 'updateInputSecurityGroupResponse_httpStatus' - The response's http status code.
newUpdateInputSecurityGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateInputSecurityGroupResponse
newUpdateInputSecurityGroupResponse :: Int -> UpdateInputSecurityGroupResponse
newUpdateInputSecurityGroupResponse Int
pHttpStatus_ =
  UpdateInputSecurityGroupResponse'
    { $sel:securityGroup:UpdateInputSecurityGroupResponse' :: Maybe InputSecurityGroup
securityGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateInputSecurityGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updateInputSecurityGroupResponse_securityGroup :: Lens.Lens' UpdateInputSecurityGroupResponse (Prelude.Maybe InputSecurityGroup)
updateInputSecurityGroupResponse_securityGroup :: Lens' UpdateInputSecurityGroupResponse (Maybe InputSecurityGroup)
updateInputSecurityGroupResponse_securityGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInputSecurityGroupResponse' {Maybe InputSecurityGroup
securityGroup :: Maybe InputSecurityGroup
$sel:securityGroup:UpdateInputSecurityGroupResponse' :: UpdateInputSecurityGroupResponse -> Maybe InputSecurityGroup
securityGroup} -> Maybe InputSecurityGroup
securityGroup) (\s :: UpdateInputSecurityGroupResponse
s@UpdateInputSecurityGroupResponse' {} Maybe InputSecurityGroup
a -> UpdateInputSecurityGroupResponse
s {$sel:securityGroup:UpdateInputSecurityGroupResponse' :: Maybe InputSecurityGroup
securityGroup = Maybe InputSecurityGroup
a} :: UpdateInputSecurityGroupResponse)

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

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