{-# 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.SSM.ListDocumentVersions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List all versions for a document.
--
-- This operation returns paginated results.
module Amazonka.SSM.ListDocumentVersions
  ( -- * Creating a Request
    ListDocumentVersions (..),
    newListDocumentVersions,

    -- * Request Lenses
    listDocumentVersions_maxResults,
    listDocumentVersions_nextToken,
    listDocumentVersions_name,

    -- * Destructuring the Response
    ListDocumentVersionsResponse (..),
    newListDocumentVersionsResponse,

    -- * Response Lenses
    listDocumentVersionsResponse_documentVersions,
    listDocumentVersionsResponse_nextToken,
    listDocumentVersionsResponse_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.SSM.Types

-- | /See:/ 'newListDocumentVersions' smart constructor.
data ListDocumentVersions = ListDocumentVersions'
  { -- | The maximum number of items to return for this call. The call also
    -- returns a token that you can specify in a subsequent call to get the
    -- next set of results.
    ListDocumentVersions -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of items to return. (You received this token
    -- from a previous call.)
    ListDocumentVersions -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the document. You can specify an Amazon Resource Name (ARN).
    ListDocumentVersions -> Text
name :: Prelude.Text
  }
  deriving (ListDocumentVersions -> ListDocumentVersions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDocumentVersions -> ListDocumentVersions -> Bool
$c/= :: ListDocumentVersions -> ListDocumentVersions -> Bool
== :: ListDocumentVersions -> ListDocumentVersions -> Bool
$c== :: ListDocumentVersions -> ListDocumentVersions -> Bool
Prelude.Eq, ReadPrec [ListDocumentVersions]
ReadPrec ListDocumentVersions
Int -> ReadS ListDocumentVersions
ReadS [ListDocumentVersions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDocumentVersions]
$creadListPrec :: ReadPrec [ListDocumentVersions]
readPrec :: ReadPrec ListDocumentVersions
$creadPrec :: ReadPrec ListDocumentVersions
readList :: ReadS [ListDocumentVersions]
$creadList :: ReadS [ListDocumentVersions]
readsPrec :: Int -> ReadS ListDocumentVersions
$creadsPrec :: Int -> ReadS ListDocumentVersions
Prelude.Read, Int -> ListDocumentVersions -> ShowS
[ListDocumentVersions] -> ShowS
ListDocumentVersions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDocumentVersions] -> ShowS
$cshowList :: [ListDocumentVersions] -> ShowS
show :: ListDocumentVersions -> String
$cshow :: ListDocumentVersions -> String
showsPrec :: Int -> ListDocumentVersions -> ShowS
$cshowsPrec :: Int -> ListDocumentVersions -> ShowS
Prelude.Show, forall x. Rep ListDocumentVersions x -> ListDocumentVersions
forall x. ListDocumentVersions -> Rep ListDocumentVersions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListDocumentVersions x -> ListDocumentVersions
$cfrom :: forall x. ListDocumentVersions -> Rep ListDocumentVersions x
Prelude.Generic)

-- |
-- Create a value of 'ListDocumentVersions' 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:
--
-- 'maxResults', 'listDocumentVersions_maxResults' - The maximum number of items to return for this call. The call also
-- returns a token that you can specify in a subsequent call to get the
-- next set of results.
--
-- 'nextToken', 'listDocumentVersions_nextToken' - The token for the next set of items to return. (You received this token
-- from a previous call.)
--
-- 'name', 'listDocumentVersions_name' - The name of the document. You can specify an Amazon Resource Name (ARN).
newListDocumentVersions ::
  -- | 'name'
  Prelude.Text ->
  ListDocumentVersions
newListDocumentVersions :: Text -> ListDocumentVersions
newListDocumentVersions Text
pName_ =
  ListDocumentVersions'
    { $sel:maxResults:ListDocumentVersions' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListDocumentVersions' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:name:ListDocumentVersions' :: Text
name = Text
pName_
    }

-- | The maximum number of items to return for this call. The call also
-- returns a token that you can specify in a subsequent call to get the
-- next set of results.
listDocumentVersions_maxResults :: Lens.Lens' ListDocumentVersions (Prelude.Maybe Prelude.Natural)
listDocumentVersions_maxResults :: Lens' ListDocumentVersions (Maybe Natural)
listDocumentVersions_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDocumentVersions' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListDocumentVersions' :: ListDocumentVersions -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListDocumentVersions
s@ListDocumentVersions' {} Maybe Natural
a -> ListDocumentVersions
s {$sel:maxResults:ListDocumentVersions' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListDocumentVersions)

-- | The token for the next set of items to return. (You received this token
-- from a previous call.)
listDocumentVersions_nextToken :: Lens.Lens' ListDocumentVersions (Prelude.Maybe Prelude.Text)
listDocumentVersions_nextToken :: Lens' ListDocumentVersions (Maybe Text)
listDocumentVersions_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDocumentVersions' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDocumentVersions' :: ListDocumentVersions -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDocumentVersions
s@ListDocumentVersions' {} Maybe Text
a -> ListDocumentVersions
s {$sel:nextToken:ListDocumentVersions' :: Maybe Text
nextToken = Maybe Text
a} :: ListDocumentVersions)

-- | The name of the document. You can specify an Amazon Resource Name (ARN).
listDocumentVersions_name :: Lens.Lens' ListDocumentVersions Prelude.Text
listDocumentVersions_name :: Lens' ListDocumentVersions Text
listDocumentVersions_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDocumentVersions' {Text
name :: Text
$sel:name:ListDocumentVersions' :: ListDocumentVersions -> Text
name} -> Text
name) (\s :: ListDocumentVersions
s@ListDocumentVersions' {} Text
a -> ListDocumentVersions
s {$sel:name:ListDocumentVersions' :: Text
name = Text
a} :: ListDocumentVersions)

instance Core.AWSPager ListDocumentVersions where
  page :: ListDocumentVersions
-> AWSResponse ListDocumentVersions -> Maybe ListDocumentVersions
page ListDocumentVersions
rq AWSResponse ListDocumentVersions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListDocumentVersions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDocumentVersionsResponse (Maybe Text)
listDocumentVersionsResponse_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 ListDocumentVersions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListDocumentVersionsResponse (Maybe (NonEmpty DocumentVersionInfo))
listDocumentVersionsResponse_documentVersions
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
Lens.to forall l. IsList l => l -> [Item l]
Prelude.toList
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListDocumentVersions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListDocumentVersions (Maybe Text)
listDocumentVersions_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListDocumentVersions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDocumentVersionsResponse (Maybe Text)
listDocumentVersionsResponse_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 ListDocumentVersions where
  type
    AWSResponse ListDocumentVersions =
      ListDocumentVersionsResponse
  request :: (Service -> Service)
-> ListDocumentVersions -> Request ListDocumentVersions
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 ListDocumentVersions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListDocumentVersions)))
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 (NonEmpty DocumentVersionInfo)
-> Maybe Text -> Int -> ListDocumentVersionsResponse
ListDocumentVersionsResponse'
            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
"DocumentVersions")
            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
"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))
      )

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

instance Prelude.NFData ListDocumentVersions where
  rnf :: ListDocumentVersions -> ()
rnf ListDocumentVersions' {Maybe Natural
Maybe Text
Text
name :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:name:ListDocumentVersions' :: ListDocumentVersions -> Text
$sel:nextToken:ListDocumentVersions' :: ListDocumentVersions -> Maybe Text
$sel:maxResults:ListDocumentVersions' :: ListDocumentVersions -> Maybe Natural
..} =
    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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders ListDocumentVersions where
  toHeaders :: ListDocumentVersions -> 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
"AmazonSSM.ListDocumentVersions" ::
                          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 ListDocumentVersions where
  toJSON :: ListDocumentVersions -> Value
toJSON ListDocumentVersions' {Maybe Natural
Maybe Text
Text
name :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:name:ListDocumentVersions' :: ListDocumentVersions -> Text
$sel:nextToken:ListDocumentVersions' :: ListDocumentVersions -> Maybe Text
$sel:maxResults:ListDocumentVersions' :: ListDocumentVersions -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" 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
maxResults,
            (Key
"NextToken" 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
nextToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newListDocumentVersionsResponse' smart constructor.
data ListDocumentVersionsResponse = ListDocumentVersionsResponse'
  { -- | The document versions.
    ListDocumentVersionsResponse
-> Maybe (NonEmpty DocumentVersionInfo)
documentVersions :: Prelude.Maybe (Prelude.NonEmpty DocumentVersionInfo),
    -- | The token to use when requesting the next set of items. If there are no
    -- additional items to return, the string is empty.
    ListDocumentVersionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListDocumentVersionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListDocumentVersionsResponse
-> ListDocumentVersionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDocumentVersionsResponse
-> ListDocumentVersionsResponse -> Bool
$c/= :: ListDocumentVersionsResponse
-> ListDocumentVersionsResponse -> Bool
== :: ListDocumentVersionsResponse
-> ListDocumentVersionsResponse -> Bool
$c== :: ListDocumentVersionsResponse
-> ListDocumentVersionsResponse -> Bool
Prelude.Eq, ReadPrec [ListDocumentVersionsResponse]
ReadPrec ListDocumentVersionsResponse
Int -> ReadS ListDocumentVersionsResponse
ReadS [ListDocumentVersionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDocumentVersionsResponse]
$creadListPrec :: ReadPrec [ListDocumentVersionsResponse]
readPrec :: ReadPrec ListDocumentVersionsResponse
$creadPrec :: ReadPrec ListDocumentVersionsResponse
readList :: ReadS [ListDocumentVersionsResponse]
$creadList :: ReadS [ListDocumentVersionsResponse]
readsPrec :: Int -> ReadS ListDocumentVersionsResponse
$creadsPrec :: Int -> ReadS ListDocumentVersionsResponse
Prelude.Read, Int -> ListDocumentVersionsResponse -> ShowS
[ListDocumentVersionsResponse] -> ShowS
ListDocumentVersionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDocumentVersionsResponse] -> ShowS
$cshowList :: [ListDocumentVersionsResponse] -> ShowS
show :: ListDocumentVersionsResponse -> String
$cshow :: ListDocumentVersionsResponse -> String
showsPrec :: Int -> ListDocumentVersionsResponse -> ShowS
$cshowsPrec :: Int -> ListDocumentVersionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListDocumentVersionsResponse x -> ListDocumentVersionsResponse
forall x.
ListDocumentVersionsResponse -> Rep ListDocumentVersionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListDocumentVersionsResponse x -> ListDocumentVersionsResponse
$cfrom :: forall x.
ListDocumentVersionsResponse -> Rep ListDocumentVersionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListDocumentVersionsResponse' 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:
--
-- 'documentVersions', 'listDocumentVersionsResponse_documentVersions' - The document versions.
--
-- 'nextToken', 'listDocumentVersionsResponse_nextToken' - The token to use when requesting the next set of items. If there are no
-- additional items to return, the string is empty.
--
-- 'httpStatus', 'listDocumentVersionsResponse_httpStatus' - The response's http status code.
newListDocumentVersionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListDocumentVersionsResponse
newListDocumentVersionsResponse :: Int -> ListDocumentVersionsResponse
newListDocumentVersionsResponse Int
pHttpStatus_ =
  ListDocumentVersionsResponse'
    { $sel:documentVersions:ListDocumentVersionsResponse' :: Maybe (NonEmpty DocumentVersionInfo)
documentVersions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListDocumentVersionsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListDocumentVersionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The document versions.
listDocumentVersionsResponse_documentVersions :: Lens.Lens' ListDocumentVersionsResponse (Prelude.Maybe (Prelude.NonEmpty DocumentVersionInfo))
listDocumentVersionsResponse_documentVersions :: Lens'
  ListDocumentVersionsResponse (Maybe (NonEmpty DocumentVersionInfo))
listDocumentVersionsResponse_documentVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDocumentVersionsResponse' {Maybe (NonEmpty DocumentVersionInfo)
documentVersions :: Maybe (NonEmpty DocumentVersionInfo)
$sel:documentVersions:ListDocumentVersionsResponse' :: ListDocumentVersionsResponse
-> Maybe (NonEmpty DocumentVersionInfo)
documentVersions} -> Maybe (NonEmpty DocumentVersionInfo)
documentVersions) (\s :: ListDocumentVersionsResponse
s@ListDocumentVersionsResponse' {} Maybe (NonEmpty DocumentVersionInfo)
a -> ListDocumentVersionsResponse
s {$sel:documentVersions:ListDocumentVersionsResponse' :: Maybe (NonEmpty DocumentVersionInfo)
documentVersions = Maybe (NonEmpty DocumentVersionInfo)
a} :: ListDocumentVersionsResponse) 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 token to use when requesting the next set of items. If there are no
-- additional items to return, the string is empty.
listDocumentVersionsResponse_nextToken :: Lens.Lens' ListDocumentVersionsResponse (Prelude.Maybe Prelude.Text)
listDocumentVersionsResponse_nextToken :: Lens' ListDocumentVersionsResponse (Maybe Text)
listDocumentVersionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDocumentVersionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDocumentVersionsResponse' :: ListDocumentVersionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDocumentVersionsResponse
s@ListDocumentVersionsResponse' {} Maybe Text
a -> ListDocumentVersionsResponse
s {$sel:nextToken:ListDocumentVersionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListDocumentVersionsResponse)

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

instance Prelude.NFData ListDocumentVersionsResponse where
  rnf :: ListDocumentVersionsResponse -> ()
rnf ListDocumentVersionsResponse' {Int
Maybe (NonEmpty DocumentVersionInfo)
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
documentVersions :: Maybe (NonEmpty DocumentVersionInfo)
$sel:httpStatus:ListDocumentVersionsResponse' :: ListDocumentVersionsResponse -> Int
$sel:nextToken:ListDocumentVersionsResponse' :: ListDocumentVersionsResponse -> Maybe Text
$sel:documentVersions:ListDocumentVersionsResponse' :: ListDocumentVersionsResponse
-> Maybe (NonEmpty DocumentVersionInfo)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty DocumentVersionInfo)
documentVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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