aws-sdk 0.7.1.0 → 0.8.0.0

raw patch · 26 files changed

+774/−516 lines, 26 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• AWS/CloudWatch/Metric.hs +21/−17
• AWS/EC2.hs +2/−2
• AWS/EC2/Acl.hs +29/−35
• AWS/EC2/Address.hs +21/−23
• AWS/EC2/AvailabilityZone.hs +2/−2
• AWS/EC2/Image.hs +59/−41
• AWS/EC2/Instance.hs +93/−126
• AWS/EC2/KeyPair.hs +5/−5
• AWS/EC2/NetworkInterface.hs +12/−9
• AWS/EC2/Params.hs +36/−35
• AWS/EC2/Query.hs +3/−4
• AWS/EC2/Region.hs +2/−2
• AWS/EC2/RouteTable.hs +9/−10
• AWS/EC2/SecurityGroup.hs +32/−43
• AWS/EC2/Snapshot.hs +97/−8
• AWS/EC2/Subnets.hs +12/−9
• AWS/EC2/Tag.hs +14/−16
• AWS/EC2/Types.hs +83/−14
• AWS/EC2/VPC.hs +112/−24
• AWS/EC2/Volume.hs +30/−38
• AWS/ELB/LoadBalancer.hs +4/−2
• AWS/Lib/FromText.hs +6/−5
• AWS/Lib/Parser.hs +1/−1
• AWS/Lib/Query.hs +77/−38
• AWS/RDS/DBInstance.hs +5/−5
• aws-sdk.cabal +7/−2

@@ -17,11 +17,14 @@ import AWS.Lib.Parser import AWS.CloudWatch.Types -dimensionFilterParams :: [DimensionFilter] -> QueryParam-dimensionFilterParams filters =-    StructArrayParams "Dimensions.member" $ map f filters+dimensionFiltersParam :: [DimensionFilter] -> QueryParam+dimensionFiltersParam =+    ("Dimensions" |.+) . ("member" |.#.) . map filterParams   where-    f (k, v) = [("Name", k), ("Value", v)]+    filterParams (k, v) =+        [ "Name" |= k+        , "Value" |= v+        ]  listMetrics     :: (MonadBaseControl IO m, MonadResource m)@@ -40,11 +43,10 @@         <*> getT "Namespace"   where     params =-        dimensionFilterParams ds :-        maybeParams-        [ ("MetricName", mn)-        , ("Namespace", ns)-        , ("NextToken", nt)+        [ dimensionFiltersParam ds+        , "MetricName" |=? mn+        , "Namespace" |=? ns+        , "NextToken" |=? nt         ]  getMetricStatistics@@ -71,14 +73,16 @@             )         <*> getT "Label"   where-    params = dimensionFilterParams ds :-        [ ValueParam "StartTime" $ timeToText start-        , ValueParam "EndTime" $ timeToText end-        , ValueParam "MetricName" mn-        , ValueParam "Namespace" ns-        , ValueParam "Period" $ toText pe-        , ArrayParams "Statistics.member" $ map s sts-        ] ++ maybeParams [("Unit", unit)]+    params =+        [ dimensionFiltersParam ds+        , "StartTime" |= timeToText start+        , "EndTime" |= timeToText end+        , "MetricName" |= mn+        , "Namespace" |= ns+        , "Period" |= toText pe+        , "Statistics" |.+ "member" |.#= map s sts+        , "Unit" |=? unit+        ]     s StatisticAverage     = "Average"     s StatisticSum         = "Sum"     s StatisticSampleCount = "SampleCount"

@@ -78,6 +78,6 @@ setEndpoint :: (MonadResource m, MonadBaseControl IO m)     => ByteString -- ^ ec2 endpoint domain <http://docs.amazonwebservices.com/general/latest/gr/rande.html>     -> EC2 m ()-setEndpoint endpoint = do+setEndpoint ep = do     ctx <- State.get-    State.put ctx { endpoint = endpoint }+    State.put ctx { endpoint = ep }

@@ -32,8 +32,8 @@         itemConduit "networkAclSet" networkAclSink   where     params =-        [ ArrayParams "NetworkAclId" nids-        , FilterParams filters+        [ "NetworkAclId" |.#= nids+        , filtersParam filters         ]  networkAclSink :: MonadThrow m@@ -70,7 +70,7 @@     ec2Query "CreateNetworkAcl" params $         element "networkAcl" networkAclSink   where-    params = [ValueParam "VpcId" vpcid]+    params = ["VpcId" |= vpcid]  deleteNetworkAcl     :: (MonadResource m, MonadBaseControl IO m)@@ -88,8 +88,8 @@         getT "newAssociationId"   where     params =-        [ ValueParam "AssociationId" assoc-        , ValueParam "NetworkAclId" aclid+        [ "AssociationId" |= assoc+        , "NetworkAclId" |= aclid         ]  createNetworkAclEntry@@ -103,39 +103,33 @@  reqToParams :: NetworkAclEntryRequest -> [QueryParam] reqToParams req =-        [ ValueParam "NetworkAclId" $+        [ "NetworkAclId" |=             networkAclEntryRequestNetworkAclId req-        , ValueParam "RuleNumber" $-            toText $ networkAclEntryRequestRuleNumber req-        , ValueParam "Protocol" $-            toText $ networkAclEntryRequestProtocol req-        , ValueParam "RuleAction" $-            ruleToText $ networkAclEntryRequestRuleAction req-        , ValueParam "CidrBlock" $+        , "RuleNumber" |=+            toText (networkAclEntryRequestRuleNumber req)+        , "Protocol" |=+            toText (networkAclEntryRequestProtocol req)+        , "RuleAction" |=+            ruleToText (networkAclEntryRequestRuleAction req)+        , "CidrBlock" |=             networkAclEntryRequestCidrBlock req-        , ValueParam "Egress" $-            boolToText $ networkAclEntryRequestEgress req-        ] ++ maybeParams-        [ ("Icmp.Code",-            toText-            <$> icmpTypeCodeCode-            <$> networkAclEntryRequestIcmp req)-        , ("Icmp.Type",-            toText-            <$> icmpTypeCodeType-            <$> networkAclEntryRequestIcmp req)-        , ("PortRange.From",-            toText-            <$> portRangeFrom-            <$> networkAclEntryRequestPortRange req)-        , ("PortRange.To",-            toText-            <$> portRangeTo-            <$> networkAclEntryRequestPortRange req)+        , "Egress" |=+            boolToText (networkAclEntryRequestEgress req)+        , "Icmp" |.? icmpParams <$> networkAclEntryRequestIcmp req+        , "PortRange" |.?+             portRangeParams <$> networkAclEntryRequestPortRange req         ]   where     ruleToText NetworkAclRuleActionAllow = "allow"     ruleToText NetworkAclRuleActionDeny = "deny"+    icmpParams icmp =+        [ "Code" |= toText (icmpTypeCodeCode icmp)+        , "Type" |= toText (icmpTypeCodeType icmp)+        ]+    portRangeParams pr =+        [ "From" |= toText (portRangeFrom pr)+        , "To" |= toText (portRangeTo pr)+        ]  deleteNetworkAclEntry     :: (MonadResource m, MonadBaseControl IO m)@@ -147,9 +141,9 @@     ec2Query "DeleteNetworkAclEntry" params $ getT "return"   where     params =-        [ ValueParam "NetworkAclId" aclid-        , ValueParam "RuleNumber" $ toText rule-        , ValueParam "Egress" $ boolToText egress+        [ "NetworkAclId" |= aclid+        , "RuleNumber" |= toText rule+        , "Egress" |= boolToText egress         ]  replaceNetworkAclEntry

@@ -35,9 +35,9 @@ describeAddresses pubIps alloIds filters =     ec2QuerySource "DescribeAddresses" params addressSet where     params =-        [ ArrayParams "PublicIp" pubIps-        , ArrayParams "AllocationId" alloIds-        , FilterParams filters+        [ "PublicIp" |.#= pubIps+        , "AllocationId" |.#= alloIds+        , filtersParam filters         ]      addressSet :: MonadThrow m => GLConduit Event m Address@@ -65,7 +65,7 @@         <*> getT "domain"         <*> getT "allocationId"   where-    params = if isVpc then [ValueParam "Domain" "vpc"] else []+    params = if isVpc then ["Domain" |= "vpc"] else []  ----------------------------------------------------- -- ReleaseAddress@@ -78,9 +78,9 @@ releaseAddress addr allocid = do     ec2Query "ReleaseAddress" params $ getT "return"   where-    params = maybeParams-        [ ("PublicIp", toText <$> addr)-        , ("AllocationId", allocid)+    params =+        [ "PublicIp" |=? toText <$> addr+        , "AllocationId" |=? allocid         ]  -----------------------------------------------------@@ -94,23 +94,21 @@     (,) <$> getT "return"         <*> getT "associationId"   where-    params = associateAddressParam param+    params = associateAddressParams param -associateAddressParam+associateAddressParams     :: AssociateAddressRequest -> [QueryParam]-associateAddressParam (AssociateAddressRequestEc2 ip iid) =-    [ ValueParam "PublicIp" $ toText ip-    , ValueParam "InstanceId" iid+associateAddressParams (AssociateAddressRequestEc2 ip iid) =+    [ "PublicIp" |= toText ip+    , "InstanceId" |= iid     ]-associateAddressParam-    (AssociateAddressRequestVpc aid iid nid pip ar) =-    [ ValueParam "AllocationId" aid ]-    ++ maybeParams-        [ ("InstanceId", iid)-        , ("NetworkInterfaceId", nid)-        , ("PrivateIpAddress", toText <$> pip)-        , ("AllowReassociation", boolToText <$> ar)-        ]+associateAddressParams (AssociateAddressRequestVpc aid iid nid pip ar) =+    [ "AllocationId" |= aid+    , "InstanceId" |=? iid+    , "NetworkInterfaceId" |=? nid+    , "PrivateIpAddress" |=? toText <$> pip+    , "AllowReassociation" |=? boolToText <$> ar+    ]  disassociateAddress     :: (MonadResource m, MonadBaseControl IO m)@@ -121,6 +119,6 @@         $ getT "return"   where     p (DisassociateAddressRequestEc2 pip)-        = [ValueParam "PublicIp" $ toText pip]+        = ["PublicIp" |= toText pip]     p (DisassociateAddressRequestVpc aid)-        = [ValueParam "AssociationId" $ toText aid]+        = ["AssociationId" |= toText aid]

@@ -25,8 +25,8 @@     ec2QuerySource "DescribeAvailabilityZones" params availabilityZoneInfo   where     params =-        [ ArrayParams "ZoneName" zones-        , FilterParams filters+        [ "ZoneName" |.#= zones+        , filtersParam filters         ]     availabilityZoneInfo :: MonadThrow m         => GLConduit Event m AvailabilityZone

@@ -6,11 +6,10 @@     , registerImage     , deregisterImage     , describeImageAttribute+    , modifyImageAttribute     ) where  import Data.Text (Text)-import qualified Data.Text as T- import Data.XML.Types (Event) import Data.Conduit import Control.Monad.Trans.Control (MonadBaseControl)@@ -33,13 +32,12 @@     -> EC2 m (ResumableSource m Image) describeImages imageIds owners execby filters =     ec2QuerySource "DescribeImages" params $ itemConduit "imagesSet" imageItem---    ec2QueryDebug "DescribeImages" params   where     params =-        [ ArrayParams "ImageId" imageIds-        , ArrayParams "Owner" owners-        , ArrayParams "ExecutableBy" execby-        , FilterParams filters+        [ "ImageId" |.#= imageIds+        , "Owner" |.#= owners+        , "ExecutableBy" |.#= execby+        , filtersParam filters         ]  imageItem :: MonadThrow m@@ -94,13 +92,13 @@ createImage iid name desc noReboot bdms =     ec2Query "CreateImage" params $ getT "imageId"   where-    param n = maybe [] (\a -> [ValueParam n a])     params =-        [ ValueParam "InstanceId" iid-        , ValueParam "Name" name-        , ValueParam "NoReboot" (boolToText noReboot)-        ] ++ param "Description" desc-          ++ [blockDeviceMappingParams bdms]+        [ "InstanceId" |= iid+        , "Name" |= name+        , "NoReboot" |= boolToText noReboot+        , "Description" |=? desc+        , blockDeviceMappingsParam bdms+        ]  registerImage     :: (MonadResource m, MonadBaseControl IO m)@@ -109,23 +107,17 @@ registerImage req =     ec2Query "RegisterImage" params $ getT "imageId"   where-    params = [ValueParam "Name" $ registerImageRequestName req]-        ++ [blockDeviceMappingParams-            $ registerImageRequestBlockDeviceMappings req]-        ++ maybeParams-            [ ("ImageLocation"-              , registerImageRequestImageLocation req-              )-            , ("Description", registerImageRequestDescription req)-            , ("Architecture"-              , registerImageRequestArchitecture req-              )-            , ("KernelId", registerImageRequestKernelId req)-            , ("RamdiskId", registerImageRequestRamdiskId req)-            , ("RootDeviceName"-              , registerImageRequestRootDeviceName req-              )-            ]+    params =+        [ "Name" |= registerImageRequestName req+        , "ImageLocation" |=? registerImageRequestImageLocation req+        , "Description" |=? registerImageRequestDescription req+        , "Architecture" |=? registerImageRequestArchitecture req+        , "KernelId" |=? registerImageRequestKernelId req+        , "RamdiskId" |=? registerImageRequestRamdiskId req+        , "RootDeviceName" |=? registerImageRequestRootDeviceName req+        , blockDeviceMappingsParam $+            registerImageRequestBlockDeviceMappings req+        ]  deregisterImage     :: (MonadResource m, MonadBaseControl IO m)@@ -134,7 +126,7 @@ deregisterImage iid =     ec2Query "DeregisterImage" params $ getT "return"   where-    params = [ValueParam "ImageId" iid]+    params = ["ImageId" |= iid]  describeImageAttribute     :: (MonadResource m, MonadBaseControl IO m)@@ -157,14 +149,40 @@         <*> blockDeviceMappingSink   where     getMMT name = join <$> elementM name (getT "value")-    params = [ ValueParam "ImageId" iid-             , ValueParam "Attribute" param+    params = [ "ImageId" |= iid+             , "Attribute" |= attrText attr              ]-    param :: Text-    param | attr == AMIDescription        = "description"-          | attr == AMIKernel             = "kernel"-          | attr == AMIRamdisk            = "ramdisk"-          | attr == AMILaunchPermission   = "launchPermission"-          | attr == AMIProductCodes       = "productCodes"-          | attr == AMIBlockDeviceMapping = "blockDeviceMapping"-          | otherwise                     = err "AMIAttribute" $ T.pack $ show attr+    attrText AMIDescription        = "description"+    attrText AMIKernel             = "kernel"+    attrText AMIRamdisk            = "ramdisk"+    attrText AMILaunchPermission   = "launchPermission"+    attrText AMIProductCodes       = "productCodes"+    attrText AMIBlockDeviceMapping = "blockDeviceMapping"++modifyImageAttribute+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ ImageId+    -> LaunchPermission -- ^ LaunchPermission+    -> [Text] -- ^ ProductCode+    -> Maybe Text -- ^ Description+    -> EC2 m Bool+modifyImageAttribute iid lp pcs desc =+    ec2Query "ModifyImageAttribute" params $ getT "return"+  where+    params =+        [ "ImageId" |= iid+        , "ProductCode" |.#= pcs+        , "LaunchPermission" |. launchPermissionParams lp+        , "Description" |.+ "Value" |=? desc+        ]++launchPermissionParams :: LaunchPermission -> [QueryParam]+launchPermissionParams lp =+    [ "Add" |.#. map itemParams (launchPermissionAdd lp)+    , "Remove" |.#. map itemParams (launchPermissionRemove lp)+    ]+  where+    itemParams item =+        [ "Group" |= launchPermissionItemGroup item+        , "UserId" |= launchPermissionUserId item+        ]

@@ -23,7 +23,6 @@ import Control.Applicative import Data.Maybe (fromMaybe, fromJust) import qualified Data.Map as Map-import Data.Monoid import Control.Monad  import AWS.EC2.Internal@@ -46,8 +45,8 @@         itemConduit "reservationSet" reservationSink   where     params =-        [ ArrayParams "InstanceId" instances-        , FilterParams filters+        [ "InstanceId" |.#= instances+        , filtersParam filters         ]  reservationSink :: MonadThrow m@@ -155,6 +154,7 @@     <*> getT "description"     <*> getT "ownerId"     <*> getT "status"+    <*> getT "macAddress"     <*> getT "privateIpAddress"     <*> getT "privateDnsName"     <*> getT "sourceDestCheck"@@ -171,6 +171,7 @@     <*> itemsSet "privateIpAddressesSet" (         InstancePrivateIpAddress         <$> getT "privateIpAddress"+        <*> getT "privateDnsName"         <*> getT "primary"         <*> instanceNetworkInterfaceAssociationSink         )@@ -197,9 +198,9 @@     ec2QuerySource' "DescribeInstanceStatus" params token instanceStatusSet   where     params =-        [ ArrayParams "InstanceId" instanceIds-        , ValueParam "IncludeAllInstances" $ boolToText isAll-        , FilterParams filters+        [ "InstanceId" |.#= instanceIds+        , "IncludeAllInstances" |= boolToText isAll+        , filtersParam filters         ]  instanceStatusSet :: MonadThrow m@@ -242,7 +243,7 @@ startInstances instanceIds =     ec2QuerySource "StartInstances" params instanceStateChangeSet   where-    params = [ArrayParams "InstanceId" instanceIds]+    params = ["InstanceId" |.#= instanceIds]  instanceStateChangeSet     :: (MonadResource m, MonadBaseControl IO m)@@ -265,8 +266,8 @@     ec2QuerySource "StopInstances" params instanceStateChangeSet   where     params =-        [ ArrayParams "InstanceId" instanceIds-        , ValueParam "Force" $ boolToText force]+        [ "InstanceId" |.#= instanceIds+        , "Force" |= boolToText force]  ------------------------------------------------------------ -- RebootInstances@@ -278,7 +279,7 @@ rebootInstances instanceIds =     ec2Query "RebootInstances" params $ getT "return"   where-    params = [ArrayParams "InstanceId" instanceIds]+    params = ["InstanceId" |.#= instanceIds]  ------------------------------------------------------------ -- TerminateInstances@@ -291,7 +292,7 @@     ec2QuerySource "TerminateInstances" params         instanceStateChangeSet   where-    params = [ArrayParams "InstanceId" instanceIds]+    params = ["InstanceId" |.#= instanceIds]  ------------------------------------------------------------ -- RunInstances@@ -305,69 +306,47 @@     ec2Query "RunInstances" params reservationSink   where     params =-        [ ValueParam "ImageId" $ runInstancesRequestImageId param-        , ValueParam "MinCount"-            $ toText $ runInstancesRequestMinCount param-        , ValueParam "MaxCount"-            $ toText $ runInstancesRequestMaxCount param-        , ArrayParams "SecurityGroupId"-            $ runInstancesRequestSecurityGroupIds param-        , ArrayParams "SecurityGroup"-            $ runInstancesRequestSecurityGroups param-        , blockDeviceMappingParams-            $ runInstancesRequestBlockDeviceMappings param-        ] ++ networkInterfaceParams-             (runInstancesRequestNetworkInterfaces param)-          ++ maybeParams-            [ ("KeyName", runInstancesRequestKeyName param)-            , ("UserData"-              , bsToText <$> runInstancesRequestUserData param-              )-            , ("InstanceType"-              , runInstancesRequestInstanceType param-              )-            , ("Placement.AvailabilityZone"-              , runInstancesRequestAvailabilityZone param-              )-            , ("Placement.GroupName"-              , runInstancesRequestPlacementGroup param-              )-            , ("Placement.Tenancy"-              , runInstancesRequestTenancy param-              )-            , ("KernelId", runInstancesRequestKernelId param)-            , ("RamdiskId", runInstancesRequestRamdiskId param)-            , ("Monitoring.Enabled"-              , boolToText-                <$> runInstancesRequestMonitoringEnabled param-              )-            , ("SubnetId", runInstancesRequestSubnetId param)-            , ("DisableApiTermination"-              , boolToText-                <$> runInstancesRequestDisableApiTermination param-              )-            , ("InstanceInitiatedShutdownBehavior"-              , sbToText-                <$> runInstancesRequestShutdownBehavior param-              )-            , ("PrivateIpAddress"-              , toText-                <$> runInstancesRequestPrivateIpAddress param-              )-            , ("ClientToken", runInstancesRequestClientToken param)-            , ("IamInstanceProfile.Arn"-              , iamInstanceProfileArn-                <$> runInstancesRequestIamInstanceProfile param-              )-            , ("IamInstanceProfile.Name"-              , iamInstanceProfileId-                <$> runInstancesRequestIamInstanceProfile param-              )-            , ("EbsOptimized"-              , boolToText-                <$> runInstancesRequestEbsOptimized param-              )+        [ "ImageId" |= runInstancesRequestImageId param+        , "MinCount" |= toText (runInstancesRequestMinCount param)+        , "MaxCount" |= toText (runInstancesRequestMaxCount param)+        , "KeyName" |=? runInstancesRequestKeyName param+        , "SecurityGroupId" |.#= runInstancesRequestSecurityGroupIds param+        , "SecurityGroup" |.#= runInstancesRequestSecurityGroups param+        , "UserData" |=? bsToText <$> runInstancesRequestUserData param+        , "InstanceType" |=? runInstancesRequestInstanceType param+        , "Placement" |.+            [ "AvailabilityZone" |=?+                runInstancesRequestAvailabilityZone param+            , "GroupName" |=?+                runInstancesRequestPlacementGroup param+            , "Tenancy" |=?+                runInstancesRequestTenancy param             ]+        , "KernelId" |=? runInstancesRequestKernelId param+        , "RamdiskId" |=? runInstancesRequestRamdiskId param+        , blockDeviceMappingsParam $+            runInstancesRequestBlockDeviceMappings param+        , "Monitoring" |.+ "Enabled" |=?+            boolToText <$> runInstancesRequestMonitoringEnabled param+        , "SubnetId" |=? runInstancesRequestSubnetId param+        , "DisableApiTermination" |=?+            boolToText <$> runInstancesRequestDisableApiTermination param+        , "InstanceInitiatedShutdownBehavior" |=?+            sbToText <$> runInstancesRequestShutdownBehavior param+        , "PrivateIpAddress" |=?+            toText <$> runInstancesRequestPrivateIpAddress param+        , "ClientToken" |=? runInstancesRequestClientToken param+        , "NetworkInterface" |.#. map networkInterfaceParams+            (runInstancesRequestNetworkInterfaces param)+        , "IamInstanceProfile" |.? iamInstanceProfileParams <$>+            runInstancesRequestIamInstanceProfile param+        , "EbsOptimized" |=?+            boolToText <$> runInstancesRequestEbsOptimized param+        ]+    iamInstanceProfileParams iam =+        [ "Arn" |= iamInstanceProfileArn iam+        , "Name" |= iamInstanceProfileId iam+        ]  -- | RunInstances parameter utility defaultRunInstancesRequest@@ -401,41 +380,30 @@         Nothing         Nothing -networkInterfaceParams :: [NetworkInterfaceParam] -> [QueryParam]-networkInterfaceParams nips = f 1 nips+networkInterfaceParams :: NetworkInterfaceParam -> [QueryParam]+networkInterfaceParams (NetworkInterfaceParamCreate di si d pia pias sgi dot) =+    [ "DeviceIndex" |= toText di+    , "SubnetId" |= si+    , "Description" |= d+    , "PrivateIpAddress" |=? toText <$> pia+    , "SecurityGroupId" |.#= sgi+    , "DeleteOnTermination" |= boolToText dot+    ] ++ s pias   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 SecondaryPrivateIpAddressParamNothing = []+    s (SecondaryPrivateIpAddressParamCount c) =+        ["SecondaryPrivateIpAddressCount" |= toText c]+    s (SecondaryPrivateIpAddressParamSpecified addrs pr) =+        [ privateIpAddressesParam "PrivateIpAddresses" addrs+        , maybeParam $ ipAddressPrimaryParam <$> pr         ]-    s n (SecondaryPrivateIpAddressParamSpecified addrs pr) =-        [ privateIpAddressesParam (p n "PrivateIpAddresses") addrs-        ] ++ maybe-            []-            (\i -> [-              ValueParam-              (p n "PrivateIpAddresses." <> toText i <> ".Primary")-              "true"])-            pr+    ipAddressPrimaryParam i =+        "PrivateIpAddresses" |.+ toText i |.+ "Primary" |= "true"+networkInterfaceParams (NetworkInterfaceParamAttach nid idx dot) =+    [ "NetworkInterfaceId" |= nid+    , "DeviceIndex" |= toText idx+    , "DeleteOnTermination" |= boolToText dot+    ]  sbToText :: ShutdownBehavior -> Text sbToText ShutdownBehaviorStop      = "stop"@@ -449,7 +417,7 @@     => Text -- ^ InstanceId     -> EC2 m ConsoleOutput getConsoleOutput iid =-    ec2Query "GetConsoleOutput" [ValueParam "InstanceId" iid] $+    ec2Query "GetConsoleOutput" ["InstanceId" |= iid] $         ConsoleOutput         <$> getT "instanceId"         <*> getT "timestamp"@@ -463,7 +431,7 @@     => Text -- ^ InstanceId     -> EC2 m PasswordData getPasswordData iid =-    ec2Query "GetPasswordData" [ValueParam "InstanceId" iid] $+    ec2Query "GetPasswordData" ["InstanceId" |= iid] $         PasswordData         <$> getT "instanceId"         <*> getT "timestamp"@@ -480,8 +448,8 @@   where     str = iar attr     params =-        [ ValueParam "InstanceId" iid-        , ValueParam "Attribute" str+        [ "InstanceId" |= iid+        , "Attribute" |= str         ]     f InstanceAttributeRequestBlockDeviceMapping = instanceBlockDeviceMappingsSink         >>= return . InstanceAttributeBlockDeviceMapping@@ -542,8 +510,8 @@     ec2Query "ResetInstanceAttribute" params $ getT "return"   where     params =-        [ ValueParam "InstanceId" iid-        , ValueParam "Attribute" $ riap attr+        [ "InstanceId" |= iid+        , "Attribute" |= riap attr         ]  -- | not tested@@ -555,29 +523,28 @@ modifyInstanceAttribute iid attrs =     ec2Query "ModifyInstanceAttribute" params $ getT "return"   where-    params = ValueParam "InstanceId" iid:concatMap miap attrs+    params = ("InstanceId" |= iid) : map miap attrs -miap :: ModifyInstanceAttributeRequest -> [QueryParam]+miap :: ModifyInstanceAttributeRequest -> QueryParam miap (ModifyInstanceAttributeRequestInstanceType a) =-    [ValueParam "InstanceType.Value" a]+    "InstanceType" |.+ "Value" |= a miap (ModifyInstanceAttributeRequestKernelId a) =-    [ValueParam "Kernel.Value"  a]+    "Kernel" |.+ "Value" |= a miap (ModifyInstanceAttributeRequestRamdiskId a) =-    [ValueParam "Ramdisk.Value" a]+    "Ramdisk" |.+ "Value" |= a miap (ModifyInstanceAttributeRequestUserData a) =-    [ValueParam "UserData.Value" a]+    "UserData" |.+ "Value" |= a miap (ModifyInstanceAttributeRequestDisableApiTermination a) =-    [ValueParam "DisableApiTermination.Value" $ toText a]+    "DisableApiTermination" |.+ "Value" |= toText a miap (ModifyInstanceAttributeRequestShutdownBehavior a) =-    [ValueParam "InstanceInitiatedShutdownBehavior.Value"-     $ sbToText a]+    "InstanceInitiatedShutdownBehavior" |.+ "Value" |= sbToText a miap (ModifyInstanceAttributeRequestRootDeviceName a) =-    [ValueParam "RootDeviceName" a]+    "RootDeviceName" |= a miap (ModifyInstanceAttributeRequestBlockDeviceMapping a) =-    [blockDeviceMappingParams a]+    blockDeviceMappingsParam a miap (ModifyInstanceAttributeRequestSourceDestCheck a) =-    [ValueParam "SourceDestCheck.Value" $ toText a]+    "SourceDestCheck" |.+ "Value" |= toText a miap (ModifyInstanceAttributeRequestGroupSet a) =-    [ArrayParams "GroupId" a]+    "GroupId" |.#= a miap (ModifyInstanceAttributeRequestEbsOptimized a) =-    [ValueParam "EbsOptimized" $ toText a]+    "EbsOptimized" |= toText a

@@ -29,8 +29,8 @@         $ itemConduit "keySet" keyPairSink   where     params =-        [ ArrayParams "KeyName" names-        , FilterParams filters+        [ "KeyName" |.#= names+        , filtersParam filters         ]  keyPairSink :: MonadThrow m => GLSink Event m KeyPair@@ -43,7 +43,7 @@     => Text -- ^ KeyName     -> EC2 m (KeyPair, Text) -- ^ KeyPair and KeyMaterial createKeyPair name =-    ec2Query "CreateKeyPair" [ValueParam "KeyName" name]+    ec2Query "CreateKeyPair" ["KeyName" |= name]         $ (,) <$> keyPairSink <*> getT "keyMaterial"  deleteKeyPair@@ -61,6 +61,6 @@     ec2Query "ImportKeyPair" params keyPairSink   where     params =-        [ ValueParam "KeyName" name-        , ValueParam "PublicKeyMaterial" material+        [ "KeyName" |= name+        , "PublicKeyMaterial" |= material         ]

@@ -29,12 +29,13 @@ 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]+    params =+        [ "NetworkInterfaceId" |= niid+        , either f g epip+        , "AllowReassignment" |=? boolToText <$> ar+        ]+    f = privateIpAddressesParam "PrivateIpAddress"+    g = ("SecondaryPrivateIpAddressCount" |=) . toText  unassignPrivateIpAddresses     :: (MonadBaseControl IO m, MonadResource m)@@ -45,7 +46,7 @@     ec2Query "UnassignPrivateIpAddresses" params $ getT "return"   where     params =-        [ ValueParam "NetworkInterfaceId" niid+        [ "NetworkInterfaceId" |= niid         , privateIpAddressesParam "PrivateIpAddress" addrs         ] @@ -59,8 +60,8 @@         $ itemConduit "networkInterfaceSet" networkInterfaceSink   where     params =-        [ ArrayParams "NetworkInterfaceId" niid-        , FilterParams filters+        [ "NetworkInterfaceId" |.#= niid+        , filtersParam filters         ]  networkInterfaceSink@@ -95,6 +96,7 @@     <*> itemsSet "privateIpAddressesSet" (         NetworkInterfacePrivateIpAddress         <$> getT "privateIpAddress"+        <*> getT "privateDnsName"         <*> getT "primary"         <*> networkInterfaceAssociationSink         )@@ -107,5 +109,6 @@         <$> getT "attachmentId"         <*> getT "instanceId"         <*> getT "publicIp"+        <*> getT "publicDnsName"         <*> getT "ipOwnerId"         <*> getT "associationId"

@@ -1,47 +1,48 @@-module AWS.EC2.Params where+module AWS.EC2.Params+    ( blockDeviceMappingsParam+    , privateIpAddressesParam+    , volumeTypeParams+    ) 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+import AWS.Lib.Query import AWS.Util -blockDeviceMappingParams-    :: [BlockDeviceMappingParam] -> QueryParam-blockDeviceMappingParams =-    StructArrayParams "BlockDeviceMapping" . map kvs-  where-    kvs (BlockDeviceMappingParamEbs name dev src dot vtype) = -        [ ("DeviceName", name)-        , ebsSource src-        ] ++ vtparam vtype ++ (uncurry f =<<-            [ ("NoDevice", boolToText <$> dev)-            , ("Ebs.DeleteOnTermination", boolToText <$> dot)-            ])-    kvs (BlockDeviceMappingParamInstanceStore name dev vname) =-        [("DeviceName", name)] ++ (uncurry f =<<-            [ ("NoDevice", boolToText <$> dev)-            , ("VirtualName", vname)-            ])+blockDeviceMappingsParam :: [BlockDeviceMappingParam] -> QueryParam+blockDeviceMappingsParam =+    ("BlockDeviceMapping" |.#.) . map blockDeviceMappingParams -    ebsSource (EbsSourceSnapshotId sid) = ("Ebs.SnapshotId", sid)-    ebsSource (EbsSourceVolumeSize size) =-        ("Ebs.VolumeSize", T.pack $ show size)+blockDeviceMappingParams :: BlockDeviceMappingParam -> [QueryParam]+blockDeviceMappingParams (BlockDeviceMappingParamEbs dn nd s dot vt) =+    [ "DeviceName" |= dn+    , "NoDevice" |=? boolToText <$> nd+    , "Ebs" |. ebsSourceParams s +++        ["DeleteOnTermination" |=? boolToText <$> dot] +++        maybe [] volumeTypeParams vt+    ]+  where+    ebsSourceParams (EbsSourceSnapshotId sid) =+        ["SnapshotId" |= sid]+    ebsSourceParams (EbsSourceVolumeSize size) =+        ["VolumeSize" |= toText size]+blockDeviceMappingParams (BlockDeviceMappingParamInstanceStore dn nd vn) =+    [ "DeviceName"|= dn+    , "NoDevice" |=? boolToText <$> nd+    , "VirtualName" |=? vn+    ] -    f n = maybe [] (\a -> [(n, a)])-    vtparam Nothing = []-    vtparam (Just VolumeTypeStandard) =-        [("Ebs.VolumeType", "standard")]-    vtparam (Just (VolumeTypeIO1 iops)) =-        [ ("Ebs.VolumeType", "io1")-        , ("Ebs.Iops", T.pack $ show iops)-        ]+volumeTypeParams :: VolumeType -> [QueryParam]+volumeTypeParams VolumeTypeStandard =+    ["VolumeType" |= "standard"]+volumeTypeParams (VolumeTypeIO1 iops) =+    [ "VolumeType" |= "io1"+    , "Iops" |= toText iops+    ]  privateIpAddressesParam :: Text -> [IPv4] -> QueryParam-privateIpAddressesParam name addrs = StructArrayParams-    name-    $ unconcat $ zip (repeat "PrivateIpAddress")-    $ map toText addrs+privateIpAddressesParam name =+    (name |.#.) . map (\a -> ["PrivateIpAddress" |= toText a])

@@ -41,7 +41,7 @@ #endif  apiVersion :: ByteString-apiVersion = "2012-10-01"+apiVersion = "2012-12-01"  sinkRequestId :: MonadThrow m     => GLSink Event m Text@@ -103,8 +103,7 @@     State.put ctx{lastRequestId = Just rid}     lift $ src1 $=+ (cond >> nextToken)   where-    params' = maybe params-        (\t -> ValueParam "NextToken" t:params) token+    params' = ("NextToken" |=? token) : params  nextToken :: MonadThrow m => Conduit Event m o nextToken = getT "nextToken" >>= maybe (return ()) (E.throw . NextToken)@@ -132,4 +131,4 @@     -> Text -- ^ ID of Target     -> EC2 m Bool ec2Delete apiName idName targetId = do-    ec2Query apiName [ ValueParam idName targetId ] $ getT "return"+    ec2Query apiName [ idName |= targetId ] $ getT "return"

@@ -25,8 +25,8 @@     ec2QuerySource "DescribeRegions" params regionInfoConduit   where     params =-        [ ArrayParams "RegionName" regions-        , FilterParams filters+        [ "RegionName" |.#= regions+        , filtersParam filters         ]     regionInfoConduit :: MonadThrow m         => GLConduit Event m Region

@@ -33,8 +33,8 @@         itemConduit "routeTableSet" routeTableSink   where     params =-        [ ArrayParams "RouteTableId" routeTables-        , FilterParams filters+        [ "RouteTableId" |.#= routeTables+        , filtersParam filters         ]  routeTableSink :: MonadThrow m@@ -74,7 +74,7 @@     => Text     -> EC2 m RouteTable createRouteTable vid =-    ec2Query "CreateRouteTable" [ValueParam "VpcId" vid] $+    ec2Query "CreateRouteTable" ["VpcId" |= vid] $         element "routeTable" routeTableSink  ------------------------------------------------------------@@ -98,8 +98,8 @@     ec2Query "AssociateRouteTable" params         $ getT "associationId"   where-    params = [ ValueParam "RouteTableId" rtid-             , ValueParam "SubnetId" sid+    params = [ "RouteTableId" |= rtid+             , "SubnetId" |= sid              ]  ------------------------------------------------------------@@ -110,9 +110,8 @@     => Text -- ^ AssociationId     -> EC2 m Bool -- ^ return disassociateRouteTable aid =-    ec2Query "DisassociateRouteTable"-        [ValueParam "AssociationId" aid]-            $ getT "return"+    ec2Query "DisassociateRouteTable" ["AssociationId" |= aid]+        $ getT "return"  ------------------------------------------------------------ -- replaceRouteTableAssociation@@ -126,6 +125,6 @@     ec2Query "ReplaceRouteTableAssociation" params         $ getT "newAssociationId"   where-    params = [ ValueParam "AssociationId" aid-             , ValueParam "RouteTableId" rtid+    params = [ "AssociationId" |= aid+             , "RouteTableId" |= rtid              ]

@@ -17,7 +17,6 @@ import Data.Conduit import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative-import Data.Monoid  import AWS.EC2.Internal import AWS.EC2.Types@@ -45,9 +44,9 @@         <*> resourceTagSink   where     params =-        [ ArrayParams "GroupName" names-        , ArrayParams "GroupId" ids-        , FilterParams filters+        [ "GroupName" |.#= names+        , "GroupId" |.#= ids+        , filtersParam filters         ]  ipPermissionsSink :: MonadThrow m@@ -75,20 +74,25 @@         $ getT_ "return" *> getT "groupId"   where     params =-        [ ValueParam "GroupName" name-        , ValueParam "GroupDescription" desc-        ] ++ maybe [] (\a -> [ValueParam "VpcId" a]) vpc+        [ "GroupName" |= name+        , "GroupDescription" |= desc+        , "VpcId" |=? vpc+        ]  deleteSecurityGroup     :: (MonadResource m, MonadBaseControl IO m)     => SecurityGroupRequest     -> EC2 m Bool deleteSecurityGroup param =-    ec2Query "DeleteSecurityGroup" [p param] $ getT "return"+    ec2Query "DeleteSecurityGroup" params $ getT "return"+  where+    params = [securityGroupRequestParam param] -p :: SecurityGroupRequest -> QueryParam-p (SecurityGroupRequestGroupId t)   = ValueParam "GroupId" t-p (SecurityGroupRequestGroupName t) = ValueParam "GroupName" t+securityGroupRequestParam :: SecurityGroupRequest -> QueryParam+securityGroupRequestParam (SecurityGroupRequestGroupId t) =+    "GroupId" |= t+securityGroupRequestParam (SecurityGroupRequestGroupName t) =+    "GroupName" |= t  -- | not tested authorizeSecurityGroupIngress@@ -137,37 +141,22 @@ securityGroupQuery act param ipps =     ec2Query act params $ getT "return"   where-    params = [p param]-        ++ concatMap (uncurry ipPermissionParam) (zip intstr ipps)--intstr :: [Int]-intstr = [1..]+    params =+        [ securityGroupRequestParam param+        , "IpPermissions" |.#. map ipPermissionParams ipps+        ] -ipPermissionParam :: Int -> IpPermission -> [QueryParam]-ipPermissionParam num ipp =-    [ValueParam (pre <> ".IpProtocol") $-        ipPermissionIpProtocol ipp]-    ++ (uncurry (mk pre) =<<-        [ (".FromPort", toText <$> ipPermissionFromPort ipp)-        , (".ToPort", toText <$> ipPermissionToPort ipp)-        ])-    ++ map-        (uncurry ipr)-        (zip intstr $ ipPermissionIpRanges ipp)-    ++ concatMap-        (uncurry grp)-        (zip intstr $ ipPermissionGroups ipp)+ipPermissionParams :: IpPermission -> [QueryParam]+ipPermissionParams ipp =+    [ "IpProtocol" |= ipPermissionIpProtocol ipp+    , "FromPort" |=? toText <$> ipPermissionFromPort ipp+    , "ToPort" |=? toText <$> ipPermissionToPort ipp+    , "Groups" |.#. map groupPairParams (ipPermissionGroups ipp)+    , "IpRanges" |.#. map (\a -> ["CidrIp" |= toText a]) (ipPermissionIpRanges ipp)+    ]   where-    pre = "IpPermissions." <> toText num-    mk h name = maybe [] (\a -> [ValueParam (h <> name) a])-    grph n = pre <> ".Groups." <> toText n-    grp n g = -        [ ValueParam (grph n <> ".GroupId") $-            userIdGroupPairGroupId g-        ] ++ (uncurry (mk (grph n)) =<<-            [ (".UserId", userIdGroupPairUserId g)-            , (".GroupName", userIdGroupPairGroupName g)-            ])-    ipr n r = ValueParam-        (pre <> ".IPRanges." <> toText n <> ".CidrIp")-        $ toText r+    groupPairParams gp =+        [ "UserId" |=? userIdGroupPairUserId gp+        , "GroupId" |= userIdGroupPairGroupId gp+        , "GroupName" |=? userIdGroupPairGroupName gp+        ]

@@ -4,10 +4,13 @@     ( describeSnapshots     , createSnapshot     , deleteSnapshot+    , copySnapshot+    , describeSnapshotAttribute+    , modifySnapshotAttribute+    , resetSnapshotAttribute     ) where  import Data.Text (Text)- import Data.XML.Types (Event) import Data.Conduit import Control.Monad.Trans.Control (MonadBaseControl)@@ -30,10 +33,10 @@         itemConduit "snapshotSet" snapshotSink   where     params =-        [ ArrayParams "SnapshotId" ssids-        , ArrayParams "Owner" owners-        , ArrayParams "RestorableBy" restby-        , FilterParams filters+        [ "SnapshotId" |.#= ssids+        , "Owner" |.#= owners+        , "RestorableBy" |.#= restby+        , filtersParam filters         ]  snapshotSink :: MonadThrow m@@ -58,8 +61,10 @@ createSnapshot volid desc =     ec2Query "CreateSnapshot" params snapshotSink   where-    params = [ValueParam "VolumeId" volid]-        ++ maybe [] (\a -> [ValueParam "Description" a]) desc+    params =+        [ "VolumeId" |= volid+        , "Description" |=? desc+        ]  deleteSnapshot     :: (MonadResource m, MonadBaseControl IO m)@@ -68,4 +73,88 @@ deleteSnapshot ssid =     ec2Query "DeleteSnapshot" params $ getT "return"   where-    params = [ValueParam "SnapshotId" ssid]+    params = ["SnapshotId" |= ssid]++copySnapshot+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ SourceRegion+    -> Text -- ^ SourceSnapshotId+    -> Maybe Text -- ^ Description+    -> EC2 m Text+copySnapshot region sid desc =+    ec2Query "CopySnapshot" params $ getT "snapshotId"+  where+    params = [ "SourceRegion" |= region+             , "SourceSnapshotId" |= sid+             , "Description" |=? desc+             ]++describeSnapshotAttribute+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ SnapshotId+    -> SnapshotAttributeRequest -- ^ Attribute+    -> EC2 m SnapshotAttribute+describeSnapshotAttribute ssid attr =+    ec2Query "DescribeSnapshotAttribute" params snapshotAttributeSink+  where+    params =+        [ "SnapshotId" |= ssid+        , "Attribute" |= attrText attr+        ]+    attrText SnapshotAttributeRequestCreateVolumePermission+        = "createVolumePermission"+    attrText SnapshotAttributeRequestProductCodes+        = "productCodes"++snapshotAttributeSink+    :: MonadThrow m+    => GLSink Event m SnapshotAttribute+snapshotAttributeSink = SnapshotAttribute+    <$> getT "snapshotId"+    <*> itemsSet "createVolumePermission" (+        CreateVolumePermissionItem+        <$> getT "userId"+        <*> getT "group"+        )+    <*> productCodeSink++modifySnapshotAttribute+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ SnapshotId+    -> CreateVolumePermission -- ^ CreateVolumePermission+    -> EC2 m Bool+modifySnapshotAttribute ssid cvp =+    ec2Query "ModifySnapshotAttribute" params $ getT "return"+  where+    params =+        [ "SnapshotId" |= ssid+        , "CreateVolumePermission" |. createVolumePermissionParams cvp+        ]++createVolumePermissionParams+    :: CreateVolumePermission+    -> [QueryParam]+createVolumePermissionParams cvp =+    [ "Add" |.#. itemParams <$> createVolumePermissionAdd cvp+    , "Remove" |.#. itemParams <$> createVolumePermissionRemove cvp+    ]+  where+    itemParams item =+        [ "UserId" |=? createVolumePermissionItemUserId item+        , "Group" |=? createVolumePermissionItemGroup item+        ]++resetSnapshotAttribute+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ SnapshotId+    -> ResetSnapshotAttributeRequest -- ^ Attribute+    -> EC2 m Bool+resetSnapshotAttribute ssid attr =+    ec2Query "ResetSnapshotAttribute" params $ getT "return"+  where+    params =+        [ "SnapshotId" |= ssid+        , "Attribute" |= attrText attr+        ]+    attrText ResetSnapshotAttributeRequestCreateVolumePermission+        = "createVolumePermission"

@@ -31,8 +31,8 @@         itemConduit "subnetSet" subnetSink   where     params =-        [ ArrayParams "SubnetId" subnets-        , FilterParams filters+        [ "SubnetId" |.#= subnets+        , filtersParam filters         ]  subnetSink :: MonadThrow m@@ -44,6 +44,8 @@     <*> getT "cidrBlock"     <*> getT "availableIpAddressCount"     <*> getT "availabilityZone"+    <*> getT "defaultForAz"+    <*> getT "mapPublicIpOnLaunch"     <*> resourceTagSink  ------------------------------------------------------------@@ -54,16 +56,17 @@     => CreateSubnetRequest     -> EC2 m Subnet createSubnet param =-    ec2Query "CreateSubnet" param' $+    ec2Query "CreateSubnet" params $           element "subnet" subnetSink   where-    param' = createSubnetParam param+    params = createSubnetParams param -createSubnetParam :: CreateSubnetRequest -> [QueryParam]-createSubnetParam (CreateSubnetRequest vid cidr zone) =-    [ ValueParam "VpcId" vid-    , ValueParam "CidrBlock" $ toText cidr-    ] ++ maybe [] (\a -> [ValueParam "AvailabilityZone" a]) zone+createSubnetParams :: CreateSubnetRequest -> [QueryParam]+createSubnetParams (CreateSubnetRequest vid cidr zone) =+    [ "VpcId" |= vid+    , "CidrBlock" |= toText cidr+    , "AvailabilityZone" |=? zone+    ]  ------------------------------------------------------------ -- DeleteSubnet

@@ -7,7 +7,6 @@     ) where  import Data.Text (Text)-import Data.Monoid import Data.Conduit import Control.Monad.Trans.Control (MonadBaseControl) import Control.Applicative@@ -16,7 +15,6 @@ import AWS.EC2.Types import AWS.EC2.Query import AWS.Lib.Parser-import AWS.Util  describeTags     :: (MonadResource m, MonadBaseControl IO m)@@ -30,7 +28,7 @@         <*> getT "key"         <*> getT "value"   where-    params = [FilterParams filters]+    params = [filtersParam filters]  createTags     :: (MonadResource m, MonadBaseControl IO m)@@ -41,12 +39,13 @@     ec2Query "CreateTags" params $ getT "return"   where     params =-        [ ArrayParams "ResourceId" rids ]-        ++ concatMap (uncurry tags) (zip ([1..]::[Int]) kvs)-    tags n (k, v) =-        [ ValueParam ("Tag." <> toText n <> ".Key") k-        , ValueParam ("Tag." <> toText n <> ".Value") v+        [ "ResourceId" |.#= rids+        , "Tag" |.#. map tagParams kvs         ]+    tagParams (k, v) =+        [ "Key" |= k+        , "Value" |= v+        ]  deleteTags     :: (MonadResource m, MonadBaseControl IO m)@@ -57,11 +56,10 @@     ec2Query "DeleteTags" params $ getT "return"   where     params =-        [ ArrayParams "ResourceId" rids ]-        ++ concatMap (uncurry tagParam) (zip ([1..]::[Int]) tags)-    tagParam n tag =-        [ ValueParam ("Tag." <> toText n <> ".Key")-         $ resourceTagKey tag ]-        ++ maybe []-            (\a -> [ValueParam ("Tag." <> toText n <> ".Value") a])-            (resourceTagValue tag)+        [ "ResourceId" |.#= rids+        , "Tag" |.#. map tagParams tags+        ]+    tagParams tag =+        [ "Key" |= resourceTagKey tag+        , "Value" |=? resourceTagValue tag+        ]

@@ -17,10 +17,15 @@     , BlockDeviceMappingParam(..)     , ConsoleOutput(..)     , CreateSubnetRequest(..)+    , CreateVolumePermission(..)+    , CreateVolumePermissionItem(..)     , CreateVolumeRequest(..)     , CreateVpnGatewayType(..)     , CustomerGateway(..)     , CustomerGatewayState(..)+    , DhcpConfiguration(..)+    , DhcpOptions(..)+    , DhcpValue(..)     , DisassociateAddressRequest(..)     , EbsBlockDevice(..)     , EbsInstanceBlockDevice(..)@@ -57,6 +62,7 @@     , IpPermission(..)     , KeyPair(..)     , ModifyInstanceAttributeRequest(..)+    , LaunchPermission(..)     , LaunchPermissionItem(..)     , NetworkAcl(..)     , NetworkAclAssociation(..)@@ -80,6 +86,7 @@     , RegisterImageRequest(..)     , Reservation(..)     , ResetInstanceAttributeRequest(..)+    , ResetSnapshotAttributeRequest(..)     , ResourceTag(..)     , RootDeviceType(..)     , Route(..)@@ -93,6 +100,8 @@     , SecurityGroupRequest(..)     , ShutdownBehavior(..)     , Snapshot(..)+    , SnapshotAttribute(..)+    , SnapshotAttributeRequest(..)     , SnapshotStatus(..)     , StateReason(..)     , Subnet(..)@@ -183,6 +192,12 @@     }   deriving (Show, Read, Eq) +data LaunchPermission = LaunchPermission+    { launchPermissionAdd :: [LaunchPermissionItem]+    , launchPermissionRemove :: [LaunchPermissionItem]+    }+  deriving (Show, Read, Eq)+ data LaunchPermissionItem = LaunchPermissionItem     { launchPermissionItemGroup :: Text     , launchPermissionUserId :: Text@@ -298,9 +313,9 @@     { instanceId :: Text     , instanceImageId :: Text     , instanceState :: InstanceState-    , instancePrivateDnsName :: Text-    , instanceDnsName :: Text-    , instanceReason :: Text+    , instancePrivateDnsName :: Maybe Text+    , instanceDnsName :: Maybe Text+    , instanceReason :: Maybe Text     , instanceKeyName :: Maybe Text     , instanceAmiLaunchIndex :: Text     , instanceProductCodes :: [ProductCode]@@ -322,10 +337,10 @@     , instanceRootDeviceType :: RootDeviceType     , instanceRootDeviceName :: Maybe Text     , instanceBlockDeviceMappings :: [InstanceBlockDeviceMapping]-    , instanceInstanceLifecycle :: InstanceLifecycle+    , instanceInstanceLifecycle :: Maybe InstanceLifecycle     , instanceSpotInstanceRequestId :: Maybe Text     , instanceVirtualizationType :: VirtualizationType-    , instanceClientToken :: Text+    , instanceClientToken :: Maybe Text     , instanceTagSet :: [ResourceTag]     , instanceHypervisor :: Hypervisor     , instanceNetworkInterfaceSet :: [InstanceNetworkInterface]@@ -401,7 +416,7 @@  data Placement = Placement     { placementAvailabilityZone :: Text-    , placementGroupName :: Text+    , placementGroupName :: Maybe Text     , placementTenancy :: Text     }   deriving (Show, Read, Eq)@@ -435,11 +450,12 @@  data InstanceNetworkInterface = InstanceNetworkInterface     { instanceNetworkInterfaceId :: Text-    , instanceNetworkInterfaceSubnetId :: Text-    , instanceNetworkInterfaceVpcId :: Text+    , instanceNetworkInterfaceSubnetId :: Maybe Text+    , instanceNetworkInterfaceVpcId :: Maybe Text     , instanceNetworkInterfaceDescription :: Maybe Text     , instanceNetworkInterfaceOwnerId :: Text     , instanceNetworkInterfaceStatus :: Text+    , instanceNetworkInterfaceMacAddress :: Maybe Text     , instanceNetworkInterfacePrivateIpAddress :: IPv4     , instanceNetworkInterfacePrivateDnsName :: Maybe Text     , instanceNetworkInterfaceSourceDestCheck :: Bool@@ -472,6 +488,7 @@  data InstancePrivateIpAddress = InstancePrivateIpAddress     { instancePrivateIpAddressAddress :: IPv4+    , instancePrivateIpAddressDnsName :: Maybe Text     , instancePrivateIpAddressPrimary :: Bool     , instancePrivateIpAddressAssociation         :: Maybe InstanceNetworkInterfaceAssociation@@ -580,6 +597,35 @@     | SnapshotError   deriving (Show, Read, Eq) +data SnapshotAttributeRequest+    = SnapshotAttributeRequestCreateVolumePermission+    | SnapshotAttributeRequestProductCodes+  deriving (Show, Read, Eq)++data ResetSnapshotAttributeRequest+    = ResetSnapshotAttributeRequestCreateVolumePermission+  deriving (Show, Read, Eq)++data SnapshotAttribute = SnapshotAttribute+    { snapshotAttributeSnapshotId :: Text+    , snapshotAttributeCreateVolumePermissionItems+        :: [CreateVolumePermissionItem]+    , snapshotAttributeProductCodes :: [ProductCode]+    }+  deriving (Show, Read, Eq)++data CreateVolumePermission = CreateVolumePermission+    { createVolumePermissionAdd :: [CreateVolumePermissionItem]+    , createVolumePermissionRemove :: [CreateVolumePermissionItem]+    }+  deriving (Show, Read, Eq)++data CreateVolumePermissionItem = CreateVolumePermissionItem+    { createVolumePermissionItemUserId :: Maybe Text+    , createVolumePermissionItemGroup :: Maybe Text+    }+  deriving (Show, Read, Eq)+ data Volume = Volume     { volumeId :: Text     , volumeSize :: Int@@ -895,6 +941,8 @@     , subnetCidrBlock :: AddrRange IPv4     , subnetAvailableIpAddressCount :: Int     , subnetAvailabilityZone :: Text+    , subnetDefaultForAz :: Maybe Bool+    , subnetMapPublicIpOnLaunch :: Maybe Bool     , subnetTagSet :: [ResourceTag]     }   deriving (Show, Read, Eq)@@ -1068,6 +1116,7 @@     , vpcDhcpOptionsId :: Text     , vpcTagSet :: [ResourceTag]     , vpcInstanceTenancy :: Text+    , vpcIsDefault :: Maybe Text     }   deriving (Show, Read, Eq) @@ -1144,6 +1193,24 @@     | InternetGatewayAttachmentStateAvailable   deriving (Show, Read, Eq) +data DhcpOptions = DhcpOptions+    { dhcpOptionsId :: Text+    , dhcpOptionsDhcpConfigurationSet :: [DhcpConfiguration]+    , dhcpOptionsTagSet :: [ResourceTag]+    }+  deriving (Show, Read, Eq)++data DhcpConfiguration = DhcpConfiguration+    { dhcpConfigurationKey :: Text+    , dhcpConfigurationDhcpValueSet :: [DhcpValue]+    }+  deriving (Show, Read, Eq)++data DhcpValue = DhcpValue+    { dhcpValueValue :: Text+    }+  deriving (Show, Read, Eq)+ data NetworkInterface = NetworkInterface     { networkInterfaceId :: Text     , networkInterfaceSubnetId :: Text@@ -1191,6 +1258,7 @@     { networkInterfaceAssociationAttachmentId :: Maybe Text     , networkInterfaceAssociationInstanceId :: Maybe Text     , networkInterfaceAssociationPublicIp :: IPv4+    , networkInterfaceAssociationPublicDnsName :: Maybe Text     , networkInterfaceAssociationIpOwnerId :: Text     , networkInterfaceAssociationId :: Text     }@@ -1199,6 +1267,7 @@ data NetworkInterfacePrivateIpAddress     = NetworkInterfacePrivateIpAddress     { networkInterfacePrivateIpAddressPrivateIpAddress :: IPv4+    , networkInterfacePrivateIpAddressDnsName :: Maybe Text     , networkInterfacePrivateIpAddressPrimary :: Bool     , networkInterfacePrivateIpAddressAssociation         :: Maybe NetworkInterfaceAssociation@@ -1207,15 +1276,15 @@  instance FromText Platform   where-    fromMaybeText Nothing  = return PlatformOther-    fromMaybeText (Just t)+    fromMaybeText _name Nothing  = return PlatformOther+    fromMaybeText _name (Just t)         | t == "windows" = return PlatformWindows         | otherwise      = return PlatformOther  instance FromText AddressDomain   where-    fromMaybeText Nothing  = return AddressDomainStandard-    fromMaybeText (Just t)+    fromMaybeText _name Nothing  = return AddressDomainStandard+    fromMaybeText _name (Just t)         | t == "standard" = return AddressDomainStandard         | t == "vpc"      = return AddressDomainVPC         | otherwise       = monadThrow $ TextConversionException t@@ -1228,8 +1297,8 @@  instance FromText InstanceLifecycle   where-    fromMaybeText Nothing  = return LifecycleNone-    fromMaybeText (Just t)+    fromMaybeText _name Nothing  = return LifecycleNone+    fromMaybeText _name (Just t)         | t == "spot" = return LifecycleSpot         | otherwise   = monadThrow $ TextConversionException t 

@@ -1,20 +1,24 @@ {-# LANGUAGE FlexibleContexts, RankNTypes #-}  module AWS.EC2.VPC-    ( createVpc+    ( associateDhcpOptions+    , attachInternetGateway+    , createVpc     , createVpnGateway     , createCustomerGateway     , createInternetGateway+    , createDhcpOptions     , deleteVpc     , deleteVpnGateway     , deleteCustomerGateway     , deleteInternetGateway+    , deleteDhcpOptions     , describeVpnConnections     , describeVpnGateways     , describeVpcs     , describeCustomerGateway     , describeInternetGateways-    , attachInternetGateway+    , describeDhcpOptions     , detachInternetGateway     ) where @@ -45,8 +49,8 @@     ec2Query "AttachInternetGateway" params $ getT "return"   where     params =-        [ ValueParam "InternetGatewayId" internetGatewayId-        , ValueParam "VpcId" vid ]+        [ "InternetGatewayId" |= internetGatewayId+        , "VpcId" |= vid ]  ------------------------------------------------------------ -- detachInternetGateway@@ -60,8 +64,8 @@     ec2Query "DetachInternetGateway" params $ getT "return"   where     params =-        [ ValueParam "InternetGatewayId" internetGatewayId-        , ValueParam "VpcId" vid ]+        [ "InternetGatewayId" |= internetGatewayId+        , "VpcId" |= vid ]  ------------------------------------------------------------ -- deleteInternetGateway@@ -95,8 +99,8 @@         itemConduit "internetGatewaySet" internetGatewaySink   where     params =-        [ ArrayParams "InternetGatewayId" internetGatewayIds-        , FilterParams filters+        [ "InternetGatewayId" |.#= internetGatewayIds+        , filtersParam filters         ]  internetGatewaySink :: MonadThrow m@@ -119,8 +123,10 @@ describeVpnConnections ids filters =     ec2QuerySource "DescribeVpnConnections" params vpnConnectionConduit   where-    params = [ArrayParams "VpnConnectionId" ids]-        ++ [FilterParams filters]+    params =+        [ "VpnConnectionId" |.#= ids+        , filtersParam filters+        ]  vpnConnectionConduit     :: (MonadBaseControl IO m, MonadResource m)@@ -168,8 +174,8 @@         itemConduit "vpcSet" vpcSink   where     params =-        [ ArrayParams "VpcId" vpcIds-        , FilterParams filters+        [ "VpcId" |.#= vpcIds+        , filtersParam filters         ]  vpcSink :: MonadThrow m@@ -181,6 +187,7 @@     <*> getT "dhcpOptionsId"     <*> resourceTagSink     <*> getT "instanceTenancy"+    <*> getT "isDefault"  ------------------------------------------------------------ -- createVpc@@ -195,8 +202,9 @@         element "vpc" vpcSink   where     params =-        [ ValueParam "CidrBlock" $ toText cidrBlock-        ] ++ maybeParams [ ("instanceTenancy", instanceTenancy) ]+        [ "CidrBlock" |= toText cidrBlock+        , "instanceTenancy" |=? instanceTenancy+        ]  ------------------------------------------------------------ -- deleteVpc@@ -220,8 +228,8 @@         itemConduit "vpnGatewaySet" vpnGatewaySink   where     params =-        [ ArrayParams "VpnGatewayId" ids-        , FilterParams filters+        [ "VpnGatewayId" |.#= ids+        , filtersParam filters         ]  vpnGatewaySink :: MonadThrow m@@ -248,13 +256,15 @@     => CreateVpnGatewayType -- ^ Type. The valid value is CreateVpnGatewayTypeIpsec1     -> Maybe Text -- ^ AvailabilityZone     -> EC2 m VpnGateway-createVpnGateway _ availabilityZone = do+createVpnGateway type' availabilityZone = do     ec2Query "CreateVpnGateway" params $         element "vpnGateway" vpnGatewaySink   where     params =-        [ ValueParam "Type" "ipsec.1"-        ] ++ maybeParams [ ("AvailabilityZone", availabilityZone) ]+        [ "Type" |= createVpnGatewayTypeText type'+        , "AvailabilityZone" |=? availabilityZone+        ]+    createVpnGatewayTypeText CreateVpnGatewayTypeIpsec1 = "ipsec.1"  ------------------------------------------------------------ -- deleteVpnGateway@@ -278,8 +288,8 @@         itemConduit "customerGatewaySet" customerGatewaySink   where     params =-        [ ArrayParams "CustomerGatewayId" ids-        , FilterParams filters+        [ "CustomerGatewayId" |.#= ids+        , filtersParam filters         ]  customerGatewaySink :: MonadThrow m@@ -306,9 +316,9 @@         element "customerGateway" customerGatewaySink   where     params =-        [ ValueParam "Type" type' -        , ValueParam "IpAddress" $ toText ipAddr-        , ValueParam "BgpAsn" (toText bgpAsn)+        [ "Type" |= type'+        , "IpAddress" |= toText ipAddr+        , "BgpAsn" |= toText bgpAsn         ]  ------------------------------------------------------------@@ -319,3 +329,81 @@     => Text -- ^ CustomerGatewayId     -> EC2 m Bool deleteCustomerGateway = ec2Delete "DeleteCustomerGateway" "CustomerGatewayId"++------------------------------------------------------------+-- describeDhcpOptions+------------------------------------------------------------+describeDhcpOptions+    :: (MonadResource m, MonadBaseControl IO m)+    => [Text] -- ^ DhcpOptionsIds+    -> [Filter] -- ^ Filters+    -> EC2 m (ResumableSource m DhcpOptions)+describeDhcpOptions ids filters =+    ec2QuerySource "DescribeDhcpOptions" params $+        itemConduit "dhcpOptionsSet" dhcpOptionsSink+  where+    params =+        [ "DhcpOptionsId" |.#= ids+        , filtersParam filters+        ]++dhcpOptionsSink :: MonadThrow m+    => GLSink Event m DhcpOptions+dhcpOptionsSink = DhcpOptions+    <$> getT "dhcpOptionsId"+    <*> itemsSet "dhcpConfigurationSet" dhcpConfigurationSink+    <*> resourceTagSink++dhcpConfigurationSink :: MonadThrow m+    => GLSink Event m DhcpConfiguration+dhcpConfigurationSink = DhcpConfiguration+    <$> getT "key"+    <*> itemsSet "valueSet"+        (DhcpValue+        <$> getT "value"+        )++------------------------------------------------------------+-- createDhcpOptions+------------------------------------------------------------+createDhcpOptions+    :: (MonadResource m, MonadBaseControl IO m)+    => [DhcpConfiguration] -- ^ DhcpConfigurations+    -> EC2 m DhcpOptions+createDhcpOptions confs =+    ec2Query "CreateDhcpOptions" params $+        element "dhcpOptions" dhcpOptionsSink+  where+    params = ["DhcpConfiguration" |.#. map dhcpConfigurationParams confs]+    dhcpConfigurationParams conf =+        [ "Key" |= dhcpConfigurationKey conf+        , "Value" |.#= map dhcpValueValue (dhcpConfigurationDhcpValueSet conf)+        ]++------------------------------------------------------------+-- deleteDhcpOptions+------------------------------------------------------------+deleteDhcpOptions+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ DhcpOptionsId+    -> EC2 m Bool+deleteDhcpOptions doid =+    ec2Query "DeleteDhcpOptions" params $ getT "return"+  where+    params = ["DhcpOptionsId" |= doid]++------------------------------------------------------------+-- associateDhcpOptions+------------------------------------------------------------+associateDhcpOptions+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ DhcpOptionsId+    -> Text -- ^ VpcId+    -> EC2 m Bool+associateDhcpOptions doid vpcid =+    ec2Query "AssociateDhcpOptions" params $ getT "return"+  where+    params =+        [ "DhcpOptionsId" |= doid+        , "VpcId" |= vpcid+        ]

@@ -19,6 +19,7 @@ import Control.Applicative  import AWS.EC2.Internal+import AWS.EC2.Params import AWS.EC2.Types import AWS.EC2.Query import AWS.Lib.Parser@@ -34,8 +35,8 @@         itemConduit "volumeSet" volumeSink   where     params =-        [ ArrayParams "VolumeId" vids-        , FilterParams filters+        [ "VolumeId" |.#= vids+        , filtersParam filters         ]  volumeSink :: MonadThrow m@@ -60,14 +61,6 @@     <*> getT "attachTime"     <*> getT "deleteOnTermination" -volumeTypeParam :: VolumeType -> [QueryParam]-volumeTypeParam VolumeTypeStandard =-    [ValueParam "VolumeType" "standard"]-volumeTypeParam (VolumeTypeIO1 iops) =-    [ ValueParam "VolumeType" "io1"-    , ValueParam "Iops" $ toText iops-    ]- createVolume     :: (MonadResource m, MonadBaseControl IO m)     => CreateVolumeRequest@@ -75,19 +68,18 @@ createVolume param =     ec2Query "CreateVolume" param' volumeSink   where-    param' = createVolumeParam param+    param' = createVolumeParams param -createVolumeParam :: CreateVolumeRequest -> [QueryParam]-createVolumeParam (CreateNewVolume size zone vtype) =-    [ ValueParam "Size" $ toText size-    , ValueParam "AvailabilityZone" zone-    ] ++ maybe [] volumeTypeParam vtype-createVolumeParam (CreateFromSnapshot sid zone size vtype) =-    [ ValueParam "SnapshotId" sid-    , ValueParam "AvailabilityZone" zone-    ]-    ++ maybe [] (\a -> [ValueParam "Size" $ toText a]) size-    ++ maybe [] volumeTypeParam vtype+createVolumeParams :: CreateVolumeRequest -> [QueryParam]+createVolumeParams (CreateNewVolume size zone vtype) =+    [ "Size" |= toText size+    , "AvailabilityZone" |= zone+    ] ++ maybe [] volumeTypeParams vtype+createVolumeParams (CreateFromSnapshot sid zone size vtype) =+    [ "SnapshotId" |= sid+    , "AvailabilityZone" |= zone+    , "Size" |=? toText <$> size+    ] ++ maybe [] volumeTypeParams vtype  deleteVolume     :: (MonadResource m, MonadBaseControl IO m)@@ -105,9 +97,9 @@     ec2Query "AttachVolume" params attachmentSink   where     params =-        [ ValueParam "VolumeId" volid-        , ValueParam "InstanceId" iid-        , ValueParam "Device" dev+        [ "VolumeId" |= volid+        , "InstanceId" |= iid+        , "Device" |= dev         ]  detachVolume@@ -120,12 +112,12 @@ detachVolume volid iid dev force =     ec2Query "DetachVolume" params attachmentSink   where-    params = [ValueParam "VolumeId" volid]-        ++ maybeParams-            [ ("InstanceId", iid)-            , ("Device", dev)-            , ("Force", toText <$> force)-            ]+    params =+        [ "VolumeId" |= volid+        , "InstanceId" |=? iid+        , "Device" |=? dev+        , "Force" |=? toText <$> force+        ]  describeVolumeStatus     :: (MonadResource m, MonadBaseControl IO m)@@ -138,8 +130,8 @@        itemConduit "volumeStatusSet" $ volumeStatusSink   where     params =-        [ ArrayParams "VolumeId" vids-        , FilterParams filters+        [ "VolumeId" |.#= vids+        , filtersParam filters         ]  volumeStatusSink :: MonadThrow m@@ -177,8 +169,8 @@     ec2Query "ModifyVolumeAttribute" params $ getT "return"   where     params =-        [ ValueParam "VolumeId" vid-        , ValueParam "AutoEnableIO.Value" $ boolToText enable+        [ "VolumeId" |= vid+        , "AutoEnableIO" |.+ "Value" |= boolToText enable         ]  enableVolumeIO@@ -188,7 +180,7 @@ enableVolumeIO vid =     ec2Query "EnableVolumeIO" params $ getT "return"   where-    params = [ValueParam "VolumeId" vid]+    params = ["VolumeId" |= vid]  -- | return (volumeId, Attribute) describeVolumeAttribute@@ -202,8 +194,8 @@         <*> volumeAttributeSink attr   where     params =-        [ ValueParam "VolumeId" vid-        , ValueParam "Attribute" $ s attr+        [ "VolumeId" |= vid+        , "Attribute" |= s attr         ]     s VolumeAttributeRequestAutoEnableIO = "autoEnableIO"     s VolumeAttributeRequestProductCodes = "productCodes"

@@ -24,8 +24,10 @@ describeLoadBalancers lbs marker =     elbQuery "DescribeLoadBalancers" params sinkLoadBalancers   where-    params = [ArrayParams "LoadBalancerNames.member" lbs]-        ++ maybe [] (\a -> [ValueParam "Marker" a]) marker+    params =+        [ "LoadBalancerNames.member" |.#= lbs+        , "Marker" |=? marker+        ]  sinkLoadBalancers :: MonadThrow m     => GLSink Event m [LoadBalancerDescription]

@@ -7,6 +7,7 @@ import Control.Monad import Data.Conduit (MonadThrow) import Data.IP (IPv4, AddrRange)+import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import Data.Time (UTCTime)@@ -28,17 +29,17 @@     fromTextMay :: Text -> Maybe a     fromTextMay = readMay . T.unpack -    fromMaybeText :: MonadThrow m => Maybe Text -> m a-    fromMaybeText+    fromMaybeText :: MonadThrow m => Text -> Maybe Text -> m a+    fromMaybeText name         = maybe-            (monadThrow $ TextConversionException "no text")+            (monadThrow $ TextConversionException $ "no text: " <> name)             fromText  instance FromText a => FromText (Maybe a)   where     fromText = return . join . fromTextMay-    fromMaybeText Nothing  = return Nothing-    fromMaybeText (Just t) = fromText t >>= return . Just+    fromMaybeText _name Nothing  = return Nothing+    fromMaybeText _name (Just t) = fromText t >>= return . Just     fromTextMay = Just . fromTextMay  instance FromText Int

@@ -88,7 +88,7 @@ getT :: (MonadThrow m, FromText a)     => Text     -> Pipe Event Event o u m a-getT name = elementM name text >>= lift . fromMaybeText+getT name = elementM name text >>= lift . fromMaybeText name  getT_ :: forall m o u . MonadThrow m     => Text

@@ -1,10 +1,17 @@ {-# LANGUAGE FlexibleContexts, RankNTypes, CPP #-}  module AWS.Lib.Query-    ( requestQuery-    , QueryParam(..)+    ( QueryParam     , Filter-    , maybeParams+    , (|.+)+    , putNumberV, putNumberP+    , filtersParam+    , maybeParam+    , nothingParam+    , (|=), (|.)+    , (|=?), (|.?)+    , (|.#=), (|.#.)+    , requestQuery     , commonQuery #ifdef DEBUG     , debugQuery@@ -19,6 +26,7 @@ import Data.Text (Text) import qualified Data.Text as T +import Data.List (transpose) import Data.Monoid import Data.XML.Types (Event(..)) import Data.Conduit@@ -49,12 +57,72 @@ #endif  data QueryParam-    = ArrayParams Text [Text]-    | FilterParams [Filter]-    | ValueParam Text Text-    | StructArrayParams Text [[(Text, Text)]]-  deriving (Show)+    = Leaf Text Text+    | Inner Text [QueryParam] +infixr 3 |.++(|.+) :: Text -> QueryParam -> QueryParam+t |.+ (Leaf k v) = t <> "." <> k |= v+t |.+ (Inner k ps) = t <> "." <> k |. ps++paramsToMap :: [QueryParam] -> Map ByteString ByteString+paramsToMap = Map.fromList . map tup . concat . map partition+  where+    tup (Leaf k v) = (textToBS k, textToBS v)+    tup (Inner _ _) = error "partition param error"++-- | partition to unit+partition :: QueryParam -> [QueryParam]+partition p@(Leaf _ _) = [p]+partition (Inner k ps) = concat $ map (partition . (k |.+)) ps++-- | put a number to each value+putNumberV :: [Text] -> [QueryParam]+putNumberV = map (uncurry Leaf) . zip (map toText ([1..] :: [Int]))++-- | put a number to each params+putNumberP :: [[QueryParam]] -> [QueryParam]+putNumberP = map (uncurry Inner) . zip (map toText ([1..] :: [Int]))++filtersParam :: [Filter] -> QueryParam+filtersParam filters = "Filter" |.#. transpose [keyParams, valParams]+  where+    keyParams = map (("Key" |=) . fst) filters+    valParams = map (("Value" |.#=) . snd) filters++maybeParam :: Maybe QueryParam -> QueryParam+maybeParam (Just p) = p+maybeParam Nothing = nothingParam++nothingParam :: QueryParam+nothingParam = Inner "" []++infixr 3 |=+(|=) :: Text -> Text -> QueryParam+(|=) = Leaf++infixr 3 |.+(|.) :: Text -> [QueryParam] -> QueryParam+(|.) = Inner++infixr 3 |=?+(|=?) :: Text -> Maybe Text -> QueryParam+t |=? (Just a) = t |= a+_ |=? Nothing = nothingParam++infixr 3 |.?+(|.?) :: Text -> Maybe [QueryParam] -> QueryParam+t |.? (Just ps) = t |. ps+_ |.? Nothing = nothingParam++infixr 3 |.#=+(|.#=) :: Text -> [Text] -> QueryParam+t |.#= ts = t |. putNumberV ts++infixr 3 |.#.+(|.#.) :: Text -> [[QueryParam]] -> QueryParam+t |.#. ps = t |. putNumberP ps+ queryHeader     :: ByteString     -> UTCTime@@ -87,35 +155,11 @@     ]   where     qheader = Map.fromList $ queryHeader action time cred ver-    qparam = queryStr $ Map.unions (qheader : map toArrayParams params)+    qparam = queryStr $ Map.union qheader $ paramsToMap 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)-    | (i, param) <- zip ([1..]::[Int]) params-    ]-toArrayParams (FilterParams kvs) =-    Map.fromList . concat . map f1 $ zip ([1..]::[Int]) kvs-  where-    f1 (n, (key, vals)) = (filt n <> ".Name", textToBS key) :-        [ (filt n <> ".Value." <> bsShow i, textToBS param)-        | (i, param) <- zip ([1..]::[Int]) vals-        ]-    filt n = "Filter." <> bsShow n-toArrayParams (ValueParam k v) =-    Map.singleton (textToBS k) (textToBS v)-toArrayParams (StructArrayParams name vss) = Map.fromList l-  where-    bsName =  textToBS name-    struct n (k, v) = (n <> "." <> textToBS k, textToBS v)-    l = mconcat-        [ map (struct (bsName <> "." <> bsShow i)) kvs-        | (i, kvs) <- zip ([1..]::[Int]) vss-        ]- queryStr :: Map ByteString ByteString -> ByteString queryStr = BS.intercalate "&" . Map.foldrWithKey' concatWithEqual []   where@@ -175,11 +219,6 @@         else do             clientError st body $ errSink action             fail "not reached"--maybeParams :: [(Text, Maybe Text)] -> [QueryParam]-maybeParams params = params >>= uncurry mk-  where-    mk name = maybe [] (\a -> [ValueParam name a])  commonQuery     :: (MonadBaseControl IO m, MonadResource m)

@@ -27,10 +27,10 @@ describeDBInstances dbid maxRecords marker =     rdsQuery "DescribeDBInstances" params sinkDBInstances   where-    params = maybeParams-        [ ("DBInstanceIdentifier", dbid)-        , ("MaxRecords", toText <$> maxRecords)-        , ("Marker", marker)+    params =+        [ "DBInstanceIdentifier" |=? dbid+        , "MaxRecords" |=? toText <$> maxRecords+        , "Marker" |=? marker         ]  sinkDBInstances@@ -96,7 +96,7 @@     <*> getT "InstanceCreateTime"     <*> getT "AllocatedStorage"     <*> getT "DBInstanceClass"-    <*> getT "MasterUsername" +    <*> getT "MasterUsername"  sinkPendingModifiedValues     :: MonadThrow m

@@ -1,7 +1,12 @@ name:                aws-sdk-version:             0.7.1.0+version:             0.8.0.0 synopsis:            AWS SDK for Haskell-description:         An AWS(Amazon Web Services) liblary for Haskell.+description: AWS (Amazon Web Services) sdk for Haskell.+             .+             This library closesly follows the official sdk.+             To find more documentation, you can lookup functions in the official sdk docs for other languages:+             <http://docs.amazonwebservices.com/AWSJavaSDK/latest/javadoc/com/amazonaws/services/ec2/model/DescribeInstancesRequest.html>+ license:             BSD3 license-file:        LICENSE author:              Yusuke Nomura <yunomu@gmail.com>