aws-sdk 0.7.0.0 → 0.7.1.0

raw patch · 34 files changed

+967/−749 lines, 34 filesdep +iproutePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: iproute

API changes (from Hackage documentation)

Files

• AWS.hs +2/−1
• AWS/Class.hs +12/−2
• AWS/CloudWatch.hs +1/−1
• AWS/CloudWatch/Metric.hs +6/−6
• AWS/EC2.hs +17/−8
• AWS/EC2/Acl.hs +12/−13
• AWS/EC2/Address.hs +20/−21
• AWS/EC2/Convert.hs +0/−200
• AWS/EC2/Image.hs +20/−21
• AWS/EC2/Instance.hs +119/−68
• AWS/EC2/Internal.hs +27/−11
• AWS/EC2/NetworkInterface.hs +111/−0
• AWS/EC2/Params.hs +8/−0
• AWS/EC2/Query.hs +8/−6
• AWS/EC2/RouteTable.hs +12/−13
• AWS/EC2/SecurityGroup.hs +11/−11
• AWS/EC2/Snapshot.hs +6/−8
• AWS/EC2/Subnets.hs +3/−4
• AWS/EC2/Tag.hs +3/−3
• AWS/EC2/Types.hs +337/−165
• AWS/EC2/Util.hs +22/−1
• AWS/EC2/VPC.hs +21/−24
• AWS/EC2/Volume.hs +13/−15
• AWS/ELB.hs +1/−1
• AWS/ELB/LoadBalancer.hs +11/−12
• AWS/Lib/Convert.hs +0/−24
• AWS/Lib/FromText.hs +83/−0
• AWS/Lib/Parser.hs +37/−43
• AWS/Lib/Query.hs +9/−6
• AWS/RDS.hs +1/−1
• AWS/RDS/DBInstance.hs +22/−22
• AWS/Util.hs +2/−34
• Tests/Main.hs +1/−0
• aws-sdk.cabal +9/−4

@@ -24,7 +24,7 @@ -- >     cred <- loadCredential -- >     doc <- runResourceT $ -- >         runEC2 cred $--- >             Util.asList $ describeInstances [] []+-- >             Util.list $ describeInstances [] [] -- >     print doc -- >     putStr "Length: " -- >     print $ length doc@@ -38,6 +38,7 @@       -- * Environment     , AWS     , AWSException(..)+    , getLastRequestId     ) where  import AWS.Credential

@@ -11,6 +11,8 @@     , runAWS     , AWSException(..)     , AWSContext(..)+    , getLastRequestId+    , monadThrow     ) where  import Control.Monad.State (StateT(..), MonadState)@@ -18,7 +20,7 @@ import Control.Monad.Reader (ReaderT(..), MonadReader) import qualified Control.Monad.Reader as R import Control.Applicative-import Control.Monad (liftM)+import Control.Monad import Control.Monad.Base (MonadBase) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (MonadTrans, lift)@@ -31,6 +33,7 @@     ) import Control.Exception (Exception) import Data.Typeable (Typeable)+import Data.Conduit (MonadThrow, monadThrow)  import qualified Network.HTTP.Conduit as HTTP import Data.Text (Text)@@ -41,11 +44,15 @@  data AWSException     = ClientError-        { errorStatus :: Int+        { errorAction :: ByteString+        , errorStatus :: Int         , errorCode :: Text         , errorMessage :: Text         , errorRequestId :: Text         } -- ^ This error is caused by client requests.+    | ResponseParseError Text+    | TextConversionException Text+        -- ^ parse error: cannot convert Text to oher data type.     | NextToken Text -- ^ This response has next token.   deriving (Show, Typeable) @@ -100,3 +107,6 @@     R.runReaderT         (S.evalStateT (runAWST app) $ ctx mgr)         cred++getLastRequestId :: (Monad m, Functor m) => AWS AWSContext m (Maybe Text)+getLastRequestId = lastRequestId <$> S.get

@@ -19,7 +19,7 @@ import Data.Monoid ((<>))  import AWS.Class-import AWS.Util+import AWS.Lib.Query (textToBS)  import AWS import AWS.CloudWatch.Internal

@@ -61,13 +61,13 @@ getMetricStatistics ds start end mn ns pe sts unit =     cloudWatchQuery "GetMetricStatistics" params $ (,)         <$> members "Datapoints" (Datapoint-            <$> getF "Timestamp" textToTime-            <*> getM "SampleCount" (textToDouble <$>)+            <$> getT "Timestamp"+            <*> getT "SampleCount"             <*> getT "Unit"-            <*> getM "Minimum" (textToDouble <$>)-            <*> getM "Maximum" (textToDouble <$>)-            <*> getM "Sum" (textToDouble <$>)-            <*> getM "Average" (textToDouble <$>)+            <*> getT "Minimum"+            <*> getT "Maximum"+            <*> getT "Sum"+            <*> getT "Average"             )         <*> getT "Label"   where

@@ -6,6 +6,7 @@       EC2     , runEC2     , setRegion+    , setEndpoint       -- * Instances     , module AWS.EC2.Instance       -- * Images@@ -20,6 +21,8 @@     , module AWS.EC2.KeyPair       -- * SecurityGroups     , module AWS.EC2.SecurityGroup+      -- * NetworkInterface+    , module AWS.EC2.NetworkInterface       -- * Placements     , module AWS.EC2.Region     , module AWS.EC2.AvailabilityZone@@ -36,9 +39,10 @@ import Control.Monad.Trans.Control (MonadBaseControl) import qualified Control.Monad.State as State import Data.Text (Text)+import Data.ByteString (ByteString) -import AWS.Util import AWS.Class+import AWS.Lib.Query (textToBS) import AWS.EC2.Internal import AWS.EC2.Types import qualified AWS.EC2.Util as Util@@ -57,18 +61,23 @@ import AWS.EC2.Subnets import AWS.EC2.Acl import AWS.EC2.RouteTable+import AWS.EC2.NetworkInterface --- | set endpoint to EC2 context.+-- | set endpoint to EC2 context by giving the EC2 region. setRegion     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ RegionName     -> EC2 m () setRegion name = do     region <- Util.head $ describeRegions [name] []-    ctx <- State.get-    maybe-        (fail "region not found")-        (\r -> State.put ctx { endpoint = f r })-        region+    maybe (fail "region not found") (setEndpoint . g) region   where-    f = textToBS . regionEndpoint+    g = textToBS . regionEndpoint++-- | set endpoint to EC2 context.+setEndpoint :: (MonadResource m, MonadBaseControl IO m)+    => ByteString -- ^ ec2 endpoint domain <http://docs.amazonwebservices.com/general/latest/gr/rande.html>+    -> EC2 m ()+setEndpoint endpoint = do+    ctx <- State.get+    State.put ctx { endpoint = endpoint }

@@ -16,7 +16,6 @@ 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@@ -42,20 +41,20 @@ networkAclSink = NetworkAcl     <$> getT "networkAclId"     <*> getT "vpcId"-    <*> getF "default" textToBool+    <*> getT "default"     <*> itemsSet "entrySet" (NetworkAclEntry-        <$> getF "ruleNumber" textToInt-        <*> getF "protocol" textToInt-        <*> getF "ruleAction" networkAclRuleAction-        <*> getF "egress" textToBool+        <$> getT "ruleNumber"+        <*> getT "protocol"+        <*> getT "ruleAction"+        <*> getT "egress"         <*> getT "cidrBlock"         <*> elementM "icmpTypeCode" (IcmpTypeCode-            <$> getF "code" textToInt-            <*> getF "type" textToInt+            <$> getT "code"+            <*> getT "type"             )         <*> elementM "portRange" (PortRange-            <$> getF "from" textToInt-            <*> getF "to" textToInt))+            <$> getT "from"+            <*> getT "to"))     <*> itemsSet "associationSet" (NetworkAclAssociation         <$> getT "networkAclAssociationId"         <*> getT "networkAclId"@@ -98,7 +97,7 @@     => NetworkAclEntryRequest     -> EC2 m Bool createNetworkAclEntry req =-    ec2Query "CreateNetworkAclEntry" params returnBool+    ec2Query "CreateNetworkAclEntry" params $ getT "return"   where     params = reqToParams req @@ -145,7 +144,7 @@     -> Bool -- ^ Egress     -> EC2 m Bool deleteNetworkAclEntry aclid rule egress =-    ec2Query "DeleteNetworkAclEntry" params returnBool+    ec2Query "DeleteNetworkAclEntry" params $ getT "return"   where     params =         [ ValueParam "NetworkAclId" aclid@@ -158,6 +157,6 @@     => NetworkAclEntryRequest     -> EC2 m Bool replaceNetworkAclEntry req =-    ec2Query "ReplaceNetworkAclEntry" params returnBool+    ec2Query "ReplaceNetworkAclEntry" params $ getT "return"   where     params = reqToParams req

@@ -11,13 +11,12 @@     ) where  import Data.Text (Text)-+import Data.IP (IPv4) import Data.XML.Types (Event) import Data.Conduit 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@@ -44,13 +43,13 @@     addressSet :: MonadThrow m => GLConduit Event m Address     addressSet = itemConduit "addressesSet" $ Address         <$> getT "publicIp"-        <*> getMT "allocationId"-        <*> getM "domain" addressDomain'-        <*> getMT "instanceId"-        <*> getMT "associationId"-        <*> getMT "networkInterfaceId"-        <*> getMT "networkInterfaceOwnerId"-        <*> getMT "privateIpAddress"+        <*> getT "allocationId"+        <*> getT "domain"+        <*> getT "instanceId"+        <*> getT "associationId"+        <*> getT "networkInterfaceId"+        <*> getT "networkInterfaceOwnerId"+        <*> getT "privateIpAddress"  ----------------------------------------------------- -- AllocateAddress@@ -63,8 +62,8 @@     ec2Query "AllocateAddress" params $         AllocateAddress         <$> getT "publicIp"-        <*> getM "domain" addressDomain'-        <*> getMT "allocationId"+        <*> getT "domain"+        <*> getT "allocationId"   where     params = if isVpc then [ValueParam "Domain" "vpc"] else [] @@ -73,14 +72,14 @@ ----------------------------------------------------- releaseAddress     :: (MonadResource m, MonadBaseControl IO m)-    => Maybe Text -- ^ PublicIp+    => Maybe IPv4 -- ^ PublicIp     -> Maybe Text -- ^ AllocationId     -> EC2 m EC2Return releaseAddress addr allocid = do-    ec2Query "ReleaseAddress" params $ getF "return" ec2Return+    ec2Query "ReleaseAddress" params $ getT "return"   where     params = maybeParams-        [ ("PublicIp", addr)+        [ ("PublicIp", toText <$> addr)         , ("AllocationId", allocid)         ] @@ -92,15 +91,15 @@     => AssociateAddressRequest     -> EC2 m (Bool, Maybe Text) associateAddress param = ec2Query "AssociateAddress" params $-    (,) <$> getF "return" textToBool-        <*> getMT "associationId"+    (,) <$> getT "return"+        <*> getT "associationId"   where     params = associateAddressParam param  associateAddressParam     :: AssociateAddressRequest -> [QueryParam] associateAddressParam (AssociateAddressRequestEc2 ip iid) =-    [ ValueParam "PublicIp" ip+    [ ValueParam "PublicIp" $ toText ip     , ValueParam "InstanceId" iid     ] associateAddressParam@@ -109,7 +108,7 @@     ++ maybeParams         [ ("InstanceId", iid)         , ("NetworkInterfaceId", nid)-        , ("PrivateIpAddress", pip)+        , ("PrivateIpAddress", toText <$> pip)         , ("AllowReassociation", boolToText <$> ar)         ] @@ -119,9 +118,9 @@     -> EC2 m Bool disassociateAddress param =     ec2Query "DisassociateAddress" (p param)-        $ getF "return" textToBool+        $ getT "return"   where     p (DisassociateAddressRequestEc2 pip)-        = [ValueParam "PublicIp" pip]+        = [ValueParam "PublicIp" $ toText pip]     p (DisassociateAddressRequestVpc aid)-        = [ValueParam "AssociationId" aid]+        = [ValueParam "AssociationId" $ toText aid]

@@ -1,200 +0,0 @@-{-# 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   = PlatformOther-platform (Just t)-    | t == "windows" = PlatformWindows-    | otherwise      = PlatformOther--mkConvertFunc-    "rootDeviceType"-    ''RootDeviceType-    ["ebs", "instance-store"]--volumeType :: Text -> Maybe Int -> VolumeType-volumeType t Nothing  | t == "standard" = VolumeTypeStandard-volumeType t (Just i) | t == "io1"      = VolumeTypeIO1 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, InstanceStatePending)-    , (16, InstanceStateRunning)-    , (32, InstanceStateShuttingDown)-    , (48, InstanceStateTerminated)-    , (64, InstanceStateStopping)-    , (80, InstanceStateStopped)-    ]--codeToState :: Int -> InstanceState-codeToState code = maybe-    (InstanceStateUnknown code)-    id-    (lookup code instanceStateCodes)--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"]

@@ -17,7 +17,6 @@ import Control.Applicative import Control.Monad (join) -import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Params@@ -48,38 +47,38 @@ imageItem = Image     <$> getT "imageId"     <*> getT "imageLocation"-    <*> getF "imageState" imageState+    <*> getT "imageState"     <*> getT "imageOwnerId"-    <*> getF "isPublic" textToBool+    <*> getT "isPublic"     <*> productCodeSink     <*> getT "architecture"-    <*> getF "imageType" imageType-    <*> getMT "kernelId"-    <*> getMT "ramdiskId"-    <*> getM "platform" platform+    <*> getT "imageType"+    <*> getT "kernelId"+    <*> getT "ramdiskId"+    <*> getT "platform"     <*> stateReasonSink-    <*> getM "viridianEnabled" (textToBool <$>)-    <*> getMT "imageOwnerAlias"-    <*> getM "name" orEmpty-    <*> getM "description" orEmpty+    <*> getT "viridianEnabled"+    <*> getT "imageOwnerAlias"+    <*> getT "name"+    <*> getT "description"     <*> itemsSet "billingProducts" (getT "billingProduct")-    <*> getF "rootDeviceType" rootDeviceType-    <*> getMT "rootDeviceName"+    <*> getT "rootDeviceType"+    <*> getT "rootDeviceName"     <*> blockDeviceMappingSink-    <*> getF "virtualizationType" virtualizationType+    <*> getT "virtualizationType"     <*> resourceTagSink-    <*> getF "hypervisor" hypervisor+    <*> getT "hypervisor"  blockDeviceMappingSink :: MonadThrow m => GLSink Event m [BlockDeviceMapping] blockDeviceMappingSink = itemsSet "blockDeviceMapping" (     BlockDeviceMapping     <$> getT "deviceName"-    <*> getMT "virtualName"+    <*> getT "virtualName"     <*> elementM "ebs" (         EbsBlockDevice-        <$> getMT "snapshotId"-        <*> getF "volumeSize" textToInt-        <*> getF "deleteOnTermination" textToBool+        <$> getT "snapshotId"+        <*> getT "volumeSize"+        <*> getT "deleteOnTermination"         <*> volumeTypeSink         )     )@@ -133,7 +132,7 @@     => Text -- ^ ImageId     -> EC2 m Bool deregisterImage iid =-    ec2Query "DeregisterImage" params returnBool+    ec2Query "DeregisterImage" params $ getT "return"   where     params = [ValueParam "ImageId" iid] @@ -157,7 +156,7 @@         <*> getMMT "description"         <*> blockDeviceMappingSink   where-    getMMT name = join <$> elementM name (getMT "value")+    getMMT name = join <$> elementM name (getT "value")     params = [ ValueParam "ImageId" iid              , ValueParam "Attribute" param              ]

@@ -21,10 +21,11 @@ import Data.Conduit import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative-import Data.Maybe (fromJust)+import Data.Maybe (fromMaybe, fromJust) import qualified Data.Map as Map+import Data.Monoid+import Control.Monad -import AWS.EC2.Convert import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Params@@ -57,12 +58,7 @@     <*> getT "ownerId"     <*> groupSetSink     <*> instanceSetSink-    <*> getMT "requesterId"--groupSetSink :: MonadThrow m => GLSink Event m [Group]-groupSetSink = itemsSet "groupSet" $ Group-    <$> getT "groupId"-    <*> getT "groupName"+    <*> getT "requesterId"  instanceSetSink :: MonadThrow m     => GLSink Event m [Instance]@@ -74,45 +70,45 @@     <*> getT "privateDnsName"     <*> getT "dnsName"     <*> getT "reason"-    <*> getMT "keyName"+    <*> getT "keyName"     <*> getT "amiLaunchIndex"     <*> productCodeSink     <*> getT "instanceType"-    <*> getF "launchTime" textToTime+    <*> getT "launchTime"     <*> element "placement" (         Placement         <$> getT "availabilityZone"         <*> getT "groupName"         <*> getT "tenancy"         )-    <*> getMT "kernelId"-    <*> getMT "ramdiskId"-    <*> getMT "platform"-    <*> element "monitoring" (getF "state" instanceMonitoringState)-    <*> getMT "subnetId"-    <*> getMT "vpcId"-    <*> getMT "privateIpAddress"-    <*> getMT "ipAddress"-    <*> getM "sourceDestCheck" (textToBool <$>)+    <*> getT "kernelId"+    <*> getT "ramdiskId"+    <*> getT "platform"+    <*> element "monitoring" (getT "state")+    <*> getT "subnetId"+    <*> getT "vpcId"+    <*> getT "privateIpAddress"+    <*> getT "ipAddress"+    <*> getT "sourceDestCheck"     <*> groupSetSink     <*> stateReasonSink-    <*> getF "architecture" architecture-    <*> getF "rootDeviceType" rootDeviceType-    <*> getMT "rootDeviceName"+    <*> getT "architecture"+    <*> getT "rootDeviceType"+    <*> getT "rootDeviceName"     <*> instanceBlockDeviceMappingsSink-    <*> getM "instanceLifecycle" instanceLifecycle-    <*> getMT "spotInstanceRequestId"-    <*> getF "virtualizationType" virtualizationType+    <*> getT "instanceLifecycle"+    <*> getT "spotInstanceRequestId"+    <*> getT "virtualizationType"     <*> getT "clientToken"     <*> resourceTagSink-    <*> getF "hypervisor" hypervisor+    <*> getT "hypervisor"     <*> networkInterfaceSink     <*> elementM "iamInstanceProfile" (         IamInstanceProfile         <$> getT "arn"         <*> getT "id"         )-    <*> getF "ebsOptimized" textToBool+    <*> getT "ebsOptimized"  instanceBlockDeviceMappingsSink :: MonadThrow m     => GLSink Event m [InstanceBlockDeviceMapping]@@ -122,18 +118,32 @@     <*> element "ebs" (         EbsInstanceBlockDevice         <$> getT "volumeId"-        <*> getF "status" attachmentSetItemResponseStatus'-        <*> getF "attachTime" textToTime-        <*> getF "deleteOnTermination" textToBool+        <*> getT "status"+        <*> getT "attachTime"+        <*> getT "deleteOnTermination"         )     ) +instanceStateCodes :: [(Int, InstanceState)]+instanceStateCodes =+    [ ( 0, InstanceStatePending)+    , (16, InstanceStateRunning)+    , (32, InstanceStateShuttingDown)+    , (48, InstanceStateTerminated)+    , (64, InstanceStateStopping)+    , (80, InstanceStateStopped)+    ]++codeToState :: Int -> Text -> InstanceState+codeToState code _name = fromMaybe+    (InstanceStateUnknown code)+    (lookup code instanceStateCodes)+ instanceStateSink :: MonadThrow m     => Text -> GLSink Event m InstanceState-instanceStateSink label = element label $-    codeToState-    <$> getF "code" textToInt-    <* getT "name"+instanceStateSink label = element label $ codeToState+    <$> getT "code"+    <*> getT "name"  networkInterfaceSink :: MonadThrow m     => GLSink Event m [InstanceNetworkInterface]@@ -142,33 +152,33 @@     <$> getT "networkInterfaceId"     <*> getT "subnetId"     <*> getT "vpcId"-    <*> getM "description" orEmpty+    <*> getT "description"     <*> getT "ownerId"     <*> getT "status"     <*> getT "privateIpAddress"-    <*> getMT "privateDnsName"-    <*> getF "sourceDestCheck" textToBool+    <*> getT "privateDnsName"+    <*> getT "sourceDestCheck"     <*> groupSetSink     <*> element "attachment" (-        NetworkInterfaceAttachment+        InstanceNetworkInterfaceAttachment         <$> getT "attachmentId"-        <*> getF "deviceIndex" textToInt+        <*> getT "deviceIndex"         <*> getT "status"-        <*> getF "attachTime" textToTime-        <*> getF "deleteOnTermination" textToBool+        <*> getT "attachTime"+        <*> getT "deleteOnTermination"         )-    <*> niAssociationSink+    <*> instanceNetworkInterfaceAssociationSink     <*> itemsSet "privateIpAddressesSet" (         InstancePrivateIpAddress         <$> getT "privateIpAddress"-        <*> getF "primary" textToBool-        <*> niAssociationSink+        <*> getT "primary"+        <*> instanceNetworkInterfaceAssociationSink         ) -niAssociationSink :: MonadThrow m-    => GLSink Event m (Maybe NetworkInterfaceAssociation)-niAssociationSink = elementM "association" $-    NetworkInterfaceAssociation+instanceNetworkInterfaceAssociationSink :: MonadThrow m+    => GLSink Event m (Maybe InstanceNetworkInterfaceAssociation)+instanceNetworkInterfaceAssociationSink = elementM "association" $+    InstanceNetworkInterfaceAssociation     <$> getT "publicIp"     <*> getT "ipOwnerId" @@ -201,10 +211,10 @@         <*> getT "availabilityZone"         <*> itemsSet "eventsSet" (             InstanceStatusEvent-            <$> getF "code" instanceStatusEventCode'+            <$> getT "code"             <*> getT "description"-            <*> getM "notBefore" (textToTime <$>)-            <*> getM "notAfter" (textToTime <$>)+            <*> getT "notBefore"+            <*> getT "notAfter"             )         <*> instanceStateSink "instanceState"         <*> instanceStatusTypeSink "systemStatus"@@ -214,12 +224,12 @@     => Text -> GLSink Event m InstanceStatusType instanceStatusTypeSink name = element name $     InstanceStatusType-    <$> getF "status" instanceStatusTypeStatus'+    <$> getT "status"     <*> itemsSet "details" (         InstanceStatusDetail         <$> getT "name"         <*> getT "status"-        <*> getM "impairedSince" (textToTime <$>)+        <*> getT "impairedSince"         )  ------------------------------------------------------------@@ -266,7 +276,7 @@     => [Text] -- ^ InstanceIds     -> EC2 m Bool rebootInstances instanceIds =-    ec2Query "RebootInstances" params returnBool+    ec2Query "RebootInstances" params $ getT "return"   where     params = [ArrayParams "InstanceId" instanceIds] @@ -306,7 +316,9 @@             $ runInstancesRequestSecurityGroups param         , blockDeviceMappingParams             $ runInstancesRequestBlockDeviceMappings param-        ] ++ maybeParams+        ] ++ networkInterfaceParams+             (runInstancesRequestNetworkInterfaces param)+          ++ maybeParams             [ ("KeyName", runInstancesRequestKeyName param)             , ("UserData"               , bsToText <$> runInstancesRequestUserData param@@ -339,7 +351,8 @@                 <$> runInstancesRequestShutdownBehavior param               )             , ("PrivateIpAddress"-              , runInstancesRequestPrivateIpAddress param+              , toText+                <$> runInstancesRequestPrivateIpAddress param               )             , ("ClientToken", runInstancesRequestClientToken param)             , ("IamInstanceProfile.Arn"@@ -388,6 +401,42 @@         Nothing         Nothing +networkInterfaceParams :: [NetworkInterfaceParam] -> [QueryParam]+networkInterfaceParams nips = f 1 nips+  where+    f :: Int -> [NetworkInterfaceParam] -> [QueryParam]+    f _ [] = []+    f n (ni:nis) = g n ni ++ f (n + 1) nis+    g n (NetworkInterfaceParamAttach nid idx dot) =+        [ ValueParam (p n "NetworkInterfaceId") nid+        , ValueParam (p n "DeviceIndex") $ toText idx+        , ValueParam (p n "DeleteOnTermination") $ boolToText dot+        ]+    g n (NetworkInterfaceParamCreate idx sn desc pip sip sec dot) =+        [ ValueParam (p n "DeviceIndex") $ toText idx+        , ValueParam (p n "SubnetId") sn+        , ValueParam (p n "Description") desc+        , ArrayParams (p n "SecurityroupId") sec+        , ValueParam (p n "DeleteOnTermination") $ boolToText dot+        ] ++ maybeParams [(p n "PrivateIpAddress", toText <$> pip)]+          ++ s n sip+    p n name = "NetworkInterface." <> toText n <> "." <> name+    s _ SecondaryPrivateIpAddressParamNothing = []+    s n (SecondaryPrivateIpAddressParamCount c) =+        [ ValueParam+          (p n "SecondaryPrivateIpAddressCount")+          $ toText c+        ]+    s n (SecondaryPrivateIpAddressParamSpecified addrs pr) =+        [ privateIpAddressesParam (p n "PrivateIpAddresses") addrs+        ] ++ maybe+            []+            (\i -> [+              ValueParam+              (p n "PrivateIpAddresses." <> toText i <> ".Primary")+              "true"])+            pr+ sbToText :: ShutdownBehavior -> Text sbToText ShutdownBehaviorStop      = "stop" sbToText ShutdownBehaviorTerminate = "terminate"@@ -403,7 +452,7 @@     ec2Query "GetConsoleOutput" [ValueParam "InstanceId" iid] $         ConsoleOutput         <$> getT "instanceId"-        <*> getF "timestamp" textToTime+        <*> getT "timestamp"         <*> getT "output"  ------------------------------------------------------------@@ -417,7 +466,7 @@     ec2Query "GetPasswordData" [ValueParam "InstanceId" iid] $         PasswordData         <$> getT "instanceId"-        <*> getF "timestamp" textToTime+        <*> getT "timestamp"         <*> getT "passwordData"  describeInstanceAttribute@@ -427,7 +476,7 @@     -> EC2 m InstanceAttribute describeInstanceAttribute iid attr =     ec2Query "DescribeInstanceAttribute" params-        $ getT "instanceId" *> f attr+        $ getT_ "instanceId" *> f attr   where     str = iar attr     params =@@ -449,19 +498,21 @@         , (InstanceAttributeRequestRamdiskId, InstanceAttributeRamdiskId)         , (InstanceAttributeRequestUserData, InstanceAttributeUserData)         , (InstanceAttributeRequestDisableApiTermination,-           InstanceAttributeDisableApiTermination-           . textToBool . fromJust)+           InstanceAttributeDisableApiTermination . just)         , (InstanceAttributeRequestShutdownBehavior,            InstanceAttributeShutdownBehavior-           . shutdownBehavior . fromJust)-        , (InstanceAttributeRequestRootDeviceName, InstanceAttributeRootDeviceName)+           . fromJust . fromTextMay . fromJust)+        , (InstanceAttributeRequestRootDeviceName,+           InstanceAttributeRootDeviceName)         , (InstanceAttributeRequestSourceDestCheck,-           InstanceAttributeSourceDestCheck . (textToBool <$>))+           InstanceAttributeSourceDestCheck+           . fromTextMay . fromJust)         , (InstanceAttributeRequestEbsOptimized,-           InstanceAttributeEbsOptimized . textToBool . fromJust)+           InstanceAttributeEbsOptimized . just)         ]+    just = fromJust . join . (fromTextMay <$>)     valueSink name val =-        (element name $ getMT "value") >>= return . val+        (element name $ getT "value") >>= return . val  iar :: InstanceAttributeRequest -> Text iar InstanceAttributeRequestInstanceType          = "instanceType"@@ -488,7 +539,7 @@     -> ResetInstanceAttributeRequest     -> EC2 m Bool resetInstanceAttribute iid attr =-    ec2Query "ResetInstanceAttribute" params returnBool+    ec2Query "ResetInstanceAttribute" params $ getT "return"   where     params =         [ ValueParam "InstanceId" iid@@ -502,7 +553,7 @@     -> [ModifyInstanceAttributeRequest]     -> EC2 m Bool modifyInstanceAttribute iid attrs =-    ec2Query "ModifyInstanceAttribute" params returnBool+    ec2Query "ModifyInstanceAttribute" params $ getT "return"   where     params = ValueParam "InstanceId" iid:concatMap miap attrs 

@@ -1,9 +1,22 @@ {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}  module AWS.EC2.Internal-    where+    ( module AWS.Class+    , EC2+    , initialEC2Context+    , runEC2+    , itemConduit+    , itemsSet+    , resourceTagSink+    , productCodeSink+    , stateReasonSink+    , volumeTypeSink+    , groupSetSink+    ) where  import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Class (lift) import qualified Network.HTTP.Conduit as HTTP import Data.ByteString.Char8 () import Control.Applicative@@ -13,9 +26,7 @@ import Data.Text (Text)  import AWS.Class-import AWS.EC2.Convert import AWS.Credential-import AWS.Util import AWS.Lib.Parser import AWS.EC2.Types @@ -49,14 +60,14 @@ resourceTagSink = itemsSet "tagSet" $     ResourceTag     <$> getT "key"-    <*> getMT "value"+    <*> getT "value"  productCodeSink :: MonadThrow m     => GLSink Event m [ProductCode] productCodeSink = itemsSet "productCodes" $     ProductCode     <$> getT "productCode"-    <*> getF "type" productCodeType'+    <*> getT "type"  stateReasonSink :: MonadThrow m     => GLSink Event m (Maybe StateReason)@@ -65,11 +76,16 @@     <$> getT "code"     <*> getT "message" +volumeType :: MonadThrow m => Text -> Maybe Int -> m VolumeType+volumeType t Nothing  | t == "standard" = return $ VolumeTypeStandard+volumeType t (Just i) | t == "io1"      = return $ VolumeTypeIO1 i+volumeType t _ = monadThrow $ TextConversionException t+ volumeTypeSink :: MonadThrow m-    => GLSink Event m VolumeType-volumeTypeSink = volumeType-    <$> getT "volumeType"-    <*> getM "iops" (textToInt <$>)+    => Pipe Event Event o u m VolumeType+volumeTypeSink = volumeType <$> getT "volumeType" <*> getT "iops" >>= lift -returnBool :: MonadThrow m => GLSink Event m Bool-returnBool = getF "return" textToBool+groupSetSink :: MonadThrow m => GLSink Event m [Group]+groupSetSink = itemsSet "groupSet" $ Group+    <$> getT "groupId"+    <*> getT "groupName"

@@ -0,0 +1,111 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.EC2.NetworkInterface+    ( assignPrivateIpAddresses+    , unassignPrivateIpAddresses+    , describeNetworkInterfaces+    ) where++import Data.IP (IPv4)+import Data.Text (Text)+import Data.XML.Types (Event)+import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Applicative++import AWS.EC2.Internal+import AWS.EC2.Types+import AWS.EC2.Params+import AWS.EC2.Query+import AWS.Lib.Parser+import AWS.Util++assignPrivateIpAddresses+    :: (MonadBaseControl IO m, MonadResource m)+    => Text -- ^ NetworkInterfaceId+    -> Either [IPv4] Int -- ^ PrivateIpAddresses or Count+    -> Maybe Bool+    -> EC2 m Bool+assignPrivateIpAddresses niid epip ar =+    ec2Query "AssignPrivateIpAddresses" params $ getT "return"+  where+    params = [ValueParam "NetworkInterfaceId" niid]+        ++ either f g epip+        ++ maybeParams [("AllowReassignment", boolToText <$> ar)]+    f addrs = [privateIpAddressesParam "PrivateIpAddress" addrs]+    g cnt = [ValueParam "SecondaryPrivateIpAddressCount"+        $ toText cnt]++unassignPrivateIpAddresses+    :: (MonadBaseControl IO m, MonadResource m)+    => Text -- ^ NetworkInterfaceId+    -> [IPv4] -- ^ PrivateIpAddresses+    -> EC2 m Bool+unassignPrivateIpAddresses niid addrs =+    ec2Query "UnassignPrivateIpAddresses" params $ getT "return"+  where+    params =+        [ ValueParam "NetworkInterfaceId" niid+        , privateIpAddressesParam "PrivateIpAddress" addrs+        ]++describeNetworkInterfaces+    :: (MonadBaseControl IO m, MonadResource m)+    => [Text] -- ^ NetworkInterfaceIds+    -> [Filter]+    -> EC2 m (ResumableSource m NetworkInterface)+describeNetworkInterfaces niid filters =+    ec2QuerySource "DescribeNetworkInterfaces" params+        $ itemConduit "networkInterfaceSet" networkInterfaceSink+  where+    params =+        [ ArrayParams "NetworkInterfaceId" niid+        , FilterParams filters+        ]++networkInterfaceSink+    :: MonadThrow m+    => GLSink Event m NetworkInterface+networkInterfaceSink = NetworkInterface+    <$> getT "networkInterfaceId"+    <*> getT "subnetId"+    <*> getT "vpcId"+    <*> getT "availabilityZone"+    <*> getT "description"+    <*> getT "ownerId"+    <*> getT "requesterId"+    <*> getT "requesterManaged"+    <*> getT "status"+    <*> getT "macAddress"+    <*> getT "privateIpAddress"+    <*> getT "privateDnsName"+    <*> getT "sourceDestCheck"+    <*> groupSetSink+    <*> elementM "attachment" (NetworkInterfaceAttachment+        <$> getT "attachmentId"+        <*> getT "instanceId"+        <*> getT "instanceOwnerId"+        <*> getT "deviceIndex"+        <*> getT "status"+        <*> getT "attachTime"+        <*> getT "deleteOnTermination"+        )+    <*> networkInterfaceAssociationSink+    <*> resourceTagSink+    <*> itemsSet "privateIpAddressesSet" (+        NetworkInterfacePrivateIpAddress+        <$> getT "privateIpAddress"+        <*> getT "primary"+        <*> networkInterfaceAssociationSink+        )++networkInterfaceAssociationSink+    :: MonadThrow m+    => GLSink Event m (Maybe NetworkInterfaceAssociation)+networkInterfaceAssociationSink =+    elementM "association" $ NetworkInterfaceAssociation+        <$> getT "attachmentId"+        <*> getT "instanceId"+        <*> getT "publicIp"+        <*> getT "ipOwnerId"+        <*> getT "associationId"

@@ -1,7 +1,9 @@ module AWS.EC2.Params where  import Control.Applicative+import Data.Text (Text) import qualified Data.Text as T+import Data.IP (IPv4)  import AWS.EC2.Query (QueryParam(..)) import AWS.EC2.Types@@ -37,3 +39,9 @@         [ ("Ebs.VolumeType", "io1")         , ("Ebs.Iops", T.pack $ show iops)         ]++privateIpAddressesParam :: Text -> [IPv4] -> QueryParam+privateIpAddressesParam name addrs = StructArrayParams+    name+    $ unconcat $ zip (repeat "PrivateIpAddress")+    $ map toText addrs

@@ -36,6 +36,7 @@  #ifdef DEBUG import Debug.Trace+import Control.Monad.IO.Class (liftIO) import qualified Data.Conduit.Binary as CB #endif @@ -49,14 +50,14 @@     await -- EventBeginElement DescribeImagesResponse     getT "requestId" -sinkError :: MonadThrow m => Int -> GLSink Event m a-sinkError s = do+sinkError :: MonadThrow m => ByteString -> Int -> GLSink Event m a+sinkError a s = do     await     element "Response" $ do         (c,m) <- element "Errors" $ element "Error" $             (,) <$> getT "Code" <*> getT "Message"         r <- getT "RequestID"-        lift $ monadThrow $ ClientError s c m r+        lift $ monadThrow $ ClientError a s c m r  ec2Query     :: (MonadResource m, MonadBaseControl IO m)@@ -106,18 +107,19 @@         (\t -> ValueParam "NextToken" t:params) token  nextToken :: MonadThrow m => Conduit Event m o-nextToken = getMT "nextToken" >>= maybe (return ()) (E.throw . NextToken)+nextToken = getT "nextToken" >>= maybe (return ()) (E.throw . NextToken)  #ifdef DEBUG ec2QueryDebug     :: (MonadResource m, MonadBaseControl IO m)     => ByteString     -> [QueryParam]-    -> EC2 m (Source m o)+    -> EC2 m a ec2QueryDebug action params = do     cred <- Reader.ask     ctx <- State.get     lift $ do+        liftIO $ mapM_ print params         response <- requestQuery cred ctx action params apiVersion sinkError         (res, _) <- unwrapResumable response         res $$ CB.sinkFile "debug.txt" >>= fail "debug"@@ -130,4 +132,4 @@     -> Text -- ^ ID of Target     -> EC2 m Bool ec2Delete apiName idName targetId = do-    ec2Query apiName [ ValueParam idName targetId ] returnBool+    ec2Query apiName [ ValueParam idName targetId ] $ getT "return"

@@ -15,12 +15,10 @@ 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 import AWS.Lib.Parser-import AWS.Util  ------------------------------------------------------------ -- describeRouteTables@@ -46,27 +44,27 @@     <*> getT "vpcId"     <*> routeSink     <*> routeTableAssociationSink-    <*> getMT "propagatingVgwSet"+    <*> getT "propagatingVgwSet"     <*> resourceTagSink  routeSink :: MonadThrow m     => GLSink Event m [Route] routeSink = itemsSet "routeSet" $ Route     <$> getT "destinationCidrBlock"-    <*> getMT "gatewayId"-    <*> getMT "instanceId"-    <*> getMT "instanceOwnerId"-    <*> getMT "networkInterfaceId"-    <*> getF "state" routeState'-    <*> getM "origin" (routeOrigin' <$>)+    <*> getT "gatewayId"+    <*> getT "instanceId"+    <*> getT "instanceOwnerId"+    <*> getT "networkInterfaceId"+    <*> getT "state"+    <*> getT "origin"  routeTableAssociationSink :: MonadThrow m     => GLSink Event m [RouteTableAssociation] routeTableAssociationSink = itemsSet "associationSet" $ RouteTableAssociation     <$> getT "routeTableAssociationId"     <*> getT "routeTableId"-    <*> getMT "subnetId"-    <*> getM "main" (textToBool <$>)+    <*> getT "subnetId"+    <*> getT "main"  ------------------------------------------------------------ -- createRouteTable@@ -112,8 +110,9 @@     => Text -- ^ AssociationId     -> EC2 m Bool -- ^ return disassociateRouteTable aid =-   ec2Query "DisassociateRouteTable" [ValueParam "AssociationId" aid]-        $ getF "return" textToBool+    ec2Query "DisassociateRouteTable"+        [ValueParam "AssociationId" aid]+            $ getT "return"  ------------------------------------------------------------ -- replaceRouteTableAssociation

@@ -39,7 +39,7 @@         <*> getT "groupId"         <*> getT "groupName"         <*> getT "groupDescription"-        <*> getMT "vpcId"+        <*> getT "vpcId"         <*> ipPermissionsSink "ipPermissions"         <*> ipPermissionsSink "ipPermissionsEgress"         <*> resourceTagSink@@ -53,15 +53,16 @@ ipPermissionsSink :: MonadThrow m     => Text -> GLSink Event m [IpPermission] ipPermissionsSink name = itemsSet name $ IpPermission-    <$> getT "ipProtocol" <*> getM "fromPort" (textToInt <$>)-    <*> getM "toPort" (textToInt <$>)+    <$> getT "ipProtocol"+    <*> getT "fromPort"+    <*> getT "toPort"     <*> itemsSet "groups" (         UserIdGroupPair-        <$> getMT "userId"+        <$> getT "userId"         <*> getT "groupId"-        <*> getMT "groupName"+        <*> getT "groupName"         )-    <*> itemsSet "ipRanges" (IpRange <$> getT "cidrIp")+    <*> itemsSet "ipRanges" (getT "cidrIp")  createSecurityGroup     :: (MonadResource m, MonadBaseControl IO m)@@ -71,7 +72,7 @@     -> EC2 m (Maybe Text) -- ^ GroupId createSecurityGroup name desc vpc =     ec2Query "CreateSecurityGroup" params-        $ getT "return" *> getMT "groupId"+        $ getT_ "return" *> getT "groupId"   where     params =         [ ValueParam "GroupName" name@@ -83,8 +84,7 @@     => SecurityGroupRequest     -> EC2 m Bool deleteSecurityGroup param =-    ec2Query "DeleteSecurityGroup" [p param]-        $ getF "return" textToBool+    ec2Query "DeleteSecurityGroup" [p param] $ getT "return"  p :: SecurityGroupRequest -> QueryParam p (SecurityGroupRequestGroupId t)   = ValueParam "GroupId" t@@ -135,7 +135,7 @@     -> [IpPermission]     -> EC2 m Bool securityGroupQuery act param ipps =-    ec2Query act params $ getF "return" textToBool+    ec2Query act params $ getT "return"   where     params = [p param]         ++ concatMap (uncurry ipPermissionParam) (zip intstr ipps)@@ -170,4 +170,4 @@             ])     ipr n r = ValueParam         (pre <> ".IPRanges." <> toText n <> ".CidrIp")-        $ ipRangeCidrIp r+        $ toText r

@@ -17,8 +17,6 @@ import AWS.EC2.Types import AWS.EC2.Query import AWS.Lib.Parser-import AWS.Util-import AWS.EC2.Convert  describeSnapshots     :: (MonadResource m, MonadBaseControl IO m)@@ -43,18 +41,18 @@ snapshotSink = Snapshot         <$> getT "snapshotId"         <*> getT "volumeId"-        <*> getF "status" snapshotStatus'-        <*> getF "startTime" textToTime+        <*> getT "status"+        <*> getT "startTime"         <*> getT "progress"         <*> getT "ownerId"-        <*> getF "volumeSize" textToInt+        <*> getT "volumeSize"         <*> getT "description"-        <*> getMT "ownerAlias"+        <*> getT "ownerAlias"         <*> resourceTagSink  createSnapshot     :: (MonadResource m, MonadBaseControl IO m)-    => Text -- ^ SnapshotId+    => Text -- ^ VolumeId     -> Maybe Text -- ^ Description     -> EC2 m Snapshot createSnapshot volid desc =@@ -68,6 +66,6 @@     => Text -- ^ SnapshotId     -> EC2 m Bool deleteSnapshot ssid =-    ec2Query "DeleteSnapshot" params $ getF "return" textToBool+    ec2Query "DeleteSnapshot" params $ getT "return"   where     params = [ValueParam "SnapshotId" ssid]

@@ -12,7 +12,6 @@ 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@@ -40,10 +39,10 @@     => GLSink Event m Subnet subnetSink = Subnet     <$> getT "subnetId"-    <*> getF "state" subnetState'+    <*> getT "state"     <*> getT "vpcId"     <*> getT "cidrBlock"-    <*> getF "availableIpAddressCount" textToInt+    <*> getT "availableIpAddressCount"     <*> getT "availabilityZone"     <*> resourceTagSink @@ -63,7 +62,7 @@ createSubnetParam :: CreateSubnetRequest -> [QueryParam] createSubnetParam (CreateSubnetRequest vid cidr zone) =     [ ValueParam "VpcId" vid-    , ValueParam "CidrBlock" cidr+    , ValueParam "CidrBlock" $ toText cidr     ] ++ maybe [] (\a -> [ValueParam "AvailabilityZone" a]) zone  ------------------------------------------------------------

@@ -28,7 +28,7 @@         <$> getT "resourceId"         <*> getT "resourceType"         <*> getT "key"-        <*> getMT "value"+        <*> getT "value"   where     params = [FilterParams filters] @@ -38,7 +38,7 @@     -> [(Text, Text)] -- ^ (Key, Value)     -> EC2 m Bool createTags rids kvs =-    ec2Query "CreateTags" params returnBool+    ec2Query "CreateTags" params $ getT "return"   where     params =         [ ArrayParams "ResourceId" rids ]@@ -54,7 +54,7 @@     -> [ResourceTag]     -> EC2 m Bool deleteTags rids tags =-    ec2Query "DeleteTags" params returnBool+    ec2Query "DeleteTags" params $ getT "return"   where     params =         [ ArrayParams "ResourceId" rids ]

@@ -1,3 +1,4 @@+{-# LANGUAGE TemplateHaskell #-} module AWS.EC2.Types     ( Address(..)     , AddressDomain(..)@@ -25,6 +26,7 @@     , EbsInstanceBlockDevice(..)     , EbsSource(..)     , EC2Return(..)+    , Filter     , Group(..)     , Hypervisor(..)     , IamInstanceProfile(..)@@ -39,6 +41,8 @@     , InstanceLifecycle(..)     , InstanceMonitoringState(..)     , InstanceNetworkInterface(..)+    , InstanceNetworkInterfaceAssociation(..)+    , InstanceNetworkInterfaceAttachment(..)     , InstancePrivateIpAddress(..)     , InstanceState(..)     , InstanceStateChange(..)@@ -51,7 +55,6 @@     , InstanceStatusDetailName     , InstanceStatusDetailStatus     , IpPermission(..)-    , IpRange(..)     , KeyPair(..)     , ModifyInstanceAttributeRequest(..)     , LaunchPermissionItem(..)@@ -60,9 +63,12 @@     , NetworkAclEntry(..)     , NetworkAclEntryRequest(..)     , NetworkAclRuleAction(..)+    , NetworkInterface(..)     , NetworkInterfaceAssociation(..)     , NetworkInterfaceAttachment(..)     , NetworkInterfaceParam(..)+    , NetworkInterfacePrivateIpAddress(..)+    , NetworkInterfaceStatus(..)     , PasswordData(..)     , Placement(..)     , Platform(..)@@ -82,6 +88,7 @@     , RouteState(..)     , RouteOrigin(..)     , RunInstancesRequest(..)+    , SecondaryPrivateIpAddressParam(..)     , SecurityGroup(..)     , SecurityGroupRequest(..)     , ShutdownBehavior(..)@@ -121,10 +128,14 @@     , InternetGatewayAttachmentState(..)     ) where +import Data.IP (IPv4, AddrRange) import Data.Text (Text) import Data.ByteString (ByteString) import Data.Time (UTCTime) +import AWS.Class+import AWS.Lib.FromText+ data Image = Image     { imageId :: Text     , imageLocation :: Text@@ -140,8 +151,8 @@     , imageStateReason :: Maybe StateReason     , imageViridianEnabled :: Maybe Bool     , imageOwnerAlias :: Maybe Text-    , imageName :: Text-    , imageDescription :: Text+    , imageName :: Maybe Text+    , imageDescription :: Maybe Text     , imageBillingProducts :: [Text]     , imageRootDeviceType :: RootDeviceType     , imageRootDeviceName :: Maybe Text@@ -150,7 +161,7 @@     , imageTagSet :: [ResourceTag]     , imageHypervisor :: Hypervisor     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AMIAttribute     = AMIDescription@@ -159,7 +170,7 @@     | AMILaunchPermission     | AMIProductCodes     | AMIBlockDeviceMapping-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AMIAttributeDescription = AMIAttributeDescription     { amiAttributeDescriptionImageId :: Text@@ -170,64 +181,64 @@     , amiAttributeDescriptionDescription :: Maybe Text     , amiAttributeDescriptionBlockDeviceMapping :: [BlockDeviceMapping]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data LaunchPermissionItem = LaunchPermissionItem     { launchPermissionItemGroup :: Text     , launchPermissionUserId :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ImageState     = ImageStateAvailable     | ImageStatePending     | ImageStateFailed-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ProductCode = ProductCode     { productCodeCode :: Text     , productCodeType :: ProductCodeType     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ProductCodeItem = ProductCodeItem     { productCodeItemProductCode :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ProductCodeType     = ProductCodeDevpay     | ProductCodeMarketplace-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ImageType     = ImageTypeMachine     | ImageTypeKernel     | ImageTypeRamDisk-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Platform     = PlatformWindows     | PlatformOther-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data StateReason = StateReason     { stateReasonCode :: Text     , stateReasonMessage :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data RootDeviceType     = RootDeviceTypeEBS     | RootDeviceTypeInstanceStore-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data BlockDeviceMapping = BlockDeviceMapping     { blockDeviceMappingDeviceName :: Text     , blockDeviceMappingVirtualName :: Maybe Text     , blockDeviceMappingEbs :: Maybe EbsBlockDevice     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data EbsBlockDevice = EbsBlockDevice     { ebsSnapshotId :: Maybe Text@@ -235,34 +246,34 @@     , ebsDeleteOnTermination :: Bool     , ebsVolumeType :: VolumeType     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeType     = VolumeTypeStandard     | VolumeTypeIO1 Int-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VirtualizationType     = VirtualizationTypeParavirtual     | VirtualizationTypeHVM-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ResourceTag = ResourceTag     { resourceTagKey :: Text     , resourceTagValue :: Maybe Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Hypervisor     = HypervisorOVM     | HypervisorXen-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Region = Region     { regionName :: Text     , regionEndpoint :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AvailabilityZone = AvailabilityZone     { zoneName :: Text@@ -270,7 +281,7 @@     , zoneRegionName :: Text     , zoneMessageSet :: [AvailabilityZoneMessage]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  type AvailabilityZoneMessage = Text @@ -281,7 +292,7 @@     , reservationInstanceSet :: [Instance]     , reservationRequesterId :: Maybe Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Instance = Instance     { instanceId :: Text@@ -302,8 +313,8 @@     , instanceMonitoring :: InstanceMonitoringState     , instanceSubnetId :: Maybe Text     , instanceVpcId :: Maybe Text-    , instancePrivateIpAddress :: Maybe Text-    , instanceIpAddress :: Maybe Text+    , instancePrivateIpAddress :: Maybe IPv4+    , instanceIpAddress :: Maybe IPv4     , instanceSourceDestCheck :: Maybe Bool     , instancevpcGroupSet :: [Group]     , instanceStateReason :: Maybe StateReason@@ -321,7 +332,7 @@     , instanceIamInstanceProfile :: Maybe IamInstanceProfile     , instanceEbsOptimized :: Bool -- default: false     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceStatus = InstanceStatus     { instanceStatusInstanceId :: Text@@ -331,7 +342,7 @@     , instanceStatusSystemStatus :: InstanceStatusType     , instanceStatusInstanceStatus :: InstanceStatusType     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceStatusEvent = InstanceStatusEvent     { instanceStatusEventCode :: InstanceStatusEventCode@@ -339,34 +350,34 @@     , instanceStatusEventNotBefore :: Maybe UTCTime     , instanceStatusEventNotAfter :: Maybe UTCTime     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceStatusEventCode     = InstanceStatusEventCodeInstanceReboot     | InstanceStatusEventCodeInstanceStop     | InstanceStatusEventCodeSystemReboot     | InstanceStatusEventCodeInstanceRetirement-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceStatusType = InstanceStatusType     { instanceStatusTypeStatus :: InstanceStatusTypeStatus     , instanceStatusTypeDetails :: [InstanceStatusDetail]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceStatusTypeStatus     = InstanceStatusTypeStatusOK     | InstanceStatusTypeStatusImpaired     | InstanceStatusTypeStatusInsufficientData     | InstanceStatusTypeStatusNotApplicable-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceStatusDetail = InstanceStatusDetail     { instanceStatusDetailName :: InstanceStatusDetailName     , instanceStatusDetailStatus :: InstanceStatusDetailStatus     , instanceStatusDetailImpairedSince :: Maybe UTCTime     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  type InstanceStatusDetailName = Text @@ -376,7 +387,7 @@     { groupId :: Text     , groupName :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceState     = InstanceStatePending@@ -386,28 +397,28 @@     | InstanceStateStopping     | InstanceStateStopped     | InstanceStateUnknown Int-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Placement = Placement     { placementAvailabilityZone :: Text     , placementGroupName :: Text     , placementTenancy :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceMonitoringState     = MonitoringDisabled     | MonitoringEnabled     | MonitoringPending-  deriving (Show, Eq)+  deriving (Show, Read, Eq) -data Architecture = I386 | X86_64 deriving (Show, Eq)+data Architecture = I386 | X86_64 deriving (Show, Read, Eq)  data InstanceBlockDeviceMapping = InstanceBlockDeviceMapping     { instanceBlockDeviceMappingDeviceName :: Text     , instanceBlockDeviceMappingEbs :: EbsInstanceBlockDevice     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data EbsInstanceBlockDevice = EbsInstanceBlockDevice     { ebsInstanceBlockDeviceVolumeId :: Text@@ -415,65 +426,68 @@     , ebsInstanceBlockDeviceAttachTime :: UTCTime     , ebsInstanceBlockDeviceDeleteOnTermination :: Bool     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceLifecycle     = LifecycleSpot     | LifecycleNone-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceNetworkInterface = InstanceNetworkInterface     { instanceNetworkInterfaceId :: Text     , instanceNetworkInterfaceSubnetId :: Text     , instanceNetworkInterfaceVpcId :: Text-    , instanceNetworkInterfaceDescription :: Text+    , instanceNetworkInterfaceDescription :: Maybe Text     , instanceNetworkInterfaceOwnerId :: Text     , instanceNetworkInterfaceStatus :: Text-    , instanceNetworkInterfacePrivateIpAddress :: Text+    , instanceNetworkInterfacePrivateIpAddress :: IPv4     , instanceNetworkInterfacePrivateDnsName :: Maybe Text     , instanceNetworkInterfaceSourceDestCheck :: Bool     , instanceNetworkInterfaceGroupSet :: [Group]     , instanceNetworkInterfaceAttachment-        :: NetworkInterfaceAttachment+        :: InstanceNetworkInterfaceAttachment     , instanceNetworkInterfaceAssociation-        :: Maybe NetworkInterfaceAssociation-    , instanceNetworkInterfacePrivateIpAddressSet+        :: Maybe InstanceNetworkInterfaceAssociation+    , instanceNetworkInterfacePrivateIpAddressesSet         :: [InstancePrivateIpAddress]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq) -data NetworkInterfaceAttachment = NetworkInterfaceAttachment-    { networkInterfaceAttachmentId :: Text-    , networkInterfaceAttachmentDeviceIndex :: Int-    , networkInterfaceAttachmentStatus :: Text-    , networkInterfaceAttachmentAttachTime :: UTCTime-    , networkInterfaceAttachmentDeleteOnTermination :: Bool+data InstanceNetworkInterfaceAttachment = InstanceNetworkInterfaceAttachment+    { instanceNetworkInterfaceAttachmentId :: Text+    , instanceNetworkInterfaceAttachmentDeviceIndex :: Int+    , instanceNetworkInterfaceAttachmentStatus :: Text+    , instanceNetworkInterfaceAttachmentAttachTime :: UTCTime+    , instanceNetworkInterfaceAttachmentDeleteOnTermination+        :: Bool     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq) -data NetworkInterfaceAssociation = NetworkInterfaceAssociation-    { networkInterfaceAssociationPublicIp :: Text-    , networkInterfaceAssociationIpOwnerId :: Text+data InstanceNetworkInterfaceAssociation+    = InstanceNetworkInterfaceAssociation+    { instanceNetworkInterfaceAssociationPublicIp :: Text+    , instanceNetworkInterfaceAssociationIpOwnerId :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstancePrivateIpAddress = InstancePrivateIpAddress-    { instancePrivateIpAddressAddress :: Text+    { instancePrivateIpAddressAddress :: IPv4     , instancePrivateIpAddressPrimary :: Bool-    , instancePrivateIpAddressAssociation :: Maybe NetworkInterfaceAssociation+    , instancePrivateIpAddressAssociation+        :: Maybe InstanceNetworkInterfaceAssociation     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data IamInstanceProfile = IamInstanceProfile     { iamInstanceProfileArn :: Text     , iamInstanceProfileId :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ShutdownBehavior     = ShutdownBehaviorStop     | ShutdownBehaviorTerminate-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceAttribute     = InstanceAttributeInstanceType Text@@ -488,32 +502,32 @@     | InstanceAttributeGroupSet [Text]     | InstanceAttributeProductCodes [ProductCode]     | InstanceAttributeEbsOptimized Bool-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Address = Address-    { addressPublicIp :: Text+    { addressPublicIp :: IPv4     , addressAllocationId :: Maybe Text     , addressDomain :: AddressDomain     , addressInstanceId :: Maybe Text     , addressAssociationId :: Maybe Text     , addressNetworkInterfaceId :: Maybe Text     , addressNetworkInterfaceOwnerId :: Maybe Text-    , addressPrivateIpAddress :: Maybe Text+    , addressPrivateIpAddress :: Maybe IPv4     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AddressDomain = AddressDomainStandard | AddressDomainVPC-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AllocateAddress = AllocateAddress-    { allocateAddressPublicIp :: Text+    { allocateAddressPublicIp :: IPv4     , allocateAddressDomain :: AddressDomain     , allocateAddressAllocationId :: Maybe Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data EC2Return = EC2Success | EC2Error Text-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Tag = Tag     { tagResourceId :: Text@@ -521,14 +535,14 @@     , tagKey :: Text     , tagValue :: Maybe Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceStateChange = InstanceStateChange     { instanceStateChangeInstanceId :: Text     , instanceStateChangeCurrentState :: InstanceState     , instanceStateChangePreviousState :: InstanceState     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ConsoleOutput = ConsoleOutput     { consoleOutputInstanceId :: Text@@ -536,7 +550,7 @@         -- ^ The time the data was last updated.     , consoleOutputOutput :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data PasswordData = PasswordData     { passwordDataInstanceId :: Text@@ -544,7 +558,7 @@       -- ^ The time the data was last updated.     , passwordDataPasswordData :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Snapshot = Snapshot     { snapshotId :: Text@@ -558,13 +572,13 @@     , snapshotOwnerAlias :: Maybe Text     , snapshotTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data SnapshotStatus     = SnapshotPending     | SnapshotCompleted     | SnapshotError-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Volume = Volume     { volumeId :: Text@@ -577,7 +591,7 @@     , volumeTagSet :: [ResourceTag]     , volumeVolumeType :: VolumeType     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeState     = VolumeStateCreating@@ -586,7 +600,7 @@     | VolumeStateDeleting     | VolumeStateDeleted     | VolumeStateError-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AttachmentSetItemResponse = AttachmentSetItemResponse     { attachmentSetItemResponseVolumeId :: Text@@ -597,20 +611,20 @@     , attachmentSetItemResponseAttachTime :: UTCTime     , attachmentSetItemResponseDeleteOnTermination :: Maybe Bool     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AttachmentSetItemResponseStatus     = AttachmentSetItemResponseStatusAttaching     | AttachmentSetItemResponseStatusAttached     | AttachmentSetItemResponseStatusDetaching     | AttachmentSetItemResponseStatusDetached-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data KeyPair = KeyPair     { keyPairName :: Text     , keyPairFingerprint :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data SecurityGroup = SecurityGroup     { securityGroupOwnerId :: Text@@ -622,28 +636,23 @@     , securityGroupIpPermissionsEgress :: [IpPermission]     , securityGroupTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data IpPermission = IpPermission     { ipPermissionIpProtocol :: Text     , ipPermissionFromPort :: Maybe Int     , ipPermissionToPort :: Maybe Int     , ipPermissionGroups :: [UserIdGroupPair]-    , ipPermissionIpRanges :: [IpRange]+    , ipPermissionIpRanges :: [AddrRange IPv4]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data UserIdGroupPair = UserIdGroupPair     { userIdGroupPairUserId :: Maybe Text     , userIdGroupPairGroupId :: Text     , userIdGroupPairGroupName :: Maybe Text     }-  deriving (Show, Eq)--data IpRange = IpRange-    { ipRangeCidrIp :: Text-    }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data BlockDeviceMappingParam     = BlockDeviceMappingParamEbs@@ -661,24 +670,42 @@         , blockDeviceMappingParamInstanceStoreVirtualName             :: Maybe Text         }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data EbsSource     = EbsSourceSnapshotId Text     | EbsSourceVolumeSize Int-  deriving (Show, Eq)+  deriving (Show, Read, Eq) -data NetworkInterfaceParam = NetworkInterfaceParam-    { networkInterfaceParamInterfaceId :: Maybe Text-    , networkInterfaceParamDeviceIndex :: Maybe Text-    , networkInterfaceParamSubnetId :: Maybe Text-    , networkInterfaceParamDescription :: Maybe Text-    , networkInterfaceParamPrivateIpAddresses :: [Text]-    , networkInterfaceParamSecurityGroupIds :: [Text]-    , networkInterfaceParamDeleteOnTermination :: Maybe Bool-    }-  deriving (Show, Eq)+data NetworkInterfaceParam+    = NetworkInterfaceParamCreate+        { networkInterfaceParamCreateDeviceIndex :: Int+        , networkInterfaceParamCreateSubnetId :: Text+        , networkInterfaceParamCreateDescription :: Text+        , networkInterfaceParamCreatePrivateIpAddress+            :: Maybe IPv4+        , networkInterfaceParamCreatePrivateIpAddresses+            :: SecondaryPrivateIpAddressParam+        , networkInterfaceParamCreateSecurityGroupIds :: [Text]+        , networkInterfaceParamCreateDeleteOnTermination :: Bool+        }+    | NetworkInterfaceParamAttach+        { networkInterfaceParamAttachInterfaceId :: Text+        , networkInterfaceParamAttachDeviceIndex :: Int+        , networkInterfaceParamAttachDeleteOnTermination :: Bool+        }+  deriving (Show, Read, Eq) +data SecondaryPrivateIpAddressParam+    = SecondaryPrivateIpAddressParamNothing+    | SecondaryPrivateIpAddressParamCount Int+    | SecondaryPrivateIpAddressParamSpecified+      { secondaryPrivateIpAddressParamSpecifiedAddresses :: [IPv4]+      , secondaryPrivateIpAddressParamSpecifiedPrimary+        :: Maybe Int+      }+  deriving (Show, Read, Eq)+ data VpnConnection = VpnConnection     { vpnConnectionId :: Text     , vpnConnectionState :: VpnConnectionState@@ -691,50 +718,50 @@     , vpnConnectionOptions :: Maybe VpnConnectionOptionsRequest     , vpnConnectionRoutes :: Maybe VpnStaticRoute     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnConnectionState     = VpnConnectionStatePending     | VpnConnectionStateAvailable     | VpnConnectionStateDeleting     | VpnConnectionStateDeleted-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnTunnelTelemetry = VpnTunnelTelemetry-    { vpnTunnelTelemetryOutsideIpAddress :: Text+    { vpnTunnelTelemetryOutsideIpAddress :: IPv4     , vpnTunnelTelemetryStatus :: VpnTunnelTelemetryStatus     , vpnTunnelTelemetryLastStatusChange :: UTCTime     , vpnTunnelTelemetryStatusMessage :: Text     , vpnTunnelTelemetryAcceptRouteCount :: Int     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnTunnelTelemetryStatus     = VpnTunnelTelemetryStatusUp     | VpnTunnelTelemetryStatusDown-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnConnectionOptionsRequest = VpnConnectionOptionsRequest     { vpnConnectionOptionsRequestStaticRoutesOnly :: Bool     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnStaticRoute = VpnStaticRoute     { vpnStaticRouteDestinationCidrBlock :: Text     , vpnStaticRouteSource :: VpnStaticRouteSource     , vpnStaticRouteState :: VpnStaticRouteState     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnStaticRouteSource = VpnStaticRouteSourceStatic-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnStaticRouteState     = VpnStaticRouteStatePending     | VpnStaticRouteStateAvailable     | VpnStaticRouteStateDeleting     | VpnStaticRouteStateDeleted-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data RunInstancesRequest = RunInstancesRequest     { runInstancesRequestImageId :: Text -- ^ Required@@ -760,15 +787,15 @@     , runInstancesRequestDisableApiTermination :: Maybe Bool     , runInstancesRequestShutdownBehavior         :: Maybe ShutdownBehavior-    , runInstancesRequestPrivateIpAddress :: Maybe Text+    , runInstancesRequestPrivateIpAddress :: Maybe IPv4     , runInstancesRequestClientToken :: Maybe Text-    , runInstancesRequestNetworkInterface-        :: [NetworkInterfaceParam] -- ^ XXX: not implemented+    , runInstancesRequestNetworkInterfaces+        :: [NetworkInterfaceParam]     , runInstancesRequestIamInstanceProfile         :: Maybe IamInstanceProfile     , runInstancesRequestEbsOptimized :: Maybe Bool     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InstanceAttributeRequest     = InstanceAttributeRequestInstanceType@@ -789,7 +816,7 @@     = ResetInstanceAttributeRequestKernel     | ResetInstanceAttributeRequestRamdisk     | ResetInstanceAttributeRequestSourceDestCheck-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data ModifyInstanceAttributeRequest     = ModifyInstanceAttributeRequestInstanceType Text@@ -805,7 +832,7 @@     | ModifyInstanceAttributeRequestSourceDestCheck Bool     | ModifyInstanceAttributeRequestGroupSet [Text]     | ModifyInstanceAttributeRequestEbsOptimized Bool-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data RegisterImageRequest = RegisterImageRequest     { registerImageRequestName :: Text@@ -818,7 +845,7 @@     , registerImageRequestBlockDeviceMappings         :: [BlockDeviceMappingParam]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data CreateVolumeRequest     = CreateNewVolume@@ -832,11 +859,11 @@         , createFromSnapshotSize :: Maybe Int         , createFromSnapshotVolumeType :: Maybe VolumeType         }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AssociateAddressRequest     = AssociateAddressRequestEc2-        { associateAddressRequestEc2PublicIp :: Text+        { associateAddressRequestEc2PublicIp :: IPv4         , associateAddressRequestEc2InstanceId :: Text         }     | AssociateAddressRequestVpc@@ -844,43 +871,43 @@         , associateAddressRequestVpcInstanceId :: Maybe Text         , associateAddressRequestVpcNetworkInterfaceId             :: Maybe Text-        , associateAddressRequestVpcPrivateIpAddress :: Maybe Text+        , associateAddressRequestVpcPrivateIpAddress :: Maybe IPv4         , associateAddressRequestVpcAllowReassociation             :: Maybe Bool         }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data DisassociateAddressRequest-    = DisassociateAddressRequestEc2 Text -- ^ PublicIp for EC2-    | DisassociateAddressRequestVpc Text+    = DisassociateAddressRequestEc2 IPv4 -- ^ PublicIp for EC2+    | DisassociateAddressRequestVpc IPv4       -- ^ AssociationId for VPC-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data SecurityGroupRequest     = SecurityGroupRequestGroupId Text     | SecurityGroupRequestGroupName Text-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Subnet = Subnet     { subnetId :: Text     , subnetState :: SubnetState     , subnetVpicId :: Text-    , subnetCidrBlock :: Text+    , subnetCidrBlock :: AddrRange IPv4     , subnetAvailableIpAddressCount :: Int     , subnetAvailabilityZone :: Text     , subnetTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data SubnetState = SubnetStatePending | SubnetStateAvailable-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data CreateSubnetRequest = CreateSubnetRequest     { createSubnetRequestVpcId :: Text-    , createSubnetRequestCidrBlock :: Text+    , createSubnetRequestCidrBlock :: AddrRange IPv4     , createSubnetRequestAvailabilityZone :: Maybe Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeStatus = VolumeStatus     { volumeStatusVolumeId :: Text@@ -889,25 +916,25 @@     , volumeStatusEventSet :: [VolumeStatusEvent]     , volumeStatusActionSet :: [VolumeStatusAction]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeStatusInfo = VolumeStatusInfo     { volumeStatusInfoStatus :: VolumeStatusInfoStatus     , volumeStatusInfoDetails :: [VolumeStatusDetail]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeStatusInfoStatus     = VolumeStatusInfoStatusOK     | VolumeStatusInfoStatusImpaired     | VolumeStatusInfoStatusInsufficientData-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeStatusDetail = VolumeStatusDetail     { volumeStatusDetailName :: Text     , volumeStatusDetailStatus :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeStatusEvent = VolumeStatusEvent     { volumeStatusEventType :: Text@@ -916,7 +943,7 @@     , volumeStatusEventNotBefore :: Maybe UTCTime     , volumeStatusEventNotAfter :: Maybe UTCTime     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeStatusAction = VolumeStatusAction     { volumeStatusActionCode :: Text@@ -924,17 +951,17 @@     , volumeStatusActionEventId :: Text     , volumeStatusActionDescription :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeAttribute     = VolumeAttributeAutoEnableIO Bool     | VolumeAttributeProductCodes [ProductCode]-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VolumeAttributeRequest     = VolumeAttributeRequestAutoEnableIO     | VolumeAttributeRequestProductCodes-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data NetworkAcl = NetworkAcl     { networkAclId :: Text@@ -944,7 +971,7 @@     , networkAclAssociationSet :: [NetworkAclAssociation]     , networkAclTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data NetworkAclEntry = NetworkAclEntry     { networkAclEntryRuleNumber :: Int@@ -955,31 +982,31 @@     , networkAclEntryIcmpTypeCode :: Maybe IcmpTypeCode     , networkAclEntryPortRange :: Maybe PortRange     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data NetworkAclRuleAction     = NetworkAclRuleActionAllow     | NetworkAclRuleActionDeny-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data IcmpTypeCode = IcmpTypeCode     { icmpTypeCodeCode :: Int     , icmpTypeCodeType :: Int     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data PortRange = PortRange     { portRangeFrom :: Int     , portRangeTo :: Int     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data NetworkAclAssociation = NetworkAclAssociation     { networkAclAssociationId :: Text     , networkAclAssociationNetworkAclId :: Text     , networkAclAssociationSubnetId :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data NetworkAclEntryRequest = NetworkAclEntryRequest     { networkAclEntryRequestNetworkAclId :: Text@@ -992,7 +1019,7 @@     , networkAclEntryRequestIcmp :: Maybe IcmpTypeCode     , networkAclEntryRequestPortRange :: Maybe PortRange     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data RouteTable = RouteTable     { routeTableId :: Text@@ -1002,7 +1029,7 @@     , routeTablePropagatingVgw :: Maybe PropagatingVgw     , routeTableTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Route = Route     { routeDestinationCidrBlock :: Text@@ -1013,16 +1040,16 @@     , routeState :: RouteState     , routeOrigin :: Maybe RouteOrigin     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data RouteState = RouteStateActive | RouteStateBlackhole-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data RouteOrigin     = RouteOriginCreateRouteTable     | RouteOriginCreateRoute     | RouteOriginTableEnableVgwRoutePropagation-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data RouteTableAssociation = RouteTableAssociation     { routeTableAssociationId :: Text@@ -1030,22 +1057,22 @@     , routeTableAssociationSubnetId :: Maybe Text     , routeTableAssociationMain :: Maybe Bool     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  type PropagatingVgw = Text  data Vpc = Vpc     { vpcId :: Text     , vpcState :: VpcState-    , vpcCidrBlock :: Text+    , vpcCidrBlock :: AddrRange IPv4     , vpcDhcpOptionsId :: Text     , vpcTagSet :: [ResourceTag]     , vpcInstanceTenancy :: Text     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpcState = VpcStatePending | VpcStateAvailable-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnGateway = VpnGateway     { vpnGatewayId :: Text@@ -1055,27 +1082,27 @@     , vpnGatewayAttachments :: [Attachment]     , vpnGatewayTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data VpnGatewayState     = VpnGatewayStatePending     | VpnGatewayStateAvailable     | VpnGatewayStateDeleting     | VpnGatewayStateDeleted-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data Attachment = Attachment     { attachmentVpcId :: Text     , attachmentState :: AttachmentState     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data AttachmentState     = AttachmentStateAttaching     | AttachmentStateAttached     | AttachmentStateDetaching     | AttachmentStateDetached-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data CreateVpnGatewayType = CreateVpnGatewayTypeIpsec1 @@ -1083,31 +1110,31 @@     { customerGatewayId :: Text     , customerGatewayState :: CustomerGatewayState     , customerGatewayType :: Text-    , customerGatewayIpAddress :: Text+    , customerGatewayIpAddress :: IPv4     , customerGatewayBgpAsn :: Int     , customerGatewayTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data CustomerGatewayState     = CustomerGatewayStatePending     | CustomerGatewayStateAvailable     | CustomerGatewayStateDeleting     | CustomerGatewayStateDeleted-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InternetGateway = InternetGateway     { internetGatewayInternetGatewayId :: Text     , internetGatewayAttachmentSet :: [InternetGatewayAttachment]     , internetGatewayTagSet :: [ResourceTag]     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InternetGatewayAttachment = InternetGatewayAttachment     { internetGatewayAttachmentVpcId :: Text     , internetGatewayAttachmentState :: InternetGatewayAttachmentState     }-  deriving (Show, Eq)+  deriving (Show, Read, Eq)  data InternetGatewayAttachmentState     = InternetGatewayAttachmentStateAttaching@@ -1115,4 +1142,149 @@     | InternetGatewayAttachmentStateDetaching     | InternetGatewayAttachmentStateDetached     | InternetGatewayAttachmentStateAvailable-  deriving (Show, Eq)+  deriving (Show, Read, Eq)++data NetworkInterface = NetworkInterface+    { networkInterfaceId :: Text+    , networkInterfaceSubnetId :: Text+    , networkInterfaceVpcId :: Text+    , networkInterfaceAvailabilityZone :: Text+    , networkInterfaceDescription :: Text+    , networkInterfaceOwnerId :: Text+    , networkInterfaceRequesterId :: Maybe Text+    , networkInterfaceRequesterManaged :: Text+    , networkInterfaceStatus :: NetworkInterfaceStatus+    , networkInterfaceMacAddress :: Text+    , networkInterfacePrivateIpAddress :: IPv4+    , networkInterfacePrivateDnsName :: Maybe Text+    , networkInterfaceSourceDestCheck :: Bool+    , networkInterfaceGroupSet :: [Group]+    , networkInterfaceAttachment+        :: Maybe NetworkInterfaceAttachment+    , networkInterfaceAssociation+        :: Maybe NetworkInterfaceAssociation+    , networkInterfaceTagSet :: [ResourceTag]+    , networkInterfacePrivateIpAddressesSet+        :: [NetworkInterfacePrivateIpAddress]+    }+  deriving (Show, Read, Eq)++type Filter = (Text, [Text])++data NetworkInterfaceStatus+    = NetworkInterfaceStatusAvailable+    | NetworkInterfaceStatusInUse+  deriving (Show, Read, Eq)++data NetworkInterfaceAttachment = NetworkInterfaceAttachment+    { networkInterfaceAttachmentId :: Text+    , networkInterfaceAttachmentInstanceId :: Maybe Text+    , networkInterfaceAttachmentInstanceOwnerId :: Text+    , networkInterfaceAttachmentDeviceIndex :: Int+    , networkInterfaceAttachmentStatus :: Text+    , networkInterfaceAttachmentAttachTime :: UTCTime+    , networkInterfaceAttachmentDeleteOnTermination :: Bool+    }+  deriving (Show, Read, Eq)++data NetworkInterfaceAssociation = NetworkInterfaceAssociation+    { networkInterfaceAssociationAttachmentId :: Maybe Text+    , networkInterfaceAssociationInstanceId :: Maybe Text+    , networkInterfaceAssociationPublicIp :: IPv4+    , networkInterfaceAssociationIpOwnerId :: Text+    , networkInterfaceAssociationId :: Text+    }+  deriving (Show, Read, Eq)++data NetworkInterfacePrivateIpAddress+    = NetworkInterfacePrivateIpAddress+    { networkInterfacePrivateIpAddressPrivateIpAddress :: IPv4+    , networkInterfacePrivateIpAddressPrimary :: Bool+    , networkInterfacePrivateIpAddressAssociation+        :: Maybe NetworkInterfaceAssociation+    }+  deriving (Show, Read, Eq)++instance FromText Platform+  where+    fromMaybeText Nothing  = return PlatformOther+    fromMaybeText (Just t)+        | t == "windows" = return PlatformWindows+        | otherwise      = return PlatformOther++instance FromText AddressDomain+  where+    fromMaybeText Nothing  = return AddressDomainStandard+    fromMaybeText (Just t)+        | t == "standard" = return AddressDomainStandard+        | t == "vpc"      = return AddressDomainVPC+        | otherwise       = monadThrow $ TextConversionException t++instance FromText EC2Return+  where+    fromTextMay t+        | t == "true" = Just EC2Success+        | otherwise   = Just $ EC2Error t++instance FromText InstanceLifecycle+  where+    fromMaybeText Nothing  = return LifecycleNone+    fromMaybeText (Just t)+        | t == "spot" = return LifecycleSpot+        | otherwise   = monadThrow $ TextConversionException t++deriveFromText "ImageState" ["available", "pending", "failed"]+deriveFromText "ProductCodeType" ["devpay", "marketplace"]+deriveFromText "ImageType" ["machine", "kernel", "ramdisk"]+deriveFromText "RootDeviceType" ["ebs", "instance-store"]+deriveFromText "VirtualizationType" ["paravirtual", "hvm"]+deriveFromText "Hypervisor" ["ovm", "xen"]+deriveFromText "InstanceStatusEventCode"+    [ "instance-reboot"+    , "instance-stop"+    , "system-reboot"+    , "instance-retirement"+    ]+deriveFromText "InstanceStatusTypeStatus"+    ["ok", "impaired", "insufficient-data", "not-applicable"]+deriveFromText "InstanceMonitoringState"+    ["disabled", "enabled", "pending"]+deriveFromText "Architecture" ["i386", "x86_64"]+deriveFromText "SnapshotStatus" ["pending", "completed", "error"]+deriveFromText "VolumeState"+    [ "creating"+    , "available"+    , "in-use"+    , "deleting"+    , "deleted"+    , "error"+    ]+deriveFromText "AttachmentSetItemResponseStatus"+    ["attaching", "attached", "detaching", "detached"]+deriveFromText "ShutdownBehavior" ["stop", "terminate"]+deriveFromText "VpnConnectionState"+    ["pending", "available", "deleting", "deleted"]+deriveFromText "VpnTunnelTelemetryStatus" ["UP", "DOWN"]+deriveFromText "VpnStaticRouteSource" ["Static"]+deriveFromText "VpnStaticRouteState"+    ["pending", "available", "deleting", "deleted"]+deriveFromText "SubnetState" ["pending", "available"]+deriveFromText "VolumeStatusInfoStatus"+    ["ok", "impaired", "insufficient-data"]+deriveFromText "NetworkAclRuleAction" ["allow", "deny"]+deriveFromText "RouteState" ["active", "blackhole"]+deriveFromText "RouteOrigin"+    [ "CreateRouteTable"+    , "CreateRoute"+    , "EnableVgwRoutePropagation"+    ]+deriveFromText "VpcState" ["pending", "available"]+deriveFromText "VpnGatewayState"+    ["pending", "available", "deleting", "deleted"]+deriveFromText "AttachmentState"+    ["attaching", "attached", "detaching", "detached"]+deriveFromText "CustomerGatewayState"+    ["pending", "available", "deleting", "deleted"]+deriveFromText "InternetGatewayAttachmentState"+    ["attaching", "attached", "detaching", "detached", "available"]+deriveFromText "NetworkInterfaceStatus" ["available", "in-use"]

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}  module AWS.EC2.Util     ( list@@ -8,6 +8,8 @@     , wait     , count     , findTag+    , sleep+    , retry     ) where  import Data.Conduit@@ -22,6 +24,8 @@ import Control.Applicative import Control.Parallel (par) import Data.List (find)+import qualified Control.Exception.Lifted as E+import Control.Monad.Trans.Control (MonadBaseControl)  import AWS.EC2.Internal import AWS.EC2.Types (ResourceTag(resourceTagKey))@@ -111,3 +115,20 @@ findTag key tags = find f tags   where     f t = resourceTagKey t == key++sleep :: MonadIO m => Int -> EC2 m ()+sleep sec = liftIO $ CC.threadDelay $ sec * 1000 * 1000++retry+    :: forall m a. (MonadBaseControl IO m, MonadResource m)+    => Int -- ^ sleep count+    -> Int -- ^ number of retry+    -> EC2 m a+    -> EC2 m a+retry _   0   f = f+retry sec cnt f = f `E.catch` handler+  where+    handler :: E.SomeException -> EC2 m a+    handler _ = do+        sleep sec+        retry sec (cnt - 1) f

@@ -19,13 +19,12 @@     ) where  import Data.Text (Text)- import Data.XML.Types (Event) import Data.Conduit+import Data.IP (IPv4, AddrRange) 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@@ -43,8 +42,7 @@     -> Text -- ^ VpcId     -> EC2 m Bool attachInternetGateway internetGatewayId vid =-    ec2Query "AttachInternetGateway" params $-        getF "return" textToBool+    ec2Query "AttachInternetGateway" params $ getT "return"   where     params =         [ ValueParam "InternetGatewayId" internetGatewayId@@ -59,8 +57,7 @@     -> Text -- ^ VpcId     -> EC2 m Bool detachInternetGateway internetGatewayId vid =-    ec2Query "DetachInternetGateway" params $-        getF "return" textToBool+    ec2Query "DetachInternetGateway" params $ getT "return"   where     params =         [ ValueParam "InternetGatewayId" internetGatewayId@@ -113,7 +110,7 @@     => GLSink Event m InternetGatewayAttachment internetGatewayAttachmentSink = InternetGatewayAttachment     <$> getT "vpcId"-    <*> getF "state" internetGatewayAttachmentState'+    <*> getT "state" describeVpnConnections     :: (MonadBaseControl IO m, MonadResource m)     => [Text] -- ^ VpnConnectionIds@@ -133,7 +130,7 @@     <$> do         a <- getT "vpnConnectionId"         traceShow a $ return a-    <*> getF "state" vpnConnectionState'+    <*> getT "state"     <*> getT "customerGatewayConfiguration"     <*> getT "type"     <*> getT "customerGatewayId"@@ -142,20 +139,20 @@     <*> itemsSet "vgwTelemetry"         (VpnTunnelTelemetry         <$> getT "outsideIpAddress"-        <*> getF "status" vpnTunnelTelemetryStatus'-        <*> getF "lastStatusChange" textToTime+        <*> getT "status"+        <*> getT "lastStatusChange"         <*> getT "statusMessage"-        <*> getF "acceptedRouteCount" textToInt+        <*> getT "acceptedRouteCount"         )     <*> elementM "options"         (VpnConnectionOptionsRequest-        <$> getF "staticRoutesOnly" textToBool+        <$> getT "staticRoutesOnly"         )     <*> elementM "routes"         (VpnStaticRoute         <$> getT "destinationCidrBlock"-        <*> getF "source" vpnStaticRouteSource'-        <*> getF "state" vpnStaticRouteState'+        <*> getT "source"+        <*> getT "state"         )  ------------------------------------------------------------@@ -179,7 +176,7 @@     => GLSink Event m Vpc vpcSink = Vpc     <$> getT "vpcId"-    <*> getF "state" vpcState'+    <*> getT "state"     <*> getT "cidrBlock"     <*> getT "dhcpOptionsId"     <*> resourceTagSink@@ -190,7 +187,7 @@ ------------------------------------------------------------ createVpc     :: (MonadResource m, MonadBaseControl IO m)-    => Text -- ^ CidrBlock+    => AddrRange IPv4 -- ^ CidrBlock     -> Maybe Text -- ^ instanceTenancy     -> EC2 m Vpc createVpc cidrBlock instanceTenancy =@@ -198,7 +195,7 @@         element "vpc" vpcSink   where     params =-        [ ValueParam "CidrBlock" cidrBlock+        [ ValueParam "CidrBlock" $ toText cidrBlock         ] ++ maybeParams [ ("instanceTenancy", instanceTenancy) ]  ------------------------------------------------------------@@ -231,9 +228,9 @@     => GLSink Event m VpnGateway vpnGatewaySink = VpnGateway     <$> getT "vpnGatewayId"-    <*> getF "state" vpnGatewayState'+    <*> getT "state"     <*> getT "type"-    <*> getMT "availabilityZone"+    <*> getT "availabilityZone"     <*> itemsSet "attachments" attachmentSink     <*> resourceTagSink @@ -241,7 +238,7 @@     => GLSink Event m Attachment attachmentSink = Attachment     <$> getT "vpcId"-    <*> getF "state" attachmentState'+    <*> getT "state"  ------------------------------------------------------------ -- createVpnGateway@@ -289,10 +286,10 @@     => GLSink Event m CustomerGateway customerGatewaySink = CustomerGateway     <$> getT "customerGatewayId"-    <*> getF "state" customerGatewayState'+    <*> getT "state"     <*> getT "type"     <*> getT "ipAddress"-    <*> getF "bgpAsn" textToInt+    <*> getT "bgpAsn"     <*> resourceTagSink  ------------------------------------------------------------@@ -301,7 +298,7 @@ createCustomerGateway     :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ Type-    -> Text -- ^ IpAddress+    -> IPv4 -- ^ IpAddress     -> Int -- ^ BgpAsn     -> EC2 m CustomerGateway createCustomerGateway type' ipAddr bgpAsn = do@@ -310,7 +307,7 @@   where     params =         [ ValueParam "Type" type' -        , ValueParam "IpAddress" ipAddr+        , ValueParam "IpAddress" $ toText ipAddr         , ValueParam "BgpAsn" (toText bgpAsn)         ] 

@@ -18,7 +18,6 @@ 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@@ -43,11 +42,11 @@     => GLSink Event m Volume volumeSink = Volume     <$> getT "volumeId"-    <*> getF "size" textToInt-    <*> getMT "snapshotId"+    <*> getT "size"+    <*> getT "snapshotId"     <*> getT "availabilityZone"-    <*> getF "status" volumeStatus'-    <*> getF "createTime" textToTime+    <*> getT "status"+    <*> getT "createTime"     <*> itemsSet "attachmentSet" attachmentSink     <*> resourceTagSink     <*> volumeTypeSink@@ -57,9 +56,9 @@     <$> getT "volumeId"     <*> getT "instanceId"     <*> getT "device"-    <*> getF "status" attachmentSetItemResponseStatus'-    <*> getF "attachTime" textToTime-    <*> getM "deleteOnTermination" (textToBool <$>)+    <*> getT "status"+    <*> getT "attachTime"+    <*> getT "deleteOnTermination"  volumeTypeParam :: VolumeType -> [QueryParam] volumeTypeParam VolumeTypeStandard =@@ -149,7 +148,7 @@     <$> getT "volumeId"     <*> getT "availabilityZone"     <*> element "volumeStatus" (VolumeStatusInfo-        <$> getF "status" volumeStatusInfoStatus'+        <$> getT "status"         <*> itemsSet "details" (VolumeStatusDetail             <$> getT "name"             <*> getT "status"@@ -159,8 +158,8 @@         <$> getT "eventType"         <*> getT "eventId"         <*> getT "description"-        <*> getM "notBefore" (textToTime <$>)-        <*> getM "notAfter" (textToTime <$>)+        <*> getT "notBefore"+        <*> getT "notAfter"         )     <*> itemsSet "actionsSet" (VolumeStatusAction         <$> getT "code"@@ -175,7 +174,7 @@     -> Bool -- ^ AutoEnableIO     -> EC2 m Bool modifyVolumeAttribute vid enable =-    ec2Query "ModifyVolumeAttribute" params returnBool+    ec2Query "ModifyVolumeAttribute" params $ getT "return"   where     params =         [ ValueParam "VolumeId" vid@@ -187,7 +186,7 @@     => Text -- ^ VolumeId     -> EC2 m Bool enableVolumeIO vid =-    ec2Query "EnableVolumeIO" params returnBool+    ec2Query "EnableVolumeIO" params $ getT "return"   where     params = [ValueParam "VolumeId" vid] @@ -215,8 +214,7 @@     -> GLSink Event m VolumeAttribute volumeAttributeSink VolumeAttributeRequestAutoEnableIO     = VolumeAttributeAutoEnableIO-    <$> element "autoEnableIO"-        (getF "value" textToBool)+    <$> element "autoEnableIO" (getT "value") volumeAttributeSink VolumeAttributeRequestProductCodes     = VolumeAttributeProductCodes     <$> productCodeSink

@@ -18,7 +18,7 @@ import Data.Monoid  import AWS.Class-import AWS.Util+import AWS.Lib.Query (textToBS)  import AWS import AWS.ELB.Internal

@@ -10,7 +10,6 @@ import Control.Monad.Trans.Control (MonadBaseControl) import Data.XML.Types (Event(..)) -import AWS.Util import AWS.Lib.Parser import AWS.Lib.Query @@ -34,26 +33,26 @@     LoadBalancerDescription     <$> members "SecurityGroups" text     <*> getT "LoadBalancerName"-    <*> getF "CreatedTime" textToTime+    <*> getT "CreatedTime"     <*> element "HealthCheck"         (HealthCheck-        <$> getF "Interval" textToInt+        <$> getT "Interval"         <*> getT "Target"-        <*> getF "HealthyThreshold" textToInt-        <*> getF "Timeout" textToInt-        <*> getF "UnhealthyThreshold" textToInt+        <*> getT "HealthyThreshold"+        <*> getT "Timeout"+        <*> getT "UnhealthyThreshold"         )-    <*> getMT "VPCId"+    <*> getT "VPCId"     <*> members "ListenerDescriptions"         (ListenerDescription         <$> members "PolicyNames" text         <*> element "Listener"             (Listener             <$> getT "Protocol"-            <*> getF "LoadBalancerPort" textToInt+            <*> getT "LoadBalancerPort"             <*> getT "InstanceProtocol"-            <*> getMT "SSLCertificateId"-            <*> getF "InstancePort" textToInt+            <*> getT "SSLCertificateId"+            <*> getT "InstancePort"             )         )     <*> members "Instances"@@ -68,7 +67,7 @@         <*> members "OtherPolicies" text         <*> members "LBCookieStickinessPolicies"             (LBCookieStickinessPolicy-            <$> getF "CookieExpirationPeriod" textToInt+            <$> getT "CookieExpirationPeriod"             <*> getT "PolicyName"             )         )@@ -84,7 +83,7 @@     <*> getT "DNSName"     <*> members "BackendServerDescriptions"         (BackendServerDescription-        <$> getF "InstancePort" textToInt+        <$> getT "InstancePort"         <*> members "PolicyNames" text         )     <*> members "Subnets" text

@@ -1,24 +0,0 @@-{-# 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)))) []])-      ) []]-      ]

@@ -0,0 +1,83 @@+{-# LANGUAGE RankNTypes, OverloadedStrings, TemplateHaskell, FlexibleInstances #-}++module AWS.Lib.FromText+    where++import Control.Applicative ((<$>))+import Control.Monad+import Data.Conduit (MonadThrow)+import Data.IP (IPv4, AddrRange)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime)+import qualified Data.Time as Time+import qualified Data.Time.Parse as TP+import Language.Haskell.TH+import Safe++import AWS.Class++class Read a => FromText a+  where+    fromText :: MonadThrow m => Text -> m a+    fromText t+        = maybe (monadThrow $ TextConversionException t) return+        . fromTextMay+        $ t++    fromTextMay :: Text -> Maybe a+    fromTextMay = readMay . T.unpack++    fromMaybeText :: MonadThrow m => Maybe Text -> m a+    fromMaybeText+        = maybe+            (monadThrow $ TextConversionException "no text")+            fromText++instance FromText a => FromText (Maybe a)+  where+    fromText = return . join . fromTextMay+    fromMaybeText Nothing  = return Nothing+    fromMaybeText (Just t) = fromText t >>= return . Just+    fromTextMay = Just . fromTextMay++instance FromText Int+instance FromText Integer+instance FromText Double+instance FromText IPv4+instance FromText (AddrRange IPv4)++instance FromText Text+  where+    fromTextMay = Just++instance FromText Bool+  where+    fromTextMay "true"  = Just True+    fromTextMay "false" = Just False+    fromTextMay _       = Nothing++instance FromText UTCTime+  where+    fromTextMay t+        = Time.localTimeToUTC Time.utc . fst+        <$> (TP.strptime fmt $ T.unpack t)+      where+        fmt = "%FT%T"++deriveFromText :: String -> [String] -> DecsQ+deriveFromText dstr strs = do+    ctrs <- map (\(NormalC name _) -> name) <$> cons+    x <- newName "x"+    let cases = caseE (varE x) (map f (zip strs ctrs) ++ [wild])+    let fun = funD 'fromTextMay [clause [varP x] (normalB cases) []]+    (:[]) <$> instanceD ctx typ [fun]+  where+    d = mkName dstr+    cons = do+        (TyConI (DataD _ _ _ cs _)) <- reify d+        return cs+    f (s, t) = match (litP $ stringL s) (normalB $ [|Just $(conE t)|]) []+    wild = match wildP (normalB [|Nothing|]) []+    typ = appT (conT ''FromText) (conT d)+    ctx = return []

@@ -1,11 +1,28 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+ module AWS.Lib.Parser-    where+    ( RequestId+    , getT+    , getT_+    , element+    , elementM+    , listConduit+    , listConsumer+    , isBeginTagName+    , awaitWhile+    , sinkResponse+    , sinkResponseMetadata+    , sinkError+    , sinkEventBeginDocument+    , members+    , text+    , FromText(..)+    ) where  import Data.XML.Types (Event(..), Name(..)) import Data.Text (Text)-import qualified Data.Text as T+import Data.ByteString (ByteString) import Data.Conduit import qualified Data.Conduit.List as CL import qualified Text.XML.Stream.Parse as XML@@ -14,6 +31,7 @@ import Control.Monad.Trans.Class (lift)  import AWS.Class+import AWS.Lib.FromText  type RequestId = Text @@ -67,29 +85,17 @@         | f a       = return $ Just a         | otherwise = awaitWhile f -getF :: MonadThrow m-    => Text-    -> (Text -> b)-    -> Pipe Event Event o u m b-getF name f = tagContent name >>= return . f--getT :: MonadThrow m-    => Text-    -> Pipe Event Event o u m Text-getT name = getF name id--getM :: MonadThrow m+getT :: (MonadThrow m, FromText a)     => Text-    -> (Maybe Text -> b)-    -> Pipe Event Event o u m b-getM name f = tagContentM name >>= return . f+    -> Pipe Event Event o u m a+getT name = elementM name text >>= lift . fromMaybeText -getMT :: MonadThrow m+getT_ :: forall m o u . MonadThrow m     => Text-    -> Pipe Event Event o u m (Maybe Text)-getMT name = getM name id+    -> Pipe Event Event o u m ()+getT_ name = () <$ (getT name :: Pipe Event Event o u m Text) -elementM :: MonadThrow m+elementM :: forall o u m a . MonadThrow m     => Text     -> Pipe Event Event o u m a     -> Pipe Event Event o u m (Maybe a)@@ -99,22 +105,12 @@   where     g n = (nameLocalName n == name) -element :: MonadThrow m+element :: forall o u m a . MonadThrow m     => Text     -> Pipe Event Event o u m a     -> Pipe Event Event o u m a-element name inner = XML.force ("parse error:" ++ T.unpack name) $ elementM name inner--tagContentM :: MonadThrow m-    => Text-    -> GLSink Event m (Maybe Text)-tagContentM name = elementM name text--tagContent :: MonadThrow m-    => Text-    -> GLSink Event m Text-tagContent name =-    XML.force ("parse error:" ++ T.unpack name) $ tagContentM name+element name inner = elementM name inner >>=+    maybe (lift $ monadThrow $ ResponseParseError name) return  sinkResponse     :: MonadThrow m@@ -144,15 +140,13 @@         Just EventBeginDocument -> return ()         Just _ -> fail $ "unexpected: " <> show me -sinkError :: MonadThrow m => Int -> GLSink Event m a-sinkError status = element "ErrorResponse" $ do-    (_t,c,m) <- element "Error" $-        (,,)-        <$> getT "Type"-        <*> getT "Code"+sinkError :: MonadThrow m => ByteString -> Int -> GLSink Event m a+sinkError action status = element "ErrorResponse" $ do+    (c,m) <- element "Error" $ (,)+        <$> (getT_ "Type" *> getT "Code")         <*> getT "Message"     rid <- getT "RequestId"-    lift $ monadThrow $ ClientError status c m rid+    lift $ monadThrow $ ClientError action status c m rid  members :: MonadThrow m     => Text

@@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleContexts, RankNTypes, CPP #-} -#define DEBUG module AWS.Lib.Query     ( requestQuery     , QueryParam(..)@@ -10,12 +9,15 @@ #ifdef DEBUG     , debugQuery #endif+    , textToBS     ) where  import           Data.ByteString (ByteString) import qualified Data.ByteString as BS import           Data.ByteString.Lazy.Char8 () import qualified Data.ByteString.Char8 as BSC+import Data.Text (Text)+import qualified Data.Text as T  import Data.Monoid import Data.XML.Types (Event(..))@@ -33,7 +35,6 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift) import Control.Exception.Lifted as E-import Data.Text (Text) import qualified Control.Monad.State as State import qualified Control.Monad.Reader as Reader @@ -41,13 +42,12 @@ import AWS.Util import AWS.Credential import AWS.Lib.Parser+import AWS.EC2.Types (Filter)  #ifdef DEBUG import qualified Data.Conduit.Binary as CB #endif -type Filter = (Text, [Text])- data QueryParam     = ArrayParams Text [Text]     | FilterParams [Filter]@@ -89,6 +89,9 @@     qheader = Map.fromList $ queryHeader action time cred ver     qparam = queryStr $ Map.unions (qheader : map toArrayParams params) +textToBS :: Text -> ByteString+textToBS = BSC.pack . T.unpack+ toArrayParams :: QueryParam -> Map ByteString ByteString toArrayParams (ArrayParams name params) = Map.fromList      [ (textToBS name <> "." <> bsShow i, textToBS param)@@ -155,7 +158,7 @@     -> ByteString     -> [QueryParam]     -> ByteString-    -> (Int -> GLSink Event m a)+    -> (ByteString -> Int -> GLSink Event m a)     -> m (ResumableSource m ByteString) requestQuery cred ctx action params ver errSink = do     let mgr = manager ctx@@ -170,7 +173,7 @@     if st < 400         then return body         else do-            clientError st body errSink+            clientError st body $ errSink action             fail "not reached"  maybeParams :: [(Text, Maybe Text)] -> [QueryParam]

@@ -18,7 +18,7 @@ import Data.Monoid ((<>))  import AWS.Class-import AWS.Util+import AWS.Lib.Query (textToBS)  import AWS import AWS.RDS.Internal

@@ -38,9 +38,9 @@     => GLSink Event m [DBInstance] sinkDBInstances = elements "DBInstance" $     DBInstance-    <$> getM "Iops" (textToInt <$>)-    <*> getF "BackupRetentionPeriod" textToInt-    <*> getF "MultiAZ" textToBool+    <$> getT "Iops"+    <*> getT "BackupRetentionPeriod"+    <*> getT "MultiAZ"     <*> getT "DBInstanceStatus"     <*> getT "DBInstanceIdentifier"     <*> getT "PreferredBackupWindow"@@ -51,11 +51,11 @@         <*> getT "Status"         )     <*> getT "AvailabilityZone"-    <*> getM "LatestRestorableTime" (textToTime <$>)+    <*> getT "LatestRestorableTime"     <*> elements "ReadReplicaDBInstanceIdentifier" text     <*> getT "Engine"     <*> sinkPendingModifiedValues-    <*> getMT "CharacterSetName"+    <*> getT "CharacterSetName"     <*> getT "LicenseModel"     <*> elementM "DBSubnetGroup"         (DBSubnetGroup@@ -70,7 +70,7 @@             <*> element "SubnetAvailabilityZone"                 (AvailabilityZone                 <$> getT "Name"-                <*> getF "ProvisionedIopsCapable" textToBool+                <*> getT "ProvisionedIopsCapable"                 )             )         )@@ -81,20 +81,20 @@         )     <*> elementM "Endpoint"         (Endpoint-        <$> getF "Port" textToInt+        <$> getT "Port"         <*> getT "Address"         )     <*> getT "EngineVersion"-    <*> getMT "ReadReplicaSourceDBInstanceIdentifier"+    <*> getT "ReadReplicaSourceDBInstanceIdentifier"     <*> elements "DBSecurityGroup"         (DBSecurityGroupMembership         <$> getT "Status"         <*> getT "DBSecurityGroupName"         )-    <*> getMT "DBName"-    <*> getF "AutoMinorVersionUpgrade" textToBool-    <*> getM "InstanceCreateTime" (textToTime <$>)-    <*> getF "AllocatedStorage" textToInt+    <*> getT "DBName"+    <*> getT "AutoMinorVersionUpgrade"+    <*> getT "InstanceCreateTime"+    <*> getT "AllocatedStorage"     <*> getT "DBInstanceClass"     <*> getT "MasterUsername"  @@ -102,15 +102,15 @@     :: MonadThrow m     => GLSink Event m [PendingModifiedValue] sinkPendingModifiedValues = element "PendingModifiedValues" $-    catMaybes <$> sequence [ m "MasterUserPassword" PMVMasterUserPassword-        , m "Iops" (PMVIops . textToInt)-        , m "MultiAZ" (PMVMultiAZ . textToBool)-        , m "AllocatedStorage" (PMVAllocatedStorage . textToInt)-        , m "EngineVersion" PMVEngineVersion-        , m "DBInstanceClass" PMVDBInstanceClass-        , m "BackupRetentionPeriod"-            (PMVBackupRetentionPeriod . textToInt)-        , m "Port" (PMVPort . textToInt)+    catMaybes <$> sequence+        [ f PMVMasterUserPassword "MasterUserPassword"+        , f PMVIops "Iops"+        , f PMVMultiAZ "MultiAZ"+        , f PMVAllocatedStorage "AllocatedStorage"+        , f PMVEngineVersion "EngineVersion"+        , f PMVDBInstanceClass "DBInstanceClass"+        , f PMVBackupRetentionPeriod "BackupRetentionPeriod"+        , f PMVPort "Port"         ]   where-    m t f = getM t (f <$>)+    f c name = fmap c <$> getT name

@@ -6,10 +6,8 @@ import qualified Data.ByteString.Lazy as BSL import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.Read as TR import Data.Time (UTCTime) import qualified Data.Time as Time-import qualified Data.Time.Parse as TP import System.Locale (defaultTimeLocale)  toS :: BSL.ByteString -> ByteString@@ -24,33 +22,6 @@ err :: String -> Text -> a err v m = error $ "unknown " ++ v ++ ": " ++ T.unpack m -textToBool :: Text -> Bool-textToBool a-    | a == "true"  = True-    | a == "false" = False-    | otherwise    = err "value" a--textToInt :: Integral a => Text -> a-textToInt t = either -    (const $ error "not decimal")-    fst-    (TR.signed TR.decimal t)--textToDouble :: Fractional a => Text -> a-textToDouble t = either-    (const $ error "not double value")-    fst-    (TR.signed TR.rational t)--textToTime :: Text -> UTCTime-textToTime-    = Time.localTimeToUTC Time.utc-    . maybe (error "time format error.") fst-    . TP.strptime fmt-    . T.unpack-  where-    fmt = "%FT%T"- timeToText :: UTCTime -> Text timeToText     = T.pack@@ -58,9 +29,6 @@   where     fmt = "%FT%T" -orEmpty :: Maybe Text -> Text-orEmpty = maybe "" id- boolToText :: Bool -> Text boolToText True  = "true" boolToText False = "false"@@ -71,5 +39,5 @@ bsToText :: ByteString -> Text bsToText = T.pack . BSC.unpack -textToBS :: Text -> ByteString-textToBS = BSC.pack . T.unpack+unconcat :: [a] -> [[a]]+unconcat = map (:[])

@@ -22,3 +22,4 @@     runAvailabilityZoneTests     runTagTests     runKeyPairTests+    runNetworkInterfaceTests

@@ -1,5 +1,5 @@ name:                aws-sdk-version:             0.7.0.0+version:             0.7.1.0 synopsis:            AWS SDK for Haskell description:         An AWS(Amazon Web Services) liblary for Haskell. license:             BSD3@@ -30,7 +30,6 @@                    , AWS.EC2.Internal                    , AWS.EC2.Address                    , AWS.EC2.AvailabilityZone-                   , AWS.EC2.Convert                    , AWS.EC2.Image                    , AWS.EC2.Instance                    , AWS.EC2.Volume@@ -43,9 +42,10 @@                    , AWS.EC2.Region                    , AWS.EC2.VPC                    , AWS.EC2.Acl+                   , AWS.EC2.NetworkInterface                    , AWS.EC2.Tag                    , AWS.EC2.Params-                   , AWS.Lib.Convert+                   , AWS.Lib.FromText                    , AWS.Lib.Parser                    , AWS.Lib.Query                    , AWS.RDS.Internal@@ -82,12 +82,15 @@                    , strptime                    , template-haskell                    , parallel+                   , iproute >= 1.2.9  test-suite test     type:              exitcode-stdio-1.0     main-is:           Main.hs     hs-source-dirs:    Tests-    ghc-options:       -Wall -threaded+    ghc-options:       -Wall+                       -threaded+                       -fno-warn-unused-do-bind     extensions: OverloadedStrings     build-depends: base                  , aws-sdk@@ -100,6 +103,8 @@                  , QuickCheck                  , hspec                  , HUnit+                 , lifted-base+                 , iproute  source-repository head     type:            git