{-# 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.CreateACL
-- 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 an Access Control List. For more information, see
-- <https://docs.aws.amazon.com/MemoryDB/latest/devguide/clusters.acls.html Authenticating users with Access Contol Lists (ACLs)>.
module Amazonka.MemoryDb.CreateACL
  ( -- * Creating a Request
    CreateACL (..),
    newCreateACL,

    -- * Request Lenses
    createACL_tags,
    createACL_userNames,
    createACL_aCLName,

    -- * Destructuring the Response
    CreateACLResponse (..),
    newCreateACLResponse,

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

-- |
-- Create a value of 'CreateACL' 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', 'createACL_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.
--
-- 'userNames', 'createACL_userNames' - The list of users that belong to the Access Control List.
--
-- 'aCLName', 'createACL_aCLName' - The name of the Access Control List.
newCreateACL ::
  -- | 'aCLName'
  Prelude.Text ->
  CreateACL
newCreateACL :: Text -> CreateACL
newCreateACL Text
pACLName_ =
  CreateACL'
    { $sel:tags:CreateACL' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:userNames:CreateACL' :: Maybe (NonEmpty Text)
userNames = forall a. Maybe a
Prelude.Nothing,
      $sel:aCLName:CreateACL' :: Text
aCLName = Text
pACLName_
    }

-- | 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.
createACL_tags :: Lens.Lens' CreateACL (Prelude.Maybe [Tag])
createACL_tags :: Lens' CreateACL (Maybe [Tag])
createACL_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateACL' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateACL' :: CreateACL -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateACL
s@CreateACL' {} Maybe [Tag]
a -> CreateACL
s {$sel:tags:CreateACL' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateACL) 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 that belong to the Access Control List.
createACL_userNames :: Lens.Lens' CreateACL (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
createACL_userNames :: Lens' CreateACL (Maybe (NonEmpty Text))
createACL_userNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateACL' {Maybe (NonEmpty Text)
userNames :: Maybe (NonEmpty Text)
$sel:userNames:CreateACL' :: CreateACL -> Maybe (NonEmpty Text)
userNames} -> Maybe (NonEmpty Text)
userNames) (\s :: CreateACL
s@CreateACL' {} Maybe (NonEmpty Text)
a -> CreateACL
s {$sel:userNames:CreateACL' :: Maybe (NonEmpty Text)
userNames = Maybe (NonEmpty Text)
a} :: CreateACL) 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.
createACL_aCLName :: Lens.Lens' CreateACL Prelude.Text
createACL_aCLName :: Lens' CreateACL Text
createACL_aCLName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateACL' {Text
aCLName :: Text
$sel:aCLName:CreateACL' :: CreateACL -> Text
aCLName} -> Text
aCLName) (\s :: CreateACL
s@CreateACL' {} Text
a -> CreateACL
s {$sel:aCLName:CreateACL' :: Text
aCLName = Text
a} :: CreateACL)

instance Core.AWSRequest CreateACL where
  type AWSResponse CreateACL = CreateACLResponse
  request :: (Service -> Service) -> CreateACL -> Request CreateACL
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 CreateACL
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateACL)))
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 -> CreateACLResponse
CreateACLResponse'
            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 CreateACL where
  hashWithSalt :: Int -> CreateACL -> Int
hashWithSalt Int
_salt CreateACL' {Maybe [Tag]
Maybe (NonEmpty Text)
Text
aCLName :: Text
userNames :: Maybe (NonEmpty Text)
tags :: Maybe [Tag]
$sel:aCLName:CreateACL' :: CreateACL -> Text
$sel:userNames:CreateACL' :: CreateACL -> Maybe (NonEmpty Text)
$sel:tags:CreateACL' :: CreateACL -> 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` Maybe (NonEmpty Text)
userNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
aCLName

instance Prelude.NFData CreateACL where
  rnf :: CreateACL -> ()
rnf CreateACL' {Maybe [Tag]
Maybe (NonEmpty Text)
Text
aCLName :: Text
userNames :: Maybe (NonEmpty Text)
tags :: Maybe [Tag]
$sel:aCLName:CreateACL' :: CreateACL -> Text
$sel:userNames:CreateACL' :: CreateACL -> Maybe (NonEmpty Text)
$sel:tags:CreateACL' :: CreateACL -> 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 Maybe (NonEmpty Text)
userNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
aCLName

instance Data.ToHeaders CreateACL where
  toHeaders :: CreateACL -> 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.CreateACL" :: 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 CreateACL where
  toJSON :: CreateACL -> Value
toJSON CreateACL' {Maybe [Tag]
Maybe (NonEmpty Text)
Text
aCLName :: Text
userNames :: Maybe (NonEmpty Text)
tags :: Maybe [Tag]
$sel:aCLName:CreateACL' :: CreateACL -> Text
$sel:userNames:CreateACL' :: CreateACL -> Maybe (NonEmpty Text)
$sel:tags:CreateACL' :: CreateACL -> Maybe [Tag]
..} =
    [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 [Tag]
tags,
            (Key
"UserNames" 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)
userNames,
            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 CreateACL where
  toPath :: CreateACL -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'CreateACLResponse' 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', 'createACLResponse_acl' - The newly-created Access Control List.
--
-- 'httpStatus', 'createACLResponse_httpStatus' - The response's http status code.
newCreateACLResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateACLResponse
newCreateACLResponse :: Int -> CreateACLResponse
newCreateACLResponse Int
pHttpStatus_ =
  CreateACLResponse'
    { $sel:acl:CreateACLResponse' :: Maybe ACL
acl = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateACLResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData CreateACLResponse where
  rnf :: CreateACLResponse -> ()
rnf CreateACLResponse' {Int
Maybe ACL
httpStatus :: Int
acl :: Maybe ACL
$sel:httpStatus:CreateACLResponse' :: CreateACLResponse -> Int
$sel:acl:CreateACLResponse' :: CreateACLResponse -> 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