{-# 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.DescribeStorediSCSIVolumes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the description of the gateway volumes specified in the request.
-- The list of gateway volumes in the request must be from one gateway. In
-- the response, Storage Gateway returns volume information sorted by
-- volume ARNs. This operation is only supported in stored volume gateway
-- type.
module Amazonka.StorageGateway.DescribeStorediSCSIVolumes
  ( -- * Creating a Request
    DescribeStorediSCSIVolumes (..),
    newDescribeStorediSCSIVolumes,

    -- * Request Lenses
    describeStorediSCSIVolumes_volumeARNs,

    -- * Destructuring the Response
    DescribeStorediSCSIVolumesResponse (..),
    newDescribeStorediSCSIVolumesResponse,

    -- * Response Lenses
    describeStorediSCSIVolumesResponse_storediSCSIVolumes,
    describeStorediSCSIVolumesResponse_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

-- | A JSON object containing a list of
-- DescribeStorediSCSIVolumesInput$VolumeARNs.
--
-- /See:/ 'newDescribeStorediSCSIVolumes' smart constructor.
data DescribeStorediSCSIVolumes = DescribeStorediSCSIVolumes'
  { -- | An array of strings where each string represents the Amazon Resource
    -- Name (ARN) of a stored volume. All of the specified stored volumes must
    -- be from the same gateway. Use ListVolumes to get volume ARNs for a
    -- gateway.
    DescribeStorediSCSIVolumes -> [Text]
volumeARNs :: [Prelude.Text]
  }
  deriving (DescribeStorediSCSIVolumes -> DescribeStorediSCSIVolumes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStorediSCSIVolumes -> DescribeStorediSCSIVolumes -> Bool
$c/= :: DescribeStorediSCSIVolumes -> DescribeStorediSCSIVolumes -> Bool
== :: DescribeStorediSCSIVolumes -> DescribeStorediSCSIVolumes -> Bool
$c== :: DescribeStorediSCSIVolumes -> DescribeStorediSCSIVolumes -> Bool
Prelude.Eq, ReadPrec [DescribeStorediSCSIVolumes]
ReadPrec DescribeStorediSCSIVolumes
Int -> ReadS DescribeStorediSCSIVolumes
ReadS [DescribeStorediSCSIVolumes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStorediSCSIVolumes]
$creadListPrec :: ReadPrec [DescribeStorediSCSIVolumes]
readPrec :: ReadPrec DescribeStorediSCSIVolumes
$creadPrec :: ReadPrec DescribeStorediSCSIVolumes
readList :: ReadS [DescribeStorediSCSIVolumes]
$creadList :: ReadS [DescribeStorediSCSIVolumes]
readsPrec :: Int -> ReadS DescribeStorediSCSIVolumes
$creadsPrec :: Int -> ReadS DescribeStorediSCSIVolumes
Prelude.Read, Int -> DescribeStorediSCSIVolumes -> ShowS
[DescribeStorediSCSIVolumes] -> ShowS
DescribeStorediSCSIVolumes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStorediSCSIVolumes] -> ShowS
$cshowList :: [DescribeStorediSCSIVolumes] -> ShowS
show :: DescribeStorediSCSIVolumes -> String
$cshow :: DescribeStorediSCSIVolumes -> String
showsPrec :: Int -> DescribeStorediSCSIVolumes -> ShowS
$cshowsPrec :: Int -> DescribeStorediSCSIVolumes -> ShowS
Prelude.Show, forall x.
Rep DescribeStorediSCSIVolumes x -> DescribeStorediSCSIVolumes
forall x.
DescribeStorediSCSIVolumes -> Rep DescribeStorediSCSIVolumes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeStorediSCSIVolumes x -> DescribeStorediSCSIVolumes
$cfrom :: forall x.
DescribeStorediSCSIVolumes -> Rep DescribeStorediSCSIVolumes x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStorediSCSIVolumes' 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:
--
-- 'volumeARNs', 'describeStorediSCSIVolumes_volumeARNs' - An array of strings where each string represents the Amazon Resource
-- Name (ARN) of a stored volume. All of the specified stored volumes must
-- be from the same gateway. Use ListVolumes to get volume ARNs for a
-- gateway.
newDescribeStorediSCSIVolumes ::
  DescribeStorediSCSIVolumes
newDescribeStorediSCSIVolumes :: DescribeStorediSCSIVolumes
newDescribeStorediSCSIVolumes =
  DescribeStorediSCSIVolumes'
    { $sel:volumeARNs:DescribeStorediSCSIVolumes' :: [Text]
volumeARNs =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | An array of strings where each string represents the Amazon Resource
-- Name (ARN) of a stored volume. All of the specified stored volumes must
-- be from the same gateway. Use ListVolumes to get volume ARNs for a
-- gateway.
describeStorediSCSIVolumes_volumeARNs :: Lens.Lens' DescribeStorediSCSIVolumes [Prelude.Text]
describeStorediSCSIVolumes_volumeARNs :: Lens' DescribeStorediSCSIVolumes [Text]
describeStorediSCSIVolumes_volumeARNs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStorediSCSIVolumes' {[Text]
volumeARNs :: [Text]
$sel:volumeARNs:DescribeStorediSCSIVolumes' :: DescribeStorediSCSIVolumes -> [Text]
volumeARNs} -> [Text]
volumeARNs) (\s :: DescribeStorediSCSIVolumes
s@DescribeStorediSCSIVolumes' {} [Text]
a -> DescribeStorediSCSIVolumes
s {$sel:volumeARNs:DescribeStorediSCSIVolumes' :: [Text]
volumeARNs = [Text]
a} :: DescribeStorediSCSIVolumes) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest DescribeStorediSCSIVolumes where
  type
    AWSResponse DescribeStorediSCSIVolumes =
      DescribeStorediSCSIVolumesResponse
  request :: (Service -> Service)
-> DescribeStorediSCSIVolumes -> Request DescribeStorediSCSIVolumes
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 DescribeStorediSCSIVolumes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeStorediSCSIVolumes)))
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 [StorediSCSIVolume]
-> Int -> DescribeStorediSCSIVolumesResponse
DescribeStorediSCSIVolumesResponse'
            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
