{-# 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.WorkMail.DisassociateMemberFromGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes a member from a group.
module Amazonka.WorkMail.DisassociateMemberFromGroup
  ( -- * Creating a Request
    DisassociateMemberFromGroup (..),
    newDisassociateMemberFromGroup,

    -- * Request Lenses
    disassociateMemberFromGroup_organizationId,
    disassociateMemberFromGroup_groupId,
    disassociateMemberFromGroup_memberId,

    -- * Destructuring the Response
    DisassociateMemberFromGroupResponse (..),
    newDisassociateMemberFromGroupResponse,

    -- * Response Lenses
    disassociateMemberFromGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDisassociateMemberFromGroup' smart constructor.
data DisassociateMemberFromGroup = DisassociateMemberFromGroup'
  { -- | The identifier for the organization under which the group exists.
    DisassociateMemberFromGroup -> Text
organizationId :: Prelude.Text,
    -- | The identifier for the group from which members are removed.
    DisassociateMemberFromGroup -> Text
groupId :: Prelude.Text,
    -- | The identifier for the member to be removed to the group.
    DisassociateMemberFromGroup -> Text
memberId :: Prelude.Text
  }
  deriving (DisassociateMemberFromGroup -> DisassociateMemberFromGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DisassociateMemberFromGroup -> DisassociateMemberFromGroup -> Bool
$c/= :: DisassociateMemberFromGroup -> DisassociateMemberFromGroup -> Bool
== :: DisassociateMemberFromGroup -> DisassociateMemberFromGroup -> Bool
$c== :: DisassociateMemberFromGroup -> DisassociateMemberFromGroup -> Bool
Prelude.Eq, ReadPrec [DisassociateMemberFromGroup]
ReadPrec DisassociateMemberFromGroup
Int -> ReadS DisassociateMemberFromGroup
ReadS [DisassociateMemberFromGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DisassociateMemberFromGroup]
$creadListPrec :: ReadPrec [DisassociateMemberFromGroup]
readPrec :: ReadPrec DisassociateMemberFromGroup
$creadPrec :: ReadPrec DisassociateMemberFromGroup
readList :: ReadS [DisassociateMemberFromGroup]
$creadList :: ReadS [DisassociateMemberFromGroup]
readsPrec :: Int -> ReadS DisassociateMemberFromGroup
$creadsPrec :: Int -> ReadS DisassociateMemberFromGroup
Prelude.Read, Int -> DisassociateMemberFromGroup -> ShowS
[DisassociateMemberFromGroup] -> ShowS
DisassociateMemberFromGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DisassociateMemberFromGroup] -> ShowS
$cshowList :: [DisassociateMemberFromGroup] -> ShowS
show :: DisassociateMemberFromGroup -> String
$cshow :: DisassociateMemberFromGroup -> String
showsPrec :: Int -> DisassociateMemberFromGroup -> ShowS
$cshowsPrec :: Int -> DisassociateMemberFromGroup -> ShowS
Prelude.Show, forall x.
Rep DisassociateMemberFromGroup x -> DisassociateMemberFromGroup
forall x.
DisassociateMemberFromGroup -> Rep DisassociateMemberFromGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DisassociateMemberFromGroup x -> DisassociateMemberFromGroup
$cfrom :: forall x.
DisassociateMemberFromGroup -> Rep DisassociateMemberFromGroup x
Prelude.Generic)

-- |
-- Create a value of 'DisassociateMemberFromGroup' 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:
--
-- 'organizationId', 'disassociateMemberFromGroup_organizationId' - The identifier for the organization under which the group exists.
--
-- 'groupId', 'disassociateMemberFromGroup_groupId' - The identifier for the group from which members are removed.
--
-- 'memberId', 'disassociateMemberFromGroup_memberId' - The identifier for the member to be removed to the group.
newDisassociateMemberFromGroup ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'groupId'
  Prelude.Text ->
  -- | 'memberId'
  Prelude.Text ->
  DisassociateMemberFromGroup
newDisassociateMemberFromGroup :: Text -> Text -> Text -> DisassociateMemberFromGroup
newDisassociateMemberFromGroup
  Text
pOrganizationId_
  Text
pGroupId_
  Text
pMemberId_ =
    DisassociateMemberFromGroup'
      { $sel:organizationId:DisassociateMemberFromGroup' :: Text
organizationId =
          Text
pOrganizationId_,
        $sel:groupId:DisassociateMemberFromGroup' :: Text
groupId = Text
pGroupId_,
        $sel:memberId:DisassociateMemberFromGroup' :: Text
memberId = Text
pMemberId_
      }

-- | The identifier for the organization under which the group exists.
disassociateMemberFromGroup_organizationId :: Lens.Lens' DisassociateMemberFromGroup Prelude.Text
disassociateMemberFromGroup_organizationId :: Lens' DisassociateMemberFromGroup Text
disassociateMemberFromGroup_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateMemberFromGroup' {Text
organizationId :: Text
$sel:organizationId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
organizationId} -> Text
organizationId) (\s :: DisassociateMemberFromGroup
s@DisassociateMemberFromGroup' {} Text
a -> DisassociateMemberFromGroup
s {$sel:organizationId:DisassociateMemberFromGroup' :: Text
organizationId = Text
a} :: DisassociateMemberFromGroup)

-- | The identifier for the group from which members are removed.
disassociateMemberFromGroup_groupId :: Lens.Lens' DisassociateMemberFromGroup Prelude.Text
disassociateMemberFromGroup_groupId :: Lens' DisassociateMemberFromGroup Text
disassociateMemberFromGroup_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateMemberFromGroup' {Text
groupId :: Text
$sel:groupId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
groupId} -> Text
groupId) (\s :: DisassociateMemberFromGroup
s@DisassociateMemberFromGroup' {} Text
a -> DisassociateMemberFromGroup
s {$sel:groupId:DisassociateMemberFromGroup' :: Text
groupId = Text
a} :: DisassociateMemberFromGroup)

-- | The identifier for the member to be removed to the group.
disassociateMemberFromGroup_memberId :: Lens.Lens' DisassociateMemberFromGroup Prelude.Text
disassociateMemberFromGroup_memberId :: Lens' DisassociateMemberFromGroup Text
disassociateMemberFromGroup_memberId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisassociateMemberFromGroup' {Text
memberId :: Text
$sel:memberId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
memberId} -> Text
memberId) (\s :: DisassociateMemberFromGroup
s@DisassociateMemberFromGroup' {} Text
a -> DisassociateMemberFromGroup
s {$sel:memberId:DisassociateMemberFromGroup' :: Text
memberId = Text
a} :: DisassociateMemberFromGroup)

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

instance Prelude.NFData DisassociateMemberFromGroup where
  rnf :: DisassociateMemberFromGroup -> ()
rnf DisassociateMemberFromGroup' {Text
memberId :: Text
groupId :: Text
organizationId :: Text
$sel:memberId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
$sel:groupId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
$sel:organizationId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId
      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 Text
memberId

instance Data.ToHeaders DisassociateMemberFromGroup where
  toHeaders :: DisassociateMemberFromGroup -> 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
"WorkMailService.DisassociateMemberFromGroup" ::
                          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 DisassociateMemberFromGroup where
  toJSON :: DisassociateMemberFromGroup -> Value
toJSON DisassociateMemberFromGroup' {Text
memberId :: Text
groupId :: Text
organizationId :: Text
$sel:memberId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
$sel:groupId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
$sel:organizationId:DisassociateMemberFromGroup' :: DisassociateMemberFromGroup -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId),
            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
"MemberId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
memberId)
          ]
      )

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

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

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

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

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

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