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

1 files changed, 8 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