{-# 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.CreateAlias
-- 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 an alias to the set of a given member (user or group) of WorkMail.
module Amazonka.WorkMail.CreateAlias
  ( -- * Creating a Request
    CreateAlias (..),
    newCreateAlias,

    -- * Request Lenses
    createAlias_organizationId,
    createAlias_entityId,
    createAlias_alias,

    -- * Destructuring the Response
    CreateAliasResponse (..),
    newCreateAliasResponse,

    -- * Response Lenses
    createAliasResponse_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:/ 'newCreateAlias' smart constructor.
data CreateAlias = CreateAlias'
  { -- | The organization under which the member (user or group) exists.
    CreateAlias -> Text
organizationId :: Prelude.Text,
    -- | The member (user or group) to which this alias is added.
    CreateAlias -> Text
entityId :: Prelude.Text,
    -- | The alias to add to the member set.
    CreateAlias -> Text
alias :: Prelude.Text
  }
  deriving (CreateAlias -> CreateAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAlias -> CreateAlias -> Bool
$c/= :: CreateAlias -> CreateAlias -> Bool
== :: CreateAlias -> CreateAlias -> Bool
$c== :: CreateAlias -> CreateAlias -> Bool
Prelude.Eq, ReadPrec [CreateAlias]
ReadPrec CreateAlias
Int -> ReadS CreateAlias
ReadS [CreateAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAlias]
$creadListPrec :: ReadPrec [CreateAlias]
readPrec :: ReadPrec CreateAlias
$creadPrec :: ReadPrec CreateAlias
readList :: ReadS [CreateAlias]
$creadList :: ReadS [CreateAlias]
readsPrec :: Int -> ReadS CreateAlias
$creadsPrec :: Int -> ReadS CreateAlias
Prelude.Read, Int -> CreateAlias -> ShowS
[CreateAlias] -> ShowS
CreateAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAlias] -> ShowS
$cshowList :: [CreateAlias] -> ShowS
show :: CreateAlias -> String
$cshow :: CreateAlias -> String
showsPrec :: Int -> CreateAlias -> ShowS
$cshowsPrec :: Int -> CreateAlias -> ShowS
Prelude.Show, forall x. Rep CreateAlias x -> CreateAlias
forall x. CreateAlias -> Rep CreateAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAlias x -> CreateAlias
$cfrom :: forall x. CreateAlias -> Rep CreateAlias x
Prelude.Generic)

-- |
-- Create a value of 'CreateAlias' 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', 'createAlias_organizationId' - The organization under which the member (user or group) exists.
--
-- 'entityId', 'createAlias_entityId' - The member (user or group) to which this alias is added.
--
-- 'alias', 'createAlias_alias' - The alias to add to the member set.
newCreateAlias ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'entityId'
  Prelude.Text ->
  -- | 'alias'
  Prelude.Text ->
  CreateAlias
newCreateAlias :: Text -> Text -> Text -> CreateAlias
newCreateAlias Text
pOrganizationId_ Text
pEntityId_ Text
pAlias_ =
  CreateAlias'
    { $sel:organizationId:CreateAlias' :: Text
organizationId = Text
pOrganizationId_,
      $sel:entityId:CreateAlias' :: Text
entityId = Text
pEntityId_,
      $sel:alias:CreateAlias' :: Text
alias = Text
pAlias_
    }

-- | The organization under which the member (user or group) exists.
createAlias_organizationId :: Lens.Lens' CreateAlias Prelude.Text
createAlias_organizationId :: Lens' CreateAlias Text
createAlias_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
organizationId :: Text
$sel:organizationId:CreateAlias' :: CreateAlias -> Text
organizationId} -> Text
organizationId) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:organizationId:CreateAlias' :: Text
organizationId = Text
a} :: CreateAlias)

-- | The member (user or group) to which this alias is added.
createAlias_entityId :: Lens.Lens' CreateAlias Prelude.Text
createAlias_entityId :: Lens' CreateAlias Text
createAlias_entityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
entityId :: Text
$sel:entityId:CreateAlias' :: CreateAlias -> Text
entityId} -> Text
entityId) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:entityId:CreateAlias' :: Text
entityId = Text
a} :: CreateAlias)

-- | The alias to add to the member set.
createAlias_alias :: Lens.Lens' CreateAlias Prelude.Text
createAlias_alias :: Lens' CreateAlias Text
createAlias_alias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAlias' {Text
alias :: Text
$sel:alias:CreateAlias' :: CreateAlias -> Text
alias} -> Text
alias) (\s :: CreateAlias
s@CreateAlias' {} Text
a -> CreateAlias
s {$sel:alias:CreateAlias' :: Text
alias = Text
a} :: CreateAlias)

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

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

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

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

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

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

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

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

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