aws-sdk 0.5.0.0 → 0.6.0.0

raw patch · 18 files changed

+593/−259 lines, 18 filesdep +paralleldep +template-haskelldep ~conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: parallel, template-haskell

Dependency ranges changed: conduit

API changes (from Hackage documentation)

Files

• AWS/Credential.hs +10/−5
• AWS/EC2/Acl.hs +2/−4
• AWS/EC2/Address.hs +1/−0
• AWS/EC2/Convert.hs +118/−0
• AWS/EC2/Image.hs +2/−1
• AWS/EC2/Instance.hs +2/−1
• AWS/EC2/Internal.hs +1/−201
• AWS/EC2/KeyPair.hs +1/−3
• AWS/EC2/Query.hs +10/−0
• AWS/EC2/RouteTable.hs +2/−3
• AWS/EC2/Snapshot.hs +1/−0
• AWS/EC2/Subnets.hs +2/−3
• AWS/EC2/Types.hs +111/−16
• AWS/EC2/Util.hs +30/−9
• AWS/EC2/VPC.hs +261/−1
• AWS/EC2/Volume.hs +8/−9
• AWS/Lib/Convert.hs +24/−0
• aws-sdk.cabal +7/−3

@@ -4,6 +4,7 @@     , AccessKey     , SecretAccessKey     , loadCredential+    , loadCredentialFromFile     , newCredential     ) where @@ -23,12 +24,16 @@  -- | Load credential from \"./aws.config\". loadCredential :: IO Credential-loadCredential = do-    str <- BS.readFile "aws.config"-    case parse configParser "" str of-        Left err   -> fail $ show err-        Right conf -> return conf+loadCredential = loadCredentialFromFile "aws.config"  -- | Create new credential. newCredential :: AccessKey -> SecretAccessKey -> Credential newCredential key secret = Credential key secret++-- | Load credential from file.+loadCredentialFromFile :: FilePath -> IO Credential+loadCredentialFromFile path = do+    str <- BS.readFile path+    case parse configParser "" str of+        Left err   -> fail $ show err+        Right conf -> return conf

@@ -16,6 +16,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query@@ -76,10 +77,7 @@     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ NetworkAclId     -> EC2 m Bool-deleteNetworkAcl aclid =-    ec2Query "DeleteNetworkAcl" params returnBool-  where-    params = [ValueParam "NetworkAclId" aclid]+deleteNetworkAcl = ec2Delete "DeleteNetworkAcl" "NetworkAclId"  replaceNetworkAclAssociation     :: (MonadResource m, MonadBaseControl IO m)

@@ -17,6 +17,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query

@@ -0,0 +1,118 @@+{-# LANGUAGE RankNTypes, TemplateHaskell #-}++module AWS.EC2.Convert+    where++import Data.Text (Text)++import AWS.Util+import AWS.Lib.Convert+import AWS.EC2.Types++mkConvertFunc "imageState" ''ImageState ["available", "pending", "failed"]++mkConvertFunc "productCodeType" ''ProductCodeType ["devpay", "marketplace"]++mkConvertFunc "imageType" ''ImageType ["machine", "kernel", "ramdisk"]++platform :: Maybe Text -> Platform+platform Nothing   = Other+platform (Just t)+    | t == "windows" = Windows+    | otherwise      = Other++mkConvertFunc "rootDeviceType" ''RootDeviceType ["ebs", "instance-store"]++volumeType :: Text -> Maybe Int -> VolumeType+volumeType t Nothing  | t == "standard" = Standard+volumeType t (Just i) | t == "io1"      = IO1 i+volumeType t _ = err "volume type" t++mkConvertFunc "virtualizationType" ''VirtualizationType ["paravirtual", "hvm"]++mkConvertFunc "hypervisor" ''Hypervisor ["ovm", "xen"]++mkConvertFunc "instanceStatusEventCode"+                  ''InstanceStatusEventCode+                  ["instance-reboot", "instance-stop", "system-reboot", "instance-retirement"]++mkConvertFunc "instanceStatusTypeStatus"+                  ''InstanceStatusTypeStatus+                  ["ok", "impaired", "insufficient-data", "not-applicable"]++instanceStateCodes :: [(Int, InstanceState)]+instanceStateCodes =+    [ (0, Pending)+    , (16, Running)+    , (32, ShuttingDown)+    , (48, Terminated)+    , (64, Stopping)+    , (80, Stopped)+    ]++codeToState :: Int -> InstanceState+codeToState code = case lookup code instanceStateCodes of+    Nothing -> UnknownState code+    Just st -> st++mkConvertFunc "instanceMonitoringState" ''InstanceMonitoringState ["disabled", "enabled", "pending"]++mkConvertFunc "architecture" ''Architecture ["i386", "x86_64"]++addressDomain :: Maybe Text -> AddressDomain+addressDomain Nothing = AddressDomainStandard+addressDomain (Just t)+    | t == "standard" = AddressDomainStandard+    | t == "vpc"      = AddressDomainVPC+    | otherwise       = err "address domain" t++ec2Return :: Text -> EC2Return+ec2Return t+    | t == "true" = EC2Success+    | otherwise   = EC2Error t++mkConvertFunc "snapshotStatus" ''SnapshotStatus ["pending", "completed", "error"]++mkConvertFunc "volumeStatus"+                  ''VolumeState+                  ["creating", "available", "in-use", "deleting", "deleted", "error"]++mkConvertFunc "attachmentSetItemResponseStatus"+                  ''AttachmentSetItemResponseStatus+                  ["attaching", "attached", "detaching", "detached"]++mkConvertFunc "shutdownBehavior" ''ShutdownBehavior ["stop", "terminate"]++mkConvertFunc "vpnConnectionState" ''VpnConnectionState ["pending", "available", "deleting", "deleted"]++mkConvertFunc "vpnTunnelTelemetryStatus" ''VpnTunnelTelemetryStatus ["UP", "DOWN"]++mkConvertFunc "vpnStaticRouteSource" ''VpnStaticRouteSource ["Static"]++mkConvertFunc "vpnStaticRouteState" ''VpnStaticRouteState ["pending", "available", "deleting", "deleted"]++instanceLifecycle :: Maybe Text -> InstanceLifecycle+instanceLifecycle Nothing = LifecycleNone+instanceLifecycle (Just t)+    | t == "spot"   = LifecycleSpot+    | otherwise     = err "lifecycle" t++mkConvertFunc "subnetState" ''SubnetState ["pending", "available"]++mkConvertFunc "volumeStatusInfoStatus" ''VolumeStatusInfoStatus ["ok", "impaired", "insufficient-data"]++mkConvertFunc "networkAclRuleAction" ''NetworkAclRuleAction ["allow", "deny"]++mkConvertFunc "routeState" ''RouteState ["active", "blackhole"]++mkConvertFunc "routeOrigin" ''RouteOrigin ["CreateRouteTable", "CreateRoute", "EnableVgwRoutePropagation"]++mkConvertFunc "vpcState'" ''VpcState ["pending", "available"]++mkConvertFunc "vpnGatewayState'" ''VpnGatewayState ["pending", "available", "deleting", "deleted"]++mkConvertFunc "attachmentState'" ''AttachmentState ["attaching", "attached", "detaching", "detached"]++mkConvertFunc "customerGatewayState'" ''CustomerGatewayState ["pending", "available", "deleting", "deleted"]++mkConvertFunc "internetGatewayAttachmentState'" ''InternetGatewayAttachmentState ["attaching", "attached", "detaching", "detached", "available"]

@@ -14,6 +14,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Params@@ -112,7 +113,7 @@             , ("KernelId", rirKernelId req)             , ("RamdiskId", rirRamdiskId req)             , ("RootDeviceName", rirRootDeviceName req)-            ] +            ]  deregisterImage     :: (MonadResource m, MonadBaseControl IO m)

@@ -24,6 +24,7 @@ import Data.Maybe (fromJust) import qualified Data.Map as Map +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Params@@ -121,7 +122,7 @@     <*> element "ebs" (         InstanceEbsBlockDevice         <$> getT "volumeId"-        <*> getF "status" attachmentStatus+        <*> getF "status" attachmentSetItemResponseStatus         <*> getF "attachTime" textToTime         <*> getF "deleteOnTermination" textToBool         )

