{-# 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.ListTapePools
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists custom tape pools. You specify custom tape pools to list by
-- specifying one or more custom tape pool Amazon Resource Names (ARNs). If
-- you don\'t specify a custom tape pool ARN, the operation lists all
-- custom tape pools.
--
-- This operation supports pagination. You can optionally specify the
-- @Limit@ parameter in the body to limit the number of tape pools in the
-- response. If the number of tape pools returned in the response is
-- truncated, the response includes a @Marker@ element that you can use in
-- your subsequent request to retrieve the next set of tape pools.
--
-- This operation returns paginated results.
module Amazonka.StorageGateway.ListTapePools
  ( -- * Creating a Request
    ListTapePools (..),
    newListTapePools,

    -- * Request Lenses
    listTapePools_limit,
    listTapePools_marker,
    listTapePools_poolARNs,

    -- * Destructuring the Response
    ListTapePoolsResponse (..),
    newListTapePoolsResponse,

    -- * Response Lenses
    listTapePoolsResponse_marker,
    listTapePoolsResponse_poolInfos,
    listTapePoolsResponse_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:/ 'newListTapePools' smart constructor.
data ListTapePools = ListTapePools'
  { -- | An optional number limit for the tape pools in the list returned by this
    -- call.
    ListTapePools -> Maybe Natural
limit :: Prelude.Maybe Prelude.Natural,
    -- | A string that indicates the position at which to begin the returned list
    -- of tape pools.
    ListTapePools -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of each of the custom tape pools you want
    -- to list. If you don\'t specify a custom tape pool ARN, the response
    -- lists all custom tape pools.
    ListTapePools -> Maybe [Text]
poolARNs :: Prelude.Maybe [Prelude.Text]
  }
  deriving (ListTapePools -> ListTapePools -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTapePools -> ListTapePools -> Bool
$c/= :: ListTapePools -> ListTapePools -> Bool
== :: ListTapePools -> ListTapePools -> Bool
$c== :: ListTapePools -> ListTapePools -> Bool
Prelude.Eq, ReadPrec [ListTapePools]
ReadPrec ListTapePools
Int -> ReadS ListTapePools
ReadS [ListTapePools]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTapePools]
$creadListPrec :: ReadPrec [ListTapePools]
readPrec :: ReadPrec ListTapePools
$creadPrec :: ReadPrec ListTapePools
readList :: ReadS [ListTapePools]
$creadList :: ReadS [ListTapePools]
readsPrec :: Int -> ReadS ListTapePools
$creadsPrec :: Int -> ReadS ListTapePools
Prelude.Read, Int -> ListTapePools -> ShowS
[ListTapePools] -> ShowS
ListTapePools -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTapePools] -> ShowS
$cshowList :: [ListTapePools] -> ShowS
show :: ListTapePools -> String
$cshow :: ListTapePools -> String
showsPrec :: Int -> ListTapePools -> ShowS
$cshowsPrec :: Int -> ListTapePools -> ShowS
Prelude.Show, forall x. Rep ListTapePools x -> ListTapePools
forall x. ListTapePools -> Rep ListTapePools x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTapePools x -> ListTapePools
$cfrom :: forall x. ListTapePools -> Rep ListTapePools x
Prelude.Generic)

-- |
-- Create a value of 'ListTapePools' 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:
--
-- 'limit', 'listTapePools_limit' - An optional number limit for the tape pools in the list returned by this
-- call.
--
-- 'marker', 'listTapePools_marker' - A string that indicates the position at which to begin the returned list
-- of tape pools.
--
-- 'poolARNs', 'listTapePools_poolARNs' - The Amazon Resource Name (ARN) of each of the custom tape pools you want
-- to list. If you don\'t specify a custom tape pool ARN, the response
-- lists all custom tape pools.
newListTapePools ::
  ListTapePools
newListTapePools :: ListTapePools
newListTapePools =
  ListTapePools'
    { $sel:limit:ListTapePools' :: Maybe Natural
limit = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListTapePools' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:poolARNs:ListTapePools' :: Maybe [Text]
poolARNs = forall a. Maybe a
Prelude.Nothing
    }

-- | An optional number limit for the tape pools in the list returned by this
-- call.
listTapePools_limit :: Lens.Lens' ListTapePools (Prelude.Maybe Prelude.Natural)
listTapePools_limit :: Lens' ListTapePools (Maybe Natural)
listTapePools_limit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTapePools' {Maybe Natural
limit :: Maybe Natural
$sel:limit:ListTapePools' :: ListTapePools -> Maybe Natural
limit} -> Maybe Natural
limit) (\s :: ListTapePools
s@ListTapePools' {} Maybe Natural
a -> ListTapePools
s {$sel:limit:ListTapePools' :: Maybe Natural
limit = Maybe Natural
a} :: ListTapePools)

-- | A string that indicates the position at which to begin the returned list
-- of tape pools.
listTapePools_marker :: Lens.Lens' ListTapePools (Prelude.Maybe Prelude.Text)
listTapePools_marker :: Lens' ListTapePools (Maybe Text)
listTapePools_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTapePools' {Maybe Text
marker :: Maybe Text
$sel:marker:ListTapePools' :: ListTapePools -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListTapePools
s@ListTapePools' {} Maybe Text
a -> ListTapePools
s {$sel:marker:ListTapePools' :: Maybe Text
marker = Maybe Text
a} :: ListTapePools)

-- | The Amazon Resource Name (ARN) of each of the custom tape pools you want
-- to list. If you don\'t specify a custom tape pool ARN, the response
-- lists all custom tape pools.
listTapePools_poolARNs :: Lens.Lens' ListTapePools (Prelude.Maybe [Prelude.Text])
listTapePools_poolARNs :: Lens' ListTapePools (Maybe [Text])
listTapePools_poolARNs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTapePools' {Maybe [Text]
poolARNs :: Maybe [Text]
$sel:poolARNs:ListTapePools' :: ListTapePools -> Maybe [Text]
poolARNs} -> Maybe [Text]
poolARNs) (\s :: ListTapePools
s@ListTapePools' {} Maybe [Text]
a -> ListTapePools
s {$sel:poolARNs:ListTapePools' :: Maybe [Text]
poolARNs = Maybe [Text]
a} :: ListTapePools) 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

instance Core.AWSPager ListTapePools where
  page :: ListTapePools -> AWSResponse ListTapePools -> Maybe ListTapePools
page ListTapePools
rq AWSResponse ListTapePools
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTapePools
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTapePoolsResponse (Maybe Text)
listTapePoolsResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTapePools
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTapePoolsResponse (Maybe [PoolInfo])
listTapePoolsResponse_poolInfos
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListTapePools
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTapePools (Maybe Text)
listTapePools_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTapePools
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTapePoolsResponse (Maybe Text)
listTapePoolsResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListTapePools where
  type
    AWSResponse ListTapePools =
      ListTapePoolsResponse
  request :: (Service -> Service) -> ListTapePools -> Request ListTapePools
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 ListTapePools
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListTapePools)))
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 [PoolInfo] -> Int -> ListTapePoolsResponse
ListTapePoolsResponse'
            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
"Marker")
            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
"PoolInfos" 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 ListTapePools where
  hashWithSalt :: Int -> ListTapePools -> Int
hashWithSalt Int
_salt ListTapePools' {Maybe Natural
Maybe [Text]
Maybe Text
poolARNs :: Maybe [Text]
marker :: Maybe Text
limit :: Maybe Natural
$sel:poolARNs:ListTapePools' :: ListTapePools -> Maybe [Text]
$sel:marker:ListTapePools' :: ListTapePools -> Maybe Text
$sel:limit:ListTapePools' :: ListTapePools -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
limit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
poolARNs

instance Prelude.NFData ListTapePools where
  rnf :: ListTapePools -> ()
