{-# 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.StorageGateway.CreateCachediSCSIVolume
-- 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 cached volume on a specified cached volume gateway. This
-- operation is only supported in the cached volume gateway type.
--
-- Cache storage must be allocated to the gateway before you can create a
-- cached volume. Use the AddCache operation to add cache storage to a
-- gateway.
--
-- In the request, you must specify the gateway, size of the volume in
-- bytes, the iSCSI target name, an IP address on which to expose the
-- target, and a unique client token. In response, the gateway creates the
-- volume and returns information about it. This information includes the
-- volume Amazon Resource Name (ARN), its size, and the iSCSI target ARN
-- that initiators can use to connect to the volume target.
--
-- Optionally, you can provide the ARN for an existing volume as the
-- @SourceVolumeARN@ for this cached volume, which creates an exact copy of
-- the existing volume’s latest recovery point. The @VolumeSizeInBytes@
-- value must be equal to or larger than the size of the copied volume, in
-- bytes.
module Amazonka.StorageGateway.CreateCachediSCSIVolume
  ( -- * Creating a Request
    CreateCachediSCSIVolume (..),
    newCreateCachediSCSIVolume,

    -- * Request Lenses
    createCachediSCSIVolume_kmsEncrypted,
    createCachediSCSIVolume_kmsKey,
    createCachediSCSIVolume_snapshotId,
    createCachediSCSIVolume_sourceVolumeARN,
    createCachediSCSIVolume_tags,
    createCachediSCSIVolume_gatewayARN,
    createCachediSCSIVolume_volumeSizeInBytes,
    createCachediSCSIVolume_targetName,
    createCachediSCSIVolume_networkInterfaceId,
    createCachediSCSIVolume_clientToken,

    -- * Destructuring the Response
    CreateCachediSCSIVolumeResponse (..),
    newCreateCachediSCSIVolumeResponse,

    -- * Response Lenses
    createCachediSCSIVolumeResponse_targetARN,
    createCachediSCSIVolumeResponse_volumeARN,
    createCachediSCSIVolumeResponse_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.StorageGateway.Types

-- | /See:/ 'newCreateCachediSCSIVolume' smart constructor.
data CreateCachediSCSIVolume = CreateCachediSCSIVolume'
  { -- | Set to @true@ to use Amazon S3 server-side encryption with your own KMS
    -- key, or @false@ to use a key managed by Amazon S3. Optional.
    --
    -- Valid Values: @true@ | @false@
    CreateCachediSCSIVolume -> Maybe Bool
kmsEncrypted :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name (ARN) of a symmetric customer master key (CMK)
    -- used for Amazon S3 server-side encryption. Storage Gateway does not
    -- support asymmetric CMKs. This value can only be set when @KMSEncrypted@
    -- is @true@. Optional.
    CreateCachediSCSIVolume -> Maybe Text
kmsKey :: Prelude.Maybe Prelude.Text,
    -- | The snapshot ID (e.g. \"snap-1122aabb\") of the snapshot to restore as
    -- the new cached volume. Specify this field if you want to create the
    -- iSCSI storage volume from a snapshot; otherwise, do not include this
    -- field. To list snapshots for your account use
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeSnapshots.html DescribeSnapshots>
    -- in the /Amazon Elastic Compute Cloud API Reference/.
    CreateCachediSCSIVolume -> Maybe Text
snapshotId :: Prelude.Maybe Prelude.Text,
    -- | The ARN for an existing volume. Specifying this ARN makes the new volume
    -- into an exact copy of the specified existing volume\'s latest recovery
    -- point. The @VolumeSizeInBytes@ value for this new volume must be equal
    -- to or larger than the size of the existing volume, in bytes.
    CreateCachediSCSIVolume -> Maybe Text
sourceVolumeARN :: Prelude.Maybe Prelude.Text,
    -- | A list of up to 50 tags that you can assign to a cached volume. Each tag
    -- is a key-value pair.
    --
    -- Valid characters for key and value are letters, spaces, and numbers that
    -- you can represent in UTF-8 format, and the following special characters:
    -- + - = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters,
    -- and the maximum length for a tag\'s value is 256 characters.
    CreateCachediSCSIVolume -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    CreateCachediSCSIVolume -> Text
gatewayARN :: Prelude.Text,
    -- | The size of the volume in bytes.
    CreateCachediSCSIVolume -> Integer
volumeSizeInBytes :: Prelude.Integer,
    -- | The name of the iSCSI target used by an initiator to connect to a volume
    -- and used as a suffix for the target ARN. For example, specifying
    -- @TargetName@ as /myvolume/ results in the target ARN of
    -- @arn:aws:storagegateway:us-east-2:111122223333:gateway\/sgw-12A3456B\/target\/iqn.1997-05.com.amazon:myvolume@.
    -- The target name must be unique across all volumes on a gateway.
    --
    -- If you don\'t specify a value, Storage Gateway uses the value that was
    -- previously used for this volume as the new target name.
    CreateCachediSCSIVolume -> Text
targetName :: Prelude.Text,
    -- | The network interface of the gateway on which to expose the iSCSI
    -- target. Only IPv4 addresses are accepted. Use DescribeGatewayInformation
    -- to get a list of the network interfaces available on a gateway.
    --
    -- Valid Values: A valid IP address.
    CreateCachediSCSIVolume -> Text
networkInterfaceId :: Prelude.Text,
    -- | A unique identifier that you use to retry a request. If you retry a
    -- request, use the same @ClientToken@ you specified in the initial
    -- request.
    CreateCachediSCSIVolume -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateCachediSCSIVolume -> CreateCachediSCSIVolume -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCachediSCSIVolume -> CreateCachediSCSIVolume -> Bool
$c/= :: CreateCachediSCSIVolume -> CreateCachediSCSIVolume -> Bool
== :: CreateCachediSCSIVolume -> CreateCachediSCSIVolume -> Bool
$c== :: CreateCachediSCSIVolume -> CreateCachediSCSIVolume -> Bool
Prelude.Eq, ReadPrec [CreateCachediSCSIVolume]
ReadPrec CreateCachediSCSIVolume
Int -> ReadS CreateCachediSCSIVolume
ReadS [CreateCachediSCSIVolume]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCachediSCSIVolume]
$creadListPrec :: ReadPrec [CreateCachediSCSIVolume]
readPrec :: ReadPrec CreateCachediSCSIVolume
$creadPrec :: ReadPrec CreateCachediSCSIVolume
readList :: ReadS [CreateCachediSCSIVolume]
$creadList :: ReadS [CreateCachediSCSIVolume]
readsPrec :: Int -> ReadS CreateCachediSCSIVolume
$creadsPrec :: Int -> ReadS CreateCachediSCSIVolume
Prelude.Read, Int -> CreateCachediSCSIVolume -> ShowS
[CreateCachediSCSIVolume] -> ShowS
CreateCachediSCSIVolume -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCachediSCSIVolume] -> ShowS
$cshowList :: [CreateCachediSCSIVolume] -> ShowS
show :: CreateCachediSCSIVolume -> String
$cshow :: CreateCachediSCSIVolume -> String
showsPrec :: Int -> CreateCachediSCSIVolume -> ShowS
$cshowsPrec :: Int -> CreateCachediSCSIVolume -> ShowS
Prelude.Show, forall x. Rep CreateCachediSCSIVolume x -> CreateCachediSCSIVolume
forall x. CreateCachediSCSIVolume -> Rep CreateCachediSCSIVolume x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCachediSCSIVolume x -> CreateCachediSCSIVolume
$cfrom :: forall x. CreateCachediSCSIVolume -> Rep CreateCachediSCSIVolume x
Prelude.Generic)

-- |
-- Create a value of 'CreateCachediSCSIVolume' 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:
--
-- 'kmsEncrypted', 'createCachediSCSIVolume_kmsEncrypted' - Set to @true@ to use Amazon S3 server-side encryption with your own KMS
-- key, or @false@ to use a key managed by Amazon S3. Optional.
--
-- Valid Values: @true@ | @false@
--
-- 'kmsKey', 'createCachediSCSIVolume_kmsKey' - The Amazon Resource Name (ARN) of a symmetric customer master key (CMK)
-- used for Amazon S3 server-side encryption. Storage Gateway does not
-- support asymmetric CMKs. This value can only be set when @KMSEncrypted@
-- is @true@. Optional.
--
-- 'snapshotId', 'createCachediSCSIVolume_snapshotId' - The snapshot ID (e.g. \"snap-1122aabb\") of the snapshot to restore as
-- the new cached volume. Specify this field if you want to create the
-- iSCSI storage volume from a snapshot; otherwise, do not include this
-- field. To list snapshots for your account use
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeSnapshots.html DescribeSnapshots>
-- in the /Amazon Elastic Compute Cloud API Reference/.
--
-- 'sourceVolumeARN', 'createCachediSCSIVolume_sourceVolumeARN' - The ARN for an existing volume. Specifying this ARN makes the new volume
-- into an exact copy of the specified existing volume\'s latest recovery
-- point. The @VolumeSizeInBytes@ value for this new volume must be equal
-- to or larger than the size of the existing volume, in bytes.
--
-- 'tags', 'createCachediSCSIVolume_tags' - A list of up to 50 tags that you can assign to a cached volume. Each tag
-- is a key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers that
-- you can represent in UTF-8 format, and the following special characters:
-- + - = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters,
-- and the maximum length for a tag\'s value is 256 characters.
--
-- 'gatewayARN', 'createCachediSCSIVolume_gatewayARN' - Undocumented member.
--
-- 'volumeSizeInBytes', 'createCachediSCSIVolume_volumeSizeInBytes' - The size of the volume in bytes.
--
-- 'targetName', 'createCachediSCSIVolume_targetName' - The name of the iSCSI target used by an initiator to connect to a volume
-- and used as a suffix for the target ARN. For example, specifying
-- @TargetName@ as /myvolume/ results in the target ARN of
-- @arn:aws:storagegateway:us-east-2:111122223333:gateway\/sgw-12A3456B\/target\/iqn.1997-05.com.amazon:myvolume@.
-- The target name must be unique across all volumes on a gateway.
--
-- If you don\'t specify a value, Storage Gateway uses the value that was
-- previously used for this volume as the new target name.
--
-- 'networkInterfaceId', 'createCachediSCSIVolume_networkInterfaceId' - The network interface of the gateway on which to expose the iSCSI
-- target. Only IPv4 addresses are accepted. Use DescribeGatewayInformation
-- to get a list of the network interfaces available on a gateway.
--
-- Valid Values: A valid IP address.
--
-- 'clientToken', 'createCachediSCSIVolume_clientToken' - A unique identifier that you use to retry a request. If you retry a
-- request, use the same @ClientToken@ you specified in the initial
-- request.
newCreateCachediSCSIVolume ::
  -- | 'gatewayARN'
  Prelude.Text ->
  -- | 'volumeSizeInBytes'
  Prelude.Integer ->
  -- | 'targetName'
  Prelude.Text ->
  -- | 'networkInterfaceId'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  CreateCachediSCSIVolume
newCreateCachediSCSIVolume :: Text -> Integer -> Text -> Text -> Text -> CreateCachediSCSIVolume
newCreateCachediSCSIVolume
  Text
pGatewayARN_
  Integer
pVolumeSizeInBytes_
  Text
pTargetName_
  Text
pNetworkInterfaceId_
  Text
pClientToken_ =
    CreateCachediSCSIVolume'
      { $sel:kmsEncrypted:CreateCachediSCSIVolume' :: Maybe Bool
kmsEncrypted =
          forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKey:CreateCachediSCSIVolume' :: Maybe Text
kmsKey = forall a. Maybe a
Prelude.Nothing,
        $sel:snapshotId:CreateCachediSCSIVolume' :: Maybe Text
snapshotId = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceVolumeARN:CreateCachediSCSIVolume' :: Maybe Text
sourceVolumeARN = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCachediSCSIVolume' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:gatewayARN:CreateCachediSCSIVolume' :: Text
gatewayARN = Text
pGatewayARN_,
        $sel:volumeSizeInBytes:CreateCachediSCSIVolume' :: Integer
volumeSizeInBytes = Integer
pVolumeSizeInBytes_,
        $sel:targetName:CreateCachediSCSIVolume' :: Text
targetName = Text
pTargetName_,
        $sel:networkInterfaceId:CreateCachediSCSIVolume' :: Text
networkInterfaceId = Text
pNetworkInterfaceId_,
        $sel:clientToken:CreateCachediSCSIVolume' :: Text
clientToken = Text
pClientToken_
      }

-- | Set to @true@ to use Amazon S3 server-side encryption with your own KMS
-- key, or @false@ to use a key managed by Amazon S3. Optional.
--
-- Valid Values: @true@ | @false@
createCachediSCSIVolume_kmsEncrypted :: Lens.Lens' CreateCachediSCSIVolume (Prelude.Maybe Prelude.Bool)
createCachediSCSIVolume_kmsEncrypted :: Lens' CreateCachediSCSIVolume (Maybe Bool)
createCachediSCSIVolume_kmsEncrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Maybe Bool
kmsEncrypted :: Maybe Bool
$sel:kmsEncrypted:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Bool
kmsEncrypted} -> Maybe Bool
kmsEncrypted) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Maybe Bool
a -> CreateCachediSCSIVolume
s {$sel:kmsEncrypted:CreateCachediSCSIVolume' :: Maybe Bool
kmsEncrypted = Maybe Bool
a} :: CreateCachediSCSIVolume)

-- | The Amazon Resource Name (ARN) of a symmetric customer master key (CMK)
-- used for Amazon S3 server-side encryption. Storage Gateway does not
-- support asymmetric CMKs. This value can only be set when @KMSEncrypted@
-- is @true@. Optional.
createCachediSCSIVolume_kmsKey :: Lens.Lens' CreateCachediSCSIVolume (Prelude.Maybe Prelude.Text)
createCachediSCSIVolume_kmsKey :: Lens' CreateCachediSCSIVolume (Maybe Text)
createCachediSCSIVolume_kmsKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Maybe Text
kmsKey :: Maybe Text
$sel:kmsKey:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
kmsKey} -> Maybe Text
kmsKey) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Maybe Text
a -> CreateCachediSCSIVolume
s {$sel:kmsKey:CreateCachediSCSIVolume' :: Maybe Text
kmsKey = Maybe Text
a} :: CreateCachediSCSIVolume)

-- | The snapshot ID (e.g. \"snap-1122aabb\") of the snapshot to restore as
-- the new cached volume. Specify this field if you want to create the
-- iSCSI storage volume from a snapshot; otherwise, do not include this
-- field. To list snapshots for your account use
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/ApiReference-query-DescribeSnapshots.html DescribeSnapshots>
-- in the /Amazon Elastic Compute Cloud API Reference/.
createCachediSCSIVolume_snapshotId :: Lens.Lens' CreateCachediSCSIVolume (Prelude.Maybe Prelude.Text)
createCachediSCSIVolume_snapshotId :: Lens' CreateCachediSCSIVolume (Maybe Text)
createCachediSCSIVolume_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Maybe Text
snapshotId :: Maybe Text
$sel:snapshotId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
snapshotId} -> Maybe Text
snapshotId) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Maybe Text
a -> CreateCachediSCSIVolume
s {$sel:snapshotId:CreateCachediSCSIVolume' :: Maybe Text
snapshotId = Maybe Text
a} :: CreateCachediSCSIVolume)

