Yesod sito ponteggi lento a rilasciare la connessione pool di database

Question

UPDATE

Ho semplificato la dimostrazione di questo con un progetto reale creato dal patibolo - è possibile verificarlo qui: https://github.com/tetigi/yesod-bug-test

Follow the README per configurare il repository e replicare il problema! Grazie :)

ORIGINALE POST

Recentemente ho cercato di creare un sito web semplice utilizzando yesod - in un particolare gestore, fa un paio di runDB chiamate (selezione e l'inserimento di alcuni valori in un ~ 200 item DB). Tuttavia, a carico medio, ad esempio il ricaricamento rapido della pagina in un browser, la pagina inizia a bloccarsi.

Facendo un po 'di debug, ho scoperto che sembra che l'app yesod non rilasci le connessioni al pool di DB in modo tempestivo e finisca per aspettare che vengano rilasciate. Per correborate questo, ho trovato le altre cose seguenti:

• Ridurre la piscina DB 2 mi ha dato un congelamento dopo solo un paio di clic
• Il valore predefinito (10) ha congelato dopo circa 5 secondi di cliccando
• Aumentando la piscina DB a 100 mi ha dato una molto più lungo periodo di scatto, fino a circa 10-15 secondi di rapido clic
• il problema è lo stesso se sto usando postgres o SQLite
• di PostgreSQL, è stato possibile vedere le transazioni 'COMMIT' accatastate nel tempo
• Tali operazioni avrebbero alla fine dissappear nel tempo e il sito sarebbe stato di nuovo reattivo

c'è qualcosa che mi manca qui? La pagina web non fa nulla di complicato, come mostrerà lo snippet qui sotto. Qualche idea? Così com'è, il sito Web sarà inutilizzabile per più utenti finché non trovo un modo per risolvere questo problema!

Sto usando l'applicazione yesod con scaffolding standard tramite stack, come consigliato nella documentazione.

Cheers!

Luca codice del gestore

Esempio (abbreviata)

getCompareR :: Handler Html 
getCompareR = do 

    -- Get all entities from the db. Throws error if < 2 elems in the DB. 
    entities <- fmap (\xs -> assert (length xs >= 2) xs) $ runDB $ selectList [] [] 

    -- Pick an entity at random 
    Entity _ thisThingEntity <- liftIO $ runRVar (choice entities) DevRandom 

    -- Pull out everything NOT the thing we just picked 
    otherEntities <- runDB $ selectList [ComparisonHash !=. (comparisonHash thisThingEntity)] [] 

    -- Pick one at random 
    Entity _ thatThingEntity <- liftIO $ runRVar (choice otherEntities) DevRandom 

    -- Some stuff including some inserts 
    -- ... 
    -- ... 

    runDB $ sequence [update thisId [ComparisonElo =. thisElo], update thatId [ComparisonElo =. thatElo]] 

    -- Start laying out the webpage 
    defaultLayout $ do 
     -- Fill in the rest with compare.hamlet 
     $(widgetFile "compare") 

Answer 1

La questione si trova all'interno Data.Random - sostituendo la chiamata choice con qualcosa di simile:

import System.Random (randomRIO) 

... 

-- Pick an entity at random 
randomInt1 <- liftIO $ randomRIO (0, length entities -1) 
let Entity _ thisThingEntity = entities !! randomInt1 

fisso tutto e non rallentiamo più. Non sono proprio sicuro del motivo per cui Data.Random lo sta facendo, ma almeno adesso funziona!

Un'altra cosa interessante da notare - il problema non è presente su Mac OS X, solo su distribuzioni Linux (CentOS, Arch, Ubuntu essendo quelle che abbiamo provato)