hapistrano 0.3.4.0 → 0.3.5.0

raw patch · 9 files changed

+81/−30 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• README.md +6/−0
• app/Config.hs +17/−1
• app/Main.hs +2/−2
• hapistrano.cabal +1/−1
• spec/System/HapistranoSpec.hs +13/−7
• src/System/Hapistrano.hs +9/−7
• src/System/Hapistrano/Commands.hs +21/−12
• src/System/Hapistrano/Types.hs +8/−0

@@ -1,3 +1,7 @@+## 0.3.5.0+* Add support for deploying to other Unix systems, besides GNU/Linux which+  didn't supported all the flags that Hapistrano was using. See issue #63+ ## 0.3.4.0 * Use `git checkout` instead of `git reset` to set the release revision 

@@ -66,6 +66,12 @@ * `vc_action` - Controls if version control related activity should   take place. It defaults to true. When you don't want activity like   cloning, fetching etc. to take place, set this to `false`.+* `linux` - Specify, whether or not, the target system where Hapistrano will+  deploy to is a GNU/Linux or other UNIX (g.e. BSD, Mac). This is set to `true`+  by default so unless the target system is not GNU/Linux, this should not be+  necessary. The platform where Hapistrano is running won't affect the+  available options for commands (g.e. A Mac deploying to a Ubuntu machine,+  doesn't need this flag) * `run_locally:`- Instructions to run locally on your machine in the   form of shell commands. Example: 

@@ -1,6 +1,9 @@+{-# LANGUAGE LambdaCase        #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Config   ( Config (..)   , CopyThing (..) )@@ -13,6 +16,7 @@ import Data.Yaml import Path import System.Hapistrano.Commands+import System.Hapistrano.Types (TargetSystem(..))  -- | Hapistrano configuration typically loaded from @hap.yaml@ file. @@ -37,6 +41,11 @@   , configVcAction :: !Bool   -- ^ 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+  , configTargetSystem :: !TargetSystem+  -- ^ Optional parameter to specify the target system. It's GNU/Linux by+  -- default   } deriving (Eq, Ord, Show)  -- | Information about source and destination locations of a file\/directory@@ -66,13 +75,20 @@     configCopyFiles  <- o .:? "copy_files" .!= []     configCopyDirs   <- o .:? "copy_dirs"  .!= []     configVcAction    <- o .:? "vc_action" .!= True-    configRunLocally  <- o .:? "run_locally" >>= +    configRunLocally  <- o .:? "run_locally" >>=       maybe (return Nothing) (fmap Just . mapM mkCmd)+    configTargetSystem <- o .:? "linux" .!= GNULinux     return Config {..}  instance FromJSON CopyThing where   parseJSON = withObject "src and dest of a thing to copy" $ \o ->     CopyThing <$> (o .: "src") <*> (o .: "dest")++instance FromJSON TargetSystem where+  parseJSON = withBool "linux" $+    pure . \case+      True  -> GNULinux+      False -> BSD  mkCmd :: String -> Parser GenericCommand mkCmd raw =

@@ -151,11 +151,11 @@                     Hap.scpDir srcPath dpath                   forM_ configBuildScript (Hap.playScript configDeployPath release)                   Hap.registerReleaseAsComplete configDeployPath release-                  Hap.activateRelease configDeployPath release+                  Hap.activateRelease configTargetSystem configDeployPath release                   Hap.dropOldReleases configDeployPath n                   forM_ configRestartCommand Hap.exec                 Rollback n -> do-                  Hap.rollback configDeployPath n+                  Hap.rollback configTargetSystem configDeployPath n                   forM_ configRestartCommand Hap.exec             atomically (writeTChan chan FinishMsg)             return r

@@ -1,5 +1,5 @@ name:                hapistrano-version:             0.3.4.0+version:             0.3.5.0 synopsis:            A deployment library for Haskell applications description:   .

@@ -10,6 +10,7 @@ import Path.IO import Data.Maybe (catMaybes) import System.Hapistrano.Types+import System.Info (os) import System.IO import Test.Hspec hiding (shouldBe, shouldReturn) import qualified System.Hapistrano as Hap@@ -68,13 +69,13 @@       it "creates the ‘current’ symlink correctly" $ \(deployPath, repoPath) -> runHap $ do         let task = mkTask deployPath repoPath         release <- Hap.pushRelease task-        Hap.activateRelease deployPath release+        Hap.activateRelease currentSystem deployPath release         rpath <- Hap.releasePath deployPath release         let rc :: Hap.Readlink Dir-            rc = Hap.Readlink (Hap.currentSymlinkPath deployPath)+            rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)         Hap.exec rc `shouldReturn` rpath         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 = catMaybes $ map Hap.mkGenericCommand ["pwd", "ls"]@@ -97,10 +98,10 @@         it "resets the ‘current’ symlink correctly" $ \(deployPath, repoPath) -> runHap $ do           let task = mkTask deployPath repoPath           rs <- replicateM 5 (Hap.pushRelease task)-          Hap.rollback deployPath 2+          Hap.rollback currentSystem deployPath 2           rpath <- Hap.releasePath deployPath (rs !! 2)           let rc :: Hap.Readlink Dir-              rc = Hap.Readlink (Hap.currentSymlinkPath deployPath)+              rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)           Hap.exec rc `shouldReturn` rpath           doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False       context "with completion tokens" $@@ -108,10 +109,10 @@           let task = mkTask deployPath repoPath           rs <- replicateM 5 (Hap.pushRelease task)           forM_ (take 3 rs) (Hap.registerReleaseAsComplete deployPath)-          Hap.rollback deployPath 2+          Hap.rollback currentSystem deployPath 2           rpath <- Hap.releasePath deployPath (rs !! 0)           let rc :: Hap.Readlink Dir-              rc = Hap.Readlink (Hap.currentSymlinkPath deployPath)+              rc = Hap.Readlink currentSystem (Hap.currentSymlinkPath deployPath)           Hap.exec rc `shouldReturn` rpath           doesFileExist (Hap.tempSymlinkPath deployPath) `shouldReturn` False @@ -221,3 +222,8 @@   , taskRepository    = fromAbsDir repoPath   , taskRevision      = revision   , taskReleaseFormat = ReleaseLong }++currentSystem :: TargetSystem+currentSystem = if os == "linux"+                then GNULinux+                else BSD

@@ -82,23 +82,25 @@ -- used in deploy or rollback cases.  activateRelease-  :: Path Abs Dir      -- ^ Deploy path+  :: TargetSystem+  -> Path Abs Dir      -- ^ Deploy path   -> Release           -- ^ Release identifier to activate   -> Hapistrano ()-activateRelease deployPath release = do+activateRelease ts deployPath release = do   rpath <- releasePath deployPath release   let tpath = tempSymlinkPath deployPath       cpath = currentSymlinkPath deployPath-  exec (Ln rpath tpath) -- create a symlink for the new candidate-  exec (Mv tpath cpath) -- atomically replace the symlink+  exec (Ln ts rpath tpath) -- create a symlink for the new candidate+  exec (Mv ts tpath cpath) -- atomically replace the symlink  -- | Activates one of already deployed releases.  rollback-  :: Path Abs Dir      -- ^ Deploy path+  :: TargetSystem+  -> Path Abs Dir      -- ^ Deploy path   -> Natural           -- ^ How many releases back to go, 0 re-activates current   -> Hapistrano ()-rollback deployPath n = do+rollback ts deployPath n = do   crs <- completedReleases deployPath   drs <- deployedReleases  deployPath   -- NOTE If we don't have any completed releases, then perhaps the@@ -107,7 +109,7 @@   -- 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.")-    (x:_) -> activateRelease deployPath x+    (x:_) -> activateRelease ts deployPath x  -- | Remove older releases to avoid filling up the target host filesystem. 

@@ -45,6 +45,8 @@ import Numeric.Natural import Path +import System.Hapistrano.Types (TargetSystem(..))+ ---------------------------------------------------------------------------- -- Commands @@ -110,19 +112,20 @@  -- | Move or rename files or directories. -data Mv t = Mv (Path Abs t) (Path Abs t)+data Mv t = Mv TargetSystem (Path Abs t) (Path Abs t)  instance Command (Mv File) where   type Result (Mv File) = ()-  renderCommand (Mv old new) = formatCmd "mv"-    [ Just "-fvT"+  renderCommand (Mv ts old new) = formatCmd "mv"+    [ Just flags     , Just (fromAbsFile old)     , Just (fromAbsFile new) ]+    where flags = if isLinux ts then "-fvT" else "-fv"   parseResult Proxy _ = ()  instance Command (Mv Dir) where   type Result (Mv Dir) = ()-  renderCommand (Mv old new) = formatCmd "mv"+  renderCommand (Mv _ old new) = formatCmd "mv"     [ Just "-fv"     , Just (fromAbsDir old)     , Just (fromAbsDir new) ]@@ -131,32 +134,35 @@ -- | Create symlinks.  data Ln where-  Ln :: Path Abs t -> Path Abs File -> Ln+  Ln :: TargetSystem -> Path Abs t -> Path Abs File -> Ln  instance Command Ln where   type Result Ln = ()-  renderCommand (Ln target linkName) = formatCmd "ln"-    [ Just "-svT"+  renderCommand (Ln ts target linkName) = formatCmd "ln"+    [ Just flags     , Just (toFilePath target)     , Just (fromAbsFile linkName) ]+    where flags = if isLinux ts then "-svT" else "-sv"   parseResult Proxy _ = ()  -- | Read link. -data Readlink t = Readlink (Path Abs File)+data Readlink t = Readlink TargetSystem (Path Abs File)  instance Command (Readlink File) where   type Result (Readlink File) = Path Abs File-  renderCommand (Readlink path) = formatCmd "readlink"-    [ Just "-f"+  renderCommand (Readlink ts path) = formatCmd "readlink"+    [ flags     , Just (toFilePath path) ]+    where flags = if isLinux ts then Just "-f" else Nothing   parseResult Proxy = fromJust . parseAbsFile . trim  instance Command (Readlink Dir) where   type Result (Readlink Dir) = Path Abs Dir-  renderCommand (Readlink path) = formatCmd "readlink"-    [ Just "-f"+  renderCommand (Readlink ts path) = formatCmd "readlink"+    [ flags     , Just (toFilePath path) ]+    where flags = if isLinux ts then Just "-f" else Nothing   parseResult Proxy = fromJust . parseAbsDir . trim  -- | @ls@, so far used only to check existence of directories, so it's not@@ -305,3 +311,6 @@  trim :: String -> String trim = dropWhileEnd isSpace . dropWhile isSpace++isLinux :: TargetSystem -> Bool+isLinux = (== GNULinux)

@@ -18,6 +18,7 @@   , SshOptions (..)   , OutputDest (..)   , Release+  , TargetSystem(..)   , mkRelease   , releaseTime   , renderRelease@@ -85,6 +86,13 @@  data Release = Release ReleaseFormat UTCTime   deriving (Eq, Show, Ord)++-- | Target's system where application will be deployed++data TargetSystem+  = GNULinux+  | BSD+  deriving (Eq, Show, Read, Ord, Bounded, Enum)  -- | Create a 'Release' indentifier.