-- | The ARN for an existing volume. Specifying this ARN makes the new volume
-- into an exact copy of the specified existing volume\'s latest recovery
-- point. The @VolumeSizeInBytes@ value for this new volume must be equal
-- to or larger than the size of the existing volume, in bytes.
createCachediSCSIVolume_sourceVolumeARN :: Lens.Lens' CreateCachediSCSIVolume (Prelude.Maybe Prelude.Text)
createCachediSCSIVolume_sourceVolumeARN :: Lens' CreateCachediSCSIVolume (Maybe Text)
createCachediSCSIVolume_sourceVolumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Maybe Text
sourceVolumeARN :: Maybe Text
$sel:sourceVolumeARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
sourceVolumeARN} -> Maybe Text
sourceVolumeARN) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Maybe Text
a -> CreateCachediSCSIVolume
s {$sel:sourceVolumeARN:CreateCachediSCSIVolume' :: Maybe Text
sourceVolumeARN = Maybe Text
a} :: CreateCachediSCSIVolume)

-- | A list of up to 50 tags that you can assign to a cached volume. Each tag
-- is a key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers that
-- you can represent in UTF-8 format, and the following special characters:
-- + - = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters,
-- and the maximum length for a tag\'s value is 256 characters.
createCachediSCSIVolume_tags :: Lens.Lens' CreateCachediSCSIVolume (Prelude.Maybe [Tag])
createCachediSCSIVolume_tags :: Lens' CreateCachediSCSIVolume (Maybe [Tag])
createCachediSCSIVolume_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Maybe [Tag]
a -> CreateCachediSCSIVolume
s {$sel:tags:CreateCachediSCSIVolume' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCachediSCSIVolume) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
createCachediSCSIVolume_gatewayARN :: Lens.Lens' CreateCachediSCSIVolume Prelude.Text
createCachediSCSIVolume_gatewayARN :: Lens' CreateCachediSCSIVolume Text
createCachediSCSIVolume_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Text
gatewayARN :: Text
$sel:gatewayARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
gatewayARN} -> Text
gatewayARN) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Text
a -> CreateCachediSCSIVolume
s {$sel:gatewayARN:CreateCachediSCSIVolume' :: Text
gatewayARN = Text
a} :: CreateCachediSCSIVolume)

-- | The size of the volume in bytes.
createCachediSCSIVolume_volumeSizeInBytes :: Lens.Lens' CreateCachediSCSIVolume Prelude.Integer
createCachediSCSIVolume_volumeSizeInBytes :: Lens' CreateCachediSCSIVolume Integer
createCachediSCSIVolume_volumeSizeInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Integer
volumeSizeInBytes :: Integer
$sel:volumeSizeInBytes:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Integer
volumeSizeInBytes} -> Integer
volumeSizeInBytes) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Integer
a -> CreateCachediSCSIVolume
s {$sel:volumeSizeInBytes:CreateCachediSCSIVolume' :: Integer
volumeSizeInBytes = Integer
a} :: CreateCachediSCSIVolume)

-- | The name of the iSCSI target used by an initiator to connect to a volume
-- and used as a suffix for the target ARN. For example, specifying
-- @TargetName@ as /myvolume/ results in the target ARN of
-- @arn:aws:storagegateway:us-east-2:111122223333:gateway\/sgw-12A3456B\/target\/iqn.1997-05.com.amazon:myvolume@.
-- The target name must be unique across all volumes on a gateway.
--
-- If you don\'t specify a value, Storage Gateway uses the value that was
-- previously used for this volume as the new target name.
createCachediSCSIVolume_targetName :: Lens.Lens' CreateCachediSCSIVolume Prelude.Text
createCachediSCSIVolume_targetName :: Lens' CreateCachediSCSIVolume Text
createCachediSCSIVolume_targetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Text
targetName :: Text
$sel:targetName:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
targetName} -> Text
targetName) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Text
a -> CreateCachediSCSIVolume
s {$sel:targetName:CreateCachediSCSIVolume' :: Text
targetName = Text
a} :: CreateCachediSCSIVolume)

-- | The network interface of the gateway on which to expose the iSCSI
-- target. Only IPv4 addresses are accepted. Use DescribeGatewayInformation
-- to get a list of the network interfaces available on a gateway.
--
-- Valid Values: A valid IP address.
createCachediSCSIVolume_networkInterfaceId :: Lens.Lens' CreateCachediSCSIVolume Prelude.Text
createCachediSCSIVolume_networkInterfaceId :: Lens' CreateCachediSCSIVolume Text
createCachediSCSIVolume_networkInterfaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Text
networkInterfaceId :: Text
$sel:networkInterfaceId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
networkInterfaceId} -> Text
networkInterfaceId) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Text
a -> CreateCachediSCSIVolume
s {$sel:networkInterfaceId:CreateCachediSCSIVolume' :: Text
networkInterfaceId = Text
a} :: CreateCachediSCSIVolume)

-- | A unique identifier that you use to retry a request. If you retry a
-- request, use the same @ClientToken@ you specified in the initial
-- request.
createCachediSCSIVolume_clientToken :: Lens.Lens' CreateCachediSCSIVolume Prelude.Text
createCachediSCSIVolume_clientToken :: Lens' CreateCachediSCSIVolume Text
createCachediSCSIVolume_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolume' {Text
clientToken :: Text
$sel:clientToken:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
clientToken} -> Text
clientToken) (\s :: CreateCachediSCSIVolume
s@CreateCachediSCSIVolume' {} Text
a -> CreateCachediSCSIVolume
s {$sel:clientToken:CreateCachediSCSIVolume' :: Text
clientToken = Text
a} :: CreateCachediSCSIVolume)

instance Core.AWSRequest CreateCachediSCSIVolume where
  type
    AWSResponse CreateCachediSCSIVolume =
      CreateCachediSCSIVolumeResponse
  request :: (Service -> Service)
-> CreateCachediSCSIVolume -> Request CreateCachediSCSIVolume
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 CreateCachediSCSIVolume
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateCachediSCSIVolume)))
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 -> Maybe Text -> Int -> CreateCachediSCSIVolumeResponse
CreateCachediSCSIVolumeResponse'
            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
"TargetARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"VolumeARN")
            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 CreateCachediSCSIVolume where
  hashWithSalt :: Int -> CreateCachediSCSIVolume -> Int
hashWithSalt Int
_salt CreateCachediSCSIVolume' {Integer
Maybe Bool
Maybe [Tag]
Maybe Text
Text
clientToken :: Text
networkInterfaceId :: Text
targetName :: Text
volumeSizeInBytes :: Integer
gatewayARN :: Text
tags :: Maybe [Tag]
sourceVolumeARN :: Maybe Text
snapshotId :: Maybe Text
kmsKey :: Maybe Text
kmsEncrypted :: Maybe Bool
$sel:clientToken:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:networkInterfaceId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:targetName:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:volumeSizeInBytes:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Integer
$sel:gatewayARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:tags:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe [Tag]
$sel:sourceVolumeARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:snapshotId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:kmsKey:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:kmsEncrypted:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
kmsEncrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceVolumeARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
volumeSizeInBytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
networkInterfaceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance Prelude.NFData CreateCachediSCSIVolume where
  rnf :: CreateCachediSCSIVolume -> ()
rnf CreateCachediSCSIVolume' {Integer
Maybe Bool
Maybe [Tag]
Maybe Text
Text
clientToken :: Text
networkInterfaceId :: Text
targetName :: Text
volumeSizeInBytes :: Integer
gatewayARN :: Text
tags :: Maybe [Tag]
sourceVolumeARN :: Maybe Text
snapshotId :: Maybe Text
kmsKey :: Maybe Text
kmsEncrypted :: Maybe Bool
$sel:clientToken:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:networkInterfaceId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:targetName:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:volumeSizeInBytes:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Integer
$sel:gatewayARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:tags:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe [Tag]
$sel:sourceVolumeARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:snapshotId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:kmsKey:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:kmsEncrypted:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
kmsEncrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceVolumeARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
volumeSizeInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
networkInterfaceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

instance Data.ToHeaders CreateCachediSCSIVolume where
  toHeaders :: CreateCachediSCSIVolume -> 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
"StorageGateway_20130630.CreateCachediSCSIVolume" ::
                          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 CreateCachediSCSIVolume where
  toJSON :: CreateCachediSCSIVolume -> Value
toJSON CreateCachediSCSIVolume' {Integer
Maybe Bool
Maybe [Tag]
Maybe Text
Text
clientToken :: Text
networkInterfaceId :: Text
targetName :: Text
volumeSizeInBytes :: Integer
gatewayARN :: Text
tags :: Maybe [Tag]
sourceVolumeARN :: Maybe Text
snapshotId :: Maybe Text
kmsKey :: Maybe Text
kmsEncrypted :: Maybe Bool
$sel:clientToken:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:networkInterfaceId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:targetName:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:volumeSizeInBytes:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Integer
$sel:gatewayARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Text
$sel:tags:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe [Tag]
$sel:sourceVolumeARN:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:snapshotId:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:kmsKey:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Text
$sel:kmsEncrypted:CreateCachediSCSIVolume' :: CreateCachediSCSIVolume -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"KMSEncrypted" 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 Bool
kmsEncrypted,
            (Key
"KMSKey" 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
kmsKey,
            (Key
"SnapshotId" 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
snapshotId,
            (Key
"SourceVolumeARN" 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
sourceVolumeARN,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"GatewayARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayARN),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"VolumeSizeInBytes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Integer
volumeSizeInBytes),
            forall a. a -> Maybe a
Prelude.Just (Key
"TargetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
targetName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"NetworkInterfaceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
networkInterfaceId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

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

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

-- | /See:/ 'newCreateCachediSCSIVolumeResponse' smart constructor.
data CreateCachediSCSIVolumeResponse = CreateCachediSCSIVolumeResponse'
  { -- | The Amazon Resource Name (ARN) of the volume target, which includes the
    -- iSCSI name that initiators can use to connect to the target.
    CreateCachediSCSIVolumeResponse -> Maybe Text
targetARN :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the configured volume.
    CreateCachediSCSIVolumeResponse -> Maybe Text
volumeARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateCachediSCSIVolumeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateCachediSCSIVolumeResponse
-> CreateCachediSCSIVolumeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCachediSCSIVolumeResponse
-> CreateCachediSCSIVolumeResponse -> Bool
$c/= :: CreateCachediSCSIVolumeResponse
-> CreateCachediSCSIVolumeResponse -> Bool
== :: CreateCachediSCSIVolumeResponse
-> CreateCachediSCSIVolumeResponse -> Bool
$c== :: CreateCachediSCSIVolumeResponse
-> CreateCachediSCSIVolumeResponse -> Bool
Prelude.Eq, ReadPrec [CreateCachediSCSIVolumeResponse]
ReadPrec CreateCachediSCSIVolumeResponse
Int -> ReadS CreateCachediSCSIVolumeResponse
ReadS [CreateCachediSCSIVolumeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCachediSCSIVolumeResponse]
$creadListPrec :: ReadPrec [CreateCachediSCSIVolumeResponse]
readPrec :: ReadPrec CreateCachediSCSIVolumeResponse
$creadPrec :: ReadPrec CreateCachediSCSIVolumeResponse
readList :: ReadS [CreateCachediSCSIVolumeResponse]
$creadList :: ReadS [CreateCachediSCSIVolumeResponse]
readsPrec :: Int -> ReadS CreateCachediSCSIVolumeResponse
$creadsPrec :: Int -> ReadS CreateCachediSCSIVolumeResponse
Prelude.Read, Int -> CreateCachediSCSIVolumeResponse -> ShowS
[CreateCachediSCSIVolumeResponse] -> ShowS
CreateCachediSCSIVolumeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCachediSCSIVolumeResponse] -> ShowS
$cshowList :: [CreateCachediSCSIVolumeResponse] -> ShowS
show :: CreateCachediSCSIVolumeResponse -> String
$cshow :: CreateCachediSCSIVolumeResponse -> String
showsPrec :: Int -> CreateCachediSCSIVolumeResponse -> ShowS
$cshowsPrec :: Int -> CreateCachediSCSIVolumeResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCachediSCSIVolumeResponse x
-> CreateCachediSCSIVolumeResponse
forall x.
CreateCachediSCSIVolumeResponse
-> Rep CreateCachediSCSIVolumeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCachediSCSIVolumeResponse x
-> CreateCachediSCSIVolumeResponse
$cfrom :: forall x.
CreateCachediSCSIVolumeResponse
-> Rep CreateCachediSCSIVolumeResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCachediSCSIVolumeResponse' 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:
--
-- 'targetARN', 'createCachediSCSIVolumeResponse_targetARN' - The Amazon Resource Name (ARN) of the volume target, which includes the
-- iSCSI name that initiators can use to connect to the target.
--
-- 'volumeARN', 'createCachediSCSIVolumeResponse_volumeARN' - The Amazon Resource Name (ARN) of the configured volume.
--
-- 'httpStatus', 'createCachediSCSIVolumeResponse_httpStatus' - The response's http status code.
newCreateCachediSCSIVolumeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateCachediSCSIVolumeResponse
newCreateCachediSCSIVolumeResponse :: Int -> CreateCachediSCSIVolumeResponse
newCreateCachediSCSIVolumeResponse Int
pHttpStatus_ =
  CreateCachediSCSIVolumeResponse'
    { $sel:targetARN:CreateCachediSCSIVolumeResponse' :: Maybe Text
targetARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:volumeARN:CreateCachediSCSIVolumeResponse' :: Maybe Text
volumeARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateCachediSCSIVolumeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the volume target, which includes the
-- iSCSI name that initiators can use to connect to the target.
createCachediSCSIVolumeResponse_targetARN :: Lens.Lens' CreateCachediSCSIVolumeResponse (Prelude.Maybe Prelude.Text)
createCachediSCSIVolumeResponse_targetARN :: Lens' CreateCachediSCSIVolumeResponse (Maybe Text)
createCachediSCSIVolumeResponse_targetARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolumeResponse' {Maybe Text
targetARN :: Maybe Text
$sel:targetARN:CreateCachediSCSIVolumeResponse' :: CreateCachediSCSIVolumeResponse -> Maybe Text
targetARN} -> Maybe Text
targetARN) (\s :: CreateCachediSCSIVolumeResponse
s@CreateCachediSCSIVolumeResponse' {} Maybe Text
a -> CreateCachediSCSIVolumeResponse
s {$sel:targetARN:CreateCachediSCSIVolumeResponse' :: Maybe Text
targetARN = Maybe Text
a} :: CreateCachediSCSIVolumeResponse)

-- | The Amazon Resource Name (ARN) of the configured volume.
createCachediSCSIVolumeResponse_volumeARN :: Lens.Lens' CreateCachediSCSIVolumeResponse (Prelude.Maybe Prelude.Text)
createCachediSCSIVolumeResponse_volumeARN :: Lens' CreateCachediSCSIVolumeResponse (Maybe Text)
createCachediSCSIVolumeResponse_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCachediSCSIVolumeResponse' {Maybe Text
volumeARN :: Maybe Text
$sel:volumeARN:CreateCachediSCSIVolumeResponse' :: CreateCachediSCSIVolumeResponse -> Maybe Text
volumeARN} -> Maybe Text
volumeARN) (\s :: CreateCachediSCSIVolumeResponse
s@CreateCachediSCSIVolumeResponse' {} Maybe Text
a -> CreateCachediSCSIVolumeResponse
s {$sel:volumeARN:CreateCachediSCSIVolumeResponse' :: Maybe Text
volumeARN = Maybe Text
a} :: CreateCachediSCSIVolumeResponse)

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

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