{-# 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.EC2.DescribeBundleTasks
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the specified bundle tasks or all of your bundle tasks.
--
-- Completed bundle tasks are listed for only a limited time. If your
-- bundle task is no longer in the list, you can still register an AMI from
-- it. Just use @RegisterImage@ with the Amazon S3 bucket name and image
-- manifest name you provided to the bundle task.
module Amazonka.EC2.DescribeBundleTasks
  ( -- * Creating a Request
    DescribeBundleTasks (..),
    newDescribeBundleTasks,

    -- * Request Lenses
    describeBundleTasks_bundleIds,
    describeBundleTasks_dryRun,
    describeBundleTasks_filters,

    -- * Destructuring the Response
    DescribeBundleTasksResponse (..),
    newDescribeBundleTasksResponse,

    -- * Response Lenses
    describeBundleTasksResponse_bundleTasks,
    describeBundleTasksResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeBundleTasks' smart constructor.
data DescribeBundleTasks = DescribeBundleTasks'
  { -- | The bundle task IDs.
    --
    -- Default: Describes all your bundle tasks.
    DescribeBundleTasks -> Maybe [Text]
bundleIds :: Prelude.Maybe [Prelude.Text],
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    DescribeBundleTasks -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The filters.
    --
    -- -   @bundle-id@ - The ID of the bundle task.
    --
    -- -   @error-code@ - If the task failed, the error code returned.
    --
    -- -   @error-message@ - If the task failed, the error message returned.
    --
    -- -   @instance-id@ - The ID of the instance.
    --
    -- -   @progress@ - The level of task completion, as a percentage (for
    --     example, 20%).
    --
    -- -   @s3-bucket@ - The Amazon S3 bucket to store the AMI.
    --
    -- -   @s3-prefix@ - The beginning of the AMI name.
    --
    -- -   @start-time@ - The time the task started (for example,
    --     2013-09-15T17:15:20.000Z).
    --
    -- -   @state@ - The state of the task (@pending@ | @waiting-for-shutdown@
    --     | @bundling@ | @storing@ | @cancelling@ | @complete@ | @failed@).
    --
    -- -   @update-time@ - The time of the most recent update for the task.
    DescribeBundleTasks -> Maybe [Filter]
filters :: Prelude.Maybe [Filter]
  }
  deriving (DescribeBundleTasks -> DescribeBundleTasks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBundleTasks -> DescribeBundleTasks -> Bool
$c/= :: DescribeBundleTasks -> DescribeBundleTasks -> Bool
== :: DescribeBundleTasks -> DescribeBundleTasks -> Bool
$c== :: DescribeBundleTasks -> DescribeBundleTasks -> Bool
Prelude.Eq, ReadPrec [DescribeBundleTasks]
ReadPrec DescribeBundleTasks
Int -> ReadS DescribeBundleTasks
ReadS [DescribeBundleTasks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBundleTasks]
$creadListPrec :: ReadPrec [DescribeBundleTasks]
readPrec :: ReadPrec DescribeBundleTasks
$creadPrec :: ReadPrec DescribeBundleTasks
readList :: ReadS [DescribeBundleTasks]
$creadList :: ReadS [DescribeBundleTasks]
readsPrec :: Int -> ReadS DescribeBundleTasks
$creadsPrec :: Int -> ReadS DescribeBundleTasks
Prelude.Read, Int -> DescribeBundleTasks -> ShowS
[DescribeBundleTasks] -> ShowS
DescribeBundleTasks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBundleTasks] -> ShowS
$cshowList :: [DescribeBundleTasks] -> ShowS
show :: DescribeBundleTasks -> String
$cshow :: DescribeBundleTasks -> String
showsPrec :: Int -> DescribeBundleTasks -> ShowS
$cshowsPrec :: Int -> DescribeBundleTasks -> ShowS
Prelude.Show, forall x. Rep DescribeBundleTasks x -> DescribeBundleTasks
forall x. DescribeBundleTasks -> Rep DescribeBundleTasks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeBundleTasks x -> DescribeBundleTasks
$cfrom :: forall x. DescribeBundleTasks -> Rep DescribeBundleTasks x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBundleTasks' 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:
--
-- 'bundleIds', 'describeBundleTasks_bundleIds' - The bundle task IDs.
--
-- Default: Describes all your bundle tasks.
--
-- 'dryRun', 'describeBundleTasks_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'filters', 'describeBundleTasks_filters' - The filters.
--
-- -   @bundle-id@ - The ID of the bundle task.
--
-- -   @error-code@ - If the task failed, the error code returned.
--
-- -   @error-message@ - If the task failed, the error message returned.
--
-- -   @instance-id@ - The ID of the instance.
--
-- -   @progress@ - The level of task completion, as a percentage (for
--     example, 20%).
--
-- -   @s3-bucket@ - The Amazon S3 bucket to store the AMI.
--
-- -   @s3-prefix@ - The beginning of the AMI name.
--
-- -   @start-time@ - The time the task started (for example,
--     2013-09-15T17:15:20.000Z).
--
-- -   @state@ - The state of the task (@pending@ | @waiting-for-shutdown@
--     | @bundling@ | @storing@ | @cancelling@ | @complete@ | @failed@).
--
-- -   @update-time@ - The time of the most recent update for the task.
newDescribeBundleTasks ::
  DescribeBundleTasks
newDescribeBundleTasks :: DescribeBundleTasks
newDescribeBundleTasks =
  DescribeBundleTasks'
    { $sel:bundleIds:DescribeBundleTasks' :: Maybe [Text]
bundleIds = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:DescribeBundleTasks' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeBundleTasks' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing
    }

-- | The bundle task IDs.
--
-- Default: Describes all your bundle tasks.
describeBundleTasks_bundleIds :: Lens.Lens' DescribeBundleTasks (Prelude.Maybe [Prelude.Text])
describeBundleTasks_bundleIds :: Lens' DescribeBundleTasks (Maybe [Text])
describeBundleTasks_bundleIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBundleTasks' {Maybe [Text]
bundleIds :: Maybe [Text]
$sel:bundleIds:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Text]
bundleIds} -> Maybe [Text]
bundleIds) (\s :: DescribeBundleTasks
s@DescribeBundleTasks' {} Maybe [Text]
a -> DescribeBundleTasks
s {$sel:bundleIds:DescribeBundleTasks' :: Maybe [Text]
bundleIds = Maybe [Text]
a} :: DescribeBundleTasks) 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

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
describeBundleTasks_dryRun :: Lens.Lens' DescribeBundleTasks (Prelude.Maybe Prelude.Bool)
describeBundleTasks_dryRun :: Lens' DescribeBundleTasks (Maybe Bool)
describeBundleTasks_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBundleTasks' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DescribeBundleTasks
s@DescribeBundleTasks' {} Maybe Bool
a -> DescribeBundleTasks
s {$sel:dryRun:DescribeBundleTasks' :: Maybe Bool
dryRun = Maybe Bool
a} :: DescribeBundleTasks)

-- | The filters.
--
-- -   @bundle-id@ - The ID of the bundle task.
--
-- -   @error-code@ - If the task failed, the error code returned.
--
-- -   @error-message@ - If the task failed, the error message returned.
--
-- -   @instance-id@ - The ID of the instance.
--
-- -   @progress@ - The level of task completion, as a percentage (for
--     example, 20%).
--
-- -   @s3-bucket@ - The Amazon S3 bucket to store the AMI.
--
-- -   @s3-prefix@ - The beginning of the AMI name.
--
-- -   @start-time@ - The time the task started (for example,
--     2013-09-15T17:15:20.000Z).
--
-- -   @state@ - The state of the task (@pending@ | @waiting-for-shutdown@
--     | @bundling@ | @storing@ | @cancelling@ | @complete@ | @failed@).
--
-- -   @update-time@ - The time of the most recent update for the task.
describeBundleTasks_filters :: Lens.Lens' DescribeBundleTasks (Prelude.Maybe [Filter])
describeBundleTasks_filters :: Lens' DescribeBundleTasks (Maybe [Filter])
describeBundleTasks_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBundleTasks' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeBundleTasks
s@DescribeBundleTasks' {} Maybe [Filter]
a -> DescribeBundleTasks
s {$sel:filters:DescribeBundleTasks' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeBundleTasks) 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.AWSRequest DescribeBundleTasks where
  type
    AWSResponse DescribeBundleTasks =
      DescribeBundleTasksResponse
  request :: (Service -> Service)
-> DescribeBundleTasks -> Request DescribeBundleTasks
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeBundleTasks
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeBundleTasks)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [BundleTask] -> Int -> DescribeBundleTasksResponse
DescribeBundleTasksResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"bundleInstanceTasksSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 DescribeBundleTasks where
  hashWithSalt :: Int -> DescribeBundleTasks -> Int
hashWithSalt Int
_salt DescribeBundleTasks' {Maybe Bool
Maybe [Text]
Maybe [Filter]
filters :: Maybe [Filter]
dryRun :: Maybe Bool
bundleIds :: Maybe [Text]
$sel:filters:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Filter]
$sel:dryRun:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe Bool
$sel:bundleIds:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
bundleIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters

instance Prelude.NFData DescribeBundleTasks where
  rnf :: DescribeBundleTasks -> ()
rnf DescribeBundleTasks' {Maybe Bool
Maybe [Text]
Maybe [Filter]
filters :: Maybe [Filter]
dryRun :: Maybe Bool
bundleIds :: Maybe [Text]
$sel:filters:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Filter]
$sel:dryRun:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe Bool
$sel:bundleIds:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
bundleIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters

instance Data.ToHeaders DescribeBundleTasks where
  toHeaders :: DescribeBundleTasks -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeBundleTasks where
  toQuery :: DescribeBundleTasks -> QueryString
toQuery DescribeBundleTasks' {Maybe Bool
Maybe [Text]
Maybe [Filter]
filters :: Maybe [Filter]
dryRun :: Maybe Bool
bundleIds :: Maybe [Text]
$sel:filters:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Filter]
$sel:dryRun:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe Bool
$sel:bundleIds:DescribeBundleTasks' :: DescribeBundleTasks -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeBundleTasks" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"BundleId" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
bundleIds),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Filter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters)
      ]

-- | /See:/ 'newDescribeBundleTasksResponse' smart constructor.
data DescribeBundleTasksResponse = DescribeBundleTasksResponse'
  { -- | Information about the bundle tasks.
    DescribeBundleTasksResponse -> Maybe [BundleTask]
bundleTasks :: Prelude.Maybe [BundleTask],
    -- | The response's http status code.
    DescribeBundleTasksResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeBundleTasksResponse -> DescribeBundleTasksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBundleTasksResponse -> DescribeBundleTasksResponse -> Bool
$c/= :: DescribeBundleTasksResponse -> DescribeBundleTasksResponse -> Bool
== :: DescribeBundleTasksResponse -> DescribeBundleTasksResponse -> Bool
$c== :: DescribeBundleTasksResponse -> DescribeBundleTasksResponse -> Bool
Prelude.Eq, ReadPrec [DescribeBundleTasksResponse]
ReadPrec DescribeBundleTasksResponse
Int -> ReadS DescribeBundleTasksResponse
ReadS [DescribeBundleTasksResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBundleTasksResponse]
$creadListPrec :: ReadPrec [DescribeBundleTasksResponse]
readPrec :: ReadPrec DescribeBundleTasksResponse
$creadPrec :: ReadPrec DescribeBundleTasksResponse
readList :: ReadS [DescribeBundleTasksResponse]
$creadList :: ReadS [DescribeBundleTasksResponse]
readsPrec :: Int -> ReadS DescribeBundleTasksResponse
$creadsPrec :: Int -> ReadS DescribeBundleTasksResponse
Prelude.Read, Int -> DescribeBundleTasksResponse -> ShowS
[DescribeBundleTasksResponse] -> ShowS
DescribeBundleTasksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBundleTasksResponse] -> ShowS
$cshowList :: [DescribeBundleTasksResponse] -> ShowS
show :: DescribeBundleTasksResponse -> String
$cshow :: DescribeBundleTasksResponse -> String
showsPrec :: Int -> DescribeBundleTasksResponse -> ShowS
$cshowsPrec :: Int -> DescribeBundleTasksResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeBundleTasksResponse x -> DescribeBundleTasksResponse
forall x.
DescribeBundleTasksResponse -> Rep DescribeBundleTasksResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeBundleTasksResponse x -> DescribeBundleTasksResponse
$cfrom :: forall x.
DescribeBundleTasksResponse -> Rep DescribeBundleTasksResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBundleTasksResponse' 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:
--
-- 'bundleTasks', 'describeBundleTasksResponse_bundleTasks' - Information about the bundle tasks.
--
-- 'httpStatus', 'describeBundleTasksResponse_httpStatus' - The response's http status code.
newDescribeBundleTasksResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeBundleTasksResponse
newDescribeBundleTasksResponse :: Int -> DescribeBundleTasksResponse
newDescribeBundleTasksResponse Int
pHttpStatus_ =
  DescribeBundleTasksResponse'
    { $sel:bundleTasks:DescribeBundleTasksResponse' :: Maybe [BundleTask]
bundleTasks =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeBundleTasksResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the bundle tasks.
describeBundleTasksResponse_bundleTasks :: Lens.Lens' DescribeBundleTasksResponse (Prelude.Maybe [BundleTask])
describeBundleTasksResponse_bundleTasks :: Lens' DescribeBundleTasksResponse (Maybe [BundleTask])
describeBundleTasksResponse_bundleTasks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBundleTasksResponse' {Maybe [BundleTask]
bundleTasks :: Maybe [BundleTask]
$sel:bundleTasks:DescribeBundleTasksResponse' :: DescribeBundleTasksResponse -> Maybe [BundleTask]
bundleTasks} -> Maybe [BundleTask]
bundleTasks) (\s :: DescribeBundleTasksResponse
s@DescribeBundleTasksResponse' {} Maybe [BundleTask]
a -> DescribeBundleTasksResponse
s {$sel:bundleTasks:DescribeBundleTasksResponse' :: Maybe [BundleTask]
bundleTasks = Maybe [BundleTask]
a} :: DescribeBundleTasksResponse) 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.
describeBundleTasksResponse_httpStatus :: Lens.Lens' DescribeBundleTasksResponse Prelude.Int
describeBundleTasksResponse_httpStatus :: Lens' DescribeBundleTasksResponse Int
describeBundleTasksResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBundleTasksResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeBundleTasksResponse' :: DescribeBundleTasksResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeBundleTasksResponse
s@DescribeBundleTasksResponse' {} Int
a -> DescribeBundleTasksResponse
s {$sel:httpStatus:DescribeBundleTasksResponse' :: Int
httpStatus = Int
a} :: DescribeBundleTasksResponse)

instance Prelude.NFData DescribeBundleTasksResponse where
  rnf :: DescribeBundleTasksResponse -> ()
rnf DescribeBundleTasksResponse' {Int
Maybe [BundleTask]
httpStatus :: Int
bundleTasks :: Maybe [BundleTask]
$sel:httpStatus:DescribeBundleTasksResponse' :: DescribeBundleTasksResponse -> Int
$sel:bundleTasks:DescribeBundleTasksResponse' :: DescribeBundleTasksResponse -> Maybe [BundleTask]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BundleTask]
bundleTasks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus