-- |
-- Module      :  System.Hapistrano
-- Copyright   :  © 2015-Present Stack Builders
-- License     :  MIT
--
-- Maintainer  :  Juan Paucar <jpaucar@stackbuilders.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- A module for creating reliable deploy processes for Haskell applications.
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

module System.Hapistrano
  ( pushRelease
  , pushReleaseWithoutVc
  , registerReleaseAsComplete
  , activateRelease
  , linkToShared
  , rollback
  , dropOldReleases
  , playScript
  , playScriptLocally
    -- * Path helpers
  , releasePath
  , sharedPath
  , currentSymlinkPath
  , tempSymlinkPath
  , ctokenPath )
where

import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.Reader       (local)
import           Data.List                  (dropWhileEnd, genericDrop, sortOn)
import           Data.Maybe                 (mapMaybe)
import           Data.Ord                   (Down (..))
import           Data.Time
import           Numeric.Natural
import           Path
import           System.Hapistrano.Commands
import           System.Hapistrano.Core
import           System.Hapistrano.Types

----------------------------------------------------------------------------
-- 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 {String
gitRepositoryRevision :: Source -> String
gitRepositoryURL :: Source -> String
gitRepositoryRevision :: String
gitRepositoryURL :: String
..} = do
      String -> Path Abs Dir -> Hapistrano ()
ensureCacheInPlace String
gitRepositoryURL Path Abs Dir
taskDeployPath
      Release
release <- ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
taskReleaseFormat
      Path Abs Dir -> Release -> Hapistrano ()
cloneToRelease Path Abs Dir
taskDeployPath Release
release
      Path Abs Dir -> Release -> String -> Hapistrano ()
setReleaseRevision Path Abs Dir
taskDeployPath Release
release String
gitRepositoryRevision
      Release -> Hapistrano Release
forall (m :: * -> *) a. Monad m => a -> m a
return Release
release
    pushReleaseForRepository LocalDirectory {Path Abs Dir
localDirectoryPath :: Source -> Path Abs Dir
localDirectoryPath :: Path Abs Dir
..} =
      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

-- | Create a file-token that will tell rollback function that this release
-- should be considered successfully compiled\/completed.

registerReleaseAsComplete
  :: Path Abs Dir      -- ^ Deploy path
  -> Release           -- ^ Release identifier to activate
  -> Hapistrano ()
registerReleaseAsComplete :: Path Abs Dir -> Release -> Hapistrano ()
registerReleaseAsComplete Path Abs Dir
deployPath Release
release = do
  Path Abs File
cpath <- Path Abs Dir -> Release -> Hapistrano (Path Abs File)
ctokenPath Path Abs Dir
deployPath Release
release
  Touch -> Hapistrano (Result Touch)
forall a. Command a => a -> Hapistrano (Result a)
exec (Path Abs File -> Touch
Touch Path Abs File
cpath)

-- | 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 -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release
  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
  Ln -> Hapistrano (Result Ln)
forall a. Command a => a -> Hapistrano (Result a)
exec (TargetSystem -> Path Abs Dir -> Path Abs File -> Ln
forall t. TargetSystem -> Path Abs t -> Path Abs File -> Ln
Ln TargetSystem
ts Path Abs Dir
rpath Path Abs File
tpath) -- create a symlink for the new candidate
  Mv File -> Hapistrano (Result (Mv File))
forall a. Command a => a -> Hapistrano (Result a)
exec (TargetSystem -> Path Abs File -> Path Abs File -> Mv File
forall t. TargetSystem -> Path Abs t -> Path Abs t -> Mv t
Mv TargetSystem
ts Path Abs File
tpath Path Abs File
cpath) -- atomically replace the symlink

-- | Activates one of already deployed releases.

rollback
  :: TargetSystem
  -> Path Abs Dir      -- ^ Deploy path
  -> Natural           -- ^ How many releases back to go, 0 re-activates current
  -> Hapistrano ()
rollback :: TargetSystem -> Path Abs Dir -> Natural -> Hapistrano ()
rollback TargetSystem
ts Path Abs Dir
deployPath Natural
n = do
  [Release]
crs <- Path Abs Dir -> Hapistrano [Release]
completedReleases Path Abs Dir
deployPath
  [Release]
drs <- Path Abs Dir -> Hapistrano [Release]
deployedReleases  Path Abs Dir
deployPath
  -- NOTE If we don't have any completed releases, then perhaps the
  -- application was used with older versions of Hapistrano that did not
  -- have this functionality. We then fall back and use collection of “just”
  -- deployed releases.
  case Natural -> [Release] -> [Release]
forall i a. Integral i => i -> [a] -> [a]
genericDrop Natural
n (if [Release] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Release]
crs then [Release]
drs else [Release]
crs) of
    [] -> Int -> Maybe String -> Hapistrano ()
forall a. Int -> Maybe String -> Hapistrano a
failWith Int
1 (String -> Maybe String
forall a. a -> Maybe a
Just String
"Could not find the requested release to rollback to.")
    (Release
x:[Release]
_) -> TargetSystem -> Path Abs Dir -> Release -> Hapistrano ()
activateRelease TargetSystem
ts Path Abs Dir
deployPath Release
x

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

dropOldReleases
  :: Path Abs Dir      -- ^ Deploy path
  -> Natural           -- ^ How many releases to keep
  -> Hapistrano ()     -- ^ Deleted Releases
dropOldReleases :: Path Abs Dir -> Natural -> Hapistrano ()
dropOldReleases Path Abs Dir
deployPath Natural
n = do
  [Release]
dreleases <- Path Abs Dir -> Hapistrano [Release]
deployedReleases Path Abs Dir
deployPath
  [Release] -> (Release -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Natural -> [Release] -> [Release]
forall i a. Integral i => i -> [a] -> [a]
genericDrop Natural
n [Release]
dreleases) ((Release -> Hapistrano ()) -> Hapistrano ())
-> (Release -> Hapistrano ()) -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$ \Release
release -> do
    Path Abs Dir
rpath <- Path Abs Dir -> Release -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release
    Rm -> Hapistrano (Result Rm)
forall a. Command a => a -> Hapistrano (Result a)
exec (Path Abs Dir -> Rm
forall t. Path Abs t -> Rm
Rm Path Abs Dir
rpath)
  [Release]
creleases <- Path Abs Dir -> Hapistrano [Release]
completedReleases Path Abs Dir
deployPath
  [Release] -> (Release -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Natural -> [Release] -> [Release]
forall i a. Integral i => i -> [a] -> [a]
genericDrop Natural
n [Release]
creleases) ((Release -> Hapistrano ()) -> Hapistrano ())
-> (Release -> Hapistrano ()) -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$ \Release
release -> do
    Path Abs File
cpath <- Path Abs Dir -> Release -> Hapistrano (Path Abs File)
ctokenPath  Path Abs Dir
deployPath Release
release
    Rm -> Hapistrano (Result Rm)
forall a. Command a => a -> Hapistrano (Result a)
exec (Path Abs File -> Rm
forall t. Path Abs t -> Rm
Rm Path Abs File
cpath)

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

playScript
  :: Path Abs Dir      -- ^ Deploy path
  -> Release           -- ^ Release identifier
  -> [GenericCommand] -- ^ Commands to execute
  -> Hapistrano ()
playScript :: Path Abs Dir -> Release -> [GenericCommand] -> Hapistrano ()
playScript Path Abs Dir
deployDir Release
release [GenericCommand]
cmds = do
  Path Abs Dir
rpath <- Path Abs Dir -> Release -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployDir Release
release
  [GenericCommand]
-> (GenericCommand -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenericCommand]
cmds (Cd GenericCommand -> Hapistrano ()
forall a. Command a => a -> Hapistrano ()
execWithInheritStdout (Cd GenericCommand -> Hapistrano ())
-> (GenericCommand -> Cd GenericCommand)
-> GenericCommand
-> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> GenericCommand -> Cd GenericCommand
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 =
  (Config -> Config) -> Hapistrano () -> Hapistrano ()
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
    (\Config
c ->
        Config
c
        { configSshOptions :: Maybe SshOptions
configSshOptions = Maybe SshOptions
forall a. Maybe a
Nothing
        }) (Hapistrano () -> Hapistrano ()) -> Hapistrano () -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$
  [GenericCommand]
-> (GenericCommand -> Hapistrano ()) -> Hapistrano ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenericCommand]
cmds GenericCommand -> Hapistrano ()
forall a. Command a => a -> Hapistrano ()
execWithInheritStdout

----------------------------------------------------------------------------
-- 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
  (MkDir -> Hapistrano ()
forall a. Command a => a -> Hapistrano (Result a)
exec (MkDir -> Hapistrano ())
-> (Path Abs Dir -> MkDir) -> Path Abs Dir -> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir (Path Abs Dir -> MkDir)
-> (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> MkDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
releasesPath)  Path Abs Dir
deployPath
  (MkDir -> Hapistrano ()
forall a. Command a => a -> Hapistrano (Result a)
exec (MkDir -> Hapistrano ())
-> (Path Abs Dir -> MkDir) -> Path Abs Dir -> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir (Path Abs Dir -> MkDir)
-> (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> MkDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
cacheRepoPath) Path Abs Dir
deployPath
  (MkDir -> Hapistrano ()
forall a. Command a => a -> Hapistrano (Result a)
exec (MkDir -> Hapistrano ())
-> (Path Abs Dir -> MkDir) -> Path Abs Dir -> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir (Path Abs Dir -> MkDir)
-> (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> MkDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> Path Abs Dir
ctokensPath)   Path Abs Dir
deployPath
  (MkDir -> Hapistrano ()
forall a. Command a => a -> Hapistrano (Result a)
exec (MkDir -> Hapistrano ())
-> (Path Abs Dir -> MkDir) -> Path Abs Dir -> Hapistrano ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> MkDir
MkDir (Path Abs Dir -> MkDir)
-> (Path Abs Dir -> Path Abs Dir) -> Path Abs Dir -> 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
  -> Hapistrano ()
ensureCacheInPlace :: String -> Path Abs Dir -> Hapistrano ()
ensureCacheInPlace String
repo Path Abs Dir
deployPath = 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 Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "refs")
  Bool
exists <- (Ls -> Hapistrano (Result Ls)
forall a. Command a => a -> Hapistrano (Result a)
exec (Path Abs Dir -> Ls
Ls Path Abs Dir
forall t. Path Abs t
refs) Hapistrano ()
-> ExceptT Failure (ReaderT Config IO) Bool
-> ExceptT Failure (ReaderT Config IO) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ExceptT Failure (ReaderT Config IO) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
    ExceptT Failure (ReaderT Config IO) Bool
-> (Failure -> ExceptT Failure (ReaderT Config IO) Bool)
-> ExceptT Failure (ReaderT Config IO) Bool
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` ExceptT Failure (ReaderT Config IO) Bool
-> Failure -> ExceptT Failure (ReaderT Config IO) Bool
forall a b. a -> b -> a
const (Bool -> ExceptT Failure (ReaderT Config IO) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
  Bool -> Hapistrano () -> Hapistrano ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (Hapistrano () -> Hapistrano ()) -> Hapistrano () -> Hapistrano ()
forall a b. (a -> b) -> a -> b
$
    GitClone -> Hapistrano (Result GitClone)
forall a. Command a => a -> Hapistrano (Result a)
exec (Bool -> Either String (Path Abs Dir) -> Path Abs Dir -> GitClone
GitClone Bool
True (String -> Either String (Path Abs Dir)
forall a b. a -> Either a b
Left String
repo) Path Abs Dir
cpath)
  Cd GitFetch -> Hapistrano (Result (Cd GitFetch))
forall a. Command a => a -> Hapistrano (Result a)
exec (Path Abs Dir -> GitFetch -> Cd GitFetch
forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
cpath (String -> GitFetch
GitFetch String
"origin")) -- TODO store this in task description?

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

newRelease :: ReleaseFormat -> Hapistrano Release
newRelease :: ReleaseFormat -> Hapistrano Release
newRelease ReleaseFormat
releaseFormat =
  ReleaseFormat -> UTCTime -> Release
mkRelease ReleaseFormat
releaseFormat (UTCTime -> Release)
-> ExceptT Failure (ReaderT Config IO) UTCTime
-> Hapistrano Release
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> ExceptT Failure (ReaderT Config IO) UTCTime
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 -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release
  let cpath :: Path Abs Dir
cpath = Path Abs Dir -> Path Abs Dir
cacheRepoPath Path Abs Dir
deployPath
  GitClone -> Hapistrano (Result GitClone)
forall a. Command a => a -> Hapistrano (Result a)
exec (Bool -> Either String (Path Abs Dir) -> Path Abs Dir -> GitClone
GitClone Bool
False (Path Abs Dir -> Either String (Path Abs Dir)
forall a b. b -> Either a b
Right Path Abs Dir
cpath) Path Abs Dir
rpath)

-- | 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 -> String -> Hapistrano ()
setReleaseRevision Path Abs Dir
deployPath Release
release String
revision = do
  Path Abs Dir
rpath <- Path Abs Dir -> Release -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release
  Cd GitCheckout -> Hapistrano (Result (Cd GitCheckout))
forall a. Command a => a -> Hapistrano (Result a)
exec (Path Abs Dir -> GitCheckout -> Cd GitCheckout
forall cmd. Path Abs Dir -> cmd -> Cd cmd
Cd Path Abs Dir
rpath (String -> GitCheckout
GitCheckout String
revision))

-- | 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 <- Find Dir -> Hapistrano (Result (Find Dir))
forall a. Command a => a -> Hapistrano (Result a)
exec (Natural -> Path Abs Dir -> Find Dir
forall t. Natural -> Path Abs Dir -> Find t
Find Natural
1 Path Abs Dir
rpath :: Find Dir)
  [Path Rel Dir]
ps <- Path Abs Dir -> [Path Abs Dir] -> Hapistrano [Path Rel Dir]
forall t. Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs Path Abs Dir
rpath ((Path Abs Dir -> Bool) -> [Path Abs Dir] -> [Path Abs Dir]
forall a. (a -> Bool) -> [a] -> [a]
filter (Path Abs Dir -> Path Abs Dir -> Bool
forall a. Eq a => a -> a -> Bool
/= Path Abs Dir
rpath) [Path Abs Dir]
xs)
  ([Release] -> Hapistrano [Release]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Release] -> Hapistrano [Release])
-> ([String] -> [Release]) -> [String] -> Hapistrano [Release]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Release -> Down Release) -> [Release] -> [Release]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Release -> Down Release
forall a. a -> Down a
Down ([Release] -> [Release])
-> ([String] -> [Release]) -> [String] -> [Release]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe Release) -> [String] -> [Release]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Release
parseRelease)
    ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> String)
-> (Path Rel Dir -> String) -> Path Rel Dir -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel Dir -> String
fromRelDir (Path Rel Dir -> String) -> [Path Rel Dir] -> [String]
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.

completedReleases
  :: Path Abs Dir      -- ^ Deploy path
  -> Hapistrano [Release]
completedReleases :: Path Abs Dir -> Hapistrano [Release]
completedReleases Path Abs Dir
deployPath = do
  let cpath :: Path Abs Dir
cpath = Path Abs Dir -> Path Abs Dir
ctokensPath Path Abs Dir
deployPath
  [Path Abs File]
xs <- Find File -> Hapistrano (Result (Find File))
forall a. Command a => a -> Hapistrano (Result a)
exec (Natural -> Path Abs Dir -> Find File
forall t. Natural -> Path Abs Dir -> Find t
Find Natural
1 Path Abs Dir
cpath :: Find File)
  [Path Rel File]
ps <- Path Abs Dir -> [Path Abs File] -> Hapistrano [Path Rel File]
forall t. Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs Path Abs Dir
cpath [Path Abs File]
xs
  ([Release] -> Hapistrano [Release]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Release] -> Hapistrano [Release])
-> ([String] -> [Release]) -> [String] -> Hapistrano [Release]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Release -> Down Release) -> [Release] -> [Release]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Release -> Down Release
forall a. a -> Down a
Down ([Release] -> [Release])
-> ([String] -> [Release]) -> [String] -> [Release]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe Release) -> [String] -> [Release]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Release
parseRelease)
    ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (String -> String)
-> (Path Rel File -> String) -> Path Rel File -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> String
fromRelFile (Path Rel File -> String) -> [Path Rel File] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Path Rel File]
ps)

----------------------------------------------------------------------------
-- 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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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
  -> Hapistrano ()
linkToShared :: TargetSystem
-> Path Abs Dir -> Path Abs Dir -> String -> Hapistrano ()
linkToShared TargetSystem
configTargetSystem Path Abs Dir
rpath Path Abs Dir
configDeployPath String
thingToLink = do
  Path Rel File
destPath <- String -> ExceptT Failure (ReaderT Config IO) (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
thingToLink
  let dpath :: Path Abs File
dpath = Path Abs Dir
rpath Path Abs Dir -> Path Rel File -> Path Abs File
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 Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
destPath
  Ln -> Hapistrano (Result Ln)
forall a. Command a => a -> Hapistrano (Result a)
exec (Ln -> Hapistrano (Result Ln)) -> Ln -> Hapistrano (Result Ln)
forall a b. (a -> b) -> a -> b
$ TargetSystem -> Path Abs File -> Path Abs File -> Ln
forall t. TargetSystem -> Path Abs t -> Path Abs File -> Ln
Ln TargetSystem
configTargetSystem Path Abs File
sharedPath' Path Abs File
dpath

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

releasePath
  :: Path Abs Dir      -- ^ Deploy path
  -> Release           -- ^ 'Release' identifier
  -> Hapistrano (Path Abs Dir)
releasePath :: Path Abs Dir -> Release -> Hapistrano (Path Abs Dir)
releasePath Path Abs Dir
deployPath Release
release = do
  let rendered :: String
rendered = Release -> String
renderRelease Release
release
  case String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
rendered of
    Maybe (Path Rel Dir)
Nothing    -> Int -> Maybe String -> Hapistrano (Path Abs Dir)
forall a. Int -> Maybe String -> Hapistrano a
failWith Int
1 (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Could not append path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rendered)
    Just Path Rel Dir
rpath -> Path Abs Dir -> Hapistrano (Path Abs Dir)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs Dir -> Path Abs Dir
releasesPath Path Abs Dir
deployPath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rpath)

-- | 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 Path Abs Dir -> Path Rel Dir -> Path Abs Dir
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 Path Abs Dir -> Path Rel File -> Path Abs File
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 Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelFile "current_tmp")

-- | Get path to the directory that contains tokens of build completion.

ctokensPath
  :: Path Abs Dir      -- ^ Deploy path
  -> Path Abs Dir
ctokensPath :: Path Abs Dir -> Path Abs Dir
ctokensPath Path Abs Dir
deployPath = Path Abs Dir
deployPath Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> $(mkRelDir "ctokens")

-- | Get path to completion token file for particular release.

ctokenPath
  :: Path Abs Dir      -- ^ Deploy path
  -> Release           -- ^ 'Release' identifier
  -> Hapistrano (Path Abs File)
ctokenPath :: Path Abs Dir -> Release -> Hapistrano (Path Abs File)
ctokenPath Path Abs Dir
deployPath Release
release = do
  let rendered :: String
rendered = Release -> String
renderRelease Release
release
  case String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
rendered of
    Maybe (Path Rel File)
Nothing    -> Int -> Maybe String -> Hapistrano (Path Abs File)
forall a. Int -> Maybe String -> Hapistrano a
failWith Int
1 (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"Could not append path: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rendered)
    Just Path Rel File
rpath -> Path Abs File -> Hapistrano (Path Abs File)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs Dir -> Path Abs Dir
ctokensPath Path Abs Dir
deployPath Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
rpath)

stripDirs :: Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs :: Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
stripDirs Path Abs Dir
path =
#if MIN_VERSION_path(0,6,0)
  (Path Abs t -> ExceptT Failure (ReaderT Config IO) (Path Rel t))
-> [Path Abs t] -> Hapistrano [Path Rel t]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Path Abs Dir
-> Path Abs t -> ExceptT Failure (ReaderT Config IO) (Path Rel t)
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