{-# 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.CreateOTAUpdate
-- 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 an IoT OTA update on a target group of things or groups.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreateOTAUpdate>
-- action.
module Amazonka.IoT.CreateOTAUpdate
  ( -- * Creating a Request
    CreateOTAUpdate (..),
    newCreateOTAUpdate,

    -- * Request Lenses
    createOTAUpdate_additionalParameters,
    createOTAUpdate_awsJobAbortConfig,
    createOTAUpdate_awsJobExecutionsRolloutConfig,
    createOTAUpdate_awsJobPresignedUrlConfig,
    createOTAUpdate_awsJobTimeoutConfig,
    createOTAUpdate_description,
    createOTAUpdate_protocols,
    createOTAUpdate_tags,
    createOTAUpdate_targetSelection,
    createOTAUpdate_otaUpdateId,
    createOTAUpdate_targets,
    createOTAUpdate_files,
    createOTAUpdate_roleArn,

    -- * Destructuring the Response
    CreateOTAUpdateResponse (..),
    newCreateOTAUpdateResponse,

    -- * Response Lenses
    createOTAUpdateResponse_awsIotJobArn,
    createOTAUpdateResponse_awsIotJobId,
    createOTAUpdateResponse_otaUpdateArn,
    createOTAUpdateResponse_otaUpdateId,
    createOTAUpdateResponse_otaUpdateStatus,
    createOTAUpdateResponse_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:/ 'newCreateOTAUpdate' smart constructor.
data CreateOTAUpdate = CreateOTAUpdate'
  { -- | A list of additional OTA update parameters which are name-value pairs.
    CreateOTAUpdate -> Maybe (HashMap Text Text)
additionalParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The criteria that determine when and how a job abort takes place.
    CreateOTAUpdate -> Maybe AwsJobAbortConfig
awsJobAbortConfig :: Prelude.Maybe AwsJobAbortConfig,
    -- | Configuration for the rollout of OTA updates.
    CreateOTAUpdate -> Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig :: Prelude.Maybe AwsJobExecutionsRolloutConfig,
    -- | Configuration information for pre-signed URLs.
    CreateOTAUpdate -> Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig :: Prelude.Maybe AwsJobPresignedUrlConfig,
    -- | Specifies the amount of time each device has to finish its execution of
    -- the job. A timer is started when the job execution status is set to
    -- @IN_PROGRESS@. If the job execution status is not set to another
    -- terminal state before the timer expires, it will be automatically set to
    -- @TIMED_OUT@.
    CreateOTAUpdate -> Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig :: Prelude.Maybe AwsJobTimeoutConfig,
    -- | The description of the OTA update.
    CreateOTAUpdate -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The protocol used to transfer the OTA update image. Valid values are
    -- [HTTP], [MQTT], [HTTP, MQTT]. When both HTTP and MQTT are specified, the
    -- target device can choose the protocol.
    CreateOTAUpdate -> Maybe (NonEmpty Protocol)
protocols :: Prelude.Maybe (Prelude.NonEmpty Protocol),
    -- | Metadata which can be used to manage updates.
    CreateOTAUpdate -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Specifies whether the update will continue to run (CONTINUOUS), or will
    -- be complete after all the things specified as targets have completed the
    -- update (SNAPSHOT). If continuous, the update may also be run on a thing
    -- when a change is detected in a target. For example, an update will run
    -- on a thing when the thing is added to a target group, even after the
    -- update was completed by all things originally in the group. Valid
    -- values: CONTINUOUS | SNAPSHOT.
    CreateOTAUpdate -> Maybe TargetSelection
targetSelection :: Prelude.Maybe TargetSelection,
    -- | The ID of the OTA update to be created.
    CreateOTAUpdate -> Text
otaUpdateId :: Prelude.Text,
    -- | The devices targeted to receive OTA updates.
    CreateOTAUpdate -> NonEmpty Text
targets :: Prelude.NonEmpty Prelude.Text,
    -- | The files to be streamed by the OTA update.
    CreateOTAUpdate -> NonEmpty OTAUpdateFile
files :: Prelude.NonEmpty OTAUpdateFile,
    -- | The IAM role that grants Amazon Web Services IoT Core access to the
    -- Amazon S3, IoT jobs and Amazon Web Services Code Signing resources to
    -- create an OTA update job.
    CreateOTAUpdate -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateOTAUpdate -> CreateOTAUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOTAUpdate -> CreateOTAUpdate -> Bool
$c/= :: CreateOTAUpdate -> CreateOTAUpdate -> Bool
== :: CreateOTAUpdate -> CreateOTAUpdate -> Bool
$c== :: CreateOTAUpdate -> CreateOTAUpdate -> Bool
Prelude.Eq, ReadPrec [CreateOTAUpdate]
ReadPrec CreateOTAUpdate
Int -> ReadS CreateOTAUpdate
ReadS [CreateOTAUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOTAUpdate]
$creadListPrec :: ReadPrec [CreateOTAUpdate]
readPrec :: ReadPrec CreateOTAUpdate
$creadPrec :: ReadPrec CreateOTAUpdate
readList :: ReadS [CreateOTAUpdate]
$creadList :: ReadS [CreateOTAUpdate]
readsPrec :: Int -> ReadS CreateOTAUpdate
$creadsPrec :: Int -> ReadS CreateOTAUpdate
Prelude.Read, Int -> CreateOTAUpdate -> ShowS
[CreateOTAUpdate] -> ShowS
CreateOTAUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOTAUpdate] -> ShowS
$cshowList :: [CreateOTAUpdate] -> ShowS
show :: CreateOTAUpdate -> String
$cshow :: CreateOTAUpdate -> String
showsPrec :: Int -> CreateOTAUpdate -> ShowS
$cshowsPrec :: Int -> CreateOTAUpdate -> ShowS
Prelude.Show, forall x. Rep CreateOTAUpdate x -> CreateOTAUpdate
forall x. CreateOTAUpdate -> Rep CreateOTAUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOTAUpdate x -> CreateOTAUpdate
$cfrom :: forall x. CreateOTAUpdate -> Rep CreateOTAUpdate x
Prelude.Generic)

-- |
-- Create a value of 'CreateOTAUpdate' 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:
--
-- 'additionalParameters', 'createOTAUpdate_additionalParameters' - A list of additional OTA update parameters which are name-value pairs.
--
-- 'awsJobAbortConfig', 'createOTAUpdate_awsJobAbortConfig' - The criteria that determine when and how a job abort takes place.
--
-- 'awsJobExecutionsRolloutConfig', 'createOTAUpdate_awsJobExecutionsRolloutConfig' - Configuration for the rollout of OTA updates.
--
-- 'awsJobPresignedUrlConfig', 'createOTAUpdate_awsJobPresignedUrlConfig' - Configuration information for pre-signed URLs.
--
-- 'awsJobTimeoutConfig', 'createOTAUpdate_awsJobTimeoutConfig' - Specifies the amount of time each device has to finish its execution of
-- the job. A timer is started when the job execution status is set to
-- @IN_PROGRESS@. If the job execution status is not set to another
-- terminal state before the timer expires, it will be automatically set to
-- @TIMED_OUT@.
--
-- 'description', 'createOTAUpdate_description' - The description of the OTA update.
--
-- 'protocols', 'createOTAUpdate_protocols' - The protocol used to transfer the OTA update image. Valid values are
-- [HTTP], [MQTT], [HTTP, MQTT]. When both HTTP and MQTT are specified, the
-- target device can choose the protocol.
--
-- 'tags', 'createOTAUpdate_tags' - Metadata which can be used to manage updates.
--
-- 'targetSelection', 'createOTAUpdate_targetSelection' - Specifies whether the update will continue to run (CONTINUOUS), or will
-- be complete after all the things specified as targets have completed the
-- update (SNAPSHOT). If continuous, the update may also be run on a thing
-- when a change is detected in a target. For example, an update will run
-- on a thing when the thing is added to a target group, even after the
-- update was completed by all things originally in the group. Valid
-- values: CONTINUOUS | SNAPSHOT.
--
-- 'otaUpdateId', 'createOTAUpdate_otaUpdateId' - The ID of the OTA update to be created.
--
-- 'targets', 'createOTAUpdate_targets' - The devices targeted to receive OTA updates.
--
-- 'files', 'createOTAUpdate_files' - The files to be streamed by the OTA update.
--
-- 'roleArn', 'createOTAUpdate_roleArn' - The IAM role that grants Amazon Web Services IoT Core access to the
-- Amazon S3, IoT jobs and Amazon Web Services Code Signing resources to
-- create an OTA update job.
newCreateOTAUpdate ::
  -- | 'otaUpdateId'
  Prelude.Text ->
  -- | 'targets'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'files'
  Prelude.NonEmpty OTAUpdateFile ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateOTAUpdate
newCreateOTAUpdate :: Text
-> NonEmpty Text
-> NonEmpty OTAUpdateFile
-> Text
-> CreateOTAUpdate
newCreateOTAUpdate
  Text
pOtaUpdateId_
  NonEmpty Text
pTargets_
  NonEmpty OTAUpdateFile
pFiles_
  Text
pRoleArn_ =
    CreateOTAUpdate'
      { $sel:additionalParameters:CreateOTAUpdate' :: Maybe (HashMap Text Text)
additionalParameters =
          forall a. Maybe a
Prelude.Nothing,
        $sel:awsJobAbortConfig:CreateOTAUpdate' :: Maybe AwsJobAbortConfig
awsJobAbortConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:awsJobExecutionsRolloutConfig:CreateOTAUpdate' :: Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:awsJobPresignedUrlConfig:CreateOTAUpdate' :: Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:awsJobTimeoutConfig:CreateOTAUpdate' :: Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateOTAUpdate' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:protocols:CreateOTAUpdate' :: Maybe (NonEmpty Protocol)
protocols = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateOTAUpdate' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:targetSelection:CreateOTAUpdate' :: Maybe TargetSelection
targetSelection = forall a. Maybe a
Prelude.Nothing,
        $sel:otaUpdateId:CreateOTAUpdate' :: Text
otaUpdateId = Text
pOtaUpdateId_,
        $sel:targets:CreateOTAUpdate' :: NonEmpty Text
targets = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pTargets_,
        $sel:files:CreateOTAUpdate' :: NonEmpty OTAUpdateFile
files = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty OTAUpdateFile
pFiles_,
        $sel:roleArn:CreateOTAUpdate' :: Text
roleArn = Text
pRoleArn_
      }

-- | A list of additional OTA update parameters which are name-value pairs.
createOTAUpdate_additionalParameters :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createOTAUpdate_additionalParameters :: Lens' CreateOTAUpdate (Maybe (HashMap Text Text))
createOTAUpdate_additionalParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe (HashMap Text Text)
additionalParameters :: Maybe (HashMap Text Text)
$sel:additionalParameters:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (HashMap Text Text)
additionalParameters} -> Maybe (HashMap Text Text)
additionalParameters) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe (HashMap Text Text)
a -> CreateOTAUpdate
s {$sel:additionalParameters:CreateOTAUpdate' :: Maybe (HashMap Text Text)
additionalParameters = Maybe (HashMap Text Text)
a} :: CreateOTAUpdate) 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 criteria that determine when and how a job abort takes place.
createOTAUpdate_awsJobAbortConfig :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe AwsJobAbortConfig)
createOTAUpdate_awsJobAbortConfig :: Lens' CreateOTAUpdate (Maybe AwsJobAbortConfig)
createOTAUpdate_awsJobAbortConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe AwsJobAbortConfig
awsJobAbortConfig :: Maybe AwsJobAbortConfig
$sel:awsJobAbortConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobAbortConfig
awsJobAbortConfig} -> Maybe AwsJobAbortConfig
awsJobAbortConfig) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe AwsJobAbortConfig
a -> CreateOTAUpdate
s {$sel:awsJobAbortConfig:CreateOTAUpdate' :: Maybe AwsJobAbortConfig
awsJobAbortConfig = Maybe AwsJobAbortConfig
a} :: CreateOTAUpdate)

