forest-fire (empty) → 0.1.0.0

raw patch · 11 files changed

+327/−0 lines, 11 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, cli, containers, forest-fire, pretty-tree, process, text

Files

• LICENSE +30/−0
• README.md +49/−0
• Setup.hs +2/−0
• app/Main.hs +28/−0
• forest-fire.cabal +57/−0
• src/AWSCommands.hs +44/−0
• src/JSONInstances.hs +30/−0
• src/Lib.hs +55/−0
• src/TreeUtils.hs +10/−0
• src/Types.hs +20/−0
• test/Spec.hs +2/−0

@@ -0,0 +1,30 @@+Copyright Paul (c) 2017++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 Paul 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.

@@ -0,0 +1,49 @@+# forest-fire++This is a little command-line tool with an ill-advised name, to easily+tear down CloudFormation stacks which have outputs that other stacks+depend on.  In the AWS Console this is rather annoying, since you have+to manually chase up dependencies.++This tool simply interrogates the `aws-cli` tool about the stack+you're trying to delete, finds out its outputs, and checks whether any+currently-active stacks are importing them.  The output is a+dependency tree, which trivially tells us the order of deletion for it+to succeed.  If you're feeling adventurous, you may also let+`forest-fire` do the actual deletion for you.++# Installation++## Prerequisites++You'll need the following installed and available to be able to use+this software:++* Haskell Stack+* AWS CLI interface++## Instructions++tba++# Usage++If you simply run the tool without arguments, it'll print usage+information.  Here's the down-low, however.++## Find out what depends on a stack++```sh+stack exec forest-fire -- "kubernetes-dynamic-91acf0ef-lifecycle"+```++## Perform the deletions if you're satisfied with the tree++```sh+stack exec forest-fire -- "kubernetes-dynamic-91acf0ef-lifecycle" --delete+```++# Credits++Thanks Redbubble, i totally should've been doing other things instead+of shaving this yak.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,28 @@+module Main where++import Lib+import Console.Options++main :: IO ()+main = defaultMain $ do+  programName "forest-fire"+  programDescription "Recursively delete CFn dependencies"+  flagA    <- flag $ FlagLong "delete"+  allArgs  <- remainingArguments "FILE"+  action $ \toParam -> do+      let reallyDelete = toParam flagA+      let stackName    = toParam allArgs+      case stackName of+        [s] -> if reallyDelete+               then actuallyDoTheDelete s+               else showDeletionPlan s+        _   -> printUsage++printUsage = do+  putStrLn "\nforest-fire"+  putStrLn "-----------\n"+  putStrLn "Usage:\n"+  putStrLn "  forest-fire <stackname> [--delete]\n"+  putStrLn "Flags:\n"+  putStrLn "--delete       To actually perform the deletion."+  putStrLn ""

@@ -0,0 +1,57 @@+name:                forest-fire+version:             0.1.0.0+synopsis:            Recursively delete CloudFormation stacks and their dependants+description: |+  This simple tool will repeatedly query CloudFormation+  stacks for outputs, and see if any other stacks are+  importing those.  This is to make it easier to tear down+  CFn stacks which have many other stacks depending on+  their outputs.+homepage:            https://github.com/toothbrush/forest-fire#readme+license:             BSD3+license-file:        LICENSE+author:              Paul+maintainer:          paul.david@redbubble.com+copyright:           Copyright: (c) 2017 Paul+category:            silly tool+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Lib+                     , AWSCommands+                     , JSONInstances+                     , TreeUtils+                     , Types+  build-depends:       base >= 4.7 && < 5+                     , aeson+                     , bytestring+                     , process+                     , text+                     , containers+                     , pretty-tree+  default-language:    Haskell2010++executable forest-fire+  hs-source-dirs:      app+  main-is:             Main.hs+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  build-depends:       base+                     , cli+                     , forest-fire+  default-language:    Haskell2010++test-suite forest-fire-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , forest-fire+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/toothbrush/forest-fire

@@ -0,0 +1,44 @@+module AWSCommands where++import Types+import qualified Data.ByteString.Lazy.Char8 as B+import System.Process+import GHC.IO.Exception++executeAWScommand :: Bool -> [String] -> IO B.ByteString+executeAWScommand allowFail args = do+  putStrLn $ "[EXEC] aws " ++ unwords args+  (code, stdout, stderr) <- readProcessWithExitCode "aws" args ""+  case code of+    ExitSuccess -> pure (B.pack stdout)+    _ -> if allowFail+         then pure (B.pack "")+         else do putStrLn stderr+                 error $ show code++jsonForDescribeStacks :: StackName -> IO B.ByteString+jsonForDescribeStacks (StackName s) =+  executeAWScommand False [ "cloudformation"+                          , "describe-stacks"+                          , "--stack-name", s]++jsonForListImports :: ExportName -> IO B.ByteString+jsonForListImports (ExportName e) =+  -- this one's optional, don't fail.+  executeAWScommand True [ "cloudformation"+                         , "list-imports"+                         , "--export-name", e]++doDeletionWait :: StackName -> IO ()+doDeletionWait (StackName s) = do+  putStrLn $ "Issuing delete command on stack " ++ s ++ "."+  res <- executeAWScommand False [ "cloudformation"+                                 , "delete-stack"+                                 , "--stack-name", s]+  putStrLn "Awaiting completion... (60 minute timeout)"+  res <- executeAWScommand False [ "cloudformation"+                                 , "wait"+                                 , "stack-delete-complete"+                                 , "--no-paginate"+                                 , "--stack-name", s]+  putStrLn $ "Removal of " ++ s ++ " complete."

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module JSONInstances where++import Types++import Data.Aeson+import Data.Aeson.Types    -- that's where Parser comes from++instance FromJSON Export where+  parseJSON = withObject "Export" $ \t ->+    Export <$> t .: "ExportName"++instance FromJSON Stacks where+  parseJSON = withObject "Stacks" $ \t ->+    Stacks <$> t .: "Stacks"++instance FromJSON Stack where+  parseJSON = withObject "Stack" $ \t ->+    Stack <$> t .:  "StackId"+          <*> t .:  "StackName"+          <*> t .:? "Outputs" .!= [] -- If there are no outputs, return []++instance FromJSON Imports where+  parseJSON = withObject "Imports" $ \t ->+    Imports <$> t .: "Imports"++instance FromJSON StackName+instance FromJSON StackId+instance FromJSON ExportName

@@ -0,0 +1,55 @@+-- TODO+-- * test suite (around JSON parsing, mostly)+-- * readme (w/ how to install and use)+-- * send to Hackage/Stackage++module Lib where++import Types+import JSONInstances+import AWSCommands+import TreeUtils++import Data.Tree+import Data.Tree.Pretty+import Data.List+import Data.Maybe+import Data.Aeson++showDeletionPlan :: String -> IO ()+showDeletionPlan stackName = do+  putStrLn $ "Retrieving dependencies of " ++ stackName ++ "..."+  tree <- buildDependencyGraph (StackName stackName)+  -- let tree = exampleDep2+  putStrLn "Done.  Delete these stacks in postorder traversal:\n"+  putStrLn $ drawTree (dependencyToTree tree)+  putStrLn "Or, delete manually in this order:\n"+  mapM_ putStrLn $ postorder (dependencyToTree tree)++actuallyDoTheDelete :: String -> IO ()+actuallyDoTheDelete stackName = do+  putStrLn $ "Retrieving dependencies of " ++ stackName ++ "..."+  tree <- buildDependencyGraph (StackName stackName)+  putStrLn "Deleting dependencies and stack..."+  mapM_ (doDeletionWait . StackName) $ postorder (dependencyToTree tree)++findExportsByStack :: StackName -> IO [ExportName]+findExportsByStack s = do+  json <- eitherDecode <$> jsonForDescribeStacks s+  either error (pure . map eName . concatMap sExports . sStacks) json++whoImportsThisValue :: ExportName -> IO [StackName]+whoImportsThisValue e = do+  json <- eitherDecode <$> jsonForListImports e :: IO (Either String Imports)+  either (const (pure [])) (pure . iStackNames) json++buildDependencyGraph :: StackName -> IO Dependency+buildDependencyGraph = buildDependencyGraph' [] -- the empty list is because we haven't yet queried any stacks+  where buildDependencyGraph' :: [StackName] -> StackName -> IO Dependency+        buildDependencyGraph' alreadySeen name = do+          outputs <- findExportsByStack name+          importers <- mapM whoImportsThisValue outputs+          let downstreams = nub $ filter (`notElem` alreadySeen) $ concat importers+          downstreamDeps <- mapM (buildDependencyGraph' (alreadySeen ++ downstreams)) downstreams+          pure $ Dependency name downstreamDeps+

@@ -0,0 +1,10 @@+module TreeUtils where++import Data.Tree+import Types++dependencyToTree :: Dependency -> Tree String+dependencyToTree (Dependency (StackName name) deps) = Node name (map dependencyToTree deps)++postorder :: Tree a -> [a]+postorder (Node label kids) = concatMap postorder kids ++ [label]

@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveGeneric #-}++module Types where++import GHC.Generics++data Dependency = Dependency {dStackName    :: StackName,+                              dDependencies :: [Dependency]} deriving (Show)++data Stack = Stack {sStackId   :: StackId,+                    sStackName :: StackName,+                    sExports   :: [Export]} deriving Show++newtype Stacks = Stacks { sStacks :: [Stack]} deriving Show+newtype Export = Export { eName :: ExportName} deriving Show++newtype StackName  = StackName  String      deriving (Show, Generic, Eq)+newtype StackId    = StackId    String      deriving (Show, Generic, Eq)+newtype ExportName = ExportName String      deriving (Show, Generic)+newtype Imports    = Imports    { iStackNames :: [StackName] } deriving (Show)

@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"