{-# 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.CreateRestoreImageTask
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a task that restores an AMI from an Amazon S3 object that was
-- previously created by using
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateStoreImageTask.html CreateStoreImageTask>.
--
-- To use this API, you must have the required permissions. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-store-restore.html#ami-s3-permissions Permissions for storing and restoring AMIs using Amazon S3>
-- in the /Amazon EC2 User Guide/.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ami-store-restore.html Store and restore an AMI using Amazon S3>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.CreateRestoreImageTask
  ( -- * Creating a Request
    CreateRestoreImageTask (..),
    newCreateRestoreImageTask,

    -- * Request Lenses
    createRestoreImageTask_dryRun,
    createRestoreImageTask_name,
    createRestoreImageTask_tagSpecifications,
    createRestoreImageTask_bucket,
    createRestoreImageTask_objectKey,

    -- * Destructuring the Response
    CreateRestoreImageTaskResponse (..),
    newCreateRestoreImageTaskResponse,

    -- * Response Lenses
    createRestoreImageTaskResponse_imageId,
    createRestoreImageTaskResponse_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:/ 'newCreateRestoreImageTask' smart constructor.
data CreateRestoreImageTask = CreateRestoreImageTask'
  { -- | 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@.
    CreateRestoreImageTask -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The name for the restored AMI. The name must be unique for AMIs in the
    -- Region for this account. If you do not provide a name, the new AMI gets
    -- the same name as the original AMI.
    CreateRestoreImageTask -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the AMI and snapshots on restoration. You can tag
    -- the AMI, the snapshots, or both.
    --
    -- -   To tag the AMI, the value for @ResourceType@ must be @image@.
    --
    -- -   To tag the snapshots, the value for @ResourceType@ must be
    --     @snapshot@. The same tag is applied to all of the snapshots that are
    --     created.
    CreateRestoreImageTask -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The name of the Amazon S3 bucket that contains the stored AMI object.
    CreateRestoreImageTask -> Text
bucket :: Prelude.Text,
    -- | The name of the stored AMI object in the bucket.
    CreateRestoreImageTask -> Text
objectKey :: Prelude.Text
  }
  deriving (CreateRestoreImageTask -> CreateRestoreImageTask -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateRestoreImageTask -> CreateRestoreImageTask -> Bool
$c/= :: CreateRestoreImageTask -> CreateRestoreImageTask -> Bool
== :: CreateRestoreImageTask -> CreateRestoreImageTask -> Bool
$c== :: CreateRestoreImageTask -> CreateRestoreImageTask -> Bool
Prelude.Eq, ReadPrec [CreateRestoreImageTask]
ReadPrec CreateRestoreImageTask
Int -> ReadS CreateRestoreImageTask
ReadS [CreateRestoreImageTask]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateRestoreImageTask]
$creadListPrec :: ReadPrec [CreateRestoreImageTask]
readPrec :: ReadPrec CreateRestoreImageTask
$creadPrec :: ReadPrec CreateRestoreImageTask
readList :: ReadS [CreateRestoreImageTask]
$creadList :: ReadS [CreateRestoreImageTask]
readsPrec :: Int -> ReadS CreateRestoreImageTask
$creadsPrec :: Int -> ReadS CreateRestoreImageTask
Prelude.Read, Int -> CreateRestoreImageTask -> ShowS
[CreateRestoreImageTask] -> ShowS
CreateRestoreImageTask -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateRestoreImageTask] -> ShowS
$cshowList :: [CreateRestoreImageTask] -> ShowS
show :: CreateRestoreImageTask -> String
$cshow :: CreateRestoreImageTask -> String
showsPrec :: Int -> CreateRestoreImageTask -> ShowS
$cshowsPrec :: Int -> CreateRestoreImageTask -> ShowS
Prelude.Show, forall x. Rep CreateRestoreImageTask x -> CreateRestoreImageTask
forall x. CreateRestoreImageTask -> Rep CreateRestoreImageTask x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateRestoreImageTask x -> CreateRestoreImageTask
$cfrom :: forall x. CreateRestoreImageTask -> Rep CreateRestoreImageTask x
Prelude.Generic)

