diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## 0.3.9.4 +### Added +* Support for GHC 8.8 +* Support for ssh args in the config file. + ## 0.3.9.3 ### Changed * Support for optparse-applicative-0.15 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014 Stack Builders Inc. +Copyright (c) 2015-Present Stack Builders Inc. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,6 @@ -[![Build Status](https://travis-ci.org/stackbuilders/hapistrano.svg?branch=master)](https://travis-ci.org/stackbuilders/hapistrano) [![Hackage version](https://img.shields.io/hackage/v/hapistrano.svg)](http://hackage.haskell.org/package/hapistrano) +[![Build Status](https://travis-ci.org/stackbuilders/hapistrano.svg?branch=master)](https://travis-ci.org/stackbuilders/hapistrano) +[![Hackage version](https://img.shields.io/hackage/v/hapistrano.svg)](http://hackage.haskell.org/package/hapistrano) +[![Docker Hub](https://img.shields.io/docker/build/stackbuilders/hapistrano.svg?style=flat)](https://hub.docker.com/r/stackbuilders/hapistrano) # Hapistrano @@ -59,6 +61,7 @@ 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. +* `ssh_args` — Optional ssh arguments. Only `-p` is passed via the `port` variable. * `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 diff --git a/app/Config.hs b/app/Config.hs --- a/app/Config.hs +++ b/app/Config.hs @@ -6,7 +6,8 @@ module Config ( Config (..) - , CopyThing (..) ) + , CopyThing (..) + , Target (..)) where import Data.Aeson @@ -26,8 +27,8 @@ data Config = Config { configDeployPath :: !(Path Abs Dir) -- ^ Top-level deploy directory on target machine - , configHosts :: ![(String, Word, Shell)] - -- ^ Hosts\/ports to deploy to. If empty, localhost will be assumed. + , configHosts :: ![Target] + -- ^ Hosts\/ports\/shell\/ssh args to deploy to. If empty, localhost will be assumed. , configRepo :: !String -- ^ Location of repository that contains the source code to deploy , configRevision :: !String @@ -69,22 +70,33 @@ data CopyThing = CopyThing FilePath FilePath deriving (Eq, Ord, Show) +data Target = + Target + { targetHost :: String + , targetPort :: Word + , targetShell :: Shell + , targetSshArgs :: [String] + } deriving (Eq, Ord, Show) + instance FromJSON Config where parseJSON = withObject "Hapistrano configuration" $ \o -> do configDeployPath <- o .: "deploy_path" let grabPort m = m .:? "port" .!= 22 grabShell m = m .:? "shell" .!= Bash + grabSshArgs m = m .:? "ssh_args" .!= [] host <- o .:? "host" port <- grabPort o shell <- grabShell o - hs <- (o .:? "targets" .!= []) >>= mapM (\m -> do - host' <- m .: "host" - port' <- grabPort m - shell' <- grabShell m - return (host', port', shell')) - let first (h, _, _) = h + sshArgs <- grabSshArgs o + hs <- (o .:? "targets" .!= []) >>= mapM (\m -> + Target + <$> m .: "host" + <*> grabPort m + <*> grabShell m + <*> grabSshArgs m) + let first Target{..} = host configHosts = nubBy ((==) `on` first) - (maybeToList ((,,) <$> host <*> pure port <*> pure shell) ++ hs) + (maybeToList (Target <$> host <*> pure port <*> pure shell <*> pure sshArgs) ++ hs) configRepo <- o .: "repo" configRevision <- o .: "revision" configRestartCommand <- (o .:? "restart_command") >>= diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -182,8 +182,8 @@ case configHosts of [] -> [hap Bash Nothing] -- localhost, no SSH xs -> - let runHap (host, port, shell) = - hap shell (Just $ SshOptions host port) + let runHap (C.Target{..}) = + hap targetShell (Just $ SshOptions targetHost targetPort targetSshArgs) in runHap <$> xs results <- (runConcurrently . traverse Concurrently) ((Right () <$ printer (length haps)) : haps) diff --git a/hapistrano.cabal b/hapistrano.cabal --- a/hapistrano.cabal +++ b/hapistrano.cabal @@ -1,5 +1,5 @@ name: hapistrano -version: 0.3.9.3 +version: 0.3.9.4 synopsis: A deployment library for Haskell applications description: . @@ -22,13 +22,13 @@ license-file: LICENSE author: Justin Leitgeb maintainer: jpaucar@stackbuilders.com -copyright: 2015-2018 Stack Builders Inc. +copyright: 2015-Present Stack Builders Inc. category: System homepage: https://github.com/stackbuilders/hapistrano bug-reports: https://github.com/stackbuilders/hapistrano/issues build-type: Simple cabal-version: >=1.18 -tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1 +tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 extra-source-files: CHANGELOG.md , README.md , Dockerfile @@ -60,7 +60,7 @@ , path >= 0.5 && < 0.7 , process >= 1.4 && < 1.7 , typed-process >= 0.2 && < 0.3 - , time >= 1.5 && < 1.9 + , time >= 1.5 && < 1.10 , transformers >= 0.4 && < 0.6 if flag(dev) ghc-options: -Wall -Werror @@ -110,6 +110,8 @@ , QuickCheck >= 2.5.1 && < 3.0 , silently >= 1.2 && < 1.3 , temporary >= 1.1 && < 1.4 + build-tools: hspec-discover >= 2.0 && < 3.0 + if flag(dev) ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Werror else diff --git a/spec/System/HapistranoSpec.hs b/spec/System/HapistranoSpec.hs --- a/spec/System/HapistranoSpec.hs +++ b/spec/System/HapistranoSpec.hs @@ -7,7 +7,7 @@ import Control.Monad import Control.Monad.Reader import Data.List (isPrefixOf) -import Data.Maybe (catMaybes) +import Data.Maybe (mapMaybe) import Numeric.Natural import Path import Path.IO @@ -143,7 +143,7 @@ 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"] + let localCommands = mapMaybe Hap.mkGenericCommand ["pwd", "ls"] task = mkTask deployPath repoPath Hap.playScriptLocally localCommands release <- Hap.pushRelease task @@ -152,7 +152,7 @@ describe "playScriptLocally (error exit)" $ it "check that deployment isn't done" $ \(deployPath, repoPath) -> (runHap $ do - let localCommands = catMaybes $ map Hap.mkGenericCommand ["pwd", "ls", "false"] + let localCommands = mapMaybe Hap.mkGenericCommand ["pwd", "ls", "false"] task = mkTask deployPath repoPath Hap.playScriptLocally localCommands release <- Hap.pushRelease task diff --git a/src/System/Hapistrano.hs b/src/System/Hapistrano.hs --- a/src/System/Hapistrano.hs +++ b/src/System/Hapistrano.hs @@ -1,9 +1,9 @@ -- | -- Module : System.Hapistrano --- Copyright : © 2015-2017 Stack Builders +-- Copyright : © 2015-Present Stack Builders -- License : MIT -- --- Maintainer : Justin Leitgeb +-- Maintainer : Juan Paucar -- Stability : experimental -- Portability : portable -- @@ -35,9 +35,9 @@ import Control.Monad import Control.Monad.Except import Control.Monad.Reader (local) -import Data.List (dropWhileEnd, genericDrop, sortBy) +import Data.List (dropWhileEnd, genericDrop, sortOn) import Data.Maybe (mapMaybe) -import Data.Ord (Down (..), comparing) +import Data.Ord (Down (..)) import Data.Time import Numeric.Natural import Path @@ -219,7 +219,7 @@ let rpath = releasesPath deployPath xs <- exec (Find 1 rpath :: Find Dir) ps <- stripDirs rpath (filter (/= rpath) xs) - (return . sortBy (comparing Down) . mapMaybe parseRelease) + (return . sortOn Down . mapMaybe parseRelease) (dropWhileEnd (== '/') . fromRelDir <$> ps) -- | Return a list of successfully completed releases sorted newest first. @@ -231,7 +231,7 @@ let cpath = ctokensPath deployPath xs <- exec (Find 1 cpath :: Find File) ps <- stripDirs cpath xs - (return . sortBy (comparing Down) . mapMaybe parseRelease) + (return . sortOn Down . mapMaybe parseRelease) (dropWhileEnd (== '/') . fromRelFile <$> ps) ---------------------------------------------------------------------------- diff --git a/src/System/Hapistrano/Commands.hs b/src/System/Hapistrano/Commands.hs --- a/src/System/Hapistrano/Commands.hs +++ b/src/System/Hapistrano/Commands.hs @@ -1,9 +1,9 @@ -- | -- Module : System.Hapistrano.Commands --- Copyright : © 2015-2017 Stack Builders +-- Copyright : © 2015-Present Stack Builders -- License : MIT -- --- Maintainer : Justin Leitgeb +-- Maintainer : Juan Paucar -- Stability : experimental -- Portability : portable -- @@ -288,7 +288,7 @@ -- | Read commands from a file. readScript :: MonadIO m => Path Abs File -> m [GenericCommand] -readScript path = liftIO $ catMaybes . fmap mkGenericCommand . lines +readScript path = liftIO $ mapMaybe mkGenericCommand . lines <$> readFile (fromAbsFile path) ---------------------------------------------------------------------------- diff --git a/src/System/Hapistrano/Core.hs b/src/System/Hapistrano/Core.hs --- a/src/System/Hapistrano/Core.hs +++ b/src/System/Hapistrano/Core.hs @@ -1,9 +1,9 @@ -- | -- Module : System.Hapistrano.Core --- Copyright : © 2015-2017 Stack Builders +-- Copyright : © 2015-Present Stack Builders -- License : MIT -- --- Maintainer : Justin Leitgeb +-- Maintainer : Juan Paucar -- Stability : experimental -- Portability : portable -- @@ -110,7 +110,7 @@ Nothing -> (renderShell configShellOptions, ["-c", cmd]) Just SshOptions {..} -> - ("ssh", [sshHost, "-p", show sshPort, cmd]) + ("ssh", sshArgs ++ [sshHost, "-p", show sshPort, cmd]) where renderShell :: Shell -> String renderShell Zsh = "zsh" diff --git a/src/System/Hapistrano/Types.hs b/src/System/Hapistrano/Types.hs --- a/src/System/Hapistrano/Types.hs +++ b/src/System/Hapistrano/Types.hs @@ -1,15 +1,16 @@ -- | -- Module : System.Hapistrano.Types --- Copyright : © 2015-2017 Stack Builders +-- Copyright : © 2015-Present Stack Builders -- License : MIT -- --- Maintainer : Justin Leitgeb +-- Maintainer : Juan Paucar -- Stability : experimental -- Portability : portable -- -- Type definitions for the Hapistrano tool. {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} module System.Hapistrano.Types ( Hapistrano @@ -79,8 +80,7 @@ deriving (Show, Read, Eq, Ord, Enum, Bounded) instance FromJSON ReleaseFormat where - parseJSON = withText "release format" $ \t -> - case t of + parseJSON = withText "release format" $ \case "short" -> return ReleaseShort "long" -> return ReleaseLong _ -> fail "expected 'short' or 'long'" @@ -92,17 +92,17 @@ deriving (Show, Eq, Ord) instance FromJSON Shell where - parseJSON = withText "shell" $ \t -> - case t of + parseJSON = withText "shell" $ \case "bash" -> return Bash "zsh" -> return Zsh - _ -> fail "supported shells: 'bash' or 'zsh'" + _ -> fail "supported shells: 'bash' or 'zsh'" -- | SSH options. data SshOptions = SshOptions - { sshHost :: String -- ^ Host to use - , sshPort :: Word -- ^ Port to use + { sshHost :: String -- ^ Host to use + , sshPort :: Word -- ^ Port to use + , sshArgs :: [String] -- ^ Arguments for ssh } deriving (Show, Read, Eq, Ord) -- | Output destination.