{-# 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.DescribeImageAttribute
-- 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 attribute of the specified AMI. You can specify
-- only one attribute at a time.
module Amazonka.EC2.DescribeImageAttribute
  ( -- * Creating a Request
    DescribeImageAttribute (..),
    newDescribeImageAttribute,

    -- * Request Lenses
    describeImageAttribute_dryRun,
    describeImageAttribute_attribute,
    describeImageAttribute_imageId,

    -- * Destructuring the Response
    DescribeImageAttributeResponse (..),
    newDescribeImageAttributeResponse,

    -- * Response Lenses
    describeImageAttributeResponse_blockDeviceMappings,
    describeImageAttributeResponse_bootMode,
    describeImageAttributeResponse_description,
    describeImageAttributeResponse_imageId,
    describeImageAttributeResponse_imdsSupport,
    describeImageAttributeResponse_kernelId,
    describeImageAttributeResponse_lastLaunchedTime,
    describeImageAttributeResponse_launchPermissions,
    describeImageAttributeResponse_productCodes,
    describeImageAttributeResponse_ramdiskId,
    describeImageAttributeResponse_sriovNetSupport,
    describeImageAttributeResponse_tpmSupport,
    describeImageAttributeResponse_uefiData,
    describeImageAttributeResponse_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

-- | Contains the parameters for DescribeImageAttribute.
--
-- /See:/ 'newDescribeImageAttribute' smart constructor.
data DescribeImageAttribute = DescribeImageAttribute'
  { -- | 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@.
    DescribeImageAttribute -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The AMI attribute.
    --
    -- __Note__: The @blockDeviceMapping@ attribute is deprecated. Using this
    -- attribute returns the @Client.AuthFailure@ error. To get information
    -- about the block device mappings for an AMI, use the DescribeImages
    -- action.
    DescribeImageAttribute -> ImageAttributeName
attribute :: ImageAttributeName,
    -- | The ID of the AMI.
    DescribeImageAttribute -> Text
imageId :: Prelude.Text
  }
  deriving (DescribeImageAttribute -> DescribeImageAttribute -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeImageAttribute -> DescribeImageAttribute -> Bool
$c/= :: DescribeImageAttribute -> DescribeImageAttribute -> Bool
== :: DescribeImageAttribute -> DescribeImageAttribute -> Bool
$c== :: DescribeImageAttribute -> DescribeImageAttribute -> Bool
Prelude.Eq, ReadPrec [DescribeImageAttribute]
ReadPrec DescribeImageAttribute
Int -> ReadS DescribeImageAttribute
ReadS [DescribeImageAttribute]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeImageAttribute]
$creadListPrec :: ReadPrec [DescribeImageAttribute]
readPrec :: ReadPrec DescribeImageAttribute
$creadPrec :: ReadPrec DescribeImageAttribute
readList :: ReadS [DescribeImageAttribute]
$creadList :: ReadS [DescribeImageAttribute]
readsPrec :: Int -> ReadS DescribeImageAttribute
$creadsPrec :: Int -> ReadS DescribeImageAttribute
Prelude.Read, Int -> DescribeImageAttribute -> ShowS
[DescribeImageAttribute] -> ShowS
DescribeImageAttribute -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeImageAttribute] -> ShowS
$cshowList :: [DescribeImageAttribute] -> ShowS
show :: DescribeImageAttribute -> String
$cshow :: DescribeImageAttribute -> String
showsPrec :: Int -> DescribeImageAttribute -> ShowS
$cshowsPrec :: Int -> DescribeImageAttribute -> ShowS
Prelude.Show, forall x. Rep DescribeImageAttribute x -> DescribeImageAttribute
forall x. DescribeImageAttribute -> Rep DescribeImageAttribute x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeImageAttribute x -> DescribeImageAttribute
$cfrom :: forall x. DescribeImageAttribute -> Rep DescribeImageAttribute x
Prelude.Generic)

