diff --git a/AWS/EC2.hs b/AWS/EC2.hs --- a/AWS/EC2.hs +++ b/AWS/EC2.hs @@ -27,6 +27,9 @@ , module AWS.EC2.Tag -- * VPC , module AWS.EC2.VPC + , module AWS.EC2.Subnets + , module AWS.EC2.Acl + , module AWS.EC2.RouteTable ) where import Data.Conduit @@ -51,6 +54,9 @@ import AWS.EC2.KeyPair import AWS.EC2.SecurityGroup import AWS.EC2.VPC +import AWS.EC2.Subnets +import AWS.EC2.Acl +import AWS.EC2.RouteTable -- | set endpoint to EC2 context. setRegion diff --git a/AWS/EC2/Acl.hs b/AWS/EC2/Acl.hs new file mode 100644 --- /dev/null +++ b/AWS/EC2/Acl.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE FlexibleContexts, RankNTypes #-} + +module AWS.EC2.Acl + ( describeNetworkAcls + , createNetworkAcl + , deleteNetworkAcl + , replaceNetworkAclAssociation + , createNetworkAclEntry + , deleteNetworkAclEntry + , replaceNetworkAclEntry + ) 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 + +describeNetworkAcls + :: (MonadResource m, MonadBaseControl IO m) + => [Text] -- ^ NetworkAclId + -> [Filter] -- ^ Filters + -> EC2 m (ResumableSource m NetworkAcl) +describeNetworkAcls nids filters = do + ec2QuerySource "DescribeNetworkAcls" params $ + itemConduit "networkAclSet" networkAclSink + where + params = + [ ArrayParams "NetworkAclId" nids + , FilterParams filters + ] + +networkAclSink :: MonadThrow m + => GLSink Event m NetworkAcl +networkAclSink = NetworkAcl + <$> getT "networkAclId" + <*> getT "vpcId" + <*> getF "default" textToBool + <*> itemsSet "entrySet" (NetworkAclEntry + <$> getF "ruleNumber" textToInt + <*> getF "protocol" textToInt + <*> getF "ruleAction" networkAclRuleAction + <*> getF "egress" textToBool + <*> getT "cidrBlock" + <*> elementM "icmpTypeCode" (IcmpTypeCode + <$> getF "code" textToInt + <*> getF "type" textToInt + ) + <*> elementM "portRange" (PortRange + <$> getF "from" textToInt + <*> getF "to" textToInt)) + <*> itemsSet "associationSet" (NetworkAclAssociation + <$> getT "networkAclAssociationId" + <*> getT "networkAclId" + <*> getT "subnetId" + ) + <*> resourceTagSink + +createNetworkAcl + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ VpcId + -> EC2 m NetworkAcl +createNetworkAcl vpcid = + ec2Query "CreateNetworkAcl" params $ + element "networkAcl" networkAclSink + where + params = [ValueParam "VpcId" vpcid] + +deleteNetworkAcl + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ NetworkAclId + -> EC2 m Bool +deleteNetworkAcl aclid = + ec2Query "DeleteNetworkAcl" params returnBool + where + params = [ValueParam "NetworkAclId" aclid] + +replaceNetworkAclAssociation + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ AssociationId + -> Text -- ^ NetworkAclId + -> EC2 m Text +replaceNetworkAclAssociation assoc aclid = + ec2Query "ReplaceNetworkAclAssociation" params $ + getT "newAssociationId" + where + params = + [ ValueParam "AssociationId" assoc + , ValueParam "NetworkAclId" aclid + ] + +createNetworkAclEntry + :: (MonadResource m, MonadBaseControl IO m) + => NetworkAclEntryRequest + -> EC2 m Bool +createNetworkAclEntry req = + ec2Query "CreateNetworkAclEntry" params returnBool + where + params = reqToParams req + +reqToParams :: NetworkAclEntryRequest -> [QueryParam] +reqToParams req = + [ ValueParam "NetworkAclId" $ + networkAclEntryRequestNetworkAclId req + , ValueParam "RuleNumber" $ + toText $ networkAclEntryRequestRuleNumber req + , ValueParam "Protocol" $ + toText $ networkAclEntryRequestProtocol req + , ValueParam "RuleAction" $ + ruleToText $ networkAclEntryRequestRuleAction req + , ValueParam "CidrBlock" $ + networkAclEntryRequestCidrBlock req + , ValueParam "Egress" $ + boolToText $ networkAclEntryRequestEgress req + ] ++ maybeParams + [ ("Icmp.Code", + toText + <$> icmpTypeCodeCode + <$> networkAclEntryRequestIcmp req) + , ("Icmp.Type", + toText + <$> icmpTypeCodeType + <$> networkAclEntryRequestIcmp req) + , ("PortRange.From", + toText + <$> portRangeFrom + <$> networkAclEntryRequestPortRange req) + , ("PortRange.To", + toText + <$> portRangeTo + <$> networkAclEntryRequestPortRange req) + ] + where + ruleToText NetworkAclRuleActionAllow = "allow" + ruleToText NetworkAclRuleActionDeny = "deny" + +deleteNetworkAclEntry + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ NetworkAclId + -> Int -- ^ RuleNumber + -> Bool -- ^ Egress + -> EC2 m Bool +deleteNetworkAclEntry aclid rule egress = + ec2Query "DeleteNetworkAclEntry" params returnBool + where + params = + [ ValueParam "NetworkAclId" aclid + , ValueParam "RuleNumber" $ toText rule + , ValueParam "Egress" $ boolToText egress + ] + +replaceNetworkAclEntry + :: (MonadResource m, MonadBaseControl IO m) + => NetworkAclEntryRequest + -> EC2 m Bool +replaceNetworkAclEntry req = + ec2Query "ReplaceNetworkAclEntry" params returnBool + where + params = reqToParams req diff --git a/AWS/EC2/Address.hs b/AWS/EC2/Address.hs --- a/AWS/EC2/Address.hs +++ b/AWS/EC2/Address.hs @@ -31,7 +31,7 @@ => [Text] -- ^ PublicIps -> [Text] -- ^ AllocationIds -> [Filter] -- ^ Filters - -> EC2 m (Source m Address) + -> EC2 m (ResumableSource m Address) describeAddresses pubIps alloIds filters = ec2QuerySource "DescribeAddresses" params addressSet where params = diff --git a/AWS/EC2/AvailabilityZone.hs b/AWS/EC2/AvailabilityZone.hs --- a/AWS/EC2/AvailabilityZone.hs +++ b/AWS/EC2/AvailabilityZone.hs @@ -20,7 +20,7 @@ :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ ZoneNames -> [Filter] -- ^ Filters - -> EC2 m (Source m AvailabilityZone) + -> EC2 m (ResumableSource m AvailabilityZone) describeAvailabilityZones zones filters = ec2QuerySource "DescribeAvailabilityZones" params availabilityZoneInfo where diff --git a/AWS/EC2/Image.hs b/AWS/EC2/Image.hs --- a/AWS/EC2/Image.hs +++ b/AWS/EC2/Image.hs @@ -27,7 +27,7 @@ -> [Text] -- ^ Owners (User Ids) -> [Text] -- ^ ExecutedBy (User Ids) -> [Filter] -- ^ Filers - -> EC2 m (Source m Image) + -> EC2 m (ResumableSource m Image) describeImages imageIds owners execby filters = ec2QuerySource "DescribeImages" params $ itemConduit "imagesSet" imageItem -- ec2QueryDebug "DescribeImages" params diff --git a/AWS/EC2/Instance.hs b/AWS/EC2/Instance.hs --- a/AWS/EC2/Instance.hs +++ b/AWS/EC2/Instance.hs @@ -38,7 +38,7 @@ :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ InstanceIds -> [Filter] -- ^ Filters - -> EC2 m (Source m Reservation) + -> EC2 m (ResumableSource m Reservation) describeInstances instances filters = do ec2QuerySource "DescribeInstances" params $ itemConduit "reservationSet" reservationSink @@ -181,7 +181,7 @@ -> Bool -- ^ is all instance? 'False': running instance only. -> [Filter] -- ^ Filters -> Maybe Text -- ^ next token - -> EC2 m (Source m InstanceStatus) + -> EC2 m (ResumableSource m InstanceStatus) describeInstanceStatus instanceIds isAll filters token = ec2QuerySource' "DescribeInstanceStatus" params token instanceStatusSet where @@ -227,7 +227,7 @@ startInstances :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ InstanceIds - -> EC2 m (Source m InstanceStateChange) + -> EC2 m (ResumableSource m InstanceStateChange) startInstances instanceIds = ec2QuerySource "StartInstances" params instanceStateChangeSet where @@ -249,7 +249,7 @@ :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ InstanceIds -> Bool -- ^ Force - -> EC2 m (Source m InstanceStateChange) + -> EC2 m (ResumableSource m InstanceStateChange) stopInstances instanceIds force = ec2QuerySource "StopInstances" params instanceStateChangeSet where @@ -275,7 +275,7 @@ terminateInstances :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ InstanceIds - -> EC2 m (Source m InstanceStateChange) + -> EC2 m (ResumableSource m InstanceStateChange) terminateInstances instanceIds = ec2QuerySource "TerminateInstances" params instanceStateChangeSet diff --git a/AWS/EC2/Internal.hs b/AWS/EC2/Internal.hs --- a/AWS/EC2/Internal.hs +++ b/AWS/EC2/Internal.hs @@ -185,7 +185,7 @@ | t == "error" = SSError | otherwise = err "snapshot status" t -volumeStatus :: Text -> VolumeStatus +volumeStatus :: Text -> VolumeState volumeStatus t | t == "creating" = VolCreating | t == "available" = VolAvailable @@ -241,3 +241,35 @@ instanceLifecycle (Just t) | t == "spot" = LifecycleSpot | otherwise = err "lifecycle" t + +subnetState :: Text -> SubnetState +subnetState t + | t == "pending" = SubnetPending + | t == "available" = SubnetAvailable + | otherwise = err "subnet state" t + +volumeStatusInfoStatus :: Text -> VolumeStatusInfoStatus +volumeStatusInfoStatus t + | t == "ok" = VSIOK + | t == "impaired" = VSIImpaired + | t == "insufficient-data" = VSIInsufficientData + | otherwise = err "VolumeStatusInfo Status" t + +networkAclRuleAction :: Text -> NetworkAclRuleAction +networkAclRuleAction t + | t == "allow" = NetworkAclRuleActionAllow + | t == "deny" = NetworkAclRuleActionDeny + | otherwise = err "network acl rule action" t + +routeState :: Text -> RouteState +routeState t + | t == "active" = RouteStateActive + | t == "blackhole" = RouteStateBlackhole + | otherwise = err "Route State" t + +routeOrigin :: Text -> RouteOrigin +routeOrigin t + | t == "CreateRouteTable" = RouteOriginCreateRouteTable + | t == "CreateRoute" = RouteOriginCreateRoute + | t == "EnableVgwRoutePropagation" = RouteOriginTableEnableVgwRoutePropagation + | otherwise = err "Route Origin" t diff --git a/AWS/EC2/KeyPair.hs b/AWS/EC2/KeyPair.hs --- a/AWS/EC2/KeyPair.hs +++ b/AWS/EC2/KeyPair.hs @@ -24,7 +24,7 @@ :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ PublicIps -> [Filter] -- ^ Filters - -> EC2 m (Source m KeyPair) + -> EC2 m (ResumableSource m KeyPair) describeKeyPairs names filters = ec2QuerySource "DescribeKeyPairs" params $ itemConduit "keySet" keyPairSink diff --git a/AWS/EC2/Query.hs b/AWS/EC2/Query.hs --- a/AWS/EC2/Query.hs +++ b/AWS/EC2/Query.hs @@ -19,11 +19,13 @@ import Control.Monad.Trans.Control (MonadBaseControl) import qualified Text.XML.Stream.Parse as XmlP 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 Control.Exception.Lifted as E import Data.Text (Text) import Control.Applicative +import Data.Conduit.Internal as CI import AWS.Class import AWS.EC2.Internal @@ -62,48 +64,47 @@ -> EC2 m o ec2Query action params sink = do src <- ec2QuerySource action params $ sink >>= yield - lift (src $$ CL.head) >>= maybe (fail "parse error") return + lift (src $$+- CL.head) >>= maybe (fail "parse error") return ec2QuerySource :: (MonadResource m, MonadBaseControl IO m) => ByteString -> [QueryParam] -> Conduit Event m o - -> EC2 m (Source m o) + -> EC2 m (ResumableSource m o) ec2QuerySource action params cond = do ec2QuerySource' action params Nothing cond +($=+) :: MonadIO m + => ResumableSource m a + -> Conduit a m b + -> m (ResumableSource m b) +a $=+ b = do + (sa, fa) <- unwrapResumable a + return $ CI.ResumableSource (sa $= b) fa + ec2QuerySource' :: (MonadResource m, MonadBaseControl IO m) => ByteString -> [QueryParam] -> Maybe Text -> Conduit Event m o - -> EC2 m (Source m o) + -> EC2 m (ResumableSource m o) ec2QuerySource' action params token cond = do cred <- Reader.ask ctx <- State.get (src1, rid) <- lift $ do response <- requestQuery cred ctx action params' ec2Version sinkError - (res, _) <- unwrapResumable response --- res $$ CB.sinkFile "debug.txt" >>= fail "debug" - res $= XmlP.parseBytes XmlP.def $$+ sinkRequestId + res <- response $=+ XmlP.parseBytes XmlP.def + res $$++ sinkRequestId State.put ctx{lastRequestId = Just rid} - lift $ do - (src2, _) <- unwrapResumable src1 - return $ src2 $= (cond >> nextToken) + lift $ src1 $=+ (cond >> nextToken) where params' = maybe params (\t -> ValueParam "NextToken" t:params) token - nextToken - :: (MonadResource m, MonadBaseControl IO m) - => Conduit Event m o - nextToken = do - mt <- getMT "nextToken" - case mt of - Nothing -> return () - Just t -> E.throw $ NextToken t +nextToken :: MonadThrow m => Conduit Event m o +nextToken = getMT "nextToken" >>= maybe (return ()) (E.throw . NextToken) #ifdef DEBUG ec2QueryDebug diff --git a/AWS/EC2/Region.hs b/AWS/EC2/Region.hs --- a/AWS/EC2/Region.hs +++ b/AWS/EC2/Region.hs @@ -20,7 +20,7 @@ :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ RegionNames -> [Filter] -- ^ Filters - -> EC2 m (Source m Region) + -> EC2 m (ResumableSource m Region) describeRegions regions filters = ec2QuerySource "DescribeRegions" params regionInfoConduit where diff --git a/AWS/EC2/RouteTable.hs b/AWS/EC2/RouteTable.hs new file mode 100644 --- /dev/null +++ b/AWS/EC2/RouteTable.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE FlexibleContexts, RankNTypes #-} + +module AWS.EC2.RouteTable + ( associateRouteTable + , createRouteTable + , deleteRouteTable + , describeRouteTables + , disassociateRouteTable + , replaceRouteTableAssociation + ) 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 + +------------------------------------------------------------ +-- describeRouteTables +------------------------------------------------------------ +describeRouteTables + :: (MonadResource m, MonadBaseControl IO m) + => [Text] -- ^ RouteTableIds + -> [Filter] -- ^ Filters + -> EC2 m (ResumableSource m RouteTable) +describeRouteTables routeTables filters = do + ec2QuerySource "DescribeRouteTables" params $ + itemConduit "routeTableSet" routeTableSink + where + params = + [ ArrayParams "RouteTableId" routeTables + , FilterParams filters + ] + +routeTableSink :: MonadThrow m + => GLSink Event m RouteTable +routeTableSink = RouteTable + <$> getT "routeTableId" + <*> getT "vpcId" + <*> routeSink + <*> routeTableAssociationSink + <*> getMT "propagatingVgwSet" + <*> resourceTagSink + +routeSink :: MonadThrow m + => GLSink Event m [Route] +routeSink = itemsSet "routeSet" $ Route + <$> getT "destinationCidrBlock" + <*> getMT "gatewayId" + <*> getMT "instanceId" + <*> getMT "instanceOwnerId" + <*> getMT "networkInterfaceId" + <*> getF "state" routeState + <*> getM "origin" (routeOrigin <$>) + +routeTableAssociationSink :: MonadThrow m + => GLSink Event m [RouteTableAssociation] +routeTableAssociationSink = itemsSet "associationSet" $ RouteTableAssociation + <$> getT "routeTableAssociationId" + <*> getT "routeTableId" + <*> getMT "subnetId" + <*> getM "main" (textToBool <$>) + +------------------------------------------------------------ +-- createRouteTable +------------------------------------------------------------ +createRouteTable + :: (MonadResource m, MonadBaseControl IO m) + => Text + -> EC2 m RouteTable +createRouteTable vid = + ec2Query "CreateRouteTable" [ValueParam "VpcId" vid] $ + element "routeTable" routeTableSink + +------------------------------------------------------------ +-- deleteRouteTable +------------------------------------------------------------ +deleteRouteTable + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ RouteTableId + -> EC2 m Bool +deleteRouteTable rtid = + ec2Query "DeleteRouteTable" [ValueParam "RouteTableId" rtid] + $ getF "return" textToBool + +------------------------------------------------------------ +-- associateRouteTable +------------------------------------------------------------ +associateRouteTable + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ RouteTableId + -> Text -- ^ SubnetId + -> EC2 m Text -- ^ associationId +associateRouteTable rtid sid = + ec2Query "AssociateRouteTable" params + $ getT "associationId" + where + params = [ ValueParam "RouteTableId" rtid + , ValueParam "SubnetId" sid + ] + +------------------------------------------------------------ +-- disassociateRouteTable +------------------------------------------------------------ +disassociateRouteTable + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ AssociationId + -> EC2 m Bool -- ^ return +disassociateRouteTable aid = + ec2Query "DisassociateRouteTable" [ValueParam "AssociationId" aid] + $ getF "return" textToBool + +------------------------------------------------------------ +-- replaceRouteTableAssociation +------------------------------------------------------------ +replaceRouteTableAssociation + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ AssociationId + -> Text -- ^ RouteTableId + -> EC2 m Text -- ^ newAssociationId +replaceRouteTableAssociation aid rtid = + ec2Query "ReplaceRouteTableAssociation" params + $ getT "newAssociationId" + where + params = [ ValueParam "AssociationId" aid + , ValueParam "RouteTableId" rtid + ] diff --git a/AWS/EC2/SecurityGroup.hs b/AWS/EC2/SecurityGroup.hs --- a/AWS/EC2/SecurityGroup.hs +++ b/AWS/EC2/SecurityGroup.hs @@ -30,7 +30,7 @@ => [Text] -- ^ GroupNames -> [Text] -- ^ GroupIds -> [Filter] -- ^ Filters - -> EC2 m (Source m SecurityGroup) + -> EC2 m (ResumableSource m SecurityGroup) describeSecurityGroups names ids filters = ec2QuerySource "DescribeSecurityGroups" params $ itemConduit "securityGroupInfo" $ diff --git a/AWS/EC2/Snapshot.hs b/AWS/EC2/Snapshot.hs --- a/AWS/EC2/Snapshot.hs +++ b/AWS/EC2/Snapshot.hs @@ -25,7 +25,7 @@ -> [Text] -- ^ Owners (UserId) -> [Text] -- ^ RestorableBy (UserId) -> [Filter] -- ^ Filters - -> EC2 m (Source m Snapshot) + -> EC2 m (ResumableSource m Snapshot) describeSnapshots ssids owners restby filters = ec2QuerySource "DescribeSnapshots" params $ itemConduit "snapshotSet" snapshotSink diff --git a/AWS/EC2/Subnets.hs b/AWS/EC2/Subnets.hs new file mode 100644 --- /dev/null +++ b/AWS/EC2/Subnets.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleContexts, RankNTypes #-} + +module AWS.EC2.Subnets + ( describeSubnets + , createSubnet + , deleteSubnet + ) 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 + +------------------------------------------------------------ +-- DescribeSubnets +------------------------------------------------------------ +describeSubnets + :: (MonadResource m, MonadBaseControl IO m) + => [Text] -- ^ SubnetIds + -> [Filter] -- ^ Filters + -> EC2 m (ResumableSource m Subnet) +describeSubnets subnets filters = do + ec2QuerySource "DescribeSubnets" params $ + itemConduit "subnetSet" subnetSink + where + params = + [ ArrayParams "SubnetId" subnets + , FilterParams filters + ] + +subnetSink :: MonadThrow m + => GLSink Event m Subnet +subnetSink = Subnet + <$> getT "subnetId" + <*> getF "state" subnetState + <*> getT "vpcId" + <*> getT "cidrBlock" + <*> getF "availableIpAddressCount" textToInt + <*> getT "availabilityZone" + <*> resourceTagSink + +------------------------------------------------------------ +-- CreateSubnet +------------------------------------------------------------ +createSubnet + :: (MonadResource m, MonadBaseControl IO m) + => CreateSubnetRequest + -> EC2 m Subnet +createSubnet param = + ec2Query "CreateSubnet" param' $ + element "subnet" subnetSink + where + param' = createSubnetParam param + +createSubnetParam :: CreateSubnetRequest -> [QueryParam] +createSubnetParam (CreateSubnetRequest vid cidr zone) = + [ ValueParam "VpcId" vid + , ValueParam "CidrBlock" cidr + ] ++ maybe [] (\a -> [ValueParam "AvailabilityZone" a]) zone + +------------------------------------------------------------ +-- DeleteSubnet +------------------------------------------------------------ +deleteSubnet + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ SubnetId + -> EC2 m Bool +deleteSubnet sid = + ec2Query "DeleteSubnet" [ValueParam "SubnetId" sid] + $ getF "return" textToBool diff --git a/AWS/EC2/Tag.hs b/AWS/EC2/Tag.hs --- a/AWS/EC2/Tag.hs +++ b/AWS/EC2/Tag.hs @@ -21,7 +21,7 @@ describeTags :: (MonadResource m, MonadBaseControl IO m) => [Filter] -- ^ Filters - -> EC2 m (Source m Tag) + -> EC2 m (ResumableSource m Tag) describeTags filters = ec2QuerySource "DescribeTags" params $ itemConduit "tagSet" $ Tag diff --git a/AWS/EC2/Types.hs b/AWS/EC2/Types.hs --- a/AWS/EC2/Types.hs +++ b/AWS/EC2/Types.hs @@ -11,6 +11,7 @@ , BlockDeviceMapping(..) , BlockDeviceMappingParam(..) , ConsoleOutput(..) + , CreateSubnetRequest(..) , CreateVolumeRequest(..) , DisassociateAddressRequest(..) , EbsBlockDevice(..) @@ -19,6 +20,7 @@ , Group(..) , Hypervisor(..) , IamInstanceProfile(..) + , IcmpTypeCode(..) , Image(..) , ImageState(..) , ImageType(..) @@ -45,12 +47,18 @@ , IpRange(..) , KeyPair(..) , ModifyInstanceAttributeRequest(..) + , NetworkAcl(..) + , NetworkAclAssociation(..) + , NetworkAclEntry(..) + , NetworkAclEntryRequest(..) + , NetworkAclRuleAction(..) , NetworkInterfaceAssociation(..) , NetworkInterfaceAttachment(..) , NetworkInterfaceParam(..) , PasswordData(..) , Placement(..) , Platform(..) + , PortRange(..) , ProductCode(..) , ProductCodeType(..) , Region(..) @@ -59,6 +67,11 @@ , ResetInstanceAttributeRequest(..) , ResourceTag(..) , RootDeviceType(..) + , Route(..) + , RouteTable(..) + , RouteTableAssociation(..) + , RouteState(..) + , RouteOrigin(..) , RunInstancesRequest(..) , SecurityGroup(..) , SecurityGroupRequest(..) @@ -66,12 +79,22 @@ , Snapshot(..) , SnapshotStatus(..) , StateReason(..) + , Subnet(..) + , SubnetState(..) , Tag(..) , UserIdGroupPair(..) , VirtualizationType(..) , Volume(..) + , VolumeAttribute(..) + , VolumeAttributeRequest(..) , VolumeType(..) + , VolumeState(..) , VolumeStatus(..) + , VolumeStatusAction(..) + , VolumeStatusEvent(..) + , VolumeStatusDetail(..) + , VolumeStatusInfo(..) + , VolumeStatusInfoStatus(..) , VpnConnection(..) , VpnConnectionOptionsRequest(..) , VpnConnectionState(..) @@ -490,7 +513,7 @@ , volSize :: Int , volSnapshotId :: Maybe Text , volAvailabilityZone :: Text - , volStatus :: VolumeStatus + , volStatus :: VolumeState , volCreateTime :: UTCTime , volAttachmentSet :: [Attachment] , volTagSet :: [ResourceTag] @@ -498,7 +521,7 @@ } deriving (Show, Eq) -data VolumeStatus +data VolumeState = VolCreating | VolAvailable | VolInUse @@ -763,3 +786,175 @@ data SecurityGroupRequest = GroupId Text | GroupName Text deriving (Show, Eq) + +data Subnet = Subnet + { snSubnetId :: Text + , snState :: SubnetState + , snVpicId :: Text + , snCidrBlock :: Text + , snAvailableIpAddressCount :: Int + , snCAvailabilityZone :: Text + , snTagSet :: [ResourceTag] + } + deriving (Show, Eq) + +data SubnetState = SubnetPending | SubnetAvailable + deriving (Show, Eq) + +data CreateSubnetRequest = CreateSubnetRequest + { csrVpcId :: Text + , csrCidrBlock :: Text + , csrAvailabilityZone :: Maybe Text + } + deriving (Show, Eq) + +data VolumeStatus = VolumeStatus + { vstVolumeId :: Text + , vstAvailabilityZone :: Text + , vstVolumeStatus :: VolumeStatusInfo + , vstEventSet :: [VolumeStatusEvent] + , vstActionSet :: [VolumeStatusAction] + } + deriving (Show, Eq) + +data VolumeStatusInfo = VolumeStatusInfo + { vsiStatus :: VolumeStatusInfoStatus + , vsiDetails :: [VolumeStatusDetail] + } + deriving (Show, Eq) + +data VolumeStatusInfoStatus + = VSIOK + | VSIImpaired + | VSIInsufficientData + deriving (Show, Eq) + +data VolumeStatusDetail = VolumeStatusDetail + { vsdName :: Text + , vsdStatus :: Text + } + deriving (Show, Eq) + +data VolumeStatusEvent = VolumeStatusEvent + { vseEventType :: Text + , vseEventId :: Text + , vseDescription :: Text + , vseNotBefore :: Maybe UTCTime + , vseNotAfter :: Maybe UTCTime + } + deriving (Show, Eq) + +data VolumeStatusAction = VolumeStatusAction + { vsaCode :: Text + , vsaEventType :: Text + , vsaEventId :: Text + , vsaDescription :: Text + } + deriving (Show, Eq) + +data VolumeAttribute + = VAAutoEnableIO Bool + | VAProductCodes [ProductCode] + deriving (Show, Eq) + +data VolumeAttributeRequest + = VARAutoEnableIO + | VARProductCodes + deriving (Show, Eq) + +data NetworkAcl = NetworkAcl + { networkAclId :: Text + , networkAclVpcId :: Text + , networkAclDefault :: Bool + , networkAclEntrySet :: [NetworkAclEntry] + , networkAclAssociationSet :: [NetworkAclAssociation] + , networkAclTagSet :: [ResourceTag] + } + deriving (Show, Eq) + +data NetworkAclEntry = NetworkAclEntry + { networkAclEntryRuleNumber :: Int + , networkAclEntryProtocol :: Int + , networkAclEntryRuleAction :: NetworkAclRuleAction + , networkAclEntryEgress :: Bool + , networkAclEntryCidrBlock :: Text + , networkAclEntryIcmpTypeCode :: Maybe IcmpTypeCode + , networkAclEntryPortRange :: Maybe PortRange + } + deriving (Show, Eq) + +data NetworkAclRuleAction + = NetworkAclRuleActionAllow + | NetworkAclRuleActionDeny + deriving (Show, Eq) + +data IcmpTypeCode = IcmpTypeCode + { icmpTypeCodeCode :: Int + , icmpTypeCodeType :: Int + } + deriving (Show, Eq) + +data PortRange = PortRange + { portRangeFrom :: Int + , portRangeTo :: Int + } + deriving (Show, Eq) + +data NetworkAclAssociation = NetworkAclAssociation + { networkAclAssociationId :: Text + , networkAclAssociationNetworkAclId :: Text + , networkAclAssociationSubnetId :: Text + } + deriving (Show, Eq) + +data NetworkAclEntryRequest = NetworkAclEntryRequest + { networkAclEntryRequestNetworkAclId :: Text + , networkAclEntryRequestRuleNumber :: Int + , networkAclEntryRequestProtocol :: Int -- ^ Protocol Number + , networkAclEntryRequestRuleAction :: NetworkAclRuleAction + , networkAclEntryRequestEgress :: Bool + , networkAclEntryRequestCidrBlock :: Text + , networkAclEntryRequestIcmp :: Maybe IcmpTypeCode + , networkAclEntryRequestPortRange :: Maybe PortRange + } + deriving (Show, Eq) + +data RouteTable = RouteTable + { rtRouteTableId :: Text + , rtVpcId :: Text + , rtRouteSet :: [Route] + , rtAssociationSet :: [RouteTableAssociation] + , rtPropagatingVgw :: Maybe PropagatingVgw + , rtTagSet :: [ResourceTag] + } + deriving (Show, Eq) + +data Route = Route + { rDestinationCidrBlock :: Text + , rGatewayId :: Maybe Text + , rInstanceId :: Maybe Text + , rInstanceOwnerId :: Maybe Text + , rNetworkInterfaceId :: Maybe Text + , rState :: RouteState + , rOrigin :: Maybe RouteOrigin + } + deriving (Show, Eq) + +data RouteState = RouteStateActive | RouteStateBlackhole + deriving (Show, Eq) + +data RouteOrigin + = RouteOriginCreateRouteTable + | RouteOriginCreateRoute + | RouteOriginTableEnableVgwRoutePropagation + deriving (Show, Eq) + +data RouteTableAssociation = RouteTableAssociation + { rtaRouteTableAssociationId :: Text + , rtaRouteTableId :: Text + , rtaSubnetId :: Maybe Text + , rtaMain :: Maybe Bool + } + deriving (Show, Eq) + +type PropagatingVgw = Text diff --git a/AWS/EC2/Util.hs b/AWS/EC2/Util.hs --- a/AWS/EC2/Util.hs +++ b/AWS/EC2/Util.hs @@ -9,7 +9,7 @@ import Data.Conduit import qualified Data.Conduit.List as CL -import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Class (MonadTrans, lift) import Prelude hiding (head) import Safe import qualified Control.Concurrent as CC @@ -22,40 +22,35 @@ asList :: Monad m - => EC2 m (Source m a) + => EC2 m (ResumableSource m a) -> EC2 m [a] asList src = do s <- src - lift $ s $$ CL.consume + lift $ s $$+- CL.consume head :: Monad m - => EC2 m (Source m a) + => EC2 m (ResumableSource m a) -> EC2 m (Maybe a) head src = do s <- src - lift $ s $$ CL.head + lift $ s $$+- CL.head each :: Monad m - => EC2 m (Source m a) - -> (a -> m b) + => (a -> m b) + -> EC2 m (ResumableSource m a) -> EC2 m () -each src f = do - s <- src - (rsrc, _) <- lift $ s $$+ CL.take 0 - lift $ each' rsrc f +each f res = res >>= lift . each' f each' :: Monad m - => ResumableSource m a - -> (a -> m b) + => (a -> m b) + -> ResumableSource m a -> m () -each' rsrc f = do +each' f rsrc = do (s', ma) <- rsrc $$++ CL.head - case ma of - Nothing -> return () - Just a -> f a >> each' s' f + maybe (return ()) (\a -> f a >> each' f s') ma -- | Wait for condition. -- @@ -78,7 +73,7 @@ wait f g rid = do mr <- headMay <$> g rid case mr of - Nothing -> fail $ "Resource not found: " ++ T.unpack rid + Nothing -> fail $ "Resource not found: " ++ T.unpack rid Just r -> if f r then return r else do diff --git a/AWS/EC2/VPC.hs b/AWS/EC2/VPC.hs --- a/AWS/EC2/VPC.hs +++ b/AWS/EC2/VPC.hs @@ -23,7 +23,7 @@ :: (MonadBaseControl IO m, MonadResource m) => [Text] -- ^ VpnConnectionIds -> [Filter] - -> EC2 m (Source m VpnConnection) + -> EC2 m (ResumableSource m VpnConnection) describeVpnConnections ids filters = ec2QuerySource "DescribeVpnConnections" params vpnConnectionConduit where diff --git a/AWS/EC2/Volume.hs b/AWS/EC2/Volume.hs --- a/AWS/EC2/Volume.hs +++ b/AWS/EC2/Volume.hs @@ -1,10 +1,14 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts, RankNTypes #-} module AWS.EC2.Volume ( describeVolumes , createVolume , deleteVolume , attachVolume , detachVolume + , describeVolumeStatus + , enableVolumeIO + , describeVolumeAttribute + , modifyVolumeAttribute ) where import Data.Text (Text) @@ -23,7 +27,7 @@ :: (MonadResource m, MonadBaseControl IO m) => [Text] -- ^ VolumeIds -> [Filter] -- ^ Filters - -> EC2 m (Source m Volume) + -> EC2 m (ResumableSource m Volume) describeVolumes vids filters = ec2QuerySource "DescribeVolumes" params $ itemConduit "volumeSet" volumeSink @@ -122,3 +126,93 @@ , ("Device", dev) , ("Force", toText <$> force) ] + +describeVolumeStatus + :: (MonadResource m, MonadBaseControl IO m) + => [Text] -- ^ VolumeId + -> [Filter] -- ^ Filters + -> Maybe Text -- ^ next token + -> EC2 m (ResumableSource m VolumeStatus) +describeVolumeStatus vids filters token = + ec2QuerySource' "DescribeVolumeStatus" params token $ + itemConduit "volumeStatusSet" $ volumeStatusSink + where + params = + [ ArrayParams "VolumeId" vids + , FilterParams filters + ] + +volumeStatusSink :: MonadThrow m + => GLSink Event m VolumeStatus +volumeStatusSink = VolumeStatus + <$> getT "volumeId" + <*> getT "availabilityZone" + <*> element "volumeStatus" (VolumeStatusInfo + <$> getF "status" volumeStatusInfoStatus + <*> itemsSet "details" (VolumeStatusDetail + <$> getT "name" + <*> getT "status" + ) + ) + <*> itemsSet "eventsSet" (VolumeStatusEvent + <$> getT "eventType" + <*> getT "eventId" + <*> getT "description" + <*> getM "notBefore" (textToTime <$>) + <*> getM "notAfter" (textToTime <$>) + ) + <*> itemsSet "actionsSet" (VolumeStatusAction + <$> getT "code" + <*> getT "eventType" + <*> getT "eventId" + <*> getT "description" + ) + +modifyVolumeAttribute + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ VolumeId + -> Bool -- ^ AutoEnableIO + -> EC2 m Bool +modifyVolumeAttribute vid enable = + ec2Query "ModifyVolumeAttribute" params returnBool + where + params = + [ ValueParam "VolumeId" vid + , ValueParam "AutoEnableIO.Value" $ boolToText enable + ] + +enableVolumeIO + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ VolumeId + -> EC2 m Bool +enableVolumeIO vid = + ec2Query "EnableVolumeIO" params returnBool + where + params = [ValueParam "VolumeId" vid] + +-- | return (volumeId, Attribute) +describeVolumeAttribute + :: (MonadResource m, MonadBaseControl IO m) + => Text -- ^ VolumeId + -> VolumeAttributeRequest + -> EC2 m (Text, VolumeAttribute) +describeVolumeAttribute vid attr = + ec2Query "DescribeVolumeAttribute" params $ (,) + <$> getT "volumeId" + <*> volumeAttributeSink attr + where + params = + [ ValueParam "VolumeId" vid + , ValueParam "Attribute" $ s attr + ] + s VARAutoEnableIO = "autoEnableIO" + s VARProductCodes = "productCodes" + +volumeAttributeSink + :: MonadThrow m + => VolumeAttributeRequest + -> GLSink Event m VolumeAttribute +volumeAttributeSink VARAutoEnableIO = + VAAutoEnableIO <$> getF "autoEnableIO" textToBool +volumeAttributeSink VARProductCodes = + VAProductCodes <$> productCodeSink 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.4.3.0 +version: 0.5.0.0 synopsis: AWS SDK for Haskell description: An AWS(Amazon Web Services) liblary for Haskell. license: BSD3 @@ -32,11 +32,14 @@ , AWS.EC2.Instance , AWS.EC2.Volume , AWS.EC2.KeyPair + , AWS.EC2.RouteTable , AWS.EC2.Snapshot , AWS.EC2.SecurityGroup + , AWS.EC2.Subnets , AWS.EC2.Query , AWS.EC2.Region , AWS.EC2.VPC + , AWS.EC2.Acl , AWS.EC2.Tag , AWS.EC2.Params , AWS.Lib.Parser @@ -85,4 +88,3 @@ source-repository head type: git location: git://github.com/worksap-ate/aws-sdk.git -