[#145] Deploy from a different repository (#193)

* Add GitSetOrigin command

* Add new command tests

* Create second repository path for testing

Co-authored-by: Alexis Crespo <alexis-2cab@homail.com>

* Add tests for new command implementation

* Remove redundant imports in spec file

Co-authored-by: CristhianMotoche <cristhian.motoche@gmail.com>
Co-authored-by: Alexis Crespo <alexis-2cab@homail.com>
This commit is contained in:
Alexis Crespo 2022-07-05 09:35:33 -05:00 committed by GitHub
parent 56bf80c171
commit 40647af28a
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 35 additions and 6 deletions

View File

@ -17,7 +17,8 @@ import Path
import Path.IO import Path.IO
import System.Directory (getCurrentDirectory, listDirectory) import System.Directory
( doesFileExist, getCurrentDirectory, listDirectory )
import qualified System.Hapistrano as Hap import qualified System.Hapistrano as Hap
import qualified System.Hapistrano.Commands as Hap import qualified System.Hapistrano.Commands as Hap
import qualified System.Hapistrano.Core as Hap import qualified System.Hapistrano.Core as Hap
@ -25,16 +26,13 @@ import System.Hapistrano.Types
import System.IO import System.IO
import System.IO.Silently (capture_) import System.IO.Silently (capture_)
import System.Info (os) import System.Info (os)
import Test.Hspec hiding (shouldBe, shouldReturn) import Test.Hspec hiding (shouldBe, shouldContain, shouldReturn)
import qualified Test.Hspec as Hspec import qualified Test.Hspec as Hspec
import Test.Hspec.QuickCheck import Test.Hspec.QuickCheck
import Test.QuickCheck hiding (Success) import Test.QuickCheck hiding (Success)
import System.Hapistrano (releasePath) import System.Hapistrano (releasePath)
import System.Hapistrano.Config (deployStateFilename) import System.Hapistrano.Config (deployStateFilename)
import System.Directory
import System.Hapistrano.Maintenance import System.Hapistrano.Maintenance
import Path
import Control.Monad.IO.Class
testBranchName :: String testBranchName :: String
testBranchName = "another_branch" testBranchName = "another_branch"
@ -176,6 +174,19 @@ spec = do
("test `git rev-parse --abbrev-ref HEAD` = " ++ testBranchName) ("test `git rev-parse --abbrev-ref HEAD` = " ++ testBranchName)
-- This fails if there are unstaged changes -- This fails if there are unstaged changes
justExec rpath "git diff --exit-code" 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 describe "createHapistranoDeployState" $ do
it ("creates the " <> deployStateFilename <> " file correctly") $ \(deployPath, repoPath) -> it ("creates the " <> deployStateFilename <> " file correctly") $ \(deployPath, repoPath) ->
runHap $ do runHap $ do
@ -259,7 +270,7 @@ spec = do
(Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` True (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` True
context "when the --keep-one-failed flag is active" $ context "when the --keep-one-failed flag is active" $
it "should delete failed releases other than the most recent" $ \(deployPath, repoPath) -> it "should delete failed releases other than the most recent" $ \(deployPath, repoPath) ->
let successfulRelease = mkReleaseWithState deployPath repoPath Success let successfulRelease = mkReleaseWithState deployPath repoPath Success
failedRelease = mkReleaseWithState deployPath repoPath Fail in failedRelease = mkReleaseWithState deployPath repoPath Fail in
runHap $ do runHap $ do
rs <- sequence [successfulRelease, successfulRelease, failedRelease, failedRelease, failedRelease] rs <- sequence [successfulRelease, successfulRelease, failedRelease, failedRelease, failedRelease]
@ -352,6 +363,10 @@ infix 1 `shouldBe`, `shouldReturn`
shouldBe :: (MonadIO m, Show a, Eq a) => a -> a -> m () shouldBe :: (MonadIO m, Show a, Eq a) => a -> a -> m ()
shouldBe x y = liftIO (x `Hspec.shouldBe` y) 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'. -- | Lifted 'Hspec.shouldReturn'.
shouldReturn :: (MonadIO m, Show a, Eq a) => m a -> a -> m () shouldReturn :: (MonadIO m, Show a, Eq a) => m a -> a -> m ()
shouldReturn m y = m >>= (`shouldBe` y) shouldReturn m y = m >>= (`shouldBe` y)

View File

@ -216,6 +216,7 @@ ensureCacheInPlace repo deployPath maybeRelease = do
`catchError` const (return False) `catchError` const (return False)
unless exists $ unless exists $
exec (GitClone True (Left repo) cpath) maybeRelease exec (GitClone True (Left repo) cpath) maybeRelease
exec (Cd cpath (GitSetOrigin repo)) maybeRelease
exec (Cd cpath (GitFetch "origin")) maybeRelease -- TODO store this in task description? exec (Cd cpath (GitFetch "origin")) maybeRelease -- TODO store this in task description?
-- | Create a new release identifier based on current timestamp. -- | Create a new release identifier based on current timestamp.

View File

@ -30,6 +30,7 @@ module System.Hapistrano.Commands
, BasicWrite(..) , BasicWrite(..)
, GitCheckout(..) , GitCheckout(..)
, GitClone(..) , GitClone(..)
, GitSetOrigin(..)
, GitFetch(..) , GitFetch(..)
, GitReset(..) , GitReset(..)
, GenericCommand , GenericCommand

View File

@ -281,6 +281,18 @@ instance Command GitFetch where
[Just "fetch", Just remote, Just "+refs/heads/\\*:refs/heads/\\*"] [Just "fetch", Just remote, Just "+refs/heads/\\*:refs/heads/\\*"]
parseResult Proxy _ = () parseResult Proxy _ = ()
-- | Git set origin
newtype GitSetOrigin =
GitSetOrigin String
instance Command GitSetOrigin where
type Result GitSetOrigin = ()
renderCommand (GitSetOrigin remote) =
formatCmd
"git"
[Just "remote", Just "set-url", Just "origin", Just remote]
parseResult Proxy _ = ()
-- | Git reset. -- | Git reset.
newtype GitReset = newtype GitReset =
GitReset String GitReset String