diff --git a/AWS/CloudWatch/Metric.hs b/AWS/CloudWatch/Metric.hs --- a/AWS/CloudWatch/Metric.hs +++ b/AWS/CloudWatch/Metric.hs @@ -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" diff --git a/AWS/EC2.hs b/AWS/EC2.hs --- a/AWS/EC2.hs +++ b/AWS/EC2.hs @@ -78,6 +78,6 @@ setEndpoint :: (MonadResource m, MonadBaseControl IO m) => ByteString -- ^ ec2 endpoint domain -> EC2 m () -setEndpoint endpoint = do +setEndpoint ep = do ctx <- State.get - State.put ctx { endpoint = endpoint } + State.put ctx { endpoint = ep } diff --git a/AWS/EC2/Acl.hs b/AWS/EC2/Acl.hs --- a/AWS/EC2/Acl.hs +++ b/AWS/EC2/Acl.hs @@ -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 diff --git a/AWS/EC2/Address.hs b/AWS/EC2/Address.hs --- a/AWS/EC2/Address.hs +++ b/AWS/EC2/Address.hs @@ -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] diff --git a/AWS/EC2/AvailabilityZone.hs b/AWS/EC2/AvailabilityZone.hs --- a/AWS/EC2/AvailabilityZone.hs +++ b/AWS/EC2/AvailabilityZone.hs @@ -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 diff --git a/AWS/EC2/Image.hs b/AWS/EC2/Image.hs --- a/AWS/EC2/Image.hs +++ b/AWS/EC2/Image.hs @@ -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 + ] diff --git a/AWS/EC2/Instance.hs b/AWS/EC2/Instance.hs --- a/AWS/EC2/Instance.hs +++ b/AWS/EC2/Instance.hs @@ -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 diff --git a/AWS/EC2/KeyPair.hs b/AWS/EC2/KeyPair.hs --- a/AWS/EC2/KeyPair.hs +++ b/AWS/EC2/KeyPair.hs @@ -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 ] diff --git a/AWS/EC2/NetworkInterface.hs b/AWS/EC2/NetworkInterface.hs --- a/AWS/EC2/NetworkInterface.hs +++ b/AWS/EC2/NetworkInterface.hs @@ -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" diff --git a/AWS/EC2/Params.hs b/AWS/EC2/Params.hs --- a/AWS/EC2/Params.hs +++ b/AWS/EC2/Params.hs @@ -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]) diff --git a/AWS/EC2/Query.hs b/AWS/EC2/Query.hs --- a/AWS/EC2/Query.hs +++ b/AWS/EC2/Query.hs @@ -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" diff --git a/AWS/EC2/Region.hs b/AWS/EC2/Region.hs --- a/AWS/EC2/Region.hs +++ b/AWS/EC2/Region.hs @@ -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 diff --git a/AWS/EC2/RouteTable.hs b/AWS/EC2/RouteTable.hs --- a/AWS/EC2/RouteTable.hs +++ b/AWS/EC2/RouteTable.hs @@ -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 ] diff --git a/AWS/EC2/SecurityGroup.hs b/AWS/EC2/SecurityGroup.hs --- a/AWS/EC2/SecurityGroup.hs +++ b/AWS/EC2/SecurityGroup.hs @@ -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 + ] diff --git a/AWS/EC2/Snapshot.hs b/AWS/EC2/Snapshot.hs --- a/AWS/EC2/Snapshot.hs +++ b/AWS/EC2/Snapshot.hs @@ -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" diff --git a/AWS/EC2/Subnets.hs b/AWS/EC2/Subnets.hs --- a/AWS/EC2/Subnets.hs +++ b/AWS/EC2/Subnets.hs @@ -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 diff --git a/AWS/EC2/Tag.hs b/AWS/EC2/Tag.hs --- a/AWS/EC2/Tag.hs +++ b/AWS/EC2/Tag.hs @@ -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 + ] diff --git a/AWS/EC2/Types.hs b/AWS/EC2/Types.hs --- a/AWS/EC2/Types.hs +++ b/AWS/EC2/Types.hs @@ -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 diff --git a/AWS/EC2/VPC.hs b/AWS/EC2/VPC.hs --- a/AWS/EC2/VPC.hs +++ b/AWS/EC2/VPC.hs @@ -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 + ] diff --git a/AWS/EC2/Volume.hs b/AWS/EC2/Volume.hs --- a/AWS/EC2/Volume.hs +++ b/AWS/EC2/Volume.hs @@ -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" diff --git a/AWS/ELB/LoadBalancer.hs b/AWS/ELB/LoadBalancer.hs --- a/AWS/ELB/LoadBalancer.hs +++ b/AWS/ELB/LoadBalancer.hs @@ -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] diff --git a/AWS/Lib/FromText.hs b/AWS/Lib/FromText.hs --- a/AWS/Lib/FromText.hs +++ b/AWS/Lib/FromText.hs @@ -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 diff --git a/AWS/Lib/Parser.hs b/AWS/Lib/Parser.hs --- a/AWS/Lib/Parser.hs +++ b/AWS/Lib/Parser.hs @@ -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 diff --git a/AWS/Lib/Query.hs b/AWS/Lib/Query.hs --- a/AWS/Lib/Query.hs +++ b/AWS/Lib/Query.hs @@ -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) diff --git a/AWS/RDS/DBInstance.hs b/AWS/RDS/DBInstance.hs --- a/AWS/RDS/DBInstance.hs +++ b/AWS/RDS/DBInstance.hs @@ -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 diff --git a/aws-sdk.cabal b/aws-sdk.cabal --- a/aws-sdk.cabal +++ b/aws-sdk.cabal @@ -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: + + license: BSD3 license-file: LICENSE author: Yusuke Nomura