{-# 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.InstanceMetadataOptionsResponse
-- 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.InstanceMetadataOptionsResponse 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.HttpTokensState
import Amazonka.EC2.Types.InstanceMetadataEndpointState
import Amazonka.EC2.Types.InstanceMetadataOptionsState
import Amazonka.EC2.Types.InstanceMetadataProtocolState
import Amazonka.EC2.Types.InstanceMetadataTagsState
import qualified Amazonka.Prelude as Prelude

-- | The metadata options for the instance.
--
-- /See:/ 'newInstanceMetadataOptionsResponse' smart constructor.
data InstanceMetadataOptionsResponse = InstanceMetadataOptionsResponse'
  { -- | Indicates whether the HTTP metadata endpoint on your instances is
    -- enabled or disabled.
    --
    -- If the value is @disabled@, you cannot access your instance metadata.
    InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataEndpointState
httpEndpoint :: Prelude.Maybe InstanceMetadataEndpointState,
    -- | Indicates whether the IPv6 endpoint for the instance metadata service is
    -- enabled or disabled.
    InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataProtocolState
httpProtocolIpv6 :: Prelude.Maybe InstanceMetadataProtocolState,
    -- | The desired HTTP PUT response hop limit for instance metadata requests.
    -- The larger the number, the further instance metadata requests can
    -- travel.
    --
    -- Default: 1
    --
    -- Possible values: Integers from 1 to 64
    InstanceMetadataOptionsResponse -> Maybe Int
httpPutResponseHopLimit :: Prelude.Maybe Prelude.Int,
    -- | The state of token usage for your instance metadata requests.
    --
    -- If the state is @optional@, you can choose to retrieve instance metadata
    -- with or without a session token on your request. If you retrieve the IAM
    -- role credentials without a token, the version 1.0 role credentials are
    -- returned. If you retrieve the IAM role credentials using a valid session
    -- token, the version 2.0 role credentials are returned.
    --
    -- If the state is @required@, you must send a session token with any
    -- instance metadata retrieval requests. In this state, retrieving the IAM
    -- role credentials always returns the version 2.0 credentials; the version
    -- 1.0 credentials are not available.
    --
    -- Default: @optional@
    InstanceMetadataOptionsResponse -> Maybe HttpTokensState
httpTokens :: Prelude.Maybe HttpTokensState,
    -- | Indicates whether access to instance tags from the instance metadata is
    -- enabled or disabled. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html#work-with-tags-in-IMDS Work with instance tags using the instance metadata>.
    InstanceMetadataOptionsResponse -> Maybe InstanceMetadataTagsState
instanceMetadataTags :: Prelude.Maybe InstanceMetadataTagsState,
    -- | The state of the metadata option changes.
    --
    -- @pending@ - The metadata options are being updated and the instance is
    -- not ready to process metadata traffic with the new selection.
    --
    -- @applied@ - The metadata options have been successfully applied on the
    -- instance.
    InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataOptionsState
state :: Prelude.Maybe InstanceMetadataOptionsState
  }
  deriving (InstanceMetadataOptionsResponse
-> InstanceMetadataOptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceMetadataOptionsResponse
-> InstanceMetadataOptionsResponse -> Bool
$c/= :: InstanceMetadataOptionsResponse
-> InstanceMetadataOptionsResponse -> Bool
== :: InstanceMetadataOptionsResponse
-> InstanceMetadataOptionsResponse -> Bool
$c== :: InstanceMetadataOptionsResponse
-> InstanceMetadataOptionsResponse -> Bool
Prelude.Eq, ReadPrec [InstanceMetadataOptionsResponse]
ReadPrec InstanceMetadataOptionsResponse
Int -> ReadS InstanceMetadataOptionsResponse
ReadS [InstanceMetadataOptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstanceMetadataOptionsResponse]
$creadListPrec :: ReadPrec [InstanceMetadataOptionsResponse]
readPrec :: ReadPrec InstanceMetadataOptionsResponse
$creadPrec :: ReadPrec InstanceMetadataOptionsResponse
readList :: ReadS [InstanceMetadataOptionsResponse]
$creadList :: ReadS [InstanceMetadataOptionsResponse]
readsPrec :: Int -> ReadS InstanceMetadataOptionsResponse
$creadsPrec :: Int -> ReadS InstanceMetadataOptionsResponse
Prelude.Read, Int -> InstanceMetadataOptionsResponse -> ShowS
[InstanceMetadataOptionsResponse] -> ShowS
InstanceMetadataOptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceMetadataOptionsResponse] -> ShowS
$cshowList :: [InstanceMetadataOptionsResponse] -> ShowS
show :: InstanceMetadataOptionsResponse -> String
$cshow :: InstanceMetadataOptionsResponse -> String
showsPrec :: Int -> InstanceMetadataOptionsResponse -> ShowS
$cshowsPrec :: Int -> InstanceMetadataOptionsResponse -> ShowS
Prelude.Show, forall x.
Rep InstanceMetadataOptionsResponse x
-> InstanceMetadataOptionsResponse
forall x.
InstanceMetadataOptionsResponse
-> Rep InstanceMetadataOptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InstanceMetadataOptionsResponse x
-> InstanceMetadataOptionsResponse
$cfrom :: forall x.
InstanceMetadataOptionsResponse
-> Rep InstanceMetadataOptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'InstanceMetadataOptionsResponse' 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:
--
-- 'httpEndpoint', 'instanceMetadataOptionsResponse_httpEndpoint' - Indicates whether the HTTP metadata endpoint on your instances is
-- enabled or disabled.
--
-- If the value is @disabled@, you cannot access your instance metadata.
--
-- 'httpProtocolIpv6', 'instanceMetadataOptionsResponse_httpProtocolIpv6' - Indicates whether the IPv6 endpoint for the instance metadata service is
-- enabled or disabled.
--
-- 'httpPutResponseHopLimit', 'instanceMetadataOptionsResponse_httpPutResponseHopLimit' - The desired HTTP PUT response hop limit for instance metadata requests.
-- The larger the number, the further instance metadata requests can
-- travel.
--
-- Default: 1
--
-- Possible values: Integers from 1 to 64
--
-- 'httpTokens', 'instanceMetadataOptionsResponse_httpTokens' - The state of token usage for your instance metadata requests.
--
-- If the state is @optional@, you can choose to retrieve instance metadata
-- with or without a session token on your request. If you retrieve the IAM
-- role credentials without a token, the version 1.0 role credentials are
-- returned. If you retrieve the IAM role credentials using a valid session
-- token, the version 2.0 role credentials are returned.
--
-- If the state is @required@, you must send a session token with any
-- instance metadata retrieval requests. In this state, retrieving the IAM
-- role credentials always returns the version 2.0 credentials; the version
-- 1.0 credentials are not available.
--
-- Default: @optional@
--
-- 'instanceMetadataTags', 'instanceMetadataOptionsResponse_instanceMetadataTags' - Indicates whether access to instance tags from the instance metadata is
-- enabled or disabled. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html#work-with-tags-in-IMDS Work with instance tags using the instance metadata>.
--
-- 'state', 'instanceMetadataOptionsResponse_state' - The state of the metadata option changes.
--
-- @pending@ - The metadata options are being updated and the instance is
-- not ready to process metadata traffic with the new selection.
--
-- @applied@ - The metadata options have been successfully applied on the
-- instance.
newInstanceMetadataOptionsResponse ::
  InstanceMetadataOptionsResponse
newInstanceMetadataOptionsResponse :: InstanceMetadataOptionsResponse
newInstanceMetadataOptionsResponse =
  InstanceMetadataOptionsResponse'
    { $sel:httpEndpoint:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataEndpointState
httpEndpoint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpProtocolIpv6:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataProtocolState
httpProtocolIpv6 = forall a. Maybe a
Prelude.Nothing,
      $sel:httpPutResponseHopLimit:InstanceMetadataOptionsResponse' :: Maybe Int
httpPutResponseHopLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:httpTokens:InstanceMetadataOptionsResponse' :: Maybe HttpTokensState
httpTokens = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceMetadataTags:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataTagsState
instanceMetadataTags = forall a. Maybe a
Prelude.Nothing,
      $sel:state:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataOptionsState
state = forall a. Maybe a
Prelude.Nothing
    }

-- | Indicates whether the HTTP metadata endpoint on your instances is
-- enabled or disabled.
--
-- If the value is @disabled@, you cannot access your instance metadata.
instanceMetadataOptionsResponse_httpEndpoint :: Lens.Lens' InstanceMetadataOptionsResponse (Prelude.Maybe InstanceMetadataEndpointState)
instanceMetadataOptionsResponse_httpEndpoint :: Lens'
  InstanceMetadataOptionsResponse
  (Maybe InstanceMetadataEndpointState)
instanceMetadataOptionsResponse_httpEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptionsResponse' {Maybe InstanceMetadataEndpointState
httpEndpoint :: Maybe InstanceMetadataEndpointState
$sel:httpEndpoint:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataEndpointState
httpEndpoint} -> Maybe InstanceMetadataEndpointState
httpEndpoint) (\s :: InstanceMetadataOptionsResponse
s@InstanceMetadataOptionsResponse' {} Maybe InstanceMetadataEndpointState
a -> InstanceMetadataOptionsResponse
s {$sel:httpEndpoint:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataEndpointState
httpEndpoint = Maybe InstanceMetadataEndpointState
a} :: InstanceMetadataOptionsResponse)