-- |
-- Create a value of 'DescribeImageAttribute' 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', 'describeImageAttribute_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@.
--
-- 'attribute', 'describeImageAttribute_attribute' - The AMI attribute.
--
-- __Note__: The @blockDeviceMapping@ attribute is deprecated. Using this
-- attribute returns the @Client.AuthFailure@ error. To get information
-- about the block device mappings for an AMI, use the DescribeImages
-- action.
--
-- 'imageId', 'describeImageAttribute_imageId' - The ID of the AMI.
newDescribeImageAttribute ::
  -- | 'attribute'
  ImageAttributeName ->
  -- | 'imageId'
  Prelude.Text ->
  DescribeImageAttribute
newDescribeImageAttribute :: ImageAttributeName -> Text -> DescribeImageAttribute
newDescribeImageAttribute ImageAttributeName
pAttribute_ Text
pImageId_ =
  DescribeImageAttribute'
    { $sel:dryRun:DescribeImageAttribute' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:attribute:DescribeImageAttribute' :: ImageAttributeName
attribute = ImageAttributeName
pAttribute_,
      $sel:imageId:DescribeImageAttribute' :: Text
imageId = Text
pImageId_
    }

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

-- | The AMI attribute.
--
-- __Note__: The @blockDeviceMapping@ attribute is deprecated. Using this
-- attribute returns the @Client.AuthFailure@ error. To get information
-- about the block device mappings for an AMI, use the DescribeImages
-- action.
describeImageAttribute_attribute :: Lens.Lens' DescribeImageAttribute ImageAttributeName
describeImageAttribute_attribute :: Lens' DescribeImageAttribute ImageAttributeName
describeImageAttribute_attribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttribute' {ImageAttributeName
attribute :: ImageAttributeName
$sel:attribute:DescribeImageAttribute' :: DescribeImageAttribute -> ImageAttributeName
attribute} -> ImageAttributeName
attribute) (\s :: DescribeImageAttribute
s@DescribeImageAttribute' {} ImageAttributeName
a -> DescribeImageAttribute
s {$sel:attribute:DescribeImageAttribute' :: ImageAttributeName
attribute = ImageAttributeName
a} :: DescribeImageAttribute)

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

instance Core.AWSRequest DescribeImageAttribute where
  type
    AWSResponse DescribeImageAttribute =
      DescribeImageAttributeResponse
  request :: (Service -> Service)
-> DescribeImageAttribute -> Request DescribeImageAttribute
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 DescribeImageAttribute
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeImageAttribute)))
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 [BlockDeviceMapping]
-> Maybe AttributeValue
-> Maybe AttributeValue
-> Maybe Text
-> Maybe AttributeValue
-> Maybe AttributeValue
-> Maybe AttributeValue
-> Maybe [LaunchPermission]
-> Maybe [ProductCode]
-> Maybe AttributeValue
-> Maybe AttributeValue
-> Maybe AttributeValue
-> Maybe AttributeValue
-> Int
-> DescribeImageAttributeResponse
DescribeImageAttributeResponse'
            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
"blockDeviceMapping"
                            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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"bootMode")
            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
"description")
            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
"imageId")
            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
"imdsSupport")
            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
"kernel")
            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
"lastLaunchedTime")
            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
"launchPermission"
                            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.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"productCodes"
                            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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ramdisk")
            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
"sriovNetSupport")
            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
"tpmSupport")
            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
"uefiData")
            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 DescribeImageAttribute where
  hashWithSalt :: Int -> DescribeImageAttribute -> Int
hashWithSalt Int
_salt DescribeImageAttribute' {Maybe Bool
Text
ImageAttributeName
imageId :: Text
attribute :: ImageAttributeName
dryRun :: Maybe Bool
$sel:imageId:DescribeImageAttribute' :: DescribeImageAttribute -> Text
$sel:attribute:DescribeImageAttribute' :: DescribeImageAttribute -> ImageAttributeName
$sel:dryRun:DescribeImageAttribute' :: DescribeImageAttribute -> 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` ImageAttributeName
attribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
imageId

instance Prelude.NFData DescribeImageAttribute where
  rnf :: DescribeImageAttribute -> ()
rnf DescribeImageAttribute' {Maybe Bool
Text
ImageAttributeName
imageId :: Text
attribute :: ImageAttributeName
dryRun :: Maybe Bool
$sel:imageId:DescribeImageAttribute' :: DescribeImageAttribute -> Text
$sel:attribute:DescribeImageAttribute' :: DescribeImageAttribute -> ImageAttributeName
$sel:dryRun:DescribeImageAttribute' :: DescribeImageAttribute -> 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 ImageAttributeName
attribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
imageId

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

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

instance Data.ToQuery DescribeImageAttribute where
  toQuery :: DescribeImageAttribute -> QueryString
toQuery DescribeImageAttribute' {Maybe Bool
Text
ImageAttributeName
imageId :: Text
attribute :: ImageAttributeName
dryRun :: Maybe Bool
$sel:imageId:DescribeImageAttribute' :: DescribeImageAttribute -> Text
$sel:attribute:DescribeImageAttribute' :: DescribeImageAttribute -> ImageAttributeName
$sel:dryRun:DescribeImageAttribute' :: DescribeImageAttribute -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeImageAttribute" :: 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
"Attribute" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ImageAttributeName
attribute,
        ByteString
"ImageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
imageId
      ]

-- | Describes an image attribute.
--
-- /See:/ 'newDescribeImageAttributeResponse' smart constructor.
data DescribeImageAttributeResponse = DescribeImageAttributeResponse'
  { -- | The block device mapping entries.
    DescribeImageAttributeResponse -> Maybe [BlockDeviceMapping]
blockDeviceMappings :: Prelude.Maybe [BlockDeviceMapping],
    -- | The boot mode.
    DescribeImageAttributeResponse -> Maybe AttributeValue
bootMode :: Prelude.Maybe AttributeValue,
    -- | A description for the AMI.
    DescribeImageAttributeResponse -> Maybe AttributeValue
description :: Prelude.Maybe AttributeValue,
    -- | The ID of the AMI.
    DescribeImageAttributeResponse -> Maybe Text
imageId :: Prelude.Maybe Prelude.Text,
    -- | If @v2.0@, it indicates that IMDSv2 is specified in the AMI. Instances
    -- launched from this AMI will have @HttpTokens@ automatically set to
    -- @required@ so that, by default, the instance requires that IMDSv2 is
    -- used when requesting instance metadata. In addition,
    -- @HttpPutResponseHopLimit@ is set to @2@. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/configuring-IMDS-new-instances.html#configure-IMDS-new-instances-ami-configuration Configure the AMI>
    -- in the /Amazon EC2 User Guide/.
    DescribeImageAttributeResponse -> Maybe AttributeValue
imdsSupport :: Prelude.Maybe AttributeValue,
    -- | The kernel ID.
    DescribeImageAttributeResponse -> Maybe AttributeValue
kernelId :: Prelude.Maybe AttributeValue,
    -- | The date and time, in
    -- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the AMI
    -- was last used to launch an EC2 instance. When the AMI is used to launch
    -- an instance, there is a 24-hour delay before that usage is reported.
    --
    -- @lastLaunchedTime@ data is available starting April 2017.
    DescribeImageAttributeResponse -> Maybe AttributeValue
lastLaunchedTime :: Prelude.Maybe AttributeValue,
    -- | The launch permissions.
    DescribeImageAttributeResponse -> Maybe [LaunchPermission]
launchPermissions :: Prelude.Maybe [LaunchPermission],
    -- | The product codes.
    DescribeImageAttributeResponse -> Maybe [ProductCode]
productCodes :: Prelude.Maybe [ProductCode],
    -- | The RAM disk ID.
    DescribeImageAttributeResponse -> Maybe AttributeValue
ramdiskId :: Prelude.Maybe AttributeValue,
    -- | Indicates whether enhanced networking with the Intel 82599 Virtual
    -- Function interface is enabled.
    DescribeImageAttributeResponse -> Maybe AttributeValue
sriovNetSupport :: Prelude.Maybe AttributeValue,
    -- | If the image is configured for NitroTPM support, the value is @v2.0@.
    DescribeImageAttributeResponse -> Maybe AttributeValue
tpmSupport :: Prelude.Maybe AttributeValue,
    -- | Base64 representation of the non-volatile UEFI variable store. To
    -- retrieve the UEFI data, use the
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_GetInstanceUefiData GetInstanceUefiData>
    -- command. You can inspect and modify the UEFI data by using the
    -- <https://github.com/awslabs/python-uefivars python-uefivars tool> on
    -- GitHub. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/uefi-secure-boot.html UEFI Secure Boot>
    -- in the /Amazon EC2 User Guide/.
    DescribeImageAttributeResponse -> Maybe AttributeValue
uefiData :: Prelude.Maybe AttributeValue,
    -- | The response's http status code.
    DescribeImageAttributeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeImageAttributeResponse
-> DescribeImageAttributeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeImageAttributeResponse
-> DescribeImageAttributeResponse -> Bool
$c/= :: DescribeImageAttributeResponse
-> DescribeImageAttributeResponse -> Bool
== :: DescribeImageAttributeResponse
-> DescribeImageAttributeResponse -> Bool
$c== :: DescribeImageAttributeResponse
-> DescribeImageAttributeResponse -> Bool
Prelude.Eq, ReadPrec [DescribeImageAttributeResponse]
ReadPrec DescribeImageAttributeResponse
Int -> ReadS DescribeImageAttributeResponse
ReadS [DescribeImageAttributeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeImageAttributeResponse]
$creadListPrec :: ReadPrec [DescribeImageAttributeResponse]
readPrec :: ReadPrec DescribeImageAttributeResponse
$creadPrec :: ReadPrec DescribeImageAttributeResponse
readList :: ReadS [DescribeImageAttributeResponse]
$creadList :: ReadS [DescribeImageAttributeResponse]
readsPrec :: Int -> ReadS DescribeImageAttributeResponse
$creadsPrec :: Int -> ReadS DescribeImageAttributeResponse
Prelude.Read, Int -> DescribeImageAttributeResponse -> ShowS
[DescribeImageAttributeResponse] -> ShowS
DescribeImageAttributeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeImageAttributeResponse] -> ShowS
$cshowList :: [DescribeImageAttributeResponse] -> ShowS
show :: DescribeImageAttributeResponse -> String
$cshow :: DescribeImageAttributeResponse -> String
showsPrec :: Int -> DescribeImageAttributeResponse -> ShowS
$cshowsPrec :: Int -> DescribeImageAttributeResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeImageAttributeResponse x
-> DescribeImageAttributeResponse
forall x.
DescribeImageAttributeResponse
-> Rep DescribeImageAttributeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeImageAttributeResponse x
-> DescribeImageAttributeResponse
$cfrom :: forall x.
DescribeImageAttributeResponse
-> Rep DescribeImageAttributeResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeImageAttributeResponse' 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:
--
-- 'blockDeviceMappings', 'describeImageAttributeResponse_blockDeviceMappings' - The block device mapping entries.
--
-- 'bootMode', 'describeImageAttributeResponse_bootMode' - The boot mode.
--
-- 'description', 'describeImageAttributeResponse_description' - A description for the AMI.
--
-- 'imageId', 'describeImageAttributeResponse_imageId' - The ID of the AMI.
--
-- 'imdsSupport', 'describeImageAttributeResponse_imdsSupport' - If @v2.0@, it indicates that IMDSv2 is specified in the AMI. Instances
-- launched from this AMI will have @HttpTokens@ automatically set to
-- @required@ so that, by default, the instance requires that IMDSv2 is
-- used when requesting instance metadata. In addition,
-- @HttpPutResponseHopLimit@ is set to @2@. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/configuring-IMDS-new-instances.html#configure-IMDS-new-instances-ami-configuration Configure the AMI>
-- in the /Amazon EC2 User Guide/.
--
-- 'kernelId', 'describeImageAttributeResponse_kernelId' - The kernel ID.
--
-- 'lastLaunchedTime', 'describeImageAttributeResponse_lastLaunchedTime' - The date and time, in
-- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the AMI
-- was last used to launch an EC2 instance. When the AMI is used to launch
-- an instance, there is a 24-hour delay before that usage is reported.
--
-- @lastLaunchedTime@ data is available starting April 2017.
--
-- 'launchPermissions', 'describeImageAttributeResponse_launchPermissions' - The launch permissions.
--
-- 'productCodes', 'describeImageAttributeResponse_productCodes' - The product codes.
--
-- 'ramdiskId', 'describeImageAttributeResponse_ramdiskId' - The RAM disk ID.
--
-- 'sriovNetSupport', 'describeImageAttributeResponse_sriovNetSupport' - Indicates whether enhanced networking with the Intel 82599 Virtual
-- Function interface is enabled.
--
-- 'tpmSupport', 'describeImageAttributeResponse_tpmSupport' - If the image is configured for NitroTPM support, the value is @v2.0@.
--
-- 'uefiData', 'describeImageAttributeResponse_uefiData' - Base64 representation of the non-volatile UEFI variable store. To
-- retrieve the UEFI data, use the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_GetInstanceUefiData GetInstanceUefiData>
-- command. You can inspect and modify the UEFI data by using the
-- <https://github.com/awslabs/python-uefivars python-uefivars tool> on
-- GitHub. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/uefi-secure-boot.html UEFI Secure Boot>
-- in the /Amazon EC2 User Guide/.
--
-- 'httpStatus', 'describeImageAttributeResponse_httpStatus' - The response's http status code.
newDescribeImageAttributeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeImageAttributeResponse
newDescribeImageAttributeResponse :: Int -> DescribeImageAttributeResponse
newDescribeImageAttributeResponse Int
pHttpStatus_ =
  DescribeImageAttributeResponse'
    { $sel:blockDeviceMappings:DescribeImageAttributeResponse' :: Maybe [BlockDeviceMapping]
blockDeviceMappings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:bootMode:DescribeImageAttributeResponse' :: Maybe AttributeValue
bootMode = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeImageAttributeResponse' :: Maybe AttributeValue
description = forall a. Maybe a
Prelude.Nothing,
      $sel:imageId:DescribeImageAttributeResponse' :: Maybe Text
imageId = forall a. Maybe a
Prelude.Nothing,
      $sel:imdsSupport:DescribeImageAttributeResponse' :: Maybe AttributeValue
imdsSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:kernelId:DescribeImageAttributeResponse' :: Maybe AttributeValue
kernelId = forall a. Maybe a
Prelude.Nothing,
      $sel:lastLaunchedTime:DescribeImageAttributeResponse' :: Maybe AttributeValue
lastLaunchedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:launchPermissions:DescribeImageAttributeResponse' :: Maybe [LaunchPermission]
launchPermissions = forall a. Maybe a
Prelude.Nothing,
      $sel:productCodes:DescribeImageAttributeResponse' :: Maybe [ProductCode]
productCodes = forall a. Maybe a
Prelude.Nothing,
      $sel:ramdiskId:DescribeImageAttributeResponse' :: Maybe AttributeValue
ramdiskId = forall a. Maybe a
Prelude.Nothing,
      $sel:sriovNetSupport:DescribeImageAttributeResponse' :: Maybe AttributeValue
sriovNetSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:tpmSupport:DescribeImageAttributeResponse' :: Maybe AttributeValue
tpmSupport = forall a. Maybe a
Prelude.Nothing,
      $sel:uefiData:DescribeImageAttributeResponse' :: Maybe AttributeValue
uefiData = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeImageAttributeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The block device mapping entries.
describeImageAttributeResponse_blockDeviceMappings :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe [BlockDeviceMapping])
describeImageAttributeResponse_blockDeviceMappings :: Lens' DescribeImageAttributeResponse (Maybe [BlockDeviceMapping])
describeImageAttributeResponse_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe [BlockDeviceMapping]
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:blockDeviceMappings:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe [BlockDeviceMapping]
blockDeviceMappings} -> Maybe [BlockDeviceMapping]
blockDeviceMappings) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe [BlockDeviceMapping]
a -> DescribeImageAttributeResponse
s {$sel:blockDeviceMappings:DescribeImageAttributeResponse' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = Maybe [BlockDeviceMapping]
a} :: DescribeImageAttributeResponse) 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 boot mode.
describeImageAttributeResponse_bootMode :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_bootMode :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_bootMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
bootMode :: Maybe AttributeValue
$sel:bootMode:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
bootMode} -> Maybe AttributeValue
bootMode) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:bootMode:DescribeImageAttributeResponse' :: Maybe AttributeValue
bootMode = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

