{-# 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.Greengrass.CreateSoftwareUpdateJob
-- 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 software update for a core or group of cores (specified as an
-- IoT thing group.) Use this to update the OTA Agent as well as the
-- Greengrass core software. It makes use of the IoT Jobs feature which
-- provides additional commands to manage a Greengrass core software update
-- job.
module Amazonka.Greengrass.CreateSoftwareUpdateJob
  ( -- * Creating a Request
    CreateSoftwareUpdateJob (..),
    newCreateSoftwareUpdateJob,

    -- * Request Lenses
    createSoftwareUpdateJob_amznClientToken,
    createSoftwareUpdateJob_updateAgentLogLevel,
    createSoftwareUpdateJob_s3UrlSignerRole,
    createSoftwareUpdateJob_updateTargetsArchitecture,
    createSoftwareUpdateJob_softwareToUpdate,
    createSoftwareUpdateJob_updateTargets,
    createSoftwareUpdateJob_updateTargetsOperatingSystem,

    -- * Destructuring the Response
    CreateSoftwareUpdateJobResponse (..),
    newCreateSoftwareUpdateJobResponse,

    -- * Response Lenses
    createSoftwareUpdateJobResponse_iotJobArn,
    createSoftwareUpdateJobResponse_iotJobId,
    createSoftwareUpdateJobResponse_platformSoftwareVersion,
    createSoftwareUpdateJobResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateSoftwareUpdateJob' smart constructor.
data CreateSoftwareUpdateJob = CreateSoftwareUpdateJob'
  { -- | A client token used to correlate requests and responses.
    CreateSoftwareUpdateJob -> Maybe Text
amznClientToken :: Prelude.Maybe Prelude.Text,
    CreateSoftwareUpdateJob -> Maybe UpdateAgentLogLevel
updateAgentLogLevel :: Prelude.Maybe UpdateAgentLogLevel,
    CreateSoftwareUpdateJob -> Text
s3UrlSignerRole :: Prelude.Text,
    CreateSoftwareUpdateJob -> UpdateTargetsArchitecture
updateTargetsArchitecture :: UpdateTargetsArchitecture,
    CreateSoftwareUpdateJob -> SoftwareToUpdate
softwareToUpdate :: SoftwareToUpdate,
    CreateSoftwareUpdateJob -> [Text]
updateTargets :: [Prelude.Text],
    CreateSoftwareUpdateJob -> UpdateTargetsOperatingSystem
updateTargetsOperatingSystem :: UpdateTargetsOperatingSystem
  }
  deriving (CreateSoftwareUpdateJob -> CreateSoftwareUpdateJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSoftwareUpdateJob -> CreateSoftwareUpdateJob -> Bool
$c/= :: CreateSoftwareUpdateJob -> CreateSoftwareUpdateJob -> Bool
== :: CreateSoftwareUpdateJob -> CreateSoftwareUpdateJob -> Bool
$c== :: CreateSoftwareUpdateJob -> CreateSoftwareUpdateJob -> Bool
Prelude.Eq, ReadPrec [CreateSoftwareUpdateJob]
ReadPrec CreateSoftwareUpdateJob
Int -> ReadS CreateSoftwareUpdateJob
ReadS [CreateSoftwareUpdateJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSoftwareUpdateJob]
$creadListPrec :: ReadPrec [CreateSoftwareUpdateJob]
readPrec :: ReadPrec CreateSoftwareUpdateJob
$creadPrec :: ReadPrec CreateSoftwareUpdateJob
readList :: ReadS [CreateSoftwareUpdateJob]
$creadList :: ReadS [CreateSoftwareUpdateJob]
readsPrec :: Int -> ReadS CreateSoftwareUpdateJob
$creadsPrec :: Int -> ReadS CreateSoftwareUpdateJob
Prelude.Read, Int -> CreateSoftwareUpdateJob -> ShowS
[CreateSoftwareUpdateJob] -> ShowS
CreateSoftwareUpdateJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSoftwareUpdateJob] -> ShowS
$cshowList :: [CreateSoftwareUpdateJob] -> ShowS
show :: CreateSoftwareUpdateJob -> String
$cshow :: CreateSoftwareUpdateJob -> String
showsPrec :: Int -> CreateSoftwareUpdateJob -> ShowS
$cshowsPrec :: Int -> CreateSoftwareUpdateJob -> ShowS
Prelude.Show, forall x. Rep CreateSoftwareUpdateJob x -> CreateSoftwareUpdateJob
forall x. CreateSoftwareUpdateJob -> Rep CreateSoftwareUpdateJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSoftwareUpdateJob x -> CreateSoftwareUpdateJob
$cfrom :: forall x. CreateSoftwareUpdateJob -> Rep CreateSoftwareUpdateJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateSoftwareUpdateJob' 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:
--
-- 'amznClientToken', 'createSoftwareUpdateJob_amznClientToken' - A client token used to correlate requests and responses.
--
-- 'updateAgentLogLevel', 'createSoftwareUpdateJob_updateAgentLogLevel' - Undocumented member.
--
-- 's3UrlSignerRole', 'createSoftwareUpdateJob_s3UrlSignerRole' - Undocumented member.
--
-- 'updateTargetsArchitecture', 'createSoftwareUpdateJob_updateTargetsArchitecture' - Undocumented member.
--
-- 'softwareToUpdate', 'createSoftwareUpdateJob_softwareToUpdate' - Undocumented member.
--
-- 'updateTargets', 'createSoftwareUpdateJob_updateTargets' - Undocumented member.
--
-- 'updateTargetsOperatingSystem', 'createSoftwareUpdateJob_updateTargetsOperatingSystem' - Undocumented member.
newCreateSoftwareUpdateJob ::
  -- | 's3UrlSignerRole'
  Prelude.Text ->
  -- | 'updateTargetsArchitecture'
  UpdateTargetsArchitecture ->
  -- | 'softwareToUpdate'
  SoftwareToUpdate ->
  -- | 'updateTargetsOperatingSystem'
  UpdateTargetsOperatingSystem ->
  CreateSoftwareUpdateJob
newCreateSoftwareUpdateJob :: Text
-> UpdateTargetsArchitecture
-> SoftwareToUpdate
-> UpdateTargetsOperatingSystem
-> CreateSoftwareUpdateJob
newCreateSoftwareUpdateJob
  Text
pS3UrlSignerRole_
  UpdateTargetsArchitecture
pUpdateTargetsArchitecture_
  SoftwareToUpdate
pSoftwareToUpdate_
  UpdateTargetsOperatingSystem
pUpdateTargetsOperatingSystem_ =
    CreateSoftwareUpdateJob'
      { $sel:amznClientToken:CreateSoftwareUpdateJob' :: Maybe Text
amznClientToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:updateAgentLogLevel:CreateSoftwareUpdateJob' :: Maybe UpdateAgentLogLevel
updateAgentLogLevel = forall a. Maybe a
Prelude.Nothing,
        $sel:s3UrlSignerRole:CreateSoftwareUpdateJob' :: Text
s3UrlSignerRole = Text
pS3UrlSignerRole_,
        $sel:updateTargetsArchitecture:CreateSoftwareUpdateJob' :: UpdateTargetsArchitecture
updateTargetsArchitecture =
          UpdateTargetsArchitecture
pUpdateTargetsArchitecture_,
        $sel:softwareToUpdate:CreateSoftwareUpdateJob' :: SoftwareToUpdate
softwareToUpdate = SoftwareToUpdate
pSoftwareToUpdate_,
        $sel:updateTargets:CreateSoftwareUpdateJob' :: [Text]
updateTargets = forall a. Monoid a => a
Prelude.mempty,
        $sel:updateTargetsOperatingSystem:CreateSoftwareUpdateJob' :: UpdateTargetsOperatingSystem
updateTargetsOperatingSystem =
          UpdateTargetsOperatingSystem
pUpdateTargetsOperatingSystem_
      }

-- | A client token used to correlate requests and responses.
createSoftwareUpdateJob_amznClientToken :: Lens.Lens' CreateSoftwareUpdateJob (Prelude.Maybe Prelude.Text)
createSoftwareUpdateJob_amznClientToken :: Lens' CreateSoftwareUpdateJob (Maybe Text)
createSoftwareUpdateJob_amznClientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJob' {Maybe Text
amznClientToken :: Maybe Text
$sel:amznClientToken:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe Text
amznClientToken} -> Maybe Text
amznClientToken) (\s :: CreateSoftwareUpdateJob
s@CreateSoftwareUpdateJob' {} Maybe Text
a -> CreateSoftwareUpdateJob
s {$sel:amznClientToken:CreateSoftwareUpdateJob' :: Maybe Text
amznClientToken = Maybe Text
a} :: CreateSoftwareUpdateJob)

-- | Undocumented member.
createSoftwareUpdateJob_updateAgentLogLevel :: Lens.Lens' CreateSoftwareUpdateJob (Prelude.Maybe UpdateAgentLogLevel)
createSoftwareUpdateJob_updateAgentLogLevel :: Lens' CreateSoftwareUpdateJob (Maybe UpdateAgentLogLevel)
createSoftwareUpdateJob_updateAgentLogLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJob' {Maybe UpdateAgentLogLevel
updateAgentLogLevel :: Maybe UpdateAgentLogLevel
$sel:updateAgentLogLevel:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe UpdateAgentLogLevel
updateAgentLogLevel} -> Maybe UpdateAgentLogLevel
updateAgentLogLevel) (\s :: CreateSoftwareUpdateJob
s@CreateSoftwareUpdateJob' {} Maybe UpdateAgentLogLevel
a -> CreateSoftwareUpdateJob
s {$sel:updateAgentLogLevel:CreateSoftwareUpdateJob' :: Maybe UpdateAgentLogLevel
updateAgentLogLevel = Maybe UpdateAgentLogLevel
a} :: CreateSoftwareUpdateJob)

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

-- | Undocumented member.
createSoftwareUpdateJob_updateTargetsArchitecture :: Lens.Lens' CreateSoftwareUpdateJob UpdateTargetsArchitecture
createSoftwareUpdateJob_updateTargetsArchitecture :: Lens' CreateSoftwareUpdateJob UpdateTargetsArchitecture
createSoftwareUpdateJob_updateTargetsArchitecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJob' {UpdateTargetsArchitecture
updateTargetsArchitecture :: UpdateTargetsArchitecture
$sel:updateTargetsArchitecture:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsArchitecture
updateTargetsArchitecture} -> UpdateTargetsArchitecture
updateTargetsArchitecture) (\s :: CreateSoftwareUpdateJob
s@CreateSoftwareUpdateJob' {} UpdateTargetsArchitecture
a -> CreateSoftwareUpdateJob
s {$sel:updateTargetsArchitecture:CreateSoftwareUpdateJob' :: UpdateTargetsArchitecture
updateTargetsArchitecture = UpdateTargetsArchitecture
a} :: CreateSoftwareUpdateJob)

-- | Undocumented member.
createSoftwareUpdateJob_softwareToUpdate :: Lens.Lens' CreateSoftwareUpdateJob SoftwareToUpdate
createSoftwareUpdateJob_softwareToUpdate :: Lens' CreateSoftwareUpdateJob SoftwareToUpdate
createSoftwareUpdateJob_softwareToUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJob' {SoftwareToUpdate
softwareToUpdate :: SoftwareToUpdate
$sel:softwareToUpdate:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> SoftwareToUpdate
softwareToUpdate} -> SoftwareToUpdate
softwareToUpdate) (\s :: CreateSoftwareUpdateJob
s@CreateSoftwareUpdateJob' {} SoftwareToUpdate
a -> CreateSoftwareUpdateJob
s {$sel:softwareToUpdate:CreateSoftwareUpdateJob' :: SoftwareToUpdate
softwareToUpdate = SoftwareToUpdate
a} :: CreateSoftwareUpdateJob)

-- | Undocumented member.
createSoftwareUpdateJob_updateTargets :: Lens.Lens' CreateSoftwareUpdateJob [Prelude.Text]
createSoftwareUpdateJob_updateTargets :: Lens' CreateSoftwareUpdateJob [Text]
createSoftwareUpdateJob_updateTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJob' {[Text]
updateTargets :: [Text]
$sel:updateTargets:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> [Text]
updateTargets} -> [Text]
updateTargets) (\s :: CreateSoftwareUpdateJob
s@CreateSoftwareUpdateJob' {} [Text]
a -> CreateSoftwareUpdateJob
s {$sel:updateTargets:CreateSoftwareUpdateJob' :: [Text]
updateTargets = [Text]
a} :: CreateSoftwareUpdateJob) 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

-- | Undocumented member.
createSoftwareUpdateJob_updateTargetsOperatingSystem :: Lens.Lens' CreateSoftwareUpdateJob UpdateTargetsOperatingSystem
createSoftwareUpdateJob_updateTargetsOperatingSystem :: Lens' CreateSoftwareUpdateJob UpdateTargetsOperatingSystem
createSoftwareUpdateJob_updateTargetsOperatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJob' {UpdateTargetsOperatingSystem
updateTargetsOperatingSystem :: UpdateTargetsOperatingSystem
$sel:updateTargetsOperatingSystem:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsOperatingSystem
updateTargetsOperatingSystem} -> UpdateTargetsOperatingSystem
updateTargetsOperatingSystem) (\s :: CreateSoftwareUpdateJob
s@CreateSoftwareUpdateJob' {} UpdateTargetsOperatingSystem
a -> CreateSoftwareUpdateJob
s {$sel:updateTargetsOperatingSystem:CreateSoftwareUpdateJob' :: UpdateTargetsOperatingSystem
updateTargetsOperatingSystem = UpdateTargetsOperatingSystem
a} :: CreateSoftwareUpdateJob)

instance Core.AWSRequest CreateSoftwareUpdateJob where
  type
    AWSResponse CreateSoftwareUpdateJob =
      CreateSoftwareUpdateJobResponse
  request :: (Service -> Service)
-> CreateSoftwareUpdateJob -> Request CreateSoftwareUpdateJob
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 CreateSoftwareUpdateJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateSoftwareUpdateJob)))
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
-> Int
-> CreateSoftwareUpdateJobResponse
CreateSoftwareUpdateJobResponse'
            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
"IotJobArn")
            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
"IotJobId")
            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
"PlatformSoftwareVersion")
            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 CreateSoftwareUpdateJob where
  hashWithSalt :: Int -> CreateSoftwareUpdateJob -> Int
hashWithSalt Int
_salt CreateSoftwareUpdateJob' {[Text]
Maybe Text
Maybe UpdateAgentLogLevel
Text
SoftwareToUpdate
UpdateTargetsArchitecture
UpdateTargetsOperatingSystem
updateTargetsOperatingSystem :: UpdateTargetsOperatingSystem
updateTargets :: [Text]
softwareToUpdate :: SoftwareToUpdate
updateTargetsArchitecture :: UpdateTargetsArchitecture
s3UrlSignerRole :: Text
updateAgentLogLevel :: Maybe UpdateAgentLogLevel
amznClientToken :: Maybe Text
$sel:updateTargetsOperatingSystem:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsOperatingSystem
$sel:updateTargets:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> [Text]
$sel:softwareToUpdate:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> SoftwareToUpdate
$sel:updateTargetsArchitecture:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsArchitecture
$sel:s3UrlSignerRole:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Text
$sel:updateAgentLogLevel:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe UpdateAgentLogLevel
$sel:amznClientToken:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
amznClientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateAgentLogLevel
updateAgentLogLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
s3UrlSignerRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateTargetsArchitecture
updateTargetsArchitecture
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SoftwareToUpdate
softwareToUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
updateTargets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateTargetsOperatingSystem
updateTargetsOperatingSystem

instance Prelude.NFData CreateSoftwareUpdateJob where
  rnf :: CreateSoftwareUpdateJob -> ()
rnf CreateSoftwareUpdateJob' {[Text]
Maybe Text
Maybe UpdateAgentLogLevel
Text
SoftwareToUpdate
UpdateTargetsArchitecture
UpdateTargetsOperatingSystem
updateTargetsOperatingSystem :: UpdateTargetsOperatingSystem
updateTargets :: [Text]
softwareToUpdate :: SoftwareToUpdate
updateTargetsArchitecture :: UpdateTargetsArchitecture
s3UrlSignerRole :: Text
updateAgentLogLevel :: Maybe UpdateAgentLogLevel
amznClientToken :: Maybe Text
$sel:updateTargetsOperatingSystem:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsOperatingSystem
$sel:updateTargets:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> [Text]
$sel:softwareToUpdate:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> SoftwareToUpdate
$sel:updateTargetsArchitecture:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsArchitecture
$sel:s3UrlSignerRole:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Text
$sel:updateAgentLogLevel:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe UpdateAgentLogLevel
$sel:amznClientToken:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
amznClientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateAgentLogLevel
updateAgentLogLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
s3UrlSignerRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UpdateTargetsArchitecture
updateTargetsArchitecture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SoftwareToUpdate
softwareToUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
updateTargets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UpdateTargetsOperatingSystem
updateTargetsOperatingSystem

instance Data.ToHeaders CreateSoftwareUpdateJob where
  toHeaders :: CreateSoftwareUpdateJob -> ResponseHeaders
toHeaders CreateSoftwareUpdateJob' {[Text]
Maybe Text
Maybe UpdateAgentLogLevel
Text
SoftwareToUpdate
UpdateTargetsArchitecture
UpdateTargetsOperatingSystem
updateTargetsOperatingSystem :: UpdateTargetsOperatingSystem
updateTargets :: [Text]
softwareToUpdate :: SoftwareToUpdate
updateTargetsArchitecture :: UpdateTargetsArchitecture
s3UrlSignerRole :: Text
updateAgentLogLevel :: Maybe UpdateAgentLogLevel
amznClientToken :: Maybe Text
$sel:updateTargetsOperatingSystem:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsOperatingSystem
$sel:updateTargets:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> [Text]
$sel:softwareToUpdate:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> SoftwareToUpdate
$sel:updateTargetsArchitecture:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsArchitecture
$sel:s3UrlSignerRole:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Text
$sel:updateAgentLogLevel:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe UpdateAgentLogLevel
$sel:amznClientToken:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amzn-Client-Token" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
amznClientToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON CreateSoftwareUpdateJob where
  toJSON :: CreateSoftwareUpdateJob -> Value
toJSON CreateSoftwareUpdateJob' {[Text]
Maybe Text
Maybe UpdateAgentLogLevel
Text
SoftwareToUpdate
UpdateTargetsArchitecture
UpdateTargetsOperatingSystem
updateTargetsOperatingSystem :: UpdateTargetsOperatingSystem
updateTargets :: [Text]
softwareToUpdate :: SoftwareToUpdate
updateTargetsArchitecture :: UpdateTargetsArchitecture
s3UrlSignerRole :: Text
updateAgentLogLevel :: Maybe UpdateAgentLogLevel
amznClientToken :: Maybe Text
$sel:updateTargetsOperatingSystem:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsOperatingSystem
$sel:updateTargets:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> [Text]
$sel:softwareToUpdate:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> SoftwareToUpdate
$sel:updateTargetsArchitecture:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> UpdateTargetsArchitecture
$sel:s3UrlSignerRole:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Text
$sel:updateAgentLogLevel:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe UpdateAgentLogLevel
$sel:amznClientToken:CreateSoftwareUpdateJob' :: CreateSoftwareUpdateJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"UpdateAgentLogLevel" 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 UpdateAgentLogLevel
updateAgentLogLevel,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"S3UrlSignerRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
s3UrlSignerRole),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"UpdateTargetsArchitecture"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UpdateTargetsArchitecture
updateTargetsArchitecture
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SoftwareToUpdate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= SoftwareToUpdate
softwareToUpdate),
            forall a. a -> Maybe a
Prelude.Just (Key
"UpdateTargets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
updateTargets),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"UpdateTargetsOperatingSystem"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UpdateTargetsOperatingSystem
updateTargetsOperatingSystem
              )
          ]
      )

instance Data.ToPath CreateSoftwareUpdateJob where
  toPath :: CreateSoftwareUpdateJob -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/greengrass/updates"

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

-- | /See:/ 'newCreateSoftwareUpdateJobResponse' smart constructor.
data CreateSoftwareUpdateJobResponse = CreateSoftwareUpdateJobResponse'
  { -- | The IoT Job ARN corresponding to this update.
    CreateSoftwareUpdateJobResponse -> Maybe Text
iotJobArn :: Prelude.Maybe Prelude.Text,
    -- | The IoT Job Id corresponding to this update.
    CreateSoftwareUpdateJobResponse -> Maybe Text
iotJobId :: Prelude.Maybe Prelude.Text,
    -- | The software version installed on the device or devices after the
    -- update.
    CreateSoftwareUpdateJobResponse -> Maybe Text
platformSoftwareVersion :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateSoftwareUpdateJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSoftwareUpdateJobResponse
-> CreateSoftwareUpdateJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSoftwareUpdateJobResponse
-> CreateSoftwareUpdateJobResponse -> Bool
$c/= :: CreateSoftwareUpdateJobResponse
-> CreateSoftwareUpdateJobResponse -> Bool
== :: CreateSoftwareUpdateJobResponse
-> CreateSoftwareUpdateJobResponse -> Bool
$c== :: CreateSoftwareUpdateJobResponse
-> CreateSoftwareUpdateJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateSoftwareUpdateJobResponse]
ReadPrec CreateSoftwareUpdateJobResponse
Int -> ReadS CreateSoftwareUpdateJobResponse
ReadS [CreateSoftwareUpdateJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSoftwareUpdateJobResponse]
$creadListPrec :: ReadPrec [CreateSoftwareUpdateJobResponse]
readPrec :: ReadPrec CreateSoftwareUpdateJobResponse
$creadPrec :: ReadPrec CreateSoftwareUpdateJobResponse
readList :: ReadS [CreateSoftwareUpdateJobResponse]
$creadList :: ReadS [CreateSoftwareUpdateJobResponse]
readsPrec :: Int -> ReadS CreateSoftwareUpdateJobResponse
$creadsPrec :: Int -> ReadS CreateSoftwareUpdateJobResponse
Prelude.Read, Int -> CreateSoftwareUpdateJobResponse -> ShowS
[CreateSoftwareUpdateJobResponse] -> ShowS
CreateSoftwareUpdateJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSoftwareUpdateJobResponse] -> ShowS
$cshowList :: [CreateSoftwareUpdateJobResponse] -> ShowS
show :: CreateSoftwareUpdateJobResponse -> String
$cshow :: CreateSoftwareUpdateJobResponse -> String
showsPrec :: Int -> CreateSoftwareUpdateJobResponse -> ShowS
$cshowsPrec :: Int -> CreateSoftwareUpdateJobResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSoftwareUpdateJobResponse x
-> CreateSoftwareUpdateJobResponse
forall x.
CreateSoftwareUpdateJobResponse
-> Rep CreateSoftwareUpdateJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSoftwareUpdateJobResponse x
-> CreateSoftwareUpdateJobResponse
$cfrom :: forall x.
CreateSoftwareUpdateJobResponse
-> Rep CreateSoftwareUpdateJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSoftwareUpdateJobResponse' 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:
--
-- 'iotJobArn', 'createSoftwareUpdateJobResponse_iotJobArn' - The IoT Job ARN corresponding to this update.
--
-- 'iotJobId', 'createSoftwareUpdateJobResponse_iotJobId' - The IoT Job Id corresponding to this update.
--
-- 'platformSoftwareVersion', 'createSoftwareUpdateJobResponse_platformSoftwareVersion' - The software version installed on the device or devices after the
-- update.
--
-- 'httpStatus', 'createSoftwareUpdateJobResponse_httpStatus' - The response's http status code.
newCreateSoftwareUpdateJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSoftwareUpdateJobResponse
newCreateSoftwareUpdateJobResponse :: Int -> CreateSoftwareUpdateJobResponse
newCreateSoftwareUpdateJobResponse Int
pHttpStatus_ =
  CreateSoftwareUpdateJobResponse'
    { $sel:iotJobArn:CreateSoftwareUpdateJobResponse' :: Maybe Text
iotJobArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:iotJobId:CreateSoftwareUpdateJobResponse' :: Maybe Text
iotJobId = forall a. Maybe a
Prelude.Nothing,
      $sel:platformSoftwareVersion:CreateSoftwareUpdateJobResponse' :: Maybe Text
platformSoftwareVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSoftwareUpdateJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The IoT Job ARN corresponding to this update.
createSoftwareUpdateJobResponse_iotJobArn :: Lens.Lens' CreateSoftwareUpdateJobResponse (Prelude.Maybe Prelude.Text)
createSoftwareUpdateJobResponse_iotJobArn :: Lens' CreateSoftwareUpdateJobResponse (Maybe Text)
createSoftwareUpdateJobResponse_iotJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJobResponse' {Maybe Text
iotJobArn :: Maybe Text
$sel:iotJobArn:CreateSoftwareUpdateJobResponse' :: CreateSoftwareUpdateJobResponse -> Maybe Text
iotJobArn} -> Maybe Text
iotJobArn) (\s :: CreateSoftwareUpdateJobResponse
s@CreateSoftwareUpdateJobResponse' {} Maybe Text
a -> CreateSoftwareUpdateJobResponse
s {$sel:iotJobArn:CreateSoftwareUpdateJobResponse' :: Maybe Text
iotJobArn = Maybe Text
a} :: CreateSoftwareUpdateJobResponse)

-- | The IoT Job Id corresponding to this update.
createSoftwareUpdateJobResponse_iotJobId :: Lens.Lens' CreateSoftwareUpdateJobResponse (Prelude.Maybe Prelude.Text)
createSoftwareUpdateJobResponse_iotJobId :: Lens' CreateSoftwareUpdateJobResponse (Maybe Text)
createSoftwareUpdateJobResponse_iotJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJobResponse' {Maybe Text
iotJobId :: Maybe Text
$sel:iotJobId:CreateSoftwareUpdateJobResponse' :: CreateSoftwareUpdateJobResponse -> Maybe Text
iotJobId} -> Maybe Text
iotJobId) (\s :: CreateSoftwareUpdateJobResponse
s@CreateSoftwareUpdateJobResponse' {} Maybe Text
a -> CreateSoftwareUpdateJobResponse
s {$sel:iotJobId:CreateSoftwareUpdateJobResponse' :: Maybe Text
iotJobId = Maybe Text
a} :: CreateSoftwareUpdateJobResponse)

-- | The software version installed on the device or devices after the
-- update.
createSoftwareUpdateJobResponse_platformSoftwareVersion :: Lens.Lens' CreateSoftwareUpdateJobResponse (Prelude.Maybe Prelude.Text)
createSoftwareUpdateJobResponse_platformSoftwareVersion :: Lens' CreateSoftwareUpdateJobResponse (Maybe Text)
createSoftwareUpdateJobResponse_platformSoftwareVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSoftwareUpdateJobResponse' {Maybe Text
platformSoftwareVersion :: Maybe Text
$sel:platformSoftwareVersion:CreateSoftwareUpdateJobResponse' :: CreateSoftwareUpdateJobResponse -> Maybe Text
platformSoftwareVersion} -> Maybe Text
platformSoftwareVersion) (\s :: CreateSoftwareUpdateJobResponse
s@CreateSoftwareUpdateJobResponse' {} Maybe Text
a -> CreateSoftwareUpdateJobResponse
s {$sel:platformSoftwareVersion:CreateSoftwareUpdateJobResponse' :: Maybe Text
platformSoftwareVersion = Maybe Text
a} :: CreateSoftwareUpdateJobResponse)

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

instance
  Prelude.NFData
    CreateSoftwareUpdateJobResponse
  where
  rnf :: CreateSoftwareUpdateJobResponse -> ()
rnf CreateSoftwareUpdateJobResponse' {Int
Maybe Text
httpStatus :: Int
platformSoftwareVersion :: Maybe Text
iotJobId :: Maybe Text
iotJobArn :: Maybe Text
$sel:httpStatus:CreateSoftwareUpdateJobResponse' :: CreateSoftwareUpdateJobResponse -> Int
$sel:platformSoftwareVersion:CreateSoftwareUpdateJobResponse' :: CreateSoftwareUpdateJobResponse -> Maybe Text
$sel:iotJobId:CreateSoftwareUpdateJobResponse' :: CreateSoftwareUpdateJobResponse -> Maybe Text
$sel:iotJobArn:CreateSoftwareUpdateJobResponse' :: CreateSoftwareUpdateJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iotJobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iotJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platformSoftwareVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus