{-# 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.Snowball.CreateJob
-- 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 import or export data between Amazon S3 and your
-- on-premises data center. Your Amazon Web Services account must have the
-- right trust policies and permissions in place to create a job for a Snow
-- device. If you\'re creating a job for a node in a cluster, you only need
-- to provide the @clusterId@ value; the other job attributes are inherited
-- from the cluster.
--
-- Only the Snowball; Edge device type is supported when ordering clustered
-- jobs.
--
-- The device capacity is optional.
--
-- Availability of device types differ by Amazon Web Services Region. For
-- more information about Region availability, see
-- <https://aws.amazon.com/about-aws/global-infrastructure/regional-product-services/?p=ngi&loc=4 Amazon Web Services Regional Services>.
--
-- __Snow Family devices and their capacities.__
--
-- -   Snow Family device type: __SNC1_SSD__
--
--     -   Capacity: T14
--
--     -   Description: Snowcone
--
-- -   Snow Family device type: __SNC1_HDD__
--
--     -   Capacity: T8
--
--     -   Description: Snowcone
--
-- -   Device type: __EDGE_S__
--
--     -   Capacity: T98
--
--     -   Description: Snowball Edge Storage Optimized for data transfer
--         only
--
-- -   Device type: __EDGE_CG__
--
--     -   Capacity: T42
--
--     -   Description: Snowball Edge Compute Optimized with GPU
--
-- -   Device type: __EDGE_C__
--
--     -   Capacity: T42
--
--     -   Description: Snowball Edge Compute Optimized without GPU
--
-- -   Device type: __EDGE__
--
--     -   Capacity: T100
--
--     -   Description: Snowball Edge Storage Optimized with EC2 Compute
--
-- -   Device type: __V3_5C__
--
--     -   Capacity: T32
--
--     -   Description: Snowball Edge Compute Optimized without GPU
--
-- -   Device type: __STANDARD__
--
--     -   Capacity: T50
--
--     -   Description: Original Snowball device
--
--         This device is only available in the Ningxia, Beijing, and
--         Singapore Amazon Web Services Region
--
-- -   Device type: __STANDARD__
--
--     -   Capacity: T80
--
--     -   Description: Original Snowball device
--
--         This device is only available in the Ningxia, Beijing, and
--         Singapore Amazon Web Services Region.
module Amazonka.Snowball.CreateJob
  ( -- * Creating a Request
    CreateJob (..),
    newCreateJob,

    -- * Request Lenses
    createJob_addressId,
    createJob_clusterId,
    createJob_description,
    createJob_deviceConfiguration,
    createJob_forwardingAddressId,
    createJob_jobType,
    createJob_kmsKeyARN,
    createJob_longTermPricingId,
    createJob_notification,
    createJob_onDeviceServiceConfiguration,
    createJob_remoteManagement,
    createJob_resources,
    createJob_roleARN,
    createJob_shippingOption,
    createJob_snowballCapacityPreference,
    createJob_snowballType,
    createJob_taxDocuments,

    -- * Destructuring the Response
    CreateJobResponse (..),
    newCreateJobResponse,

    -- * Response Lenses
    createJobResponse_jobId,
    createJobResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateJob' smart constructor.
data CreateJob = CreateJob'
  { -- | The ID for the address that you want the Snow device shipped to.
    CreateJob -> Maybe Text
addressId :: Prelude.Maybe Prelude.Text,
    -- | The ID of a cluster. If you\'re creating a job for a node in a cluster,
    -- you need to provide only this @clusterId@ value. The other job
    -- attributes are inherited from the cluster.
    CreateJob -> Maybe Text
clusterId :: Prelude.Maybe Prelude.Text,
    -- | Defines an optional description of this specific job, for example
    -- @Important Photos 2016-08-11@.
    CreateJob -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Defines the device configuration for an Snowcone job.
    --
    -- For more information, see
    -- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
    -- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
    -- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
    -- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
    CreateJob -> Maybe DeviceConfiguration
deviceConfiguration :: Prelude.Maybe DeviceConfiguration,
    -- | The forwarding address ID for a job. This field is not supported in most
    -- Regions.
    CreateJob -> Maybe Text
forwardingAddressId :: Prelude.Maybe Prelude.Text,
    -- | Defines the type of job that you\'re creating.
    CreateJob -> Maybe JobType
jobType :: Prelude.Maybe JobType,
    -- | The @KmsKeyARN@ that you want to associate with this job. @KmsKeyARN@s
    -- are created using the
    -- <https://docs.aws.amazon.com/kms/latest/APIReference/API_CreateKey.html CreateKey>
    -- Key Management Service (KMS) API action.
    CreateJob -> Maybe Text
kmsKeyARN :: Prelude.Maybe Prelude.Text,
    -- | The ID of the long-term pricing type for the device.
    CreateJob -> Maybe Text
longTermPricingId :: Prelude.Maybe Prelude.Text,
    -- | Defines the Amazon Simple Notification Service (Amazon SNS) notification
    -- settings for this job.
    CreateJob -> Maybe Notification
notification :: Prelude.Maybe Notification,
    -- | Specifies the service or services on the Snow Family device that your
    -- transferred data will be exported from or imported into. Amazon Web
    -- Services Snow Family supports Amazon S3 and NFS (Network File System)
    -- and the Amazon Web Services Storage Gateway service Tape Gateway type.
    CreateJob -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration :: Prelude.Maybe OnDeviceServiceConfiguration,
    -- | Allows you to securely operate and manage Snowcone devices remotely from
    -- outside of your internal network. When set to @INSTALLED_AUTOSTART@,
    -- remote management will automatically be available when the device
    -- arrives at your location. Otherwise, you need to use the Snowball Client
    -- to manage the device.
    CreateJob -> Maybe RemoteManagement
remoteManagement :: Prelude.Maybe RemoteManagement,
    -- | Defines the Amazon S3 buckets associated with this job.
    --
    -- With @IMPORT@ jobs, you specify the bucket or buckets that your
    -- transferred data will be imported into.
    --
    -- With @EXPORT@ jobs, you specify the bucket or buckets that your
    -- transferred data will be exported from. Optionally, you can also specify
    -- a @KeyRange@ value. If you choose to export a range, you define the
    -- length of the range by providing either an inclusive @BeginMarker@
    -- value, an inclusive @EndMarker@ value, or both. Ranges are UTF-8 binary
    -- sorted.
    CreateJob -> Maybe JobResource
resources :: Prelude.Maybe JobResource,
    -- | The @RoleARN@ that you want to associate with this job. @RoleArn@s are
    -- created using the
    -- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
    -- Identity and Access Management (IAM) API action.
    CreateJob -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text,
    -- | The shipping speed for this job. This speed doesn\'t dictate how soon
    -- you\'ll get the Snow device, rather it represents how quickly the Snow
    -- device moves to its destination while in transit. Regional shipping
    -- speeds are as follows:
    --
    -- -   In Australia, you have access to express shipping. Typically, Snow
    --     devices shipped express are delivered in about a day.
    --
    -- -   In the European Union (EU), you have access to express shipping.
    --     Typically, Snow devices shipped express are delivered in about a
    --     day. In addition, most countries in the EU have access to standard
    --     shipping, which typically takes less than a week, one way.
    --
    -- -   In India, Snow devices are delivered in one to seven days.
    --
    -- -   In the US, you have access to one-day shipping and two-day shipping.
    CreateJob -> Maybe ShippingOption
shippingOption :: Prelude.Maybe ShippingOption,
    -- | If your job is being created in one of the US regions, you have the
    -- option of specifying what size Snow device you\'d like for this job. In
    -- all other regions, Snowballs come with 80 TB in storage capacity.
    --
    -- For more information, see
    -- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
    -- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
    -- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
    -- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
    CreateJob -> Maybe SnowballCapacity
snowballCapacityPreference :: Prelude.Maybe SnowballCapacity,
    -- | The type of Snow Family devices to use for this job.
    --
    -- For cluster jobs, Amazon Web Services Snow Family currently supports
    -- only the @EDGE@ device type.
    --
    -- The type of Amazon Web Services Snow device to use for this job.
    -- Currently, the only supported device type for cluster jobs is @EDGE@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/snowball/latest/developer-guide/device-differences.html Snowball Edge Device Options>
    -- in the Snowball Edge Developer Guide.
    --
    -- For more information, see
    -- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
    -- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
    -- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
    -- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
    CreateJob -> Maybe SnowballType
snowballType :: Prelude.Maybe SnowballType,
    -- | The tax documents required in your Amazon Web Services Region.
    CreateJob -> Maybe TaxDocuments
taxDocuments :: Prelude.Maybe TaxDocuments
  }
  deriving (CreateJob -> CreateJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJob -> CreateJob -> Bool
$c/= :: CreateJob -> CreateJob -> Bool
== :: CreateJob -> CreateJob -> Bool
$c== :: CreateJob -> CreateJob -> Bool
Prelude.Eq, ReadPrec [CreateJob]
ReadPrec CreateJob
Int -> ReadS CreateJob
ReadS [CreateJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJob]
$creadListPrec :: ReadPrec [CreateJob]
readPrec :: ReadPrec CreateJob
$creadPrec :: ReadPrec CreateJob
readList :: ReadS [CreateJob]
$creadList :: ReadS [CreateJob]
readsPrec :: Int -> ReadS CreateJob
$creadsPrec :: Int -> ReadS CreateJob
Prelude.Read, Int -> CreateJob -> ShowS
[CreateJob] -> ShowS
CreateJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJob] -> ShowS
$cshowList :: [CreateJob] -> ShowS
show :: CreateJob -> String
$cshow :: CreateJob -> String
showsPrec :: Int -> CreateJob -> ShowS
$cshowsPrec :: Int -> CreateJob -> ShowS
Prelude.Show, forall x. Rep CreateJob x -> CreateJob
forall x. CreateJob -> Rep CreateJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJob x -> CreateJob
$cfrom :: forall x. CreateJob -> Rep CreateJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateJob' 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:
--
-- 'addressId', 'createJob_addressId' - The ID for the address that you want the Snow device shipped to.
--
-- 'clusterId', 'createJob_clusterId' - The ID of a cluster. If you\'re creating a job for a node in a cluster,
-- you need to provide only this @clusterId@ value. The other job
-- attributes are inherited from the cluster.
--
-- 'description', 'createJob_description' - Defines an optional description of this specific job, for example
-- @Important Photos 2016-08-11@.
--
-- 'deviceConfiguration', 'createJob_deviceConfiguration' - Defines the device configuration for an Snowcone job.
--
-- For more information, see
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
--
-- 'forwardingAddressId', 'createJob_forwardingAddressId' - The forwarding address ID for a job. This field is not supported in most
-- Regions.
--
-- 'jobType', 'createJob_jobType' - Defines the type of job that you\'re creating.
--
-- 'kmsKeyARN', 'createJob_kmsKeyARN' - The @KmsKeyARN@ that you want to associate with this job. @KmsKeyARN@s
-- are created using the
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_CreateKey.html CreateKey>
-- Key Management Service (KMS) API action.
--
-- 'longTermPricingId', 'createJob_longTermPricingId' - The ID of the long-term pricing type for the device.
--
-- 'notification', 'createJob_notification' - Defines the Amazon Simple Notification Service (Amazon SNS) notification
-- settings for this job.
--
-- 'onDeviceServiceConfiguration', 'createJob_onDeviceServiceConfiguration' - Specifies the service or services on the Snow Family device that your
-- transferred data will be exported from or imported into. Amazon Web
-- Services Snow Family supports Amazon S3 and NFS (Network File System)
-- and the Amazon Web Services Storage Gateway service Tape Gateway type.
--
-- 'remoteManagement', 'createJob_remoteManagement' - Allows you to securely operate and manage Snowcone devices remotely from
-- outside of your internal network. When set to @INSTALLED_AUTOSTART@,
-- remote management will automatically be available when the device
-- arrives at your location. Otherwise, you need to use the Snowball Client
-- to manage the device.
--
-- 'resources', 'createJob_resources' - Defines the Amazon S3 buckets associated with this job.
--
-- With @IMPORT@ jobs, you specify the bucket or buckets that your
-- transferred data will be imported into.
--
-- With @EXPORT@ jobs, you specify the bucket or buckets that your
-- transferred data will be exported from. Optionally, you can also specify
-- a @KeyRange@ value. If you choose to export a range, you define the
-- length of the range by providing either an inclusive @BeginMarker@
-- value, an inclusive @EndMarker@ value, or both. Ranges are UTF-8 binary
-- sorted.
--
-- 'roleARN', 'createJob_roleARN' - The @RoleARN@ that you want to associate with this job. @RoleArn@s are
-- created using the
-- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
-- Identity and Access Management (IAM) API action.
--
-- 'shippingOption', 'createJob_shippingOption' - The shipping speed for this job. This speed doesn\'t dictate how soon
-- you\'ll get the Snow device, rather it represents how quickly the Snow
-- device moves to its destination while in transit. Regional shipping
-- speeds are as follows:
--
-- -   In Australia, you have access to express shipping. Typically, Snow
--     devices shipped express are delivered in about a day.
--
-- -   In the European Union (EU), you have access to express shipping.
--     Typically, Snow devices shipped express are delivered in about a
--     day. In addition, most countries in the EU have access to standard
--     shipping, which typically takes less than a week, one way.
--
-- -   In India, Snow devices are delivered in one to seven days.
--
-- -   In the US, you have access to one-day shipping and two-day shipping.
--
-- 'snowballCapacityPreference', 'createJob_snowballCapacityPreference' - If your job is being created in one of the US regions, you have the
-- option of specifying what size Snow device you\'d like for this job. In
-- all other regions, Snowballs come with 80 TB in storage capacity.
--
-- For more information, see
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
--
-- 'snowballType', 'createJob_snowballType' - The type of Snow Family devices to use for this job.
--
-- For cluster jobs, Amazon Web Services Snow Family currently supports
-- only the @EDGE@ device type.
--
-- The type of Amazon Web Services Snow device to use for this job.
-- Currently, the only supported device type for cluster jobs is @EDGE@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/snowball/latest/developer-guide/device-differences.html Snowball Edge Device Options>
-- in the Snowball Edge Developer Guide.
--
-- For more information, see
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
--
-- 'taxDocuments', 'createJob_taxDocuments' - The tax documents required in your Amazon Web Services Region.
newCreateJob ::
  CreateJob
newCreateJob :: CreateJob
newCreateJob =
  CreateJob'
    { $sel:addressId:CreateJob' :: Maybe Text
addressId = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterId:CreateJob' :: Maybe Text
clusterId = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateJob' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceConfiguration:CreateJob' :: Maybe DeviceConfiguration
deviceConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:forwardingAddressId:CreateJob' :: Maybe Text
forwardingAddressId = forall a. Maybe a
Prelude.Nothing,
      $sel:jobType:CreateJob' :: Maybe JobType
jobType = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyARN:CreateJob' :: Maybe Text
kmsKeyARN = forall a. Maybe a
Prelude.Nothing,
      $sel:longTermPricingId:CreateJob' :: Maybe Text
longTermPricingId = forall a. Maybe a
Prelude.Nothing,
      $sel:notification:CreateJob' :: Maybe Notification
notification = forall a. Maybe a
Prelude.Nothing,
      $sel:onDeviceServiceConfiguration:CreateJob' :: Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteManagement:CreateJob' :: Maybe RemoteManagement
remoteManagement = forall a. Maybe a
Prelude.Nothing,
      $sel:resources:CreateJob' :: Maybe JobResource
resources = forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:CreateJob' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing,
      $sel:shippingOption:CreateJob' :: Maybe ShippingOption
shippingOption = forall a. Maybe a
Prelude.Nothing,
      $sel:snowballCapacityPreference:CreateJob' :: Maybe SnowballCapacity
snowballCapacityPreference = forall a. Maybe a
Prelude.Nothing,
      $sel:snowballType:CreateJob' :: Maybe SnowballType
snowballType = forall a. Maybe a
Prelude.Nothing,
      $sel:taxDocuments:CreateJob' :: Maybe TaxDocuments
taxDocuments = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID for the address that you want the Snow device shipped to.
createJob_addressId :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_addressId :: Lens' CreateJob (Maybe Text)
createJob_addressId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
addressId :: Maybe Text
$sel:addressId:CreateJob' :: CreateJob -> Maybe Text
addressId} -> Maybe Text
addressId) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:addressId:CreateJob' :: Maybe Text
addressId = Maybe Text
a} :: CreateJob)

-- | The ID of a cluster. If you\'re creating a job for a node in a cluster,
-- you need to provide only this @clusterId@ value. The other job
-- attributes are inherited from the cluster.
createJob_clusterId :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_clusterId :: Lens' CreateJob (Maybe Text)
createJob_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
clusterId :: Maybe Text
$sel:clusterId:CreateJob' :: CreateJob -> Maybe Text
clusterId} -> Maybe Text
clusterId) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:clusterId:CreateJob' :: Maybe Text
clusterId = Maybe Text
a} :: CreateJob)

-- | Defines an optional description of this specific job, for example
-- @Important Photos 2016-08-11@.
createJob_description :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_description :: Lens' CreateJob (Maybe Text)
createJob_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
description :: Maybe Text
$sel:description:CreateJob' :: CreateJob -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:description:CreateJob' :: Maybe Text
description = Maybe Text
a} :: CreateJob)

-- | Defines the device configuration for an Snowcone job.
--
-- For more information, see
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
createJob_deviceConfiguration :: Lens.Lens' CreateJob (Prelude.Maybe DeviceConfiguration)
createJob_deviceConfiguration :: Lens' CreateJob (Maybe DeviceConfiguration)
createJob_deviceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe DeviceConfiguration
deviceConfiguration :: Maybe DeviceConfiguration
$sel:deviceConfiguration:CreateJob' :: CreateJob -> Maybe DeviceConfiguration
deviceConfiguration} -> Maybe DeviceConfiguration
deviceConfiguration) (\s :: CreateJob
s@CreateJob' {} Maybe DeviceConfiguration
a -> CreateJob
s {$sel:deviceConfiguration:CreateJob' :: Maybe DeviceConfiguration
deviceConfiguration = Maybe DeviceConfiguration
a} :: CreateJob)

-- | The forwarding address ID for a job. This field is not supported in most
-- Regions.
createJob_forwardingAddressId :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_forwardingAddressId :: Lens' CreateJob (Maybe Text)
createJob_forwardingAddressId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
forwardingAddressId :: Maybe Text
$sel:forwardingAddressId:CreateJob' :: CreateJob -> Maybe Text
forwardingAddressId} -> Maybe Text
forwardingAddressId) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:forwardingAddressId:CreateJob' :: Maybe Text
forwardingAddressId = Maybe Text
a} :: CreateJob)

-- | Defines the type of job that you\'re creating.
createJob_jobType :: Lens.Lens' CreateJob (Prelude.Maybe JobType)
createJob_jobType :: Lens' CreateJob (Maybe JobType)
createJob_jobType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe JobType
jobType :: Maybe JobType
$sel:jobType:CreateJob' :: CreateJob -> Maybe JobType
jobType} -> Maybe JobType
jobType) (\s :: CreateJob
s@CreateJob' {} Maybe JobType
a -> CreateJob
s {$sel:jobType:CreateJob' :: Maybe JobType
jobType = Maybe JobType
a} :: CreateJob)

-- | The @KmsKeyARN@ that you want to associate with this job. @KmsKeyARN@s
-- are created using the
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_CreateKey.html CreateKey>
-- Key Management Service (KMS) API action.
createJob_kmsKeyARN :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_kmsKeyARN :: Lens' CreateJob (Maybe Text)
createJob_kmsKeyARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
kmsKeyARN :: Maybe Text
$sel:kmsKeyARN:CreateJob' :: CreateJob -> Maybe Text
kmsKeyARN} -> Maybe Text
kmsKeyARN) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:kmsKeyARN:CreateJob' :: Maybe Text
kmsKeyARN = Maybe Text
a} :: CreateJob)

-- | The ID of the long-term pricing type for the device.
createJob_longTermPricingId :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_longTermPricingId :: Lens' CreateJob (Maybe Text)
createJob_longTermPricingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
longTermPricingId :: Maybe Text
$sel:longTermPricingId:CreateJob' :: CreateJob -> Maybe Text
longTermPricingId} -> Maybe Text
longTermPricingId) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:longTermPricingId:CreateJob' :: Maybe Text
longTermPricingId = Maybe Text
a} :: CreateJob)

-- | Defines the Amazon Simple Notification Service (Amazon SNS) notification
-- settings for this job.
createJob_notification :: Lens.Lens' CreateJob (Prelude.Maybe Notification)
createJob_notification :: Lens' CreateJob (Maybe Notification)
createJob_notification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Notification
notification :: Maybe Notification
$sel:notification:CreateJob' :: CreateJob -> Maybe Notification
notification} -> Maybe Notification
notification) (\s :: CreateJob
s@CreateJob' {} Maybe Notification
a -> CreateJob
s {$sel:notification:CreateJob' :: Maybe Notification
notification = Maybe Notification
a} :: CreateJob)

-- | Specifies the service or services on the Snow Family device that your
-- transferred data will be exported from or imported into. Amazon Web
-- Services Snow Family supports Amazon S3 and NFS (Network File System)
-- and the Amazon Web Services Storage Gateway service Tape Gateway type.
createJob_onDeviceServiceConfiguration :: Lens.Lens' CreateJob (Prelude.Maybe OnDeviceServiceConfiguration)
createJob_onDeviceServiceConfiguration :: Lens' CreateJob (Maybe OnDeviceServiceConfiguration)
createJob_onDeviceServiceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
$sel:onDeviceServiceConfiguration:CreateJob' :: CreateJob -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration} -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration) (\s :: CreateJob
s@CreateJob' {} Maybe OnDeviceServiceConfiguration
a -> CreateJob
s {$sel:onDeviceServiceConfiguration:CreateJob' :: Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration = Maybe OnDeviceServiceConfiguration
a} :: CreateJob)

-- | Allows you to securely operate and manage Snowcone devices remotely from
-- outside of your internal network. When set to @INSTALLED_AUTOSTART@,
-- remote management will automatically be available when the device
-- arrives at your location. Otherwise, you need to use the Snowball Client
-- to manage the device.
createJob_remoteManagement :: Lens.Lens' CreateJob (Prelude.Maybe RemoteManagement)
createJob_remoteManagement :: Lens' CreateJob (Maybe RemoteManagement)
createJob_remoteManagement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe RemoteManagement
remoteManagement :: Maybe RemoteManagement
$sel:remoteManagement:CreateJob' :: CreateJob -> Maybe RemoteManagement
remoteManagement} -> Maybe RemoteManagement
remoteManagement) (\s :: CreateJob
s@CreateJob' {} Maybe RemoteManagement
a -> CreateJob
s {$sel:remoteManagement:CreateJob' :: Maybe RemoteManagement
remoteManagement = Maybe RemoteManagement
a} :: CreateJob)

-- | Defines the Amazon S3 buckets associated with this job.
--
-- With @IMPORT@ jobs, you specify the bucket or buckets that your
-- transferred data will be imported into.
--
-- With @EXPORT@ jobs, you specify the bucket or buckets that your
-- transferred data will be exported from. Optionally, you can also specify
-- a @KeyRange@ value. If you choose to export a range, you define the
-- length of the range by providing either an inclusive @BeginMarker@
-- value, an inclusive @EndMarker@ value, or both. Ranges are UTF-8 binary
-- sorted.
createJob_resources :: Lens.Lens' CreateJob (Prelude.Maybe JobResource)
createJob_resources :: Lens' CreateJob (Maybe JobResource)
createJob_resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe JobResource
resources :: Maybe JobResource
$sel:resources:CreateJob' :: CreateJob -> Maybe JobResource
resources} -> Maybe JobResource
resources) (\s :: CreateJob
s@CreateJob' {} Maybe JobResource
a -> CreateJob
s {$sel:resources:CreateJob' :: Maybe JobResource
resources = Maybe JobResource
a} :: CreateJob)

-- | The @RoleARN@ that you want to associate with this job. @RoleArn@s are
-- created using the
-- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
-- Identity and Access Management (IAM) API action.
createJob_roleARN :: Lens.Lens' CreateJob (Prelude.Maybe Prelude.Text)
createJob_roleARN :: Lens' CreateJob (Maybe Text)
createJob_roleARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe Text
roleARN :: Maybe Text
$sel:roleARN:CreateJob' :: CreateJob -> Maybe Text
roleARN} -> Maybe Text
roleARN) (\s :: CreateJob
s@CreateJob' {} Maybe Text
a -> CreateJob
s {$sel:roleARN:CreateJob' :: Maybe Text
roleARN = Maybe Text
a} :: CreateJob)

-- | The shipping speed for this job. This speed doesn\'t dictate how soon
-- you\'ll get the Snow device, rather it represents how quickly the Snow
-- device moves to its destination while in transit. Regional shipping
-- speeds are as follows:
--
-- -   In Australia, you have access to express shipping. Typically, Snow
--     devices shipped express are delivered in about a day.
--
-- -   In the European Union (EU), you have access to express shipping.
--     Typically, Snow devices shipped express are delivered in about a
--     day. In addition, most countries in the EU have access to standard
--     shipping, which typically takes less than a week, one way.
--
-- -   In India, Snow devices are delivered in one to seven days.
--
-- -   In the US, you have access to one-day shipping and two-day shipping.
createJob_shippingOption :: Lens.Lens' CreateJob (Prelude.Maybe ShippingOption)
createJob_shippingOption :: Lens' CreateJob (Maybe ShippingOption)
createJob_shippingOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe ShippingOption
shippingOption :: Maybe ShippingOption
$sel:shippingOption:CreateJob' :: CreateJob -> Maybe ShippingOption
shippingOption} -> Maybe ShippingOption
shippingOption) (\s :: CreateJob
s@CreateJob' {} Maybe ShippingOption
a -> CreateJob
s {$sel:shippingOption:CreateJob' :: Maybe ShippingOption
shippingOption = Maybe ShippingOption
a} :: CreateJob)

-- | If your job is being created in one of the US regions, you have the
-- option of specifying what size Snow device you\'d like for this job. In
-- all other regions, Snowballs come with 80 TB in storage capacity.
--
-- For more information, see
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
createJob_snowballCapacityPreference :: Lens.Lens' CreateJob (Prelude.Maybe SnowballCapacity)
createJob_snowballCapacityPreference :: Lens' CreateJob (Maybe SnowballCapacity)
createJob_snowballCapacityPreference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe SnowballCapacity
snowballCapacityPreference :: Maybe SnowballCapacity
$sel:snowballCapacityPreference:CreateJob' :: CreateJob -> Maybe SnowballCapacity
snowballCapacityPreference} -> Maybe SnowballCapacity
snowballCapacityPreference) (\s :: CreateJob
s@CreateJob' {} Maybe SnowballCapacity
a -> CreateJob
s {$sel:snowballCapacityPreference:CreateJob' :: Maybe SnowballCapacity
snowballCapacityPreference = Maybe SnowballCapacity
a} :: CreateJob)

-- | The type of Snow Family devices to use for this job.
--
-- For cluster jobs, Amazon Web Services Snow Family currently supports
-- only the @EDGE@ device type.
--
-- The type of Amazon Web Services Snow device to use for this job.
-- Currently, the only supported device type for cluster jobs is @EDGE@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/snowball/latest/developer-guide/device-differences.html Snowball Edge Device Options>
-- in the Snowball Edge Developer Guide.
--
-- For more information, see
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/snowcone-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/ or
-- \"https:\/\/docs.aws.amazon.com\/snowball\/latest\/developer-guide\/snow-device-types.html\"
-- (Snow Family Devices and Capacity) in the /Snowcone User Guide/.
createJob_snowballType :: Lens.Lens' CreateJob (Prelude.Maybe SnowballType)
createJob_snowballType :: Lens' CreateJob (Maybe SnowballType)
createJob_snowballType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe SnowballType
snowballType :: Maybe SnowballType
$sel:snowballType:CreateJob' :: CreateJob -> Maybe SnowballType
snowballType} -> Maybe SnowballType
snowballType) (\s :: CreateJob
s@CreateJob' {} Maybe SnowballType
a -> CreateJob
s {$sel:snowballType:CreateJob' :: Maybe SnowballType
snowballType = Maybe SnowballType
a} :: CreateJob)

-- | The tax documents required in your Amazon Web Services Region.
createJob_taxDocuments :: Lens.Lens' CreateJob (Prelude.Maybe TaxDocuments)
createJob_taxDocuments :: Lens' CreateJob (Maybe TaxDocuments)
createJob_taxDocuments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJob' {Maybe TaxDocuments
taxDocuments :: Maybe TaxDocuments
$sel:taxDocuments:CreateJob' :: CreateJob -> Maybe TaxDocuments
taxDocuments} -> Maybe TaxDocuments
taxDocuments) (\s :: CreateJob
s@CreateJob' {} Maybe TaxDocuments
a -> CreateJob
s {$sel:taxDocuments:CreateJob' :: Maybe TaxDocuments
taxDocuments = Maybe TaxDocuments
a} :: CreateJob)

instance Core.AWSRequest CreateJob where
  type AWSResponse CreateJob = CreateJobResponse
  request :: (Service -> Service) -> CreateJob -> Request CreateJob
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 CreateJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateJob)))
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 -> Int -> CreateJobResponse
CreateJobResponse'
            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
"JobId")
            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 CreateJob where
  hashWithSalt :: Int -> CreateJob -> Int
hashWithSalt Int
_salt CreateJob' {Maybe Text
Maybe JobType
Maybe Notification
Maybe RemoteManagement
Maybe ShippingOption
Maybe SnowballCapacity
Maybe SnowballType
Maybe OnDeviceServiceConfiguration
Maybe TaxDocuments
Maybe JobResource
Maybe DeviceConfiguration
taxDocuments :: Maybe TaxDocuments
snowballType :: Maybe SnowballType
snowballCapacityPreference :: Maybe SnowballCapacity
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
remoteManagement :: Maybe RemoteManagement
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
longTermPricingId :: Maybe Text
kmsKeyARN :: Maybe Text
jobType :: Maybe JobType
forwardingAddressId :: Maybe Text
deviceConfiguration :: Maybe DeviceConfiguration
description :: Maybe Text
clusterId :: Maybe Text
addressId :: Maybe Text
$sel:taxDocuments:CreateJob' :: CreateJob -> Maybe TaxDocuments
$sel:snowballType:CreateJob' :: CreateJob -> Maybe SnowballType
$sel:snowballCapacityPreference:CreateJob' :: CreateJob -> Maybe SnowballCapacity
$sel:shippingOption:CreateJob' :: CreateJob -> Maybe ShippingOption
$sel:roleARN:CreateJob' :: CreateJob -> Maybe Text
$sel:resources:CreateJob' :: CreateJob -> Maybe JobResource
$sel:remoteManagement:CreateJob' :: CreateJob -> Maybe RemoteManagement
$sel:onDeviceServiceConfiguration:CreateJob' :: CreateJob -> Maybe OnDeviceServiceConfiguration
$sel:notification:CreateJob' :: CreateJob -> Maybe Notification
$sel:longTermPricingId:CreateJob' :: CreateJob -> Maybe Text
$sel:kmsKeyARN:CreateJob' :: CreateJob -> Maybe Text
$sel:jobType:CreateJob' :: CreateJob -> Maybe JobType
$sel:forwardingAddressId:CreateJob' :: CreateJob -> Maybe Text
$sel:deviceConfiguration:CreateJob' :: CreateJob -> Maybe DeviceConfiguration
$sel:description:CreateJob' :: CreateJob -> Maybe Text
$sel:clusterId:CreateJob' :: CreateJob -> Maybe Text
$sel:addressId:CreateJob' :: CreateJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
addressId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceConfiguration
deviceConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
forwardingAddressId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobType
jobType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
longTermPricingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Notification
notification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RemoteManagement
remoteManagement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe JobResource
resources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ShippingOption
shippingOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SnowballCapacity
snowballCapacityPreference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SnowballType
snowballType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaxDocuments
taxDocuments

instance Prelude.NFData CreateJob where
  rnf :: CreateJob -> ()
rnf CreateJob' {Maybe Text
Maybe JobType
Maybe Notification
Maybe RemoteManagement
Maybe ShippingOption
Maybe SnowballCapacity
Maybe SnowballType
Maybe OnDeviceServiceConfiguration
Maybe TaxDocuments
Maybe JobResource
Maybe DeviceConfiguration
taxDocuments :: Maybe TaxDocuments
snowballType :: Maybe SnowballType
snowballCapacityPreference :: Maybe SnowballCapacity
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
remoteManagement :: Maybe RemoteManagement
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
longTermPricingId :: Maybe Text
kmsKeyARN :: Maybe Text
jobType :: Maybe JobType
forwardingAddressId :: Maybe Text
deviceConfiguration :: Maybe DeviceConfiguration
description :: Maybe Text
clusterId :: Maybe Text
addressId :: Maybe Text
$sel:taxDocuments:CreateJob' :: CreateJob -> Maybe TaxDocuments
$sel:snowballType:CreateJob' :: CreateJob -> Maybe SnowballType
$sel:snowballCapacityPreference:CreateJob' :: CreateJob -> Maybe SnowballCapacity
$sel:shippingOption:CreateJob' :: CreateJob -> Maybe ShippingOption
$sel:roleARN:CreateJob' :: CreateJob -> Maybe Text
$sel:resources:CreateJob' :: CreateJob -> Maybe JobResource
$sel:remoteManagement:CreateJob' :: CreateJob -> Maybe RemoteManagement
$sel:onDeviceServiceConfiguration:CreateJob' :: CreateJob -> Maybe OnDeviceServiceConfiguration
$sel:notification:CreateJob' :: CreateJob -> Maybe Notification
$sel:longTermPricingId:CreateJob' :: CreateJob -> Maybe Text
$sel:kmsKeyARN:CreateJob' :: CreateJob -> Maybe Text
$sel:jobType:CreateJob' :: CreateJob -> Maybe JobType
$sel:forwardingAddressId:CreateJob' :: CreateJob -> Maybe Text
$sel:deviceConfiguration:CreateJob' :: CreateJob -> Maybe DeviceConfiguration
$sel:description:CreateJob' :: CreateJob -> Maybe Text
$sel:clusterId:CreateJob' :: CreateJob -> Maybe Text
$sel:addressId:CreateJob' :: CreateJob -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
addressId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterId
      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 DeviceConfiguration
deviceConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
forwardingAddressId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobType
jobType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
longTermPricingId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Notification
notification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RemoteManagement
remoteManagement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobResource
resources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ShippingOption
shippingOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SnowballCapacity
snowballCapacityPreference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SnowballType
snowballType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaxDocuments
taxDocuments

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

instance Data.ToJSON CreateJob where
  toJSON :: CreateJob -> Value
toJSON CreateJob' {Maybe Text
Maybe JobType
Maybe Notification
Maybe RemoteManagement
Maybe ShippingOption
Maybe SnowballCapacity
Maybe SnowballType
Maybe OnDeviceServiceConfiguration
Maybe TaxDocuments
Maybe JobResource
Maybe DeviceConfiguration
taxDocuments :: Maybe TaxDocuments
snowballType :: Maybe SnowballType
snowballCapacityPreference :: Maybe SnowballCapacity
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
remoteManagement :: Maybe RemoteManagement
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
longTermPricingId :: Maybe Text
kmsKeyARN :: Maybe Text
jobType :: Maybe JobType
forwardingAddressId :: Maybe Text
deviceConfiguration :: Maybe DeviceConfiguration
description :: Maybe Text
clusterId :: Maybe Text
addressId :: Maybe Text
$sel:taxDocuments:CreateJob' :: CreateJob -> Maybe TaxDocuments
$sel:snowballType:CreateJob' :: CreateJob -> Maybe SnowballType
$sel:snowballCapacityPreference:CreateJob' :: CreateJob -> Maybe SnowballCapacity
$sel:shippingOption:CreateJob' :: CreateJob -> Maybe ShippingOption
$sel:roleARN:CreateJob' :: CreateJob -> Maybe Text
$sel:resources:CreateJob' :: CreateJob -> Maybe JobResource
$sel:remoteManagement:CreateJob' :: CreateJob -> Maybe RemoteManagement
$sel:onDeviceServiceConfiguration:CreateJob' :: CreateJob -> Maybe OnDeviceServiceConfiguration
$sel:notification:CreateJob' :: CreateJob -> Maybe Notification
$sel:longTermPricingId:CreateJob' :: CreateJob -> Maybe Text
$sel:kmsKeyARN:CreateJob' :: CreateJob -> Maybe Text
$sel:jobType:CreateJob' :: CreateJob -> Maybe JobType
$sel:forwardingAddressId:CreateJob' :: CreateJob -> Maybe Text
$sel:deviceConfiguration:CreateJob' :: CreateJob -> Maybe DeviceConfiguration
$sel:description:CreateJob' :: CreateJob -> Maybe Text
$sel:clusterId:CreateJob' :: CreateJob -> Maybe Text
$sel:addressId:CreateJob' :: CreateJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AddressId" 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
addressId,
            (Key
"ClusterId" 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
clusterId,
            (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
"DeviceConfiguration" 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 DeviceConfiguration
deviceConfiguration,
            (Key
"ForwardingAddressId" 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
forwardingAddressId,
            (Key
"JobType" 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 JobType
jobType,
            (Key
"KmsKeyARN" 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
kmsKeyARN,
            (Key
"LongTermPricingId" 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
longTermPricingId,
            (Key
"Notification" 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 Notification
notification,
            (Key
"OnDeviceServiceConfiguration" 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 OnDeviceServiceConfiguration
onDeviceServiceConfiguration,
            (Key
"RemoteManagement" 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 RemoteManagement
remoteManagement,
            (Key
"Resources" 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 JobResource
resources,
            (Key
"RoleARN" 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
roleARN,
            (Key
"ShippingOption" 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 ShippingOption
shippingOption,
            (Key
"SnowballCapacityPreference" 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 SnowballCapacity
snowballCapacityPreference,
            (Key
"SnowballType" 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 SnowballType
snowballType,
            (Key
"TaxDocuments" 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 TaxDocuments
taxDocuments
          ]
      )

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

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

-- | /See:/ 'newCreateJobResponse' smart constructor.
data CreateJobResponse = CreateJobResponse'
  { -- | The automatically generated ID for a job, for example
    -- @JID123e4567-e89b-12d3-a456-426655440000@.
    CreateJobResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateJobResponse -> CreateJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateJobResponse -> CreateJobResponse -> Bool
$c/= :: CreateJobResponse -> CreateJobResponse -> Bool
== :: CreateJobResponse -> CreateJobResponse -> Bool
$c== :: CreateJobResponse -> CreateJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateJobResponse]
ReadPrec CreateJobResponse
Int -> ReadS CreateJobResponse
ReadS [CreateJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateJobResponse]
$creadListPrec :: ReadPrec [CreateJobResponse]
readPrec :: ReadPrec CreateJobResponse
$creadPrec :: ReadPrec CreateJobResponse
readList :: ReadS [CreateJobResponse]
$creadList :: ReadS [CreateJobResponse]
readsPrec :: Int -> ReadS CreateJobResponse
$creadsPrec :: Int -> ReadS CreateJobResponse
Prelude.Read, Int -> CreateJobResponse -> ShowS
[CreateJobResponse] -> ShowS
CreateJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateJobResponse] -> ShowS
$cshowList :: [CreateJobResponse] -> ShowS
show :: CreateJobResponse -> String
$cshow :: CreateJobResponse -> String
showsPrec :: Int -> CreateJobResponse -> ShowS
$cshowsPrec :: Int -> CreateJobResponse -> ShowS
Prelude.Show, forall x. Rep CreateJobResponse x -> CreateJobResponse
forall x. CreateJobResponse -> Rep CreateJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateJobResponse x -> CreateJobResponse
$cfrom :: forall x. CreateJobResponse -> Rep CreateJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateJobResponse' 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:
--
-- 'jobId', 'createJobResponse_jobId' - The automatically generated ID for a job, for example
-- @JID123e4567-e89b-12d3-a456-426655440000@.
--
-- 'httpStatus', 'createJobResponse_httpStatus' - The response's http status code.
newCreateJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateJobResponse
newCreateJobResponse :: Int -> CreateJobResponse
newCreateJobResponse Int
pHttpStatus_ =
  CreateJobResponse'
    { $sel:jobId:CreateJobResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The automatically generated ID for a job, for example
-- @JID123e4567-e89b-12d3-a456-426655440000@.
createJobResponse_jobId :: Lens.Lens' CreateJobResponse (Prelude.Maybe Prelude.Text)
createJobResponse_jobId :: Lens' CreateJobResponse (Maybe Text)
createJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateJobResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:CreateJobResponse' :: CreateJobResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: CreateJobResponse
s@CreateJobResponse' {} Maybe Text
a -> CreateJobResponse
s {$sel:jobId:CreateJobResponse' :: Maybe Text
jobId = Maybe Text
a} :: CreateJobResponse)

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

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