haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-11 19:58:28 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Warn and continue if orig.tar is 404

Browse Source
This commit is contained in:
Bryan Richter 2025-03-18 14:47:23 +02:00
parent cbe4038c12
commit 810e0f3253
No known key found for this signature in database
GPG Key ID: B202264020068BFB
1 changed files with 44 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
src/Stackage/Database/Cron.hs
View File

@ -858,44 +858,57 @@ createHoogleDB rootDir snapshotId snapName = do
outname = root </> "output.hoo"
inputTarKey = toPathPiece snapName <> "/hoogle/orig.tar"
inputTarUrl = downloadBucketUrl <> "/" <> inputTarKey
outputTarFP = root </> T.unpack inputTarKey
-- Fetch the tarball with Hoogle inputs
req <- parseRequest $ T.unpack inputTarUrl
env <- asks scEnvAWS
let man = env ^. env_manager
withResponseUnliftIO req {decompress = const True} man $ \res -> do
mTarFile <- withResponseUnliftIO req {decompress = const True} man $ \res -> do
-- FIXME: Catch HttpExceptionRequest and give up on this snapshot?
throwErrorStatusCodes req res
createDirectoryIfMissing True $ takeDirectory outputTarFP
withBinaryFileDurableAtomic outputTarFP WriteMode $ \tarHandle ->
runConduitRes $ bodyReaderSource (responseBody res) .| sinkHandle tarHandle
case responseStatus res of
status
| status == status200 -> do
let outputTarFP = root </> T.unpack inputTarKey
createDirectoryIfMissing True $ takeDirectory outputTarFP
withBinaryFileDurableAtomic outputTarFP WriteMode $ \tarHandle ->
runConduitRes $ bodyReaderSource (responseBody res) .| sinkHandle tarHandle
pure $ Just outputTarFP
| status == status404 -> do
logWarn $ "Input orig.tar is a 404 for " <> display snapName
pure Nothing
| otherwise ->
-- NOW we give up.
Nothing <$ throwErrorStatusCodes req res
-- Extract the Hoogle inputs from the tarball into a separate temp dir, then
-- generate the hoogle database.
withSystemTempDirectory ("hoogle-" ++ T.unpack (textDisplay snapName)) $ \tmpdir -> do
Any hasRestored <-
runConduitRes $
sourceFile outputTarFP .|
untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .|
foldMapC Any
-- We just check if we have any Hoogle .txt file at all.
-- If there are none, we just give up
if hasRestored then do
-- Generate the hoogle database
let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir]
logInfo $
mconcat
[ "Merging databases... ("
, foldMap fromString $ L.intersperse " " ("hoogle" : args)
, ")"
]
-- 'Hoogle.hoogle' expects to run as an app, and crashes if something
-- goes wrong. That's good.
liftIO $ Hoogle.hoogle args
logInfo "Merge done"
pure $ Just outname
else do
logWarn $ "No Hoogle.txt files found for " <> display snapName <> ", skipping Hoogle DB creation."
pure Nothing
case mTarFile of
Nothing -> pure Nothing
Just outputTarFP -> do
withSystemTempDirectory ("hoogle-" ++ T.unpack (textDisplay snapName)) $ \tmpdir -> do
Any hasRestored <-
runConduitRes $
sourceFile outputTarFP .|
untar (restoreHoogleTxtFileWithCabal tmpdir snapshotId snapName) .|
foldMapC Any
-- We just check if we have any Hoogle .txt file at all.
-- If there are none, we just give up
if hasRestored then do
-- Generate the hoogle database
let args = ["generate", "--database=" ++ outname, "--local=" ++ tmpdir]
logInfo $
mconcat
[ "Merging databases... ("
, foldMap fromString $ L.intersperse " " ("hoogle" : args)
, ")"
]
-- 'Hoogle.hoogle' expects to run as an app, and crashes if something
-- goes wrong. That's good.
liftIO $ Hoogle.hoogle args
logInfo "Merge done"
pure $ Just outname
else do
logWarn $ "No Hoogle.txt files found for " <> display snapName <> ", skipping Hoogle DB creation."
pure Nothing
-- | Grabs hoogle txt file from the tarball and a matching cabal file from pantry. Writes