-- | Configuration for the rollout of OTA updates.
createOTAUpdate_awsJobExecutionsRolloutConfig :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe AwsJobExecutionsRolloutConfig)
createOTAUpdate_awsJobExecutionsRolloutConfig :: Lens' CreateOTAUpdate (Maybe AwsJobExecutionsRolloutConfig)
createOTAUpdate_awsJobExecutionsRolloutConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig :: Maybe AwsJobExecutionsRolloutConfig
$sel:awsJobExecutionsRolloutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig} -> Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe AwsJobExecutionsRolloutConfig
a -> CreateOTAUpdate
s {$sel:awsJobExecutionsRolloutConfig:CreateOTAUpdate' :: Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig = Maybe AwsJobExecutionsRolloutConfig
a} :: CreateOTAUpdate)

-- | Configuration information for pre-signed URLs.
createOTAUpdate_awsJobPresignedUrlConfig :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe AwsJobPresignedUrlConfig)
createOTAUpdate_awsJobPresignedUrlConfig :: Lens' CreateOTAUpdate (Maybe AwsJobPresignedUrlConfig)
createOTAUpdate_awsJobPresignedUrlConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig :: Maybe AwsJobPresignedUrlConfig
$sel:awsJobPresignedUrlConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig} -> Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe AwsJobPresignedUrlConfig
a -> CreateOTAUpdate
s {$sel:awsJobPresignedUrlConfig:CreateOTAUpdate' :: Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig = Maybe AwsJobPresignedUrlConfig
a} :: CreateOTAUpdate)

