diff --git a/haxl.cabal b/haxl.cabal index ce1e4e9..a7540ad 100644 --- a/haxl.cabal +++ b/haxl.cabal @@ -132,6 +132,7 @@ test-suite test if impl(ghc >= 8.0) other-modules: AdoTests + OutgoneFetchesTests other-modules: AllTests diff --git a/tests/AllTests.hs b/tests/AllTests.hs index bfe026a..f2bc291 100644 --- a/tests/AllTests.hs +++ b/tests/AllTests.hs @@ -13,6 +13,7 @@ import CoreTests import DataCacheTest #if __GLASGOW_HASKELL__ >= 801 import AdoTests +import OutgoneFetchesTests #endif #if __GLASGOW_HASKELL__ >= 710 import ProfileTests @@ -33,6 +34,7 @@ allTests = TestList , TestLabel "DataCacheTests" DataCacheTest.tests #if __GLASGOW_HASKELL__ >= 801 , TestLabel "AdoTests" $ AdoTests.tests False + , TestLabel "OutgoneFetchesTest" OutgoneFetchesTests.tests #endif #if __GLASGOW_HASKELL__ >= 710 , TestLabel "ProfileTests" ProfileTests.tests diff --git a/tests/OutgoneFetchesTests.hs b/tests/OutgoneFetchesTests.hs new file mode 100644 index 0000000..1aba924 --- /dev/null +++ b/tests/OutgoneFetchesTests.hs @@ -0,0 +1,137 @@ +-- Copyright (c) 2014-present, Facebook, Inc. +-- All rights reserved. +-- +-- This source code is distributed under the terms of a BSD license, +-- found in the LICENSE file. + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ApplicativeDo #-} +module OutgoneFetchesTests (tests) where + +import Haxl.Prelude as Haxl +import Prelude() + +import Haxl.Core +import Haxl.DataSource.ConcurrentIO +import Haxl.Core.RequestStore (getMapFromRCMap) + +import Data.IORef +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Proxy (Proxy(..)) +import Data.Typeable +import Test.HUnit +import System.Timeout + +import ExampleDataSource +import SleepDataSource + +testEnv = do + exstate <- ExampleDataSource.initGlobalState + sleepState <- mkConcurrentIOState + let st = stateSet exstate $ stateSet sleepState stateEmpty + e <- initEnv st () + return e { flags = (flags e) {report = 1} } + -- report=1 to enable fetches tracking + +-- A cheap haxl computation we interleave b/w the @sleep@ fetches. +wombats :: GenHaxl () () Int +wombats = length <$> listWombats 3 + +getFetches :: Env () () -> IO (Map Text (Map TypeRep Int)) +getFetches env = getMapFromRCMap <$> readIORef (submittedReqsRef env) + +outgoneFetchesTest :: Test +outgoneFetchesTest = TestCase $ do + let + withTimeout env h = timeout 2000 $ runHaxl env h -- 2 ms + + -- test that a completed datasource fetch doesn't show up in Env + env <- testEnv + + withTimeout env $ do + _ <- sleep 1 -- 1 ms + _ <- sleep 1 -- should be cached + _ <- sleep 1 + wombats + + fetchesMap <- getFetches env + assertEqual "outgoneFetches1" 0 (Map.size fetchesMap) + + -- test that unfinished datasource fetches shows up in Env + env <- testEnv + + withTimeout env $ do + _ <- sleep 4 -- 4 ms + _ <- wombats + _ <- sleep 5 -- 4 ms + _ <- wombats + return () + + fetchesMap <- getFetches env + assertEqual "outgoneFetches2" 1 (Map.size fetchesMap) + assertEqual "outgoneFetches2" + (Map.fromList + [ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep)) + , Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 2)] + ) + ]) + fetchesMap + + -- test for finished/unfinished fetches from the same datasource + env <- testEnv + + withTimeout env $ do + _ <- sleep 1 -- 1 ms + _ <- sleep 4 + _ <- sleep 5 + return () + + fetchesMap <- getFetches env + assertEqual "outgoneFetches3" + (Map.fromList + [ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep)) + , Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 2)] + ) + ]) + fetchesMap + + -- test for cached requests not showing up twice in ReqCountMap + env <- testEnv + + withTimeout env $ do + _ <- sleep 4 -- 3 ms + _ <- sleep 4 + return () + + fetchesMap <- getFetches env + assertEqual "outgoneFetches4" + (Map.fromList + [ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep)) + , Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 1)] + ) + ]) + fetchesMap + + -- test for unsent requests not showing up in ReqCountMap + env <- testEnv + + withTimeout env $ do + _ <- sleep =<< sleep 4 -- second req should never be sent + return () + + fetchesMap <- getFetches env + assertEqual "outgoneFetches5" + (Map.fromList + [ ( dataSourceName (Proxy :: Proxy (ConcurrentIOReq Sleep)) + , Map.fromList [(typeOf1 (undefined :: ConcurrentIOReq Sleep a), 1)] + ) + ]) + fetchesMap + + + + +tests = TestList + [ TestLabel "outgoneFetchesTest" outgoneFetchesTest + ] diff --git a/tests/SleepDataSource.hs b/tests/SleepDataSource.hs index b7cd532..42aa88a 100644 --- a/tests/SleepDataSource.hs +++ b/tests/SleepDataSource.hs @@ -14,7 +14,7 @@ {-# LANGUAGE FlexibleInstances #-} module SleepDataSource ( - sleep, + Sleep, sleep, ) where import Haxl.Prelude