Jesod scaffolded strona powoli uwalniają Bilard bazie

Question

UPDATE

Mam uprościł pokaz to z rzeczywistego projektu utworzonego z rusztowania - można to sprawdzić tutaj: https://github.com/tetigi/yesod-bug-test

Śledź README skonfigurować repozytorium i powtórzyć problem! Dzięki :)

ORIGINAL POST

ja niedawno stara się stworzyć prostą stronę internetową za pomocą Yesod - w jednym konkretnym obsługi, to sprawia, że ​​kilka runDB połączenia (wybieranie i wstawianie pewne wartości do ~ 200 pozycji DB). Jednak przy średnim obciążeniu, takim jak szybkie wczytanie strony w przeglądarce, strona zaczyna się zawieszać.

Przeprowadzając trochę debugowania, stwierdziłem, że wygląda na to, że aplikacja Yesod nie zwalnia połączeń z pulą DB w odpowiednim czasie i czeka na ich zwolnienie. Aby to correborate, znalazłem inne następujące rzeczy:

• zmniejszenie basen DB do 2 dał mi zamrożenie po zaledwie kilku kliknięć
• Domyślna (10) zamarła po około 5 sekundach od kliknięcia
• Zwiększenie basen DB do 100 dał mi o wiele dłużej kliknij okres, aż do około 10-15 sekund szybkiego klikania
• kwestia jest taka sama, czy używam PostgreSQL lub SQLite
• W PostgreSQL, możliwe było aby zobaczyć transakcje "COMMIT" układające się w czasie z czasem
• Te transakcje w końcu znikną z czasem, a witryna ponownie się zareaguje.

Czy jest tu coś, czego mi brakuje? Strona nie robi nic skomplikowanego, jak pokazuje poniższy fragment. Jakieś pomysły? W obecnej wersji witryna będzie nieużyteczna dla wielu użytkowników, dopóki nie znajdę sposobu na jej rozwiązanie!

Używam standardowej aplikacji takodowanej na szkielet przez stos, jak zaleca się w dokumentacji.

Pozdrawiam!

Luke

Przykład kodu obsługi (skrócona)

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

Problem leży w Data.Random - zastępując połączenia choice z czymś takim:

import System.Random (randomRIO) 

... 

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

Poprawiono wszystko i już nie zwalniamy. Nie bardzo wiem, dlaczego robi to Data.Random, ale przynajmniej działa teraz!

Inną interesującą rzeczą, którą należy zwrócić uwagę - problem nie występuje na Mac OS X, tylko na smaków Linuksa (CentOS, Arch, Ubuntu to te, które próbowaliśmy)