From 722f441d65a8404cffea40288683416d2eed8d5e Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 27 Oct 2020 14:11:55 +0200
Subject: [PATCH] More timeouts

---
 src/Handler/Package.hs | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/src/Handler/Package.hs b/src/Handler/Package.hs
index 40d1a7c..ba8ffe6 100644
--- a/src/Handler/Package.hs
+++ b/src/Handler/Package.hs
@@ -76,11 +76,19 @@ checkSpam pname inner = do
 packagePage :: Maybe SnapshotPackageInfo -> PackageNameP -> Handler Html
 packagePage mspi pname =
     track "Handler.Package.packagePage" $
-    checkSpam pname $
-        maybe (getSnapshotPackageLatestVersion pname) (return . Just) mspi >>= \case
+    checkSpam pname $ do
+        mspi' <-
+          case mspi of
+            Just spi -> pure $ Just spi
+            Nothing ->
+              fmap join $ timeout 2000000 $ getSnapshotPackageLatestVersion pname
+        case mspi' of
           Nothing -> do
-            hci <- run (getHackageLatestVersion pname) >>= maybe notFound pure
-            handlePackage $ Left hci
+            mmhci <- timeout 2000000 $ run $ getHackageLatestVersion pname
+            case mmhci of
+              Nothing -> error "Getting latest version timed out"
+              Just Nothing -> notFound
+              Just (Just hci) -> handlePackage $ Left hci
           Just spi -> handlePackage $ Right spi