From 52d56172bd11ff6da55b63538b9d524cf735a87a Mon Sep 17 00:00:00 2001
From: Ben Radford <benradf@users.noreply.github.com>
Date: Wed, 28 Aug 2024 13:55:08 +0100
Subject: [PATCH] Embed version string and git commit hash in binary.

---
 .bazelrc            |  2 ++
 backend/BUILD.bazel |  7 +++++++
 backend/src/Main.hs | 27 +++++++++++++++++++++++++++
 release/version.bzl | 19 +++++++++++++++++++
 release/version.sh  |  4 ++++
 5 files changed, 59 insertions(+)
 create mode 100644 release/version.bzl
 create mode 100755 release/version.sh

diff --git a/.bazelrc b/.bazelrc
index 526f129..896ee71 100644
--- a/.bazelrc
+++ b/.bazelrc
@@ -16,4 +16,6 @@ run --host_platform=//backend:regular_executable --incompatible_enable_cc_toolch
 # We also need to setup an utf8 locale
 test --test_env=LANG=en_US.utf8 --test_env=LOCALE_ARCHIVE
 
+build --workspace_status_command "bash release/version.sh"
+
 try-import .bazelrc.local
diff --git a/backend/BUILD.bazel b/backend/BUILD.bazel
index ca0d8ef..b582976 100644
--- a/backend/BUILD.bazel
+++ b/backend/BUILD.bazel
@@ -1,4 +1,5 @@
 load("@rules_haskell//haskell:defs.bzl", "haskell_binary", "haskell_toolchain_library")
+load("//release:version.bzl", "copy_stable_status")
 
 constraint_setting(
     name = "executable_linking",
@@ -31,6 +32,11 @@ platform(
     visibility = ["//visibility:public"],
 )
 
+copy_stable_status(
+    name = "stable_status",
+    output = "stable-status.txt",
+)
+
 haskell_toolchain_library(name = "base")
 
 haskell_binary(
@@ -47,6 +53,7 @@ haskell_binary(
         ":src/Sqlite.hs",
     ],
     extra_srcs = [
+        ":stable_status",
         "//frontend:main.js",
         "//frontend:src/index.js",
         "//frontend:src/format.js",
diff --git a/backend/src/Main.hs b/backend/src/Main.hs
index 65e982d..eb35440 100644
--- a/backend/src/Main.hs
+++ b/backend/src/Main.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
 module Main where
@@ -12,18 +13,23 @@ import Control.Concurrent (threadDelay)
 import Control.Exception (bracket, tryJust)
 import Control.Monad (guard, when)
 import Data.Aeson (decode, encode)
+import qualified Data.ByteString.Char8 as BSC
+import Data.FileEmbed (embedFileIfExists)
 import Data.Foldable (asum, for_, traverse_)
 import Data.Functor (void, (<&>))
 import Data.List (isPrefixOf, stripPrefix)
+import qualified Data.Map as Map
 import Data.Maybe (fromMaybe, isNothing)
 import qualified Data.Text as Text
 import Data.UUID (UUID)
 import qualified Import
+import qualified Language.Haskell.TH as TH
 import Network.HTTP.Client (Request (..), RequestBody (..), defaultManagerSettings, httpLbs, newManager, parseRequest, responseBody, responseStatus)
 import Network.HTTP.Types (Status (..))
 import qualified Server
 import System.Directory (createDirectoryIfMissing)
 import System.Environment (getArgs, setEnv)
+import System.FilePath.Find (filePath, find, (~~?))
 import System.FilePath.Posix (takeBaseName)
 import System.IO (stdin)
 import System.IO.Error (isDoesNotExistError)
@@ -43,8 +49,29 @@ main = do
     ["server"] -> pure ()
     "import" : args -> importWorkspace args
     "import-graphviz" : args -> importGraphviz args
+    ["--version"] -> putStrLn version
     _ -> usageError
 
+version :: String
+version = do
+  let stableStatus =
+        BSC.unpack $
+          fromMaybe "" $
+            $( embedFileIfExists
+                 $( do
+                      found <- TH.runIO $ find (pure True) (filePath ~~? "**/stable-status.txt") "."
+                      pure $
+                        TH.LitE $
+                          TH.StringL $ case found of
+                            [path] -> path
+                            [] -> ""
+                            _ -> error "unexpectedly found multiple Version.hs files"
+                  )
+             )
+      fields = Map.fromList $ words <$> lines stableStatus <&> \[k, v] -> (k, v)
+      lookupField k = fromMaybe "(unknown)" $ Map.lookup k fields
+  lookupField "STABLE_VERSION" <> " (built from " <> lookupField "STABLE_GIT_COMMIT" <> ")"
+
 restartServer :: IO ()
 restartServer = do
   traverse_ attemptTerminate =<< getPidFromFile
diff --git a/release/version.bzl b/release/version.bzl
new file mode 100644
index 0000000..c9ae477
--- /dev/null
+++ b/release/version.bzl
@@ -0,0 +1,19 @@
+def _copy_stable_status(ctx):
+    ctx.actions.run_shell(
+        inputs = [ctx.info_file],
+        outputs = [ctx.outputs.output],
+        mnemonic = "CopyStableStatus",
+        command = "sed -n '/^STABLE_/p' {INFO_FILE} >{OUTPUT}".format(
+            INFO_FILE = ctx.info_file.path,
+            OUTPUT = ctx.outputs.output.path,
+        ),
+    )
+
+copy_stable_status = rule(
+    implementation = _copy_stable_status,
+    attrs = {
+        "output" : attr.output(
+            mandatory = True,
+        ),
+    },
+)
diff --git a/release/version.sh b/release/version.sh
new file mode 100755
index 0000000..a36a60c
--- /dev/null
+++ b/release/version.sh
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+set -eu
+echo "STABLE_VERSION 0.4.4"
+echo "STABLE_GIT_COMMIT $(git rev-parse HEAD)"