Merge pull request #174 from stackbuilders/keep-failed-releases

Added `keep_one_failed` option that deletes failed releases except for the latest one
2024-12-27 05:53:30 +03:00 · 2022-02-08 16:48:45 +01:00 · 2022-02-08 16:48:45 +01:00 · 2bfde28d69
commit 2bfde28d69
parent 205c887d2f 4c6c44bd1b
12 changed files with 396 additions and 245 deletions
--- a/README.md
+++ b/README.md
@ -108,6 +108,10 @@ The following parameters are *optional*:
  '--keep-releases' argument passed via the CLI takes precedence over this
  value. If neither CLI nor configuration file value is specified, it defaults
  to '5'
+* `keep_one_failed` - A boolean specifying whether to keep all failed releases
+  or just one (the latest failed release), the '--keep-one-failed' flag passed via
+  the CLI takes precedence over this value. If neither CLI nor configuration file value is specified,
+  it defaults to false (i.e. keep all failed releases).
 * `linked_files:`- Listed files that will be symlinked from the `{deploy_path}/shared` folder
 into each release directory during deployment. Can be used for configuration files
 that need to be persisted (e.g. dotenv files).  **NOTE:** The directory structure _must_
--- a/app/Main.hs
+++ b/app/Main.hs
@ -8,7 +8,6 @@ module Main (main) where
 import           Control.Concurrent.Async
 import           Control.Concurrent.STM
 import           Control.Monad
-
 #if !MIN_VERSION_base(4,13,0)
 import           Data.Monoid                ((<>))
 #endif
@ -16,7 +15,6 @@ import           Data.Version               (showVersion)
 import qualified Data.Yaml.Config           as Yaml
 import           Development.GitRev
 import           Formatting                 (formatToString, string, (%))
-import           Numeric.Natural
 import           Options.Applicative        hiding (str)
 import           Path
 import           Path.IO
@ -28,23 +26,10 @@ import qualified System.Hapistrano.Config   as C
 import qualified System.Hapistrano.Core     as Hap
 import           System.Hapistrano.Types
 import           System.IO
+import           System.Hapistrano (createHapistranoDeployState)
+import           Control.Monad.Error.Class (throwError, catchError)

 ----------------------------------------------------------------------------
-- Command line options
-
-- | Command line options.
-
-data Opts = Opts
-  { optsCommand    :: Command
-  , optsConfigFile :: FilePath
-  }
-
-- | Command to execute and command-specific options.
-
-data Command
-  = Deploy (Maybe ReleaseFormat) (Maybe Natural) -- ^ Deploy a new release (with timestamp
-    -- format and how many releases to keep)
-  | Rollback Natural -- ^ Rollback to Nth previous release

 parserInfo :: ParserInfo Opts
 parserInfo =
@ -95,6 +80,10 @@ deployParser = Deploy
            <> help "How many releases to keep, default is '5'"
            )
        )
+  <*> switch
+        ( long "keep-one-failed"
+            <> help "Keep all failed releases or just one -the latest-, default (without using this flag) is to keep all failed releases."
+        )

 rollbackParser :: Parser Command
 rollbackParser = Rollback
@ -125,7 +114,7 @@ data Message

 main :: IO ()
 main = do
-  Opts {..} <- execParser parserInfo
+  Opts{..} <- execParser parserInfo
  C.Config{..} <- Yaml.loadYamlSettings [optsConfigFile] [] Yaml.useEnv
  chan <- newTChanIO
  let task rf = Task { taskDeployPath    = configDeployPath
@ -133,43 +122,55 @@ main = do
                     , taskReleaseFormat = rf }
  let printFnc dest str = atomically $
        writeTChan chan (PrintMsg dest str)
-      hap shell sshOpts =  do
+      hap shell sshOpts = do
        r <- Hap.runHapistrano sshOpts shell printFnc $
          case optsCommand of
-            Deploy cliReleaseFormat cliKeepReleases -> do
+            Deploy cliReleaseFormat cliKeepReleases cliKeepOneFailed ->
              let releaseFormat = fromMaybeReleaseFormat cliReleaseFormat configReleaseFormat
                  keepReleases = fromMaybeKeepReleases cliKeepReleases configKeepReleases
-              forM_ configRunLocally Hap.playScriptLocally
-              release <- if configVcAction
-                          then Hap.pushRelease (task releaseFormat)
-                          else Hap.pushReleaseWithoutVc (task releaseFormat)
-              rpath <- Hap.releasePath configDeployPath release configWorkingDir
-              forM_ (toMaybePath configSource) $ \src ->
-                Hap.scpDir src rpath
-              forM_ configCopyFiles $ \(C.CopyThing src dest) -> do
-                srcPath  <- resolveFile' src
-                destPath <- parseRelFile dest
-                let dpath = rpath </> destPath
-                (Hap.exec . Hap.MkDir . parent) dpath
-                Hap.scpFile srcPath dpath
-              forM_ configCopyDirs $ \(C.CopyThing src dest) -> do
-                srcPath  <- resolveDir' src
-                destPath <- parseRelDir dest
-                let dpath = rpath </> destPath
-                (Hap.exec . Hap.MkDir . parent) dpath
-                Hap.scpDir srcPath dpath
-              forM_ configLinkedFiles
-                (Hap.linkToShared configTargetSystem rpath configDeployPath)
-              forM_ configLinkedDirs
-                (Hap.linkToShared configTargetSystem rpath configDeployPath)
-              forM_ configBuildScript (Hap.playScript configDeployPath release configWorkingDir)
-              Hap.registerReleaseAsComplete configDeployPath release
-              Hap.activateRelease configTargetSystem configDeployPath release
-              Hap.dropOldReleases configDeployPath keepReleases
-              forM_ configRestartCommand Hap.exec
+                  keepOneFailed = cliKeepOneFailed || configKeepOneFailed
+                  -- We define the handler for when an exception happens inside a deployment
+                  failStateAndThrow e@(_, maybeRelease) = do
+                    case maybeRelease of
+                      (Just release) -> do
+                        createHapistranoDeployState configDeployPath release Fail
+                        Hap.dropOldReleases configDeployPath keepReleases keepOneFailed 
+                        throwError e
+                      Nothing -> do
+                        throwError e
+              in do
+                forM_ configRunLocally Hap.playScriptLocally
+                release <- if configVcAction
+                            then Hap.pushRelease (task releaseFormat)
+                            else Hap.pushReleaseWithoutVc (task releaseFormat)
+                rpath <- Hap.releasePath configDeployPath release configWorkingDir
+                forM_ (toMaybePath configSource) $ \src ->
+                  Hap.scpDir src rpath (Just release)
+                forM_ configCopyFiles $ \(C.CopyThing src dest) -> do
+                  srcPath  <- resolveFile' src
+                  destPath <- parseRelFile dest
+                  let dpath = rpath </> destPath
+                  (flip Hap.exec (Just release) . Hap.MkDir . parent) dpath
+                  Hap.scpFile srcPath dpath (Just release)
+                forM_ configCopyDirs $ \(C.CopyThing src dest) -> do
+                  srcPath  <- resolveDir' src
+                  destPath <- parseRelDir dest
+                  let dpath = rpath </> destPath
+                  (flip Hap.exec (Just release) . Hap.MkDir . parent) dpath
+                  Hap.scpDir srcPath dpath (Just release)
+                forM_ configLinkedFiles
+                  $ flip (Hap.linkToShared configTargetSystem rpath configDeployPath) (Just release)
+                forM_ configLinkedDirs
+                  $ flip (Hap.linkToShared configTargetSystem rpath configDeployPath) (Just release)
+                forM_ configBuildScript (Hap.playScript configDeployPath release configWorkingDir)
+                Hap.activateRelease configTargetSystem configDeployPath release
+                forM_ configRestartCommand (flip Hap.exec $ Just release)
+                Hap.createHapistranoDeployState configDeployPath release System.Hapistrano.Types.Success
+                Hap.dropOldReleases configDeployPath keepReleases keepOneFailed 
+              `catchError` failStateAndThrow
            Rollback n -> do
              Hap.rollback configTargetSystem configDeployPath n
-              forM_ configRestartCommand Hap.exec
+              forM_ configRestartCommand (flip Hap.exec Nothing)
        atomically (writeTChan chan FinishMsg)
        return r
      printer :: Int -> IO ()
@ -187,7 +188,7 @@ main = do
        case configHosts of
          [] -> [hap Bash Nothing] -- localhost, no SSH
          xs ->
-            let runHap (C.Target{..}) =
+            let runHap C.Target{..} =
                  hap targetShell (Just $ SshOptions targetHost targetPort targetSshArgs)
            in runHap <$> xs
  results <- (runConcurrently . traverse Concurrently)
--- a/example/example.cabal
+++ b/example/example.cabal
@ -5,7 +5,7 @@ description:
  This is an example project that has been created in order to test
  the deployment process using the working_dir feature of hapistrano.
 author:         Justin Leitgeb
-maintainer:     jpaucar@stackbuilders.com
+maintainer:     cmotoche@stackbuilders.com
 copyright:      2015-Present Stack Builders Inc.
 license:        MIT
 license-file:   ../LICENSE
--- a/hapistrano.cabal
+++ b/hapistrano.cabal
@ -21,7 +21,7 @@ description:
 license:             MIT
 license-file:        LICENSE
 author:              Justin Leitgeb
-maintainer:          jpaucar@stackbuilders.com
+maintainer:          cmotoche@stackbuilders.com
 copyright:           2015-Present Stack Builders Inc.
 category:            System
 homepage:            https://github.com/stackbuilders/hapistrano
@ -82,6 +82,7 @@ executable hap
                     , formatting         >= 6.2 && < 8.0
                     , gitrev             >= 1.2 && < 1.4
                     , hapistrano
+                     , mtl                >= 2.0 && < 3.0
                     , optparse-applicative >= 0.11 && < 0.17
                     , path               >= 0.5 && < 0.9
                     , path-io            >= 1.2 && < 1.7
--- a/spec/System/HapistranoConfigSpec.hs
+++ b/spec/System/HapistranoConfigSpec.hs
@ -62,5 +62,6 @@ defaultConfiguration =
    , configTargetSystem = GNULinux
    , configReleaseFormat = Nothing
    , configKeepReleases = Nothing
+    , configKeepOneFailed = False
    , configWorkingDir = Nothing
    }
--- a/spec/System/HapistranoSpec.hs
+++ b/spec/System/HapistranoSpec.hs
@ -1,5 +1,6 @@
 {-# LANGUAGE CPP             #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}

 module System.HapistranoSpec
  ( spec
@ -11,9 +12,9 @@ import Data.List (isPrefixOf)
 import Data.Maybe (mapMaybe)
 import Numeric.Natural
 import Path
-#if !MIN_VERSION_base(4,13,0)
-import Path.Internal (Path(..))
-#endif
+
+
+

 import Path.IO
 import System.Directory (getCurrentDirectory, listDirectory)
@ -27,7 +28,9 @@ import System.Info (os)
 import Test.Hspec hiding (shouldBe, shouldReturn)
 import qualified Test.Hspec as Hspec
 import Test.Hspec.QuickCheck
-import Test.QuickCheck
+import Test.QuickCheck hiding (Success)
+import System.Hapistrano (releasePath)
+import System.Hapistrano.Config (deployStateFilename)

 testBranchName :: String
 testBranchName = "another_branch"
@ -46,7 +49,7 @@ spec = do
    let (Just commandTest) =
          Hap.mkGenericCommand
            "echo \"hapistrano\"; sleep 2; echo \"onartsipah\""
-        commandExecution = Hap.execWithInheritStdout commandTest
+        commandExecution = Hap.execWithInheritStdout commandTest Nothing
        expectedOutput = "hapistrano\nonartsipah"
     in do actualOutput <- capture_ (runHap commandExecution)
           expectedOutput `Hspec.shouldSatisfy` (`isPrefixOf` actualOutput)
@ -154,14 +157,25 @@ spec = do
            ("test `git rev-parse --abbrev-ref HEAD` = " ++ testBranchName)
        -- This fails if there are unstaged changes
          justExec rpath "git diff --exit-code"
-    describe "registerReleaseAsComplete" $
-      it "creates the token all right" $ \(deployPath, repoPath) ->
+    describe "createHapistranoDeployState" $ do
+      it ("creates the " <> deployStateFilename <> " file correctly") $ \(deployPath, repoPath) ->
        runHap $ do
          let task = mkTask deployPath repoPath
          release <- Hap.pushRelease task
-          Hap.registerReleaseAsComplete deployPath release
-          (Hap.ctokenPath deployPath release >>= doesFileExist) `shouldReturn`
+          parseStatePath <- parseRelFile deployStateFilename
+          actualReleasePath <- releasePath deployPath release Nothing
+          let stateFilePath = actualReleasePath </> parseStatePath
+          Hap.createHapistranoDeployState deployPath release Success
+          Path.IO.doesFileExist stateFilePath `shouldReturn`
            True
+      it "when created in a successful deploy, the contents are \"Success\"" $ \(deployPath, repoPath) ->
+        runHap $ do
+          let task = mkTask deployPath repoPath
+          release <- Hap.pushRelease task
+          Hap.createHapistranoDeployState deployPath release Success
+          Hap.deployState deployPath Nothing release `shouldReturn`
+            Success
+
    describe "activateRelease" $
      it "creates the ‘current’ symlink correctly" $ \(deployPath, repoPath) ->
        runHap $ do
@ -172,8 +186,8 @@ spec = do
          let rc :: Hap.Readlink Dir
              rc =
                Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
-          Hap.exec rc `shouldReturn` rpath
-          doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False
+          Hap.exec rc (Just release) `shouldReturn` rpath
+          Path.IO.doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False
    describe "playScriptLocally (successful run)" $
      it "check that local scripts are run and deployment is successful" $ \(deployPath, repoPath) ->
        runHap $ do
@ -181,8 +195,11 @@ spec = do
              task = mkTask deployPath repoPath
          Hap.playScriptLocally localCommands
          release <- Hap.pushRelease task
-          Hap.registerReleaseAsComplete deployPath release
-          (Hap.ctokenPath deployPath release >>= doesFileExist) `shouldReturn`
+          parseStatePath <- parseRelFile deployStateFilename
+          actualReleasePath <- releasePath deployPath release Nothing
+          let stateFilePath = actualReleasePath </> parseStatePath
+          Hap.createHapistranoDeployState deployPath release Success
+          Path.IO.doesFileExist stateFilePath `shouldReturn`
            True
    describe "playScriptLocally (error exit)" $
      it "check that deployment isn't done" $ \(deployPath, repoPath) ->
@ -192,55 +209,51 @@ spec = do
               task = mkTask deployPath repoPath
           Hap.playScriptLocally localCommands
           release <- Hap.pushRelease task
-           Hap.registerReleaseAsComplete deployPath release) `shouldThrow`
+           Hap.createHapistranoDeployState deployPath release Success) `shouldThrow`
        anyException
    describe "rollback" $ do
-      context "without completion tokens" $
-        it "resets the ‘current’ symlink correctly" $ \(deployPath, repoPath) ->
-          runHap $ do
-            let task = mkTask deployPath repoPath
-            rs <- replicateM 5 (Hap.pushRelease task)
-            Hap.rollback currentSystem deployPath 2
-            rpath <- Hap.releasePath deployPath (rs !! 2) Nothing
-            let rc :: Hap.Readlink Dir
-                rc =
-                  Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
-            Hap.exec rc `shouldReturn` rpath
-            doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False
-      context "with completion tokens" $
-        it "resets the ‘current’ symlink correctly" $ \(deployPath, repoPath) ->
-          runHap $ do
-            let task = mkTask deployPath repoPath
-            rs <- replicateM 5 (Hap.pushRelease task)
-            forM_ (take 3 rs) (Hap.registerReleaseAsComplete deployPath)
-            Hap.rollback currentSystem deployPath 2
-            rpath <- Hap.releasePath deployPath (rs !! 0) Nothing
-            let rc :: Hap.Readlink Dir
-                rc =
-                  Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
-            Hap.exec rc `shouldReturn` rpath
-            doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False
-    describe "dropOldReleases" $
+      it "resets the ‘current’ symlink correctly" $ \(deployPath, repoPath) ->
+        runHap $ do
+          let task = mkTask deployPath repoPath
+          rs <- replicateM 5 (Hap.pushRelease task)
+          Hap.rollback currentSystem deployPath 2
+          rpath <- Hap.releasePath deployPath (rs !! 2) Nothing
+          let rc :: Hap.Readlink Dir
+              rc =
+                Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
+          Hap.exec rc Nothing `shouldReturn` rpath
+          Path.IO.doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False
+    describe "dropOldReleases" $ do
      it "works" $ \(deployPath, repoPath) ->
        runHap $ do
          rs <-
            replicateM 7 $ do
              r <- Hap.pushRelease (mkTask deployPath repoPath)
-              Hap.registerReleaseAsComplete deployPath r
+              Hap.createHapistranoDeployState deployPath r Success
              return r
-          Hap.dropOldReleases deployPath 5
-        -- two oldest releases should not survive:
+          Hap.dropOldReleases deployPath 5 False
+          -- two oldest releases should not survive:
          forM_ (take 2 rs) $ \r ->
            (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` False
-        -- 5 most recent releases should stay alive:
+          -- 5 most recent releases should stay alive:
          forM_ (drop 2 rs) $ \r ->
            (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` True
-        -- two oldest completion tokens should not survive:
-          forM_ (take 2 rs) $ \r ->
-            (Hap.ctokenPath deployPath r >>= doesFileExist) `shouldReturn` False
-        -- 5 most recent completion tokens should stay alive:
-          forM_ (drop 2 rs) $ \r ->
-            (Hap.ctokenPath deployPath r >>= doesFileExist) `shouldReturn` True
+      context "when the --keep-one-failed flag is active" $
+        it "should delete failed releases other than the most recent" $ \(deployPath, repoPath) ->
+          let successfulRelease = mkReleaseWithState deployPath repoPath Success 
+              failedRelease = mkReleaseWithState deployPath repoPath Fail in
+          runHap $ do
+            rs <- sequence [successfulRelease, successfulRelease, failedRelease, failedRelease, failedRelease]
+            Hap.dropOldReleases deployPath 5 True
+            -- The two successful releases should survive
+            forM_ (take 2 rs) $ \r ->
+              (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` True
+            -- The latest failed release should survive:
+            forM_ (drop 4 rs) $ \r ->
+              (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` True
+            -- The two older failed releases should not survive:
+            forM_ (take 2 . drop 2 $ rs) $ \r ->
+              (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` False
    describe "linkToShared" $ do
      context "when the deploy_path/shared directory doesn't exist" $
        it "should create the link anyway" $ \(deployPath, repoPath) ->
@ -249,8 +262,8 @@ spec = do
                sharedDir = Hap.sharedPath deployPath
            release <- Hap.pushRelease task
            rpath <- Hap.releasePath deployPath release Nothing
-            Hap.exec $ Hap.Rm sharedDir
-            Hap.linkToShared currentSystem rpath deployPath "thing" `shouldReturn`
+            Hap.exec (Hap.Rm sharedDir) (Just release)
+            Hap.linkToShared currentSystem rpath deployPath "thing" (Just release) `shouldReturn`
              ()
      context "when the file/directory to link exists in the repository" $
        it "should throw an error" $ \(deployPath, repoPath) ->
@ -258,7 +271,7 @@ spec = do
            (do let task = mkTask deployPath repoPath
                release <- Hap.pushRelease task
                rpath <- Hap.releasePath deployPath release Nothing
-                Hap.linkToShared currentSystem rpath deployPath "foo.txt") `shouldThrow`
+                Hap.linkToShared currentSystem rpath deployPath "foo.txt" $ Just release) `shouldThrow`
          anyException
      context "when it attempts to link a file" $ do
        context "when the file is not at the root of the shared directory" $
@ -270,7 +283,7 @@ spec = do
                  rpath <- Hap.releasePath deployPath release Nothing
                  justExec sharedDir "mkdir foo/"
                  justExec sharedDir "echo 'Bar!' > foo/bar.txt"
-                  Hap.linkToShared currentSystem rpath deployPath "foo/bar.txt") `shouldThrow`
+                  Hap.linkToShared currentSystem rpath deployPath "foo/bar.txt" $ Just release) `shouldThrow`
            anyException
        context "when the file is at the root of the shared directory" $
          it "should link the file successfully" $ \(deployPath, repoPath) ->
@ -280,7 +293,7 @@ spec = do
              release <- Hap.pushRelease task
              rpath <- Hap.releasePath deployPath release Nothing
              justExec sharedDir "echo 'Bar!' > bar.txt"
-              Hap.linkToShared currentSystem rpath deployPath "bar.txt"
+              Hap.linkToShared currentSystem rpath deployPath "bar.txt" (Just release)
              (liftIO . readFile . fromAbsFile)
                (rpath </> $(mkRelFile "bar.txt")) `shouldReturn`
                "Bar!\n"
@ -295,7 +308,7 @@ spec = do
                  justExec sharedDir "mkdir foo/"
                  justExec sharedDir "echo 'Bar!' > foo/bar.txt"
                  justExec sharedDir "echo 'Baz!' > foo/baz.txt"
-                  Hap.linkToShared currentSystem rpath deployPath "foo/") `shouldThrow`
+                  Hap.linkToShared currentSystem rpath deployPath "foo/" $ Just release) `shouldThrow`
            anyException
        it "should link the file successfully" $ \(deployPath, repoPath) ->
          runHap $ do
@ -306,7 +319,7 @@ spec = do
            justExec sharedDir "mkdir foo/"
            justExec sharedDir "echo 'Bar!' > foo/bar.txt"
            justExec sharedDir "echo 'Baz!' > foo/baz.txt"
-            Hap.linkToShared currentSystem rpath deployPath "foo"
+            Hap.linkToShared currentSystem rpath deployPath "foo" (Just release)
            files <-
              (liftIO . listDirectory . fromAbsDir)
                (rpath </> $(mkRelDir "foo"))
@ -359,8 +372,8 @@ populateTestRepo path =
 justExec :: Path Abs Dir -> String -> Hapistrano ()
 justExec path cmd' =
  case Hap.mkGenericCommand cmd' of
-    Nothing -> Hap.failWith 1 (Just $ "Failed to parse the command: " ++ cmd')
-    Just cmd -> Hap.exec (Hap.Cd path cmd)
+    Nothing -> Hap.failWith 1 (Just $ "Failed to parse the command: " ++ cmd') Nothing
+    Just cmd -> Hap.exec (Hap.Cd path cmd) Nothing

 -- | Run 'Hapistrano' monad locally.
 runHap :: Hapistrano a -> IO a
@ -398,6 +411,14 @@ mkTaskWithCustomRevision deployPath repoPath revision =
    , taskReleaseFormat = ReleaseLong
    }

+-- | Creates a release tagged with 'Success' or 'Fail'
+
+mkReleaseWithState :: Path Abs Dir -> Path Abs Dir -> DeployState -> Hapistrano Release
+mkReleaseWithState deployPath repoPath state = do
+  r <- Hap.pushRelease (mkTask deployPath repoPath)
+  Hap.createHapistranoDeployState deployPath r state
+  return r
+
 currentSystem :: TargetSystem
 currentSystem =
  if os == "linux"
--- a/src/System/Hapistrano.hs
+++ b/src/System/Hapistrano.hs
@ -15,11 +15,12 @@
 {-# LANGUAGE TemplateHaskell     #-}

 module System.Hapistrano
-  ( pushRelease
+  ( runHapistrano
+  , pushRelease
  , pushReleaseWithoutVc
-  , registerReleaseAsComplete
  , activateRelease
  , linkToShared
+  , createHapistranoDeployState
  , rollback
  , dropOldReleases
  , playScript
@ -29,14 +30,14 @@ module System.Hapistrano
  , sharedPath
  , currentSymlinkPath
  , tempSymlinkPath
-  , ctokenPath )
+  , deployState )
 where

 import           Control.Monad
 import           Control.Monad.Except
-import           Control.Monad.Reader       (local)
+import           Control.Monad.Reader       (local, runReaderT)
 import           Data.List                  (dropWhileEnd, genericDrop, sortOn)
-import           Data.Maybe                 (mapMaybe)
+import           Data.Maybe                 (mapMaybe, fromMaybe)
 import           Data.Ord                   (Down (..))
 import           Data.Time
 import           Numeric.Natural
@ -44,8 +45,35 @@ import           Path
 import           System.Hapistrano.Commands
 import           System.Hapistrano.Core
 import           System.Hapistrano.Types
+import           System.Hapistrano.Config (deployStateFilename)
+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 sshOptions shell' printFnc m =
+  liftIO $ do
+    let config =
+          Config
+            { configSshOptions = sshOptions
+            , configShellOptions = shell'
+            , configPrint = printFnc
+            }
+    r <- runReaderT (runExceptT m) config
+    case r of
+      Left (Failure n msg, _) -> do
+        forM_ msg (printFnc StderrDest)
+        return (Left n)
+      Right x -> return (Right x)
+
 -- High-level functionality

 -- | Perform basic setup for a project, making sure necessary directories
@ -60,7 +88,7 @@ pushRelease Task {..} = do
    -- When the configuration is set for a local directory, it will only create
    -- the release directory without any version control operations.
    pushReleaseForRepository GitRepository {..} = do
-      ensureCacheInPlace gitRepositoryURL taskDeployPath
+      ensureCacheInPlace gitRepositoryURL taskDeployPath Nothing
      release <- newRelease taskReleaseFormat
      cloneToRelease taskDeployPath release
      setReleaseRevision taskDeployPath release gitRepositoryRevision
@ -76,17 +104,6 @@ pushReleaseWithoutVc Task {..} = do
  setupDirs taskDeployPath
  newRelease 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 deployPath release = do
-  cpath <- ctokenPath deployPath release
-  exec (Touch cpath)
-
 -- | Switch the current symlink to point to the specified release. May be
 -- used in deploy or rollback cases.

@ -99,8 +116,23 @@ activateRelease ts deployPath release = do
  rpath <- releasePath deployPath release Nothing
  let tpath = tempSymlinkPath deployPath
      cpath = currentSymlinkPath deployPath
-  exec (Ln ts rpath tpath) -- create a symlink for the new candidate
-  exec (Mv ts tpath cpath) -- atomically replace the symlink
+  exec (Ln ts rpath tpath) (Just release) -- create a symlink for the new candidate
+  exec (Mv ts tpath cpath) (Just 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 deployPath release state = do
+  parseStatePath <- parseRelFile deployStateFilename 
+  actualReleasePath <- releasePath deployPath release Nothing
+  let stateFilePath = actualReleasePath </> parseStatePath
+  exec (Touch stateFilePath) (Just release) -- creates '.hapistrano_deploy_state'
+  exec (BasicWrite stateFilePath $ show state) (Just release) -- writes the deploy state to '.hapistrano_deploy_state'

 -- | Activates one of already deployed releases.

@ -110,14 +142,9 @@ rollback
  -> Natural           -- ^ How many releases back to go, 0 re-activates current
  -> Hapistrano ()
 rollback ts deployPath n = do
-  crs <- completedReleases deployPath
-  drs <- deployedReleases  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 genericDrop n (if null crs then drs else crs) of
-    [] -> failWith 1 (Just "Could not find the requested release to rollback to.")
+  releases <- releasesWithState Success deployPath
+  case genericDrop n releases of
+    [] -> failWith 1 (Just "Could not find the requested release to rollback to.") Nothing
    (x:_) -> activateRelease ts deployPath x

 -- | Remove older releases to avoid filling up the target host filesystem.
@ -125,16 +152,19 @@ rollback ts deployPath n = do
 dropOldReleases
  :: Path Abs Dir      -- ^ Deploy path
  -> Natural           -- ^ How many releases to keep
-  -> Hapistrano ()     -- ^ Deleted Releases
-dropOldReleases deployPath n = do
+  -> Bool              -- ^ Whether the @--keep-one-failed@ flag is present or not
+  -> Hapistrano ()
+dropOldReleases deployPath n keepOneFailed = do
+  failedReleases <- releasesWithState Fail deployPath
+  when (keepOneFailed && length failedReleases > 1) $
+    -- Remove every failed release except the most recent one
+    forM_ (tail failedReleases) $ \release -> do
+      rpath <- releasePath deployPath release Nothing
+      exec (Rm rpath) Nothing
  dreleases <- deployedReleases deployPath
  forM_ (genericDrop n dreleases) $ \release -> do
    rpath <- releasePath deployPath release Nothing
-    exec (Rm rpath)
-  creleases <- completedReleases deployPath
-  forM_ (genericDrop n creleases) $ \release -> do
-    cpath <- ctokenPath  deployPath release
-    exec (Rm cpath)
+    exec (Rm rpath) Nothing

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

@ -146,18 +176,18 @@ playScript
  -> Hapistrano ()
 playScript deployDir release mWorkingDir cmds = do
  rpath <- releasePath deployDir release mWorkingDir
-  forM_ cmds (execWithInheritStdout . Cd rpath)
+  forM_ cmds (flip execWithInheritStdout (Just release) . Cd rpath)

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

-playScriptLocally :: [GenericCommand] -> Hapistrano ()
+playScriptLocally :: [GenericCommand] ->  Hapistrano ()
 playScriptLocally cmds =
  local
    (\c ->
        c
        { configSshOptions = Nothing
        }) $
-  forM_ cmds execWithInheritStdout
+  forM_ cmds $ flip execWithInheritStdout Nothing

 ----------------------------------------------------------------------------
 -- Helpers
@ -168,10 +198,9 @@ setupDirs
  :: Path Abs Dir      -- ^ Deploy path
  -> Hapistrano ()
 setupDirs deployPath = do
-  (exec . MkDir . releasesPath)  deployPath
-  (exec . MkDir . cacheRepoPath) deployPath
-  (exec . MkDir . ctokensPath)   deployPath
-  (exec . MkDir . sharedPath)    deployPath
+  (flip exec Nothing . MkDir . releasesPath)  deployPath
+  (flip exec Nothing . MkDir . cacheRepoPath) deployPath
+  (flip exec Nothing . MkDir . sharedPath)    deployPath

 -- | Ensure that the specified repo is cloned and checked out on the given
 -- revision. Idempotent.
@ -179,17 +208,18 @@ setupDirs deployPath = do
 ensureCacheInPlace
  :: String            -- ^ Repo URL
  -> Path Abs Dir      -- ^ Deploy path
+  -> Maybe Release     -- ^ Release that was being attempted, if it was defined 
  -> Hapistrano ()
-ensureCacheInPlace repo deployPath = do
+ensureCacheInPlace repo deployPath maybeRelease = do
  let cpath = cacheRepoPath deployPath
      refs  = cpath </> $(mkRelDir "refs")
-  exists <- (exec (Ls refs) >> return True)
+  exists <- (exec (Ls refs) Nothing >> return True)
    `catchError` const (return False)
  unless exists $
-    exec (GitClone True (Left repo) cpath)
-  exec (Cd cpath (GitFetch "origin")) -- TODO store this in task description?
+    exec (GitClone True (Left repo) cpath) maybeRelease
+  exec (Cd cpath (GitFetch "origin")) maybeRelease -- TODO store this in task description?

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

 newRelease :: ReleaseFormat -> Hapistrano Release
 newRelease releaseFormat =
@ -204,7 +234,7 @@ cloneToRelease
 cloneToRelease deployPath release = do
  rpath <- releasePath deployPath release Nothing
  let cpath = cacheRepoPath deployPath
-  exec (GitClone False (Right cpath) rpath)
+  exec (GitClone False (Right cpath) rpath) (Just release)

 -- | Set the release to the correct revision by checking out a branch or
 -- a commit.
@ -216,7 +246,7 @@ setReleaseRevision
  -> Hapistrano ()
 setReleaseRevision deployPath release revision = do
  rpath <- releasePath deployPath release Nothing
-  exec (Cd rpath (GitCheckout revision))
+  exec (Cd rpath (GitCheckout revision)) (Just release)

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

@ -225,22 +255,27 @@ deployedReleases
  -> Hapistrano [Release]
 deployedReleases deployPath = do
  let rpath = releasesPath deployPath
-  xs <- exec (Find 1 rpath :: Find Dir)
+  xs <- exec (Find 1 rpath :: Find Dir) Nothing
  ps <- stripDirs rpath (filter (/= rpath) xs)
  (return . sortOn Down . mapMaybe parseRelease)
    (dropWhileEnd (== '/') . fromRelDir <$> ps)

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

-completedReleases
-  :: Path Abs Dir      -- ^ Deploy path
+releasesWithState
+  :: DeployState       -- ^ Selector for failed or successful releases
+  -> Path Abs Dir      -- ^ Deploy path
  -> Hapistrano [Release]
-completedReleases deployPath = do
-  let cpath = ctokensPath deployPath
-  xs <- exec (Find 1 cpath :: Find File)
-  ps <- stripDirs cpath xs
-  (return . sortOn Down . mapMaybe parseRelease)
-    (dropWhileEnd (== '/') . fromRelFile <$> ps)
+releasesWithState selectedState deployPath = do
+  releases <- deployedReleases deployPath
+  filterM (
+    fmap ((\bool -> if selectedState == Success then bool else not bool) . stateToBool)
+     . deployState deployPath Nothing
+    ) releases
+  where
+    stateToBool :: DeployState -> Bool
+    stateToBool Fail = False
+    stateToBool _ = True

 ----------------------------------------------------------------------------
 -- Path helpers
@ -268,12 +303,13 @@ linkToShared
  -> 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 configTargetSystem rpath configDeployPath thingToLink = do
+linkToShared configTargetSystem rpath configDeployPath thingToLink maybeRelease = do
  destPath <- parseRelFile thingToLink
  let dpath = rpath </> destPath
      sharedPath' = sharedPath configDeployPath </> destPath
-  exec $ Ln configTargetSystem sharedPath' dpath
+  exec (Ln configTargetSystem sharedPath' dpath) maybeRelease

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

@ -285,7 +321,7 @@ releasePath
 releasePath deployPath release mWorkingDir =
  let rendered = renderRelease release
  in case parseRelDir rendered of
-    Nothing    -> failWith 1 (Just $ "Could not append path: " ++ rendered)
+    Nothing    -> failWith 1 (Just $ "Could not append path: " ++ rendered) (Just release)
    Just rpath ->
      return $ case mWorkingDir of
        Nothing         -> releasesPath deployPath </> rpath
@ -313,24 +349,25 @@ tempSymlinkPath
  -> Path Abs File
 tempSymlinkPath deployPath = deployPath </> $(mkRelFile "current_tmp")

-- | Get path to the directory that contains tokens of build completion.
+-- | 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'.

-ctokensPath
-  :: Path Abs Dir      -- ^ Deploy path
-  -> Path Abs Dir
-ctokensPath deployPath = deployPath </> $(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 deployPath release = do
-  let rendered = renderRelease release
-  case parseRelFile rendered of
-    Nothing    -> failWith 1 (Just $ "Could not append path: " ++ rendered)
-    Just rpath -> return (ctokensPath deployPath </> rpath)
+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 deployPath mWorkingDir release = do
+  parseStatePath <- parseRelFile deployStateFilename
+  actualReleasePath <- releasePath deployPath release mWorkingDir
+  let stateFilePath = actualReleasePath </> parseStatePath
+  doesExist <- exec (CheckExists stateFilePath) (Just release)
+  if doesExist then do
+    deployStateContents <- exec (Cat stateFilePath) (Just release)
+    return $ (fromMaybe Unknown . readMaybe) deployStateContents
+  else return Unknown 

 stripDirs :: Path Abs Dir -> [Path Abs t] -> Hapistrano [Path Rel t]
 stripDirs path =
--- a/src/System/Hapistrano/Commands.hs
+++ b/src/System/Hapistrano/Commands.hs
@ -3,7 +3,7 @@
 -- Copyright   :  © 2015-Present Stack Builders
 -- License     :  MIT
 --
-- Maintainer  :  Juan Paucar <jpaucar@stackbuilders.com>
+-- Maintainer  :  Cristhian Motoche <cmotoche@stackbuilders.com>
 -- Stability   :  experimental
 -- Portability :  portable
 --
@ -26,6 +26,9 @@ module System.Hapistrano.Commands
  , Readlink(..)
  , Find(..)
  , Touch(..)
+  , Cat(..)
+  , CheckExists(..)
+  , BasicWrite(..)
  , GitCheckout(..)
  , GitClone(..)
  , GitFetch(..)
--- a/src/System/Hapistrano/Commands/Internal.hs
+++ b/src/System/Hapistrano/Commands/Internal.hs
@ -3,7 +3,7 @@
 -- Copyright   :  © 2015-Present Stack Builders
 -- License     :  MIT
 --
-- Maintainer  :  Juan Paucar <jpaucar@stackbuilders.com>
+-- Maintainer  :  Cristhian Motoche <cmotoche@stackbuilders.com>
 -- Stability   :  experimental
 -- Portability :  portable
 --
@ -67,7 +67,7 @@ instance Command cmd => Command (Cd cmd) where
  parseResult Proxy = parseResult (Proxy :: Proxy cmd)

 -- | Create a directory. Does not fail if the directory already exists.
-data MkDir =
+newtype MkDir =
  MkDir (Path Abs Dir)

 instance Command MkDir where
@ -151,7 +151,7 @@ instance Command (Readlink Dir) where

 -- | @ls@, so far used only to check existence of directories, so it's not
 -- very functional right now.
-data Ls =
+newtype Ls =
  Ls (Path Abs Dir)

 instance Command Ls where
@ -190,7 +190,7 @@ instance Command (Find File) where
  parseResult Proxy = mapMaybe (parseAbsFile . trim) . lines

 -- | @touch@.
-data Touch =
+newtype Touch =
  Touch (Path Abs File)

 instance Command Touch where
@ -198,8 +198,49 @@ instance Command Touch where
  renderCommand (Touch path) = formatCmd "touch" [Just (fromAbsFile path)]
  parseResult Proxy _ = ()

+-- | Command that checks for the existance of a particular
+-- file in the host.
+
+newtype CheckExists =
+  CheckExists
+  (Path Abs File) -- ^ The absolute path to the file you want to check for existence
+
+instance Command CheckExists where
+  type Result CheckExists = Bool
+  renderCommand (CheckExists path) = 
+    "([ -r " <> fromAbsFile path <> " ] && echo True) || echo False"
+  parseResult Proxy = read
+
+-- | Command used to read the contents of a particular
+-- file in the host.
+
+newtype Cat =
+  Cat
+  (Path Abs File) -- ^ The absolute path to the file you want to read
+
+instance Command Cat where
+  type Result Cat = String
+  renderCommand (Cat path) = formatCmd "cat" [Just (fromAbsFile path)]
+  parseResult Proxy = id 
+
+-- | Basic command that writes to a file some contents.
+-- It uses the @file > contents@ shell syntax and the @contents@ is
+-- represented as a 'String', so it shouldn't be used for
+-- bigger writing operations. Currently used to write @fail@ or @success@
+-- to the @.hapistrano_deploy_state@ file.
+data BasicWrite =
+  BasicWrite 
+  (Path Abs File) -- ^ The absolute path to the file to which you want to write
+  String -- ^ The contents that will be written to the file
+
+instance Command BasicWrite where
+  type Result BasicWrite = ()
+  renderCommand (BasicWrite path contents) =
+     "echo \"" <> contents <> "\"" <> " > " <> fromAbsFile path
+  parseResult Proxy _ = ()
+
 -- | Git checkout.
-data GitCheckout =
+newtype GitCheckout =
  GitCheckout String

 instance Command GitCheckout where
@ -230,7 +271,7 @@ instance Command GitClone where
  parseResult Proxy _ = ()

 -- | Git fetch (simplified).
-data GitFetch =
+newtype GitFetch =
  GitFetch String

 instance Command GitFetch where
@ -242,7 +283,7 @@ instance Command GitFetch where
  parseResult Proxy _ = ()

 -- | Git reset.
-data GitReset =
+newtype GitReset =
  GitReset String

 instance Command GitReset where
@ -252,7 +293,7 @@ instance Command GitReset where
  parseResult Proxy _ = ()

 -- | Weakly-typed generic command, avoid using it directly.
-data GenericCommand =
+newtype GenericCommand =
  GenericCommand String
  deriving (Show, Eq, Ord)

--- a/src/System/Hapistrano/Config.hs
+++ b/src/System/Hapistrano/Config.hs
@ -1,3 +1,14 @@
+-- |
+-- Module      :  System.Config
+-- Copyright   :  © 2015-Present Stack Builders
+-- License     :  MIT
+--
+-- Maintainer  :  Cristhian Motoche <cmotoche@stackbuilders.com>
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Definitions for types and functions related to the configuration
+-- of the Hapistrano tool.
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
@ -7,7 +18,8 @@
 module System.Hapistrano.Config
  ( Config (..)
  , CopyThing (..)
-  , Target (..))
+  , Target (..)
+  , deployStateFilename)
 where

 import           Control.Applicative        ((<|>))
@ -47,7 +59,7 @@ data Config = Config
  , configLinkedDirs       :: ![FilePath]
    -- ^ Collection of directories to link from each release to _shared_
  , configVcAction       :: !Bool
-  -- ^ Perform version control related actions. By default, it's assumed to be True.
+  -- ^ Perform version control related actions. By default, it's assumed to be `True`.
  , configRunLocally     :: !(Maybe [GenericCommand])
  -- ^ Perform a series of commands on the local machine before communication
  -- with target server starts
@ -55,13 +67,19 @@ data Config = Config
  -- ^ Optional parameter to specify the target system. It's GNU/Linux by
  -- default
  , configReleaseFormat  :: !(Maybe ReleaseFormat)
-  -- ^ The release timestamp format, the '--release-format' argument passed via
+  -- ^ The release timestamp format, the @--release-format@ argument passed via
  -- the CLI takes precedence over this value. If neither CLI or configuration
  -- file value is specified, it defaults to short
  , configKeepReleases   :: !(Maybe Natural)
-  -- ^ The number of releases to keep, the '--keep-releases' argument passed via
+  -- ^ The number of releases to keep, the @--keep-releases@ argument passed via
  -- the CLI takes precedence over this value. If neither CLI or configuration
  -- file value is specified, it defaults to 5
+  , configKeepOneFailed :: !Bool
+  -- ^ Specifies whether to keep all failed releases along with the successful releases
+  -- or just the latest failed (at least this one should be kept for debugging purposes).
+  -- The @--keep-one-failed@ argument passed via the CLI takes precedence over this value.
+  -- If neither CLI or configuration file value is specified, it defaults to `False` 
+  -- (i.e. keep all failed releases).
  , configWorkingDir :: !(Maybe (Path Rel Dir))
  } deriving (Eq, Ord, Show)

@ -71,6 +89,8 @@ data Config = Config
 data CopyThing = CopyThing FilePath FilePath
  deriving (Eq, Ord, Show)

+-- | Datatype that holds information about the target host.
+
 data Target =
  Target
    { targetHost    :: String
@ -116,6 +136,7 @@ instance FromJSON Config where
    configTargetSystem <- o .:? "linux" .!= GNULinux
    configReleaseFormat <- o .:? "release_format"
    configKeepReleases <- o .:? "keep_releases"
+    configKeepOneFailed <- o .:? "keep_one_failed" .!= False
    configWorkingDir <- o .:? "working_directory"
    return Config {..}

@ -134,3 +155,9 @@ mkCmd raw =
  case mkGenericCommand raw of
    Nothing  -> fail "invalid restart command"
    Just cmd -> return cmd
+
+-- | Constant with the name of the file used to store 
+-- the deployment state information.
+
+deployStateFilename :: String 
+deployStateFilename = ".hapistrano_deploy_state"
--- a/src/System/Hapistrano/Core.hs
+++ b/src/System/Hapistrano/Core.hs
@ -3,7 +3,7 @@
 -- Copyright   :  © 2015-Present Stack Builders
 -- License     :  MIT
 --
-- Maintainer  :  Juan Paucar <jpaucar@stackbuilders.com>
+-- Maintainer  :  Cristhian Motoche <cmotoche@stackbuilders.com>
 -- Stability   :  experimental
 -- Portability :  portable
 --
@ -14,8 +14,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}

 module System.Hapistrano.Core
-  ( runHapistrano
-  , failWith
+  ( failWith
  , exec
  , execWithInheritStdout
  , scpFile
@ -32,38 +31,14 @@ import           Path
 import           System.Console.ANSI
 import           System.Exit
 import           System.Hapistrano.Commands
-import           System.Hapistrano.Types
+import           System.Hapistrano.Types hiding (Command)
 import           System.Process
 import           System.Process.Typed       (ProcessConfig)
 import qualified System.Process.Typed       as SPT

-- | 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 sshOptions shell' printFnc m =
-  liftIO $ do
-    let config =
-          Config
-            { configSshOptions = sshOptions
-            , configShellOptions = shell'
-            , configPrint = printFnc
-            }
-    r <- runReaderT (runExceptT m) config
-    case r of
-      Left (Failure n msg) -> do
-        forM_ msg (printFnc StderrDest)
-        return (Left n)
-      Right x -> return (Right x)
-
 -- | Fail returning the following status code and message.
-failWith :: Int -> Maybe String -> Hapistrano a
-failWith n msg = throwError (Failure n msg)
+failWith :: Int -> Maybe String -> Maybe Release -> Hapistrano a
+failWith n msg maybeRelease = throwError (Failure n msg, maybeRelease)

 -- | Run the given sequence of command. Whether to use SSH or not is
 -- determined from settings contained in the 'Hapistrano' monad
@ -74,20 +49,25 @@ failWith n msg = throwError (Failure n msg)
 -- parse the result.
 exec ::
     forall a. Command a
-  => a
+  => a -- ^ Command being executed
+  -> Maybe Release -- ^ Release that was being attempted, if it was defined 
  -> Hapistrano (Result a)
-exec typedCmd = do
+exec typedCmd maybeRelease = do
  let cmd = renderCommand typedCmd
  (prog, args) <- getProgAndArgs cmd
  parseResult (Proxy :: Proxy a) <$>
-    exec' cmd (readProcessWithExitCode prog args "")
+    exec' cmd (readProcessWithExitCode prog args "") maybeRelease

 -- | Same as 'exec' but it streams to stdout only for _GenericCommand_s
-execWithInheritStdout :: Command a => a -> Hapistrano ()
-execWithInheritStdout typedCmd = do
+execWithInheritStdout ::
+     Command a 
+  => a -- ^ Command being executed
+  -> Maybe Release -- ^ Release that was being attempted, if it was defined 
+  -> Hapistrano ()
+execWithInheritStdout typedCmd maybeRelease = do
  let cmd = renderCommand typedCmd
  (prog, args) <- getProgAndArgs cmd
-  void $ exec' cmd (readProcessWithExitCode' (SPT.proc prog args))
+  void $ exec' cmd (readProcessWithExitCode' (SPT.proc prog args)) maybeRelease
    where
    -- | Prepares a process, reads @stdout@ and @stderr@ and returns exit code
    -- NOTE: @strdout@ and @stderr@ are empty string because we're writing
@ -120,6 +100,7 @@ getProgAndArgs cmd = do
 scpFile ::
     Path Abs File -- ^ Location of the file to copy
  -> Path Abs File -- ^ Where to put the file on target machine
+  -> Maybe Release -- ^ Release that was being attempted, if it was defined 
  -> Hapistrano ()
 scpFile src dest = scp' (fromAbsFile src) (fromAbsFile dest) ["-q"]

@ -127,11 +108,12 @@ scpFile src dest = scp' (fromAbsFile src) (fromAbsFile dest) ["-q"]
 scpDir ::
     Path Abs Dir -- ^ Location of the directory to copy
  -> Path Abs Dir -- ^ Where to put the dir on target machine
+  -> Maybe Release -- ^ Release that was being attempted, if it was defined 
  -> Hapistrano ()
 scpDir src dest = scp' (fromAbsDir src) (fromAbsDir dest) ["-qr"]

-scp' :: FilePath -> FilePath -> [String] -> Hapistrano ()
-scp' src dest extraArgs = do
+scp' :: FilePath -> FilePath -> [String] -> Maybe Release -> Hapistrano ()
+scp' src dest extraArgs maybeRelease = do
  Config {..} <- ask
  let prog = "scp"
      portArg =
@ -144,7 +126,7 @@ scp' src dest extraArgs = do
          Just x  -> x ++ ":"
      args = extraArgs ++ portArg ++ [src, hostPrefix ++ dest]
  void
-    (exec' (prog ++ " " ++ unwords args) (readProcessWithExitCode prog args ""))
+    (exec' (prog ++ " " ++ unwords args) (readProcessWithExitCode prog args "") maybeRelease)

 ----------------------------------------------------------------------------
 -- Helpers
@ -152,8 +134,9 @@ scp' src dest extraArgs = do
 exec' ::
     String -- ^ How to show the command in print-outs
  -> IO (ExitCode, String, String) -- ^ Handler to get (ExitCode, Output, Error) it can change accordingly to @stdout@ and @stderr@ of child process
+  -> Maybe Release -- ^ Release that was being attempted, if it was defined 
  -> Hapistrano String -- ^ Raw stdout output of that program
-exec' cmd readProcessOutput = do
+exec' cmd readProcessOutput maybeRelease = do
  Config {..} <- ask
  time <- liftIO getZonedTime
  let timeStampFormat = "%T,  %F (%Z)"
@ -171,7 +154,7 @@ exec' cmd readProcessOutput = do
  unless (null stderr') . liftIO $ configPrint StderrDest stderr'
  case exitCode' of
    ExitSuccess   -> return stdout'
-    ExitFailure n -> failWith n Nothing
+    ExitFailure n -> failWith n Nothing maybeRelease

 -- | Put something “inside” a line, sort-of beautifully.
 putLine :: String -> String
--- a/src/System/Hapistrano/Types.hs
+++ b/src/System/Hapistrano/Types.hs
@ -3,7 +3,7 @@
 -- Copyright   :  © 2015-Present Stack Builders
 -- License     :  MIT
 --
-- Maintainer  :  Juan Paucar <jpaucar@stackbuilders.com>
+-- Maintainer  :  Cristhian Motoche <cmotoche@stackbuilders.com>
 -- Stability   :  experimental
 -- Portability :  portable
 --
@ -22,7 +22,10 @@ module System.Hapistrano.Types
  , OutputDest(..)
  , Release
  , TargetSystem(..)
+  , DeployState(..)
  , Shell(..)
+  , Opts(..)
+  , Command(..)
  -- * Types helpers
  , mkRelease
  , releaseTime
@ -43,7 +46,7 @@ import Numeric.Natural
 import Path

 -- | Hapistrano monad.
-type Hapistrano a = ExceptT Failure (ReaderT Config IO) a
+type Hapistrano a = ExceptT (Failure, Maybe Release) (ReaderT Config IO) a

 -- | Failure with status code and a message.
 data Failure =
@ -133,12 +136,41 @@ data Release =
  Release ReleaseFormat UTCTime
  deriving (Eq, Show, Ord)

-- | Target's system where application will be deployed
+-- | Target's system where application will be deployed.
 data TargetSystem
  = GNULinux
  | BSD
  deriving (Eq, Show, Read, Ord, Bounded, Enum)

+-- | State of the deployment after running @hap deploy@.
+-- __note:__ the 'Unknown' value is not intended to be
+-- written to the @.hapistrano_deploy_state@ file; instead,
+-- it's intended to represent whenever Hapistrano couldn't
+-- get the information on the deployment state (e.g. the file is not present).
+data DeployState
+  = Fail
+  | Success
+  | Unknown
+  deriving (Eq, Show, Read, Ord, Bounded, Enum)
+
+-- Command line options
+
+-- | Command line options.
+
+data Opts = Opts
+  { optsCommand    :: Command
+  , optsConfigFile :: FilePath
+  }
+
+-- | Command to execute and command-specific options.
+
+data Command
+  = Deploy (Maybe ReleaseFormat) (Maybe Natural) Bool -- ^ Deploy a new release (with timestamp
+    -- format, how many releases to keep, and whether the failed releases except the latest one
+    -- get deleted or not)
+  | Rollback Natural -- ^ Rollback to Nth previous release
+
+
 -- | Create a 'Release' indentifier.
 mkRelease :: ReleaseFormat -> UTCTime -> Release
 mkRelease = Release