From a2aa3dba432dc1ad49844cca0f0abc18980c2cc3 Mon Sep 17 00:00:00 2001 From: Gautier DI FOLCO Date: Wed, 25 Oct 2023 04:03:44 +0200 Subject: [PATCH] Add interactive init command (#224) (#227) * Add interactive init command (#224) * fixup! Add interactive init command (#224) * fixup! Add interactive init command (#224) --- app/Main.hs | 48 ++++++++++++++++++---------- hapistrano.cabal | 3 ++ spec/System/Hapistrano/InitSpec.hs | 17 ++++++++++ src/System/Hapistrano.hs | 44 ++++++++++++++++++++++++++ src/System/Hapistrano/Types.hs | 50 ++++++++++++++++++++++++++++++ 5 files changed, 145 insertions(+), 17 deletions(-) create mode 100644 spec/System/Hapistrano/InitSpec.hs diff --git a/app/Main.hs b/app/Main.hs index 065a63f3..6f4c892a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -52,7 +52,9 @@ optionParser = Opts command "rollback" (info rollbackParser (progDesc "Roll back to Nth previous release")) <> command "maintenance" - (info maintenanceParser (progDesc "Enable/Disable maintenance mode")) + (info maintenanceParser (progDesc "Enable/Disable maintenance mode")) <> + command "init" + (info initParser (progDesc "Initialize hapistrano file")) ) <*> strOption ( long "config" @@ -92,6 +94,9 @@ rollbackParser = Rollback <> showDefault <> help "How many deployments back to go?" ) +initParser :: Parser Command +initParser = pure InitConfig + maintenanceParser :: Parser Command maintenanceParser = Maintenance @@ -120,27 +125,35 @@ data Message main :: IO () main = do - Opts{..} <- execParser parserInfo + opts@Opts{..} <- execParser parserInfo + case optsCommand of + Deploy cliReleaseFormat cliKeepReleases cliKeepOneFailed -> + runHapCmd opts $ \hapConfig@C.Config{..} executionMode -> + Hap.deploy + hapConfig + (fromMaybeReleaseFormat cliReleaseFormat configReleaseFormat) + (fromMaybeKeepReleases cliKeepReleases configKeepReleases) + (cliKeepOneFailed || configKeepOneFailed) + executionMode + Rollback n -> + runHapCmd opts $ \C.Config{..} _ -> + Hap.rollback configTargetSystem configDeployPath n configRestartCommand + Maintenance Enable -> + runHapCmd opts $ \C.Config{..} _ -> + Hap.writeMaintenanceFile configDeployPath configMaintenanceDirectory configMaintenanceFileName + Maintenance _ -> + runHapCmd opts $ \C.Config{..} _ -> + Hap.deleteMaintenanceFile configDeployPath configMaintenanceDirectory configMaintenanceFileName + InitConfig -> Hap.initConfig getLine + +runHapCmd :: Opts -> (C.Config -> C.ExecutionMode -> Hapistrano ()) -> IO () +runHapCmd Opts{..} hapCmd = do hapConfig@C.Config{..} <- Yaml.loadYamlSettings [optsConfigFile] [] Yaml.useEnv chan <- newTChanIO let printFnc dest str = atomically $ writeTChan chan (PrintMsg dest str) hap shell sshOpts executionMode = do - r <- Hap.runHapistrano sshOpts shell printFnc $ - case optsCommand of - Deploy cliReleaseFormat cliKeepReleases cliKeepOneFailed -> - Hap.deploy - hapConfig - (fromMaybeReleaseFormat cliReleaseFormat configReleaseFormat) - (fromMaybeKeepReleases cliKeepReleases configKeepReleases) - (cliKeepOneFailed || configKeepOneFailed) - executionMode - Rollback n -> - Hap.rollback configTargetSystem configDeployPath n configRestartCommand - Maintenance Enable-> do - Hap.writeMaintenanceFile configDeployPath configMaintenanceDirectory configMaintenanceFileName - Maintenance _ -> do - Hap.deleteMaintenanceFile configDeployPath configMaintenanceDirectory configMaintenanceFileName + r <- Hap.runHapistrano sshOpts shell printFnc $ hapCmd hapConfig executionMode atomically (writeTChan chan FinishMsg) return r printer :: Int -> IO () @@ -162,6 +175,7 @@ main = do hap targetShell (Just $ SshOptions targetHost targetPort targetSshArgs) (if leadTarget == currentTarget then C.LeadTarget else C.AllTargets) in runHap <$> targets + results <- (runConcurrently . traverse Concurrently) ((Right () <$ printer (length haps)) : haps) case sequence_ results of diff --git a/hapistrano.cabal b/hapistrano.cabal index e8100b57..e09ffbec 100644 --- a/hapistrano.cabal +++ b/hapistrano.cabal @@ -54,6 +54,7 @@ library build-depends: aeson >= 2.0 && < 3.0 , ansi-terminal >= 0.9 && < 0.12 , base >= 4.9 && < 5.0 + , directory >= 1.2.5 && < 1.4 , filepath >= 1.2 && < 1.5 , gitrev >= 1.2 && < 1.4 , mtl >= 2.0 && < 3.0 @@ -61,6 +62,7 @@ library , path >= 0.5 && < 0.9 , path-io >= 1.2 && < 1.7 , process >= 1.4 && < 1.7 + , text >= 1.2 && < 3 , typed-process >= 0.2 && < 0.3 , time >= 1.5 && < 1.11 , transformers >= 0.4 && < 0.6 @@ -99,6 +101,7 @@ test-suite test main-is: Spec.hs other-modules: System.HapistranoSpec , System.Hapistrano.ConfigSpec + , System.Hapistrano.InitSpec , System.HapistranoPropsSpec build-depends: base >= 4.9 && < 5.0 , aeson diff --git a/spec/System/Hapistrano/InitSpec.hs b/spec/System/Hapistrano/InitSpec.hs new file mode 100644 index 00000000..4f4ad520 --- /dev/null +++ b/spec/System/Hapistrano/InitSpec.hs @@ -0,0 +1,17 @@ +module System.Hapistrano.InitSpec (spec) where + +import Test.Hspec +import System.Directory (doesFileExist, getCurrentDirectory, withCurrentDirectory) +import System.FilePath (()) +import System.Hapistrano (initConfig) +import System.IO.Temp (withSystemTempDirectory) + +spec :: Spec +spec = do + describe "initConfig" $ do + it "should create a file when missing" $ + withSystemTempDirectory "hapistrano-spec-initConfig-missing" $ \tempDir -> + withCurrentDirectory tempDir $ do + configFilePath <- ( "hap.yml") <$> getCurrentDirectory + initConfig $ return "" + doesFileExist configFilePath `shouldReturn` True diff --git a/src/System/Hapistrano.hs b/src/System/Hapistrano.hs index f4370ed0..c3ab3e14 100644 --- a/src/System/Hapistrano.hs +++ b/src/System/Hapistrano.hs @@ -9,6 +9,7 @@ -- A module for creating reliable deploy processes for Haskell applications. {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} @@ -26,6 +27,7 @@ module System.Hapistrano , dropOldReleases , playScript , playScriptLocally + , initConfig -- * Path helpers , releasePath , sharedPath @@ -42,7 +44,10 @@ import Control.Monad.Reader (local) import Data.List (dropWhileEnd, genericDrop, sortOn) import Data.Maybe (fromMaybe, mapMaybe) import Data.Ord (Down (..)) +import qualified Data.Text as T +import qualified Data.Text.IO as T import Data.Time +import qualified Data.Yaml as Yaml import Numeric.Natural import Path import Path.IO @@ -55,6 +60,10 @@ import System.Hapistrano.Config ( BuildCommand (..) import qualified System.Hapistrano.Config as HC import System.Hapistrano.Core import System.Hapistrano.Types +import qualified System.Directory as Directory +import System.Exit (exitFailure) +import qualified System.FilePath as FilePath +import System.IO (stderr) import Text.Read (readMaybe) ---------------------------------------------------------------------------- @@ -262,6 +271,41 @@ playScriptLocally cmds = }) $ forM_ cmds $ flip execWithInheritStdout Nothing +initConfig :: IO String -> IO () +initConfig getLine' = do + configFilePath <- (FilePath. "hap.yml") <$> Directory.getCurrentDirectory + alreadyExisting <- Directory.doesFileExist configFilePath + when alreadyExisting $ do + T.hPutStrLn stderr "'hap.yml' already exists" + exitFailure + putStrLn "Creating 'hap.yml'" + defaults <- defaultInitTemplateConfig + let prompt :: Read a => T.Text -> a -> IO a + prompt title d = do + T.putStrLn $ title <> "?: " + x <- getLine' + return $ + if null x + then d + else read x + prompt' :: Read a => T.Text -> (InitTemplateConfig -> T.Text) -> (InitTemplateConfig -> a) -> IO a + prompt' title f fd = prompt (title <> " (default: " <> f defaults <> ")") (fd defaults) + + let yesNo :: a -> a -> T.Text -> a + yesNo t f x = if x == "y" then t else f + + config <- + InitTemplateConfig + <$> prompt' "repo" repo repo + <*> prompt' "revision" revision revision + <*> prompt' "host" host host + <*> prompt' "port" (T.pack . show . port) port + <*> return (buildScript defaults) + <*> fmap (yesNo (restartCommand defaults) Nothing) (prompt' "Include restart command" (const "Y/n") (const "y")) + + Yaml.encodeFile configFilePath config + putStrLn $ "Configuration written at " <> configFilePath + ---------------------------------------------------------------------------- -- Helpers diff --git a/src/System/Hapistrano/Types.hs b/src/System/Hapistrano/Types.hs index 71cdc68d..0fb90484 100644 --- a/src/System/Hapistrano/Types.hs +++ b/src/System/Hapistrano/Types.hs @@ -28,6 +28,7 @@ module System.Hapistrano.Types , Opts(..) , Command(..) , MaintenanceOptions(..) + , InitTemplateConfig(..) -- * Types helpers , mkRelease , releaseTime @@ -36,6 +37,7 @@ module System.Hapistrano.Types , fromMaybeReleaseFormat , fromMaybeKeepReleases , toMaybePath + , defaultInitTemplateConfig ) where import Control.Applicative @@ -44,9 +46,14 @@ import Control.Monad.Except import Control.Monad.Reader import Data.Aeson import Data.Maybe +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL import Data.Time import Numeric.Natural import Path +import System.Exit (ExitCode(ExitSuccess)) +import System.Process.Typed (nullStream, readProcessStdout, setStderr, shell) -- | Hapistrano monad. newtype Hapistrano a = @@ -192,6 +199,7 @@ data Command -- get deleted or not) | Rollback Natural -- ^ Rollback to Nth previous release | Maintenance MaintenanceOptions + | InitConfig -- ^ initialize configuration file -- | Create a 'Release' indentifier. mkRelease :: ReleaseFormat -> UTCTime -> Release @@ -210,6 +218,48 @@ renderRelease (Release rfmt time) = formatTime defaultTimeLocale fmt time ReleaseShort -> releaseFormatShort ReleaseLong -> releaseFormatLong +-- | Initial configurable fields +data InitTemplateConfig = InitTemplateConfig + { repo :: T.Text + , revision :: T.Text + , host :: T.Text + , port :: Word + , buildScript :: [T.Text] + , restartCommand :: Maybe T.Text + } + +defaultInitTemplateConfig :: IO InitTemplateConfig +defaultInitTemplateConfig = do + let shellWithDefault d cmd = do + (exitCode, stdout) <- readProcessStdout $ setStderr nullStream $ shell cmd + return $ + if exitCode == ExitSuccess + then maybe d (T.strip . TL.toStrict) $ listToMaybe $ TL.lines $ TL.decodeUtf8 stdout + else d + remoteBranch <- shellWithDefault "origin/main" "git rev-parse --abbrev-ref --symbolic-full-name @{u}" + let remote = T.takeWhile (/='/') remoteBranch + repository <- shellWithDefault "https://github.com/user/repo.git" ("git ls-remote --get-url " <> T.unpack remote) + return $ + InitTemplateConfig + { repo = repository + , revision = remoteBranch + , host = "root@localhost" + , port = 22 + , buildScript = ["echo 'Build steps'"] + , restartCommand = Just "echo 'Restart command'" + } + +instance ToJSON InitTemplateConfig where + toJSON x = + object + [ "repo" .= repo x + , "revision" .= revision x + , "host" .= host x + , "port" .= port x + , "buildScript" .= buildScript x + , "restartCommand" .= restartCommand x + ] + ---------------------------------------------------------------------------- -- Types helpers