{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.AWS.EC2.Metadata
(
isEC2
, dynamic
, metadata
, userdata
, identity
, Dynamic (..)
, Metadata (..)
, Mapping (..)
, Info (..)
, Interface (..)
, IdentityDocument (..)
, devpayProductCodes
, billingProducts
, version
, privateIp
, availabilityZone
, region
, instanceId
, instanceType
, accountId
, imageId
, kernelId
, ramdiskId
, architecture
, pendingTime
) where
import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as LBS
import Data.Monoid
import qualified Data.Text as Text
import Network.AWS.Data.JSON
import Network.AWS.Data.Time
import Network.AWS.Lens (Lens', lens, mapping)
import Network.AWS.Prelude hiding (request)
import Network.HTTP.Conduit
data Dynamic
= FWS
| Document
| PKCS7
| Signature
deriving (Eq, Ord, Show, Typeable)
instance ToText Dynamic where
toText = \case
FWS -> "dynamic/fws/instance-monitoring"
Document -> "dynamic/instance-identity/document"
PKCS7 -> "dynamic/instance-identity/pkcs7"
Signature -> "dynamic/instance-identity/signature"
data Metadata
= AMIId
| AMILaunchIndex
| AMIManifestPath
| AncestorAMIIds
| BlockDevice !Mapping
| Hostname
| IAM !Info
| InstanceAction
| InstanceId
| InstanceType
| KernelId
| LocalHostname
| LocalIPV4
| MAC
| Network !Text !Interface
| AvailabilityZone
| ProductCodes
| PublicHostname
| PublicIPV4
| OpenSSHKey
| RAMDiskId
| ReservationId
| SecurityGroups
deriving (Eq, Ord, Show, Typeable)
instance ToText Metadata where
toText = \case
AMIId -> "meta-data/ami-id"
AMILaunchIndex -> "meta-data/ami-launch-index"
AMIManifestPath -> "meta-data/ami-manifest-path"
AncestorAMIIds -> "meta-data/ancestor-ami-ids"
BlockDevice m -> "meta-data/block-device-mapping/" <> toText m
Hostname -> "meta-data/hostname"
IAM m -> "meta-data/iam/" <> toText m
InstanceAction -> "meta-data/instance-action"
InstanceId -> "meta-data/instance-id"
InstanceType -> "meta-data/instance-type"
KernelId -> "meta-data/kernel-id"
LocalHostname -> "meta-data/local-hostname"
LocalIPV4 -> "meta-data/local-ipv4"
MAC -> "meta-data/mac"
Network n m -> "meta-data/network/interfaces/macs/" <> toText n <> "/" <> toText m
AvailabilityZone -> "meta-data/placement/availability-zone"
ProductCodes -> "meta-data/product-codes"
PublicHostname -> "meta-data/public-hostname"
PublicIPV4 -> "meta-data/public-ipv4"
OpenSSHKey -> "meta-data/public-keys/0/openssh-key"
RAMDiskId -> "meta-data/ramdisk-id"
ReservationId -> "meta-data/reservation-id"
SecurityGroups -> "meta-data/security-groups"
data Mapping
= AMI
| EBS !Int
| Ephemeral !Int
| Root
| Swap
deriving (Eq, Ord, Show, Typeable)
instance ToText Mapping where
toText = \case
AMI -> "ami"
EBS n -> "ebs" <> toText n
Ephemeral n -> "ephemeral" <> toText n
Root -> "root"
Swap -> "root"
data Interface
= IDeviceNumber
| IIPV4Associations !Text
| ILocalHostname
| ILocalIPV4s
| IMAC
| IOwnerId
| IPublicHostname
| IPublicIPV4s
| ISecurityGroups
| ISecurityGroupIds
| ISubnetId
| ISubnetIPV4_CIDRBlock
| IVPCId
| IVPCIPV4_CIDRBlock
deriving (Eq, Ord, Show, Typeable)
instance ToText Interface where
toText = \case
IDeviceNumber -> "device-number"
IIPV4Associations ip -> "ipv4-associations/" <> toText ip
ILocalHostname -> "local-hostname"
ILocalIPV4s -> "local-ipv4s"
IMAC -> "mac"
IOwnerId -> "owner-id"
IPublicHostname -> "public-hostname"
IPublicIPV4s -> "public-ipv4s"
ISecurityGroups -> "security-groups"
ISecurityGroupIds -> "security-group-ids"
ISubnetId -> "subnet-id"
ISubnetIPV4_CIDRBlock -> "subnet-ipv4-cidr-block"
IVPCId -> "vpc-id"
IVPCIPV4_CIDRBlock -> "vpc-ipv4-cidr-block"
data Info
= Info'
| SecurityCredentials (Maybe Text)
deriving (Eq, Ord, Show, Typeable)
instance ToText Info where
toText = \case
Info' -> "info"
SecurityCredentials r -> "security-credentials/" <> maybe mempty toText r
latest :: Text
latest = "http://169.254.169.254/latest/"
isEC2 :: MonadIO m => Manager -> m Bool
isEC2 m = liftIO (req `catch` err)
where
req = do
!_ <- request m "http://instance-data/latest"
return True
err :: HttpException -> IO Bool
err = const (return False)
dynamic :: (MonadIO m, MonadThrow m) => Manager -> Dynamic -> m ByteString
dynamic m = get m . mappend latest . toText
metadata :: (MonadIO m, MonadThrow m) => Manager -> Metadata -> m ByteString
metadata m = get m . mappend latest . toText
userdata :: (MonadIO m, MonadCatch m) => Manager -> m (Maybe ByteString)
userdata m = do
x <- try $ get m (latest <> "user-data")
case x of
Left (HttpExceptionRequest _ (StatusCodeException rs _))
| fromEnum (responseStatus rs) == 404
-> return Nothing
Left e -> throwM e
Right b -> return (Just b)
data IdentityDocument = IdentityDocument
{ _devpayProductCodes :: Maybe Text
, _billingProducts :: Maybe Text
, _version :: Maybe Text
, _privateIp :: Maybe Text
, _availabilityZone :: Text
, _region :: !Region
, _instanceId :: Text
, _instanceType :: Text
, _accountId :: Text
, _imageId :: Maybe Text
, _kernelId :: Maybe Text
, _ramdiskId :: Maybe Text
, _architecture :: Maybe Text
, _pendingTime :: Maybe ISO8601
} deriving (Eq, Show)
devpayProductCodes :: Lens' IdentityDocument (Maybe Text)
devpayProductCodes = lens _devpayProductCodes (\s a -> s { _devpayProductCodes = a })
billingProducts :: Lens' IdentityDocument (Maybe Text)
billingProducts = lens _billingProducts (\s a -> s { _billingProducts = a })
version :: Lens' IdentityDocument (Maybe Text)
version = lens _version (\s a -> s { _version = a })
privateIp :: Lens' IdentityDocument (Maybe Text)
privateIp = lens _privateIp (\s a -> s { _privateIp = a })
availabilityZone :: Lens' IdentityDocument Text
availabilityZone = lens _availabilityZone (\s a -> s { _availabilityZone = a })
region :: Lens' IdentityDocument Region
region = lens _region (\s a -> s { _region = a })
instanceId :: Lens' IdentityDocument Text
instanceId = lens _instanceId (\s a -> s { _instanceId = a })
instanceType :: Lens' IdentityDocument Text
instanceType = lens _instanceType (\s a -> s { _instanceType = a })
accountId :: Lens' IdentityDocument Text
accountId = lens _accountId (\s a -> s { _accountId = a })
imageId :: Lens' IdentityDocument (Maybe Text)
imageId = lens _imageId (\s a -> s { _imageId = a })
kernelId :: Lens' IdentityDocument (Maybe Text)
kernelId = lens _kernelId (\s a -> s { _kernelId = a })
ramdiskId :: Lens' IdentityDocument (Maybe Text)
ramdiskId = lens _ramdiskId (\s a -> s { _ramdiskId = a })
architecture :: Lens' IdentityDocument (Maybe Text)
architecture = lens _architecture (\s a -> s { _architecture = a })
pendingTime :: Lens' IdentityDocument (Maybe UTCTime)
pendingTime = lens _pendingTime (\s a -> s { _pendingTime = a }) . mapping _Time
instance FromJSON IdentityDocument where
parseJSON = withObject "dynamic/instance-identity/document" $ \o -> do
_devpayProductCodes <- o .:? "devpayProductCodes"
_billingProducts <- o .:? "billingProducts"
_privateIp <- o .:? "privateIp"
_version <- o .:? "version"
_availabilityZone <- o .: "availabilityZone"
_region <- o .: "region"
_instanceId <- o .: "instanceId"
_instanceType <- o .: "instanceType"
_accountId <- o .: "accountId"
_imageId <- o .:? "imageId"
_kernelId <- o .:? "kernelId"
_ramdiskId <- o .:? "ramdiskId"
_architecture <- o .:? "architecture"
_pendingTime <- o .:? "pendingTime"
pure IdentityDocument{..}
instance ToJSON IdentityDocument where
toJSON IdentityDocument{..} =
object
[ "devpayProductCodes" .= _devpayProductCodes
, "billingProducts" .= _billingProducts
, "privateIp" .= _privateIp
, "version" .= _version
, "availabilityZone" .= _availabilityZone
, "region" .= _region
, "instanceId" .= _instanceId
, "instanceType" .= _instanceType
, "accountId" .= _accountId
, "imageId" .= _imageId
, "kernelId" .= _kernelId
, "ramdiskId" .= _ramdiskId
, "architecture" .= _architecture
]
identity :: (MonadIO m, MonadThrow m)
=> Manager
-> m (Either String IdentityDocument)
identity m = (eitherDecode . LBS.fromStrict) `liftM` dynamic m Document
get :: (MonadIO m, MonadThrow m) => Manager -> Text -> m ByteString
get m url = liftIO (strip `liftM` request m url)
where
strip bs
| BS8.isSuffixOf "\n" bs = BS8.init bs
| otherwise = bs
request :: Manager -> Text -> IO ByteString
request m url = do
rq <- parseUrlThrow (Text.unpack url)
rs <- httpLbs rq m
return . LBS.toStrict $ responseBody rs