-- |
-- Create a value of 'CreateRestoreImageTask' 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:
--
-- 'dryRun', 'createRestoreImageTask_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@.
--
-- 'name', 'createRestoreImageTask_name' - The name for the restored AMI. The name must be unique for AMIs in the
-- Region for this account. If you do not provide a name, the new AMI gets
-- the same name as the original AMI.
--
-- 'tagSpecifications', 'createRestoreImageTask_tagSpecifications' - The tags to apply to the AMI and snapshots on restoration. You can tag
-- the AMI, the snapshots, or both.
--
-- -   To tag the AMI, the value for @ResourceType@ must be @image@.
--
-- -   To tag the snapshots, the value for @ResourceType@ must be
--     @snapshot@. The same tag is applied to all of the snapshots that are
--     created.
--
-- 'bucket', 'createRestoreImageTask_bucket' - The name of the Amazon S3 bucket that contains the stored AMI object.
--
-- 'objectKey', 'createRestoreImageTask_objectKey' - The name of the stored AMI object in the bucket.
newCreateRestoreImageTask ::
  -- | 'bucket'
  Prelude.Text ->
  -- | 'objectKey'
  Prelude.Text ->
  CreateRestoreImageTask
newCreateRestoreImageTask :: Text -> Text -> CreateRestoreImageTask
newCreateRestoreImageTask Text
pBucket_ Text
pObjectKey_ =
  CreateRestoreImageTask'
    { $sel:dryRun:CreateRestoreImageTask' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateRestoreImageTask' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateRestoreImageTask' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:CreateRestoreImageTask' :: Text
bucket = Text
pBucket_,
      $sel:objectKey:CreateRestoreImageTask' :: Text
objectKey = Text
pObjectKey_
    }

-- | 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@.
createRestoreImageTask_dryRun :: Lens.Lens' CreateRestoreImageTask (Prelude.Maybe Prelude.Bool)
createRestoreImageTask_dryRun :: Lens' CreateRestoreImageTask (Maybe Bool)
createRestoreImageTask_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestoreImageTask' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateRestoreImageTask
s@CreateRestoreImageTask' {} Maybe Bool
a -> CreateRestoreImageTask
s {$sel:dryRun:CreateRestoreImageTask' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateRestoreImageTask)

-- | The name for the restored AMI. The name must be unique for AMIs in the
-- Region for this account. If you do not provide a name, the new AMI gets
-- the same name as the original AMI.
createRestoreImageTask_name :: Lens.Lens' CreateRestoreImageTask (Prelude.Maybe Prelude.Text)
createRestoreImageTask_name :: Lens' CreateRestoreImageTask (Maybe Text)
createRestoreImageTask_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestoreImageTask' {Maybe Text
name :: Maybe Text
$sel:name:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateRestoreImageTask
s@CreateRestoreImageTask' {} Maybe Text
a -> CreateRestoreImageTask
s {$sel:name:CreateRestoreImageTask' :: Maybe Text
name = Maybe Text
a} :: CreateRestoreImageTask)

-- | The tags to apply to the AMI and snapshots on restoration. You can tag
-- the AMI, the snapshots, or both.
--
-- -   To tag the AMI, the value for @ResourceType@ must be @image@.
--
-- -   To tag the snapshots, the value for @ResourceType@ must be
--     @snapshot@. The same tag is applied to all of the snapshots that are
--     created.
createRestoreImageTask_tagSpecifications :: Lens.Lens' CreateRestoreImageTask (Prelude.Maybe [TagSpecification])
createRestoreImageTask_tagSpecifications :: Lens' CreateRestoreImageTask (Maybe [TagSpecification])
createRestoreImageTask_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestoreImageTask' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateRestoreImageTask
s@CreateRestoreImageTask' {} Maybe [TagSpecification]
a -> CreateRestoreImageTask
s {$sel:tagSpecifications:CreateRestoreImageTask' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateRestoreImageTask) 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 name of the Amazon S3 bucket that contains the stored AMI object.
createRestoreImageTask_bucket :: Lens.Lens' CreateRestoreImageTask Prelude.Text
createRestoreImageTask_bucket :: Lens' CreateRestoreImageTask Text
createRestoreImageTask_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestoreImageTask' {Text
bucket :: Text
$sel:bucket:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
bucket} -> Text
bucket) (\s :: CreateRestoreImageTask
s@CreateRestoreImageTask' {} Text
a -> CreateRestoreImageTask
s {$sel:bucket:CreateRestoreImageTask' :: Text
bucket = Text
a} :: CreateRestoreImageTask)

-- | The name of the stored AMI object in the bucket.
createRestoreImageTask_objectKey :: Lens.Lens' CreateRestoreImageTask Prelude.Text
createRestoreImageTask_objectKey :: Lens' CreateRestoreImageTask Text
createRestoreImageTask_objectKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestoreImageTask' {Text
objectKey :: Text
$sel:objectKey:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
objectKey} -> Text
objectKey) (\s :: CreateRestoreImageTask
s@CreateRestoreImageTask' {} Text
a -> CreateRestoreImageTask
s {$sel:objectKey:CreateRestoreImageTask' :: Text
objectKey = Text
a} :: CreateRestoreImageTask)

instance Core.AWSRequest CreateRestoreImageTask where
  type
    AWSResponse CreateRestoreImageTask =
      CreateRestoreImageTaskResponse
  request :: (Service -> Service)
-> CreateRestoreImageTask -> Request CreateRestoreImageTask
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 CreateRestoreImageTask
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateRestoreImageTask)))
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 Text -> Int -> CreateRestoreImageTaskResponse
CreateRestoreImageTaskResponse'
            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
"imageId")
            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 CreateRestoreImageTask where
  hashWithSalt :: Int -> CreateRestoreImageTask -> Int
hashWithSalt Int
_salt CreateRestoreImageTask' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
objectKey :: Text
bucket :: Text
tagSpecifications :: Maybe [TagSpecification]
name :: Maybe Text
dryRun :: Maybe Bool
$sel:objectKey:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
$sel:bucket:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
$sel:tagSpecifications:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe [TagSpecification]
$sel:name:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Text
$sel:dryRun:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
objectKey

instance Prelude.NFData CreateRestoreImageTask where
  rnf :: CreateRestoreImageTask -> ()
rnf CreateRestoreImageTask' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
objectKey :: Text
bucket :: Text
tagSpecifications :: Maybe [TagSpecification]
name :: Maybe Text
dryRun :: Maybe Bool
$sel:objectKey:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
$sel:bucket:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
$sel:tagSpecifications:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe [TagSpecification]
$sel:name:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Text
$sel:dryRun:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Bool
..} =
    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 Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
objectKey

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

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

instance Data.ToQuery CreateRestoreImageTask where
  toQuery :: CreateRestoreImageTask -> QueryString
toQuery CreateRestoreImageTask' {Maybe Bool
Maybe [TagSpecification]
Maybe Text
Text
objectKey :: Text
bucket :: Text
tagSpecifications :: Maybe [TagSpecification]
name :: Maybe Text
dryRun :: Maybe Bool
$sel:objectKey:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
$sel:bucket:CreateRestoreImageTask' :: CreateRestoreImageTask -> Text
$sel:tagSpecifications:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe [TagSpecification]
$sel:name:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Text
$sel:dryRun:CreateRestoreImageTask' :: CreateRestoreImageTask -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateRestoreImageTask" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Name" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
name,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"Bucket" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
bucket,
        ByteString
"ObjectKey" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
objectKey
      ]

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

-- |
-- Create a value of 'CreateRestoreImageTaskResponse' 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:
--
-- 'imageId', 'createRestoreImageTaskResponse_imageId' - The AMI ID.
--
-- 'httpStatus', 'createRestoreImageTaskResponse_httpStatus' - The response's http status code.
newCreateRestoreImageTaskResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateRestoreImageTaskResponse
newCreateRestoreImageTaskResponse :: Int -> CreateRestoreImageTaskResponse
newCreateRestoreImageTaskResponse Int
pHttpStatus_ =
  CreateRestoreImageTaskResponse'
    { $sel:imageId:CreateRestoreImageTaskResponse' :: Maybe Text
imageId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateRestoreImageTaskResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The AMI ID.
createRestoreImageTaskResponse_imageId :: Lens.Lens' CreateRestoreImageTaskResponse (Prelude.Maybe Prelude.Text)
createRestoreImageTaskResponse_imageId :: Lens' CreateRestoreImageTaskResponse (Maybe Text)
createRestoreImageTaskResponse_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateRestoreImageTaskResponse' {Maybe Text
imageId :: Maybe Text
$sel:imageId:CreateRestoreImageTaskResponse' :: CreateRestoreImageTaskResponse -> Maybe Text
imageId} -> Maybe Text
imageId) (\s :: CreateRestoreImageTaskResponse
s@CreateRestoreImageTaskResponse' {} Maybe Text
a -> CreateRestoreImageTaskResponse
s {$sel:imageId:CreateRestoreImageTaskResponse' :: Maybe Text
imageId = Maybe Text
a} :: CreateRestoreImageTaskResponse)

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

instance
  Prelude.NFData
    CreateRestoreImageTaskResponse
  where
  rnf :: CreateRestoreImageTaskResponse -> ()
rnf CreateRestoreImageTaskResponse' {Int
Maybe Text
httpStatus :: Int
imageId :: Maybe Text
$sel:httpStatus:CreateRestoreImageTaskResponse' :: CreateRestoreImageTaskResponse -> Int
$sel:imageId:CreateRestoreImageTaskResponse' :: CreateRestoreImageTaskResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus