{-# 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.Lightsail.Types.InstanceMetadataOptions
-- 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.Lightsail.Types.InstanceMetadataOptions 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.HttpEndpoint
import Amazonka.Lightsail.Types.HttpProtocolIpv6
import Amazonka.Lightsail.Types.HttpTokens
import Amazonka.Lightsail.Types.InstanceMetadataState
import qualified Amazonka.Prelude as Prelude

-- | The metadata options for the instance.
--
-- /See:/ 'newInstanceMetadataOptions' smart constructor.
data InstanceMetadataOptions = InstanceMetadataOptions'
  { -- | Indicates whether the HTTP metadata endpoint on your instances is
    -- enabled or disabled.
    --
    -- If the value is @disabled@, you cannot access your instance metadata.
    InstanceMetadataOptions -> Maybe HttpEndpoint
httpEndpoint :: Prelude.Maybe HttpEndpoint,
    -- | Indicates whether the IPv6 endpoint for the instance metadata service is
    -- enabled or disabled.
    InstanceMetadataOptions -> 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.
    InstanceMetadataOptions -> 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 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.
    --
    -- Not all instance blueprints in Lightsail support version 2.0
    -- credentials. Use the @MetadataNoToken@ instance metric to track the
    -- number of calls to the instance metadata service that are using version
    -- 1.0 credentials. For more information, see
    -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-viewing-instance-health-metrics Viewing instance metrics in Amazon Lightsail>
    -- in the /Amazon Lightsail Developer Guide/.
    InstanceMetadataOptions -> Maybe HttpTokens
httpTokens :: Prelude.Maybe HttpTokens,
    -- | The state of the metadata option changes.
    --
    -- The following states are possible:
    --
    -- -   @pending@ - The metadata options are being updated. The instance is
    --     not yet ready to process metadata traffic with the new selection.
    --
    -- -   @applied@ - The metadata options have been successfully applied to
    --     the instance.
    InstanceMetadataOptions -> Maybe InstanceMetadataState
state :: Prelude.Maybe InstanceMetadataState
  }
  deriving (InstanceMetadataOptions -> InstanceMetadataOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceMetadataOptions -> InstanceMetadataOptions -> Bool
$c/= :: InstanceMetadataOptions -> InstanceMetadataOptions -> Bool
== :: InstanceMetadataOptions -> InstanceMetadataOptions -> Bool
$c== :: InstanceMetadataOptions -> InstanceMetadataOptions -> Bool
Prelude.Eq, ReadPrec [InstanceMetadataOptions]
ReadPrec InstanceMetadataOptions
Int -> ReadS InstanceMetadataOptions
ReadS [InstanceMetadataOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstanceMetadataOptions]
$creadListPrec :: ReadPrec [InstanceMetadataOptions]
readPrec :: ReadPrec InstanceMetadataOptions
$creadPrec :: ReadPrec InstanceMetadataOptions
readList :: ReadS [InstanceMetadataOptions]
$creadList :: ReadS [InstanceMetadataOptions]
readsPrec :: Int -> ReadS InstanceMetadataOptions
$creadsPrec :: Int -> ReadS InstanceMetadataOptions
Prelude.Read, Int -> InstanceMetadataOptions -> ShowS
[InstanceMetadataOptions] -> ShowS
InstanceMetadataOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceMetadataOptions] -> ShowS
$cshowList :: [InstanceMetadataOptions] -> ShowS
show :: InstanceMetadataOptions -> String
$cshow :: InstanceMetadataOptions -> String
showsPrec :: Int -> InstanceMetadataOptions -> ShowS
$cshowsPrec :: Int -> InstanceMetadataOptions -> ShowS
Prelude.Show, forall x. Rep InstanceMetadataOptions x -> InstanceMetadataOptions
forall x. InstanceMetadataOptions -> Rep InstanceMetadataOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstanceMetadataOptions x -> InstanceMetadataOptions
$cfrom :: forall x. InstanceMetadataOptions -> Rep InstanceMetadataOptions x
Prelude.Generic)

-- |
-- Create a value of 'InstanceMetadataOptions' 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', 'instanceMetadataOptions_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', 'instanceMetadataOptions_httpProtocolIpv6' - Indicates whether the IPv6 endpoint for the instance metadata service is
-- enabled or disabled.
--
-- 'httpPutResponseHopLimit', 'instanceMetadataOptions_httpPutResponseHopLimit' - The desired HTTP PUT response hop limit for instance metadata requests.
-- A larger number means that the instance metadata requests can travel
-- farther.
--
-- 'httpTokens', 'instanceMetadataOptions_httpTokens' - The state of token usage for your instance metadata requests.
--
-- 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.
--
-- Not all instance blueprints in Lightsail support version 2.0
-- credentials. Use the @MetadataNoToken@ instance metric to track the
-- number of calls to the instance metadata service that are using version
-- 1.0 credentials. For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-viewing-instance-health-metrics Viewing instance metrics in Amazon Lightsail>
-- in the /Amazon Lightsail Developer Guide/.
--
-- 'state', 'instanceMetadataOptions_state' - The state of the metadata option changes.
--
-- The following states are possible:
--
-- -   @pending@ - The metadata options are being updated. The instance is
--     not yet ready to process metadata traffic with the new selection.
--
-- -   @applied@ - The metadata options have been successfully applied to
--     the instance.
newInstanceMetadataOptions ::
  InstanceMetadataOptions
newInstanceMetadataOptions :: InstanceMetadataOptions
newInstanceMetadataOptions =
  InstanceMetadataOptions'
    { $sel:httpEndpoint:InstanceMetadataOptions' :: Maybe HttpEndpoint
httpEndpoint =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpProtocolIpv6:InstanceMetadataOptions' :: Maybe HttpProtocolIpv6
httpProtocolIpv6 = forall a. Maybe a
Prelude.Nothing,
      $sel:httpPutResponseHopLimit:InstanceMetadataOptions' :: Maybe Int
httpPutResponseHopLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:httpTokens:InstanceMetadataOptions' :: Maybe HttpTokens
httpTokens = forall a. Maybe a
Prelude.Nothing,
      $sel:state:InstanceMetadataOptions' :: Maybe InstanceMetadataState
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.
instanceMetadataOptions_httpEndpoint :: Lens.Lens' InstanceMetadataOptions (Prelude.Maybe HttpEndpoint)
instanceMetadataOptions_httpEndpoint :: Lens' InstanceMetadataOptions (Maybe HttpEndpoint)
instanceMetadataOptions_httpEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptions' {Maybe HttpEndpoint
httpEndpoint :: Maybe HttpEndpoint
$sel:httpEndpoint:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe HttpEndpoint
httpEndpoint} -> Maybe HttpEndpoint
httpEndpoint) (\s :: InstanceMetadataOptions
s@InstanceMetadataOptions' {} Maybe HttpEndpoint
a -> InstanceMetadataOptions
s {$sel:httpEndpoint:InstanceMetadataOptions' :: Maybe HttpEndpoint
httpEndpoint = Maybe HttpEndpoint
a} :: InstanceMetadataOptions)

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

-- | The desired HTTP PUT response hop limit for instance metadata requests.
-- A larger number means that the instance metadata requests can travel
-- farther.
instanceMetadataOptions_httpPutResponseHopLimit :: Lens.Lens' InstanceMetadataOptions (Prelude.Maybe Prelude.Int)
instanceMetadataOptions_httpPutResponseHopLimit :: Lens' InstanceMetadataOptions (Maybe Int)
instanceMetadataOptions_httpPutResponseHopLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptions' {Maybe Int
httpPutResponseHopLimit :: Maybe Int
$sel:httpPutResponseHopLimit:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe Int
httpPutResponseHopLimit} -> Maybe Int
httpPutResponseHopLimit) (\s :: InstanceMetadataOptions
s@InstanceMetadataOptions' {} Maybe Int
a -> InstanceMetadataOptions
s {$sel:httpPutResponseHopLimit:InstanceMetadataOptions' :: Maybe Int
httpPutResponseHopLimit = Maybe Int
a} :: InstanceMetadataOptions)

-- | The state of token usage for your instance metadata requests.
--
-- 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.
--
-- Not all instance blueprints in Lightsail support version 2.0
-- credentials. Use the @MetadataNoToken@ instance metric to track the
-- number of calls to the instance metadata service that are using version
-- 1.0 credentials. For more information, see
-- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-viewing-instance-health-metrics Viewing instance metrics in Amazon Lightsail>
-- in the /Amazon Lightsail Developer Guide/.
instanceMetadataOptions_httpTokens :: Lens.Lens' InstanceMetadataOptions (Prelude.Maybe HttpTokens)
instanceMetadataOptions_httpTokens :: Lens' InstanceMetadataOptions (Maybe HttpTokens)
instanceMetadataOptions_httpTokens = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceMetadataOptions' {Maybe HttpTokens
httpTokens :: Maybe HttpTokens
$sel:httpTokens:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe HttpTokens
httpTokens} -> Maybe HttpTokens
httpTokens) (\s :: InstanceMetadataOptions
s@InstanceMetadataOptions' {} Maybe HttpTokens
a -> InstanceMetadataOptions
s {$sel:httpTokens:InstanceMetadataOptions' :: Maybe HttpTokens
httpTokens = Maybe HttpTokens
a} :: InstanceMetadataOptions)

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

instance Data.FromJSON InstanceMetadataOptions where
  parseJSON :: Value -> Parser InstanceMetadataOptions
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"InstanceMetadataOptions"
      ( \Object
x ->
          Maybe HttpEndpoint
-> Maybe HttpProtocolIpv6
-> Maybe Int
-> Maybe HttpTokens
-> Maybe InstanceMetadataState
-> InstanceMetadataOptions
InstanceMetadataOptions'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"httpEndpoint")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"httpProtocolIpv6")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"httpPutResponseHopLimit")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"httpTokens")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"state")
      )

instance Prelude.Hashable InstanceMetadataOptions where
  hashWithSalt :: Int -> InstanceMetadataOptions -> Int
hashWithSalt Int
_salt InstanceMetadataOptions' {Maybe Int
Maybe HttpEndpoint
Maybe HttpProtocolIpv6
Maybe HttpTokens
Maybe InstanceMetadataState
state :: Maybe InstanceMetadataState
httpTokens :: Maybe HttpTokens
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe HttpProtocolIpv6
httpEndpoint :: Maybe HttpEndpoint
$sel:state:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe InstanceMetadataState
$sel:httpTokens:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe HttpTokens
$sel:httpPutResponseHopLimit:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe HttpProtocolIpv6
$sel:httpEndpoint:InstanceMetadataOptions' :: InstanceMetadataOptions -> 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` Maybe InstanceMetadataState
state

instance Prelude.NFData InstanceMetadataOptions where
  rnf :: InstanceMetadataOptions -> ()
rnf InstanceMetadataOptions' {Maybe Int
Maybe HttpEndpoint
Maybe HttpProtocolIpv6
Maybe HttpTokens
Maybe InstanceMetadataState
state :: Maybe InstanceMetadataState
httpTokens :: Maybe HttpTokens
httpPutResponseHopLimit :: Maybe Int
httpProtocolIpv6 :: Maybe HttpProtocolIpv6
httpEndpoint :: Maybe HttpEndpoint
$sel:state:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe InstanceMetadataState
$sel:httpTokens:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe HttpTokens
$sel:httpPutResponseHopLimit:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe Int
$sel:httpProtocolIpv6:InstanceMetadataOptions' :: InstanceMetadataOptions -> Maybe HttpProtocolIpv6
$sel:httpEndpoint:InstanceMetadataOptions' :: InstanceMetadataOptions -> 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 Maybe InstanceMetadataState
state