Change to centralized instance spec hydration

* This moves all the environment relative loading of InstanceSpecs into the `perform` function.
* Removes the need to model use previous value logic in stack-deploy parameter type.
* Removes the newtype around Parameters that does not add anything special over a plain map
* Change exports of the `Stack.Parameters` module to fit unqualified or `as StackDeploy` import.

stack-deploy/package.yaml

@@ -50,3 +50,15 @@ dependencies:
 tests:
   test:
     <<: *test
+    other-modules:  []
+  doctest:
+    dependencies:
+    - doctest-parallel
+    - stack-deploy
+    main: DocTest.hs
+    other-modules:  []
+    source-dirs: test
+    ghc-options:
+    - -rtsopts
+    - -threaded
+    - -with-rtsopts=-N

stack-deploy/src/StackDeploy/CLI.hs

@@ -73,23 +73,25 @@ parserInfo instanceSpecProvider = wrapHelper commands "stack commands"
       success
 
     create :: InstanceSpec.Name -> Parameters -> MIO env ExitCode
-    create name params = do
-      spec <- InstanceSpec.get instanceSpecProvider name params
-      exitCode =<< perform (OpCreate spec)
+    create name userParameters = do
+      instanceSpec <- InstanceSpec.get instanceSpecProvider name
+      exitCode =<< perform (OpCreate instanceSpec userParameters)
 
     update :: InstanceSpec.Name -> Parameters -> MIO env ExitCode
-    update name params = do
-      spec     <- InstanceSpec.get instanceSpecProvider name params
-      stackId  <- getExistingStackId name
+    update name userParameters = do
+      instanceSpec <- InstanceSpec.get instanceSpecProvider name
+      stackId      <- getExistingStackId name
 
-      exitCode =<< perform (OpUpdate stackId spec)
+      exitCode =<< perform (OpUpdate stackId instanceSpec userParameters)
 
     sync :: InstanceSpec.Name -> Parameters -> MIO env ExitCode
-    sync name params = do
-      spec <- InstanceSpec.get instanceSpecProvider name params
+    sync name userParameters = do
+      instanceSpec <- InstanceSpec.get instanceSpecProvider name
 
       exitCode
-        =<< perform . maybe (OpCreate spec) (`OpUpdate` spec)
+        =<< perform . maybe
+              (OpCreate instanceSpec userParameters)
+              (\stackId -> OpUpdate stackId instanceSpec userParameters)
         =<< getStackId name
 
     wait :: InstanceSpec.Name -> Token -> MIO env ExitCode
@@ -138,7 +140,7 @@ parserInfo instanceSpecProvider = wrapHelper commands "stack commands"
       void $ pollEvents (defaultPoll stackId) printEvent
       success
 
-    waitForOperation :: Token -> Id -> MIO env ExitCode
+    waitForOperation :: Token -> StackId -> MIO env ExitCode
     waitForOperation token stackId =
       exitCode =<< waitForAccept RemoteOperation{..} printEvent
 
@@ -183,4 +185,4 @@ parameterReader = eitherReader (Text.parseOnly parser . convertText)
       char -> Char.isDigit char || Char.isAlpha char
 
 parameters :: Parser Parameters
-parameters = fromList <$> many parameter
+parameters = fromList . fmap (\Parameter{..} -> (name, value)) <$> many parameter

stack-deploy/src/StackDeploy/Events.hs

@@ -20,12 +20,12 @@ import qualified MIO.Amazonka                                as AWS
 data Poll = Poll
   { delay          :: forall m . MonadIO m => m ()
   , eventFilter    :: CF.StackEvent -> Bool
-  , stackId        :: Id
+  , stackId        :: StackId
   , startCondition :: CF.StackEvent -> Bool
   , stopCondition  :: CF.StackEvent -> Bool
   }
 
-defaultPoll :: Id -> Poll
+defaultPoll :: StackId -> Poll
 defaultPoll stackId = Poll
   { delay          = liftIO $ threadDelay 1_000_000  -- 1 second
   , eventFilter    = const True                      -- accept all events
@@ -96,7 +96,7 @@ allEvents Poll{..} =
 
 stackEvents
   :: AWS.Env env
-  => Id
+  => StackId
   -> ConduitT () CF.StackEvent (MIO env) ()
 stackEvents stackId = listResource request (fromMaybe [] . (.stackEvents))
   where

stack-deploy/src/StackDeploy/InstanceSpec.hs

@@ -19,7 +19,6 @@ import StackDeploy.Template (Template)
 import qualified Amazonka.CloudFormation.Types as CF
 import qualified Data.Aeson                    as JSON
 import qualified Data.Aeson.KeyMap             as KeyMap
-import qualified StackDeploy.Parameters        as Parameters
 import qualified StackDeploy.Provider          as Provider
 import qualified StackDeploy.Template          as Template
 import qualified Stratosphere
@@ -33,53 +32,26 @@ type Name = BoundText "StackDeploy.InstanceSpec.Name"
 type Provider env = Provider.Provider (InstanceSpec env)
 
 data InstanceSpec env = InstanceSpec
-  { capabilities  :: [CF.Capability]
-  , envParameters :: MIO env Parameters
-  , envRoleARN    :: Maybe (MIO env RoleARN)
-  , name          :: Name
-  , onSuccess     :: MIO env ()
-  , parameters    :: Parameters
-  , roleARN       :: Maybe RoleARN
-  , template      :: Template
+  { capabilities :: [CF.Capability]
+  , name         :: Name
+  , onLoad       :: InstanceSpec env -> MIO env (InstanceSpec env)
+  , onSuccess    :: MIO env ()
+  , parameters   :: Parameters
+  , roleARN      :: Maybe RoleARN
+  , template     :: Template
   }
 
 instance Provider.HasItemName (InstanceSpec env) where
   type ItemName (InstanceSpec env) = Name
   name = (.name)
 
-get
-  :: Provider env
-  -> Name
-  -> Parameters
-  -> MIO env (InstanceSpec env)
-get provider targetName userParameters = do
-  instanceSpec <- Provider.get "instance-spec" provider targetName
-  env          <- instanceSpec.envParameters
-  roleARN      <- tryEnvRole instanceSpec
-
-  pure $ instanceSpec
-    { parameters
-        =  expandedParameters instanceSpec
-        `union` env
-        `union` userParameters
-    , roleARN  = roleARN
-    }
-
-  where
-    expandedParameters :: InstanceSpec env -> Parameters
-    expandedParameters InstanceSpec{..} =
-      Parameters.expandTemplate parameters template
-
-    tryEnvRole :: InstanceSpec env -> MIO env (Maybe RoleARN)
-    tryEnvRole InstanceSpec{..} = maybe (pure roleARN) (pure <$>) envRoleARN
-
-    union = Parameters.union
+get :: Provider env -> Name -> MIO env (InstanceSpec env)
+get = Provider.get "instance-spec"
 
 mk :: Name -> Template -> InstanceSpec env
 mk name template = InstanceSpec
   { capabilities  = empty
-  , envParameters = pure []
-  , envRoleARN    = empty
+  , onLoad        = pure
   , onSuccess     = pure ()
   , parameters    = []
   , roleARN       = empty

stack-deploy/src/StackDeploy/Parameters.hs

@@ -3,22 +3,18 @@ module StackDeploy.Parameters
   , ParameterName(..)
   , ParameterValue(..)
   , Parameters
-  , cfParameters
-  , expandTemplate
-  , fromStratosphereParameter
-  , union
+  , parameterFromStratosphere
+  , parameterTemplateExpand
+  , parametersFromList
   )
 where
 
 import Control.Lens ((?~))
 import Data.Map.Strict (Map)
 import Data.Set (Set)
 import StackDeploy.Prelude
-import StackDeploy.Template
 
 import qualified Amazonka.CloudFormation.Types as CF
-import qualified Data.Foldable                 as Foldable
-import qualified Data.List                     as List
 import qualified Data.Map.Strict               as Map
 import qualified Data.Set                      as Set
 import qualified Stratosphere
@@ -31,83 +27,55 @@ newtype ParameterValue = ParameterValue Text
   deriving (Conversion Text) via Text
   deriving stock Eq
 
-data Parameter
-  = Parameter ParameterName ParameterValue
-  | ParameterUsePrevious ParameterName
+data Parameter = Parameter
+  { name  :: ParameterName
+  , value :: ParameterValue
+  }
 
-newtype Parameters = Parameters (Map ParameterName Parameter)
+type Parameters = Map ParameterName ParameterValue
 
-parameterName :: Parameter -> ParameterName
-parameterName = \case
-  (Parameter name _value)     -> name
-  (ParameterUsePrevious name) -> name
-
-fromStratosphereParameter
+parameterFromStratosphere
   :: Stratosphere.Parameter
   -> ParameterValue
   -> Parameter
-fromStratosphereParameter = Parameter . ParameterName . (.name)
-
-instance IsList Parameters where
-  type Item Parameters = Parameter
-
-  fromList parameters =
-    Parameters . Map.fromList $ pairs
-    where
-      pairs :: [(ParameterName, Parameter)]
-      pairs = mkPair <$> parameters
-
-      mkPair :: Parameter -> (ParameterName, Parameter)
-      mkPair parameter = (parameterName parameter, parameter)
-
-  toList (Parameters map) = List.sortOn parameterName $ Map.elems map
-
-cfParameters :: Parameters -> [CF.Parameter]
-cfParameters parameters = mkCFParameter <$> toList parameters
-
-mkCFParameter :: Parameter -> CF.Parameter
-mkCFParameter = \case
-  Parameter name value ->
-    CF.newParameter
-      & CF.parameter_parameterKey   ?~ toText name
-      & CF.parameter_parameterValue ?~ toText value
-  ParameterUsePrevious name ->
-    CF.newParameter
-      & CF.parameter_parameterKey     ?~ toText name
-      & CF.parameter_usePreviousValue ?~ True
-
-union :: Parameters -> Parameters -> Parameters
-union (Parameters left) (Parameters right) =
-  Parameters $ Map.union right left
-
-expandTemplate :: Parameters -> Template -> Parameters
-expandTemplate parameters@(Parameters hash) template
-  = parameters `union` usePreviousParameters
+parameterFromStratosphere = Parameter . ParameterName . (.name)
+
+parametersFromList :: [Parameter] -> Parameters
+parametersFromList = Map.fromList . fmap (\Parameter{..} -> (name, value))
+
+-- | Expand parameters to amazonka cloudformation parameters against a stratosphere template
+-- |
+-- | For parameters not explicitly given but present in the template parameters, a use previous value parameter
+-- | will be generated.
+-- >>> import StackDeploy.Prelude
+-- >>> import qualified Stratosphere as CFT
+-- >>> let cftTemplate = CFT.mkTemplate [] & CFT.set @"Parameters" [CFT.mkParameter "String" "A"]
+-- >>> parameterTemplateExpand [(ParameterName "A", ParameterValue "A-Value")] cftTemplate
+-- [Parameter' {parameterKey = Just "A", parameterValue = Just "A-Value", resolvedValue = Nothing, usePreviousValue = Nothing},Parameter' {parameterKey = Just "String", parameterValue = Nothing, resolvedValue = Nothing, usePreviousValue = Just True}]
+parameterTemplateExpand :: Parameters -> Stratosphere.Template -> [CF.Parameter]
+parameterTemplateExpand parameters template
+  = givenParameters <> usePreviousParameters
   where
-    usePreviousParameters :: Parameters
-    usePreviousParameters
-      =   Parameters
-      .   Map.fromList
-      $   mkPair
-      <$> Foldable.toList missingParameterNames
-
-    mkPair name = (name, ParameterUsePrevious name)
-
-    missingParameterNames :: Set ParameterName
-    missingParameterNames =
-      Set.difference
-        templateParameterNames
-        givenParameterNames
+    usePreviousParameters :: [CF.Parameter]
+    usePreviousParameters =
+      mkUsePrevious <$> Set.toList (Set.difference templateParameterNames (Map.keysSet parameters))
 
-    givenParameterNames :: Set ParameterName
-    givenParameterNames = Set.fromList $ Map.keys hash
+    givenParameters :: [CF.Parameter]
+    givenParameters = mkParameter <$> Map.toList parameters
 
     templateParameterNames :: Set ParameterName
     templateParameterNames
       = Set.fromList
-      $ ParameterName . (.name) <$> templateParameters
+      $ ParameterName . (.name) <$> (maybe [] (.parameterList) template.parameters)
 
-    templateParameters :: [Stratosphere.Parameter]
-    templateParameters
-      = maybe empty (.parameterList)
-      $ template.stratosphere.parameters
+    mkUsePrevious :: ParameterName -> CF.Parameter
+    mkUsePrevious name
+      = CF.newParameter
+      & CF.parameter_parameterKey     ?~ toText name
+      & CF.parameter_usePreviousValue ?~ True
+
+    mkParameter :: (ParameterName, ParameterValue) -> CF.Parameter
+    mkParameter (name, value)
+      = CF.newParameter
+      & CF.parameter_parameterKey   ?~ toText name
+      & CF.parameter_parameterValue ?~ toText value