@@ -16,12 +16,11 @@ import Data.Monoid
1616import qualified Data.Text as T
1717import qualified Data.Text.IO as T
1818import System.Directory
19−import System.Exit (ExitCode (..))
2019import System.FilePath
21−import System.Process
20+import System.Process (delegate_ctlc, env, proc, readProcess)
2221
2322import Obelisk.App (MonadObelisk)
24−import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith)
23+import Obelisk.CLI (Severity (..), callProcessAndLogOutput, failWith, withSpinner)
2524import Obelisk.Command.Nix
2625import Obelisk.Command.Thunk
2726import Obelisk.Command.Utils
@@ -77,31 +76,34 @@ deployPush deployPath = do
7776 _ <- failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
7877 return Nothing
7978 _ -> return Nothing
80− liftIO $ forM_ result $ \res -> do
79+ forM_ result $ \res -> do
8180 let deployAndSwitch outputPath sshAgentEnv = do
82− callProcess' (Just sshAgentEnv) "ssh-add" [deployPath </> "ssh_key"]
83− callProcess' (Just sshAgentEnv) "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
84− callProcess' (Just sshAgentEnv) "ssh"
85− [ "root@" <> host
86− , unwords
87− [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
88− , "&&"
89− , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
90− ]
91− ]
92− sshAgentEnv <- sshAgent
81+ withSpinner "Adding ssh key" $ do
82+ callProcess' (Just sshAgentEnv) "ssh-add" [deployPath </> "ssh_key"]
83+ withSpinner "Uploading closure" $ do
84+ callProcess' (Just sshAgentEnv) "nix-copy-closure" ["-v", "--to", "root@" <> host, "--gzip", outputPath]
85+ withSpinner "Switching to new configuration" $ do
86+ callProcess' (Just sshAgentEnv) "ssh"
87+ [ "root@" <> host
88+ , unwords
89+ [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
90+ , "&&"
91+ , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
92+ ]
93+ ]
94+ sshAgentEnv <- liftIO sshAgent
9395 deployAndSwitch res sshAgentEnv `finally` callProcess' (Just sshAgentEnv) "ssh-agent" ["-k"]
94− isClean <- checkGitCleanStatus deployPath
96+ isClean <- liftIO $ checkGitCleanStatus deployPath
9597 when (not isClean) $ do
96− callProcess "git" ["-C", deployPath, "add", "--update"]
97− callProcess "git" ["-C", deployPath, "commit", "-m", "New deployment"]
98+ withSpinner "Commiting changes to Git" $ do
99+ callProcessAndLogOutput (Debug, Error) $ proc "git"
100+ ["-C", deployPath, "add", "--update"]
101+ callProcessAndLogOutput (Debug, Error) $ proc "git"
102+ ["-C", deployPath, "commit", "-m", "New deployment"]
98103 where
99104 callProcess' e cmd args = do
100105 let p = (proc cmd args) { delegate_ctlc = True, env = e }
101− exit_code <- withCreateProcess p $ \_ _ _ ph -> waitForProcess ph
102− case exit_code of
103− ExitSuccess -> return ()
104− ExitFailure r -> fail $ "callProcess'" <> "(exit: " <> show r <> ")"
106+ callProcessAndLogOutput (Notice, Notice) p
105107
106108deployUpdate :: MonadObelisk m => FilePath -> m ()
107109deployUpdate deployPath = updateThunkToLatest $ deployPath </> "src"