HapistranoSpec.hs

{-# LANGUAGE CPP             #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module System.HapistranoSpec
  ( spec
  ) where

import Control.Monad
import Control.Monad.Reader
import Data.List (isPrefixOf)
import Data.Maybe (mapMaybe)
import Numeric.Natural
import Path




import Path.IO
import System.Directory
    ( doesFileExist, getCurrentDirectory, listDirectory )
import qualified System.Hapistrano as Hap
import qualified System.Hapistrano.Commands as Hap
import qualified System.Hapistrano.Core as Hap
import System.Hapistrano.Types
import System.IO
import System.IO.Silently (capture_)
import System.Info (os)
import Test.Hspec hiding (shouldBe, shouldContain, shouldReturn)
import qualified Test.Hspec as Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck hiding (Success)
import System.Hapistrano (releasePath)
import System.Hapistrano.Config (deployStateFilename)
import System.Hapistrano.Maintenance

testBranchName :: String
testBranchName = "another_branch"

workingDir :: Path Rel Dir
workingDir = $(mkRelDir "working_dir")

releaseDir :: Path Rel Dir
releaseDir = $(mkRelDir "releases")

spec :: Spec
spec = do
  describe "execWithInheritStdout" $
    context "given a command that prints to stdout" $
    it "redirects commands' output to stdout first" $
    let (Just commandTest) =
          Hap.mkGenericCommand
            "echo \"hapistrano\"; sleep 2; echo \"onartsipah\""
        commandExecution = Hap.execWithInheritStdout commandTest Nothing
        expectedOutput = "hapistrano\nonartsipah"
     in do actualOutput <- capture_ (runHap commandExecution)
           expectedOutput `Hspec.shouldSatisfy` (`isPrefixOf` actualOutput)
  describe "readScript" $
    it "performs all the necessary normalizations correctly" $ do
      spath <- do
        currentDirectory <- getCurrentDirectory >>= parseAbsDir
        scriptFile <- parseRelFile "script/clean-build.sh"
        return (currentDirectory </> scriptFile)
      (fmap Hap.unGenericCommand <$> Hap.readScript spath) `Hspec.shouldReturn`
        [ "export PATH=~/.cabal/bin:/usr/local/bin:$PATH"
        , "cabal sandbox delete"
        , "cabal sandbox init"
        , "cabal clean"
        , "cabal update"
        , "cabal install --only-dependencies -j"
        , "cabal build -j"
        ]
  describe "fromMaybeReleaseFormat" $ do
    context "when the command line value is present" $ do
      context "and the config file value is present" $
        prop "returns the command line value" $
        forAll ((,) <$> arbitraryReleaseFormat <*> arbitraryReleaseFormat) $ \(rf1, rf2) ->
          fromMaybeReleaseFormat (Just rf1) (Just rf2) `Hspec.shouldBe` rf1
      context "and the config file value is not present" $
        prop "returns the command line value" $
        forAll arbitraryReleaseFormat $ \rf ->
          fromMaybeReleaseFormat (Just rf) Nothing `Hspec.shouldBe` rf
    context "when the command line value is not present" $ do
      context "and the config file value is present" $
        prop "returns the config file value" $
        forAll arbitraryReleaseFormat $ \rf ->
          fromMaybeReleaseFormat Nothing (Just rf) `Hspec.shouldBe` rf
      context "and the config file value is not present" $
        it "returns the default value" $
        fromMaybeReleaseFormat Nothing Nothing `Hspec.shouldBe` ReleaseShort
  describe "fromMaybeKeepReleases" $ do
    context "when the command line value is present" $ do
      context "and the config file value is present" $
        prop "returns the command line value" $
        forAll ((,) <$> arbitraryKeepReleases <*> arbitraryKeepReleases) $ \(kr1, kr2) ->
          fromMaybeKeepReleases (Just kr1) (Just kr2) `Hspec.shouldBe` kr1
      context "and the second value is not present" $
        prop "returns the command line value" $
        forAll arbitraryKeepReleases $ \kr ->
          fromMaybeKeepReleases (Just kr) Nothing `Hspec.shouldBe` kr
    context "when the command line value is not present" $ do
      context "and the config file value is present" $
        prop "returns the config file value" $
        forAll arbitraryKeepReleases $ \kr ->
          fromMaybeKeepReleases Nothing (Just kr) `Hspec.shouldBe` kr
      context "and the config file value is not present" $
        it "returns the default value" $
        fromMaybeKeepReleases Nothing Nothing `Hspec.shouldBe` 5
  around withSandbox $ do
    describe "writeMaintenanceFile" $
      context "when the file doesn't exist" $
        it "creates the maintenance file in the given path" $ \(deployPath, _) -> do
          result <- runHap $ do
            writeMaintenanceFile deployPath $(mkRelDir "maintenance") $(mkRelFile "maintenance.html")
            liftIO $ System.Directory.doesFileExist ((fromAbsDir deployPath) <> "/maintenance/maintenance.html")
          result `shouldBe` True
    describe "deleteMaintenanceFile" $
      context "when the file exists" $
        it "removes the maintenance file from the given path" $ \(deployPath, _) -> do
          result <- runHap $ do
            writeMaintenanceFile deployPath $(mkRelDir "maintenance") $(mkRelFile "maintenance.html")
            deleteMaintenanceFile deployPath $(mkRelDir "maintenance") $(mkRelFile "maintenance.html")
            liftIO $ System.Directory.doesFileExist ((fromAbsDir deployPath) <> "/maintenance/maintenance.html")
          result `shouldBe` False
    describe "releasePath" $ do
      context "when the configWorkingDir is Nothing" $
        it "should return the release path" $ \(deployPath, repoPath) -> do
          (rpath, release) <- runHap $ do
            release <- Hap.pushRelease $ mkTask deployPath repoPath
            (,) <$> Hap.releasePath deployPath release Nothing
                <*> pure release

          rel <- parseRelDir $ renderRelease release
          rpath `shouldBe` deployPath </> releaseDir </> rel

      context "when the configWorkingDir is Just" $
        it "should return the release path with WorkingDir" $ \(deployPath, repoPath) -> do
          (rpath, release) <- runHap $ do
            release <- Hap.pushRelease $ mkTask deployPath repoPath
            (,) <$> Hap.releasePath deployPath release (Just workingDir)
                <*> pure release

          rel <- parseRelDir $ renderRelease release
          rpath `shouldBe` deployPath </> releaseDir </> rel </> workingDir

    describe "pushRelease" $ do
      it "sets up repo all right in Zsh" $ \(deployPath, repoPath) ->
        runHapWithShell Zsh $ do
          let task = mkTask deployPath repoPath
          release <- Hap.pushRelease task
          rpath <- Hap.releasePath deployPath release Nothing
        -- let's check that the dir exists and contains the right files
          (liftIO . readFile . fromAbsFile) (rpath </> $(mkRelFile "foo.txt")) `shouldReturn`
            "Foo!\n"
      it "sets up repo all right" $ \(deployPath, repoPath) ->
        runHap $ do
          let task = mkTask deployPath repoPath
          release <- Hap.pushRelease task
          rpath <- Hap.releasePath deployPath release Nothing
        -- let's check that the dir exists and contains the right files
          (liftIO . readFile . fromAbsFile) (rpath </> $(mkRelFile "foo.txt")) `shouldReturn`
            "Foo!\n"
      it "deploys properly a branch other than master" $ \(deployPath, repoPath) ->
        runHap $ do
          let task = mkTaskWithCustomRevision deployPath repoPath testBranchName
          release <- Hap.pushRelease task
          rpath <- Hap.releasePath deployPath release Nothing
        -- let's check that the dir exists and contains the right files
          (liftIO . readFile . fromAbsFile) (rpath </> $(mkRelFile "bar.txt")) `shouldReturn`
            "Bar!\n"
        -- This fails if the opened branch is not testBranchName
          justExec
            rpath
            ("test `git rev-parse --abbrev-ref HEAD` = " ++ testBranchName)
        -- This fails if there are unstaged changes
          justExec rpath "git diff --exit-code"
      it "updates the origin url when it's changed" $ \(deployPath, repoPath) ->
        runHap $ do
          let tempDirPrefix = "hap-test-repotwo"
          withSystemTempDir tempDirPrefix $ \repoPathTwo -> do
            let task1 = mkTask deployPath repoPath
                task2 = mkTask deployPath repoPathTwo
                repoConfigFile = deployPath </> $(mkRelDir "repo") </> $(mkRelFile "config")
            liftIO $ populateTestRepo repoPathTwo
            void $ Hap.pushRelease task1
            void $ Hap.pushRelease task2

            repoFile <- (liftIO . readFile . fromAbsFile) repoConfigFile 
            repoFile `shouldContain` tempDirPrefix
    describe "createHapistranoDeployState" $ do
      it ("creates the " <> deployStateFilename <> " file correctly") $ \(deployPath, repoPath) ->
        runHap $ do
          let task = mkTask deployPath repoPath
          release <- Hap.pushRelease task
          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
          let task = mkTask deployPath repoPath
          release <- Hap.pushRelease task
          Hap.activateRelease currentSystem deployPath release
          rpath <- Hap.releasePath deployPath release Nothing
          let rc :: Hap.Readlink Dir
              rc =
                Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
          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
          let localCommands = mapMaybe Hap.mkGenericCommand ["pwd", "ls"]
              task = mkTask deployPath repoPath
          Hap.playScriptLocally localCommands
          release <- Hap.pushRelease task
          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) ->
        (runHap $ do
           let localCommands =
                 mapMaybe Hap.mkGenericCommand ["pwd", "ls", "false"]
               task = mkTask deployPath repoPath
           Hap.playScriptLocally localCommands
           release <- Hap.pushRelease task
           Hap.createHapistranoDeployState deployPath release Success) `shouldThrow`
        anyException
    describe "rollback" $ do
      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.createHapistranoDeployState deployPath r Success
              return r
          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:
          forM_ (drop 2 rs) $ \r ->
            (Hap.releasePath deployPath r Nothing >>= doesDirExist) `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) ->
          runHap $ do
            let task = mkTask deployPath repoPath
                sharedDir = Hap.sharedPath deployPath
            release <- Hap.pushRelease task
            rpath <- Hap.releasePath deployPath release Nothing
            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) ->
          runHap
            (do let task = mkTask deployPath repoPath
                release <- Hap.pushRelease task
                rpath <- Hap.releasePath deployPath release Nothing
                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" $
          it "should throw an error" $ \(deployPath, repoPath) ->
            runHap
              (do let task = mkTask deployPath repoPath
                      sharedDir = Hap.sharedPath deployPath
                  release <- Hap.pushRelease task
                  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" $ Just release) `shouldThrow`
            anyException
        context "when the file is at the root of the shared directory" $
          it "should link the file successfully" $ \(deployPath, repoPath) ->
            runHap $ do
              let task = mkTask deployPath repoPath
                  sharedDir = Hap.sharedPath deployPath
              release <- Hap.pushRelease task
              rpath <- Hap.releasePath deployPath release Nothing
              justExec sharedDir "echo 'Bar!' > bar.txt"
              Hap.linkToShared currentSystem rpath deployPath "bar.txt" (Just release)
              (liftIO . readFile . fromAbsFile)
                (rpath </> $(mkRelFile "bar.txt")) `shouldReturn`
                "Bar!\n"
      context "when it attemps to link a directory" $ do
        context "when the directory ends in '/'" $
          it "should throw an error" $ \(deployPath, repoPath) ->
            runHap
              (do let task = mkTask deployPath repoPath
                      sharedDir = Hap.sharedPath deployPath
                  release <- Hap.pushRelease task
                  rpath <- Hap.releasePath deployPath release Nothing
                  justExec sharedDir "mkdir foo/"
                  justExec sharedDir "echo 'Bar!' > foo/bar.txt"
                  justExec sharedDir "echo 'Baz!' > foo/baz.txt"
                  Hap.linkToShared currentSystem rpath deployPath "foo/" $ Just release) `shouldThrow`
            anyException
        it "should link the file successfully" $ \(deployPath, repoPath) ->
          runHap $ do
            let task = mkTask deployPath repoPath
                sharedDir = Hap.sharedPath deployPath
            release <- Hap.pushRelease task
            rpath <- Hap.releasePath deployPath release Nothing
            justExec sharedDir "mkdir foo/"
            justExec sharedDir "echo 'Bar!' > foo/bar.txt"
            justExec sharedDir "echo 'Baz!' > foo/baz.txt"
            Hap.linkToShared currentSystem rpath deployPath "foo" (Just release)
            files <-
              (liftIO . listDirectory . fromAbsDir)
                (rpath </> $(mkRelDir "foo"))
            liftIO $ files `shouldMatchList` ["baz.txt", "bar.txt"]

----------------------------------------------------------------------------
-- Helpers
infix 1 `shouldBe`, `shouldReturn`

-- | Lifted 'Hspec.shouldBe'.
shouldBe :: (MonadIO m, Show a, Eq a) => a -> a -> m ()
shouldBe x y = liftIO (x `Hspec.shouldBe` y)

-- | Lifted 'Hspec.shouldContain'.
shouldContain :: (MonadIO m, Show a, Eq a) => [a] -> [a] -> m ()
shouldContain x y = liftIO (x `Hspec.shouldContain` y)

-- | Lifted 'Hspec.shouldReturn'.
shouldReturn :: (MonadIO m, Show a, Eq a) => m a -> a -> m ()
shouldReturn m y = m >>= (`shouldBe` y)

-- | The sandbox prepares the environment for an independent round of
-- testing. It provides two paths: deploy path and path where git repo is
-- located.
withSandbox :: ActionWith (Path Abs Dir, Path Abs Dir) -> IO ()
withSandbox action =
  withSystemTempDir "hap-test" $ \dir -> do
    let dpath = dir </> $(mkRelDir "deploy")
        rpath = dir </> $(mkRelDir "repo")
    ensureDir dpath
    ensureDir rpath
    populateTestRepo rpath
    action (dpath, rpath)

-- | Given path where to put the repo, generate it for testing.
populateTestRepo :: Path Abs Dir -> IO ()
populateTestRepo path =
  runHap $ do
    justExec path "git init"
    justExec path "git config --local --replace-all push.default simple"
    justExec path "git config --local --replace-all user.email   hap@hap"
    justExec path "git config --local --replace-all user.name    Hap"
    justExec path "echo 'Foo!' > foo.txt"
    justExec path "git add -A"
    justExec path "git commit -m 'Initial commit'"
  -- Add dummy content to a branch that is not master
    justExec path ("git checkout -b " ++ testBranchName)
    justExec path "echo 'Bar!' > bar.txt"
    justExec path "git add bar.txt"
    justExec path "git commit -m 'Added more bars to another branch'"
    justExec path "git checkout master"

-- | Execute arbitrary commands in the specified directory.
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') Nothing
    Just cmd -> Hap.exec (Hap.Cd path cmd) Nothing

-- | Run 'Hapistrano' monad locally.
runHap :: Hapistrano a -> IO a
runHap = runHapWithShell Bash

-- | Run 'Hapistrano' monad setting a particular shell.
runHapWithShell :: Shell -> Hapistrano a -> IO a
runHapWithShell shell m = do
  let printFnc dest str =
        case dest of
          StdoutDest -> putStr str
          StderrDest -> hPutStr stderr str
  r <- Hap.runHapistrano Nothing shell printFnc m
  case r of
    Left n -> do
      expectationFailure ("Failed with status code: " ++ show n)
      return undefined
      -- ↑ because expectationFailure from Hspec has wrong type :-(
    Right x -> return x

-- | Make a 'Task' given deploy path and path to the repo.
mkTask :: Path Abs Dir -> Path Abs Dir -> Task
mkTask deployPath repoPath =
  mkTaskWithCustomRevision deployPath repoPath "master"

mkTaskWithCustomRevision :: Path Abs Dir -> Path Abs Dir -> String -> Task
mkTaskWithCustomRevision deployPath repoPath revision =
  Task
    { taskDeployPath = deployPath
    , taskSource =
        GitRepository
          { gitRepositoryURL = fromAbsDir repoPath
          , gitRepositoryRevision = 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"
    then GNULinux
    else BSD

arbitraryReleaseFormat :: Gen ReleaseFormat
arbitraryReleaseFormat = elements [ReleaseShort, ReleaseLong]

arbitraryKeepReleases :: Gen Natural
arbitraryKeepReleases = fromInteger . getPositive <$> arbitrary