Merge pull request #155 from stackbuilders/add_working_directory

[#149] Add working directory

.gitignore

@@ -16,3 +16,5 @@ cabal.sandbox.config
 .stack-work/
 dist-newstyle
 result
+nix/
+shell.nix

CHANGELOG.md

@@ -1,4 +1,6 @@
 ## 0.4.2.0
+### Added
+* Add support for working directory
 
 ### Removed
 * GHC support for versions older than 8.0. Bounds for base corrected

app/Main.hs

@@ -139,7 +139,7 @@ main = do
               release <- if configVcAction
                           then Hap.pushRelease (task releaseFormat)
                           else Hap.pushReleaseWithoutVc (task releaseFormat)
-              rpath <- Hap.releasePath configDeployPath release
+              rpath <- Hap.releasePath configDeployPath release configWorkingDir
               forM_ (toMaybePath configSource) $ \src ->
                 Hap.scpDir src rpath
               forM_ configCopyFiles $ \(C.CopyThing src dest) -> do
@@ -158,7 +158,7 @@ main = do
                 (Hap.linkToShared configTargetSystem rpath configDeployPath)
               forM_ configLinkedDirs
                 (Hap.linkToShared configTargetSystem rpath configDeployPath)
-              forM_ configBuildScript (Hap.playScript configDeployPath release)
+              forM_ configBuildScript (Hap.playScript configDeployPath release configWorkingDir)
               Hap.registerReleaseAsComplete configDeployPath release
               Hap.activateRelease configTargetSystem configDeployPath release
               Hap.dropOldReleases configDeployPath keepReleases

example/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+*~
+.vagrant

example/README.md

@@ -0,0 +1,50 @@
+# Example project to test hapistrano's working_dir feature
+
+We're going to test the hapistrano's `working_dir` feature by deploying this project to a local server (Virtual machine).
+To do this we need to:
+
+1. Install [VirtualBox][virtualbox]
+2. Install [Vagrant][vagrant]
+3. Make sure you have hapistrano installed. You can install it via [stack] by running
+    ```bash
+    stack install hapistrano
+    ```
+4. You must have a ssh key with the name `id_rsa`.If you're not sure this [article][ssh] can be helfpul.
+5. Go to the `/hapistano/example` directory.
+6. Execute in your terminal the next line. `*`
+    ```bash
+    #This could take a couple of minutes
+    $ vagrant up
+    $ hap deploy
+    ```
+    If everything went fine, this should trigger the deployment procces to the virtual machine.
+7. To check if the project was built you can ssh the vagrant vm, and do the folowing:
+    ```bash
+    vagrant ssh
+    cd /tmp/hap-examle/current/example
+   stack build
+   ```
+   Nothing should happen since your project is already compiled.
+
+`*` A known issue occurs if you have other vagrant vms. When trying to run `hap deploy` you could get the following console result. To avoid this issue remove the line that contains the previous RSA host key and try running `hap deploy` again.
+
+```bash
+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+@    WARNING: REMOTE HOST IDENTIFICATION HAS CHANGED!     @
+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+IT IS POSSIBLE THAT SOMEONE IS DOING SOMETHING NASTY!
+Someone could be eavesdropping on you right now (man-in-the-middle attack)!
+It is also possible that the RSA host key has just been changed.
+The fingerprint for the RSA key sent by the remote host is
+<host key>.
+Please contact your system administrator.
+Add correct host key in /path/to/.ssh/known_hosts to get rid of this message.
+Offending key in /path/to/.ssh/known_hosts:<line>
+RSA host key for [ip-or-host]:<port> has changed and you have requested strict checking.
+Host key verification failed.
+```
+
+[virtualbox]: https://www.virtualbox.org/wiki/Downloads
+[vagrant]: https://www.vagrantup.com/docs/installation
+[ssh]: https://docs.github.com/en/github/authenticating-to-github/checking-for-existing-ssh-keys
+[stack]: https://docs.haskellstack.org/en/stable/README/

example/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

example/Vagrantfile

@@ -0,0 +1,16 @@
+Vagrant.configure("2") do |config|
+  config.vm.box = "debian/buster64"
+  config.vm.provider "virtualbox" do |v|
+    v.memory = 1024
+    v.cpus = 2
+  end
+
+  # ~/.ssh/id_rsa.pub is a file in the host machine
+  config.vm.provision "file", source: "~/.ssh/id_rsa.pub", destination: "~/.ssh/me.pub"
+  config.vm.provision "shell", inline: <<-SCRIPT
+    apt update
+    apt install -y curl
+    curl -sSL https://get.haskellstack.org/ | sh
+    cat /home/vagrant/.ssh/me.pub >> /home/vagrant/.ssh/authorized_keys
+  SCRIPT
+end

example/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import Lib
+
+main :: IO ()
+main = helloWorld

example/example.cabal

@@ -0,0 +1,41 @@
+cabal-version:  1.12
+name:           example
+version:        0.1.0.0
+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
+copyright:      2015-Present Stack Builders Inc.
+license:        MIT
+license-file:   ../LICENSE
+build-type:     Simple
+extra-source-files:
+  README.md
+
+source-repository head
+  type: git
+  location: https://github.com/stackbuilders/hapistrano/
+
+library
+  exposed-modules:
+      Lib
+  other-modules:
+      Paths_example
+  hs-source-dirs:
+      src
+  build-depends:
+      base >=4.7 && <5
+  default-language: Haskell2010
+
+executable example-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_example
+  hs-source-dirs:
+      app
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , example
+  default-language: Haskell2010

example/hap.yaml

@@ -0,0 +1,9 @@
+deploy_path: "/tmp/hap-example"
+repo: "https://github.com/stackbuilders/hapistrano.git"
+revision: "origin/master"
+host: vagrant@127.0.0.1
+port: 2222
+working_directory: example
+
+build_script:
+  - stack build -j1

example/src/Lib.hs

@@ -0,0 +1,6 @@
+module Lib
+    ( helloWorld
+    ) where
+
+helloWorld :: IO ()
+helloWorld = putStrLn "Hello world!"

example/stack.yaml

@@ -0,0 +1,3 @@
+resolver: lts-17.10
+packages:
+  - .

example/stack.yaml.lock

@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots:
+- completed:
+    size: 567241
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/10.yaml
+    sha256: 321b3b9f0c7f76994b39e0dabafdc76478274b4ff74cc5e43d410897a335ad3b
+  original: lts-17.10

spec/System/HapistranoConfigSpec.hs

@@ -56,4 +56,5 @@ defaultConfiguration =
     , configTargetSystem = GNULinux
     , configReleaseFormat = Nothing
     , configKeepReleases = Nothing
+    , configWorkingDir = Nothing
     }

spec/System/HapistranoSpec.hs

@@ -12,6 +12,7 @@ import Data.List (isPrefixOf)
 import Data.Maybe (mapMaybe)
 import Numeric.Natural
 import Path
+import Path.Internal (Path(..))
 import Path.IO
 import System.Directory (getCurrentDirectory, listDirectory)
 import qualified System.Hapistrano as Hap
@@ -29,6 +30,12 @@ import Test.QuickCheck
 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" $
@@ -93,12 +100,33 @@ spec = do
         it "returns the default value" $
         fromMaybeKeepReleases Nothing Nothing `Hspec.shouldBe` 5
   around withSandbox $ do
+    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
+          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"
@@ -106,7 +134,7 @@ spec = do
         runHap $ do
           let task = mkTask deployPath repoPath
           release <- Hap.pushRelease task
-          rpath <- Hap.releasePath deployPath release
+          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"
@@ -114,7 +142,7 @@ spec = do
         runHap $ do
           let task = mkTaskWithCustomRevision deployPath repoPath testBranchName
           release <- Hap.pushRelease task
-          rpath <- Hap.releasePath deployPath release
+          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"
@@ -138,7 +166,7 @@ spec = do
           let task = mkTask deployPath repoPath
           release <- Hap.pushRelease task
           Hap.activateRelease currentSystem deployPath release
-          rpath <- Hap.releasePath deployPath release
+          rpath <- Hap.releasePath deployPath release Nothing
           let rc :: Hap.Readlink Dir
               rc =
                 Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
@@ -171,7 +199,7 @@ spec = do
             let task = mkTask deployPath repoPath
             rs <- replicateM 5 (Hap.pushRelease task)
             Hap.rollback currentSystem deployPath 2
-            rpath <- Hap.releasePath deployPath (rs !! 2)
+            rpath <- Hap.releasePath deployPath (rs !! 2) Nothing
             let rc :: Hap.Readlink Dir
                 rc =
                   Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
@@ -184,7 +212,7 @@ spec = do
             rs <- replicateM 5 (Hap.pushRelease task)
             forM_ (take 3 rs) (Hap.registerReleaseAsComplete deployPath)
             Hap.rollback currentSystem deployPath 2
-            rpath <- Hap.releasePath deployPath (rs !! 0)
+            rpath <- Hap.releasePath deployPath (rs !! 0) Nothing
             let rc :: Hap.Readlink Dir
                 rc =
                   Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)
@@ -201,10 +229,10 @@ spec = do
           Hap.dropOldReleases deployPath 5
         -- two oldest releases should not survive:
           forM_ (take 2 rs) $ \r ->
-            (Hap.releasePath deployPath r >>= doesDirExist) `shouldReturn` False
+            (Hap.releasePath deployPath r Nothing >>= doesDirExist) `shouldReturn` False
         -- 5 most recent releases should stay alive:
           forM_ (drop 2 rs) $ \r ->
-            (Hap.releasePath deployPath r >>= doesDirExist) `shouldReturn` True
+            (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
@@ -218,7 +246,7 @@ spec = do
             let task = mkTask deployPath repoPath
                 sharedDir = Hap.sharedPath deployPath
             release <- Hap.pushRelease task
-            rpath <- Hap.releasePath deployPath release
+            rpath <- Hap.releasePath deployPath release Nothing
             Hap.exec $ Hap.Rm sharedDir
             Hap.linkToShared currentSystem rpath deployPath "thing" `shouldReturn`
               ()
@@ -227,7 +255,7 @@ spec = do
           runHap
             (do let task = mkTask deployPath repoPath
                 release <- Hap.pushRelease task
-                rpath <- Hap.releasePath deployPath release
+                rpath <- Hap.releasePath deployPath release Nothing
                 Hap.linkToShared currentSystem rpath deployPath "foo.txt") `shouldThrow`
           anyException
       context "when it attemps to link a file" $ do
@@ -237,7 +265,7 @@ spec = do
               (do let task = mkTask deployPath repoPath
                       sharedDir = Hap.sharedPath deployPath
                   release <- Hap.pushRelease task
-                  rpath <- Hap.releasePath deployPath release
+                  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`
@@ -248,7 +276,7 @@ spec = do
               let task = mkTask deployPath repoPath
                   sharedDir = Hap.sharedPath deployPath
               release <- Hap.pushRelease task
-              rpath <- Hap.releasePath deployPath release
+              rpath <- Hap.releasePath deployPath release Nothing
               justExec sharedDir "echo 'Bar!' > bar.txt"
               Hap.linkToShared currentSystem rpath deployPath "bar.txt"
               (liftIO . readFile . fromAbsFile)
@@ -261,7 +289,7 @@ spec = do
               (do let task = mkTask deployPath repoPath
                       sharedDir = Hap.sharedPath deployPath
                   release <- Hap.pushRelease task
-                  rpath <- Hap.releasePath deployPath release
+                  rpath <- Hap.releasePath deployPath release Nothing
                   justExec sharedDir "mkdir foo/"
                   justExec sharedDir "echo 'Bar!' > foo/bar.txt"
                   justExec sharedDir "echo 'Baz!' > foo/baz.txt"
@@ -272,7 +300,7 @@ spec = do
             let task = mkTask deployPath repoPath
                 sharedDir = Hap.sharedPath deployPath
             release <- Hap.pushRelease task
-            rpath <- Hap.releasePath deployPath release
+            rpath <- Hap.releasePath deployPath release Nothing
             justExec sharedDir "mkdir foo/"
             justExec sharedDir "echo 'Bar!' > foo/bar.txt"
             justExec sharedDir "echo 'Baz!' > foo/baz.txt"

src/System/Hapistrano.hs

@@ -96,7 +96,7 @@ activateRelease
   -> Release           -- ^ Release identifier to activate
   -> Hapistrano ()
 activateRelease ts deployPath release = do
-  rpath <- releasePath deployPath release
+  rpath <- releasePath deployPath release Nothing
   let tpath = tempSymlinkPath deployPath
       cpath = currentSymlinkPath deployPath
   exec (Ln ts rpath tpath) -- create a symlink for the new candidate
@@ -129,7 +129,7 @@ dropOldReleases
 dropOldReleases deployPath n = do
   dreleases <- deployedReleases deployPath
   forM_ (genericDrop n dreleases) $ \release -> do
-    rpath <- releasePath deployPath release
+    rpath <- releasePath deployPath release Nothing
     exec (Rm rpath)
   creleases <- completedReleases deployPath
   forM_ (genericDrop n creleases) $ \release -> do
@@ -141,10 +141,11 @@ dropOldReleases deployPath n = do
 playScript
   :: Path Abs Dir         -- ^ Deploy path
   -> Release              -- ^ Release identifier
+  -> Maybe (Path Rel Dir) -- ^ Working directory
   -> [GenericCommand]     -- ^ Commands to execute
   -> Hapistrano ()
-playScript deployDir release cmds = do
+playScript deployDir release mWorkingDir cmds = do
-  rpath <- releasePath deployDir release
+  rpath <- releasePath deployDir release mWorkingDir
   forM_ cmds (execWithInheritStdout . Cd rpath)
 
 -- | Plays the given script on your machine locally.
@@ -201,7 +202,7 @@ cloneToRelease
   -> Release           -- ^ 'Release' to create
   -> Hapistrano ()
 cloneToRelease deployPath release = do
-  rpath <- releasePath deployPath release
+  rpath <- releasePath deployPath release Nothing
   let cpath = cacheRepoPath deployPath
   exec (GitClone False (Right cpath) rpath)
 
@@ -214,7 +215,7 @@ setReleaseRevision
   -> String            -- ^ Revision to checkout
   -> Hapistrano ()
 setReleaseRevision deployPath release revision = do
-  rpath <- releasePath deployPath release
+  rpath <- releasePath deployPath release Nothing
   exec (Cd rpath (GitCheckout revision))
 
 -- | Return a list of all currently deployed releases sorted newest first.
@@ -279,12 +280,16 @@ linkToShared configTargetSystem rpath configDeployPath thingToLink = do
 releasePath
   :: Path Abs Dir         -- ^ Deploy path
   -> Release              -- ^ 'Release' identifier
+  -> Maybe (Path Rel Dir) -- ^ Working directory
   -> Hapistrano (Path Abs Dir)
-releasePath deployPath release = do
+releasePath deployPath release mWorkingDir =
   let rendered = renderRelease release
-  case parseRelDir rendered of
+  in case parseRelDir rendered of
     Nothing    -> failWith 1 (Just $ "Could not append path: " ++ rendered)
-    Just rpath -> return (releasesPath deployPath </> rpath)
+    Just rpath ->
+      return $ case mWorkingDir of
+        Nothing         -> releasesPath deployPath </> rpath
+        Just workingDir -> releasesPath deployPath </> rpath </> workingDir
 
 -- | Return the full path to the git repo used for cache purposes on the
 -- target host filesystem.

src/System/Hapistrano/Config.hs

@@ -62,6 +62,7 @@ data Config = Config
   -- ^ 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
+  , configWorkingDir :: !(Maybe (Path Rel Dir))
   } deriving (Eq, Ord, Show)
 
 -- | Information about source and destination locations of a file\/directory
@@ -115,6 +116,7 @@ instance FromJSON Config where
     configTargetSystem <- o .:? "linux" .!= GNULinux
     configReleaseFormat <- o .:? "release_format"
     configKeepReleases <- o .:? "keep_releases"
+    configWorkingDir <- o .:? "working_directory"
     return Config {..}
 
 instance FromJSON CopyThing where

stack.yaml

@@ -1,4 +1,3 @@
-resolver: lts-17.7
+resolver: lts-17.10
 packages:
-  - '.'
+  - .
-

stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 565715
+    size: 567241
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/7.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/10.yaml
-    sha256: 1b5e4124989399e60e7a7901f0cefd910beea546131fb07a13a7208c4cc8b7ee
+    sha256: 321b3b9f0c7f76994b39e0dabafdc76478274b4ff74cc5e43d410897a335ad3b
-  original: lts-17.7
+  original: lts-17.10