@@ -17,7 +17,7 @@ import Data.Bits
1717import qualified Data.ByteString.Lazy as BSL
1818import Data.Default
1919import qualified Data.Map as Map
20−import Data.Maybe (isJust)
20+import Data.Maybe (isJust, listToMaybe)
2121import qualified Data.Set as Set
2222import Data.String.Here.Interpolated (i)
2323import qualified Data.Text as T
@@ -125,16 +125,18 @@ deployPush deployPath getNixBuilders = do
125125 enableHttps <- read <$> readDeployConfig deployPath "enable_https"
126126 route <- readDeployConfig deployPath $ "config" </> "common" </> "route"
127127 routeHost <- getHostFromRoute enableHttps route
128− let srcPath = deployPath </> "src"
129− thunkPtr' <- readThunk srcPath >>= \case
130− Right (ThunkData_Packed _ ptr) -> return $ Just ptr
131− Right ThunkData_Checkout -> do
132− checkGitCleanStatus srcPath True >>= \case
133− True -> Just <$> packThunk (ThunkPackConfig False (ThunkConfig Nothing)) srcPath
134− False -> Nothing <$ putLog Warning "Skipping packing of src thunk; won't be able to automatically commit this deployment"
135− -- failWith $ T.pack $ "ob deploy push: ensure " <> srcPath <> " has no pending changes and latest is pushed upstream."
136− Left err -> failWith $ "ob deploy push: couldn't read src thunk: " <> T.pack (show err)
137− let version' = show . _thunkRev_commit . _thunkPtr_rev <$> thunkPtr'
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"]
138140 builders <- getNixBuilders
139141 let moduleFile = deployPath </> "module.nix"
140142 moduleFileExists <- liftIO $ doesFileExist moduleFile