aws-ec2 0.3.3 → 0.3.5

raw patch · 61 files changed

+989/−376 lines, 61 filesdep +blaze-markupdep +exceptionsdep +iproutedep ~aesondep ~awsdep ~aws-ec2new-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: blaze-markup, exceptions, iproute

Dependency ranges changed: aeson, aws, aws-ec2, base, base16-bytestring, base64-bytestring, blaze-builder, byteable, bytestring, conduit-extra, containers, cryptohash, http-conduit, http-types, mtl, optparse-applicative, resourcet, scientific, template-haskell, text, time, unordered-containers, vector, xml-conduit, yaml

API changes (from Hackage documentation)

Files

• aws-ec2.cabal +138/−146
• cmd/put-metric.hs +1/−0
• cmd/run-inst.hs +2/−1
• include/config.h +0/−70
• src/Aws/Canonical.hs +1/−0
• src/Aws/CloudWatch/Commands/PutMetricData.hs +2/−1
• src/Aws/CloudWatch/Core.hs +1/−1
• src/Aws/Ec2.hs +10/−0
• src/Aws/Ec2/Commands/AttachInternetGateway.hs +1/−1
• src/Aws/Ec2/Commands/AttachVolume.hs +1/−1
• src/Aws/Ec2/Commands/AuthorizeSecurityGroupIngress.hs +3/−28
• src/Aws/Ec2/Commands/CreateInternetGateway.hs +1/−1
• src/Aws/Ec2/Commands/CreatePlacementGroup.hs +28/−0
• src/Aws/Ec2/Commands/CreateRoute.hs +2/−1
• src/Aws/Ec2/Commands/CreateSecurityGroup.hs +18/−1
• src/Aws/Ec2/Commands/CreateSubnet.hs +1/−1
• src/Aws/Ec2/Commands/CreateTags.hs +15/−9
• src/Aws/Ec2/Commands/CreateVolume.hs +1/−1
• src/Aws/Ec2/Commands/CreateVpc.hs +1/−1
• src/Aws/Ec2/Commands/DescribeAvailabilityZones.hs +2/−1
• src/Aws/Ec2/Commands/DescribeImages.hs +2/−1
• src/Aws/Ec2/Commands/DescribeInstanceStatus.hs +2/−1
• src/Aws/Ec2/Commands/DescribeInstances.hs +9/−1
• src/Aws/Ec2/Commands/DescribeKeyPairs.hs +2/−1
• src/Aws/Ec2/Commands/DescribePlacementGroups.hs +14/−0
• src/Aws/Ec2/Commands/DescribeRegions.hs +4/−1
• src/Aws/Ec2/Commands/DescribeRouteTables.hs +2/−1
• src/Aws/Ec2/Commands/DescribeSecurityGroups.hs +12/−1
• src/Aws/Ec2/Commands/DescribeSubnets.hs +2/−1
• src/Aws/Ec2/Commands/DescribeTags.hs +23/−1
• src/Aws/Ec2/Commands/DescribeVolumeStatus.hs +2/−1
• src/Aws/Ec2/Commands/DescribeVolumes.hs +2/−1
• src/Aws/Ec2/Commands/DescribeVpcs.hs +2/−1
• src/Aws/Ec2/Commands/GetConsoleOutput.hs +14/−6
• src/Aws/Ec2/Commands/ImportKeyPair.hs +1/−1
• src/Aws/Ec2/Commands/ModifyInstanceAttribute.hs +30/−0
• src/Aws/Ec2/Commands/ModifyVpcAttribute.hs +1/−1
• src/Aws/Ec2/Commands/RevokeSecurityGroupIngress.hs +28/−0
• src/Aws/Ec2/Commands/RunInstances.hs +46/−3
• src/Aws/Ec2/Commands/StartInstances.hs +1/−1
• src/Aws/Ec2/Commands/StopInstances.hs +1/−1
• src/Aws/Ec2/Commands/TerminateInstances.hs +26/−2
• src/Aws/Ec2/TH.hs +2/−4
• src/Aws/Ec2/Types.hs +487/−52
• src/Aws/Elb/Commands/ConfigureHealthCheck.hs +1/−1
• src/Aws/Elb/Commands/CreateAppCookieStickinessPolicy.hs +1/−1
• src/Aws/Elb/Commands/CreateLBCookieStickinessPolicy.hs +1/−1
• src/Aws/Elb/Commands/CreateLoadBalancer.hs +1/−2
• src/Aws/Elb/Commands/DeregisterInstancesFromLoadBalancer.hs +1/−1
• src/Aws/Elb/Commands/DescribeInstanceHealth.hs +1/−1
• src/Aws/Elb/Commands/DescribeLoadBalancerPolicies.hs +1/−1
• src/Aws/Elb/Commands/DescribeLoadBalancerPolicyTypes.hs +1/−1
• src/Aws/Elb/Commands/DescribeLoadBalancers.hs +2/−1
• src/Aws/Elb/Commands/ModifyLoadBalancerAttributes.hs +1/−1
• src/Aws/Elb/Commands/RegisterInstancesWithLoadBalancer.hs +1/−1
• src/Aws/Elb/Commands/SetLoadBalancerPoliciesOfListener.hs +1/−1
• src/Aws/Elb/TH.hs +1/−5
• src/Aws/Elb/Types.hs +1/−0
• src/Aws/Query.hs +21/−3
• src/Aws/Query/TH.hs +2/−6
• src/Aws/TH.hs +7/−1

