Keep a log of deployed releases, and added a subcommand to display it

README.md

@@ -12,6 +12,7 @@ Usage:
   hx-deploy-tool list-releases
   hx-deploy-tool unpack <release> <todir>
   hx-deploy-tool select <release>
+  hx-deploy-tool show-log
   hx-deploy-tool aws-docker-login-cmd
 
 The config file is read from the file specified with HX_DEPLOY_CONFIG.
@@ -79,6 +80,10 @@ Specifically it:
  - stops the current release (if any)
  - starts the new release
  - switches the `current` symlink to point to the new release
+
+# hx-deploy-tool show-log
+
+Show the history of releases deployed via the select command.
 ```
 
 The tool is configured with an ADL specified json

adl/config.adl

@@ -13,6 +13,7 @@ struct DeployContextFile
 struct ToolConfig {
     FilePath releasesDir = "/opt/releases";
     FilePath contextCache = "/opt/etc/deployment";
+    FilePath logFile = "/opt/var/log/hx-deploy-tool.log";
     S3Path releasesS3;
     Vector<DeployContextFile> deployContextFiles;
 };

hx-deploy-tool.cabal

@@ -45,6 +45,7 @@ executable hx-deploy-tool
                      , resourcet >= 1.1.9 && < 1.3
                      , scientific >= 0.3.4 && < 0.4
                      , text >= 1.2 && < 1.3
+                     , time >= 1.8 && < 1.10
                      , unix >= 2.7 && < 2.8
                      , unordered-containers >= 0.2.7 && < 0.3
                      , vector >= 0.11 && < 0.13

scripts/gen-adl.sh

@@ -1,4 +1,4 @@
-#!/bin/sh
+#!/bin/bash
 set -e
 ROOT="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"/..
 rm -rf $ROOT/src/ADL

src/ADL/Config.hs

@@ -36,26 +36,29 @@ instance AdlValue DeployContextFile where
 data ToolConfig = ToolConfig
     { tc_releasesDir :: ADL.Types.FilePath
     , tc_contextCache :: ADL.Types.FilePath
+    , tc_logFile :: ADL.Types.FilePath
     , tc_releasesS3 :: ADL.Types.S3Path
     , tc_deployContextFiles :: [DeployContextFile]
     }
     deriving (Prelude.Eq,Prelude.Ord,Prelude.Show)
 
 mkToolConfig :: ADL.Types.S3Path -> [DeployContextFile] -> ToolConfig
-mkToolConfig releasesS3 deployContextFiles = ToolConfig "/opt/releases" "/opt/etc/deployment" releasesS3 deployContextFiles
+mkToolConfig releasesS3 deployContextFiles = ToolConfig "/opt/releases" "/opt/etc/deployment" "/opt/var/log/hx-deploy-tool.log" releasesS3 deployContextFiles
 
 instance AdlValue ToolConfig where
     atype _ = "config.ToolConfig"
 
     jsonGen = genObject
         [ genField "releasesDir" tc_releasesDir
         , genField "contextCache" tc_contextCache
+        , genField "logFile" tc_logFile
         , genField "releasesS3" tc_releasesS3
         , genField "deployContextFiles" tc_deployContextFiles
         ]
 
     jsonParser = ToolConfig
         <$> parseFieldDef "releasesDir" "/opt/releases"
         <*> parseFieldDef "contextCache" "/opt/etc/deployment"
+        <*> parseFieldDef "logFile" "/opt/var/log/hx-deploy-tool.log"
         <*> parseField "releasesS3"
         <*> parseField "deployContextFiles"

src/Commands.hs

@@ -32,11 +32,12 @@ import Data.Monoid
 import Data.Conduit((.|), ($$), ($$+-))
 import Data.Conduit.Binary(sinkFile)
 import Data.Foldable(for_)
+import Data.Time.Clock.POSIX(getCurrentTime)
 import Data.Traversable(for)
 import System.Directory(createDirectoryIfMissing,doesFileExist,doesDirectoryExist,withCurrentDirectory)
 import System.FilePath(takeBaseName, takeDirectory, dropExtension, (</>))
 import System.Posix.Files(createSymbolicLink, removeLink)
-import System.IO(stdout)
+import System.IO(stdout, withFile, hIsEOF, IOMode(..))
 import System.Process(callProcess,callCommand)
 import Network.AWS.Data.Body(RsBody(..))
 import Network.AWS.Data.Text(ToText(..))
@@ -86,6 +87,9 @@ select tcfg release = do
   let newReleaseDir = T.unpack (tc_releasesDir tcfg) </> (takeBaseName (T.unpack release))
   let currentReleaseLink = T.unpack (tc_releasesDir tcfg) </> "current"
 
+  -- Log the request
+  logMessage tcfg ("Selecting release " <> release)
+
   -- Fetch the context in case it has been updated
   fetchContext tcfg Nothing
 
@@ -156,6 +160,18 @@ awsDockerLoginCmd tcfg = do
           Nothing -> endpoint
           (Just endpoint) -> endpoint
 
+-- dump the log file
+showLog :: ToolConfig -> IO ()
+showLog tcfg = do
+  let logFile = T.unpack (tc_logFile tcfg)
+  withFile logFile ReadMode $ \h -> nextLine h
+  where
+    nextLine h = do
+      eof <- hIsEOF h
+      when (not eof) $ do
+        T.hGetLine h >>= T.putStrLn
+        nextLine h
+
 downloadFileFromS3 :: Env -> S3.BucketName -> S3.ObjectKey -> FilePath -> Maybe Int -> IO ()
 downloadFileFromS3 env bucketName  objectKey toFilePath retryAfter = do
   handling _ServiceError onServiceError $ do
@@ -217,3 +233,12 @@ toFilePath :: FilePath -> Path Abs File
 toFilePath path = case parseAbsFile path of
   Just p -> p
   Nothing -> error "Unable to parse directory"
+
+-- crude and slow function to write a line to the log file
+logMessage :: ToolConfig -> T.Text -> IO ()
+logMessage tcfg message = do
+  now <- getCurrentTime
+  let logFile = T.unpack (tc_logFile tcfg)
+      ltext = T.pack (show now) <> ": " <> message <> "\n"
+  createDirectoryIfMissing True (takeDirectory logFile)
+  T.appendFile logFile ltext

src/Main.hs

@@ -6,7 +6,7 @@ import qualified Data.Text.IO as T
 
 import ADL.Config(ToolConfig(..))
 import ADL.Core(adlFromJsonFile')
-import Commands(fetchContext, listReleases, select, unpack, awsDockerLoginCmd)
+import Commands(fetchContext, listReleases, select, unpack, awsDockerLoginCmd, showLog)
 import System.Environment(getArgs, lookupEnv, getExecutablePath)
 import System.Exit(exitWith,ExitCode(..))
 import System.FilePath(takeDirectory, (</>))
@@ -20,6 +20,7 @@ usageText = "\
   \  hx-deploy-tool list-releases\n\
   \  hx-deploy-tool unpack <release> <todir>\n\
   \  hx-deploy-tool select <release>\n\
+  \  hx-deploy-tool show-log\n\
   \  hx-deploy-tool aws-docker-login-cmd\n\
   \\n\
   \The config file is read from the file specified with HX_DEPLOY_CONFIG.\n\
@@ -89,6 +90,11 @@ helpText = "\
   \ - stops the current release (if any)\n\
   \ - starts the new release\n\
   \ - switches the `current` symlink to point to the new release\n\
+  \\n\
+  \# hx-deploy-tool show-log\n\
+  \\n\
+  \Show the history of releases deployed via the select command.\n\
+  \\n\
   \"
 
 usage :: IO ()
@@ -130,6 +136,9 @@ main = do
     ["select", release] -> do
       config <- adlFromJsonFile' configPath
       select config (T.pack release)
+    ["show-log"] -> do
+      config <- adlFromJsonFile' configPath
+      showLog config
     ["aws-docker-login-cmd"] -> do
       config <- adlFromJsonFile' configPath
       awsDockerLoginCmd config