-- | A description for the AMI.
describeImageAttributeResponse_description :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_description :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
description :: Maybe AttributeValue
$sel:description:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
description} -> Maybe AttributeValue
description) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:description:DescribeImageAttributeResponse' :: Maybe AttributeValue
description = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

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

-- | If @v2.0@, it indicates that IMDSv2 is specified in the AMI. Instances
-- launched from this AMI will have @HttpTokens@ automatically set to
-- @required@ so that, by default, the instance requires that IMDSv2 is
-- used when requesting instance metadata. In addition,
-- @HttpPutResponseHopLimit@ is set to @2@. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/configuring-IMDS-new-instances.html#configure-IMDS-new-instances-ami-configuration Configure the AMI>
-- in the /Amazon EC2 User Guide/.
describeImageAttributeResponse_imdsSupport :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_imdsSupport :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_imdsSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
imdsSupport :: Maybe AttributeValue
$sel:imdsSupport:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
imdsSupport} -> Maybe AttributeValue
imdsSupport) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:imdsSupport:DescribeImageAttributeResponse' :: Maybe AttributeValue
imdsSupport = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

-- | The kernel ID.
describeImageAttributeResponse_kernelId :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_kernelId :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_kernelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
kernelId :: Maybe AttributeValue
$sel:kernelId:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
kernelId} -> Maybe AttributeValue
kernelId) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:kernelId:DescribeImageAttributeResponse' :: Maybe AttributeValue
kernelId = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

-- | The date and time, in
-- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the AMI
-- was last used to launch an EC2 instance. When the AMI is used to launch
-- an instance, there is a 24-hour delay before that usage is reported.
--
-- @lastLaunchedTime@ data is available starting April 2017.
describeImageAttributeResponse_lastLaunchedTime :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_lastLaunchedTime :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_lastLaunchedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
lastLaunchedTime :: Maybe AttributeValue
$sel:lastLaunchedTime:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
lastLaunchedTime} -> Maybe AttributeValue
lastLaunchedTime) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:lastLaunchedTime:DescribeImageAttributeResponse' :: Maybe AttributeValue
lastLaunchedTime = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

-- | The launch permissions.
describeImageAttributeResponse_launchPermissions :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe [LaunchPermission])
describeImageAttributeResponse_launchPermissions :: Lens' DescribeImageAttributeResponse (Maybe [LaunchPermission])
describeImageAttributeResponse_launchPermissions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe [LaunchPermission]
launchPermissions :: Maybe [LaunchPermission]
$sel:launchPermissions:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe [LaunchPermission]
launchPermissions} -> Maybe [LaunchPermission]
launchPermissions) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe [LaunchPermission]
a -> DescribeImageAttributeResponse
s {$sel:launchPermissions:DescribeImageAttributeResponse' :: Maybe [LaunchPermission]
launchPermissions = Maybe [LaunchPermission]
a} :: DescribeImageAttributeResponse) 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 product codes.
describeImageAttributeResponse_productCodes :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe [ProductCode])
describeImageAttributeResponse_productCodes :: Lens' DescribeImageAttributeResponse (Maybe [ProductCode])
describeImageAttributeResponse_productCodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe [ProductCode]
productCodes :: Maybe [ProductCode]
$sel:productCodes:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe [ProductCode]
productCodes} -> Maybe [ProductCode]
productCodes) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe [ProductCode]
a -> DescribeImageAttributeResponse
s {$sel:productCodes:DescribeImageAttributeResponse' :: Maybe [ProductCode]
productCodes = Maybe [ProductCode]
a} :: DescribeImageAttributeResponse) 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 RAM disk ID.
describeImageAttributeResponse_ramdiskId :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_ramdiskId :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_ramdiskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
ramdiskId :: Maybe AttributeValue
$sel:ramdiskId:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
ramdiskId} -> Maybe AttributeValue
ramdiskId) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:ramdiskId:DescribeImageAttributeResponse' :: Maybe AttributeValue
ramdiskId = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

