{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.BundleTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Types.BundleTask where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.BundleTaskError
import Amazonka.EC2.Types.BundleTaskState
import Amazonka.EC2.Types.Storage
import qualified Amazonka.Prelude as Prelude

-- | Describes a bundle task.
--
-- /See:/ 'newBundleTask' smart constructor.
data BundleTask = BundleTask'
  { -- | If the task fails, a description of the error.
    BundleTask -> Maybe BundleTaskError
bundleTaskError :: Prelude.Maybe BundleTaskError,
    -- | The ID of the bundle task.
    BundleTask -> Text
bundleId :: Prelude.Text,
    -- | The ID of the instance associated with this bundle task.
    BundleTask -> Text
instanceId :: Prelude.Text,
    -- | The level of task completion, as a percent (for example, 20%).
    BundleTask -> Text
progress :: Prelude.Text,
    -- | The time this task started.
    BundleTask -> ISO8601
startTime :: Data.ISO8601,
    -- | The state of the task.
    BundleTask -> BundleTaskState
state :: BundleTaskState,
    -- | The Amazon S3 storage locations.
    BundleTask -> Storage
storage :: Storage,
    -- | The time of the most recent update for the task.
    BundleTask -> ISO8601
updateTime :: Data.ISO8601
  }
  deriving (BundleTask -> BundleTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BundleTask -> BundleTask -> Bool
$c/= :: BundleTask -> BundleTask -> Bool
== :: BundleTask -> BundleTask -> Bool
$c== :: BundleTask -> BundleTask -> Bool
Prelude.Eq, ReadPrec [BundleTask]
ReadPrec BundleTask
Int -> ReadS BundleTask
ReadS [BundleTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BundleTask]
$creadListPrec :: ReadPrec [BundleTask]
readPrec :: ReadPrec BundleTask
$creadPrec :: ReadPrec BundleTask
readList :: ReadS [BundleTask]
$creadList :: ReadS [BundleTask]
readsPrec :: Int -> ReadS BundleTask
$creadsPrec :: Int -> ReadS BundleTask
Prelude.Read, Int -> BundleTask -> ShowS
[BundleTask] -> ShowS
BundleTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BundleTask] -> ShowS
$cshowList :: [BundleTask] -> ShowS
show :: BundleTask -> String
$cshow :: BundleTask -> String
showsPrec :: Int -> BundleTask -> ShowS
$cshowsPrec :: Int -> BundleTask -> ShowS
Prelude.Show, forall x. Rep BundleTask x -> BundleTask
forall x. BundleTask -> Rep BundleTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BundleTask x -> BundleTask
$cfrom :: forall x. BundleTask -> Rep BundleTask x
Prelude.Generic)

-- |
-- Create a value of 'BundleTask' 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:
--
-- 'bundleTaskError', 'bundleTask_bundleTaskError' - If the task fails, a description of the error.
--
-- 'bundleId', 'bundleTask_bundleId' - The ID of the bundle task.
--
-- 'instanceId', 'bundleTask_instanceId' - The ID of the instance associated with this bundle task.
--
-- 'progress', 'bundleTask_progress' - The level of task completion, as a percent (for example, 20%).
--
-- 'startTime', 'bundleTask_startTime' - The time this task started.
--
-- 'state', 'bundleTask_state' - The state of the task.
--
-- 'storage', 'bundleTask_storage' - The Amazon S3 storage locations.
--
-- 'updateTime', 'bundleTask_updateTime' - The time of the most recent update for the task.
newBundleTask ::
  -- | 'bundleId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  -- | 'progress'
  Prelude.Text ->
  -- | 'startTime'
  Prelude.UTCTime ->
  -- | 'state'
  BundleTaskState ->
  -- | 'storage'
  Storage ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  BundleTask
newBundleTask :: Text
-> Text
-> Text
-> UTCTime
-> BundleTaskState
-> Storage
-> UTCTime
-> BundleTask
newBundleTask
  Text
pBundleId_
  Text
pInstanceId_
  Text
pProgress_
  UTCTime
pStartTime_
  BundleTaskState
pState_
  Storage
pStorage_
  UTCTime
pUpdateTime_ =
    BundleTask'
      { $sel:bundleTaskError:BundleTask' :: Maybe BundleTaskError
bundleTaskError = forall a. Maybe a
Prelude.Nothing,
        $sel:bundleId:BundleTask' :: Text
bundleId = Text
pBundleId_,
        $sel:instanceId:BundleTask' :: Text
instanceId = Text
pInstanceId_,
        $sel:progress:BundleTask' :: Text
progress = Text
pProgress_,
        $sel:startTime:BundleTask' :: ISO8601
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
        $sel:state:BundleTask' :: BundleTaskState
state = BundleTaskState
pState_,
        $sel:storage:BundleTask' :: Storage
storage = Storage
pStorage_,
        $sel:updateTime:BundleTask' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

-- | If the task fails, a description of the error.
bundleTask_bundleTaskError :: Lens.Lens' BundleTask (Prelude.Maybe BundleTaskError)
bundleTask_bundleTaskError :: Lens' BundleTask (Maybe BundleTaskError)
bundleTask_bundleTaskError = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {Maybe BundleTaskError
bundleTaskError :: Maybe BundleTaskError
$sel:bundleTaskError:BundleTask' :: BundleTask -> Maybe BundleTaskError
bundleTaskError} -> Maybe BundleTaskError
bundleTaskError) (\s :: BundleTask
s@BundleTask' {} Maybe BundleTaskError
a -> BundleTask
s {$sel:bundleTaskError:BundleTask' :: Maybe BundleTaskError
bundleTaskError = Maybe BundleTaskError
a} :: BundleTask)

-- | The ID of the bundle task.
bundleTask_bundleId :: Lens.Lens' BundleTask Prelude.Text
bundleTask_bundleId :: Lens' BundleTask Text
bundleTask_bundleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {Text
bundleId :: Text
$sel:bundleId:BundleTask' :: BundleTask -> Text
bundleId} -> Text
bundleId) (\s :: BundleTask
s@BundleTask' {} Text
a -> BundleTask
s {$sel:bundleId:BundleTask' :: Text
bundleId = Text
a} :: BundleTask)

-- | The ID of the instance associated with this bundle task.
bundleTask_instanceId :: Lens.Lens' BundleTask Prelude.Text
bundleTask_instanceId :: Lens' BundleTask Text
bundleTask_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {Text
instanceId :: Text
$sel:instanceId:BundleTask' :: BundleTask -> Text
instanceId} -> Text
instanceId) (\s :: BundleTask
s@BundleTask' {} Text
a -> BundleTask
s {$sel:instanceId:BundleTask' :: Text
instanceId = Text
a} :: BundleTask)

-- | The level of task completion, as a percent (for example, 20%).
bundleTask_progress :: Lens.Lens' BundleTask Prelude.Text
bundleTask_progress :: Lens' BundleTask Text
bundleTask_progress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {Text
progress :: Text
$sel:progress:BundleTask' :: BundleTask -> Text
progress} -> Text
progress) (\s :: BundleTask
s@BundleTask' {} Text
a -> BundleTask
s {$sel:progress:BundleTask' :: Text
progress = Text
a} :: BundleTask)

-- | The time this task started.
bundleTask_startTime :: Lens.Lens' BundleTask Prelude.UTCTime
bundleTask_startTime :: Lens' BundleTask UTCTime
bundleTask_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {ISO8601
startTime :: ISO8601
$sel:startTime:BundleTask' :: BundleTask -> ISO8601
startTime} -> ISO8601
startTime) (\s :: BundleTask
s@BundleTask' {} ISO8601
a -> BundleTask
s {$sel:startTime:BundleTask' :: ISO8601
startTime = ISO8601
a} :: BundleTask) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The state of the task.
bundleTask_state :: Lens.Lens' BundleTask BundleTaskState
bundleTask_state :: Lens' BundleTask BundleTaskState
bundleTask_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {BundleTaskState
state :: BundleTaskState
$sel:state:BundleTask' :: BundleTask -> BundleTaskState
state} -> BundleTaskState
state) (\s :: BundleTask
s@BundleTask' {} BundleTaskState
a -> BundleTask
s {$sel:state:BundleTask' :: BundleTaskState
state = BundleTaskState
a} :: BundleTask)

-- | The Amazon S3 storage locations.
bundleTask_storage :: Lens.Lens' BundleTask Storage
bundleTask_storage :: Lens' BundleTask Storage
bundleTask_storage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {Storage
storage :: Storage
$sel:storage:BundleTask' :: BundleTask -> Storage
storage} -> Storage
storage) (\s :: BundleTask
s@BundleTask' {} Storage
a -> BundleTask
s {$sel:storage:BundleTask' :: Storage
storage = Storage
a} :: BundleTask)

-- | The time of the most recent update for the task.
bundleTask_updateTime :: Lens.Lens' BundleTask Prelude.UTCTime
bundleTask_updateTime :: Lens' BundleTask UTCTime
bundleTask_updateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BundleTask' {ISO8601
updateTime :: ISO8601
$sel:updateTime:BundleTask' :: BundleTask -> ISO8601
updateTime} -> ISO8601
updateTime) (\s :: BundleTask
s@BundleTask' {} ISO8601
a -> BundleTask
s {$sel:updateTime:BundleTask' :: ISO8601
updateTime = ISO8601
a} :: BundleTask) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromXML BundleTask where
  parseXML :: [Node] -> Either String BundleTask
parseXML [Node]
x =
    Maybe BundleTaskError
-> Text
-> Text
-> Text
-> ISO8601
-> BundleTaskState
-> Storage
-> ISO8601
-> BundleTask
BundleTask'
      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
"error")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"bundleId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"instanceId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"progress")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"startTime")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"state")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"storage")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"updateTime")

instance Prelude.Hashable BundleTask where
  hashWithSalt :: Int -> BundleTask -> Int
hashWithSalt Int
_salt BundleTask' {Maybe BundleTaskError
Text
ISO8601
BundleTaskState
Storage
updateTime :: ISO8601
storage :: Storage
state :: BundleTaskState
startTime :: ISO8601
progress :: Text
instanceId :: Text
bundleId :: Text
bundleTaskError :: Maybe BundleTaskError
$sel:updateTime:BundleTask' :: BundleTask -> ISO8601
$sel:storage:BundleTask' :: BundleTask -> Storage
$sel:state:BundleTask' :: BundleTask -> BundleTaskState
$sel:startTime:BundleTask' :: BundleTask -> ISO8601
$sel:progress:BundleTask' :: BundleTask -> Text
$sel:instanceId:BundleTask' :: BundleTask -> Text
$sel:bundleId:BundleTask' :: BundleTask -> Text
$sel:bundleTaskError:BundleTask' :: BundleTask -> Maybe BundleTaskError
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BundleTaskError
bundleTaskError
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bundleId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
progress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BundleTaskState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Storage
storage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
updateTime

instance Prelude.NFData BundleTask where
  rnf :: BundleTask -> ()
rnf BundleTask' {Maybe BundleTaskError
Text
ISO8601
BundleTaskState
Storage
updateTime :: ISO8601
storage :: Storage
state :: BundleTaskState
startTime :: ISO8601
progress :: Text
instanceId :: Text
bundleId :: Text
bundleTaskError :: Maybe BundleTaskError
$sel:updateTime:BundleTask' :: BundleTask -> ISO8601
$sel:storage:BundleTask' :: BundleTask -> Storage
$sel:state:BundleTask' :: BundleTask -> BundleTaskState
$sel:startTime:BundleTask' :: BundleTask -> ISO8601
$sel:progress:BundleTask' :: BundleTask -> Text
$sel:instanceId:BundleTask' :: BundleTask -> Text
$sel:bundleId:BundleTask' :: BundleTask -> Text
$sel:bundleTaskError:BundleTask' :: BundleTask -> Maybe BundleTaskError
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BundleTaskError
bundleTaskError
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bundleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
progress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BundleTaskState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Storage
storage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updateTime