aws-sdk 0.1.0.1 → 0.1.1.0
raw patch · 8 files changed
+246/−24 lines, 8 filesdep ~base
Dependency ranges changed: base
Files
- AWS/EC2.hs +6/−0
- AWS/EC2/Image.hs +1/−4
- AWS/EC2/Instance.hs +1/−1
- AWS/EC2/Parser.hs +8/−0
- AWS/EC2/Snapshot.hs +49/−0
- AWS/EC2/Types.hs +125/−17
- AWS/EC2/Volume.hs +52/−0
- aws-sdk.cabal +4/−2
AWS/EC2.hs view
@@ -11,6 +11,10 @@ , module AWS.EC2.Instance -- * Images , module AWS.EC2.Image+ -- * Volumes+ , module AWS.EC2.Volume+ -- * Snapshots+ , module AWS.EC2.Snapshot -- * Placements , module AWS.EC2.Region , module AWS.EC2.AvailabilityZone@@ -34,6 +38,8 @@ import AWS.EC2.Instance import AWS.EC2.Address import AWS.EC2.Tag+import AWS.EC2.Snapshot+import AWS.EC2.Volume import AWS.Credential newEC2Context :: Credential -> IO EC2Context
AWS/EC2/Image.hs view
@@ -67,10 +67,7 @@ <$> getMT "snapshotId" <*> getF "volumeSize" textToInt <*> getF "deleteOnTermination" textToBool- <*> (volumeType- <$> getT "volumeType"- <*> getM "iops" (textToInt <$>)- )+ <*> volumeTypeSink ) ) <*> getF "virtualizationType" virtualizationType
AWS/EC2/Instance.hs view
@@ -103,7 +103,7 @@ <*> element "ebs" ( instanceEbsBlockDevice <$> getT "volumeId"- <*> getF "status" volumeState+ <*> getF "status" attachmentStatus <*> getF "attachTime" textToTime <*> getF "deleteOnTermination" textToBool )
AWS/EC2/Parser.hs view
@@ -3,6 +3,7 @@ , resourceTagSink , productCodeSink , stateReasonSink+ , volumeTypeSink ) where import Control.Applicative@@ -11,6 +12,7 @@ import AWS.EC2.Types import AWS.EC2.Parser.Internal+import AWS.Util resourceTagSink :: MonadThrow m => GLSink Event m [ResourceTag]@@ -32,3 +34,9 @@ stateReason <$> getT "code" <*> getT "message"++volumeTypeSink :: MonadThrow m+ => GLSink Event m VolumeType+volumeTypeSink = volumeType+ <$> getT "volumeType"+ <*> getM "iops" (textToInt <$>)
+ AWS/EC2/Snapshot.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.Snapshot+ ( describeSnapshots+ ) 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++describeSnapshots+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ SnapshotIds+ -> [Text] -- ^ Owners (UserId)+ -> [Text] -- ^ RestorableBy (UserId)+ -> [Filter] -- ^ Filters+ -> EC2 m (Source m Snapshot)+describeSnapshots ssids owners restby filters =+ ec2QuerySource "DescribeSnapshots" params snapshotSet+ where+ params =+ [ ArrayParams "SnapshotId" ssids+ , ArrayParams "Owner" owners+ , ArrayParams "RestorableBy" restby+ , FilterParams filters+ ]+ snapshotSet :: MonadThrow m+ => GLConduit Event m Snapshot+ snapshotSet = itemConduit "snapshotSet" $+ snapshot+ <$> getT "snapshotId"+ <*> getT "volumeId"+ <*> getF "status" snapshotStatus+ <*> getF "startTime" textToTime+ <*> getT "progress"+ <*> getT "ownerId"+ <*> getF "volumeSize" textToInt+ <*> getT "description"+ <*> getMT "ownerAlias"+ <*> resourceTagSink
AWS/EC2/Types.hs view
@@ -570,14 +570,14 @@ data InstanceEbsBlockDevice = InstanceEbsBlockDevice { instanceEbsVolumeId :: Text- , instanceEbsState :: VolumeState+ , instanceEbsState :: AttachmentStatus , instanceEbsAttachTime :: UTCTime , instanceEbsDeleteOnTermination :: Bool } deriving (Show) instanceEbsBlockDevice- :: Text -> VolumeState -> UTCTime -> Bool+ :: Text -> AttachmentStatus -> UTCTime -> Bool -> InstanceEbsBlockDevice instanceEbsBlockDevice vid vst atime dot = InstanceEbsBlockDevice@@ -587,21 +587,6 @@ , 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) @@ -834,3 +819,126 @@ , pdTimestamp = time , pdPasswordData = out }++data Snapshot = Snapshot+ { snapshotId :: Text+ , ssVolumeId :: Text+ , ssStatus :: SnapshotStatus+ , ssStartTime :: UTCTime+ , ssProgress :: Text+ , ssOwnerId :: Text+ , ssVolumeSize :: Int+ , ssDescription :: Text+ , ssOwnerAlias :: Maybe Text+ , ssTagSet :: [ResourceTag]+ }+ deriving (Show)++snapshot :: Text -> Text -> SnapshotStatus -> UTCTime+ -> Text -> Text -> Int -> Text -> Maybe Text+ -> [ResourceTag] -> Snapshot+snapshot ssid vid stat stime progress oid vsize desc oali tags =+ Snapshot+ { snapshotId = ssid+ , ssVolumeId = vid+ , ssStatus = stat+ , ssStartTime = stime+ , ssProgress = progress+ , ssOwnerId = oid+ , ssVolumeSize = vsize+ , ssDescription = desc+ , ssOwnerAlias = oali+ , ssTagSet = tags+ }++data SnapshotStatus = SSPending | SSCompleted | SSError+ deriving (Show)++snapshotStatus :: Text -> SnapshotStatus+snapshotStatus t+ | t == "pending" = SSPending+ | t == "completed" = SSCompleted+ | t == "error" = SSError+ | otherwise = err "snapshot status" t++data Volume = Volume+ { volumeId :: Text+ , volSize :: Int+ , volSnapshotId :: Maybe Text+ , volAvailabilityZone :: Text+ , volStatus :: VolumeStatus+ , volCreateTime :: UTCTime+ , volAttachmentSet :: [Attachment]+ , volTagSet :: [ResourceTag]+ , volVolumeType :: VolumeType+ }+ deriving (Show)++volume :: Text -> Int -> Maybe Text -> Text -> VolumeStatus -> UTCTime+ -> [Attachment] -> [ResourceTag] -> VolumeType -> Volume+volume vid size sid az stat ctime aset tset vtype = Volume+ { volumeId = vid+ , volSize = size+ , volSnapshotId = sid+ , volAvailabilityZone = az+ , volStatus = stat+ , volCreateTime = ctime+ , volAttachmentSet = aset+ , volTagSet = tset+ , volVolumeType = vtype+ }++data VolumeStatus+ = VolCreating+ | VolAvailable+ | VolInUse+ | VolDeleting+ | VolDeleted+ | VolError+ deriving (Show)++volumeStatus :: Text -> VolumeStatus+volumeStatus t+ | t == "creating" = VolCreating+ | t == "available" = VolAvailable+ | t == "in-use" = VolInUse+ | t == "deleting" = VolDeleting+ | t == "deleted" = VolDeleted+ | t == "error" = VolError+ | otherwise = err "volume state" t++data Attachment = Attachment+ { attVolumeId :: Text+ , attInstanceId :: Text+ , attDevice :: Text+ , attStatus :: AttachmentStatus+ , attAttachTime :: UTCTime+ , attDeleteOnTermination :: Bool+ }+ deriving (Show)++attachment :: Text -> Text -> Text -> AttachmentStatus+ -> UTCTime -> Bool -> Attachment+attachment vid iid dev stat atime dot = Attachment+ { attVolumeId = vid+ , attInstanceId = iid+ , attDevice = dev+ , attStatus = stat+ , attAttachTime = atime+ , attDeleteOnTermination = dot+ }++data AttachmentStatus+ = AttAttaching+ | AttAttached+ | AttDetaching+ | AttDetached+ deriving (Show)++attachmentStatus :: Text -> AttachmentStatus+attachmentStatus t+ | t == "attaching" = AttAttaching+ | t == "attached" = AttAttached+ | t == "detaching" = AttDetaching+ | t == "detached" = AttDetached+ | otherwise = err "attachment status" t
+ AWS/EC2/Volume.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleContexts #-}++module AWS.EC2.Volume+ ( describeVolumes+ ) 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++describeVolumes+ :: (MonadResource m, MonadBaseControl IO m)+ => [Text] -- ^ VolumeIds+ -> [Filter] -- ^ Filters+ -> EC2 m (Source m Volume)+describeVolumes vids filters =+ ec2QuerySource "DescribeVolumes" params volumeSet+ where+ params =+ [ ArrayParams "VolumeId" vids+ , FilterParams filters+ ]+ volumeSet :: MonadThrow m+ => GLConduit Event m Volume+ volumeSet = itemConduit "volumeSet" $+ volume+ <$> getT "volumeId"+ <*> getF "size" textToInt+ <*> getMT "snapshotId"+ <*> getT "availabilityZone"+ <*> getF "status" volumeStatus+ <*> getF "createTime" textToTime+ <*> itemsSet "attachmentSet" (+ attachment+ <$> getT "volumeId"+ <*> getT "instanceId"+ <*> getT "device"+ <*> getF "status" attachmentStatus+ <*> getF "attachTime" textToTime+ <*> getF "deleteOnTermination" textToBool+ )+ <*> resourceTagSink+ <*> volumeTypeSink
aws-sdk.cabal view
@@ -1,5 +1,5 @@ name: aws-sdk-version: 0.1.0.1+version: 0.1.1.0 synopsis: AWS SDK for Haskell description: An AWS(Amazon Web Services) liblary for Haskell. license: BSD3@@ -24,6 +24,8 @@ , AWS.EC2.AvailabilityZone , AWS.EC2.Image , AWS.EC2.Instance+ , AWS.EC2.Volume+ , AWS.EC2.Snapshot , AWS.EC2.Parser , AWS.EC2.Query , AWS.EC2.Region@@ -35,7 +37,7 @@ ghc-options: -Wall -fno-warn-unused-do-bind extensions: OverloadedStrings- build-depends: base ==4.5.*+ build-depends: base >= 4 && < 5 , containers <= 0.4.2.1 , SHA , base64-bytestring >= 1.0.0.0