{-# 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.DescribeWorkingStorage
-- 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 information about the working storage of a gateway. This
-- operation is only supported in the stored volumes gateway type. This
-- operation is deprecated in cached volumes API version (20120630). Use
-- DescribeUploadBuffer instead.
--
-- Working storage is also referred to as upload buffer. You can also use
-- the DescribeUploadBuffer operation to add upload buffer to a stored
-- volume gateway.
--
-- The response includes disk IDs that are configured as working storage,
-- and it includes the amount of working storage allocated and used.
module Amazonka.StorageGateway.DescribeWorkingStorage
  ( -- * Creating a Request
    DescribeWorkingStorage (..),
    newDescribeWorkingStorage,

    -- * Request Lenses
    describeWorkingStorage_gatewayARN,

    -- * Destructuring the Response
    DescribeWorkingStorageResponse (..),
    newDescribeWorkingStorageResponse,

    -- * Response Lenses
    describeWorkingStorageResponse_diskIds,
    describeWorkingStorageResponse_gatewayARN,
    describeWorkingStorageResponse_workingStorageAllocatedInBytes,
    describeWorkingStorageResponse_workingStorageUsedInBytes,
    describeWorkingStorageResponse_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 the Amazon Resource Name (ARN) of the gateway.
--
-- /See:/ 'newDescribeWorkingStorage' smart constructor.
data DescribeWorkingStorage = DescribeWorkingStorage'
  { DescribeWorkingStorage -> Text
gatewayARN :: Prelude.Text
  }
  deriving (DescribeWorkingStorage -> DescribeWorkingStorage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWorkingStorage -> DescribeWorkingStorage -> Bool
$c/= :: DescribeWorkingStorage -> DescribeWorkingStorage -> Bool
== :: DescribeWorkingStorage -> DescribeWorkingStorage -> Bool
$c== :: DescribeWorkingStorage -> DescribeWorkingStorage -> Bool
Prelude.Eq, ReadPrec [DescribeWorkingStorage]
ReadPrec DescribeWorkingStorage
Int -> ReadS DescribeWorkingStorage
ReadS [DescribeWorkingStorage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWorkingStorage]
$creadListPrec :: ReadPrec [DescribeWorkingStorage]
readPrec :: ReadPrec DescribeWorkingStorage
$creadPrec :: ReadPrec DescribeWorkingStorage
readList :: ReadS [DescribeWorkingStorage]
$creadList :: ReadS [DescribeWorkingStorage]
readsPrec :: Int -> ReadS DescribeWorkingStorage
$creadsPrec :: Int -> ReadS DescribeWorkingStorage
Prelude.Read, Int -> DescribeWorkingStorage -> ShowS
[DescribeWorkingStorage] -> ShowS
DescribeWorkingStorage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWorkingStorage] -> ShowS
$cshowList :: [DescribeWorkingStorage] -> ShowS
show :: DescribeWorkingStorage -> String
$cshow :: DescribeWorkingStorage -> String
showsPrec :: Int -> DescribeWorkingStorage -> ShowS
$cshowsPrec :: Int -> DescribeWorkingStorage -> ShowS
Prelude.Show, forall x. Rep DescribeWorkingStorage x -> DescribeWorkingStorage
forall x. DescribeWorkingStorage -> Rep DescribeWorkingStorage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeWorkingStorage x -> DescribeWorkingStorage
$cfrom :: forall x. DescribeWorkingStorage -> Rep DescribeWorkingStorage x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWorkingStorage' 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:
--
-- 'gatewayARN', 'describeWorkingStorage_gatewayARN' - Undocumented member.
newDescribeWorkingStorage ::
  -- | 'gatewayARN'
  Prelude.Text ->
  DescribeWorkingStorage
newDescribeWorkingStorage :: Text -> DescribeWorkingStorage
newDescribeWorkingStorage Text
pGatewayARN_ =
  DescribeWorkingStorage' {$sel:gatewayARN:DescribeWorkingStorage' :: Text
gatewayARN = Text
pGatewayARN_}

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

instance Core.AWSRequest DescribeWorkingStorage where
  type
    AWSResponse DescribeWorkingStorage =
      DescribeWorkingStorageResponse
  request :: (Service -> Service)
-> DescribeWorkingStorage -> Request DescribeWorkingStorage
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 DescribeWorkingStorage
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeWorkingStorage)))
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
-> Maybe Integer
-> Maybe Integer
-> Int
-> DescribeWorkingStorageResponse
DescribeWorkingStorageResponse'
            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
"DiskIds" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"GatewayARN")
            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
"WorkingStorageAllocatedInBytes")
            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
"WorkingStorageUsedInBytes")
            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 DescribeWorkingStorage where
  hashWithSalt :: Int -> DescribeWorkingStorage -> Int
hashWithSalt Int
_salt DescribeWorkingStorage' {Text
gatewayARN :: Text
$sel:gatewayARN:DescribeWorkingStorage' :: DescribeWorkingStorage -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN

instance Prelude.NFData DescribeWorkingStorage where
  rnf :: DescribeWorkingStorage -> ()
rnf DescribeWorkingStorage' {Text
gatewayARN :: Text
$sel:gatewayARN:DescribeWorkingStorage' :: DescribeWorkingStorage -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayARN

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

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

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

-- | A JSON object containing the following fields:
--
-- /See:/ 'newDescribeWorkingStorageResponse' smart constructor.
data DescribeWorkingStorageResponse = DescribeWorkingStorageResponse'
  { -- | An array of the gateway\'s local disk IDs that are configured as working
    -- storage. Each local disk ID is specified as a string (minimum length of
    -- 1 and maximum length of 300). If no local disks are configured as
    -- working storage, then the DiskIds array is empty.
    DescribeWorkingStorageResponse -> Maybe [Text]
diskIds :: Prelude.Maybe [Prelude.Text],
    DescribeWorkingStorageResponse -> Maybe Text
gatewayARN :: Prelude.Maybe Prelude.Text,
    -- | The total working storage in bytes allocated for the gateway. If no
    -- working storage is configured for the gateway, this field returns 0.
    DescribeWorkingStorageResponse -> Maybe Integer
workingStorageAllocatedInBytes :: Prelude.Maybe Prelude.Integer,
    -- | The total working storage in bytes in use by the gateway. If no working
    -- storage is configured for the gateway, this field returns 0.
    DescribeWorkingStorageResponse -> Maybe Integer
workingStorageUsedInBytes :: Prelude.Maybe Prelude.Integer,
    -- | The response's http status code.
    DescribeWorkingStorageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeWorkingStorageResponse
-> DescribeWorkingStorageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWorkingStorageResponse
-> DescribeWorkingStorageResponse -> Bool
$c/= :: DescribeWorkingStorageResponse
-> DescribeWorkingStorageResponse -> Bool
== :: DescribeWorkingStorageResponse
-> DescribeWorkingStorageResponse -> Bool
$c== :: DescribeWorkingStorageResponse
-> DescribeWorkingStorageResponse -> Bool
Prelude.Eq, ReadPrec [DescribeWorkingStorageResponse]
ReadPrec DescribeWorkingStorageResponse
Int -> ReadS DescribeWorkingStorageResponse
ReadS [DescribeWorkingStorageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWorkingStorageResponse]
$creadListPrec :: ReadPrec [DescribeWorkingStorageResponse]
readPrec :: ReadPrec DescribeWorkingStorageResponse
$creadPrec :: ReadPrec DescribeWorkingStorageResponse
readList :: ReadS [DescribeWorkingStorageResponse]
$creadList :: ReadS [DescribeWorkingStorageResponse]
readsPrec :: Int -> ReadS DescribeWorkingStorageResponse
$creadsPrec :: Int -> ReadS DescribeWorkingStorageResponse
Prelude.Read, Int -> DescribeWorkingStorageResponse -> ShowS
[DescribeWorkingStorageResponse] -> ShowS
DescribeWorkingStorageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWorkingStorageResponse] -> ShowS
$cshowList :: [DescribeWorkingStorageResponse] -> ShowS
show :: DescribeWorkingStorageResponse -> String
$cshow :: DescribeWorkingStorageResponse -> String
showsPrec :: Int -> DescribeWorkingStorageResponse -> ShowS
$cshowsPrec :: Int -> DescribeWorkingStorageResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeWorkingStorageResponse x
-> DescribeWorkingStorageResponse
forall x.
DescribeWorkingStorageResponse
-> Rep DescribeWorkingStorageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeWorkingStorageResponse x
-> DescribeWorkingStorageResponse
$cfrom :: forall x.
DescribeWorkingStorageResponse
-> Rep DescribeWorkingStorageResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWorkingStorageResponse' 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:
--
-- 'diskIds', 'describeWorkingStorageResponse_diskIds' - An array of the gateway\'s local disk IDs that are configured as working
-- storage. Each local disk ID is specified as a string (minimum length of
-- 1 and maximum length of 300). If no local disks are configured as
-- working storage, then the DiskIds array is empty.
--
-- 'gatewayARN', 'describeWorkingStorageResponse_gatewayARN' - Undocumented member.
--
-- 'workingStorageAllocatedInBytes', 'describeWorkingStorageResponse_workingStorageAllocatedInBytes' - The total working storage in bytes allocated for the gateway. If no
-- working storage is configured for the gateway, this field returns 0.
--
-- 'workingStorageUsedInBytes', 'describeWorkingStorageResponse_workingStorageUsedInBytes' - The total working storage in bytes in use by the gateway. If no working
-- storage is configured for the gateway, this field returns 0.
--
-- 'httpStatus', 'describeWorkingStorageResponse_httpStatus' - The response's http status code.
newDescribeWorkingStorageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeWorkingStorageResponse
newDescribeWorkingStorageResponse :: Int -> DescribeWorkingStorageResponse
newDescribeWorkingStorageResponse Int
pHttpStatus_ =
  DescribeWorkingStorageResponse'
    { $sel:diskIds:DescribeWorkingStorageResponse' :: Maybe [Text]
diskIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:gatewayARN:DescribeWorkingStorageResponse' :: Maybe Text
gatewayARN = forall a. Maybe a
Prelude.Nothing,
      $sel:workingStorageAllocatedInBytes:DescribeWorkingStorageResponse' :: Maybe Integer
workingStorageAllocatedInBytes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:workingStorageUsedInBytes:DescribeWorkingStorageResponse' :: Maybe Integer
workingStorageUsedInBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeWorkingStorageResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of the gateway\'s local disk IDs that are configured as working
-- storage. Each local disk ID is specified as a string (minimum length of
-- 1 and maximum length of 300). If no local disks are configured as
-- working storage, then the DiskIds array is empty.
describeWorkingStorageResponse_diskIds :: Lens.Lens' DescribeWorkingStorageResponse (Prelude.Maybe [Prelude.Text])
describeWorkingStorageResponse_diskIds :: Lens' DescribeWorkingStorageResponse (Maybe [Text])
describeWorkingStorageResponse_diskIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkingStorageResponse' {Maybe [Text]
diskIds :: Maybe [Text]
$sel:diskIds:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe [Text]
diskIds} -> Maybe [Text]
diskIds) (\s :: DescribeWorkingStorageResponse
s@DescribeWorkingStorageResponse' {} Maybe [Text]
a -> DescribeWorkingStorageResponse
s {$sel:diskIds:DescribeWorkingStorageResponse' :: Maybe [Text]
diskIds = Maybe [Text]
a} :: DescribeWorkingStorageResponse) 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.
describeWorkingStorageResponse_gatewayARN :: Lens.Lens' DescribeWorkingStorageResponse (Prelude.Maybe Prelude.Text)
describeWorkingStorageResponse_gatewayARN :: Lens' DescribeWorkingStorageResponse (Maybe Text)
describeWorkingStorageResponse_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkingStorageResponse' {Maybe Text
gatewayARN :: Maybe Text
$sel:gatewayARN:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe Text
gatewayARN} -> Maybe Text
gatewayARN) (\s :: DescribeWorkingStorageResponse
s@DescribeWorkingStorageResponse' {} Maybe Text
a -> DescribeWorkingStorageResponse
s {$sel:gatewayARN:DescribeWorkingStorageResponse' :: Maybe Text
gatewayARN = Maybe Text
a} :: DescribeWorkingStorageResponse)

-- | The total working storage in bytes allocated for the gateway. If no
-- working storage is configured for the gateway, this field returns 0.
describeWorkingStorageResponse_workingStorageAllocatedInBytes :: Lens.Lens' DescribeWorkingStorageResponse (Prelude.Maybe Prelude.Integer)
describeWorkingStorageResponse_workingStorageAllocatedInBytes :: Lens' DescribeWorkingStorageResponse (Maybe Integer)
describeWorkingStorageResponse_workingStorageAllocatedInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkingStorageResponse' {Maybe Integer
workingStorageAllocatedInBytes :: Maybe Integer
$sel:workingStorageAllocatedInBytes:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe Integer
workingStorageAllocatedInBytes} -> Maybe Integer
workingStorageAllocatedInBytes) (\s :: DescribeWorkingStorageResponse
s@DescribeWorkingStorageResponse' {} Maybe Integer
a -> DescribeWorkingStorageResponse
s {$sel:workingStorageAllocatedInBytes:DescribeWorkingStorageResponse' :: Maybe Integer
workingStorageAllocatedInBytes = Maybe Integer
a} :: DescribeWorkingStorageResponse)

-- | The total working storage in bytes in use by the gateway. If no working
-- storage is configured for the gateway, this field returns 0.
describeWorkingStorageResponse_workingStorageUsedInBytes :: Lens.Lens' DescribeWorkingStorageResponse (Prelude.Maybe Prelude.Integer)
describeWorkingStorageResponse_workingStorageUsedInBytes :: Lens' DescribeWorkingStorageResponse (Maybe Integer)
describeWorkingStorageResponse_workingStorageUsedInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWorkingStorageResponse' {Maybe Integer
workingStorageUsedInBytes :: Maybe Integer
$sel:workingStorageUsedInBytes:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe Integer
workingStorageUsedInBytes} -> Maybe Integer
workingStorageUsedInBytes) (\s :: DescribeWorkingStorageResponse
s@DescribeWorkingStorageResponse' {} Maybe Integer
a -> DescribeWorkingStorageResponse
s {$sel:workingStorageUsedInBytes:DescribeWorkingStorageResponse' :: Maybe Integer
workingStorageUsedInBytes = Maybe Integer
a} :: DescribeWorkingStorageResponse)

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

instance
  Prelude.NFData
    DescribeWorkingStorageResponse
  where
  rnf :: DescribeWorkingStorageResponse -> ()
rnf DescribeWorkingStorageResponse' {Int
Maybe Integer
Maybe [Text]
Maybe Text
httpStatus :: Int
workingStorageUsedInBytes :: Maybe Integer
workingStorageAllocatedInBytes :: Maybe Integer
gatewayARN :: Maybe Text
diskIds :: Maybe [Text]
$sel:httpStatus:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Int
$sel:workingStorageUsedInBytes:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe Integer
$sel:workingStorageAllocatedInBytes:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe Integer
$sel:gatewayARN:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe Text
$sel:diskIds:DescribeWorkingStorageResponse' :: DescribeWorkingStorageResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
diskIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
workingStorageAllocatedInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
workingStorageUsedInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus