{-# 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.MemoryDb.UpdateSubnetGroup
-- 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 a subnet group. For more information, see
-- <https://docs.aws.amazon.com/MemoryDB/latest/devguide/ubnetGroups.Modifying.html Updating a subnet group>
module Amazonka.MemoryDb.UpdateSubnetGroup
  ( -- * Creating a Request
    UpdateSubnetGroup (..),
    newUpdateSubnetGroup,

    -- * Request Lenses
    updateSubnetGroup_description,
    updateSubnetGroup_subnetIds,
    updateSubnetGroup_subnetGroupName,

    -- * Destructuring the Response
    UpdateSubnetGroupResponse (..),
    newUpdateSubnetGroupResponse,

    -- * Response Lenses
    updateSubnetGroupResponse_subnetGroup,
    updateSubnetGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateSubnetGroup' smart constructor.
data UpdateSubnetGroup = UpdateSubnetGroup'
  { -- | A description of the subnet group
    UpdateSubnetGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The EC2 subnet IDs for the subnet group.
    UpdateSubnetGroup -> Maybe [Text]
subnetIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the subnet group
    UpdateSubnetGroup -> Text
subnetGroupName :: Prelude.Text
  }
  deriving (UpdateSubnetGroup -> UpdateSubnetGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSubnetGroup -> UpdateSubnetGroup -> Bool
$c/= :: UpdateSubnetGroup -> UpdateSubnetGroup -> Bool
== :: UpdateSubnetGroup -> UpdateSubnetGroup -> Bool
$c== :: UpdateSubnetGroup -> UpdateSubnetGroup -> Bool
Prelude.Eq, ReadPrec [UpdateSubnetGroup]
ReadPrec UpdateSubnetGroup
Int -> ReadS UpdateSubnetGroup
ReadS [UpdateSubnetGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSubnetGroup]
$creadListPrec :: ReadPrec [UpdateSubnetGroup]
readPrec :: ReadPrec UpdateSubnetGroup
$creadPrec :: ReadPrec UpdateSubnetGroup
readList :: ReadS [UpdateSubnetGroup]
$creadList :: ReadS [UpdateSubnetGroup]
readsPrec :: Int -> ReadS UpdateSubnetGroup
$creadsPrec :: Int -> ReadS UpdateSubnetGroup
Prelude.Read, Int -> UpdateSubnetGroup -> ShowS
[UpdateSubnetGroup] -> ShowS
UpdateSubnetGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSubnetGroup] -> ShowS
$cshowList :: [UpdateSubnetGroup] -> ShowS
show :: UpdateSubnetGroup -> String
$cshow :: UpdateSubnetGroup -> String
showsPrec :: Int -> UpdateSubnetGroup -> ShowS
$cshowsPrec :: Int -> UpdateSubnetGroup -> ShowS
Prelude.Show, forall x. Rep UpdateSubnetGroup x -> UpdateSubnetGroup
forall x. UpdateSubnetGroup -> Rep UpdateSubnetGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSubnetGroup x -> UpdateSubnetGroup
$cfrom :: forall x. UpdateSubnetGroup -> Rep UpdateSubnetGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSubnetGroup' 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:
--
-- 'description', 'updateSubnetGroup_description' - A description of the subnet group
--
-- 'subnetIds', 'updateSubnetGroup_subnetIds' - The EC2 subnet IDs for the subnet group.
--
-- 'subnetGroupName', 'updateSubnetGroup_subnetGroupName' - The name of the subnet group
newUpdateSubnetGroup ::
  -- | 'subnetGroupName'
  Prelude.Text ->
  UpdateSubnetGroup
newUpdateSubnetGroup :: Text -> UpdateSubnetGroup
newUpdateSubnetGroup Text
pSubnetGroupName_ =
  UpdateSubnetGroup'
    { $sel:description:UpdateSubnetGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetIds:UpdateSubnetGroup' :: Maybe [Text]
subnetIds = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetGroupName:UpdateSubnetGroup' :: Text
subnetGroupName = Text
pSubnetGroupName_
    }

-- | A description of the subnet group
updateSubnetGroup_description :: Lens.Lens' UpdateSubnetGroup (Prelude.Maybe Prelude.Text)
updateSubnetGroup_description :: Lens' UpdateSubnetGroup (Maybe Text)
updateSubnetGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubnetGroup' {Maybe Text
description :: Maybe Text
$sel:description:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateSubnetGroup
s@UpdateSubnetGroup' {} Maybe Text
a -> UpdateSubnetGroup
s {$sel:description:UpdateSubnetGroup' :: Maybe Text
description = Maybe Text
a} :: UpdateSubnetGroup)

-- | The EC2 subnet IDs for the subnet group.
updateSubnetGroup_subnetIds :: Lens.Lens' UpdateSubnetGroup (Prelude.Maybe [Prelude.Text])
updateSubnetGroup_subnetIds :: Lens' UpdateSubnetGroup (Maybe [Text])
updateSubnetGroup_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubnetGroup' {Maybe [Text]
subnetIds :: Maybe [Text]
$sel:subnetIds:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe [Text]
subnetIds} -> Maybe [Text]
subnetIds) (\s :: UpdateSubnetGroup
s@UpdateSubnetGroup' {} Maybe [Text]
a -> UpdateSubnetGroup
s {$sel:subnetIds:UpdateSubnetGroup' :: Maybe [Text]
subnetIds = Maybe [Text]
a} :: UpdateSubnetGroup) 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 name of the subnet group
updateSubnetGroup_subnetGroupName :: Lens.Lens' UpdateSubnetGroup Prelude.Text
updateSubnetGroup_subnetGroupName :: Lens' UpdateSubnetGroup Text
updateSubnetGroup_subnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubnetGroup' {Text
subnetGroupName :: Text
$sel:subnetGroupName:UpdateSubnetGroup' :: UpdateSubnetGroup -> Text
subnetGroupName} -> Text
subnetGroupName) (\s :: UpdateSubnetGroup
s@UpdateSubnetGroup' {} Text
a -> UpdateSubnetGroup
s {$sel:subnetGroupName:UpdateSubnetGroup' :: Text
subnetGroupName = Text
a} :: UpdateSubnetGroup)

instance Core.AWSRequest UpdateSubnetGroup where
  type
    AWSResponse UpdateSubnetGroup =
      UpdateSubnetGroupResponse
  request :: (Service -> Service)
-> UpdateSubnetGroup -> Request UpdateSubnetGroup
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 UpdateSubnetGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateSubnetGroup)))
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 SubnetGroup -> Int -> UpdateSubnetGroupResponse
UpdateSubnetGroupResponse'
            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
"SubnetGroup")
            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 UpdateSubnetGroup where
  hashWithSalt :: Int -> UpdateSubnetGroup -> Int
hashWithSalt Int
_salt UpdateSubnetGroup' {Maybe [Text]
Maybe Text
Text
subnetGroupName :: Text
subnetIds :: Maybe [Text]
description :: Maybe Text
$sel:subnetGroupName:UpdateSubnetGroup' :: UpdateSubnetGroup -> Text
$sel:subnetIds:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe [Text]
$sel:description:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
subnetIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
subnetGroupName

instance Prelude.NFData UpdateSubnetGroup where
  rnf :: UpdateSubnetGroup -> ()
rnf UpdateSubnetGroup' {Maybe [Text]
Maybe Text
Text
subnetGroupName :: Text
subnetIds :: Maybe [Text]
description :: Maybe Text
$sel:subnetGroupName:UpdateSubnetGroup' :: UpdateSubnetGroup -> Text
$sel:subnetIds:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe [Text]
$sel:description:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
subnetIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
subnetGroupName

instance Data.ToHeaders UpdateSubnetGroup where
  toHeaders :: UpdateSubnetGroup -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonMemoryDB.UpdateSubnetGroup" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateSubnetGroup where
  toJSON :: UpdateSubnetGroup -> Value
toJSON UpdateSubnetGroup' {Maybe [Text]
Maybe Text
Text
subnetGroupName :: Text
subnetIds :: Maybe [Text]
description :: Maybe Text
$sel:subnetGroupName:UpdateSubnetGroup' :: UpdateSubnetGroup -> Text
$sel:subnetIds:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe [Text]
$sel:description:UpdateSubnetGroup' :: UpdateSubnetGroup -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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 Text
description,
            (Key
"SubnetIds" 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 [Text]
subnetIds,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SubnetGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
subnetGroupName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateSubnetGroupResponse' 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:
--
-- 'subnetGroup', 'updateSubnetGroupResponse_subnetGroup' - The updated subnet group
--
-- 'httpStatus', 'updateSubnetGroupResponse_httpStatus' - The response's http status code.
newUpdateSubnetGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSubnetGroupResponse
newUpdateSubnetGroupResponse :: Int -> UpdateSubnetGroupResponse
newUpdateSubnetGroupResponse Int
pHttpStatus_ =
  UpdateSubnetGroupResponse'
    { $sel:subnetGroup:UpdateSubnetGroupResponse' :: Maybe SubnetGroup
subnetGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateSubnetGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated subnet group
updateSubnetGroupResponse_subnetGroup :: Lens.Lens' UpdateSubnetGroupResponse (Prelude.Maybe SubnetGroup)
updateSubnetGroupResponse_subnetGroup :: Lens' UpdateSubnetGroupResponse (Maybe SubnetGroup)
updateSubnetGroupResponse_subnetGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSubnetGroupResponse' {Maybe SubnetGroup
subnetGroup :: Maybe SubnetGroup
$sel:subnetGroup:UpdateSubnetGroupResponse' :: UpdateSubnetGroupResponse -> Maybe SubnetGroup
subnetGroup} -> Maybe SubnetGroup
subnetGroup) (\s :: UpdateSubnetGroupResponse
s@UpdateSubnetGroupResponse' {} Maybe SubnetGroup
a -> UpdateSubnetGroupResponse
s {$sel:subnetGroup:UpdateSubnetGroupResponse' :: Maybe SubnetGroup
subnetGroup = Maybe SubnetGroup
a} :: UpdateSubnetGroupResponse)

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

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