{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Amazonka.EC2.Metadata
-- Copyright   : (c) 2013-2021 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 is intended to be used 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 (..),
    Mapping (..),
    Info (..),
    Interface (..),

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

    -- *** Lenses
    devpayProductCodes,
    billingProducts,
    version,
    privateIp,
    availabilityZone,
    region,
    instanceId,
    instanceType,
    accountId,
    imageId,
    kernelId,
    ramdiskId,
    architecture,
    pendingTime,
  )
where

import Amazonka.Data
import Amazonka.Lens (lens, mapping)
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

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
  | Signature
  deriving stock (Dynamic -> Dynamic -> Bool
(Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool) -> Eq Dynamic
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
Eq Dynamic
-> (Dynamic -> Dynamic -> Ordering)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Bool)
-> (Dynamic -> Dynamic -> Dynamic)
-> (Dynamic -> Dynamic -> Dynamic)
-> Ord 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
$cp1Ord :: Eq Dynamic
Ord, Int -> Dynamic -> ShowS
[Dynamic] -> ShowS
Dynamic -> String
(Int -> Dynamic -> ShowS)
-> (Dynamic -> String) -> ([Dynamic] -> ShowS) -> Show Dynamic
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. Dynamic -> Rep Dynamic x)
-> (forall x. Rep Dynamic x -> Dynamic) -> Generic Dynamic
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 = \case
    Dynamic
FWS -> Text
"dynamic/fws/instance-monitoring"
    Dynamic
Document -> Text
"dynamic/instance-identity/document"
    Dynamic
PKCS7 -> Text
"dynamic/instance-identity/pkcs7"
    Dynamic
Signature -> Text
"dynamic/instance-identity/signature"

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: 'Mapping'
    BlockDevice !Mapping
  | -- | The private 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).
    Hostname
  | -- | See: 'Info'
    IAM !Info
  | -- | 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 type of instance.
    --
    -- See: @InstanceType@
    InstanceType
  | -- | The ID of the kernel launched with this instance, if applicable.
    KernelId
  | -- | The private 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).
    LocalHostname
  | -- | The private IP 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).
    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
  | -- | The Availability Zone in which the instance launched.
    AvailabilityZone
  | -- | Product codes associated with the instance, if any.
    ProductCodes
  | -- | The instance's public DNS. If the instance is in a VPC, this category
    -- is only returned if the enableDnsHostnames attribute is set to true.
    -- For more information, see Using DNS with Your VPC.
    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.
    SecurityGroups
  deriving stock (Metadata -> Metadata -> Bool
(Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool) -> Eq Metadata
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
Eq Metadata
-> (Metadata -> Metadata -> Ordering)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Bool)
-> (Metadata -> Metadata -> Metadata)
-> (Metadata -> Metadata -> Metadata)
-> Ord 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
$cp1Ord :: Eq Metadata
Ord, Int -> Metadata -> ShowS
[Metadata] -> ShowS
Metadata -> String
(Int -> Metadata -> ShowS)
-> (Metadata -> String) -> ([Metadata] -> ShowS) -> Show Metadata
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. Metadata -> Rep Metadata x)
-> (forall x. Rep Metadata x -> Metadata) -> Generic Metadata
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 = \case
    Metadata
AMIId -> Text
"meta-data/ami-id"
    Metadata
AMILaunchIndex -> Text
"meta-data/ami-launch-index"
    Metadata
AMIManifestPath -> Text
"meta-data/ami-manifest-path"
    Metadata
AncestorAMIIds -> Text
"meta-data/ancestor-ami-ids"
    BlockDevice Mapping
m -> Text
"meta-data/block-device-mapping/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Mapping -> Text
forall a. ToText a => a -> Text
toText Mapping
m
    Metadata
Hostname -> Text
"meta-data/hostname"
    IAM Info
m -> Text
"meta-data/iam/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Info -> Text
forall a. ToText a => a -> Text
toText Info
m
    Metadata
InstanceAction -> Text
"meta-data/instance-action"
    Metadata
InstanceId -> Text
"meta-data/instance-id"
    Metadata
InstanceType -> Text
"meta-data/instance-type"
    Metadata
KernelId -> Text
"meta-data/kernel-id"
    Metadata
