-- | EC2 Meta-data service.
--   This is available to use within EC2/VPC instance.
module AWS.EC2.Metadata
    ( latestVersion
      -- * Meta-data
    , amiId
    , amiLaunchIndex
    , amiManifestPath
    , blockDeviceMapping
    , hostname
    , instanceAction
    , instanceId
    , instanceType
    , kernelId
    , localHostname
    , localIpv4
    , mac
    , metrics
    , interfaces
    , availabilityZone
    , profile
    , publicKeys
    , reservationId
    , securityGroups
      -- * User-data
    , userdata
      -- * Instance identity
    , idPkcs7
    , idSignature
    , idDocument
    , query
	) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.Text (Text)
import Data.Conduit
import Network.HTTP.Conduit hiding (path)
import Control.Monad.IO.Class (liftIO)
import Data.Monoid
import Control.Applicative
import Control.Exception

import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL

import AWS.Util

base :: String
base = "http://169.254.169.254"

version :: String
version = "/latest"

query :: String -> IO [ByteString]
query path = runResourceT $ do
    req <- liftIO $ parseUrl (base <> path)
    mgr <- liftIO $ newManager def
    Response _ _ _ res <- http req mgr
    res $$+- CB.lines =$ CL.consume

latestVersion :: IO Text
latestVersion = bsToText . last . init <$> query ""

metadata :: String -> IO [ByteString]
metadata path = query $ version <> "/meta-data/" <> path

h :: Functor f => f [ByteString] -> f Text
h = fmap (bsToText . head)

t :: [ByteString] -> [Text]
t = map bsToText

ignore :: IO (Maybe a) -> IO (Maybe a)
ignore io = handle ignore' io
  where
    ignore' :: HttpException -> IO (Maybe a)
    ignore' _ = return Nothing

amiId :: IO Text
amiId = h $ metadata "ami-id"

amiLaunchIndex :: IO Text
amiLaunchIndex = h $ metadata "ami-launch-index"

amiManifestPath :: IO Text
amiManifestPath = h $ metadata "ami-manifest-path"

blockDeviceMapping :: IO [(Text, Text)]
blockDeviceMapping = do
    bs <- metadata bdm
    ds <- mapM (\b -> head <$> (metadata $ bdm <> BC.unpack b)) bs
    return $ zip (t bs) (t ds)
  where
    bdm = "block-device-mapping/"

hostname :: IO Text
hostname = h $ metadata "hostname"

instanceAction :: IO Text
instanceAction = h $ metadata "instance-action"

instanceId :: IO Text
instanceId = h $ metadata "instance-id"

instanceType :: IO Text
instanceType = h $ metadata "instance-type"

kernelId :: IO Text
kernelId = h $ metadata "kernel-id"

localHostname :: IO Text
localHostname = h $ metadata "local-hostname"

localIpv4 :: IO Text
localIpv4 = h $ metadata "local-ipv4"

mac :: IO Text
mac = h $ metadata "mac"

metrics :: IO Text
metrics = h $ metadata "metrics/vhostmd"

interfaces :: IO [(Text, [(Text, Text)])]
interfaces = do
    ms <- metadata macs
    vs <- mapM (\b -> (val b)) ms
    ts <- mapM (uncurry f) (zip ms vs)
    return $ zip (map (bsToText . BC.init) ms) ts
  where
    macs = "network/interfaces/macs/"
    f m ks = zip (t ks) <$> mapM (kv m) ks
    kv m k = bsToText . head <$> val (m <> k)
    val k = metadata $ macs <> BC.unpack k

availabilityZone :: IO Text
availabilityZone = h $ metadata "placement/availability-zone"

profile :: IO Text
profile = h $ metadata "profile"

publicKeys :: IO [Text]
publicKeys = t <$> metadata "public-keys"

reservationId :: IO Text
reservationId = h $ metadata "reservation-id"

securityGroups :: IO [Text]
securityGroups = t <$> metadata "security-groups"

userdata :: IO (Maybe Text)
userdata = ignore $
    Just <$> (h <$> query $ version <> "/user-data")

queryRaw :: String -> IO ByteString
queryRaw path = runResourceT $ do
    req <- liftIO $ parseUrl (base <> path)
    mgr <- liftIO $ newManager def
    Response _ _ _ res <- http req mgr
    mconcat <$> (res $$+- CL.consume)

identity :: String -> IO Text
identity name =
    bsToText <$> (queryRaw $ is <> name)
  where
    is = version <> "/dynamic/instance-identity/"

idPkcs7 :: IO Text
idPkcs7 = identity "pkcs7"

idSignature :: IO Text
idSignature = identity "signature"

idDocument :: IO Text
idDocument = identity "document"