Fix deployer checking stale state instead of actual running services

The deployer compared its in-memory stateServices map to decide if a
service needed restarting. When the deployer restarted, this state was
lost, causing it to think services were 'already at' the desired path
when they were actually running old code.

Changes:
- Add getRunningStorePath to Systemd module to read actual store path
- Update deployService to query systemd instead of stale in-memory state
- Add DerivingStrategies extension to Deployer.hs

2 files changed, 31 insertions, 4 deletions

diff --git a/Omni/Deploy/Deployer.hs b/Omni/Deploy/Deployer.hs
index ee06907..7e57b34 100644
--- a/Omni/Deploy/Deployer.hs
+++ b/Omni/Deploy/Deployer.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -74,7 +75,8 @@ s3Url = "s3://omni-nix-cache?profile=digitalocean&scheme=https&endpoint=nyc3.dig
 newtype DeployerState = DeployerState
   { stateServices :: Map Text Text
   }
-  deriving (Show, Eq, Generic, Aeson.FromJSON, Aeson.ToJSON)
+  deriving (Show, Eq, Generic)
+  deriving anyclass (Aeson.FromJSON, Aeson.ToJSON)
 
 emptyState :: DeployerState
 emptyState = DeployerState mempty
@@ -143,14 +145,16 @@ deployService :: Manifest.Service -> DeployerState -> IO (Bool, DeployerState)
 deployService svc st = do
   let name = Manifest.serviceName svc
       path = Manifest.storePath (Manifest.serviceArtifact svc)
-      currentPath = Map.lookup name (stateServices st)
 
-  if currentPath == Just path
+  -- Check what's actually running in systemd instead of in-memory state
+  runningPath <- Systemd.getRunningStorePath name
+
+  if runningPath == Just path
     then do
       Log.info ["deployer", name, "already at", path]
       pure (True, st)
     else do
-      Log.info ["deployer", "deploying", name, fromMaybe "new" currentPath, "->", path]
+      Log.info ["deployer", "deploying", name, fromMaybe "new" runningPath, "->", path]
 
       pulled <- pullClosure path
       if don't pulled
diff --git a/Omni/Deploy/Systemd.hs b/Omni/Deploy/Systemd.hs
index d7af1cd..7b64d1f 100644
--- a/Omni/Deploy/Systemd.hs
+++ b/Omni/Deploy/Systemd.hs
@@ -13,6 +13,7 @@ module Omni.Deploy.Systemd
     reloadAndRestart,
     stopAndDisable,
     removeUnit,
+    getRunningStorePath,
     servicesDir,
     main,
     test,
@@ -141,6 +142,28 @@ removeUnit baseDir sysDir serviceName' = do
   _ <- Process.readProcessWithExitCode "systemctl" ["daemon-reload"] ""
   pure ()
 
+-- | Get the store path of the currently running service by reading its unit file.
+getRunningStorePath :: Text -> IO (Maybe Text)
+getRunningStorePath serviceName' = do
+  let unitPath = servicesDir </> Text.unpack serviceName' <> ".service"
+  exists <- Dir.doesFileExist unitPath
+  if not exists
+    then pure Nothing
+    else do
+      content <- Text.IO.readFile unitPath
+      pure <| extractStorePath content
+  where
+    -- Extract /nix/store/...-service-name from ExecStart=/nix/store/.../bin/...
+    extractStorePath content =
+      content
+        |> Text.lines
+        |> find (Text.isPrefixOf "ExecStart=")
+        |> fmap (Text.drop (Text.length "ExecStart="))
+        |> fmap (Text.dropWhile (/= '/'))
+        |> fmap (Text.drop 1)
+        |> fmap (Text.takeWhile (/= '/'))
+        |> fmap ("/nix/store/" <>)
+
 test :: Test.Tree
 test =
   Test.group