{-# 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.DirectoryService.RegisterEventTopic
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Associates a directory with an Amazon SNS topic. This establishes the
-- directory as a publisher to the specified Amazon SNS topic. You can then
-- receive email or text (SMS) messages when the status of your directory
-- changes. You get notified if your directory goes from an Active status
-- to an Impaired or Inoperable status. You also receive a notification
-- when the directory returns to an Active status.
module Amazonka.DirectoryService.RegisterEventTopic
  ( -- * Creating a Request
    RegisterEventTopic (..),
    newRegisterEventTopic,

    -- * Request Lenses
    registerEventTopic_directoryId,
    registerEventTopic_topicName,

    -- * Destructuring the Response
    RegisterEventTopicResponse (..),
    newRegisterEventTopicResponse,

    -- * Response Lenses
    registerEventTopicResponse_httpStatus,
  )
where

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

-- | Registers a new event topic.
--
-- /See:/ 'newRegisterEventTopic' smart constructor.
data RegisterEventTopic = RegisterEventTopic'
  { -- | The Directory ID that will publish status messages to the Amazon SNS
    -- topic.
    RegisterEventTopic -> Text
directoryId :: Prelude.Text,
    -- | The Amazon SNS topic name to which the directory will publish status
    -- messages. This Amazon SNS topic must be in the same region as the
    -- specified Directory ID.
    RegisterEventTopic -> Text
topicName :: Prelude.Text
  }
  deriving (RegisterEventTopic -> RegisterEventTopic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterEventTopic -> RegisterEventTopic -> Bool
$c/= :: RegisterEventTopic -> RegisterEventTopic -> Bool
== :: RegisterEventTopic -> RegisterEventTopic -> Bool
$c== :: RegisterEventTopic -> RegisterEventTopic -> Bool
Prelude.Eq, ReadPrec [RegisterEventTopic]
ReadPrec RegisterEventTopic
Int -> ReadS RegisterEventTopic
ReadS [RegisterEventTopic]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterEventTopic]
$creadListPrec :: ReadPrec [RegisterEventTopic]
readPrec :: ReadPrec RegisterEventTopic
$creadPrec :: ReadPrec RegisterEventTopic
readList :: ReadS [RegisterEventTopic]
$creadList :: ReadS [RegisterEventTopic]
readsPrec :: Int -> ReadS RegisterEventTopic
$creadsPrec :: Int -> ReadS RegisterEventTopic
Prelude.Read, Int -> RegisterEventTopic -> ShowS
[RegisterEventTopic] -> ShowS
RegisterEventTopic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterEventTopic] -> ShowS
$cshowList :: [RegisterEventTopic] -> ShowS
show :: RegisterEventTopic -> String
$cshow :: RegisterEventTopic -> String
showsPrec :: Int -> RegisterEventTopic -> ShowS
$cshowsPrec :: Int -> RegisterEventTopic -> ShowS
Prelude.Show, forall x. Rep RegisterEventTopic x -> RegisterEventTopic
forall x. RegisterEventTopic -> Rep RegisterEventTopic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterEventTopic x -> RegisterEventTopic
$cfrom :: forall x. RegisterEventTopic -> Rep RegisterEventTopic x
Prelude.Generic)

-- |
-- Create a value of 'RegisterEventTopic' 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:
--
-- 'directoryId', 'registerEventTopic_directoryId' - The Directory ID that will publish status messages to the Amazon SNS
-- topic.
--
-- 'topicName', 'registerEventTopic_topicName' - The Amazon SNS topic name to which the directory will publish status
-- messages. This Amazon SNS topic must be in the same region as the
-- specified Directory ID.
newRegisterEventTopic ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'topicName'
  Prelude.Text ->
  RegisterEventTopic
newRegisterEventTopic :: Text -> Text -> RegisterEventTopic
newRegisterEventTopic Text
pDirectoryId_ Text
pTopicName_ =
  RegisterEventTopic'
    { $sel:directoryId:RegisterEventTopic' :: Text
directoryId = Text
pDirectoryId_,
      $sel:topicName:RegisterEventTopic' :: Text
topicName = Text
pTopicName_
    }

-- | The Directory ID that will publish status messages to the Amazon SNS
-- topic.
registerEventTopic_directoryId :: Lens.Lens' RegisterEventTopic Prelude.Text
registerEventTopic_directoryId :: Lens' RegisterEventTopic Text
registerEventTopic_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterEventTopic' {Text
directoryId :: Text
$sel:directoryId:RegisterEventTopic' :: RegisterEventTopic -> Text
directoryId} -> Text
directoryId) (\s :: RegisterEventTopic
s@RegisterEventTopic' {} Text
a -> RegisterEventTopic
s {$sel:directoryId:RegisterEventTopic' :: Text
directoryId = Text
a} :: RegisterEventTopic)

-- | The Amazon SNS topic name to which the directory will publish status
-- messages. This Amazon SNS topic must be in the same region as the
-- specified Directory ID.
registerEventTopic_topicName :: Lens.Lens' RegisterEventTopic Prelude.Text
registerEventTopic_topicName :: Lens' RegisterEventTopic Text
registerEventTopic_topicName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterEventTopic' {Text
topicName :: Text
$sel:topicName:RegisterEventTopic' :: RegisterEventTopic -> Text
topicName} -> Text
topicName) (\s :: RegisterEventTopic
s@RegisterEventTopic' {} Text
a -> RegisterEventTopic
s {$sel:topicName:RegisterEventTopic' :: Text
topicName = Text
a} :: RegisterEventTopic)

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

instance Prelude.NFData RegisterEventTopic where
  rnf :: RegisterEventTopic -> ()
rnf RegisterEventTopic' {Text
topicName :: Text
directoryId :: Text
$sel:topicName:RegisterEventTopic' :: RegisterEventTopic -> Text
$sel:directoryId:RegisterEventTopic' :: RegisterEventTopic -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
topicName

instance Data.ToHeaders RegisterEventTopic where
  toHeaders :: RegisterEventTopic -> 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
"DirectoryService_20150416.RegisterEventTopic" ::
                          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 RegisterEventTopic where
  toJSON :: RegisterEventTopic -> Value
toJSON RegisterEventTopic' {Text
topicName :: Text
directoryId :: Text
$sel:topicName:RegisterEventTopic' :: RegisterEventTopic -> Text
$sel:directoryId:RegisterEventTopic' :: RegisterEventTopic -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId),
            forall a. a -> Maybe a
Prelude.Just (Key
"TopicName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
topicName)
          ]
      )

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

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

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

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

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

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