diff --git a/AWS/EC2.hs b/AWS/EC2.hs --- a/AWS/EC2.hs +++ b/AWS/EC2.hs @@ -35,6 +35,7 @@ , module AWS.EC2.Acl , module AWS.EC2.RouteTable , module AWS.EC2.Route + , module AWS.EC2.PlacementGroup ) where import Data.Conduit @@ -65,6 +66,7 @@ import AWS.EC2.RouteTable import AWS.EC2.NetworkInterface import AWS.EC2.NetworkInterfaceAttribute +import AWS.EC2.PlacementGroup -- | set endpoint to EC2 context by giving the EC2 region. setRegion diff --git a/AWS/EC2/Instance.hs b/AWS/EC2/Instance.hs --- a/AWS/EC2/Instance.hs +++ b/AWS/EC2/Instance.hs @@ -14,6 +14,8 @@ , describeInstanceAttribute , resetInstanceAttribute , modifyInstanceAttribute + , monitorInstances + , unmonitorInstances ) where import Data.Text (Text) @@ -40,6 +42,7 @@ -> [Filter] -- ^ Filters -> EC2 m (ResumableSource m Reservation) describeInstances instances filters = do +-- ec2QueryDebug "DescribeInstances" params ec2QuerySource "DescribeInstances" params $ itemConduit "reservationSet" reservationSink where @@ -180,6 +183,7 @@ instanceNetworkInterfaceAssociationSink = elementM "association" $ InstanceNetworkInterfaceAssociation <$> getT "publicIp" + <*> getT "publicDnsName" <*> getT "ipOwnerId" ------------------------------------------------------------ @@ -547,3 +551,33 @@ "GroupId" |.#= a miap (ModifyInstanceAttributeRequestEbsOptimized a) = "EbsOptimized" |= toText a + +------------------------------------------------------------ +-- MonitorInstances +------------------------------------------------------------ +monitorInstances + :: (MonadResource m, MonadBaseControl IO m) + => [Text] -- ^ InstanceIds + -> EC2 m (ResumableSource m MonitorInstancesResponse) +monitorInstances iids = + ec2QuerySource "MonitorInstances" ["InstanceId" |.#= iids] + monitorInstancesResponseSink + +monitorInstancesResponseSink + :: (MonadResource m, MonadBaseControl IO m) + => Conduit Event m MonitorInstancesResponse +monitorInstancesResponseSink = itemConduit "instancesSet" $ + MonitorInstancesResponse + <$> getT "instanceId" + <*> element "monitoring" (getT "state") + +------------------------------------------------------------ +-- UnmonitorInstances +------------------------------------------------------------ +unmonitorInstances + :: (MonadResource m, MonadBaseControl IO m) + => [Text] -- ^ InstanceIds + -> EC2 m (ResumableSource m MonitorInstancesResponse) +unmonitorInstances iids = + ec2QuerySource "UnmonitorInstances" ["InstanceId" |.#= iids] + monitorInstancesResponseSink diff --git a/AWS/EC2/PlacementGroup.hs b/AWS/EC2/PlacementGroup.hs new file mode 100644 --- /dev/null +++ b/AWS/EC2/PlacementGroup.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE FlexibleContexts #-} +module AWS.EC2.PlacementGroup + ( describePlacementGroups + , createPlacementGroup + , deletePlacementGroup + ) where + +import Control.Applicative ((<$>), (<*>)) +import Data.Conduit +import Data.Text (Text) +import Data.XML.Types (Event) + +import AWS.EC2.Internal (EC2, itemConduit) +import AWS.EC2.Query (ec2Query, ec2QuerySource) +import AWS.EC2.Types (Filter, PlacementGroup(..), PlacementGroupStrategy(..)) +import AWS.Lib.Parser (getT) +import AWS.Lib.Query ((|=), (|.#=), filtersParam) + +describePlacementGroups + :: (MonadResource m, MonadBaseControl IO m) + => [Text] -- ^ Placement group names. + -> [Filter] -- ^ Filters + -> EC2 m (ResumableSource m PlacementGroup) +describePlacementGroups groupNames filters = + ec2QuerySource "DescribePlacementGroups" params $ + itemConduit "placementGroupSet" placementGroupSink + where + params = + [ "GroupName" |.#= groupNames + , filtersParam filters + ] + +placementGroupSink :: MonadThrow m => GLSink Event m PlacementGroup +placementGroupSink = + PlacementGroup + <$> getT "groupName" + <*> getT "strategy" + <*> getT "state" + +createPlacementGroup + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ A name for the placement group. + -> PlacementGroupStrategy -- ^ The placement group strategy. + -> EC2 m Bool +createPlacementGroup groupName strategy = + ec2Query "CreatePlacementGroup" params $ getT "return" + where + params = + [ "GroupName" |= groupName + , "Strategy" |= stringifyStrategy strategy + ] + +stringifyStrategy :: PlacementGroupStrategy -> Text +stringifyStrategy PlacementGroupStrategyCluster = "cluster" + +deletePlacementGroup + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ The name of the placement group. + -> EC2 m Bool +deletePlacementGroup groupName = + ec2Query "DeletePlacementGroup" ["GroupName" |= groupName] $ getT "return" diff --git a/AWS/EC2/Types.hs b/AWS/EC2/Types.hs --- a/AWS/EC2/Types.hs +++ b/AWS/EC2/Types.hs @@ -63,6 +63,7 @@ , IpPermission(..) , KeyPair(..) , ModifyInstanceAttributeRequest(..) + , MonitorInstancesResponse(..) , LaunchPermission(..) , LaunchPermissionItem(..) , NetworkAcl(..) @@ -78,6 +79,9 @@ , NetworkInterfaceStatus(..) , PasswordData(..) , Placement(..) + , PlacementGroup(..) + , PlacementGroupState(..) + , PlacementGroupStrategy(..) , Platform(..) , PortRange(..) , ProductCode(..) @@ -422,10 +426,29 @@ } deriving (Show, Read, Eq) +data PlacementGroup = PlacementGroup + { placementGroupGroupName :: Text + , placementGroupStrategy :: PlacementGroupStrategy + , placementGroupState :: PlacementGroupState + } + deriving (Show, Read, Eq) + +data PlacementGroupState + = PlacementGroupStatePending + | PlacementGroupStateAvailable + | PlacementGroupStateDeleting + | PlacementGroupStateDeleted + deriving (Show, Read, Eq) + +data PlacementGroupStrategy + = PlacementGroupStrategyCluster + deriving (Show, Read, Eq) + data InstanceMonitoringState = MonitoringDisabled | MonitoringEnabled | MonitoringPending + | MonitoringDisabling deriving (Show, Read, Eq) data Architecture = I386 | X86_64 deriving (Show, Read, Eq) @@ -482,7 +505,9 @@ data InstanceNetworkInterfaceAssociation = InstanceNetworkInterfaceAssociation - { instanceNetworkInterfaceAssociationPublicIp :: Text + { instanceNetworkInterfaceAssociationPublicIp :: IPv4 + , instanceNetworkInterfaceAssociationPublicDnsName + :: Maybe Text , instanceNetworkInterfaceAssociationIpOwnerId :: Text } deriving (Show, Read, Eq) @@ -578,15 +603,22 @@ } deriving (Show, Read, Eq) +data MonitorInstancesResponse = MonitorInstancesResponse + { monitorInstancesResponseInstanceId :: Text + , monitorInstancesResponseInstanceMonitoringState + :: InstanceMonitoringState + } + deriving (Show, Read, Eq) + data Snapshot = Snapshot { snapshotId :: Text - , snapshotVolumeId :: Text + , snapshotVolumeId :: Maybe Text , snapshotStatus :: SnapshotStatus , snapshotStartTime :: UTCTime - , snapshotProgress :: Text + , snapshotProgress :: Maybe Text , snapshotOwnerId :: Text , snapshotVolumeSize :: Int - , snapshotDescription :: Text + , snapshotDescription :: Maybe Text , snapshotOwnerAlias :: Maybe Text , snapshotTagSet :: [ResourceTag] } @@ -1235,7 +1267,7 @@ , networkInterfaceSubnetId :: Text , networkInterfaceVpcId :: Text , networkInterfaceAvailabilityZone :: Text - , networkInterfaceDescription :: Text + , networkInterfaceDescription :: Maybe Text , networkInterfaceOwnerId :: Text , networkInterfaceRequesterId :: Maybe Text , networkInterfaceRequesterManaged :: Text @@ -1337,7 +1369,7 @@ deriveFromText "InstanceStatusTypeStatus" ["ok", "impaired", "insufficient-data", "not-applicable"] deriveFromText "InstanceMonitoringState" - ["disabled", "enabled", "pending"] + ["disabled", "enabled", "pending", "disabling"] deriveFromText "Architecture" ["i386", "x86_64"] deriveFromText "SnapshotStatus" ["pending", "completed", "error"] deriveFromText "VolumeState" @@ -1377,3 +1409,5 @@ deriveFromText "InternetGatewayAttachmentState" ["attaching", "attached", "detaching", "detached", "available"] deriveFromText "NetworkInterfaceStatus" ["available", "in-use", "pending"] +deriveFromText "PlacementGroupState" ["pending", "available", "deleting", "deleted"] +deriveFromText "PlacementGroupStrategy" ["cluster"] diff --git a/AWS/Lib/FromText.hs b/AWS/Lib/FromText.hs --- a/AWS/Lib/FromText.hs +++ b/AWS/Lib/FromText.hs @@ -39,7 +39,7 @@ where fromText = return . join . fromTextMay fromMaybeText _name Nothing = return Nothing - fromMaybeText _name (Just t) = fromText t >>= return . Just + fromMaybeText _name (Just t) = return $ fromTextMay t fromTextMay = Just . fromTextMay instance FromText Int @@ -50,7 +50,9 @@ instance FromText Text where - fromTextMay = Just + fromTextMay t + | t == "" = Nothing + | otherwise = Just t instance FromText Bool where diff --git a/AWS/Lib/Parser.hs b/AWS/Lib/Parser.hs --- a/AWS/Lib/Parser.hs +++ b/AWS/Lib/Parser.hs @@ -27,7 +27,7 @@ import qualified Data.Conduit.List as CL import qualified Text.XML.Stream.Parse as XML import Control.Applicative -import Data.Monoid +import Data.Monoid ((<>)) import Control.Monad.Trans.Class (lift) import AWS.Class diff --git a/AWS/Lib/Query.hs b/AWS/Lib/Query.hs --- a/AWS/Lib/Query.hs +++ b/AWS/Lib/Query.hs @@ -98,7 +98,7 @@ filtersParam :: [Filter] -> QueryParam filtersParam filters = "Filter" |.#. transpose [keyParams, valParams] where - keyParams = map (("Key" |=) . fst) filters + keyParams = map (("Name" |=) . fst) filters valParams = map (("Value" |.#=) . snd) filters maybeParam :: Maybe QueryParam -> QueryParam diff --git a/Tests/Main.hs b/Tests/Main.hs --- a/Tests/Main.hs +++ b/Tests/Main.hs @@ -27,6 +27,7 @@ runKeyPairTests runNetworkInterfaceTests runNetworkInterfaceAttributeTests + runPlacementGroupTests -- RDS Tests runDBInstanceTests diff --git a/aws-sdk.cabal b/aws-sdk.cabal --- a/aws-sdk.cabal +++ b/aws-sdk.cabal @@ -1,5 +1,5 @@ name: aws-sdk -version: 0.9.0.0 +version: 0.9.1.0 synopsis: AWS SDK for Haskell description: AWS (Amazon Web Services) sdk for Haskell. . @@ -53,6 +53,7 @@ , AWS.EC2.NetworkInterfaceAttribute , AWS.EC2.Tag , AWS.EC2.Params + , AWS.EC2.PlacementGroup , AWS.Lib.FromText , AWS.Lib.Parser , AWS.Lib.Query