{-# 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.UpdateACL
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes the list of users that belong to the Access Control List.
module Amazonka.MemoryDb.UpdateACL
  ( -- * Creating a Request
    UpdateACL (..),
    newUpdateACL,

    -- * Request Lenses
    updateACL_userNamesToAdd,
    updateACL_userNamesToRemove,
    updateACL_aCLName,

    -- * Destructuring the Response
    UpdateACLResponse (..),
    newUpdateACLResponse,

    -- * Response Lenses
    updateACLResponse_acl,
    updateACLResponse_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:/ 'newUpdateACL' smart constructor.
data UpdateACL = UpdateACL'
  { -- | The list of users to add to the Access Control List
    UpdateACL -> Maybe (NonEmpty Text)
userNamesToAdd :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The list of users to remove from the Access Control List
    UpdateACL -> Maybe (NonEmpty Text)
userNamesToRemove :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The name of the Access Control List
    UpdateACL -> Text
aCLName :: Prelude.Text
  }
  deriving (UpdateACL -> UpdateACL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateACL -> UpdateACL -> Bool
$c/= :: UpdateACL -> UpdateACL -> Bool
== :: UpdateACL -> UpdateACL -> Bool
$c== :: UpdateACL -> UpdateACL -> Bool
Prelude.Eq, ReadPrec [UpdateACL]
ReadPrec UpdateACL
Int -> ReadS UpdateACL
ReadS [UpdateACL]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateACL]
$creadListPrec :: ReadPrec [UpdateACL]
readPrec :: ReadPrec UpdateACL
$creadPrec :: ReadPrec UpdateACL
readList :: ReadS [UpdateACL]
$creadList :: ReadS [UpdateACL]
readsPrec :: Int -> ReadS UpdateACL
$creadsPrec :: Int -> ReadS UpdateACL
Prelude.Read, Int -> UpdateACL -> ShowS
[UpdateACL] -> ShowS
UpdateACL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateACL] -> ShowS
$cshowList :: [UpdateACL] -> ShowS
show :: UpdateACL -> String
$cshow :: UpdateACL -> String
showsPrec :: Int -> UpdateACL -> ShowS
$cshowsPrec :: Int -> UpdateACL -> ShowS
Prelude.Show, forall x. Rep UpdateACL x -> UpdateACL
forall x. UpdateACL -> Rep UpdateACL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateACL x -> UpdateACL
$cfrom :: forall x. UpdateACL -> Rep UpdateACL x
Prelude.Generic)

-- |
-- Create a value of 'UpdateACL' 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:
--
-- 'userNamesToAdd', 'updateACL_userNamesToAdd' - The list of users to add to the Access Control List
--
-- 'userNamesToRemove', 'updateACL_userNamesToRemove' - The list of users to remove from the Access Control List
--
-- 'aCLName', 'updateACL_aCLName' - The name of the Access Control List
newUpdateACL ::
  -- | 'aCLName'
  Prelude.Text ->
  UpdateACL
newUpdateACL :: Text -> UpdateACL
newUpdateACL Text
pACLName_ =
  UpdateACL'
    { $sel:userNamesToAdd:UpdateACL' :: Maybe (NonEmpty Text)
userNamesToAdd = forall a. Maybe a
Prelude.Nothing,
      $sel:userNamesToRemove:UpdateACL' :: Maybe (NonEmpty Text)
userNamesToRemove = forall a. Maybe a
Prelude.Nothing,
      $sel:aCLName:UpdateACL' :: Text
aCLName = Text
pACLName_
    }

-- | The list of users to add to the Access Control List
updateACL_userNamesToAdd :: Lens.Lens' UpdateACL (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
updateACL_userNamesToAdd :: Lens' UpdateACL (Maybe (NonEmpty Text))
updateACL_userNamesToAdd = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateACL' {Maybe (NonEmpty Text)
userNamesToAdd :: Maybe (NonEmpty Text)
$sel:userNamesToAdd:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
userNamesToAdd} -> Maybe (NonEmpty Text)
userNamesToAdd) (\s :: UpdateACL
s@UpdateACL' {} Maybe (NonEmpty Text)
a -> UpdateACL
s {$sel:userNamesToAdd:UpdateACL' :: Maybe (NonEmpty Text)
userNamesToAdd = Maybe (NonEmpty Text)
a} :: UpdateACL) 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 list of users to remove from the Access Control List
updateACL_userNamesToRemove :: Lens.Lens' UpdateACL (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
updateACL_userNamesToRemove :: Lens' UpdateACL (Maybe (NonEmpty Text))
updateACL_userNamesToRemove = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateACL' {Maybe (NonEmpty Text)
userNamesToRemove :: Maybe (NonEmpty Text)
$sel:userNamesToRemove:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
userNamesToRemove} -> Maybe (NonEmpty Text)
userNamesToRemove) (\s :: UpdateACL
s@UpdateACL' {} Maybe (NonEmpty Text)
a -> UpdateACL
s {$sel:userNamesToRemove:UpdateACL' :: Maybe (NonEmpty Text)
userNamesToRemove = Maybe (NonEmpty Text)
a} :: UpdateACL) 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 Access Control List
updateACL_aCLName :: Lens.Lens' UpdateACL Prelude.Text
updateACL_aCLName :: Lens' UpdateACL Text
updateACL_aCLName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateACL' {Text
aCLName :: Text
$sel:aCLName:UpdateACL' :: UpdateACL -> Text
aCLName} -> Text
aCLName) (\s :: UpdateACL
s@UpdateACL' {} Text
a -> UpdateACL
s {$sel:aCLName:UpdateACL' :: Text
aCLName = Text
a} :: UpdateACL)

instance Core.AWSRequest UpdateACL where
  type AWSResponse UpdateACL = UpdateACLResponse
  request :: (Service -> Service) -> UpdateACL -> Request UpdateACL
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 UpdateACL
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateACL)))
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 ACL -> Int -> UpdateACLResponse
UpdateACLResponse'
            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
"ACL")
            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 UpdateACL where
  hashWithSalt :: Int -> UpdateACL -> Int
hashWithSalt Int
_salt UpdateACL' {Maybe (NonEmpty Text)
Text
aCLName :: Text
userNamesToRemove :: Maybe (NonEmpty Text)
userNamesToAdd :: Maybe (NonEmpty Text)
$sel:aCLName:UpdateACL' :: UpdateACL -> Text
$sel:userNamesToRemove:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
$sel:userNamesToAdd:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
userNamesToAdd
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
userNamesToRemove
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
aCLName

instance Prelude.NFData UpdateACL where
  rnf :: UpdateACL -> ()
rnf UpdateACL' {Maybe (NonEmpty Text)
Text
aCLName :: Text
userNamesToRemove :: Maybe (NonEmpty Text)
userNamesToAdd :: Maybe (NonEmpty Text)
$sel:aCLName:UpdateACL' :: UpdateACL -> Text
$sel:userNamesToRemove:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
$sel:userNamesToAdd:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
userNamesToAdd
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
userNamesToRemove
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
aCLName

instance Data.ToHeaders UpdateACL where
  toHeaders :: UpdateACL -> 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.UpdateACL" :: 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 UpdateACL where
  toJSON :: UpdateACL -> Value
toJSON UpdateACL' {Maybe (NonEmpty Text)
Text
aCLName :: Text
userNamesToRemove :: Maybe (NonEmpty Text)
userNamesToAdd :: Maybe (NonEmpty Text)
$sel:aCLName:UpdateACL' :: UpdateACL -> Text
$sel:userNamesToRemove:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
$sel:userNamesToAdd:UpdateACL' :: UpdateACL -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"UserNamesToAdd" 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 (NonEmpty Text)
userNamesToAdd,
            (Key
"UserNamesToRemove" 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 (NonEmpty Text)
userNamesToRemove,
            forall a. a -> Maybe a
Prelude.Just (Key
"ACLName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
aCLName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateACLResponse' 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:
--
-- 'acl', 'updateACLResponse_acl' - The updated Access Control List
--
-- 'httpStatus', 'updateACLResponse_httpStatus' - The response's http status code.
newUpdateACLResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateACLResponse
newUpdateACLResponse :: Int -> UpdateACLResponse
newUpdateACLResponse Int
pHttpStatus_ =
  UpdateACLResponse'
    { $sel:acl:UpdateACLResponse' :: Maybe ACL
acl = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateACLResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated Access Control List
updateACLResponse_acl :: Lens.Lens' UpdateACLResponse (Prelude.Maybe ACL)
updateACLResponse_acl :: Lens' UpdateACLResponse (Maybe ACL)
updateACLResponse_acl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateACLResponse' {Maybe ACL
acl :: Maybe ACL
$sel:acl:UpdateACLResponse' :: UpdateACLResponse -> Maybe ACL
acl} -> Maybe ACL
acl) (\s :: UpdateACLResponse
s@UpdateACLResponse' {} Maybe ACL
a -> UpdateACLResponse
s {$sel:acl:UpdateACLResponse' :: Maybe ACL
acl = Maybe ACL
a} :: UpdateACLResponse)

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

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