mirror of
https://github.com/stackbuilders/hapistrano.git
synced 2024-12-23 11:32:09 +03:00
* Add interactive init command (#224) * fixup! Add interactive init command (#224) * fixup! Add interactive init command (#224)
This commit is contained in:
Gautier DI FOLCO
GitHub
parent
ccb8d7c3ba
commit
a2aa3dba43
48
app/Main.hs
48
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
|
||||
|
||||
@ -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
|
||||
|
||||
17
spec/System/Hapistrano/InitSpec.hs
Normal file
17
spec/System/Hapistrano/InitSpec.hs
Normal file
@ -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
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user