{-# 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.Snowball.Types.ClusterMetadata
-- 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.Snowball.Types.ClusterMetadata 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 Amazonka.Snowball.Types.ClusterState
import Amazonka.Snowball.Types.JobResource
import Amazonka.Snowball.Types.JobType
import Amazonka.Snowball.Types.Notification
import Amazonka.Snowball.Types.OnDeviceServiceConfiguration
import Amazonka.Snowball.Types.ShippingOption
import Amazonka.Snowball.Types.SnowballType
import Amazonka.Snowball.Types.TaxDocuments

-- | Contains metadata about a specific cluster.
--
-- /See:/ 'newClusterMetadata' smart constructor.
data ClusterMetadata = ClusterMetadata'
  { -- | The automatically generated ID for a specific address.
    ClusterMetadata -> Maybe Text
addressId :: Prelude.Maybe Prelude.Text,
    -- | The automatically generated ID for a cluster.
    ClusterMetadata -> Maybe Text
clusterId :: Prelude.Maybe Prelude.Text,
    -- | The current status of the cluster.
    ClusterMetadata -> Maybe ClusterState
clusterState :: Prelude.Maybe ClusterState,
    -- | The creation date for this cluster.
    ClusterMetadata -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | The optional description of the cluster.
    ClusterMetadata -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ID of the address that you want a cluster shipped to, after it will
    -- be shipped to its primary address. This field is not supported in most
    -- regions.
    ClusterMetadata -> Maybe Text
forwardingAddressId :: Prelude.Maybe Prelude.Text,
    -- | The type of job for this cluster. Currently, the only job type supported
    -- for clusters is @LOCAL_USE@.
    ClusterMetadata -> Maybe JobType
jobType :: Prelude.Maybe JobType,
    -- | The @KmsKeyARN@ Amazon Resource Name (ARN) associated with this cluster.
    -- This ARN was created using the
    -- <https://docs.aws.amazon.com/kms/latest/APIReference/API_CreateKey.html CreateKey>
    -- API action in Key Management Service (KMS.
    ClusterMetadata -> Maybe Text
kmsKeyARN :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Simple Notification Service (Amazon SNS) notification
    -- settings for this cluster.
    ClusterMetadata -> Maybe Notification
notification :: Prelude.Maybe Notification,
    -- | Represents metadata and configuration settings for services on an Amazon
    -- Web Services Snow Family device.
    ClusterMetadata -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration :: Prelude.Maybe OnDeviceServiceConfiguration,
    -- | The arrays of JobResource objects that can include updated S3Resource
    -- objects or LambdaResource objects.
    ClusterMetadata -> Maybe JobResource
resources :: Prelude.Maybe JobResource,
    -- | The role ARN associated with this cluster. This ARN was created using
    -- the
    -- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
    -- API action in Identity and Access Management (IAM).
    ClusterMetadata -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text,
    -- | The shipping speed for each node in this cluster. This speed doesn\'t
    -- dictate how soon you\'ll get each device, rather it represents how
    -- quickly each device moves to its destination while in transit. Regional
    -- shipping speeds are as follows:
    --
    -- -   In Australia, you have access to express shipping. Typically,
    --     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.
    ClusterMetadata -> Maybe ShippingOption
shippingOption :: Prelude.Maybe ShippingOption,
    -- | The type of Snowcone device to use for this cluster.
    --
    -- For cluster jobs, Amazon Web Services Snow Family currently supports
    -- only the @EDGE@ device type.
    ClusterMetadata -> Maybe SnowballType
snowballType :: Prelude.Maybe SnowballType,
    -- | The tax documents required in your Amazon Web Services Region.
    ClusterMetadata -> Maybe TaxDocuments
taxDocuments :: Prelude.Maybe TaxDocuments
  }
  deriving (ClusterMetadata -> ClusterMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterMetadata -> ClusterMetadata -> Bool
$c/= :: ClusterMetadata -> ClusterMetadata -> Bool
== :: ClusterMetadata -> ClusterMetadata -> Bool
$c== :: ClusterMetadata -> ClusterMetadata -> Bool
Prelude.Eq, ReadPrec [ClusterMetadata]
ReadPrec ClusterMetadata
Int -> ReadS ClusterMetadata
ReadS [ClusterMetadata]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterMetadata]
$creadListPrec :: ReadPrec [ClusterMetadata]
readPrec :: ReadPrec ClusterMetadata
$creadPrec :: ReadPrec ClusterMetadata
readList :: ReadS [ClusterMetadata]
$creadList :: ReadS [ClusterMetadata]
readsPrec :: Int -> ReadS ClusterMetadata
$creadsPrec :: Int -> ReadS ClusterMetadata
Prelude.Read, Int -> ClusterMetadata -> ShowS
[ClusterMetadata] -> ShowS
ClusterMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterMetadata] -> ShowS
$cshowList :: [ClusterMetadata] -> ShowS
show :: ClusterMetadata -> String
$cshow :: ClusterMetadata -> String
showsPrec :: Int -> ClusterMetadata -> ShowS
$cshowsPrec :: Int -> ClusterMetadata -> ShowS
Prelude.Show, forall x. Rep ClusterMetadata x -> ClusterMetadata
forall x. ClusterMetadata -> Rep ClusterMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClusterMetadata x -> ClusterMetadata
$cfrom :: forall x. ClusterMetadata -> Rep ClusterMetadata x
Prelude.Generic)

