aws-sdk 0.4.2.0 → 0.4.3.0

raw patch · 4 files changed

+288/−174 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• AWS/EC2/Internal.hs +169/−0
• AWS/EC2/Types.hs +83/−173
• AWS/EC2/Util.hs +35/−0
• aws-sdk.cabal +1/−1

@@ -72,3 +72,172 @@  returnBool :: MonadThrow m => GLSink Event m Bool returnBool = getF "return" textToBool++imageState :: Text -> ImageState+imageState a+    | a == "available" = ImageAvailable+    | a == "pending"   = ImagePending+    | a == "failed"    = ImageFailed+    | otherwise        = err "image state" a++productCodeType :: Text -> ProductCodeType+productCodeType t+    | t == "marketplace" = Marketplace+    | t == "devpay"      = Devpay+    | otherwise          = err "product code type" t++imageType :: Text -> ImageType+imageType t+    | t == "machine"  = Machine+    | t == "kernel"   = Kernel+    | t == "ramdisk" = RamDisk+    | otherwise       = err "image type" t++platform :: Maybe Text -> Platform+platform Nothing   = Other+platform (Just t)+    | t == "windows" = Windows+    | otherwise      = Other++rootDeviceType :: Text -> RootDeviceType+rootDeviceType t+    | t == "ebs"            = EBS+    | t == "instance-store" = InstanceStore+    | otherwise             = err "root device type" t++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++virtualizationType :: Text -> VirtualizationType+virtualizationType t+    | t == "paravirtual" = Paravirtual+    | t == "hvm"         = HVM+    | otherwise          = err "virtualization type" t++hypervisor :: Text -> Hypervisor+hypervisor t+    | t == "xen" = Xen+    | t == "ovm" = OVM+    | otherwise  = err "hypervisor" t++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++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++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 -> UnknownState code+    Just st -> st++instanceMonitoringState :: Text -> InstanceMonitoringState+instanceMonitoringState t+    | t == "disabled" = MonitoringDisabled+    | t == "enabled"  = MonitoringEnabled+    | t == "pending"  = MonitoringPending+    | otherwise       = err "monitoring state" t++architecture :: Text -> Architecture+architecture t+    | t == "i386"   = I386+    | t == "x86_64" = X86_64+    | otherwise     = err "architecture" t++addressDomain :: Maybe Text -> AddressDomain+addressDomain Nothing = AddressDomainStandard+addressDomain (Just t)+    | t == "standard" = AddressDomainStandard+    | t == "vpc"      = AddressDomainVPC+    | otherwise       = err "address domain" t++ec2Return :: Text -> EC2Return+ec2Return t+    | t == "true" = EC2Success+    | otherwise   = EC2Error t++snapshotStatus :: Text -> SnapshotStatus+snapshotStatus t+    | t == "pending"   = SSPending+    | t == "completed" = SSCompleted+    | t == "error"     = SSError+    | otherwise        = err "snapshot status" t++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++attachmentStatus :: Text -> AttachmentStatus+attachmentStatus t+    | t == "attaching" = AttAttaching+    | t == "attached"  = AttAttached+    | t == "detaching" = AttDetaching+    | t == "detached"  = AttDetached+    | otherwise        = err "attachment status" t++shutdownBehavior :: Text -> ShutdownBehavior+shutdownBehavior t+    | t == "stop"      = SBStop+    | t == "terminate" = SBTerminate+    | otherwise = err "shutdown behavior" t++vpnConnectionState :: Text -> VpnConnectionState+vpnConnectionState t+    | t == "pending"   = VCSPending+    | t == "available" = VCSAvailable+    | t == "deleting"  = VCSDeleting+    | t == "deleted"   = VCSDeleted+    | otherwise        = err "vpn connection state" t++vpnTunnelTelemetryStatus :: Text -> VpnTunnelTelemetryStatus+vpnTunnelTelemetryStatus t+    | t == "UP"   = VTTSUp+    | t == "DOWN" = VTTSDown+    | otherwise   = err "vpn tunnel telemetry status" t++vpnStaticRouteSource :: Text -> VpnStaticRouteSource+vpnStaticRouteSource t+    | t == "Static" = VSRStatic+    | otherwise     = err "vpn static route source" t++vpnStaticRouteState :: Text -> VpnStaticRouteState+vpnStaticRouteState t+    | t == "pending"   = VSRSPending+    | t == "available" = VSRSAvailable+    | t == "deleting"  = VSRSDeleting+    | t == "deleted"   = VSRSDeleted+    | otherwise        = err "vpn static route state" t++instanceLifecycle :: Maybe Text -> InstanceLifecycle+instanceLifecycle Nothing = LifecycleNone+instanceLifecycle (Just t)+    | t == "spot"   = LifecycleSpot+    | otherwise     = err "lifecycle" t

@@ -1,12 +1,92 @@-module AWS.EC2.Types where+module AWS.EC2.Types+    ( Address(..)+    , AddressDomain(..)+    , AllocateAddressResponse(..)+    , Architecture(..)+    , AssociateAddressRequest(..)+    , Attachment(..)+    , AttachmentStatus(..)+    , AvailabilityZone(..)+    , AvailabilityZoneMessage+    , BlockDeviceMapping(..)+    , BlockDeviceMappingParam(..)+    , ConsoleOutput(..)+    , CreateVolumeRequest(..)+    , DisassociateAddressRequest(..)+    , EbsBlockDevice(..)+    , EbsSource(..)+    , EC2Return(..)+    , Group(..)+    , Hypervisor(..)+    , IamInstanceProfile(..)+    , Image(..)+    , ImageState(..)+    , ImageType(..)+    , Instance(..)+    , InstanceAttribute(..)+    , InstanceAttributeRequest(..)+    , InstanceBlockDeviceMapping(..)+    , InstanceEbsBlockDevice(..)+    , InstanceLifecycle(..)+    , InstanceMonitoringState(..)+    , InstanceNetworkInterface(..)+    , InstancePrivateIpAddress(..)+    , InstanceState(..)+    , InstanceStateChange(..)+    , InstanceStatus(..)+    , InstanceStatusEvent(..)+    , InstanceStatusEventCode(..)+    , InstanceStatusType(..)+    , InstanceStatusTypeStatus(..)+    , InstanceStatusDetail(..)+    , InstanceStatusDetailName+    , InstanceStatusDetailStatus+    , IpPermission(..)+    , IpRange(..)+    , KeyPair(..)+    , ModifyInstanceAttributeRequest(..)+    , NetworkInterfaceAssociation(..)+    , NetworkInterfaceAttachment(..)+    , NetworkInterfaceParam(..)+    , PasswordData(..)+    , Placement(..)+    , Platform(..)+    , ProductCode(..)+    , ProductCodeType(..)+    , Region(..)+    , RegisterImageRequest(..)+    , Reservation(..)+    , ResetInstanceAttributeRequest(..)+    , ResourceTag(..)+    , RootDeviceType(..)+    , RunInstancesRequest(..)+    , SecurityGroup(..)+    , SecurityGroupRequest(..)+    , ShutdownBehavior(..)+    , Snapshot(..)+    , SnapshotStatus(..)+    , StateReason(..)+    , Tag(..)+    , UserIdGroupPair(..)+    , VirtualizationType(..)+    , Volume(..)+    , VolumeType(..)+    , VolumeStatus(..)+    , VpnConnection(..)+    , VpnConnectionOptionsRequest(..)+    , VpnConnectionState(..)+    , VpnStaticRoute(..)+    , VpnStaticRouteSource(..)+    , VpnStaticRouteState(..)+    , VpnTunnelTelemetry(..)+    , VpnTunnelTelemetryStatus(..)+    ) where  import Data.Default (Default(..)) import Data.Text (Text) import Data.ByteString (ByteString) import Data.Time (UTCTime) -import AWS.Util- data Image = Image     { imageId :: Text     , imageLocation :: Text@@ -40,13 +120,6 @@     | ImageFailed   deriving (Show, Eq) -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@@ -57,34 +130,15 @@                      | Marketplace   deriving (Show, Eq) -productCodeType :: Text -> ProductCodeType-productCodeType t-    | t == "marketplace" = Marketplace-    | t == "devpay"      = Devpay-    | otherwise          = err "product code type" t- data ImageType = Machine                | Kernel                | RamDisk   deriving (Show, Eq) -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, Eq) -platform :: Maybe Text -> Platform-platform Nothing   = Other-platform (Just t)-    | t == "windows" = Windows-    | otherwise      = Other- data StateReason = StateReason     { stateReasonCode :: Text     , stateReasonMessage :: Text@@ -96,12 +150,6 @@     | InstanceStore   deriving (Show, Eq) -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@@ -121,11 +169,6 @@                 | IO1 Int   deriving (Show, Eq) -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@@ -134,12 +177,6 @@                         | HVM   deriving (Show, Eq) -virtualizationType :: Text -> VirtualizationType-virtualizationType t-    | t == "paravirtual" = Paravirtual-    | t == "hvm"         = HVM-    | otherwise          = err "virtualization type" t- data ResourceTag = ResourceTag     { resourceKey :: Text     , resourceValue :: Maybe Text@@ -150,13 +187,6 @@                 | Xen   deriving (Show, Eq) -hypervisor :: Text -> Hypervisor-hypervisor t-    | t == "xen" = Xen-    | t == "ovm" = OVM-    | otherwise  = err "hypervisor" t--{- DescribeRegions -} data Region = Region     { regionName :: Text     , regionEndpoint :: Text@@ -247,14 +277,6 @@     | InstanceRetirement   deriving (Show, Eq) -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]@@ -268,14 +290,6 @@     | InstanceStatusNotApplicable   deriving (Show, Eq) -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@@ -303,21 +317,6 @@     | UnknownState Int   deriving (Show, Eq) -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 -> UnknownState code-    Just st -> st- data Placement = Placement     { placementAvailabilityZone :: Text     , placementGroupName :: Text@@ -331,21 +330,8 @@     | MonitoringPending   deriving (Show, Eq) -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, Eq) -architecture :: Text -> Architecture-architecture t-    | t == "i386"   = I386-    | t == "x86_64" = X86_64-    | otherwise     = err "architecture" t- data InstanceBlockDeviceMapping = InstanceBlockDeviceMapping     { instanceDeviceName :: Text     , instanceEbs :: InstanceEbsBlockDevice@@ -363,12 +349,6 @@ data InstanceLifecycle = LifecycleSpot | LifecycleNone   deriving (Show, Eq) -instanceLifecycle :: Maybe Text -> InstanceLifecycle-instanceLifecycle Nothing = LifecycleNone-instanceLifecycle (Just t)-    | t == "spot"   = LifecycleSpot-    | otherwise     = err "lifecycle" t- data InstanceNetworkInterface = InstanceNetworkInterface     { instanceNetworkInterfaceId :: Text     , iniSubnetId :: Text@@ -419,12 +399,6 @@     | SBTerminate   deriving (Show, Eq) -shutdownBehavior :: Text -> ShutdownBehavior-shutdownBehavior t-    | t == "stop"      = SBStop-    | t == "terminate" = SBTerminate-    | otherwise = err "shutdown behavior" t- data InstanceAttribute     = IAInstanceType Text     | IAKernelId (Maybe Text)@@ -455,13 +429,6 @@ data AddressDomain = AddressDomainStandard | AddressDomainVPC   deriving (Show, Eq) -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@@ -472,11 +439,6 @@ data EC2Return = EC2Success | EC2Error Text   deriving (Show, Eq) -ec2Return :: Text -> EC2Return-ec2Return t-    | t == "true" = EC2Success-    | otherwise   = EC2Error t- data Tag = Tag     { tagResourceId :: Text     , tagResourceType :: Text@@ -523,13 +485,6 @@ data SnapshotStatus = SSPending | SSCompleted | SSError   deriving (Show, Eq) -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@@ -552,16 +507,6 @@     | VolError   deriving (Show, Eq) -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@@ -579,14 +524,6 @@     | AttDetached   deriving (Show, Eq) -attachmentStatus :: Text -> AttachmentStatus-attachmentStatus t-    | t == "attaching" = AttAttaching-    | t == "attached"  = AttAttached-    | t == "detaching" = AttDetaching-    | t == "detached"  = AttDetached-    | otherwise        = err "attachment status" t- data KeyPair = KeyPair     { keyName :: Text     , keyFingerprint :: Text@@ -678,14 +615,6 @@     | VCSDeleted   deriving (Show, Eq) -vpnConnectionState :: Text -> VpnConnectionState-vpnConnectionState t-    | t == "pending"   = VCSPending-    | t == "available" = VCSAvailable-    | t == "deleting"  = VCSDeleting-    | t == "deleted"   = VCSDeleted-    | otherwise        = err "vpn connection state" t- data VpnTunnelTelemetry = VpnTunnelTelemetry     { vttOutsideIpAddress :: Text     , vttStatus :: VpnTunnelTelemetryStatus@@ -700,12 +629,6 @@     | VTTSDown   deriving (Show, Eq) -vpnTunnelTelemetryStatus :: Text -> VpnTunnelTelemetryStatus-vpnTunnelTelemetryStatus t-    | t == "UP"   = VTTSUp-    | t == "DOWN" = VTTSDown-    | otherwise   = err "vpn tunnel telemetry status" t- data VpnConnectionOptionsRequest = VpnConnectionOptionsRequest     { staticRoutesOnly :: Bool     }@@ -721,25 +644,12 @@ data VpnStaticRouteSource = VSRStatic   deriving (Show, Eq) -vpnStaticRouteSource :: Text -> VpnStaticRouteSource-vpnStaticRouteSource t-    | t == "Static" = VSRStatic-    | otherwise     = err "vpn static route source" t- data VpnStaticRouteState     = VSRSPending     | VSRSAvailable     | VSRSDeleting     | VSRSDeleted   deriving (Show, Eq)--vpnStaticRouteState :: Text -> VpnStaticRouteState-vpnStaticRouteState t-    | t == "pending"   = VSRSPending-    | t == "available" = VSRSAvailable-    | t == "deleting"  = VSRSDeleting-    | t == "deleted"   = VSRSDeleted-    | otherwise        = err "vpn static route state" t  data RunInstancesRequest = RunInstancesRequest     { riImageId :: Text -- ^ Required

@@ -4,12 +4,19 @@     ( asList     , head     , each+    , wait     ) where  import Data.Conduit import qualified Data.Conduit.List as CL import Control.Monad.Trans.Class (lift) import Prelude hiding (head)+import Safe+import qualified Control.Concurrent as CC+import Control.Monad.IO.Class (liftIO, MonadIO)+import Data.Text (Text)+import qualified Data.Text as T+import Control.Applicative  import AWS.EC2.Internal @@ -49,3 +56,31 @@     case ma of         Nothing -> return ()         Just a  -> f a >> each' s' f++-- | Wait for condition.+--+-- > import AWS.EC2+-- > import AWS.EC2.Types+-- > import AWS.EC2.Util (asList, wait)+-- > +-- > waitForAvailable :: (MonadIO m, Functor m)+-- >     => Text -- ^ ImageId+-- >     -> EC2 m a+-- > waitForAvailable = wait+-- >     (\img -> imageImageState img == ImageAvailable)+-- >     (\imgId -> asList (describeImages [imgId] [] [] []))+wait+    :: (MonadIO m, Functor m)+    => (a -> Bool) -- ^ condition+    -> (Text -> EC2 m [a]) -- ^ DescribeResources+    -> Text -- ^ Resource Id+    -> EC2 m a+wait f g rid = do+    mr <- headMay <$> g rid+    case mr of+        Nothing -> fail $ "Resource not found: " ++ T.unpack rid+        Just r  -> if f r+            then return r+            else do+                liftIO $ CC.threadDelay 5+                wait f g rid

@@ -1,5 +1,5 @@ name:                aws-sdk-version:             0.4.2.0+version:             0.4.3.0 synopsis:            AWS SDK for Haskell description:         An AWS(Amazon Web Services) liblary for Haskell. license:             BSD3