@@ -17,7 +17,6 @@ import Data.Bits
1717import qualified Data.ByteString.Lazy as BSL
1818import Data.Default
1919import qualified Data.Map as Map
20−import Data.Maybe (isJust, listToMaybe)
2120import qualified Data.Set as Set
2221import Data.String.Here.Interpolated (i)
2322import qualified Data.Text as T
@@ -86,13 +85,12 @@ deployInit' thunkPtr (DeployInitOpts deployDir sshKeyPath hostnames route adminE
8685 --accidentally create a production deployment that uses development
8786 --credentials to connect to some resources. This could result in, e.g.,
8887 --production data backed up to a dev environment.
89− withSpinner "Creating project configuration directories" $ do
90− callProcessAndLogOutput (Notice, Error) $
91− proc "mkdir" [ "-p"
92− , deployDir </> "config" </> "backend"
93− , deployDir </> "config" </> "common"
94− , deployDir </> "config" </> "frontend"
95− ]
88+ withSpinner "Creating project configuration directories" $ liftIO $ do
89+ mapM_ (createDirectoryIfMissing True)
90+ [ deployDir </> "config" </> "backend"
91+ , deployDir </> "config" </> "common"
92+ , deployDir </> "config" </> "frontend"
93+ ]
9694
9795 let srcDir = deployDir </> "src"
9896 withSpinner ("Creating source thunk (" <> T.pack (makeRelative deployDir srcDir) <> ")") $ do
@@ -125,18 +123,15 @@ deployPush deployPath getNixBuilders = do
125123 enableHttps <- read <$> readDeployConfig deployPath "enable_https"
126124 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"
127125 routeHost <- getHostFromRoute enableHttps route
128− let
129− srcPath = deployPath </> "src"
130− handleUnpackedWith f = checkGitCleanStatus srcPath True >>= \case
131− True -> f
132− False -> failWith $ "ob deploy push: ensure " <> T.pack srcPath <> " has no pending changes and latest is pushed upstream."
133−
134− version' <- readThunk srcPath >>= \case
135− Right (ThunkData_Packed _ ptr) -> return $ Just $ show $ _thunkRev_commit $ _thunkPtr_rev ptr
136− Right ThunkData_Checkout -> handleUnpackedWith $ Just . show . _thunkRev_commit . _thunkPtr_rev <$> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath
137− Left err -> do
138− putLog Warning [i|No valid thunk found at ${srcPath} due to ${err}: Attempting to find commit hash anyway.|]
139− handleUnpackedWith $ fmap show . listToMaybe . T.lines <$> readGitProcess srcPath ["rev-parse", "HEAD"]
126+ let srcPath = deployPath </> "src"
127+ thunkPtr <- readThunk srcPath >>= \case
128+ Right (ThunkData_Packed _ ptr) -> return ptr
129+ Right ThunkData_Checkout -> do
130+ checkGitCleanStatus srcPath True >>= \case
131+ True -> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath
132+ False -> failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
133+ Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
134+ let version = show . _thunkRev_commit $ _thunkPtr_rev thunkPtr
140135 builders <- getNixBuilders
141136 let moduleFile = deployPath </> "module.nix"
142137 moduleFileExists <- liftIO $ doesFileExist moduleFile
@@ -153,7 +148,7 @@ deployPush deployPath getNixBuilders = do
153148 [ strArg "hostName" host
154149 , strArg "adminEmail" adminEmail
155150 , strArg "routeHost" routeHost
156− , strArg "version" $ maybe "Deployment was done with a dirty source tree" id version'
151+ , strArg "version" version
157152 , boolArg "enableHttps" enableHttps
158153 ] <> [rawArg "module" ("import " <> toNixPath moduleFile) | moduleFileExists ])
159154 & nixCmdConfig_builders .~ builders
@@ -166,8 +161,8 @@ deployPush deployPath getNixBuilders = do
166161 "nix-copy-closure" ["-v", "--to", "--use-substitutes", "root@" <> host, "--gzip", outputPath]
167162 withSpinner "Uploading config" $ ifor_ buildOutputByHost $ \host _ -> do
168163 callProcessAndLogOutput (Notice, Warning) $
169− proc "rsync"
170− [ "-e ssh " <> unwords sshOpts
164+ proc rsyncPath
165+ [ "-e " <> sshPath <> " " <> unwords sshOpts
171166 , "-qarvz"
172167 , deployPath </> "config"
173168 , "root@" <> host <> ":/var/lib/backend"
@@ -175,22 +170,22 @@ deployPush deployPath getNixBuilders = do
175170 --TODO: Create GC root so we're sure our closure won't go away during this time period
176171 withSpinner "Switching to new configuration" $ ifor_ buildOutputByHost $ \host outputPath -> do
177172 callProcessAndLogOutput (Notice, Warning) $
178− proc "ssh" $ sshOpts <>
173+ proc sshPath $ sshOpts <>
179174 [ "root@" <> host
180175 , unwords
176+ -- Note that we don't want to $(staticWhich "nix-env") here, because this is executing on a remote machine
181177 [ "nix-env -p /nix/var/nix/profiles/system --set " <> outputPath
182178 , "&&"
183179 , "/nix/var/nix/profiles/system/bin/switch-to-configuration switch"
184180 ]
185181 ]
186− when (isJust version') $ do
187− isClean <- checkGitCleanStatus deployPath True
188− when (not isClean) $ do
189− withSpinner "Committing changes to Git" $ do
190− callProcessAndLogOutput (Debug, Error) $ proc "git"
191− ["-C", deployPath, "add", "."]
192− callProcessAndLogOutput (Debug, Error) $ proc "git"
193− ["-C", deployPath, "commit", "-m", "New deployment"]
182+ isClean <- checkGitCleanStatus deployPath True
183+ when (not isClean) $ do
184+ withSpinner "Committing changes to Git" $ do
185+ callProcessAndLogOutput (Debug, Error) $
186+ gitProc deployPath ["add", "."]
187+ callProcessAndLogOutput (Debug, Error) $
188+ gitProc deployPath ["commit", "-m", "New deployment"]
194189 putLog Notice $ "Deployed => " <> T.pack route
195190 where
196191 callProcess' envMap cmd args = do
@@ -320,7 +315,7 @@ readDeployConfig deployDir fname = liftIO $ do
320315
321316verifyHostKey :: MonadObelisk m => FilePath -> FilePath -> String -> m ()
322317verifyHostKey knownHostsPath keyPath hostName =
323− callProcessAndLogOutput (Notice, Warning) $ proc "ssh" $
318+ callProcessAndLogOutput (Notice, Warning) $ proc sshPath $
324319 sshArgs knownHostsPath keyPath True <>
325320 [ "root@" <> hostName
326321 , "-o", "NumberOfPasswordPrompts=0"