"StorediSCSIVolumes"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 DescribeStorediSCSIVolumes where
  hashWithSalt :: Int -> DescribeStorediSCSIVolumes -> Int
hashWithSalt Int
_salt DescribeStorediSCSIVolumes' {[Text]
volumeARNs :: [Text]
$sel:volumeARNs:DescribeStorediSCSIVolumes' :: DescribeStorediSCSIVolumes -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
volumeARNs

instance Prelude.NFData DescribeStorediSCSIVolumes where
  rnf :: DescribeStorediSCSIVolumes -> ()
rnf DescribeStorediSCSIVolumes' {[Text]
volumeARNs :: [Text]
$sel:volumeARNs:DescribeStorediSCSIVolumes' :: DescribeStorediSCSIVolumes -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
volumeARNs

instance Data.ToHeaders DescribeStorediSCSIVolumes where
  toHeaders :: DescribeStorediSCSIVolumes -> 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.DescribeStorediSCSIVolumes" ::
                          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 DescribeStorediSCSIVolumes where
  toJSON :: DescribeStorediSCSIVolumes -> Value
toJSON DescribeStorediSCSIVolumes' {[Text]
volumeARNs :: [Text]
$sel:volumeARNs:DescribeStorediSCSIVolumes' :: DescribeStorediSCSIVolumes -> [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"VolumeARNs" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
volumeARNs)]
      )

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

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

-- | /See:/ 'newDescribeStorediSCSIVolumesResponse' smart constructor.
data DescribeStorediSCSIVolumesResponse = DescribeStorediSCSIVolumesResponse'
  { -- | Describes a single unit of output from DescribeStorediSCSIVolumes. The
    -- following fields are returned:
    --
    -- -   @ChapEnabled@: Indicates whether mutual CHAP is enabled for the
    --     iSCSI target.
    --
    -- -   @LunNumber@: The logical disk number.
    --
    -- -   @NetworkInterfaceId@: The network interface ID of the stored volume
    --     that initiator use to map the stored volume as an iSCSI target.
    --
    -- -   @NetworkInterfacePort@: The port used to communicate with iSCSI
    --     targets.
    --
    -- -   @PreservedExistingData@: Indicates when the stored volume was
    --     created, existing data on the underlying local disk was preserved.
    --
    -- -   @SourceSnapshotId@: If the stored volume was created from a
    --     snapshot, this field contains the snapshot ID used, e.g.
    --     @snap-1122aabb@. Otherwise, this field is not included.
    --
    -- -   @StorediSCSIVolumes@: An array of StorediSCSIVolume objects where
    --     each object contains metadata about one stored volume.
    --
    -- -   @TargetARN@: The Amazon Resource Name (ARN) of the volume target.
    --
    -- -   @VolumeARN@: The Amazon Resource Name (ARN) of the stored volume.
    --
    -- -   @VolumeDiskId@: The disk ID of the local disk that was specified in
    --     the CreateStorediSCSIVolume operation.
    --
    -- -   @VolumeId@: The unique identifier of the storage volume, e.g.
    --     @vol-1122AABB@.
    --
    -- -   @VolumeiSCSIAttributes@: An VolumeiSCSIAttributes object that
    --     represents a collection of iSCSI attributes for one stored volume.
    --
    -- -   @VolumeProgress@: Represents the percentage complete if the volume
    --     is restoring or bootstrapping that represents the percent of data
    --     transferred. This field does not appear in the response if the
    --     stored volume is not restoring or bootstrapping.
    --
    -- -   @VolumeSizeInBytes@: The size of the volume in bytes.
    --
    -- -   @VolumeStatus@: One of the @VolumeStatus@ values that indicates the
    --     state of the volume.
    --
    -- -   @VolumeType@: One of the enumeration values describing the type of
    --     the volume. Currently, only @STORED@ volumes are supported.
    DescribeStorediSCSIVolumesResponse -> Maybe [StorediSCSIVolume]
storediSCSIVolumes :: Prelude.Maybe [StorediSCSIVolume],
    -- | The response's http status code.
    DescribeStorediSCSIVolumesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeStorediSCSIVolumesResponse
-> DescribeStorediSCSIVolumesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStorediSCSIVolumesResponse
-> DescribeStorediSCSIVolumesResponse -> Bool
$c/= :: DescribeStorediSCSIVolumesResponse
-> DescribeStorediSCSIVolumesResponse -> Bool
== :: DescribeStorediSCSIVolumesResponse
-> DescribeStorediSCSIVolumesResponse -> Bool
$c== :: DescribeStorediSCSIVolumesResponse
-> DescribeStorediSCSIVolumesResponse -> Bool
Prelude.Eq, ReadPrec [DescribeStorediSCSIVolumesResponse]
ReadPrec DescribeStorediSCSIVolumesResponse
Int -> ReadS DescribeStorediSCSIVolumesResponse
ReadS [DescribeStorediSCSIVolumesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStorediSCSIVolumesResponse]
$creadListPrec :: ReadPrec [DescribeStorediSCSIVolumesResponse]
readPrec :: ReadPrec DescribeStorediSCSIVolumesResponse
$creadPrec :: ReadPrec DescribeStorediSCSIVolumesResponse
readList :: ReadS [DescribeStorediSCSIVolumesResponse]
$creadList :: ReadS [DescribeStorediSCSIVolumesResponse]
readsPrec :: Int -> ReadS DescribeStorediSCSIVolumesResponse
$creadsPrec :: Int -> ReadS DescribeStorediSCSIVolumesResponse
Prelude.Read, Int -> DescribeStorediSCSIVolumesResponse -> ShowS
[DescribeStorediSCSIVolumesResponse] -> ShowS
DescribeStorediSCSIVolumesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStorediSCSIVolumesResponse] -> ShowS
$cshowList :: [DescribeStorediSCSIVolumesResponse] -> ShowS
show :: DescribeStorediSCSIVolumesResponse -> String
$cshow :: DescribeStorediSCSIVolumesResponse -> String
showsPrec :: Int -> DescribeStorediSCSIVolumesResponse -> ShowS
$cshowsPrec :: Int -> DescribeStorediSCSIVolumesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeStorediSCSIVolumesResponse x
-> DescribeStorediSCSIVolumesResponse
forall x.
DescribeStorediSCSIVolumesResponse
-> Rep DescribeStorediSCSIVolumesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeStorediSCSIVolumesResponse x
-> DescribeStorediSCSIVolumesResponse
$cfrom :: forall x.
DescribeStorediSCSIVolumesResponse
-> Rep DescribeStorediSCSIVolumesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStorediSCSIVolumesResponse' 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:
--
-- 'storediSCSIVolumes', 'describeStorediSCSIVolumesResponse_storediSCSIVolumes' - Describes a single unit of output from DescribeStorediSCSIVolumes. The
-- following fields are returned:
--
-- -   @ChapEnabled@: Indicates whether mutual CHAP is enabled for the
--     iSCSI target.
--
-- -   @LunNumber@: The logical disk number.
--
-- -   @NetworkInterfaceId@: The network interface ID of the stored volume
--     that initiator use to map the stored volume as an iSCSI target.
--
-- -   @NetworkInterfacePort@: The port used to communicate with iSCSI
--     targets.
--
-- -   @PreservedExistingData@: Indicates when the stored volume was
--     created, existing data on the underlying local disk was preserved.
--
-- -   @SourceSnapshotId@: If the stored volume was created from a
--     snapshot, this field contains the snapshot ID used, e.g.
--     @snap-1122aabb@. Otherwise, this field is not included.
--
-- -   @StorediSCSIVolumes@: An array of StorediSCSIVolume objects where
--     each object contains metadata about one stored volume.
--
-- -   @TargetARN@: The Amazon Resource Name (ARN) of the volume target.
--
-- -   @VolumeARN@: The Amazon Resource Name (ARN) of the stored volume.
--
-- -   @VolumeDiskId@: The disk ID of the local disk that was specified in
--     the CreateStorediSCSIVolume operation.
--
-- -   @VolumeId@: The unique identifier of the storage volume, e.g.
--     @vol-1122AABB@.
--
-- -   @VolumeiSCSIAttributes@: An VolumeiSCSIAttributes object that
--     represents a collection of iSCSI attributes for one stored volume.
--
-- -   @VolumeProgress@: Represents the percentage complete if the volume
--     is restoring or bootstrapping that represents the percent of data
--     transferred. This field does not appear in the response if the
--     stored volume is not restoring or bootstrapping.
--
-- -   @VolumeSizeInBytes@: The size of the volume in bytes.
--
-- -   @VolumeStatus@: One of the @VolumeStatus@ values that indicates the
--     state of the volume.
--
-- -   @VolumeType@: One of the enumeration values describing the type of
--     the volume. Currently, only @STORED@ volumes are supported.
--
-- 'httpStatus', 'describeStorediSCSIVolumesResponse_httpStatus' - The response's http status code.
newDescribeStorediSCSIVolumesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeStorediSCSIVolumesResponse
newDescribeStorediSCSIVolumesResponse :: Int -> DescribeStorediSCSIVolumesResponse
newDescribeStorediSCSIVolumesResponse Int
pHttpStatus_ =
  DescribeStorediSCSIVolumesResponse'
    { $sel:storediSCSIVolumes:DescribeStorediSCSIVolumesResponse' :: Maybe [StorediSCSIVolume]
storediSCSIVolumes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeStorediSCSIVolumesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Describes a single unit of output from DescribeStorediSCSIVolumes. The
-- following fields are returned:
--
-- -   @ChapEnabled@: Indicates whether mutual CHAP is enabled for the
--     iSCSI target.
--
-- -   @LunNumber@: The logical disk number.
--
-- -   @NetworkInterfaceId@: The network interface ID of the stored volume
--     that initiator use to map the stored volume as an iSCSI target.
--
-- -   @NetworkInterfacePort@: The port used to communicate with iSCSI
--     targets.
--
-- -   @PreservedExistingData@: Indicates when the stored volume was
--     created, existing data on the underlying local disk was preserved.
--
-- -   @SourceSnapshotId@: If the stored volume was created from a
--     snapshot, this field contains the snapshot ID used, e.g.
--     @snap-1122aabb@. Otherwise, this field is not included.
--
-- -   @StorediSCSIVolumes@: An array of StorediSCSIVolume objects where
--     each object contains metadata about one stored volume.
--
-- -   @TargetARN@: The Amazon Resource Name (ARN) of the volume target.
--
-- -   @VolumeARN@: The Amazon Resource Name (ARN) of the stored volume.
--
-- -   @VolumeDiskId@: The disk ID of the local disk that was specified in
--     the CreateStorediSCSIVolume operation.
--
-- -   @VolumeId@: The unique identifier of the storage volume, e.g.
--     @vol-1122AABB@.
--
-- -   @VolumeiSCSIAttributes@: An VolumeiSCSIAttributes object that
--     represents a collection of iSCSI attributes for one stored volume.
--
-- -   @VolumeProgress@: Represents the percentage complete if the volume
--     is restoring or bootstrapping that represents the percent of data
--     transferred. This field does not appear in the response if the
--     stored volume is not restoring or bootstrapping.
--
-- -   @VolumeSizeInBytes@: The size of the volume in bytes.
--
-- -   @VolumeStatus@: One of the @VolumeStatus@ values that indicates the
--     state of the volume.
--
-- -   @VolumeType@: One of the enumeration values describing the type of
--     the volume. Currently, only @STORED@ volumes are supported.
describeStorediSCSIVolumesResponse_storediSCSIVolumes :: Lens.Lens' DescribeStorediSCSIVolumesResponse (Prelude.Maybe [StorediSCSIVolume])
describeStorediSCSIVolumesResponse_storediSCSIVolumes :: Lens'
  DescribeStorediSCSIVolumesResponse (Maybe [StorediSCSIVolume])
describeStorediSCSIVolumesResponse_storediSCSIVolumes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStorediSCSIVolumesResponse' {Maybe [StorediSCSIVolume]
storediSCSIVolumes :: Maybe [StorediSCSIVolume]
$sel:storediSCSIVolumes:DescribeStorediSCSIVolumesResponse' :: DescribeStorediSCSIVolumesResponse -> Maybe [StorediSCSIVolume]
storediSCSIVolumes} -> Maybe [StorediSCSIVolume]
storediSCSIVolumes) (\s :: DescribeStorediSCSIVolumesResponse
s@DescribeStorediSCSIVolumesResponse' {} Maybe [StorediSCSIVolume]
a -> DescribeStorediSCSIVolumesResponse
s {$sel:storediSCSIVolumes:DescribeStorediSCSIVolumesResponse' :: Maybe [StorediSCSIVolume]
storediSCSIVolumes = Maybe [StorediSCSIVolume]
a} :: DescribeStorediSCSIVolumesResponse) 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

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

instance
  Prelude.NFData
    DescribeStorediSCSIVolumesResponse
  where
  rnf :: DescribeStorediSCSIVolumesResponse -> ()
rnf DescribeStorediSCSIVolumesResponse' {Int
Maybe [StorediSCSIVolume]
httpStatus :: Int
storediSCSIVolumes :: Maybe [StorediSCSIVolume]
$sel:httpStatus:DescribeStorediSCSIVolumesResponse' :: DescribeStorediSCSIVolumesResponse -> Int
$sel:storediSCSIVolumes:DescribeStorediSCSIVolumesResponse' :: DescribeStorediSCSIVolumesResponse -> Maybe [StorediSCSIVolume]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [StorediSCSIVolume]
storediSCSIVolumes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus