{-# 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.CreateFuotaTask
-- 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 FUOTA task.
module Amazonka.IoTWireless.CreateFuotaTask
  ( -- * Creating a Request
    CreateFuotaTask (..),
    newCreateFuotaTask,

    -- * Request Lenses
    createFuotaTask_clientRequestToken,
    createFuotaTask_description,
    createFuotaTask_loRaWAN,
    createFuotaTask_name,
    createFuotaTask_tags,
    createFuotaTask_firmwareUpdateImage,
    createFuotaTask_firmwareUpdateRole,

    -- * Destructuring the Response
    CreateFuotaTaskResponse (..),
    newCreateFuotaTaskResponse,

    -- * Response Lenses
    createFuotaTaskResponse_arn,
    createFuotaTaskResponse_id,
    createFuotaTaskResponse_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:/ 'newCreateFuotaTask' smart constructor.
data CreateFuotaTask = CreateFuotaTask'
  { CreateFuotaTask -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    CreateFuotaTask -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    CreateFuotaTask -> Maybe LoRaWANFuotaTask
loRaWAN :: Prelude.Maybe LoRaWANFuotaTask,
    CreateFuotaTask -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    CreateFuotaTask -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    CreateFuotaTask -> Text
firmwareUpdateImage :: Prelude.Text,
    CreateFuotaTask -> Text
firmwareUpdateRole :: Prelude.Text
  }
  deriving (CreateFuotaTask -> CreateFuotaTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFuotaTask -> CreateFuotaTask -> Bool
$c/= :: CreateFuotaTask -> CreateFuotaTask -> Bool
== :: CreateFuotaTask -> CreateFuotaTask -> Bool
$c== :: CreateFuotaTask -> CreateFuotaTask -> Bool
Prelude.Eq, ReadPrec [CreateFuotaTask]
ReadPrec CreateFuotaTask
Int -> ReadS CreateFuotaTask
ReadS [CreateFuotaTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFuotaTask]
$creadListPrec :: ReadPrec [CreateFuotaTask]
readPrec :: ReadPrec CreateFuotaTask
$creadPrec :: ReadPrec CreateFuotaTask
readList :: ReadS [CreateFuotaTask]
$creadList :: ReadS [CreateFuotaTask]
readsPrec :: Int -> ReadS CreateFuotaTask
$creadsPrec :: Int -> ReadS CreateFuotaTask
Prelude.Read, Int -> CreateFuotaTask -> ShowS
[CreateFuotaTask] -> ShowS
CreateFuotaTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFuotaTask] -> ShowS
$cshowList :: [CreateFuotaTask] -> ShowS
show :: CreateFuotaTask -> String
$cshow :: CreateFuotaTask -> String
showsPrec :: Int -> CreateFuotaTask -> ShowS
$cshowsPrec :: Int -> CreateFuotaTask -> ShowS
Prelude.Show, forall x. Rep CreateFuotaTask x -> CreateFuotaTask
forall x. CreateFuotaTask -> Rep CreateFuotaTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFuotaTask x -> CreateFuotaTask
$cfrom :: forall x. CreateFuotaTask -> Rep CreateFuotaTask x
Prelude.Generic)

-- |
-- Create a value of 'CreateFuotaTask' 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', 'createFuotaTask_clientRequestToken' - Undocumented member.
--
-- 'description', 'createFuotaTask_description' - Undocumented member.
--
-- 'loRaWAN', 'createFuotaTask_loRaWAN' - Undocumented member.
--
-- 'name', 'createFuotaTask_name' - Undocumented member.
--
-- 'tags', 'createFuotaTask_tags' - Undocumented member.
--
-- 'firmwareUpdateImage', 'createFuotaTask_firmwareUpdateImage' - Undocumented member.
--
-- 'firmwareUpdateRole', 'createFuotaTask_firmwareUpdateRole' - Undocumented member.
newCreateFuotaTask ::
  -- | 'firmwareUpdateImage'
  Prelude.Text ->
  -- | 'firmwareUpdateRole'
  Prelude.Text ->
  CreateFuotaTask
newCreateFuotaTask :: Text -> Text -> CreateFuotaTask
newCreateFuotaTask
  Text
pFirmwareUpdateImage_
  Text
pFirmwareUpdateRole_ =
    CreateFuotaTask'
      { $sel:clientRequestToken:CreateFuotaTask' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateFuotaTask' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:loRaWAN:CreateFuotaTask' :: Maybe LoRaWANFuotaTask
loRaWAN = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateFuotaTask' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateFuotaTask' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:firmwareUpdateImage:CreateFuotaTask' :: Text
firmwareUpdateImage = Text
pFirmwareUpdateImage_,
        $sel:firmwareUpdateRole:CreateFuotaTask' :: Text
firmwareUpdateRole = Text
pFirmwareUpdateRole_
      }

-- | Undocumented member.
createFuotaTask_clientRequestToken :: Lens.Lens' CreateFuotaTask (Prelude.Maybe Prelude.Text)
createFuotaTask_clientRequestToken :: Lens' CreateFuotaTask (Maybe Text)
createFuotaTask_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTask' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateFuotaTask
s@CreateFuotaTask' {} Maybe Text
a -> CreateFuotaTask
s {$sel:clientRequestToken:CreateFuotaTask' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateFuotaTask)

-- | Undocumented member.
createFuotaTask_description :: Lens.Lens' CreateFuotaTask (Prelude.Maybe Prelude.Text)
createFuotaTask_description :: Lens' CreateFuotaTask (Maybe Text)
createFuotaTask_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTask' {Maybe Text
description :: Maybe Text
$sel:description:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateFuotaTask
s@CreateFuotaTask' {} Maybe Text
a -> CreateFuotaTask
s {$sel:description:CreateFuotaTask' :: Maybe Text
description = Maybe Text
a} :: CreateFuotaTask)

-- | Undocumented member.
createFuotaTask_loRaWAN :: Lens.Lens' CreateFuotaTask (Prelude.Maybe LoRaWANFuotaTask)
createFuotaTask_loRaWAN :: Lens' CreateFuotaTask (Maybe LoRaWANFuotaTask)
createFuotaTask_loRaWAN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTask' {Maybe LoRaWANFuotaTask
loRaWAN :: Maybe LoRaWANFuotaTask
$sel:loRaWAN:CreateFuotaTask' :: CreateFuotaTask -> Maybe LoRaWANFuotaTask
loRaWAN} -> Maybe LoRaWANFuotaTask
loRaWAN) (\s :: CreateFuotaTask
s@CreateFuotaTask' {} Maybe LoRaWANFuotaTask
a -> CreateFuotaTask
s {$sel:loRaWAN:CreateFuotaTask' :: Maybe LoRaWANFuotaTask
loRaWAN = Maybe LoRaWANFuotaTask
a} :: CreateFuotaTask)

-- | Undocumented member.
createFuotaTask_name :: Lens.Lens' CreateFuotaTask (Prelude.Maybe Prelude.Text)
createFuotaTask_name :: Lens' CreateFuotaTask (Maybe Text)
createFuotaTask_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTask' {Maybe Text
name :: Maybe Text
$sel:name:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateFuotaTask
s@CreateFuotaTask' {} Maybe Text
a -> CreateFuotaTask
s {$sel:name:CreateFuotaTask' :: Maybe Text
name = Maybe Text
a} :: CreateFuotaTask)

-- | Undocumented member.
createFuotaTask_tags :: Lens.Lens' CreateFuotaTask (Prelude.Maybe [Tag])
createFuotaTask_tags :: Lens' CreateFuotaTask (Maybe [Tag])
createFuotaTask_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTask' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateFuotaTask' :: CreateFuotaTask -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateFuotaTask
s@CreateFuotaTask' {} Maybe [Tag]
a -> CreateFuotaTask
s {$sel:tags:CreateFuotaTask' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateFuotaTask) 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

-- | Undocumented member.
createFuotaTask_firmwareUpdateImage :: Lens.Lens' CreateFuotaTask Prelude.Text
createFuotaTask_firmwareUpdateImage :: Lens' CreateFuotaTask Text
createFuotaTask_firmwareUpdateImage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTask' {Text
firmwareUpdateImage :: Text
$sel:firmwareUpdateImage:CreateFuotaTask' :: CreateFuotaTask -> Text
firmwareUpdateImage} -> Text
firmwareUpdateImage) (\s :: CreateFuotaTask
s@CreateFuotaTask' {} Text
a -> CreateFuotaTask
s {$sel:firmwareUpdateImage:CreateFuotaTask' :: Text
firmwareUpdateImage = Text
a} :: CreateFuotaTask)

-- | Undocumented member.
createFuotaTask_firmwareUpdateRole :: Lens.Lens' CreateFuotaTask Prelude.Text
createFuotaTask_firmwareUpdateRole :: Lens' CreateFuotaTask Text
createFuotaTask_firmwareUpdateRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTask' {Text
firmwareUpdateRole :: Text
$sel:firmwareUpdateRole:CreateFuotaTask' :: CreateFuotaTask -> Text
firmwareUpdateRole} -> Text
firmwareUpdateRole) (\s :: CreateFuotaTask
s@CreateFuotaTask' {} Text
a -> CreateFuotaTask
s {$sel:firmwareUpdateRole:CreateFuotaTask' :: Text
firmwareUpdateRole = Text
a} :: CreateFuotaTask)

instance Core.AWSRequest CreateFuotaTask where
  type
    AWSResponse CreateFuotaTask =
      CreateFuotaTaskResponse
  request :: (Service -> Service) -> CreateFuotaTask -> Request CreateFuotaTask
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 CreateFuotaTask
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFuotaTask)))
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 -> CreateFuotaTaskResponse
CreateFuotaTaskResponse'
            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
"Id")
            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 CreateFuotaTask where
  hashWithSalt :: Int -> CreateFuotaTask -> Int
hashWithSalt Int
_salt CreateFuotaTask' {Maybe [Tag]
Maybe Text
Maybe LoRaWANFuotaTask
Text
firmwareUpdateRole :: Text
firmwareUpdateImage :: Text
tags :: Maybe [Tag]
name :: Maybe Text
loRaWAN :: Maybe LoRaWANFuotaTask
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:firmwareUpdateRole:CreateFuotaTask' :: CreateFuotaTask -> Text
$sel:firmwareUpdateImage:CreateFuotaTask' :: CreateFuotaTask -> Text
$sel:tags:CreateFuotaTask' :: CreateFuotaTask -> Maybe [Tag]
$sel:name:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
$sel:loRaWAN:CreateFuotaTask' :: CreateFuotaTask -> Maybe LoRaWANFuotaTask
$sel:description:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
$sel:clientRequestToken:CreateFuotaTask' :: CreateFuotaTask -> 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 LoRaWANFuotaTask
loRaWAN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
firmwareUpdateImage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
firmwareUpdateRole

instance Prelude.NFData CreateFuotaTask where
  rnf :: CreateFuotaTask -> ()
rnf CreateFuotaTask' {Maybe [Tag]
Maybe Text
Maybe LoRaWANFuotaTask
Text
firmwareUpdateRole :: Text
firmwareUpdateImage :: Text
tags :: Maybe [Tag]
name :: Maybe Text
loRaWAN :: Maybe LoRaWANFuotaTask
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:firmwareUpdateRole:CreateFuotaTask' :: CreateFuotaTask -> Text
$sel:firmwareUpdateImage:CreateFuotaTask' :: CreateFuotaTask -> Text
$sel:tags:CreateFuotaTask' :: CreateFuotaTask -> Maybe [Tag]
$sel:name:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
$sel:loRaWAN:CreateFuotaTask' :: CreateFuotaTask -> Maybe LoRaWANFuotaTask
$sel:description:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
$sel:clientRequestToken:CreateFuotaTask' :: CreateFuotaTask -> 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 LoRaWANFuotaTask
loRaWAN
      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 Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
firmwareUpdateImage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
firmwareUpdateRole

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

instance Data.ToJSON CreateFuotaTask where
  toJSON :: CreateFuotaTask -> Value
toJSON CreateFuotaTask' {Maybe [Tag]
Maybe Text
Maybe LoRaWANFuotaTask
Text
firmwareUpdateRole :: Text
firmwareUpdateImage :: Text
tags :: Maybe [Tag]
name :: Maybe Text
loRaWAN :: Maybe LoRaWANFuotaTask
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:firmwareUpdateRole:CreateFuotaTask' :: CreateFuotaTask -> Text
$sel:firmwareUpdateImage:CreateFuotaTask' :: CreateFuotaTask -> Text
$sel:tags:CreateFuotaTask' :: CreateFuotaTask -> Maybe [Tag]
$sel:name:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
$sel:loRaWAN:CreateFuotaTask' :: CreateFuotaTask -> Maybe LoRaWANFuotaTask
$sel:description:CreateFuotaTask' :: CreateFuotaTask -> Maybe Text
$sel:clientRequestToken:CreateFuotaTask' :: CreateFuotaTask -> 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
"LoRaWAN" 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 LoRaWANFuotaTask
loRaWAN,
            (Key
"Name" 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
name,
            (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
"FirmwareUpdateImage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
firmwareUpdateImage),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"FirmwareUpdateRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
firmwareUpdateRole)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateFuotaTaskResponse' 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', 'createFuotaTaskResponse_arn' - Undocumented member.
--
-- 'id', 'createFuotaTaskResponse_id' - Undocumented member.
--
-- 'httpStatus', 'createFuotaTaskResponse_httpStatus' - The response's http status code.
newCreateFuotaTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFuotaTaskResponse
newCreateFuotaTaskResponse :: Int -> CreateFuotaTaskResponse
newCreateFuotaTaskResponse Int
pHttpStatus_ =
  CreateFuotaTaskResponse'
    { $sel:arn:CreateFuotaTaskResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateFuotaTaskResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFuotaTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
createFuotaTaskResponse_arn :: Lens.Lens' CreateFuotaTaskResponse (Prelude.Maybe Prelude.Text)
createFuotaTaskResponse_arn :: Lens' CreateFuotaTaskResponse (Maybe Text)
createFuotaTaskResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTaskResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateFuotaTaskResponse' :: CreateFuotaTaskResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateFuotaTaskResponse
s@CreateFuotaTaskResponse' {} Maybe Text
a -> CreateFuotaTaskResponse
s {$sel:arn:CreateFuotaTaskResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateFuotaTaskResponse)

-- | Undocumented member.
createFuotaTaskResponse_id :: Lens.Lens' CreateFuotaTaskResponse (Prelude.Maybe Prelude.Text)
createFuotaTaskResponse_id :: Lens' CreateFuotaTaskResponse (Maybe Text)
createFuotaTaskResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFuotaTaskResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateFuotaTaskResponse' :: CreateFuotaTaskResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateFuotaTaskResponse
s@CreateFuotaTaskResponse' {} Maybe Text
a -> CreateFuotaTaskResponse
s {$sel:id:CreateFuotaTaskResponse' :: Maybe Text
id = Maybe Text
a} :: CreateFuotaTaskResponse)

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

instance Prelude.NFData CreateFuotaTaskResponse where
  rnf :: CreateFuotaTaskResponse -> ()
rnf CreateFuotaTaskResponse' {Int
Maybe Text
httpStatus :: Int
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateFuotaTaskResponse' :: CreateFuotaTaskResponse -> Int
$sel:id:CreateFuotaTaskResponse' :: CreateFuotaTaskResponse -> Maybe Text
$sel:arn:CreateFuotaTaskResponse' :: CreateFuotaTaskResponse -> 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
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus