module AWS.EC2.Image
( describeImages
, createImage
, registerImage
, deregisterImage
, describeImageAttribute
) where
import Data.Text (Text)
import qualified Data.Text as T
import Data.XML.Types (Event)
import Data.Conduit
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Applicative
import Control.Monad (join)
import AWS.EC2.Internal
import AWS.EC2.Types
import AWS.EC2.Params
import AWS.EC2.Query
import AWS.Lib.Parser
import AWS.Util
describeImages
:: (MonadResource m, MonadBaseControl IO m)
=> [Text]
-> [Text]
-> [Text]
-> [Filter]
-> EC2 m (ResumableSource m Image)
describeImages imageIds owners execby filters =
ec2QuerySource "DescribeImages" params $ itemConduit "imagesSet" imageItem
where
params =
[ ArrayParams "ImageId" imageIds
, ArrayParams "Owner" owners
, ArrayParams "ExecutableBy" execby
, FilterParams filters
]
imageItem :: MonadThrow m
=> GLSink Event m Image
imageItem = Image
<$> getT "imageId"
<*> getT "imageLocation"
<*> getT "imageState"
<*> getT "imageOwnerId"
<*> getT "isPublic"
<*> productCodeSink
<*> getT "architecture"
<*> getT "imageType"
<*> getT "kernelId"
<*> getT "ramdiskId"
<*> getT "platform"
<*> stateReasonSink
<*> getT "viridianEnabled"
<*> getT "imageOwnerAlias"
<*> getT "name"
<*> getT "description"
<*> itemsSet "billingProducts" (getT "billingProduct")
<*> getT "rootDeviceType"
<*> getT "rootDeviceName"
<*> blockDeviceMappingSink
<*> getT "virtualizationType"
<*> resourceTagSink
<*> getT "hypervisor"
blockDeviceMappingSink :: MonadThrow m => GLSink Event m [BlockDeviceMapping]
blockDeviceMappingSink = itemsSet "blockDeviceMapping" (
BlockDeviceMapping
<$> getT "deviceName"
<*> getT "virtualName"
<*> elementM "ebs" (
EbsBlockDevice
<$> getT "snapshotId"
<*> getT "volumeSize"
<*> getT "deleteOnTermination"
<*> volumeTypeSink
)
)
createImage
:: (MonadResource m, MonadBaseControl IO m)
=> Text
-> Text
-> Maybe Text
-> Bool
-> [BlockDeviceMappingParam]
-> EC2 m Text
createImage iid name desc noReboot bdms =
ec2Query "CreateImage" params $ getT "imageId"
where
param n = maybe [] (\a -> [ValueParam n a])
params =
[ ValueParam "InstanceId" iid
, ValueParam "Name" name
, ValueParam "NoReboot" (boolToText noReboot)
] ++ param "Description" desc
++ [blockDeviceMappingParams bdms]
registerImage
:: (MonadResource m, MonadBaseControl IO m)
=> RegisterImageRequest
-> EC2 m Text
registerImage req =
ec2Query "RegisterImage" params $ getT "imageId"
where
params = [ValueParam "Name" $ registerImageRequestName req]
++ [blockDeviceMappingParams
$ registerImageRequestBlockDeviceMappings req]
++ maybeParams
[ ("ImageLocation"
, registerImageRequestImageLocation req
)
, ("Description", registerImageRequestDescription req)
, ("Architecture"
, registerImageRequestArchitecture req
)
, ("KernelId", registerImageRequestKernelId req)
, ("RamdiskId", registerImageRequestRamdiskId req)
, ("RootDeviceName"
, registerImageRequestRootDeviceName req
)
]
deregisterImage
:: (MonadResource m, MonadBaseControl IO m)
=> Text
-> EC2 m Bool
deregisterImage iid =
ec2Query "DeregisterImage" params $ getT "return"
where
params = [ValueParam "ImageId" iid]
describeImageAttribute
:: (MonadResource m, MonadBaseControl IO m)
=> Text
-> AMIAttribute
-> EC2 m AMIAttributeDescription
describeImageAttribute iid attr =
ec2Query "DescribeImageAttribute" params $ AMIAttributeDescription
<$> getT "imageId"
<*> itemsSet "launchPermission"
(LaunchPermissionItem
<$> getT "group"
<*> getT "userId")
<*> itemsSet "productCodes"
(ProductCodeItem
<$> getT "productCode")
<*> getMMT "kernel"
<*> getMMT "ramdisk"
<*> getMMT "description"
<*> blockDeviceMappingSink
where
getMMT name = join <$> elementM name (getT "value")
params = [ ValueParam "ImageId" iid
, ValueParam "Attribute" param
]
param :: Text
param | attr == AMIDescription = "description"
| attr == AMIKernel = "kernel"
| attr == AMIRamdisk = "ramdisk"
| attr == AMILaunchPermission = "launchPermission"
| attr == AMIProductCodes = "productCodes"
| attr == AMIBlockDeviceMapping = "blockDeviceMapping"
| otherwise = err "AMIAttribute" $ T.pack $ show attr