@@ -1,156 +1,148 @@-name:                aws-ec2-version:             0.3.3-synopsis:            AWS EC2/VPC, ELB and CloudWatch client library for Haskell-license-file:        LICENSE-license:             BSD3-author:              Vladimir Kirillov-maintainer:          vlad.ki@zalora.com-copyright:           See contributors list in README and LICENSE file-build-type:          Simple-cabal-version:       >=1.10-category:            Network, Web, AWS, Cloud, Distributed Computing-homepage:            https://github.com/zalora/aws-ec2-description:         AWS client library with focus on infrastructure services like EC2 (with VPC), ELB and CloudWatch, extension to <https://github.com/aristidb/aws>.--extra-source-files:  include/config.h+name: aws-ec2+version: 0.3.5+cabal-version: >=1.10+build-type: Simple+license: BSD3+license-file: LICENSE+copyright: See contributors list in README and LICENSE file+maintainer: MemCachier, Inc <code@memcachier.com>+homepage: https://github.com/memcachier/aws-ec2+synopsis: AWS EC2/VPC, ELB and CloudWatch client library for Haskell+description:+    AWS client library with focus on infrastructure services like EC2 (with VPC), ELB and CloudWatch, extension to <https://github.com/aristidb/aws>.+category: Network, Web, AWS, Cloud, Distributed Computing+author: Vladimir Kirillov; MemCachier, Inc  source-repository this-  type: git-  location: https://github.com/zalora/aws-ec2.git-  tag: 0.3.3+    type: git+    location: https://github.com/memcachier/aws-ec2.git+    tag: 0.3.5  source-repository head-  type: git-  location: https://github.com/zalora/aws-ec2.git+    type: git+    location: https://github.com/memcachier/aws-ec2.git  library-  exposed-modules:-      Aws.Canonical--    , Aws.Query-    , Aws.Query.TH-    , Aws.Query.Types-    , Aws.TH--    , Aws.CloudWatch-    , Aws.CloudWatch.Core-    , Aws.CloudWatch.Types-    , Aws.CloudWatch.Commands.PutMetricData--    , Aws.Ec2-    , Aws.Ec2.Core-    , Aws.Ec2.TH-    , Aws.Ec2.Types-    , Aws.Ec2.Commands.AttachInternetGateway-    , Aws.Ec2.Commands.AttachVolume-    , Aws.Ec2.Commands.AuthorizeSecurityGroupIngress-    , Aws.Ec2.Commands.CreateInternetGateway-    , Aws.Ec2.Commands.CreateRoute-    , Aws.Ec2.Commands.CreateSecurityGroup-    , Aws.Ec2.Commands.CreateSubnet-    , Aws.Ec2.Commands.CreateTags-    , Aws.Ec2.Commands.CreateVolume-    , Aws.Ec2.Commands.CreateVpc-    , Aws.Ec2.Commands.DescribeAvailabilityZones-    , Aws.Ec2.Commands.DescribeImages-    , Aws.Ec2.Commands.DescribeInstanceStatus-    , Aws.Ec2.Commands.DescribeInstances-    , Aws.Ec2.Commands.DescribeKeyPairs-    , Aws.Ec2.Commands.DescribeRegions-    , Aws.Ec2.Commands.DescribeRouteTables-    , Aws.Ec2.Commands.DescribeSecurityGroups-    , Aws.Ec2.Commands.DescribeSubnets-    , Aws.Ec2.Commands.DescribeTags-    , Aws.Ec2.Commands.DescribeVolumeStatus-    , Aws.Ec2.Commands.DescribeVolumes-    , Aws.Ec2.Commands.DescribeVpcs-    , Aws.Ec2.Commands.GetConsoleOutput-    , Aws.Ec2.Commands.ImportKeyPair-    , Aws.Ec2.Commands.ModifyVpcAttribute-    , Aws.Ec2.Commands.RunInstances-    , Aws.Ec2.Commands.StartInstances-    , Aws.Ec2.Commands.StopInstances-    , Aws.Ec2.Commands.TerminateInstances--    , Aws.Elb-    , Aws.Elb.Core-    , Aws.Elb.TH-    , Aws.Elb.Types-    , Aws.Elb.Commands.CreateLoadBalancer-    , Aws.Elb.Commands.DescribeInstanceHealth-    , Aws.Elb.Commands.DescribeLoadBalancerPolicies-    , Aws.Elb.Commands.DescribeLoadBalancerPolicyTypes-    , Aws.Elb.Commands.DescribeLoadBalancers-    , Aws.Elb.Commands.ModifyLoadBalancerAttributes-    , Aws.Elb.Commands.RegisterInstancesWithLoadBalancer-    , Aws.Elb.Commands.DeregisterInstancesFromLoadBalancer-    , Aws.Elb.Commands.CreateAppCookieStickinessPolicy-    , Aws.Elb.Commands.CreateLBCookieStickinessPolicy-    , Aws.Elb.Commands.SetLoadBalancerPoliciesOfListener-    , Aws.Elb.Commands.ConfigureHealthCheck--  build-depends:-      base >=4 && <5-    , template-haskell-    , containers-    , mtl-    , text-    , bytestring-    , base16-bytestring-    , base64-bytestring-    , blaze-builder-    , time--    , aeson-    , unordered-containers-    , vector-    , scientific--    , resourcet-    , byteable-    , cryptohash-    , http-types-    , http-conduit-    , conduit-extra-    , xml-conduit-    , aws >= 0.9.4--  hs-source-dirs:      src-  default-language:    Haskell2010-  default-extensions:  OverloadedStrings, TemplateHaskell, CPP-  ghc-options:         -optP --include=include/config.h+    exposed-modules:+        Aws.Canonical+        Aws.Query+        Aws.Query.TH+        Aws.Query.Types+        Aws.TH+        Aws.CloudWatch+        Aws.CloudWatch.Core+        Aws.CloudWatch.Types+        Aws.CloudWatch.Commands.PutMetricData+        Aws.Ec2+        Aws.Ec2.Core+        Aws.Ec2.TH+        Aws.Ec2.Types+        Aws.Ec2.Commands.AttachInternetGateway+        Aws.Ec2.Commands.AttachVolume+        Aws.Ec2.Commands.AuthorizeSecurityGroupIngress+        Aws.Ec2.Commands.CreateInternetGateway+        Aws.Ec2.Commands.CreatePlacementGroup+        Aws.Ec2.Commands.CreateRoute+        Aws.Ec2.Commands.CreateSecurityGroup+        Aws.Ec2.Commands.CreateSubnet+        Aws.Ec2.Commands.CreateTags+        Aws.Ec2.Commands.CreateVolume+        Aws.Ec2.Commands.CreateVpc+        Aws.Ec2.Commands.DescribeAvailabilityZones+        Aws.Ec2.Commands.DescribeImages+        Aws.Ec2.Commands.DescribeInstanceStatus+        Aws.Ec2.Commands.DescribeInstances+        Aws.Ec2.Commands.DescribeKeyPairs+        Aws.Ec2.Commands.DescribePlacementGroups+        Aws.Ec2.Commands.DescribeRegions+        Aws.Ec2.Commands.DescribeRouteTables+        Aws.Ec2.Commands.DescribeSecurityGroups+        Aws.Ec2.Commands.DescribeSubnets+        Aws.Ec2.Commands.DescribeTags+        Aws.Ec2.Commands.DescribeVolumeStatus+        Aws.Ec2.Commands.DescribeVolumes+        Aws.Ec2.Commands.DescribeVpcs+        Aws.Ec2.Commands.GetConsoleOutput+        Aws.Ec2.Commands.ImportKeyPair+        Aws.Ec2.Commands.ModifyInstanceAttribute+        Aws.Ec2.Commands.ModifyVpcAttribute+        Aws.Ec2.Commands.RevokeSecurityGroupIngress+        Aws.Ec2.Commands.RunInstances+        Aws.Ec2.Commands.StartInstances+        Aws.Ec2.Commands.StopInstances+        Aws.Ec2.Commands.TerminateInstances+        Aws.Elb+        Aws.Elb.Core+        Aws.Elb.TH+        Aws.Elb.Types+        Aws.Elb.Commands.CreateLoadBalancer+        Aws.Elb.Commands.DescribeInstanceHealth+        Aws.Elb.Commands.DescribeLoadBalancerPolicies+        Aws.Elb.Commands.DescribeLoadBalancerPolicyTypes+        Aws.Elb.Commands.DescribeLoadBalancers+        Aws.Elb.Commands.ModifyLoadBalancerAttributes+        Aws.Elb.Commands.RegisterInstancesWithLoadBalancer+        Aws.Elb.Commands.DeregisterInstancesFromLoadBalancer+        Aws.Elb.Commands.CreateAppCookieStickinessPolicy+        Aws.Elb.Commands.CreateLBCookieStickinessPolicy+        Aws.Elb.Commands.SetLoadBalancerPoliciesOfListener+        Aws.Elb.Commands.ConfigureHealthCheck+    build-depends:+        base                  >=4.7        &&  <5,+        template-haskell      >=2.9.0.0    &&  <2.12,+        containers            >=0.5.5.1    &&  <0.6,+        mtl                   >=2.1.3.1    &&  <2.3,+        text                  >=1.2.0.6    &&  <1.3,+        bytestring            >=0.10.4.0   &&  <0.11,+        base16-bytestring     >=0.1.1.6    &&  <0.2,+        base64-bytestring     >=1.0.0.1    &&  <1.1,+        blaze-builder         >=0.4.0.1    &&  <0.5,+        time                  >=1.4.2      &&  <1.7,+        aeson                 >=0.8.0.2    &&  <0.12,+        unordered-containers  >=0.2.5.1    &&  <0.3,+        vector                >=0.10.12.3  &&  <0.12,+        scientific            >=0.3.3.8    &&  <0.4,+        exceptions            >=0.8.0.2    &&  <0.9,+        resourcet             >=1.1.6      &&  <1.2,+        byteable              >=0.1.1      &&  <0.2,+        cryptohash            >=0.11.6     &&  <0.12,+        http-types            >=0.8.6      &&  <0.10,+        http-conduit          >=2.1.7.2    &&  <2.2,+        conduit-extra         >=1.1.9.1    &&  <1.2,+        blaze-markup          >=0.7.0.2    &&  <0.8,+        xml-conduit           >=1.2.6      &&  <1.4,+        iproute               >=1.3.2      &&  <1.8,+        aws                   >=0.9.4      &&  <0.15+    default-language: Haskell2010+    hs-source-dirs: src  executable put-metric-  main-is: put-metric.hs-  build-depends:-      base-    , bytestring-    , text-    , optparse-applicative-    , aws >= 0.9.4-    , aws-ec2--  hs-source-dirs:      cmd-  default-language:    Haskell2010-  default-extensions:  OverloadedStrings-  ghc-options:         -static+    main-is: put-metric.hs+    build-depends:+        base                  >=4.7.0.2    &&  <4.10,+        bytestring            >=0.10.4.0   &&  <0.11,+        text                  >=1.2.0.6    &&  <1.3,+        optparse-applicative  >=0.11.0.2   &&  <0.13,+        aws                   >=0.9.4      &&  <0.15,+        aws-ec2               >=0.3.4      &&  <0.4+    default-language: Haskell2010+    hs-source-dirs: cmd+    ghc-options: -static  executable run-inst-  main-is: run-inst.hs-  build-depends:-      base-    , bytestring-    , text-    , optparse-applicative-    , aws >= 0.9.4-    , aws-ec2-    , yaml-    , vector-    , containers-    , unordered-containers-    , aeson--  hs-source-dirs:      cmd-  default-language:    Haskell2010-  default-extensions:  OverloadedStrings-  ghc-options:         -static+    main-is: run-inst.hs+    build-depends:+        base                  >=4.7.0.2    &&  <4.10,+        bytestring            >=0.10.4.0   &&  <0.11,+        text                  >=1.2.0.6    &&  <1.3,+        optparse-applicative  >=0.11.0.2   &&  <0.13,+        aws                   >=0.9.4      &&  <0.15,+        aws-ec2               >=0.3.4      &&  <0.4,+        yaml                  >=0.8.12     &&  <0.9,+        vector                >=0.10.12.3  &&  <0.12,+        containers            >=0.5.5.1    &&  <0.6,+        unordered-containers  >=0.2.5.1    &&  <0.3,+        aeson                 >=0.8.0.2    &&  <0.12+    default-language: Haskell2010+    hs-source-dirs: cmd+    ghc-options: -static

@@ -3,6 +3,7 @@ module Main where  import Control.Monad+import Data.Monoid import Options.Applicative  import qualified Data.ByteString.Char8 as B

@@ -1,10 +1,10 @@ {-# LANGUAGE FlexibleContexts, TypeFamilies  #-}-{-# LANGUAGE OverlappingInstances  #-} {-# LANGUAGE ScopedTypeVariables #-}  module Main where  import Control.Monad+import Data.Monoid import Options.Applicative  import qualified Data.ByteString.Char8 as B@@ -55,6 +55,7 @@         Nothing         Nothing         publicIp+        Nothing     B.putStr $ Y.encode val     return () 

@@ -1,70 +0,0 @@-#if __GLASGOW_HASKELL__ >= 780-#define USE_TH 1-#else-#undef USE_TH-#endif--#ifdef USE_TH-#define QUERYVALUETRANSACTION(Name,Response) queryValueTransaction ''Name Response-#define EC2VALUETRANSACTIONDEF(Name,NameStr,Tag,FilterKey) ec2ValueTransactionDef ''Name 'Name Tag FilterKey -#define EC2VALUETRANSACTION(Name,Response) ec2ValueTransaction ''Name Response-#define ELBVALUETRANSACTIONDEF(Name,NameStr,Tag,FilterKey) elbValueTransactionDef ''Name 'Name Tag FilterKey -#define ELBVALUETRANSACTION(Name,Response) elbValueTransaction ''Name Response--#else-#define QUERYVALUETRANSACTION(Name,Response) \-instance ResponseConsumer Name Value where { \-  type ResponseMetadata Value = QueryMetadata; \-  responseConsumer _v \-    = (queryResponseConsumer \-       $ (valueConsumer Response id)) }; \-instance Transaction Name Value--#define EC2VALUETRANSACTIONDEF(Name,NameStr,Tag,FilterKey) \-instance SignQuery Name where { \-  type ServiceConfiguration Name = QueryAPIConfiguration; \-  signQuery (Name arg_arQu) \-    = (ec2SignQuery \-       $ ([("Action", qArg NameStr), defVersion] \-          +++ (enumerate FilterKey arg_arQu qArg))) }; \-instance ResponseConsumer Name Value where { \-  type ResponseMetadata Value = QueryMetadata ; \-  responseConsumer _v \-    = (queryResponseConsumer \-       $ (valueConsumerOpt \-            (XMLValueOptions "item") Tag id)) } ;\-instance Transaction Name Value--#define EC2VALUETRANSACTION(Name,Response) \-instance ResponseConsumer Name Value where { \-  type ResponseMetadata Value = QueryMetadata ; \-  responseConsumer _v \-    = (queryResponseConsumer \-       $ (valueConsumer (Response) id)) } ; \-instance Transaction Name Value--#define ELBVALUETRANSACTIONDEF(Name,NameStr,Tag,FilterKey) \-instance SignQuery Name where { \-  type ServiceConfiguration Name = QueryAPIConfiguration ; \-  signQuery (Name arg_aHEZ) \-    = (elbSignQuery \-       $ ([("Action", qArg NameStr), defVersion] \-          +++ (enumerate FilterKey arg_aHEZ qArg))) }; \-instance ResponseConsumer Name Value where { \-  type ResponseMetadata Value = QueryMetadata ; \-  responseConsumer _ \-    = (queryResponseConsumer \-       $ (valueConsumerOpt \-            (XMLValueOptions "member") Tag id)) }; \-instance Transaction Name Value--#define ELBVALUETRANSACTION(Name,Response) \-instance ResponseConsumer Name Value where { \-  type ResponseMetadata Value = QueryMetadata ; \-  responseConsumer _v \-    = (queryResponseConsumer \-       $ (valueConsumerOpt \-            (XMLValueOptions "member") Response id)) }; \-instance Transaction Name Value--#endif

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Aws.Canonical where  import Data.IORef

@@ -4,6 +4,7 @@            , OverloadedStrings            , RecordWildCards            , TemplateHaskell+           , OverloadedStrings            #-}  module Aws.CloudWatch.Commands.PutMetricData where@@ -67,4 +68,4 @@                                                            , ("Namespace", qArg namespace)                                                            ] +++ enumerateMetrics xs -QUERYVALUETRANSACTION(PutMetricData,"PutMetricDataResponse")+queryValueTransaction ''PutMetricData "PutMetricDataResponse"

@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}  module Aws.CloudWatch.Core (   module Network.HTTP.Types

@@ -11,6 +11,7 @@ , module Aws.Ec2.Commands.DescribeSecurityGroups , module Aws.Ec2.Commands.CreateSecurityGroup , module Aws.Ec2.Commands.AuthorizeSecurityGroupIngress+, module Aws.Ec2.Commands.RevokeSecurityGroupIngress  , module Aws.Ec2.Commands.CreateTags , module Aws.Ec2.Commands.DescribeTags@@ -24,6 +25,7 @@ , module Aws.Ec2.Commands.StopInstances , module Aws.Ec2.Commands.TerminateInstances , module Aws.Ec2.Commands.GetConsoleOutput+, module Aws.Ec2.Commands.ModifyInstanceAttribute  , module Aws.Ec2.Commands.DescribeVpcs , module Aws.Ec2.Commands.CreateVpc@@ -40,6 +42,9 @@ , module Aws.Ec2.Commands.DescribeVolumeStatus , module Aws.Ec2.Commands.CreateVolume , module Aws.Ec2.Commands.AttachVolume++, module Aws.Ec2.Commands.DescribePlacementGroups+, module Aws.Ec2.Commands.CreatePlacementGroup ) where  import Aws.Core (Transaction)@@ -54,6 +59,7 @@ import Aws.Ec2.Commands.DescribeSecurityGroups import Aws.Ec2.Commands.CreateSecurityGroup import Aws.Ec2.Commands.AuthorizeSecurityGroupIngress+import Aws.Ec2.Commands.RevokeSecurityGroupIngress  import Aws.Ec2.Commands.CreateTags import Aws.Ec2.Commands.DescribeTags@@ -67,6 +73,7 @@ import Aws.Ec2.Commands.StopInstances import Aws.Ec2.Commands.TerminateInstances import Aws.Ec2.Commands.GetConsoleOutput+import Aws.Ec2.Commands.ModifyInstanceAttribute  import Aws.Ec2.Commands.DescribeVpcs import Aws.Ec2.Commands.CreateVpc@@ -83,3 +90,6 @@ import Aws.Ec2.Commands.DescribeVolumeStatus import Aws.Ec2.Commands.CreateVolume import Aws.Ec2.Commands.AttachVolume++import Aws.Ec2.Commands.DescribePlacementGroups+import Aws.Ec2.Commands.CreatePlacementGroup

@@ -25,4 +25,4 @@                                            , defVersion                                            ] -EC2VALUETRANSACTION(AttachInternetGateway,"return")+ec2ValueTransaction ''AttachInternetGateway "return"

@@ -27,4 +27,4 @@                                               , ("Device", qArg avol_device)                                               ] -EC2VALUETRANSACTION(AttachVolume,"AttachVolumeResponse")+ec2ValueTransaction ''AttachVolume "AttachVolumeResponse"

@@ -8,40 +8,15 @@  module Aws.Ec2.Commands.AuthorizeSecurityGroupIngress where -import qualified Network.HTTP.Types as HTTP-import Data.Monoid (mconcat) import Data.Text (Text)-import Data.ByteString.Char8 (pack, ByteString) import Aws.Ec2.TH--data IpProtocol = TCP | UDP | ICMP | Proto Int | All--instance Show IpProtocol where-    show TCP = "tcp" -- 6-    show UDP = "udp" -- 17-    show ICMP = "icmp" -- 1-    show (Proto i) = show i-    show All = "-1"--type CidrIp = Text--data IpPermission = IpPermission IpProtocol (Maybe Int) (Maybe Int) [CidrIp]-                deriving (Show)+import Aws.Ec2.Types  data AuthorizeSecurityGroupIngress = AuthorizeSecurityGroupIngress                { asi_groupId :: Text-               , asi_permissions :: [IpPermission]+               , asi_permissions :: [SgPermission]                } deriving (Show) -enumeratePermissions :: [IpPermission] -> HTTP.Query-enumeratePermissions = enumerateLists "IpPermissions." . fmap unroll-  where-    unroll (IpPermission proto from to ips) = [ ("IpProtocol", qShow proto)-                                              , ("FromPort", qShow $ maybe (-1) id from)-                                              , ("ToPort", qShow $ maybe (-1) id to)-                                              ] +++ [(mconcat [k, ".CidrIp"], v)| (k, v) <- enumerate "IpRanges" ips qArg]-- instance SignQuery AuthorizeSecurityGroupIngress where     type ServiceConfiguration AuthorizeSecurityGroupIngress = EC2Configuration     signQuery AuthorizeSecurityGroupIngress{..} = ec2SignQuery $@@ -50,4 +25,4 @@                                            , defVersion                                            ] +++ enumeratePermissions asi_permissions -EC2VALUETRANSACTION(AuthorizeSecurityGroupIngress,"AuthorizeSecurityGroupIngressResponse")+ec2ValueTransaction ''AuthorizeSecurityGroupIngress "AuthorizeSecurityGroupIngressResponse"

@@ -20,4 +20,4 @@                                            , defVersion                                            ] -EC2VALUETRANSACTION(CreateInternetGateway,"internetGateway")+ec2ValueTransaction ''CreateInternetGateway "internetGateway"

@@ -0,0 +1,28 @@+{-# LANGUAGE TypeFamilies+           , MultiParamTypeClasses+           , FlexibleInstances+           , OverloadedStrings+           , RecordWildCards+           , TemplateHaskell+           #-}++module Aws.Ec2.Commands.CreatePlacementGroup where++import Aws.Ec2.TH++data CreatePlacementGroup = CreatePlacementGroup+               { cpg_name :: Text+               -- currently strategy must be "cluster"+               --, cpg_strategy :: Text+               } deriving (Show)++instance SignQuery CreatePlacementGroup where+    type ServiceConfiguration CreatePlacementGroup = EC2Configuration+    signQuery CreatePlacementGroup{..} = ec2SignQuery $+                                           [ ("GroupName", qArg cpg_name)+                                           , ("Strategy", qArg "cluster")+                                           , ("Action", qArg "CreatePlacementGroup")+                                           , defVersion+                                           ]++ec2ValueTransaction ''CreatePlacementGroup "return"

@@ -2,6 +2,7 @@            , MultiParamTypeClasses            , TemplateHaskell            , RecordWildCards+           , OverloadedStrings            #-}  -- | Optimized to lookup a default route table for VPC.@@ -35,4 +36,4 @@                                                    NetworkInterfaceId t -> [("NetworkInterfaceId", qArg t)]                                                    VpcPeeringConnectionId t -> [("VpcPeeringConnectionId", qArg t)] -EC2VALUETRANSACTION(CreateRoute,"return")+ec2ValueTransaction ''CreateRoute "return"

@@ -8,6 +8,9 @@  module Aws.Ec2.Commands.CreateSecurityGroup where +import Data.Aeson (Value (..), FromJSON, (.:), parseJSON)+import Data.Aeson.Types (typeMismatch)+ import Aws.Ec2.TH  data CreateSecurityGroup = CreateSecurityGroup@@ -25,4 +28,18 @@                                            , defVersion                                            ] +++ optionalA "VpcId" csec_vpcId -EC2VALUETRANSACTION(CreateSecurityGroup,"CreateSecurityGroupResponse")+ec2ValueTransaction ''CreateSecurityGroup "CreateSecurityGroupResponse"++data CreateSecurityGroupResponse =+  CreateSecurityGroupResponse+  { csgrRequestId :: Text+  , csgrReturn :: Text+  , csgrGroupId :: Text }+  deriving Show++instance FromJSON CreateSecurityGroupResponse where+  parseJSON (Object v) = CreateSecurityGroupResponse <$>+    v .: "requestId" <*>+    v .: "return" <*>+    v .: "groupId"+  parseJSON invalid = typeMismatch "CreateSecurityGroupResponse" invalid

@@ -26,4 +26,4 @@                                               , ("CidrBlock", qArg csub_cidrBlock)                                               ] +++ (optionalA "AvailabilityZone" csub_availabilityZone) -EC2VALUETRANSACTION(CreateSubnet,"subnet")+ec2ValueTransaction ''CreateSubnet "subnet"

@@ -8,22 +8,22 @@  module Aws.Ec2.Commands.CreateTags where +import Data.Aeson (Value (..), FromJSON, parseJSON)+ import Aws.Ec2.TH import qualified Network.HTTP.Types as HTTP -type Tag = (Text, Text)- data CreateTags = CreateTags-               { ct_resources :: [Text]-               , ct_tags :: [Tag]-               } deriving (Show)+                  { ct_resources :: [Text]+                  , ct_tags :: [Tag]+                  } deriving (Show)  enumerateTags :: [Tag] -> HTTP.Query enumerateTags = enumerateLists "Tag." . fmap unroll   where-    unroll (key, value) = [ ("Key", qArg key)-                          , ("Value", qArg value)-                          ]+    unroll (Tag key value) = [ ("Key", qArg key)+                             , ("Value", qArg value)+                             ]  instance SignQuery CreateTags where     type ServiceConfiguration CreateTags = EC2Configuration@@ -33,4 +33,10 @@                                            ] +++ enumerate "ResourceId" ct_resources qArg                                              +++ enumerateTags ct_tags -EC2VALUETRANSACTION(CreateTags,"return")+ec2ValueTransaction ''CreateTags "return"++newtype CreateTagsResponse = CreateTagsResponse {ctrReturn :: Bool} deriving (Show)++instance FromJSON CreateTagsResponse where+  parseJSON v = CreateTagsResponse <$>+    (readBool <$> parseJSON v)

@@ -24,4 +24,4 @@                                                 , ("AvailabilityZone", qArg cvol_AvailabilityZone)                                                 ] ++ queryEbsBlockDevice cvol_ebs -EC2VALUETRANSACTION(CreateVolume,"CreateVolumeResponse")+ec2ValueTransaction ''CreateVolume "CreateVolumeResponse"

@@ -24,4 +24,4 @@                                            , defVersion                                            ] -EC2VALUETRANSACTION(CreateVpc,"vpc")+ec2ValueTransaction ''CreateVpc "vpc"

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell            , MultiParamTypeClasses            , TypeFamilies+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeAvailabilityZones where@@ -10,4 +11,4 @@ data DescribeAvailabilityZones = DescribeAvailabilityZones [Text]                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeAvailabilityZones,"DescribeAvailabilityZones","availabilityZoneInfo","ZoneName")+ec2ValueTransactionDef ''DescribeAvailabilityZones 'DescribeAvailabilityZones "availabilityZoneInfo" "ZoneName"

@@ -2,6 +2,7 @@            , MultiParamTypeClasses            , TypeFamilies            , RecordWildCards+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeImages where@@ -20,4 +21,4 @@                                                         [] -> [("Owner.1", qArg "self")]                                                         _ -> enumerate "ImageId" di_imageIds qArg -EC2VALUETRANSACTION(DescribeImages,"imagesSet")+ec2ValueTransaction ''DescribeImages "imagesSet"

@@ -4,6 +4,7 @@            , OverloadedStrings            , TemplateHaskell            , RecordWildCards+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeInstanceStatus where@@ -13,4 +14,4 @@ data DescribeInstanceStatus = DescribeInstanceStatus { dis_instanceIds :: [Text] }                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeInstanceStatus,"DescribeInstanceStatus","instanceStatusSet","InstanceId")+ec2ValueTransactionDef ''DescribeInstanceStatus 'DescribeInstanceStatus "instanceStatusSet" "InstanceId"

@@ -8,6 +8,8 @@  module Aws.Ec2.Commands.DescribeInstances where +import Data.Aeson (Value (..), FromJSON, parseJSON)+ import Aws.Ec2.TH  data DescribeInstances = DescribeInstances { di_instanceIds :: [Text] }@@ -20,5 +22,11 @@                                                 , defVersion                                                 ] +++ enumerate "InstanceId" di_instanceIds qArg -EC2VALUETRANSACTION(DescribeInstances,"reservationSet")+ec2ValueTransaction ''DescribeInstances "reservationSet" +newtype DescribeInstancesResponse =+  DescribeInstancesResponse {dirReservations :: [Reservation]} deriving (Show)++instance FromJSON DescribeInstancesResponse where+  parseJSON v = DescribeInstancesResponse <$>+    (maybeToList <$> parseJSON v)

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell            , MultiParamTypeClasses            , TypeFamilies+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeKeyPairs where@@ -10,4 +11,4 @@ data DescribeKeyPairs = DescribeKeyPairs [Text]                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeKeyPairs,"DescribeKeyPairs","keySet","KeyName")+ec2ValueTransactionDef ''DescribeKeyPairs 'DescribeKeyPairs "keySet" "KeyName"

@@ -0,0 +1,14 @@+{-# LANGUAGE TemplateHaskell+           , MultiParamTypeClasses+           , TypeFamilies+           , OverloadedStrings+           #-}++module Aws.Ec2.Commands.DescribePlacementGroups where++import Aws.Ec2.TH++data DescribePlacementGroups = DescribePlacementGroups [Text]+                       deriving (Show)++ec2ValueTransactionDef ''DescribePlacementGroups 'DescribePlacementGroups "placementGroupSet" "GroupName"

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell            , MultiParamTypeClasses            , TypeFamilies+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeRegions where@@ -10,4 +11,6 @@ data DescribeRegions = DescribeRegions [Text]                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeRegions,"DescribeRegions","regionInfo","RegionName")+ec2ValueTransactionDef ''DescribeRegions 'DescribeRegions "regionInfo" "RegionName"++type DescribeRegionsResponse = [Region]

@@ -2,6 +2,7 @@            , MultiParamTypeClasses            , TemplateHaskell            , RecordWildCards+           , OverloadedStrings            #-}  -- | Optimized to lookup a default route table for VPC.@@ -22,4 +23,4 @@                                            , ("Filter.1.Value.1", qArg drt_vpcId)                                            ] -EC2VALUETRANSACTION(DescribeRouteTables,"routeTableSet")+ec2ValueTransaction ''DescribeRouteTables "routeTableSet"

@@ -2,10 +2,14 @@            , MultiParamTypeClasses            , TypeFamilies            , RecordWildCards+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeSecurityGroups where +import Data.Aeson (Value (..), FromJSON, (.:), parseJSON)+import Data.Aeson.Types (typeMismatch)+ import Aws.Ec2.TH  type SecurityGroupId = Text@@ -27,4 +31,11 @@                                                         [] -> []                                                         _ -> ("Filter.1.Name", qArg "group-name"):(enumerate "Filter.1.Value" sg_names qArg) -EC2VALUETRANSACTION(DescribeSecurityGroups,"securityGroupInfo")+ec2ValueTransaction ''DescribeSecurityGroups "securityGroupInfo"++newtype DescribeSecurityGroupsResponse =+  DescribeSecurityGroupsResponse {dsgrGroups :: [Group]} deriving (Show)++instance FromJSON DescribeSecurityGroupsResponse where+  parseJSON v = DescribeSecurityGroupsResponse <$>+    (maybeToList <$> parseJSON v)

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell            , MultiParamTypeClasses            , TypeFamilies+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeSubnets where@@ -10,4 +11,4 @@ data DescribeSubnets = DescribeSubnets [Text]                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeSubnets,"DescribeSubnets","subnetSet","SubnetId")+ec2ValueTransactionDef ''DescribeSubnets 'DescribeSubnets "subnetSet" "SubnetId"

@@ -1,13 +1,35 @@ {-# LANGUAGE TemplateHaskell            , MultiParamTypeClasses            , TypeFamilies+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeTags where +import Data.Aeson (Value (..), FromJSON, (.:), parseJSON)+import Data.Aeson.Types (typeMismatch)+ import Aws.Ec2.TH  data DescribeTags = DescribeTags [Text]                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeTags,"DescribeTags","tagSet","") -- search not implemented+ec2ValueTransactionDef ''DescribeTags 'DescribeTags "tagSet" "" -- search not implemented++type DescribeTagsResponse = [TagDescription]++-- | Data structure returned from EC2 DescribeTags command.+data TagDescription = TagDescription+                      { tdResourceId :: Text+                      , tdResourceType :: Text+                      , tdKey :: Text+                      , tdValue :: Text }+                    deriving Show++instance FromJSON TagDescription where+  parseJSON (Object v) = TagDescription <$>+    v .: "resourceId" <*>+    v .: "resourceType" <*>+    v .: "key" <*>+    v .: "value"+  parseJSON invalid = typeMismatch "TagDescription" invalid

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell            , MultiParamTypeClasses            , TypeFamilies+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeVolumeStatus where@@ -10,4 +11,4 @@ data DescribeVolumeStatus = DescribeVolumeStatus [Text]                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeVolumeStatus,"DescribeVolumeStatus","volumeStatusSet","VolumeId")+ec2ValueTransactionDef ''DescribeVolumeStatus 'DescribeVolumeStatus "volumeStatusSet" "VolumeId"

@@ -1,6 +1,7 @@ {-# LANGUAGE TemplateHaskell            , MultiParamTypeClasses            , TypeFamilies+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeVolumes where@@ -10,4 +11,4 @@ data DescribeVolumes = DescribeVolumes [Text]                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeVolumes,"DescribeVolumes","volumeSet","VolumeId")+ec2ValueTransactionDef ''DescribeVolumes 'DescribeVolumes "volumeSet" "VolumeId"

@@ -1,6 +1,7 @@ {-# LANGUAGE TypeFamilies            , MultiParamTypeClasses            , TemplateHaskell+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.DescribeVpcs where@@ -10,4 +11,4 @@ data DescribeVpcs = DescribeVpcs { dvpc_vpcIds :: [Text] }                        deriving (Show) -EC2VALUETRANSACTIONDEF(DescribeVpcs,"DescribeVpcs","vpcSet","VpcId")+ec2ValueTransactionDef ''DescribeVpcs 'DescribeVpcs "vpcSet" "VpcId"

@@ -3,10 +3,13 @@            , TypeFamilies            , RecordWildCards            , DeriveGeneric+           , OverloadedStrings            #-}  module Aws.Ec2.Commands.GetConsoleOutput where +import Data.Aeson (Value(..), FromJSON, (.:), parseJSON)+ import Aws.Ec2.TH import GHC.Generics @@ -14,13 +17,18 @@                        deriving (Show)  data ConsoleOutput = ConsoleOutput-                   { requestId :: Text-                   , instanceId :: Text-                   , timestamp :: UTCTime-                   , output :: Text+                   { coRequestId :: Text+                   , coInstanceId :: Text+                   , coTimestamp :: UTCTime+                   , coOutput :: Text                    } deriving (Generic, Show) -instance FromJSON ConsoleOutput+instance FromJSON ConsoleOutput where+  parseJSON (Object v) = ConsoleOutput <$>+    v .: "requestId" <*>+    v .: "instanceId" <*>+    v .: "timestamp" <*>+    v .: "output"  instance SignQuery GetConsoleOutput where     type ServiceConfiguration GetConsoleOutput = EC2Configuration@@ -29,4 +37,4 @@                                                   , ("InstanceId", qArg gco_instanceId)                                                   ] -EC2VALUETRANSACTION(GetConsoleOutput,"GetConsoleOutputResponse")+ec2ValueTransaction ''GetConsoleOutput "GetConsoleOutputResponse"

@@ -25,4 +25,4 @@                                            , ("PublicKeyMaterial", qArg ikp_publicKeyMaterial)                                            ] -EC2VALUETRANSACTION(ImportKeyPair,"ImportKeyPairResponse")+ec2ValueTransaction ''ImportKeyPair "ImportKeyPairResponse"

@@ -0,0 +1,30 @@+{-# LANGUAGE TypeFamilies+           , MultiParamTypeClasses+           , FlexibleInstances+           , OverloadedStrings+           , RecordWildCards+           , TemplateHaskell+           #-}++module Aws.Ec2.Commands.ModifyInstanceAttribute where++import Aws.Ec2.TH++data InstanceAttribute = DisableApiTermination Bool+                  deriving (Show)++data ModifyInstanceAttribute = ModifyInstanceAttribute+               { mia_InstanceId :: Text+               , mia_attribute :: InstanceAttribute+               } deriving (Show)++instance SignQuery ModifyInstanceAttribute where+    type ServiceConfiguration ModifyInstanceAttribute = EC2Configuration+    signQuery ModifyInstanceAttribute{..} = ec2SignQuery $+                                           [ ("InstanceId", qArg mia_InstanceId)+                                           , ("Action", qArg "ModifyInstanceAttribute")+                                           , defVersion+                                           ] +++ case mia_attribute of+                                                   DisableApiTermination dat -> [("DisableApiTermination.Value", qShow dat)]++ec2ValueTransaction ''ModifyInstanceAttribute "return"

@@ -28,4 +28,4 @@                                                    EnableDnsSupport es -> [("EnableDnsSupport.Value", qShow es)]                                                    EnableDnsHostnames eh -> [("EnableDnsHostnames.Value", qShow eh)] -EC2VALUETRANSACTION(ModifyVpcAttribute,"return")+ec2ValueTransaction ''ModifyVpcAttribute "return"

@@ -0,0 +1,28 @@+{-# LANGUAGE TypeFamilies+           , MultiParamTypeClasses+           , FlexibleInstances+           , OverloadedStrings+           , RecordWildCards+           , TemplateHaskell+           #-}++module Aws.Ec2.Commands.RevokeSecurityGroupIngress where++import Data.Text (Text)+import Aws.Ec2.TH+import Aws.Ec2.Types++data RevokeSecurityGroupIngress = RevokeSecurityGroupIngress+               { rsi_groupId :: Text+               , rsi_permissions :: [SgPermission]+               } deriving (Show)++instance SignQuery RevokeSecurityGroupIngress where+    type ServiceConfiguration RevokeSecurityGroupIngress = EC2Configuration+    signQuery RevokeSecurityGroupIngress{..} = ec2SignQuery $+                                           [ ("GroupId", qArg rsi_groupId)+                                           , ("Action", qArg "RevokeSecurityGroupIngress")+                                           , defVersion+                                           ] +++ enumeratePermissions rsi_permissions++ec2ValueTransaction ''RevokeSecurityGroupIngress "RevokeSecurityGroupIngressResponse"

@@ -39,7 +39,7 @@                   , run_iamInstanceProfileARN :: Maybe Text                   , run_availabilityZone :: Maybe Text                   , run_associatePublicIpAddress :: Bool-                  -- , run_placement :: Maybe Placement+                  , run_placementGroup :: Maybe Text                   -- also missing: NetworkInterface                   } deriving (Show) @@ -49,13 +49,54 @@     show Stop = "stop"     show Terminate = "terminate" +-- http://docs.aws.amazon.com/AWSEC2/latest/APIReference/ApiReference-query-RunInstances.html+instanceTypes :: [Text]+instanceTypes = [ "t2.micro"+                , "t2.small"+                , "t2.medium"+                , "m3.medium"+                , "m3.large"+                , "m3.xlarge"+                , "m3.2xlarge"+                , "m1.small" -- default+                , "m1.medium"+                , "m1.large"+                , "m1.xlarge"+                , "c3.large"+                , "c3.xlarge"+                , "c3.2xlarge"+                , "c3.4xlarge"+                , "c3.8xlarge"+                , "c1.medium"+                , "c1.xlarge"+                , "cc2.8xlarge"+                , "r3.large"+                , "r3.xlarge"+                , "r3.2xlarge"+                , "r3.4xlarge"+                , "r3.8xlarge"+                , "m2.xlarge"+                , "m2.2xlarge"+                , "m2.4xlarge"+                , "cr1.8xlarge"+                , "i2.xlarge"+                , "i2.2xlarge"+                , "i2.4xlarge"+                , "i2.8xlarge"+                , "hs1.8xlarge"+                , "hi1.4xlarge"+                , "t1.micro"+                , "g2.2xlarge"+                , "cg1.4xlarge"+                ]+ enumerateBlockDevices :: [BlockDeviceMapping] -> HTTP.Query enumerateBlockDevices = enumerateLists "BlockDeviceMapping." . fmap unroll   where     unroll BlockDeviceMapping{..} = [ ("DeviceName", qArg bdm_deviceName)                                     ] +++ case bdm_device of                                             Ephemeral{..} -> [("VirtualName", qArg bdm_virtualName)]-                                            EBS ebs -> queryEbsBlockDevice ebs                                            +                                            EBS ebs -> queryEbsBlockDevice ebs  instance SignQuery RunInstances where     type ServiceConfiguration RunInstances = EC2Configuration@@ -67,6 +108,7 @@                                   +++ (optionalA "RamdiskId" run_ramdiskId)                                   +++ (optionalA "ClientToken" run_clientToken)                                   +++ (optionalA "Placement.AvailabilityZone" run_availabilityZone)+                                  +++ (optionalA "Placement.GroupName" run_placementGroup)                                   +++ enumerateBlockDevices run_blockDeviceMappings         where           main :: HTTP.Query@@ -88,5 +130,6 @@                                           , ("NetworkInterface.0.AssociatePublicIpAddress", qShow run_associatePublicIpAddress)                                           ] +++ enumerate "NetworkInterface.0.SecurityGroupId" run_securityGroupIds qArg -EC2VALUETRANSACTION(RunInstances,"RunInstancesResponse")+ec2ValueTransaction ''RunInstances "RunInstancesResponse" +type RunInstancesResponse = Reservation

@@ -34,4 +34,4 @@           enumerateInstances [] = []           enumerateInstances ((i,x):xs) = [("InstanceId." <> pack (show i), qArg x)] +++ enumerateInstances xs -EC2VALUETRANSACTION(StartInstances,"StartInstancesResponse")+ec2ValueTransaction ''StartInstances "StartInstancesResponse"

@@ -35,4 +35,4 @@           enumerateInstances ((i,x):xs) = [("InstanceId." <> pack (show i), qArg x)] +++ enumerateInstances xs  -EC2VALUETRANSACTION(StopInstances,"StopInstancesResponse")+ec2ValueTransaction ''StopInstances "StopInstancesResponse"

@@ -9,7 +9,9 @@  module Aws.Ec2.Commands.TerminateInstances where -import Data.Text ()+import Data.Aeson (Value (..), FromJSON, (.:), parseJSON)+import Data.Aeson.Types (typeMismatch)+import Data.Text (Text) import Data.ByteString.Char8 (pack) import qualified Network.HTTP.Types as HTTP import Data.Monoid@@ -35,4 +37,26 @@           enumerateInstances ((i,x):xs) = [("InstanceId." <> pack (show i), qArg x)] +++ enumerateInstances xs  -EC2VALUETRANSACTION(TerminateInstances,"TerminateInstancesResponse")+ec2ValueTransaction ''TerminateInstances "TerminateInstancesResponse"++data TerminateInstancesResponse =+  TerminateInstancesResponse { tirRequestId :: Text+                             , tirInstancesSet :: [InstanceStateChange]}++instance FromJSON TerminateInstancesResponse where+  parseJSON (Object v) = TerminateInstancesResponse <$>+    v .: "requestId" <*>+    v .: "instancesSet"+  parseJSON invalid = typeMismatch "TerminateInstancesResponse" invalid++data InstanceStateChange =+  InstanceStateChange { iscInstanceId    :: Text+                      , iscCurrentState  :: InstanceState+                      , iscPreviousState :: InstanceState}++instance FromJSON InstanceStateChange where+  parseJSON (Object v) = InstanceStateChange <$>+    v .: "instanceId" <*>+    v .: "currentState" <*>+    v .: "previousState"+  parseJSON invalid = typeMismatch "InstanceStateChange" invalid

@@ -10,15 +10,15 @@ , module Aws.Query , module Aws.Ec2.Core , module Aws.Ec2.Types+, module Control.Applicative , Text , UTCTime , FromJSON-#ifdef USE_TH , ec2ValueTransactionDef , ec2ValueTransaction-#endif ) where +import Control.Applicative hiding (optional) import Data.Text (Text) import Data.Aeson.Types (FromJSON(..)) import Data.Time.Clock (UTCTime)@@ -29,8 +29,6 @@ import Aws.Query import Aws.Query.TH -#ifdef USE_TH ec2ValueTransactionDef ty cons tag filterKey = queryValueTransactionDef ty cons tag 'ec2SignQuery 'defVersion "item" filterKey  ec2ValueTransaction = queryValueTransaction-#endif

@@ -2,13 +2,36 @@            , FlexibleInstances            , RecordWildCards            , LambdaCase+           , OverloadedStrings            #-} +-- | This module implements a number of response types for the aws-ec2+-- library. All commands from the library are written to return a JSON+-- 'Value', but we provide more specific types for some responses+-- where possible. Implementing and especially testing response types+-- is a cumbersome job because the AWS documentation is not accurate+-- and response types might be missing in various ways (absent, there+-- but empty, sometimes there). Although the ideal would be to be+-- feature complete, a lot of trial and error is needed to get the+-- response types right so we've not yet done this.+--+-- However, it's useful to have more specific return types in common+-- cases, even without full coverage.  Since decoding of return values+-- is type-driven, if you need more specific response decoding or+-- coverage of features not implemented here, just define a new+-- response type and use that. module Aws.Ec2.Types where +import Control.Applicative+import Data.Aeson (Value (..), FromJSON, (.:), (.:?), (.!=), parseJSON)+import Data.Aeson.Types (typeMismatch)+import Data.Char (toUpper, toLower)+import Data.IP (IPv4)+import Data.Maybe (fromMaybe) import Data.Text (Text)+import qualified Data.Text as T import Data.Time.Clock (UTCTime)-import Data.Monoid+import Data.Monoid hiding (All) import Data.ByteString.Char8 (ByteString, pack)  import Network.HTTP.Types as HTTP@@ -16,18 +39,8 @@ import Aws.Query import Aws.Ec2.Core -data InstanceTenancy = Default | Dedicated -instance Show InstanceTenancy where-    show Default = "default"-    show Dedicated = "dedicated"--data VolumeType = Standard | GP2SSD | IOPSSD Int--instance Show VolumeType where-    show Standard = "standard"-    show GP2SSD = "gp2"-    show (IOPSSD _) = "io1"+-- EC2 Data Types  data BlockDeviceMapping = BlockDeviceMapping                                 { bdm_deviceName :: Text@@ -57,43 +70,465 @@                                                  _ -> []  --- http://docs.aws.amazon.com/AWSEC2/latest/APIReference/ApiReference-query-RunInstances.html-instanceTypes :: [Text]-instanceTypes = [ "t2.micro"-                , "t2.small"-                , "t2.medium"-                , "m3.medium"-                , "m3.large"-                , "m3.xlarge"-                , "m3.2xlarge"-                , "m1.small" -- default-                , "m1.medium"-                , "m1.large"-                , "m1.xlarge"-                , "c3.large"-                , "c3.xlarge"-                , "c3.2xlarge"-                , "c3.4xlarge"-                , "c3.8xlarge"-                , "c1.medium"-                , "c1.xlarge"-                , "cc2.8xlarge"-                , "r3.large"-                , "r3.xlarge"-                , "r3.2xlarge"-                , "r3.4xlarge"-                , "r3.8xlarge"-                , "m2.xlarge"-                , "m2.2xlarge"-                , "m2.4xlarge"-                , "cr1.8xlarge"-                , "i2.xlarge"-                , "i2.2xlarge"-                , "i2.4xlarge"-                , "i2.8xlarge"-                , "hs1.8xlarge"-                , "hi1.4xlarge"-                , "t1.micro"-                , "g2.2xlarge"-                , "cg1.4xlarge"-                ]+type CidrIp = Text+type SgGroupId = Text++data SgPermission = IpPermission IpProtocol (Maybe Int) (Maybe Int) [CidrIp]+                  | SgPermission IpProtocol (Maybe Int) (Maybe Int) [SgGroupId]+                deriving (Show)+++data Region = Region { regionEndpoint :: T.Text+                     , regionName :: T.Text}+                     deriving (Show)++instance FromJSON Region where+  parseJSON (Object v) = Region <$>+    v .: "regionEndpoint" <*>+    v .: "regionName"+  parseJSON invalid = typeMismatch "Region" invalid++data Reservation = Reservation { reservationId :: T.Text+                               , reservationOwnerId :: T.Text+                               , reservationSecurityGroups :: [Group]+                               , reservationInstances :: [Instance]}+                               deriving (Show)++instance FromJSON Reservation where+  parseJSON (Object v) = Reservation <$>+    v .: "reservationId" <*>+    v .: "ownerId" <*>+    (maybeToList <$> (v .:? "groupSet" .!= Nothing)) <*>+    v .: "instancesSet"+  parseJSON invalid = typeMismatch "Reservation" invalid++data Group = Group { groupId :: T.Text+                   , groupName :: T.Text}+                   deriving (Show)++instance FromJSON Group where+  parseJSON (Object v) = Group <$>+    v .: "groupId" <*>+    v .: "groupName"+  parseJSON invalid = typeMismatch "Group" invalid++-- | The respose type describing an instance.+--+-- Note: this response type is not complete (according to the docs) but only+-- contains the types we have encountered. The other types that could be present+-- are commented out, as they could not be tested.+data Instance = Instance { instanceId :: T.Text+                         , instanceImageId :: T.Text+                         , instanceState :: InstanceState+                         , instancePrivateDnsName :: Maybe T.Text+                         , instancePublicDnsName :: Maybe T.Text+                         , instanceStateTransitionReason :: Maybe T.Text+                         , instanceKeyName :: Maybe T.Text+                         , instanceAmiLaunchIndex :: Int+                         , instanceProductCodes :: [ProductCode]+                         , instanceType :: T.Text -- InstanceType = ...+                         , instanceLaunchTime :: UTCTime+                         , instancePlacement :: Placement+                         , instanceMonitoring :: Monitoring+                         , instanceSecurityGroups :: [Group]+                         , instanceArchitecture :: Architecture+                         , instanceRootDeviceType :: RootDeviceType+                         , instanceRootDeviceName :: Maybe T.Text+                         , instanceHypervisor :: Hypervisor+                         , instanceVirtualizationType :: VirtualizationType+                         , instanceClientToken :: Maybe T.Text+                         , instanceBlockDeviceMapping :: [InstanceBlockDeviceMapping]+                         , instanceEbsOptimized :: Bool+                         , instanceStateReason :: Maybe StateReason+                         , instanceNetworkInterfaces :: [InstanceNetworkInterface]+                         , instancePrivateIpAddress :: Maybe IPv4+                         , instancePublicIpAddress :: Maybe IPv4+                         , instanceTags :: [Tag]+                         , instanceKernelId :: Maybe T.Text+                         , instanceSourceDestCheck :: Maybe Bool+                         , instanceVpcId :: Maybe T.Text+                         , instanceSubnetId :: Maybe T.Text+                         -- The following fields are documented but have not been+                         -- encountered in an actual response. During the development+                         -- phase of the launhcer we will leave the possible fields+                         -- commented out in case we will need them.+                         --, instanceIamInstanceProfile :: Maybe IamInstanceProfile+                         --, instanceLifecycle :: Maybe T.Text -- InstanceLifecycle = spot+                         --, instanceRamdiskId :: Maybe T.Text+                         --, instancePlatform :: Maybe T.Text -- Platform = windows+                         --, instanceSpotInstanceRequestId :: Maybe T.Text+                         --, instanceSriovNetSupport :: Maybe T.Text+                         } deriving (Show)++instance FromJSON Instance where+  parseJSON (Object v) = Instance <$>+    v .: "instanceId" <*>+    v .: "imageId" <*>+    v .: "instanceState" <*>+    v .:? "privateDnsName" .!= Nothing <*>+    v .:? "dnsName" .!= Nothing <*>+    v .:? "reason" .!= Nothing <*>+    v .:? "keyName" .!= Nothing <*>+    (read <$> v .: "amiLaunchIndex") <*>+    (maybeToList <$> (v .:? "productCodes" .!= Nothing)) <*>+    v .: "instanceType" <*>+    v .: "launchTime" <*>+    v .: "placement" <*>+    v .: "monitoring" <*>+    (maybeToList <$> (v .:? "groupSet" .!= Nothing)) <*>+    (read <$> (v .: "architecture")) <*>+    (read <$> (v .: "rootDeviceType")) <*>+    v .:? "rootDeviceName" .!= Nothing <*>+    (read <$> (v .: "hypervisor")) <*>+    (read <$> (v .: "virtualizationType")) <*>+    v .:? "clientToken" .!= Nothing <*>+    (maybeToList <$> (v .:? "blockDeviceMapping" .!= Nothing)) <*>+    (readBool <$> (v .: "ebsOptimized")) <*>+    v .:? "stateReason" .!= Nothing <*>+    (maybeToList <$> (v .:? "networkInterfaceSet" .!= Nothing)) <*>+    (fmap read <$> (v .:? "privateIpAddress" .!= Nothing)) <*>+    (fmap read <$> (v .:? "ipAddress" .!= Nothing)) <*>+    (maybeToList <$> (v .:? "tagSet" .!= Nothing)) <*>+    v .:? "kernelId" .!= Nothing <*>+    (fmap readBool <$> (v .:? "sourceDestCheck" .!= Nothing)) <*>+    v .:? "vpcId" .!= Nothing <*>+    v .:? "subnetId" .!= Nothing+  parseJSON invalid = typeMismatch "Instance" invalid++data ProductCode = ProductCode { productCodeId :: T.Text+                               , productCodeType :: T.Text} --ProductCodeType = devpay | marketplace+                               deriving (Show)++instance FromJSON ProductCode where+  parseJSON (Object v) = ProductCode <$>+    v .: "productCodeId" <*>+    v .: "productCodeType"+  parseJSON invalid = typeMismatch "ProductCode" invalid++data InstanceNetworkInterface =+  InstanceNetworkInterface { iniNetworkInterfaceId :: T.Text+                           , iniSubnetId :: Maybe T.Text+                           , iniVpcId :: Maybe T.Text+                           , iniDescription :: Maybe T.Text+                           , iniOwnerId :: T.Text+                           , iniStatus :: T.Text -- Status = available | attaching | in-use | detaching+                           , iniMacAddress :: Maybe T.Text+                           , iniPrivateIpAddress :: Maybe IPv4+                           , iniSourceDestCheck :: Maybe Bool+                           , iniSecurityGroups :: [Group]+                           , iniAttachment :: Value -- Attachment+                           , iniAssociation :: Maybe Value} -- Maybe Association}+                           deriving (Show)++instance FromJSON InstanceNetworkInterface where+  parseJSON (Object v) = InstanceNetworkInterface <$>+    v .: "networkInterfaceId" <*>+    v .:? "subnetId" .!= Nothing <*>+    v .:? "vpcId" .!= Nothing <*>+    v .:? "description" .!= Nothing <*>+    v .: "ownerId" <*>+    v .: "status" <*>+    v .:? "macAddress" .!= Nothing <*>+    (fmap read <$> (v .:? "privateIpAddress" .!= Nothing)) <*>+    (fmap readBool <$> (v .:? "sourceDestCheck" .!= Nothing)) <*>+    (maybeToList <$> (v .:? "groupSet" .!= Nothing)) <*>+    v .: "attachment" <*>+    v .:? "association" .!= Nothing+  parseJSON invalid = typeMismatch "InstanceNetworkInterface" invalid++data Tag = Tag { tagKey :: T.Text+               , tagValue :: T.Text}+               deriving (Show)++instance FromJSON Tag where+  parseJSON (Object v) = Tag <$>+    v .: "key" <*>+    v .: "value"+  parseJSON invalid = typeMismatch "Tag" invalid++data InstanceBlockDeviceMapping =+  InstanceBlockDeviceMapping { ibdmDeviceName :: T.Text+                             , ibdmEbs :: EbsInstanceBlockDevice}+                             deriving (Show)++instance FromJSON InstanceBlockDeviceMapping where+  parseJSON (Object v) = InstanceBlockDeviceMapping <$>+    v .: "deviceName" <*>+    v .: "ebs"+  parseJSON invalid = typeMismatch "InstanceBlockDeviceMapping" invalid++data EbsInstanceBlockDevice =+  EbsInstanceBlockDevice { eibdVolumeId :: T.Text+                         , eibdStatus :: T.Text -- Status = attaching | attached | detatichg | detached+                         , eibdAttachTime :: UTCTime+                         , eibdDeleteOnTermination :: Bool}+                         deriving (Show)++instance FromJSON EbsInstanceBlockDevice where+  parseJSON (Object v) = EbsInstanceBlockDevice <$>+    v .: "volumeId" <*>+    v .: "status" <*>+    v .: "attachTime" <*>+    (readBool <$> (v .: "deleteOnTermination"))+  parseJSON invalid = typeMismatch "EbsInstanceBlockDevice" invalid++data InstanceState = InstanceState { isName :: InstanceStateName+                                   , isCode :: Int}+                                   deriving (Show)++instance FromJSON InstanceState where+  parseJSON (Object v) = InstanceState <$>+    (read <$> (v .: "name")) <*>+    (read <$> (v .: "code"))+  parseJSON invalid = typeMismatch "InstanceState" invalid+++data Placement = Placement { pAvailabilityZone :: T.Text+                           , pTenancy :: T.Text+                           , pGroupName :: Maybe T.Text}+                           deriving (Show)++instance FromJSON Placement where+  parseJSON (Object v) = Placement <$>+    v .: "availabilityZone" <*>+    v .: "tenancy"  <*>+    v .: "groupName"+  parseJSON invalid = typeMismatch "Placement" invalid++data Monitoring = Monitoring {monitoringState :: T.Text} deriving (Show) -- State = disabled | disabling | enabled | pendig++instance FromJSON Monitoring where+  parseJSON (Object v) = Monitoring <$> v .: "state"+  parseJSON invalid = typeMismatch "Monitoring" invalid++data StateReason = StateReason { srCode :: T.Text+                               , srMessage :: T.Text}+                               deriving (Show)++instance FromJSON StateReason where+  parseJSON (Object v) = StateReason <$>+    v .: "code" <*>+    v .: "message"+  parseJSON invalid = typeMismatch "StateReason" invalid++data AvailabilityZone = AvailabilityZone { azRegionName :: T.Text+                                         , azZoneName :: T.Text+                                         , azZoneState :: T.Text+                                         , azMessageSet :: Value}+                                         deriving (Show)++instance FromJSON AvailabilityZone where+  parseJSON (Object v) = AvailabilityZone <$>+    v .: "regionName" <*>+    v .: "zoneName" <*>+    v .: "zoneState" <*>+    v .: "messageSet"+  parseJSON invalid = typeMismatch "AvailabilityZone" invalid++data SecurityGroup = SecurityGroup { sgOwnerId :: T.Text+                                   , sgGroupId :: T.Text+                                   , sgGroupName :: T.Text+                                   , sgGroupDescription :: T.Text+                                   , sgVpcId :: Maybe T.Text+                                   , sgIpPermissionsEgress :: Value+                                   , sgIpPermissions :: Value}+                                   deriving (Show)++instance FromJSON SecurityGroup where+  parseJSON (Object v) = SecurityGroup <$>+    v .: "ownerId" <*>+    v .: "groupId" <*>+    v .: "groupName" <*>+    v .: "groupDescription" <*>+    v .:? "vpcId" .!= Nothing <*>+    v .: "ipPermissionsEgress" <*>+    v .: "ipPermissions"+  parseJSON invalid = typeMismatch "SecurityGroup" invalid++data PlacementGroup = PlacementGroup { pgGroupName :: T.Text+                                     , pgStrategy :: T.Text+                                     , pgState :: T.Text}+                                     deriving (Show)++instance FromJSON PlacementGroup where+  parseJSON (Object v) = PlacementGroup <$>+    v .: "groupName" <*>+    v .: "strategy" <*>+    v .: "state"+  parseJSON invalid = typeMismatch "PlacementGroup" invalid++data KeyPair = KeyPair { keyName :: T.Text+                       , keyFingerprint :: T.Text}+                       deriving (Show)++instance FromJSON KeyPair where+  parseJSON (Object v) = KeyPair <$>+    v .: "keyName" <*>+    v .: "keyFingerprint"+  parseJSON invalid = typeMismatch "KeyPair" invalid++data Vpc = Vpc { vpcId :: T.Text+               , vpcState :: T.Text+               , vpcCIDR :: T.Text+               , vpcDHCPOptions :: T.Text+               , vpcInstanceTenacity :: T.Text+               , vpcIsDefault :: Maybe Bool}+               deriving (Show)++instance FromJSON Vpc where+  parseJSON (Object v) = Vpc <$>+    v .: "vpcId" <*>+    v .: "state" <*>+    v .: "cidrBlock" <*>+    v .: "dhcpOptionsId" <*>+    v .: "instanceTenancy" <*>+    (fmap readBool <$> (v .:? "isDefault" .!= Nothing))+  parseJSON invalid = typeMismatch "Vpc" invalid++data Subnet = Subnet { subnetId :: T.Text+                     , subnetVpcId :: T.Text+                     , subnetState :: T.Text+                     , subnetCIDR :: T.Text+                     , subnetAZ :: T.Text+                     , subnetAvailableIpCount :: Int+                     , subnetDefaultForAZ :: Maybe Bool+                     , subnetMapPublicIp :: Maybe Bool}+                     deriving (Show)++instance FromJSON Subnet where+  parseJSON (Object v) = Subnet <$>+    v .: "subnetId" <*>+    v .: "vpcId" <*>+    v .: "state" <*>+    v .: "cidrBlock" <*>+    v .: "availabilityZone" <*>+    (read <$> (v .: "availableIpAddressCount")) <*>+    (fmap readBool <$> (v .:? "defaultForAz" .!= Nothing)) <*>+    (fmap readBool <$> (v .:? "mapPublicIpOnLaunch" .!= Nothing))+  parseJSON invalid = typeMismatch "Subnet" invalid++-- Enums++data InstanceTenancy = Default | Dedicated++instance Show InstanceTenancy where+    show Default = "default"+    show Dedicated = "dedicated"++data VolumeType = Standard | GP2SSD | IOPSSD Int++instance Show VolumeType where+    show Standard = "standard"+    show GP2SSD = "gp2"+    show (IOPSSD _) = "io1"++data IpProtocol = TCP | UDP | ICMP | Proto Int | All++instance Show IpProtocol where+    show TCP = "tcp" -- 6+    show UDP = "udp" -- 17+    show ICMP = "icmp" -- 1+    show (Proto i) = show i+    show All = "-1"++data VirtualizationType = HVM | PARAVIRTUAL deriving (Eq)++instance Show VirtualizationType where+    show HVM = "hvm"+    show PARAVIRTUAL = "paravirtual"++instance Read VirtualizationType where+  readsPrec _ h = case h of+                    "hvm" -> [(HVM,"")]+                    "paravirtual" -> [(PARAVIRTUAL,"")]+                    _ -> fail $ "Failed to parse " ++ h ++ " into VirtualizationType."++data RootDeviceType = EBS_STORE | INSTANCE_STORE deriving (Eq)++instance Show RootDeviceType where+    show EBS_STORE = "ebs"+    show INSTANCE_STORE = "instance-store"++instance Read RootDeviceType where+  readsPrec _ h = case h of+                    "ebs" -> [(EBS_STORE,"")]+                    "instance-store" -> [(INSTANCE_STORE,"")]+                    _ -> fail $ "Failed to parse " ++ h ++ " into RootDeviceType."++data Architecture = I386 | X86_64 deriving (Eq)++instance Show Architecture where+    show I386 = "32-bit"+    show X86_64 = "64-bit"++instance Read Architecture where+  readsPrec _ h = case h of+                    "i386" -> [(I386,"")]+                    "x86_64" -> [(X86_64,"")]+                    _ -> fail $ "Failed to parse " ++ h ++ " into Architecture."++data Hypervisor = OVM | XEN deriving (Eq)++instance Show Hypervisor where+    show OVM = "ovm"+    show XEN = "xen"++instance Read Hypervisor where+  readsPrec _ h = case h of+                    "ovm" -> [(OVM,"")]+                    "xen" -> [(XEN,"")]+                    _ -> fail $ "Failed to parse " ++ h ++ " into Hypervisor."++data InstanceStateName = Pending+                       | Running+                       | ShuttingDown+                       | Terminated+                       | Stopping+                       | Stopped+                       deriving (Eq)++instance Show InstanceStateName where+    show Pending = "pending"+    show Running = "running"+    show ShuttingDown = "shutting-down"+    show Terminated = "terminated"+    show Stopping = "stopping"+    show Stopped = "stopped"++instance Read InstanceStateName where+  readsPrec _ h = case h of+                    "pending" -> [(Pending,"")]+                    "running" -> [(Running,"")]+                    "shutting-down" -> [(ShuttingDown,"")]+                    "terminated" -> [(Terminated,"")]+                    "stopping" -> [(Stopping,"")]+                    "stopped" -> [(Stopped,"")]+                    _ -> fail $ "Failed to parse " ++ h ++ " into InstanceStateName."+++-- Helper functions++enumeratePermissions :: [SgPermission] -> HTTP.Query+enumeratePermissions = enumerateLists "IpPermissions." . fmap unroll+  where+    port n = maybe [] (\p -> [(n, qShow p)])+    unroll (IpPermission proto from to ips) =+      [("IpProtocol", qShow proto)] +++      port "FromPort" from +++      port "ToPort" to ++++      [(mconcat [k, ".CidrIp"], v)| (k, v) <- enumerate "IpRanges" ips qArg]+    unroll (SgPermission proto from to sgs) =+      [("IpProtocol", qShow proto)] +++      port "FromPort" from +++      port "ToPort" to ++++      [(mconcat [k, ".GroupId"], v)| (k, v) <- enumerate "Groups" sgs qArg]++-- JSON parsing helper functions++maybeToList :: Maybe [a] -> [a]+maybeToList (Just a) = a+maybeToList Nothing = []++readBool :: String -> Bool+readBool (x:xs) = read $ toUpper x : map toLower xs+readBool [] = error "Cannot read bool. String is empty."

@@ -46,4 +46,4 @@                                                     , ("HealthCheck.Timeout", qShow hc_timeout)                                                     ] -ELBVALUETRANSACTION(ConfigureHealthCheck,"ConfigureHealthCheckResult")+elbValueTransaction ''ConfigureHealthCheck "ConfigureHealthCheckResult"

@@ -26,4 +26,4 @@                                                     , ("CookieName", qArg cacsp_cookieName)                                                     ] -ELBVALUETRANSACTION(CreateAppCookieStickinessPolicy,"CreateAppCookieStickinessPolicyResult")+elbValueTransaction ''CreateAppCookieStickinessPolicy "CreateAppCookieStickinessPolicyResult"

@@ -25,4 +25,4 @@                                                     , ("PolicyName", qArg clbcsp_policyName)                                                     ] +++ optional "CookieExpirationPeriod" clbcsp_cookieExpirationPeriod qShow -ELBVALUETRANSACTION(CreateLBCookieStickinessPolicy,"CreateLBCookieStickinessPolicyResult")+elbValueTransaction ''CreateLBCookieStickinessPolicy "CreateLBCookieStickinessPolicyResult"

@@ -55,5 +55,4 @@                                                             Internal -> [("Scheme", qArg "internal")]                                                             _ -> [] --ELBVALUETRANSACTION(CreateLoadBalancer,"CreateLoadBalancerResult")+elbValueTransaction ''CreateLoadBalancer "CreateLoadBalancerResult"

@@ -25,4 +25,4 @@                                                     , ("LoadBalancerName", qArg dilb_name)                                                     ] +++ enumerateInstanceIds dilb_instanceIds -ELBVALUETRANSACTION(DeregisterInstancesFromLoadBalancer,"DeregisterInstancesFromLoadBalancerResult")+elbValueTransaction ''DeregisterInstancesFromLoadBalancer "DeregisterInstancesFromLoadBalancerResult"

@@ -19,4 +19,4 @@                                                            , ("LoadBalancerName", qArg lb)                                                            ] -ELBVALUETRANSACTION(DescribeInstanceHealth,"DescribeInstanceHealthResult")+elbValueTransaction ''DescribeInstanceHealth "DescribeInstanceHealthResult"

@@ -19,4 +19,4 @@                                                                  , ("LoadBalancerName", qArg lb)                                                                  ] -ELBVALUETRANSACTION(DescribeLoadBalancerPolicies,"DescribeLoadBalancerPoliciesResult")+elbValueTransaction ''DescribeLoadBalancerPolicies "DescribeLoadBalancerPoliciesResult"

@@ -31,6 +31,6 @@     responseConsumer ListLoadBalancerPolicyTypes = queryResponseConsumer $ \cu -> do       let cu' = cu $.// Cu.laxElement "PolicyTypeName" &| (toValue (XMLValueOptions "item") . Cu.node)       return $ Array $ V.fromList cu'-    responseConsumer (DescribeLoadBalancerPolicyTypes _) = queryResponseConsumer $ valueConsumerOpt (XMLValueOptions "member") "DescribeLoadBalancerPolicyTypesResult" id+    responseConsumer (DescribeLoadBalancerPolicyTypes _) = queryResponseConsumer $ valueConsumerOpt (XMLValueOptions "member") "DescribeLoadBalancerPolicyTypesResult" fromJSONConsumer  instance Transaction DescribeLoadBalancerPolicyTypes Value

@@ -4,6 +4,7 @@            , OverloadedStrings            , TemplateHaskell            , RecordWildCards+           , OverloadedStrings            #-}  module Aws.Elb.Commands.DescribeLoadBalancers where@@ -12,4 +13,4 @@  data DescribeLoadBalancers = DescribeLoadBalancers [Text] -ELBVALUETRANSACTIONDEF(DescribeLoadBalancers,"DescribeLoadBalancers","LoadBalancerDescriptions","LoadBalancerNames.member")+elbValueTransactionDef ''DescribeLoadBalancers 'DescribeLoadBalancers "LoadBalancerDescriptions" "LoadBalancerNames.member"

@@ -53,4 +53,4 @@                                                     , ("LoadBalancerName", qArg mlba_name)                                                     ] +++ concatMap attributeQuery mlba_attributes -ELBVALUETRANSACTION(ModifyLoadBalancerAttributes,"ModifyLoadBalancerAttributesResult")+elbValueTransaction ''ModifyLoadBalancerAttributes "ModifyLoadBalancerAttributesResult"

@@ -25,4 +25,4 @@                                                     , ("LoadBalancerName", qArg rilb_name)                                                     ] +++ enumerateInstanceIds rilb_instanceIds -ELBVALUETRANSACTION(RegisterInstancesWithLoadBalancer,"RegisterInstancesWithLoadBalancerResult")+elbValueTransaction ''RegisterInstancesWithLoadBalancer "RegisterInstancesWithLoadBalancerResult"

@@ -25,4 +25,4 @@                                                     , ("LoadBalancerPort", qShow spl_loadBalancerPort)                                                     ] +++ enumerate "PolicyNames.member" spl_policyNames qArg -ELBVALUETRANSACTION(SetLoadBalancerPoliciesOfListener,"SetLoadBalancerPoliciesOfListenerResult")+elbValueTransaction ''SetLoadBalancerPoliciesOfListener "SetLoadBalancerPoliciesOfListenerResult"

@@ -11,10 +11,8 @@ , module Aws.Query , Text , FromJSON-#ifdef USE_TH , elbValueTransaction , elbValueTransactionDef-#endif ) where  import Language.Haskell.TH@@ -29,15 +27,13 @@ import Aws.Query.TH import Aws.Elb.Core -#ifdef USE_TH elbValueTransaction :: Name -> String -> DecsQ elbValueTransaction ty tag = [d|                   instance ResponseConsumer $(conT ty) Value where                       type ResponseMetadata Value = QueryMetadata-                      responseConsumer _ = queryResponseConsumer $ valueConsumerOpt (XMLValueOptions "member") $(stringE tag) id+                      responseConsumer _ = queryResponseConsumer $ valueConsumerOpt (XMLValueOptions "member") $(stringE tag) fromJSONConsumer                    instance Transaction $(conT ty) Value                   |]  elbValueTransactionDef ty cons tag filterKey = queryValueTransactionDef ty cons tag 'elbSignQuery 'defVersion "member" filterKey-#endif

@@ -2,6 +2,7 @@            , FlexibleInstances            , RecordWildCards            , LambdaCase+           , OverloadedStrings            #-}  module Aws.Elb.Types where

@@ -19,6 +19,7 @@ , qArg , qShow , qBool+, fromJSONConsumer , valueConsumer , valueConsumerOpt , queryResponseConsumer@@ -44,6 +45,7 @@ import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) +import Data.Aeson (FromJSON, Result (..), fromJSON) import Data.List import Data.Monoid import Data.Maybe@@ -95,6 +97,13 @@     mempty = QueryMetadata Nothing     (QueryMetadata r1) `mappend` (QueryMetadata r2) = QueryMetadata (r1 `mplus` r2) +data ConsumeError = ConsumeError String deriving (Typeable)++instance C.Exception ConsumeError++instance Show ConsumeError where+  show (ConsumeError e) = e+ querySignQuery :: HTTP.Query -> QueryData -> SignatureData -> SignedQuery querySignQuery query QueryData{..} sd     = SignedQuery {@@ -201,14 +210,23 @@ qBool True = Just "true" qBool False = Just "false" -valueConsumer :: Text -> (Value -> a) -> Cu.Cursor -> Response QueryMetadata a+fromJSONConsumer :: FromJSON a => Value -> Response QueryMetadata a+fromJSONConsumer value =+  case fromJSON value of+      Error e -> throwM $+        ConsumeError $ "ConsumeError: " ++ e +++                       "\nError occured while consuming the following Value:\n" +++                       show value+      Success result -> return result++valueConsumer :: Text -> (Value -> Response QueryMetadata a) -> Cu.Cursor -> Response QueryMetadata a valueConsumer = valueConsumerOpt (XMLValueOptions "item") -valueConsumerOpt :: XMLValueOptions -> Text -> (Value -> a) -> Cu.Cursor -> Response QueryMetadata a+valueConsumerOpt :: XMLValueOptions -> Text -> (Value -> Response QueryMetadata a) -> Cu.Cursor -> Response QueryMetadata a valueConsumerOpt options tag cons cu = go $ head cu'   where     cu' = cu $.// Cu.laxElement tag-    go = return . cons . toValue options . Cu.node +    go = cons . toValue options . Cu.node  -- similar: iamResponseConsumer queryResponseConsumer :: (Cu.Cursor -> Response QueryMetadata a)

@@ -14,10 +14,8 @@ , Text , UTCTime , FromJSON-#ifdef USE_TH , queryValueTransactionDef , queryValueTransaction-#endif ) where  import Language.Haskell.TH@@ -31,7 +29,6 @@ import Aws.Core import Aws.Query -#ifdef USE_TH queryValueTransactionDef :: Name -> Name -> String -> Name -> Name -> String -> String -> DecsQ queryValueTransactionDef ty cons tag signF version item filterKey = do                 arg <- newName "arg"@@ -44,7 +41,7 @@                    instance ResponseConsumer $(conT ty) Value where                       type ResponseMetadata Value = QueryMetadata-                      responseConsumer _ = queryResponseConsumer $ valueConsumerOpt (XMLValueOptions $(stringE item)) $(stringE tag) id+                      responseConsumer _ = queryResponseConsumer $ valueConsumerOpt (XMLValueOptions $(stringE item)) $(stringE tag) fromJSONConsumer                    instance Transaction $(conT ty) Value                   |]@@ -53,8 +50,7 @@ queryValueTransaction ty tag = [d|                   instance ResponseConsumer $(conT ty) Value where                       type ResponseMetadata Value = QueryMetadata-                      responseConsumer _ = queryResponseConsumer $ valueConsumer $(stringE tag) id+                      responseConsumer _ = queryResponseConsumer $ valueConsumer $(stringE tag) fromJSONConsumer                    instance Transaction $(conT ty) Value                   |]-#endif

@@ -1,4 +1,6 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskell+           , CPP+           #-}  module Aws.TH where @@ -8,7 +10,11 @@  derivePatchedShowRead :: Name -> (String -> String) -> Q [Dec] derivePatchedShowRead name patch = do+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (DataD _ _ _ _ cons _) <- reify name+#else     TyConI (DataD _ _ _ cons _) <- reify name+#endif     let names = (\(NormalC name []) -> name) <$> cons     Just show <- lookupValueName "show"     showD <- instanceD (cxt []) (appT (conT ''Show) (conT name)) [fun show names]