{-# 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.ElastiCache.AuthorizeCacheSecurityGroupIngress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Allows network ingress to a cache security group. Applications using
-- ElastiCache must be running on Amazon EC2, and Amazon EC2 security
-- groups are used as the authorization mechanism.
--
-- You cannot authorize ingress from an Amazon EC2 security group in one
-- region to an ElastiCache cluster in another region.
module Amazonka.ElastiCache.AuthorizeCacheSecurityGroupIngress
  ( -- * Creating a Request
    AuthorizeCacheSecurityGroupIngress (..),
    newAuthorizeCacheSecurityGroupIngress,

    -- * Request Lenses
    authorizeCacheSecurityGroupIngress_cacheSecurityGroupName,
    authorizeCacheSecurityGroupIngress_eC2SecurityGroupName,
    authorizeCacheSecurityGroupIngress_eC2SecurityGroupOwnerId,

    -- * Destructuring the Response
    AuthorizeCacheSecurityGroupIngressResponse (..),
    newAuthorizeCacheSecurityGroupIngressResponse,

    -- * Response Lenses
    authorizeCacheSecurityGroupIngressResponse_cacheSecurityGroup,
    authorizeCacheSecurityGroupIngressResponse_httpStatus,
  )
where

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

-- | Represents the input of an AuthorizeCacheSecurityGroupIngress operation.
--
-- /See:/ 'newAuthorizeCacheSecurityGroupIngress' smart constructor.
data AuthorizeCacheSecurityGroupIngress = AuthorizeCacheSecurityGroupIngress'
  { -- | The cache security group that allows network ingress.
    AuthorizeCacheSecurityGroupIngress -> Text
cacheSecurityGroupName :: Prelude.Text,
    -- | The Amazon EC2 security group to be authorized for ingress to the cache
    -- security group.
    AuthorizeCacheSecurityGroupIngress -> Text
eC2SecurityGroupName :: Prelude.Text,
    -- | The Amazon account number of the Amazon EC2 security group owner. Note
    -- that this is not the same thing as an Amazon access key ID - you must
    -- provide a valid Amazon account number for this parameter.
    AuthorizeCacheSecurityGroupIngress -> Text
eC2SecurityGroupOwnerId :: Prelude.Text
  }
  deriving (AuthorizeCacheSecurityGroupIngress
-> AuthorizeCacheSecurityGroupIngress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizeCacheSecurityGroupIngress
-> AuthorizeCacheSecurityGroupIngress -> Bool
$c/= :: AuthorizeCacheSecurityGroupIngress
-> AuthorizeCacheSecurityGroupIngress -> Bool
== :: AuthorizeCacheSecurityGroupIngress
-> AuthorizeCacheSecurityGroupIngress -> Bool
$c== :: AuthorizeCacheSecurityGroupIngress
-> AuthorizeCacheSecurityGroupIngress -> Bool
Prelude.Eq, ReadPrec [AuthorizeCacheSecurityGroupIngress]
ReadPrec AuthorizeCacheSecurityGroupIngress
Int -> ReadS AuthorizeCacheSecurityGroupIngress
ReadS [AuthorizeCacheSecurityGroupIngress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AuthorizeCacheSecurityGroupIngress]
$creadListPrec :: ReadPrec [AuthorizeCacheSecurityGroupIngress]
readPrec :: ReadPrec AuthorizeCacheSecurityGroupIngress
$creadPrec :: ReadPrec AuthorizeCacheSecurityGroupIngress
readList :: ReadS [AuthorizeCacheSecurityGroupIngress]
$creadList :: ReadS [AuthorizeCacheSecurityGroupIngress]
readsPrec :: Int -> ReadS AuthorizeCacheSecurityGroupIngress
$creadsPrec :: Int -> ReadS AuthorizeCacheSecurityGroupIngress
Prelude.Read, Int -> AuthorizeCacheSecurityGroupIngress -> ShowS
[AuthorizeCacheSecurityGroupIngress] -> ShowS
AuthorizeCacheSecurityGroupIngress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizeCacheSecurityGroupIngress] -> ShowS
$cshowList :: [AuthorizeCacheSecurityGroupIngress] -> ShowS
show :: AuthorizeCacheSecurityGroupIngress -> String
$cshow :: AuthorizeCacheSecurityGroupIngress -> String
showsPrec :: Int -> AuthorizeCacheSecurityGroupIngress -> ShowS
$cshowsPrec :: Int -> AuthorizeCacheSecurityGroupIngress -> ShowS
Prelude.Show, forall x.
Rep AuthorizeCacheSecurityGroupIngress x
-> AuthorizeCacheSecurityGroupIngress
forall x.
AuthorizeCacheSecurityGroupIngress
-> Rep AuthorizeCacheSecurityGroupIngress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AuthorizeCacheSecurityGroupIngress x
-> AuthorizeCacheSecurityGroupIngress
$cfrom :: forall x.
AuthorizeCacheSecurityGroupIngress
-> Rep AuthorizeCacheSecurityGroupIngress x
Prelude.Generic)

-- |
-- Create a value of 'AuthorizeCacheSecurityGroupIngress' 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:
--
-- 'cacheSecurityGroupName', 'authorizeCacheSecurityGroupIngress_cacheSecurityGroupName' - The cache security group that allows network ingress.
--
-- 'eC2SecurityGroupName', 'authorizeCacheSecurityGroupIngress_eC2SecurityGroupName' - The Amazon EC2 security group to be authorized for ingress to the cache
-- security group.
--
-- 'eC2SecurityGroupOwnerId', 'authorizeCacheSecurityGroupIngress_eC2SecurityGroupOwnerId' - The Amazon account number of the Amazon EC2 security group owner. Note
-- that this is not the same thing as an Amazon access key ID - you must
-- provide a valid Amazon account number for this parameter.
newAuthorizeCacheSecurityGroupIngress ::
  -- | 'cacheSecurityGroupName'
  Prelude.Text ->
  -- | 'eC2SecurityGroupName'
  Prelude.Text ->
  -- | 'eC2SecurityGroupOwnerId'
  Prelude.Text ->
  AuthorizeCacheSecurityGroupIngress
newAuthorizeCacheSecurityGroupIngress :: Text -> Text -> Text -> AuthorizeCacheSecurityGroupIngress
newAuthorizeCacheSecurityGroupIngress
  Text
pCacheSecurityGroupName_
  Text
pEC2SecurityGroupName_
  Text
pEC2SecurityGroupOwnerId_ =
    AuthorizeCacheSecurityGroupIngress'
      { $sel:cacheSecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: Text
cacheSecurityGroupName =
          Text
pCacheSecurityGroupName_,
        $sel:eC2SecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: Text
eC2SecurityGroupName =
          Text
pEC2SecurityGroupName_,
        $sel:eC2SecurityGroupOwnerId:AuthorizeCacheSecurityGroupIngress' :: Text
eC2SecurityGroupOwnerId =
          Text
pEC2SecurityGroupOwnerId_
      }

-- | The cache security group that allows network ingress.
authorizeCacheSecurityGroupIngress_cacheSecurityGroupName :: Lens.Lens' AuthorizeCacheSecurityGroupIngress Prelude.Text
authorizeCacheSecurityGroupIngress_cacheSecurityGroupName :: Lens' AuthorizeCacheSecurityGroupIngress Text
authorizeCacheSecurityGroupIngress_cacheSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeCacheSecurityGroupIngress' {Text
cacheSecurityGroupName :: Text
$sel:cacheSecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
cacheSecurityGroupName} -> Text
cacheSecurityGroupName) (\s :: AuthorizeCacheSecurityGroupIngress
s@AuthorizeCacheSecurityGroupIngress' {} Text
a -> AuthorizeCacheSecurityGroupIngress
s {$sel:cacheSecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: Text
cacheSecurityGroupName = Text
a} :: AuthorizeCacheSecurityGroupIngress)

-- | The Amazon EC2 security group to be authorized for ingress to the cache
-- security group.
authorizeCacheSecurityGroupIngress_eC2SecurityGroupName :: Lens.Lens' AuthorizeCacheSecurityGroupIngress Prelude.Text
authorizeCacheSecurityGroupIngress_eC2SecurityGroupName :: Lens' AuthorizeCacheSecurityGroupIngress Text
authorizeCacheSecurityGroupIngress_eC2SecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeCacheSecurityGroupIngress' {Text
eC2SecurityGroupName :: Text
$sel:eC2SecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
eC2SecurityGroupName} -> Text
eC2SecurityGroupName) (\s :: AuthorizeCacheSecurityGroupIngress
s@AuthorizeCacheSecurityGroupIngress' {} Text
a -> AuthorizeCacheSecurityGroupIngress
s {$sel:eC2SecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: Text
eC2SecurityGroupName = Text
a} :: AuthorizeCacheSecurityGroupIngress)

-- | The Amazon account number of the Amazon EC2 security group owner. Note
-- that this is not the same thing as an Amazon access key ID - you must
-- provide a valid Amazon account number for this parameter.
authorizeCacheSecurityGroupIngress_eC2SecurityGroupOwnerId :: Lens.Lens' AuthorizeCacheSecurityGroupIngress Prelude.Text
authorizeCacheSecurityGroupIngress_eC2SecurityGroupOwnerId :: Lens' AuthorizeCacheSecurityGroupIngress Text
authorizeCacheSecurityGroupIngress_eC2SecurityGroupOwnerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeCacheSecurityGroupIngress' {Text
eC2SecurityGroupOwnerId :: Text
$sel:eC2SecurityGroupOwnerId:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
eC2SecurityGroupOwnerId} -> Text
eC2SecurityGroupOwnerId) (\s :: AuthorizeCacheSecurityGroupIngress
s@AuthorizeCacheSecurityGroupIngress' {} Text
a -> AuthorizeCacheSecurityGroupIngress
s {$sel:eC2SecurityGroupOwnerId:AuthorizeCacheSecurityGroupIngress' :: Text
eC2SecurityGroupOwnerId = Text
a} :: AuthorizeCacheSecurityGroupIngress)

instance
  Core.AWSRequest
    AuthorizeCacheSecurityGroupIngress
  where
  type
    AWSResponse AuthorizeCacheSecurityGroupIngress =
      AuthorizeCacheSecurityGroupIngressResponse
  request :: (Service -> Service)
-> AuthorizeCacheSecurityGroupIngress
-> Request AuthorizeCacheSecurityGroupIngress
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 AuthorizeCacheSecurityGroupIngress
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AuthorizeCacheSecurityGroupIngress)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"AuthorizeCacheSecurityGroupIngressResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe CacheSecurityGroup
-> Int -> AuthorizeCacheSecurityGroupIngressResponse
AuthorizeCacheSecurityGroupIngressResponse'
            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
"CacheSecurityGroup")
            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
    AuthorizeCacheSecurityGroupIngress
  where
  hashWithSalt :: Int -> AuthorizeCacheSecurityGroupIngress -> Int
hashWithSalt
    Int
_salt
    AuthorizeCacheSecurityGroupIngress' {Text
eC2SecurityGroupOwnerId :: Text
eC2SecurityGroupName :: Text
cacheSecurityGroupName :: Text
$sel:eC2SecurityGroupOwnerId:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
$sel:eC2SecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
$sel:cacheSecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cacheSecurityGroupName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eC2SecurityGroupName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eC2SecurityGroupOwnerId

instance
  Prelude.NFData
    AuthorizeCacheSecurityGroupIngress
  where
  rnf :: AuthorizeCacheSecurityGroupIngress -> ()
rnf AuthorizeCacheSecurityGroupIngress' {Text
eC2SecurityGroupOwnerId :: Text
eC2SecurityGroupName :: Text
cacheSecurityGroupName :: Text
$sel:eC2SecurityGroupOwnerId:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
$sel:eC2SecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
$sel:cacheSecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
cacheSecurityGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eC2SecurityGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eC2SecurityGroupOwnerId

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

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

instance
  Data.ToQuery
    AuthorizeCacheSecurityGroupIngress
  where
  toQuery :: AuthorizeCacheSecurityGroupIngress -> QueryString
toQuery AuthorizeCacheSecurityGroupIngress' {Text
eC2SecurityGroupOwnerId :: Text
eC2SecurityGroupName :: Text
cacheSecurityGroupName :: Text
$sel:eC2SecurityGroupOwnerId:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
$sel:eC2SecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
$sel:cacheSecurityGroupName:AuthorizeCacheSecurityGroupIngress' :: AuthorizeCacheSecurityGroupIngress -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"AuthorizeCacheSecurityGroupIngress" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"CacheSecurityGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cacheSecurityGroupName,
        ByteString
"EC2SecurityGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
eC2SecurityGroupName,
        ByteString
"EC2SecurityGroupOwnerId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
eC2SecurityGroupOwnerId
      ]

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

-- |
-- Create a value of 'AuthorizeCacheSecurityGroupIngressResponse' 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:
--
-- 'cacheSecurityGroup', 'authorizeCacheSecurityGroupIngressResponse_cacheSecurityGroup' - Undocumented member.
--
-- 'httpStatus', 'authorizeCacheSecurityGroupIngressResponse_httpStatus' - The response's http status code.
newAuthorizeCacheSecurityGroupIngressResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AuthorizeCacheSecurityGroupIngressResponse
newAuthorizeCacheSecurityGroupIngressResponse :: Int -> AuthorizeCacheSecurityGroupIngressResponse
newAuthorizeCacheSecurityGroupIngressResponse
  Int
pHttpStatus_ =
    AuthorizeCacheSecurityGroupIngressResponse'
      { $sel:cacheSecurityGroup:AuthorizeCacheSecurityGroupIngressResponse' :: Maybe CacheSecurityGroup
cacheSecurityGroup =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:AuthorizeCacheSecurityGroupIngressResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Undocumented member.
authorizeCacheSecurityGroupIngressResponse_cacheSecurityGroup :: Lens.Lens' AuthorizeCacheSecurityGroupIngressResponse (Prelude.Maybe CacheSecurityGroup)
authorizeCacheSecurityGroupIngressResponse_cacheSecurityGroup :: Lens'
  AuthorizeCacheSecurityGroupIngressResponse
  (Maybe CacheSecurityGroup)
authorizeCacheSecurityGroupIngressResponse_cacheSecurityGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AuthorizeCacheSecurityGroupIngressResponse' {Maybe CacheSecurityGroup
cacheSecurityGroup :: Maybe CacheSecurityGroup
$sel:cacheSecurityGroup:AuthorizeCacheSecurityGroupIngressResponse' :: AuthorizeCacheSecurityGroupIngressResponse
-> Maybe CacheSecurityGroup
cacheSecurityGroup} -> Maybe CacheSecurityGroup
cacheSecurityGroup) (\s :: AuthorizeCacheSecurityGroupIngressResponse
s@AuthorizeCacheSecurityGroupIngressResponse' {} Maybe CacheSecurityGroup
a -> AuthorizeCacheSecurityGroupIngressResponse
s {$sel:cacheSecurityGroup:AuthorizeCacheSecurityGroupIngressResponse' :: Maybe CacheSecurityGroup
cacheSecurityGroup = Maybe CacheSecurityGroup
a} :: AuthorizeCacheSecurityGroupIngressResponse)

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

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