hapistrano 0.3.8.0 → 0.3.9.0

raw patch · 10 files changed

+197/−35 lines, 10 filesdep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +11/−0
• app/Config.hs +16/−5
• app/Main.hs +13/−8
• hapistrano.cabal +2/−2
• spec/System/HapistranoSpec.hs +83/−2
• src/System/Hapistrano.hs +25/−0
• src/System/Hapistrano/Commands.hs +1/−1
• src/System/Hapistrano/Core.hs +23/−17
• src/System/Hapistrano/Types.hs +16/−0

@@ -1,3 +1,10 @@+## 0.3.9.0+### Added+* Support to deploy to a host that has default `zsh` shell.+* Support to deploy using a different shell. Currently supported: `zsh` and `bash`.+* `linked_files` and `linked_dirs` to link files and directories located in the+`{deploy_path}/shared/` directory.+ ## 0.3.8.0 ### Added * `execWithInheritStdout` was added to `System.Hapistrano.Core` to stream output children's

@@ -58,6 +58,7 @@ * `host` — the target host, if missing, `localhost` will be assumed (which   is useful for testing and playing with `hap` locally). * `port` — SSH port number to use. If missing, 22 will be used.+* `shell` — Shell to use. Currently supported: `zsh` ans `bash`. If missing, `Bash` will be used. * `build_script` — instructions how to build the application in the form of   shell commands. * `restart_command` — if you need to restart a remote web server after a@@ -80,6 +81,16 @@   '--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'+* `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_+be similar in your release directories in case you need to link a file inside a+nested directory (e.g. `shared/foo/file.txt`).+* `linked_dirs:`- Listed directories that will be symlinked from the `{deploy_path}/shared` folder+into each release directory during deployment. Can be used for data directories+that need to be persisted (e.g. upload directories). **NOTE:** Do not add a slash `/`+at the end of the directory (e.g. `foo/`) because we use `parseRelFile` to create+the symlink. * `run_locally:`- Instructions to run locally on your machine in the   form of shell commands. Example: 

@@ -17,7 +17,8 @@ import           Numeric.Natural import           Path import           System.Hapistrano.Commands-import           System.Hapistrano.Types    (ReleaseFormat (..),+import           System.Hapistrano.Types    (Shell(..),+                                             ReleaseFormat (..),                                              TargetSystem (..))  -- | Hapistrano configuration typically loaded from @hap.yaml@ file.@@ -25,7 +26,7 @@ data Config = Config   { configDeployPath     :: !(Path Abs Dir)     -- ^ Top-level deploy directory on target machine-  , configHosts          :: ![(String, Word)]+  , configHosts          :: ![(String, Word, Shell)]     -- ^ Hosts\/ports to deploy to. If empty, localhost will be assumed.   , configRepo           :: !String     -- ^ Location of repository that contains the source code to deploy@@ -40,6 +41,10 @@     -- ^ Collection of files to copy over to target machine before building   , configCopyDirs       :: ![CopyThing]     -- ^ Collection of directories to copy over to target machine before building+  , configLinkedFiles      :: ![FilePath]+    -- ^ Collection of files to link from each release to _shared_+  , 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.   , configRunLocally     :: !(Maybe [GenericCommand])@@ -68,14 +73,18 @@   parseJSON = withObject "Hapistrano configuration" $ \o -> do     configDeployPath <- o .: "deploy_path"     let grabPort m = m .:? "port" .!= 22+        grabShell m = m .:? "shell" .!= Bash     host             <- o .:? "host"     port             <- grabPort o+    shell            <- grabShell o     hs               <- (o .:? "targets" .!= []) >>= mapM (\m -> do       host' <- m .: "host"       port' <- grabPort m-      return (host', port'))-    let configHosts = nubBy ((==) `on` fst)-          (maybeToList ((,) <$> host <*> pure port) ++ hs)+      shell' <- grabShell m+      return (host', port', shell'))+    let first (h, _, _) = h+        configHosts = nubBy ((==) `on` first)+          (maybeToList ((,,) <$> host <*> pure port <*> pure shell) ++ hs)     configRepo       <- o .: "repo"     configRevision   <- o .: "revision"     configRestartCommand <- (o .:? "restart_command") >>=@@ -84,6 +93,8 @@       maybe (return Nothing) (fmap Just . mapM mkCmd)     configCopyFiles  <- o .:? "copy_files" .!= []     configCopyDirs   <- o .:? "copy_dirs"  .!= []+    configLinkedFiles <- o .:? "linked_files" .!= []+    configLinkedDirs  <- o .:? "linked_dirs"  .!= []     configVcAction    <- o .:? "vc_action" .!= True     configRunLocally  <- o .:? "run_locally" >>=       maybe (return Nothing) (fmap Just . mapM mkCmd)

@@ -130,16 +130,16 @@                      , taskReleaseFormat = rf }   let printFnc dest str = atomically $         writeTChan chan (PrintMsg dest str)-      hap sshOpts =  do-        r <- Hap.runHapistrano sshOpts printFnc $+      hap shell sshOpts =  do+        r <- Hap.runHapistrano sshOpts shell printFnc $           case optsCommand of             Deploy cliReleaseFormat cliKeepReleases -> do               let releaseFormat = fromMaybeReleaseFormat cliReleaseFormat configReleaseFormat                   keepReleases = fromMaybeKeepReleases cliKeepReleases configKeepReleases               forM_ configRunLocally Hap.playScriptLocally-              release <- case configVcAction of-                           True -> Hap.pushRelease (task releaseFormat)-                           False -> Hap.pushReleaseWithoutVc (task releaseFormat)+              release <- if configVcAction+                          then Hap.pushRelease (task releaseFormat)+                          else Hap.pushReleaseWithoutVc (task releaseFormat)               rpath <- Hap.releasePath configDeployPath release               forM_ configCopyFiles $ \(C.CopyThing src dest) -> do                 srcPath  <- resolveFile' src@@ -153,6 +153,10 @@                 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)               Hap.registerReleaseAsComplete configDeployPath release               Hap.activateRelease configTargetSystem configDeployPath release@@ -176,10 +180,11 @@       haps :: [IO (Either Int ())]       haps =         case configHosts of-          [] -> [hap Nothing] -- localhost, no SSH+          [] -> [hap Bash Nothing] -- localhost, no SSH           xs ->-            let f (host, port) = SshOptions host port-            in hap . Just . f <$> xs+            let runHap (host, port, shell) =+                  hap shell (Just $ SshOptions host port)+            in runHap <$> xs   results <- (runConcurrently . traverse Concurrently)     ((Right () <$ printer (length haps)) : haps)   case sequence_ results of

@@ -1,5 +1,5 @@ name:                hapistrano-version:             0.3.8.0+version:             0.3.9.0 synopsis:            A deployment library for Haskell applications description:   .@@ -99,7 +99,7 @@   main-is:             Spec.hs   other-modules:       System.HapistranoSpec   build-depends:       base               >= 4.8 && < 5.0-                     , directory          >= 1.2.2 && < 1.4+                     , directory          >= 1.2.5 && < 1.4                      , filepath           >= 1.2 && < 1.5                      , hapistrano                      , hspec              >= 2.0 && < 3.0

@@ -10,6 +10,7 @@ import           Numeric.Natural import           Path import           Path.IO+import           System.Directory           (listDirectory) import qualified System.Hapistrano          as Hap import qualified System.Hapistrano.Commands as Hap import qualified System.Hapistrano.Core     as Hap@@ -93,6 +94,14 @@    around withSandbox $ do     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+        -- 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@@ -195,6 +204,73 @@           (Hap.ctokenPath deployPath r >>= doesFileExist)             `shouldReturn` True +    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+          Hap.exec $ Hap.Rm sharedDir+          Hap.linkToShared currentSystem rpath deployPath "thing"+            `shouldReturn` ()++      context "when the file/directory to link exists in the respository" $+        it "should throw an error" $ \(deployPath, repoPath) -> runHap (do+          let task = mkTask deployPath repoPath+          release <- Hap.pushRelease task+          rpath   <- Hap.releasePath deployPath release+          Hap.linkToShared currentSystem rpath deployPath "foo.txt")+            `shouldThrow` anyException++      context "when it attemps 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+            justExec sharedDir "mkdir foo/"+            justExec sharedDir "echo 'Bar!' > foo/bar.txt"+            Hap.linkToShared currentSystem rpath deployPath "foo/bar.txt")+              `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+            justExec sharedDir "echo 'Bar!' > bar.txt"+            Hap.linkToShared currentSystem rpath deployPath "bar.txt"+            (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+            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` 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+          justExec sharedDir "mkdir foo/"+          justExec sharedDir "echo 'Bar!' > foo/bar.txt"+          justExec sharedDir "echo 'Baz!' > foo/baz.txt"+          Hap.linkToShared currentSystem rpath deployPath "foo"+          files <- (liftIO . listDirectory . fromAbsDir) (rpath </> $(mkRelDir "foo"))+          liftIO $ files `shouldMatchList` ["baz.txt","bar.txt"]+ ---------------------------------------------------------------------------- -- Helpers @@ -253,12 +329,17 @@ -- | Run 'Hapistrano' monad locally.  runHap :: Hapistrano a -> IO a-runHap m = do+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 printFnc m+  r <- Hap.runHapistrano Nothing shell printFnc m   case r of     Left n -> do       expectationFailure ("Failed with status code: " ++ show n)

@@ -19,12 +19,14 @@   , pushReleaseWithoutVc   , registerReleaseAsComplete   , activateRelease+  , linkToShared   , rollback   , dropOldReleases   , playScript   , playScriptLocally     -- * Path helpers   , releasePath+  , sharedPath   , currentSymlinkPath   , tempSymlinkPath   , ctokenPath )@@ -161,6 +163,7 @@   (exec . MkDir . releasesPath)  deployPath   (exec . MkDir . cacheRepoPath) deployPath   (exec . MkDir . ctokensPath)   deployPath+  (exec . MkDir . sharedPath)    deployPath  -- | Ensure that the specified repo is cloned and checked out on the given -- revision. Idempotent.@@ -241,6 +244,28 @@   :: Path Abs Dir      -- ^ Deploy path   -> Path Abs Dir releasesPath deployPath = deployPath </> $(mkRelDir "releases")++-- | Return the full path to the directory containing the shared files/directories.++sharedPath+  :: Path Abs Dir      -- ^ Deploy path+  -> Path Abs Dir+sharedPath deployPath = deployPath </> $(mkRelDir "shared")++-- | Link something (file or directory) from the {deploy_path}/shared/ directory+-- to a release++linkToShared+  :: TargetSystem -- ^ System to deploy+  -> Path Abs Dir -- ^ Release path+  -> Path Abs Dir -- ^ Deploy path+  -> FilePath     -- ^ Thing to link in share+  -> Hapistrano ()+linkToShared configTargetSystem rpath configDeployPath thingToLink = do+  destPath <- parseRelFile thingToLink+  let dpath = rpath </> destPath+      sharedPath' = sharedPath configDeployPath </> destPath+  exec $ Ln configTargetSystem sharedPath' dpath  -- | Construct path to a particular 'Release'. 

@@ -245,7 +245,7 @@   renderCommand (GitFetch remote) = formatCmd "git"     [ Just "fetch"     , Just remote-    , Just "+refs/heads/*:refs/heads/*" ]+    , Just "+refs/heads/\\*:refs/heads/\\*" ]   parseResult Proxy _ = ()  -- | Git reset.

@@ -40,13 +40,15 @@  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 printFnc m = liftIO $ do+runHapistrano sshOptions shell' printFnc m = liftIO $ do   let config = Config         { configSshOptions = sshOptions+        , configShellOptions = shell'         , configPrint      = printFnc }   r <- runReaderT (runExceptT m) config   case r of@@ -70,28 +72,16 @@  exec :: forall a. Command a => a -> Hapistrano (Result a) exec typedCmd = do-  Config {..} <- ask-  let (prog, args) =-        case configSshOptions of-          Nothing ->-            ("bash", ["-c", cmd])-          Just SshOptions {..} ->-            ("ssh", [sshHost, "-p", show sshPort, cmd])-      cmd = renderCommand typedCmd+  let cmd = renderCommand typedCmd+  (prog, args) <- getProgAndArgs cmd   parseResult (Proxy :: Proxy a) <$> exec' cmd (readProcessWithExitCode prog args "")  -- | Same as 'exec' but it streams to stdout only for _GenericCommand_s  execWithInheritStdout :: Command a => a -> Hapistrano () execWithInheritStdout typedCmd = do-  Config {..} <- ask-  let (prog, args) =-        case configSshOptions of-          Nothing ->-            ("bash", ["-c", cmd])-          Just SshOptions {..} ->-            ("ssh", [sshHost, "-p", show sshPort, cmd])-      cmd = renderCommand typedCmd+  let cmd = renderCommand typedCmd+  (prog, args) <- getProgAndArgs cmd   void $ exec' cmd (readProcessWithExitCode' (SPT.proc prog args))     where     -- | Prepares a process, reads @stdout@ and @stderr@ and returns exit code@@ -108,6 +98,22 @@         where           pc' = SPT.setStdout SPT.inherit               $ SPT.setStderr SPT.inherit pc++-- | Get program and args to run a command locally or remotelly.++getProgAndArgs :: String -> Hapistrano (String, [String])+getProgAndArgs cmd = do+  Config {..} <- ask+  return $+    case configSshOptions of+      Nothing ->+        (renderShell configShellOptions, ["-c", cmd])+      Just SshOptions {..} ->+        ("ssh", [sshHost, "-p", show sshPort, cmd])+    where+      renderShell :: Shell -> String+      renderShell Zsh = "zsh"+      renderShell Bash = "bash"  -- | Copy a file from local path to target server. 

@@ -21,6 +21,7 @@   , OutputDest (..)   , Release   , TargetSystem(..)+  , Shell(..)   , mkRelease   , releaseTime   , renderRelease@@ -51,6 +52,8 @@ data Config = Config   { configSshOptions :: !(Maybe SshOptions)     -- ^ 'Nothing' if we are running locally, or SSH options to use.+  , configShellOptions :: !Shell+    -- ^ One of the supported 'Shell's   , configPrint      :: !(OutputDest -> String -> IO ())     -- ^ How to print messages   }@@ -81,6 +84,19 @@       "short" -> return ReleaseShort       "long"  -> return ReleaseLong       _       -> fail "expected 'short' or 'long'"++-- | Current shells supported.+data Shell =+  Bash+  | Zsh+  deriving (Show, Eq, Ord)++instance FromJSON Shell where+  parseJSON = withText "shell" $ \t ->+    case t of+      "bash" -> return Bash+      "zsh"  -> return Zsh+      _       -> fail "supported shells: 'bash' or 'zsh'"  -- | SSH options.