-- | Specifies the amount of time each device has to finish its execution of
-- the job. A timer is started when the job execution status is set to
-- @IN_PROGRESS@. If the job execution status is not set to another
-- terminal state before the timer expires, it will be automatically set to
-- @TIMED_OUT@.
createOTAUpdate_awsJobTimeoutConfig :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe AwsJobTimeoutConfig)
createOTAUpdate_awsJobTimeoutConfig :: Lens' CreateOTAUpdate (Maybe AwsJobTimeoutConfig)
createOTAUpdate_awsJobTimeoutConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig :: Maybe AwsJobTimeoutConfig
$sel:awsJobTimeoutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig} -> Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe AwsJobTimeoutConfig
a -> CreateOTAUpdate
s {$sel:awsJobTimeoutConfig:CreateOTAUpdate' :: Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig = Maybe AwsJobTimeoutConfig
a} :: CreateOTAUpdate)

-- | The description of the OTA update.
createOTAUpdate_description :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe Prelude.Text)
createOTAUpdate_description :: Lens' CreateOTAUpdate (Maybe Text)
createOTAUpdate_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe Text
description :: Maybe Text
$sel:description:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe Text
a -> CreateOTAUpdate
s {$sel:description:CreateOTAUpdate' :: Maybe Text
description = Maybe Text
a} :: CreateOTAUpdate)

-- | The protocol used to transfer the OTA update image. Valid values are
-- [HTTP], [MQTT], [HTTP, MQTT]. When both HTTP and MQTT are specified, the
-- target device can choose the protocol.
createOTAUpdate_protocols :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe (Prelude.NonEmpty Protocol))
createOTAUpdate_protocols :: Lens' CreateOTAUpdate (Maybe (NonEmpty Protocol))
createOTAUpdate_protocols = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe (NonEmpty Protocol)
protocols :: Maybe (NonEmpty Protocol)
$sel:protocols:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (NonEmpty Protocol)
protocols} -> Maybe (NonEmpty Protocol)
protocols) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe (NonEmpty Protocol)
a -> CreateOTAUpdate
s {$sel:protocols:CreateOTAUpdate' :: Maybe (NonEmpty Protocol)
protocols = Maybe (NonEmpty Protocol)
a} :: CreateOTAUpdate) 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

-- | Metadata which can be used to manage updates.
createOTAUpdate_tags :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe [Tag])
createOTAUpdate_tags :: Lens' CreateOTAUpdate (Maybe [Tag])
createOTAUpdate_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe [Tag]
a -> CreateOTAUpdate
s {$sel:tags:CreateOTAUpdate' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateOTAUpdate) 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

-- | Specifies whether the update will continue to run (CONTINUOUS), or will
-- be complete after all the things specified as targets have completed the
-- update (SNAPSHOT). If continuous, the update may also be run on a thing
-- when a change is detected in a target. For example, an update will run
-- on a thing when the thing is added to a target group, even after the
-- update was completed by all things originally in the group. Valid
-- values: CONTINUOUS | SNAPSHOT.
createOTAUpdate_targetSelection :: Lens.Lens' CreateOTAUpdate (Prelude.Maybe TargetSelection)
createOTAUpdate_targetSelection :: Lens' CreateOTAUpdate (Maybe TargetSelection)
createOTAUpdate_targetSelection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Maybe TargetSelection
targetSelection :: Maybe TargetSelection
$sel:targetSelection:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe TargetSelection
targetSelection} -> Maybe TargetSelection
targetSelection) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Maybe TargetSelection
a -> CreateOTAUpdate
s {$sel:targetSelection:CreateOTAUpdate' :: Maybe TargetSelection
targetSelection = Maybe TargetSelection
a} :: CreateOTAUpdate)

-- | The ID of the OTA update to be created.
createOTAUpdate_otaUpdateId :: Lens.Lens' CreateOTAUpdate Prelude.Text
createOTAUpdate_otaUpdateId :: Lens' CreateOTAUpdate Text
createOTAUpdate_otaUpdateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Text
otaUpdateId :: Text
$sel:otaUpdateId:CreateOTAUpdate' :: CreateOTAUpdate -> Text
otaUpdateId} -> Text
otaUpdateId) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Text
a -> CreateOTAUpdate
s {$sel:otaUpdateId:CreateOTAUpdate' :: Text
otaUpdateId = Text
a} :: CreateOTAUpdate)

-- | The devices targeted to receive OTA updates.
createOTAUpdate_targets :: Lens.Lens' CreateOTAUpdate (Prelude.NonEmpty Prelude.Text)
createOTAUpdate_targets :: Lens' CreateOTAUpdate (NonEmpty Text)
createOTAUpdate_targets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {NonEmpty Text
targets :: NonEmpty Text
$sel:targets:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty Text
targets} -> NonEmpty Text
targets) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} NonEmpty Text
a -> CreateOTAUpdate
s {$sel:targets:CreateOTAUpdate' :: NonEmpty Text
targets = NonEmpty Text
a} :: CreateOTAUpdate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The files to be streamed by the OTA update.
createOTAUpdate_files :: Lens.Lens' CreateOTAUpdate (Prelude.NonEmpty OTAUpdateFile)
createOTAUpdate_files :: Lens' CreateOTAUpdate (NonEmpty OTAUpdateFile)
createOTAUpdate_files = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {NonEmpty OTAUpdateFile
files :: NonEmpty OTAUpdateFile
$sel:files:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty OTAUpdateFile
files} -> NonEmpty OTAUpdateFile
files) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} NonEmpty OTAUpdateFile
a -> CreateOTAUpdate
s {$sel:files:CreateOTAUpdate' :: NonEmpty OTAUpdateFile
files = NonEmpty OTAUpdateFile
a} :: CreateOTAUpdate) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The IAM role that grants Amazon Web Services IoT Core access to the
-- Amazon S3, IoT jobs and Amazon Web Services Code Signing resources to
-- create an OTA update job.
createOTAUpdate_roleArn :: Lens.Lens' CreateOTAUpdate Prelude.Text
createOTAUpdate_roleArn :: Lens' CreateOTAUpdate Text
createOTAUpdate_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdate' {Text
roleArn :: Text
$sel:roleArn:CreateOTAUpdate' :: CreateOTAUpdate -> Text
roleArn} -> Text
roleArn) (\s :: CreateOTAUpdate
s@CreateOTAUpdate' {} Text
a -> CreateOTAUpdate
s {$sel:roleArn:CreateOTAUpdate' :: Text
roleArn = Text
a} :: CreateOTAUpdate)

