Prevent concurrent Hoogle queries #172

Application.hs

@@ -146,6 +146,7 @@ makeFoundation useEcho conf = do
         , updateAction = getLatestMatcher manager
         }
 
+    hoogleLock <- newMVar ()
     let logger = Yesod.Core.Types.Logger loggerSet' getter
         foundation = App
             { settings = conf
@@ -156,6 +157,7 @@ makeFoundation useEcho conf = do
             , websiteContent = websiteContent'
             , stackageDatabase = stackageDatabase'
             , latestStackMatcher = latestStackMatcher'
+            , appHoogleLock = hoogleLock
             }
 
     return foundation

Foundation.hs

@@ -30,6 +30,9 @@ data App = App
     , stackageDatabase :: IO StackageDatabase
     , latestStackMatcher :: IO (Text -> Maybe Text)
     -- ^ Give a pattern, get a URL
+    , appHoogleLock :: MVar ()
+    -- ^ Avoid concurrent Hoogle queries, see
+    -- https://github.com/fpco/stackage-server/issues/172
     }
 
 instance HasGenIO App where

Handler/Hoogle.hs

@@ -37,8 +37,11 @@ getHoogleR name = do
         Just x -> return $ liftIO $ Hoogle.loadDatabase x
         Nothing -> hoogleDatabaseNotAvailableFor name
 
+    -- Avoid concurrent Hoogle queries, see
+    -- https://github.com/fpco/stackage-server/issues/172
+    lock <- appHoogleLock <$> getYesod
     mresults <- case mquery of
-        Just query -> runHoogleQuery heDatabase HoogleQueryInput
+        Just query -> withMVar lock $ const $ runHoogleQuery heDatabase HoogleQueryInput
             { hqiQueryInput = query
             , hqiExactSearch = if exact then Just query else Nothing
             , hqiLimitTo = count'