{-# 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.ModifyInstanceMetadataOptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modify the instance metadata parameters on a running or stopped
-- instance. When you modify the parameters on a stopped instance, they are
-- applied when the instance is started. When you modify the parameters on
-- a running instance, the API responds with a state of “pending”. After
-- the parameter modifications are successfully applied to the instance,
-- the state of the modifications changes from “pending” to “applied” in
-- subsequent describe-instances API calls. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-metadata.html Instance metadata and user data>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.ModifyInstanceMetadataOptions
  ( -- * Creating a Request
    ModifyInstanceMetadataOptions (..),
    newModifyInstanceMetadataOptions,

    -- * Request Lenses
    modifyInstanceMetadataOptions_dryRun,
    modifyInstanceMetadataOptions_httpEndpoint,
    modifyInstanceMetadataOptions_httpProtocolIpv6,
    modifyInstanceMetadataOptions_httpPutResponseHopLimit,
    modifyInstanceMetadataOptions_httpTokens,
    modifyInstanceMetadataOptions_instanceMetadataTags,
    modifyInstanceMetadataOptions_instanceId,

    -- * Destructuring the Response
    ModifyInstanceMetadataOptionsResponse (..),
    newModifyInstanceMetadataOptionsResponse,

    -- * Response Lenses
    modifyInstanceMetadataOptionsResponse_instanceId,
    modifyInstanceMetadataOptionsResponse_instanceMetadataOptions,
    modifyInstanceMetadataOptionsResponse_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:/ 'newModifyInstanceMetadataOptions' smart constructor.
data ModifyInstanceMetadataOptions = ModifyInstanceMetadataOptions'
  { -- | 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@.
    ModifyInstanceMetadataOptions -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Enables or disables the HTTP metadata endpoint on your instances. If
    -- this parameter is not specified, the existing state is maintained.
    --
    -- If you specify a value of @disabled@, you cannot access your instance
    -- metadata.
    ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataEndpointState
httpEndpoint :: Prelude.Maybe InstanceMetadataEndpointState,
    -- | Enables or disables the IPv6 endpoint for the instance metadata service.
    -- This setting applies only if you have enabled the HTTP metadata
    -- endpoint.
    ModifyInstanceMetadataOptions
-> 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. If no parameter is specified, the existing state is maintained.
    --
    -- Possible values: Integers from 1 to 64
    ModifyInstanceMetadataOptions -> Maybe Int
httpPutResponseHopLimit :: Prelude.Maybe Prelude.Int,
    -- | The state of token usage for your instance metadata requests. If the
    -- parameter is not specified in the request, the default state is
    -- @optional@.
    --
    -- 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.
    ModifyInstanceMetadataOptions -> Maybe HttpTokensState
httpTokens :: Prelude.Maybe HttpTokensState,
    -- | Set to @enabled@ to allow access to instance tags from the instance
    -- metadata. Set to @disabled@ to turn off access to instance tags from the
    -- instance metadata. 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>.
    --
    -- Default: @disabled@
    ModifyInstanceMetadataOptions -> Maybe InstanceMetadataTagsState
instanceMetadataTags :: Prelude.Maybe InstanceMetadataTagsState,
    -- | The ID of the instance.
    ModifyInstanceMetadataOptions -> Text
instanceId :: Prelude.Text
  }
  deriving (ModifyInstanceMetadataOptions
-> ModifyInstanceMetadataOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyInstanceMetadataOptions
-> ModifyInstanceMetadataOptions -> Bool
$c/= :: ModifyInstanceMetadataOptions
-> ModifyInstanceMetadataOptions -> Bool
== :: ModifyInstanceMetadataOptions
-> ModifyInstanceMetadataOptions -> Bool
$c== :: ModifyInstanceMetadataOptions
-> ModifyInstanceMetadataOptions -> Bool
Prelude.Eq, ReadPrec [ModifyInstanceMetadataOptions]
ReadPrec ModifyInstanceMetadataOptions
Int -> ReadS ModifyInstanceMetadataOptions
ReadS [ModifyInstanceMetadataOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyInstanceMetadataOptions]
$creadListPrec :: ReadPrec [ModifyInstanceMetadataOptions]
readPrec :: ReadPrec ModifyInstanceMetadataOptions
$creadPrec :: ReadPrec ModifyInstanceMetadataOptions
readList :: ReadS [ModifyInstanceMetadataOptions]
$creadList :: ReadS [ModifyInstanceMetadataOptions]
readsPrec :: Int -> ReadS ModifyInstanceMetadataOptions
$creadsPrec :: Int -> ReadS ModifyInstanceMetadataOptions
Prelude.Read, Int -> ModifyInstanceMetadataOptions -> ShowS
[ModifyInstanceMetadataOptions] -> ShowS
ModifyInstanceMetadataOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyInstanceMetadataOptions] -> ShowS
$cshowList :: [ModifyInstanceMetadataOptions] -> ShowS
show :: ModifyInstanceMetadataOptions -> String
$cshow :: ModifyInstanceMetadataOptions -> String
showsPrec :: Int -> ModifyInstanceMetadataOptions -> ShowS
$cshowsPrec :: Int -> ModifyInstanceMetadataOptions -> ShowS
Prelude.Show, forall x.
Rep ModifyInstanceMetadataOptions x
-> ModifyInstanceMetadataOptions
forall x.
ModifyInstanceMetadataOptions
-> Rep ModifyInstanceMetadataOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyInstanceMetadataOptions x
-> ModifyInstanceMetadataOptions
$cfrom :: forall x.
ModifyInstanceMetadataOptions
-> Rep ModifyInstanceMetadataOptions x
Prelude.Generic)

-- |
-- Create a value of 'ModifyInstanceMetadataOptions' 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', 'modifyInstanceMetadataOptions_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@.
--
-- 'httpEndpoint', 'modifyInstanceMetadataOptions_httpEndpoint' - Enables or disables the HTTP metadata endpoint on your instances. If
-- this parameter is not specified, the existing state is maintained.
--
-- If you specify a value of @disabled@, you cannot access your instance
-- metadata.
--
-- 'httpProtocolIpv6', 'modifyInstanceMetadataOptions_httpProtocolIpv6' - Enables or disables the IPv6 endpoint for the instance metadata service.
-- This setting applies only if you have enabled the HTTP metadata
-- endpoint.
--
-- 'httpPutResponseHopLimit', 'modifyInstanceMetadataOptions_httpPutResponseHopLimit' - The desired HTTP PUT response hop limit for instance metadata requests.
-- The larger the number, the further instance metadata requests can
-- travel. If no parameter is specified, the existing state is maintained.
--
-- Possible values: Integers from 1 to 64
--
-- 'httpTokens', 'modifyInstanceMetadataOptions_httpTokens' - The state of token usage for your instance metadata requests. If the
-- parameter is not specified in the request, the default state is
-- @optional@.
--
-- 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.
--
-- 'instanceMetadataTags', 'modifyInstanceMetadataOptions_instanceMetadataTags' - Set to @enabled@ to allow access to instance tags from the instance
-- metadata. Set to @disabled@ to turn off access to instance tags from the
-- instance metadata. 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>.
--
-- Default: @disabled@
--
-- 'instanceId', 'modifyInstanceMetadataOptions_instanceId' - The ID of the instance.
newModifyInstanceMetadataOptions ::
  -- | 'instanceId'
  Prelude.Text ->
  ModifyInstanceMetadataOptions
newModifyInstanceMetadataOptions :: Text -> ModifyInstanceMetadataOptions
newModifyInstanceMetadataOptions Text
pInstanceId_ =
  ModifyInstanceMetadataOptions'
    { $sel:dryRun:ModifyInstanceMetadataOptions' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpEndpoint:ModifyInstanceMetadataOptions' :: Maybe InstanceMetadataEndpointState
httpEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:httpProtocolIpv6:ModifyInstanceMetadataOptions' :: Maybe InstanceMetadataProtocolState
httpProtocolIpv6 = forall a. Maybe a
Prelude.Nothing,
      $sel:httpPutResponseHopLimit:ModifyInstanceMetadataOptions' :: Maybe Int
httpPutResponseHopLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:httpTokens:ModifyInstanceMetadataOptions' :: Maybe HttpTokensState
httpTokens = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceMetadataTags:ModifyInstanceMetadataOptions' :: Maybe InstanceMetadataTagsState
instanceMetadataTags = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:ModifyInstanceMetadataOptions' :: Text
instanceId = Text
pInstanceId_
    }

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

-- | Enables or disables the HTTP metadata endpoint on your instances. If
-- this parameter is not specified, the existing state is maintained.
--
-- If you specify a value of @disabled@, you cannot access your instance
-- metadata.
modifyInstanceMetadataOptions_httpEndpoint :: Lens.Lens' ModifyInstanceMetadataOptions (Prelude.Maybe InstanceMetadataEndpointState)
modifyInstanceMetadataOptions_httpEndpoint :: Lens'
  ModifyInstanceMetadataOptions (Maybe InstanceMetadataEndpointState)
modifyInstanceMetadataOptions_httpEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptions' {Maybe InstanceMetadataEndpointState
httpEndpoint :: Maybe InstanceMetadataEndpointState
$sel:httpEndpoint:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataEndpointState
httpEndpoint} -> Maybe InstanceMetadataEndpointState
httpEndpoint) (\s :: ModifyInstanceMetadataOptions
s@ModifyInstanceMetadataOptions' {} Maybe InstanceMetadataEndpointState
a -> ModifyInstanceMetadataOptions
s {$sel:httpEndpoint:ModifyInstanceMetadataOptions' :: Maybe InstanceMetadataEndpointState
httpEndpoint = Maybe InstanceMetadataEndpointState
a} :: ModifyInstanceMetadataOptions)

-- | Enables or disables the IPv6 endpoint for the instance metadata service.
-- This setting applies only if you have enabled the HTTP metadata
-- endpoint.
modifyInstanceMetadataOptions_httpProtocolIpv6 :: Lens.Lens' ModifyInstanceMetadataOptions (Prelude.Maybe InstanceMetadataProtocolState)
modifyInstanceMetadataOptions_httpProtocolIpv6 :: Lens'
  ModifyInstanceMetadataOptions (Maybe InstanceMetadataProtocolState)
modifyInstanceMetadataOptions_httpProtocolIpv6 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptions' {Maybe InstanceMetadataProtocolState
httpProtocolIpv6 :: Maybe InstanceMetadataProtocolState
$sel:httpProtocolIpv6:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataProtocolState
httpProtocolIpv6} -> Maybe InstanceMetadataProtocolState
httpProtocolIpv6) (\s :: ModifyInstanceMetadataOptions
s@ModifyInstanceMetadataOptions' {} Maybe InstanceMetadataProtocolState
a -> ModifyInstanceMetadataOptions
s {$sel:httpProtocolIpv6:ModifyInstanceMetadataOptions' :: Maybe InstanceMetadataProtocolState
httpProtocolIpv6 = Maybe InstanceMetadataProtocolState
a} :: ModifyInstanceMetadataOptions)

-- | The desired HTTP PUT response hop limit for instance metadata requests.
-- The larger the number, the further instance metadata requests can
-- travel. If no parameter is specified, the existing state is maintained.
--
-- Possible values: Integers from 1 to 64
modifyInstanceMetadataOptions_httpPutResponseHopLimit :: Lens.Lens' ModifyInstanceMetadataOptions (Prelude.Maybe Prelude.Int)
modifyInstanceMetadataOptions_httpPutResponseHopLimit :: Lens' ModifyInstanceMetadataOptions (Maybe Int)
modifyInstanceMetadataOptions_httpPutResponseHopLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptions' {Maybe Int
httpPutResponseHopLimit :: Maybe Int
$sel:httpPutResponseHopLimit:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe Int
httpPutResponseHopLimit} -> Maybe Int
httpPutResponseHopLimit) (\s :: ModifyInstanceMetadataOptions
s@ModifyInstanceMetadataOptions' {} Maybe Int
a -> ModifyInstanceMetadataOptions
s {$sel:httpPutResponseHopLimit:ModifyInstanceMetadataOptions' :: Maybe Int
httpPutResponseHopLimit = Maybe Int
a} :: ModifyInstanceMetadataOptions)

-- | The state of token usage for your instance metadata requests. If the
-- parameter is not specified in the request, the default state is
-- @optional@.
--
-- 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.
modifyInstanceMetadataOptions_httpTokens :: Lens.Lens' ModifyInstanceMetadataOptions (Prelude.Maybe HttpTokensState)
modifyInstanceMetadataOptions_httpTokens :: Lens' ModifyInstanceMetadataOptions (Maybe HttpTokensState)
modifyInstanceMetadataOptions_httpTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptions' {Maybe HttpTokensState
httpTokens :: Maybe HttpTokensState
$sel:httpTokens:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe HttpTokensState
httpTokens} -> Maybe HttpTokensState
httpTokens) (\s :: ModifyInstanceMetadataOptions
s@ModifyInstanceMetadataOptions' {} Maybe HttpTokensState
a -> ModifyInstanceMetadataOptions
s {$sel:httpTokens:ModifyInstanceMetadataOptions' :: Maybe HttpTokensState
httpTokens = Maybe HttpTokensState
a} :: ModifyInstanceMetadataOptions)

-- | Set to @enabled@ to allow access to instance tags from the instance
-- metadata. Set to @disabled@ to turn off access to instance tags from the
-- instance metadata. 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>.
--
-- Default: @disabled@
modifyInstanceMetadataOptions_instanceMetadataTags :: Lens.Lens' ModifyInstanceMetadataOptions (Prelude.Maybe InstanceMetadataTagsState)
modifyInstanceMetadataOptions_instanceMetadataTags :: Lens'
  ModifyInstanceMetadataOptions (Maybe InstanceMetadataTagsState)
modifyInstanceMetadataOptions_instanceMetadataTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptions' {Maybe InstanceMetadataTagsState
instanceMetadataTags :: Maybe InstanceMetadataTagsState
$sel:instanceMetadataTags:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe InstanceMetadataTagsState
instanceMetadataTags} -> Maybe InstanceMetadataTagsState
instanceMetadataTags) (\s :: ModifyInstanceMetadataOptions
s@ModifyInstanceMetadataOptions' {} Maybe InstanceMetadataTagsState
a -> ModifyInstanceMetadataOptions
s {$sel:instanceMetadataTags:ModifyInstanceMetadataOptions' :: Maybe InstanceMetadataTagsState
instanceMetadataTags = Maybe InstanceMetadataTagsState
a} :: ModifyInstanceMetadataOptions)

-- | The ID of the instance.
modifyInstanceMetadataOptions_instanceId :: Lens.Lens' ModifyInstanceMetadataOptions Prelude.Text
modifyInstanceMetadataOptions_instanceId :: Lens' ModifyInstanceMetadataOptions Text
modifyInstanceMetadataOptions_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptions' {Text
instanceId :: Text
$sel:instanceId:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Text
instanceId} -> Text
instanceId) (\s :: ModifyInstanceMetadataOptions
s@ModifyInstanceMetadataOptions' {} Text
a -> ModifyInstanceMetadataOptions
s {$sel:instanceId:ModifyInstanceMetadataOptions' :: Text
instanceId = Text
a} :: ModifyInstanceMetadataOptions)

instance
  Core.AWSRequest
    ModifyInstanceMetadataOptions
  where
  type
    AWSResponse ModifyInstanceMetadataOptions =
      ModifyInstanceMetadataOptionsResponse
  request :: (Service -> Service)
-> ModifyInstanceMetadataOptions
-> Request ModifyInstanceMetadataOptions
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 ModifyInstanceMetadataOptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyInstanceMetadataOptions)))
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
-> Maybe InstanceMetadataOptionsResponse
-> Int
-> ModifyInstanceMetadataOptionsResponse
ModifyInstanceMetadataOptionsResponse'
            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
"instanceId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"instanceMetadataOptions")
            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
    ModifyInstanceMetadataOptions
  where
  hashWithSalt :: Int -> ModifyInstanceMetadataOptions -> Int
hashWithSalt Int
_salt ModifyInstanceMetadataOptions' {Maybe Bool
Maybe Int
Maybe HttpTokensState
Maybe InstanceMetadataEndpointState
Maybe InstanceMetadataProtocolState
Maybe InstanceMetadataTagsState
Text
instanceId :: Text
instanceMetadataTags :: Maybe InstanceMetadataTagsState
httpTokens :: Maybe HttpTokensState
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe InstanceMetadataProtocolState
httpEndpoint :: Maybe InstanceMetadataEndpointState
dryRun :: Maybe Bool
$sel:instanceId:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Text
$sel:instanceMetadataTags:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe InstanceMetadataTagsState
$sel:httpTokens:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe HttpTokensState
$sel:httpPutResponseHopLimit:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataProtocolState
$sel:httpEndpoint:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataEndpointState
$sel:dryRun:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> 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 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` Text
instanceId

instance Prelude.NFData ModifyInstanceMetadataOptions where
  rnf :: ModifyInstanceMetadataOptions -> ()
rnf ModifyInstanceMetadataOptions' {Maybe Bool
Maybe Int
Maybe HttpTokensState
Maybe InstanceMetadataEndpointState
Maybe InstanceMetadataProtocolState
Maybe InstanceMetadataTagsState
Text
instanceId :: Text
instanceMetadataTags :: Maybe InstanceMetadataTagsState
httpTokens :: Maybe HttpTokensState
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe InstanceMetadataProtocolState
httpEndpoint :: Maybe InstanceMetadataEndpointState
dryRun :: Maybe Bool
$sel:instanceId:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Text
$sel:instanceMetadataTags:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe InstanceMetadataTagsState
$sel:httpTokens:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe HttpTokensState
$sel:httpPutResponseHopLimit:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataProtocolState
$sel:httpEndpoint:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataEndpointState
$sel:dryRun:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> 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 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 Text
instanceId

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

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

instance Data.ToQuery ModifyInstanceMetadataOptions where
  toQuery :: ModifyInstanceMetadataOptions -> QueryString
toQuery ModifyInstanceMetadataOptions' {Maybe Bool
Maybe Int
Maybe HttpTokensState
Maybe InstanceMetadataEndpointState
Maybe InstanceMetadataProtocolState
Maybe InstanceMetadataTagsState
Text
instanceId :: Text
instanceMetadataTags :: Maybe InstanceMetadataTagsState
httpTokens :: Maybe HttpTokensState
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe InstanceMetadataProtocolState
httpEndpoint :: Maybe InstanceMetadataEndpointState
dryRun :: Maybe Bool
$sel:instanceId:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Text
$sel:instanceMetadataTags:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe InstanceMetadataTagsState
$sel:httpTokens:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe HttpTokensState
$sel:httpPutResponseHopLimit:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataProtocolState
$sel:httpEndpoint:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions
-> Maybe InstanceMetadataEndpointState
$sel:dryRun:ModifyInstanceMetadataOptions' :: ModifyInstanceMetadataOptions -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ModifyInstanceMetadataOptions" ::
                      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
"HttpEndpoint" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceMetadataEndpointState
httpEndpoint,
        ByteString
"HttpProtocolIpv6" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceMetadataProtocolState
httpProtocolIpv6,
        ByteString
"HttpPutResponseHopLimit"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
httpPutResponseHopLimit,
        ByteString
"HttpTokens" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe HttpTokensState
httpTokens,
        ByteString
"InstanceMetadataTags" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceMetadataTagsState
instanceMetadataTags,
        ByteString
"InstanceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
instanceId
      ]

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

-- |
-- Create a value of 'ModifyInstanceMetadataOptionsResponse' 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:
--
-- 'instanceId', 'modifyInstanceMetadataOptionsResponse_instanceId' - The ID of the instance.
--
-- 'instanceMetadataOptions', 'modifyInstanceMetadataOptionsResponse_instanceMetadataOptions' - The metadata options for the instance.
--
-- 'httpStatus', 'modifyInstanceMetadataOptionsResponse_httpStatus' - The response's http status code.
newModifyInstanceMetadataOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyInstanceMetadataOptionsResponse
newModifyInstanceMetadataOptionsResponse :: Int -> ModifyInstanceMetadataOptionsResponse
newModifyInstanceMetadataOptionsResponse Int
pHttpStatus_ =
  ModifyInstanceMetadataOptionsResponse'
    { $sel:instanceId:ModifyInstanceMetadataOptionsResponse' :: Maybe Text
instanceId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:instanceMetadataOptions:ModifyInstanceMetadataOptionsResponse' :: Maybe InstanceMetadataOptionsResponse
instanceMetadataOptions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyInstanceMetadataOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the instance.
modifyInstanceMetadataOptionsResponse_instanceId :: Lens.Lens' ModifyInstanceMetadataOptionsResponse (Prelude.Maybe Prelude.Text)
modifyInstanceMetadataOptionsResponse_instanceId :: Lens' ModifyInstanceMetadataOptionsResponse (Maybe Text)
modifyInstanceMetadataOptionsResponse_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptionsResponse' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:ModifyInstanceMetadataOptionsResponse' :: ModifyInstanceMetadataOptionsResponse -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: ModifyInstanceMetadataOptionsResponse
s@ModifyInstanceMetadataOptionsResponse' {} Maybe Text
a -> ModifyInstanceMetadataOptionsResponse
s {$sel:instanceId:ModifyInstanceMetadataOptionsResponse' :: Maybe Text
instanceId = Maybe Text
a} :: ModifyInstanceMetadataOptionsResponse)

-- | The metadata options for the instance.
modifyInstanceMetadataOptionsResponse_instanceMetadataOptions :: Lens.Lens' ModifyInstanceMetadataOptionsResponse (Prelude.Maybe InstanceMetadataOptionsResponse)
modifyInstanceMetadataOptionsResponse_instanceMetadataOptions :: Lens'
  ModifyInstanceMetadataOptionsResponse
  (Maybe InstanceMetadataOptionsResponse)
modifyInstanceMetadataOptionsResponse_instanceMetadataOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyInstanceMetadataOptionsResponse' {Maybe InstanceMetadataOptionsResponse
instanceMetadataOptions :: Maybe InstanceMetadataOptionsResponse
$sel:instanceMetadataOptions:ModifyInstanceMetadataOptionsResponse' :: ModifyInstanceMetadataOptionsResponse
-> Maybe InstanceMetadataOptionsResponse
instanceMetadataOptions} -> Maybe InstanceMetadataOptionsResponse
instanceMetadataOptions) (\s :: ModifyInstanceMetadataOptionsResponse
s@ModifyInstanceMetadataOptionsResponse' {} Maybe InstanceMetadataOptionsResponse
a -> ModifyInstanceMetadataOptionsResponse
s {$sel:instanceMetadataOptions:ModifyInstanceMetadataOptionsResponse' :: Maybe InstanceMetadataOptionsResponse
instanceMetadataOptions = Maybe InstanceMetadataOptionsResponse
a} :: ModifyInstanceMetadataOptionsResponse)

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

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