{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Amazonka.EC2.Metadata
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
--
-- This module contains functions for retrieving various EC2 metadata from an
-- instance's local metadata endpoint. It assumes that you're running the code
-- on an EC2 instance or have a compatible @instance-data@ endpoint available.
--
-- It is intended to be usable when you need to make metadata calls prior to
-- initialisation of the 'Amazonka.Env.Env'.
module Amazonka.EC2.Metadata
  ( -- * EC2 Instance Check
    isEC2,

    -- * Retrieving Instance Data
    dynamic,
    metadata,
    userdata,
    identity,

    -- ** Path Constructors
    Dynamic (..),
    Metadata (..),
    Autoscaling (..),
    Mapping (..),
    ElasticGpus (..),
    ElasticInference (..),
    Events (..),
    Maintenance (..),
    Recommendations (..),
    IAM (..),
    IdentityCredentialsEC2 (..),
    Interface (..),
    Placement (..),
    Services (..),
    Spot (..),
    Tags (..),

    -- ** Identity Document
    IdentityDocument (..),

    -- *** Lenses
    identityDocument_devpayProductCodes,
    identityDocument_billingProducts,
    identityDocument_version,
    identityDocument_privateIp,
    identityDocument_availabilityZone,
    identityDocument_region,
    identityDocument_instanceId,
    identityDocument_instanceType,
    identityDocument_accountId,
    identityDocument_imageId,
    identityDocument_kernelId,
    identityDocument_ramdiskId,
    identityDocument_architecture,
    identityDocument_pendingTime,
  )
where

import Amazonka.Data
import Amazonka.Prelude
import Amazonka.Types (Region)
import qualified Control.Exception as Exception
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as Text
import qualified Network.HTTP.Client as Client
import Network.HTTP.Simple (setRequestHeader, setRequestMethod)

data Dynamic
  = -- | Value showing whether the customer has enabled detailed one-minute
    -- monitoring in CloudWatch.
    --
    -- Valid values: @enabled@ | @disabled@.
    FWS
  | -- | JSON containing instance attributes, such as instance-id,
    -- private IP address, etc.
    -- /See:/ 'identity', 'InstanceDocument'.
    Document
  | -- | Used to verify the document's authenticity and content against the
    -- signature.
    PKCS7
  | -- | Data that can be used by other parties to verify its origin
    -- and authenticity.
    Signature
  deriving stock (Dynamic -> Dynamic -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dynamic -> Dynamic -> Bool
$c/= :: Dynamic -> Dynamic -> Bool
== :: Dynamic -> Dynamic -> Bool
$c== :: Dynamic -> Dynamic -> Bool
Eq, Eq Dynamic
Dynamic -> Dynamic -> Bool
Dynamic -> Dynamic -> Ordering
Dynamic -> Dynamic -> Dynamic
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dynamic -> Dynamic -> Dynamic
$cmin :: Dynamic -> Dynamic -> Dynamic
max :: Dynamic -> Dynamic -> Dynamic
$cmax :: Dynamic -> Dynamic -> Dynamic
>= :: Dynamic -> Dynamic -> Bool
$c>= :: Dynamic -> Dynamic -> Bool
> :: Dynamic -> Dynamic -> Bool
$c> :: Dynamic -> Dynamic -> Bool
<= :: Dynamic -> Dynamic -> Bool
$c<= :: Dynamic -> Dynamic -> Bool
< :: Dynamic -> Dynamic -> Bool
$c< :: Dynamic -> Dynamic -> Bool
compare :: Dynamic -> Dynamic -> Ordering
$ccompare :: Dynamic -> Dynamic -> Ordering
Ord, Int -> Dynamic -> ShowS
[Dynamic] -> ShowS
Dynamic -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dynamic] -> ShowS
$cshowList :: [Dynamic] -> ShowS
show :: Dynamic -> String
$cshow :: Dynamic -> String
showsPrec :: Int -> Dynamic -> ShowS
$cshowsPrec :: Int -> Dynamic -> ShowS
Show, forall x. Rep Dynamic x -> Dynamic
forall x. Dynamic -> Rep Dynamic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Dynamic x -> Dynamic
$cfrom :: forall x. Dynamic -> Rep Dynamic x
Generic)

instance ToText Dynamic where
  toText :: Dynamic -> Text
toText =
    (Text
"dynamic/" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Dynamic
FWS -> Text
"fws/instance-monitoring"
      Dynamic
Document -> Text
"instance-identity/document"
      Dynamic
PKCS7 -> Text
"instance-identity/pkcs7"
      Dynamic
Signature -> Text
"instance-identity/signature"

-- | Instance metadata categories. The list of supported categories
-- are listed in the [EC2 Documentation](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instancedata-data-categories.html).
data Metadata
  = -- | The AMI ID used to launch the instance.
    AMIId
  | -- | If you started more than one instance at the same time, this value
    -- indicates the order in which the instance was launched.
    -- The value of the first instance launched is 0.
    AMILaunchIndex
  | -- | The path to the AMI's manifest file in Amazon S3.
    -- If you used an Amazon EBS-backed AMI to launch the instance,
    -- the returned result is @unknown@.
    AMIManifestPath
  | -- | The AMI IDs of any instances that were rebundled to create this AMI.
    -- This value will only exist if the AMI manifest file contained an
    -- @ancestor-amis@ key.
    AncestorAMIIds
  | -- | See: 'Autoscaling'
    Autoscaling !Autoscaling
  | -- | See: 'Mapping'
    BlockDevice !Mapping
  | -- | See: 'ElasticGpus'
    ElasticGpus !ElasticGpus
  | -- | See 'ElasticInference'
    ElasticInference !ElasticInference
  | -- | See 'Events'
    Events !Events
  | -- | If the EC2 instance is using IP-based naming (IPBN), this is
    -- the private IPv4 DNS hostname of the instance. If the EC2
    -- instance is using Resource-based naming (RBN), this is the
    -- RBN. In cases where multiple network interfaces are present,
    -- this refers to the eth0 device (the device for which the device
    -- number is 0). For more information about IPBN and RBN, see
    -- [Amazon EC2 instance hostname types](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-naming.html).
    Hostname
  | -- | See: 'IAM'
    IAM !IAM
  | -- | See: 'IdentityCredentialsEC2'
    IdentityCredentialsEC2 !IdentityCredentialsEC2
  | -- | Notifies the instance that it should reboot in preparation for bundling.
    -- Valid values: @none@ | @shutdown@ | @bundle-pending@.
    InstanceAction
  | -- | The ID of this instance.
    InstanceId
  | -- | The purchasing option of this instance. For more
    -- information, see
    -- [Instance purchasing options](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-purchasing-options.html).
    InstanceLifeCycle
  | -- | The type of instance. For more information, see
    -- [Instance types](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html).
    InstanceType
  | -- | The IPv6 address of the instance. In cases where multiple
    -- network interfaces are present, this refers to the eth0 device
    -- (the device for which the device number is 0) network interface
    -- and the first IPv6 address assigned. If no IPv6 address exists
    -- on network interface[0], this item is not set and results in an
    -- HTTP 404 response.
    IPV6
  | -- | The ID of the kernel launched with this instance, if applicable.
    KernelId
  | -- | In cases where multiple network interfaces are present, this
    -- refers to the eth0 device (the device for which the device
    -- number is 0). If the EC2 instance is using IP-based naming
    -- (IPBN), this is the private IPv4 DNS hostname of the
    -- instance. If the EC2 instance is using Resource-based naming
    -- (RBN), this is the RBN. For more information about IPBN, RBN,
    -- and EC2 instance naming, see
    -- [Amazon EC2 instance hostname types](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-naming.html).
    LocalHostname
  | -- | The private IPv4 address of the instance. In cases where
    -- multiple network interfaces are present, this refers to the
    -- eth0 device (the device for which the device number is 0). If
    -- this is an IPv6-only instance, this item is not set and results
    -- in an HTTP 404 response.
    LocalIPV4
  | -- | The instance's media access control (MAC) address. In cases
    -- where multiple network interfaces are present, this refers to
    -- the eth0 device (the device for which the device number is 0).
    MAC
  | -- | See: 'Interface'
    Network !Text !Interface
  | -- | See: 'Placement'
    Placement !Placement
  | -- | AWS Marketplace product codes associated with the instance,
    -- if any.
    ProductCodes
  | -- | The instance's public DNS (IPv4). This category is only
    -- returned if the @enableDnsHostnames@ attribute is set to
    -- @true@. For more information, see
    -- [Using DNS with Your VPC](https://docs.aws.amazon.com/vpc/latest/userguide/vpc-dns.html)
    -- in the /Amazon VPC User Guide/. If the instance only has a
    -- public-IPv6 address and no public-IPv4 address, this item is
    -- not set and results in an HTTP 404 response.
    PublicHostname
  | -- | The public IP address. If an Elastic IP address is associated with the
    -- instance, the value returned is the Elastic IP address.
    PublicIPV4
  | -- | Public key. Only available if supplied at instance launch time.
    OpenSSHKey
  | -- | The ID of the RAM disk specified at launch time, if applicable.
    RAMDiskId
  | -- | ID of the reservation.
    ReservationId
  | -- | The names of the security groups applied to the instance.
    --
    -- After launch, you can change the security groups of the
    -- instances. Such changes are reflected here and in
    -- @network\/interfaces\/macs\/${mac}\/security-groups@.
    SecurityGroups
  | -- | See: 'Services'
    Services !Services
  | -- | See: 'Spot'
    Spot !Spot
  | -- | See: 'Tags'
    Tags !Tags
  deriving stock (Metadata -> Metadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metadata -> Metadata -> Bool
$c/= :: Metadata -> Metadata -> Bool
== :: Metadata -> Metadata -> Bool
$c== :: Metadata -> Metadata -> Bool
Eq, Eq Metadata
Metadata -> Metadata -> Bool
Metadata -> Metadata -> Ordering
Metadata -> Metadata -> Metadata
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Metadata -> Metadata -> Metadata
$cmin :: Metadata -> Metadata -> Metadata
max :: Metadata -> Metadata -> Metadata
$cmax :: Metadata -> Metadata -> Metadata
>= :: Metadata -> Metadata -> Bool
$c>= :: Metadata -> Metadata -> Bool
> :: Metadata -> Metadata -> Bool
$c> :: Metadata -> Metadata -> Bool
<= :: Metadata -> Metadata -> Bool
$c<= :: Metadata -> Metadata -> Bool
< :: Metadata -> Metadata -> Bool
$c< :: Metadata -> Metadata -> Bool
compare :: Metadata -> Metadata -> Ordering
$ccompare :: Metadata -> Metadata -> Ordering
Ord, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metadata] -> ShowS
$cshowList :: [Metadata] -> ShowS
show :: Metadata -> String
$cshow :: Metadata -> String
showsPrec :: Int -> Metadata -> ShowS
$cshowsPrec :: Int -> Metadata -> ShowS
Show, forall x. Rep Metadata x -> Metadata
forall x. Metadata -> Rep Metadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Metadata x -> Metadata
$cfrom :: forall x. Metadata -> Rep Metadata x
Generic)

instance ToText Metadata where
  toText :: Metadata -> Text
toText =
    (Text
"meta-data/" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      Metadata
AMIId -> Text
"ami-id"
      Metadata
AMILaunchIndex -> Text
"ami-launch-index"
      Metadata
AMIManifestPath -> Text
"ami-manifest-path"
      Metadata
AncestorAMIIds -> Text
"ancestor-ami-ids"
      Autoscaling Autoscaling
m -> Text
"autoscaling/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Autoscaling
m
      BlockDevice Mapping
m -> Text
"block-device-mapping/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Mapping
m
      Metadata
Hostname -> Text
"hostname"
      ElasticGpus ElasticGpus
m -> Text
"elastic-gpus/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText ElasticGpus
m
      ElasticInference ElasticInference
m -> Text
"elastic-inference/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText ElasticInference
m
      Events Events
m -> Text
"events/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Events
m
      IAM IAM
m -> Text
"iam/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText IAM
m
      IdentityCredentialsEC2 IdentityCredentialsEC2
m -> Text
"identity-credentials/ec2/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText IdentityCredentialsEC2
m
      Metadata
InstanceAction -> Text
"instance-action"
      Metadata
InstanceId -> Text
"instance-id"
      Metadata
InstanceLifeCycle -> Text
"instance-life-cycle"
      Metadata
InstanceType -> Text
"instance-type"
      Metadata
IPV6 -> Text
"ipv6"
      Metadata
KernelId -> Text
"kernel-id"
      Metadata
LocalHostname -> Text
"local-hostname"
      Metadata
LocalIPV4 -> Text
"local-ipv4"
      Metadata
MAC -> Text
"mac"
      Network Text
n Interface
m -> Text
"network/interfaces/macs/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Text
n forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Interface
m
      Placement Placement
m -> Text
"placement/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Placement
m
      Metadata
ProductCodes -> Text
"product-codes"
      Metadata
PublicHostname -> Text
"public-hostname"
      Metadata
PublicIPV4 -> Text
"public-ipv4"
      Metadata
OpenSSHKey -> Text
"public-keys/0/openssh-key"
      Metadata
RAMDiskId -> Text
"ramdisk-id"
      Metadata
ReservationId -> Text
"reservation-id"
      Metadata
SecurityGroups -> Text
"security-groups"
      Services Services
m -> Text
"services/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Services
m
      Spot Spot
m -> Text
"spot/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Spot
m
      Tags Tags
m -> Text
"tags/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Tags
m

-- | Metadata keys for @autoscaling/*@.
data Autoscaling
  = -- | Value showing the target Auto Scaling lifecycle state that an
    -- Auto Scaling instance is transitioning to. Present when the
    -- instance transitions to one of the target lifecycle states
    -- after March 10, 2022. Possible values: @Detached@ | @InService@
    -- | @Standby@ | @Terminated@ | @Warmed:Hibernated@ |
    -- @Warmed:Running@ | @Warmed:Stopped@ | @Warmed:Terminated@. See
    -- [Retrieve the target lifecycle state through instance metadata](https://docs.aws.amazon.com/autoscaling/ec2/userguide/retrieving-target-lifecycle-state-through-imds.html)
    -- in the /Amazon EC2 Auto Scaling User Guide/.
    TargetLifecycleState
  deriving stock (Autoscaling -> Autoscaling -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Autoscaling -> Autoscaling -> Bool
$c/= :: Autoscaling -> Autoscaling -> Bool
== :: Autoscaling -> Autoscaling -> Bool
$c== :: Autoscaling -> Autoscaling -> Bool
Eq, Eq Autoscaling
Autoscaling -> Autoscaling -> Bool
Autoscaling -> Autoscaling -> Ordering
Autoscaling -> Autoscaling -> Autoscaling
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Autoscaling -> Autoscaling -> Autoscaling
$cmin :: Autoscaling -> Autoscaling -> Autoscaling
max :: Autoscaling -> Autoscaling -> Autoscaling
$cmax :: Autoscaling -> Autoscaling -> Autoscaling
>= :: Autoscaling -> Autoscaling -> Bool
$c>= :: Autoscaling -> Autoscaling -> Bool
> :: Autoscaling -> Autoscaling -> Bool
$c> :: Autoscaling -> Autoscaling -> Bool
<= :: Autoscaling -> Autoscaling -> Bool
$c<= :: Autoscaling -> Autoscaling -> Bool
< :: Autoscaling -> Autoscaling -> Bool
$c< :: Autoscaling -> Autoscaling -> Bool
compare :: Autoscaling -> Autoscaling -> Ordering
$ccompare :: Autoscaling -> Autoscaling -> Ordering
Ord, Int -> Autoscaling -> ShowS
[Autoscaling] -> ShowS
Autoscaling -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Autoscaling] -> ShowS
$cshowList :: [Autoscaling] -> ShowS
show :: Autoscaling -> String
$cshow :: Autoscaling -> String
showsPrec :: Int -> Autoscaling -> ShowS
$cshowsPrec :: Int -> Autoscaling -> ShowS
Show, forall x. Rep Autoscaling x -> Autoscaling
forall x. Autoscaling -> Rep Autoscaling x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Autoscaling x -> Autoscaling
$cfrom :: forall x. Autoscaling -> Rep Autoscaling x
Generic)

instance ToText Autoscaling where
  toText :: Autoscaling -> Text
toText = \case
    Autoscaling
TargetLifecycleState -> Text
"target-lifecycle-state"

-- | Metadata keys for @block-device-mapping/*@.
data Mapping
  = -- | The virtual device that contains the root/boot file system.
    AMI
  | -- | The virtual devices associated with Amazon EBS volumes, if present.
    -- This value is only available in metadata if it is present at launch time.
    -- The N indicates the index of the Amazon EBS volume (such as ebs1 or ebs2).
    EBS !Int
  | -- | The virtual devices associated with ephemeral devices, if present.
    -- The N indicates the index of the ephemeral volume.
    Ephemeral !Int
  | -- | The virtual devices or partitions associated with the root devices,
    -- or partitions on the virtual device, where the root (/ or C:) file system
    -- is associated with the given instance.
    Root
  | -- | The virtual devices associated with swap. Not always present.
    Swap
  deriving stock (Mapping -> Mapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mapping -> Mapping -> Bool
$c/= :: Mapping -> Mapping -> Bool
== :: Mapping -> Mapping -> Bool
$c== :: Mapping -> Mapping -> Bool
Eq, Eq Mapping
Mapping -> Mapping -> Bool
Mapping -> Mapping -> Ordering
Mapping -> Mapping -> Mapping
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mapping -> Mapping -> Mapping
$cmin :: Mapping -> Mapping -> Mapping
max :: Mapping -> Mapping -> Mapping
$cmax :: Mapping -> Mapping -> Mapping
>= :: Mapping -> Mapping -> Bool
$c>= :: Mapping -> Mapping -> Bool
> :: Mapping -> Mapping -> Bool
$c> :: Mapping -> Mapping -> Bool
<= :: Mapping -> Mapping -> Bool
$c<= :: Mapping -> Mapping -> Bool
< :: Mapping -> Mapping -> Bool
$c< :: Mapping -> Mapping -> Bool
compare :: Mapping -> Mapping -> Ordering
$ccompare :: Mapping -> Mapping -> Ordering
Ord, Int -> Mapping -> ShowS
[Mapping] -> ShowS
Mapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mapping] -> ShowS
$cshowList :: [Mapping] -> ShowS
show :: Mapping -> String
$cshow :: Mapping -> String
showsPrec :: Int -> Mapping -> ShowS
$cshowsPrec :: Int -> Mapping -> ShowS
Show, forall x. Rep Mapping x -> Mapping
forall x. Mapping -> Rep Mapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mapping x -> Mapping
$cfrom :: forall x. Mapping -> Rep Mapping x
Generic)

instance ToText Mapping where
  toText :: Mapping -> Text
toText = \case
    Mapping
AMI -> Text
"ami"
    EBS Int
n -> Text
"ebs" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Int
n
    Ephemeral Int
n -> Text
"ephemeral" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Int
n
    Mapping
Root -> Text
"root"
    Mapping
Swap -> Text
"root"

-- | Metadata keys for @elastic-gpus/*@.
newtype ElasticGpus
  = -- | If there is an Elastic GPU attached to the instance, contains
    -- a JSON string with information about the Elastic GPU, including
    -- its ID and connection information.
    EGAssociations Text
  deriving stock (ElasticGpus -> ElasticGpus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElasticGpus -> ElasticGpus -> Bool
$c/= :: ElasticGpus -> ElasticGpus -> Bool
== :: ElasticGpus -> ElasticGpus -> Bool
$c== :: ElasticGpus -> ElasticGpus -> Bool
Eq, Eq ElasticGpus
ElasticGpus -> ElasticGpus -> Bool
ElasticGpus -> ElasticGpus -> Ordering
ElasticGpus -> ElasticGpus -> ElasticGpus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ElasticGpus -> ElasticGpus -> ElasticGpus
$cmin :: ElasticGpus -> ElasticGpus -> ElasticGpus
max :: ElasticGpus -> ElasticGpus -> ElasticGpus
$cmax :: ElasticGpus -> ElasticGpus -> ElasticGpus
>= :: ElasticGpus -> ElasticGpus -> Bool
$c>= :: ElasticGpus -> ElasticGpus -> Bool
> :: ElasticGpus -> ElasticGpus -> Bool
$c> :: ElasticGpus -> ElasticGpus -> Bool
<= :: ElasticGpus -> ElasticGpus -> Bool
$c<= :: ElasticGpus -> ElasticGpus -> Bool
< :: ElasticGpus -> ElasticGpus -> Bool
$c< :: ElasticGpus -> ElasticGpus -> Bool
compare :: ElasticGpus -> ElasticGpus -> Ordering
$ccompare :: ElasticGpus -> ElasticGpus -> Ordering
Ord, Int -> ElasticGpus -> ShowS
[ElasticGpus] -> ShowS
ElasticGpus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElasticGpus] -> ShowS
$cshowList :: [ElasticGpus] -> ShowS
show :: ElasticGpus -> String
$cshow :: ElasticGpus -> String
showsPrec :: Int -> ElasticGpus -> ShowS
$cshowsPrec :: Int -> ElasticGpus -> ShowS
Show, forall x. Rep ElasticGpus x -> ElasticGpus
forall x. ElasticGpus -> Rep ElasticGpus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ElasticGpus x -> ElasticGpus
$cfrom :: forall x. ElasticGpus -> Rep ElasticGpus x
Generic)

instance ToText ElasticGpus where
  toText :: ElasticGpus -> Text
toText = \case
    EGAssociations Text
gpuId -> Text
"associations/" forall a. Semigroup a => a -> a -> a
<> Text
gpuId

-- | Metadata keys for @elastic-inference/*@.
newtype ElasticInference
  = -- | If there is an Elastic Inference accelerator attached to the
    -- instance, contains a JSON string with information about the
    -- Elastic Inference accelerator, including its ID and type.
    EIAssociations Text
  deriving stock (ElasticInference -> ElasticInference -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElasticInference -> ElasticInference -> Bool
$c/= :: ElasticInference -> ElasticInference -> Bool
== :: ElasticInference -> ElasticInference -> Bool
$c== :: ElasticInference -> ElasticInference -> Bool
Eq, Eq ElasticInference
ElasticInference -> ElasticInference -> Bool
ElasticInference -> ElasticInference -> Ordering
ElasticInference -> ElasticInference -> ElasticInference
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ElasticInference -> ElasticInference -> ElasticInference
$cmin :: ElasticInference -> ElasticInference -> ElasticInference
max :: ElasticInference -> ElasticInference -> ElasticInference
$cmax :: ElasticInference -> ElasticInference -> ElasticInference
>= :: ElasticInference -> ElasticInference -> Bool
$c>= :: ElasticInference -> ElasticInference -> Bool
> :: ElasticInference -> ElasticInference -> Bool
$c> :: ElasticInference -> ElasticInference -> Bool
<= :: ElasticInference -> ElasticInference -> Bool
$c<= :: ElasticInference -> ElasticInference -> Bool
< :: ElasticInference -> ElasticInference -> Bool
$c< :: ElasticInference -> ElasticInference -> Bool
compare :: ElasticInference -> ElasticInference -> Ordering
$ccompare :: ElasticInference -> ElasticInference -> Ordering
Ord, Int -> ElasticInference -> ShowS
[ElasticInference] -> ShowS
ElasticInference -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElasticInference] -> ShowS
$cshowList :: [ElasticInference] -> ShowS
show :: ElasticInference -> String
$cshow :: ElasticInference -> String
showsPrec :: Int -> ElasticInference -> ShowS
$cshowsPrec :: Int -> ElasticInference -> ShowS
Show, forall x. Rep ElasticInference x -> ElasticInference
forall x. ElasticInference -> Rep ElasticInference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ElasticInference x -> ElasticInference
$cfrom :: forall x. ElasticInference -> Rep ElasticInference x
Generic)

instance ToText ElasticInference where
  toText :: ElasticInference -> Text
toText = \case
    EIAssociations Text
eiId -> Text
"associations/" forall a. Semigroup a => a -> a -> a
<> Text
eiId

-- | Metadata keys for @events/*@.
data Events
  = Maintenance !Maintenance
  | Recommendations !Recommendations
  deriving stock (Events -> Events -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Events -> Events -> Bool
$c/= :: Events -> Events -> Bool
== :: Events -> Events -> Bool
$c== :: Events -> Events -> Bool
Eq, Eq Events
Events -> Events -> Bool
Events -> Events -> Ordering
Events -> Events -> Events
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Events -> Events -> Events
$cmin :: Events -> Events -> Events
max :: Events -> Events -> Events
$cmax :: Events -> Events -> Events
>= :: Events -> Events -> Bool
$c>= :: Events -> Events -> Bool
> :: Events -> Events -> Bool
$c> :: Events -> Events -> Bool
<= :: Events -> Events -> Bool
$c<= :: Events -> Events -> Bool
< :: Events -> Events -> Bool
$c< :: Events -> Events -> Bool
compare :: Events -> Events -> Ordering
$ccompare :: Events -> Events -> Ordering
Ord, Int -> Events -> ShowS
[Events] -> ShowS
Events -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Events] -> ShowS
$cshowList :: [Events] -> ShowS
show :: Events -> String
$cshow :: Events -> String
showsPrec :: Int -> Events -> ShowS
$cshowsPrec :: Int -> Events -> ShowS
Show, forall x. Rep Events x -> Events
forall x. Events -> Rep Events x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Events x -> Events
$cfrom :: forall x. Events -> Rep Events x
Generic)

instance ToText Events where
  toText :: Events -> Text
toText = \case
    Maintenance Maintenance
m -> Text
"maintenance/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Maintenance
m
    Recommendations Recommendations
m -> Text
"recommendations/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Recommendations
m

-- | Metadata keys for @events/maintenance/*@.
data Maintenance
  = -- | If there are completed or canceled maintenance events for the
    -- instance, contains a JSON string with information about the
    -- events. For more information, see
    -- [To view event history about completed or canceled events](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/monitoring-instances-status-check_sched.html#viewing-event-history).
    History
  | -- | If there are active maintenance events for the instance,
    -- contains a JSON string with information about the events. For
    -- more information, see
    -- [View scheduled events](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/monitoring-instances-status-check_sched.html#viewing_scheduled_events).
    Scheduled
  deriving stock (Maintenance -> Maintenance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Maintenance -> Maintenance -> Bool
$c/= :: Maintenance -> Maintenance -> Bool
== :: Maintenance -> Maintenance -> Bool
$c== :: Maintenance -> Maintenance -> Bool
Eq, Eq Maintenance
Maintenance -> Maintenance -> Bool
Maintenance -> Maintenance -> Ordering
Maintenance -> Maintenance -> Maintenance
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Maintenance -> Maintenance -> Maintenance
$cmin :: Maintenance -> Maintenance -> Maintenance
max :: Maintenance -> Maintenance -> Maintenance
$cmax :: Maintenance -> Maintenance -> Maintenance
>= :: Maintenance -> Maintenance -> Bool
$c>= :: Maintenance -> Maintenance -> Bool
> :: Maintenance -> Maintenance -> Bool
$c> :: Maintenance -> Maintenance -> Bool
<= :: Maintenance -> Maintenance -> Bool
$c<= :: Maintenance -> Maintenance -> Bool
< :: Maintenance -> Maintenance -> Bool
$c< :: Maintenance -> Maintenance -> Bool
compare :: Maintenance -> Maintenance -> Ordering
$ccompare :: Maintenance -> Maintenance -> Ordering
Ord, Int -> Maintenance -> ShowS
[Maintenance] -> ShowS
Maintenance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Maintenance] -> ShowS
$cshowList :: [Maintenance] -> ShowS
show :: Maintenance -> String
$cshow :: Maintenance -> String
showsPrec :: Int -> Maintenance -> ShowS
$cshowsPrec :: Int -> Maintenance -> ShowS
Show, forall x. Rep Maintenance x -> Maintenance
forall x. Maintenance -> Rep Maintenance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Maintenance x -> Maintenance
$cfrom :: forall x. Maintenance -> Rep Maintenance x
Generic)

instance ToText Maintenance where
  toText :: Maintenance -> Text
toText = \case
    Maintenance
History -> Text
"history"
    Maintenance
Scheduled -> Text
"scheduled"

-- | Metadata keys for @events\/recommendations\/*@.
data Recommendations
  = -- | The approximate time, in UTC, when the EC2 instance rebalance
    -- recommendation notification is emitted for the instance. The
    -- following is an example of the metadata for this category:
    -- @{"noticeTime": "2020-11-05T08:22:00Z"}@. This category is
    -- available only after the notification is emitted. For more
    -- information, see
    -- [EC2 instance rebalance recommendations](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/rebalance-recommendations.html).
    Rebalance
  deriving stock (Recommendations -> Recommendations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recommendations -> Recommendations -> Bool
$c/= :: Recommendations -> Recommendations -> Bool
== :: Recommendations -> Recommendations -> Bool
$c== :: Recommendations -> Recommendations -> Bool
Eq, Eq Recommendations
Recommendations -> Recommendations -> Bool
Recommendations -> Recommendations -> Ordering
Recommendations -> Recommendations -> Recommendations
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Recommendations -> Recommendations -> Recommendations
$cmin :: Recommendations -> Recommendations -> Recommendations
max :: Recommendations -> Recommendations -> Recommendations
$cmax :: Recommendations -> Recommendations -> Recommendations
>= :: Recommendations -> Recommendations -> Bool
$c>= :: Recommendations -> Recommendations -> Bool
> :: Recommendations -> Recommendations -> Bool
$c> :: Recommendations -> Recommendations -> Bool
<= :: Recommendations -> Recommendations -> Bool
$c<= :: Recommendations -> Recommendations -> Bool
< :: Recommendations -> Recommendations -> Bool
$c< :: Recommendations -> Recommendations -> Bool
compare :: Recommendations -> Recommendations -> Ordering
$ccompare :: Recommendations -> Recommendations -> Ordering
Ord, Int -> Recommendations -> ShowS
[Recommendations] -> ShowS
Recommendations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recommendations] -> ShowS
$cshowList :: [Recommendations] -> ShowS
show :: Recommendations -> String
$cshow :: Recommendations -> String
showsPrec :: Int -> Recommendations -> ShowS
$cshowsPrec :: Int -> Recommendations -> ShowS
Show, forall x. Rep Recommendations x -> Recommendations
forall x. Recommendations -> Rep Recommendations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Recommendations x -> Recommendations
$cfrom :: forall x. Recommendations -> Rep Recommendations x
Generic)

instance ToText Recommendations where
  toText :: Recommendations -> Text
toText = \case
    Recommendations
Rebalance -> Text
"rebalance"

-- | Metadata keys for @iam/*@.
data IAM
  = -- | If there is an IAM role associated with the instance,
    -- contains information about the last time the instance profile
    -- was updated, including the instance's LastUpdated date,
    -- InstanceProfileArn, and InstanceProfileId. Otherwise, not
    -- present.
    Info
  | -- | If there is an IAM role associated with the instance,
    -- @role-name@ is the name of the role, and @role-name@ contains the
    -- temporary security credentials associated with the role (for
    -- more information, see
    -- [Retrieve security credentials from instance metadata](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/iam-roles-for-amazon-ec2.html#instance-metadata-security-credentials)).
    -- Otherwise, not present.
    --
    -- See: 'Auth' for JSON deserialisation.
    SecurityCredentials (Maybe Text)
  deriving stock (IAM -> IAM -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IAM -> IAM -> Bool
$c/= :: IAM -> IAM -> Bool
== :: IAM -> IAM -> Bool
$c== :: IAM -> IAM -> Bool
Eq, Eq IAM
IAM -> IAM -> Bool
IAM -> IAM -> Ordering
IAM -> IAM -> IAM
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IAM -> IAM -> IAM
$cmin :: IAM -> IAM -> IAM
max :: IAM -> IAM -> IAM
$cmax :: IAM -> IAM -> IAM
>= :: IAM -> IAM -> Bool
$c>= :: IAM -> IAM -> Bool
> :: IAM -> IAM -> Bool
$c> :: IAM -> IAM -> Bool
<= :: IAM -> IAM -> Bool
$c<= :: IAM -> IAM -> Bool
< :: IAM -> IAM -> Bool
$c< :: IAM -> IAM -> Bool
compare :: IAM -> IAM -> Ordering
$ccompare :: IAM -> IAM -> Ordering
Ord, Int -> IAM -> ShowS
[IAM] -> ShowS
IAM -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IAM] -> ShowS
$cshowList :: [IAM] -> ShowS
show :: IAM -> String
$cshow :: IAM -> String
showsPrec :: Int -> IAM -> ShowS
$cshowsPrec :: Int -> IAM -> ShowS
Show, forall x. Rep IAM x -> IAM
forall x. IAM -> Rep IAM x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IAM x -> IAM
$cfrom :: forall x. IAM -> Rep IAM x
Generic)

instance ToText IAM where
  toText :: IAM -> Text
toText = \case
    IAM
Info -> Text
"info"
    SecurityCredentials Maybe Text
r -> Text
"security-credentials/" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. ToText a => a -> Text
toText Maybe Text
r

-- | Metadata keys for @identity-credentials\/ec2\/*@.
data IdentityCredentialsEC2
  = -- | Information about the credentials in
    -- @identity-credentials/ec2/security-credentials/ec2-instance@.
    ICEInfo
  | -- | Credentials for the instance identity role that allow
    -- on-instance software to identify itself to AWS to support
    -- features such as EC2 Instance Connect and AWS Systems Manager
    -- Default Host Management Configuration. These credentials have
    -- no policies attached, so they have no additional AWS API
    -- permissions beyond identifying the instance to the AWS
    -- feature. For more information, see [Instance identity
    -- roles](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-identity-roles.html).
    ICESecurityCredentials
  deriving stock (IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
$c/= :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
== :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
$c== :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
Eq, Eq IdentityCredentialsEC2
IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Ordering
IdentityCredentialsEC2
-> IdentityCredentialsEC2 -> IdentityCredentialsEC2
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IdentityCredentialsEC2
-> IdentityCredentialsEC2 -> IdentityCredentialsEC2
$cmin :: IdentityCredentialsEC2
-> IdentityCredentialsEC2 -> IdentityCredentialsEC2
max :: IdentityCredentialsEC2
-> IdentityCredentialsEC2 -> IdentityCredentialsEC2
$cmax :: IdentityCredentialsEC2
-> IdentityCredentialsEC2 -> IdentityCredentialsEC2
>= :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
$c>= :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
> :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
$c> :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
<= :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
$c<= :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
< :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
$c< :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Bool
compare :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Ordering
$ccompare :: IdentityCredentialsEC2 -> IdentityCredentialsEC2 -> Ordering
Ord, Int -> IdentityCredentialsEC2 -> ShowS
[IdentityCredentialsEC2] -> ShowS
IdentityCredentialsEC2 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentityCredentialsEC2] -> ShowS
$cshowList :: [IdentityCredentialsEC2] -> ShowS
show :: IdentityCredentialsEC2 -> String
$cshow :: IdentityCredentialsEC2 -> String
showsPrec :: Int -> IdentityCredentialsEC2 -> ShowS
$cshowsPrec :: Int -> IdentityCredentialsEC2 -> ShowS
Show, forall x. Rep IdentityCredentialsEC2 x -> IdentityCredentialsEC2
forall x. IdentityCredentialsEC2 -> Rep IdentityCredentialsEC2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdentityCredentialsEC2 x -> IdentityCredentialsEC2
$cfrom :: forall x. IdentityCredentialsEC2 -> Rep IdentityCredentialsEC2 x
Generic)

instance ToText IdentityCredentialsEC2 where
  toText :: IdentityCredentialsEC2 -> Text
toText = \case
    IdentityCredentialsEC2
ICEInfo -> Text
"info"
    IdentityCredentialsEC2
ICESecurityCredentials -> Text
"security-credentials/ec2-instance"

-- | Metadata keys for @network\/interfaces\/macs\/${mac}\/*@.
data Interface
  = -- | The unique device number associated with that interface. The
    -- device number corresponds to the device name; for example, a
    -- @device-number@ of 2 is for the eth2 device. This category
    -- corresponds to the @DeviceIndex@ and @device-index@ fields that
    -- are used by the Amazon EC2 API and the EC2 commands for the AWS
    -- CLI.
    IDeviceNumber
  | -- | The ID of the network interface.
    IInterfaceId
  | -- | The private IPv4 addresses that are associated with each public-ip
    -- address and assigned to that interface.
    IIPV4Associations !Text
  | -- | The IPv6 addresses associated with the interface. Returned
    -- only for instances launched into a VPC.
    IIPV6s
  | -- | The private IPv4 DNS hostname of the instance. In cases where
    -- multiple network interfaces are present, this refers to the
    -- eth0 device (the device for which the device number is 0). If
    -- this is a IPv6-only instance, this is the resource-based
    -- name. For more information about IPBN and RBN, see
    -- [Amazon EC2 instance hostname types](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-instance-naming.html).
    ILocalHostname
  | -- | The private IPv4 addresses associated with the interface. If
    -- this is an IPv6-only network interface, this item is not set
    -- and results in an HTTP 404 response.
    ILocalIPV4s
  | -- | The instance's MAC address.
    IMAC
  | -- | The index of the network card. Some instance types support multiple network cards.
    INetworkCardIndex
  | -- | The ID of the owner of the network interface. In multiple-interface
    -- environments, an interface can be attached by a third party, such as
    -- Elastic Load Balancing. Traffic on an interface is always billed to
    -- the interface owner.
    IOwnerId
  | -- | The interface's public DNS (IPv4). This category is only
    -- returned if the @enableDnsHostnames@ attribute is set to
    -- @true@. For more information, see
    -- [Using DNS with Your VPC](https://docs.aws.amazon.com/vpc/latest/userguide/vpc-dns.html)
    -- in the /Amazon VPC User Guide/. If the instance only has a
    -- public-IPv6 address and no public-IPv4 address, this item is
    -- not set and results in an HTTP 404 response.
    IPublicHostname
  | -- | The Elastic IP addresses associated with the interface. There may be
    -- multiple IP addresses on an instance.
    IPublicIPV4s
  | -- | Security groups to which the network interface belongs.
    ISecurityGroups
  | -- | The IDs of the security groups to which the network interface belongs.
    ISecurityGroupIds
  | -- | The ID of the subnet in which the interface resides.
    ISubnetId
  | -- | The IPv4 CIDR block of the subnet in which the interface resides.
    ISubnetIPV4_CIDRBlock
  | -- | The IPv6 CIDR block of the subnet in which the interface resides.
    ISubnetIPV6_CIDRBlock
  | -- | The ID of the VPC in which the interface resides.
    IVPCId
  | -- | The primary IPv4 CIDR block of the VPC.
    IVPCIPV4_CIDRBlock
  | -- | The IPv4 CIDR blocks for the VPC.
    IVPCIPV4_CIDRBlocks
  | -- | The IPv6 CIDR block of the VPC in which the interface resides.
    IVPCIPV6_CIDRBlocks
  deriving stock (Interface -> Interface -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interface -> Interface -> Bool
$c/= :: Interface -> Interface -> Bool
== :: Interface -> Interface -> Bool
$c== :: Interface -> Interface -> Bool
Eq, Eq Interface
Interface -> Interface -> Bool
Interface -> Interface -> Ordering
Interface -> Interface -> Interface
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Interface -> Interface -> Interface
$cmin :: Interface -> Interface -> Interface
max :: Interface -> Interface -> Interface
$cmax :: Interface -> Interface -> Interface
>= :: Interface -> Interface -> Bool
$c>= :: Interface -> Interface -> Bool
> :: Interface -> Interface -> Bool
$c> :: Interface -> Interface -> Bool
<= :: Interface -> Interface -> Bool
$c<= :: Interface -> Interface -> Bool
< :: Interface -> Interface -> Bool
$c< :: Interface -> Interface -> Bool
compare :: Interface -> Interface -> Ordering
$ccompare :: Interface -> Interface -> Ordering
Ord, Int -> Interface -> ShowS
[Interface] -> ShowS
Interface -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interface] -> ShowS
$cshowList :: [Interface] -> ShowS
show :: Interface -> String
$cshow :: Interface -> String
showsPrec :: Int -> Interface -> ShowS
$cshowsPrec :: Int -> Interface -> ShowS
Show, forall x. Rep Interface x -> Interface
forall x. Interface -> Rep Interface x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Interface x -> Interface
$cfrom :: forall x. Interface -> Rep Interface x
Generic)

instance ToText Interface where
  toText :: Interface -> Text
toText = \case
    Interface
IDeviceNumber -> Text
"device-number"
    Interface
IInterfaceId -> Text
"interface-id"
    IIPV4Associations Text
ip -> Text
"ipv4-associations/" forall a. Semigroup a => a -> a -> a
<> forall a. ToText a => a -> Text
toText Text
ip
    Interface
IIPV6s -> Text
"ipv6s"
    Interface
ILocalHostname -> Text
"local-hostname"
    Interface
ILocalIPV4s -> Text
"local-ipv4s"
    Interface
IMAC -> Text
"mac"
    Interface
INetworkCardIndex -> Text
"network-card-index"
    Interface
IOwnerId -> Text
"owner-id"
    Interface
IPublicHostname -> Text
"public-hostname"
    Interface
IPublicIPV4s -> Text
"public-ipv4s"
    Interface
ISecurityGroups -> Text
"security-groups"
    Interface
ISecurityGroupIds -> Text
"security-group-ids"
    Interface
ISubnetId -> Text
"subnet-id"
    Interface
ISubnetIPV4_CIDRBlock -> Text
"subnet-ipv4-cidr-block"
    Interface
ISubnetIPV6_CIDRBlock -> Text
"subnet-ipv6-cidr-block"
    Interface
IVPCId -> Text
"vpc-id"
    Interface
IVPCIPV4_CIDRBlock -> Text
"vpc-ipv4-cidr-block"
    Interface
IVPCIPV4_CIDRBlocks -> Text
"vpc-ipv4-cidr-blocks"
    Interface
IVPCIPV6_CIDRBlocks -> Text
"vpc-ipv6-cidr-blocks"

-- | Metadata keys for @placement/*@.
data Placement
  = -- | The Availability Zone in which the instance launched.
    AvailabilityZone
  | -- | The static Availability Zone ID in which the instance is
    -- launched. The Availability Zone ID is consistent across
    -- accounts. However, it might be different from the Availability
    -- Zone, which can vary by account.
    AvailabilityZoneId
  | -- | The name of the placement group in which the instance is launched.
    GroupName
  | -- | The ID of the host on which the instance is
    -- launched. Applicable only to Dedicated Hosts.
    HostId
  | -- | The number of the partition in which the instance is launched.
    PartitionNumber
  | -- | The AWS Region in which the instance is launched.
    Region
  deriving stock (Placement -> Placement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Placement -> Placement -> Bool
$c/= :: Placement -> Placement -> Bool
== :: Placement -> Placement -> Bool
$c== :: Placement -> Placement -> Bool
Eq, Eq Placement
Placement -> Placement -> Bool
Placement -> Placement -> Ordering
Placement -> Placement -> Placement
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Placement -> Placement -> Placement
$cmin :: Placement -> Placement -> Placement
max :: Placement -> Placement -> Placement
$cmax :: Placement -> Placement -> Placement
>= :: Placement -> Placement -> Bool
$c>= :: Placement -> Placement -> Bool
> :: Placement -> Placement -> Bool
$c> :: Placement -> Placement -> Bool
<= :: Placement -> Placement -> Bool
$c<= :: Placement -> Placement -> Bool
< :: Placement -> Placement -> Bool
$c< :: Placement -> Placement -> Bool
compare :: Placement -> Placement -> Ordering
$ccompare :: Placement -> Placement -> Ordering
Ord, Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Placement] -> ShowS
$cshowList :: [Placement] -> ShowS
show :: Placement -> String
$cshow :: Placement -> String
showsPrec :: Int -> Placement -> ShowS
$cshowsPrec :: Int -> Placement -> ShowS
Show, forall x. Rep Placement x -> Placement
forall x. Placement -> Rep Placement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Placement x -> Placement
$cfrom :: forall x. Placement -> Rep Placement x
Generic)

instance ToText Placement where
  toText :: Placement -> Text
toText = \case
    Placement
AvailabilityZone -> Text
"availability-zone"
    Placement
AvailabilityZoneId -> Text
"availability-zone-id"
    Placement
GroupName -> Text
"group-name"
    Placement
HostId -> Text
"host-id"
    Placement
PartitionNumber -> Text
"partition-number"
    Placement
Region -> Text
"region"

-- | Metadata keys for @services/*@.
data Services
  = -- | The domain for AWS resources for the Region.
    Domain
  | -- | The partition that the resource is in. For standard AWS
    -- Regions, the partition is @aws@. If you have resources in other
    -- partitions, the partition is @aws-${partitionname}@. For example,
    -- the partition for resources in the China (Beijing) Region is
    -- @aws-cn@.
    Partition
  deriving stock (Services -> Services -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Services -> Services -> Bool
$c/= :: Services -> Services -> Bool
== :: Services -> Services -> Bool
$c== :: Services -> Services -> Bool
Eq, Eq Services
Services -> Services -> Bool
Services -> Services -> Ordering
Services -> Services -> Services
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Services -> Services -> Services
$cmin :: Services -> Services -> Services
max :: Services -> Services -> Services
$cmax :: Services -> Services -> Services
>= :: Services -> Services -> Bool
$c>= :: Services -> Services -> Bool
> :: Services -> Services -> Bool
$c> :: Services -> Services -> Bool
<= :: Services -> Services -> Bool
$c<= :: Services -> Services -> Bool
< :: Services -> Services -> Bool
$c< :: Services -> Services -> Bool
compare :: Services -> Services -> Ordering
$ccompare :: Services -> Services -> Ordering
Ord, Int -> Services -> ShowS
[Services] -> ShowS
Services -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Services] -> ShowS
$cshowList :: [Services] -> ShowS
show :: Services -> String
$cshow :: Services -> String
showsPrec :: Int -> Services -> ShowS
$cshowsPrec :: Int -> Services -> ShowS
Show, forall x. Rep Services x -> Services
forall x. Services -> Rep Services x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Services x -> Services
$cfrom :: forall x. Services -> Rep Services x
Generic)

instance ToText Services where
  toText :: Services -> Text
toText = \case
    Services
Domain -> Text
"domain"
    Services
Partition -> Text
"partition"

-- | Metadata keys for @spot/*@.
data Spot
  = -- | The action (hibernate, stop, or terminate) and the
    -- approximate time, in UTC, when the action will occur. This item
    -- is present only if the Spot Instance has been marked for
    -- hibernate, stop, or terminate. For more information, see
    -- [instance-action](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-instance-termination-notices.html#instance-action-metadata).
    SInstanceAction
  | -- | The approximate time, in UTC, that the operating system for
    -- your Spot Instance will receive the shutdown signal. This item
    -- is present and contains a time value (for example,
    -- 2015-01-05T18:02:00Z) only if the Spot Instance has been marked
    -- for termination by Amazon EC2. The termination-time item is not
    -- set to a time if you terminated the Spot Instance yourself. For
    -- more information, see
    -- [termination-time](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-instance-termination-notices.html#termination-time-metadata).
    STerminationTime
  deriving stock (Spot -> Spot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spot -> Spot -> Bool
$c/= :: Spot -> Spot -> Bool
== :: Spot -> Spot -> Bool
$c== :: Spot -> Spot -> Bool
Eq, Eq Spot
Spot -> Spot -> Bool
Spot -> Spot -> Ordering
Spot -> Spot -> Spot
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Spot -> Spot -> Spot
$cmin :: Spot -> Spot -> Spot
max :: Spot -> Spot -> Spot
$cmax :: Spot -> Spot -> Spot
>= :: Spot -> Spot -> Bool
$c>= :: Spot -> Spot -> Bool
> :: Spot -> Spot -> Bool
$c> :: Spot -> Spot -> Bool
<= :: Spot -> Spot -> Bool
$c<= :: Spot -> Spot -> Bool
< :: Spot -> Spot -> Bool
$c< :: Spot -> Spot -> Bool
compare :: Spot -> Spot -> Ordering
$ccompare :: Spot -> Spot -> Ordering
Ord, Int -> Spot -> ShowS
[Spot] -> ShowS
Spot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Spot] -> ShowS
$cshowList :: [Spot] -> ShowS
show :: Spot -> String
$cshow :: Spot -> String
showsPrec :: Int -> Spot -> ShowS
$cshowsPrec :: Int -> Spot -> ShowS
Show, forall x. Rep Spot x -> Spot
forall x. Spot -> Rep Spot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Spot x -> Spot
$cfrom :: forall x. Spot -> Rep Spot x
Generic)

instance ToText Spot where
  toText :: Spot -> Text
toText = \case
    Spot
SInstanceAction -> Text
"instance-action"
    Spot
STerminationTime -> Text
"termination-time"

-- | Metadata keys for @tags/*@.
data Tags
  = -- | The instance tags associated with the instance. Only
    -- available if you explicitly allow access to tags in instance
    -- metadata. For more information, see
    -- [Allow access to tags in instance metadata](https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Using_Tags.html#allow-access-to-tags-in-IMDS).
    Instance
  deriving stock (Tags -> Tags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tags -> Tags -> Bool
$c/= :: Tags -> Tags -> Bool
== :: Tags -> Tags -> Bool
$c== :: Tags -> Tags -> Bool
Eq, Eq Tags
Tags -> Tags -> Bool
Tags -> Tags -> Ordering
Tags -> Tags -> Tags
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Tags -> Tags -> Tags
$cmin :: Tags -> Tags -> Tags
max :: Tags -> Tags -> Tags
$cmax :: Tags -> Tags -> Tags
>= :: Tags -> Tags -> Bool
$c>= :: Tags -> Tags -> Bool
> :: Tags -> Tags -> Bool
$c> :: Tags -> Tags -> Bool
<= :: Tags -> Tags -> Bool
$c<= :: Tags -> Tags -> Bool
< :: Tags -> Tags -> Bool
$c< :: Tags -> Tags -> Bool
compare :: Tags -> Tags -> Ordering
$ccompare :: Tags -> Tags -> Ordering
Ord, Int -> Tags -> ShowS
[Tags] -> ShowS
Tags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tags] -> ShowS
$cshowList :: [Tags] -> ShowS
show :: Tags -> String
$cshow :: Tags -> String
showsPrec :: Int -> Tags -> ShowS
$cshowsPrec :: Int -> Tags -> ShowS
Show, forall x. Rep Tags x -> Tags
forall x. Tags -> Rep Tags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tags x -> Tags
$cfrom :: forall x. Tags -> Rep Tags x
Generic)

instance ToText Tags where
  toText :: Tags -> Text
toText = \case
    Tags
Instance -> Text
"instance"

latest :: Text
latest :: Text
latest = Text
"http://169.254.169.254/latest/"

-- | Test whether the underlying host is running on EC2 by
-- making an HTTP request to @http://instance-data/latest@.
isEC2 :: MonadIO m => Client.Manager -> m Bool
isEC2 :: forall (m :: * -> *). MonadIO m => Manager -> m Bool
isEC2 Manager
m = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => IO a -> (e -> IO a) -> IO a
Exception.catch IO Bool
req HttpException -> IO Bool
err)
  where
    req :: IO Bool
req = do
      !ByteString
_ <- forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m Text
"http://instance-data/latest"

      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    err :: Client.HttpException -> IO Bool
    err :: HttpException -> IO Bool
err = forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Retrieve the specified 'Dynamic' data.
--
-- Throws 'HttpException' if HTTP communication fails.
dynamic :: MonadIO m => Client.Manager -> Dynamic -> m ByteString
dynamic :: forall (m :: * -> *).
MonadIO m =>
Manager -> Dynamic -> m ByteString
dynamic Manager
m = forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend Text
latest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText

-- | Retrieve the specified 'Metadata'.
--
-- Throws 'HttpException' if HTTP communication fails.
metadata :: MonadIO m => Client.Manager -> Metadata -> m ByteString
metadata :: forall (m :: * -> *).
MonadIO m =>
Manager -> Metadata -> m ByteString
metadata Manager
m = forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend Text
latest forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText

-- | Retrieve the user data. Returns 'Nothing' if no user data is assigned
-- to the instance.
--
-- Throws 'HttpException' if HTTP communication fails.
userdata :: MonadIO m => Client.Manager -> m (Maybe ByteString)
userdata :: forall (m :: * -> *). MonadIO m => Manager -> m (Maybe ByteString)
userdata Manager
m =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m (Text
latest forall a. Semigroup a => a -> a -> a
<> Text
"user-data")) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left (Client.HttpExceptionRequest Request
_ (Client.StatusCodeException Response ()
rs ByteString
_))
        | forall a. Enum a => a -> Int
fromEnum (forall body. Response body -> Status
Client.responseStatus Response ()
rs) forall a. Eq a => a -> a -> Bool
== Int
404 ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      --
      Left HttpException
e -> forall e a. Exception e => e -> IO a
Exception.throwIO HttpException
e
      --
      Right ByteString
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just ByteString
b)

-- | Represents an instance's identity document.
--
-- /Note:/ Fields such as '_instanceType' are represented as unparsed 'Text' and
-- will need to be manually parsed using 'fromText' when the relevant types
-- from a library such as "Amazonka.EC2" are brought into scope.
data IdentityDocument = IdentityDocument
  { IdentityDocument -> Maybe [Text]
devpayProductCodes :: Maybe [Text],
    IdentityDocument -> Maybe [Text]
billingProducts :: Maybe [Text],
    IdentityDocument -> Maybe Text
version :: Maybe Text,
    IdentityDocument -> Maybe Text
privateIp :: Maybe Text,
    IdentityDocument -> Text
availabilityZone :: Text,
    IdentityDocument -> Region
region :: Region,
    IdentityDocument -> Text
instanceId :: Text,
    IdentityDocument -> Text
instanceType :: Text,
    IdentityDocument -> Text
accountId :: Text,
    IdentityDocument -> Maybe Text
imageId :: Maybe Text,
    IdentityDocument -> Maybe Text
kernelId :: Maybe Text,
    IdentityDocument -> Maybe Text
ramdiskId :: Maybe Text,
    IdentityDocument -> Maybe Text
architecture :: Maybe Text,
    IdentityDocument -> Maybe ISO8601
pendingTime :: Maybe ISO8601
  }
  deriving stock (IdentityDocument -> IdentityDocument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IdentityDocument -> IdentityDocument -> Bool
$c/= :: IdentityDocument -> IdentityDocument -> Bool
== :: IdentityDocument -> IdentityDocument -> Bool
$c== :: IdentityDocument -> IdentityDocument -> Bool
Eq, Int -> IdentityDocument -> ShowS
[IdentityDocument] -> ShowS
IdentityDocument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdentityDocument] -> ShowS
$cshowList :: [IdentityDocument] -> ShowS
show :: IdentityDocument -> String
$cshow :: IdentityDocument -> String
showsPrec :: Int -> IdentityDocument -> ShowS
$cshowsPrec :: Int -> IdentityDocument -> ShowS
Show, forall x. Rep IdentityDocument x -> IdentityDocument
forall x. IdentityDocument -> Rep IdentityDocument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IdentityDocument x -> IdentityDocument
$cfrom :: forall x. IdentityDocument -> Rep IdentityDocument x
Generic)

instance FromJSON IdentityDocument where
  parseJSON :: Value -> Parser IdentityDocument
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"dynamic/instance-identity/document" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe [Text]
devpayProductCodes <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"devpayProductCodes"
    Maybe [Text]
billingProducts <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"billingProducts"
    Maybe Text
privateIp <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"privateIp"
    Maybe Text
version <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version"
    Text
availabilityZone <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"availabilityZone"
    Region
region <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"region"
    Text
instanceId <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"instanceId"
    Text
instanceType <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"instanceType"
    Text
accountId <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"accountId"
    Maybe Text
imageId <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"imageId"
    Maybe Text
kernelId <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"kernelId"
    Maybe Text
ramdiskId <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ramdiskId"
    Maybe Text
architecture <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"architecture"
    Maybe ISO8601
pendingTime <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pendingTime"
    forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentityDocument {Maybe [Text]
Maybe Text
Maybe ISO8601
Text
Region
pendingTime :: Maybe ISO8601
architecture :: Maybe Text
ramdiskId :: Maybe Text
kernelId :: Maybe Text
imageId :: Maybe Text
accountId :: Text
instanceType :: Text
instanceId :: Text
region :: Region
availabilityZone :: Text
version :: Maybe Text
privateIp :: Maybe Text
billingProducts :: Maybe [Text]
devpayProductCodes :: Maybe [Text]
$sel:pendingTime:IdentityDocument :: Maybe ISO8601
$sel:architecture:IdentityDocument :: Maybe Text
$sel:ramdiskId:IdentityDocument :: Maybe Text
$sel:kernelId:IdentityDocument :: Maybe Text
$sel:imageId:IdentityDocument :: Maybe Text
$sel:accountId:IdentityDocument :: Text
$sel:instanceType:IdentityDocument :: Text
$sel:instanceId:IdentityDocument :: Text
$sel:region:IdentityDocument :: Region
$sel:availabilityZone:IdentityDocument :: Text
$sel:privateIp:IdentityDocument :: Maybe Text
$sel:version:IdentityDocument :: Maybe Text
$sel:billingProducts:IdentityDocument :: Maybe [Text]
$sel:devpayProductCodes:IdentityDocument :: Maybe [Text]
..}

instance ToJSON IdentityDocument where
  toJSON :: IdentityDocument -> Value
toJSON IdentityDocument {Maybe [Text]
Maybe Text
Maybe ISO8601
Text
Region
pendingTime :: Maybe ISO8601
architecture :: Maybe Text
ramdiskId :: Maybe Text
kernelId :: Maybe Text
imageId :: Maybe Text
accountId :: Text
instanceType :: Text
instanceId :: Text
region :: Region
availabilityZone :: Text
privateIp :: Maybe Text
version :: Maybe Text
billingProducts :: Maybe [Text]
devpayProductCodes :: Maybe [Text]
$sel:pendingTime:IdentityDocument :: IdentityDocument -> Maybe ISO8601
$sel:architecture:IdentityDocument :: IdentityDocument -> Maybe Text
$sel:ramdiskId:IdentityDocument :: IdentityDocument -> Maybe Text
$sel:kernelId:IdentityDocument :: IdentityDocument -> Maybe Text
$sel:imageId:IdentityDocument :: IdentityDocument -> Maybe Text
$sel:accountId:IdentityDocument :: IdentityDocument -> Text
$sel:instanceType:IdentityDocument :: IdentityDocument -> Text
$sel:instanceId:IdentityDocument :: IdentityDocument -> Text
$sel:region:IdentityDocument :: IdentityDocument -> Region
$sel:availabilityZone:IdentityDocument :: IdentityDocument -> Text
$sel:privateIp:IdentityDocument :: IdentityDocument -> Maybe Text
$sel:version:IdentityDocument :: IdentityDocument -> Maybe Text
$sel:billingProducts:IdentityDocument :: IdentityDocument -> Maybe [Text]
$sel:devpayProductCodes:IdentityDocument :: IdentityDocument -> Maybe [Text]
..} =
    [Pair] -> Value
object
      [ Key
"devpayProductCodes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
devpayProductCodes,
        Key
"billingProducts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Text]
billingProducts,
        Key
"privateIp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
privateIp,
        Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
version,
        Key
"availabilityZone" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
availabilityZone,
        Key
"region" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Region
region,
        Key
"instanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
instanceId,
        Key
"instanceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
instanceType,
        Key
"accountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
accountId,
        Key
"imageId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
imageId,
        Key
"kernelId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
kernelId,
        Key
"ramdiskId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
ramdiskId,
        Key
"architecture" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
architecture
      ]

{-# INLINE identityDocument_devpayProductCodes #-}
identityDocument_devpayProductCodes :: Lens' IdentityDocument (Maybe [Text])
identityDocument_devpayProductCodes :: Lens' IdentityDocument (Maybe [Text])
identityDocument_devpayProductCodes Maybe [Text] -> f (Maybe [Text])
f i :: IdentityDocument
i@IdentityDocument {Maybe [Text]
devpayProductCodes :: Maybe [Text]
$sel:devpayProductCodes:IdentityDocument :: IdentityDocument -> Maybe [Text]
devpayProductCodes} = Maybe [Text] -> f (Maybe [Text])
f Maybe [Text]
devpayProductCodes forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe [Text]
devpayProductCodes' -> IdentityDocument
i {$sel:devpayProductCodes:IdentityDocument :: Maybe [Text]
devpayProductCodes = Maybe [Text]
devpayProductCodes'}

{-# INLINE identityDocument_billingProducts #-}
identityDocument_billingProducts :: Lens' IdentityDocument (Maybe [Text])
identityDocument_billingProducts :: Lens' IdentityDocument (Maybe [Text])
identityDocument_billingProducts Maybe [Text] -> f (Maybe [Text])
f i :: IdentityDocument
i@IdentityDocument {Maybe [Text]
billingProducts :: Maybe [Text]
$sel:billingProducts:IdentityDocument :: IdentityDocument -> Maybe [Text]
billingProducts} = Maybe [Text] -> f (Maybe [Text])
f Maybe [Text]
billingProducts forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe [Text]
billingProducts' -> IdentityDocument
i {$sel:billingProducts:IdentityDocument :: Maybe [Text]
billingProducts = Maybe [Text]
billingProducts'}

{-# INLINE identityDocument_version #-}
identityDocument_version :: Lens' IdentityDocument (Maybe Text)
identityDocument_version :: Lens' IdentityDocument (Maybe Text)
identityDocument_version Maybe Text -> f (Maybe Text)
f i :: IdentityDocument
i@IdentityDocument {Maybe Text
version :: Maybe Text
$sel:version:IdentityDocument :: IdentityDocument -> Maybe Text
version} = Maybe Text -> f (Maybe Text)
f Maybe Text
version forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
version' -> IdentityDocument
i {$sel:version:IdentityDocument :: Maybe Text
version = Maybe Text
version'}

{-# INLINE identityDocument_privateIp #-}
identityDocument_privateIp :: Lens' IdentityDocument (Maybe Text)
identityDocument_privateIp :: Lens' IdentityDocument (Maybe Text)
identityDocument_privateIp Maybe Text -> f (Maybe Text)
f i :: IdentityDocument
i@IdentityDocument {Maybe Text
privateIp :: Maybe Text
$sel:privateIp:IdentityDocument :: IdentityDocument -> Maybe Text
privateIp} = Maybe Text -> f (Maybe Text)
f Maybe Text
privateIp forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
privateIp' -> IdentityDocument
i {$sel:privateIp:IdentityDocument :: Maybe Text
privateIp = Maybe Text
privateIp'}

{-# INLINE identityDocument_availabilityZone #-}
identityDocument_availabilityZone :: Lens' IdentityDocument Text
identityDocument_availabilityZone :: Lens' IdentityDocument Text
identityDocument_availabilityZone Text -> f Text
f i :: IdentityDocument
i@IdentityDocument {Text
availabilityZone :: Text
$sel:availabilityZone:IdentityDocument :: IdentityDocument -> Text
availabilityZone} = Text -> f Text
f Text
availabilityZone forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
availabilityZone' -> IdentityDocument
i {$sel:availabilityZone:IdentityDocument :: Text
availabilityZone = Text
availabilityZone'}

{-# INLINE identityDocument_region #-}
identityDocument_region :: Lens' IdentityDocument Region
identityDocument_region :: Lens' IdentityDocument Region
identityDocument_region Region -> f Region
f i :: IdentityDocument
i@IdentityDocument {Region
region :: Region
$sel:region:IdentityDocument :: IdentityDocument -> Region
region} = Region -> f Region
f Region
region forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Region
region' -> IdentityDocument
i {$sel:region:IdentityDocument :: Region
region = Region
region'}

{-# INLINE identityDocument_instanceId #-}
identityDocument_instanceId :: Lens' IdentityDocument Text
identityDocument_instanceId :: Lens' IdentityDocument Text
identityDocument_instanceId Text -> f Text
f i :: IdentityDocument
i@IdentityDocument {Text
instanceId :: Text
$sel:instanceId:IdentityDocument :: IdentityDocument -> Text
instanceId} = Text -> f Text
f Text
instanceId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
instanceId' -> IdentityDocument
i {$sel:instanceId:IdentityDocument :: Text
instanceId = Text
instanceId'}

{-# INLINE identityDocument_instanceType #-}
identityDocument_instanceType :: Lens' IdentityDocument Text
identityDocument_instanceType :: Lens' IdentityDocument Text
identityDocument_instanceType Text -> f Text
f i :: IdentityDocument
i@IdentityDocument {Text
instanceType :: Text
$sel:instanceType:IdentityDocument :: IdentityDocument -> Text
instanceType} = Text -> f Text
f Text
instanceType forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
instanceType' -> IdentityDocument
i {$sel:instanceType:IdentityDocument :: Text
instanceType = Text
instanceType'}

{-# INLINE identityDocument_accountId #-}
identityDocument_accountId :: Lens' IdentityDocument Text
identityDocument_accountId :: Lens' IdentityDocument Text
identityDocument_accountId Text -> f Text
f i :: IdentityDocument
i@IdentityDocument {Text
accountId :: Text
$sel:accountId:IdentityDocument :: IdentityDocument -> Text
accountId} = Text -> f Text
f Text
accountId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
accountId' -> IdentityDocument
i {$sel:accountId:IdentityDocument :: Text
accountId = Text
accountId'}

{-# INLINE identityDocument_imageId #-}
identityDocument_imageId :: Lens' IdentityDocument (Maybe Text)
identityDocument_imageId :: Lens' IdentityDocument (Maybe Text)
identityDocument_imageId Maybe Text -> f (Maybe Text)
f i :: IdentityDocument
i@IdentityDocument {Maybe Text
imageId :: Maybe Text
$sel:imageId:IdentityDocument :: IdentityDocument -> Maybe Text
imageId} = Maybe Text -> f (Maybe Text)
f Maybe Text
imageId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
imageId' -> IdentityDocument
i {$sel:imageId:IdentityDocument :: Maybe Text
imageId = Maybe Text
imageId'}

{-# INLINE identityDocument_kernelId #-}
identityDocument_kernelId :: Lens' IdentityDocument (Maybe Text)
identityDocument_kernelId :: Lens' IdentityDocument (Maybe Text)
identityDocument_kernelId Maybe Text -> f (Maybe Text)
f i :: IdentityDocument
i@IdentityDocument {Maybe Text
kernelId :: Maybe Text
$sel:kernelId:IdentityDocument :: IdentityDocument -> Maybe Text
kernelId} = Maybe Text -> f (Maybe Text)
f Maybe Text
kernelId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
kernelId' -> IdentityDocument
i {$sel:kernelId:IdentityDocument :: Maybe Text
kernelId = Maybe Text
kernelId'}

{-# INLINE identityDocument_ramdiskId #-}
identityDocument_ramdiskId :: Lens' IdentityDocument (Maybe Text)
identityDocument_ramdiskId :: Lens' IdentityDocument (Maybe Text)
identityDocument_ramdiskId Maybe Text -> f (Maybe Text)
f i :: IdentityDocument
i@IdentityDocument {Maybe Text
ramdiskId :: Maybe Text
$sel:ramdiskId:IdentityDocument :: IdentityDocument -> Maybe Text
ramdiskId} = Maybe Text -> f (Maybe Text)
f Maybe Text
ramdiskId forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
ramdiskId' -> IdentityDocument
i {$sel:ramdiskId:IdentityDocument :: Maybe Text
ramdiskId = Maybe Text
ramdiskId'}

{-# INLINE identityDocument_architecture #-}
identityDocument_architecture :: Lens' IdentityDocument (Maybe Text)
identityDocument_architecture :: Lens' IdentityDocument (Maybe Text)
identityDocument_architecture Maybe Text -> f (Maybe Text)
f i :: IdentityDocument
i@IdentityDocument {Maybe Text
architecture :: Maybe Text
$sel:architecture:IdentityDocument :: IdentityDocument -> Maybe Text
architecture} = Maybe Text -> f (Maybe Text)
f Maybe Text
architecture forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
architecture' -> IdentityDocument
i {$sel:architecture:IdentityDocument :: Maybe Text
architecture = Maybe Text
architecture'}

{-# INLINE identityDocument_pendingTime #-}
identityDocument_pendingTime :: Lens' IdentityDocument (Maybe ISO8601)
identityDocument_pendingTime :: Lens' IdentityDocument (Maybe ISO8601)
identityDocument_pendingTime Maybe ISO8601 -> f (Maybe ISO8601)
f i :: IdentityDocument
i@IdentityDocument {Maybe ISO8601
pendingTime :: Maybe ISO8601
$sel:pendingTime:IdentityDocument :: IdentityDocument -> Maybe ISO8601
pendingTime} = Maybe ISO8601 -> f (Maybe ISO8601)
f Maybe ISO8601
pendingTime forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe ISO8601
pendingTime' -> IdentityDocument
i {$sel:pendingTime:IdentityDocument :: Maybe ISO8601
pendingTime = Maybe ISO8601
pendingTime'}

-- | Retrieve the instance's identity document, detailing various EC2 metadata.
--
-- You can alternatively retrieve the raw unparsed identity document by using
-- 'dynamic' and the 'Document' path.
--
-- /See:/ <http://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-identity-documents.html AWS Instance Identity Documents>.
identity ::
  MonadIO m =>
  Client.Manager ->
  m (Either String IdentityDocument)
identity :: forall (m :: * -> *).
MonadIO m =>
Manager -> m (Either String IdentityDocument)
identity Manager
m = forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Manager -> Dynamic -> m ByteString
dynamic Manager
m Dynamic
Document

get :: MonadIO m => Client.Manager -> Text -> m ByteString
get :: forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m Text
url = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  ByteString
token <- ByteString -> ByteString
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString
requestToken
  ByteString -> ByteString
strip forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Request -> Request) -> Manager -> Text -> IO ByteString
requestWith (ByteString -> Request -> Request
addToken ByteString
token) Manager
m Text
url
  where
    requestToken :: IO ByteString
requestToken =
      (Request -> Request) -> Manager -> Text -> IO ByteString
requestWith
        ( ByteString -> Request -> Request
setRequestMethod ByteString
"PUT"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> [ByteString] -> Request -> Request
setRequestHeader HeaderName
"X-aws-ec2-metadata-token-ttl-seconds" [ByteString
"60"]
        )
        Manager
m
        (Text
latest forall a. Semigroup a => a -> a -> a
<> Text
"api/token")

    addToken :: ByteString -> Request -> Request
addToken ByteString
token = HeaderName -> [ByteString] -> Request -> Request
setRequestHeader HeaderName
"X-aws-ec2-metadata-token" [ByteString
token]

    strip :: ByteString -> ByteString
strip ByteString
bs
      | ByteString -> ByteString -> Bool
BS8.isSuffixOf ByteString
"\n" ByteString
bs = HasCallStack => ByteString -> ByteString
BS8.init ByteString
bs
      | Bool
otherwise = ByteString
bs

requestWith ::
  (Client.Request -> Client.Request) ->
  Client.Manager ->
  Text ->
  IO ByteString
requestWith :: (Request -> Request) -> Manager -> Text -> IO ByteString
requestWith Request -> Request
modifyRequest Manager
m Text
url = do
  Request
rq <- forall (m :: * -> *). MonadThrow m => String -> m Request
Client.parseUrlThrow (Text -> String
Text.unpack Text
url)
  Response ByteString
rs <- Request -> Manager -> IO (Response ByteString)
Client.httpLbs (Request -> Request
modifyRequest Request
rq) Manager
m

  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
Client.responseBody Response ByteString
rs