{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module System.Hapistrano
( runHapistrano
, pushRelease
, pushReleaseWithoutVc
, activateRelease
, linkToShared
, createHapistranoDeployState
, deploy
, rollback
, dropOldReleases
, playScript
, playScriptLocally
, releasePath
, sharedPath
, currentSymlinkPath
, tempSymlinkPath
, deployState )
where
import Control.Exception (try)
import Control.Monad
import Control.Monad.Catch (catch, throwM)
import Control.Monad.Except
import Control.Monad.Reader (local)
import Data.List (dropWhileEnd, genericDrop, sortOn)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (Down (..))
import Data.Time
import Numeric.Natural
import Path
import Path.IO
import System.Hapistrano.Commands
import System.Hapistrano.Config (CopyThing (..),
deployStateFilename)
import qualified System.Hapistrano.Config as HC
import System.Hapistrano.Core
import System.Hapistrano.Types
import Text.Read (readMaybe)
runHapistrano ::
MonadIO m
=> Maybe SshOptions
-> Shell
-> (OutputDest -> String -> IO ())
-> Hapistrano a
-> m (Either Int a)
runHapistrano :: forall (m :: * -> *) a.
MonadIO m =>
Maybe SshOptions
-> Shell
-> (OutputDest -> [Char] -> IO ())
-> Hapistrano a
-> m (Either Int a)
runHapistrano Maybe SshOptions
sshOptions Shell
shell' OutputDest -> [Char] -> IO ()
printFnc Hapistrano a
m =
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
let config :: Config
config =
Config
{ configSshOptions :: Maybe SshOptions
configSshOptions = Maybe SshOptions
sshOptions
, configShellOptions :: Shell
configShellOptions = Shell
shell'
, configPrint :: OutputDest -> [Char] -> IO ()
configPrint = OutputDest -> [Char] -> IO ()
printFnc
}
Either HapistranoException a
r <- forall e a. Exception e => IO a -> IO (Either e a)
try @HapistranoException forall a b. (a -> b) -> a -> b
$ forall a. Hapistrano a -> Config -> IO a
unHapistrano Hapistrano a
m Config
config
case Either HapistranoException a
r of
Left (HapistranoException (Failure Int
n Maybe [Char]
msg, Maybe Release
_)) -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [Char]
msg (OutputDest -> [Char] -> IO ()
printFnc OutputDest
StderrDest)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left Int
n)
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right a
x)
pushRelease :: Task -> Hapistrano Release
pushRelease :: Task -> Hapistrano Release
pushRelease Task {Path Abs Dir
ReleaseFormat
Source
taskReleaseFormat :: Task -> ReleaseFormat
taskSource :: Task -> Source
taskDeployPath :: Task -> Path Abs Dir
taskReleaseFormat :: ReleaseFormat
taskSource :: Source
taskDeployPath :: Path Abs Dir
..} = do
Path Abs Dir -> Hapistrano ()
setupDirs Path Abs Dir
taskDeployPath
Source -> Hapistrano Release
pushReleaseForRepository Source
taskSource
where
pushReleaseForRepository :: Source -> Hapistrano Release
pushReleaseForRepository GitRepository {[Char]
gitRepositoryRevision :: Source -> [Char]
gitRepositoryURL :: Source -> [Char]
gitRepositoryRevision :: [Char]
gitRepositoryURL :: [Char]
..} = do
[Char] -> Path Abs Dir -> Maybe Release -> Hapistrano ()
ensureCacheInPlace [Char]
gitRepositoryURL Path Abs Dir
taskDeployPath forall a. Maybe a
Nothing
Release
release <- ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
taskReleaseFormat
Path Abs Dir -> Release -> Hapistrano ()
cloneToRelease Path Abs Dir
taskDeployPath Release
release
Path Abs Dir -> Release -> [Char] -> Hapistrano ()
setReleaseRevision Path Abs Dir
taskDeployPath Release
release [Char]
gitRepositoryRevision
forall (m :: * -> *) a. Monad m => a -> m a
return Release
release
pushReleaseForRepository LocalDirectory {} =
ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
taskReleaseFormat
pushReleaseWithoutVc :: Task -> Hapistrano Release
pushReleaseWithoutVc :: Task -> Hapistrano Release
pushReleaseWithoutVc Task {Path Abs Dir
ReleaseFormat
Source
taskReleaseFormat :: ReleaseFormat
taskSource :: Source
taskDeployPath :: Path Abs Dir
taskReleaseFormat :: Task -> ReleaseFormat
taskSource :: Task -> Source
taskDeployPath :: Task -> Path Abs Dir
..} = do
Path Abs Dir -> Hapistrano ()
setupDirs Path Abs Dir
taskDeployPath
ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
taskReleaseFormat
activateRelease
:: TargetSystem
-> Path Abs Dir
-> Release
-> Hapistrano ()
activateRelease :: TargetSystem -> Path Abs Dir -> Release -> Hapistrano ()
activateRelease TargetSystem
ts Path Abs Dir
deployPath Release
release = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release forall a. Maybe a
Nothing
let tpath :: Path Abs File
tpath = Path Abs Dir -> Path Abs File
tempSymlinkPath Path Abs Dir
deployPath
cpath :: Path Abs File
cpath = Path Abs Dir -> Path Abs File
currentSymlinkPath Path Abs Dir
deployPath
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall t. TargetSystem -> Path Abs t -> Path Abs File -> Ln
Ln TargetSystem
ts Path Abs Dir
rpath Path Abs File
tpath) (forall a. a -> Maybe a
Just Release
release)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall t. TargetSystem -> Path Abs t -> Path Abs t -> Mv t
Mv TargetSystem
ts Path Abs File
tpath Path Abs File
cpath) (forall a. a -> Maybe a
Just Release
release)
createHapistranoDeployState
:: Path Abs Dir
-> Release
-> DeployState
-> Hapistrano ()
createHapistranoDeployState :: Path Abs Dir -> Release -> DeployState -> Hapistrano ()
createHapistranoDeployState Path Abs Dir
deployPath Release
release DeployState
state = do
Path Rel File
parseStatePath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
deployStateFilename
Path Abs Dir
actualReleasePath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release forall a. Maybe a
Nothing
let stateFilePath :: Path Abs File
stateFilePath = Path Abs Dir
actualReleasePath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
parseStatePath
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> Touch
Touch Path Abs File
stateFilePath) (forall a. a -> Maybe a
Just Release
release)
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> [Char] -> BasicWrite
BasicWrite Path Abs File
stateFilePath forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show DeployState
state) (forall a. a -> Maybe a
Just Release
release)
deploy
:: HC.Config
-> ReleaseFormat
-> Natural
-> Bool
-> Hapistrano ()
deploy :: Config -> ReleaseFormat -> Natural -> Bool -> Hapistrano ()
deploy HC.Config{Bool
[[Char]]
[Target]
[CopyThing]
Maybe Natural
Maybe [GenericCommand]
Maybe (Path Rel Dir)
Maybe ReleaseFormat
Maybe GenericCommand
Path Abs Dir
Path Rel File
Path Rel Dir
TargetSystem
Source
configMaintenanceFileName :: Config -> Path Rel File
configMaintenanceDirectory :: Config -> Path Rel Dir
configWorkingDir :: Config -> Maybe (Path Rel Dir)
configKeepOneFailed :: Config -> Bool
configKeepReleases :: Config -> Maybe Natural
configReleaseFormat :: Config -> Maybe ReleaseFormat
configTargetSystem :: Config -> TargetSystem
configRunLocally :: Config -> Maybe [GenericCommand]
configVcAction :: Config -> Bool
configLinkedDirs :: Config -> [[Char]]
configLinkedFiles :: Config -> [[Char]]
configCopyDirs :: Config -> [CopyThing]
configCopyFiles :: Config -> [CopyThing]
configBuildScript :: Config -> Maybe [GenericCommand]
configRestartCommand :: Config -> Maybe GenericCommand
configSource :: Config -> Source
configHosts :: Config -> [Target]
configDeployPath :: Config -> Path Abs Dir
configMaintenanceFileName :: Path Rel File
configMaintenanceDirectory :: Path Rel Dir
configWorkingDir :: Maybe (Path Rel Dir)
configKeepOneFailed :: Bool
configKeepReleases :: Maybe Natural
configReleaseFormat :: Maybe ReleaseFormat
configTargetSystem :: TargetSystem
configRunLocally :: Maybe [GenericCommand]
configVcAction :: Bool
configLinkedDirs :: [[Char]]
configLinkedFiles :: [[Char]]
configCopyDirs :: [CopyThing]
configCopyFiles :: [CopyThing]
configBuildScript :: Maybe [GenericCommand]
configRestartCommand :: Maybe GenericCommand
configSource :: Source
configHosts :: [Target]
configDeployPath :: Path Abs Dir
..} ReleaseFormat
releaseFormat Natural
keepReleases Bool
keepOneFailed = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [GenericCommand]
configRunLocally [GenericCommand] -> Hapistrano ()
playScriptLocally
Release
release <- if Bool
configVcAction
then Task -> Hapistrano Release
pushRelease Task
task
else Task -> Hapistrano Release
pushReleaseWithoutVc Task
task
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
configDeployPath Release
release Maybe (Path Rel Dir)
configWorkingDir
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Source -> Maybe (Path Abs Dir)
toMaybePath Source
configSource) forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
src ->
Path Abs Dir -> Path Abs Dir -> Maybe Release -> Hapistrano ()
scpDir Path Abs Dir
src Path Abs Dir
rpath (forall a. a -> Maybe a
Just Release
release)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CopyThing]
configCopyFiles forall a b. (a -> b) -> a -> b
$ \(CopyThing [Char]
src [Char]
dest) -> do
Path Abs File
srcPath <- forall (m :: * -> *). MonadIO m => [Char] -> m (Path Abs File)
resolveFile' [Char]
src
Path Rel File
destPath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
dest
let dpath :: Path Abs File
dpath = Path Abs Dir
rpath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
destPath
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall a. a -> Maybe a
Just Release
release) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> Path b Dir
parent) Path Abs File
dpath
Path Abs File -> Path Abs File -> Maybe Release -> Hapistrano ()
scpFile Path Abs File
srcPath Path Abs File
dpath (forall a. a -> Maybe a
Just Release
release)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [CopyThing]
configCopyDirs forall a b. (a -> b) -> a -> b
$ \(CopyThing [Char]
src [Char]
dest) -> do
Path Abs Dir
srcPath <- forall (m :: * -> *). MonadIO m => [Char] -> m (Path Abs Dir)
resolveDir' [Char]
src
Path Rel Dir
destPath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir [Char]
dest
let dpath :: Path Abs Dir
dpath = Path Abs Dir
rpath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
destPath
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall a. a -> Maybe a
Just Release
release) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> Path b Dir
parent) Path Abs Dir
dpath
Path Abs Dir -> Path Abs Dir -> Maybe Release -> Hapistrano ()
scpDir Path Abs Dir
srcPath Path Abs Dir
dpath (forall a. a -> Maybe a
Just Release
release)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
configLinkedFiles
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (TargetSystem
-> Path Abs Dir
-> Path Abs Dir
-> [Char]
-> Maybe Release
-> Hapistrano ()
linkToShared TargetSystem
configTargetSystem Path Abs Dir
rpath Path Abs Dir
configDeployPath) (forall a. a -> Maybe a
Just Release
release)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[Char]]
configLinkedDirs
forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip (TargetSystem
-> Path Abs Dir
-> Path Abs Dir
-> [Char]
-> Maybe Release
-> Hapistrano ()
linkToShared TargetSystem
configTargetSystem Path Abs Dir
rpath Path Abs Dir
configDeployPath) (forall a. a -> Maybe a
Just Release
release)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe [GenericCommand]
configBuildScript (Path Abs Dir
-> Release
-> Maybe (Path Rel Dir)
-> [GenericCommand]
-> Hapistrano ()
playScript Path Abs Dir
configDeployPath Release
release Maybe (Path Rel Dir)
configWorkingDir)
TargetSystem -> Path Abs Dir -> Release -> Hapistrano ()
activateRelease TargetSystem
configTargetSystem Path Abs Dir
configDeployPath Release
release
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GenericCommand
configRestartCommand (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Release
release)
Path Abs Dir -> Release -> DeployState -> Hapistrano ()
createHapistranoDeployState Path Abs Dir
configDeployPath Release
release DeployState
Success
Path Abs Dir -> Natural -> Bool -> Hapistrano ()
dropOldReleases Path Abs Dir
configDeployPath Natural
keepReleases Bool
keepOneFailed
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` forall {b}. HapistranoException -> Hapistrano b
failStateAndThrow
where
failStateAndThrow :: HapistranoException -> Hapistrano b
failStateAndThrow e :: HapistranoException
e@(HapistranoException (Failure
_, Maybe Release
maybeRelease)) = do
case Maybe Release
maybeRelease of
(Just Release
release) -> do
Path Abs Dir -> Release -> DeployState -> Hapistrano ()
createHapistranoDeployState Path Abs Dir
configDeployPath Release
release DeployState
Fail
Path Abs Dir -> Natural -> Bool -> Hapistrano ()
dropOldReleases Path Abs Dir
configDeployPath Natural
keepReleases Bool
keepOneFailed
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM HapistranoException
e
Maybe Release
Nothing -> do
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM HapistranoException
e
task :: Task
task =
Task
{ taskDeployPath :: Path Abs Dir
taskDeployPath = Path Abs Dir
configDeployPath
, taskSource :: Source
taskSource = Source
configSource
, taskReleaseFormat :: ReleaseFormat
taskReleaseFormat = ReleaseFormat
releaseFormat
}
rollback
:: TargetSystem
-> Path Abs Dir
-> Natural
-> Maybe GenericCommand
-> Hapistrano ()
rollback :: TargetSystem
-> Path Abs Dir -> Natural -> Maybe GenericCommand -> Hapistrano ()
rollback TargetSystem
ts Path Abs Dir
deployPath Natural
n Maybe GenericCommand
mbRestartCommand = do
[Release]
releases <- DeployState -> Path Abs Dir -> Hapistrano [Release]
releasesWithState DeployState
Success Path Abs Dir
deployPath
case forall i a. Integral i => i -> [a] -> [a]
genericDrop Natural
n [Release]
releases of
[] -> forall a. Int -> Maybe [Char] -> Maybe Release -> Hapistrano a
failWith Int
1 (forall a. a -> Maybe a
Just [Char]
"Could not find the requested release to rollback to.") forall a. Maybe a
Nothing
(Release
x:[Release]
_) -> do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
x forall a. Maybe a
Nothing
Bool
isRpathExist <- forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist Path Abs Dir
rpath
if Bool
isRpathExist
then TargetSystem -> Path Abs Dir -> Release -> Hapistrano ()
activateRelease TargetSystem
ts Path Abs Dir
deployPath Release
x
else forall a. Int -> Maybe [Char] -> Maybe Release -> Hapistrano a
failWith Int
1 (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot rollback to the release path '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Path Abs Dir
rpath forall a. Semigroup a => a -> a -> a
<> [Char]
"'.") (forall a. a -> Maybe a
Just Release
x)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GenericCommand
mbRestartCommand (forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
`exec` forall a. Maybe a
Nothing)
dropOldReleases
:: Path Abs Dir
-> Natural
-> Bool
-> Hapistrano ()
dropOldReleases :: Path Abs Dir -> Natural -> Bool -> Hapistrano ()
dropOldReleases Path Abs Dir
deployPath Natural
n Bool
keepOneFailed = do
[Release]
failedReleases <- DeployState -> Path Abs Dir -> Hapistrano [Release]
releasesWithState DeployState
Fail Path Abs Dir
deployPath
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
keepOneFailed Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [Release]
failedReleases forall a. Ord a => a -> a -> Bool
> Int
1) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> [a]
tail [Release]
failedReleases) forall a b. (a -> b) -> a -> b
$ \Release
release -> do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release forall a. Maybe a
Nothing
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall t. Path Abs t -> Rm
Rm Path Abs Dir
rpath) forall a. Maybe a
Nothing
[Release]
dreleases <- Path Abs Dir -> Hapistrano [Release]
deployedReleases Path Abs Dir
deployPath
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall i a. Integral i => i -> [a] -> [a]
genericDrop Natural
n [Release]
dreleases) forall a b. (a -> b) -> a -> b
$ \Release
release -> do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release forall a. Maybe a
Nothing
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall t. Path Abs t -> Rm
Rm Path Abs Dir
rpath) forall a. Maybe a
Nothing
playScript
:: Path Abs Dir
-> Release
-> Maybe (Path Rel Dir)
-> [GenericCommand]
-> Hapistrano ()
playScript :: Path Abs Dir
-> Release
-> Maybe (Path Rel Dir)
-> [GenericCommand]
-> Hapistrano ()
playScript Path Abs Dir
deployDir Release
release Maybe (Path Rel Dir)
mWorkingDir [GenericCommand]
cmds = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployDir Release
release Maybe (Path Rel Dir)
mWorkingDir
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenericCommand]
cmds (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano ()
execWithInheritStdout (forall a. a -> Maybe a
Just Release
release) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
rpath)
playScriptLocally :: [GenericCommand] -> Hapistrano ()
playScriptLocally :: [GenericCommand] -> Hapistrano ()
playScriptLocally [GenericCommand]
cmds =
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
(\Config
c ->
Config
c
{ configSshOptions :: Maybe SshOptions
configSshOptions = forall a. Maybe a
Nothing
}) forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenericCommand]
cmds forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano ()
execWithInheritStdout forall a. Maybe a
Nothing
setupDirs
:: Path Abs Dir
-> Hapistrano ()
setupDirs :: Path Abs Dir -> Hapistrano ()
setupDirs Path Abs Dir
deployPath = do
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
releasesPath) Path Abs Dir
deployPath
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
cacheRepoPath) Path Abs Dir
deployPath
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
sharedPath) Path Abs Dir
deployPath
ensureCacheInPlace
:: String
-> Path Abs Dir
-> Maybe Release
-> Hapistrano ()
ensureCacheInPlace :: [Char] -> Path Abs Dir -> Maybe Release -> Hapistrano ()
ensureCacheInPlace [Char]
repo Path Abs Dir
deployPath Maybe Release
maybeRelease = do
let cpath :: Path Abs Dir
cpath = Path Abs Dir -> Path Abs Dir
cacheRepoPath Path Abs Dir
deployPath
refs :: Path Abs t
refs = Path Abs Dir
cpath forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "refs")
Bool
exists <- (forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs Dir -> Ls
Ls forall {t}. Path Abs t
refs) forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (\(HapistranoException
_ :: HapistranoException) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Bool -> Either [Char] (Path Abs Dir) -> Path Abs Dir -> GitClone
GitClone Bool
True (forall a b. a -> Either a b
Left [Char]
repo) Path Abs Dir
cpath) Maybe Release
maybeRelease
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
cpath ([Char] -> GitSetOrigin
GitSetOrigin [Char]
repo)) Maybe Release
maybeRelease
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
cpath ([Char] -> GitFetch
GitFetch [Char]
"origin")) Maybe Release
maybeRelease
newRelease :: ReleaseFormat -> Hapistrano Release
newRelease :: ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
releaseFormat =
ReleaseFormat -> UTCTime -> Release
mkRelease ReleaseFormat
releaseFormat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
cloneToRelease
:: Path Abs Dir
-> Release
-> Hapistrano ()
cloneToRelease :: Path Abs Dir -> Release -> Hapistrano ()
cloneToRelease Path Abs Dir
deployPath Release
release = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release forall a. Maybe a
Nothing
let cpath :: Path Abs Dir
cpath = Path Abs Dir -> Path Abs Dir
cacheRepoPath Path Abs Dir
deployPath
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Bool -> Either [Char] (Path Abs Dir) -> Path Abs Dir -> GitClone
GitClone Bool
False (forall a b. b -> Either a b
Right Path Abs Dir
cpath) Path Abs Dir
rpath) (forall a. a -> Maybe a
Just Release
release)
setReleaseRevision
:: Path Abs Dir
-> Release
-> String
-> Hapistrano ()
setReleaseRevision :: Path Abs Dir -> Release -> [Char] -> Hapistrano ()
setReleaseRevision Path Abs Dir
deployPath Release
release [Char]
revision = do
Path Abs Dir
rpath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release forall a. Maybe a
Nothing
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
rpath ([Char] -> GitCheckout
GitCheckout [Char]
revision)) (forall a. a -> Maybe a
Just Release
release)
deployedReleases
:: Path Abs Dir
-> Hapistrano [Release]
deployedReleases :: Path Abs Dir -> Hapistrano [Release]
deployedReleases Path Abs Dir
deployPath = do
let rpath :: Path Abs Dir
rpath = Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath
[Path Abs Dir]
xs <- forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall t. Natural -> Path Abs Dir -> Find t
Find Natural
1 Path Abs Dir
rpath :: Find Dir) forall a. Maybe a
Nothing
[Path Rel Dir]
ps <- forall t. Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs Path Abs Dir
rpath (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Path Abs Dir
rpath) [Path Abs Dir]
xs)
(forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Char] -> Maybe Release
parseRelease)
(forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'/') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> [Char]
fromRelDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Rel Dir]
ps)
releasesWithState
:: DeployState
-> Path Abs Dir
-> Hapistrano [Release]
releasesWithState :: DeployState -> Path Abs Dir -> Hapistrano [Release]
releasesWithState DeployState
selectedState Path Abs Dir
deployPath = do
[Release]
releases <- Path Abs Dir -> Hapistrano [Release]
deployedReleases Path Abs Dir
deployPath
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((\Bool
bool -> if DeployState
selectedState forall a. Eq a => a -> a -> Bool
== DeployState
Success then Bool
bool else Bool -> Bool
not Bool
bool) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeployState -> Bool
stateToBool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir
-> Maybe (Path Rel Dir) -> Release -> Hapistrano DeployState
deployState Path Abs Dir
deployPath forall a. Maybe a
Nothing
) [Release]
releases
where
stateToBool :: DeployState -> Bool
stateToBool :: DeployState -> Bool
stateToBool DeployState
Fail = Bool
False
stateToBool DeployState
_ = Bool
True
releasesPath
:: Path Abs Dir
-> Path Abs Dir
releasesPath :: Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath = Path Abs Dir
deployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "releases")
sharedPath
:: Path Abs Dir
-> Path Abs Dir
sharedPath :: Path Abs Dir -> Path Abs Dir
sharedPath Path Abs Dir
deployPath = Path Abs Dir
deployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "shared")
linkToShared
:: TargetSystem
-> Path Abs Dir
-> Path Abs Dir
-> FilePath
-> Maybe Release
-> Hapistrano ()
linkToShared :: TargetSystem
-> Path Abs Dir
-> Path Abs Dir
-> [Char]
-> Maybe Release
-> Hapistrano ()
linkToShared TargetSystem
configTargetSystem Path Abs Dir
rpath Path Abs Dir
configDeployPath [Char]
thingToLink Maybe Release
maybeRelease = do
Path Rel File
destPath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
thingToLink
let dpath :: Path Abs File
dpath = Path Abs Dir
rpath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
destPath
sharedPath' :: Path Abs File
sharedPath' = Path Abs Dir -> Path Abs Dir
sharedPath Path Abs Dir
configDeployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
destPath
forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (forall t. TargetSystem -> Path Abs t -> Path Abs File -> Ln
Ln TargetSystem
configTargetSystem Path Abs File
sharedPath' Path Abs File
dpath) Maybe Release
maybeRelease
releasePath
:: Path Abs Dir
-> Release
-> Maybe (Path Rel Dir)
-> Hapistrano (Path Abs Dir)
releasePath :: Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
mWorkingDir =
let rendered :: [Char]
rendered = Release -> [Char]
renderRelease Release
release
in case forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel Dir)
parseRelDir [Char]
rendered of
Maybe (Path Rel Dir)
Nothing -> forall a. Int -> Maybe [Char] -> Maybe Release -> Hapistrano a
failWith Int
1 (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"Could not append path: " forall a. [a] -> [a] -> [a]
++ [Char]
rendered) (forall a. a -> Maybe a
Just Release
release)
Just Path Rel Dir
rpath ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe (Path Rel Dir)
mWorkingDir of
Maybe (Path Rel Dir)
Nothing -> Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rpath
Just Path Rel Dir
workingDir -> Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rpath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
workingDir
cacheRepoPath
:: Path Abs Dir
-> Path Abs Dir
cacheRepoPath :: Path Abs Dir -> Path Abs Dir
cacheRepoPath Path Abs Dir
deployPath = Path Abs Dir
deployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "repo")
currentSymlinkPath
:: Path Abs Dir
-> Path Abs File
currentSymlinkPath :: Path Abs Dir -> Path Abs File
currentSymlinkPath Path Abs Dir
deployPath = Path Abs Dir
deployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelFile "current")
tempSymlinkPath
:: Path Abs Dir
-> Path Abs File
tempSymlinkPath :: Path Abs Dir -> Path Abs File
tempSymlinkPath Path Abs Dir
deployPath = Path Abs Dir
deployPath forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelFile "current_tmp")
deployState
:: Path Abs Dir
-> Maybe (Path Rel Dir)
-> Release
-> Hapistrano DeployState
deployState :: Path Abs Dir
-> Maybe (Path Rel Dir) -> Release -> Hapistrano DeployState
deployState Path Abs Dir
deployPath Maybe (Path Rel Dir)
mWorkingDir Release
release = do
Path Rel File
parseStatePath <- forall (m :: * -> *). MonadThrow m => [Char] -> m (Path Rel File)
parseRelFile [Char]
deployStateFilename
Path Abs Dir
actualReleasePath <- Path Abs Dir
-> Release -> Maybe (Path Rel Dir) -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release Maybe (Path Rel Dir)
mWorkingDir
let stateFilePath :: Path Abs File
stateFilePath = Path Abs Dir
actualReleasePath forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
parseStatePath
Bool
doesExist <- forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> CheckExists
CheckExists Path Abs File
stateFilePath) (forall a. a -> Maybe a
Just Release
release)
if Bool
doesExist then do
[Char]
deployStateContents <- forall a. Command a => a -> Maybe Release -> Hapistrano (Result a)
exec (Path Abs File -> Cat
Cat Path Abs File
stateFilePath) (forall a. a -> Maybe a
Just Release
release)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. a -> Maybe a -> a
fromMaybe DeployState
Unknown forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => [Char] -> Maybe a
readMaybe) [Char]
deployStateContents
else forall (m :: * -> *) a. Monad m => a -> m a
return DeployState
Unknown
stripDirs :: Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs :: forall t. Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs Path Abs Dir
path =
#if MIN_VERSION_path(0,6,0)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
path)
#else
mapM (stripDir path)
#endif