LocalHostname -> Text
"meta-data/local-hostname"
    Metadata
LocalIPV4 -> Text
"meta-data/local-ipv4"
    Metadata
MAC -> Text
"meta-data/mac"
    Network Text
n Interface
m -> Text
"meta-data/network/interfaces/macs/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. ToText a => a -> Text
toText Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Interface -> Text
forall a. ToText a => a -> Text
toText Interface
m
    Metadata
AvailabilityZone -> Text
"meta-data/placement/availability-zone"
    Metadata
ProductCodes -> Text
"meta-data/product-codes"
    Metadata
PublicHostname -> Text
"meta-data/public-hostname"
    Metadata
PublicIPV4 -> Text
"meta-data/public-ipv4"
    Metadata
OpenSSHKey -> Text
"meta-data/public-keys/0/openssh-key"
    Metadata
RAMDiskId -> Text
"meta-data/ramdisk-id"
    Metadata
ReservationId -> Text
"meta-data/reservation-id"
    Metadata
SecurityGroups -> Text
"meta-data/security-groups"

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
(Mapping -> Mapping -> Bool)
-> (Mapping -> Mapping -> Bool) -> Eq Mapping
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
Eq Mapping
-> (Mapping -> Mapping -> Ordering)
-> (Mapping -> Mapping -> Bool)
-> (Mapping -> Mapping -> Bool)
-> (Mapping -> Mapping -> Bool)
-> (Mapping -> Mapping -> Bool)
-> (Mapping -> Mapping -> Mapping)
-> (Mapping -> Mapping -> Mapping)
-> Ord 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
$cp1Ord :: Eq Mapping
Ord, Int -> Mapping -> ShowS
[Mapping] -> ShowS
Mapping -> String
(Int -> Mapping -> ShowS)
-> (Mapping -> String) -> ([Mapping] -> ShowS) -> Show Mapping
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. Mapping -> Rep Mapping x)
-> (forall x. Rep Mapping x -> Mapping) -> Generic Mapping
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" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. ToText a => a -> Text
toText Int
n
    Ephemeral Int
n -> Text
"ephemeral" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. ToText a => a -> Text
toText Int
n
    Mapping
Root -> Text
"root"
    Mapping
Swap -> Text
"root"

data Interface
  = -- | The device number associated with that interface. Each interface must
    -- have a unique device number. The device number serves as a hint to device
    -- naming in the instance; for example, device-number is 2 for the eth2 device.
    IDeviceNumber
  | -- | The private IPv4 addresses that are associated with each public-ip
    -- address and assigned to that interface.
    IIPV4Associations !Text
  | -- | The interface's local hostname.
    ILocalHostname
  | -- | The private IP addresses associated with the interface.
    ILocalIPV4s
  | -- | The instance's MAC address.
    IMAC
  | -- | 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. If the instance is in a VPC, this category
    -- is only returned if the enableDnsHostnames attribute is set to true.
    -- For more information, see Using DNS with Your VPC.
    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. Returned only
    -- for instances launched into a VPC.
    ISecurityGroups
  | -- | IDs of the security groups to which the network interface belongs.
    -- Returned only for instances launched into a VPC. For more information on
    -- security groups in the EC2-VPC platform, see Security Groups for Your VPC.
    ISecurityGroupIds
  | -- | The ID of the subnet in which the interface resides. Returned only for
    -- instances launched into a VPC.
    ISubnetId
  | -- | The CIDR block of the subnet in which the interface resides. Returned
    -- only for instances launched into a VPC.
    ISubnetIPV4_CIDRBlock
  | -- | The ID of the VPC in which the interface resides. Returned only for
    -- instances launched into a VPC.
    IVPCId
  | -- | The CIDR block of the VPC in which the interface resides. Returned only
    -- for instances launched into a VPC.
    IVPCIPV4_CIDRBlock
  deriving stock (Interface -> Interface -> Bool
(Interface -> Interface -> Bool)
-> (Interface -> Interface -> Bool) -> Eq Interface
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
Eq Interface
-> (Interface -> Interface -> Ordering)
-> (Interface -> Interface -> Bool)
-> (Interface -> Interface -> Bool)
-> (Interface -> Interface -> Bool)
-> (Interface -> Interface -> Bool)
-> (Interface -> Interface -> Interface)
-> (Interface -> Interface -> Interface)
-> Ord 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
$cp1Ord :: Eq Interface
Ord, Int -> Interface -> ShowS
[Interface] -> ShowS
Interface -> String
(Int -> Interface -> ShowS)
-> (Interface -> String)
-> ([Interface] -> ShowS)
-> Show Interface
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. Interface -> Rep Interface x)
-> (forall x. Rep Interface x -> Interface) -> Generic Interface
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"
    IIPV4Associations Text
