{-# 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.Lightsail.UpdateInstanceMetadataOptions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the Amazon Lightsail instance metadata parameters on a running
-- or stopped instance. When you modify the parameters on a running
-- instance, the @GetInstance@ or @GetInstances@ API operation initially
-- responds with a state of @pending@. After the parameter modifications
-- are successfully applied, the state changes to @applied@ in subsequent
-- @GetInstance@ or @GetInstances@ API calls. For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-configuring-instance-metadata-service Use IMDSv2 with an Amazon Lightsail instance>
-- in the /Amazon Lightsail Developer Guide/.
module Amazonka.Lightsail.UpdateInstanceMetadataOptions
  ( -- * Creating a Request
    UpdateInstanceMetadataOptions (..),
    newUpdateInstanceMetadataOptions,

    -- * Request Lenses
    updateInstanceMetadataOptions_httpEndpoint,
    updateInstanceMetadataOptions_httpProtocolIpv6,
    updateInstanceMetadataOptions_httpPutResponseHopLimit,
    updateInstanceMetadataOptions_httpTokens,
    updateInstanceMetadataOptions_instanceName,

    -- * Destructuring the Response
    UpdateInstanceMetadataOptionsResponse (..),
    newUpdateInstanceMetadataOptionsResponse,

    -- * Response Lenses
    updateInstanceMetadataOptionsResponse_operation,
    updateInstanceMetadataOptionsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Lightsail.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateInstanceMetadataOptions' smart constructor.
data UpdateInstanceMetadataOptions = UpdateInstanceMetadataOptions'
  { -- | 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.
    UpdateInstanceMetadataOptions -> Maybe HttpEndpoint
httpEndpoint :: Prelude.Maybe HttpEndpoint,
    -- | Enables or disables the IPv6 endpoint for the instance metadata service.
    -- This setting applies only when the HTTP metadata endpoint is enabled.
    --
    -- This parameter is available only for instances in the Europe (Stockholm)
    -- Amazon Web Services Region (@eu-north-1@).
    UpdateInstanceMetadataOptions -> Maybe HttpProtocolIpv6
httpProtocolIpv6 :: Prelude.Maybe HttpProtocolIpv6,
    -- | The desired HTTP PUT response hop limit for instance metadata requests.
    -- A larger number means that the instance metadata requests can travel
    -- farther. If no parameter is specified, the existing state is maintained.
    UpdateInstanceMetadataOptions -> 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 whether to retrieve instance
    -- metadata with a signed token header 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 by using a valid
    -- signed token, the version 2.0 role credentials are returned.
    --
    -- If the state is @required@, you must send a signed token header with all
    -- instance metadata retrieval requests. In this state, retrieving the IAM
    -- role credential always returns the version 2.0 credentials. The version
    -- 1.0 credentials are not available.
    UpdateInstanceMetadataOptions -> Maybe HttpTokens
httpTokens :: Prelude.Maybe HttpTokens,
    -- | The name of the instance for which to update metadata parameters.
    UpdateInstanceMetadataOptions -> Text
instanceName :: Prelude.Text
  }
  deriving (UpdateInstanceMetadataOptions
-> UpdateInstanceMetadataOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateInstanceMetadataOptions
-> UpdateInstanceMetadataOptions -> Bool
$c/= :: UpdateInstanceMetadataOptions
-> UpdateInstanceMetadataOptions -> Bool
== :: UpdateInstanceMetadataOptions
-> UpdateInstanceMetadataOptions -> Bool
$c== :: UpdateInstanceMetadataOptions
-> UpdateInstanceMetadataOptions -> Bool
Prelude.Eq, ReadPrec [UpdateInstanceMetadataOptions]
ReadPrec UpdateInstanceMetadataOptions
Int -> ReadS UpdateInstanceMetadataOptions
ReadS [UpdateInstanceMetadataOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateInstanceMetadataOptions]
$creadListPrec :: ReadPrec [UpdateInstanceMetadataOptions]
readPrec :: ReadPrec UpdateInstanceMetadataOptions
$creadPrec :: ReadPrec UpdateInstanceMetadataOptions
readList :: ReadS [UpdateInstanceMetadataOptions]
$creadList :: ReadS [UpdateInstanceMetadataOptions]
readsPrec :: Int -> ReadS UpdateInstanceMetadataOptions
$creadsPrec :: Int -> ReadS UpdateInstanceMetadataOptions
Prelude.Read, Int -> UpdateInstanceMetadataOptions -> ShowS
[UpdateInstanceMetadataOptions] -> ShowS
UpdateInstanceMetadataOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateInstanceMetadataOptions] -> ShowS
$cshowList :: [UpdateInstanceMetadataOptions] -> ShowS
show :: UpdateInstanceMetadataOptions -> String
$cshow :: UpdateInstanceMetadataOptions -> String
showsPrec :: Int -> UpdateInstanceMetadataOptions -> ShowS
$cshowsPrec :: Int -> UpdateInstanceMetadataOptions -> ShowS
Prelude.Show, forall x.
Rep UpdateInstanceMetadataOptions x
-> UpdateInstanceMetadataOptions
forall x.
UpdateInstanceMetadataOptions
-> Rep UpdateInstanceMetadataOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateInstanceMetadataOptions x
-> UpdateInstanceMetadataOptions
$cfrom :: forall x.
UpdateInstanceMetadataOptions
-> Rep UpdateInstanceMetadataOptions x
Prelude.Generic)

-- |
-- Create a value of 'UpdateInstanceMetadataOptions' 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', 'updateInstanceMetadataOptions_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', 'updateInstanceMetadataOptions_httpProtocolIpv6' - Enables or disables the IPv6 endpoint for the instance metadata service.
-- This setting applies only when the HTTP metadata endpoint is enabled.
--
-- This parameter is available only for instances in the Europe (Stockholm)
-- Amazon Web Services Region (@eu-north-1@).
--
-- 'httpPutResponseHopLimit', 'updateInstanceMetadataOptions_httpPutResponseHopLimit' - The desired HTTP PUT response hop limit for instance metadata requests.
-- A larger number means that the instance metadata requests can travel
-- farther. If no parameter is specified, the existing state is maintained.
--
-- 'httpTokens', 'updateInstanceMetadataOptions_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 whether to retrieve instance
-- metadata with a signed token header 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 by using a valid
-- signed token, the version 2.0 role credentials are returned.
--
-- If the state is @required@, you must send a signed token header with all
-- instance metadata retrieval requests. In this state, retrieving the IAM
-- role credential always returns the version 2.0 credentials. The version
-- 1.0 credentials are not available.
--
-- 'instanceName', 'updateInstanceMetadataOptions_instanceName' - The name of the instance for which to update metadata parameters.
newUpdateInstanceMetadataOptions ::
  -- | 'instanceName'
  Prelude.Text ->
  UpdateInstanceMetadataOptions
newUpdateInstanceMetadataOptions :: Text -> UpdateInstanceMetadataOptions
newUpdateInstanceMetadataOptions Text
pInstanceName_ =
  UpdateInstanceMetadataOptions'
    { $sel:httpEndpoint:UpdateInstanceMetadataOptions' :: Maybe HttpEndpoint
httpEndpoint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpProtocolIpv6:UpdateInstanceMetadataOptions' :: Maybe HttpProtocolIpv6
httpProtocolIpv6 = forall a. Maybe a
Prelude.Nothing,
      $sel:httpPutResponseHopLimit:UpdateInstanceMetadataOptions' :: Maybe Int
httpPutResponseHopLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:httpTokens:UpdateInstanceMetadataOptions' :: Maybe HttpTokens
httpTokens = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceName:UpdateInstanceMetadataOptions' :: Text
instanceName = Text
pInstanceName_
    }

-- | 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.
updateInstanceMetadataOptions_httpEndpoint :: Lens.Lens' UpdateInstanceMetadataOptions (Prelude.Maybe HttpEndpoint)
updateInstanceMetadataOptions_httpEndpoint :: Lens' UpdateInstanceMetadataOptions (Maybe HttpEndpoint)
updateInstanceMetadataOptions_httpEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstanceMetadataOptions' {Maybe HttpEndpoint
httpEndpoint :: Maybe HttpEndpoint
$sel:httpEndpoint:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpEndpoint
httpEndpoint} -> Maybe HttpEndpoint
httpEndpoint) (\s :: UpdateInstanceMetadataOptions
s@UpdateInstanceMetadataOptions' {} Maybe HttpEndpoint
a -> UpdateInstanceMetadataOptions
s {$sel:httpEndpoint:UpdateInstanceMetadataOptions' :: Maybe HttpEndpoint
httpEndpoint = Maybe HttpEndpoint
a} :: UpdateInstanceMetadataOptions)

-- | Enables or disables the IPv6 endpoint for the instance metadata service.
-- This setting applies only when the HTTP metadata endpoint is enabled.
--
-- This parameter is available only for instances in the Europe (Stockholm)
-- Amazon Web Services Region (@eu-north-1@).
updateInstanceMetadataOptions_httpProtocolIpv6 :: Lens.Lens' UpdateInstanceMetadataOptions (Prelude.Maybe HttpProtocolIpv6)
updateInstanceMetadataOptions_httpProtocolIpv6 :: Lens' UpdateInstanceMetadataOptions (Maybe HttpProtocolIpv6)
updateInstanceMetadataOptions_httpProtocolIpv6 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstanceMetadataOptions' {Maybe HttpProtocolIpv6
httpProtocolIpv6 :: Maybe HttpProtocolIpv6
$sel:httpProtocolIpv6:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpProtocolIpv6
httpProtocolIpv6} -> Maybe HttpProtocolIpv6
httpProtocolIpv6) (\s :: UpdateInstanceMetadataOptions
s@UpdateInstanceMetadataOptions' {} Maybe HttpProtocolIpv6
a -> UpdateInstanceMetadataOptions
s {$sel:httpProtocolIpv6:UpdateInstanceMetadataOptions' :: Maybe HttpProtocolIpv6
httpProtocolIpv6 = Maybe HttpProtocolIpv6
a} :: UpdateInstanceMetadataOptions)

-- | The desired HTTP PUT response hop limit for instance metadata requests.
-- A larger number means that the instance metadata requests can travel
-- farther. If no parameter is specified, the existing state is maintained.
updateInstanceMetadataOptions_httpPutResponseHopLimit :: Lens.Lens' UpdateInstanceMetadataOptions (Prelude.Maybe Prelude.Int)
updateInstanceMetadataOptions_httpPutResponseHopLimit :: Lens' UpdateInstanceMetadataOptions (Maybe Int)
updateInstanceMetadataOptions_httpPutResponseHopLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstanceMetadataOptions' {Maybe Int
httpPutResponseHopLimit :: Maybe Int
$sel:httpPutResponseHopLimit:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe Int
httpPutResponseHopLimit} -> Maybe Int
httpPutResponseHopLimit) (\s :: UpdateInstanceMetadataOptions
s@UpdateInstanceMetadataOptions' {} Maybe Int
a -> UpdateInstanceMetadataOptions
s {$sel:httpPutResponseHopLimit:UpdateInstanceMetadataOptions' :: Maybe Int
httpPutResponseHopLimit = Maybe Int
a} :: UpdateInstanceMetadataOptions)

-- | 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 whether to retrieve instance
-- metadata with a signed token header 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 by using a valid
-- signed token, the version 2.0 role credentials are returned.
--
-- If the state is @required@, you must send a signed token header with all
-- instance metadata retrieval requests. In this state, retrieving the IAM
-- role credential always returns the version 2.0 credentials. The version
-- 1.0 credentials are not available.
updateInstanceMetadataOptions_httpTokens :: Lens.Lens' UpdateInstanceMetadataOptions (Prelude.Maybe HttpTokens)
updateInstanceMetadataOptions_httpTokens :: Lens' UpdateInstanceMetadataOptions (Maybe HttpTokens)
updateInstanceMetadataOptions_httpTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstanceMetadataOptions' {Maybe HttpTokens
httpTokens :: Maybe HttpTokens
$sel:httpTokens:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpTokens
httpTokens} -> Maybe HttpTokens
httpTokens) (\s :: UpdateInstanceMetadataOptions
s@UpdateInstanceMetadataOptions' {} Maybe HttpTokens
a -> UpdateInstanceMetadataOptions
s {$sel:httpTokens:UpdateInstanceMetadataOptions' :: Maybe HttpTokens
httpTokens = Maybe HttpTokens
a} :: UpdateInstanceMetadataOptions)

-- | The name of the instance for which to update metadata parameters.
updateInstanceMetadataOptions_instanceName :: Lens.Lens' UpdateInstanceMetadataOptions Prelude.Text
updateInstanceMetadataOptions_instanceName :: Lens' UpdateInstanceMetadataOptions Text
updateInstanceMetadataOptions_instanceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstanceMetadataOptions' {Text
instanceName :: Text
$sel:instanceName:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Text
instanceName} -> Text
instanceName) (\s :: UpdateInstanceMetadataOptions
s@UpdateInstanceMetadataOptions' {} Text
a -> UpdateInstanceMetadataOptions
s {$sel:instanceName:UpdateInstanceMetadataOptions' :: Text
instanceName = Text
a} :: UpdateInstanceMetadataOptions)

instance
  Core.AWSRequest
    UpdateInstanceMetadataOptions
  where
  type
    AWSResponse UpdateInstanceMetadataOptions =
      UpdateInstanceMetadataOptionsResponse
  request :: (Service -> Service)
-> UpdateInstanceMetadataOptions
-> Request UpdateInstanceMetadataOptions
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateInstanceMetadataOptions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateInstanceMetadataOptions)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Operation -> Int -> UpdateInstanceMetadataOptionsResponse
UpdateInstanceMetadataOptionsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"operation")
            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
    UpdateInstanceMetadataOptions
  where
  hashWithSalt :: Int -> UpdateInstanceMetadataOptions -> Int
hashWithSalt Int
_salt UpdateInstanceMetadataOptions' {Maybe Int
Maybe HttpEndpoint
Maybe HttpProtocolIpv6
Maybe HttpTokens
Text
instanceName :: Text
httpTokens :: Maybe HttpTokens
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe HttpProtocolIpv6
httpEndpoint :: Maybe HttpEndpoint
$sel:instanceName:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Text
$sel:httpTokens:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpTokens
$sel:httpPutResponseHopLimit:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpProtocolIpv6
$sel:httpEndpoint:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpEndpoint
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpEndpoint
httpEndpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpProtocolIpv6
httpProtocolIpv6
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
httpPutResponseHopLimit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpTokens
httpTokens
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceName

instance Prelude.NFData UpdateInstanceMetadataOptions where
  rnf :: UpdateInstanceMetadataOptions -> ()
rnf UpdateInstanceMetadataOptions' {Maybe Int
Maybe HttpEndpoint
Maybe HttpProtocolIpv6
Maybe HttpTokens
Text
instanceName :: Text
httpTokens :: Maybe HttpTokens
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe HttpProtocolIpv6
httpEndpoint :: Maybe HttpEndpoint
$sel:instanceName:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Text
$sel:httpTokens:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpTokens
$sel:httpPutResponseHopLimit:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpProtocolIpv6
$sel:httpEndpoint:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpEndpoint
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpEndpoint
httpEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpProtocolIpv6
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 HttpTokens
httpTokens
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceName

instance Data.ToHeaders UpdateInstanceMetadataOptions where
  toHeaders :: UpdateInstanceMetadataOptions -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Lightsail_20161128.UpdateInstanceMetadataOptions" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateInstanceMetadataOptions where
  toJSON :: UpdateInstanceMetadataOptions -> Value
toJSON UpdateInstanceMetadataOptions' {Maybe Int
Maybe HttpEndpoint
Maybe HttpProtocolIpv6
Maybe HttpTokens
Text
instanceName :: Text
httpTokens :: Maybe HttpTokens
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe HttpProtocolIpv6
httpEndpoint :: Maybe HttpEndpoint
$sel:instanceName:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Text
$sel:httpTokens:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpTokens
$sel:httpPutResponseHopLimit:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpProtocolIpv6
$sel:httpEndpoint:UpdateInstanceMetadataOptions' :: UpdateInstanceMetadataOptions -> Maybe HttpEndpoint
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"httpEndpoint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HttpEndpoint
httpEndpoint,
            (Key
"httpProtocolIpv6" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HttpProtocolIpv6
httpProtocolIpv6,
            (Key
"httpPutResponseHopLimit" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
httpPutResponseHopLimit,
            (Key
"httpTokens" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HttpTokens
httpTokens,
            forall a. a -> Maybe a
Prelude.Just (Key
"instanceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceName)
          ]
      )

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

instance Data.ToQuery UpdateInstanceMetadataOptions where
  toQuery :: UpdateInstanceMetadataOptions -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'UpdateInstanceMetadataOptionsResponse' 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:
--
-- 'operation', 'updateInstanceMetadataOptionsResponse_operation' - Undocumented member.
--
-- 'httpStatus', 'updateInstanceMetadataOptionsResponse_httpStatus' - The response's http status code.
newUpdateInstanceMetadataOptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateInstanceMetadataOptionsResponse
newUpdateInstanceMetadataOptionsResponse :: Int -> UpdateInstanceMetadataOptionsResponse
newUpdateInstanceMetadataOptionsResponse Int
pHttpStatus_ =
  UpdateInstanceMetadataOptionsResponse'
    { $sel:operation:UpdateInstanceMetadataOptionsResponse' :: Maybe Operation
operation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateInstanceMetadataOptionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updateInstanceMetadataOptionsResponse_operation :: Lens.Lens' UpdateInstanceMetadataOptionsResponse (Prelude.Maybe Operation)
updateInstanceMetadataOptionsResponse_operation :: Lens' UpdateInstanceMetadataOptionsResponse (Maybe Operation)
updateInstanceMetadataOptionsResponse_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateInstanceMetadataOptionsResponse' {Maybe Operation
operation :: Maybe Operation
$sel:operation:UpdateInstanceMetadataOptionsResponse' :: UpdateInstanceMetadataOptionsResponse -> Maybe Operation
operation} -> Maybe Operation
operation) (\s :: UpdateInstanceMetadataOptionsResponse
s@UpdateInstanceMetadataOptionsResponse' {} Maybe Operation
a -> UpdateInstanceMetadataOptionsResponse
s {$sel:operation:UpdateInstanceMetadataOptionsResponse' :: Maybe Operation
operation = Maybe Operation
a} :: UpdateInstanceMetadataOptionsResponse)

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

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