Add correctness tests for outgone-fetches logging (#99)

Summary:
Pull Request resolved: https://github.com/facebook/Haxl/pull/99

This adds unit tests to haxl, to make sure we are tracking the outgone
fetches correctly..

Reviewed By: simonmar

Differential Revision: D14683672

fbshipit-source-id: 49a318f0b8aa38c2af154fcbe0946122e70b9565

haxl.cabal

@@ -132,6 +132,7 @@ test-suite test
   if impl(ghc >= 8.0)
     other-modules:
       AdoTests
+      OutgoneFetchesTests
 
   other-modules:
     AllTests

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

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
+  ]

tests/SleepDataSource.hs

@@ -14,7 +14,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 
 module SleepDataSource (
-    sleep,
+    Sleep, sleep,
   ) where
 
 import Haxl.Prelude