{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Panorama.Types.DeviceJobConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Panorama.Types.DeviceJobConfig where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Panorama.Types.OTAJobConfig
import qualified Amazonka.Prelude as Prelude

-- | A job\'s configuration.
--
-- /See:/ 'newDeviceJobConfig' smart constructor.
data DeviceJobConfig = DeviceJobConfig'
  { -- | A configuration for an over-the-air (OTA) upgrade. Required for OTA
    -- jobs.
    DeviceJobConfig -> Maybe OTAJobConfig
oTAJobConfig :: Prelude.Maybe OTAJobConfig
  }
  deriving (DeviceJobConfig -> DeviceJobConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeviceJobConfig -> DeviceJobConfig -> Bool
$c/= :: DeviceJobConfig -> DeviceJobConfig -> Bool
== :: DeviceJobConfig -> DeviceJobConfig -> Bool
$c== :: DeviceJobConfig -> DeviceJobConfig -> Bool
Prelude.Eq, ReadPrec [DeviceJobConfig]
ReadPrec DeviceJobConfig
Int -> ReadS DeviceJobConfig
ReadS [DeviceJobConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeviceJobConfig]
$creadListPrec :: ReadPrec [DeviceJobConfig]
readPrec :: ReadPrec DeviceJobConfig
$creadPrec :: ReadPrec DeviceJobConfig
readList :: ReadS [DeviceJobConfig]
$creadList :: ReadS [DeviceJobConfig]
readsPrec :: Int -> ReadS DeviceJobConfig
$creadsPrec :: Int -> ReadS DeviceJobConfig
Prelude.Read, Int -> DeviceJobConfig -> ShowS
[DeviceJobConfig] -> ShowS
DeviceJobConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeviceJobConfig] -> ShowS
$cshowList :: [DeviceJobConfig] -> ShowS
show :: DeviceJobConfig -> String
$cshow :: DeviceJobConfig -> String
showsPrec :: Int -> DeviceJobConfig -> ShowS
$cshowsPrec :: Int -> DeviceJobConfig -> ShowS
Prelude.Show, forall x. Rep DeviceJobConfig x -> DeviceJobConfig
forall x. DeviceJobConfig -> Rep DeviceJobConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeviceJobConfig x -> DeviceJobConfig
$cfrom :: forall x. DeviceJobConfig -> Rep DeviceJobConfig x
Prelude.Generic)

-- |
-- Create a value of 'DeviceJobConfig' 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:
--
-- 'oTAJobConfig', 'deviceJobConfig_oTAJobConfig' - A configuration for an over-the-air (OTA) upgrade. Required for OTA
-- jobs.
newDeviceJobConfig ::
  DeviceJobConfig
newDeviceJobConfig :: DeviceJobConfig
newDeviceJobConfig =
  DeviceJobConfig' {$sel:oTAJobConfig:DeviceJobConfig' :: Maybe OTAJobConfig
oTAJobConfig = forall a. Maybe a
Prelude.Nothing}

-- | A configuration for an over-the-air (OTA) upgrade. Required for OTA
-- jobs.
deviceJobConfig_oTAJobConfig :: Lens.Lens' DeviceJobConfig (Prelude.Maybe OTAJobConfig)
deviceJobConfig_oTAJobConfig :: Lens' DeviceJobConfig (Maybe OTAJobConfig)
deviceJobConfig_oTAJobConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeviceJobConfig' {Maybe OTAJobConfig
oTAJobConfig :: Maybe OTAJobConfig
$sel:oTAJobConfig:DeviceJobConfig' :: DeviceJobConfig -> Maybe OTAJobConfig
oTAJobConfig} -> Maybe OTAJobConfig
oTAJobConfig) (\s :: DeviceJobConfig
s@DeviceJobConfig' {} Maybe OTAJobConfig
a -> DeviceJobConfig
s {$sel:oTAJobConfig:DeviceJobConfig' :: Maybe OTAJobConfig
oTAJobConfig = Maybe OTAJobConfig
a} :: DeviceJobConfig)

instance Prelude.Hashable DeviceJobConfig where
  hashWithSalt :: Int -> DeviceJobConfig -> Int
hashWithSalt Int
_salt DeviceJobConfig' {Maybe OTAJobConfig
oTAJobConfig :: Maybe OTAJobConfig
$sel:oTAJobConfig:DeviceJobConfig' :: DeviceJobConfig -> Maybe OTAJobConfig
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OTAJobConfig
oTAJobConfig

instance Prelude.NFData DeviceJobConfig where
  rnf :: DeviceJobConfig -> ()
rnf DeviceJobConfig' {Maybe OTAJobConfig
oTAJobConfig :: Maybe OTAJobConfig
$sel:oTAJobConfig:DeviceJobConfig' :: DeviceJobConfig -> Maybe OTAJobConfig
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe OTAJobConfig
oTAJobConfig

instance Data.ToJSON DeviceJobConfig where
  toJSON :: DeviceJobConfig -> Value
toJSON DeviceJobConfig' {Maybe OTAJobConfig
oTAJobConfig :: Maybe OTAJobConfig
$sel:oTAJobConfig:DeviceJobConfig' :: DeviceJobConfig -> Maybe OTAJobConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"OTAJobConfig" 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 OTAJobConfig
oTAJobConfig]
      )