{-# 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.IdentityStore.UpdateGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- For the specified group in the specified identity store, updates the
-- group metadata and attributes.
module Amazonka.IdentityStore.UpdateGroup
  ( -- * Creating a Request
    UpdateGroup (..),
    newUpdateGroup,

    -- * Request Lenses
    updateGroup_identityStoreId,
    updateGroup_groupId,
    updateGroup_operations,

    -- * Destructuring the Response
    UpdateGroupResponse (..),
    newUpdateGroupResponse,

    -- * Response Lenses
    updateGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateGroup' smart constructor.
data UpdateGroup = UpdateGroup'
  { -- | The globally unique identifier for the identity store.
    UpdateGroup -> Text
identityStoreId :: Prelude.Text,
    -- | The identifier for a group in the identity store.
    UpdateGroup -> Text
groupId :: Prelude.Text,
    -- | A list of @AttributeOperation@ objects to apply to the requested group.
    -- These operations might add, replace, or remove an attribute.
    UpdateGroup -> NonEmpty AttributeOperation
operations :: Prelude.NonEmpty AttributeOperation
  }
  deriving (UpdateGroup -> UpdateGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateGroup -> UpdateGroup -> Bool
$c/= :: UpdateGroup -> UpdateGroup -> Bool
== :: UpdateGroup -> UpdateGroup -> Bool
$c== :: UpdateGroup -> UpdateGroup -> Bool
Prelude.Eq, ReadPrec [UpdateGroup]
ReadPrec UpdateGroup
Int -> ReadS UpdateGroup
ReadS [UpdateGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateGroup]
$creadListPrec :: ReadPrec [UpdateGroup]
readPrec :: ReadPrec UpdateGroup
$creadPrec :: ReadPrec UpdateGroup
readList :: ReadS [UpdateGroup]
$creadList :: ReadS [UpdateGroup]
readsPrec :: Int -> ReadS UpdateGroup
$creadsPrec :: Int -> ReadS UpdateGroup
Prelude.Read, Int -> UpdateGroup -> ShowS
[UpdateGroup] -> ShowS
UpdateGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateGroup] -> ShowS
$cshowList :: [UpdateGroup] -> ShowS
show :: UpdateGroup -> String
$cshow :: UpdateGroup -> String
showsPrec :: Int -> UpdateGroup -> ShowS
$cshowsPrec :: Int -> UpdateGroup -> ShowS
Prelude.Show, forall x. Rep UpdateGroup x -> UpdateGroup
forall x. UpdateGroup -> Rep UpdateGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateGroup x -> UpdateGroup
$cfrom :: forall x. UpdateGroup -> Rep UpdateGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateGroup' 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:
--
-- 'identityStoreId', 'updateGroup_identityStoreId' - The globally unique identifier for the identity store.
--
-- 'groupId', 'updateGroup_groupId' - The identifier for a group in the identity store.
--
-- 'operations', 'updateGroup_operations' - A list of @AttributeOperation@ objects to apply to the requested group.
-- These operations might add, replace, or remove an attribute.
newUpdateGroup ::
  -- | 'identityStoreId'
  Prelude.Text ->
  -- | 'groupId'
  Prelude.Text ->
  -- | 'operations'
  Prelude.NonEmpty AttributeOperation ->
  UpdateGroup
newUpdateGroup :: Text -> Text -> NonEmpty AttributeOperation -> UpdateGroup
newUpdateGroup
  Text
pIdentityStoreId_
  Text
pGroupId_
  NonEmpty AttributeOperation
pOperations_ =
    UpdateGroup'
      { $sel:identityStoreId:UpdateGroup' :: Text
identityStoreId = Text
pIdentityStoreId_,
        $sel:groupId:UpdateGroup' :: Text
groupId = Text
pGroupId_,
        $sel:operations:UpdateGroup' :: NonEmpty AttributeOperation
operations = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty AttributeOperation
pOperations_
      }

-- | The globally unique identifier for the identity store.
updateGroup_identityStoreId :: Lens.Lens' UpdateGroup Prelude.Text
updateGroup_identityStoreId :: Lens' UpdateGroup Text
updateGroup_identityStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGroup' {Text
identityStoreId :: Text
$sel:identityStoreId:UpdateGroup' :: UpdateGroup -> Text
identityStoreId} -> Text
identityStoreId) (\s :: UpdateGroup
s@UpdateGroup' {} Text
a -> UpdateGroup
s {$sel:identityStoreId:UpdateGroup' :: Text
identityStoreId = Text
a} :: UpdateGroup)

-- | The identifier for a group in the identity store.
updateGroup_groupId :: Lens.Lens' UpdateGroup Prelude.Text
updateGroup_groupId :: Lens' UpdateGroup Text
updateGroup_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGroup' {Text
groupId :: Text
$sel:groupId:UpdateGroup' :: UpdateGroup -> Text
groupId} -> Text
groupId) (\s :: UpdateGroup
s@UpdateGroup' {} Text
a -> UpdateGroup
s {$sel:groupId:UpdateGroup' :: Text
groupId = Text
a} :: UpdateGroup)

-- | A list of @AttributeOperation@ objects to apply to the requested group.
-- These operations might add, replace, or remove an attribute.
updateGroup_operations :: Lens.Lens' UpdateGroup (Prelude.NonEmpty AttributeOperation)
updateGroup_operations :: Lens' UpdateGroup (NonEmpty AttributeOperation)
updateGroup_operations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGroup' {NonEmpty AttributeOperation
operations :: NonEmpty AttributeOperation
$sel:operations:UpdateGroup' :: UpdateGroup -> NonEmpty AttributeOperation
operations} -> NonEmpty AttributeOperation
operations) (\s :: UpdateGroup
s@UpdateGroup' {} NonEmpty AttributeOperation
a -> UpdateGroup
s {$sel:operations:UpdateGroup' :: NonEmpty AttributeOperation
operations = NonEmpty AttributeOperation
a} :: UpdateGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest UpdateGroup where
  type AWSResponse UpdateGroup = UpdateGroupResponse
  request :: (Service -> Service) -> UpdateGroup -> Request UpdateGroup
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 UpdateGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateGroup)))
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 -> UpdateGroupResponse
UpdateGroupResponse'
            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 UpdateGroup where
  hashWithSalt :: Int -> UpdateGroup -> Int
hashWithSalt Int
_salt UpdateGroup' {NonEmpty AttributeOperation
Text
operations :: NonEmpty AttributeOperation
groupId :: Text
identityStoreId :: Text
$sel:operations:UpdateGroup' :: UpdateGroup -> NonEmpty AttributeOperation
$sel:groupId:UpdateGroup' :: UpdateGroup -> Text
$sel:identityStoreId:UpdateGroup' :: UpdateGroup -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityStoreId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
groupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty AttributeOperation
operations

instance Prelude.NFData UpdateGroup where
  rnf :: UpdateGroup -> ()
rnf UpdateGroup' {NonEmpty AttributeOperation
Text
operations :: NonEmpty AttributeOperation
groupId :: Text
identityStoreId :: Text
$sel:operations:UpdateGroup' :: UpdateGroup -> NonEmpty AttributeOperation
$sel:groupId:UpdateGroup' :: UpdateGroup -> Text
$sel:identityStoreId:UpdateGroup' :: UpdateGroup -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identityStoreId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
groupId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty AttributeOperation
operations

instance Data.ToHeaders UpdateGroup where
  toHeaders :: UpdateGroup -> 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
"AWSIdentityStore.UpdateGroup" ::
                          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 UpdateGroup where
  toJSON :: UpdateGroup -> Value
toJSON UpdateGroup' {NonEmpty AttributeOperation
Text
operations :: NonEmpty AttributeOperation
groupId :: Text
identityStoreId :: Text
$sel:operations:UpdateGroup' :: UpdateGroup -> NonEmpty AttributeOperation
$sel:groupId:UpdateGroup' :: UpdateGroup -> Text
$sel:identityStoreId:UpdateGroup' :: UpdateGroup -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityStoreId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityStoreId),
            forall a. a -> Maybe a
Prelude.Just (Key
"GroupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
groupId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Operations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty AttributeOperation
operations)
          ]
      )

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

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

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

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

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

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