{-# 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.ExportToS3Task
-- 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.ExportToS3Task 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.ContainerFormat
import Amazonka.EC2.Types.DiskImageFormat
import qualified Amazonka.Prelude as Prelude

-- | Describes the format and location for the export task.
--
-- /See:/ 'newExportToS3Task' smart constructor.
data ExportToS3Task = ExportToS3Task'
  { -- | The container format used to combine disk images with metadata (such as
    -- OVF). If absent, only the disk image is exported.
    ExportToS3Task -> Maybe ContainerFormat
containerFormat :: Prelude.Maybe ContainerFormat,
    -- | The format for the exported image.
    ExportToS3Task -> Maybe DiskImageFormat
diskImageFormat :: Prelude.Maybe DiskImageFormat,
    -- | The Amazon S3 bucket for the destination image. The destination bucket
    -- must exist and have an access control list (ACL) attached that specifies
    -- the Region-specific canonical account ID for the @Grantee@. For more
    -- information about the ACL to your S3 bucket, see
    -- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmexport.html#vmexport-prerequisites Prerequisites>
    -- in the VM Import\/Export User Guide.
    ExportToS3Task -> Maybe Text
s3Bucket :: Prelude.Maybe Prelude.Text,
    -- | The encryption key for your S3 bucket.
    ExportToS3Task -> Maybe Text
s3Key :: Prelude.Maybe Prelude.Text
  }
  deriving (ExportToS3Task -> ExportToS3Task -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportToS3Task -> ExportToS3Task -> Bool
$c/= :: ExportToS3Task -> ExportToS3Task -> Bool
== :: ExportToS3Task -> ExportToS3Task -> Bool
$c== :: ExportToS3Task -> ExportToS3Task -> Bool
Prelude.Eq, ReadPrec [ExportToS3Task]
ReadPrec ExportToS3Task
Int -> ReadS ExportToS3Task
ReadS [ExportToS3Task]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportToS3Task]
$creadListPrec :: ReadPrec [ExportToS3Task]
readPrec :: ReadPrec ExportToS3Task
$creadPrec :: ReadPrec ExportToS3Task
readList :: ReadS [ExportToS3Task]
$creadList :: ReadS [ExportToS3Task]
readsPrec :: Int -> ReadS ExportToS3Task
$creadsPrec :: Int -> ReadS ExportToS3Task
Prelude.Read, Int -> ExportToS3Task -> ShowS
[ExportToS3Task] -> ShowS
ExportToS3Task -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportToS3Task] -> ShowS
$cshowList :: [ExportToS3Task] -> ShowS
show :: ExportToS3Task -> String
$cshow :: ExportToS3Task -> String
showsPrec :: Int -> ExportToS3Task -> ShowS
$cshowsPrec :: Int -> ExportToS3Task -> ShowS
Prelude.Show, forall x. Rep ExportToS3Task x -> ExportToS3Task
forall x. ExportToS3Task -> Rep ExportToS3Task x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportToS3Task x -> ExportToS3Task
$cfrom :: forall x. ExportToS3Task -> Rep ExportToS3Task x
Prelude.Generic)

-- |
-- Create a value of 'ExportToS3Task' 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:
--
-- 'containerFormat', 'exportToS3Task_containerFormat' - The container format used to combine disk images with metadata (such as
-- OVF). If absent, only the disk image is exported.
--
-- 'diskImageFormat', 'exportToS3Task_diskImageFormat' - The format for the exported image.
--
-- 's3Bucket', 'exportToS3Task_s3Bucket' - The Amazon S3 bucket for the destination image. The destination bucket
-- must exist and have an access control list (ACL) attached that specifies
-- the Region-specific canonical account ID for the @Grantee@. For more
-- information about the ACL to your S3 bucket, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmexport.html#vmexport-prerequisites Prerequisites>
-- in the VM Import\/Export User Guide.
--
-- 's3Key', 'exportToS3Task_s3Key' - The encryption key for your S3 bucket.
newExportToS3Task ::
  ExportToS3Task
newExportToS3Task :: ExportToS3Task
newExportToS3Task =
  ExportToS3Task'
    { $sel:containerFormat:ExportToS3Task' :: Maybe ContainerFormat
containerFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:diskImageFormat:ExportToS3Task' :: Maybe DiskImageFormat
diskImageFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Bucket:ExportToS3Task' :: Maybe Text
s3Bucket = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Key:ExportToS3Task' :: Maybe Text
s3Key = forall a. Maybe a
Prelude.Nothing
    }

-- | The container format used to combine disk images with metadata (such as
-- OVF). If absent, only the disk image is exported.
exportToS3Task_containerFormat :: Lens.Lens' ExportToS3Task (Prelude.Maybe ContainerFormat)
exportToS3Task_containerFormat :: Lens' ExportToS3Task (Maybe ContainerFormat)
exportToS3Task_containerFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportToS3Task' {Maybe ContainerFormat
containerFormat :: Maybe ContainerFormat
$sel:containerFormat:ExportToS3Task' :: ExportToS3Task -> Maybe ContainerFormat
containerFormat} -> Maybe ContainerFormat
containerFormat) (\s :: ExportToS3Task
s@ExportToS3Task' {} Maybe ContainerFormat
a -> ExportToS3Task
s {$sel:containerFormat:ExportToS3Task' :: Maybe ContainerFormat
containerFormat = Maybe ContainerFormat
a} :: ExportToS3Task)

-- | The format for the exported image.
exportToS3Task_diskImageFormat :: Lens.Lens' ExportToS3Task (Prelude.Maybe DiskImageFormat)
exportToS3Task_diskImageFormat :: Lens' ExportToS3Task (Maybe DiskImageFormat)
exportToS3Task_diskImageFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportToS3Task' {Maybe DiskImageFormat
diskImageFormat :: Maybe DiskImageFormat
$sel:diskImageFormat:ExportToS3Task' :: ExportToS3Task -> Maybe DiskImageFormat
diskImageFormat} -> Maybe DiskImageFormat
diskImageFormat) (\s :: ExportToS3Task
s@ExportToS3Task' {} Maybe DiskImageFormat
a -> ExportToS3Task
s {$sel:diskImageFormat:ExportToS3Task' :: Maybe DiskImageFormat
diskImageFormat = Maybe DiskImageFormat
a} :: ExportToS3Task)

-- | The Amazon S3 bucket for the destination image. The destination bucket
-- must exist and have an access control list (ACL) attached that specifies
-- the Region-specific canonical account ID for the @Grantee@. For more
-- information about the ACL to your S3 bucket, see
-- <https://docs.aws.amazon.com/vm-import/latest/userguide/vmexport.html#vmexport-prerequisites Prerequisites>
-- in the VM Import\/Export User Guide.
exportToS3Task_s3Bucket :: Lens.Lens' ExportToS3Task (Prelude.Maybe Prelude.Text)
exportToS3Task_s3Bucket :: Lens' ExportToS3Task (Maybe Text)
exportToS3Task_s3Bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportToS3Task' {Maybe Text
s3Bucket :: Maybe Text
$sel:s3Bucket:ExportToS3Task' :: ExportToS3Task -> Maybe Text
s3Bucket} -> Maybe Text
s3Bucket) (\s :: ExportToS3Task
s@ExportToS3Task' {} Maybe Text
a -> ExportToS3Task
s {$sel:s3Bucket:ExportToS3Task' :: Maybe Text
s3Bucket = Maybe Text
a} :: ExportToS3Task)

-- | The encryption key for your S3 bucket.
exportToS3Task_s3Key :: Lens.Lens' ExportToS3Task (Prelude.Maybe Prelude.Text)
exportToS3Task_s3Key :: Lens' ExportToS3Task (Maybe Text)
exportToS3Task_s3Key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportToS3Task' {Maybe Text
s3Key :: Maybe Text
$sel:s3Key:ExportToS3Task' :: ExportToS3Task -> Maybe Text
s3Key} -> Maybe Text
s3Key) (\s :: ExportToS3Task
s@ExportToS3Task' {} Maybe Text
a -> ExportToS3Task
s {$sel:s3Key:ExportToS3Task' :: Maybe Text
s3Key = Maybe Text
a} :: ExportToS3Task)

instance Data.FromXML ExportToS3Task where
  parseXML :: [Node] -> Either String ExportToS3Task
parseXML [Node]
x =
    Maybe ContainerFormat
-> Maybe DiskImageFormat
-> Maybe Text
-> Maybe Text
-> ExportToS3Task
ExportToS3Task'
      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
"containerFormat")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"diskImageFormat")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"s3Bucket")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"s3Key")

instance Prelude.Hashable ExportToS3Task where
  hashWithSalt :: Int -> ExportToS3Task -> Int
hashWithSalt Int
_salt ExportToS3Task' {Maybe Text
Maybe ContainerFormat
Maybe DiskImageFormat
s3Key :: Maybe Text
s3Bucket :: Maybe Text
diskImageFormat :: Maybe DiskImageFormat
containerFormat :: Maybe ContainerFormat
$sel:s3Key:ExportToS3Task' :: ExportToS3Task -> Maybe Text
$sel:s3Bucket:ExportToS3Task' :: ExportToS3Task -> Maybe Text
$sel:diskImageFormat:ExportToS3Task' :: ExportToS3Task -> Maybe DiskImageFormat
$sel:containerFormat:ExportToS3Task' :: ExportToS3Task -> Maybe ContainerFormat
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContainerFormat
containerFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DiskImageFormat
diskImageFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
s3Bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
s3Key

instance Prelude.NFData ExportToS3Task where
  rnf :: ExportToS3Task -> ()
rnf ExportToS3Task' {Maybe Text
Maybe ContainerFormat
Maybe DiskImageFormat
s3Key :: Maybe Text
s3Bucket :: Maybe Text
diskImageFormat :: Maybe DiskImageFormat
containerFormat :: Maybe ContainerFormat
$sel:s3Key:ExportToS3Task' :: ExportToS3Task -> Maybe Text
$sel:s3Bucket:ExportToS3Task' :: ExportToS3Task -> Maybe Text
$sel:diskImageFormat:ExportToS3Task' :: ExportToS3Task -> Maybe DiskImageFormat
$sel:containerFormat:ExportToS3Task' :: ExportToS3Task -> Maybe ContainerFormat
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ContainerFormat
containerFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DiskImageFormat
diskImageFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
s3Bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
s3Key