{-# 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.IoT.ConfirmTopicRuleDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Confirms a topic rule destination. When you create a rule requiring a
-- destination, IoT sends a confirmation message to the endpoint or base
-- address you specify. The message includes a token which you pass back
-- when calling @ConfirmTopicRuleDestination@ to confirm that you own or
-- have access to the endpoint.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions ConfirmTopicRuleDestination>
-- action.
module Amazonka.IoT.ConfirmTopicRuleDestination
  ( -- * Creating a Request
    ConfirmTopicRuleDestination (..),
    newConfirmTopicRuleDestination,

    -- * Request Lenses
    confirmTopicRuleDestination_confirmationToken,

    -- * Destructuring the Response
    ConfirmTopicRuleDestinationResponse (..),
    newConfirmTopicRuleDestinationResponse,

    -- * Response Lenses
    confirmTopicRuleDestinationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newConfirmTopicRuleDestination' smart constructor.
data ConfirmTopicRuleDestination = ConfirmTopicRuleDestination'
  { -- | The token used to confirm ownership or access to the topic rule
    -- confirmation URL.
    ConfirmTopicRuleDestination -> Text
confirmationToken :: Prelude.Text
  }
  deriving (ConfirmTopicRuleDestination -> ConfirmTopicRuleDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmTopicRuleDestination -> ConfirmTopicRuleDestination -> Bool
$c/= :: ConfirmTopicRuleDestination -> ConfirmTopicRuleDestination -> Bool
== :: ConfirmTopicRuleDestination -> ConfirmTopicRuleDestination -> Bool
$c== :: ConfirmTopicRuleDestination -> ConfirmTopicRuleDestination -> Bool
Prelude.Eq, ReadPrec [ConfirmTopicRuleDestination]
ReadPrec ConfirmTopicRuleDestination
Int -> ReadS ConfirmTopicRuleDestination
ReadS [ConfirmTopicRuleDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfirmTopicRuleDestination]
$creadListPrec :: ReadPrec [ConfirmTopicRuleDestination]
readPrec :: ReadPrec ConfirmTopicRuleDestination
$creadPrec :: ReadPrec ConfirmTopicRuleDestination
readList :: ReadS [ConfirmTopicRuleDestination]
$creadList :: ReadS [ConfirmTopicRuleDestination]
readsPrec :: Int -> ReadS ConfirmTopicRuleDestination
$creadsPrec :: Int -> ReadS ConfirmTopicRuleDestination
Prelude.Read, Int -> ConfirmTopicRuleDestination -> ShowS
[ConfirmTopicRuleDestination] -> ShowS
ConfirmTopicRuleDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmTopicRuleDestination] -> ShowS
$cshowList :: [ConfirmTopicRuleDestination] -> ShowS
show :: ConfirmTopicRuleDestination -> String
$cshow :: ConfirmTopicRuleDestination -> String
showsPrec :: Int -> ConfirmTopicRuleDestination -> ShowS
$cshowsPrec :: Int -> ConfirmTopicRuleDestination -> ShowS
Prelude.Show, forall x.
Rep ConfirmTopicRuleDestination x -> ConfirmTopicRuleDestination
forall x.
ConfirmTopicRuleDestination -> Rep ConfirmTopicRuleDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ConfirmTopicRuleDestination x -> ConfirmTopicRuleDestination
$cfrom :: forall x.
ConfirmTopicRuleDestination -> Rep ConfirmTopicRuleDestination x
Prelude.Generic)

-- |
-- Create a value of 'ConfirmTopicRuleDestination' 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:
--
-- 'confirmationToken', 'confirmTopicRuleDestination_confirmationToken' - The token used to confirm ownership or access to the topic rule
-- confirmation URL.
newConfirmTopicRuleDestination ::
  -- | 'confirmationToken'
  Prelude.Text ->
  ConfirmTopicRuleDestination
newConfirmTopicRuleDestination :: Text -> ConfirmTopicRuleDestination
newConfirmTopicRuleDestination Text
pConfirmationToken_ =
  ConfirmTopicRuleDestination'
    { $sel:confirmationToken:ConfirmTopicRuleDestination' :: Text
confirmationToken =
        Text
pConfirmationToken_
    }

-- | The token used to confirm ownership or access to the topic rule
-- confirmation URL.
confirmTopicRuleDestination_confirmationToken :: Lens.Lens' ConfirmTopicRuleDestination Prelude.Text
confirmTopicRuleDestination_confirmationToken :: Lens' ConfirmTopicRuleDestination Text
confirmTopicRuleDestination_confirmationToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmTopicRuleDestination' {Text
confirmationToken :: Text
$sel:confirmationToken:ConfirmTopicRuleDestination' :: ConfirmTopicRuleDestination -> Text
confirmationToken} -> Text
confirmationToken) (\s :: ConfirmTopicRuleDestination
s@ConfirmTopicRuleDestination' {} Text
a -> ConfirmTopicRuleDestination
s {$sel:confirmationToken:ConfirmTopicRuleDestination' :: Text
confirmationToken = Text
a} :: ConfirmTopicRuleDestination)

instance Core.AWSRequest ConfirmTopicRuleDestination where
  type
    AWSResponse ConfirmTopicRuleDestination =
      ConfirmTopicRuleDestinationResponse
  request :: (Service -> Service)
-> ConfirmTopicRuleDestination
-> Request ConfirmTopicRuleDestination
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ConfirmTopicRuleDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ConfirmTopicRuleDestination)))
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 -> ConfirmTopicRuleDestinationResponse
ConfirmTopicRuleDestinationResponse'
            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 ConfirmTopicRuleDestination where
  hashWithSalt :: Int -> ConfirmTopicRuleDestination -> Int
hashWithSalt Int
_salt ConfirmTopicRuleDestination' {Text
confirmationToken :: Text
$sel:confirmationToken:ConfirmTopicRuleDestination' :: ConfirmTopicRuleDestination -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
confirmationToken

instance Prelude.NFData ConfirmTopicRuleDestination where
  rnf :: ConfirmTopicRuleDestination -> ()
rnf ConfirmTopicRuleDestination' {Text
confirmationToken :: Text
$sel:confirmationToken:ConfirmTopicRuleDestination' :: ConfirmTopicRuleDestination -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
confirmationToken

instance Data.ToHeaders ConfirmTopicRuleDestination where
  toHeaders :: ConfirmTopicRuleDestination -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath ConfirmTopicRuleDestination where
  toPath :: ConfirmTopicRuleDestination -> ByteString
toPath ConfirmTopicRuleDestination' {Text
confirmationToken :: Text
$sel:confirmationToken:ConfirmTopicRuleDestination' :: ConfirmTopicRuleDestination -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/confirmdestination/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
confirmationToken]

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

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

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

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

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