{-# 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.RegisterToWorkMail
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers an existing and disabled user, group, or resource for WorkMail
-- use by associating a mailbox and calendaring capabilities. It performs
-- no change if the user, group, or resource is enabled and fails if the
-- user, group, or resource is deleted. This operation results in the
-- accumulation of costs. For more information, see
-- <https://aws.amazon.com/workmail/pricing Pricing>. The equivalent
-- console functionality for this operation is /Enable/.
--
-- Users can either be created by calling the CreateUser API operation or
-- they can be synchronized from your directory. For more information, see
-- DeregisterFromWorkMail.
module Amazonka.WorkMail.RegisterToWorkMail
  ( -- * Creating a Request
    RegisterToWorkMail (..),
    newRegisterToWorkMail,

    -- * Request Lenses
    registerToWorkMail_organizationId,
    registerToWorkMail_entityId,
    registerToWorkMail_email,

    -- * Destructuring the Response
    RegisterToWorkMailResponse (..),
    newRegisterToWorkMailResponse,

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

-- |
-- Create a value of 'RegisterToWorkMail' 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', 'registerToWorkMail_organizationId' - The identifier for the organization under which the user, group, or
-- resource exists.
--
-- 'entityId', 'registerToWorkMail_entityId' - The identifier for the user, group, or resource to be updated.
--
-- 'email', 'registerToWorkMail_email' - The email for the user, group, or resource to be updated.
newRegisterToWorkMail ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'entityId'
  Prelude.Text ->
  -- | 'email'
  Prelude.Text ->
  RegisterToWorkMail
newRegisterToWorkMail :: Text -> Text -> Text -> RegisterToWorkMail
newRegisterToWorkMail
  Text
pOrganizationId_
  Text
pEntityId_
  Text
pEmail_ =
    RegisterToWorkMail'
      { $sel:organizationId:RegisterToWorkMail' :: Text
organizationId =
          Text
pOrganizationId_,
        $sel:entityId:RegisterToWorkMail' :: Text
entityId = Text
pEntityId_,
        $sel:email:RegisterToWorkMail' :: Text
email = Text
pEmail_
      }

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

-- | The identifier for the user, group, or resource to be updated.
registerToWorkMail_entityId :: Lens.Lens' RegisterToWorkMail Prelude.Text
registerToWorkMail_entityId :: Lens' RegisterToWorkMail Text
registerToWorkMail_entityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterToWorkMail' {Text
entityId :: Text
$sel:entityId:RegisterToWorkMail' :: RegisterToWorkMail -> Text
entityId} -> Text
entityId) (\s :: RegisterToWorkMail
s@RegisterToWorkMail' {} Text
a -> RegisterToWorkMail
s {$sel:entityId:RegisterToWorkMail' :: Text
entityId = Text
a} :: RegisterToWorkMail)

-- | The email for the user, group, or resource to be updated.
registerToWorkMail_email :: Lens.Lens' RegisterToWorkMail Prelude.Text
registerToWorkMail_email :: Lens' RegisterToWorkMail Text
registerToWorkMail_email = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterToWorkMail' {Text
email :: Text
$sel:email:RegisterToWorkMail' :: RegisterToWorkMail -> Text
email} -> Text
email) (\s :: RegisterToWorkMail
s@RegisterToWorkMail' {} Text
a -> RegisterToWorkMail
s {$sel:email:RegisterToWorkMail' :: Text
email = Text
a} :: RegisterToWorkMail)

instance Core.AWSRequest RegisterToWorkMail where
  type
    AWSResponse RegisterToWorkMail =
      RegisterToWorkMailResponse
  request :: (Service -> Service)
-> RegisterToWorkMail -> Request RegisterToWorkMail
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 RegisterToWorkMail
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterToWorkMail)))
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 -> RegisterToWorkMailResponse
RegisterToWorkMailResponse'
            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 RegisterToWorkMail where
  hashWithSalt :: Int -> RegisterToWorkMail -> Int
hashWithSalt Int
_salt RegisterToWorkMail' {Text
email :: Text
entityId :: Text
organizationId :: Text
$sel:email:RegisterToWorkMail' :: RegisterToWorkMail -> Text
$sel:entityId:RegisterToWorkMail' :: RegisterToWorkMail -> Text
$sel:organizationId:RegisterToWorkMail' :: RegisterToWorkMail -> 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
email

instance Prelude.NFData RegisterToWorkMail where
  rnf :: RegisterToWorkMail -> ()
rnf RegisterToWorkMail' {Text
email :: Text
entityId :: Text
organizationId :: Text
$sel:email:RegisterToWorkMail' :: RegisterToWorkMail -> Text
$sel:entityId:RegisterToWorkMail' :: RegisterToWorkMail -> Text
$sel:organizationId:RegisterToWorkMail' :: RegisterToWorkMail -> 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
email

instance Data.ToHeaders RegisterToWorkMail where
  toHeaders :: RegisterToWorkMail -> 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.RegisterToWorkMail" ::
                          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 RegisterToWorkMail where
  toJSON :: RegisterToWorkMail -> Value
toJSON RegisterToWorkMail' {Text
email :: Text
entityId :: Text
organizationId :: Text
$sel:email:RegisterToWorkMail' :: RegisterToWorkMail -> Text
$sel:entityId:RegisterToWorkMail' :: RegisterToWorkMail -> Text
$sel:organizationId:RegisterToWorkMail' :: RegisterToWorkMail -> 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
"Email" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
email)
          ]
      )

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

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

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

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

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

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