{-# 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.UpdateTopicRuleDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a topic rule destination. You use this to change the status,
-- endpoint URL, or confirmation URL of the destination.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions UpdateTopicRuleDestination>
-- action.
module Amazonka.IoT.UpdateTopicRuleDestination
  ( -- * Creating a Request
    UpdateTopicRuleDestination (..),
    newUpdateTopicRuleDestination,

    -- * Request Lenses
    updateTopicRuleDestination_arn,
    updateTopicRuleDestination_status,

    -- * Destructuring the Response
    UpdateTopicRuleDestinationResponse (..),
    newUpdateTopicRuleDestinationResponse,

    -- * Response Lenses
    updateTopicRuleDestinationResponse_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:/ 'newUpdateTopicRuleDestination' smart constructor.
data UpdateTopicRuleDestination = UpdateTopicRuleDestination'
  { -- | The ARN of the topic rule destination.
    UpdateTopicRuleDestination -> Text
arn :: Prelude.Text,
    -- | The status of the topic rule destination. Valid values are:
    --
    -- [IN_PROGRESS]
    --     A topic rule destination was created but has not been confirmed. You
    --     can set @status@ to @IN_PROGRESS@ by calling
    --     @UpdateTopicRuleDestination@. Calling @UpdateTopicRuleDestination@
    --     causes a new confirmation challenge to be sent to your confirmation
    --     endpoint.
    --
    -- [ENABLED]
    --     Confirmation was completed, and traffic to this destination is
    --     allowed. You can set @status@ to @DISABLED@ by calling
    --     @UpdateTopicRuleDestination@.
    --
    -- [DISABLED]
    --     Confirmation was completed, and traffic to this destination is not
    --     allowed. You can set @status@ to @ENABLED@ by calling
    --     @UpdateTopicRuleDestination@.
    --
    -- [ERROR]
    --     Confirmation could not be completed, for example if the confirmation
    --     timed out. You can call @GetTopicRuleDestination@ for details about
    --     the error. You can set @status@ to @IN_PROGRESS@ by calling
    --     @UpdateTopicRuleDestination@. Calling @UpdateTopicRuleDestination@
    --     causes a new confirmation challenge to be sent to your confirmation
    --     endpoint.
    UpdateTopicRuleDestination -> TopicRuleDestinationStatus
status :: TopicRuleDestinationStatus
  }
  deriving (UpdateTopicRuleDestination -> UpdateTopicRuleDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTopicRuleDestination -> UpdateTopicRuleDestination -> Bool
$c/= :: UpdateTopicRuleDestination -> UpdateTopicRuleDestination -> Bool
== :: UpdateTopicRuleDestination -> UpdateTopicRuleDestination -> Bool
$c== :: UpdateTopicRuleDestination -> UpdateTopicRuleDestination -> Bool
Prelude.Eq, ReadPrec [UpdateTopicRuleDestination]
ReadPrec UpdateTopicRuleDestination
Int -> ReadS UpdateTopicRuleDestination
ReadS [UpdateTopicRuleDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTopicRuleDestination]
$creadListPrec :: ReadPrec [UpdateTopicRuleDestination]
readPrec :: ReadPrec UpdateTopicRuleDestination
$creadPrec :: ReadPrec UpdateTopicRuleDestination
readList :: ReadS [UpdateTopicRuleDestination]
$creadList :: ReadS [UpdateTopicRuleDestination]
readsPrec :: Int -> ReadS UpdateTopicRuleDestination
$creadsPrec :: Int -> ReadS UpdateTopicRuleDestination
Prelude.Read, Int -> UpdateTopicRuleDestination -> ShowS
[UpdateTopicRuleDestination] -> ShowS
UpdateTopicRuleDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTopicRuleDestination] -> ShowS
$cshowList :: [UpdateTopicRuleDestination] -> ShowS
show :: UpdateTopicRuleDestination -> String
$cshow :: UpdateTopicRuleDestination -> String
showsPrec :: Int -> UpdateTopicRuleDestination -> ShowS
$cshowsPrec :: Int -> UpdateTopicRuleDestination -> ShowS
Prelude.Show, forall x.
Rep UpdateTopicRuleDestination x -> UpdateTopicRuleDestination
forall x.
UpdateTopicRuleDestination -> Rep UpdateTopicRuleDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateTopicRuleDestination x -> UpdateTopicRuleDestination
$cfrom :: forall x.
UpdateTopicRuleDestination -> Rep UpdateTopicRuleDestination x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTopicRuleDestination' 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', 'updateTopicRuleDestination_arn' - The ARN of the topic rule destination.
--
-- 'status', 'updateTopicRuleDestination_status' - The status of the topic rule destination. Valid values are:
--
-- [IN_PROGRESS]
--     A topic rule destination was created but has not been confirmed. You
--     can set @status@ to @IN_PROGRESS@ by calling
--     @UpdateTopicRuleDestination@. Calling @UpdateTopicRuleDestination@
--     causes a new confirmation challenge to be sent to your confirmation
--     endpoint.
--
-- [ENABLED]
--     Confirmation was completed, and traffic to this destination is
--     allowed. You can set @status@ to @DISABLED@ by calling
--     @UpdateTopicRuleDestination@.
--
-- [DISABLED]
--     Confirmation was completed, and traffic to this destination is not
--     allowed. You can set @status@ to @ENABLED@ by calling
--     @UpdateTopicRuleDestination@.
--
-- [ERROR]
--     Confirmation could not be completed, for example if the confirmation
--     timed out. You can call @GetTopicRuleDestination@ for details about
--     the error. You can set @status@ to @IN_PROGRESS@ by calling
--     @UpdateTopicRuleDestination@. Calling @UpdateTopicRuleDestination@
--     causes a new confirmation challenge to be sent to your confirmation
--     endpoint.
newUpdateTopicRuleDestination ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'status'
  TopicRuleDestinationStatus ->
  UpdateTopicRuleDestination
newUpdateTopicRuleDestination :: Text -> TopicRuleDestinationStatus -> UpdateTopicRuleDestination
newUpdateTopicRuleDestination Text
pArn_ TopicRuleDestinationStatus
pStatus_ =
  UpdateTopicRuleDestination'
    { $sel:arn:UpdateTopicRuleDestination' :: Text
arn = Text
pArn_,
      $sel:status:UpdateTopicRuleDestination' :: TopicRuleDestinationStatus
status = TopicRuleDestinationStatus
pStatus_
    }

-- | The ARN of the topic rule destination.
updateTopicRuleDestination_arn :: Lens.Lens' UpdateTopicRuleDestination Prelude.Text
updateTopicRuleDestination_arn :: Lens' UpdateTopicRuleDestination Text
updateTopicRuleDestination_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTopicRuleDestination' {Text
arn :: Text
$sel:arn:UpdateTopicRuleDestination' :: UpdateTopicRuleDestination -> Text
arn} -> Text
arn) (\s :: UpdateTopicRuleDestination
s@UpdateTopicRuleDestination' {} Text
a -> UpdateTopicRuleDestination
s {$sel:arn:UpdateTopicRuleDestination' :: Text
arn = Text
a} :: UpdateTopicRuleDestination)

-- | The status of the topic rule destination. Valid values are:
--
-- [IN_PROGRESS]
--     A topic rule destination was created but has not been confirmed. You
--     can set @status@ to @IN_PROGRESS@ by calling
--     @UpdateTopicRuleDestination@. Calling @UpdateTopicRuleDestination@
--     causes a new confirmation challenge to be sent to your confirmation
--     endpoint.
--
-- [ENABLED]
--     Confirmation was completed, and traffic to this destination is
--     allowed. You can set @status@ to @DISABLED@ by calling
--     @UpdateTopicRuleDestination@.
--
-- [DISABLED]
--     Confirmation was completed, and traffic to this destination is not
--     allowed. You can set @status@ to @ENABLED@ by calling
--     @UpdateTopicRuleDestination@.
--
-- [ERROR]
--     Confirmation could not be completed, for example if the confirmation
--     timed out. You can call @GetTopicRuleDestination@ for details about
--     the error. You can set @status@ to @IN_PROGRESS@ by calling
--     @UpdateTopicRuleDestination@. Calling @UpdateTopicRuleDestination@
--     causes a new confirmation challenge to be sent to your confirmation
--     endpoint.
updateTopicRuleDestination_status :: Lens.Lens' UpdateTopicRuleDestination TopicRuleDestinationStatus
updateTopicRuleDestination_status :: Lens' UpdateTopicRuleDestination TopicRuleDestinationStatus
updateTopicRuleDestination_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTopicRuleDestination' {TopicRuleDestinationStatus
status :: TopicRuleDestinationStatus
$sel:status:UpdateTopicRuleDestination' :: UpdateTopicRuleDestination -> TopicRuleDestinationStatus
status} -> TopicRuleDestinationStatus
status) (\s :: UpdateTopicRuleDestination
s@UpdateTopicRuleDestination' {} TopicRuleDestinationStatus
a -> UpdateTopicRuleDestination
s {$sel:status:UpdateTopicRuleDestination' :: TopicRuleDestinationStatus
status = TopicRuleDestinationStatus
a} :: UpdateTopicRuleDestination)

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

instance Prelude.NFData UpdateTopicRuleDestination where
  rnf :: UpdateTopicRuleDestination -> ()
rnf UpdateTopicRuleDestination' {Text
TopicRuleDestinationStatus
status :: TopicRuleDestinationStatus
arn :: Text
$sel:status:UpdateTopicRuleDestination' :: UpdateTopicRuleDestination -> TopicRuleDestinationStatus
$sel:arn:UpdateTopicRuleDestination' :: UpdateTopicRuleDestination -> 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 TopicRuleDestinationStatus
status

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

instance Data.ToJSON UpdateTopicRuleDestination where
  toJSON :: UpdateTopicRuleDestination -> Value
toJSON UpdateTopicRuleDestination' {Text
TopicRuleDestinationStatus
status :: TopicRuleDestinationStatus
arn :: Text
$sel:status:UpdateTopicRuleDestination' :: UpdateTopicRuleDestination -> TopicRuleDestinationStatus
$sel:arn:UpdateTopicRuleDestination' :: UpdateTopicRuleDestination -> 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
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TopicRuleDestinationStatus
status)
          ]
      )

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

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

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

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

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

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