@@ -19,6 +19,7 @@ import Data.Map (Map)
1919import qualified Data.Map as Map
2020import Data.Maybe
2121import Data.Text (Text)
22+import qualified Data.Set as Set
2223import qualified Data.Text as T
2324import qualified Data.Text.IO as T
2425import GHC.Generics
@@ -90,7 +91,7 @@ setupObeliskImpl deployDir = do
9091
9192deployPush :: MonadObelisk m => FilePath -> m [String] -> m ()
9293deployPush deployPath getNixBuilders = do
93− host <- readDeployConfig deployPath "backend_hosts"
94+ hosts <- Set.fromList . filter (/= mempty) . lines <$> readDeployConfig deployPath "backend_hosts"
9495 adminEmail <- readDeployConfig deployPath "admin_email"
9596 enableHttps <- read <$> readDeployConfig deployPath "enable_https"
9697 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"
@@ -105,51 +106,50 @@ deployPush deployPath getNixBuilders = do
105106 Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
106107 let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
107108 builders <- getNixBuilders
108− buildOutput <- nixCmd $ NixCmd_Build $ def
109− & nixCmdConfig_target .~Target
110− { _target_path = Just srcPath
111− , _target_attr = Just "server.system"
112− , _target_expr = Nothing
113− }
114− & nixBuildConfig_outLink .~ OutLink_None
115− & nixCmdConfig_args .~
116− [ strArg "hostName" host
117− , strArg "adminEmail" adminEmail
118− , strArg "routeHost" routeHost
119− , strArg "version" version
120− , boolArg "enableHttps" enableHttps
121− , rawArg "config" $ deployPath </> "config"
122− ]
123− & nixCmdConfig_builders .~ builders
124− let result = listToMaybe $ lines buildOutput
125− forM_ result $ \res -> do
126− let knownHostsPath = deployPath </> "backend_known_hosts"
127− sshOpts = sshArgs knownHostsPath (deployPath </> "ssh_key") False
128− deployAndSwitch outputPath = do
129− withSpinner "Uploading closure" $ do
130− callProcess'
131− (Map.fromList [("NIX_SSHOPTS", unwords sshOpts)])
132− "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
133−
134− withSpinner "Switching to new configuration" $ do
135− callProcessAndLogOutput (Notice, Warning) $
136− proc "ssh" $ sshOpts <>
137− [ "root@" <> host
138− , unwords
139− [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
140− , "&&"
141− , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
142− ]
143− ]
144− deployAndSwitch res
145− isClean <- checkGitCleanStatus deployPath True
146− when (not isClean) $ do
147− withSpinner "Commiting changes to Git" $ do
148− callProcessAndLogOutput (Debug, Error) $ proc "git"
149− ["-C", deployPath, "add", "."]
150− callProcessAndLogOutput (Debug, Error) $ proc "git"
151− ["-C", deployPath, "commit", "-m", "New deployment"]
152− putLog Notice $ "Deployed => " <> T.pack route
109+ buildOutputByHost <- ifor (Map.fromSet (const ()) hosts) $ \host () -> do
110+ --TODO: What does it mean if this returns more or less than 1 line of output?
111+ [result] <- fmap lines $ nixCmd $ NixCmd_Build $ def
112+ & nixCmdConfig_target .~ Target
113+ { _target_path = Just srcPath
114+ , _target_attr = Just "server.system"
115+ , _target_expr = Nothing
116+ }
117+ & nixBuildConfig_outLink .~ OutLink_None
118+ & nixCmdConfig_args .~
119+ [ strArg "hostName" host
120+ , strArg "adminEmail" adminEmail
121+ , strArg "routeHost" routeHost
122+ , strArg "version" version
123+ , boolArg "enableHttps" enableHttps
124+ , rawArg "config" $ deployPath </> "config"
125+ ]
126+ & nixCmdConfig_builders .~ builders
127+ pure result
128+ let knownHostsPath = deployPath </> "backend_known_hosts"
129+ sshOpts = sshArgs knownHostsPath (deployPath </> "ssh_key") False
130+ withSpinner "Uploading closures" $ ifor_ buildOutputByHost $ \host outputPath -> do
131+ callProcess'
132+ (Map.fromList [("NIX_SSHOPTS", unwords sshOpts)])
133+ "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
134+ --TODO: Create GC root so we're sure our closure won't go away during this time period
135+ withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do
136+ callProcessAndLogOutput (Notice, Warning) $
137+ proc "ssh" $ sshOpts <>
138+ [ "root@" <> host
139+ , unwords
140+ [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
141+ , "&&"
142+ , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
143+ ]
144+ ]
145+ isClean <- checkGitCleanStatus deployPath True
146+ when (not isClean) $ do
147+ withSpinner "Commiting changes to Git" $ do
148+ callProcessAndLogOutput (Debug, Error) $ proc "git"
149+ ["-C", deployPath, "add", "."]
150+ callProcessAndLogOutput (Debug, Error) $ proc "git"
151+ ["-C", deployPath, "commit", "-m", "New deployment"]
152+ putLog Notice $ "Deployed => " <> T.pack route
153153 where
154154 callProcess' envMap cmd args = do
155155 processEnv <- Map.toList . (envMap <>) . Map.fromList <$> liftIO getEnvironment