{-# 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.MigrationHub.ListCreatedArtifacts
-- 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 the created artifacts attached to a given migration task in an
-- update stream. This API has the following traits:
--
-- -   Gets the list of the created artifacts while migration is taking
--     place.
--
-- -   Shows the artifacts created by the migration tool that was
--     associated by the @AssociateCreatedArtifact@ API.
--
-- -   Lists created artifacts in a paginated interface.
--
-- This operation returns paginated results.
module Amazonka.MigrationHub.ListCreatedArtifacts
  ( -- * Creating a Request
    ListCreatedArtifacts (..),
    newListCreatedArtifacts,

    -- * Request Lenses
    listCreatedArtifacts_maxResults,
    listCreatedArtifacts_nextToken,
    listCreatedArtifacts_progressUpdateStream,
    listCreatedArtifacts_migrationTaskName,

    -- * Destructuring the Response
    ListCreatedArtifactsResponse (..),
    newListCreatedArtifactsResponse,

    -- * Response Lenses
    listCreatedArtifactsResponse_createdArtifactList,
    listCreatedArtifactsResponse_nextToken,
    listCreatedArtifactsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListCreatedArtifacts' smart constructor.
data ListCreatedArtifacts = ListCreatedArtifacts'
  { -- | Maximum number of results to be returned per page.
    ListCreatedArtifacts -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If a @NextToken@ was returned by a previous call, there are more results
    -- available. To retrieve the next page of results, make the call again
    -- using the returned token in @NextToken@.
    ListCreatedArtifacts -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the ProgressUpdateStream.
    ListCreatedArtifacts -> Text
progressUpdateStream :: Prelude.Text,
    -- | Unique identifier that references the migration task. /Do not store
    -- personal data in this field./
    ListCreatedArtifacts -> Text
migrationTaskName :: Prelude.Text
  }
  deriving (ListCreatedArtifacts -> ListCreatedArtifacts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCreatedArtifacts -> ListCreatedArtifacts -> Bool
$c/= :: ListCreatedArtifacts -> ListCreatedArtifacts -> Bool
== :: ListCreatedArtifacts -> ListCreatedArtifacts -> Bool
$c== :: ListCreatedArtifacts -> ListCreatedArtifacts -> Bool
Prelude.Eq, ReadPrec [ListCreatedArtifacts]
ReadPrec ListCreatedArtifacts
Int -> ReadS ListCreatedArtifacts
ReadS [ListCreatedArtifacts]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCreatedArtifacts]
$creadListPrec :: ReadPrec [ListCreatedArtifacts]
readPrec :: ReadPrec ListCreatedArtifacts
$creadPrec :: ReadPrec ListCreatedArtifacts
readList :: ReadS [ListCreatedArtifacts]
$creadList :: ReadS [ListCreatedArtifacts]
readsPrec :: Int -> ReadS ListCreatedArtifacts
$creadsPrec :: Int -> ReadS ListCreatedArtifacts
Prelude.Read, Int -> ListCreatedArtifacts -> ShowS
[ListCreatedArtifacts] -> ShowS
ListCreatedArtifacts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCreatedArtifacts] -> ShowS
$cshowList :: [ListCreatedArtifacts] -> ShowS
show :: ListCreatedArtifacts -> String
$cshow :: ListCreatedArtifacts -> String
showsPrec :: Int -> ListCreatedArtifacts -> ShowS
$cshowsPrec :: Int -> ListCreatedArtifacts -> ShowS
Prelude.Show, forall x. Rep ListCreatedArtifacts x -> ListCreatedArtifacts
forall x. ListCreatedArtifacts -> Rep ListCreatedArtifacts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCreatedArtifacts x -> ListCreatedArtifacts
$cfrom :: forall x. ListCreatedArtifacts -> Rep ListCreatedArtifacts x
Prelude.Generic)

-- |
-- Create a value of 'ListCreatedArtifacts' 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', 'listCreatedArtifacts_maxResults' - Maximum number of results to be returned per page.
--
-- 'nextToken', 'listCreatedArtifacts_nextToken' - If a @NextToken@ was returned by a previous call, there are more results
-- available. To retrieve the next page of results, make the call again
-- using the returned token in @NextToken@.
--
-- 'progressUpdateStream', 'listCreatedArtifacts_progressUpdateStream' - The name of the ProgressUpdateStream.
--
-- 'migrationTaskName', 'listCreatedArtifacts_migrationTaskName' - Unique identifier that references the migration task. /Do not store
-- personal data in this field./
newListCreatedArtifacts ::
  -- | 'progressUpdateStream'
  Prelude.Text ->
  -- | 'migrationTaskName'
  Prelude.Text ->
  ListCreatedArtifacts
newListCreatedArtifacts :: Text -> Text -> ListCreatedArtifacts
newListCreatedArtifacts
  Text
pProgressUpdateStream_
  Text
pMigrationTaskName_ =
    ListCreatedArtifacts'
      { $sel:maxResults:ListCreatedArtifacts' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListCreatedArtifacts' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:progressUpdateStream:ListCreatedArtifacts' :: Text
progressUpdateStream = Text
pProgressUpdateStream_,
        $sel:migrationTaskName:ListCreatedArtifacts' :: Text
migrationTaskName = Text
pMigrationTaskName_
      }

-- | Maximum number of results to be returned per page.
listCreatedArtifacts_maxResults :: Lens.Lens' ListCreatedArtifacts (Prelude.Maybe Prelude.Natural)
listCreatedArtifacts_maxResults :: Lens' ListCreatedArtifacts (Maybe Natural)
listCreatedArtifacts_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCreatedArtifacts' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCreatedArtifacts' :: ListCreatedArtifacts -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCreatedArtifacts
s@ListCreatedArtifacts' {} Maybe Natural
a -> ListCreatedArtifacts
s {$sel:maxResults:ListCreatedArtifacts' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCreatedArtifacts)

-- | If a @NextToken@ was returned by a previous call, there are more results
-- available. To retrieve the next page of results, make the call again
-- using the returned token in @NextToken@.
listCreatedArtifacts_nextToken :: Lens.Lens' ListCreatedArtifacts (Prelude.Maybe Prelude.Text)
listCreatedArtifacts_nextToken :: Lens' ListCreatedArtifacts (Maybe Text)
listCreatedArtifacts_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCreatedArtifacts' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCreatedArtifacts' :: ListCreatedArtifacts -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCreatedArtifacts
s@ListCreatedArtifacts' {} Maybe Text
a -> ListCreatedArtifacts
s {$sel:nextToken:ListCreatedArtifacts' :: Maybe Text
nextToken = Maybe Text
a} :: ListCreatedArtifacts)

-- | The name of the ProgressUpdateStream.
listCreatedArtifacts_progressUpdateStream :: Lens.Lens' ListCreatedArtifacts Prelude.Text
listCreatedArtifacts_progressUpdateStream :: Lens' ListCreatedArtifacts Text
listCreatedArtifacts_progressUpdateStream = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCreatedArtifacts' {Text
progressUpdateStream :: Text
$sel:progressUpdateStream:ListCreatedArtifacts' :: ListCreatedArtifacts -> Text
progressUpdateStream} -> Text
progressUpdateStream) (\s :: ListCreatedArtifacts
s@ListCreatedArtifacts' {} Text
a -> ListCreatedArtifacts
s {$sel:progressUpdateStream:ListCreatedArtifacts' :: Text
progressUpdateStream = Text
a} :: ListCreatedArtifacts)

-- | Unique identifier that references the migration task. /Do not store
-- personal data in this field./
listCreatedArtifacts_migrationTaskName :: Lens.Lens' ListCreatedArtifacts Prelude.Text
listCreatedArtifacts_migrationTaskName :: Lens' ListCreatedArtifacts Text
listCreatedArtifacts_migrationTaskName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCreatedArtifacts' {Text
migrationTaskName :: Text
$sel:migrationTaskName:ListCreatedArtifacts' :: ListCreatedArtifacts -> Text
migrationTaskName} -> Text
migrationTaskName) (\s :: ListCreatedArtifacts
s@ListCreatedArtifacts' {} Text
a -> ListCreatedArtifacts
s {$sel:migrationTaskName:ListCreatedArtifacts' :: Text
migrationTaskName = Text
a} :: ListCreatedArtifacts)

instance Core.AWSPager ListCreatedArtifacts where
  page :: ListCreatedArtifacts
-> AWSResponse ListCreatedArtifacts -> Maybe ListCreatedArtifacts
page ListCreatedArtifacts
rq AWSResponse ListCreatedArtifacts
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCreatedArtifacts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCreatedArtifactsResponse (Maybe Text)
listCreatedArtifactsResponse_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 ListCreatedArtifacts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCreatedArtifactsResponse (Maybe [CreatedArtifact])
listCreatedArtifactsResponse_createdArtifactList
            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.$ ListCreatedArtifacts
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCreatedArtifacts (Maybe Text)
listCreatedArtifacts_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCreatedArtifacts
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCreatedArtifactsResponse (Maybe Text)
listCreatedArtifactsResponse_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 ListCreatedArtifacts where
  type
    AWSResponse ListCreatedArtifacts =
      ListCreatedArtifactsResponse
  request :: (Service -> Service)