@@ -13,6 +13,7 @@ import Data.Text (Text)  import AWS.Class+import AWS.EC2.Convert import AWS.Credential import AWS.Util import AWS.Lib.Parser@@ -72,204 +73,3 @@  returnBool :: MonadThrow m => GLSink Event m Bool returnBool = getF "return" textToBool--imageState :: Text -> ImageState-imageState a-    | a == "available" = ImageAvailable-    | a == "pending"   = ImagePending-    | a == "failed"    = ImageFailed-    | otherwise        = err "image state" a--productCodeType :: Text -> ProductCodeType-productCodeType t-    | t == "marketplace" = Marketplace-    | t == "devpay"      = Devpay-    | otherwise          = err "product code type" t--imageType :: Text -> ImageType-imageType t-    | t == "machine"  = Machine-    | t == "kernel"   = Kernel-    | t == "ramdisk" = RamDisk-    | otherwise       = err "image type" t--platform :: Maybe Text -> Platform-platform Nothing   = Other-platform (Just t)-    | t == "windows" = Windows-    | otherwise      = Other--rootDeviceType :: Text -> RootDeviceType-rootDeviceType t-    | t == "ebs"            = EBS-    | t == "instance-store" = InstanceStore-    | otherwise             = err "root device type" t--volumeType :: Text -> Maybe Int -> VolumeType-volumeType t Nothing  | t == "standard" = Standard-volumeType t (Just i) | t == "io1"      = IO1 i-volumeType t _ = err "volume type" t--virtualizationType :: Text -> VirtualizationType-virtualizationType t-    | t == "paravirtual" = Paravirtual-    | t == "hvm"         = HVM-    | otherwise          = err "virtualization type" t--hypervisor :: Text -> Hypervisor-hypervisor t-    | t == "xen" = Xen-    | t == "ovm" = OVM-    | otherwise  = err "hypervisor" t--instanceStatusEventCode :: Text -> InstanceStatusEventCode-instanceStatusEventCode t-    | t == "instance-reboot"     = InstanceReboot-    | t == "instance-stop"       = InstanceStop-    | t == "system-reboot"       = SystemReboot-    | t == "instance-retirement" = InstanceRetirement-    | otherwise                  = err "InstanceStatusEventCode" t--instanceStatusTypeStatus :: Text -> InstanceStatusTypeStatus-instanceStatusTypeStatus t-    | t == "ok"                = InstanceStatusOK-    | t == "impaired"          = InstanceStatusImpaired-    | t == "insufficient-data" = InstanceStatusInsufficientData-    | t == "not-applicable"    = InstanceStatusNotApplicable-    | otherwise = err "instance status detail status" t--instanceStateCodes :: [(Int, InstanceState)]-instanceStateCodes =-    [ (0, Pending)-    , (16, Running)-    , (32, ShuttingDown)-    , (48, Terminated)-    , (64, Stopping)-    , (80, Stopped)-    ]--codeToState :: Int -> InstanceState-codeToState code = case lookup code instanceStateCodes of-    Nothing -> UnknownState code-    Just st -> st--instanceMonitoringState :: Text -> InstanceMonitoringState-instanceMonitoringState t-    | t == "disabled" = MonitoringDisabled-    | t == "enabled"  = MonitoringEnabled-    | t == "pending"  = MonitoringPending-    | otherwise       = err "monitoring state" t--architecture :: Text -> Architecture-architecture t-    | t == "i386"   = I386-    | t == "x86_64" = X86_64-    | otherwise     = err "architecture" t--addressDomain :: Maybe Text -> AddressDomain-addressDomain Nothing = AddressDomainStandard-addressDomain (Just t)-    | t == "standard" = AddressDomainStandard-    | t == "vpc"      = AddressDomainVPC-    | otherwise       = err "address domain" t--ec2Return :: Text -> EC2Return-ec2Return t-    | t == "true" = EC2Success-    | otherwise   = EC2Error t--snapshotStatus :: Text -> SnapshotStatus-snapshotStatus t-    | t == "pending"   = SSPending-    | t == "completed" = SSCompleted-    | t == "error"     = SSError-    | otherwise        = err "snapshot status" t--volumeStatus :: Text -> VolumeState-volumeStatus t-    | t == "creating"  = VolCreating-    | t == "available" = VolAvailable-    | t == "in-use"    = VolInUse-    | t == "deleting"  = VolDeleting-    | t == "deleted"   = VolDeleted-    | t == "error"     = VolError-    | otherwise        = err "volume state" t--attachmentStatus :: Text -> AttachmentStatus-attachmentStatus t-    | t == "attaching" = AttAttaching-    | t == "attached"  = AttAttached-    | t == "detaching" = AttDetaching-    | t == "detached"  = AttDetached-    | otherwise        = err "attachment status" t--shutdownBehavior :: Text -> ShutdownBehavior-shutdownBehavior t-    | t == "stop"      = SBStop-    | t == "terminate" = SBTerminate-    | otherwise = err "shutdown behavior" t--vpnConnectionState :: Text -> VpnConnectionState-vpnConnectionState t-    | t == "pending"   = VCSPending-    | t == "available" = VCSAvailable-    | t == "deleting"  = VCSDeleting-    | t == "deleted"   = VCSDeleted-    | otherwise        = err "vpn connection state" t--vpnTunnelTelemetryStatus :: Text -> VpnTunnelTelemetryStatus-vpnTunnelTelemetryStatus t-    | t == "UP"   = VTTSUp-    | t == "DOWN" = VTTSDown-    | otherwise   = err "vpn tunnel telemetry status" t--vpnStaticRouteSource :: Text -> VpnStaticRouteSource-vpnStaticRouteSource t-    | t == "Static" = VSRStatic-    | otherwise     = err "vpn static route source" t--vpnStaticRouteState :: Text -> VpnStaticRouteState-vpnStaticRouteState t-    | t == "pending"   = VSRSPending-    | t == "available" = VSRSAvailable-    | t == "deleting"  = VSRSDeleting-    | t == "deleted"   = VSRSDeleted-    | otherwise        = err "vpn static route state" t--instanceLifecycle :: Maybe Text -> InstanceLifecycle-instanceLifecycle Nothing = LifecycleNone-instanceLifecycle (Just t)-    | t == "spot"   = LifecycleSpot-    | otherwise     = err "lifecycle" t--subnetState :: Text -> SubnetState-subnetState t-    | t == "pending"   = SubnetPending-    | t == "available" = SubnetAvailable-    | otherwise        = err "subnet state" t--volumeStatusInfoStatus :: Text -> VolumeStatusInfoStatus-volumeStatusInfoStatus t-    | t == "ok"                = VSIOK-    | t == "impaired"          = VSIImpaired-    | t == "insufficient-data" = VSIInsufficientData-    | otherwise                = err "VolumeStatusInfo Status" t--networkAclRuleAction :: Text -> NetworkAclRuleAction-networkAclRuleAction t-    | t == "allow" = NetworkAclRuleActionAllow-    | t == "deny"  = NetworkAclRuleActionDeny-    | otherwise    = err "network acl rule action" t--routeState :: Text -> RouteState-routeState t-    | t == "active"    = RouteStateActive-    | t == "blackhole" = RouteStateBlackhole-    | otherwise        = err "Route State" t--routeOrigin :: Text -> RouteOrigin-routeOrigin t-    | t == "CreateRouteTable"          = RouteOriginCreateRouteTable-    | t == "CreateRoute"               = RouteOriginCreateRoute-    | t == "EnableVgwRoutePropagation" = RouteOriginTableEnableVgwRoutePropagation-    | otherwise                        = err "Route Origin" t

@@ -51,9 +51,7 @@     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ KeyName     -> EC2 m Bool-deleteKeyPair name =-    ec2Query "DeleteKeyPair" [ValueParam "KeyName" name]-        $ getF "return" textToBool+deleteKeyPair = ec2Delete "DeleteKeyPair" "KeyName"  importKeyPair     :: (MonadResource m, MonadBaseControl IO m)

@@ -7,6 +7,7 @@ #ifdef DEBUG     , ec2QueryDebug #endif+    , ec2Delete     , module AWS.Lib.Query     ) where @@ -120,3 +121,12 @@         (res, _) <- unwrapResumable response         res $$ CB.sinkFile "debug.txt" >>= fail "debug" #endif++ec2Delete+    :: (MonadResource m, MonadBaseControl IO m)+    => ByteString -- ^ Name of API+    -> Text -- ^ Parameter Name of ID+    -> Text -- ^ ID of Target+    -> EC2 m Bool+ec2Delete apiName idName targetId = do+    ec2Query apiName [ ValueParam idName targetId ] returnBool

@@ -15,6 +15,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query@@ -85,9 +86,7 @@     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ RouteTableId     -> EC2 m Bool-deleteRouteTable rtid =-    ec2Query "DeleteRouteTable" [ValueParam "RouteTableId" rtid]-        $ getF "return" textToBool+deleteRouteTable = ec2Delete "DeleteRouteTable" "RouteTableId"  ------------------------------------------------------------ -- associateRouteTable

@@ -18,6 +18,7 @@ import AWS.EC2.Query import AWS.Lib.Parser import AWS.Util+import AWS.EC2.Convert  describeSnapshots     :: (MonadResource m, MonadBaseControl IO m)

@@ -12,6 +12,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query@@ -72,6 +73,4 @@     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ SubnetId     -> EC2 m Bool-deleteSubnet sid =-    ec2Query "DeleteSubnet" [ValueParam "SubnetId" sid]-        $ getF "return" textToBool+deleteSubnet = ec2Delete "DeleteSubnet" "SubnetId"

@@ -5,7 +5,9 @@     , Architecture(..)     , AssociateAddressRequest(..)     , Attachment(..)-    , AttachmentStatus(..)+    , AttachmentState(..)+    , AttachmentSetItemResponse(..)+    , AttachmentSetItemResponseStatus(..)     , AvailabilityZone(..)     , AvailabilityZoneMessage     , BlockDeviceMapping(..)@@ -13,6 +15,9 @@     , ConsoleOutput(..)     , CreateSubnetRequest(..)     , CreateVolumeRequest(..)+    , CreateVpnGatewayType(..)+    , CustomerGateway(..)+    , CustomerGatewayState(..)     , DisassociateAddressRequest(..)     , EbsBlockDevice(..)     , EbsSource(..)@@ -95,14 +100,21 @@     , VolumeStatusDetail(..)     , VolumeStatusInfo(..)     , VolumeStatusInfoStatus(..)+    , Vpc(..)+    , VpcState(..)     , VpnConnection(..)     , VpnConnectionOptionsRequest(..)     , VpnConnectionState(..)+    , VpnGateway(..)+    , VpnGatewayState(..)     , VpnStaticRoute(..)     , VpnStaticRouteSource(..)     , VpnStaticRouteState(..)     , VpnTunnelTelemetry(..)     , VpnTunnelTelemetryStatus(..)+    , InternetGateway(..)+    , InternetGatewayAttachment(..)+    , InternetGatewayAttachmentState(..)     ) where  import Data.Default (Default(..))@@ -253,7 +265,7 @@     , instancePlatform :: Maybe Text     , instanceMonitoring :: InstanceMonitoringState     , subnetId :: Maybe Text-    , vpcId :: Maybe Text+    , instanceVpcId :: Maybe Text     , privateIpAddress :: Maybe Text     , ipAddress :: Maybe Text     , sourceDestCheck :: Maybe Bool@@ -363,7 +375,7 @@  data InstanceEbsBlockDevice = InstanceEbsBlockDevice     { instanceEbsVolumeId :: Text-    , instanceEbsState :: AttachmentStatus+    , instanceEbsState :: AttachmentSetItemResponseStatus     , instanceEbsAttachTime :: UTCTime     , instanceEbsDeleteOnTermination :: Bool     }@@ -515,7 +527,7 @@     , volAvailabilityZone :: Text     , volStatus :: VolumeState     , volCreateTime :: UTCTime-    , volAttachmentSet :: [Attachment]+    , volAttachmentSet :: [AttachmentSetItemResponse]     , volTagSet :: [ResourceTag]     , volVolumeType :: VolumeType     }@@ -530,21 +542,21 @@     | VolError   deriving (Show, Eq) -data Attachment = Attachment-    { attVolumeId :: Text-    , attInstanceId :: Text-    , attDevice :: Text-    , attStatus :: AttachmentStatus-    , attAttachTime :: UTCTime-    , attDeleteOnTermination :: Maybe Bool+data AttachmentSetItemResponse = AttachmentSetItemResponse+    { asirVolumeId :: Text+    , asirInstanceId :: Text+    , asirDevice :: Text+    , asirStatus :: AttachmentSetItemResponseStatus+    , asirAttachTime :: UTCTime+    , asirDeleteOnTermination :: Maybe Bool     }   deriving (Show, Eq) -data AttachmentStatus-    = AttAttaching-    | AttAttached-    | AttDetaching-    | AttDetached+data AttachmentSetItemResponseStatus+    = AsirAttaching+    | AsirAttached+    | AsirDetaching+    | AsirDetached   deriving (Show, Eq)  data KeyPair = KeyPair@@ -958,3 +970,86 @@   deriving (Show, Eq)  type PropagatingVgw = Text++data Vpc = Vpc+    { vpcId :: Text+    , vpcState :: VpcState+    , vpcCidrBlock :: Text+    , vpcDhcpOptionsId :: Text+    , vpcTagSet :: [ResourceTag]+    , vpcInstanceTenancy :: Text+    }+  deriving (Show, Eq)++data VpcState = VpcStatePending | VpcStateAvailable+  deriving (Show, Eq)++data VpnGateway = VpnGateway+    { vpnGatewayId :: Text+    , vpnGatewayState :: VpnGatewayState+    , vpnGatewayType :: Text+    , vpnGatewayAvailabilityZone :: Maybe Text+    , vpnGatewayAttachments :: [Attachment]+    , vpnGatewayTagSet :: [ResourceTag]+    }+  deriving (Show, Eq)++data VpnGatewayState+    = VpnGatewayStatePending+    | VpnGatewayStateAvailable+    | VpnGatewayStateDeleting+    | VpnGatewayStateDeleted+  deriving (Show, Eq)++data Attachment = Attachment+    { attachmentVpcId :: Text+    , attachmentState :: AttachmentState+    }+  deriving (Show, Eq)++data AttachmentState+    = AttachmentStateAttaching+    | AttachmentStateAttached+    | AttachmentStateDetaching+    | AttachmentStateDetached+  deriving (Show, Eq)++data CreateVpnGatewayType = CreateVpnGatewayTypeIpsec1++data CustomerGateway = CustomerGateway+    { customerGatewayId :: Text+    , customerGatewayState :: CustomerGatewayState+    , customerGatewayType :: Text+    , customerGatewayIpAddress :: Text+    , customerGatewayBgpAsn :: Int+    , customerGateway :: [ResourceTag]+    }+  deriving (Show, Eq)++data CustomerGatewayState+    = CustomerGatewayStatePending+    | CustomerGatewayStateAvailable+    | CustomerGatewayStateDeleting+    | CustomerGatewayStateDeleted+  deriving (Show, Eq)++data InternetGateway = InternetGateway+    { internetGatewayInternetGatewayId :: Text+    , internetGatewayAttachmentSet :: [InternetGatewayAttachment]+    , internetGatewayTagSet :: [ResourceTag]+    }+  deriving (Show, Eq)++data InternetGatewayAttachment = InternetGatewayAttachment+    { internetGatewayAttachmentVpcId :: Text+    , internetGatewayAttachmentState :: InternetGatewayAttachmentState+    }+  deriving (Show, Eq)++data InternetGatewayAttachmentState+    = InternetGatewayAttachmentStateAttaching+    | InternetGatewayAttachmentStateAttached+    | InternetGatewayAttachmentStateDetaching+    | InternetGatewayAttachmentStateDetached+    | InternetGatewayAttachmentStateAvailable+  deriving (Show, Eq)

@@ -1,10 +1,12 @@ {-# LANGUAGE FlexibleContexts #-}  module AWS.EC2.Util-    ( asList+    ( list     , head     , each+    , eachp     , wait+    , count     ) where  import Data.Conduit@@ -17,14 +19,15 @@ import Data.Text (Text) import qualified Data.Text as T import Control.Applicative+import Control.Parallel (par)  import AWS.EC2.Internal -asList+list     :: Monad m     => EC2 m (ResumableSource m a)     -> EC2 m [a]-asList src = do+list src = do     s <- src     lift $ s $$+- CL.consume @@ -42,15 +45,33 @@     -> EC2 m (ResumableSource m a)     -> EC2 m () each f res = res >>= lift . each' f+  where+    each' g rsrc = do+        (s', ma) <- rsrc $$++ CL.head+        maybe (return ()) (\a -> g a >> each' g s') ma -each'+-- | parallel each+eachp     :: Monad m     => (a -> m b)-    -> ResumableSource m a-    -> m ()-each' f rsrc = do-    (s', ma) <- rsrc $$++ CL.head-    maybe (return ()) (\a -> f a >> each' f s') ma+    -> EC2 m (ResumableSource m a)+    -> EC2 m ()+eachp f res = res >>= lift . each' f+  where+    each' g rsrc = do+        (s', ma) <- rsrc $$++ CL.head+        maybe (return ()) (\a -> g a `par` each' g s') ma++-- | Count resources.+count+    :: Monad m+    => EC2 m (ResumableSource m a)+    -> EC2 m Int+count ers = do+    s <- ers+    lift $ s $$+- c 0+  where+    c n = await >>= maybe (return n) (const $ c $ n + 1)  -- | Wait for condition. --

@@ -1,7 +1,21 @@ {-# LANGUAGE FlexibleContexts, RankNTypes #-}  module AWS.EC2.VPC-    ( describeVpnConnections+    ( createVpc+    , createVpnGateway+    , createCustomerGateway+    , createInternetGateway+    , deleteVpc+    , deleteVpnGateway+    , deleteCustomerGateway+    , deleteInternetGateway+    , describeVpnConnections+    , describeVpnGateways+    , describeVpcs+    , describeCustomerGateway+    , describeInternetGateways+    , attachInternetGateway+    , detachInternetGateway     ) where  import Data.Text (Text)@@ -11,6 +25,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query@@ -19,6 +34,86 @@  import Debug.Trace +------------------------------------------------------------+-- attachInternetGateway+------------------------------------------------------------+attachInternetGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ InternetGatewayId+    -> Text -- ^ VpcId+    -> EC2 m Bool+attachInternetGateway internetGatewayId vid =+    ec2Query "AttachInternetGateway" params $+        getF "return" textToBool+  where+    params =+        [ ValueParam "InternetGatewayId" internetGatewayId+        , ValueParam "VpcId" vid ]++------------------------------------------------------------+-- detachInternetGateway+------------------------------------------------------------+detachInternetGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ InternetGatewayId+    -> Text -- ^ VpcId+    -> EC2 m Bool+detachInternetGateway internetGatewayId vid =+    ec2Query "DetachInternetGateway" params $+        getF "return" textToBool+  where+    params =+        [ ValueParam "InternetGatewayId" internetGatewayId+        , ValueParam "VpcId" vid ]++------------------------------------------------------------+-- deleteInternetGateway+------------------------------------------------------------+deleteInternetGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ InternetGatewayId+    -> EC2 m Bool+deleteInternetGateway = ec2Delete "DeleteInternetGateway" "InternetGatewayId"++------------------------------------------------------------+-- createInternetGateway+------------------------------------------------------------+createInternetGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => EC2 m InternetGateway+createInternetGateway =+    ec2Query "CreateInternetGateway" [] $+        element "internetGateway" internetGatewaySink++------------------------------------------------------------+-- describeInternetGateways+------------------------------------------------------------+describeInternetGateways+    :: (MonadResource m, MonadBaseControl IO m)+    => [Text] -- ^ InternetGatewayIds+    -> [Filter] -- ^ Filters+    -> EC2 m (ResumableSource m InternetGateway)+describeInternetGateways internetGatewayIds filters = do+    ec2QuerySource "DescribeInternetGateways" params $+        itemConduit "internetGatewaySet" internetGatewaySink+  where+    params =+        [ ArrayParams "InternetGatewayId" internetGatewayIds+        , FilterParams filters+        ]++internetGatewaySink :: MonadThrow m+    => GLSink Event m InternetGateway+internetGatewaySink = InternetGateway+    <$> getT "internetGatewayId"+    <*> itemsSet "attachmentSet" internetGatewayAttachmentSink+    <*> resourceTagSink++internetGatewayAttachmentSink :: MonadThrow m+    => GLSink Event m InternetGatewayAttachment+internetGatewayAttachmentSink = InternetGatewayAttachment+    <$> getT "vpcId"+    <*> getF "state" internetGatewayAttachmentState' describeVpnConnections     :: (MonadBaseControl IO m, MonadResource m)     => [Text] -- ^ VpnConnectionIds@@ -62,3 +157,168 @@         <*> getF "source" vpnStaticRouteSource         <*> getF "state" vpnStaticRouteState         )++------------------------------------------------------------+-- describeVpcs+------------------------------------------------------------+describeVpcs+    :: (MonadResource m, MonadBaseControl IO m)+    => [Text] -- ^ VpcIds+    -> [Filter] -- ^ Filters+    -> EC2 m (ResumableSource m Vpc)+describeVpcs vpcIds filters = do+    ec2QuerySource "DescribeVpcs" params $+        itemConduit "vpcSet" vpcSink+  where+    params =+        [ ArrayParams "VpcId" vpcIds+        , FilterParams filters+        ]++vpcSink :: MonadThrow m+    => GLSink Event m Vpc+vpcSink = Vpc+    <$> getT "vpcId"+    <*> getF "state" vpcState'+    <*> getT "cidrBlock"+    <*> getT "dhcpOptionsId"+    <*> resourceTagSink+    <*> getT "instanceTenancy"++------------------------------------------------------------+-- createVpc+------------------------------------------------------------+createVpc+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ CidrBlock+    -> Maybe Text -- ^ instanceTenancy+    -> EC2 m Vpc+createVpc cidrBlock instanceTenancy =+    ec2Query "CreateVpc" params $+        element "vpc" vpcSink+  where+    params =+        [ ValueParam "CidrBlock" cidrBlock+        ] ++ maybeParams [ ("instanceTenancy", instanceTenancy) ]++------------------------------------------------------------+-- deleteVpc+------------------------------------------------------------+deleteVpc+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ VpcId+    -> EC2 m Bool+deleteVpc = ec2Delete "DeleteVpc" "VpcId"++------------------------------------------------------------+-- describeVpnGateways+------------------------------------------------------------+describeVpnGateways+    :: (MonadResource m, MonadBaseControl IO m)+    => [Text] -- ^ VpnGatewayId+    -> [Filter] -- ^ Filters+    -> EC2 m (ResumableSource m VpnGateway)+describeVpnGateways ids filters = do+    ec2QuerySource "DescribeVpnGateways" params $+        itemConduit "vpnGatewaySet" vpnGatewaySink+  where+    params =+        [ ArrayParams "VpnGatewayId" ids+        , FilterParams filters+        ]++vpnGatewaySink :: MonadThrow m+    => GLSink Event m VpnGateway+vpnGatewaySink = VpnGateway+    <$> getT "vpnGatewayId"+    <*> getF "state" vpnGatewayState'+    <*> getT "type"+    <*> getMT "availabilityZone"+    <*> itemsSet "attachments" attachmentSink+    <*> resourceTagSink++attachmentSink :: MonadThrow m+    => GLSink Event m Attachment+attachmentSink = Attachment+    <$> getT "vpcId"+    <*> getF "state" attachmentState'++------------------------------------------------------------+-- createVpnGateway+------------------------------------------------------------+createVpnGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => CreateVpnGatewayType -- ^ Type. The valid value is CreateVpnGatewayTypeIpsec1+    -> Maybe Text -- ^ AvailabilityZone+    -> EC2 m VpnGateway+createVpnGateway _ availabilityZone = do+    ec2Query "CreateVpnGateway" params $+        element "vpnGateway" vpnGatewaySink+  where+    params =+        [ ValueParam "Type" "ipsec.1"+        ] ++ maybeParams [ ("AvailabilityZone", availabilityZone) ]++------------------------------------------------------------+-- deleteVpnGateway+------------------------------------------------------------+deleteVpnGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ VpnGatewayId+    -> EC2 m Bool+deleteVpnGateway = ec2Delete "DeleteVpnGateway" "VpnGatewayId"++------------------------------------------------------------+-- describeCustomerGateway+------------------------------------------------------------+describeCustomerGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => [Text] -- ^ CustomerGatewayId+    -> [Filter] -- ^ Filters+    -> EC2 m (ResumableSource m CustomerGateway)+describeCustomerGateway ids filters = do+    ec2QuerySource "DescribeCustomerGateways" params $+        itemConduit "customerGatewaySet" customerGatewaySink+  where+    params =+        [ ArrayParams "CustomerGatewayId" ids+        , FilterParams filters+        ]++customerGatewaySink :: MonadThrow m+    => GLSink Event m CustomerGateway+customerGatewaySink = CustomerGateway+    <$> getT "customerGatewayId"+    <*> getF "state" customerGatewayState'+    <*> getT "type"+    <*> getT "ipAddress"+    <*> getF "bgpAsn" textToInt+    <*> resourceTagSink++------------------------------------------------------------+-- createCustomerGateway+------------------------------------------------------------+createCustomerGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ Type+    -> Text -- ^ IpAddress+    -> Int -- ^ BgpAsn+    -> EC2 m CustomerGateway+createCustomerGateway type' ipAddr bgpAsn = do+    ec2Query "CreateCustomerGateway" params $+        element "customerGateway" customerGatewaySink+  where+    params =+        [ ValueParam "Type" type' +        , ValueParam "IpAddress" ipAddr+        , ValueParam "BgpAsn" (toText bgpAsn)+        ]++------------------------------------------------------------+-- deleteCustomerGateway+------------------------------------------------------------+deleteCustomerGateway+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ CustomerGatewayId+    -> EC2 m Bool+deleteCustomerGateway = ec2Delete "DeleteCustomerGateway" "CustomerGatewayId"

@@ -9,7 +9,7 @@     , enableVolumeIO     , describeVolumeAttribute     , modifyVolumeAttribute-    ) where +    ) where import Data.Text (Text)  import Data.XML.Types (Event)@@ -17,6 +17,7 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative +import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query@@ -50,12 +51,12 @@     <*> resourceTagSink     <*> volumeTypeSink -attachmentSink :: MonadThrow m => GLSink Event m Attachment-attachmentSink = Attachment+attachmentSink :: MonadThrow m => GLSink Event m AttachmentSetItemResponse+attachmentSink = AttachmentSetItemResponse     <$> getT "volumeId"     <*> getT "instanceId"     <*> getT "device"-    <*> getF "status" attachmentStatus+    <*> getF "status" attachmentSetItemResponseStatus     <*> getF "attachTime" textToTime     <*> getM "deleteOnTermination" (textToBool <$>) @@ -91,16 +92,14 @@     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ VolumeId     -> EC2 m Bool-deleteVolume volid =-    ec2Query "DeleteVolume" [ValueParam "VolumeId" volid]-        $ getF "return" textToBool+deleteVolume = ec2Delete "DeleteVolume" "VolumeId"  attachVolume     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ VolumeId     -> Text -- ^ InstanceId     -> Text -- ^ Device-    -> EC2 m Attachment+    -> EC2 m AttachmentSetItemResponse attachVolume volid iid dev =     ec2Query "AttachVolume" params attachmentSink   where@@ -116,7 +115,7 @@     -> Maybe Text -- ^ InstanceId     -> Maybe Text -- ^ Device     -> Maybe Bool -- ^ Force-    -> EC2 m Attachment+    -> EC2 m AttachmentSetItemResponse detachVolume volid iid dev force =     ec2Query "DetachVolume" params attachmentSink   where

@@ -0,0 +1,24 @@+{-# LANGUAGE RankNTypes, OverloadedStrings, TemplateHaskell #-}++module AWS.Lib.Convert+    where++import Language.Haskell.TH+import Control.Applicative ((<$>))+import Data.Text (Text)++import AWS.Util++mkConvertFunc :: String -> Name -> [String] -> Q [Dec]+mkConvertFunc fs d strs = runQ $ do+  v <- newName "v"+  ctrs <- (\(TyConI (DataD [] _ [] x [])) -> map (\(NormalC name []) -> name) x)+          <$> reify d+  return $+      [ SigD (mkName fs) (AppT (AppT ArrowT (ConT ''Text)) (ConT d))+      , FunD (mkName fs) [Clause [VarP v] (NormalB+        (CaseE (VarE v)+           $ (map (\(s,t) -> Match (LitP (StringL s)) (NormalB (ConE t)) []) $ zip strs ctrs)+           ++ [Match WildP (NormalB (AppE (AppE (VarE 'err) (LitE (StringL $ show d))) (LitE (StringL $ show v)))) []])+      ) []]+      ]

@@ -1,5 +1,5 @@ name:                aws-sdk-version:             0.5.0.0+version:             0.6.0.0 synopsis:            AWS SDK for Haskell description:         An AWS(Amazon Web Services) liblary for Haskell. license:             BSD3@@ -28,6 +28,7 @@                    , AWS.EC2.Internal                    , AWS.EC2.Address                    , AWS.EC2.AvailabilityZone+                   , AWS.EC2.Convert                    , AWS.EC2.Image                    , AWS.EC2.Instance                    , AWS.EC2.Volume@@ -42,6 +43,7 @@                    , AWS.EC2.Acl                    , AWS.EC2.Tag                    , AWS.EC2.Params+                   , AWS.Lib.Convert                    , AWS.Lib.Parser                    , AWS.Lib.Query                    , AWS.RDS.Internal@@ -57,7 +59,7 @@                    , base64-bytestring >= 1.0.0.0                    , bytestring                    , http-types-                   , conduit >= 0.5.0+                   , conduit >= 0.5.2                    , transformers                    , time                    , old-locale@@ -74,12 +76,14 @@                    , lifted-base                    , transformers-base                    , strptime+                   , template-haskell+                   , parallel  test-suite test     type:              exitcode-stdio-1.0     main-is:           main.hs     hs-source-dirs:    tests-    ghc-options:       -Wall+    ghc-options:       -Wall -threaded      build-depends: base                  , hspec