rnf ListTapePools' {Maybe Natural
Maybe [Text]
Maybe Text
poolARNs :: Maybe [Text]
marker :: Maybe Text
limit :: Maybe Natural
$sel:poolARNs:ListTapePools' :: ListTapePools -> Maybe [Text]
$sel:marker:ListTapePools' :: ListTapePools -> Maybe Text
$sel:limit:ListTapePools' :: ListTapePools -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
limit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
poolARNs

instance Data.ToHeaders ListTapePools where
  toHeaders :: ListTapePools -> 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.ListTapePools" ::
                          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 ListTapePools where
  toJSON :: ListTapePools -> Value
toJSON ListTapePools' {Maybe Natural
Maybe [Text]
Maybe Text
poolARNs :: Maybe [Text]
marker :: Maybe Text
limit :: Maybe Natural
$sel:poolARNs:ListTapePools' :: ListTapePools -> Maybe [Text]
$sel:marker:ListTapePools' :: ListTapePools -> Maybe Text
$sel:limit:ListTapePools' :: ListTapePools -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Limit" 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 Natural
limit,
            (Key
"Marker" 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
marker,
            (Key
"PoolARNs" 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]
poolARNs
          ]
      )

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

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

-- | /See:/ 'newListTapePoolsResponse' smart constructor.
data ListTapePoolsResponse = ListTapePoolsResponse'
  { -- | A string that indicates the position at which to begin the returned list
    -- of tape pools. Use the marker in your next request to continue
    -- pagination of tape pools. If there are no more tape pools to list, this
    -- element does not appear in the response body.
    ListTapePoolsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | An array of @PoolInfo@ objects, where each object describes a single
    -- custom tape pool. If there are no custom tape pools, the @PoolInfos@ is
    -- an empty array.
    ListTapePoolsResponse -> Maybe [PoolInfo]
poolInfos :: Prelude.Maybe [PoolInfo],
    -- | The response's http status code.
    ListTapePoolsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTapePoolsResponse -> ListTapePoolsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTapePoolsResponse -> ListTapePoolsResponse -> Bool
$c/= :: ListTapePoolsResponse -> ListTapePoolsResponse -> Bool
== :: ListTapePoolsResponse -> ListTapePoolsResponse -> Bool
$c== :: ListTapePoolsResponse -> ListTapePoolsResponse -> Bool
Prelude.Eq, ReadPrec [ListTapePoolsResponse]
ReadPrec ListTapePoolsResponse
Int -> ReadS ListTapePoolsResponse
ReadS [ListTapePoolsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTapePoolsResponse]
$creadListPrec :: ReadPrec [ListTapePoolsResponse]
readPrec :: ReadPrec ListTapePoolsResponse
$creadPrec :: ReadPrec ListTapePoolsResponse
readList :: ReadS [ListTapePoolsResponse]
$creadList :: ReadS [ListTapePoolsResponse]
readsPrec :: Int -> ReadS ListTapePoolsResponse
$creadsPrec :: Int -> ReadS ListTapePoolsResponse
Prelude.Read, Int -> ListTapePoolsResponse -> ShowS
[ListTapePoolsResponse] -> ShowS
ListTapePoolsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTapePoolsResponse] -> ShowS
$cshowList :: [ListTapePoolsResponse] -> ShowS
show :: ListTapePoolsResponse -> String
$cshow :: ListTapePoolsResponse -> String
showsPrec :: Int -> ListTapePoolsResponse -> ShowS
$cshowsPrec :: Int -> ListTapePoolsResponse -> ShowS
Prelude.Show, forall x. Rep ListTapePoolsResponse x -> ListTapePoolsResponse
forall x. ListTapePoolsResponse -> Rep ListTapePoolsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTapePoolsResponse x -> ListTapePoolsResponse
$cfrom :: forall x. ListTapePoolsResponse -> Rep ListTapePoolsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTapePoolsResponse' 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:
--
-- 'marker', 'listTapePoolsResponse_marker' - A string that indicates the position at which to begin the returned list
-- of tape pools. Use the marker in your next request to continue
-- pagination of tape pools. If there are no more tape pools to list, this
-- element does not appear in the response body.
--
-- 'poolInfos', 'listTapePoolsResponse_poolInfos' - An array of @PoolInfo@ objects, where each object describes a single
-- custom tape pool. If there are no custom tape pools, the @PoolInfos@ is
-- an empty array.
--
-- 'httpStatus', 'listTapePoolsResponse_httpStatus' - The response's http status code.
newListTapePoolsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTapePoolsResponse
newListTapePoolsResponse :: Int -> ListTapePoolsResponse
newListTapePoolsResponse Int
pHttpStatus_ =
  ListTapePoolsResponse'
    { $sel:marker:ListTapePoolsResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:poolInfos:ListTapePoolsResponse' :: Maybe [PoolInfo]
poolInfos = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTapePoolsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A string that indicates the position at which to begin the returned list
-- of tape pools. Use the marker in your next request to continue
-- pagination of tape pools. If there are no more tape pools to list, this
-- element does not appear in the response body.
listTapePoolsResponse_marker :: Lens.Lens' ListTapePoolsResponse (Prelude.Maybe Prelude.Text)
listTapePoolsResponse_marker :: Lens' ListTapePoolsResponse (Maybe Text)
listTapePoolsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTapePoolsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListTapePoolsResponse' :: ListTapePoolsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListTapePoolsResponse
s@ListTapePoolsResponse' {} Maybe Text
a -> ListTapePoolsResponse
s {$sel:marker:ListTapePoolsResponse' :: Maybe Text
marker = Maybe Text
a} :: ListTapePoolsResponse)