-- |
-- Create a value of 'ClusterMetadata' 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', 'clusterMetadata_addressId' - The automatically generated ID for a specific address.
--
-- 'clusterId', 'clusterMetadata_clusterId' - The automatically generated ID for a cluster.
--
-- 'clusterState', 'clusterMetadata_clusterState' - The current status of the cluster.
--
-- 'creationDate', 'clusterMetadata_creationDate' - The creation date for this cluster.
--
-- 'description', 'clusterMetadata_description' - The optional description of the cluster.
--
-- 'forwardingAddressId', 'clusterMetadata_forwardingAddressId' - The ID of the address that you want a cluster shipped to, after it will
-- be shipped to its primary address. This field is not supported in most
-- regions.
--
-- 'jobType', 'clusterMetadata_jobType' - The type of job for this cluster. Currently, the only job type supported
-- for clusters is @LOCAL_USE@.
--
-- 'kmsKeyARN', 'clusterMetadata_kmsKeyARN' - The @KmsKeyARN@ Amazon Resource Name (ARN) associated with this cluster.
-- This ARN was created using the
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_CreateKey.html CreateKey>
-- API action in Key Management Service (KMS.
--
-- 'notification', 'clusterMetadata_notification' - The Amazon Simple Notification Service (Amazon SNS) notification
-- settings for this cluster.
--
-- 'onDeviceServiceConfiguration', 'clusterMetadata_onDeviceServiceConfiguration' - Represents metadata and configuration settings for services on an Amazon
-- Web Services Snow Family device.
--
-- 'resources', 'clusterMetadata_resources' - The arrays of JobResource objects that can include updated S3Resource
-- objects or LambdaResource objects.
--
-- 'roleARN', 'clusterMetadata_roleARN' - The role ARN associated with this cluster. This ARN was created using
-- the
-- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
-- API action in Identity and Access Management (IAM).
--
-- 'shippingOption', 'clusterMetadata_shippingOption' - The shipping speed for each node in this cluster. This speed doesn\'t
-- dictate how soon you\'ll get each device, rather it represents how
-- quickly each device moves to its destination while in transit. Regional
-- shipping speeds are as follows:
--
-- -   In Australia, you have access to express shipping. Typically,
--     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.
--
-- 'snowballType', 'clusterMetadata_snowballType' - The type of Snowcone device to use for this cluster.
--
-- For cluster jobs, Amazon Web Services Snow Family currently supports
-- only the @EDGE@ device type.
--
-- 'taxDocuments', 'clusterMetadata_taxDocuments' - The tax documents required in your Amazon Web Services Region.
newClusterMetadata ::
  ClusterMetadata
newClusterMetadata :: ClusterMetadata
newClusterMetadata =
  ClusterMetadata'
    { $sel:addressId:ClusterMetadata' :: Maybe Text
addressId = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterId:ClusterMetadata' :: Maybe Text
clusterId = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterState:ClusterMetadata' :: Maybe ClusterState
clusterState = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:ClusterMetadata' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:ClusterMetadata' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:forwardingAddressId:ClusterMetadata' :: Maybe Text
forwardingAddressId = forall a. Maybe a
Prelude.Nothing,
      $sel:jobType:ClusterMetadata' :: Maybe JobType
jobType = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyARN:ClusterMetadata' :: Maybe Text
kmsKeyARN = forall a. Maybe a
Prelude.Nothing,
      $sel:notification:ClusterMetadata' :: Maybe Notification
notification = forall a. Maybe a
Prelude.Nothing,
      $sel:onDeviceServiceConfiguration:ClusterMetadata' :: Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:resources:ClusterMetadata' :: Maybe JobResource
resources = forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:ClusterMetadata' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing,
      $sel:shippingOption:ClusterMetadata' :: Maybe ShippingOption
shippingOption = forall a. Maybe a
Prelude.Nothing,
      $sel:snowballType:ClusterMetadata' :: Maybe SnowballType
snowballType = forall a. Maybe a
Prelude.Nothing,
      $sel:taxDocuments:ClusterMetadata' :: Maybe TaxDocuments
taxDocuments = forall a. Maybe a
Prelude.Nothing
    }

-- | The automatically generated ID for a specific address.
clusterMetadata_addressId :: Lens.Lens' ClusterMetadata (Prelude.Maybe Prelude.Text)
clusterMetadata_addressId :: Lens' ClusterMetadata (Maybe Text)
clusterMetadata_addressId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe Text
addressId :: Maybe Text
$sel:addressId:ClusterMetadata' :: ClusterMetadata -> Maybe Text
addressId} -> Maybe Text
addressId) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe Text
a -> ClusterMetadata
s {$sel:addressId:ClusterMetadata' :: Maybe Text
addressId = Maybe Text
a} :: ClusterMetadata)

-- | The automatically generated ID for a cluster.
clusterMetadata_clusterId :: Lens.Lens' ClusterMetadata (Prelude.Maybe Prelude.Text)
clusterMetadata_clusterId :: Lens' ClusterMetadata (Maybe Text)
clusterMetadata_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe Text
clusterId :: Maybe Text
$sel:clusterId:ClusterMetadata' :: ClusterMetadata -> Maybe Text
clusterId} -> Maybe Text
clusterId) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe Text
a -> ClusterMetadata
s {$sel:clusterId:ClusterMetadata' :: Maybe Text
clusterId = Maybe Text
a} :: ClusterMetadata)

-- | The current status of the cluster.
clusterMetadata_clusterState :: Lens.Lens' ClusterMetadata (Prelude.Maybe ClusterState)
clusterMetadata_clusterState :: Lens' ClusterMetadata (Maybe ClusterState)
clusterMetadata_clusterState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe ClusterState
clusterState :: Maybe ClusterState
$sel:clusterState:ClusterMetadata' :: ClusterMetadata -> Maybe ClusterState
clusterState} -> Maybe ClusterState
clusterState) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe ClusterState
a -> ClusterMetadata
s {$sel:clusterState:ClusterMetadata' :: Maybe ClusterState
clusterState = Maybe ClusterState
a} :: ClusterMetadata)

-- | The creation date for this cluster.
clusterMetadata_creationDate :: Lens.Lens' ClusterMetadata (Prelude.Maybe Prelude.UTCTime)
clusterMetadata_creationDate :: Lens' ClusterMetadata (Maybe UTCTime)
clusterMetadata_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:ClusterMetadata' :: ClusterMetadata -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe POSIX
a -> ClusterMetadata
s {$sel:creationDate:ClusterMetadata' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: ClusterMetadata) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The optional description of the cluster.
clusterMetadata_description :: Lens.Lens' ClusterMetadata (Prelude.Maybe Prelude.Text)
clusterMetadata_description :: Lens' ClusterMetadata (Maybe Text)
clusterMetadata_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe Text
description :: Maybe Text
$sel:description:ClusterMetadata' :: ClusterMetadata -> Maybe Text
description} -> Maybe Text
description) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe Text
a -> ClusterMetadata
s {$sel:description:ClusterMetadata' :: Maybe Text
description = Maybe Text
a} :: ClusterMetadata)

-- | The ID of the address that you want a cluster shipped to, after it will
-- be shipped to its primary address. This field is not supported in most
-- regions.
clusterMetadata_forwardingAddressId :: Lens.Lens' ClusterMetadata (Prelude.Maybe Prelude.Text)
clusterMetadata_forwardingAddressId :: Lens' ClusterMetadata (Maybe Text)
clusterMetadata_forwardingAddressId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe Text
forwardingAddressId :: Maybe Text
$sel:forwardingAddressId:ClusterMetadata' :: ClusterMetadata -> Maybe Text
forwardingAddressId} -> Maybe Text
forwardingAddressId) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe Text
a -> ClusterMetadata
s {$sel:forwardingAddressId:ClusterMetadata' :: Maybe Text
forwardingAddressId = Maybe Text
a} :: ClusterMetadata)

-- | The type of job for this cluster. Currently, the only job type supported
-- for clusters is @LOCAL_USE@.
clusterMetadata_jobType :: Lens.Lens' ClusterMetadata (Prelude.Maybe JobType)
clusterMetadata_jobType :: Lens' ClusterMetadata (Maybe JobType)
clusterMetadata_jobType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe JobType
jobType :: Maybe JobType
$sel:jobType:ClusterMetadata' :: ClusterMetadata -> Maybe JobType
jobType} -> Maybe JobType
jobType) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe JobType
a -> ClusterMetadata
s {$sel:jobType:ClusterMetadata' :: Maybe JobType
jobType = Maybe JobType
a} :: ClusterMetadata)

-- | The @KmsKeyARN@ Amazon Resource Name (ARN) associated with this cluster.
-- This ARN was created using the
-- <https://docs.aws.amazon.com/kms/latest/APIReference/API_CreateKey.html CreateKey>
-- API action in Key Management Service (KMS.
clusterMetadata_kmsKeyARN :: Lens.Lens' ClusterMetadata (Prelude.Maybe Prelude.Text)
clusterMetadata_kmsKeyARN :: Lens' ClusterMetadata (Maybe Text)
clusterMetadata_kmsKeyARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe Text
kmsKeyARN :: Maybe Text
$sel:kmsKeyARN:ClusterMetadata' :: ClusterMetadata -> Maybe Text
kmsKeyARN} -> Maybe Text
kmsKeyARN) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe Text
a -> ClusterMetadata
s {$sel:kmsKeyARN:ClusterMetadata' :: Maybe Text
kmsKeyARN = Maybe Text
a} :: ClusterMetadata)

-- | The Amazon Simple Notification Service (Amazon SNS) notification
-- settings for this cluster.
clusterMetadata_notification :: Lens.Lens' ClusterMetadata (Prelude.Maybe Notification)
clusterMetadata_notification :: Lens' ClusterMetadata (Maybe Notification)
clusterMetadata_notification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe Notification
notification :: Maybe Notification
$sel:notification:ClusterMetadata' :: ClusterMetadata -> Maybe Notification
notification} -> Maybe Notification
notification) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe Notification
a -> ClusterMetadata
s {$sel:notification:ClusterMetadata' :: Maybe Notification
notification = Maybe Notification
a} :: ClusterMetadata)

-- | Represents metadata and configuration settings for services on an Amazon
-- Web Services Snow Family device.
clusterMetadata_onDeviceServiceConfiguration :: Lens.Lens' ClusterMetadata (Prelude.Maybe OnDeviceServiceConfiguration)
clusterMetadata_onDeviceServiceConfiguration :: Lens' ClusterMetadata (Maybe OnDeviceServiceConfiguration)
clusterMetadata_onDeviceServiceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
$sel:onDeviceServiceConfiguration:ClusterMetadata' :: ClusterMetadata -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration} -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe OnDeviceServiceConfiguration
a -> ClusterMetadata
s {$sel:onDeviceServiceConfiguration:ClusterMetadata' :: Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration = Maybe OnDeviceServiceConfiguration
a} :: ClusterMetadata)

-- | The arrays of JobResource objects that can include updated S3Resource
-- objects or LambdaResource objects.
clusterMetadata_resources :: Lens.Lens' ClusterMetadata (Prelude.Maybe JobResource)
clusterMetadata_resources :: Lens' ClusterMetadata (Maybe JobResource)
clusterMetadata_resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe JobResource
resources :: Maybe JobResource
$sel:resources:ClusterMetadata' :: ClusterMetadata -> Maybe JobResource
resources} -> Maybe JobResource
resources) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe JobResource
a -> ClusterMetadata
s {$sel:resources:ClusterMetadata' :: Maybe JobResource
resources = Maybe JobResource
a} :: ClusterMetadata)

-- | The role ARN associated with this cluster. This ARN was created using
-- the
-- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
-- API action in Identity and Access Management (IAM).
clusterMetadata_roleARN :: Lens.Lens' ClusterMetadata (Prelude.Maybe Prelude.Text)
clusterMetadata_roleARN :: Lens' ClusterMetadata (Maybe Text)
clusterMetadata_roleARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe Text
roleARN :: Maybe Text
$sel:roleARN:ClusterMetadata' :: ClusterMetadata -> Maybe Text
roleARN} -> Maybe Text
roleARN) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe Text
a -> ClusterMetadata
s {$sel:roleARN:ClusterMetadata' :: Maybe Text
roleARN = Maybe Text
a} :: ClusterMetadata)

-- | The shipping speed for each node in this cluster. This speed doesn\'t
-- dictate how soon you\'ll get each device, rather it represents how
-- quickly each device moves to its destination while in transit. Regional
-- shipping speeds are as follows:
--
-- -   In Australia, you have access to express shipping. Typically,
--     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.
clusterMetadata_shippingOption :: Lens.Lens' ClusterMetadata (Prelude.Maybe ShippingOption)
clusterMetadata_shippingOption :: Lens' ClusterMetadata (Maybe ShippingOption)
clusterMetadata_shippingOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe ShippingOption
shippingOption :: Maybe ShippingOption
$sel:shippingOption:ClusterMetadata' :: ClusterMetadata -> Maybe ShippingOption
shippingOption} -> Maybe ShippingOption
shippingOption) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe ShippingOption
a -> ClusterMetadata
s {$sel:shippingOption:ClusterMetadata' :: Maybe ShippingOption
shippingOption = Maybe ShippingOption
a} :: ClusterMetadata)

-- | The type of Snowcone device to use for this cluster.
--
-- For cluster jobs, Amazon Web Services Snow Family currently supports
-- only the @EDGE@ device type.
clusterMetadata_snowballType :: Lens.Lens' ClusterMetadata (Prelude.Maybe SnowballType)
clusterMetadata_snowballType :: Lens' ClusterMetadata (Maybe SnowballType)
clusterMetadata_snowballType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterMetadata' {Maybe SnowballType
snowballType :: Maybe SnowballType
$sel:snowballType:ClusterMetadata' :: ClusterMetadata -> Maybe SnowballType
snowballType} -> Maybe SnowballType
snowballType) (\s :: ClusterMetadata
s@ClusterMetadata' {} Maybe SnowballType
a -> ClusterMetadata
s {$sel:snowballType:ClusterMetadata' :: Maybe SnowballType
snowballType = Maybe SnowballType
a} :: ClusterMetadata)

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

instance Data.FromJSON ClusterMetadata where
  parseJSON :: Value -> Parser ClusterMetadata
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ClusterMetadata"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe ClusterState
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe JobType
-> Maybe Text
-> Maybe Notification
-> Maybe OnDeviceServiceConfiguration
-> Maybe JobResource
-> Maybe Text
-> Maybe ShippingOption
-> Maybe SnowballType
-> Maybe TaxDocuments
-> ClusterMetadata
ClusterMetadata'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AddressId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ClusterId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ClusterState")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CreationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ForwardingAddressId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"JobType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"KmsKeyARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Notification")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"OnDeviceServiceConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Resources")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RoleARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ShippingOption")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SnowballType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TaxDocuments")
      )

instance Prelude.Hashable ClusterMetadata where
  hashWithSalt :: Int -> ClusterMetadata -> Int
hashWithSalt Int
_salt ClusterMetadata' {Maybe Text
Maybe POSIX
Maybe ClusterState
Maybe JobType
Maybe Notification
Maybe ShippingOption
Maybe SnowballType
Maybe OnDeviceServiceConfiguration
Maybe TaxDocuments
Maybe JobResource
taxDocuments :: Maybe TaxDocuments
snowballType :: Maybe SnowballType
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
kmsKeyARN :: Maybe Text
jobType :: Maybe JobType
forwardingAddressId :: Maybe Text
description :: Maybe Text
creationDate :: Maybe POSIX
clusterState :: Maybe ClusterState
clusterId :: Maybe Text
addressId :: Maybe Text
$sel:taxDocuments:ClusterMetadata' :: ClusterMetadata -> Maybe TaxDocuments
$sel:snowballType:ClusterMetadata' :: ClusterMetadata -> Maybe SnowballType
$sel:shippingOption:ClusterMetadata' :: ClusterMetadata -> Maybe ShippingOption
$sel:roleARN:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:resources:ClusterMetadata' :: ClusterMetadata -> Maybe JobResource
$sel:onDeviceServiceConfiguration:ClusterMetadata' :: ClusterMetadata -> Maybe OnDeviceServiceConfiguration
$sel:notification:ClusterMetadata' :: ClusterMetadata -> Maybe Notification
$sel:kmsKeyARN:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:jobType:ClusterMetadata' :: ClusterMetadata -> Maybe JobType
$sel:forwardingAddressId:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:description:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:creationDate:ClusterMetadata' :: ClusterMetadata -> Maybe POSIX
$sel:clusterState:ClusterMetadata' :: ClusterMetadata -> Maybe ClusterState
$sel:clusterId:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:addressId:ClusterMetadata' :: ClusterMetadata -> 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 ClusterState
clusterState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      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 Notification
notification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration
      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 SnowballType
snowballType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TaxDocuments
taxDocuments

instance Prelude.NFData ClusterMetadata where
  rnf :: ClusterMetadata -> ()
rnf ClusterMetadata' {Maybe Text
Maybe POSIX
Maybe ClusterState
Maybe JobType
Maybe Notification
Maybe ShippingOption
Maybe SnowballType
Maybe OnDeviceServiceConfiguration
Maybe TaxDocuments
Maybe JobResource
taxDocuments :: Maybe TaxDocuments
snowballType :: Maybe SnowballType
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
kmsKeyARN :: Maybe Text
jobType :: Maybe JobType
forwardingAddressId :: Maybe Text
description :: Maybe Text
creationDate :: Maybe POSIX
clusterState :: Maybe ClusterState
clusterId :: Maybe Text
addressId :: Maybe Text
$sel:taxDocuments:ClusterMetadata' :: ClusterMetadata -> Maybe TaxDocuments
$sel:snowballType:ClusterMetadata' :: ClusterMetadata -> Maybe SnowballType
$sel:shippingOption:ClusterMetadata' :: ClusterMetadata -> Maybe ShippingOption
$sel:roleARN:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:resources:ClusterMetadata' :: ClusterMetadata -> Maybe JobResource
$sel:onDeviceServiceConfiguration:ClusterMetadata' :: ClusterMetadata -> Maybe OnDeviceServiceConfiguration
$sel:notification:ClusterMetadata' :: ClusterMetadata -> Maybe Notification
$sel:kmsKeyARN:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:jobType:ClusterMetadata' :: ClusterMetadata -> Maybe JobType
$sel:forwardingAddressId:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:description:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:creationDate:ClusterMetadata' :: ClusterMetadata -> Maybe POSIX
$sel:clusterState:ClusterMetadata' :: ClusterMetadata -> Maybe ClusterState
$sel:clusterId:ClusterMetadata' :: ClusterMetadata -> Maybe Text
$sel:addressId:ClusterMetadata' :: ClusterMetadata -> 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 ClusterState
clusterState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      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 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 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 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 SnowballType
snowballType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaxDocuments
taxDocuments