{-# 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.Panorama.CreateJobForDevices
-- 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 job to run on one or more devices. A job can update a
-- device\'s software or reboot it.
module Amazonka.Panorama.CreateJobForDevices
  ( -- * Creating a Request
    CreateJobForDevices (..),
    newCreateJobForDevices,

    -- * Request Lenses
    createJobForDevices_deviceJobConfig,
    createJobForDevices_deviceIds,
    createJobForDevices_jobType,

    -- * Destructuring the Response
    CreateJobForDevicesResponse (..),
    newCreateJobForDevicesResponse,

    -- * Response Lenses
    createJobForDevicesResponse_httpStatus,
    createJobForDevicesResponse_jobs,
  )
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateJobForDevices' smart constructor.
data CreateJobForDevices = CreateJobForDevices'
  { -- | Configuration settings for a software update job.
    CreateJobForDevices -> Maybe DeviceJobConfig
deviceJobConfig :: Prelude.Maybe DeviceJobConfig,
    -- | IDs of target devices.
    CreateJobForDevices -> NonEmpty Text
deviceIds :: Prelude.NonEmpty Prelude.Text,
    -- | The type of job to run.
    CreateJobForDevices -> JobType
jobType :: JobType
  }
  deriving (CreateJobForDevices -> CreateJobForDevices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJobForDevices -> CreateJobForDevices -> Bool
$c/= :: CreateJobForDevices -> CreateJobForDevices -> Bool
== :: CreateJobForDevices -> CreateJobForDevices -> Bool
$c== :: CreateJobForDevices -> CreateJobForDevices -> Bool
Prelude.Eq, ReadPrec [CreateJobForDevices]
ReadPrec CreateJobForDevices
Int -> ReadS CreateJobForDevices
ReadS [CreateJobForDevices]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJobForDevices]
$creadListPrec :: ReadPrec [CreateJobForDevices]
readPrec :: ReadPrec CreateJobForDevices
$creadPrec :: ReadPrec CreateJobForDevices
readList :: ReadS [CreateJobForDevices]
$creadList :: ReadS [CreateJobForDevices]
readsPrec :: Int -> ReadS CreateJobForDevices
$creadsPrec :: Int -> ReadS CreateJobForDevices
Prelude.Read, Int -> CreateJobForDevices -> ShowS
[CreateJobForDevices] -> ShowS
CreateJobForDevices -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJobForDevices] -> ShowS
$cshowList :: [CreateJobForDevices] -> ShowS
show :: CreateJobForDevices -> String
$cshow :: CreateJobForDevices -> String
showsPrec :: Int -> CreateJobForDevices -> ShowS
$cshowsPrec :: Int -> CreateJobForDevices -> ShowS
Prelude.Show, forall x. Rep CreateJobForDevices x -> CreateJobForDevices
forall x. CreateJobForDevices -> Rep CreateJobForDevices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJobForDevices x -> CreateJobForDevices
$cfrom :: forall x. CreateJobForDevices -> Rep CreateJobForDevices x
Prelude.Generic)

-- |
-- Create a value of 'CreateJobForDevices' 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:
--
-- 'deviceJobConfig', 'createJobForDevices_deviceJobConfig' - Configuration settings for a software update job.
--
-- 'deviceIds', 'createJobForDevices_deviceIds' - IDs of target devices.
--
-- 'jobType', 'createJobForDevices_jobType' - The type of job to run.
newCreateJobForDevices ::
  -- | 'deviceIds'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'jobType'
  JobType ->
  CreateJobForDevices
newCreateJobForDevices :: NonEmpty Text -> JobType -> CreateJobForDevices
newCreateJobForDevices NonEmpty Text
pDeviceIds_ JobType
pJobType_ =
  CreateJobForDevices'
    { $sel:deviceJobConfig:CreateJobForDevices' :: Maybe DeviceJobConfig
deviceJobConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deviceIds:CreateJobForDevices' :: NonEmpty Text
deviceIds = 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
pDeviceIds_,
      $sel:jobType:CreateJobForDevices' :: JobType
jobType = JobType
pJobType_
    }

-- | Configuration settings for a software update job.
createJobForDevices_deviceJobConfig :: Lens.Lens' CreateJobForDevices (Prelude.Maybe DeviceJobConfig)
createJobForDevices_deviceJobConfig :: Lens' CreateJobForDevices (Maybe DeviceJobConfig)
createJobForDevices_deviceJobConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobForDevices' {Maybe DeviceJobConfig
deviceJobConfig :: Maybe DeviceJobConfig
$sel:deviceJobConfig:CreateJobForDevices' :: CreateJobForDevices -> Maybe DeviceJobConfig
deviceJobConfig} -> Maybe DeviceJobConfig
deviceJobConfig) (\s :: CreateJobForDevices
s@CreateJobForDevices' {} Maybe DeviceJobConfig
a -> CreateJobForDevices
s {$sel:deviceJobConfig:CreateJobForDevices' :: Maybe DeviceJobConfig
deviceJobConfig = Maybe DeviceJobConfig
a} :: CreateJobForDevices)

-- | IDs of target devices.
createJobForDevices_deviceIds :: Lens.Lens' CreateJobForDevices (Prelude.NonEmpty Prelude.Text)
createJobForDevices_deviceIds :: Lens' CreateJobForDevices (NonEmpty Text)
createJobForDevices_deviceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobForDevices' {NonEmpty Text
deviceIds :: NonEmpty Text
$sel:deviceIds:CreateJobForDevices' :: CreateJobForDevices -> NonEmpty Text
deviceIds} -> NonEmpty Text
deviceIds) (\s :: CreateJobForDevices
s@CreateJobForDevices' {} NonEmpty Text
a -> CreateJobForDevices
s {$sel:deviceIds:CreateJobForDevices' :: NonEmpty Text
deviceIds = NonEmpty Text
a} :: CreateJobForDevices) 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 type of job to run.
createJobForDevices_jobType :: Lens.Lens' CreateJobForDevices JobType
createJobForDevices_jobType :: Lens' CreateJobForDevices JobType
createJobForDevices_jobType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobForDevices' {JobType
jobType :: JobType
$sel:jobType:CreateJobForDevices' :: CreateJobForDevices -> JobType
jobType} -> JobType
jobType) (\s :: CreateJobForDevices
s@CreateJobForDevices' {} JobType
a -> CreateJobForDevices
s {$sel:jobType:CreateJobForDevices' :: JobType
jobType = JobType
a} :: CreateJobForDevices)

instance Core.AWSRequest CreateJobForDevices where
  type
    AWSResponse CreateJobForDevices =
      CreateJobForDevicesResponse
  request :: (Service -> Service)
-> CreateJobForDevices -> Request CreateJobForDevices
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 CreateJobForDevices
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateJobForDevices)))
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 ->
          Int -> [Job] -> CreateJobForDevicesResponse
CreateJobForDevicesResponse'
            forall (f :: * -> *) a b. Functor 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))
            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
"Jobs" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable CreateJobForDevices where
  hashWithSalt :: Int -> CreateJobForDevices -> Int
hashWithSalt Int
_salt CreateJobForDevices' {Maybe DeviceJobConfig
NonEmpty Text
JobType
jobType :: JobType
deviceIds :: NonEmpty Text
deviceJobConfig :: Maybe DeviceJobConfig
$sel:jobType:CreateJobForDevices' :: CreateJobForDevices -> JobType
$sel:deviceIds:CreateJobForDevices' :: CreateJobForDevices -> NonEmpty Text
$sel:deviceJobConfig:CreateJobForDevices' :: CreateJobForDevices -> Maybe DeviceJobConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceJobConfig
deviceJobConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
deviceIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` JobType
jobType

instance Prelude.NFData CreateJobForDevices where
  rnf :: CreateJobForDevices -> ()
rnf CreateJobForDevices' {Maybe DeviceJobConfig
NonEmpty Text
JobType
jobType :: JobType
deviceIds :: NonEmpty Text
deviceJobConfig :: Maybe DeviceJobConfig
$sel:jobType:CreateJobForDevices' :: CreateJobForDevices -> JobType
$sel:deviceIds:CreateJobForDevices' :: CreateJobForDevices -> NonEmpty Text
$sel:deviceJobConfig:CreateJobForDevices' :: CreateJobForDevices -> Maybe DeviceJobConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceJobConfig
deviceJobConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
deviceIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobType
jobType

instance Data.ToHeaders CreateJobForDevices where
  toHeaders :: CreateJobForDevices -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateJobForDevices where
  toJSON :: CreateJobForDevices -> Value
toJSON CreateJobForDevices' {Maybe DeviceJobConfig
NonEmpty Text
JobType
jobType :: JobType
deviceIds :: NonEmpty Text
deviceJobConfig :: Maybe DeviceJobConfig
$sel:jobType:CreateJobForDevices' :: CreateJobForDevices -> JobType
$sel:deviceIds:CreateJobForDevices' :: CreateJobForDevices -> NonEmpty Text
$sel:deviceJobConfig:CreateJobForDevices' :: CreateJobForDevices -> Maybe DeviceJobConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DeviceJobConfig" 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 DeviceJobConfig
deviceJobConfig,
            forall a. a -> Maybe a
Prelude.Just (Key
"DeviceIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
deviceIds),
            forall a. a -> Maybe a
Prelude.Just (Key
"JobType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= JobType
jobType)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateJobForDevicesResponse' 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:
--
-- 'httpStatus', 'createJobForDevicesResponse_httpStatus' - The response's http status code.
--
-- 'jobs', 'createJobForDevicesResponse_jobs' - A list of jobs.
newCreateJobForDevicesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateJobForDevicesResponse
newCreateJobForDevicesResponse :: Int -> CreateJobForDevicesResponse
newCreateJobForDevicesResponse Int
pHttpStatus_ =
  CreateJobForDevicesResponse'
    { $sel:httpStatus:CreateJobForDevicesResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:jobs:CreateJobForDevicesResponse' :: [Job]
jobs = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | A list of jobs.
createJobForDevicesResponse_jobs :: Lens.Lens' CreateJobForDevicesResponse [Job]
createJobForDevicesResponse_jobs :: Lens' CreateJobForDevicesResponse [Job]
createJobForDevicesResponse_jobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobForDevicesResponse' {[Job]
jobs :: [Job]
$sel:jobs:CreateJobForDevicesResponse' :: CreateJobForDevicesResponse -> [Job]
jobs} -> [Job]
jobs) (\s :: CreateJobForDevicesResponse
s@CreateJobForDevicesResponse' {} [Job]
a -> CreateJobForDevicesResponse
s {$sel:jobs:CreateJobForDevicesResponse' :: [Job]
jobs = [Job]
a} :: CreateJobForDevicesResponse) 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

instance Prelude.NFData CreateJobForDevicesResponse where
  rnf :: CreateJobForDevicesResponse -> ()
rnf CreateJobForDevicesResponse' {Int
[Job]
jobs :: [Job]
httpStatus :: Int
$sel:jobs:CreateJobForDevicesResponse' :: CreateJobForDevicesResponse -> [Job]
$sel:httpStatus:CreateJobForDevicesResponse' :: CreateJobForDevicesResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Job]
jobs