-- | An array of @PoolInfo@ objects, where each object describes a single
-- custom tape pool. If there are no custom tape pools, the @PoolInfos@ is
-- an empty array.
listTapePoolsResponse_poolInfos :: Lens.Lens' ListTapePoolsResponse (Prelude.Maybe [PoolInfo])
listTapePoolsResponse_poolInfos :: Lens' ListTapePoolsResponse (Maybe [PoolInfo])
listTapePoolsResponse_poolInfos = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTapePoolsResponse' {Maybe [PoolInfo]
poolInfos :: Maybe [PoolInfo]
$sel:poolInfos:ListTapePoolsResponse' :: ListTapePoolsResponse -> Maybe [PoolInfo]
poolInfos} -> Maybe [PoolInfo]
poolInfos) (\s :: ListTapePoolsResponse
s@ListTapePoolsResponse' {} Maybe [PoolInfo]
a -> ListTapePoolsResponse
s {$sel:poolInfos:ListTapePoolsResponse' :: Maybe [PoolInfo]
poolInfos = Maybe [PoolInfo]
a} :: ListTapePoolsResponse) 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.
listTapePoolsResponse_httpStatus :: Lens.Lens' ListTapePoolsResponse Prelude.Int
listTapePoolsResponse_httpStatus :: Lens' ListTapePoolsResponse Int
listTapePoolsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTapePoolsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTapePoolsResponse' :: ListTapePoolsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTapePoolsResponse
s@ListTapePoolsResponse' {} Int
a -> ListTapePoolsResponse
s {$sel:httpStatus:ListTapePoolsResponse' :: Int
httpStatus = Int
a} :: ListTapePoolsResponse)

instance Prelude.NFData ListTapePoolsResponse where
  rnf :: ListTapePoolsResponse -> ()
rnf ListTapePoolsResponse' {Int
Maybe [PoolInfo]
Maybe Text
httpStatus :: Int
poolInfos :: Maybe [PoolInfo]
marker :: Maybe Text
$sel:httpStatus:ListTapePoolsResponse' :: ListTapePoolsResponse -> Int
$sel:poolInfos:ListTapePoolsResponse' :: ListTapePoolsResponse -> Maybe [PoolInfo]
$sel:marker:ListTapePoolsResponse' :: ListTapePoolsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PoolInfo]
poolInfos
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus