{-# 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.Omics.ListSequenceStores
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a list of sequence stores.
--
-- This operation returns paginated results.
module Amazonka.Omics.ListSequenceStores
  ( -- * Creating a Request
    ListSequenceStores (..),
    newListSequenceStores,

    -- * Request Lenses
    listSequenceStores_filter,
    listSequenceStores_maxResults,
    listSequenceStores_nextToken,

    -- * Destructuring the Response
    ListSequenceStoresResponse (..),
    newListSequenceStoresResponse,

    -- * Response Lenses
    listSequenceStoresResponse_nextToken,
    listSequenceStoresResponse_httpStatus,
    listSequenceStoresResponse_sequenceStores,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Omics.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListSequenceStores' smart constructor.
data ListSequenceStores = ListSequenceStores'
  { -- | A filter to apply to the list.
    ListSequenceStores -> Maybe SequenceStoreFilter
filter' :: Prelude.Maybe SequenceStoreFilter,
    -- | The maximum number of stores to return in one page of results.
    ListSequenceStores -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Specify the pagination token from a previous request to retrieve the
    -- next page of results.
    ListSequenceStores -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListSequenceStores -> ListSequenceStores -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSequenceStores -> ListSequenceStores -> Bool
$c/= :: ListSequenceStores -> ListSequenceStores -> Bool
== :: ListSequenceStores -> ListSequenceStores -> Bool
$c== :: ListSequenceStores -> ListSequenceStores -> Bool
Prelude.Eq, ReadPrec [ListSequenceStores]
ReadPrec ListSequenceStores
Int -> ReadS ListSequenceStores
ReadS [ListSequenceStores]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSequenceStores]
$creadListPrec :: ReadPrec [ListSequenceStores]
readPrec :: ReadPrec ListSequenceStores
$creadPrec :: ReadPrec ListSequenceStores
readList :: ReadS [ListSequenceStores]
$creadList :: ReadS [ListSequenceStores]
readsPrec :: Int -> ReadS ListSequenceStores
$creadsPrec :: Int -> ReadS ListSequenceStores
Prelude.Read, Int -> ListSequenceStores -> ShowS
[ListSequenceStores] -> ShowS
ListSequenceStores -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSequenceStores] -> ShowS
$cshowList :: [ListSequenceStores] -> ShowS
show :: ListSequenceStores -> String
$cshow :: ListSequenceStores -> String
showsPrec :: Int -> ListSequenceStores -> ShowS
$cshowsPrec :: Int -> ListSequenceStores -> ShowS
Prelude.Show, forall x. Rep ListSequenceStores x -> ListSequenceStores
forall x. ListSequenceStores -> Rep ListSequenceStores x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSequenceStores x -> ListSequenceStores
$cfrom :: forall x. ListSequenceStores -> Rep ListSequenceStores x
Prelude.Generic)

-- |
-- Create a value of 'ListSequenceStores' 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:
--
-- 'filter'', 'listSequenceStores_filter' - A filter to apply to the list.
--
-- 'maxResults', 'listSequenceStores_maxResults' - The maximum number of stores to return in one page of results.
--
-- 'nextToken', 'listSequenceStores_nextToken' - Specify the pagination token from a previous request to retrieve the
-- next page of results.
newListSequenceStores ::
  ListSequenceStores
newListSequenceStores :: ListSequenceStores
newListSequenceStores =
  ListSequenceStores'
    { $sel:filter':ListSequenceStores' :: Maybe SequenceStoreFilter
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListSequenceStores' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSequenceStores' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | A filter to apply to the list.
listSequenceStores_filter :: Lens.Lens' ListSequenceStores (Prelude.Maybe SequenceStoreFilter)
listSequenceStores_filter :: Lens' ListSequenceStores (Maybe SequenceStoreFilter)
listSequenceStores_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSequenceStores' {Maybe SequenceStoreFilter
filter' :: Maybe SequenceStoreFilter
$sel:filter':ListSequenceStores' :: ListSequenceStores -> Maybe SequenceStoreFilter
filter'} -> Maybe SequenceStoreFilter
filter') (\s :: ListSequenceStores
s@ListSequenceStores' {} Maybe SequenceStoreFilter
a -> ListSequenceStores
s {$sel:filter':ListSequenceStores' :: Maybe SequenceStoreFilter
filter' = Maybe SequenceStoreFilter
a} :: ListSequenceStores)

-- | The maximum number of stores to return in one page of results.
listSequenceStores_maxResults :: Lens.Lens' ListSequenceStores (Prelude.Maybe Prelude.Natural)
listSequenceStores_maxResults :: Lens' ListSequenceStores (Maybe Natural)
listSequenceStores_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSequenceStores' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListSequenceStores' :: ListSequenceStores -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListSequenceStores
s@ListSequenceStores' {} Maybe Natural
a -> ListSequenceStores
s {$sel:maxResults:ListSequenceStores' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListSequenceStores)

-- | Specify the pagination token from a previous request to retrieve the
-- next page of results.
listSequenceStores_nextToken :: Lens.Lens' ListSequenceStores (Prelude.Maybe Prelude.Text)
listSequenceStores_nextToken :: Lens' ListSequenceStores (Maybe Text)
listSequenceStores_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSequenceStores' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSequenceStores' :: ListSequenceStores -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSequenceStores
s@ListSequenceStores' {} Maybe Text
a -> ListSequenceStores
s {$sel:nextToken:ListSequenceStores' :: Maybe Text
nextToken = Maybe Text
a} :: ListSequenceStores)

instance Core.AWSPager ListSequenceStores where
  page :: ListSequenceStores
-> AWSResponse ListSequenceStores -> Maybe ListSequenceStores
page ListSequenceStores
rq AWSResponse ListSequenceStores
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSequenceStores
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSequenceStoresResponse (Maybe Text)
listSequenceStoresResponse_nextToken
            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 ListSequenceStores
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListSequenceStoresResponse [SequenceStoreDetail]
listSequenceStoresResponse_sequenceStores
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListSequenceStores
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSequenceStores (Maybe Text)
listSequenceStores_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSequenceStores
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSequenceStoresResponse (Maybe Text)
listSequenceStoresResponse_nextToken
          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 ListSequenceStores where
  type
    AWSResponse ListSequenceStores =
      ListSequenceStoresResponse
  request :: (Service -> Service)
-> ListSequenceStores -> Request ListSequenceStores
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 ListSequenceStores
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListSequenceStores)))
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
-> Int -> [SequenceStoreDetail] -> ListSequenceStoresResponse
ListSequenceStoresResponse'
            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
"nextToken")
            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))
            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
"sequenceStores"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListSequenceStores where
  hashWithSalt :: Int -> ListSequenceStores -> Int
hashWithSalt Int
_salt ListSequenceStores' {Maybe Natural
Maybe Text
Maybe SequenceStoreFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe SequenceStoreFilter
$sel:nextToken:ListSequenceStores' :: ListSequenceStores -> Maybe Text
$sel:maxResults:ListSequenceStores' :: ListSequenceStores -> Maybe Natural
$sel:filter':ListSequenceStores' :: ListSequenceStores -> Maybe SequenceStoreFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SequenceStoreFilter
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListSequenceStores where
  rnf :: ListSequenceStores -> ()
rnf ListSequenceStores' {Maybe Natural
Maybe Text
Maybe SequenceStoreFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe SequenceStoreFilter
$sel:nextToken:ListSequenceStores' :: ListSequenceStores -> Maybe Text
$sel:maxResults:ListSequenceStores' :: ListSequenceStores -> Maybe Natural
$sel:filter':ListSequenceStores' :: ListSequenceStores -> Maybe SequenceStoreFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SequenceStoreFilter
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListSequenceStores where
  toHeaders :: ListSequenceStores -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListSequenceStores where
  toJSON :: ListSequenceStores -> Value
toJSON ListSequenceStores' {Maybe Natural
Maybe Text
Maybe SequenceStoreFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe SequenceStoreFilter
$sel:nextToken:ListSequenceStores' :: ListSequenceStores -> Maybe Text
$sel:maxResults:ListSequenceStores' :: ListSequenceStores -> Maybe Natural
$sel:filter':ListSequenceStores' :: ListSequenceStores -> Maybe SequenceStoreFilter
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"filter" 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 SequenceStoreFilter
filter']
      )

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

instance Data.ToQuery ListSequenceStores where
  toQuery :: ListSequenceStores -> QueryString
toQuery ListSequenceStores' {Maybe Natural
Maybe Text
Maybe SequenceStoreFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe SequenceStoreFilter
$sel:nextToken:ListSequenceStores' :: ListSequenceStores -> Maybe Text
$sel:maxResults:ListSequenceStores' :: ListSequenceStores -> Maybe Natural
$sel:filter':ListSequenceStores' :: ListSequenceStores -> Maybe SequenceStoreFilter
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListSequenceStoresResponse' smart constructor.
data ListSequenceStoresResponse = ListSequenceStoresResponse'
  { -- | A pagination token that\'s included if more results are available.
    ListSequenceStoresResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListSequenceStoresResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of sequence stores.
    ListSequenceStoresResponse -> [SequenceStoreDetail]
sequenceStores :: [SequenceStoreDetail]
  }
  deriving (ListSequenceStoresResponse -> ListSequenceStoresResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSequenceStoresResponse -> ListSequenceStoresResponse -> Bool
$c/= :: ListSequenceStoresResponse -> ListSequenceStoresResponse -> Bool
== :: ListSequenceStoresResponse -> ListSequenceStoresResponse -> Bool
$c== :: ListSequenceStoresResponse -> ListSequenceStoresResponse -> Bool
Prelude.Eq, ReadPrec [ListSequenceStoresResponse]
ReadPrec ListSequenceStoresResponse
Int -> ReadS ListSequenceStoresResponse
ReadS [ListSequenceStoresResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSequenceStoresResponse]
$creadListPrec :: ReadPrec [ListSequenceStoresResponse]
readPrec :: ReadPrec ListSequenceStoresResponse
$creadPrec :: ReadPrec ListSequenceStoresResponse
readList :: ReadS [ListSequenceStoresResponse]
$creadList :: ReadS [ListSequenceStoresResponse]
readsPrec :: Int -> ReadS ListSequenceStoresResponse
$creadsPrec :: Int -> ReadS ListSequenceStoresResponse
Prelude.Read, Int -> ListSequenceStoresResponse -> ShowS
[ListSequenceStoresResponse] -> ShowS
ListSequenceStoresResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSequenceStoresResponse] -> ShowS
$cshowList :: [ListSequenceStoresResponse] -> ShowS
show :: ListSequenceStoresResponse -> String
$cshow :: ListSequenceStoresResponse -> String
showsPrec :: Int -> ListSequenceStoresResponse -> ShowS
$cshowsPrec :: Int -> ListSequenceStoresResponse -> ShowS
Prelude.Show, forall x.
Rep ListSequenceStoresResponse x -> ListSequenceStoresResponse
forall x.
ListSequenceStoresResponse -> Rep ListSequenceStoresResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListSequenceStoresResponse x -> ListSequenceStoresResponse
$cfrom :: forall x.
ListSequenceStoresResponse -> Rep ListSequenceStoresResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSequenceStoresResponse' 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:
--
-- 'nextToken', 'listSequenceStoresResponse_nextToken' - A pagination token that\'s included if more results are available.
--
-- 'httpStatus', 'listSequenceStoresResponse_httpStatus' - The response's http status code.
--
-- 'sequenceStores', 'listSequenceStoresResponse_sequenceStores' - A list of sequence stores.
newListSequenceStoresResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSequenceStoresResponse
newListSequenceStoresResponse :: Int -> ListSequenceStoresResponse
newListSequenceStoresResponse Int
pHttpStatus_ =
  ListSequenceStoresResponse'
    { $sel:nextToken:ListSequenceStoresResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSequenceStoresResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:sequenceStores:ListSequenceStoresResponse' :: [SequenceStoreDetail]
sequenceStores = forall a. Monoid a => a
Prelude.mempty
    }

-- | A pagination token that\'s included if more results are available.
listSequenceStoresResponse_nextToken :: Lens.Lens' ListSequenceStoresResponse (Prelude.Maybe Prelude.Text)
listSequenceStoresResponse_nextToken :: Lens' ListSequenceStoresResponse (Maybe Text)
listSequenceStoresResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSequenceStoresResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSequenceStoresResponse' :: ListSequenceStoresResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSequenceStoresResponse
s@ListSequenceStoresResponse' {} Maybe Text
a -> ListSequenceStoresResponse
s {$sel:nextToken:ListSequenceStoresResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSequenceStoresResponse)

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

-- | A list of sequence stores.
listSequenceStoresResponse_sequenceStores :: Lens.Lens' ListSequenceStoresResponse [SequenceStoreDetail]
listSequenceStoresResponse_sequenceStores :: Lens' ListSequenceStoresResponse [SequenceStoreDetail]
listSequenceStoresResponse_sequenceStores = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSequenceStoresResponse' {[SequenceStoreDetail]
sequenceStores :: [SequenceStoreDetail]
$sel:sequenceStores:ListSequenceStoresResponse' :: ListSequenceStoresResponse -> [SequenceStoreDetail]
sequenceStores} -> [SequenceStoreDetail]
sequenceStores) (\s :: ListSequenceStoresResponse
s@ListSequenceStoresResponse' {} [SequenceStoreDetail]
a -> ListSequenceStoresResponse
s {$sel:sequenceStores:ListSequenceStoresResponse' :: [SequenceStoreDetail]
sequenceStores = [SequenceStoreDetail]
a} :: ListSequenceStoresResponse) 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 Prelude.NFData ListSequenceStoresResponse where
  rnf :: ListSequenceStoresResponse -> ()
rnf ListSequenceStoresResponse' {Int
[SequenceStoreDetail]
Maybe Text
sequenceStores :: [SequenceStoreDetail]
httpStatus :: Int
nextToken :: Maybe Text
$sel:sequenceStores:ListSequenceStoresResponse' :: ListSequenceStoresResponse -> [SequenceStoreDetail]
$sel:httpStatus:ListSequenceStoresResponse' :: ListSequenceStoresResponse -> Int
$sel:nextToken:ListSequenceStoresResponse' :: ListSequenceStoresResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [SequenceStoreDetail]
sequenceStores