{-# 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.UpdateCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- While a cluster\'s @ClusterState@ value is in the @AwaitingQuorum@
-- state, you can update some of the information associated with a cluster.
-- Once the cluster changes to a different job state, usually 60 minutes
-- after the cluster being created, this action is no longer available.
module Amazonka.Snowball.UpdateCluster
  ( -- * Creating a Request
    UpdateCluster (..),
    newUpdateCluster,

    -- * Request Lenses
    updateCluster_addressId,
    updateCluster_description,
    updateCluster_forwardingAddressId,
    updateCluster_notification,
    updateCluster_onDeviceServiceConfiguration,
    updateCluster_resources,
    updateCluster_roleARN,
    updateCluster_shippingOption,
    updateCluster_clusterId,

    -- * Destructuring the Response
    UpdateClusterResponse (..),
    newUpdateClusterResponse,

    -- * Response Lenses
    updateClusterResponse_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:/ 'newUpdateCluster' smart constructor.
data UpdateCluster = UpdateCluster'
  { -- | The ID of the updated Address object.
    UpdateCluster -> Maybe Text
addressId :: Prelude.Maybe Prelude.Text,
    -- | The updated description of this cluster.
    UpdateCluster -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The updated ID for the forwarding address for a cluster. This field is
    -- not supported in most regions.
    UpdateCluster -> Maybe Text
forwardingAddressId :: Prelude.Maybe Prelude.Text,
    -- | The new or updated Notification object.
    UpdateCluster -> 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 device clusters support Amazon S3 and NFS (Network
    -- File System).
    UpdateCluster -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration :: Prelude.Maybe OnDeviceServiceConfiguration,
    -- | The updated arrays of JobResource objects that can include updated
    -- S3Resource objects or LambdaResource objects.
    UpdateCluster -> Maybe JobResource
resources :: Prelude.Maybe JobResource,
    -- | The new role Amazon Resource Name (ARN) that you want to associate with
    -- this cluster. To create a role ARN, use the
    -- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
    -- API action in Identity and Access Management (IAM).
    UpdateCluster -> Maybe Text
roleARN :: Prelude.Maybe Prelude.Text,
    -- | The updated shipping option value of this cluster\'s ShippingDetails
    -- object.
    UpdateCluster -> Maybe ShippingOption
shippingOption :: Prelude.Maybe ShippingOption,
    -- | The cluster ID of the cluster that you want to update, for example
    -- @CID123e4567-e89b-12d3-a456-426655440000@.
    UpdateCluster -> Text
clusterId :: Prelude.Text
  }
  deriving (UpdateCluster -> UpdateCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCluster -> UpdateCluster -> Bool
$c/= :: UpdateCluster -> UpdateCluster -> Bool
== :: UpdateCluster -> UpdateCluster -> Bool
$c== :: UpdateCluster -> UpdateCluster -> Bool
Prelude.Eq, ReadPrec [UpdateCluster]
ReadPrec UpdateCluster
Int -> ReadS UpdateCluster
ReadS [UpdateCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCluster]
$creadListPrec :: ReadPrec [UpdateCluster]
readPrec :: ReadPrec UpdateCluster
$creadPrec :: ReadPrec UpdateCluster
readList :: ReadS [UpdateCluster]
$creadList :: ReadS [UpdateCluster]
readsPrec :: Int -> ReadS UpdateCluster
$creadsPrec :: Int -> ReadS UpdateCluster
Prelude.Read, Int -> UpdateCluster -> ShowS
[UpdateCluster] -> ShowS
UpdateCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCluster] -> ShowS
$cshowList :: [UpdateCluster] -> ShowS
show :: UpdateCluster -> String
$cshow :: UpdateCluster -> String
showsPrec :: Int -> UpdateCluster -> ShowS
$cshowsPrec :: Int -> UpdateCluster -> ShowS
Prelude.Show, forall x. Rep UpdateCluster x -> UpdateCluster
forall x. UpdateCluster -> Rep UpdateCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCluster x -> UpdateCluster
$cfrom :: forall x. UpdateCluster -> Rep UpdateCluster x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCluster' 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', 'updateCluster_addressId' - The ID of the updated Address object.
--
-- 'description', 'updateCluster_description' - The updated description of this cluster.
--
-- 'forwardingAddressId', 'updateCluster_forwardingAddressId' - The updated ID for the forwarding address for a cluster. This field is
-- not supported in most regions.
--
-- 'notification', 'updateCluster_notification' - The new or updated Notification object.
--
-- 'onDeviceServiceConfiguration', 'updateCluster_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 device clusters support Amazon S3 and NFS (Network
-- File System).
--
-- 'resources', 'updateCluster_resources' - The updated arrays of JobResource objects that can include updated
-- S3Resource objects or LambdaResource objects.
--
-- 'roleARN', 'updateCluster_roleARN' - The new role Amazon Resource Name (ARN) that you want to associate with
-- this cluster. To create a role ARN, use the
-- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
-- API action in Identity and Access Management (IAM).
--
-- 'shippingOption', 'updateCluster_shippingOption' - The updated shipping option value of this cluster\'s ShippingDetails
-- object.
--
-- 'clusterId', 'updateCluster_clusterId' - The cluster ID of the cluster that you want to update, for example
-- @CID123e4567-e89b-12d3-a456-426655440000@.
newUpdateCluster ::
  -- | 'clusterId'
  Prelude.Text ->
  UpdateCluster
newUpdateCluster :: Text -> UpdateCluster
newUpdateCluster Text
pClusterId_ =
  UpdateCluster'
    { $sel:addressId:UpdateCluster' :: Maybe Text
addressId = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateCluster' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:forwardingAddressId:UpdateCluster' :: Maybe Text
forwardingAddressId = forall a. Maybe a
Prelude.Nothing,
      $sel:notification:UpdateCluster' :: Maybe Notification
notification = forall a. Maybe a
Prelude.Nothing,
      $sel:onDeviceServiceConfiguration:UpdateCluster' :: Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:resources:UpdateCluster' :: Maybe JobResource
resources = forall a. Maybe a
Prelude.Nothing,
      $sel:roleARN:UpdateCluster' :: Maybe Text
roleARN = forall a. Maybe a
Prelude.Nothing,
      $sel:shippingOption:UpdateCluster' :: Maybe ShippingOption
shippingOption = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterId:UpdateCluster' :: Text
clusterId = Text
pClusterId_
    }

-- | The ID of the updated Address object.
updateCluster_addressId :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_addressId :: Lens' UpdateCluster (Maybe Text)
updateCluster_addressId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
addressId :: Maybe Text
$sel:addressId:UpdateCluster' :: UpdateCluster -> Maybe Text
addressId} -> Maybe Text
addressId) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:addressId:UpdateCluster' :: Maybe Text
addressId = Maybe Text
a} :: UpdateCluster)

