{-# 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.CreateCacheParameterGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new Amazon ElastiCache cache parameter group. An ElastiCache
-- cache parameter group is a collection of parameters and their values
-- that are applied to all of the nodes in any cluster or replication group
-- using the CacheParameterGroup.
--
-- A newly created CacheParameterGroup is an exact duplicate of the default
-- parameter group for the CacheParameterGroupFamily. To customize the
-- newly created CacheParameterGroup you can change the values of specific
-- parameters. For more information, see:
--
-- -   <https://docs.aws.amazon.com/AmazonElastiCache/latest/APIReference/API_ModifyCacheParameterGroup.html ModifyCacheParameterGroup>
--     in the ElastiCache API Reference.
--
-- -   <https://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/ParameterGroups.html Parameters and Parameter Groups>
--     in the ElastiCache User Guide.
module Amazonka.ElastiCache.CreateCacheParameterGroup
  ( -- * Creating a Request
    CreateCacheParameterGroup (..),
    newCreateCacheParameterGroup,

    -- * Request Lenses
    createCacheParameterGroup_tags,
    createCacheParameterGroup_cacheParameterGroupName,
    createCacheParameterGroup_cacheParameterGroupFamily,
    createCacheParameterGroup_description,

    -- * Destructuring the Response
    CreateCacheParameterGroupResponse (..),
    newCreateCacheParameterGroupResponse,

    -- * Response Lenses
    createCacheParameterGroupResponse_cacheParameterGroup,
    createCacheParameterGroupResponse_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 a @CreateCacheParameterGroup@ operation.
--
-- /See:/ 'newCreateCacheParameterGroup' smart constructor.
data CreateCacheParameterGroup = CreateCacheParameterGroup'
  { -- | A list of tags to be added to this resource. A tag is a key-value pair.
    -- A tag key must be accompanied by a tag value, although null is accepted.
    CreateCacheParameterGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A user-specified name for the cache parameter group.
    CreateCacheParameterGroup -> Text
cacheParameterGroupName :: Prelude.Text,
    -- | The name of the cache parameter group family that the cache parameter
    -- group can be used with.
    --
    -- Valid values are: @memcached1.4@ | @memcached1.5@ | @memcached1.6@ |
    -- @redis2.6@ | @redis2.8@ | @redis3.2@ | @redis4.0@ | @redis5.0@ |
    -- @redis6.x@
    CreateCacheParameterGroup -> Text
cacheParameterGroupFamily :: Prelude.Text,
    -- | A user-specified description for the cache parameter group.
    CreateCacheParameterGroup -> Text
description :: Prelude.Text
  }
  deriving (CreateCacheParameterGroup -> CreateCacheParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCacheParameterGroup -> CreateCacheParameterGroup -> Bool
$c/= :: CreateCacheParameterGroup -> CreateCacheParameterGroup -> Bool
== :: CreateCacheParameterGroup -> CreateCacheParameterGroup -> Bool
$c== :: CreateCacheParameterGroup -> CreateCacheParameterGroup -> Bool
Prelude.Eq, ReadPrec [CreateCacheParameterGroup]
ReadPrec CreateCacheParameterGroup
Int -> ReadS CreateCacheParameterGroup
ReadS [CreateCacheParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCacheParameterGroup]
$creadListPrec :: ReadPrec [CreateCacheParameterGroup]
readPrec :: ReadPrec CreateCacheParameterGroup
$creadPrec :: ReadPrec CreateCacheParameterGroup
readList :: ReadS [CreateCacheParameterGroup]
$creadList :: ReadS [CreateCacheParameterGroup]
readsPrec :: Int -> ReadS CreateCacheParameterGroup
$creadsPrec :: Int -> ReadS CreateCacheParameterGroup
Prelude.Read, Int -> CreateCacheParameterGroup -> ShowS
[CreateCacheParameterGroup] -> ShowS
CreateCacheParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCacheParameterGroup] -> ShowS
$cshowList :: [CreateCacheParameterGroup] -> ShowS
show :: CreateCacheParameterGroup -> String
$cshow :: CreateCacheParameterGroup -> String
showsPrec :: Int -> CreateCacheParameterGroup -> ShowS
$cshowsPrec :: Int -> CreateCacheParameterGroup -> ShowS
Prelude.Show, forall x.
Rep CreateCacheParameterGroup x -> CreateCacheParameterGroup
forall x.
CreateCacheParameterGroup -> Rep CreateCacheParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCacheParameterGroup x -> CreateCacheParameterGroup
$cfrom :: forall x.
CreateCacheParameterGroup -> Rep CreateCacheParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'CreateCacheParameterGroup' 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', 'createCacheParameterGroup_tags' - A list of tags to be added to this resource. A tag is a key-value pair.
-- A tag key must be accompanied by a tag value, although null is accepted.
--
-- 'cacheParameterGroupName', 'createCacheParameterGroup_cacheParameterGroupName' - A user-specified name for the cache parameter group.
--
-- 'cacheParameterGroupFamily', 'createCacheParameterGroup_cacheParameterGroupFamily' - The name of the cache parameter group family that the cache parameter
-- group can be used with.
--
-- Valid values are: @memcached1.4@ | @memcached1.5@ | @memcached1.6@ |
-- @redis2.6@ | @redis2.8@ | @redis3.2@ | @redis4.0@ | @redis5.0@ |
-- @redis6.x@
--
-- 'description', 'createCacheParameterGroup_description' - A user-specified description for the cache parameter group.
newCreateCacheParameterGroup ::
  -- | 'cacheParameterGroupName'
  Prelude.Text ->
  -- | 'cacheParameterGroupFamily'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  CreateCacheParameterGroup
newCreateCacheParameterGroup :: Text -> Text -> Text -> CreateCacheParameterGroup
newCreateCacheParameterGroup
  Text
pCacheParameterGroupName_
  Text
pCacheParameterGroupFamily_
  Text
pDescription_ =
    CreateCacheParameterGroup'
      { $sel:tags:CreateCacheParameterGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:cacheParameterGroupName:CreateCacheParameterGroup' :: Text
cacheParameterGroupName =
          Text
pCacheParameterGroupName_,
        $sel:cacheParameterGroupFamily:CreateCacheParameterGroup' :: Text
cacheParameterGroupFamily =
          Text
pCacheParameterGroupFamily_,
        $sel:description:CreateCacheParameterGroup' :: Text
description = Text
pDescription_
      }

-- | A list of tags to be added to this resource. A tag is a key-value pair.
-- A tag key must be accompanied by a tag value, although null is accepted.
createCacheParameterGroup_tags :: Lens.Lens' CreateCacheParameterGroup (Prelude.Maybe [Tag])
createCacheParameterGroup_tags :: Lens' CreateCacheParameterGroup (Maybe [Tag])
createCacheParameterGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCacheParameterGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCacheParameterGroup
s@CreateCacheParameterGroup' {} Maybe [Tag]
a -> CreateCacheParameterGroup
s {$sel:tags:CreateCacheParameterGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCacheParameterGroup) 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

-- | A user-specified name for the cache parameter group.
createCacheParameterGroup_cacheParameterGroupName :: Lens.Lens' CreateCacheParameterGroup Prelude.Text
createCacheParameterGroup_cacheParameterGroupName :: Lens' CreateCacheParameterGroup Text
createCacheParameterGroup_cacheParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCacheParameterGroup' {Text
cacheParameterGroupName :: Text
$sel:cacheParameterGroupName:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
cacheParameterGroupName} -> Text
cacheParameterGroupName) (\s :: CreateCacheParameterGroup
s@CreateCacheParameterGroup' {} Text
a -> CreateCacheParameterGroup
s {$sel:cacheParameterGroupName:CreateCacheParameterGroup' :: Text
cacheParameterGroupName = Text
a} :: CreateCacheParameterGroup)

-- | The name of the cache parameter group family that the cache parameter
-- group can be used with.
--
-- Valid values are: @memcached1.4@ | @memcached1.5@ | @memcached1.6@ |
-- @redis2.6@ | @redis2.8@ | @redis3.2@ | @redis4.0@ | @redis5.0@ |
-- @redis6.x@
createCacheParameterGroup_cacheParameterGroupFamily :: Lens.Lens' CreateCacheParameterGroup Prelude.Text
createCacheParameterGroup_cacheParameterGroupFamily :: Lens' CreateCacheParameterGroup Text
createCacheParameterGroup_cacheParameterGroupFamily = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCacheParameterGroup' {Text
cacheParameterGroupFamily :: Text
$sel:cacheParameterGroupFamily:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
cacheParameterGroupFamily} -> Text
cacheParameterGroupFamily) (\s :: CreateCacheParameterGroup
s@CreateCacheParameterGroup' {} Text
a -> CreateCacheParameterGroup
s {$sel:cacheParameterGroupFamily:CreateCacheParameterGroup' :: Text
cacheParameterGroupFamily = Text
a} :: CreateCacheParameterGroup)

-- | A user-specified description for the cache parameter group.
createCacheParameterGroup_description :: Lens.Lens' CreateCacheParameterGroup Prelude.Text
createCacheParameterGroup_description :: Lens' CreateCacheParameterGroup Text
createCacheParameterGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCacheParameterGroup' {Text
description :: Text
$sel:description:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
description} -> Text
description) (\s :: CreateCacheParameterGroup
s@CreateCacheParameterGroup' {} Text
a -> CreateCacheParameterGroup
s {$sel:description:CreateCacheParameterGroup' :: Text
description = Text
a} :: CreateCacheParameterGroup)

instance Core.AWSRequest CreateCacheParameterGroup where
  type
    AWSResponse CreateCacheParameterGroup =
      CreateCacheParameterGroupResponse
  request :: (Service -> Service)
-> CreateCacheParameterGroup -> Request CreateCacheParameterGroup
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 CreateCacheParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateCacheParameterGroup)))
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
"CreateCacheParameterGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe CacheParameterGroup
-> Int -> CreateCacheParameterGroupResponse
CreateCacheParameterGroupResponse'
            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
"CacheParameterGroup")
            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 CreateCacheParameterGroup where
  hashWithSalt :: Int -> CreateCacheParameterGroup -> Int
hashWithSalt Int
_salt CreateCacheParameterGroup' {Maybe [Tag]
Text
description :: Text
cacheParameterGroupFamily :: Text
cacheParameterGroupName :: Text
tags :: Maybe [Tag]
$sel:description:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:cacheParameterGroupFamily:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:cacheParameterGroupName:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:tags:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cacheParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cacheParameterGroupFamily
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description

instance Prelude.NFData CreateCacheParameterGroup where
  rnf :: CreateCacheParameterGroup -> ()
rnf CreateCacheParameterGroup' {Maybe [Tag]
Text
description :: Text
cacheParameterGroupFamily :: Text
cacheParameterGroupName :: Text
tags :: Maybe [Tag]
$sel:description:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:cacheParameterGroupFamily:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:cacheParameterGroupName:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:tags:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cacheParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cacheParameterGroupFamily
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description

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

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

instance Data.ToQuery CreateCacheParameterGroup where
  toQuery :: CreateCacheParameterGroup -> QueryString
toQuery CreateCacheParameterGroup' {Maybe [Tag]
Text
description :: Text
cacheParameterGroupFamily :: Text
cacheParameterGroupName :: Text
tags :: Maybe [Tag]
$sel:description:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:cacheParameterGroupFamily:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:cacheParameterGroupName:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Text
$sel:tags:CreateCacheParameterGroup' :: CreateCacheParameterGroup -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateCacheParameterGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"CacheParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cacheParameterGroupName,
        ByteString
"CacheParameterGroupFamily"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cacheParameterGroupFamily,
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
description
      ]

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

-- |
-- Create a value of 'CreateCacheParameterGroupResponse' 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:
--
-- 'cacheParameterGroup', 'createCacheParameterGroupResponse_cacheParameterGroup' - Undocumented member.
--
-- 'httpStatus', 'createCacheParameterGroupResponse_httpStatus' - The response's http status code.
newCreateCacheParameterGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCacheParameterGroupResponse
newCreateCacheParameterGroupResponse :: Int -> CreateCacheParameterGroupResponse
newCreateCacheParameterGroupResponse Int
pHttpStatus_ =
  CreateCacheParameterGroupResponse'
    { $sel:cacheParameterGroup:CreateCacheParameterGroupResponse' :: Maybe CacheParameterGroup
cacheParameterGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCacheParameterGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createCacheParameterGroupResponse_cacheParameterGroup :: Lens.Lens' CreateCacheParameterGroupResponse (Prelude.Maybe CacheParameterGroup)
createCacheParameterGroupResponse_cacheParameterGroup :: Lens' CreateCacheParameterGroupResponse (Maybe CacheParameterGroup)
createCacheParameterGroupResponse_cacheParameterGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCacheParameterGroupResponse' {Maybe CacheParameterGroup
cacheParameterGroup :: Maybe CacheParameterGroup
$sel:cacheParameterGroup:CreateCacheParameterGroupResponse' :: CreateCacheParameterGroupResponse -> Maybe CacheParameterGroup
cacheParameterGroup} -> Maybe CacheParameterGroup
cacheParameterGroup) (\s :: CreateCacheParameterGroupResponse
s@CreateCacheParameterGroupResponse' {} Maybe CacheParameterGroup
a -> CreateCacheParameterGroupResponse
s {$sel:cacheParameterGroup:CreateCacheParameterGroupResponse' :: Maybe CacheParameterGroup
cacheParameterGroup = Maybe CacheParameterGroup
a} :: CreateCacheParameterGroupResponse)

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

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