aws-sdk 0.3.0.0 → 0.4.0.0

raw patch · 25 files changed

+568/−265 lines, 25 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• AWS/Class.hs +2/−1
• AWS/EC2.hs +1/−0
• AWS/EC2/Address.hs +4/−7
• AWS/EC2/AvailabilityZone.hs +1/−1
• AWS/EC2/Image.hs +1/−1
• AWS/EC2/Instance.hs +5/−5
• AWS/EC2/Internal.hs +54/−6
• AWS/EC2/KeyPair.hs +1/−1
• AWS/EC2/Parser.hs +0/−46
• AWS/EC2/Query.hs +5/−6
• AWS/EC2/Region.hs +1/−1
• AWS/EC2/SecurityGroup.hs +1/−1
• AWS/EC2/Snapshot.hs +1/−1
• AWS/EC2/Tag.hs +1/−1
• AWS/EC2/Volume.hs +3/−4
• AWS/ELB.hs +45/−0
• AWS/ELB/Internal.hs +33/−0
• AWS/ELB/LoadBalancer.hs +90/−0
• AWS/ELB/Types.hs +85/−0
• AWS/Lib/Parser.hs +44/−13
• AWS/Lib/Query.hs +30/−7
• AWS/RDS.hs +3/−160
• AWS/RDS/DBInstance.hs +116/−0
• AWS/RDS/Internal.hs +34/−0
• aws-sdk.cabal +7/−3

@@ -41,7 +41,8 @@  data AWSException     = ClientError-        { errorCode :: Text+        { errorStatus :: Int+        , errorCode :: Text         , errorMessage :: Text         , errorRequestId :: Text         } -- ^ This error is caused by client requests.

@@ -33,6 +33,7 @@ import Data.Text (Text)  import AWS.Util+import AWS.Class import AWS.EC2.Internal import AWS.EC2.Types import qualified AWS.EC2.Util as Util

@@ -20,7 +20,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  -----------------------------------------------------@@ -78,8 +78,7 @@ releaseAddress addr allocid = do     ec2Query "ReleaseAddress" params $ getF "return" ec2Return   where-    param name = maybe [] (\a -> [ValueParam name a])-    params = uncurry param =<<+    params = maybeParams         [ ("PublicIp", addr)         , ("AllocationId", allocid)         ]@@ -119,14 +118,12 @@     ] associateAddressParam (AAVPCInstance aid iid nid pip ar) =     [ ValueParam "AllocationId" aid ]-    ++ (uncurry f =<<+    ++ maybeParams         [ ("InstanceId", iid)         , ("NetworkInterfaceId", nid)         , ("PrivateIpAddress", pip)         , ("AllowReassociation", boolToText <$> ar)-        ])-  where-    f name = maybe [] (\a -> [ValueParam name a])+        ]  disassociateAddress     :: (MonadResource m, MonadBaseControl IO m)

@@ -14,7 +14,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser  describeAvailabilityZones     :: (MonadResource m, MonadBaseControl IO m)

@@ -16,7 +16,7 @@ import AWS.EC2.Types import AWS.EC2.Params import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  describeImages

@@ -34,7 +34,7 @@ import AWS.EC2.Types import AWS.EC2.Params import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  ------------------------------------------------------------@@ -299,7 +299,6 @@ runInstances param =     ec2Query "RunInstances" params reservationSink   where-    mk name = maybe [] (\a -> [ValueParam name a])     params =         [ ValueParam "ImageId" $ riImageId param         , ValueParam "MinCount" $ toText $ riMinCount param@@ -307,8 +306,9 @@         , ArrayParams "SecurityGroupId" $ riSecurityGroupIds param         , ArrayParams "SecurityGroup" $ riSecurityGroups param         , blockDeviceMappingParams $ riBlockDeviceMappings param-        ] ++ (uncurry mk =<<-            [ ("KeyName", riKeyName param) , ("UserData", bsToText <$> riUserData param)+        ] ++ maybeParams+            [ ("KeyName", riKeyName param)+            , ("UserData", bsToText <$> riUserData param)             , ("InstanceType", riInstanceType param)             , ("Placement.AvailabilityZone",                riAvailabilityZone param)@@ -329,7 +329,7 @@             , ("IamInstanceProfile.Name",                iipId <$> riIamInstanceProfile param)             , ("EbsOptimized", boolToText <$> riEbsOptimized param)-            ])+            ]  data RunInstancesParam = RunInstancesParam     { riImageId :: Text -- ^ Required

@@ -1,17 +1,22 @@+{-# LANGUAGE RankNTypes #-}+ module AWS.EC2.Internal-    ( AWSContext(..)-    , EC2-    , runEC2-      -- re-export-    , AWSException(..)-    ) where+    where  import Control.Monad.IO.Class (MonadIO) import qualified Network.HTTP.Conduit as HTTP import Data.ByteString.Char8 ()+import Control.Applicative+import Data.Conduit+import qualified Data.Conduit.List as CL+import Data.XML.Types (Event)+import Data.Text (Text)  import AWS.Class import AWS.Credential+import AWS.Util+import AWS.Lib.Parser+import AWS.EC2.Types  initialEC2Context :: HTTP.Manager -> AWSContext initialEC2Context mgr = AWSContext@@ -24,3 +29,46 @@  runEC2 :: MonadIO m => Credential -> AWS AWSContext m a -> m a runEC2 = runAWS initialEC2Context++itemConduit :: MonadThrow m+    => Text+    -> GLSink Event m o+    -> GLConduit Event m o+itemConduit tag inner =+    maybe (()) id <$> elementM tag (listConduit "item" inner)++itemsSet :: MonadThrow m+    => Text+    -> GLSink Event m o+    -> GLSink Event m [o]+itemsSet tag inner = itemConduit tag inner >+> CL.consume++resourceTagSink :: MonadThrow m+    => GLSink Event m [ResourceTag]+resourceTagSink = itemsSet "tagSet" $+    ResourceTag+    <$> getT "key"+    <*> getMT "value"++productCodeSink :: MonadThrow m+    => GLSink Event m [ProductCode]+productCodeSink = itemsSet "productCodes" $+    ProductCode+    <$> getT "productCode"+    <*> getF "type" productCodeType++stateReasonSink :: MonadThrow m+    => GLSink Event m (Maybe StateReason)+stateReasonSink = elementM "stateReason" $+    StateReason+    <$> getT "code"+    <*> getT "message"++volumeTypeSink :: MonadThrow m+    => GLSink Event m VolumeType+volumeTypeSink = volumeType+    <$> getT "volumeType"+    <*> getM "iops" (textToInt <$>)++returnBool :: MonadThrow m => GLSink Event m Bool+returnBool = getF "return" textToBool

@@ -17,7 +17,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  describeKeyPairs

@@ -1,46 +0,0 @@-module AWS.EC2.Parser-    ( module AWS.Lib.Parser-    , resourceTagSink-    , productCodeSink-    , stateReasonSink-    , volumeTypeSink-    , returnBool-    ) where--import Control.Applicative-import Data.Conduit-import Data.XML.Types (Event)--import AWS.EC2.Types-import AWS.Lib.Parser-import AWS.Util--resourceTagSink :: MonadThrow m-    => GLSink Event m [ResourceTag]-resourceTagSink = itemsSet "tagSet" $-    ResourceTag-    <$> getT "key"-    <*> getMT "value"--productCodeSink :: MonadThrow m-    => GLSink Event m [ProductCode]-productCodeSink = itemsSet "productCodes" $-    ProductCode-    <$> getT "productCode"-    <*> getF "type" productCodeType--stateReasonSink :: MonadThrow m-    => GLSink Event m (Maybe StateReason)-stateReasonSink = elementM "stateReason" $-    StateReason-    <$> getT "code"-    <*> getT "message"--volumeTypeSink :: MonadThrow m-    => GLSink Event m VolumeType-volumeTypeSink = volumeType-    <$> getT "volumeType"-    <*> getM "iops" (textToInt <$>)--returnBool :: MonadThrow m => GLSink Event m Bool-returnBool = getF "return" textToBool

@@ -4,8 +4,7 @@     ( ec2Query     , ec2QuerySource     , ec2QuerySource'-    , QueryParam(..)-    , Filter+    , module AWS.Lib.Query     ) where  import           Data.ByteString (ByteString)@@ -23,14 +22,14 @@ import Data.Text (Text) import Control.Applicative +import AWS.Class import AWS.EC2.Internal-import AWS.EC2.Parser+import AWS.Lib.Parser hiding (sinkError) import AWS.Lib.Query  {- Debug import Debug.Trace import qualified Data.Conduit.Binary as CB-import System.IO (stdout) --}  ec2Version :: ByteString@@ -44,13 +43,13 @@     getT "requestId"  sinkError :: MonadThrow m => Int -> GLSink Event m a-sinkError _ = do+sinkError s = do     await     element "Response" $ do         (c,m) <- element "Errors" $ element "Error" $             (,) <$> getT "Code" <*> getT "Message"         r <- getT "RequestID"-        lift $ monadThrow $ ClientError c m r+        lift $ monadThrow $ ClientError s c m r  ec2Query     :: (MonadResource m, MonadBaseControl IO m)

@@ -14,7 +14,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser  describeRegions     :: (MonadResource m, MonadBaseControl IO m)

@@ -23,7 +23,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  describeSecurityGroups

@@ -16,7 +16,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  describeSnapshots

@@ -15,7 +15,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  describeTags

@@ -17,7 +17,7 @@ import AWS.EC2.Internal import AWS.EC2.Types import AWS.EC2.Query-import AWS.EC2.Parser+import AWS.Lib.Parser import AWS.Util  describeVolumes@@ -131,10 +131,9 @@ detachVolume volid iid dev force =     ec2Query "DetachVolume" params attachmentSink   where-    mk name = maybe [] (\a -> [ValueParam name a])     params = [ValueParam "VolumeId" volid]-        ++ (uncurry mk =<<+        ++ maybeParams             [ ("InstanceId", iid)             , ("Device", dev)             , ("Force", toText <$> force)-            ])+            ]

@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.ELB+    ( -- * ELB Environment+      ELB+    , runELB+    , setRegion+      -- * LoadBalancer+    , module AWS.ELB.LoadBalancer+    ) where++import Data.Text (Text)+import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.IO.Class (MonadIO)+import qualified Control.Monad.State as State+import qualified Network.HTTP.Conduit as HTTP+import Data.Monoid++import AWS.Class+import AWS.Util++import AWS+import AWS.ELB.Internal+import AWS.ELB.LoadBalancer++initialELBContext :: HTTP.Manager -> AWSContext+initialELBContext mgr = AWSContext+    { manager = mgr+    , endpoint = "elasticloadbalancing.amazonaws.com"+    , lastRequestId = Nothing+    }++runELB :: MonadIO m => Credential -> ELB m a -> m a+runELB = runAWS initialELBContext++setRegion+    :: (MonadBaseControl IO m, MonadResource m)+    => Text -> ELB m ()+setRegion region = do+    ctx <- State.get+    State.put+        ctx { endpoint =+            "elasticloadbalancing." <> textToBS region <> ".amazonaws.com"+            }

@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.ELB.Internal+    where++import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.XML.Types (Event(..))++import AWS.Class+import AWS.Lib.Query+import AWS.Lib.Parser++apiVersion :: ByteString+apiVersion = "2012-06-01"++type ELB m a = AWS AWSContext m a++elbQuery+    :: (MonadBaseControl IO m, MonadResource m)+    => ByteString -- ^ Action+    -> [QueryParam]+    -> GLSink Event m a+    -> AWS AWSContext m a+elbQuery = commonQuery apiVersion++members :: MonadThrow m+    => Text+    -> GLSink Event m a+    -> GLSink Event m [a]+members name f = element name $ listConsumer "member" f

@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.ELB.LoadBalancer+    ( describeLoadBalancers+    ) where++import Data.Text (Text)+import Data.Conduit+import Control.Applicative+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.XML.Types (Event(..))++import AWS.Util+import AWS.Lib.Parser+import AWS.Lib.Query++import AWS.ELB.Types+import AWS.ELB.Internal++describeLoadBalancers+    :: (MonadBaseControl IO m, MonadResource m)+    => [Text] -- ^ LoadBalancerNames+    -> Maybe Text -- ^ Marker+    -> ELB m [LoadBalancerDescription]+describeLoadBalancers lbs marker =+    elbQuery "DescribeLoadBalancers" params sinkLoadBalancers+  where+    params = [ArrayParams "LoadBalancerNames.member" lbs]+        ++ maybe [] (\a -> [ValueParam "Marker" a]) marker++sinkLoadBalancers :: MonadThrow m+    => GLSink Event m [LoadBalancerDescription]+sinkLoadBalancers = members "LoadBalancerDescriptions" $+    LoadBalancerDescription+    <$> members "SecurityGroups" text+    <*> getT "LoadBalancerName"+    <*> getF "CreatedTime" textToTime+    <*> element "HealthCheck"+        (HealthCheck+        <$> getF "Interval" textToInt+        <*> getT "Target"+        <*> getF "HealthyThreshold" textToInt+        <*> getF "Timeout" textToInt+        <*> getF "UnhealthyThreshold" textToInt+        )+    <*> getMT "VPCId"+    <*> members "ListenerDescriptions"+        (ListenerDescription+        <$> members "PolicyNames" text+        <*> element "Listener"+            (Listener+            <$> getT "Protocol"+            <*> getF "LoadBalancerPort" textToInt+            <*> getT "InstanceProtocol"+            <*> getMT "SSLCertificateId"+            <*> getF "InstancePort" textToInt+            )+        )+    <*> members "Instances"+        (Instance <$> getT "InstanceId")+    <*> element "Policies"+        (Policies+        <$> members "AppCookieStickinessPolicies"+            (AppCookieStickinessPolicy+            <$> getT "CookieName"+            <*> getT "PolicyName"+            )+        <*> members "OtherPolicies" text+        <*> members "LBCookieStickinessPolicies"+            (LBCookieStickinessPolicy+            <$> getF "CookieExpirationPeriod" textToInt+            <*> getT "PolicyName"+            )+        )+    <*> members "AvailabilityZones" text+    <*> getT "CanonicalHostedZoneName"+    <*> getT "CanonicalHostedZoneNameID"+    <*> getT "Scheme"+    <*> elementM "SourceSecurityGroup"+        (SourceSecurityGroup+        <$> getT "OwnerAlias"+        <*> getT "GroupName"+        )+    <*> getT "DNSName"+    <*> members "BackendServerDescriptions"+        (BackendServerDescription+        <$> getF "InstancePort" textToInt+        <*> members "PolicyNames" text+        )+    <*> members "Subnets" text

@@ -0,0 +1,85 @@+module AWS.ELB.Types+    where++import Data.Text (Text)+import Data.Time (UTCTime)++data LoadBalancerDescription = LoadBalancerDescription+    { lbSecurityGroups :: [Text]+    , lbLoadBalancerName :: Text+    , lbCreatedTime :: UTCTime+    , lbHealthCheck :: HealthCheck+    , lbVPCId :: Maybe Text+    , lbListenerDescriptions :: [ListenerDescription]+    , lbInstances :: [Instance]+    , lbPolicies :: Policies+    , lbAvailabilityZones :: [Text]+    , lbCanonicalHostedZoneName :: Text+    , lbCanonicalHostedZoneNameID :: Text+    , lbScheme :: Text+    , lbSourceSecurityGroup :: Maybe SourceSecurityGroup+    , lbDNSName :: Text+    , lbBackendServerDescriptions :: [BackendServerDescription]+    , lbSubnets :: [Text]+    }+  deriving (Show)++data BackendServerDescription = BackendServerDescription+    { bsInstancePort :: Int+    , bsPolicyNames :: [Text]+    }+  deriving (Show)++data HealthCheck = HealthCheck+    { hcInterval :: Int+    , hcTarget :: Text+    , hcHealthyThreshold :: Int+    , hcTimeout :: Int+    , hcUnhealthyThreshold :: Int+    }+  deriving (Show)++data Instance = Instance+    { iInstanceId :: Text+    }+  deriving (Show)++data ListenerDescription = ListenerDescription+    { ldPolicyNames :: [Text]+    , ldListener :: Listener+    }+  deriving (Show)++data Listener = Listener+    { lProtocol :: Text+    , lLoadBalancerPort :: Int+    , lInstanceProtocol :: Text+    , lSSLCertificateId :: Maybe Text+    , lInstancePort :: Int+    }+  deriving (Show)++data Policies = Policies+    { pAppCookieStickinessPolicies :: [AppCookieStickinessPolicy]+    , pOtherPolicies :: [Text]+    , pLBCookieStickinessPolicies :: [LBCookieStickinessPolicy]+    }+  deriving (Show)++data AppCookieStickinessPolicy = AppCookieStickinessPolicy+    { acspCookieName :: Text+    , acspPolicyName :: Text+    }+  deriving (Show)++data LBCookieStickinessPolicy = LBCookieStickinessPolicy+    { lbcspCookieExpirationPeriod :: Integer+    , lbcspPolicyName :: Text+    }+  deriving (Show)++data SourceSecurityGroup = SourceSecurityGroup+    { ssgOwnerAlias :: Text+    , ssgGroupName :: Text+    }+  deriving (Show)

@@ -10,17 +10,16 @@ import qualified Data.Conduit.List as CL import qualified Text.XML.Stream.Parse as XML import Control.Applicative+import Data.Monoid+import Control.Monad.Trans.Class (lift) +import AWS.Class++type RequestId = Text+ text :: MonadThrow m => GLSink Event m Text text = XML.content -itemConduit :: MonadThrow m-    => Text-    -> GLSink Event m o-    -> GLConduit Event m o-itemConduit tag inner =-    maybe (()) id <$> elementM tag (listConduit "item" inner)- listConduit :: MonadThrow m     => Text     -> GLSink Event m o@@ -41,12 +40,6 @@     -> GLSink Event m [o] listConsumer name p = listConduit name p >+> CL.consume -itemsSet :: MonadThrow m-    => Text-    -> GLSink Event m o-    -> GLSink Event m [o]-itemsSet tag inner = itemConduit tag inner >+> CL.consume- isTag :: Event -> Bool isTag (EventBeginElement _ _) =True isTag (EventEndElement _) =True@@ -122,3 +115,41 @@     -> GLSink Event m Text tagContent name =     XML.force ("parse error:" ++ T.unpack name) $ tagContentM name++sinkResponse+    :: MonadThrow m+    => Text -- ^ Action+    -> GLSink Event m a+    -> GLSink Event m (a, RequestId)+sinkResponse action sink = do+    sinkEventBeginDocument+    element (action <> "Response") $ (,)+        <$> element (action <> "Result") sink -- XXX: parse Marker+        <*> sinkResponseMetadata++sinkResponseMetadata+    :: MonadThrow m+    => GLSink Event m Text+sinkResponseMetadata =+    element "ResponseMetadata" $+        getT "RequestId"++sinkEventBeginDocument+    :: MonadThrow m+    => GLSink Event m ()+sinkEventBeginDocument = do+    me <- await+    case me of+        Nothing -> return ()+        Just EventBeginDocument -> return ()+        Just _ -> fail $ "unexpected: " <> show me++sinkError :: MonadThrow m => Int -> GLSink Event m a+sinkError status = element "ErrorResponse" $ do+    (_t,c,m) <- element "Error" $+        (,,)+        <$> getT "Type"+        <*> getT "Code"+        <*> getT "Message"+    rid <- getT "RequestId"+    lift $ monadThrow $ ClientError status c m rid

@@ -4,6 +4,8 @@     ( requestQuery     , QueryParam(..)     , Filter+    , maybeParams+    , commonQuery     ) where  import           Data.ByteString (ByteString)@@ -25,19 +27,17 @@ import qualified Data.Digest.Pure.SHA as SHA import qualified Data.ByteString.Base64 as BASE import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift) import Control.Exception.Lifted as E import Data.Text (Text)+import qualified Control.Monad.State as State+import qualified Control.Monad.Reader as Reader+--import qualified Data.Conduit.Binary as CB  import AWS.Class import AWS.Util-import AWS.EC2.Parser () import AWS.Credential--{- Debug-import Debug.Trace-import qualified Data.Conduit.Binary as CB-import System.IO (stdout)---}+import AWS.Lib.Parser  type Filter = (Text, [Text]) @@ -157,9 +157,32 @@     let req = request { HTTP.checkStatus = checkStatus' }     response <- HTTP.http req mgr     let body = HTTP.responseBody response+--    body $$+- CB.sinkFile "debug.txt" >> fail "debug"     let st = H.statusCode $ HTTP.responseStatus response     if st < 400         then return body         else do             clientError st body errSink             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)+    => ByteString -- ^ apiVersion+    -> ByteString -- ^ Action+    -> [QueryParam]+    -> GLSink Event m a+    -> AWS AWSContext m a+commonQuery apiVersion action params sink = do+    ctx <- State.get+    cred <- Reader.ask+    rs <- lift $ requestQuery cred ctx action params apiVersion sinkError+--    lift $ rs $$+- CB.sinkFile "debug.txt" >> fail "debug"+    (res, rid) <- lift $ rs $$+-+        XmlP.parseBytes XmlP.def =$ sinkResponse (bsToText action) sink+    State.put ctx { lastRequestId = Just rid }+    return res

@@ -6,40 +6,23 @@     , runRDS     , setRegion       -- * DBInstance-    , describeDBInstances+    , module AWS.RDS.DBInstance     ) where -import Data.ByteString (ByteString) import Data.Text (Text) import Data.Conduit-import Control.Applicative import Control.Monad.Trans.Control (MonadBaseControl)-import Control.Monad.Trans.Class (lift) import Control.Monad.IO.Class (MonadIO) import qualified Control.Monad.State as State-import qualified Control.Monad.Reader as Reader import qualified Network.HTTP.Conduit as HTTP import Data.Monoid ((<>))-import qualified Text.XML.Stream.Parse as XML-import Data.XML.Types (Event(..))-import Data.Maybe (catMaybes)  import AWS.Class import AWS.Util-import AWS.Lib.Query-import AWS.Lib.Parser  import AWS-import AWS.RDS.Types----import qualified Data.Conduit.Binary as CB--apiVersion :: ByteString-apiVersion = "2012-09-17"--type RequestId = Text--type RDS m a = AWS AWSContext m a+import AWS.RDS.Internal+import AWS.RDS.DBInstance  initialRDSContext :: HTTP.Manager -> AWSContext initialRDSContext mgr = AWSContext@@ -50,146 +33,6 @@  runRDS :: MonadIO m => Credential -> RDS m a -> m a runRDS = runAWS initialRDSContext--describeDBInstances-    :: (MonadBaseControl IO m, MonadResource m)-    => Maybe Text -- ^ DBInstanceIdentifier-    -> Maybe Int -- ^ MaxRecords-    -> Maybe Text -- ^ Marker-    -> RDS m [DBInstance]-describeDBInstances dbid maxRecords marker = do-    ctx <- State.get-    cred <- Reader.ask-    rs <- lift $ requestQuery cred ctx (textToBS action) params apiVersion undefined---    lift $ rs $$+- CB.sinkFile "debug.txt" >> fail "debug"-    (res, rid) <- lift $ rs $$+- XML.parseBytes XML.def =$ do-        sinkResponse action $ sinkDBInstances-    State.put ctx { lastRequestId = Just rid }-    return res-  where-    action = "DescribeDBInstances"-    mk name = maybe [] (\a -> [ValueParam name a])-    params = uncurry mk =<<-        [ ("DBInstanceIdentifier", dbid)-        , ("MaxRecords", toText <$> maxRecords)-        , ("Marker", marker)-        ]--elements :: MonadThrow m-    => Text-    -> GLSink Event m a-    -> GLSink Event m [a]-elements name f = element (name <> "s") $ listConsumer name f--sinkDBInstances-    :: MonadThrow m-    => GLSink Event m [DBInstance]-sinkDBInstances = elements "DBInstance" $-    DBInstance-    <$> getM "Iops" (textToInt <$>)-    <*> getF "BackupRetentionPeriod" textToInt-    <*> getF "MultiAZ" textToBool-    <*> getT "DBInstanceStatus"-    <*> getT "DBInstanceIdentifier"-    <*> getT "PreferredBackupWindow"-    <*> getT "PreferredMaintenanceWindow"-    <*> elementM "OptionGroupMembership"-        (OptionGroupMembership-        <$> getT "OptionGroupName"-        <*> getT "Status"-        )-    <*> getT "AvailabilityZone"-    <*> getM "LatestRestorableTime" (textToTime <$>)-    <*> elements "ReadReplicaDBInstanceIdentifier" text-    <*> getT "Engine"-    <*> sinkPendingModifiedValues-    <*> getMT "CharacterSetName"-    <*> getT "LicenseModel"-    <*> elementM "DBSubnetGroup"-        (DBSubnetGroup-        <$> getT "VpcId"-        <*> getT "SubnetGroupStatus"-        <*> getT "DBSubnetGroupDescription"-        <*> getT "DBSubnetGroupName"-        <*> elements "Subnet"-            (Subnet-            <$> getT "SubnetStatus"-            <*> getT "SubnetIdentifier"-            <*> element "SubnetAvailabilityZone"-                (AvailabilityZone-                <$> getT "Name"-                <*> getF "ProvisionedIopsCapable" textToBool-                )-            )-        )-    <*> elements "DBParameterGroup"-        (DBParameterGroupStatus-        <$> getT "ParameterApplyStatus"-        <*> getT "DBParameterGroupName"-        )-    <*> elementM "Endpoint"-        (Endpoint-        <$> getF "Port" textToInt-        <*> getT "Address"-        )-    <*> getT "EngineVersion"-    <*> getMT "ReadReplicaSourceDBInstanceIdentifier"-    <*> elements "DBSecurityGroup"-        (DBSecurityGroupMembership-        <$> getT "Status"-        <*> getT "DBSecurityGroupName"-        )-    <*> getMT "DBName"-    <*> getF "AutoMinorVersionUpgrade" textToBool-    <*> getM "InstanceCreateTime" (textToTime <$>)-    <*> getF "AllocatedStorage" textToInt-    <*> getT "DBInstanceClass"-    <*> getT "MasterUsername" --sinkPendingModifiedValues-    :: MonadThrow m-    => GLSink Event m [PendingModifiedValue]-sinkPendingModifiedValues = element "PendingModifiedValues" $-    catMaybes <$> sequence [ m "MasterUserPassword" PMVMasterUserPassword-        , m "Iops" (PMVIops . textToInt)-        , m "MultiAZ" (PMVMultiAZ . textToBool)-        , m "AllocatedStorage" (PMVAllocatedStorage . textToInt)-        , m "EngineVersion" PMVEngineVersion-        , m "DBInstanceClass" PMVDBInstanceClass-        , m "BackupRetentionPeriod"-            (PMVBackupRetentionPeriod . textToInt)-        , m "Port" (PMVPort . textToInt)-        ]-  where-    m t f = getM t (f <$>)--sinkResponse-    :: MonadThrow m-    => Text -- ^ Action-    -> GLSink Event m a-    -> GLSink Event m (a, RequestId)-sinkResponse action sink = do-    sinkEventBeginDocument-    element (action <> "Response") $ (,)-        <$> element (action <> "Result") sink -- XXX: parse Marker-        <*> sinkResponseMetadata--sinkResponseMetadata-    :: MonadThrow m-    => GLSink Event m Text-sinkResponseMetadata =-    element "ResponseMetadata" $-        getT "RequestId"--sinkEventBeginDocument-    :: MonadThrow m-    => GLSink Event m ()-sinkEventBeginDocument = do-    me <- await-    case me of-        Nothing -> return ()-        Just EventBeginDocument -> return ()-        Just _ -> fail $ "unexpected: " <> show me  setRegion     :: (MonadBaseControl IO m, MonadResource m)

@@ -0,0 +1,116 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.RDS.DBInstance+    ( describeDBInstances+    ) where++import Data.Text (Text)+import Data.Conduit+import Control.Applicative+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.XML.Types (Event(..))+import Data.Maybe (catMaybes)++import AWS.Util+import AWS.Lib.Query+import AWS.Lib.Parser++import AWS.RDS.Types+import AWS.RDS.Internal++describeDBInstances+    :: (MonadBaseControl IO m, MonadResource m)+    => Maybe Text -- ^ DBInstanceIdentifier+    -> Maybe Int -- ^ MaxRecords+    -> Maybe Text -- ^ Marker+    -> RDS m [DBInstance]+describeDBInstances dbid maxRecords marker =+    rdsQuery "DescribeDBInstances" params sinkDBInstances+  where+    params = maybeParams+        [ ("DBInstanceIdentifier", dbid)+        , ("MaxRecords", toText <$> maxRecords)+        , ("Marker", marker)+        ]++sinkDBInstances+    :: MonadThrow m+    => GLSink Event m [DBInstance]+sinkDBInstances = elements "DBInstance" $+    DBInstance+    <$> getM "Iops" (textToInt <$>)+    <*> getF "BackupRetentionPeriod" textToInt+    <*> getF "MultiAZ" textToBool+    <*> getT "DBInstanceStatus"+    <*> getT "DBInstanceIdentifier"+    <*> getT "PreferredBackupWindow"+    <*> getT "PreferredMaintenanceWindow"+    <*> elementM "OptionGroupMembership"+        (OptionGroupMembership+        <$> getT "OptionGroupName"+        <*> getT "Status"+        )+    <*> getT "AvailabilityZone"+    <*> getM "LatestRestorableTime" (textToTime <$>)+    <*> elements "ReadReplicaDBInstanceIdentifier" text+    <*> getT "Engine"+    <*> sinkPendingModifiedValues+    <*> getMT "CharacterSetName"+    <*> getT "LicenseModel"+    <*> elementM "DBSubnetGroup"+        (DBSubnetGroup+        <$> getT "VpcId"+        <*> getT "SubnetGroupStatus"+        <*> getT "DBSubnetGroupDescription"+        <*> getT "DBSubnetGroupName"+        <*> elements "Subnet"+            (Subnet+            <$> getT "SubnetStatus"+            <*> getT "SubnetIdentifier"+            <*> element "SubnetAvailabilityZone"+                (AvailabilityZone+                <$> getT "Name"+                <*> getF "ProvisionedIopsCapable" textToBool+                )+            )+        )+    <*> elements "DBParameterGroup"+        (DBParameterGroupStatus+        <$> getT "ParameterApplyStatus"+        <*> getT "DBParameterGroupName"+        )+    <*> elementM "Endpoint"+        (Endpoint+        <$> getF "Port" textToInt+        <*> getT "Address"+        )+    <*> getT "EngineVersion"+    <*> getMT "ReadReplicaSourceDBInstanceIdentifier"+    <*> elements "DBSecurityGroup"+        (DBSecurityGroupMembership+        <$> getT "Status"+        <*> getT "DBSecurityGroupName"+        )+    <*> getMT "DBName"+    <*> getF "AutoMinorVersionUpgrade" textToBool+    <*> getM "InstanceCreateTime" (textToTime <$>)+    <*> getF "AllocatedStorage" textToInt+    <*> getT "DBInstanceClass"+    <*> getT "MasterUsername" ++sinkPendingModifiedValues+    :: MonadThrow m+    => GLSink Event m [PendingModifiedValue]+sinkPendingModifiedValues = element "PendingModifiedValues" $+    catMaybes <$> sequence [ m "MasterUserPassword" PMVMasterUserPassword+        , m "Iops" (PMVIops . textToInt)+        , m "MultiAZ" (PMVMultiAZ . textToBool)+        , m "AllocatedStorage" (PMVAllocatedStorage . textToInt)+        , m "EngineVersion" PMVEngineVersion+        , m "DBInstanceClass" PMVDBInstanceClass+        , m "BackupRetentionPeriod"+            (PMVBackupRetentionPeriod . textToInt)+        , m "Port" (PMVPort . textToInt)+        ]+  where+    m t f = getM t (f <$>)

@@ -0,0 +1,34 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.RDS.Internal+    where++import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Monoid ((<>))+import Data.XML.Types (Event(..))++import AWS.Class+import AWS.Lib.Query+import AWS.Lib.Parser++apiVersion :: ByteString+apiVersion = "2012-09-17"++type RDS m a = AWS AWSContext m a++rdsQuery+    :: (MonadBaseControl IO m, MonadResource m)+    => ByteString -- ^ Action+    -> [QueryParam]+    -> GLSink Event m a+    -> RDS m a+rdsQuery = commonQuery apiVersion++elements :: MonadThrow m+    => Text+    -> GLSink Event m a+    -> GLSink Event m [a]+elements name f = element (name <> "s") $ listConsumer name f

@@ -1,5 +1,5 @@ name:                aws-sdk-version:             0.3.0.0+version:             0.4.0.0 synopsis:            AWS SDK for Haskell description:         An AWS(Amazon Web Services) liblary for Haskell. license:             BSD3@@ -20,6 +20,8 @@                    , AWS.EC2.Util                    , AWS.RDS                    , AWS.RDS.Types+                   , AWS.ELB+                   , AWS.ELB.Types   other-modules:     AWS.Util                    , AWS.Credential                    , AWS.Class@@ -32,14 +34,16 @@                    , AWS.EC2.KeyPair                    , AWS.EC2.Snapshot                    , AWS.EC2.SecurityGroup-                   , AWS.EC2.Parser                    , AWS.EC2.Query                    , AWS.EC2.Region                    , AWS.EC2.Tag-                   , AWS.EC2.Parser                    , AWS.EC2.Params                    , AWS.Lib.Parser                    , AWS.Lib.Query+                   , AWS.RDS.Internal+                   , AWS.RDS.DBInstance+                   , AWS.ELB.Internal+                   , AWS.ELB.LoadBalancer   ghc-options:       -Wall                      -fno-warn-unused-do-bind   extensions: OverloadedStrings