module Aws.Ec2.Types where
import Control.Applicative
import Data.Aeson (Value (..), FromJSON, (.:), (.:?), (.!=), parseJSON)
import Data.Aeson.Types (typeMismatch)
import Data.Char (toUpper, toLower)
import Data.IP (IPv4)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Data.Monoid hiding (All)
import Data.ByteString.Char8 (ByteString, pack)
import Network.HTTP.Types as HTTP
import Aws.Query
import Aws.Ec2.Core
data BlockDeviceMapping = BlockDeviceMapping
{ bdm_deviceName :: Text
, bdm_device :: BlockDevice
} deriving (Show)
data BlockDevice = Ephemeral {bdm_virtualName :: Text}
| EBS EbsBlockDevice
deriving (Show)
data EbsBlockDevice = EbsBlockDevice
{ ebd_snapshotId :: Maybe Text
, ebd_deleteOnTermination :: Bool
, ebd_volumeType :: VolumeType
, ebd_volumeSize :: Int
, ebd_encrypted :: Bool
} deriving (Show)
queryEbsBlockDevice EbsBlockDevice{..} = [ ("VolumeType", qShow ebd_volumeType)
, ("Size", qShow ebd_volumeSize)
, ("Encrypted", qShow ebd_encrypted)
] +++ optionalA "SnapshotId" ebd_snapshotId
+++ case ebd_volumeType of
IOPSSD iops -> [("Iops", qShow iops)]
_ -> []
type CidrIp = Text
type SgGroupId = Text
data SgPermission = IpPermission IpProtocol (Maybe Int) (Maybe Int) [CidrIp]
| SgPermission IpProtocol (Maybe Int) (Maybe Int) [SgGroupId]
deriving (Eq, Show)
data Region = Region { regionEndpoint :: T.Text
, regionName :: T.Text}
deriving (Show)
instance FromJSON Region where
parseJSON (Object v) = Region <$>
v .: "regionEndpoint" <*>
v .: "regionName"
parseJSON invalid = typeMismatch "Region" invalid
data Reservation = Reservation { reservationId :: T.Text
, reservationOwnerId :: T.Text
, reservationSecurityGroups :: [Group]
, reservationInstances :: [Instance]}
deriving (Show)
instance FromJSON Reservation where
parseJSON (Object v) = Reservation <$>
v .: "reservationId" <*>
v .: "ownerId" <*>
(maybeToList <$> (v .:? "groupSet" .!= Nothing)) <*>
v .: "instancesSet"
parseJSON invalid = typeMismatch "Reservation" invalid
data Group = Group { groupId :: T.Text
, groupName :: T.Text}
deriving (Show)
instance FromJSON Group where
parseJSON (Object v) = Group <$>
v .: "groupId" <*>
v .: "groupName"
parseJSON invalid = typeMismatch "Group" invalid
data Instance = Instance { instanceId :: T.Text
, instanceImageId :: T.Text
, instanceState :: InstanceState
, instancePrivateDnsName :: Maybe T.Text
, instancePublicDnsName :: Maybe T.Text
, instanceStateTransitionReason :: Maybe T.Text
, instanceKeyName :: Maybe T.Text
, instanceAmiLaunchIndex :: Int
, instanceProductCodes :: [ProductCode]
, instanceType :: T.Text
, instanceLaunchTime :: UTCTime
, instancePlacement :: Placement
, instanceMonitoring :: Monitoring
, instanceSecurityGroups :: [Group]
, instanceArchitecture :: Architecture
, instanceRootDeviceType :: RootDeviceType
, instanceRootDeviceName :: Maybe T.Text
, instanceHypervisor :: Hypervisor
, instanceVirtualizationType :: VirtualizationType
, instanceClientToken :: Maybe T.Text
, instanceBlockDeviceMapping :: [InstanceBlockDeviceMapping]
, instanceEbsOptimized :: Bool
, instanceStateReason :: Maybe StateReason
, instanceNetworkInterfaces :: [InstanceNetworkInterface]
, instancePrivateIpAddress :: Maybe IPv4
, instancePublicIpAddress :: Maybe IPv4
, instanceTags :: [Tag]
, instanceKernelId :: Maybe T.Text
, instanceSourceDestCheck :: Maybe Bool
, instanceVpcId :: Maybe T.Text
, instanceSubnetId :: Maybe T.Text
} deriving (Show)
instance FromJSON Instance where
parseJSON (Object v) = Instance <$>
v .: "instanceId" <*>
v .: "imageId" <*>
v .: "instanceState" <*>
v .:? "privateDnsName" .!= Nothing <*>
v .:? "dnsName" .!= Nothing <*>
v .:? "reason" .!= Nothing <*>
v .:? "keyName" .!= Nothing <*>
(read <$> v .: "amiLaunchIndex") <*>
(maybeToList <$> (v .:? "productCodes" .!= Nothing)) <*>
v .: "instanceType" <*>
v .: "launchTime" <*>
v .: "placement" <*>
v .: "monitoring" <*>
(maybeToList <$> (v .:? "groupSet" .!= Nothing)) <*>
(read <$> (v .: "architecture")) <*>
(read <$> (v .: "rootDeviceType")) <*>
v .:? "rootDeviceName" .!= Nothing <*>
(read <$> (v .: "hypervisor")) <*>
(read <$> (v .: "virtualizationType")) <*>
v .:? "clientToken" .!= Nothing <*>
(maybeToList <$> (v .:? "blockDeviceMapping" .!= Nothing)) <*>
(readBool <$> (v .: "ebsOptimized")) <*>
v .:? "stateReason" .!= Nothing <*>
(maybeToList <$> (v .:? "networkInterfaceSet" .!= Nothing)) <*>
(fmap read <$> (v .:? "privateIpAddress" .!= Nothing)) <*>
(fmap read <$> (v .:? "ipAddress" .!= Nothing)) <*>
(maybeToList <$> (v .:? "tagSet" .!= Nothing)) <*>
v .:? "kernelId" .!= Nothing <*>
(fmap readBool <$> (v .:? "sourceDestCheck" .!= Nothing)) <*>
v .:? "vpcId" .!= Nothing <*>
v .:? "subnetId" .!= Nothing
parseJSON invalid = typeMismatch "Instance" invalid
data ProductCode = ProductCode { productCodeId :: T.Text
, productCodeType :: T.Text}
deriving (Show)
instance FromJSON ProductCode where
parseJSON (Object v) = ProductCode <$>
v .: "productCodeId" <*>
v .: "productCodeType"
parseJSON invalid = typeMismatch "ProductCode" invalid
data InstanceNetworkInterface =
InstanceNetworkInterface { iniNetworkInterfaceId :: T.Text
, iniSubnetId :: Maybe T.Text
, iniVpcId :: Maybe T.Text
, iniDescription :: Maybe T.Text
, iniOwnerId :: T.Text
, iniStatus :: T.Text
, iniMacAddress :: Maybe T.Text
, iniPrivateIpAddress :: Maybe IPv4
, iniSourceDestCheck :: Maybe Bool
, iniSecurityGroups :: [Group]
, iniAttachment :: Value
, iniAssociation :: Maybe Value}
deriving (Show)
instance FromJSON InstanceNetworkInterface where
parseJSON (Object v) = InstanceNetworkInterface <$>
v .: "networkInterfaceId" <*>
v .:? "subnetId" .!= Nothing <*>
v .:? "vpcId" .!= Nothing <*>
v .:? "description" .!= Nothing <*>
v .: "ownerId" <*>
v .: "status" <*>
v .:? "macAddress" .!= Nothing <*>
(fmap read <$> (v .:? "privateIpAddress" .!= Nothing)) <*>
(fmap readBool <$> (v .:? "sourceDestCheck" .!= Nothing)) <*>
(maybeToList <$> (v .:? "groupSet" .!= Nothing)) <*>
v .: "attachment" <*>
v .:? "association" .!= Nothing
parseJSON invalid = typeMismatch "InstanceNetworkInterface" invalid
data Tag = Tag { tagKey :: T.Text
, tagValue :: T.Text}
deriving (Show)
instance FromJSON Tag where
parseJSON (Object v) = Tag <$>
v .: "key" <*>
v .: "value"
parseJSON invalid = typeMismatch "Tag" invalid
data InstanceBlockDeviceMapping =
InstanceBlockDeviceMapping { ibdmDeviceName :: T.Text
, ibdmEbs :: EbsInstanceBlockDevice}
deriving (Show)
instance FromJSON InstanceBlockDeviceMapping where
parseJSON (Object v) = InstanceBlockDeviceMapping <$>
v .: "deviceName" <*>
v .: "ebs"
parseJSON invalid = typeMismatch "InstanceBlockDeviceMapping" invalid
data EbsInstanceBlockDevice =
EbsInstanceBlockDevice { eibdVolumeId :: T.Text
, eibdStatus :: T.Text
, eibdAttachTime :: UTCTime
, eibdDeleteOnTermination :: Bool}
deriving (Show)
instance FromJSON EbsInstanceBlockDevice where
parseJSON (Object v) = EbsInstanceBlockDevice <$>
v .: "volumeId" <*>
v .: "status" <*>
v .: "attachTime" <*>
(readBool <$> (v .: "deleteOnTermination"))
parseJSON invalid = typeMismatch "EbsInstanceBlockDevice" invalid
data InstanceState = InstanceState { isName :: InstanceStateName
, isCode :: Int}
deriving (Show)
instance FromJSON InstanceState where
parseJSON (Object v) = InstanceState <$>
(read <$> (v .: "name")) <*>
(read <$> (v .: "code"))
parseJSON invalid = typeMismatch "InstanceState" invalid
data Placement = Placement { pAvailabilityZone :: T.Text
, pTenancy :: T.Text
, pGroupName :: Maybe T.Text}
deriving (Show)
instance FromJSON Placement where
parseJSON (Object v) = Placement <$>
v .: "availabilityZone" <*>
v .: "tenancy" <*>
v .: "groupName"
parseJSON invalid = typeMismatch "Placement" invalid
data Monitoring = Monitoring {monitoringState :: T.Text} deriving (Show)
instance FromJSON Monitoring where
parseJSON (Object v) = Monitoring <$> v .: "state"
parseJSON invalid = typeMismatch "Monitoring" invalid
data StateReason = StateReason { srCode :: T.Text
, srMessage :: T.Text}
deriving (Show)
instance FromJSON StateReason where
parseJSON (Object v) = StateReason <$>
v .: "code" <*>
v .: "message"
parseJSON invalid = typeMismatch "StateReason" invalid
data AvailabilityZone = AvailabilityZone { azRegionName :: T.Text
, azZoneName :: T.Text
, azZoneState :: T.Text
, azMessageSet :: Value}
deriving (Show)
instance FromJSON AvailabilityZone where
parseJSON (Object v) = AvailabilityZone <$>
v .: "regionName" <*>
v .: "zoneName" <*>
v .: "zoneState" <*>
v .: "messageSet"
parseJSON invalid = typeMismatch "AvailabilityZone" invalid
data SecurityGroup = SecurityGroup { sgOwnerId :: T.Text
, sgGroupId :: T.Text
, sgGroupName :: T.Text
, sgGroupDescription :: T.Text
, sgVpcId :: Maybe T.Text
, sgIpPermissionsEgress :: Value
, sgIpPermissions :: Value}
deriving (Show)
instance FromJSON SecurityGroup where
parseJSON (Object v) = SecurityGroup <$>
v .: "ownerId" <*>
v .: "groupId" <*>
v .: "groupName" <*>
v .: "groupDescription" <*>
v .:? "vpcId" .!= Nothing <*>
v .: "ipPermissionsEgress" <*>
v .: "ipPermissions"
parseJSON invalid = typeMismatch "SecurityGroup" invalid
data PlacementGroup = PlacementGroup { pgGroupName :: T.Text
, pgStrategy :: T.Text
, pgState :: T.Text}
deriving (Show)
instance FromJSON PlacementGroup where
parseJSON (Object v) = PlacementGroup <$>
v .: "groupName" <*>
v .: "strategy" <*>
v .: "state"
parseJSON invalid = typeMismatch "PlacementGroup" invalid
data KeyPair = KeyPair { keyName :: T.Text
, keyFingerprint :: T.Text}
deriving (Show)
instance FromJSON KeyPair where
parseJSON (Object v) = KeyPair <$>
v .: "keyName" <*>
v .: "keyFingerprint"
parseJSON invalid = typeMismatch "KeyPair" invalid
data Vpc = Vpc { vpcId :: T.Text
, vpcState :: T.Text
, vpcCIDR :: T.Text
, vpcDHCPOptions :: T.Text
, vpcInstanceTenacity :: T.Text
, vpcIsDefault :: Maybe Bool}
deriving (Show)
instance FromJSON Vpc where
parseJSON (Object v) = Vpc <$>
v .: "vpcId" <*>
v .: "state" <*>
v .: "cidrBlock" <*>
v .: "dhcpOptionsId" <*>
v .: "instanceTenancy" <*>
(fmap readBool <$> (v .:? "isDefault" .!= Nothing))
parseJSON invalid = typeMismatch "Vpc" invalid
data Subnet = Subnet { subnetId :: T.Text
, subnetVpcId :: T.Text
, subnetState :: T.Text
, subnetCIDR :: T.Text
, subnetAZ :: T.Text
, subnetAvailableIpCount :: Int
, subnetDefaultForAZ :: Maybe Bool
, subnetMapPublicIp :: Maybe Bool}
deriving (Show)
instance FromJSON Subnet where
parseJSON (Object v) = Subnet <$>
v .: "subnetId" <*>
v .: "vpcId" <*>
v .: "state" <*>
v .: "cidrBlock" <*>
v .: "availabilityZone" <*>
(read <$> (v .: "availableIpAddressCount")) <*>
(fmap readBool <$> (v .:? "defaultForAz" .!= Nothing)) <*>
(fmap readBool <$> (v .:? "mapPublicIpOnLaunch" .!= Nothing))
parseJSON invalid = typeMismatch "Subnet" invalid
data InstanceTenancy = Default | Dedicated
instance Show InstanceTenancy where
show Default = "default"
show Dedicated = "dedicated"
data VolumeType = Standard | GP2SSD | IOPSSD Int
instance Show VolumeType where
show Standard = "standard"
show GP2SSD = "gp2"
show (IOPSSD _) = "io1"
data IpProtocol = TCP | UDP | ICMP | Proto Int | All
deriving Eq
instance Show IpProtocol where
show TCP = "tcp"
show UDP = "udp"
show ICMP = "icmp"
show (Proto i) = show i
show All = "-1"
data VirtualizationType = HVM | PARAVIRTUAL deriving (Eq)
instance Show VirtualizationType where
show HVM = "hvm"
show PARAVIRTUAL = "paravirtual"
instance Read VirtualizationType where
readsPrec _ h = case h of
"hvm" -> [(HVM,"")]
"paravirtual" -> [(PARAVIRTUAL,"")]
_ -> fail $ "Failed to parse " ++ h ++ " into VirtualizationType."
data RootDeviceType = EBS_STORE | INSTANCE_STORE deriving (Eq)
instance Show RootDeviceType where
show EBS_STORE = "ebs"
show INSTANCE_STORE = "instance-store"
instance Read RootDeviceType where
readsPrec _ h = case h of
"ebs" -> [(EBS_STORE,"")]
"instance-store" -> [(INSTANCE_STORE,"")]
_ -> fail $ "Failed to parse " ++ h ++ " into RootDeviceType."
data Architecture = I386 | X86_64 deriving (Eq)
instance Show Architecture where
show I386 = "32-bit"
show X86_64 = "64-bit"
instance Read Architecture where
readsPrec _ h = case h of
"i386" -> [(I386,"")]
"x86_64" -> [(X86_64,"")]
_ -> fail $ "Failed to parse " ++ h ++ " into Architecture."
data Hypervisor = OVM | XEN deriving (Eq)
instance Show Hypervisor where
show OVM = "ovm"
show XEN = "xen"
instance Read Hypervisor where
readsPrec _ h = case h of
"ovm" -> [(OVM,"")]
"xen" -> [(XEN,"")]
_ -> fail $ "Failed to parse " ++ h ++ " into Hypervisor."
data InstanceStateName = Pending
| Running
| ShuttingDown
| Terminated
| Stopping
| Stopped
deriving (Eq)
instance Show InstanceStateName where
show Pending = "pending"
show Running = "running"
show ShuttingDown = "shutting-down"
show Terminated = "terminated"
show Stopping = "stopping"
show Stopped = "stopped"
instance Read InstanceStateName where
readsPrec _ h = case h of
"pending" -> [(Pending,"")]
"running" -> [(Running,"")]
"shutting-down" -> [(ShuttingDown,"")]
"terminated" -> [(Terminated,"")]
"stopping" -> [(Stopping,"")]
"stopped" -> [(Stopped,"")]
_ -> fail $ "Failed to parse " ++ h ++ " into InstanceStateName."
enumeratePermissions :: [SgPermission] -> HTTP.Query
enumeratePermissions = enumerateLists "IpPermissions." . fmap unroll
where
port n = maybe [] (\p -> [(n, qShow p)])
unroll (IpPermission proto from to ips) =
[("IpProtocol", qShow proto)] ++
port "FromPort" from ++
port "ToPort" to +++
[(mconcat [k, ".CidrIp"], v)| (k, v) <- enumerate "IpRanges" ips qArg]
unroll (SgPermission proto from to sgs) =
[("IpProtocol", qShow proto)] ++
port "FromPort" from ++
port "ToPort" to +++
[(mconcat [k, ".GroupId"], v)| (k, v) <- enumerate "Groups" sgs qArg]
maybeToList :: Maybe [a] -> [a]
maybeToList (Just a) = a
maybeToList Nothing = []
readBool :: String -> Bool
readBool (x:xs) = read $ toUpper x : map toLower xs
readBool [] = error "Cannot read bool. String is empty."