-- | Indicates whether enhanced networking with the Intel 82599 Virtual
-- Function interface is enabled.
describeImageAttributeResponse_sriovNetSupport :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_sriovNetSupport :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_sriovNetSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
sriovNetSupport :: Maybe AttributeValue
$sel:sriovNetSupport:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
sriovNetSupport} -> Maybe AttributeValue
sriovNetSupport) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:sriovNetSupport:DescribeImageAttributeResponse' :: Maybe AttributeValue
sriovNetSupport = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

-- | If the image is configured for NitroTPM support, the value is @v2.0@.
describeImageAttributeResponse_tpmSupport :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_tpmSupport :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_tpmSupport = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
tpmSupport :: Maybe AttributeValue
$sel:tpmSupport:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
tpmSupport} -> Maybe AttributeValue
tpmSupport) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:tpmSupport:DescribeImageAttributeResponse' :: Maybe AttributeValue
tpmSupport = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

-- | Base64 representation of the non-volatile UEFI variable store. To
-- retrieve the UEFI data, use the
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_GetInstanceUefiData GetInstanceUefiData>
-- command. You can inspect and modify the UEFI data by using the
-- <https://github.com/awslabs/python-uefivars python-uefivars tool> on
-- GitHub. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/uefi-secure-boot.html UEFI Secure Boot>
-- in the /Amazon EC2 User Guide/.
describeImageAttributeResponse_uefiData :: Lens.Lens' DescribeImageAttributeResponse (Prelude.Maybe AttributeValue)
describeImageAttributeResponse_uefiData :: Lens' DescribeImageAttributeResponse (Maybe AttributeValue)
describeImageAttributeResponse_uefiData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeImageAttributeResponse' {Maybe AttributeValue
uefiData :: Maybe AttributeValue
$sel:uefiData:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
uefiData} -> Maybe AttributeValue
uefiData) (\s :: DescribeImageAttributeResponse
s@DescribeImageAttributeResponse' {} Maybe AttributeValue
a -> DescribeImageAttributeResponse
s {$sel:uefiData:DescribeImageAttributeResponse' :: Maybe AttributeValue
uefiData = Maybe AttributeValue
a} :: DescribeImageAttributeResponse)

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

instance
  Prelude.NFData
    DescribeImageAttributeResponse
  where
  rnf :: DescribeImageAttributeResponse -> ()
rnf DescribeImageAttributeResponse' {Int
Maybe [LaunchPermission]
Maybe [ProductCode]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe AttributeValue
httpStatus :: Int
uefiData :: Maybe AttributeValue
tpmSupport :: Maybe AttributeValue
sriovNetSupport :: Maybe AttributeValue
ramdiskId :: Maybe AttributeValue
productCodes :: Maybe [ProductCode]
launchPermissions :: Maybe [LaunchPermission]
lastLaunchedTime :: Maybe AttributeValue
kernelId :: Maybe AttributeValue
imdsSupport :: Maybe AttributeValue
imageId :: Maybe Text
description :: Maybe AttributeValue
bootMode :: Maybe AttributeValue
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:httpStatus:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Int
$sel:uefiData:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:tpmSupport:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:sriovNetSupport:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:ramdiskId:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:productCodes:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe [ProductCode]
$sel:launchPermissions:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe [LaunchPermission]
$sel:lastLaunchedTime:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:kernelId:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:imdsSupport:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:imageId:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe Text
$sel:description:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:bootMode:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe AttributeValue
$sel:blockDeviceMappings:DescribeImageAttributeResponse' :: DescribeImageAttributeResponse -> Maybe [BlockDeviceMapping]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BlockDeviceMapping]
blockDeviceMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
bootMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe AttributeValue
imdsSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
kernelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
lastLaunchedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LaunchPermission]
launchPermissions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ProductCode]
productCodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
ramdiskId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
sriovNetSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
tpmSupport
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeValue
uefiData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus