aws-sdk 0.4.0.0 → 0.4.1.0

raw patch · 9 files changed

+415/−20 lines, 9 filesdep +parsecdep −parsec3dep ~simple-configPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: parsec

Dependencies removed: parsec3

Dependency ranges changed: simple-config

API changes (from Hackage documentation)

Files

• AWS/EC2.hs +3/−0
• AWS/EC2/Image.hs +46/−2
• AWS/EC2/Metadata.hs +175/−0
• AWS/EC2/Params.hs +5/−5
• AWS/EC2/Query.hs +22/−4
• AWS/EC2/Types.hs +89/−2
• AWS/EC2/VPC.hs +64/−0
• AWS/Lib/Query.hs +5/−2
• aws-sdk.cabal +6/−5

@@ -25,6 +25,8 @@     , module AWS.EC2.AvailabilityZone       -- * Tags     , module AWS.EC2.Tag+      -- * VPC+    , module AWS.EC2.VPC     ) where  import Data.Conduit@@ -48,6 +50,7 @@ import AWS.EC2.Volume import AWS.EC2.KeyPair import AWS.EC2.SecurityGroup+import AWS.EC2.VPC  -- | set endpoint to EC2 context. setRegion

@@ -3,6 +3,9 @@ module AWS.EC2.Image     ( describeImages     , createImage+    , registerImage+    , RegisterImageRequest(..)+    , deregisterImage     ) where  import Data.Text (Text)@@ -27,8 +30,8 @@     -> [Filter] -- ^ Filers     -> EC2 m (Source m Image) describeImages imageIds owners execby filters =-    ec2QuerySource "DescribeImages" params $-        itemConduit "imagesSet" imageItem+    ec2QuerySource "DescribeImages" params $ itemConduit "imagesSet" imageItem+--    ec2QueryDebug "DescribeImages" params   where     params =         [ ArrayParams "ImageId" imageIds@@ -52,9 +55,11 @@     <*> getMT "ramdiskId"     <*> getM "platform" platform     <*> stateReasonSink+    <*> getM "viridianEnabled" (textToBool <$>)     <*> getMT "imageOwnerAlias"     <*> getM "name" orEmpty     <*> getM "description" orEmpty+    <*> itemsSet "billingProducts" (getT "billingProduct")     <*> getF "rootDeviceType" rootDeviceType     <*> getMT "rootDeviceName"     <*> itemsSet "blockDeviceMapping" (@@ -91,3 +96,42 @@         , ValueParam "NoReboot" (boolToText noReboot)         ] ++ param "Description" desc           ++ [blockDeviceMappingParams bdms]++data RegisterImageRequest = RegisterImageRequest+    { rirName :: Text+    , rirImageLocation :: Maybe Text+    , rirDescription :: Maybe Text+    , rirArchitecture :: Maybe Text+    , rirKernelId :: Maybe Text+    , rirRamdiskId :: Maybe Text+    , rirRootDeviceName :: Maybe Text+    , rirBlockDeviceMappings :: [BlockDeviceMappingParam]+    }+  deriving (Show)++registerImage+    :: (MonadResource m, MonadBaseControl IO m)+    => RegisterImageRequest+    -> EC2 m Text+registerImage req =+    ec2Query "RegisterImage" params $ getT "imageId"+  where+    params = [ValueParam "Name" $ rirName req]+        ++ [blockDeviceMappingParams $ rirBlockDeviceMappings req]+        ++ maybeParams+            [ ("ImageLocation", rirImageLocation req)+            , ("Description", rirDescription req)+            , ("Architecture", rirArchitecture req)+            , ("KernelId", rirKernelId req)+            , ("RamdiskId", rirRamdiskId req)+            , ("RootDeviceName", rirRootDeviceName req)+            ] ++deregisterImage+    :: (MonadResource m, MonadBaseControl IO m)+    => Text -- ^ ImageId+    -> EC2 m Bool+deregisterImage iid =+    ec2Query "DeregisterImage" params returnBool+  where+    params = [ValueParam "ImageId" iid]

@@ -0,0 +1,175 @@+-- | EC2 Meta-data service.+--   This is available to use within EC2/VPC instance.+module AWS.EC2.Metadata+    ( latestVersion+      -- * Meta-data+    , amiId+    , amiLaunchIndex+    , amiManifestPath+    , blockDeviceMapping+    , hostname+    , instanceAction+    , instanceId+    , instanceType+    , kernelId+    , localHostname+    , localIpv4+    , mac+    , metrics+    , interfaces+    , availabilityZone+    , profile+    , publicKeys+    , reservationId+    , securityGroups+      -- * User-data+    , userdata+      -- * Instance identity+    , idPkcs7+    , idSignature+    , idDocument+    , query+	) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Data.Text (Text)+import Data.Conduit+import Network.HTTP.Conduit hiding (path)+import Control.Monad.IO.Class (liftIO)+import Data.Monoid+import Control.Applicative+import Control.Exception++import qualified Data.Conduit.Binary as CB+import qualified Data.Conduit.List as CL++import AWS.Util++base :: String+base = "http://169.254.169.254"++version :: String+version = "/latest"++query :: String -> IO [ByteString]+query path = runResourceT $ do+    req <- liftIO $ parseUrl (base <> path)+    mgr <- liftIO $ newManager def+    Response _ _ _ res <- http req mgr+    res $$+- CB.lines =$ CL.consume++latestVersion :: IO Text+latestVersion = bsToText . last . init <$> query ""++metadata :: String -> IO [ByteString]+metadata path = query $ version <> "/meta-data/" <> path++h :: Functor f => f [ByteString] -> f Text+h = fmap (bsToText . head)++t :: [ByteString] -> [Text]+t = map bsToText++ignore :: IO (Maybe a) -> IO (Maybe a)+ignore io = handle ignore' io+  where+    ignore' :: HttpException -> IO (Maybe a)+    ignore' _ = return Nothing++amiId :: IO Text+amiId = h $ metadata "ami-id"++amiLaunchIndex :: IO Text+amiLaunchIndex = h $ metadata "ami-launch-index"++amiManifestPath :: IO Text+amiManifestPath = h $ metadata "ami-manifest-path"++blockDeviceMapping :: IO [(Text, Text)]+blockDeviceMapping = do+    bs <- metadata bdm+    ds <- mapM (\b -> head <$> (metadata $ bdm <> BC.unpack b)) bs+    return $ zip (t bs) (t ds)+  where+    bdm = "block-device-mapping/"++hostname :: IO Text+hostname = h $ metadata "hostname"++instanceAction :: IO Text+instanceAction = h $ metadata "instance-action"++instanceId :: IO Text+instanceId = h $ metadata "instance-id"++instanceType :: IO Text+instanceType = h $ metadata "instance-type"++kernelId :: IO Text+kernelId = h $ metadata "kernel-id"++localHostname :: IO Text+localHostname = h $ metadata "local-hostname"++localIpv4 :: IO Text+localIpv4 = h $ metadata "local-ipv4"++mac :: IO Text+mac = h $ metadata "mac"++metrics :: IO Text+metrics = h $ metadata "metrics/vhostmd"++interfaces :: IO [(Text, [(Text, Text)])]+interfaces = do+    ms <- metadata macs+    vs <- mapM (\b -> (val b)) ms+    ts <- mapM (uncurry f) (zip ms vs)+    return $ zip (map (bsToText . BC.init) ms) ts+  where+    macs = "network/interfaces/macs/"+    f m ks = zip (t ks) <$> mapM (kv m) ks+    kv m k = bsToText . head <$> val (m <> k)+    val k = metadata $ macs <> BC.unpack k++availabilityZone :: IO Text+availabilityZone = h $ metadata "placement/availability-zone"++profile :: IO Text+profile = h $ metadata "profile"++publicKeys :: IO [Text]+publicKeys = t <$> metadata "public-keys"++reservationId :: IO Text+reservationId = h $ metadata "reservation-id"++securityGroups :: IO [Text]+securityGroups = t <$> metadata "security-groups"++userdata :: IO (Maybe Text)+userdata = ignore $+    Just <$> (h <$> query $ version <> "/user-data")++queryRaw :: String -> IO ByteString+queryRaw path = runResourceT $ do+    req <- liftIO $ parseUrl (base <> path)+    mgr <- liftIO $ newManager def+    Response _ _ _ res <- http req mgr+    mconcat <$> (res $$+- CL.consume)++identity :: String -> IO Text+identity name =+    bsToText <$> (queryRaw $ is <> name)+  where+    is = version <> "/dynamic/instance-identity/"++idPkcs7 :: IO Text+idPkcs7 = identity "pkcs7"++idSignature :: IO Text+idSignature = identity "signature"++idDocument :: IO Text+idDocument = identity "document"

@@ -13,16 +13,16 @@     StructArrayParams "BlockDeviceMapping" . map kvs   where     kvs (BlockDeviceMappingParamEBS name dev src dot vtype) = -        [ ("Ebs.DeviceName", name)+        [ ("DeviceName", name)         , ebsSource src         ] ++ vtparam vtype ++ (uncurry f =<<-            [ ("Ebs.NoDevice", boolToText <$> dev)+            [ ("NoDevice", boolToText <$> dev)             , ("Ebs.DeleteOnTermination", boolToText <$> dot)             ])     kvs (BlockDeviceMappingParamInstanceStore name dev vname) =-        [("Ebs.DeviceName", name)] ++ (uncurry f =<<-            [ ("Ebs.NoDevice", boolToText <$> dev)-            , ("Ebs.VirtualName", vname)+        [("DeviceName", name)] ++ (uncurry f =<<+            [ ("NoDevice", boolToText <$> dev)+            , ("VirtualName", vname)             ])      ebsSource (EbsSnapshotId sid) = ("Ebs.SnapshotId", sid)

@@ -1,9 +1,12 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE FlexibleContexts, RankNTypes, CPP #-}  module AWS.EC2.Query     ( ec2Query     , ec2QuerySource     , ec2QuerySource'+#ifdef DEBUG+    , ec2QueryDebug+#endif     , module AWS.Lib.Query     ) where @@ -27,13 +30,13 @@ import AWS.Lib.Parser hiding (sinkError) import AWS.Lib.Query -{- Debug+#ifdef DEBUG import Debug.Trace import qualified Data.Conduit.Binary as CB---}+#endif  ec2Version :: ByteString-ec2Version = "2012-08-15"+ec2Version = "2012-10-01"  sinkRequestId :: MonadThrow m     => GLSink Event m Text@@ -101,3 +104,18 @@         case mt of             Nothing -> return ()             Just t  -> E.throw $ NextToken t++#ifdef DEBUG+ec2QueryDebug+    :: (MonadResource m, MonadBaseControl IO m)+    => ByteString+    -> [QueryParam]+    -> EC2 m (Source m o)+ec2QueryDebug action params = do+    cred <- Reader.ask+    ctx <- State.get+    lift $ do+        response <- requestQuery cred ctx action params ec2Version sinkError+        (res, _) <- unwrapResumable response+        res $$ CB.sinkFile "debug.txt" >>= fail "debug"+#endif

@@ -19,9 +19,11 @@     , ramdiskId :: Maybe Text     , imagePlatform :: Platform     , imageStateReason :: Maybe StateReason+    , imageViridianEnabled :: Maybe Bool     , imageOwnerAlias :: Maybe Text     , imageName :: Text     , imageDescription :: Text+    , imageBillingProducts :: [Text]     , imageRootDeviceType :: RootDeviceType     , imageRootDeviceName :: Maybe Text     , blockDeviceMappings :: [BlockDeviceMapping]@@ -88,8 +90,9 @@     }   deriving (Show) -data RootDeviceType = EBS-                    | InstanceStore+data RootDeviceType+    = EBS+    | InstanceStore   deriving (Show)  rootDeviceType :: Text -> RootDeviceType@@ -652,3 +655,87 @@     , nipDeleteOnTermination :: Maybe Bool     }   deriving (Show)++data VpnConnection = VpnConnection+    { vpnConnectionId :: Text+    , vcState :: VpnConnectionState+    , vcCustomerGatewayConfiguration :: Text+    , vcType :: Text+    , vcCustomerGatewayId :: Text+    , vcVpnGatewayId :: Text+    , vcTagSet :: [ResourceTag]+    , vcVgwTelemetry :: [VpnTunnelTelemetry]+    , vcOptions :: Maybe VpnConnectionOptionsRequest+    , vcRoutes :: Maybe VpnStaticRoute+    }+  deriving (Show)++data VpnConnectionState+    = VCSPending+    | VCSAvailable+    | VCSDeleting+    | VCSDeleted+  deriving (Show)++vpnConnectionState :: Text -> VpnConnectionState+vpnConnectionState t+    | t == "pending"   = VCSPending+    | t == "available" = VCSAvailable+    | t == "deleting"  = VCSDeleting+    | t == "deleted"   = VCSDeleted+    | otherwise        = err "vpn connection state" t++data VpnTunnelTelemetry = VpnTunnelTelemetry+    { vttOutsideIpAddress :: Text+    , vttStatus :: VpnTunnelTelemetryStatus+    , vttLastStatusChange :: UTCTime+    , vttStatusMessage :: Text+    , vttAcceptRouteCount :: Int+    }+  deriving (Show)++data VpnTunnelTelemetryStatus+    = VTTSUp+    | VTTSDown+  deriving (Show)++vpnTunnelTelemetryStatus :: Text -> VpnTunnelTelemetryStatus+vpnTunnelTelemetryStatus t+    | t == "UP"   = VTTSUp+    | t == "DOWN" = VTTSDown+    | otherwise   = err "vpn tunnel telemetry status" t++data VpnConnectionOptionsRequest = VpnConnectionOptionsRequest+    { staticRoutesOnly :: Bool+    }+  deriving (Show)++data VpnStaticRoute = VpnStaticRoute+    { vsrDestinationCidrBlock :: Text+    , vsrSource :: VpnStaticRouteSource+    , vsrState :: VpnStaticRouteState+    }+  deriving (Show)++data VpnStaticRouteSource = VSRStatic+  deriving (Show)++vpnStaticRouteSource :: Text -> VpnStaticRouteSource+vpnStaticRouteSource t+    | t == "Static" = VSRStatic+    | otherwise     = err "vpn static route source" t++data VpnStaticRouteState+    = VSRSPending+    | VSRSAvailable+    | VSRSDeleting+    | VSRSDeleted+  deriving (Show)++vpnStaticRouteState :: Text -> VpnStaticRouteState+vpnStaticRouteState t+    | t == "pending"   = VSRSPending+    | t == "available" = VSRSAvailable+    | t == "deleting"  = VSRSDeleting+    | t == "deleted"   = VSRSDeleted+    | otherwise        = err "vpn static route state" t

@@ -0,0 +1,64 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.EC2.VPC+    ( describeVpnConnections+    ) where++import Data.Text (Text)++import Data.XML.Types (Event)+import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Applicative++import AWS.EC2.Internal+import AWS.EC2.Types+import AWS.EC2.Query+import AWS.Lib.Parser+import AWS.Util++import Debug.Trace++describeVpnConnections+    :: (MonadBaseControl IO m, MonadResource m)+    => [Text] -- ^ VpnConnectionIds+    -> [Filter]+    -> EC2 m (Source m VpnConnection)+describeVpnConnections ids filters =+    ec2QuerySource "DescribeVpnConnections" params vpnConnectionConduit+  where+    params = [ArrayParams "VpnConnectionId" ids]+        ++ [FilterParams filters]++vpnConnectionConduit+    :: (MonadBaseControl IO m, MonadResource m)+    => GLConduit Event m VpnConnection+vpnConnectionConduit = itemConduit "vpnConnectionSet" $+    VpnConnection+    <$> do+        a <- getT "vpnConnectionId"+        traceShow a $ return a+    <*> getF "state" vpnConnectionState+    <*> getT "customerGatewayConfiguration"+    <*> getT "type"+    <*> getT "customerGatewayId"+    <*> getT "vpnGatewayId"+    <*> resourceTagSink+    <*> itemsSet "vgwTelemetry"+        (VpnTunnelTelemetry+        <$> getT "outsideIpAddress"+        <*> getF "status" vpnTunnelTelemetryStatus+        <*> getF "lastStatusChange" textToTime+        <*> getT "statusMessage"+        <*> getF "acceptedRouteCount" textToInt+        )+    <*> elementM "options"+        (VpnConnectionOptionsRequest+        <$> getF "staticRoutesOnly" textToBool+        )+    <*> elementM "routes"+        (VpnStaticRoute+        <$> getT "destinationCidrBlock"+        <*> getF "source" vpnStaticRouteSource+        <*> getF "state" vpnStaticRouteState+        )

@@ -59,7 +59,7 @@     , ("Version", ver)     , ("SignatureVersion", "2")     , ("SignatureMethod", "HmacSHA256")-    , ("Timestamp", H.urlEncode True $ awsTimeFormat time)+    , ("Timestamp", awsTimeFormat time)     , ("AWSAccessKeyId", accessKey cred)     ] @@ -110,7 +110,10 @@ queryStr :: Map ByteString ByteString -> ByteString queryStr = BS.intercalate "&" . Map.foldrWithKey' concatWithEqual []   where-    concatWithEqual key val acc = key <> "=" <> val : acc+    concatWithEqual key val acc+        = key+        <> "="+        <> (H.urlEncode True val) : acc  awsTimeFormat :: UTCTime -> ByteString awsTimeFormat = BSC.pack . formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ")

@@ -1,5 +1,5 @@ name:                aws-sdk-version:             0.4.0.0+version:             0.4.1.0 synopsis:            AWS SDK for Haskell description:         An AWS(Amazon Web Services) liblary for Haskell. license:             BSD3@@ -18,12 +18,12 @@                    , AWS.EC2                    , AWS.EC2.Types                    , AWS.EC2.Util+                   , AWS.EC2.Metadata                    , AWS.RDS                    , AWS.RDS.Types                    , AWS.ELB                    , AWS.ELB.Types-  other-modules:     AWS.Util-                   , AWS.Credential+  other-modules:     AWS.Util , AWS.Credential                    , AWS.Class                    , AWS.EC2.Internal                    , AWS.EC2.Address@@ -36,6 +36,7 @@                    , AWS.EC2.SecurityGroup                    , AWS.EC2.Query                    , AWS.EC2.Region+                   , AWS.EC2.VPC                    , AWS.EC2.Tag                    , AWS.EC2.Params                    , AWS.Lib.Parser@@ -64,8 +65,8 @@                    , text                    , monad-control                    , safe-                   , simple-config >= 1.1.0-                   , parsec3+                   , simple-config >= 1.1.1.0+                   , parsec                    , mtl                    , lifted-base                    , transformers-base