instance Core.AWSRequest CreateOTAUpdate where
  type
    AWSResponse CreateOTAUpdate =
      CreateOTAUpdateResponse
  request :: (Service -> Service) -> CreateOTAUpdate -> Request CreateOTAUpdate
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 CreateOTAUpdate
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateOTAUpdate)))
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
-> Maybe Text
-> Maybe Text
-> Maybe OTAUpdateStatus
-> Int
-> CreateOTAUpdateResponse
CreateOTAUpdateResponse'
            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
"awsIotJobArn")
            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
"awsIotJobId")
            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
"otaUpdateArn")
            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
"otaUpdateId")
            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
"otaUpdateStatus")
            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 CreateOTAUpdate where
  hashWithSalt :: Int -> CreateOTAUpdate -> Int
hashWithSalt Int
_salt CreateOTAUpdate' {Maybe [Tag]
Maybe (NonEmpty Protocol)
Maybe Text
Maybe (HashMap Text Text)
Maybe AwsJobAbortConfig
Maybe AwsJobPresignedUrlConfig
Maybe AwsJobExecutionsRolloutConfig
Maybe AwsJobTimeoutConfig
Maybe TargetSelection
NonEmpty Text
NonEmpty OTAUpdateFile
Text
roleArn :: Text
files :: NonEmpty OTAUpdateFile
targets :: NonEmpty Text
otaUpdateId :: Text
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
protocols :: Maybe (NonEmpty Protocol)
description :: Maybe Text
awsJobTimeoutConfig :: Maybe AwsJobTimeoutConfig
awsJobPresignedUrlConfig :: Maybe AwsJobPresignedUrlConfig
awsJobExecutionsRolloutConfig :: Maybe AwsJobExecutionsRolloutConfig
awsJobAbortConfig :: Maybe AwsJobAbortConfig
additionalParameters :: Maybe (HashMap Text Text)
$sel:roleArn:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:files:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty OTAUpdateFile
$sel:targets:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty Text
$sel:otaUpdateId:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:targetSelection:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe TargetSelection
$sel:tags:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe [Tag]
$sel:protocols:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (NonEmpty Protocol)
$sel:description:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe Text
$sel:awsJobTimeoutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobTimeoutConfig
$sel:awsJobPresignedUrlConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobPresignedUrlConfig
$sel:awsJobExecutionsRolloutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobExecutionsRolloutConfig
$sel:awsJobAbortConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobAbortConfig
$sel:additionalParameters:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
additionalParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AwsJobAbortConfig
awsJobAbortConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Protocol)
protocols
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetSelection
targetSelection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
otaUpdateId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
targets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty OTAUpdateFile
files
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateOTAUpdate where
  rnf :: CreateOTAUpdate -> ()
rnf CreateOTAUpdate' {Maybe [Tag]
Maybe (NonEmpty Protocol)
Maybe Text
Maybe (HashMap Text Text)
Maybe AwsJobAbortConfig
Maybe AwsJobPresignedUrlConfig
Maybe AwsJobExecutionsRolloutConfig
Maybe AwsJobTimeoutConfig
Maybe TargetSelection
NonEmpty Text
NonEmpty OTAUpdateFile
Text
roleArn :: Text
files :: NonEmpty OTAUpdateFile
targets :: NonEmpty Text
otaUpdateId :: Text
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
protocols :: Maybe (NonEmpty Protocol)
description :: Maybe Text
awsJobTimeoutConfig :: Maybe AwsJobTimeoutConfig
awsJobPresignedUrlConfig :: Maybe AwsJobPresignedUrlConfig
awsJobExecutionsRolloutConfig :: Maybe AwsJobExecutionsRolloutConfig
awsJobAbortConfig :: Maybe AwsJobAbortConfig
additionalParameters :: Maybe (HashMap Text Text)
$sel:roleArn:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:files:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty OTAUpdateFile
$sel:targets:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty Text
$sel:otaUpdateId:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:targetSelection:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe TargetSelection
$sel:tags:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe [Tag]
$sel:protocols:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (NonEmpty Protocol)
$sel:description:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe Text
$sel:awsJobTimeoutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobTimeoutConfig
$sel:awsJobPresignedUrlConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobPresignedUrlConfig
$sel:awsJobExecutionsRolloutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobExecutionsRolloutConfig
$sel:awsJobAbortConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobAbortConfig
$sel:additionalParameters:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
additionalParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AwsJobAbortConfig
awsJobAbortConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AwsJobTimeoutConfig
awsJobTimeoutConfig
      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 (NonEmpty Protocol)
protocols
      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 Maybe TargetSelection
targetSelection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
otaUpdateId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
targets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty OTAUpdateFile
files
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

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

instance Data.ToJSON CreateOTAUpdate where
  toJSON :: CreateOTAUpdate -> Value
toJSON CreateOTAUpdate' {Maybe [Tag]
Maybe (NonEmpty Protocol)
Maybe Text
Maybe (HashMap Text Text)
Maybe AwsJobAbortConfig
Maybe AwsJobPresignedUrlConfig
Maybe AwsJobExecutionsRolloutConfig
Maybe AwsJobTimeoutConfig
Maybe TargetSelection
NonEmpty Text
NonEmpty OTAUpdateFile
Text
roleArn :: Text
files :: NonEmpty OTAUpdateFile
targets :: NonEmpty Text
otaUpdateId :: Text
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
protocols :: Maybe (NonEmpty Protocol)
description :: Maybe Text
awsJobTimeoutConfig :: Maybe AwsJobTimeoutConfig
awsJobPresignedUrlConfig :: Maybe AwsJobPresignedUrlConfig
awsJobExecutionsRolloutConfig :: Maybe AwsJobExecutionsRolloutConfig
awsJobAbortConfig :: Maybe AwsJobAbortConfig
additionalParameters :: Maybe (HashMap Text Text)
$sel:roleArn:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:files:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty OTAUpdateFile
$sel:targets:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty Text
$sel:otaUpdateId:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:targetSelection:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe TargetSelection
$sel:tags:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe [Tag]
$sel:protocols:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (NonEmpty Protocol)
$sel:description:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe Text
$sel:awsJobTimeoutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobTimeoutConfig
$sel:awsJobPresignedUrlConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobPresignedUrlConfig
$sel:awsJobExecutionsRolloutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobExecutionsRolloutConfig
$sel:awsJobAbortConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobAbortConfig
$sel:additionalParameters:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"additionalParameters" 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 (HashMap Text Text)
additionalParameters,
            (Key
"awsJobAbortConfig" 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 AwsJobAbortConfig
awsJobAbortConfig,
            (Key
"awsJobExecutionsRolloutConfig" 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 AwsJobExecutionsRolloutConfig
awsJobExecutionsRolloutConfig,
            (Key
"awsJobPresignedUrlConfig" 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 AwsJobPresignedUrlConfig
awsJobPresignedUrlConfig,
            (Key
"awsJobTimeoutConfig" 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 AwsJobTimeoutConfig
awsJobTimeoutConfig,
            (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
"protocols" 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 (NonEmpty Protocol)
protocols,
            (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,
            (Key
"targetSelection" 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 TargetSelection
targetSelection,
            forall a. a -> Maybe a
Prelude.Just (Key
"targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
targets),
            forall a. a -> Maybe a
Prelude.Just (Key
"files" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty OTAUpdateFile
files),
            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 CreateOTAUpdate where
  toPath :: CreateOTAUpdate -> ByteString
toPath CreateOTAUpdate' {Maybe [Tag]
Maybe (NonEmpty Protocol)
Maybe Text
Maybe (HashMap Text Text)
Maybe AwsJobAbortConfig
Maybe AwsJobPresignedUrlConfig
Maybe AwsJobExecutionsRolloutConfig
Maybe AwsJobTimeoutConfig
Maybe TargetSelection
NonEmpty Text
NonEmpty OTAUpdateFile
Text
roleArn :: Text
files :: NonEmpty OTAUpdateFile
targets :: NonEmpty Text
otaUpdateId :: Text
targetSelection :: Maybe TargetSelection
tags :: Maybe [Tag]
protocols :: Maybe (NonEmpty Protocol)
description :: Maybe Text
awsJobTimeoutConfig :: Maybe AwsJobTimeoutConfig
awsJobPresignedUrlConfig :: Maybe AwsJobPresignedUrlConfig
awsJobExecutionsRolloutConfig :: Maybe AwsJobExecutionsRolloutConfig
awsJobAbortConfig :: Maybe AwsJobAbortConfig
additionalParameters :: Maybe (HashMap Text Text)
$sel:roleArn:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:files:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty OTAUpdateFile
$sel:targets:CreateOTAUpdate' :: CreateOTAUpdate -> NonEmpty Text
$sel:otaUpdateId:CreateOTAUpdate' :: CreateOTAUpdate -> Text
$sel:targetSelection:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe TargetSelection
$sel:tags:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe [Tag]
$sel:protocols:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (NonEmpty Protocol)
$sel:description:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe Text
$sel:awsJobTimeoutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobTimeoutConfig
$sel:awsJobPresignedUrlConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobPresignedUrlConfig
$sel:awsJobExecutionsRolloutConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobExecutionsRolloutConfig
$sel:awsJobAbortConfig:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe AwsJobAbortConfig
$sel:additionalParameters:CreateOTAUpdate' :: CreateOTAUpdate -> Maybe (HashMap Text Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/otaUpdates/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
otaUpdateId]

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

-- | /See:/ 'newCreateOTAUpdateResponse' smart constructor.
data CreateOTAUpdateResponse = CreateOTAUpdateResponse'
  { -- | The IoT job ARN associated with the OTA update.
    CreateOTAUpdateResponse -> Maybe Text
awsIotJobArn :: Prelude.Maybe Prelude.Text,
    -- | The IoT job ID associated with the OTA update.
    CreateOTAUpdateResponse -> Maybe Text
awsIotJobId :: Prelude.Maybe Prelude.Text,
    -- | The OTA update ARN.
    CreateOTAUpdateResponse -> Maybe Text
otaUpdateArn :: Prelude.Maybe Prelude.Text,
    -- | The OTA update ID.
    CreateOTAUpdateResponse -> Maybe Text
otaUpdateId :: Prelude.Maybe Prelude.Text,
    -- | The OTA update status.
    CreateOTAUpdateResponse -> Maybe OTAUpdateStatus
otaUpdateStatus :: Prelude.Maybe OTAUpdateStatus,
    -- | The response's http status code.
    CreateOTAUpdateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateOTAUpdateResponse -> CreateOTAUpdateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateOTAUpdateResponse -> CreateOTAUpdateResponse -> Bool
$c/= :: CreateOTAUpdateResponse -> CreateOTAUpdateResponse -> Bool
== :: CreateOTAUpdateResponse -> CreateOTAUpdateResponse -> Bool
$c== :: CreateOTAUpdateResponse -> CreateOTAUpdateResponse -> Bool
Prelude.Eq, ReadPrec [CreateOTAUpdateResponse]
ReadPrec CreateOTAUpdateResponse
Int -> ReadS CreateOTAUpdateResponse
ReadS [CreateOTAUpdateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateOTAUpdateResponse]
$creadListPrec :: ReadPrec [CreateOTAUpdateResponse]
readPrec :: ReadPrec CreateOTAUpdateResponse
$creadPrec :: ReadPrec CreateOTAUpdateResponse
readList :: ReadS [CreateOTAUpdateResponse]
$creadList :: ReadS [CreateOTAUpdateResponse]
readsPrec :: Int -> ReadS CreateOTAUpdateResponse
$creadsPrec :: Int -> ReadS CreateOTAUpdateResponse
Prelude.Read, Int -> CreateOTAUpdateResponse -> ShowS
[CreateOTAUpdateResponse] -> ShowS
CreateOTAUpdateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateOTAUpdateResponse] -> ShowS
$cshowList :: [CreateOTAUpdateResponse] -> ShowS
show :: CreateOTAUpdateResponse -> String
$cshow :: CreateOTAUpdateResponse -> String
showsPrec :: Int -> CreateOTAUpdateResponse -> ShowS
$cshowsPrec :: Int -> CreateOTAUpdateResponse -> ShowS
Prelude.Show, forall x. Rep CreateOTAUpdateResponse x -> CreateOTAUpdateResponse
forall x. CreateOTAUpdateResponse -> Rep CreateOTAUpdateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateOTAUpdateResponse x -> CreateOTAUpdateResponse
$cfrom :: forall x. CreateOTAUpdateResponse -> Rep CreateOTAUpdateResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateOTAUpdateResponse' 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:
--
-- 'awsIotJobArn', 'createOTAUpdateResponse_awsIotJobArn' - The IoT job ARN associated with the OTA update.
--
-- 'awsIotJobId', 'createOTAUpdateResponse_awsIotJobId' - The IoT job ID associated with the OTA update.
--
-- 'otaUpdateArn', 'createOTAUpdateResponse_otaUpdateArn' - The OTA update ARN.
--
-- 'otaUpdateId', 'createOTAUpdateResponse_otaUpdateId' - The OTA update ID.
--
-- 'otaUpdateStatus', 'createOTAUpdateResponse_otaUpdateStatus' - The OTA update status.
--
-- 'httpStatus', 'createOTAUpdateResponse_httpStatus' - The response's http status code.
newCreateOTAUpdateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateOTAUpdateResponse
newCreateOTAUpdateResponse :: Int -> CreateOTAUpdateResponse
newCreateOTAUpdateResponse Int
pHttpStatus_ =
  CreateOTAUpdateResponse'
    { $sel:awsIotJobArn:CreateOTAUpdateResponse' :: Maybe Text
awsIotJobArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:awsIotJobId:CreateOTAUpdateResponse' :: Maybe Text
awsIotJobId = forall a. Maybe a
Prelude.Nothing,
      $sel:otaUpdateArn:CreateOTAUpdateResponse' :: Maybe Text
otaUpdateArn = forall a. Maybe a
Prelude.Nothing,
      $sel:otaUpdateId:CreateOTAUpdateResponse' :: Maybe Text
otaUpdateId = forall a. Maybe a
Prelude.Nothing,
      $sel:otaUpdateStatus:CreateOTAUpdateResponse' :: Maybe OTAUpdateStatus
otaUpdateStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateOTAUpdateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The IoT job ARN associated with the OTA update.
createOTAUpdateResponse_awsIotJobArn :: Lens.Lens' CreateOTAUpdateResponse (Prelude.Maybe Prelude.Text)
createOTAUpdateResponse_awsIotJobArn :: Lens' CreateOTAUpdateResponse (Maybe Text)
createOTAUpdateResponse_awsIotJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdateResponse' {Maybe Text
awsIotJobArn :: Maybe Text
$sel:awsIotJobArn:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
awsIotJobArn} -> Maybe Text
awsIotJobArn) (\s :: CreateOTAUpdateResponse
s@CreateOTAUpdateResponse' {} Maybe Text
a -> CreateOTAUpdateResponse
s {$sel:awsIotJobArn:CreateOTAUpdateResponse' :: Maybe Text
awsIotJobArn = Maybe Text
a} :: CreateOTAUpdateResponse)

-- | The IoT job ID associated with the OTA update.
createOTAUpdateResponse_awsIotJobId :: Lens.Lens' CreateOTAUpdateResponse (Prelude.Maybe Prelude.Text)
createOTAUpdateResponse_awsIotJobId :: Lens' CreateOTAUpdateResponse (Maybe Text)
createOTAUpdateResponse_awsIotJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdateResponse' {Maybe Text
awsIotJobId :: Maybe Text
$sel:awsIotJobId:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
awsIotJobId} -> Maybe Text
awsIotJobId) (\s :: CreateOTAUpdateResponse
s@CreateOTAUpdateResponse' {} Maybe Text
a -> CreateOTAUpdateResponse
s {$sel:awsIotJobId:CreateOTAUpdateResponse' :: Maybe Text
awsIotJobId = Maybe Text
a} :: CreateOTAUpdateResponse)

-- | The OTA update ARN.
createOTAUpdateResponse_otaUpdateArn :: Lens.Lens' CreateOTAUpdateResponse (Prelude.Maybe Prelude.Text)
createOTAUpdateResponse_otaUpdateArn :: Lens' CreateOTAUpdateResponse (Maybe Text)
createOTAUpdateResponse_otaUpdateArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdateResponse' {Maybe Text
otaUpdateArn :: Maybe Text
$sel:otaUpdateArn:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
otaUpdateArn} -> Maybe Text
otaUpdateArn) (\s :: CreateOTAUpdateResponse
s@CreateOTAUpdateResponse' {} Maybe Text
a -> CreateOTAUpdateResponse
s {$sel:otaUpdateArn:CreateOTAUpdateResponse' :: Maybe Text
otaUpdateArn = Maybe Text
a} :: CreateOTAUpdateResponse)

-- | The OTA update ID.
createOTAUpdateResponse_otaUpdateId :: Lens.Lens' CreateOTAUpdateResponse (Prelude.Maybe Prelude.Text)
createOTAUpdateResponse_otaUpdateId :: Lens' CreateOTAUpdateResponse (Maybe Text)
createOTAUpdateResponse_otaUpdateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdateResponse' {Maybe Text
otaUpdateId :: Maybe Text
$sel:otaUpdateId:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
otaUpdateId} -> Maybe Text
otaUpdateId) (\s :: CreateOTAUpdateResponse
s@CreateOTAUpdateResponse' {} Maybe Text
a -> CreateOTAUpdateResponse
s {$sel:otaUpdateId:CreateOTAUpdateResponse' :: Maybe Text
otaUpdateId = Maybe Text
a} :: CreateOTAUpdateResponse)

-- | The OTA update status.
createOTAUpdateResponse_otaUpdateStatus :: Lens.Lens' CreateOTAUpdateResponse (Prelude.Maybe OTAUpdateStatus)
createOTAUpdateResponse_otaUpdateStatus :: Lens' CreateOTAUpdateResponse (Maybe OTAUpdateStatus)
createOTAUpdateResponse_otaUpdateStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateOTAUpdateResponse' {Maybe OTAUpdateStatus
otaUpdateStatus :: Maybe OTAUpdateStatus
$sel:otaUpdateStatus:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe OTAUpdateStatus
otaUpdateStatus} -> Maybe OTAUpdateStatus
otaUpdateStatus) (\s :: CreateOTAUpdateResponse
s@CreateOTAUpdateResponse' {} Maybe OTAUpdateStatus
a -> CreateOTAUpdateResponse
s {$sel:otaUpdateStatus:CreateOTAUpdateResponse' :: Maybe OTAUpdateStatus
otaUpdateStatus = Maybe OTAUpdateStatus
a} :: CreateOTAUpdateResponse)

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

instance Prelude.NFData CreateOTAUpdateResponse where
  rnf :: CreateOTAUpdateResponse -> ()
rnf CreateOTAUpdateResponse' {Int
Maybe Text
Maybe OTAUpdateStatus
httpStatus :: Int
otaUpdateStatus :: Maybe OTAUpdateStatus
otaUpdateId :: Maybe Text
otaUpdateArn :: Maybe Text
awsIotJobId :: Maybe Text
awsIotJobArn :: Maybe Text
$sel:httpStatus:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Int
$sel:otaUpdateStatus:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe OTAUpdateStatus
$sel:otaUpdateId:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
$sel:otaUpdateArn:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
$sel:awsIotJobId:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
$sel:awsIotJobArn:CreateOTAUpdateResponse' :: CreateOTAUpdateResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
awsIotJobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
awsIotJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
otaUpdateArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
otaUpdateId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OTAUpdateStatus
otaUpdateStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus