{-# 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.SNS.ConfirmSubscription
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Verifies an endpoint owner\'s intent to receive messages by validating
-- the token sent to the endpoint by an earlier @Subscribe@ action. If the
-- token is valid, the action creates a new subscription and returns its
-- Amazon Resource Name (ARN). This call requires an AWS signature only
-- when the @AuthenticateOnUnsubscribe@ flag is set to \"true\".
module Amazonka.SNS.ConfirmSubscription
  ( -- * Creating a Request
    ConfirmSubscription (..),
    newConfirmSubscription,

    -- * Request Lenses
    confirmSubscription_authenticateOnUnsubscribe,
    confirmSubscription_topicArn,
    confirmSubscription_token,

    -- * Destructuring the Response
    ConfirmSubscriptionResponse (..),
    newConfirmSubscriptionResponse,

    -- * Response Lenses
    confirmSubscriptionResponse_subscriptionArn,
    confirmSubscriptionResponse_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.SNS.Types

-- | Input for ConfirmSubscription action.
--
-- /See:/ 'newConfirmSubscription' smart constructor.
data ConfirmSubscription = ConfirmSubscription'
  { -- | Disallows unauthenticated unsubscribes of the subscription. If the value
    -- of this parameter is @true@ and the request has an Amazon Web Services
    -- signature, then only the topic owner and the subscription owner can
    -- unsubscribe the endpoint. The unsubscribe action requires Amazon Web
    -- Services authentication.
    ConfirmSubscription -> Maybe Text
authenticateOnUnsubscribe :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the topic for which you wish to confirm a subscription.
    ConfirmSubscription -> Text
topicArn :: Prelude.Text,
    -- | Short-lived token sent to an endpoint during the @Subscribe@ action.
    ConfirmSubscription -> Text
token :: Prelude.Text
  }
  deriving (ConfirmSubscription -> ConfirmSubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmSubscription -> ConfirmSubscription -> Bool
$c/= :: ConfirmSubscription -> ConfirmSubscription -> Bool
== :: ConfirmSubscription -> ConfirmSubscription -> Bool
$c== :: ConfirmSubscription -> ConfirmSubscription -> Bool
Prelude.Eq, ReadPrec [ConfirmSubscription]
ReadPrec ConfirmSubscription
Int -> ReadS ConfirmSubscription
ReadS [ConfirmSubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfirmSubscription]
$creadListPrec :: ReadPrec [ConfirmSubscription]
readPrec :: ReadPrec ConfirmSubscription
$creadPrec :: ReadPrec ConfirmSubscription
readList :: ReadS [ConfirmSubscription]
$creadList :: ReadS [ConfirmSubscription]
readsPrec :: Int -> ReadS ConfirmSubscription
$creadsPrec :: Int -> ReadS ConfirmSubscription
Prelude.Read, Int -> ConfirmSubscription -> ShowS
[ConfirmSubscription] -> ShowS
ConfirmSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmSubscription] -> ShowS
$cshowList :: [ConfirmSubscription] -> ShowS
show :: ConfirmSubscription -> String
$cshow :: ConfirmSubscription -> String
showsPrec :: Int -> ConfirmSubscription -> ShowS
$cshowsPrec :: Int -> ConfirmSubscription -> ShowS
Prelude.Show, forall x. Rep ConfirmSubscription x -> ConfirmSubscription
forall x. ConfirmSubscription -> Rep ConfirmSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfirmSubscription x -> ConfirmSubscription
$cfrom :: forall x. ConfirmSubscription -> Rep ConfirmSubscription x
Prelude.Generic)

-- |
-- Create a value of 'ConfirmSubscription' 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:
--
-- 'authenticateOnUnsubscribe', 'confirmSubscription_authenticateOnUnsubscribe' - Disallows unauthenticated unsubscribes of the subscription. If the value
-- of this parameter is @true@ and the request has an Amazon Web Services
-- signature, then only the topic owner and the subscription owner can
-- unsubscribe the endpoint. The unsubscribe action requires Amazon Web
-- Services authentication.
--
-- 'topicArn', 'confirmSubscription_topicArn' - The ARN of the topic for which you wish to confirm a subscription.
--
-- 'token', 'confirmSubscription_token' - Short-lived token sent to an endpoint during the @Subscribe@ action.
newConfirmSubscription ::
  -- | 'topicArn'
  Prelude.Text ->
  -- | 'token'
  Prelude.Text ->
  ConfirmSubscription
newConfirmSubscription :: Text -> Text -> ConfirmSubscription
newConfirmSubscription Text
pTopicArn_ Text
pToken_ =
  ConfirmSubscription'
    { $sel:authenticateOnUnsubscribe:ConfirmSubscription' :: Maybe Text
authenticateOnUnsubscribe =
        forall a. Maybe a
Prelude.Nothing,
      $sel:topicArn:ConfirmSubscription' :: Text
topicArn = Text
pTopicArn_,
      $sel:token:ConfirmSubscription' :: Text
token = Text
pToken_
    }

-- | Disallows unauthenticated unsubscribes of the subscription. If the value
-- of this parameter is @true@ and the request has an Amazon Web Services
-- signature, then only the topic owner and the subscription owner can
-- unsubscribe the endpoint. The unsubscribe action requires Amazon Web
-- Services authentication.
confirmSubscription_authenticateOnUnsubscribe :: Lens.Lens' ConfirmSubscription (Prelude.Maybe Prelude.Text)
confirmSubscription_authenticateOnUnsubscribe :: Lens' ConfirmSubscription (Maybe Text)
confirmSubscription_authenticateOnUnsubscribe = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmSubscription' {Maybe Text
authenticateOnUnsubscribe :: Maybe Text
$sel:authenticateOnUnsubscribe:ConfirmSubscription' :: ConfirmSubscription -> Maybe Text
authenticateOnUnsubscribe} -> Maybe Text
authenticateOnUnsubscribe) (\s :: ConfirmSubscription
s@ConfirmSubscription' {} Maybe Text
a -> ConfirmSubscription
s {$sel:authenticateOnUnsubscribe:ConfirmSubscription' :: Maybe Text
authenticateOnUnsubscribe = Maybe Text
a} :: ConfirmSubscription)

-- | The ARN of the topic for which you wish to confirm a subscription.
confirmSubscription_topicArn :: Lens.Lens' ConfirmSubscription Prelude.Text
confirmSubscription_topicArn :: Lens' ConfirmSubscription Text
confirmSubscription_topicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmSubscription' {Text
topicArn :: Text
$sel:topicArn:ConfirmSubscription' :: ConfirmSubscription -> Text
topicArn} -> Text
topicArn) (\s :: ConfirmSubscription
s@ConfirmSubscription' {} Text
a -> ConfirmSubscription
s {$sel:topicArn:ConfirmSubscription' :: Text
topicArn = Text
a} :: ConfirmSubscription)

-- | Short-lived token sent to an endpoint during the @Subscribe@ action.
confirmSubscription_token :: Lens.Lens' ConfirmSubscription Prelude.Text
confirmSubscription_token :: Lens' ConfirmSubscription Text
confirmSubscription_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmSubscription' {Text
token :: Text
$sel:token:ConfirmSubscription' :: ConfirmSubscription -> Text
token} -> Text
token) (\s :: ConfirmSubscription
s@ConfirmSubscription' {} Text
a -> ConfirmSubscription
s {$sel:token:ConfirmSubscription' :: Text
token = Text
a} :: ConfirmSubscription)

instance Core.AWSRequest ConfirmSubscription where
  type
    AWSResponse ConfirmSubscription =
      ConfirmSubscriptionResponse
  request :: (Service -> Service)
-> ConfirmSubscription -> Request ConfirmSubscription
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ConfirmSubscription
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ConfirmSubscription)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ConfirmSubscriptionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> ConfirmSubscriptionResponse
ConfirmSubscriptionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SubscriptionArn")
            forall (f :: * -> *) a b. Applicative f => 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 ConfirmSubscription where
  hashWithSalt :: Int -> ConfirmSubscription -> Int
hashWithSalt Int
_salt ConfirmSubscription' {Maybe Text
Text
token :: Text
topicArn :: Text
authenticateOnUnsubscribe :: Maybe Text
$sel:token:ConfirmSubscription' :: ConfirmSubscription -> Text
$sel:topicArn:ConfirmSubscription' :: ConfirmSubscription -> Text
$sel:authenticateOnUnsubscribe:ConfirmSubscription' :: ConfirmSubscription -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
authenticateOnUnsubscribe
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
topicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
token

instance Prelude.NFData ConfirmSubscription where
  rnf :: ConfirmSubscription -> ()
rnf ConfirmSubscription' {Maybe Text
Text
token :: Text
topicArn :: Text
authenticateOnUnsubscribe :: Maybe Text
$sel:token:ConfirmSubscription' :: ConfirmSubscription -> Text
$sel:topicArn:ConfirmSubscription' :: ConfirmSubscription -> Text
$sel:authenticateOnUnsubscribe:ConfirmSubscription' :: ConfirmSubscription -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
authenticateOnUnsubscribe
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
topicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
token

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

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

instance Data.ToQuery ConfirmSubscription where
  toQuery :: ConfirmSubscription -> QueryString
toQuery ConfirmSubscription' {Maybe Text
Text
token :: Text
topicArn :: Text
authenticateOnUnsubscribe :: Maybe Text
$sel:token:ConfirmSubscription' :: ConfirmSubscription -> Text
$sel:topicArn:ConfirmSubscription' :: ConfirmSubscription -> Text
$sel:authenticateOnUnsubscribe:ConfirmSubscription' :: ConfirmSubscription -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ConfirmSubscription" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-03-31" :: Prelude.ByteString),
        ByteString
"AuthenticateOnUnsubscribe"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
authenticateOnUnsubscribe,
        ByteString
"TopicArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
topicArn,
        ByteString
"Token" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
token
      ]

-- | Response for ConfirmSubscriptions action.
--
-- /See:/ 'newConfirmSubscriptionResponse' smart constructor.
data ConfirmSubscriptionResponse = ConfirmSubscriptionResponse'
  { -- | The ARN of the created subscription.
    ConfirmSubscriptionResponse -> Maybe Text
subscriptionArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ConfirmSubscriptionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ConfirmSubscriptionResponse -> ConfirmSubscriptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmSubscriptionResponse -> ConfirmSubscriptionResponse -> Bool
$c/= :: ConfirmSubscriptionResponse -> ConfirmSubscriptionResponse -> Bool
== :: ConfirmSubscriptionResponse -> ConfirmSubscriptionResponse -> Bool
$c== :: ConfirmSubscriptionResponse -> ConfirmSubscriptionResponse -> Bool
Prelude.Eq, ReadPrec [ConfirmSubscriptionResponse]
ReadPrec ConfirmSubscriptionResponse
Int -> ReadS ConfirmSubscriptionResponse
ReadS [ConfirmSubscriptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfirmSubscriptionResponse]
$creadListPrec :: ReadPrec [ConfirmSubscriptionResponse]
readPrec :: ReadPrec ConfirmSubscriptionResponse
$creadPrec :: ReadPrec ConfirmSubscriptionResponse
readList :: ReadS [ConfirmSubscriptionResponse]
$creadList :: ReadS [ConfirmSubscriptionResponse]
readsPrec :: Int -> ReadS ConfirmSubscriptionResponse
$creadsPrec :: Int -> ReadS ConfirmSubscriptionResponse
Prelude.Read, Int -> ConfirmSubscriptionResponse -> ShowS
[ConfirmSubscriptionResponse] -> ShowS
ConfirmSubscriptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmSubscriptionResponse] -> ShowS
$cshowList :: [ConfirmSubscriptionResponse] -> ShowS
show :: ConfirmSubscriptionResponse -> String
$cshow :: ConfirmSubscriptionResponse -> String
showsPrec :: Int -> ConfirmSubscriptionResponse -> ShowS
$cshowsPrec :: Int -> ConfirmSubscriptionResponse -> ShowS
Prelude.Show, forall x.
Rep ConfirmSubscriptionResponse x -> ConfirmSubscriptionResponse
forall x.
ConfirmSubscriptionResponse -> Rep ConfirmSubscriptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ConfirmSubscriptionResponse x -> ConfirmSubscriptionResponse
$cfrom :: forall x.
ConfirmSubscriptionResponse -> Rep ConfirmSubscriptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'ConfirmSubscriptionResponse' 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:
--
-- 'subscriptionArn', 'confirmSubscriptionResponse_subscriptionArn' - The ARN of the created subscription.
--
-- 'httpStatus', 'confirmSubscriptionResponse_httpStatus' - The response's http status code.
newConfirmSubscriptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ConfirmSubscriptionResponse
newConfirmSubscriptionResponse :: Int -> ConfirmSubscriptionResponse
newConfirmSubscriptionResponse Int
pHttpStatus_ =
  ConfirmSubscriptionResponse'
    { $sel:subscriptionArn:ConfirmSubscriptionResponse' :: Maybe Text
subscriptionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ConfirmSubscriptionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the created subscription.
confirmSubscriptionResponse_subscriptionArn :: Lens.Lens' ConfirmSubscriptionResponse (Prelude.Maybe Prelude.Text)
confirmSubscriptionResponse_subscriptionArn :: Lens' ConfirmSubscriptionResponse (Maybe Text)
confirmSubscriptionResponse_subscriptionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmSubscriptionResponse' {Maybe Text
subscriptionArn :: Maybe Text
$sel:subscriptionArn:ConfirmSubscriptionResponse' :: ConfirmSubscriptionResponse -> Maybe Text
subscriptionArn} -> Maybe Text
subscriptionArn) (\s :: ConfirmSubscriptionResponse
s@ConfirmSubscriptionResponse' {} Maybe Text
a -> ConfirmSubscriptionResponse
s {$sel:subscriptionArn:ConfirmSubscriptionResponse' :: Maybe Text
subscriptionArn = Maybe Text
a} :: ConfirmSubscriptionResponse)

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

instance Prelude.NFData ConfirmSubscriptionResponse where
  rnf :: ConfirmSubscriptionResponse -> ()
rnf ConfirmSubscriptionResponse' {Int
Maybe Text
httpStatus :: Int
subscriptionArn :: Maybe Text
$sel:httpStatus:ConfirmSubscriptionResponse' :: ConfirmSubscriptionResponse -> Int
$sel:subscriptionArn:ConfirmSubscriptionResponse' :: ConfirmSubscriptionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subscriptionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus