module Stackctl.StackSpec
( StackSpec
, stackSpecFilePath
, stackSpecSpecPath
, stackSpecSpecBody
, stackSpecStackName
, stackSpecStackDescription
, stackSpecActions
, stackSpecParameters
, stackSpecCapabilities
, stackSpecStackFile
, stackSpecTemplateFile
, stackSpecTags
, buildStackSpec
, TemplateBody
, templateBodyFromValue
, writeStackSpec
, readStackSpec
, createChangeSet
, sortStackSpecs
) where
import Stackctl.Prelude
import qualified CfnFlip
import Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.List.Extra (nubOrdOn)
import qualified Data.Yaml as Yaml
import Stackctl.AWS
import Stackctl.Action
import Stackctl.Config (HasConfig (..), applyConfig)
import Stackctl.Sort
import Stackctl.StackSpecPath
import Stackctl.StackSpecYaml
import System.FilePath (takeExtension)
import qualified System.FilePath as FilePath
import UnliftIO.Directory (createDirectoryIfMissing, doesFileExist)
data StackSpec = StackSpec
{ StackSpec -> FilePath
ssSpecRoot :: FilePath
, StackSpec -> StackSpecPath
ssSpecPath :: StackSpecPath
, StackSpec -> StackSpecYaml
ssSpecBody :: StackSpecYaml
}
stackSpecSpecRoot :: StackSpec -> FilePath
stackSpecSpecRoot :: StackSpec -> FilePath
stackSpecSpecRoot = StackSpec -> FilePath
ssSpecRoot
stackSpecFilePath :: StackSpec -> FilePath
stackSpecFilePath :: StackSpec -> FilePath
stackSpecFilePath StackSpec
spec =
FilePath -> FilePath
FilePath.normalise forall a b. (a -> b) -> a -> b
$ StackSpec -> FilePath
stackSpecSpecRoot StackSpec
spec FilePath -> FilePath -> FilePath
</> StackSpec -> FilePath
stackSpecStackFile StackSpec
spec
stackSpecSpecPath :: StackSpec -> StackSpecPath
stackSpecSpecPath :: StackSpec -> StackSpecPath
stackSpecSpecPath = StackSpec -> StackSpecPath
ssSpecPath
stackSpecSpecBody :: StackSpec -> StackSpecYaml
stackSpecSpecBody :: StackSpec -> StackSpecYaml
stackSpecSpecBody = StackSpec -> StackSpecYaml
ssSpecBody
stackSpecStackName :: StackSpec -> StackName
stackSpecStackName :: StackSpec -> StackName
stackSpecStackName = StackSpecPath -> StackName
stackSpecPathStackName forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecPath
ssSpecPath
stackSpecStackDescription :: StackSpec -> Maybe StackDescription
stackSpecStackDescription :: StackSpec -> Maybe StackDescription
stackSpecStackDescription = StackSpecYaml -> Maybe StackDescription
ssyDescription forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecYaml
ssSpecBody
stackSpecDepends :: StackSpec -> [StackName]
stackSpecDepends :: StackSpec -> [StackName]
stackSpecDepends = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecYaml -> Maybe [StackName]
ssyDepends forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecYaml
ssSpecBody
stackSpecActions :: StackSpec -> [Action]
stackSpecActions :: StackSpec -> [Action]
stackSpecActions = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecYaml -> Maybe [Action]
ssyActions forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecYaml
ssSpecBody
stackSpecStackFile :: StackSpec -> FilePath
stackSpecStackFile :: StackSpec -> FilePath
stackSpecStackFile = StackSpecPath -> FilePath
stackSpecPathFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecPath
ssSpecPath
stackSpecTemplateFile :: StackSpec -> FilePath
stackSpecTemplateFile :: StackSpec -> FilePath
stackSpecTemplateFile = (FilePath
"templates" FilePath -> FilePath -> FilePath
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecYaml -> FilePath
ssyTemplate forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecYaml
ssSpecBody
stackSpecTemplate :: StackSpec -> StackTemplate
stackSpecTemplate :: StackSpec -> StackTemplate
stackSpecTemplate StackSpec
spec =
FilePath -> StackTemplate
StackTemplate
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
FilePath.normalise
forall a b. (a -> b) -> a -> b
$ StackSpec -> FilePath
ssSpecRoot StackSpec
spec
FilePath -> FilePath -> FilePath
</> StackSpec -> FilePath
stackSpecTemplateFile StackSpec
spec
stackSpecParameters :: StackSpec -> [Parameter]
stackSpecParameters :: StackSpec -> [Parameter]
stackSpecParameters =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map ParameterYaml -> Parameter
unParameterYaml forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParametersYaml -> [ParameterYaml]
unParametersYaml) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecYaml -> Maybe ParametersYaml
ssyParameters forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecYaml
ssSpecBody
stackSpecCapabilities :: StackSpec -> [Capability]
stackSpecCapabilities :: StackSpec -> [Capability]
stackSpecCapabilities = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecYaml -> Maybe [Capability]
ssyCapabilities forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecYaml
ssSpecBody
stackSpecTags :: StackSpec -> [Tag]
stackSpecTags :: StackSpec -> [Tag]
stackSpecTags = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map TagYaml -> Tag
unTagYaml forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagsYaml -> [TagYaml]
unTagsYaml) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecYaml -> Maybe TagsYaml
ssyTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpec -> StackSpecYaml
ssSpecBody
buildStackSpec
:: (MonadReader env m, HasConfig env)
=> FilePath
-> StackSpecPath
-> StackSpecYaml
-> m StackSpec
buildStackSpec :: forall env (m :: * -> *).
(MonadReader env m, HasConfig env) =>
FilePath -> StackSpecPath -> StackSpecYaml -> m StackSpec
buildStackSpec FilePath
dir StackSpecPath
specPath StackSpecYaml
specBody = do
Config
config <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env Config
configL
forall (f :: * -> *) a. Applicative f => a -> f a
pure
StackSpec
{ ssSpecRoot :: FilePath
ssSpecRoot = FilePath
dir
, ssSpecPath :: StackSpecPath
ssSpecPath = StackSpecPath
specPath
, ssSpecBody :: StackSpecYaml
ssSpecBody = Config -> StackSpecYaml -> StackSpecYaml
applyConfig Config
config StackSpecYaml
specBody
}
data TemplateBody
= TemplateText Text
| TemplateJson Value
newtype UnexpectedTemplateJson = UnexpectedTemplateJson
{ UnexpectedTemplateJson -> FilePath
_unexpectedTemplateJsonExtension :: String
}
deriving stock (Int -> UnexpectedTemplateJson -> FilePath -> FilePath
[UnexpectedTemplateJson] -> FilePath -> FilePath
UnexpectedTemplateJson -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [UnexpectedTemplateJson] -> FilePath -> FilePath
$cshowList :: [UnexpectedTemplateJson] -> FilePath -> FilePath
show :: UnexpectedTemplateJson -> FilePath
$cshow :: UnexpectedTemplateJson -> FilePath
showsPrec :: Int -> UnexpectedTemplateJson -> FilePath -> FilePath
$cshowsPrec :: Int -> UnexpectedTemplateJson -> FilePath -> FilePath
Show)
instance Exception UnexpectedTemplateJson where
displayException :: UnexpectedTemplateJson -> FilePath
displayException (UnexpectedTemplateJson FilePath
ext) =
FilePath
"TemplateJson must be written to .yaml or .json, encountered "
forall a. Semigroup a => a -> a -> a
<> FilePath
ext
forall a. Semigroup a => a -> a -> a
<> FilePath
". To write to an arbitrary path, use TemplateText."
templateBodyFromValue :: Value -> TemplateBody
templateBodyFromValue :: Value -> TemplateBody
templateBodyFromValue = \case
String Text
x -> Text -> TemplateBody
TemplateText Text
x
Value
v -> Value -> TemplateBody
TemplateJson Value
v
writeTemplateBody :: MonadUnliftIO m => FilePath -> TemplateBody -> m ()
writeTemplateBody :: forall (m :: * -> *).
MonadUnliftIO m =>
FilePath -> TemplateBody -> m ()
writeTemplateBody FilePath
path TemplateBody
body = do
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True FilePath
dir
case (TemplateBody
body, FilePath
ext) of
(TemplateText Text
t, FilePath
_) -> forall (m :: * -> *). MonadIO m => FilePath -> Text -> m ()
writeFileUtf8 FilePath
path Text
t
(TemplateJson Value
v, FilePath
".yaml") -> forall (m :: * -> *) a.
(MonadUnliftIO m, ToJSON a) =>
FilePath -> a -> m ()
CfnFlip.jsonToYamlFile FilePath
path Value
v
(TemplateJson Value
v, FilePath
".json") -> forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBinary FilePath
path forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode Value
v
(TemplateJson Value
_, FilePath
_) -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> UnexpectedTemplateJson
UnexpectedTemplateJson FilePath
ext
where
dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
path
ext :: FilePath
ext = FilePath -> FilePath
takeExtension FilePath
path
writeStackSpec
:: (MonadUnliftIO m, MonadLogger m)
=> Bool
-> StackSpec
-> Maybe TemplateBody
-> m ()
writeStackSpec :: forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Bool -> StackSpec -> Maybe TemplateBody -> m ()
writeStackSpec Bool
overwrite StackSpec
stackSpec Maybe TemplateBody
mTemplateBody = do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe TemplateBody
mTemplateBody forall a b. (a -> b) -> a -> b
$ \TemplateBody
templateBody -> do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Writing template" Text -> [SeriesElem] -> Message
:# [Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
templatePath]
forall (m :: * -> *).
MonadUnliftIO m =>
FilePath -> TemplateBody -> m ()
writeTemplateBody FilePath
templatePath TemplateBody
templateBody
Bool
exists <- forall (m :: * -> *). MonadIO m => FilePath -> m Bool
doesFileExist FilePath
specPath
if Bool
exists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
overwrite
then do
let
reason :: Text
reason :: Text
reason = Text
"file exists and overwrite not set"
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Skipping" Text -> [SeriesElem] -> Message
:# [Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
specPath, Key
"reason" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reason]
else do
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Text
"Writing specification" Text -> [SeriesElem] -> Message
:# [Key
"path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= FilePath
specPath]
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDirectory FilePath
specPath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => FilePath -> a -> IO ()
Yaml.encodeFile FilePath
specPath forall a b. (a -> b) -> a -> b
$ StackSpec -> StackSpecYaml
stackSpecSpecBody StackSpec
stackSpec
where
templatePath :: FilePath
templatePath = StackTemplate -> FilePath
unStackTemplate forall a b. (a -> b) -> a -> b
$ StackSpec -> StackTemplate
stackSpecTemplate StackSpec
stackSpec
specPath :: FilePath
specPath = StackSpec -> FilePath
stackSpecFilePath StackSpec
stackSpec
readStackSpec
:: (MonadIO m, MonadReader env m, HasConfig env)
=> FilePath
-> StackSpecPath
-> m StackSpec
readStackSpec :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasConfig env) =>
FilePath -> StackSpecPath -> m StackSpec
readStackSpec FilePath
dir StackSpecPath
specPath = do
StackSpecYaml
specBody <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseException -> IO StackSpecYaml
err forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => FilePath -> IO (Either ParseException a)
Yaml.decodeFileEither FilePath
path
forall env (m :: * -> *).
(MonadReader env m, HasConfig env) =>
FilePath -> StackSpecPath -> StackSpecYaml -> m StackSpec
buildStackSpec FilePath
dir StackSpecPath
specPath StackSpecYaml
specBody
where
path :: FilePath
path = FilePath
dir FilePath -> FilePath -> FilePath
</> StackSpecPath -> FilePath
stackSpecPathFilePath StackSpecPath
specPath
err :: ParseException -> IO StackSpecYaml
err ParseException
e =
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
FilePath -> m a
throwString forall a b. (a -> b) -> a -> b
$ FilePath
path forall a. Semigroup a => a -> a -> a
<> FilePath
" is invalid: " forall a. Semigroup a => a -> a -> a
<> ParseException -> FilePath
Yaml.prettyPrintParseException ParseException
e
createChangeSet
:: ( MonadUnliftIO m
, MonadResource m
, MonadLogger m
, MonadReader env m
, HasAwsEnv env
)
=> StackSpec
-> [Parameter]
-> [Tag]
-> m (Either Text (Maybe ChangeSet))
createChangeSet :: forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasAwsEnv env) =>
StackSpec
-> [Parameter] -> [Tag] -> m (Either Text (Maybe ChangeSet))
createChangeSet StackSpec
spec [Parameter]
parameters [Tag]
tags =
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadResource m, MonadLogger m,
MonadReader env m, HasAwsEnv env) =>
StackName
-> Maybe StackDescription
-> StackTemplate
-> [Parameter]
-> [Capability]
-> [Tag]
-> m (Either Text (Maybe ChangeSet))
awsCloudFormationCreateChangeSet
(StackSpec -> StackName
stackSpecStackName StackSpec
spec)
(StackSpec -> Maybe StackDescription
stackSpecStackDescription StackSpec
spec)
(StackSpec -> StackTemplate
stackSpecTemplate StackSpec
spec)
( forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (forall s a. s -> Getting a s a -> a
^. Lens' Parameter (Maybe Text)
parameter_parameterKey) forall a b. (a -> b) -> a -> b
$ [Parameter]
parameters forall a. Semigroup a => a -> a -> a
<> StackSpec -> [Parameter]
stackSpecParameters StackSpec
spec
)
(StackSpec -> [Capability]
stackSpecCapabilities StackSpec
spec)
(forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (forall s a. s -> Getting a s a -> a
^. Lens' Tag Text
tag_key) forall a b. (a -> b) -> a -> b
$ [Tag]
tags forall a. Semigroup a => a -> a -> a
<> StackSpec -> [Tag]
stackSpecTags StackSpec
spec)
sortStackSpecs :: [StackSpec] -> [StackSpec]
sortStackSpecs :: [StackSpec] -> [StackSpec]
sortStackSpecs = forall k a. Ord k => (a -> k) -> (a -> [k]) -> [a] -> [a]
sortByDependencies StackSpec -> StackName
stackSpecStackName StackSpec -> [StackName]
stackSpecDepends