-- | The updated description of this cluster.
updateCluster_description :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_description :: Lens' UpdateCluster (Maybe Text)
updateCluster_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
description :: Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:description:UpdateCluster' :: Maybe Text
description = Maybe Text
a} :: UpdateCluster)

-- | The updated ID for the forwarding address for a cluster. This field is
-- not supported in most regions.
updateCluster_forwardingAddressId :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_forwardingAddressId :: Lens' UpdateCluster (Maybe Text)
updateCluster_forwardingAddressId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
forwardingAddressId :: Maybe Text
$sel:forwardingAddressId:UpdateCluster' :: UpdateCluster -> Maybe Text
forwardingAddressId} -> Maybe Text
forwardingAddressId) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:forwardingAddressId:UpdateCluster' :: Maybe Text
forwardingAddressId = Maybe Text
a} :: UpdateCluster)

-- | The new or updated Notification object.
updateCluster_notification :: Lens.Lens' UpdateCluster (Prelude.Maybe Notification)
updateCluster_notification :: Lens' UpdateCluster (Maybe Notification)
updateCluster_notification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Notification
notification :: Maybe Notification
$sel:notification:UpdateCluster' :: UpdateCluster -> Maybe Notification
notification} -> Maybe Notification
notification) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Notification
a -> UpdateCluster
s {$sel:notification:UpdateCluster' :: Maybe Notification
notification = Maybe Notification
a} :: UpdateCluster)

-- | 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 device clusters support Amazon S3 and NFS (Network
-- File System).
updateCluster_onDeviceServiceConfiguration :: Lens.Lens' UpdateCluster (Prelude.Maybe OnDeviceServiceConfiguration)
updateCluster_onDeviceServiceConfiguration :: Lens' UpdateCluster (Maybe OnDeviceServiceConfiguration)
updateCluster_onDeviceServiceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
$sel:onDeviceServiceConfiguration:UpdateCluster' :: UpdateCluster -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration} -> Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe OnDeviceServiceConfiguration
a -> UpdateCluster
s {$sel:onDeviceServiceConfiguration:UpdateCluster' :: Maybe OnDeviceServiceConfiguration
onDeviceServiceConfiguration = Maybe OnDeviceServiceConfiguration
a} :: UpdateCluster)

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

-- | The new role Amazon Resource Name (ARN) that you want to associate with
-- this cluster. To create a role ARN, use the
-- <https://docs.aws.amazon.com/IAM/latest/APIReference/API_CreateRole.html CreateRole>
-- API action in Identity and Access Management (IAM).
updateCluster_roleARN :: Lens.Lens' UpdateCluster (Prelude.Maybe Prelude.Text)
updateCluster_roleARN :: Lens' UpdateCluster (Maybe Text)
updateCluster_roleARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe Text
roleARN :: Maybe Text
$sel:roleARN:UpdateCluster' :: UpdateCluster -> Maybe Text
roleARN} -> Maybe Text
roleARN) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe Text
a -> UpdateCluster
s {$sel:roleARN:UpdateCluster' :: Maybe Text
roleARN = Maybe Text
a} :: UpdateCluster)

-- | The updated shipping option value of this cluster\'s ShippingDetails
-- object.
updateCluster_shippingOption :: Lens.Lens' UpdateCluster (Prelude.Maybe ShippingOption)
updateCluster_shippingOption :: Lens' UpdateCluster (Maybe ShippingOption)
updateCluster_shippingOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Maybe ShippingOption
shippingOption :: Maybe ShippingOption
$sel:shippingOption:UpdateCluster' :: UpdateCluster -> Maybe ShippingOption
shippingOption} -> Maybe ShippingOption
shippingOption) (\s :: UpdateCluster
s@UpdateCluster' {} Maybe ShippingOption
a -> UpdateCluster
s {$sel:shippingOption:UpdateCluster' :: Maybe ShippingOption
shippingOption = Maybe ShippingOption
a} :: UpdateCluster)

-- | The cluster ID of the cluster that you want to update, for example
-- @CID123e4567-e89b-12d3-a456-426655440000@.
updateCluster_clusterId :: Lens.Lens' UpdateCluster Prelude.Text
updateCluster_clusterId :: Lens' UpdateCluster Text
updateCluster_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCluster' {Text
clusterId :: Text
$sel:clusterId:UpdateCluster' :: UpdateCluster -> Text
clusterId} -> Text
clusterId) (\s :: UpdateCluster
s@UpdateCluster' {} Text
a -> UpdateCluster
s {$sel:clusterId:UpdateCluster' :: Text
clusterId = Text
a} :: UpdateCluster)

instance Core.AWSRequest UpdateCluster where
  type
    AWSResponse UpdateCluster =
      UpdateClusterResponse
  request :: (Service -> Service) -> UpdateCluster -> Request UpdateCluster
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 UpdateCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateCluster)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateClusterResponse
UpdateClusterResponse'
            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))
      )

instance Prelude.Hashable UpdateCluster where
  hashWithSalt :: Int -> UpdateCluster -> Int
hashWithSalt Int
_salt UpdateCluster' {Maybe Text
Maybe Notification
Maybe ShippingOption
Maybe OnDeviceServiceConfiguration
Maybe JobResource
Text
clusterId :: Text
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
forwardingAddressId :: Maybe Text
description :: Maybe Text
addressId :: Maybe Text
$sel:clusterId:UpdateCluster' :: UpdateCluster -> Text
$sel:shippingOption:UpdateCluster' :: UpdateCluster -> Maybe ShippingOption
$sel:roleARN:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:resources:UpdateCluster' :: UpdateCluster -> Maybe JobResource
$sel:onDeviceServiceConfiguration:UpdateCluster' :: UpdateCluster -> Maybe OnDeviceServiceConfiguration
$sel:notification:UpdateCluster' :: UpdateCluster -> Maybe Notification
$sel:forwardingAddressId:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:addressId:UpdateCluster' :: UpdateCluster -> 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
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
forwardingAddressId
      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` Text
clusterId

instance Prelude.NFData UpdateCluster where
  rnf :: UpdateCluster -> ()
rnf UpdateCluster' {Maybe Text
Maybe Notification
Maybe ShippingOption
Maybe OnDeviceServiceConfiguration
Maybe JobResource
Text
clusterId :: Text
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
forwardingAddressId :: Maybe Text
description :: Maybe Text
addressId :: Maybe Text
$sel:clusterId:UpdateCluster' :: UpdateCluster -> Text
$sel:shippingOption:UpdateCluster' :: UpdateCluster -> Maybe ShippingOption
$sel:roleARN:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:resources:UpdateCluster' :: UpdateCluster -> Maybe JobResource
$sel:onDeviceServiceConfiguration:UpdateCluster' :: UpdateCluster -> Maybe OnDeviceServiceConfiguration
$sel:notification:UpdateCluster' :: UpdateCluster -> Maybe Notification
$sel:forwardingAddressId:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:addressId:UpdateCluster' :: UpdateCluster -> 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
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 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 Text
clusterId

instance Data.ToHeaders UpdateCluster where
  toHeaders :: UpdateCluster -> 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.UpdateCluster" ::
                          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 UpdateCluster where
  toJSON :: UpdateCluster -> Value
toJSON UpdateCluster' {Maybe Text
Maybe Notification
Maybe ShippingOption
Maybe OnDeviceServiceConfiguration
Maybe JobResource
Text
clusterId :: Text
shippingOption :: Maybe ShippingOption
roleARN :: Maybe Text
resources :: Maybe JobResource
onDeviceServiceConfiguration :: Maybe OnDeviceServiceConfiguration
notification :: Maybe Notification
forwardingAddressId :: Maybe Text
description :: Maybe Text
addressId :: Maybe Text
$sel:clusterId:UpdateCluster' :: UpdateCluster -> Text
$sel:shippingOption:UpdateCluster' :: UpdateCluster -> Maybe ShippingOption
$sel:roleARN:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:resources:UpdateCluster' :: UpdateCluster -> Maybe JobResource
$sel:onDeviceServiceConfiguration:UpdateCluster' :: UpdateCluster -> Maybe OnDeviceServiceConfiguration
$sel:notification:UpdateCluster' :: UpdateCluster -> Maybe Notification
$sel:forwardingAddressId:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:description:UpdateCluster' :: UpdateCluster -> Maybe Text
$sel:addressId:UpdateCluster' :: UpdateCluster -> 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
"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
"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
"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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateClusterResponse' 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', 'updateClusterResponse_httpStatus' - The response's http status code.
newUpdateClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateClusterResponse
newUpdateClusterResponse :: Int -> UpdateClusterResponse
newUpdateClusterResponse Int
pHttpStatus_ =
  UpdateClusterResponse' {$sel:httpStatus:UpdateClusterResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateClusterResponse where
  rnf :: UpdateClusterResponse -> ()
rnf UpdateClusterResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateClusterResponse' :: UpdateClusterResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus