-- |
-- Module      :  System.Hapistrano
-- Copyright   :  © 2015-Present Stack Builders
-- License     :  MIT
--
-- Stability   :  experimental
-- Portability :  portable
--
-- A module for creating reliable deploy processes for Haskell applications.
{-# 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
    -- * Path helpers
  , 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)

----------------------------------------------------------------------------

-- | Run the 'Hapistrano' monad. The monad hosts 'exec' actions.
runHapistrano ::
     MonadIO m
  => Maybe SshOptions -- ^ SSH options to use or 'Nothing' if we run locally
  -> Shell -- ^ Shell to run commands
  -> (OutputDest -> String -> IO ()) -- ^ How to print messages
  -> Hapistrano a -- ^ The computation to run
  -> m (Either Int a) -- ^ Status code in 'Left' on failure, result in
              -- 'Right' on success
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)

-- High-level functionality

-- | Perform basic setup for a project, making sure necessary directories
-- exist and pushing a new release directory with the SHA1 or branch
-- specified in the configuration. Return identifier of the pushed release.

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
    -- When the configuration is set for a local directory, it will only create
    -- the release directory without any version control operations.
    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

-- | Same as 'pushRelease' but doesn't perform any version control
-- related operations.

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

-- | Switch the current symlink to point to the specified release. May be
-- used in deploy or rollback cases.

activateRelease
  :: TargetSystem
  -> Path Abs Dir      -- ^ Deploy path
  -> Release           -- ^ Release identifier to activate
  -> 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) -- create a symlink for the new candidate
  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) -- atomically replace the symlink

-- | Creates the file @.hapistrano__state@ containing
-- @fail@ or @success@ depending on how the deployment ended.

createHapistranoDeployState
  :: Path Abs Dir -- ^ Deploy path
  -> Release -- ^ Release being deployed
  -> DeployState -- ^ Indicates how the deployment went
  -> 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) -- creates '.hapistrano_deploy_state'
  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) -- writes the deploy state to '.hapistrano_deploy_state'

-- | Deploys a new release
deploy
  :: HC.Config -- ^ Deploy configuration
  -> ReleaseFormat -- ^ Long or Short format
  -> Natural -- ^ Number of releases to keep
  -> Bool -- ^ Wheter we should keep one failed release or not
  -> 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
      }

-- | Activates one of already deployed releases.

rollback
  :: TargetSystem
  -> Path Abs Dir      -- ^ Deploy path
  -> Natural           -- ^ How many releases back to go, 0 re-activates current
  -> Maybe GenericCommand -- ^ Restart command
  -> 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)

-- | Remove older releases to avoid filling up the target host filesystem.

dropOldReleases
  :: Path Abs Dir      -- ^ Deploy path
  -> Natural           -- ^ How many releases to keep
  -> Bool              -- ^ Whether the @--keep-one-failed@ flag is present or not
  -> 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
$
    -- Remove every failed release except the most recent one
    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

-- | Play the given script switching to directory of given release.

playScript
  :: Path Abs Dir         -- ^ Deploy path
  -> Release              -- ^ Release identifier
  -> Maybe (Path Rel Dir) -- ^ Working directory
  -> [GenericCommand]     -- ^ Commands to execute
  -> 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)

-- | Plays the given script on your machine locally.

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

----------------------------------------------------------------------------
-- Helpers

-- | Ensure that necessary directories exist. Idempotent.

setupDirs
  :: Path Abs Dir      -- ^ Deploy path
  -> 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

-- | Ensure that the specified repo is cloned and checked out on the given
-- revision. Idempotent.

ensureCacheInPlace
  :: String            -- ^ Repo URL
  -> Path Abs Dir      -- ^ Deploy path
  -> Maybe Release     -- ^ Release that was being attempted, if it was defined
  -> 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 -- TODO store this in task description?

-- | Create a new release identifier based on current timestamp.

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

-- | Clone the repository to create the specified 'Release'.

cloneToRelease
  :: Path Abs Dir      -- ^ Deploy path
  -> Release           -- ^ 'Release' to create
  -> 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)

-- | Set the release to the correct revision by checking out a branch or
-- a commit.

setReleaseRevision
  :: Path Abs Dir      -- ^ Deploy path
  -> Release           -- ^ 'Release' to checkout
  -> String            -- ^ Revision to checkout
  -> 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)

-- | Return a list of all currently deployed releases sorted newest first.

deployedReleases
  :: Path Abs Dir      -- ^ Deploy path
  -> 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)

-- | Return a list of successfully completed releases sorted newest first.

releasesWithState
  :: DeployState       -- ^ Selector for failed or successful releases
  -> Path Abs Dir      -- ^ Deploy path
  -> 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

----------------------------------------------------------------------------
-- Path helpers

-- | Return the full path to the directory containing all of the release
-- builds.

releasesPath
  :: Path Abs Dir      -- ^ Deploy path
  -> 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")

-- | Return the full path to the directory containing the shared files/directories.

sharedPath
  :: Path Abs Dir      -- ^ Deploy path
  -> 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")

-- | Link something (file or directory) from the {deploy_path}/shared/ directory
-- to a release

linkToShared
  :: TargetSystem -- ^ System to deploy
  -> Path Abs Dir -- ^ Release path
  -> Path Abs Dir -- ^ Deploy path
  -> FilePath     -- ^ Thing to link in share
  -> Maybe Release -- ^ Release that was being attempted, if it was defined
  -> 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

-- | Construct path to a particular 'Release'.

releasePath
  :: Path Abs Dir         -- ^ Deploy path
  -> Release              -- ^ 'Release' identifier
  -> Maybe (Path Rel Dir) -- ^ Working directory
  -> 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

-- | Return the full path to the git repo used for cache purposes on the
-- target host filesystem.

cacheRepoPath
  :: Path Abs Dir      -- ^ Deploy path
  -> 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")

-- | Get full path to current symlink.

currentSymlinkPath
  :: Path Abs Dir      -- ^ Deploy path
  -> 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")

-- | Get full path to temp symlink.

tempSymlinkPath
  :: Path Abs Dir      -- ^ Deploy path
  -> 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")

-- | Checks if a release was deployed properly or not
-- by looking into the @.hapistrano_deploy_state@ file.
-- If the file doesn't exist or the contents are anything other than
-- 'Fail' or 'Success', it returns 'Nothing'.

deployState
  :: Path Abs Dir -- ^ Deploy path
  -> Maybe (Path Rel Dir) -- ^ Working directory
  -> Release -- ^ 'Release' identifier
  -> Hapistrano DeployState -- ^ Whether the release was deployed successfully or not
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