{-# 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.RegisterMailDomain
-- 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 a new domain in WorkMail and SES, and configures it for use by
-- WorkMail. Emails received by SES for this domain are routed to the
-- specified WorkMail organization, and WorkMail has permanent permission
-- to use the specified domain for sending your users\' emails.
module Amazonka.WorkMail.RegisterMailDomain
  ( -- * Creating a Request
    RegisterMailDomain (..),
    newRegisterMailDomain,

    -- * Request Lenses
    registerMailDomain_clientToken,
    registerMailDomain_organizationId,
    registerMailDomain_domainName,

    -- * Destructuring the Response
    RegisterMailDomainResponse (..),
    newRegisterMailDomainResponse,

    -- * Response Lenses
    registerMailDomainResponse_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:/ 'newRegisterMailDomain' smart constructor.
data RegisterMailDomain = RegisterMailDomain'
  { -- | Idempotency token used when retrying requests.
    RegisterMailDomain -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The WorkMail organization under which you\'re creating the domain.
    RegisterMailDomain -> Text
organizationId :: Prelude.Text,
    -- | The name of the mail domain to create in WorkMail and SES.
    RegisterMailDomain -> Text
domainName :: Prelude.Text
  }
  deriving (RegisterMailDomain -> RegisterMailDomain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterMailDomain -> RegisterMailDomain -> Bool
$c/= :: RegisterMailDomain -> RegisterMailDomain -> Bool
== :: RegisterMailDomain -> RegisterMailDomain -> Bool
$c== :: RegisterMailDomain -> RegisterMailDomain -> Bool
Prelude.Eq, ReadPrec [RegisterMailDomain]
ReadPrec RegisterMailDomain
Int -> ReadS RegisterMailDomain
ReadS [RegisterMailDomain]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterMailDomain]
$creadListPrec :: ReadPrec [RegisterMailDomain]
readPrec :: ReadPrec RegisterMailDomain
$creadPrec :: ReadPrec RegisterMailDomain
readList :: ReadS [RegisterMailDomain]
$creadList :: ReadS [RegisterMailDomain]
readsPrec :: Int -> ReadS RegisterMailDomain
$creadsPrec :: Int -> ReadS RegisterMailDomain
Prelude.Read, Int -> RegisterMailDomain -> ShowS
[RegisterMailDomain] -> ShowS
RegisterMailDomain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterMailDomain] -> ShowS
$cshowList :: [RegisterMailDomain] -> ShowS
show :: RegisterMailDomain -> String
$cshow :: RegisterMailDomain -> String
showsPrec :: Int -> RegisterMailDomain -> ShowS
$cshowsPrec :: Int -> RegisterMailDomain -> ShowS
Prelude.Show, forall x. Rep RegisterMailDomain x -> RegisterMailDomain
forall x. RegisterMailDomain -> Rep RegisterMailDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterMailDomain x -> RegisterMailDomain
$cfrom :: forall x. RegisterMailDomain -> Rep RegisterMailDomain x
Prelude.Generic)

-- |
-- Create a value of 'RegisterMailDomain' 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:
--
-- 'clientToken', 'registerMailDomain_clientToken' - Idempotency token used when retrying requests.
--
-- 'organizationId', 'registerMailDomain_organizationId' - The WorkMail organization under which you\'re creating the domain.
--
-- 'domainName', 'registerMailDomain_domainName' - The name of the mail domain to create in WorkMail and SES.
newRegisterMailDomain ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'domainName'
  Prelude.Text ->
  RegisterMailDomain
newRegisterMailDomain :: Text -> Text -> RegisterMailDomain
newRegisterMailDomain Text
pOrganizationId_ Text
pDomainName_ =
  RegisterMailDomain'
    { $sel:clientToken:RegisterMailDomain' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationId:RegisterMailDomain' :: Text
organizationId = Text
pOrganizationId_,
      $sel:domainName:RegisterMailDomain' :: Text
domainName = Text
pDomainName_
    }

-- | Idempotency token used when retrying requests.
registerMailDomain_clientToken :: Lens.Lens' RegisterMailDomain (Prelude.Maybe Prelude.Text)
registerMailDomain_clientToken :: Lens' RegisterMailDomain (Maybe Text)
registerMailDomain_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterMailDomain' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:RegisterMailDomain' :: RegisterMailDomain -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: RegisterMailDomain
s@RegisterMailDomain' {} Maybe Text
a -> RegisterMailDomain
s {$sel:clientToken:RegisterMailDomain' :: Maybe Text
clientToken = Maybe Text
a} :: RegisterMailDomain)

-- | The WorkMail organization under which you\'re creating the domain.
registerMailDomain_organizationId :: Lens.Lens' RegisterMailDomain Prelude.Text
registerMailDomain_organizationId :: Lens' RegisterMailDomain Text
registerMailDomain_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterMailDomain' {Text
organizationId :: Text
$sel:organizationId:RegisterMailDomain' :: RegisterMailDomain -> Text
organizationId} -> Text
organizationId) (\s :: RegisterMailDomain
s@RegisterMailDomain' {} Text
a -> RegisterMailDomain
s {$sel:organizationId:RegisterMailDomain' :: Text
organizationId = Text
a} :: RegisterMailDomain)

-- | The name of the mail domain to create in WorkMail and SES.
registerMailDomain_domainName :: Lens.Lens' RegisterMailDomain Prelude.Text
registerMailDomain_domainName :: Lens' RegisterMailDomain Text
registerMailDomain_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterMailDomain' {Text
domainName :: Text
$sel:domainName:RegisterMailDomain' :: RegisterMailDomain -> Text
domainName} -> Text
domainName) (\s :: RegisterMailDomain
s@RegisterMailDomain' {} Text
a -> RegisterMailDomain
s {$sel:domainName:RegisterMailDomain' :: Text
domainName = Text
a} :: RegisterMailDomain)

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

instance Prelude.NFData RegisterMailDomain where
  rnf :: RegisterMailDomain -> ()
rnf RegisterMailDomain' {Maybe Text
Text
domainName :: Text
organizationId :: Text
clientToken :: Maybe Text
$sel:domainName:RegisterMailDomain' :: RegisterMailDomain -> Text
$sel:organizationId:RegisterMailDomain' :: RegisterMailDomain -> Text
$sel:clientToken:RegisterMailDomain' :: RegisterMailDomain -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
domainName

instance Data.ToHeaders RegisterMailDomain where
  toHeaders :: RegisterMailDomain -> 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.RegisterMailDomain" ::
                          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 RegisterMailDomain where
  toJSON :: RegisterMailDomain -> Value
toJSON RegisterMailDomain' {Maybe Text
Text
domainName :: Text
organizationId :: Text
clientToken :: Maybe Text
$sel:domainName:RegisterMailDomain' :: RegisterMailDomain -> Text
$sel:organizationId:RegisterMailDomain' :: RegisterMailDomain -> Text
$sel:clientToken:RegisterMailDomain' :: RegisterMailDomain -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            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
"DomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainName)
          ]
      )

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

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

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

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

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

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