{-# 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.CodeStarNotifications.Unsubscribe
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes an association between a notification rule and an Chatbot topic
-- so that subscribers to that topic stop receiving notifications when the
-- events described in the rule are triggered.
module Amazonka.CodeStarNotifications.Unsubscribe
  ( -- * Creating a Request
    Unsubscribe (..),
    newUnsubscribe,

    -- * Request Lenses
    unsubscribe_arn,
    unsubscribe_targetAddress,

    -- * Destructuring the Response
    UnsubscribeResponse (..),
    newUnsubscribeResponse,

    -- * Response Lenses
    unsubscribeResponse_httpStatus,
    unsubscribeResponse_arn,
  )
where

import Amazonka.CodeStarNotifications.Types
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

-- | /See:/ 'newUnsubscribe' smart constructor.
data Unsubscribe = Unsubscribe'
  { -- | The Amazon Resource Name (ARN) of the notification rule.
    Unsubscribe -> Text
arn :: Prelude.Text,
    -- | The ARN of the Chatbot topic to unsubscribe from the notification rule.
    Unsubscribe -> Sensitive Text
targetAddress :: Data.Sensitive Prelude.Text
  }
  deriving (Unsubscribe -> Unsubscribe -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unsubscribe -> Unsubscribe -> Bool
$c/= :: Unsubscribe -> Unsubscribe -> Bool
== :: Unsubscribe -> Unsubscribe -> Bool
$c== :: Unsubscribe -> Unsubscribe -> Bool
Prelude.Eq, Int -> Unsubscribe -> ShowS
[Unsubscribe] -> ShowS
Unsubscribe -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unsubscribe] -> ShowS
$cshowList :: [Unsubscribe] -> ShowS
show :: Unsubscribe -> String
$cshow :: Unsubscribe -> String
showsPrec :: Int -> Unsubscribe -> ShowS
$cshowsPrec :: Int -> Unsubscribe -> ShowS
Prelude.Show, forall x. Rep Unsubscribe x -> Unsubscribe
forall x. Unsubscribe -> Rep Unsubscribe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Unsubscribe x -> Unsubscribe
$cfrom :: forall x. Unsubscribe -> Rep Unsubscribe x
Prelude.Generic)

-- |
-- Create a value of 'Unsubscribe' 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:
--
-- 'arn', 'unsubscribe_arn' - The Amazon Resource Name (ARN) of the notification rule.
--
-- 'targetAddress', 'unsubscribe_targetAddress' - The ARN of the Chatbot topic to unsubscribe from the notification rule.
newUnsubscribe ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'targetAddress'
  Prelude.Text ->
  Unsubscribe
newUnsubscribe :: Text -> Text -> Unsubscribe
newUnsubscribe Text
pArn_ Text
pTargetAddress_ =
  Unsubscribe'
    { $sel:arn:Unsubscribe' :: Text
arn = Text
pArn_,
      $sel:targetAddress:Unsubscribe' :: Sensitive Text
targetAddress =
        forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pTargetAddress_
    }

-- | The Amazon Resource Name (ARN) of the notification rule.
unsubscribe_arn :: Lens.Lens' Unsubscribe Prelude.Text
unsubscribe_arn :: Lens' Unsubscribe Text
unsubscribe_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Unsubscribe' {Text
arn :: Text
$sel:arn:Unsubscribe' :: Unsubscribe -> Text
arn} -> Text
arn) (\s :: Unsubscribe
s@Unsubscribe' {} Text
a -> Unsubscribe
s {$sel:arn:Unsubscribe' :: Text
arn = Text
a} :: Unsubscribe)

-- | The ARN of the Chatbot topic to unsubscribe from the notification rule.
unsubscribe_targetAddress :: Lens.Lens' Unsubscribe Prelude.Text
unsubscribe_targetAddress :: Lens' Unsubscribe Text
unsubscribe_targetAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Unsubscribe' {Sensitive Text
targetAddress :: Sensitive Text
$sel:targetAddress:Unsubscribe' :: Unsubscribe -> Sensitive Text
targetAddress} -> Sensitive Text
targetAddress) (\s :: Unsubscribe
s@Unsubscribe' {} Sensitive Text
a -> Unsubscribe
s {$sel:targetAddress:Unsubscribe' :: Sensitive Text
targetAddress = Sensitive Text
a} :: Unsubscribe) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest Unsubscribe where
  type AWSResponse Unsubscribe = UnsubscribeResponse
  request :: (Service -> Service) -> Unsubscribe -> Request Unsubscribe
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 Unsubscribe
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Unsubscribe)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> UnsubscribeResponse
UnsubscribeResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Arn")
      )

instance Prelude.Hashable Unsubscribe where
  hashWithSalt :: Int -> Unsubscribe -> Int
hashWithSalt Int
_salt Unsubscribe' {Text
Sensitive Text
targetAddress :: Sensitive Text
arn :: Text
$sel:targetAddress:Unsubscribe' :: Unsubscribe -> Sensitive Text
$sel:arn:Unsubscribe' :: Unsubscribe -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
targetAddress

instance Prelude.NFData Unsubscribe where
  rnf :: Unsubscribe -> ()
rnf Unsubscribe' {Text
Sensitive Text
targetAddress :: Sensitive Text
arn :: Text
$sel:targetAddress:Unsubscribe' :: Unsubscribe -> Sensitive Text
$sel:arn:Unsubscribe' :: Unsubscribe -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
targetAddress

instance Data.ToHeaders Unsubscribe where
  toHeaders :: Unsubscribe -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON Unsubscribe where
  toJSON :: Unsubscribe -> Value
toJSON Unsubscribe' {Text
Sensitive Text
targetAddress :: Sensitive Text
arn :: Text
$sel:targetAddress:Unsubscribe' :: Unsubscribe -> Sensitive Text
$sel:arn:Unsubscribe' :: Unsubscribe -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"Arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TargetAddress" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
targetAddress)
          ]
      )

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

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

-- | /See:/ 'newUnsubscribeResponse' smart constructor.
data UnsubscribeResponse = UnsubscribeResponse'
  { -- | The response's http status code.
    UnsubscribeResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the the notification rule from which
    -- you have removed a subscription.
    UnsubscribeResponse -> Text
arn :: Prelude.Text
  }
  deriving (UnsubscribeResponse -> UnsubscribeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
$c/= :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
== :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
$c== :: UnsubscribeResponse -> UnsubscribeResponse -> Bool
Prelude.Eq, ReadPrec [UnsubscribeResponse]
ReadPrec UnsubscribeResponse
Int -> ReadS UnsubscribeResponse
ReadS [UnsubscribeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnsubscribeResponse]
$creadListPrec :: ReadPrec [UnsubscribeResponse]
readPrec :: ReadPrec UnsubscribeResponse
$creadPrec :: ReadPrec UnsubscribeResponse
readList :: ReadS [UnsubscribeResponse]
$creadList :: ReadS [UnsubscribeResponse]
readsPrec :: Int -> ReadS UnsubscribeResponse
$creadsPrec :: Int -> ReadS UnsubscribeResponse
Prelude.Read, Int -> UnsubscribeResponse -> ShowS
[UnsubscribeResponse] -> ShowS
UnsubscribeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnsubscribeResponse] -> ShowS
$cshowList :: [UnsubscribeResponse] -> ShowS
show :: UnsubscribeResponse -> String
$cshow :: UnsubscribeResponse -> String
showsPrec :: Int -> UnsubscribeResponse -> ShowS
$cshowsPrec :: Int -> UnsubscribeResponse -> ShowS
Prelude.Show, forall x. Rep UnsubscribeResponse x -> UnsubscribeResponse
forall x. UnsubscribeResponse -> Rep UnsubscribeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnsubscribeResponse x -> UnsubscribeResponse
$cfrom :: forall x. UnsubscribeResponse -> Rep UnsubscribeResponse x
Prelude.Generic)

-- |
-- Create a value of 'UnsubscribeResponse' 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', 'unsubscribeResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'unsubscribeResponse_arn' - The Amazon Resource Name (ARN) of the the notification rule from which
-- you have removed a subscription.
newUnsubscribeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  UnsubscribeResponse
newUnsubscribeResponse :: Int -> Text -> UnsubscribeResponse
newUnsubscribeResponse Int
pHttpStatus_ Text
pArn_ =
  UnsubscribeResponse'
    { $sel:httpStatus:UnsubscribeResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:arn:UnsubscribeResponse' :: Text
arn = Text
pArn_
    }

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

-- | The Amazon Resource Name (ARN) of the the notification rule from which
-- you have removed a subscription.
unsubscribeResponse_arn :: Lens.Lens' UnsubscribeResponse Prelude.Text
unsubscribeResponse_arn :: Lens' UnsubscribeResponse Text
unsubscribeResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnsubscribeResponse' {Text
arn :: Text
$sel:arn:UnsubscribeResponse' :: UnsubscribeResponse -> Text
arn} -> Text
arn) (\s :: UnsubscribeResponse
s@UnsubscribeResponse' {} Text
a -> UnsubscribeResponse
s {$sel:arn:UnsubscribeResponse' :: Text
arn = Text
a} :: UnsubscribeResponse)

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