Maintenance mode commands (#169)

* Create maintenance command

* Read filepath and filename

zsh:1: command not found: q

* Addd config and test

* Addd config and test

* Add tests and imports

* Add test for writing maintenance file

Co-authored-by: Cristhian Motoche <CristhianMotoche@users.noreply.github.com>

* Expand writeMaintenancFile function

Co-authored-by: Cristhian Motoche <CristhianMotoche@users.noreply.github.com>

* Add functionality for command enable

Co-authored-by: Cristhian Motoche <CristhianMotoche@users.noreply.github.com>

* Add delete function

* Add filename and directory from configPath

zsh:1: command not found: wq

* Remove unused file

* Change variable name

* Remove Utils from cabal file

* Remove environment file

* Change pattern

* Add suggested formatting and comments

* Add more suggestions and option to run stack

* Update README with new variables

* Update README with changes

Co-authored-by: Cristhian Motoche <CristhianMotoche@users.noreply.github.com>

.gitignore

@@ -21,3 +21,4 @@ dist-newstyle
 result
 nix/
 shell.nix
+.ghc.environment.*

README.md

@@ -151,6 +151,8 @@ Rollback is also trivial:
 $ hap rollback # to rollback to previous successful deploy
 $ hap rollback -n 2 # go two deploys back in time, etc.
 ```
+* `maintenance_directory:`- The name of the directory on which the maintenance file will be placed. `{deploy_path}/{maintenance_directory}`. The default directory name is `maintenance`
+* `maintenance_filename:`- The name of the file that is going to be created in the maintenance_directory. It has to have the `.html` extension to be seen in the browser. `{deploy_path}/{maintenance_directory}/{maintenance_filename}`. The default filename is `maintenance.html`
 
 ### Environment Variables
 
@@ -248,12 +250,26 @@ For just building Hapistrano, you just:
 ```bash
 nix-build release.nix
 ```
+## Enable/disable maintenance mode
+
+Present a maintenance page to visitors. Disables your application's web interface by writing a {maintenance_filename} file to each web server. The servers must be configured to detect the presence of this file, and if it is present, always display it instead of performing the request.
+
+The maintenance page will just say the site is down for maintenance, and will be back shortly.
+
+To enable maintenance mode run:
+```bash
+hapistrano maintenance enable
+```
+Disabling maintenance mode will remove the file from the {maintenance_directory} it can be done with the following command:
+
+```bash
+hapistrano maintenance disable
+```
 
 ## Notes
 
 * Hapistrano is not supported on Windows. Please check: [Issue #96](https://github.com/stackbuilders/hapistrano/issues/96).
 
-
 ## License
 
 MIT, see [the LICENSE file](LICENSE).

app/Main.hs

@@ -24,6 +24,7 @@ import qualified System.Hapistrano          as Hap
 import qualified System.Hapistrano.Commands as Hap
 import qualified System.Hapistrano.Config   as C
 import qualified System.Hapistrano.Core     as Hap
+import qualified System.Hapistrano.Maintenance as Hap
 import           System.Hapistrano.Types
 import           System.IO
 import           System.Hapistrano (createHapistranoDeployState)
@@ -55,7 +56,10 @@ optionParser = Opts
   ( command "deploy"
     (info deployParser (progDesc "Deploy a new release")) <>
     command "rollback"
-    (info rollbackParser (progDesc "Roll back to Nth previous release")) )
+    (info rollbackParser (progDesc "Roll back to Nth previous release")) <>
+    command "maintenance"
+    (info maintenanceParser (progDesc "Enable/Disable maintenance mode"))
+    )
   <*> strOption
   ( long "config"
   <> short 'c'
@@ -94,6 +98,14 @@ rollbackParser = Rollback
   <> showDefault
   <> help "How many deployments back to go?" )
 
+maintenanceParser :: Parser Command
+maintenanceParser =
+  Maintenance
+    <$> hsubparser
+      ( command "enable" (info (pure Enable) (progDesc "Enables maintenance mode"))
+          <> command "disable" (info (pure Disable) (progDesc "Disables maintenance mode"))
+      )
+
 pReleaseFormat :: ReadM ReleaseFormat
 pReleaseFormat = eitherReader $ \s ->
   case s of
@@ -134,7 +146,7 @@ main = do
                     case maybeRelease of
                       (Just release) -> do
                         createHapistranoDeployState configDeployPath release Fail
-                        Hap.dropOldReleases configDeployPath keepReleases keepOneFailed 
+                        Hap.dropOldReleases configDeployPath keepReleases keepOneFailed
                         throwError e
                       Nothing -> do
                         throwError e
@@ -166,11 +178,15 @@ main = do
                 Hap.activateRelease configTargetSystem configDeployPath release
                 forM_ configRestartCommand (flip Hap.exec $ Just release)
                 Hap.createHapistranoDeployState configDeployPath release System.Hapistrano.Types.Success
-                Hap.dropOldReleases configDeployPath keepReleases keepOneFailed 
+                Hap.dropOldReleases configDeployPath keepReleases keepOneFailed
               `catchError` failStateAndThrow
             Rollback n -> do
               Hap.rollback configTargetSystem configDeployPath n
               forM_ configRestartCommand (flip Hap.exec Nothing)
+            Maintenance Enable-> do
+              Hap.writeMaintenanceFile configDeployPath configMaintenanceDirectory configMaintenanceFileName
+            Maintenance _ -> do
+              Hap.deleteMaintenanceFile configDeployPath configMaintenanceDirectory configMaintenanceFileName
         atomically (writeTChan chan FinishMsg)
         return r
       printer :: Int -> IO ()

hapistrano.cabal

@@ -50,6 +50,7 @@ library
                      , System.Hapistrano.Core
                      , System.Hapistrano.Types
                      , System.Hapistrano.Commands.Internal
+                     , System.Hapistrano.Maintenance
   build-depends:       aeson              >= 2.0 && < 3.0
                      , ansi-terminal      >= 0.9 && < 0.12
                      , base               >= 4.9 && < 5.0

spec/System/HapistranoConfigSpec.hs

@@ -11,9 +11,9 @@ import           System.Hapistrano.Types  (Shell (..),
 
 import qualified Data.Yaml.Config         as Yaml
 #if MIN_VERSION_base(4,15,0)
-import           Path                     (mkAbsDir)
+import           Path                     (mkAbsDir, mkRelDir, mkRelFile)
 #else
-import           Path                     (mkAbsDir, Abs, Dir)
+import           Path                     (mkAbsDir, mkRelDir, mkRelFile, Abs, Rel, Dir, File)
 #endif
 import           Test.Hspec
 
@@ -64,4 +64,6 @@ defaultConfiguration =
     , configKeepReleases = Nothing
     , configKeepOneFailed = False
     , configWorkingDir = Nothing
+    , configMaintenanceDirectory = $(mkRelDir "maintenance")
+    , configMaintenanceFileName = $(mkRelFile "maintenance.html")
     }

spec/System/HapistranoSpec.hs

@@ -31,6 +31,10 @@ import Test.Hspec.QuickCheck
 import Test.QuickCheck hiding (Success)
 import System.Hapistrano (releasePath)
 import System.Hapistrano.Config (deployStateFilename)
+import System.Directory
+import System.Hapistrano.Maintenance
+import Path
+import Control.Monad.IO.Class
 
 testBranchName :: String
 testBranchName = "another_branch"
@@ -105,6 +109,21 @@ spec = do
         it "returns the default value" $
         fromMaybeKeepReleases Nothing Nothing `Hspec.shouldBe` 5
   around withSandbox $ do
+    describe "writeMaintenanceFile" $
+      context "when the file doesn't exist" $
+        it "creates the maintenance file in the given path" $ \(deployPath, _) -> do
+          result <- runHap $ do
+            writeMaintenanceFile deployPath $(mkRelDir "maintenance") $(mkRelFile "maintenance.html")
+            liftIO $ System.Directory.doesFileExist ((fromAbsDir deployPath) <> "/maintenance/maintenance.html")
+          result `shouldBe` True
+    describe "deleteMaintenanceFile" $
+      context "when the file exists" $
+        it "removes the maintenance file from the given path" $ \(deployPath, _) -> do
+          result <- runHap $ do
+            writeMaintenanceFile deployPath $(mkRelDir "maintenance") $(mkRelFile "maintenance.html")
+            deleteMaintenanceFile deployPath $(mkRelDir "maintenance") $(mkRelFile "maintenance.html")
+            liftIO $ System.Directory.doesFileExist ((fromAbsDir deployPath) <> "/maintenance/maintenance.html")
+          result `shouldBe` False
     describe "releasePath" $ do
       context "when the configWorkingDir is Nothing" $
         it "should return the release path" $ \(deployPath, repoPath) -> do

src/System/Hapistrano/Config.hs

@@ -11,6 +11,7 @@
 {-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -77,7 +78,9 @@ data Config = Config
   -- The @--keep-one-failed@ argument passed via the CLI takes precedence over this value.
   -- If neither CLI or configuration file value is specified, it defaults to `False`
   -- (i.e. keep all failed releases).
-  , configWorkingDir     :: !(Maybe (Path Rel Dir))
+  , configWorkingDir :: !(Maybe (Path Rel Dir))
+  , configMaintenanceDirectory :: !(Path Rel Dir)
+  , configMaintenanceFileName :: !(Path Rel File)
   } deriving (Eq, Ord, Show)
 
 -- | Information about source and destination locations of a file\/directory
@@ -135,6 +138,8 @@ instance FromJSON Config where
     configKeepReleases <- o .:? "keep_releases"
     configKeepOneFailed <- o .:? "keep_one_failed" .!= False
     configWorkingDir <- o .:? "working_directory"
+    configMaintenanceDirectory <- o .:? "maintenance_directory" .!= $(mkRelDir "maintenance")
+    configMaintenanceFileName <- o .:? "maintenance_filename" .!= $(mkRelFile "maintenance.html")
     return Config {..}
 
 instance FromJSON CopyThing where

src/System/Hapistrano/Maintenance.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module System.Hapistrano.Maintenance
+  ( writeMaintenanceFile
+  , deleteMaintenanceFile
+  ) where
+
+import Path (Abs, Dir, File, Path, Rel, (</>))
+import System.Hapistrano.Commands
+import System.Hapistrano.Core
+import System.Hapistrano.Types
+
+-- | It writes an HTML page in the given directory with a given name
+writeMaintenanceFile ::
+     Path Abs Dir -> Path Rel Dir -> Path Rel File -> Hapistrano ()
+writeMaintenanceFile deployPath relDir fileName =
+  let foo = deployPath </> relDir
+      fullpath = relDir </> fileName
+      root = deployPath </> fullpath
+   in do exec (MkDir foo) Nothing
+         exec (Touch root) Nothing
+         exec (BasicWrite root maintenancePageContent) Nothing
+
+-- | It deletes the file in the given directory with the given name
+deleteMaintenanceFile ::
+     Path Abs Dir -> Path Rel Dir -> Path Rel File -> Hapistrano ()
+deleteMaintenanceFile deployPath relDir fileName =
+  let fullpath = relDir </> fileName
+      root = deployPath </> fullpath
+   in exec (Rm root) Nothing
+
+maintenancePageContent :: String
+maintenancePageContent =
+  "<!DOCTYPE html> \n\
+  \<html>\n\
+  \ <head>\n\
+  \ <title>Maintenance</title>\n\
+  \ <style type=\"text/css\">\n\
+  \   body {\n\
+  \     width: 400px;\n\
+  \     margin: 100px auto;\n\
+  \     font: 300 120% \"OpenSans\", \"Helvetica Neue\", \"Helvetica\", Arial, Verdana, sans-serif;\n\
+  \    }\n\
+  \   h1 {\n\
+  \     font-weight: 300;\n\
+  \    }\n\
+  \ </style>\n\
+  \ </head>\n\
+  \ <body>\n\
+  \   <h1>Maintenance</h1>\n\
+  \   <p>The system is down for maintenance</p>\n\
+  \   <p>It'll be back shortly</p>\n\
+  \ </body>\n\
+  \</html>"

src/System/Hapistrano/Types.hs

@@ -25,6 +25,7 @@ module System.Hapistrano.Types
   , Shell(..)
   , Opts(..)
   , Command(..)
+  , MaintenanceOptions(..)
   -- * Types helpers
   , mkRelease
   , releaseTime
@@ -152,7 +153,9 @@ data DeployState
   | Unknown
   deriving (Eq, Show, Read, Ord, Bounded, Enum)
 
--- Command line options
+-- | Maintenance options
+
+data MaintenanceOptions = Enable | Disable
 
 -- | Command line options.
 
@@ -168,7 +171,7 @@ data Command
     -- format, how many releases to keep, and whether the failed releases except the latest one
     -- get deleted or not)
   | Rollback Natural -- ^ Rollback to Nth previous release
-
+  | Maintenance MaintenanceOptions
 
 -- | Create a 'Release' indentifier.
 mkRelease :: ReleaseFormat -> UTCTime -> Release

stack.yaml

@@ -1,3 +1,4 @@
 resolver: lts-17.10
 packages:
   - .
+allow-newer: true