-> ListCreatedArtifacts -> Request ListCreatedArtifacts
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 ListCreatedArtifacts
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCreatedArtifacts)))
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 [CreatedArtifact]
-> Maybe Text -> Int -> ListCreatedArtifactsResponse
ListCreatedArtifactsResponse'
            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
"CreatedArtifactList"
                            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
"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 ListCreatedArtifacts where
  hashWithSalt :: Int -> ListCreatedArtifacts -> Int
hashWithSalt Int
_salt ListCreatedArtifacts' {Maybe Natural
Maybe Text
Text
migrationTaskName :: Text
progressUpdateStream :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:migrationTaskName:ListCreatedArtifacts' :: ListCreatedArtifacts -> Text
$sel:progressUpdateStream:ListCreatedArtifacts' :: ListCreatedArtifacts -> Text
$sel:nextToken:ListCreatedArtifacts' :: ListCreatedArtifacts -> Maybe Text
$sel:maxResults:ListCreatedArtifacts' :: ListCreatedArtifacts -> 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
progressUpdateStream
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
migrationTaskName

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

instance Data.ToHeaders ListCreatedArtifacts where
  toHeaders :: ListCreatedArtifacts -> 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
"AWSMigrationHub.ListCreatedArtifacts" ::
                          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 ListCreatedArtifacts where
  toJSON :: ListCreatedArtifacts -> Value
toJSON ListCreatedArtifacts' {Maybe Natural
Maybe Text
Text
migrationTaskName :: Text
progressUpdateStream :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:migrationTaskName:ListCreatedArtifacts' :: ListCreatedArtifacts -> Text
$sel:progressUpdateStream:ListCreatedArtifacts' :: ListCreatedArtifacts -> Text
$sel:nextToken:ListCreatedArtifacts' :: ListCreatedArtifacts -> Maybe Text
$sel:maxResults:ListCreatedArtifacts' :: ListCreatedArtifacts -> 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
"ProgressUpdateStream"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
progressUpdateStream
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"MigrationTaskName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
migrationTaskName)
          ]
      )

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

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

-- | /See:/ 'newListCreatedArtifactsResponse' smart constructor.
data ListCreatedArtifactsResponse = ListCreatedArtifactsResponse'
  { -- | List of created artifacts up to the maximum number of results specified
    -- in the request.
    ListCreatedArtifactsResponse -> Maybe [CreatedArtifact]
createdArtifactList :: Prelude.Maybe [CreatedArtifact],
    -- | If there are more created artifacts than the max result, return the next
    -- token to be passed to the next call as a bookmark of where to start
    -- from.
    ListCreatedArtifactsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCreatedArtifactsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCreatedArtifactsResponse
-> ListCreatedArtifactsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCreatedArtifactsResponse
-> ListCreatedArtifactsResponse -> Bool
$c/= :: ListCreatedArtifactsResponse
-> ListCreatedArtifactsResponse -> Bool
== :: ListCreatedArtifactsResponse
-> ListCreatedArtifactsResponse -> Bool
$c== :: ListCreatedArtifactsResponse
-> ListCreatedArtifactsResponse -> Bool
Prelude.Eq, ReadPrec [ListCreatedArtifactsResponse]
ReadPrec ListCreatedArtifactsResponse
Int -> ReadS ListCreatedArtifactsResponse
ReadS [ListCreatedArtifactsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCreatedArtifactsResponse]
$creadListPrec :: ReadPrec [ListCreatedArtifactsResponse]
readPrec :: ReadPrec ListCreatedArtifactsResponse
$creadPrec :: ReadPrec ListCreatedArtifactsResponse
readList :: ReadS [ListCreatedArtifactsResponse]
$creadList :: ReadS [ListCreatedArtifactsResponse]
readsPrec :: Int -> ReadS ListCreatedArtifactsResponse
$creadsPrec :: Int -> ReadS ListCreatedArtifactsResponse
Prelude.Read, Int -> ListCreatedArtifactsResponse -> ShowS
[ListCreatedArtifactsResponse] -> ShowS
ListCreatedArtifactsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCreatedArtifactsResponse] -> ShowS
$cshowList :: [ListCreatedArtifactsResponse] -> ShowS
show :: ListCreatedArtifactsResponse -> String
$cshow :: ListCreatedArtifactsResponse -> String
showsPrec :: Int -> ListCreatedArtifactsResponse -> ShowS
$cshowsPrec :: Int -> ListCreatedArtifactsResponse -> ShowS
Prelude.Show, forall x.
Rep ListCreatedArtifactsResponse x -> ListCreatedArtifactsResponse
forall x.
ListCreatedArtifactsResponse -> Rep ListCreatedArtifactsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCreatedArtifactsResponse x -> ListCreatedArtifactsResponse
$cfrom :: forall x.
ListCreatedArtifactsResponse -> Rep ListCreatedArtifactsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCreatedArtifactsResponse' 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:
--
-- 'createdArtifactList', 'listCreatedArtifactsResponse_createdArtifactList' - List of created artifacts up to the maximum number of results specified
-- in the request.
--
-- 'nextToken', 'listCreatedArtifactsResponse_nextToken' - If there are more created artifacts than the max result, return the next
-- token to be passed to the next call as a bookmark of where to start
-- from.
--
-- 'httpStatus', 'listCreatedArtifactsResponse_httpStatus' - The response's http status code.
newListCreatedArtifactsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCreatedArtifactsResponse
newListCreatedArtifactsResponse :: Int -> ListCreatedArtifactsResponse
newListCreatedArtifactsResponse Int
pHttpStatus_ =
  ListCreatedArtifactsResponse'
    { $sel:createdArtifactList:ListCreatedArtifactsResponse' :: Maybe [CreatedArtifact]
createdArtifactList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCreatedArtifactsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCreatedArtifactsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | List of created artifacts up to the maximum number of results specified
-- in the request.
listCreatedArtifactsResponse_createdArtifactList :: Lens.Lens' ListCreatedArtifactsResponse (Prelude.Maybe [CreatedArtifact])
listCreatedArtifactsResponse_createdArtifactList :: Lens' ListCreatedArtifactsResponse (Maybe [CreatedArtifact])
listCreatedArtifactsResponse_createdArtifactList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCreatedArtifactsResponse' {Maybe [CreatedArtifact]
createdArtifactList :: Maybe [CreatedArtifact]
$sel:createdArtifactList:ListCreatedArtifactsResponse' :: ListCreatedArtifactsResponse -> Maybe [CreatedArtifact]
createdArtifactList} -> Maybe [CreatedArtifact]
createdArtifactList) (\s :: ListCreatedArtifactsResponse
s@ListCreatedArtifactsResponse' {} Maybe [CreatedArtifact]
a -> ListCreatedArtifactsResponse
s {$sel:createdArtifactList:ListCreatedArtifactsResponse' :: Maybe [CreatedArtifact]
createdArtifactList = Maybe [CreatedArtifact]
a} :: ListCreatedArtifactsResponse) 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

-- | If there are more created artifacts than the max result, return the next
-- token to be passed to the next call as a bookmark of where to start
-- from.
listCreatedArtifactsResponse_nextToken :: Lens.Lens' ListCreatedArtifactsResponse (Prelude.Maybe Prelude.Text)
listCreatedArtifactsResponse_nextToken :: Lens' ListCreatedArtifactsResponse (Maybe Text)
listCreatedArtifactsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCreatedArtifactsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCreatedArtifactsResponse' :: ListCreatedArtifactsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCreatedArtifactsResponse
s@ListCreatedArtifactsResponse' {} Maybe Text
a -> ListCreatedArtifactsResponse
s {$sel:nextToken:ListCreatedArtifactsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCreatedArtifactsResponse)

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

instance Prelude.NFData ListCreatedArtifactsResponse where
  rnf :: ListCreatedArtifactsResponse -> ()
rnf ListCreatedArtifactsResponse' {Int
Maybe [CreatedArtifact]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
createdArtifactList :: Maybe [CreatedArtifact]
$sel:httpStatus:ListCreatedArtifactsResponse' :: ListCreatedArtifactsResponse -> Int
$sel:nextToken:ListCreatedArtifactsResponse' :: ListCreatedArtifactsResponse -> Maybe Text
$sel:createdArtifactList:ListCreatedArtifactsResponse' :: ListCreatedArtifactsResponse -> Maybe [CreatedArtifact]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CreatedArtifact]
createdArtifactList
      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