-- | Indicates whether the IPv6 endpoint for the instance metadata service is
-- enabled or disabled.
instanceMetadataOptionsResponse_httpProtocolIpv6 :: Lens.Lens' InstanceMetadataOptionsResponse (Prelude.Maybe InstanceMetadataProtocolState)
instanceMetadataOptionsResponse_httpProtocolIpv6 :: Lens'
  InstanceMetadataOptionsResponse
  (Maybe InstanceMetadataProtocolState)
instanceMetadataOptionsResponse_httpProtocolIpv6 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptionsResponse' {Maybe InstanceMetadataProtocolState
httpProtocolIpv6 :: Maybe InstanceMetadataProtocolState
$sel:httpProtocolIpv6:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataProtocolState
httpProtocolIpv6} -> Maybe InstanceMetadataProtocolState
httpProtocolIpv6) (\s :: InstanceMetadataOptionsResponse
s@InstanceMetadataOptionsResponse' {} Maybe InstanceMetadataProtocolState
a -> InstanceMetadataOptionsResponse
s {$sel:httpProtocolIpv6:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataProtocolState
httpProtocolIpv6 = Maybe InstanceMetadataProtocolState
a} :: InstanceMetadataOptionsResponse)

-- | The desired HTTP PUT response hop limit for instance metadata requests.
-- The larger the number, the further instance metadata requests can
-- travel.
--
-- Default: 1
--
-- Possible values: Integers from 1 to 64
instanceMetadataOptionsResponse_httpPutResponseHopLimit :: Lens.Lens' InstanceMetadataOptionsResponse (Prelude.Maybe Prelude.Int)
instanceMetadataOptionsResponse_httpPutResponseHopLimit :: Lens' InstanceMetadataOptionsResponse (Maybe Int)
instanceMetadataOptionsResponse_httpPutResponseHopLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptionsResponse' {Maybe Int
httpPutResponseHopLimit :: Maybe Int
$sel:httpPutResponseHopLimit:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe Int
httpPutResponseHopLimit} -> Maybe Int
httpPutResponseHopLimit) (\s :: InstanceMetadataOptionsResponse
s@InstanceMetadataOptionsResponse' {} Maybe Int
a -> InstanceMetadataOptionsResponse
s {$sel:httpPutResponseHopLimit:InstanceMetadataOptionsResponse' :: Maybe Int
httpPutResponseHopLimit = Maybe Int
a} :: InstanceMetadataOptionsResponse)

-- | The state of token usage for your instance metadata requests.
--
-- If the state is @optional@, you can choose to retrieve instance metadata
-- with or without a session token on your request. If you retrieve the IAM
-- role credentials without a token, the version 1.0 role credentials are
-- returned. If you retrieve the IAM role credentials using a valid session
-- token, the version 2.0 role credentials are returned.
--
-- If the state is @required@, you must send a session token with any
-- instance metadata retrieval requests. In this state, retrieving the IAM
-- role credentials always returns the version 2.0 credentials; the version
-- 1.0 credentials are not available.
--
-- Default: @optional@
instanceMetadataOptionsResponse_httpTokens :: Lens.Lens' InstanceMetadataOptionsResponse (Prelude.Maybe HttpTokensState)
instanceMetadataOptionsResponse_httpTokens :: Lens' InstanceMetadataOptionsResponse (Maybe HttpTokensState)
instanceMetadataOptionsResponse_httpTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptionsResponse' {Maybe HttpTokensState
httpTokens :: Maybe HttpTokensState
$sel:httpTokens:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe HttpTokensState
httpTokens} -> Maybe HttpTokensState
httpTokens) (\s :: InstanceMetadataOptionsResponse
s@InstanceMetadataOptionsResponse' {} Maybe HttpTokensState
a -> InstanceMetadataOptionsResponse
s {$sel:httpTokens:InstanceMetadataOptionsResponse' :: Maybe HttpTokensState
httpTokens = Maybe HttpTokensState
a} :: InstanceMetadataOptionsResponse)

-- | Indicates whether access to instance tags from the instance metadata is
-- enabled or disabled. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html#work-with-tags-in-IMDS Work with instance tags using the instance metadata>.
instanceMetadataOptionsResponse_instanceMetadataTags :: Lens.Lens' InstanceMetadataOptionsResponse (Prelude.Maybe InstanceMetadataTagsState)
instanceMetadataOptionsResponse_instanceMetadataTags :: Lens'
  InstanceMetadataOptionsResponse (Maybe InstanceMetadataTagsState)
instanceMetadataOptionsResponse_instanceMetadataTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptionsResponse' {Maybe InstanceMetadataTagsState
instanceMetadataTags :: Maybe InstanceMetadataTagsState
$sel:instanceMetadataTags:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe InstanceMetadataTagsState
instanceMetadataTags} -> Maybe InstanceMetadataTagsState
instanceMetadataTags) (\s :: InstanceMetadataOptionsResponse
s@InstanceMetadataOptionsResponse' {} Maybe InstanceMetadataTagsState
a -> InstanceMetadataOptionsResponse
s {$sel:instanceMetadataTags:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataTagsState
instanceMetadataTags = Maybe InstanceMetadataTagsState
a} :: InstanceMetadataOptionsResponse)

-- | The state of the metadata option changes.
--
-- @pending@ - The metadata options are being updated and the instance is
-- not ready to process metadata traffic with the new selection.
--
-- @applied@ - The metadata options have been successfully applied on the
-- instance.
instanceMetadataOptionsResponse_state :: Lens.Lens' InstanceMetadataOptionsResponse (Prelude.Maybe InstanceMetadataOptionsState)
instanceMetadataOptionsResponse_state :: Lens'
  InstanceMetadataOptionsResponse
  (Maybe InstanceMetadataOptionsState)
instanceMetadataOptionsResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptionsResponse' {Maybe InstanceMetadataOptionsState
state :: Maybe InstanceMetadataOptionsState
$sel:state:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataOptionsState
state} -> Maybe InstanceMetadataOptionsState
state) (\s :: InstanceMetadataOptionsResponse
s@InstanceMetadataOptionsResponse' {} Maybe InstanceMetadataOptionsState
a -> InstanceMetadataOptionsResponse
s {$sel:state:InstanceMetadataOptionsResponse' :: Maybe InstanceMetadataOptionsState
state = Maybe InstanceMetadataOptionsState
a} :: InstanceMetadataOptionsResponse)

instance Data.FromXML InstanceMetadataOptionsResponse where
  parseXML :: [Node] -> Either String InstanceMetadataOptionsResponse
parseXML [Node]
x =
    Maybe InstanceMetadataEndpointState
-> Maybe InstanceMetadataProtocolState
-> Maybe Int
-> Maybe HttpTokensState
-> Maybe InstanceMetadataTagsState
-> Maybe InstanceMetadataOptionsState
-> InstanceMetadataOptionsResponse
InstanceMetadataOptionsResponse'
      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
"httpEndpoint")
      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
"httpProtocolIpv6")
      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
"httpPutResponseHopLimit")
      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
"httpTokens")
      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
"instanceMetadataTags")
      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
"state")

instance
  Prelude.Hashable
    InstanceMetadataOptionsResponse
  where
  hashWithSalt :: Int -> InstanceMetadataOptionsResponse -> Int
hashWithSalt
    Int
_salt
    InstanceMetadataOptionsResponse' {Maybe Int
Maybe HttpTokensState
Maybe InstanceMetadataEndpointState
Maybe InstanceMetadataOptionsState
Maybe InstanceMetadataProtocolState
Maybe InstanceMetadataTagsState
state :: Maybe InstanceMetadataOptionsState
instanceMetadataTags :: Maybe InstanceMetadataTagsState
httpTokens :: Maybe HttpTokensState
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe InstanceMetadataProtocolState
httpEndpoint :: Maybe InstanceMetadataEndpointState
$sel:state:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataOptionsState
$sel:instanceMetadataTags:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe InstanceMetadataTagsState
$sel:httpTokens:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe HttpTokensState
$sel:httpPutResponseHopLimit:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe Int
$sel:httpProtocolIpv6:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataProtocolState
$sel:httpEndpoint:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataEndpointState
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceMetadataEndpointState
httpEndpoint
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceMetadataProtocolState
httpProtocolIpv6
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
httpPutResponseHopLimit
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpTokensState
httpTokens
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceMetadataTagsState
instanceMetadataTags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceMetadataOptionsState
state

instance
  Prelude.NFData
    InstanceMetadataOptionsResponse
  where
  rnf :: InstanceMetadataOptionsResponse -> ()
rnf InstanceMetadataOptionsResponse' {Maybe Int
Maybe HttpTokensState
Maybe InstanceMetadataEndpointState
Maybe InstanceMetadataOptionsState
Maybe InstanceMetadataProtocolState
Maybe InstanceMetadataTagsState
state :: Maybe InstanceMetadataOptionsState
instanceMetadataTags :: Maybe InstanceMetadataTagsState
httpTokens :: Maybe HttpTokensState
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe InstanceMetadataProtocolState
httpEndpoint :: Maybe InstanceMetadataEndpointState
$sel:state:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataOptionsState
$sel:instanceMetadataTags:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe InstanceMetadataTagsState
$sel:httpTokens:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe HttpTokensState
$sel:httpPutResponseHopLimit:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse -> Maybe Int
$sel:httpProtocolIpv6:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataProtocolState
$sel:httpEndpoint:InstanceMetadataOptionsResponse' :: InstanceMetadataOptionsResponse
-> Maybe InstanceMetadataEndpointState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceMetadataEndpointState
httpEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceMetadataProtocolState
httpProtocolIpv6
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
httpPutResponseHopLimit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpTokensState
httpTokens
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceMetadataTagsState
instanceMetadataTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceMetadataOptionsState
state