ip -> Text
"ipv4-associations/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. ToText a => a -> Text
toText Text
ip
    Interface
ILocalHostname -> Text
"local-hostname"
    Interface
ILocalIPV4s -> Text
"local-ipv4s"
    Interface
IMAC -> Text
"mac"
    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
IVPCId -> Text
"vpc-id"
    Interface
IVPCIPV4_CIDRBlock -> Text
"vpc-ipv4-cidr-block"

data Info
  = -- | Returns information about the last time the instance profile was updated,
    -- including the instance's LastUpdated date, InstanceProfileArn,
    -- and InstanceProfileId.
    Info'
  | -- | Where role-name is the name of the IAM role associated with the instance.
    -- Returns the temporary security credentials.
    --
    -- See: 'Auth' for JSON deserialisation.
    SecurityCredentials (Maybe Text)
  deriving stock (Info -> Info -> Bool
(Info -> Info -> Bool) -> (Info -> Info -> Bool) -> Eq Info
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Info -> Info -> Bool
$c/= :: Info -> Info -> Bool
== :: Info -> Info -> Bool
$c== :: Info -> Info -> Bool
Eq, Eq Info
Eq Info
-> (Info -> Info -> Ordering)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Bool)
-> (Info -> Info -> Info)
-> (Info -> Info -> Info)
-> Ord Info
Info -> Info -> Bool
Info -> Info -> Ordering
Info -> Info -> Info
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 :: Info -> Info -> Info
$cmin :: Info -> Info -> Info
max :: Info -> Info -> Info
$cmax :: Info -> Info -> Info
>= :: Info -> Info -> Bool
$c>= :: Info -> Info -> Bool
> :: Info -> Info -> Bool
$c> :: Info -> Info -> Bool
<= :: Info -> Info -> Bool
$c<= :: Info -> Info -> Bool
< :: Info -> Info -> Bool
$c< :: Info -> Info -> Bool
compare :: Info -> Info -> Ordering
$ccompare :: Info -> Info -> Ordering
$cp1Ord :: Eq Info
Ord, Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show, (forall x. Info -> Rep Info x)
-> (forall x. Rep Info x -> Info) -> Generic Info
forall x. Rep Info x -> Info
forall x. Info -> Rep Info x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Info x -> Info
$cfrom :: forall x. Info -> Rep Info x
Generic)

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

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 :: Manager -> m Bool
isEC2 Manager
m = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> (HttpException -> IO Bool) -> IO Bool
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
_ <- Manager -> Text -> IO ByteString
request Manager
m Text
"http://instance-data/latest"

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

    err :: Client.HttpException -> IO Bool
    err :: HttpException -> IO Bool
err = IO Bool -> HttpException -> IO Bool
forall a b. a -> b -> a
const (Bool -> IO Bool
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 :: Manager -> Dynamic -> m ByteString
dynamic Manager
m = Manager -> Text -> m ByteString
forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m (Text -> m ByteString)
-> (Dynamic -> Text) -> Dynamic -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
latest (Text -> Text) -> (Dynamic -> Text) -> Dynamic -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic -> Text
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 :: Manager -> Metadata -> m ByteString
metadata Manager
m = Manager -> Text -> m ByteString
forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m (Text -> m ByteString)
-> (Metadata -> Text) -> Metadata -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
latest (Text -> Text) -> (Metadata -> Text) -> Metadata -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Text
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 :: Manager -> m (Maybe ByteString)
userdata Manager
m =
  IO (Maybe ByteString) -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
    IO ByteString -> IO (Either HttpException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (Manager -> Text -> IO ByteString
forall (m :: * -> *). MonadIO m => Manager -> Text -> m ByteString
get Manager
m (Text
latest Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"user-data")) IO (Either HttpException ByteString)
-> (Either HttpException ByteString -> IO (Maybe ByteString))
-> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left (Client.HttpExceptionRequest Request
_ (Client.StatusCodeException Response ()
rs ByteString
_))
        | Status -> Int
forall a. Enum a => a -> Int
fromEnum (Response () -> Status
forall body. Response body -> Status
Client.responseStatus Response ()
rs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
404 ->
          Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
      --
      Left HttpException
e -> HttpException -> IO (Maybe ByteString)
forall e a. Exception e => e -> IO a
Exception.throwIO HttpException
e
      --
      Right ByteString
b -> Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
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
(IdentityDocument -> IdentityDocument -> Bool)
-> (IdentityDocument -> IdentityDocument -> Bool)
-> Eq IdentityDocument
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
(Int -> IdentityDocument -> ShowS)
-> (IdentityDocument -> String)
-> ([IdentityDocument] -> ShowS)
-> Show IdentityDocument
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. IdentityDocument -> Rep IdentityDocument x)
-> (forall x. Rep IdentityDocument x -> IdentityDocument)
-> Generic IdentityDocument
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)

devpayProductCodes :: Lens' IdentityDocument (Maybe [Text])
devpayProductCodes :: (Maybe [Text] -> f (Maybe [Text]))
-> IdentityDocument -> f IdentityDocument
devpayProductCodes = (IdentityDocument -> Maybe [Text])
-> (IdentityDocument -> Maybe [Text] -> IdentityDocument)
-> Lens
     IdentityDocument IdentityDocument (Maybe [Text]) (Maybe [Text])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe [Text]
_devpayProductCodes (\IdentityDocument
s Maybe [Text]
a -> IdentityDocument
s {$sel:_devpayProductCodes:IdentityDocument :: Maybe [Text]
_devpayProductCodes = Maybe [Text]
a})

billingProducts :: Lens' IdentityDocument (Maybe [Text])
billingProducts :: (Maybe [Text] -> f (Maybe [Text]))
-> IdentityDocument -> f IdentityDocument
billingProducts = (IdentityDocument -> Maybe [Text])
-> (IdentityDocument -> Maybe [Text] -> IdentityDocument)
-> Lens
     IdentityDocument IdentityDocument (Maybe [Text]) (Maybe [Text])
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe [Text]
_billingProducts (\IdentityDocument
s Maybe [Text]
a -> IdentityDocument
s {$sel:_billingProducts:IdentityDocument :: Maybe [Text]
_billingProducts = Maybe [Text]
a})

version :: Lens' IdentityDocument (Maybe Text)
version :: (Maybe Text -> f (Maybe Text))
-> IdentityDocument -> f IdentityDocument
version = (IdentityDocument -> Maybe Text)
-> (IdentityDocument -> Maybe Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe Text
_version (\IdentityDocument
s Maybe Text
a -> IdentityDocument
s {$sel:_version:IdentityDocument :: Maybe Text
_version = Maybe Text
a})

privateIp :: Lens' IdentityDocument (Maybe Text)
privateIp :: (Maybe Text -> f (Maybe Text))
-> IdentityDocument -> f IdentityDocument
privateIp = (IdentityDocument -> Maybe Text)
-> (IdentityDocument -> Maybe Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe Text
_privateIp (\IdentityDocument
s Maybe Text
a -> IdentityDocument
s {$sel:_privateIp:IdentityDocument :: Maybe Text
_privateIp = Maybe Text
a})

availabilityZone :: Lens' IdentityDocument Text
availabilityZone :: (Text -> f Text) -> IdentityDocument -> f IdentityDocument
availabilityZone = (IdentityDocument -> Text)
-> (IdentityDocument -> Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Text
_availabilityZone (\IdentityDocument
s Text
a -> IdentityDocument
s {$sel:_availabilityZone:IdentityDocument :: Text
_availabilityZone = Text
a})

region :: Lens' IdentityDocument Region
region :: (Region -> f Region) -> IdentityDocument -> f IdentityDocument
region = (IdentityDocument -> Region)
-> (IdentityDocument -> Region -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument Region Region
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Region
_region (\IdentityDocument
s Region
a -> IdentityDocument
s {$sel:_region:IdentityDocument :: Region
_region = Region
a})

instanceId :: Lens' IdentityDocument Text
instanceId :: (Text -> f Text) -> IdentityDocument -> f IdentityDocument
instanceId = (IdentityDocument -> Text)
-> (IdentityDocument -> Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Text
_instanceId (\IdentityDocument
s Text
a -> IdentityDocument
s {$sel:_instanceId:IdentityDocument :: Text
_instanceId = Text
a})

instanceType :: Lens' IdentityDocument Text
instanceType :: (Text -> f Text) -> IdentityDocument -> f IdentityDocument
instanceType = (IdentityDocument -> Text)
-> (IdentityDocument -> Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Text
_instanceType (\IdentityDocument
s Text
a -> IdentityDocument
s {$sel:_instanceType:IdentityDocument :: Text
_instanceType = Text
a})

accountId :: Lens' IdentityDocument Text
accountId :: (Text -> f Text) -> IdentityDocument -> f IdentityDocument
accountId = (IdentityDocument -> Text)
-> (IdentityDocument -> Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument Text Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Text
_accountId (\IdentityDocument
s Text
a -> IdentityDocument
s {$sel:_accountId:IdentityDocument :: Text
_accountId = Text
a})

imageId :: Lens' IdentityDocument (Maybe Text)
imageId :: (Maybe Text -> f (Maybe Text))
-> IdentityDocument -> f IdentityDocument
imageId = (IdentityDocument -> Maybe Text)
-> (IdentityDocument -> Maybe Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe Text
_imageId (\IdentityDocument
s Maybe Text
a -> IdentityDocument
s {$sel:_imageId:IdentityDocument :: Maybe Text
_imageId = Maybe Text
a})

kernelId :: Lens' IdentityDocument (Maybe Text)
kernelId :: (Maybe Text -> f (Maybe Text))
-> IdentityDocument -> f IdentityDocument
kernelId = (IdentityDocument -> Maybe Text)
-> (IdentityDocument -> Maybe Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe Text
_kernelId (\IdentityDocument
s Maybe Text
a -> IdentityDocument
s {$sel:_kernelId:IdentityDocument :: Maybe Text
_kernelId = Maybe Text
a})

ramdiskId :: Lens' IdentityDocument (Maybe Text)
ramdiskId :: (Maybe Text -> f (Maybe Text))
-> IdentityDocument -> f IdentityDocument
ramdiskId = (IdentityDocument -> Maybe Text)
-> (IdentityDocument -> Maybe Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe Text
_ramdiskId (\IdentityDocument
s Maybe Text
a -> IdentityDocument
s {$sel:_ramdiskId:IdentityDocument :: Maybe Text
_ramdiskId = Maybe Text
a})

architecture :: Lens' IdentityDocument (Maybe Text)
architecture :: (Maybe Text -> f (Maybe Text))
-> IdentityDocument -> f IdentityDocument
architecture = (IdentityDocument -> Maybe Text)
-> (IdentityDocument -> Maybe Text -> IdentityDocument)
-> Lens IdentityDocument IdentityDocument (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe Text
_architecture (\IdentityDocument
s Maybe Text
a -> IdentityDocument
s {$sel:_architecture:IdentityDocument :: Maybe Text
_architecture = Maybe Text
a})

pendingTime :: Lens' IdentityDocument (Maybe UTCTime)
pendingTime :: (Maybe UTCTime -> f (Maybe UTCTime))
-> IdentityDocument -> f IdentityDocument
pendingTime = (IdentityDocument -> Maybe ISO8601)
-> (IdentityDocument -> Maybe ISO8601 -> IdentityDocument)
-> Lens
     IdentityDocument IdentityDocument (Maybe ISO8601) (Maybe ISO8601)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens IdentityDocument -> Maybe ISO8601
_pendingTime (\IdentityDocument
s Maybe ISO8601
a -> IdentityDocument
s {$sel:_pendingTime:IdentityDocument :: Maybe ISO8601
_pendingTime = Maybe ISO8601
a}) ((Maybe ISO8601 -> f (Maybe ISO8601))
 -> IdentityDocument -> f IdentityDocument)
-> ((Maybe UTCTime -> f (Maybe UTCTime))
    -> Maybe ISO8601 -> f (Maybe ISO8601))
-> (Maybe UTCTime -> f (Maybe UTCTime))
-> IdentityDocument
-> f IdentityDocument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso ISO8601 ISO8601 UTCTime UTCTime
-> Iso
     (Maybe ISO8601) (Maybe ISO8601) (Maybe UTCTime) (Maybe UTCTime)
forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
mapping AnIso ISO8601 ISO8601 UTCTime UTCTime
forall (a :: Format). Iso' (Time a) UTCTime
_Time

instance FromJSON IdentityDocument where
  parseJSON :: Value -> Parser IdentityDocument
parseJSON = String
-> (Object -> Parser IdentityDocument)
-> Value
-> Parser IdentityDocument
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"dynamic/instance-identity/document" ((Object -> Parser IdentityDocument)
 -> Value -> Parser IdentityDocument)
-> (Object -> Parser IdentityDocument)
-> Value
-> Parser IdentityDocument
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe [Text]
_devpayProductCodes <- Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"devpayProductCodes"
    Maybe [Text]
_billingProducts <- Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"billingProducts"
    Maybe Text
_privateIp <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"privateIp"
    Maybe Text
_version <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"version"
    Text
_availabilityZone <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"availabilityZone"
    Region
_region <- Object
o Object -> Text -> Parser Region
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"region"
    Text
_instanceId <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"instanceId"
    Text
_instanceType <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"instanceType"
    Text
_accountId <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"accountId"
    Maybe Text
_imageId <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"imageId"
    Maybe Text
_kernelId <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"kernelId"
    Maybe Text
_ramdiskId <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"ramdiskId"
    Maybe Text
_architecture <- Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"architecture"
    Maybe ISO8601
_pendingTime <- Object
o Object -> Text -> Parser (Maybe ISO8601)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"pendingTime"
    IdentityDocument -> Parser IdentityDocument
forall (f :: * -> *) a. Applicative f => a -> f a
pure IdentityDocument :: Maybe [Text]
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Text
-> Region
-> Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> IdentityDocument
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
      [ Text
"devpayProductCodes" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Text]
_devpayProductCodes,
        Text
"billingProducts" Text -> Maybe [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe [Text]
_billingProducts,
        Text
"privateIp" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
_privateIp,
        Text
"version" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
_version,
        Text
"availabilityZone" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
_availabilityZone,
        Text
"region" Text -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Region
_region,
        Text
"instanceId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
_instanceId,
        Text
"instanceType" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
_instanceType,
        Text
"accountId" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
_accountId,
        Text
"imageId" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
_imageId,
        Text
"kernelId" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
_kernelId,
        Text
"ramdiskId" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
_ramdiskId,
        Text
"architecture" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
_architecture
      ]

-- | 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 :: Manager -> m (Either String IdentityDocument)
identity Manager
m = ByteString -> Either String IdentityDocument
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String IdentityDocument)
-> (ByteString -> ByteString)
-> ByteString
-> Either String IdentityDocument
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict (ByteString -> Either String IdentityDocument)
-> m ByteString -> m (Either String IdentityDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager -> Dynamic -> m ByteString
forall (m :: * -> *).
MonadIO m =>
Manager -> Dynamic -> m ByteString
dynamic Manager
m Dynamic
Document

get :: MonadIO m => Client.Manager -> Text -> m ByteString
get :: Manager -> Text -> m ByteString
get Manager
m Text
url = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> ByteString
strip (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Manager -> Text -> IO ByteString
request Manager
m Text
url)
  where
    strip :: ByteString -> ByteString
strip ByteString
bs
      | ByteString -> ByteString -> Bool
BS8.isSuffixOf ByteString
"\n" ByteString
bs = ByteString -> ByteString
BS8.init ByteString
bs
      | Bool
otherwise = ByteString
bs

request :: Client.Manager -> Text -> IO ByteString
request :: Manager -> Text -> IO ByteString
request Manager
m Text
url = do
  Request
rq <- String -> IO Request
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
rq Manager
m

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