{-# 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.DescribeCache
-- 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 cache of a gateway. This operation is only
-- supported in the cached volume, tape, and file gateway types.
--
-- The response includes disk IDs that are configured as cache, and it
-- includes the amount of cache allocated and used.
module Amazonka.StorageGateway.DescribeCache
  ( -- * Creating a Request
    DescribeCache (..),
    newDescribeCache,

    -- * Request Lenses
    describeCache_gatewayARN,

    -- * Destructuring the Response
    DescribeCacheResponse (..),
    newDescribeCacheResponse,

    -- * Response Lenses
    describeCacheResponse_cacheAllocatedInBytes,
    describeCacheResponse_cacheDirtyPercentage,
    describeCacheResponse_cacheHitPercentage,
    describeCacheResponse_cacheMissPercentage,
    describeCacheResponse_cacheUsedPercentage,
    describeCacheResponse_diskIds,
    describeCacheResponse_gatewayARN,
    describeCacheResponse_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:/ 'newDescribeCache' smart constructor.
data DescribeCache = DescribeCache'
  { DescribeCache -> Text
gatewayARN :: Prelude.Text
  }
  deriving (DescribeCache -> DescribeCache -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCache -> DescribeCache -> Bool
$c/= :: DescribeCache -> DescribeCache -> Bool
== :: DescribeCache -> DescribeCache -> Bool
$c== :: DescribeCache -> DescribeCache -> Bool
Prelude.Eq, ReadPrec [DescribeCache]
ReadPrec DescribeCache
Int -> ReadS DescribeCache
ReadS [DescribeCache]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCache]
$creadListPrec :: ReadPrec [DescribeCache]
readPrec :: ReadPrec DescribeCache
$creadPrec :: ReadPrec DescribeCache
readList :: ReadS [DescribeCache]
$creadList :: ReadS [DescribeCache]
readsPrec :: Int -> ReadS DescribeCache
$creadsPrec :: Int -> ReadS DescribeCache
Prelude.Read, Int -> DescribeCache -> ShowS
[DescribeCache] -> ShowS
DescribeCache -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCache] -> ShowS
$cshowList :: [DescribeCache] -> ShowS
show :: DescribeCache -> String
$cshow :: DescribeCache -> String
showsPrec :: Int -> DescribeCache -> ShowS
$cshowsPrec :: Int -> DescribeCache -> ShowS
Prelude.Show, forall x. Rep DescribeCache x -> DescribeCache
forall x. DescribeCache -> Rep DescribeCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeCache x -> DescribeCache
$cfrom :: forall x. DescribeCache -> Rep DescribeCache x
Prelude.Generic)

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

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

instance Core.AWSRequest DescribeCache where
  type
    AWSResponse DescribeCache =
      DescribeCacheResponse
  request :: (Service -> Service) -> DescribeCache -> Request DescribeCache
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 DescribeCache
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeCache)))
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 Integer
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe [Text]
-> Maybe Text
-> Int
-> DescribeCacheResponse
DescribeCacheResponse'
            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
"CacheAllocatedInBytes")
            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
"CacheDirtyPercentage")
            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
"CacheHitPercentage")
            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
"CacheMissPercentage")
            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
"CacheUsedPercentage")
            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
"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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DescribeCache where
  hashWithSalt :: Int -> DescribeCache -> Int
hashWithSalt Int
_salt DescribeCache' {Text
gatewayARN :: Text
$sel:gatewayARN:DescribeCache' :: DescribeCache -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN

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

instance Data.ToHeaders DescribeCache where
  toHeaders :: DescribeCache -> 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.DescribeCache" ::
                          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 DescribeCache where
  toJSON :: DescribeCache -> Value
toJSON DescribeCache' {Text
gatewayARN :: Text
$sel:gatewayARN:DescribeCache' :: DescribeCache -> 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 DescribeCache where
  toPath :: DescribeCache -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeCacheResponse' smart constructor.
data DescribeCacheResponse = DescribeCacheResponse'
  { -- | The amount of cache in bytes allocated to a gateway.
    DescribeCacheResponse -> Maybe Integer
cacheAllocatedInBytes :: Prelude.Maybe Prelude.Integer,
    -- | The file share\'s contribution to the overall percentage of the
    -- gateway\'s cache that has not been persisted to Amazon Web Services. The
    -- sample is taken at the end of the reporting period.
    DescribeCacheResponse -> Maybe Double
cacheDirtyPercentage :: Prelude.Maybe Prelude.Double,
    -- | Percent of application read operations from the file shares that are
    -- served from cache. The sample is taken at the end of the reporting
    -- period.
    DescribeCacheResponse -> Maybe Double
cacheHitPercentage :: Prelude.Maybe Prelude.Double,
    -- | Percent of application read operations from the file shares that are not
    -- served from cache. The sample is taken at the end of the reporting
    -- period.
    DescribeCacheResponse -> Maybe Double
cacheMissPercentage :: Prelude.Maybe Prelude.Double,
    -- | Percent use of the gateway\'s cache storage. This metric applies only to
    -- the gateway-cached volume setup. The sample is taken at the end of the
    -- reporting period.
    DescribeCacheResponse -> Maybe Double
cacheUsedPercentage :: Prelude.Maybe Prelude.Double,
    -- | An array of strings that identify disks that are to be configured as
    -- working storage. Each string has a minimum length of 1 and maximum
    -- length of 300. You can get the disk IDs from the ListLocalDisks API.
    DescribeCacheResponse -> Maybe [Text]
diskIds :: Prelude.Maybe [Prelude.Text],
    DescribeCacheResponse -> Maybe Text
gatewayARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeCacheResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeCacheResponse -> DescribeCacheResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCacheResponse -> DescribeCacheResponse -> Bool
$c/= :: DescribeCacheResponse -> DescribeCacheResponse -> Bool
== :: DescribeCacheResponse -> DescribeCacheResponse -> Bool
$c== :: DescribeCacheResponse -> DescribeCacheResponse -> Bool
Prelude.Eq, ReadPrec [DescribeCacheResponse]
ReadPrec DescribeCacheResponse
Int -> ReadS DescribeCacheResponse
ReadS [DescribeCacheResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCacheResponse]
$creadListPrec :: ReadPrec [DescribeCacheResponse]
readPrec :: ReadPrec DescribeCacheResponse
$creadPrec :: ReadPrec DescribeCacheResponse
readList :: ReadS [DescribeCacheResponse]
$creadList :: ReadS [DescribeCacheResponse]
readsPrec :: Int -> ReadS DescribeCacheResponse
$creadsPrec :: Int -> ReadS DescribeCacheResponse
Prelude.Read, Int -> DescribeCacheResponse -> ShowS
[DescribeCacheResponse] -> ShowS
DescribeCacheResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCacheResponse] -> ShowS
$cshowList :: [DescribeCacheResponse] -> ShowS
show :: DescribeCacheResponse -> String
$cshow :: DescribeCacheResponse -> String
showsPrec :: Int -> DescribeCacheResponse -> ShowS
$cshowsPrec :: Int -> DescribeCacheResponse -> ShowS
Prelude.Show, forall x. Rep DescribeCacheResponse x -> DescribeCacheResponse
forall x. DescribeCacheResponse -> Rep DescribeCacheResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeCacheResponse x -> DescribeCacheResponse
$cfrom :: forall x. DescribeCacheResponse -> Rep DescribeCacheResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCacheResponse' 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:
--
-- 'cacheAllocatedInBytes', 'describeCacheResponse_cacheAllocatedInBytes' - The amount of cache in bytes allocated to a gateway.
--
-- 'cacheDirtyPercentage', 'describeCacheResponse_cacheDirtyPercentage' - The file share\'s contribution to the overall percentage of the
-- gateway\'s cache that has not been persisted to Amazon Web Services. The
-- sample is taken at the end of the reporting period.
--
-- 'cacheHitPercentage', 'describeCacheResponse_cacheHitPercentage' - Percent of application read operations from the file shares that are
-- served from cache. The sample is taken at the end of the reporting
-- period.
--
-- 'cacheMissPercentage', 'describeCacheResponse_cacheMissPercentage' - Percent of application read operations from the file shares that are not
-- served from cache. The sample is taken at the end of the reporting
-- period.
--
-- 'cacheUsedPercentage', 'describeCacheResponse_cacheUsedPercentage' - Percent use of the gateway\'s cache storage. This metric applies only to
-- the gateway-cached volume setup. The sample is taken at the end of the
-- reporting period.
--
-- 'diskIds', 'describeCacheResponse_diskIds' - An array of strings that identify disks that are to be configured as
-- working storage. Each string has a minimum length of 1 and maximum
-- length of 300. You can get the disk IDs from the ListLocalDisks API.
--
-- 'gatewayARN', 'describeCacheResponse_gatewayARN' - Undocumented member.
--
-- 'httpStatus', 'describeCacheResponse_httpStatus' - The response's http status code.
newDescribeCacheResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeCacheResponse
newDescribeCacheResponse :: Int -> DescribeCacheResponse
newDescribeCacheResponse Int
pHttpStatus_ =
  DescribeCacheResponse'
    { $sel:cacheAllocatedInBytes:DescribeCacheResponse' :: Maybe Integer
cacheAllocatedInBytes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cacheDirtyPercentage:DescribeCacheResponse' :: Maybe Double
cacheDirtyPercentage = forall a. Maybe a
Prelude.Nothing,
      $sel:cacheHitPercentage:DescribeCacheResponse' :: Maybe Double
cacheHitPercentage = forall a. Maybe a
Prelude.Nothing,
      $sel:cacheMissPercentage:DescribeCacheResponse' :: Maybe Double
cacheMissPercentage = forall a. Maybe a
Prelude.Nothing,
      $sel:cacheUsedPercentage:DescribeCacheResponse' :: Maybe Double
cacheUsedPercentage = forall a. Maybe a
Prelude.Nothing,
      $sel:diskIds:DescribeCacheResponse' :: Maybe [Text]
diskIds = forall a. Maybe a
Prelude.Nothing,
      $sel:gatewayARN:DescribeCacheResponse' :: Maybe Text
gatewayARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeCacheResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The amount of cache in bytes allocated to a gateway.
describeCacheResponse_cacheAllocatedInBytes :: Lens.Lens' DescribeCacheResponse (Prelude.Maybe Prelude.Integer)
describeCacheResponse_cacheAllocatedInBytes :: Lens' DescribeCacheResponse (Maybe Integer)
describeCacheResponse_cacheAllocatedInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCacheResponse' {Maybe Integer
cacheAllocatedInBytes :: Maybe Integer
$sel:cacheAllocatedInBytes:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Integer
cacheAllocatedInBytes} -> Maybe Integer
cacheAllocatedInBytes) (\s :: DescribeCacheResponse
s@DescribeCacheResponse' {} Maybe Integer
a -> DescribeCacheResponse
s {$sel:cacheAllocatedInBytes:DescribeCacheResponse' :: Maybe Integer
cacheAllocatedInBytes = Maybe Integer
a} :: DescribeCacheResponse)

-- | The file share\'s contribution to the overall percentage of the
-- gateway\'s cache that has not been persisted to Amazon Web Services. The
-- sample is taken at the end of the reporting period.
describeCacheResponse_cacheDirtyPercentage :: Lens.Lens' DescribeCacheResponse (Prelude.Maybe Prelude.Double)
describeCacheResponse_cacheDirtyPercentage :: Lens' DescribeCacheResponse (Maybe Double)
describeCacheResponse_cacheDirtyPercentage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCacheResponse' {Maybe Double
cacheDirtyPercentage :: Maybe Double
$sel:cacheDirtyPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
cacheDirtyPercentage} -> Maybe Double
cacheDirtyPercentage) (\s :: DescribeCacheResponse
s@DescribeCacheResponse' {} Maybe Double
a -> DescribeCacheResponse
s {$sel:cacheDirtyPercentage:DescribeCacheResponse' :: Maybe Double
cacheDirtyPercentage = Maybe Double
a} :: DescribeCacheResponse)

-- | Percent of application read operations from the file shares that are
-- served from cache. The sample is taken at the end of the reporting
-- period.
describeCacheResponse_cacheHitPercentage :: Lens.Lens' DescribeCacheResponse (Prelude.Maybe Prelude.Double)
describeCacheResponse_cacheHitPercentage :: Lens' DescribeCacheResponse (Maybe Double)
describeCacheResponse_cacheHitPercentage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCacheResponse' {Maybe Double
cacheHitPercentage :: Maybe Double
$sel:cacheHitPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
cacheHitPercentage} -> Maybe Double
cacheHitPercentage) (\s :: DescribeCacheResponse
s@DescribeCacheResponse' {} Maybe Double
a -> DescribeCacheResponse
s {$sel:cacheHitPercentage:DescribeCacheResponse' :: Maybe Double
cacheHitPercentage = Maybe Double
a} :: DescribeCacheResponse)

-- | Percent of application read operations from the file shares that are not
-- served from cache. The sample is taken at the end of the reporting
-- period.
describeCacheResponse_cacheMissPercentage :: Lens.Lens' DescribeCacheResponse (Prelude.Maybe Prelude.Double)
describeCacheResponse_cacheMissPercentage :: Lens' DescribeCacheResponse (Maybe Double)
describeCacheResponse_cacheMissPercentage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCacheResponse' {Maybe Double
cacheMissPercentage :: Maybe Double
$sel:cacheMissPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
cacheMissPercentage} -> Maybe Double
cacheMissPercentage) (\s :: DescribeCacheResponse
s@DescribeCacheResponse' {} Maybe Double
a -> DescribeCacheResponse
s {$sel:cacheMissPercentage:DescribeCacheResponse' :: Maybe Double
cacheMissPercentage = Maybe Double
a} :: DescribeCacheResponse)

-- | Percent use of the gateway\'s cache storage. This metric applies only to
-- the gateway-cached volume setup. The sample is taken at the end of the
-- reporting period.
describeCacheResponse_cacheUsedPercentage :: Lens.Lens' DescribeCacheResponse (Prelude.Maybe Prelude.Double)
describeCacheResponse_cacheUsedPercentage :: Lens' DescribeCacheResponse (Maybe Double)
describeCacheResponse_cacheUsedPercentage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCacheResponse' {Maybe Double
cacheUsedPercentage :: Maybe Double
$sel:cacheUsedPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
cacheUsedPercentage} -> Maybe Double
cacheUsedPercentage) (\s :: DescribeCacheResponse
s@DescribeCacheResponse' {} Maybe Double
a -> DescribeCacheResponse
s {$sel:cacheUsedPercentage:DescribeCacheResponse' :: Maybe Double
cacheUsedPercentage = Maybe Double
a} :: DescribeCacheResponse)

-- | An array of strings that identify disks that are to be configured as
-- working storage. Each string has a minimum length of 1 and maximum
-- length of 300. You can get the disk IDs from the ListLocalDisks API.
describeCacheResponse_diskIds :: Lens.Lens' DescribeCacheResponse (Prelude.Maybe [Prelude.Text])
describeCacheResponse_diskIds :: Lens' DescribeCacheResponse (Maybe [Text])
describeCacheResponse_diskIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCacheResponse' {Maybe [Text]
diskIds :: Maybe [Text]
$sel:diskIds:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe [Text]
diskIds} -> Maybe [Text]
diskIds) (\s :: DescribeCacheResponse
s@DescribeCacheResponse' {} Maybe [Text]
a -> DescribeCacheResponse
s {$sel:diskIds:DescribeCacheResponse' :: Maybe [Text]
diskIds = Maybe [Text]
a} :: DescribeCacheResponse) 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.
describeCacheResponse_gatewayARN :: Lens.Lens' DescribeCacheResponse (Prelude.Maybe Prelude.Text)
describeCacheResponse_gatewayARN :: Lens' DescribeCacheResponse (Maybe Text)
describeCacheResponse_gatewayARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCacheResponse' {Maybe Text
gatewayARN :: Maybe Text
$sel:gatewayARN:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Text
gatewayARN} -> Maybe Text
gatewayARN) (\s :: DescribeCacheResponse
s@DescribeCacheResponse' {} Maybe Text
a -> DescribeCacheResponse
s {$sel:gatewayARN:DescribeCacheResponse' :: Maybe Text
gatewayARN = Maybe Text
a} :: DescribeCacheResponse)

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

instance Prelude.NFData DescribeCacheResponse where
  rnf :: DescribeCacheResponse -> ()
rnf DescribeCacheResponse' {Int
Maybe Double
Maybe Integer
Maybe [Text]
Maybe Text
httpStatus :: Int
gatewayARN :: Maybe Text
diskIds :: Maybe [Text]
cacheUsedPercentage :: Maybe Double
cacheMissPercentage :: Maybe Double
cacheHitPercentage :: Maybe Double
cacheDirtyPercentage :: Maybe Double
cacheAllocatedInBytes :: Maybe Integer
$sel:httpStatus:DescribeCacheResponse' :: DescribeCacheResponse -> Int
$sel:gatewayARN:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Text
$sel:diskIds:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe [Text]
$sel:cacheUsedPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
$sel:cacheMissPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
$sel:cacheHitPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
$sel:cacheDirtyPercentage:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Double
$sel:cacheAllocatedInBytes:DescribeCacheResponse' :: DescribeCacheResponse -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
cacheAllocatedInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
cacheDirtyPercentage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
cacheHitPercentage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
cacheMissPercentage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
cacheUsedPercentage
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Int
httpStatus