@@ -12,7 +12,7 @@ import Control.Monad.IO.Class (liftIO)
1212import Data.Bits
1313import Data.Default
1414import qualified Data.Map as Map
15−import Data.Maybe
15+import qualified Data.Set as Set
1616import qualified Data.Text as T
1717import qualified Data.Text.IO as T
1818import System.Directory
@@ -82,7 +82,7 @@ setupObeliskImpl deployDir = do
8282
8383deployPush :: MonadObelisk m => FilePath -> m [String] -> m ()
8484deployPush deployPath getNixBuilders = do
85− host <- readDeployConfig deployPath "backend_hosts"
85+ hosts <- Set.fromList . filter (/= mempty) . lines <$> readDeployConfig deployPath "backend_hosts"
8686 adminEmail <- readDeployConfig deployPath "admin_email"
8787 enableHttps <- read <$> readDeployConfig deployPath "enable_https"
8888 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"
@@ -97,51 +97,50 @@ deployPush deployPath getNixBuilders = do
9797 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
9898 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
9999 builders <- getNixBuilders
100− buildOutput <- nixCmd $ NixCmd_Build $ def
101− & nixCmdConfig_target .~Target
102− { _target_path = Just srcPath
103− , _target_attr = Just "server.system"
104− , _target_expr = Nothing
105− }
106− & nixBuildConfig_outLink .~ OutLink_None
107− & nixCmdConfig_args .~
108− [ strArg "hostName" host
109− , strArg "adminEmail" adminEmail
110− , strArg "routeHost" routeHost
111− , strArg "version" version
112− , boolArg "enableHttps" enableHttps
113− , rawArg "config" $ deployPath </> "config"
114− ]
115− & nixCmdConfig_builders .~ builders
116− let result = listToMaybe $ lines buildOutput
117− forM_ result $ \res -> do
118− let knownHostsPath = deployPath </> "backend_known_hosts"
119− sshOpts = sshArgs knownHostsPath (deployPath </> "ssh_key") False
120− deployAndSwitch outputPath = do
121− withSpinner "Uploading closure" $ do
122− callProcess'
123− (Map.fromList [("NIX_SSHOPTS", unwords sshOpts)])
124− "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
125−
126− withSpinner "Switching to new configuration" $ do
127− callProcessAndLogOutput (Notice, Warning) $
128− proc "ssh" $ sshOpts <>
129− [ "root@" <> host
130− , unwords
131− [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
132− , "&&"
133− , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
134− ]
135− ]
136− deployAndSwitch res
137− isClean <- checkGitCleanStatus deployPath True
138− when (not isClean) $ do
139− withSpinner "Commiting changes to Git" $ do
140− callProcessAndLogOutput (Debug, Error) $ proc "git"
141− ["-C", deployPath, "add", "."]
142− callProcessAndLogOutput (Debug, Error) $ proc "git"
143− ["-C", deployPath, "commit", "-m", "New deployment"]
144− putLog Notice $ "Deployed => " <> T.pack route
100+ buildOutputByHost <- ifor (Map.fromSet (const ()) hosts) $ \host () -> do
101+ --TODO: What does it mean if this returns more or less than 1 line of output?
102+ [result] <- fmap lines $ nixCmd $ NixCmd_Build $ def
103+ & nixCmdConfig_target .~ Target
104+ { _target_path = Just srcPath
105+ , _target_attr = Just "server.system"
106+ , _target_expr = Nothing
107+ }
108+ & nixBuildConfig_outLink .~ OutLink_None
109+ & nixCmdConfig_args .~
110+ [ strArg "hostName" host
111+ , strArg "adminEmail" adminEmail
112+ , strArg "routeHost" routeHost
113+ , strArg "version" version
114+ , boolArg "enableHttps" enableHttps
115+ , rawArg "config" $ deployPath </> "config"
116+ ]
117+ & nixCmdConfig_builders .~ builders
118+ pure result
119+ let knownHostsPath = deployPath </> "backend_known_hosts"
120+ sshOpts = sshArgs knownHostsPath (deployPath </> "ssh_key") False
121+ withSpinner "Uploading closures" $ ifor_ buildOutputByHost $ \host outputPath -> do
122+ callProcess'
123+ (Map.fromList [("NIX_SSHOPTS", unwords sshOpts)])
124+ "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
125+ --TODO: Create GC root so we're sure our closure won't go away during this time period
126+ withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do
127+ callProcessAndLogOutput (Notice, Warning) $
128+ proc "ssh" $ sshOpts <>
129+ [ "root@" <> host
130+ , unwords
131+ [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
132+ , "&&"
133+ , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
134+ ]
135+ ]
136+ isClean <- checkGitCleanStatus deployPath True
137+ when (not isClean) $ do
138+ withSpinner "Commiting changes to Git" $ do
139+ callProcessAndLogOutput (Debug, Error) $ proc "git"
140+ ["-C", deployPath, "add", "."]
141+ callProcessAndLogOutput (Debug, Error) $ proc "git"
142+ ["-C", deployPath, "commit", "-m", "New deployment"]
143+ putLog Notice $ "Deployed => " <> T.pack route
145144 where
146145 callProcess' envMap cmd args = do
147146 processEnv <- Map.toList . (envMap <>) . Map.fromList <$> liftIO getEnvironment