aws-sdk (empty) → 0.1.0.0
raw patch · 22 files changed
+2403/−0 lines, 22 filesdep +QuickCheckdep +SHAdep +basesetup-changed
Dependencies added: QuickCheck, SHA, base, base64-bytestring, bytestring, conduit, containers, data-default, hspec, http-conduit, http-types, lifted-base, monad-control, mtl, old-locale, parsec3, safe, simple-config, text, time, transformers, transformers-base, xml-conduit, xml-types
Files
- AWS.hs +39/−0
- AWS/Credential.hs +28/−0
- AWS/EC2.hs +54/−0
- AWS/EC2/Address.hs +127/−0
- AWS/EC2/AvailabilityZone.hs +38/−0
- AWS/EC2/Class.hs +80/−0
- AWS/EC2/Image.hs +97/−0
- AWS/EC2/Instance.hs +415/−0
- AWS/EC2/Params.hs +38/−0
- AWS/EC2/Parser.hs +34/−0
- AWS/EC2/Parser/Internal.hs +117/−0
- AWS/EC2/Query.hs +195/−0
- AWS/EC2/Region.hs +36/−0
- AWS/EC2/Tag.hs +28/−0
- AWS/EC2/Types.hs +836/−0
- AWS/EC2/Utils.hs +39/−0
- AWS/Types.hs +18/−0
- AWS/Util.hs +57/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- aws-sdk.cabal +74/−0
- tests/main.hs +21/−0
+ AWS.hs view
@@ -0,0 +1,39 @@+-- | aws-sdk is an AWS library for Haskell+--+-- Put your AWS AccessKey and SecretAccessKey into a configuration+-- file. Write the following in /./\//aws.config/.+--+-- > accessKey: your-access-key+-- > secretAccessKey: your-secret-access-key+--+-- The followin is quick example(DescribeInstances).+--+-- > module Example where+-- > +-- > import Data.Conduit+-- > import qualified Data.Conduit.List as CL+-- > import Control.Monad.IO.Class (liftIO)+-- > import Control.Monad.Trans.Class (lift)+-- > +-- > import AWS+-- > import AWS.EC2+-- > +-- > main :: IO ()+-- > main = do+-- > cred <- loadCredential+-- > doc <- runResourceT $ do+-- > ctx <- liftIO $ newEC2Context cred+-- > runEC2 ctx $ do+-- > response <- describeInstances [] []+-- > lift $ response $$ CL.consume+-- > print doc+-- > putStr "Length: "+-- > print $ length doc+{-# LANGUAGE OverloadedStrings #-}+module AWS+ ( -- * Credentials+ Credential+ , loadCredential+ ) where++import AWS.Credential
+ AWS/Credential.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}+module AWS.Credential+ ( Credential(..)+ , AccessKey+ , SecretAccessKey+ , loadCredential+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Text.Config+import Text.Parsec++mkConfig "configParser" [config|+Credential+ accessKey ByteString+ secretAccessKey ByteString+|]++type AccessKey = ByteString+type SecretAccessKey = ByteString++loadCredential :: IO Credential+loadCredential = do+ str <- BS.readFile "aws.config"+ case parse configParser "" str of+ Left err -> fail $ show err+ Right conf -> return conf
+ AWS/EC2.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}++module AWS.EC2+ ( -- * EC2 Environment+ module AWS.EC2.Class+ , EC2Endpoint(..)+ , newEC2Context+ , setEndpoint+ -- * Instances+ , module AWS.EC2.Instance+ -- * Images+ , module AWS.EC2.Image+ -- * Placements+ , module AWS.EC2.Region+ , module AWS.EC2.AvailabilityZone+ -- * Addresses+ , module AWS.EC2.Address+ -- * Tags+ , module AWS.EC2.Tag+ ) where++import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import qualified Control.Monad.State as ST+import qualified Network.HTTP.Conduit as HTTP++import AWS.Types+import AWS.EC2.Class++import AWS.EC2.Image+import AWS.EC2.Region+import AWS.EC2.AvailabilityZone+import AWS.EC2.Instance+import AWS.EC2.Address+import AWS.EC2.Tag+import AWS.Credential++newEC2Context :: Credential -> IO EC2Context+newEC2Context cred = do+ mgr <- HTTP.newManager HTTP.def+ return EC2Context+ { manager = mgr+ , credential = cred+ , endpoint = UsEast1+ , lastRequestId = Nothing+ }++setEndpoint+ :: (MonadResource m, MonadBaseControl IO m)+ => EC2Endpoint -> EC2 m ()+setEndpoint ep = do+ ctx <- ST.get+ ST.put ctx { endpoint = ep }
+ AWS/EC2/Address.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.Address+ ( describeAddresses+ , allocateAddress+ , releaseAddress+ , associateAddress+ , AssociateAddressParam(..)+ ) 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.Types+import AWS.EC2.Class+import AWS.EC2.Query+import AWS.EC2.Parser+import AWS.Util++-----------------------------------------------------+-- DescribeAddresses+-----------------------------------------------------+describeAddresses+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ PublicIps+ -> [Text] -- ^ AllocationIds+ -> [Filter] -- ^ Filters+ -> EC2 m (Source m Address)+describeAddresses pubIps alloIds filters =+ ec2QuerySource "DescribeAddresses" params addressSet where+ params =+ [ ArrayParams "PublicIp" pubIps+ , ArrayParams "AllocationId" alloIds+ , FilterParams filters+ ]++ addressSet :: MonadThrow m => GLConduit Event m Address+ addressSet = itemConduit "addressesSet" $ address+ <$> getT "publicIp"+ <*> getMT "allocationId"+ <*> getM "domain" addressDomain+ <*> getMT "instanceId"+ <*> getMT "associationId"+ <*> getMT "networkInterfaceId"+ <*> getMT "networkInterfaceOwnerId"+ <*> getMT "privateIpAddress"++-----------------------------------------------------+-- AllocateAddress+-----------------------------------------------------+allocateAddress+ :: (MonadResource m, MonadBaseControl IO m)+ => Bool -- ^ is VPC?+ -> EC2 m AllocateAddressResponse+allocateAddress isVpc = do+ ec2Query "AllocateAddress" params $+ allocateAddressResponse+ <$> getT "publicIp"+ <*> getM "domain" addressDomain+ <*> getMT "allocationId"+ where+ params = if isVpc then [ValueParam "Domain" "vpc"] else []++-----------------------------------------------------+-- ReleaseAddress+-----------------------------------------------------+releaseAddress+ :: (MonadResource m, MonadBaseControl IO m)+ => Maybe Text -- ^ PublicIp+ -> Maybe Text -- ^ AllocationId+ -> EC2 m EC2Return+releaseAddress addr allocid = do+ ec2Query "ReleaseAddress" params $ getF "return" ec2Return+ where+ param name = maybe [] (\a -> [ValueParam name a])+ params = uncurry param =<<+ [ ("PublicIp", addr)+ , ("AllocationId", allocid)+ ]++-----------------------------------------------------+-- AssociateAddress+-----------------------------------------------------+associateAddress+ :: (MonadResource m, MonadBaseControl IO m)+ => AssociateAddressParam+ -> EC2 m (Bool, Maybe Text)+associateAddress param = ec2Query "AssociateAddress" params $+ (,) <$> getF "return" textToBool+ <*> getMT "associationId"+ where+ params = associateAddressParam param++data AssociateAddressParam+ = AAEC2Instance+ { aaec2PublicIp :: Text+ , aaec2InstanceId :: Text+ }+ | AAVPCInstance+ { aavpcAllocationId :: Text+ , aavpcInstanceId :: Maybe Text+ , aavpcNetworkInterfaceId :: Maybe Text+ , aavpcPrivateIpAddress :: Maybe Text+ , aavpcAllowReassociation :: Maybe Bool+ }+ deriving (Show)++associateAddressParam+ :: AssociateAddressParam -> [QueryParam]+associateAddressParam (AAEC2Instance ip iid) =+ [ ValueParam "PublicIp" ip+ , ValueParam "InstanceId" iid+ ]+associateAddressParam (AAVPCInstance aid iid nid pip ar) =+ [ ValueParam "AllocationId" aid ]+ ++ (uncurry f =<<+ [ ("InstanceId", iid)+ , ("NetworkInterfaceId", nid)+ , ("PrivateIpAddress", pip)+ , ("AllowReassociation", boolToText <$> ar)+ ])+ where+ f name = maybe [] (\a -> [ValueParam name a])
+ AWS/EC2/AvailabilityZone.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.AvailabilityZone+ ( describeAvailabilityZones+ ) 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.Types+import AWS.EC2.Class+import AWS.EC2.Query+import AWS.EC2.Parser++describeAvailabilityZones+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ ZoneNames+ -> [Filter] -- ^ Filters+ -> EC2 m (Source m AvailabilityZone)+describeAvailabilityZones zones filters =+ ec2QuerySource "DescribeAvailabilityZones" params availabilityZoneInfo+ where+ params =+ [ ArrayParams "ZoneName" zones+ , FilterParams filters+ ]+ availabilityZoneInfo :: MonadThrow m+ => GLConduit Event m AvailabilityZone+ availabilityZoneInfo = itemConduit "availabilityZoneInfo" $+ availabilityZone+ <$> getT "zoneName"+ <*> getT "zoneState"+ <*> getT "regionName"+ <*> itemsSet "messageSet" (getT "message")
+ AWS/EC2/Class.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE GeneralizedNewtypeDeriving+ , TypeFamilies+ , FlexibleInstances+ , MultiParamTypeClasses+ , UndecidableInstances+ , DeriveDataTypeable+ #-}++module AWS.EC2.Class+ ( EC2+ , runEC2+ , ResponseParserException(..)+ , EC2Context(..)+ ) where++import Control.Monad.State (StateT(..), MonadState)+import qualified Control.Monad.State as S+import Control.Applicative+import Control.Monad (liftM)+import Control.Monad.Base (MonadBase)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Class (MonadTrans, lift)+import Control.Monad.Trans.Control+ ( MonadBaseControl(..)+ , MonadTransControl(..)+ , ComposeSt+ , defaultLiftBaseWith+ , defaultRestoreM+ )+import Control.Exception (Exception)+import Data.Typeable (Typeable)++import qualified Network.HTTP.Conduit as HTTP+import Data.Text (Text)++import AWS.Types+import AWS.Credential++data EC2Context = EC2Context+ { manager :: HTTP.Manager+ , credential :: Credential+ , endpoint :: EC2Endpoint+ , lastRequestId :: Maybe Text+ }++data ResponseParserException+ = NextToken Text+ deriving (Show, Typeable)++instance Exception ResponseParserException++newtype EC2 m a = EC2T+ { runEC2T :: StateT EC2Context m a+ } deriving+ ( Monad+ , Applicative+ , Functor+ , MonadIO+ , MonadState EC2Context+ , MonadBase base+ )++instance MonadTrans EC2 where+ lift = EC2T . lift++instance MonadTransControl EC2 where+ newtype StT EC2 a = StEC2 { unStEC2 :: (a, EC2Context) }+ liftWith f = EC2T . StateT $ \s ->+ liftM (\x -> (x, s))+ (f $ \a -> liftM StEC2+ (S.runStateT (runEC2T a) s))+ restoreT = EC2T . StateT . const . liftM unStEC2++instance MonadBaseControl base m => MonadBaseControl base (EC2 m) where+ newtype StM (EC2 m) a = StMEC2 { unStMEC2 :: ComposeSt EC2 m a }+ liftBaseWith = defaultLiftBaseWith StMEC2+ restoreM = defaultRestoreM unStMEC2++runEC2 :: Monad m => EC2Context -> EC2 m a -> m a+runEC2 ctx app = S.evalStateT (runEC2T app) ctx
+ AWS/EC2/Image.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.Image+ ( describeImages+ , createImage+ ) 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.Types+import AWS.EC2.Utils+import AWS.EC2.Params+import AWS.EC2.Class+import AWS.EC2.Query+import AWS.EC2.Parser+import AWS.Util++describeImages+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ ImageIds+ -> [Text] -- ^ Owners (User Ids)+ -> [Text] -- ^ ExecutedBy (User Ids)+ -> [Filter] -- ^ Filers+ -> EC2 m (Source m Image)+describeImages imageIds owners execby filters =+ ec2QuerySource "DescribeImages" params $+ itemConduit "imagesSet" imageItem+ where+ params =+ [ ArrayParams "ImageId" imageIds+ , ArrayParams "Owner" owners+ , ArrayParams "ExecutableBy" execby+ , FilterParams filters+ ]++imageItem :: MonadThrow m+ => GLSink Event m Image+imageItem = image+ <$> getT "imageId"+ <*> getT "imageLocation"+ <*> getF "imageState" imageState+ <*> getT "imageOwnerId"+ <*> getF "isPublic" textToBool+ <*> productCodeSink+ <*> getT "architecture"+ <*> getF "imageType" imageType+ <*> getMT "kernelId"+ <*> getMT "ramdiskId"+ <*> getM "platform" platform+ <*> stateReasonSink+ <*> getMT "imageOwnerAlias"+ <*> getM "name" orEmpty+ <*> getM "description" orEmpty+ <*> getF "rootDeviceType" rootDeviceType+ <*> getMT "rootDeviceName"+ <*> itemsSet "blockDeviceMapping" (+ blockDeviceMapping+ <$> getT "deviceName"+ <*> getMT "virtualName"+ <*> elementM "ebs" (+ ebsBlockDevice+ <$> getMT "snapshotId"+ <*> getF "volumeSize" textToInt+ <*> getF "deleteOnTermination" textToBool+ <*> (volumeType+ <$> getT "volumeType"+ <*> getM "iops" (textToInt <$>)+ )+ )+ )+ <*> getF "virtualizationType" virtualizationType+ <*> resourceTagSink+ <*> getF "hypervisor" hypervisor++createImage+ :: (MonadResource m, MonadBaseControl IO m)+ => Text -- ^ InstanceId+ -> Text -- ^ Name+ -> Maybe Text -- ^ Description+ -> Bool -- ^ NoReboot+ -> [BlockDeviceMappingParam] -- ^ BlockDeviceMapping+ -> EC2 m Text+createImage iid name desc noReboot bdms =+ ec2Query "CreateImage" params $ getT "imageId"+ where+ param n = maybe [] (\a -> [ValueParam n a])+ params =+ [ ValueParam "InstanceId" iid+ , ValueParam "Name" name+ , ValueParam "NoReboot" (boolToText noReboot)+ ] ++ param "Description" desc+ ++ [blockDeviceMappingParams bdms]
+ AWS/EC2/Instance.hs view
@@ -0,0 +1,415 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.Instance+ ( describeInstances+ , runInstances+ , RunInstancesParam(..)+ , defaultRunInstancesParam+ , terminateInstances+ , startInstances+ , stopInstances+ , rebootInstances+ , getConsoleOutput+ , getPasswordData+ , describeInstanceStatus+ ) where++import Data.Text (Text)+import Data.ByteString (ByteString)++import Data.XML.Types (Event)+import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Applicative++import AWS.EC2.Types+import AWS.EC2.Params+import AWS.EC2.Utils+import AWS.EC2.Class+import AWS.EC2.Query+import AWS.EC2.Parser+import AWS.Util++------------------------------------------------------------+-- DescribeInstances+------------------------------------------------------------+describeInstances+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ InstanceIds+ -> [Filter] -- ^ Filters+ -> EC2 m (Source m Reservation)+describeInstances instances filters = do+ ec2QuerySource "DescribeInstances" params $+ itemConduit "reservationSet" reservationSink+ where+ params =+ [ ArrayParams "InstanceId" instances+ , FilterParams filters+ ]++reservationSink :: MonadThrow m+ => GLSink Event m Reservation+reservationSink =+ reservation+ <$> getT "reservationId"+ <*> getT "ownerId"+ <*> groupSetSink+ <*> instanceSetSink+ <*> getMT "requesterId"++groupSetSink :: MonadThrow m => GLSink Event m [Group]+groupSetSink = itemsSet "groupSet" $ group+ <$> getT "groupId"+ <*> getT "groupName"++instanceSetSink :: MonadThrow m+ => GLSink Event m [Instance]+instanceSetSink = itemsSet "instancesSet" $+ ec2Instance+ <$> getT "instanceId"+ <*> getT "imageId"+ <*> instanceStateSink "instanceState"+ <*> getT "privateDnsName"+ <*> getT "dnsName"+ <*> getT "reason"+ <*> getMT "keyName"+ <*> getT "amiLaunchIndex"+ <*> productCodeSink+ <*> getT "instanceType"+ <*> getF "launchTime" textToTime+ <*> element "placement" (+ placement+ <$> getT "availabilityZone"+ <*> getT "groupName"+ <*> getT "tenancy"+ )+ <*> getMT "kernelId"+ <*> getMT "ramdiskId"+ <*> getMT "platform"+ <*> element "monitoring" (getF "state" instanceMonitoringState)+ <*> getMT "subnetId"+ <*> getMT "vpcId"+ <*> getMT "privateIpAddress"+ <*> getMT "ipAddress"+ <*> getM "sourceDestCheck" (textToBool <$>)+ <*> groupSetSink+ <*> stateReasonSink+ <*> getF "architecture" architecture+ <*> getF "rootDeviceType" rootDeviceType+ <*> getMT "rootDeviceName"+ <*> itemsSet "blockDeviceMapping" (+ instanceBlockDeviceMapping+ <$> getT "deviceName"+ <*> element "ebs" (+ instanceEbsBlockDevice+ <$> getT "volumeId"+ <*> getF "status" volumeState+ <*> getF "attachTime" textToTime+ <*> getF "deleteOnTermination" textToBool+ )+ )+ <*> getM "instanceLifecycle" instanceLifecycle+ <*> getMT "spotInstanceRequestId"+ <*> getF "virtualizationType" virtualizationType+ <*> getT "clientToken"+ <*> resourceTagSink+ <*> getF "hypervisor" hypervisor+ <*> networkInterfaceSink+ <*> elementM "iamInstanceProfile" (+ iamInstanceProfile+ <$> getT "arn"+ <*> getT "id"+ )+ <*> getF "ebsOptimized" textToBool++instanceStateSink :: MonadThrow m+ => Text -> GLSink Event m InstanceState+instanceStateSink label = element label $+ codeToState+ <$> getF "code" textToInt+ <* getT "name"++networkInterfaceSink :: MonadThrow m+ => GLSink Event m [InstanceNetworkInterface]+networkInterfaceSink = itemsSet "networkInterfaceSet" $+ instanceNetworkInterface+ <$> getT "networkInterfaceId"+ <*> getT "subnetId"+ <*> getT "vpcId"+ <*> getM "description" orEmpty+ <*> getT "ownerId"+ <*> getT "status"+ <*> getT "privateIpAddress"+ <*> getMT "privateDnsName"+ <*> getF "sourceDestCheck" textToBool+ <*> groupSetSink+ <*> element "attachment" (+ networkInterfaceAttachment+ <$> getT "attachmentId"+ <*> getF "deviceIndex" textToInt+ <*> getT "status"+ <*> getF "attachTime" textToTime+ <*> getF "deleteOnTermination" textToBool+ )+ <*> niAssociationSink+ <*> itemsSet "privateIpAddressesSet" (+ instancePrivateIpAddress+ <$> getT "privateIpAddress"+ <*> getF "primary" textToBool+ <*> niAssociationSink+ )++niAssociationSink :: MonadThrow m+ => GLSink Event m (Maybe NetworkInterfaceAssociation)+niAssociationSink = elementM "association" $+ networkInterfaceAssociation+ <$> getT "publicIp"+ <*> getT "ipOwnerId"++------------------------------------------------------------+-- DescribeInstanceStatus+------------------------------------------------------------+-- | raise 'ResponseParserException'('NextToken' token)+describeInstanceStatus+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ InstanceIds+ -> Bool -- ^ is all instance? 'False': running instance only.+ -> [Filter] -- ^ Filters+ -> Maybe Text -- ^ next token+ -> EC2 m (Source m InstanceStatus)+describeInstanceStatus instanceIds isAll filters token =+ ec2QuerySource' "DescribeInstanceStatus" params token instanceStatusSet+ where+ params =+ [ ArrayParams "InstanceId" instanceIds+ , ValueParam "IncludeAllInstances" $ boolToText isAll+ , FilterParams filters+ ]++instanceStatusSet :: MonadThrow m+ => GLConduit Event m InstanceStatus+instanceStatusSet = do+ itemConduit "instanceStatusSet" $+ instanceStatus+ <$> getT "instanceId"+ <*> getT "availabilityZone"+ <*> itemsSet "eventsSet" (+ instanceStatusEvent+ <$> getF "code" instanceStatusEventCode+ <*> getT "description"+ <*> getM "notBefore" (textToTime <$>)+ <*> getM "notAfter" (textToTime <$>)+ )+ <*> instanceStateSink "instanceState"+ <*> instanceStatusTypeSink "systemStatus"+ <*> instanceStatusTypeSink "instanceStatus"++instanceStatusTypeSink :: MonadThrow m+ => Text -> GLSink Event m InstanceStatusType+instanceStatusTypeSink name = element name $+ instanceStatusType+ <$> getF "status" instanceStatusTypeStatus+ <*> itemsSet "details" (+ instanceStatusDetail+ <$> getT "name"+ <*> getT "status"+ <*> getM "impairedSince" (textToTime <$>)+ )++------------------------------------------------------------+-- StartInstances+------------------------------------------------------------+startInstances+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ InstanceIds+ -> EC2 m (Source m InstanceStateChange)+startInstances instanceIds =+ ec2QuerySource "StartInstances" params instanceStateChangeSet+ where+ params = [ArrayParams "InstanceId" instanceIds]++instanceStateChangeSet+ :: (MonadResource m, MonadBaseControl IO m)+ => Conduit Event m InstanceStateChange+instanceStateChangeSet = itemConduit "instancesSet" $ do+ instanceStateChange+ <$> getT "instanceId"+ <*> instanceStateSink "currentState"+ <*> instanceStateSink "previousState"++------------------------------------------------------------+-- StopInstances+------------------------------------------------------------+stopInstances+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ InstanceIds+ -> Bool -- ^ Force+ -> EC2 m (Source m InstanceStateChange)+stopInstances instanceIds force =+ ec2QuerySource "StopInstances" params instanceStateChangeSet+ where+ params =+ [ ArrayParams "InstanceId" instanceIds+ , ValueParam "Force" $ boolToText force]++------------------------------------------------------------+-- RebootInstances+------------------------------------------------------------+rebootInstances+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ InstanceIds+ -> EC2 m Bool+rebootInstances instanceIds =+ ec2Query "RebootInstances" params $ getF "return" textToBool+ where+ params = [ArrayParams "InstanceId" instanceIds]++------------------------------------------------------------+-- TerminateInstances+------------------------------------------------------------+terminateInstances+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ InstanceIds+ -> EC2 m (Source m InstanceStateChange)+terminateInstances instanceIds =+ ec2QuerySource "TerminateInstances" params+ instanceStateChangeSet+ where+ params = [ArrayParams "InstanceId" instanceIds]++------------------------------------------------------------+-- RunInstances+------------------------------------------------------------+-- | 'RunInstancesParam' is genereted with 'defaultRunInstancesParam'+runInstances+ :: (MonadResource m, MonadBaseControl IO m)+ => RunInstancesParam+ -> EC2 m Reservation+runInstances param =+ ec2Query "RunInstances" params reservationSink+ where+ mk name = maybe [] (\a -> [ValueParam name a])+ params =+ [ ValueParam "ImageId" $ riImageId param+ , ValueParam "MinCount" $ toText $ riMinCount param+ , ValueParam "MaxCount" $ toText $ riMaxCount param+ , ArrayParams "SecurityGroupId" $ riSecurityGroupIds param+ , ArrayParams "SecurityGroup" $ riSecurityGroups param+ , blockDeviceMappingParams $ riBlockDeviceMappings param+ ] ++ (uncurry mk =<<+ [ ("KeyName", riKeyName param) , ("UserData", bsToText <$> riUserData param)+ , ("InstanceType", riInstanceType param)+ , ("Placement.AvailabilityZone",+ riAvailabilityZone param)+ , ("Placement.GroupName", riPlacementGroup param)+ , ("Placement.Tenancy", riTenancy param)+ , ("KernelId", riKernelId param)+ , ("RamdiskId", riRamdiskId param)+ , ("Monitoring.Enabled",+ boolToText <$> riMonitoringEnabled param)+ , ("SubnetId", riSubnetId param)+ , ("DisableApiTermination",+ boolToText <$> riDisableApiTermination param)+ , ("InstanceInitiatedShutdownBehavior",+ sbToText <$> riShutdownBehavior param)+ , ("ClientToken", riClientToken param)+ , ("IamInstanceProfile.Arn",+ iipArn <$> riIamInstanceProfile param)+ , ("IamInstanceProfile.Name",+ iipId <$> riIamInstanceProfile param)+ , ("EbsOptimized", boolToText <$> riEbsOptimized param)+ ])++data RunInstancesParam = RunInstancesParam+ { riImageId :: Text -- ^ Required+ , riMinCount :: Int -- ^ Required+ , riMaxCount :: Int -- ^ Required+ , riKeyName :: Maybe Text+ , riSecurityGroupIds :: [Text]+ -- ^ SecurityGroupIds (Required for VPC; optional for EC2)+ , riSecurityGroups :: [Text]+ -- ^ SecurityGroups (Only for EC2; either id or name is accepted)+ , riUserData :: Maybe ByteString+ -- ^ UserData (Base64-encoded MIME user data)+ , riInstanceType :: Maybe Text+ , riAvailabilityZone :: Maybe Text+ , riPlacementGroup :: Maybe Text+ , riTenancy :: Maybe Text+ , riKernelId :: Maybe Text+ , riRamdiskId :: Maybe Text+ , riBlockDeviceMappings :: [BlockDeviceMappingParam]+ , riMonitoringEnabled :: Maybe Bool+ , riSubnetId :: Maybe Text+ , riDisableApiTermination :: Maybe Bool+ , riShutdownBehavior :: Maybe ShutdownBehavior+ , riPrivateIpAddresses :: [Text] -- ^ XXX: not implemented+ , riClientToken :: Maybe Text+ , riNetworkInterface :: [NetworkInterfaceParam] -- ^ XXX: not implemented+ , riIamInstanceProfile :: Maybe IamInstanceProfile+ , riEbsOptimized :: Maybe Bool+ }+ deriving (Show)++-- | RunInstances parameter utility+defaultRunInstancesParam+ :: Text -- ^ ImageId+ -> Int -- ^ MinCount+ -> Int -- ^ MaxCount+ -> RunInstancesParam+defaultRunInstancesParam iid minCount maxCount = RunInstancesParam+ { riImageId = iid+ , riMinCount = minCount+ , riMaxCount = maxCount+ , riKeyName = Nothing+ , riSecurityGroupIds = []+ , riSecurityGroups = []+ , riUserData = Nothing+ , riInstanceType = Nothing+ , riAvailabilityZone = Nothing+ , riPlacementGroup = Nothing+ , riTenancy = Nothing+ , riKernelId = Nothing+ , riRamdiskId = Nothing+ , riBlockDeviceMappings = []+ , riMonitoringEnabled = Nothing+ , riSubnetId = Nothing+ , riDisableApiTermination = Nothing+ , riShutdownBehavior = Nothing+ , riPrivateIpAddresses = []+ , riClientToken = Nothing+ , riNetworkInterface = []+ , riIamInstanceProfile = Nothing+ , riEbsOptimized = Nothing+ }++sbToText :: ShutdownBehavior -> Text+sbToText SBStop = "stop"+sbToText SBTerminate = "terminate"++------------------------------------------------------------+-- GetConsoleOutput+------------------------------------------------------------+getConsoleOutput+ :: (MonadResource m, MonadBaseControl IO m)+ => Text -- ^ InstanceId+ -> EC2 m ConsoleOutput+getConsoleOutput iid =+ ec2Query "GetConsoleOutput" [ValueParam "InstanceId" iid] $+ consoleOutput+ <$> getT "instanceId"+ <*> getF "timestamp" textToTime+ <*> getT "output"++------------------------------------------------------------+-- GetPasswordData+------------------------------------------------------------+getPasswordData+ :: (MonadResource m, MonadBaseControl IO m)+ => Text -- ^ InstanceId+ -> EC2 m PasswordData+getPasswordData iid =+ ec2Query "GetPasswordData" [ValueParam "InstanceId" iid] $+ passwordData+ <$> getT "instanceId"+ <*> getF "timestamp" textToTime+ <*> getT "passwordData"
+ AWS/EC2/Params.hs view
@@ -0,0 +1,38 @@+module AWS.EC2.Params where++import Data.Text (Text)++import AWS.EC2.Types++data BlockDeviceMappingParam+ = BlockDeviceMappingParamEBS+ { bdmpEbsDeviceName :: Text+ , bdmpEbsNoDevice :: Maybe Bool+ , bdmpEbsSource :: EbsSource+ , bdmpEbsDeleteOnTermination :: Maybe Bool+ , bdmpEbsVolumeType :: Maybe VolumeType+ }+ | BlockDeviceMappingParamInstanceStore+ { bdmpIsDeviceName :: Text+ , bdmpIsNoDevice :: Maybe Bool+ , bdmpIsVirtualName :: Maybe Text+ }+ deriving (Show)++data EbsSource+ = EbsSnapshotId Text+ | EbsVolumeSize Int+ deriving (Show)++data ShutdownBehavior = SBStop | SBTerminate deriving (Show)++data NetworkInterfaceParam = NetworkInterfaceParam+ { nipInterfaceId :: Maybe Text+ , nipDeviceIndex :: Maybe Text+ , nipSubnetId :: Maybe Text+ , nipDescription :: Maybe Text+ , nipPrivateIpAddresses :: [Text]+ , nipSecurityGroupIds :: [Text]+ , nipDeleteOnTermination :: Maybe Bool+ }+ deriving (Show)
+ AWS/EC2/Parser.hs view
@@ -0,0 +1,34 @@+module AWS.EC2.Parser+ ( module AWS.EC2.Parser.Internal+ , resourceTagSink+ , productCodeSink+ , stateReasonSink+ ) where++import Control.Applicative+import Data.Conduit+import Data.XML.Types (Event)++import AWS.EC2.Types+import AWS.EC2.Parser.Internal++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"
+ AWS/EC2/Parser/Internal.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+module AWS.EC2.Parser.Internal where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BSC+import Data.ByteString.Lazy.Char8 ()++import Data.XML.Types (Event(..), Name(..))+import Data.Text (Text)+import qualified Data.Text as T+import Data.Conduit+import qualified Data.Conduit.List as CL+import qualified Text.XML.Stream.Parse as XML+import Control.Applicative+import Data.Monoid ((<>))++apiVersion :: ByteString+apiVersion = "2012-08-15"++itemConduit :: MonadThrow m+ => Text+ -> GLSink Event m o+ -> GLConduit Event m o+itemConduit tag inner = do+ maybe (()) id <$> elementM tag (items inner)+ where+ items :: MonadThrow m+ => Pipe Event Event o u m o+ -> Pipe Event Event o u m ()+ items p = awaitWhile isTag >>= maybe (return ()) (\e -> do+ leftover e+ if isBeginTagName "item" e+ then do+ element "item" $ p >>= yield+ items p+ else return ()+ )++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+isTag _ = False++isBeginTagName :: Text -> Event -> Bool+isBeginTagName name (EventBeginElement n _)+ | n == ec2Name name = True+ | otherwise = False+isBeginTagName _ _ = False++awaitWhile :: Monad m+ => (i -> Bool)+ -> Pipe l i o u m (Maybe i)+awaitWhile f = await >>= g+ where+ g Nothing = return Nothing+ g (Just a)+ | f a = return $ Just a+ | otherwise = awaitWhile f++getF :: MonadThrow m+ => Text+ -> (Text -> b)+ -> Pipe Event Event o u m b+getF name f = tagContentF name >>= return . f++getT :: MonadThrow m+ => Text+ -> Pipe Event Event o u m Text+getT name = getF name id++getM :: MonadThrow m+ => Text+ -> (Maybe Text -> b)+ -> Pipe Event Event o u m b+getM name f = tagContent name >>= return . f++getMT :: MonadThrow m+ => Text+ -> Pipe Event Event o u m (Maybe Text)+getMT name = getM name id++elementM :: MonadThrow m+ => Text+ -> Pipe Event Event o u m a+ -> Pipe Event Event o u m (Maybe a)+elementM name inner = XML.tagNoAttr (ec2Name name) inner++element :: MonadThrow m+ => Text+ -> Pipe Event Event o u m a+ -> Pipe Event Event o u m a+element name inner = XML.force "parse error" $ elementM name inner++tagContent :: MonadThrow m+ => Text+ -> GLSink Event m (Maybe Text)+tagContent name = XML.tagNoAttr (ec2Name name) XML.content++tagContentF :: MonadThrow m+ => Text+ -> GLSink Event m Text+tagContentF = XML.force "parse error" . tagContent++ec2Name :: Text -> Name+ec2Name name = Name+ { nameLocalName = name+ , nameNamespace =+ Just $ "http://ec2.amazonaws.com/doc/" <> T.pack (BSC.unpack apiVersion) <> "/"+ , namePrefix = Nothing+ }
+ AWS/EC2/Query.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++module AWS.EC2.Query+ ( ec2Query+ , ec2QuerySource+ , ec2QuerySource'+ , ec2Request+ , QueryParam(..)+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.ByteString.Lazy.Char8 ()+import qualified Data.ByteString.Char8 as BSC++import Data.Monoid+import Data.XML.Types (Event(..))+import Data.Conduit+import qualified Data.Conduit.List as CL+import Control.Monad.Trans.Control (MonadBaseControl)+import qualified Network.HTTP.Conduit as HTTP+import qualified Text.XML.Stream.Parse as XmlP+import Data.Time (UTCTime, formatTime, getCurrentTime)+import System.Locale (defaultTimeLocale, iso8601DateFormat)+import qualified Data.Map as Map+import Data.Map (Map)+import qualified Network.HTTP.Types as H+import qualified Data.Digest.Pure.SHA as SHA+import qualified Data.ByteString.Base64 as BASE+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Class (lift)+import qualified Control.Monad.State as ST+import Control.Exception.Lifted as E+import Data.Text (Text)++import AWS.EC2.Types+import AWS.Types+import AWS.Util+import AWS.EC2.Parser+import AWS.EC2.Class+import AWS.Credential++{- Debug+import Debug.Trace+import qualified Data.Conduit.Binary as CB+--}++data QueryParam+ = ArrayParams Text [Text]+ | FilterParams [Filter]+ | ValueParam Text Text+ | StructArrayParams Text [[(Text, Text)]]+ deriving (Show)++queryHeader :: ByteString -> UTCTime -> Credential -> [(ByteString, ByteString)]+queryHeader action time cred =+ [ ("Action", action)+ , ("Version", apiVersion)+ , ("SignatureVersion", "2")+ , ("SignatureMethod", "HmacSHA256")+ , ("Timestamp", H.urlEncode True $ awsTimeFormat time)+ , ("AWSAccessKeyId", accessKey cred)+ ]++mkUrl :: Endpoint end+ => end+ -> Credential+ -> UTCTime+ -> ByteString+ -> [QueryParam]+ -> ByteString+mkUrl ep cred time action params = mconcat+ [ "https://"+ , endpointStr ep+ , "/?"+ , qparam+ , "&Signature="+ , signature ep (secretAccessKey cred) qparam+ ]+ where+ qheader = Map.fromList $ queryHeader action time cred+ qparam = queryStr $ Map.unions (qheader : map toArrayParams params)++toArrayParams :: QueryParam -> Map ByteString ByteString+toArrayParams (ArrayParams name params) = Map.fromList + [ (textToBS name <> "." <> bsShow i, textToBS param)+ | (i, param) <- zip ([1..]::[Int]) params+ ]+toArrayParams (FilterParams kvs) =+ Map.fromList . concat . map f1 $ zip ([1..]::[Int]) kvs+ where+ f1 (n, (key, vals)) = (filt n <> ".Name", textToBS key) :+ [ (filt n <> ".Value." <> bsShow i, textToBS param)+ | (i, param) <- zip ([1..]::[Int]) vals+ ]+ filt n = "Filter." <> bsShow n+toArrayParams (ValueParam k v) =+ Map.singleton (textToBS k) (textToBS v)+toArrayParams (StructArrayParams name vss) = Map.fromList l+ where+ bsName = textToBS name+ struct n (k, v) = (n <> "." <> textToBS k, textToBS v)+ l = mconcat+ [ map (struct (bsName <> "." <> bsShow i)) kvs+ | (i, kvs) <- zip ([1..]::[Int]) vss+ ]++queryStr :: Map ByteString ByteString -> ByteString+queryStr = BS.intercalate "&" . Map.foldrWithKey' concatWithEqual []+ where+ concatWithEqual key val acc = key <> "=" <> val : acc++awsTimeFormat :: UTCTime -> ByteString+awsTimeFormat = BSC.pack . formatTime defaultTimeLocale (iso8601DateFormat $ Just "%XZ")++signature :: Endpoint end + => end -> SecretAccessKey -> ByteString -> ByteString+signature ep secret query = urlstr+ where+ stringToSign = "GET\n" <> endpointStr ep <> "\n/\n" <> query+ signedStr = toS . SHA.bytestringDigest $ SHA.hmacSha256 (toL secret) (toL stringToSign)+ urlstr = H.urlEncode True . BASE.encode $ signedStr++sinkRequestId :: MonadThrow m+ => GLSink Event m Text+sinkRequestId = do+ await -- EventBeginDocument+ await -- EventBeginElement DescribeImagesResponse+ tagContentF "requestId"++ec2Request+ :: (MonadResource m, MonadBaseControl IO m)+ => EC2Context+ -> ByteString+ -> [QueryParam]+ -> m (ResumableSource m ByteString)+ec2Request ctx action params = do+ let mgr = manager ctx+ let cred = credential ctx+ let ep = endpoint ctx+ time <- liftIO getCurrentTime+ let url = mkUrl ep cred time action params+ request <- liftIO $ HTTP.parseUrl (BSC.unpack url)+ response <- HTTP.http request mgr+ return $ HTTP.responseBody response++ec2Query+ :: (MonadResource m, MonadBaseControl IO m)+ => ByteString+ -> [QueryParam]+ -> GLSink Event m o+ -> EC2 m o+ec2Query action params sink = do+ src <- ec2QuerySource action params $ sink >>= yield+ 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)+ec2QuerySource action params cond = do+ ec2QuerySource' action params Nothing cond++ec2QuerySource'+ :: (MonadResource m, MonadBaseControl IO m)+ => ByteString+ -> [QueryParam]+ -> Maybe Text+ -> Conduit Event m o+ -> EC2 m (Source m o)+ec2QuerySource' action params token cond = do+ ctx <- ST.get+ (src1, rid) <- lift $ do+ response <- ec2Request ctx action params'+ (res, _) <- unwrapResumable response+-- res $$ CB.sinkFile "debug.txt" >>= fail "debug"+ res $= XmlP.parseBytes XmlP.def $$+ sinkRequestId+ ST.put ctx{lastRequestId = Just rid}+ lift $ do+ (src2, _) <- unwrapResumable src1+ return $ src2 $= (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
+ AWS/EC2/Region.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.Region+ ( describeRegions+ ) 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.Types+import AWS.EC2.Class+import AWS.EC2.Query+import AWS.EC2.Parser++describeRegions+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ RegionNames+ -> [Filter] -- ^ Filters+ -> EC2 m (Source m Region)+describeRegions regions filters =+ ec2QuerySource "DescribeRegions" params regionInfoConduit+ where+ params =+ [ ArrayParams "RegionName" regions+ , FilterParams filters+ ]+ regionInfoConduit :: MonadThrow m+ => GLConduit Event m Region+ regionInfoConduit = itemConduit "regionInfo" $+ region+ <$> getT "regionName"+ <*> getT "regionEndpoint"
+ AWS/EC2/Tag.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.Tag+ ( describeTags+ ) where++import Data.Conduit+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Applicative++import AWS.EC2.Types+import AWS.EC2.Class+import AWS.EC2.Query+import AWS.EC2.Parser++describeTags+ :: (MonadResource m, MonadBaseControl IO m)+ => [Filter] -- ^ Filters+ -> EC2 m (Source m Tag)+describeTags filters =+ ec2QuerySource "DescribeTags" params $ itemConduit "tagSet" $+ tag+ <$> getT "resourceId"+ <*> getT "resourceType"+ <*> getT "key"+ <*> getMT "value"+ where+ params = [FilterParams filters]
+ AWS/EC2/Types.hs view
@@ -0,0 +1,836 @@+module AWS.EC2.Types where++import Data.Default (Default(..))+import Data.Text (Text)+import Data.Time (UTCTime)++import AWS.Util++type Filter = (Text, [Text])++data Image = Image+ { imageId :: Text+ , imageLocation :: Text+ , imageImageState :: ImageState+ , imageOwnerId :: Text+ , isPublic :: Bool+ , imageProductCodes :: [ProductCode]+ , imageArchitecture :: Text+ , imageImageType :: ImageType+ , kernelId :: Maybe Text+ , ramdiskId :: Maybe Text+ , imagePlatform :: Platform+ , imageStateReason :: Maybe StateReason+ , imageOwnerAlias :: Maybe Text+ , imageName :: Text+ , imageDescription :: Text+ , imageRootDeviceType :: RootDeviceType+ , imageRootDeviceName :: Maybe Text+ , blockDeviceMappings :: [BlockDeviceMapping]+ , imageVirtualizationType :: VirtualizationType+ , imageTagSet :: [ResourceTag]+ , imageHypervisor :: Hypervisor+ }+ deriving (Show)++image+ :: Text -> Text -> ImageState -> Text -> Bool+ -> [ProductCode] -> Text -> ImageType -> Maybe Text+ -> Maybe Text -> Platform -> Maybe StateReason+ -> Maybe Text -> Text -> Text -> RootDeviceType+ -> Maybe Text -> [BlockDeviceMapping] -> VirtualizationType+ -> [ResourceTag] -> Hypervisor -> Image+image i l s oid p pc a t kid rid pf+ sr oa n d rdt rdn bdms vt ts h =+ Image+ { imageId = i+ , imageLocation = l+ , imageImageState = s+ , imageOwnerId = oid+ , isPublic = p+ , imageProductCodes = pc+ , imageArchitecture = a+ , imageImageType = t+ , kernelId = kid+ , ramdiskId = rid+ , imagePlatform = pf+ , imageStateReason = sr+ , imageOwnerAlias = oa+ , imageName = n+ , imageDescription = d+ , imageRootDeviceType = rdt+ , imageRootDeviceName = rdn+ , blockDeviceMappings = bdms+ , imageVirtualizationType = vt+ , imageTagSet = ts+ , imageHypervisor = h+ }++data ImageState+ = ImageAvailable+ | ImagePending+ | ImageFailed+ deriving (Show)++imageState :: Text -> ImageState+imageState a+ | a == "available" = ImageAvailable+ | a == "pending" = ImagePending+ | a == "failed" = ImageFailed+ | otherwise = err "image state" a++data ProductCode = ProductCode+ { pcCode :: Text+ , pcType :: ProductCodeType+ }+ deriving (Show)++productCode :: Text -> ProductCodeType -> ProductCode+productCode c t = ProductCode+ { pcCode = c+ , pcType = t+ }++data ProductCodeType = Devpay+ | Marketplace+ deriving (Show)++productCodeType :: Text -> ProductCodeType+productCodeType t+ | t == "marketplace" = Marketplace+ | t == "devpay" = Devpay+ | otherwise = err "product code type" t++data ImageType = Machine+ | Kernel+ | RamDisk+ deriving (Show)++imageType :: Text -> ImageType+imageType t+ | t == "machine" = Machine+ | t == "kernel" = Kernel+ | t == "ramdisk" = RamDisk+ | otherwise = err "image type" t++data Platform = Windows+ | Other+ deriving (Show)++platform :: Maybe Text -> Platform+platform Nothing = Other+platform (Just t)+ | t == "windows" = Windows+ | otherwise = Other++data StateReason = StateReason+ { stateReasonCode :: Text+ , stateReasonMessage :: Text+ }+ deriving (Show)++stateReason :: Text -> Text -> StateReason+stateReason c m =+ StateReason+ { stateReasonCode = c+ , stateReasonMessage = m+ }++data RootDeviceType = EBS+ | InstanceStore+ deriving (Show)++rootDeviceType :: Text -> RootDeviceType+rootDeviceType t+ | t == "ebs" = EBS+ | t == "instance-store" = InstanceStore+ | otherwise = err "root device type" t++data BlockDeviceMapping = BlockDeviceMapping+ { deviceName :: Text+ , virtualName :: Maybe Text+ , ebs :: Maybe EbsBlockDevice+ }+ deriving (Show)++blockDeviceMapping :: Text -> Maybe Text -> Maybe EbsBlockDevice+ -> BlockDeviceMapping+blockDeviceMapping dname v e =+ BlockDeviceMapping+ { deviceName = dname+ , virtualName = v+ , ebs = e+ }++data EbsBlockDevice = EbsBlockDevice+ { ebsSnapshotId :: Maybe Text+ , ebsVolumeSize :: Int+ , ebsDeleteOnTermination :: Bool+ , ebsVolumeType :: VolumeType+ }+ deriving (Show)++ebsBlockDevice+ :: Maybe Text -> Int -> Bool -> VolumeType+ -> EbsBlockDevice+ebsBlockDevice sid vs dot vt =+ EbsBlockDevice+ { ebsSnapshotId = sid+ , ebsVolumeSize = vs+ , ebsDeleteOnTermination = dot+ , ebsVolumeType = vt+ }++data VolumeType = Standard+ | IO1 Int+ deriving (Show)++volumeType :: Text -> Maybe Int -> VolumeType+volumeType t Nothing | t == "standard" = Standard+volumeType t (Just i) | t == "io1" = IO1 i+volumeType t _ = err "volume type" t++instance Default VolumeType+ where+ def = Standard++data VirtualizationType = Paravirtual+ | HVM+ deriving (Show)++virtualizationType :: Text -> VirtualizationType+virtualizationType t+ | t == "paravirtual" = Paravirtual+ | t == "hvm" = HVM+ | otherwise = err "virtualization type" t++data ResourceTag = ResourceTag+ { resourceKey :: Text+ , resourceValue :: Maybe Text+ }+ deriving (Show)++resourceTag :: Text -> Maybe Text -> ResourceTag+resourceTag k v =+ ResourceTag+ { resourceKey = k+ , resourceValue = v+ }++data Hypervisor = OVM+ | Xen+ deriving (Show)++hypervisor :: Text -> Hypervisor+hypervisor t+ | t == "xen" = Xen+ | t == "ovm" = OVM+ | otherwise = err "hypervisor" t++{- DescribeRegions -}+data Region = Region+ { regionName :: Text+ , regionEndpoint :: Text+ }+ deriving (Show)++region :: Text -> Text -> Region+region name rep = Region+ { regionName = name+ , regionEndpoint = rep+ }++{- DescribeAvailabilityZones -}+data AvailabilityZone = AvailabilityZone+ { zoneName :: Text+ , zoneState :: Text+ , zoneRegionName :: Text+ , messageSet :: [AvailabilityZoneMessage]+ }+ deriving (Show)++type AvailabilityZoneMessage = Text++availabilityZone+ :: Text -> Text -> Text -> [AvailabilityZoneMessage]+ -> AvailabilityZone+availabilityZone name st reg msgs =+ AvailabilityZone+ { zoneName = name+ , zoneState = st+ , zoneRegionName = reg+ , messageSet = msgs+ }++{- DescribeInstances -}+data Reservation = Reservation+ { reservationId :: Text+ , ownerId :: Text+ , groupSet :: [Group]+ , instanceSet :: [Instance]+ , requesterId :: Maybe Text+ }+ deriving (Show)++reservation+ :: Text -> Text -> [Group] -> [Instance] -> Maybe Text+ -> Reservation+reservation i o g iset rid = Reservation+ { reservationId = i+ , ownerId = o+ , groupSet = g+ , instanceSet = iset+ , requesterId = rid+ }++data Instance = Instance+ { instanceId :: Text+ , instanceImageId :: Text+ , instanceState :: InstanceState+ , privateDnsName :: Text+ , dnsName :: Text+ , reason :: Text+ , keyName :: Maybe Text+ , amiLaunchIndex :: Text+ , instanceProductCodes :: [ProductCode]+ , instanceType :: Text+ , launchTime :: UTCTime+ , instancePlacement :: Placement+ , instanceKernelId :: Maybe Text+ , instanceRamdiskId :: Maybe Text+ , instancePlatform :: Maybe Text+ , instanceMonitoring :: InstanceMonitoringState+ , subnetId :: Maybe Text+ , vpcId :: Maybe Text+ , privateIpAddress :: Maybe Text+ , ipAddress :: Maybe Text+ , sourceDestCheck :: Maybe Bool+ , vpcGroupSet :: [Group]+ , instanceStateReason :: Maybe StateReason+ , instanceArchitecture :: Architecture+ , instanceRootDeviceType :: RootDeviceType+ , instanceRootDeviceName :: Maybe Text+ , instanceBlockDeviceMappings :: [InstanceBlockDeviceMapping]+ , instanceInstanceLifecycle :: InstanceLifecycle+ , spotInstanceRequestId :: Maybe Text+ , instanceVirtualizationType :: VirtualizationType+ , clientToken :: Text+ , instanceTagSet :: [ResourceTag]+ , instanceHypervisor :: Hypervisor+ , instanceNetworkInterfaceSet :: [InstanceNetworkInterface]+ , instanceIamInstanceProfile :: Maybe IamInstanceProfile+ , ebsOptimized :: Bool -- default: false+ }+ deriving (Show)++ec2Instance+ :: Text -> Text -> InstanceState -> Text -> Text -> Text+ -> Maybe Text -> Text -> [ProductCode] -> Text -> UTCTime+ -> Placement -> Maybe Text -> Maybe Text -> Maybe Text+ -> InstanceMonitoringState -> Maybe Text -> Maybe Text+ -> Maybe Text -> Maybe Text -> Maybe Bool -> [Group]+ -> Maybe StateReason -> Architecture -> RootDeviceType+ -> Maybe Text -> [InstanceBlockDeviceMapping]+ -> InstanceLifecycle -> Maybe Text -> VirtualizationType+ -> Text -> [ResourceTag] -> Hypervisor+ -> [InstanceNetworkInterface] -> Maybe IamInstanceProfile+ -> Bool -> Instance+ec2Instance iid img istate pdns dns res kname aidx pcode+ itype ltime place kid rid pf mon snid vpcid paddr addr+ sdc grp sreason arch rdtype rdname bdmap life spotid+ vtype ctoken tset hv nicset iam eopt =+ Instance+ { instanceId = iid+ , instanceImageId = img+ , instanceState = istate+ , privateDnsName = pdns+ , dnsName = dns+ , reason = res+ , keyName = kname+ , amiLaunchIndex = aidx+ , instanceProductCodes = pcode+ , instanceType = itype+ , launchTime = ltime+ , instancePlacement = place+ , instanceKernelId = kid+ , instanceRamdiskId = rid+ , instancePlatform = pf+ , instanceMonitoring = mon+ , subnetId = snid+ , vpcId = vpcid+ , privateIpAddress = paddr+ , ipAddress = addr+ , sourceDestCheck = sdc+ , vpcGroupSet = grp+ , instanceStateReason = sreason+ , instanceArchitecture = arch+ , instanceRootDeviceType = rdtype+ , instanceRootDeviceName = rdname+ , instanceBlockDeviceMappings = bdmap+ , instanceInstanceLifecycle = life+ , spotInstanceRequestId = spotid+ , instanceVirtualizationType = vtype+ , clientToken = ctoken+ , instanceTagSet = tset+ , instanceHypervisor = hv+ , instanceNetworkInterfaceSet = nicset+ , instanceIamInstanceProfile = iam+ , ebsOptimized = eopt+ }++data InstanceStatus = InstanceStatus+ { isInstanceId :: Text+ , isAvailabilityZone :: Text+ , isEventsSet :: [InstanceStatusEvent]+ , isInstanceState :: InstanceState+ , isSystemStatus :: InstanceStatusType+ , isInstanceStatus :: InstanceStatusType+ }+ deriving (Show)++instanceStatus :: Text -> Text -> [InstanceStatusEvent]+ -> InstanceState -> InstanceStatusType+ -> InstanceStatusType -> InstanceStatus+instanceStatus iid az es ist sst iss = InstanceStatus+ { isInstanceId = iid+ , isAvailabilityZone = az+ , isEventsSet = es+ , isInstanceState = ist+ , isSystemStatus = sst+ , isInstanceStatus = iss+ }++data InstanceStatusEvent = InstanceStatusEvent+ { iseCode :: InstanceStatusEventCode+ , iseDescription :: Text+ , iseNotBefore :: Maybe UTCTime+ , iseNotAfter :: Maybe UTCTime+ }+ deriving (Show)++instanceStatusEvent :: InstanceStatusEventCode+ -> Text -> Maybe UTCTime -> Maybe UTCTime+ -> InstanceStatusEvent+instanceStatusEvent code desc before after = InstanceStatusEvent+ { iseCode = code+ , iseDescription = desc+ , iseNotBefore = before+ , iseNotAfter = after+ }++data InstanceStatusEventCode+ = InstanceReboot+ | InstanceStop+ | SystemReboot+ | InstanceRetirement+ deriving (Show)++instanceStatusEventCode :: Text -> InstanceStatusEventCode+instanceStatusEventCode t+ | t == "instance-reboot" = InstanceReboot+ | t == "instance-stop" = InstanceStop+ | t == "system-reboot" = SystemReboot+ | t == "instance-retirement" = InstanceRetirement+ | otherwise = err "InstanceStatusEventCode" t++data InstanceStatusType = InstanceStatusType+ { isdStatus :: InstanceStatusTypeStatus+ , isdDetails :: [InstanceStatusDetail]+ }+ deriving (Show)++instanceStatusType :: InstanceStatusTypeStatus+ -> [InstanceStatusDetail] -> InstanceStatusType+instanceStatusType status details = InstanceStatusType+ { isdStatus = status+ , isdDetails = details+ }++data InstanceStatusTypeStatus+ = InstanceStatusOK+ | InstanceStatusImpaired+ | InstanceStatusInsufficientData+ | InstanceStatusNotApplicable+ deriving (Show)++instanceStatusTypeStatus :: Text -> InstanceStatusTypeStatus+instanceStatusTypeStatus t+ | t == "ok" = InstanceStatusOK+ | t == "impaired" = InstanceStatusImpaired+ | t == "insufficient-data" = InstanceStatusInsufficientData+ | t == "not-applicable" = InstanceStatusNotApplicable+ | otherwise = err "instance status detail status" t++data InstanceStatusDetail = InstanceStatusDetail+ { isddName :: InstanceStatusDetailName+ , isddStatus :: InstanceStatusDetailStatus+ , isddImpairedSince :: Maybe UTCTime+ }+ deriving (Show)++instanceStatusDetail :: InstanceStatusDetailName+ -> InstanceStatusDetailStatus -> Maybe UTCTime+ -> InstanceStatusDetail+instanceStatusDetail name status since =+ InstanceStatusDetail+ { isddName = name+ , isddStatus = status+ , isddImpairedSince = since+ }++type InstanceStatusDetailName = Text++type InstanceStatusDetailStatus = Text++data Group = Group+ { groupId :: Text+ , groupName :: Text+ }+ deriving (Show)++group :: Text -> Text -> Group+group i n = Group+ { groupId = i+ , groupName = n+ }++data InstanceState+ = Pending+ | Running+ | ShuttingDown+ | Terminated+ | Stopping+ | Stopped+ deriving (Show)++instanceStateCodes :: [(Int, InstanceState)]+instanceStateCodes =+ [ (0, Pending)+ , (16, Running)+ , (32, ShuttingDown)+ , (48, Terminated)+ , (64, Stopping)+ , (80, Stopped)+ ]++codeToState :: Int -> InstanceState+codeToState code = case lookup code instanceStateCodes of+ Nothing -> error "invalid state code"+ Just st -> st++data Placement = Placement+ { placementAvailabilityZone :: Text+ , placementGroupName :: Text+ , tenancy :: Text+ }+ deriving (Show)++placement :: Text -> Text -> Text -> Placement+placement zone gname ten = Placement+ { placementAvailabilityZone = zone+ , placementGroupName = gname+ , tenancy = ten+ }++data InstanceMonitoringState+ = MonitoringDisabled+ | MonitoringEnabled+ | MonitoringPending+ deriving (Show)++instanceMonitoringState :: Text -> InstanceMonitoringState+instanceMonitoringState t+ | t == "disabled" = MonitoringDisabled+ | t == "enabled" = MonitoringEnabled+ | t == "pending" = MonitoringPending+ | otherwise = err "monitoring state" t++data Architecture = I386 | X86_64 deriving (Show)++architecture :: Text -> Architecture+architecture t+ | t == "i386" = I386+ | t == "x86_64" = X86_64+ | otherwise = err "architecture" t++data InstanceBlockDeviceMapping = InstanceBlockDeviceMapping+ { instanceDeviceName :: Text+ , instanceEbs :: InstanceEbsBlockDevice+ }+ deriving (Show)++instanceBlockDeviceMapping+ :: Text -> InstanceEbsBlockDevice+ -> InstanceBlockDeviceMapping+instanceBlockDeviceMapping devname iebs =+ InstanceBlockDeviceMapping+ { instanceDeviceName = devname+ , instanceEbs = iebs+ }++data InstanceEbsBlockDevice = InstanceEbsBlockDevice+ { instanceEbsVolumeId :: Text+ , instanceEbsState :: VolumeState+ , instanceEbsAttachTime :: UTCTime+ , instanceEbsDeleteOnTermination :: Bool+ }+ deriving (Show)++instanceEbsBlockDevice+ :: Text -> VolumeState -> UTCTime -> Bool+ -> InstanceEbsBlockDevice+instanceEbsBlockDevice vid vst atime dot =+ InstanceEbsBlockDevice+ { instanceEbsVolumeId = vid+ , instanceEbsState = vst+ , instanceEbsAttachTime = atime+ , instanceEbsDeleteOnTermination = dot+ }++data VolumeState+ = VolumeAttaching+ | VolumeAttached+ | VolumeDetaching+ | VolumeDetached+ deriving (Show)++volumeState :: Text -> VolumeState+volumeState t+ | t == "attached" = VolumeAttached+ | t == "attaching" = VolumeAttaching+ | t == "detaching" = VolumeDetaching+ | t == "detached" = VolumeDetached+ | otherwise = err "volume state" t++data InstanceLifecycle = LifecycleSpot | LifecycleNone+ deriving (Show)++instanceLifecycle :: Maybe Text -> InstanceLifecycle+instanceLifecycle Nothing = LifecycleNone+instanceLifecycle (Just t)+ | t == "spot" = LifecycleSpot+ | otherwise = err "lifecycle" t++data InstanceNetworkInterface = InstanceNetworkInterface+ { instanceNetworkInterfaceId :: Text+ , iniSubnetId :: Text+ , iniVpcId :: Text+ , iniDescription :: Text+ , iniOwnerId :: Text+ , iniStatus :: Text+ , iniPrivateIpAddress :: Text+ , iniPrivateDnsName :: Maybe Text+ , iniSourceDestCheck :: Bool+ , iniGroupSet :: [Group]+ , iniAttachment :: NetworkInterfaceAttachment+ , iniAssociation :: Maybe NetworkInterfaceAssociation+ , iniPrivateIpAddressSet :: [InstancePrivateIpAddress]+ }+ deriving (Show)++instanceNetworkInterface+ :: Text -> Text -> Text -> Text -> Text -> Text -> Text+ -> Maybe Text -> Bool -> [Group] -> NetworkInterfaceAttachment+ -> Maybe NetworkInterfaceAssociation+ -> [InstancePrivateIpAddress]+ -> InstanceNetworkInterface+instanceNetworkInterface+ iid sid vpcid desc own st paddr pdns sdc grp att asso pips =+ InstanceNetworkInterface+ { instanceNetworkInterfaceId = iid+ , iniSubnetId = sid+ , iniVpcId = vpcid+ , iniDescription = desc+ , iniOwnerId = own+ , iniStatus = st+ , iniPrivateIpAddress = paddr+ , iniPrivateDnsName = pdns+ , iniSourceDestCheck = sdc+ , iniGroupSet = grp+ , iniAttachment = att+ , iniAssociation = asso+ , iniPrivateIpAddressSet = pips+ }++data NetworkInterfaceAttachment = NetworkInterfaceAttachment+ { niatAttachmentId :: Text+ , niatDeviceIndex :: Int+ , niatStatus :: Text+ , niatAttachTime :: UTCTime+ , niatDeleteOnTermination :: Bool+ }+ deriving (Show)++networkInterfaceAttachment+ :: Text -> Int -> Text -> UTCTime -> Bool+ -> NetworkInterfaceAttachment+networkInterfaceAttachment aid idx st time dot =+ NetworkInterfaceAttachment+ { niatAttachmentId = aid+ , niatDeviceIndex = idx+ , niatStatus = st+ , niatAttachTime = time+ , niatDeleteOnTermination = dot+ }++data NetworkInterfaceAssociation = NetworkInterfaceAssociation+ { niasPublicIp :: Text+ , niasIpOwnerId :: Text+ }+ deriving (Show)++networkInterfaceAssociation+ :: Text -> Text -> NetworkInterfaceAssociation+networkInterfaceAssociation ip own =+ NetworkInterfaceAssociation+ { niasPublicIp = ip+ , niasIpOwnerId = own+ }++data InstancePrivateIpAddress = InstancePrivateIpAddress+ { iPrivateIpAddress :: Text+ , iPrimary :: Bool+ , iAssociation :: Maybe NetworkInterfaceAssociation+ }+ deriving (Show)++instancePrivateIpAddress+ :: Text -> Bool -> Maybe NetworkInterfaceAssociation+ -> InstancePrivateIpAddress+instancePrivateIpAddress ip pr asso =+ InstancePrivateIpAddress+ { iPrivateIpAddress = ip+ , iPrimary = pr+ , iAssociation = asso+ }++data IamInstanceProfile = IamInstanceProfile+ { iipArn :: Text+ , iipId :: Text+ }+ deriving (Show)++iamInstanceProfile :: Text -> Text -> IamInstanceProfile+iamInstanceProfile arn iid = IamInstanceProfile+ { iipArn = arn+ , iipId = iid+ }++data Address = Address+ { addrPublicIp :: Text+ , addrAllocationId :: Maybe Text+ , addrDomain :: AddressDomain+ , addrInstanceId :: Maybe Text+ , addrAssociationId :: Maybe Text+ , addrNetworkInterfaceId :: Maybe Text+ , addrNetworkInterfaceOwnerId :: Maybe Text+ , addrPrivateIpAddress :: Maybe Text+ }+ deriving (Show)++address :: Text -> Maybe Text -> AddressDomain -> Maybe Text+ -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text+ -> Address+address pip alid dom iid asid niid nioid pips = Address+ { addrPublicIp = pip+ , addrAllocationId = alid+ , addrDomain = dom+ , addrInstanceId = iid+ , addrAssociationId = asid+ , addrNetworkInterfaceId = niid+ , addrNetworkInterfaceOwnerId = nioid+ , addrPrivateIpAddress = pips+ }++data AddressDomain = AddressDomainStandard | AddressDomainVPC+ deriving (Show)++addressDomain :: Maybe Text -> AddressDomain+addressDomain Nothing = AddressDomainStandard+addressDomain (Just t)+ | t == "standard" = AddressDomainStandard+ | t == "vpc" = AddressDomainVPC+ | otherwise = err "address domain" t++data AllocateAddressResponse = AllocateAddressResponse+ { alaPublicIp :: Text+ , alaDomain :: AddressDomain+ , alaAllocationId :: Maybe Text+ }+ deriving (Show)++allocateAddressResponse :: Text -> AddressDomain -> Maybe Text+ -> AllocateAddressResponse+allocateAddressResponse ip domain allid =+ AllocateAddressResponse+ { alaPublicIp = ip+ , alaDomain = domain+ , alaAllocationId = allid+ }++data EC2Return = EC2Success | EC2Error Text+ deriving (Show)++ec2Return :: Text -> EC2Return+ec2Return t+ | t == "true" = EC2Success+ | otherwise = EC2Error t++data Tag = Tag+ { tagResourceId :: Text+ , tagResourceType :: Text+ , tagKey :: Text+ , tagValue :: Maybe Text+ }+ deriving (Show)++tag :: Text -> Text -> Text -> Maybe Text -> Tag+tag tid ttype key value = Tag+ { tagResourceId = tid+ , tagResourceType = ttype+ , tagKey = key+ , tagValue = value+ }++data InstanceStateChange = InstanceStateChange+ { iscInstanceId :: Text+ , iscCurrentState :: InstanceState+ , iscPreviousState :: InstanceState+ }+ deriving (Show)++instanceStateChange :: Text -> InstanceState -> InstanceState+ -> InstanceStateChange+instanceStateChange iid curr prev = InstanceStateChange+ { iscInstanceId = iid+ , iscCurrentState = curr+ , iscPreviousState = prev+ }++data ConsoleOutput = ConsoleOutput+ { coInstanceId :: Text+ , coTimestamp :: UTCTime -- ^ The time the data was last updated.+ , coOutput :: Text+ }+ deriving (Show)++consoleOutput :: Text -> UTCTime -> Text -> ConsoleOutput+consoleOutput iid time out = ConsoleOutput+ { coInstanceId = iid+ , coTimestamp = time+ , coOutput = out+ }++data PasswordData = PasswordData+ { pdInstanceId :: Text+ , pdTimestamp :: UTCTime -- ^ The time the data was last updated.+ , pdPasswordData :: Text+ }+ deriving (Show)++passwordData :: Text -> UTCTime -> Text -> PasswordData+passwordData iid time out = PasswordData+ { pdInstanceId = iid+ , pdTimestamp = time+ , pdPasswordData = out+ }
+ AWS/EC2/Utils.hs view
@@ -0,0 +1,39 @@+module AWS.EC2.Utils where++import Control.Applicative+import qualified Data.Text as T++import AWS.EC2.Query (QueryParam(..))+import AWS.EC2.Types+import AWS.EC2.Params+import AWS.Util++blockDeviceMappingParams+ :: [BlockDeviceMappingParam] -> QueryParam+blockDeviceMappingParams =+ StructArrayParams "BlockDeviceMapping" . map kvs+ where+ kvs (BlockDeviceMappingParamEBS name dev src dot vtype) = + [ ("Ebs.DeviceName", name)+ , ebsSource src+ ] ++ vtparam vtype ++ (uncurry f =<<+ [ ("Ebs.NoDevice", boolToText <$> dev)+ , ("Ebs.DeleteOnTermination", boolToText <$> dot)+ ])+ kvs (BlockDeviceMappingParamInstanceStore name dev vname) =+ [("Ebs.DeviceName", name)] ++ (uncurry f =<<+ [ ("Ebs.NoDevice", boolToText <$> dev)+ , ("Ebs.VirtualName", vname)+ ])++ ebsSource (EbsSnapshotId sid) = ("Ebs.SnapshotId", sid)+ ebsSource (EbsVolumeSize size) =+ ("Ebs.VolumeSize", T.pack $ show size)++ f n = maybe [] (\a -> [(n, a)])+ vtparam Nothing = []+ vtparam (Just Standard) = [("Ebs.VolumeType", "standard")]+ vtparam (Just (IO1 iops)) =+ [ ("Ebs.VolumeType", "io1")+ , ("Ebs.Iops", T.pack $ show iops)+ ]
+ AWS/Types.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+module AWS.Types+ ( Endpoint (..)+ , EC2Endpoint (..)+ ) where++import Data.ByteString (ByteString)+import Data.ByteString.Char8 ()++class Endpoint a where+ endpointStr :: a -> ByteString++data EC2Endpoint = UsEast1+ | ApNortheast1++instance Endpoint EC2Endpoint where+ endpointStr UsEast1 = "ec2.us-east-1.amazonaws.com"+ endpointStr ApNortheast1 = "ec2.ap-northeast-1.amazonaws.com"
+ AWS/Util.hs view
@@ -0,0 +1,57 @@+module AWS.Util where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Read as TR+import Data.Time (UTCTime)+import qualified Data.Time as Time+import System.Locale (defaultTimeLocale)++toS :: BSL.ByteString -> ByteString+toS = BS.concat . BSL.toChunks++toL :: ByteString -> BSL.ByteString+toL = BSL.fromChunks . (:[])++bsShow :: Show a => a -> ByteString+bsShow = BSC.pack . show++err :: String -> Text -> a+err v m = error $ "unknown " ++ v ++ ": " ++ T.unpack m++textToBool :: Text -> Bool+textToBool a+ | a == "true" = True+ | a == "false" = False+ | otherwise = err "value" a++textToInt :: Integral a => Text -> a+textToInt t = either + (const $ error "not decimal")+ fst+ (TR.decimal t)++textToTime :: Text -> UTCTime+textToTime = Time.readTime defaultTimeLocale fmt . T.unpack+ where+ fmt = "%FT%T.000Z"++orEmpty :: Maybe Text -> Text+orEmpty = maybe "" id++boolToText :: Bool -> Text+boolToText True = "true"+boolToText False = "false"++toText :: Show a => a -> Text+toText = T.pack . show++bsToText :: ByteString -> Text+bsToText = T.pack . BSC.unpack++textToBS :: Text -> ByteString+textToBS = BSC.pack . T.unpack
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, AWS SDK for Haskell Developers++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Yusuke Nomura nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ aws-sdk.cabal view
@@ -0,0 +1,74 @@+name: aws-sdk+version: 0.1.0.0+synopsis: AWS SDK for Haskell+description: An AWS(Amazon Web Services) liblary for Haskell.+license: BSD3+license-file: LICENSE+author: Yusuke Nomura <yunomu@gmail.com>+maintainer: Yusuke Nomura <yunomu@gmail.com>+homepage: https://worksap-ate.github.com/aws-sdk+copyright: AWS SDK for Haskell Developers+category: Cloud, AWS+build-type: Simple+cabal-version: >=1.8++library+ exposed-modules: AWS+ , AWS.Types+ , AWS.EC2+ , AWS.EC2.Types+ , AWS.EC2.Params+ other-modules: AWS.Util+ , AWS.Credential+ , AWS.EC2.Address+ , AWS.EC2.AvailabilityZone+ , AWS.EC2.Image+ , AWS.EC2.Instance+ , AWS.EC2.Parser+ , AWS.EC2.Query+ , AWS.EC2.Region+ , AWS.EC2.Tag+ , AWS.EC2.Class+ , AWS.EC2.Utils+ , AWS.EC2.Parser+ , AWS.EC2.Parser.Internal+ ghc-options: -Wall+ -fno-warn-unused-do-bind+ extensions: OverloadedStrings+ build-depends: base ==4.5.*+ , containers+ , SHA+ , base64-bytestring >= 1.0.0.0+ , bytestring+ , http-types+ , conduit+ , transformers+ , time+ , old-locale+ , http-conduit+ , data-default+ , xml-conduit+ , xml-types+ , text+ , monad-control+ , safe+ , simple-config >= 1.1.0+ , parsec3+ , mtl+ , lifted-base+ , transformers-base++test-suite test+ type: exitcode-stdio-1.0+ main-is: main.hs+ hs-source-dirs: tests+ ghc-options: -Wall++ build-depends: base+ , hspec+ , QuickCheck++source-repository head+ type: git+ location: git://github.com/worksap-ate/aws-sdk.git+
+ tests/main.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main where++import Test.Hspec (hspec)++import PropExample+import SpecExample++main :: IO ()+main = do+ propTest+ specTest++specTest :: IO ()+specTest = hspec normalSpecs++propTest :: IO ()+propTest = hspec propSpecs