Use non-permanent temp dir for intermediate files

This commit also removes some extraneous error checking in favor of just
crashing if things go wrong.
This commit is contained in:
Bryan Richter 2025-02-07 13:43:13 +02:00
parent 672099d68e
commit c344ce21ce
No known key found for this signature in database
GPG Key ID: B202264020068BFB

View File

@ -814,6 +814,7 @@ buildAndUploadHoogleDBs doNotUpload = do
-- checkInsertSnapshotHoogleDb just check against SnapshotHoogleDb. -- checkInsertSnapshotHoogleDb just check against SnapshotHoogleDb.
-- Perhaps the check can be removed. -- Perhaps the check can be removed.
unlessM (checkH snapshotId) $ do unlessM (checkH snapshotId) $ do
withSystemTempDirectory ("hoogle-" ++ T.unpack (textDisplay snapName)) $ \tmpdir -> do
logInfo $ "Starting Hoogle database download: " <> display (hoogleKey snapName) logInfo $ "Starting Hoogle database download: " <> display (hoogleKey snapName)
-- Check if the database already exists (by downloading it). -- Check if the database already exists (by downloading it).
-- FIXME: Why not just send a HEAD? -- FIXME: Why not just send a HEAD?
@ -830,15 +831,12 @@ buildAndUploadHoogleDBs doNotUpload = do
void $ insertH snapshotId void $ insertH snapshotId
Nothing -> do Nothing -> do
logInfo $ "Current hoogle database does not yet exist in the bucket for: " <> display snapName logInfo $ "Current hoogle database does not yet exist in the bucket for: " <> display snapName
mfp' <- createHoogleDB snapshotId snapName -- NB: createHoogleDB will fail if something goes wrong.
forM_ mfp' $ \fp -> do fp <- createHoogleDB tmpdir snapshotId snapName
let key = hoogleKey snapName let key = hoogleKey snapName
dest = T.unpack key unless doNotUpload $ do
createDirectoryIfMissing True $ takeDirectory dest uploadHoogleDB fp (ObjectKey key)
renamePath fp dest void $ insertH snapshotId
unless doNotUpload $ do
uploadHoogleDB dest (ObjectKey key)
void $ insertH snapshotId
-- | Create a hoogle db from haddocks for the given snapshot. -- | Create a hoogle db from haddocks for the given snapshot.
-- --
@ -847,31 +845,30 @@ buildAndUploadHoogleDBs doNotUpload = do
-- --
-- Returns the path to the .hoo database, which will be found in the first -- Returns the path to the .hoo database, which will be found in the first
-- argument. It will look like @<rootDir>/hoogle-gen/output.hoo@. -- argument. It will look like @<rootDir>/hoogle-gen/output.hoo@.
createHoogleDB :: SnapshotId -> SnapName -> RIO StackageCron FilePath createHoogleDB :: FilePath -> SnapshotId -> SnapName -> RIO StackageCron FilePath
createHoogleDB snapshotId snapName = do createHoogleDB rootDir snapshotId snapName = do
logInfo $ "Creating Hoogle DB for " <> display snapName logInfo $ "Creating Hoogle DB for " <> display snapName
downloadBucketUrl <- scDownloadBucketUrl <$> ask downloadBucketUrl <- scDownloadBucketUrl <$> ask
let root = "hoogle-gen" let root = rootDir </> "hoogle-gen"
outname = root </> "output.hoo" outname = root </> "output.hoo"
tarKey = toPathPiece snapName <> "/hoogle/orig.tar" inputTarKey = toPathPiece snapName <> "/hoogle/orig.tar"
tarUrl = downloadBucketUrl <> "/" <> tarKey inputTarUrl = downloadBucketUrl <> "/" <> inputTarKey
tarFP = root </> T.unpack tarKey outputTarFP = root </> T.unpack inputTarKey
-- When tarball is downloaded it is saved with durability and atomicity, so if it -- Fetch the tarball with Hoogle inputs
-- is present it is not in a corrupted state req <- parseRequest $ T.unpack inputTarUrl
unlessM (doesFileExist tarFP) $ do env <- asks scEnvAWS
req <- parseRequest $ T.unpack tarUrl let man = env ^. env_manager
env <- asks scEnvAWS withResponseUnliftIO req {decompress = const True} man $ \res -> do
let man = env ^. env_manager throwErrorStatusCodes req res
withResponseUnliftIO req {decompress = const True} man $ \res -> do createDirectoryIfMissing True $ takeDirectory outputTarFP
throwErrorStatusCodes req res withBinaryFileDurableAtomic outputTarFP WriteMode $ \tarHandle ->
createDirectoryIfMissing True $ takeDirectory tarFP runConduitRes $ bodyReaderSource (responseBody res) .| sinkHandle tarHandle
withBinaryFileDurableAtomic tarFP WriteMode $ \tarHandle -> -- Extract the Hoogle inputs from the tarball into a separate temp dir, then
runConduitRes $ bodyReaderSource (responseBody res) .| sinkHandle tarHandle -- generate the hoogle database.
void $ tryIO $ removeFile outname
withSystemTempDirectory ("hoogle-" ++ T.unpack (textDisplay snapName)) $ \tmpdir -> do withSystemTempDirectory ("hoogle-" ++ T.unpack (textDisplay snapName)) $ \tmpdir -> do
Any hasRestored <- Any hasRestored <-
runConduitRes $ runConduitRes $
sourceFile tarFP .| sourceFile outputTarFP .|
untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .| untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .|
foldMapC Any foldMapC Any
-- We just check if we have any Hoogle .txt file at all. -- We just check if we have any Hoogle .txt file at all.
@ -888,7 +885,7 @@ createHoogleDB snapshotId snapName = do
-- goes wrong. That's good. -- goes wrong. That's good.
liftIO $ Hoogle.hoogle args liftIO $ Hoogle.hoogle args
logInfo "Merge done" logInfo "Merge done"
return $ Just outname pure outname
-- | Grabs hoogle txt file from the tarball and a matching cabal file from pantry. Writes -- | Grabs hoogle txt file from the tarball and a matching cabal file from pantry. Writes