{-# 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.AssociateDelegateToResource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a member (user or group) to the resource\'s set of delegates.
module Amazonka.WorkMail.AssociateDelegateToResource
  ( -- * Creating a Request
    AssociateDelegateToResource (..),
    newAssociateDelegateToResource,

    -- * Request Lenses
    associateDelegateToResource_organizationId,
    associateDelegateToResource_resourceId,
    associateDelegateToResource_entityId,

    -- * Destructuring the Response
    AssociateDelegateToResourceResponse (..),
    newAssociateDelegateToResourceResponse,

    -- * Response Lenses
    associateDelegateToResourceResponse_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:/ 'newAssociateDelegateToResource' smart constructor.
data AssociateDelegateToResource = AssociateDelegateToResource'
  { -- | The organization under which the resource exists.
    AssociateDelegateToResource -> Text
organizationId :: Prelude.Text,
    -- | The resource for which members (users or groups) are associated.
    AssociateDelegateToResource -> Text
resourceId :: Prelude.Text,
    -- | The member (user or group) to associate to the resource.
    AssociateDelegateToResource -> Text
entityId :: Prelude.Text
  }
  deriving (AssociateDelegateToResource -> AssociateDelegateToResource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateDelegateToResource -> AssociateDelegateToResource -> Bool
$c/= :: AssociateDelegateToResource -> AssociateDelegateToResource -> Bool
== :: AssociateDelegateToResource -> AssociateDelegateToResource -> Bool
$c== :: AssociateDelegateToResource -> AssociateDelegateToResource -> Bool
Prelude.Eq, ReadPrec [AssociateDelegateToResource]
ReadPrec AssociateDelegateToResource
Int -> ReadS AssociateDelegateToResource
ReadS [AssociateDelegateToResource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateDelegateToResource]
$creadListPrec :: ReadPrec [AssociateDelegateToResource]
readPrec :: ReadPrec AssociateDelegateToResource
$creadPrec :: ReadPrec AssociateDelegateToResource
readList :: ReadS [AssociateDelegateToResource]
$creadList :: ReadS [AssociateDelegateToResource]
readsPrec :: Int -> ReadS AssociateDelegateToResource
$creadsPrec :: Int -> ReadS AssociateDelegateToResource
Prelude.Read, Int -> AssociateDelegateToResource -> ShowS
[AssociateDelegateToResource] -> ShowS
AssociateDelegateToResource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateDelegateToResource] -> ShowS
$cshowList :: [AssociateDelegateToResource] -> ShowS
show :: AssociateDelegateToResource -> String
$cshow :: AssociateDelegateToResource -> String
showsPrec :: Int -> AssociateDelegateToResource -> ShowS
$cshowsPrec :: Int -> AssociateDelegateToResource -> ShowS
Prelude.Show, forall x.
Rep AssociateDelegateToResource x -> AssociateDelegateToResource
forall x.
AssociateDelegateToResource -> Rep AssociateDelegateToResource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateDelegateToResource x -> AssociateDelegateToResource
$cfrom :: forall x.
AssociateDelegateToResource -> Rep AssociateDelegateToResource x
Prelude.Generic)

-- |
-- Create a value of 'AssociateDelegateToResource' 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', 'associateDelegateToResource_organizationId' - The organization under which the resource exists.
--
-- 'resourceId', 'associateDelegateToResource_resourceId' - The resource for which members (users or groups) are associated.
--
-- 'entityId', 'associateDelegateToResource_entityId' - The member (user or group) to associate to the resource.
newAssociateDelegateToResource ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'entityId'
  Prelude.Text ->
  AssociateDelegateToResource
newAssociateDelegateToResource :: Text -> Text -> Text -> AssociateDelegateToResource
newAssociateDelegateToResource
  Text
pOrganizationId_
  Text
pResourceId_
  Text
pEntityId_ =
    AssociateDelegateToResource'
      { $sel:organizationId:AssociateDelegateToResource' :: Text
organizationId =
          Text
pOrganizationId_,
        $sel:resourceId:AssociateDelegateToResource' :: Text
resourceId = Text
pResourceId_,
        $sel:entityId:AssociateDelegateToResource' :: Text
entityId = Text
pEntityId_
      }

-- | The organization under which the resource exists.
associateDelegateToResource_organizationId :: Lens.Lens' AssociateDelegateToResource Prelude.Text
associateDelegateToResource_organizationId :: Lens' AssociateDelegateToResource Text
associateDelegateToResource_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDelegateToResource' {Text
organizationId :: Text
$sel:organizationId:AssociateDelegateToResource' :: AssociateDelegateToResource -> Text
organizationId} -> Text
organizationId) (\s :: AssociateDelegateToResource
s@AssociateDelegateToResource' {} Text
a -> AssociateDelegateToResource
s {$sel:organizationId:AssociateDelegateToResource' :: Text
organizationId = Text
a} :: AssociateDelegateToResource)

-- | The resource for which members (users or groups) are associated.
associateDelegateToResource_resourceId :: Lens.Lens' AssociateDelegateToResource Prelude.Text
associateDelegateToResource_resourceId :: Lens' AssociateDelegateToResource Text
associateDelegateToResource_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDelegateToResource' {Text
resourceId :: Text
$sel:resourceId:AssociateDelegateToResource' :: AssociateDelegateToResource -> Text
resourceId} -> Text
resourceId) (\s :: AssociateDelegateToResource
s@AssociateDelegateToResource' {} Text
a -> AssociateDelegateToResource
s {$sel:resourceId:AssociateDelegateToResource' :: Text
resourceId = Text
a} :: AssociateDelegateToResource)

-- | The member (user or group) to associate to the resource.
associateDelegateToResource_entityId :: Lens.Lens' AssociateDelegateToResource Prelude.Text
associateDelegateToResource_entityId :: Lens' AssociateDelegateToResource Text
associateDelegateToResource_entityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDelegateToResource' {Text
entityId :: Text
$sel:entityId:AssociateDelegateToResource' :: AssociateDelegateToResource -> Text
entityId} -> Text
entityId) (\s :: AssociateDelegateToResource
s@AssociateDelegateToResource' {} Text
a -> AssociateDelegateToResource
s {$sel:entityId:AssociateDelegateToResource' :: Text
entityId = Text
a} :: AssociateDelegateToResource)

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

instance Prelude.NFData AssociateDelegateToResource where
  rnf :: AssociateDelegateToResource -> ()
rnf AssociateDelegateToResource' {Text
entityId :: Text
resourceId :: Text
organizationId :: Text
$sel:entityId:AssociateDelegateToResource' :: AssociateDelegateToResource -> Text
$sel:resourceId:AssociateDelegateToResource' :: AssociateDelegateToResource -> Text
$sel:organizationId:AssociateDelegateToResource' :: AssociateDelegateToResource -> 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
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
entityId

instance Data.ToHeaders AssociateDelegateToResource where
  toHeaders :: AssociateDelegateToResource -> 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.AssociateDelegateToResource" ::
                          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 AssociateDelegateToResource where
  toJSON :: AssociateDelegateToResource -> Value
toJSON AssociateDelegateToResource' {Text
entityId :: Text
resourceId :: Text
organizationId :: Text
$sel:entityId:AssociateDelegateToResource' :: AssociateDelegateToResource -> Text
$sel:resourceId:AssociateDelegateToResource' :: AssociateDelegateToResource -> Text
$sel:organizationId:AssociateDelegateToResource' :: AssociateDelegateToResource -> 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
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"EntityId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
entityId)
          ]
      )

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

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

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

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

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

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