{-# 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.CreateDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new destination that maps a device message to an AWS IoT rule.
module Amazonka.IoTWireless.CreateDestination
  ( -- * Creating a Request
    CreateDestination (..),
    newCreateDestination,

    -- * Request Lenses
    createDestination_clientRequestToken,
    createDestination_description,
    createDestination_tags,
    createDestination_name,
    createDestination_expressionType,
    createDestination_expression,
    createDestination_roleArn,

    -- * Destructuring the Response
    CreateDestinationResponse (..),
    newCreateDestinationResponse,

    -- * Response Lenses
    createDestinationResponse_arn,
    createDestinationResponse_name,
    createDestinationResponse_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:/ 'newCreateDestination' smart constructor.
data CreateDestination = CreateDestination'
  { -- | Each resource must have a unique client request token. If you try to
    -- create a new resource with the same token as a resource that already
    -- exists, an exception occurs. If you omit this value, AWS SDKs will
    -- automatically generate a unique client request.
    CreateDestination -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The description of the new resource.
    CreateDestination -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The tags to attach to the new destination. Tags are metadata that you
    -- can use to manage a resource.
    CreateDestination -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the new resource.
    CreateDestination -> Text
name :: Prelude.Text,
    -- | The type of value in @Expression@.
    CreateDestination -> ExpressionType
expressionType :: ExpressionType,
    -- | The rule name or topic rule to send messages to.
    CreateDestination -> Text
expression :: Prelude.Text,
    -- | The ARN of the IAM Role that authorizes the destination.
    CreateDestination -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateDestination -> CreateDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDestination -> CreateDestination -> Bool
$c/= :: CreateDestination -> CreateDestination -> Bool
== :: CreateDestination -> CreateDestination -> Bool
$c== :: CreateDestination -> CreateDestination -> Bool
Prelude.Eq, ReadPrec [CreateDestination]
ReadPrec CreateDestination
Int -> ReadS CreateDestination
ReadS [CreateDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDestination]
$creadListPrec :: ReadPrec [CreateDestination]
readPrec :: ReadPrec CreateDestination
$creadPrec :: ReadPrec CreateDestination
readList :: ReadS [CreateDestination]
$creadList :: ReadS [CreateDestination]
readsPrec :: Int -> ReadS CreateDestination
$creadsPrec :: Int -> ReadS CreateDestination
Prelude.Read, Int -> CreateDestination -> ShowS
[CreateDestination] -> ShowS
CreateDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDestination] -> ShowS
$cshowList :: [CreateDestination] -> ShowS
show :: CreateDestination -> String
$cshow :: CreateDestination -> String
showsPrec :: Int -> CreateDestination -> ShowS
$cshowsPrec :: Int -> CreateDestination -> ShowS
Prelude.Show, forall x. Rep CreateDestination x -> CreateDestination
forall x. CreateDestination -> Rep CreateDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDestination x -> CreateDestination
$cfrom :: forall x. CreateDestination -> Rep CreateDestination x
Prelude.Generic)

-- |
-- Create a value of 'CreateDestination' 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:
--
-- 'clientRequestToken', 'createDestination_clientRequestToken' - Each resource must have a unique client request token. If you try to
-- create a new resource with the same token as a resource that already
-- exists, an exception occurs. If you omit this value, AWS SDKs will
-- automatically generate a unique client request.
--
-- 'description', 'createDestination_description' - The description of the new resource.
--
-- 'tags', 'createDestination_tags' - The tags to attach to the new destination. Tags are metadata that you
-- can use to manage a resource.
--
-- 'name', 'createDestination_name' - The name of the new resource.
--
-- 'expressionType', 'createDestination_expressionType' - The type of value in @Expression@.
--
-- 'expression', 'createDestination_expression' - The rule name or topic rule to send messages to.
--
-- 'roleArn', 'createDestination_roleArn' - The ARN of the IAM Role that authorizes the destination.
newCreateDestination ::
  -- | 'name'
  Prelude.Text ->
  -- | 'expressionType'
  ExpressionType ->
  -- | 'expression'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateDestination
newCreateDestination :: Text -> ExpressionType -> Text -> Text -> CreateDestination
newCreateDestination
  Text
pName_
  ExpressionType
pExpressionType_
  Text
pExpression_
  Text
pRoleArn_ =
    CreateDestination'
      { $sel:clientRequestToken:CreateDestination' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateDestination' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateDestination' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateDestination' :: Text
name = Text
pName_,
        $sel:expressionType:CreateDestination' :: ExpressionType
expressionType = ExpressionType
pExpressionType_,
        $sel:expression:CreateDestination' :: Text
expression = Text
pExpression_,
        $sel:roleArn:CreateDestination' :: Text
roleArn = Text
pRoleArn_
      }

-- | Each resource must have a unique client request token. If you try to
-- create a new resource with the same token as a resource that already
-- exists, an exception occurs. If you omit this value, AWS SDKs will
-- automatically generate a unique client request.
createDestination_clientRequestToken :: Lens.Lens' CreateDestination (Prelude.Maybe Prelude.Text)
createDestination_clientRequestToken :: Lens' CreateDestination (Maybe Text)
createDestination_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestination' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateDestination' :: CreateDestination -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateDestination
s@CreateDestination' {} Maybe Text
a -> CreateDestination
s {$sel:clientRequestToken:CreateDestination' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateDestination)

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

-- | The tags to attach to the new destination. Tags are metadata that you
-- can use to manage a resource.
createDestination_tags :: Lens.Lens' CreateDestination (Prelude.Maybe [Tag])
createDestination_tags :: Lens' CreateDestination (Maybe [Tag])
createDestination_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestination' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateDestination' :: CreateDestination -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateDestination
s@CreateDestination' {} Maybe [Tag]
a -> CreateDestination
s {$sel:tags:CreateDestination' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateDestination) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

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

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

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

instance Core.AWSRequest CreateDestination where
  type
    AWSResponse CreateDestination =
      CreateDestinationResponse
  request :: (Service -> Service)
-> CreateDestination -> Request CreateDestination
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 CreateDestination
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateDestination)))
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 ->
          Maybe Text -> Maybe Text -> Int -> CreateDestinationResponse
CreateDestinationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            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 CreateDestination where
  hashWithSalt :: Int -> CreateDestination -> Int
hashWithSalt Int
_salt CreateDestination' {Maybe [Tag]
Maybe Text
Text
ExpressionType
roleArn :: Text
expression :: Text
expressionType :: ExpressionType
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:roleArn:CreateDestination' :: CreateDestination -> Text
$sel:expression:CreateDestination' :: CreateDestination -> Text
$sel:expressionType:CreateDestination' :: CreateDestination -> ExpressionType
$sel:name:CreateDestination' :: CreateDestination -> Text
$sel:tags:CreateDestination' :: CreateDestination -> Maybe [Tag]
$sel:description:CreateDestination' :: CreateDestination -> Maybe Text
$sel:clientRequestToken:CreateDestination' :: CreateDestination -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ExpressionType
expressionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
expression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateDestination where
  rnf :: CreateDestination -> ()
rnf CreateDestination' {Maybe [Tag]
Maybe Text
Text
ExpressionType
roleArn :: Text
expression :: Text
expressionType :: ExpressionType
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:roleArn:CreateDestination' :: CreateDestination -> Text
$sel:expression:CreateDestination' :: CreateDestination -> Text
$sel:expressionType:CreateDestination' :: CreateDestination -> ExpressionType
$sel:name:CreateDestination' :: CreateDestination -> Text
$sel:tags:CreateDestination' :: CreateDestination -> Maybe [Tag]
$sel:description:CreateDestination' :: CreateDestination -> Maybe Text
$sel:clientRequestToken:CreateDestination' :: CreateDestination -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ExpressionType
expressionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
expression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

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

instance Data.ToJSON CreateDestination where
  toJSON :: CreateDestination -> Value
toJSON CreateDestination' {Maybe [Tag]
Maybe Text
Text
ExpressionType
roleArn :: Text
expression :: Text
expressionType :: ExpressionType
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:roleArn:CreateDestination' :: CreateDestination -> Text
$sel:expression:CreateDestination' :: CreateDestination -> Text
$sel:expressionType:CreateDestination' :: CreateDestination -> ExpressionType
$sel:name:CreateDestination' :: CreateDestination -> Text
$sel:tags:CreateDestination' :: CreateDestination -> Maybe [Tag]
$sel:description:CreateDestination' :: CreateDestination -> Maybe Text
$sel:clientRequestToken:CreateDestination' :: CreateDestination -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (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
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ExpressionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ExpressionType
expressionType),
            forall a. a -> Maybe a
Prelude.Just (Key
"Expression" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
expression),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateDestinationResponse' 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', 'createDestinationResponse_arn' - The Amazon Resource Name of the new resource.
--
-- 'name', 'createDestinationResponse_name' - The name of the new resource.
--
-- 'httpStatus', 'createDestinationResponse_httpStatus' - The response's http status code.
newCreateDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDestinationResponse
newCreateDestinationResponse :: Int -> CreateDestinationResponse
newCreateDestinationResponse Int
pHttpStatus_ =
  CreateDestinationResponse'
    { $sel:arn:CreateDestinationResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateDestinationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDestinationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name of the new resource.
createDestinationResponse_arn :: Lens.Lens' CreateDestinationResponse (Prelude.Maybe Prelude.Text)
createDestinationResponse_arn :: Lens' CreateDestinationResponse (Maybe Text)
createDestinationResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDestinationResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateDestinationResponse' :: CreateDestinationResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateDestinationResponse
s@CreateDestinationResponse' {} Maybe Text
a -> CreateDestinationResponse
s {$sel:arn:CreateDestinationResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateDestinationResponse)

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

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

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