AWSで作成したインスタンス等を削除する処理

main.hs

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

module Main where

import Prelude hiding (catch)
import Data.Text ()
import Data.Conduit
import qualified Data.Conduit.List as CL
import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Exception
import qualified Control.Exception.Lifted as E (catch)
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Class (lift)
import Network.HTTP.Conduit
import Network.TLS

import AWS
import AWS.EC2
import AWS.EC2.Types
import qualified AWS.EC2.Util as Util
import qualified AWS.ELB as ELB
import AWS.ELB.Types

terminateAllInstances region = do
    setRegion region
    doc <- Util.list $ describeInstances [] []
    let instanceIds = getInstanceIds doc
    terminateInstances instanceIds 
    return instanceIds 
  where
    getInstanceIds doc = concat 
                         $ map (\rsvtn -> map instanceId $ reservationInstanceSet rsvtn) doc

releaseAllAddresses region = do
    setRegion region
    addrs <- Util.list $ describeAddresses [] [] []
    let publicIps     = map (\addr -> Just $ addressPublicIp addr) addrs
        allocationIds = map addressAllocationId addrs
        ipIds         = zip publicIps allocationIds 
    forM_ ipIds $ \(publicIp, allocationId) ->
        case allocationId of
      Just _  -> releaseAddress Nothing  allocationId
	    Nothing -> releaseAddress publicIp Nothing
        `E.catch` \(_ :: AWSException) -> return $ EC2Error "release fail"
    return publicIps

deleteAllSecurityGroups region = do
    setRegion region
    groups <- Util.list $ describeSecurityGroups [] [] []
    let groupIds = map securityGroupId groups
        requests = map SecurityGroupRequestGroupId groupIds
    forM_ requests $ \req -> 
        (deleteSecurityGroup req) 
        `E.catch` (\(_ :: AWSException) -> return False)
    return groupIds
  
deleteAllVpcs region = do
    setRegion region
    vpcIds <- map vpcId <$> (Util.list $ describeVpcs [] [])
    forM_ vpcIds $ \vpcId ->  
        deleteVpc vpcId `E.catch` \(_ :: AWSException) -> return False
    return vpcIds

deleteAllInternetGateways region = do
    setRegion region
    gatewayIds <- map internetGatewayInternetGatewayId 
                  <$> (Util.list $ describeInternetGateways [] [])
    forM_ gatewayIds $ \gatewayId ->
        deleteInternetGateway gatewayId `E.catch` \(_ :: AWSException) -> return False
    return gatewayIds

deleteAllSubnet region = do
    setRegion region
    subnetIds <- map subnetId <$> (Util.list $ describeSubnets [] [])
    forM_ subnetIds $ \subnetId ->
        deleteSubnet subnetId `E.catch` \(_ :: AWSException) -> return False
    return subnetIds

deleteAllVolumes region = do
    setRegion region
    volumeIds <- map volumeId <$> (Util.list $ describeVolumes [] [])
    forM_ volumeIds $ \volumeId ->
        deleteVolume volumeId `E.catch` \(_ :: AWSException) -> return False
    return volumeIds

deleteAllLoadBalancers region = do
    ELB.setRegion region
    lbNames <- map lbLoadBalancerName <$> (ELB.describeLoadBalancers [] Nothing)
    -- mapM_ deleteLoadBalancer lbNames
    return lbNames

removeResources cred region = do
    doRemoveProc "instances"       terminateAllInstances 
    doRemoveProc "addresses"       releaseAllAddresses
    doRemoveProc "security groups" deleteAllSecurityGroups
    doRemoveProc "gateways"        deleteAllInternetGateways
    doRemoveProc "subnet"          deleteAllSubnet
    doRemoveProc "volumes"         deleteAllVolumes
    doRemoveProc "load balancers"  deleteAllLoadBalancers
    doRemoveProc "vpcs"            deleteAllVpcs
  where
    doRemoveProc title removeProc = do
        putStrLn title
        (runResourceT $ runEC2 cred $ removeProc region) 
        `catches` [ Handler awsExceptionHandler
                  , Handler handShakeFailedHandler
                  , Handler failedConnectionExceptionHandler]
      where
          awsExceptionHandler :: AWSException -> IO [a]
          awsExceptionHandler e = do 
              print e
              return []
          handShakeFailedHandler :: HandshakeFailed -> IO [a]
          handShakeFailedHandler e = do 
              threadDelay $ 5 * 1000 * 1000
              doRemoveProc title removeProc
              return []
          failedConnectionExceptionHandler :: HttpException -> IO [a]
          failedConnectionExceptionHandler e = do
              threadDelay $ 5 * 1000 * 1000
              doRemoveProc title removeProc
              return []

regions = [ "us-east-1"
          , "us-west-1"
          -- , "us-west-2"
          -- , "eu-west-1"
          -- , "ap-southeast-1"
          -- , "ap-southeast-2"
          -- , "sa-east-1"
          ]

main :: IO ()
main = do
    cred <- loadCredential
    mapM_ (removeResources cred) regions
    return () 

test.cabal

-- test.cabal auto-generated by cabal init. For additional options,
-- see
-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
-- The name of the package.
Name:                test

-- The package version. See the Haskell package versioning policy
-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
-- standards guiding when and how versions should be incremented.
Version:             0.1

-- A short (one-line) description of the package.
-- Synopsis:            

-- A longer description of the package.
-- Description:         

-- URL for the project homepage or repository.
Homepage:            http://hello

-- The license under which the package is released.
License:             BSD3

-- The file containing the license text.
License-file:        LICENSE

-- The package author(s).
Author:              mitou

-- An email address to which users can send suggestions, bug reports,
-- and patches.
Maintainer:          mitou@mail

-- A copyright notice.
-- Copyright:           

Category:            Test

Build-type:          Simple

-- Extra files to be distributed with the package, such as examples or
-- a README.
-- Extra-source-files:  

-- Constraint on the version of Cabal needed to build this package.
Cabal-version:       >=1.2


Executable test
  -- .hs or .lhs file containing the Main module.
  Main-is: main.hs
  
  -- Packages needed in order to build this package.
--  Build-depends: base, aws-sdk >=0.9.1.0, transformers, conduit, text
  Build-depends: base, aws-sdk, transformers, conduit, text, tls, lifted-base, http-conduit
  -- Modules not exported by this package.
  -- Other-modules:       
  
  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
  -- Build-tools: