Change public interface

stack-deploy/package.yaml

@@ -1,7 +1,7 @@
 _common/package: !include "../common/package.yaml"
 
 name:        stack-deploy
-version:     0.0.9
+version:     0.1.0
 synopsis:    Utilities around cloudformation templates
 license:     BSD3
 
@@ -50,3 +50,14 @@ dependencies:
 tests:
   test:
     <<: *test
+    other-modules:  []
+  doctest:
+    dependencies:
+    - doctest-parallel
+    main: DocTest.hs
+    other-modules:  []
+    source-dirs: test
+    ghc-options:
+    - -rtsopts
+    - -threaded
+    - -with-rtsopts=-N

stack-deploy/src/StackDeploy/AWS.hs

@@ -2,7 +2,6 @@ module StackDeploy.AWS (listResource) where
 
 import Data.Conduit (ConduitT, (.|))
 import Data.Conduit.Combinators (concatMap)
--- import Network.AWS.Types as Exports
 import StackDeploy.Prelude
 
 import qualified Amazonka

stack-deploy/src/StackDeploy/CLI.hs

@@ -1,9 +1,9 @@
 module StackDeploy.CLI (parserInfo) where
 
 import CLI.Utils
+import Control.Applicative (many)
 import Control.Lens ((.~))
 import Data.Conduit ((.|), runConduit)
-import Options.Applicative hiding (value)
 import StackDeploy.CLI.Utils
 import StackDeploy.Events
 import StackDeploy.IO
@@ -12,7 +12,6 @@ import StackDeploy.Prelude
 import StackDeploy.Stack
 import StackDeploy.Types
 import StackDeploy.Wait
-import System.Exit (ExitCode(..))
 
 import qualified Amazonka.CloudFormation.CancelUpdateStack   as CF
 import qualified Amazonka.CloudFormation.DescribeStackEvents as CF
@@ -21,29 +20,34 @@ import qualified Data.Attoparsec.Text                        as Text
 import qualified Data.ByteString.Lazy                        as LBS
 import qualified Data.Char                                   as Char
 import qualified Data.Conduit.Combinators                    as Conduit
+import qualified Data.Map.Strict                             as Map
 import qualified Data.Text.Encoding                          as Text
 import qualified Data.Text.IO                                as Text
 import qualified MIO.Amazonka                                as AWS
+import qualified Options.Applicative                         as CLI
 import qualified StackDeploy.AWS                             as AWS
 import qualified StackDeploy.Env                             as StackDeploy
-import qualified StackDeploy.InstanceSpec                    as InstanceSpec
-import qualified StackDeploy.Template                        as Template
+import qualified StackDeploy.InstanceSpec                    as StackDeploy
+import qualified StackDeploy.NamedTemplate                   as StackDeploy
+import qualified StackDeploy.Stack                           as StackDeploy
+import qualified Stratosphere                                as CFT
+import qualified System.Exit                                 as System
 
 parserInfo
   :: forall env . (AWS.Env env, StackDeploy.Env env)
-  => InstanceSpec.Provider env
-  -> ParserInfo (MIO env ExitCode)
-parserInfo instanceSpecProvider = wrapHelper commands "stack commands"
+  => StackDeploy.InstanceSpecMap env
+  -> CLI.ParserInfo (MIO env System.ExitCode)
+parserInfo instanceSpecMap = wrapHelper commands "stack commands"
   where
-    commands :: Parser (MIO env ExitCode)
-    commands = hsubparser
+    commands :: CLI.Parser (MIO env System.ExitCode)
+    commands = CLI.hsubparser
       $  mkCommand "instance" instanceCommands     "instance commands"
       <> mkCommand "spec"     specCommands         "instance spec commands"
       <> mkCommand "token"    (pure printNewToken) "print a new stack token"
       <> mkCommand "template" templateCommands     "template commands"
 
-    instanceCommands :: Parser (MIO env ExitCode)
-    instanceCommands = hsubparser
+    instanceCommands :: CLI.Parser (MIO env System.ExitCode)
+    instanceCommands = CLI.hsubparser
       $  mkCommand "cancel"   (cancel <$> instanceSpecNameOption)                "cancel stack update"
       <> mkCommand "create"   (create <$> instanceSpecNameOption <*> parameters) "create stack"
       <> mkCommand "delete"   (delete <$> instanceSpecNameOption)                "delete stack"
@@ -55,125 +59,159 @@ parserInfo instanceSpecProvider = wrapHelper commands "stack commands"
       <> mkCommand "wait"     (wait <$> instanceSpecNameOption <*> tokenParser)  "wait for stack operation"
       <> mkCommand "watch"    (watch <$> instanceSpecNameOption)                 "watch stack events"
 
-    templateCommands :: Parser (MIO env ExitCode)
-    templateCommands = hsubparser
+    templateCommands :: CLI.Parser (MIO env System.ExitCode)
+    templateCommands = CLI.hsubparser
       $  mkCommand "list"    (pure listTemplates)            "list templates"
       <> mkCommand "render"  (render <$> templateNameOption) "render template"
 
-    specCommands :: Parser (MIO env ExitCode)
-    specCommands = hsubparser
+    specCommands :: CLI.Parser (MIO env System.ExitCode)
+    specCommands = CLI.hsubparser
       $  mkCommand "list"   (pure listSpecs) "list stack specifications"
 
-    tokenParser :: Parser Token
-    tokenParser = Token <$> argument str (metavar "TOKEN")
+    tokenParser :: CLI.Parser Token
+    tokenParser = Token <$> CLI.argument CLI.str (CLI.metavar "TOKEN")
 
-    cancel :: InstanceSpec.Name -> MIO env ExitCode
+    cancel :: StackDeploy.InstanceSpecName -> MIO env System.ExitCode
     cancel name = do
       void . AWS.send . CF.newCancelUpdateStack $ toText name
       success
 
-    create :: InstanceSpec.Name -> Parameters -> MIO env ExitCode
-    create name params = do
-      spec <- InstanceSpec.get instanceSpecProvider name params
-      exitCode =<< perform (OpCreate spec)
-
-    update :: InstanceSpec.Name -> Parameters -> MIO env ExitCode
-    update name params = do
-      spec     <- InstanceSpec.get instanceSpecProvider name params
-      stackId  <- getExistingStackId name
-
-      exitCode =<< perform (OpUpdate stackId spec)
-
-    sync :: InstanceSpec.Name -> Parameters -> MIO env ExitCode
-    sync name params = do
-      spec <- InstanceSpec.get instanceSpecProvider name params
-
-      exitCode
-        =<< perform . maybe (OpCreate spec) (`OpUpdate` spec)
-        =<< getStackId name
-
-    wait :: InstanceSpec.Name -> Token -> MIO env ExitCode
+    create :: StackDeploy.InstanceSpecName -> ParameterMap -> MIO env System.ExitCode
+    create name userParameterMap = do
+      withInstanceSpec name $ \instanceSpec ->
+        exitCode =<< perform (OpCreate instanceSpec userParameterMap)
+
+    update :: StackDeploy.InstanceSpecName -> ParameterMap -> MIO env System.ExitCode
+    update name userParameterMap = do
+      withInstanceSpec name $ \instanceSpec ->
+        withExistingStack name $ \stackId ->
+          exitCode =<< perform (OpUpdate stackId instanceSpec userParameterMap)
+
+    sync :: StackDeploy.InstanceSpecName -> ParameterMap -> MIO env System.ExitCode
+    sync name userParameterMap = do
+      withInstanceSpec name $ \instanceSpec -> do
+        exitCode
+          =<< perform . maybe
+                (OpCreate instanceSpec userParameterMap)
+                (\stackId -> OpUpdate stackId instanceSpec userParameterMap)
+          =<< getStackId name
+
+    wait :: StackDeploy.InstanceSpecName -> Token -> MIO env System.ExitCode
     wait name token = maybe success (waitForOperation token) =<< getStackId name
 
-    outputs :: InstanceSpec.Name -> MIO env ExitCode
+    outputs :: StackDeploy.InstanceSpecName -> MIO env System.ExitCode
     outputs name = do
       traverse_ printOutput . fromMaybe [] . (.outputs) =<< getExistingStack name
       success
       where
         printOutput :: CF.Output -> MIO env ()
         printOutput = liftIO . Text.putStrLn . convertText . show
 
-    delete :: InstanceSpec.Name -> MIO env ExitCode
+    delete :: StackDeploy.InstanceSpecName -> MIO env System.ExitCode
     delete = maybe success (exitCode <=< perform . OpDelete) <=< getStackId
 
-    list :: MIO env ExitCode
+    list :: MIO env System.ExitCode
     list = do
       runConduit $ stackNames .| Conduit.mapM_ say
       success
 
-    listTemplates :: MIO env ExitCode
+    listTemplates :: MIO env System.ExitCode
     listTemplates = do
-      traverse_
-        (liftIO . Text.putStrLn . toText . (.name))
-        (toList templateProvider)
+      printList $ Map.keys templateMap
       success
 
-    listSpecs :: MIO env ExitCode
+    listSpecs :: MIO env System.ExitCode
     listSpecs = do
-      traverse_
-        (liftIO . Text.putStrLn . toText . (.name))
-        (toList instanceSpecProvider)
+      printList $ Map.keys instanceSpecMap
       success
 
-    events :: InstanceSpec.Name -> MIO env ExitCode
+    events :: StackDeploy.InstanceSpecName -> MIO env System.ExitCode
     events name = do
       runConduit $ AWS.listResource req (fromMaybe [] . (.stackEvents)) .| Conduit.mapM_ printEvent
       success
       where
         req = CF.newDescribeStackEvents & CF.describeStackEvents_stackName .~ pure (toText name)
 
-    watch :: InstanceSpec.Name -> MIO env ExitCode
+    watch :: StackDeploy.InstanceSpecName -> MIO env System.ExitCode
     watch name = do
       stackId <- getExistingStackId name
       void $ pollEvents (defaultPoll stackId) printEvent
       success
 
-    waitForOperation :: Token -> Id -> MIO env ExitCode
+    waitForOperation :: Token -> StackId -> MIO env System.ExitCode
     waitForOperation token stackId =
       exitCode =<< waitForAccept RemoteOperation{..} printEvent
 
-    printNewToken :: MIO env ExitCode
+    printNewToken :: MIO env System.ExitCode
     printNewToken = do
       say =<< newToken
       success
 
-    render :: Template.Name -> MIO env ExitCode
-    render name = do
-      template <- Template.get templateProvider name
-      say . Text.decodeUtf8 . LBS.toStrict $ Template.encode template
-      success
-
-    success :: MIO env ExitCode
-    success = pure ExitSuccess
+    render :: StackDeploy.TemplateName -> MIO env System.ExitCode
+    render templateName =
+      maybe
+        (failure $ "Template not found: " <> convert templateName)
+        printPretty
+        (Map.lookup templateName templateMap)
+      where
+        printPretty :: CFT.Template -> MIO env System.ExitCode
+        printPretty template = do
+          say
+            . Text.decodeUtf8
+            . LBS.toStrict
+            $ StackDeploy.stratosphereTemplateEncodePretty template
+          pure System.ExitSuccess
+
+    success :: MIO env System.ExitCode
+    success = pure System.ExitSuccess
+
+    failure :: Text -> MIO env System.ExitCode
+    failure message = do
+      say message
+      pure $ System.ExitFailure 1
 
     exitCode = \case
       RemoteOperationSuccess -> success
-      RemoteOperationFailure -> pure $ ExitFailure 1
-
-    templateProvider = InstanceSpec.templateProvider instanceSpecProvider
-
-parameter :: Parser Parameter
-parameter = option
+      RemoteOperationFailure -> failure "Stack operation failed"
+
+    templateMap = StackDeploy.instanceSpecTemplateMap instanceSpecMap
+
+    withExistingStack
+      :: StackDeploy.InstanceSpecName
+      -> (StackId -> MIO env System.ExitCode)
+      -> MIO env System.ExitCode
+    withExistingStack instanceSpecName action =
+      StackDeploy.getStackId instanceSpecName >>=
+        maybe
+          (failure $ "Stack does not exist: " <> convert instanceSpecName)
+          action
+
+    withInstanceSpec
+      :: StackDeploy.InstanceSpecName
+      -> (StackDeploy.InstanceSpec env -> MIO env System.ExitCode)
+      -> MIO env System.ExitCode
+    withInstanceSpec instanceSpecName action =
+      maybe
+        (failure $ "Instance spec does not exist: " <> convert instanceSpecName)
+        action
+        (Map.lookup instanceSpecName instanceSpecMap)
+
+
+    printList :: Conversion Text a => [a] -> MIO env ()
+    printList = traverse_ say
+
+parameter :: CLI.Parser Parameter
+parameter = CLI.option
   parameterReader
-  (long "parameter" <> help "Set stack parameter")
+  (CLI.long "parameter" <> CLI.help "Set stack parameter")
 
-parameterReader :: ReadM Parameter
-parameterReader = eitherReader (Text.parseOnly parser . convertText)
+parameterReader :: CLI.ReadM Parameter
+parameterReader = CLI.eitherReader (Text.parseOnly parser . convertText)
   where
     parser = do
-      name <- ParameterName . convertText <$> Text.many1 (Text.satisfy allowChar)
+      name <- convertFail =<< Text.many1 (Text.satisfy allowChar)
       Text.skip (== ':')
-      value <- ParameterValue . convertText <$> Text.many' Text.anyChar
+      value <- convertFail =<< Text.many' Text.anyChar
       void Text.endOfInput
 
       pure $ Parameter name value
@@ -182,5 +220,5 @@ parameterReader = eitherReader (Text.parseOnly parser . convertText)
       '-'  -> True
       char -> Char.isDigit char || Char.isAlpha char
 
-parameters :: Parser Parameters
-parameters = fromList <$> many parameter
+parameters :: CLI.Parser ParameterMap
+parameters = fromList . fmap (\Parameter{..} -> (name, value)) <$> many parameter

stack-deploy/src/StackDeploy/CLI/Utils.hs

@@ -8,20 +8,20 @@ import GHC.TypeLits (KnownSymbol)
 import Options.Applicative
 import StackDeploy.Prelude
 
-import qualified StackDeploy.InstanceSpec as InstanceSpec
-import qualified StackDeploy.Template     as Template
+import qualified StackDeploy.InstanceSpec  as StackDeploy
+import qualified StackDeploy.NamedTemplate as StackDeploy
 
-instanceSpecNameOption :: Parser InstanceSpec.Name
+instanceSpecNameOption :: Parser StackDeploy.InstanceSpecName
 instanceSpecNameOption =
   option
     reader
     (long "instance" <> metavar "INSTANCE" <> help "Stack instance name")
 
-templateNameOption :: Parser Template.Name
+templateNameOption :: Parser StackDeploy.TemplateName
 templateNameOption =
   option
     reader
-    (long "template" <> metavar "TEMPLATE" <> help "Template name")
+    (long "template" <> metavar "TEMPLATE_NAME" <> help "Template name")
 
 reader :: KnownSymbol a => ReadM (BoundText a)
 reader = maybeReader (convertMaybe . convert @Text)