{-# 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.IoTWireless.UpdateDestination
-- 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 properties of a destination.
module Amazonka.IoTWireless.UpdateDestination
  ( -- * Creating a Request
    UpdateDestination (..),
    newUpdateDestination,

    -- * Request Lenses
    updateDestination_description,
    updateDestination_expression,
    updateDestination_expressionType,
    updateDestination_roleArn,
    updateDestination_name,

    -- * Destructuring the Response
    UpdateDestinationResponse (..),
    newUpdateDestinationResponse,

    -- * Response Lenses
    updateDestinationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateDestination' smart constructor.
data UpdateDestination = UpdateDestination'
  { -- | A new description of the resource.
    UpdateDestination -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The new rule name or topic rule to send messages to.
    UpdateDestination -> Maybe Text
expression :: Prelude.Maybe Prelude.Text,
    -- | The type of value in @Expression@.
    UpdateDestination -> Maybe ExpressionType
expressionType :: Prelude.Maybe ExpressionType,
    -- | The ARN of the IAM Role that authorizes the destination.
    UpdateDestination -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The new name of the resource.
    UpdateDestination -> Text
name :: Prelude.Text
  }
  deriving (UpdateDestination -> UpdateDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDestination -> UpdateDestination -> Bool
$c/= :: UpdateDestination -> UpdateDestination -> Bool
== :: UpdateDestination -> UpdateDestination -> Bool
$c== :: UpdateDestination -> UpdateDestination -> Bool
Prelude.Eq, ReadPrec [UpdateDestination]
ReadPrec UpdateDestination
Int -> ReadS UpdateDestination
ReadS [UpdateDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDestination]
$creadListPrec :: ReadPrec [UpdateDestination]
readPrec :: ReadPrec UpdateDestination
$creadPrec :: ReadPrec UpdateDestination
readList :: ReadS [UpdateDestination]
$creadList :: ReadS [UpdateDestination]
readsPrec :: Int -> ReadS UpdateDestination
$creadsPrec :: Int -> ReadS UpdateDestination
Prelude.Read, Int -> UpdateDestination -> ShowS
[UpdateDestination] -> ShowS
UpdateDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDestination] -> ShowS
$cshowList :: [UpdateDestination] -> ShowS
show :: UpdateDestination -> String
$cshow :: UpdateDestination -> String
showsPrec :: Int -> UpdateDestination -> ShowS
$cshowsPrec :: Int -> UpdateDestination -> ShowS
Prelude.Show, forall x. Rep UpdateDestination x -> UpdateDestination
forall x. UpdateDestination -> Rep UpdateDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDestination x -> UpdateDestination
$cfrom :: forall x. UpdateDestination -> Rep UpdateDestination x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDestination' 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:
--
-- 'description', 'updateDestination_description' - A new description of the resource.
--
-- 'expression', 'updateDestination_expression' - The new rule name or topic rule to send messages to.
--
-- 'expressionType', 'updateDestination_expressionType' - The type of value in @Expression@.
--
-- 'roleArn', 'updateDestination_roleArn' - The ARN of the IAM Role that authorizes the destination.
--
-- 'name', 'updateDestination_name' - The new name of the resource.
newUpdateDestination ::
  -- | 'name'
  Prelude.Text ->
  UpdateDestination
newUpdateDestination :: Text -> UpdateDestination
newUpdateDestination Text
pName_ =
  UpdateDestination'
    { $sel:description:UpdateDestination' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:expression:UpdateDestination' :: Maybe Text
expression = forall a. Maybe a
Prelude.Nothing,
      $sel:expressionType:UpdateDestination' :: Maybe ExpressionType
expressionType = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateDestination' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateDestination' :: Text
name = Text
pName_
    }

-- | A new description of the resource.
updateDestination_description :: Lens.Lens' UpdateDestination (Prelude.Maybe Prelude.Text)
updateDestination_description :: Lens' UpdateDestination (Maybe Text)
updateDestination_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe Text
description :: Maybe Text
$sel:description:UpdateDestination' :: UpdateDestination -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe Text
a -> UpdateDestination
s {$sel:description:UpdateDestination' :: Maybe Text
description = Maybe Text
a} :: UpdateDestination)

-- | The new rule name or topic rule to send messages to.
updateDestination_expression :: Lens.Lens' UpdateDestination (Prelude.Maybe Prelude.Text)
updateDestination_expression :: Lens' UpdateDestination (Maybe Text)
updateDestination_expression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe Text
expression :: Maybe Text
$sel:expression:UpdateDestination' :: UpdateDestination -> Maybe Text
expression} -> Maybe Text
expression) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe Text
a -> UpdateDestination
s {$sel:expression:UpdateDestination' :: Maybe Text
expression = Maybe Text
a} :: UpdateDestination)

-- | The type of value in @Expression@.
updateDestination_expressionType :: Lens.Lens' UpdateDestination (Prelude.Maybe ExpressionType)
updateDestination_expressionType :: Lens' UpdateDestination (Maybe ExpressionType)
updateDestination_expressionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe ExpressionType
expressionType :: Maybe ExpressionType
$sel:expressionType:UpdateDestination' :: UpdateDestination -> Maybe ExpressionType
expressionType} -> Maybe ExpressionType
expressionType) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe ExpressionType
a -> UpdateDestination
s {$sel:expressionType:UpdateDestination' :: Maybe ExpressionType
expressionType = Maybe ExpressionType
a} :: UpdateDestination)

-- | The ARN of the IAM Role that authorizes the destination.
updateDestination_roleArn :: Lens.Lens' UpdateDestination (Prelude.Maybe Prelude.Text)
updateDestination_roleArn :: Lens' UpdateDestination (Maybe Text)
updateDestination_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateDestination' :: UpdateDestination -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateDestination
s@UpdateDestination' {} Maybe Text
a -> UpdateDestination
s {$sel:roleArn:UpdateDestination' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateDestination)

-- | The new name of the resource.
updateDestination_name :: Lens.Lens' UpdateDestination Prelude.Text
updateDestination_name :: Lens' UpdateDestination Text
updateDestination_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDestination' {Text
name :: Text
$sel:name:UpdateDestination' :: UpdateDestination -> Text
name} -> Text
name) (\s :: UpdateDestination
s@UpdateDestination' {} Text
a -> UpdateDestination
s {$sel:name:UpdateDestination' :: Text
name = Text
a} :: UpdateDestination)

instance Core.AWSRequest UpdateDestination where
  type
    AWSResponse UpdateDestination =
      UpdateDestinationResponse
  request :: (Service -> Service)
-> UpdateDestination -> Request UpdateDestination
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 UpdateDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDestination)))
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 -> UpdateDestinationResponse
UpdateDestinationResponse'
            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 UpdateDestination where
  hashWithSalt :: Int -> UpdateDestination -> Int
hashWithSalt Int
_salt UpdateDestination' {Maybe Text
Maybe ExpressionType
Text
name :: Text
roleArn :: Maybe Text
expressionType :: Maybe ExpressionType
expression :: Maybe Text
description :: Maybe Text
$sel:name:UpdateDestination' :: UpdateDestination -> Text
$sel:roleArn:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:expressionType:UpdateDestination' :: UpdateDestination -> Maybe ExpressionType
$sel:expression:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:description:UpdateDestination' :: UpdateDestination -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExpressionType
expressionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData UpdateDestination where
  rnf :: UpdateDestination -> ()
rnf UpdateDestination' {Maybe Text
Maybe ExpressionType
Text
name :: Text
roleArn :: Maybe Text
expressionType :: Maybe ExpressionType
expression :: Maybe Text
description :: Maybe Text
$sel:name:UpdateDestination' :: UpdateDestination -> Text
$sel:roleArn:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:expressionType:UpdateDestination' :: UpdateDestination -> Maybe ExpressionType
$sel:expression:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:description:UpdateDestination' :: UpdateDestination -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExpressionType
expressionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

instance Data.ToJSON UpdateDestination where
  toJSON :: UpdateDestination -> Value
toJSON UpdateDestination' {Maybe Text
Maybe ExpressionType
Text
name :: Text
roleArn :: Maybe Text
expressionType :: Maybe ExpressionType
expression :: Maybe Text
description :: Maybe Text
$sel:name:UpdateDestination' :: UpdateDestination -> Text
$sel:roleArn:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:expressionType:UpdateDestination' :: UpdateDestination -> Maybe ExpressionType
$sel:expression:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:description:UpdateDestination' :: UpdateDestination -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"Expression" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
expression,
            (Key
"ExpressionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ExpressionType
expressionType,
            (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
roleArn
          ]
      )

instance Data.ToPath UpdateDestination where
  toPath :: UpdateDestination -> ByteString
toPath UpdateDestination' {Maybe Text
Maybe ExpressionType
Text
name :: Text
roleArn :: Maybe Text
expressionType :: Maybe ExpressionType
expression :: Maybe Text
description :: Maybe Text
$sel:name:UpdateDestination' :: UpdateDestination -> Text
$sel:roleArn:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:expressionType:UpdateDestination' :: UpdateDestination -> Maybe ExpressionType
$sel:expression:UpdateDestination' :: UpdateDestination -> Maybe Text
$sel:description:UpdateDestination' :: UpdateDestination -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/destinations/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

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

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

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

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