{-# 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.MQ.UpdateUser
-- 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 the information for an ActiveMQ user.
module Amazonka.MQ.UpdateUser
  ( -- * Creating a Request
    UpdateUser (..),
    newUpdateUser,

    -- * Request Lenses
    updateUser_consoleAccess,
    updateUser_groups,
    updateUser_password,
    updateUser_username,
    updateUser_brokerId,

    -- * Destructuring the Response
    UpdateUserResponse (..),
    newUpdateUserResponse,

    -- * Response Lenses
    updateUserResponse_httpStatus,
  )
where

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

-- | Updates the information for an ActiveMQ user.
--
-- /See:/ 'newUpdateUser' smart constructor.
data UpdateUser = UpdateUser'
  { -- | Enables access to the the ActiveMQ Web Console for the ActiveMQ user.
    UpdateUser -> Maybe Bool
consoleAccess :: Prelude.Maybe Prelude.Bool,
    -- | The list of groups (20 maximum) to which the ActiveMQ user belongs. This
    -- value can contain only alphanumeric characters, dashes, periods,
    -- underscores, and tildes (- . _ ~). This value must be 2-100 characters
    -- long.
    UpdateUser -> Maybe [Text]
groups :: Prelude.Maybe [Prelude.Text],
    -- | The password of the user. This value must be at least 12 characters
    -- long, must contain at least 4 unique characters, and must not contain
    -- commas, colons, or equal signs (,:=).
    UpdateUser -> Maybe Text
password :: Prelude.Maybe Prelude.Text,
    -- | The username of the ActiveMQ user. This value can contain only
    -- alphanumeric characters, dashes, periods, underscores, and tildes (- . _
    -- ~). This value must be 2-100 characters long.
    UpdateUser -> Text
username :: Prelude.Text,
    -- | The unique ID that Amazon MQ generates for the broker.
    UpdateUser -> Text
brokerId :: Prelude.Text
  }
  deriving (UpdateUser -> UpdateUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUser -> UpdateUser -> Bool
$c/= :: UpdateUser -> UpdateUser -> Bool
== :: UpdateUser -> UpdateUser -> Bool
$c== :: UpdateUser -> UpdateUser -> Bool
Prelude.Eq, ReadPrec [UpdateUser]
ReadPrec UpdateUser
Int -> ReadS UpdateUser
ReadS [UpdateUser]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateUser]
$creadListPrec :: ReadPrec [UpdateUser]
readPrec :: ReadPrec UpdateUser
$creadPrec :: ReadPrec UpdateUser
readList :: ReadS [UpdateUser]
$creadList :: ReadS [UpdateUser]
readsPrec :: Int -> ReadS UpdateUser
$creadsPrec :: Int -> ReadS UpdateUser
Prelude.Read, Int -> UpdateUser -> ShowS
[UpdateUser] -> ShowS
UpdateUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUser] -> ShowS
$cshowList :: [UpdateUser] -> ShowS
show :: UpdateUser -> String
$cshow :: UpdateUser -> String
showsPrec :: Int -> UpdateUser -> ShowS
$cshowsPrec :: Int -> UpdateUser -> ShowS
Prelude.Show, forall x. Rep UpdateUser x -> UpdateUser
forall x. UpdateUser -> Rep UpdateUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateUser x -> UpdateUser
$cfrom :: forall x. UpdateUser -> Rep UpdateUser x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUser' 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:
--
-- 'consoleAccess', 'updateUser_consoleAccess' - Enables access to the the ActiveMQ Web Console for the ActiveMQ user.
--
-- 'groups', 'updateUser_groups' - The list of groups (20 maximum) to which the ActiveMQ user belongs. This
-- value can contain only alphanumeric characters, dashes, periods,
-- underscores, and tildes (- . _ ~). This value must be 2-100 characters
-- long.
--
-- 'password', 'updateUser_password' - The password of the user. This value must be at least 12 characters
-- long, must contain at least 4 unique characters, and must not contain
-- commas, colons, or equal signs (,:=).
--
-- 'username', 'updateUser_username' - The username of the ActiveMQ user. This value can contain only
-- alphanumeric characters, dashes, periods, underscores, and tildes (- . _
-- ~). This value must be 2-100 characters long.
--
-- 'brokerId', 'updateUser_brokerId' - The unique ID that Amazon MQ generates for the broker.
newUpdateUser ::
  -- | 'username'
  Prelude.Text ->
  -- | 'brokerId'
  Prelude.Text ->
  UpdateUser
newUpdateUser :: Text -> Text -> UpdateUser
newUpdateUser Text
pUsername_ Text
pBrokerId_ =
  UpdateUser'
    { $sel:consoleAccess:UpdateUser' :: Maybe Bool
consoleAccess = forall a. Maybe a
Prelude.Nothing,
      $sel:groups:UpdateUser' :: Maybe [Text]
groups = forall a. Maybe a
Prelude.Nothing,
      $sel:password:UpdateUser' :: Maybe Text
password = forall a. Maybe a
Prelude.Nothing,
      $sel:username:UpdateUser' :: Text
username = Text
pUsername_,
      $sel:brokerId:UpdateUser' :: Text
brokerId = Text
pBrokerId_
    }

-- | Enables access to the the ActiveMQ Web Console for the ActiveMQ user.
updateUser_consoleAccess :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Bool)
updateUser_consoleAccess :: Lens' UpdateUser (Maybe Bool)
updateUser_consoleAccess = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Bool
consoleAccess :: Maybe Bool
$sel:consoleAccess:UpdateUser' :: UpdateUser -> Maybe Bool
consoleAccess} -> Maybe Bool
consoleAccess) (\s :: UpdateUser
s@UpdateUser' {} Maybe Bool
a -> UpdateUser
s {$sel:consoleAccess:UpdateUser' :: Maybe Bool
consoleAccess = Maybe Bool
a} :: UpdateUser)

-- | The list of groups (20 maximum) to which the ActiveMQ user belongs. This
-- value can contain only alphanumeric characters, dashes, periods,
-- underscores, and tildes (- . _ ~). This value must be 2-100 characters
-- long.
updateUser_groups :: Lens.Lens' UpdateUser (Prelude.Maybe [Prelude.Text])
updateUser_groups :: Lens' UpdateUser (Maybe [Text])
updateUser_groups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe [Text]
groups :: Maybe [Text]
$sel:groups:UpdateUser' :: UpdateUser -> Maybe [Text]
groups} -> Maybe [Text]
groups) (\s :: UpdateUser
s@UpdateUser' {} Maybe [Text]
a -> UpdateUser
s {$sel:groups:UpdateUser' :: Maybe [Text]
groups = Maybe [Text]
a} :: UpdateUser) 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 password of the user. This value must be at least 12 characters
-- long, must contain at least 4 unique characters, and must not contain
-- commas, colons, or equal signs (,:=).
updateUser_password :: Lens.Lens' UpdateUser (Prelude.Maybe Prelude.Text)
updateUser_password :: Lens' UpdateUser (Maybe Text)
updateUser_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Maybe Text
password :: Maybe Text
$sel:password:UpdateUser' :: UpdateUser -> Maybe Text
password} -> Maybe Text
password) (\s :: UpdateUser
s@UpdateUser' {} Maybe Text
a -> UpdateUser
s {$sel:password:UpdateUser' :: Maybe Text
password = Maybe Text
a} :: UpdateUser)

-- | The username of the ActiveMQ user. This value can contain only
-- alphanumeric characters, dashes, periods, underscores, and tildes (- . _
-- ~). This value must be 2-100 characters long.
updateUser_username :: Lens.Lens' UpdateUser Prelude.Text
updateUser_username :: Lens' UpdateUser Text
updateUser_username = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Text
username :: Text
$sel:username:UpdateUser' :: UpdateUser -> Text
username} -> Text
username) (\s :: UpdateUser
s@UpdateUser' {} Text
a -> UpdateUser
s {$sel:username:UpdateUser' :: Text
username = Text
a} :: UpdateUser)

-- | The unique ID that Amazon MQ generates for the broker.
updateUser_brokerId :: Lens.Lens' UpdateUser Prelude.Text
updateUser_brokerId :: Lens' UpdateUser Text
updateUser_brokerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUser' {Text
brokerId :: Text
$sel:brokerId:UpdateUser' :: UpdateUser -> Text
brokerId} -> Text
brokerId) (\s :: UpdateUser
s@UpdateUser' {} Text
a -> UpdateUser
s {$sel:brokerId:UpdateUser' :: Text
brokerId = Text
a} :: UpdateUser)

instance Core.AWSRequest UpdateUser where
  type AWSResponse UpdateUser = UpdateUserResponse
  request :: (Service -> Service) -> UpdateUser -> Request UpdateUser
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateUser
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateUser)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateUserResponse
UpdateUserResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateUser where
  hashWithSalt :: Int -> UpdateUser -> Int
hashWithSalt Int
_salt UpdateUser' {Maybe Bool
Maybe [Text]
Maybe Text
Text
brokerId :: Text
username :: Text
password :: Maybe Text
groups :: Maybe [Text]
consoleAccess :: Maybe Bool
$sel:brokerId:UpdateUser' :: UpdateUser -> Text
$sel:username:UpdateUser' :: UpdateUser -> Text
$sel:password:UpdateUser' :: UpdateUser -> Maybe Text
$sel:groups:UpdateUser' :: UpdateUser -> Maybe [Text]
$sel:consoleAccess:UpdateUser' :: UpdateUser -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
consoleAccess
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
groups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
password
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
username
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
brokerId

instance Prelude.NFData UpdateUser where
  rnf :: UpdateUser -> ()
rnf UpdateUser' {Maybe Bool
Maybe [Text]
Maybe Text
Text
brokerId :: Text
username :: Text
password :: Maybe Text
groups :: Maybe [Text]
consoleAccess :: Maybe Bool
$sel:brokerId:UpdateUser' :: UpdateUser -> Text
$sel:username:UpdateUser' :: UpdateUser -> Text
$sel:password:UpdateUser' :: UpdateUser -> Maybe Text
$sel:groups:UpdateUser' :: UpdateUser -> Maybe [Text]
$sel:consoleAccess:UpdateUser' :: UpdateUser -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
consoleAccess
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
groups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
password
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
username
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
brokerId

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

instance Data.ToJSON UpdateUser where
  toJSON :: UpdateUser -> Value
toJSON UpdateUser' {Maybe Bool
Maybe [Text]
Maybe Text
Text
brokerId :: Text
username :: Text
password :: Maybe Text
groups :: Maybe [Text]
consoleAccess :: Maybe Bool
$sel:brokerId:UpdateUser' :: UpdateUser -> Text
$sel:username:UpdateUser' :: UpdateUser -> Text
$sel:password:UpdateUser' :: UpdateUser -> Maybe Text
$sel:groups:UpdateUser' :: UpdateUser -> Maybe [Text]
$sel:consoleAccess:UpdateUser' :: UpdateUser -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"consoleAccess" 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 Bool
consoleAccess,
            (Key
"groups" 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]
groups,
            (Key
"password" 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
password
          ]
      )

instance Data.ToPath UpdateUser where
  toPath :: UpdateUser -> ByteString
toPath UpdateUser' {Maybe Bool
Maybe [Text]
Maybe Text
Text
brokerId :: Text
username :: Text
password :: Maybe Text
groups :: Maybe [Text]
consoleAccess :: Maybe Bool
$sel:brokerId:UpdateUser' :: UpdateUser -> Text
$sel:username:UpdateUser' :: UpdateUser -> Text
$sel:password:UpdateUser' :: UpdateUser -> Maybe Text
$sel:groups:UpdateUser' :: UpdateUser -> Maybe [Text]
$sel:consoleAccess:UpdateUser' :: UpdateUser -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/brokers/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
brokerId,
        ByteString
"/users/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
username
      ]

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

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

-- |
-- Create a value of 'UpdateUserResponse' 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:
--
-- 'httpStatus', 'updateUserResponse_httpStatus' - The response's http status code.
newUpdateUserResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateUserResponse
newUpdateUserResponse :: Int -> UpdateUserResponse
newUpdateUserResponse Int
pHttpStatus_ =
  UpdateUserResponse' {$sel:httpStatus:UpdateUserResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateUserResponse where
  rnf :: UpdateUserResponse -> ()
rnf UpdateUserResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateUserResponse' :: UpdateUserResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus