mirror of
https://github.com/facebook/Haxl.git
synced 2024-10-04 06:07:32 +03:00
fe44803c40
Summary: Pull Request resolved: https://github.com/facebook/Haxl/pull/129 Some datasources will throw exceptions but this does not indicate a problem with the datasource itself. This can make the statistics difficult to use to track actual problems versus problems with the way the datasource is used. Here we allow the datasource to classify some failures to be ignored by the stats collection. They are not simply ignored however - but stored in a new field `fetchIgnoredFailures` Reviewed By: josefs Differential Revision: D23475953 fbshipit-source-id: a35ee0fc44ae98db86ae56573f5e7462e0355709
192 lines
6.9 KiB
Haskell
192 lines
6.9 KiB
Haskell
-- 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 RecordWildCards #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module StatsTests (tests) where
|
|
|
|
import Test.HUnit
|
|
import Data.List
|
|
import Data.Maybe
|
|
|
|
import Haxl.Prelude
|
|
import Haxl.Core
|
|
import Prelude()
|
|
|
|
import ExampleDataSource
|
|
import SleepDataSource
|
|
import Haxl.DataSource.ConcurrentIO
|
|
|
|
import Control.Monad (void)
|
|
import Data.IORef
|
|
import qualified Data.HashMap.Strict as HashMap
|
|
|
|
aggregateBatches :: Test
|
|
aggregateBatches = TestCase $ do
|
|
let
|
|
statsNoBatches = [ FetchStats { fetchDataSource = "foo"
|
|
, fetchBatchSize = 7
|
|
, fetchStart = 0
|
|
, fetchDuration = 10
|
|
, fetchSpace = 1
|
|
, fetchFailures = 2
|
|
, fetchIgnoredFailures = 0
|
|
, fetchBatchId = n
|
|
, fetchIds = [1,2] }
|
|
| n <- reverse [1..10] ++ [11..20] ]
|
|
++ [ FetchCall "A" ["B"] 1, FetchCall "C" ["D"] 2 ]
|
|
fetchBatch = [ FetchStats { fetchDataSource = "batch"
|
|
, fetchBatchSize = 1
|
|
, fetchStart = 100
|
|
, fetchDuration = 1000 * n
|
|
, fetchSpace = 3
|
|
, fetchFailures = if n <= 3 then 1 else 0
|
|
, fetchIgnoredFailures = 0
|
|
, fetchBatchId = 123
|
|
, fetchIds = [fromIntegral n] } | n <- [1..50] ]
|
|
agg (sz,bids) FetchStats{..} = (sz + fetchBatchSize, fetchBatchId:bids)
|
|
agg _ _ = error "unexpected"
|
|
agg' = foldl' agg (0,[])
|
|
aggNoBatch = aggregateFetchBatches agg' (Stats statsNoBatches)
|
|
expectedNoBatch = [(7, [n]) | n <- reverse [1..20] :: [Int]]
|
|
aggBatch = aggregateFetchBatches agg' (Stats fetchBatch)
|
|
expectedResultBatch = (50, [123 | _ <- [1..50] :: [Int]])
|
|
aggInterspersedBatch =
|
|
aggregateFetchBatches agg'
|
|
(Stats $ intersperse (head fetchBatch) statsNoBatches)
|
|
expectedResultInterspersed =
|
|
(21, [123 | _ <- [1..21] :: [Int]]) : expectedNoBatch
|
|
assertEqual "No batch has no change" expectedNoBatch aggNoBatch
|
|
assertEqual "Batch is combined" [expectedResultBatch] aggBatch
|
|
assertEqual
|
|
"Grouping works as expected" expectedResultInterspersed aggInterspersedBatch
|
|
|
|
|
|
testEnv = do
|
|
-- To use a data source, we need to initialize its state:
|
|
exstate <- ExampleDataSource.initGlobalState
|
|
sleepState <- mkConcurrentIOState
|
|
|
|
-- And create a StateStore object containing the states we need:
|
|
let st = stateSet exstate (stateSet sleepState stateEmpty)
|
|
|
|
-- Create the Env:
|
|
env <- initEnv st ()
|
|
return env{ flags = (flags env){ report = 5 } }
|
|
|
|
|
|
fetchIdsSync :: Test
|
|
fetchIdsSync = TestCase $ do
|
|
env <- testEnv
|
|
_ <- runHaxl env $
|
|
sequence_
|
|
[ void $ countAardvarks "abcabc" + (length <$> listWombats 3)
|
|
, void $ listWombats 100
|
|
, void $ listWombats 99
|
|
, void $ countAardvarks "BANG4" `catch` \NotFound{} -> return 123
|
|
]
|
|
-- expect a single DS stat
|
|
(Stats stats) <- readIORef (statsRef env)
|
|
let
|
|
fetchStats = [x | x@FetchStats{} <- stats]
|
|
assertEqual "Only 1 batch" 1 (length fetchStats)
|
|
let
|
|
[stat] = fetchStats
|
|
assertEqual "No real failures" 0 (fetchFailures stat)
|
|
assertEqual "1 ignored failure" 1 (fetchIgnoredFailures stat)
|
|
|
|
fetchIdsBackground :: Test
|
|
fetchIdsBackground = TestCase $ do
|
|
env <- testEnv
|
|
_ <- runHaxl env $
|
|
sequence_
|
|
[ withLabel "short" $ sleep 1
|
|
, withLabel "long" $ sleep 500 ]
|
|
|
|
-- make sure that with memo'ing we still preserve the stack
|
|
_ <- runHaxl env $ withLabel "base"
|
|
(memo (1 :: Int) $ withLabel "child" $ sleep 102)
|
|
|
|
_ <- runHaxl env $ withLabel "short_cached" $ sleep 1
|
|
|
|
-- expect a single DS stat
|
|
(Stats stats) <- readIORef (statsRef env)
|
|
(Profile p pt _) <- readIORef (profRef env)
|
|
let
|
|
keyMap =
|
|
HashMap.fromList [ (label, k) | ((label,_), k) <- HashMap.toList pt]
|
|
revMap = HashMap.fromList [(v,k) | (k,v) <- HashMap.toList pt]
|
|
parentMap =
|
|
HashMap.fromList $
|
|
catMaybes
|
|
[ case HashMap.lookup kp revMap of
|
|
Just (lp,_) -> Just (label, lp)
|
|
Nothing -> Nothing
|
|
| ((label,kp), _) <- HashMap.toList pt]
|
|
fetchMap = HashMap.fromList [ (fid, x) | x@FetchStats{} <- stats
|
|
, fid <- fetchIds x]
|
|
get l = [ (prof, wasCached, fetchStat)
|
|
| Just key <- [HashMap.lookup l keyMap]
|
|
, Just prof <- [HashMap.lookup key p]
|
|
, ProfileFetch fid _ wasCached <- profileFetches prof
|
|
, Just fetchStat <- [HashMap.lookup fid fetchMap]]
|
|
[(short, shortWC, shortFetch)] = get "short"
|
|
[(long, longWC, longFetch)] = get "long"
|
|
[(shortCached, shortCachedWC, shortCachedFetch)] = get "short_cached"
|
|
|
|
assertEqual "3 batches" 3 (HashMap.size fetchMap)
|
|
assertEqual "6 labels (inc MAIN)" 6 (HashMap.size keyMap)
|
|
|
|
assertEqual "child parent is base"
|
|
(Just "base")
|
|
(HashMap.lookup "child" parentMap)
|
|
|
|
assertEqual "base parent is MAIN"
|
|
(Just "MAIN")
|
|
(HashMap.lookup "base" parentMap)
|
|
|
|
assertEqual "long parent is MAIN"
|
|
(Just "MAIN")
|
|
(HashMap.lookup "long" parentMap)
|
|
|
|
assertBool "original fetches not cached (short)" (not shortWC)
|
|
assertBool "original fetches not cached (long)" (not longWC)
|
|
assertBool "was cached short" shortCachedWC
|
|
|
|
assertEqual "one fetch short" 1 (length $ profileFetches short)
|
|
assertEqual "one fetch long" 1 (length $ profileFetches long)
|
|
assertEqual "one fetch short_cached" 1 (length $ profileFetches shortCached)
|
|
|
|
assertBool "short fetch mapped properly" (fetchDuration shortFetch < 100000)
|
|
assertEqual
|
|
"short cached fetch mapped properly"
|
|
(fetchDuration shortFetch)
|
|
(fetchDuration shortCachedFetch)
|
|
assertBool "long fetch was mapped properly" (fetchDuration longFetch > 100000)
|
|
|
|
|
|
ppStatsTest :: Test
|
|
ppStatsTest = TestCase $ do
|
|
let
|
|
r = ppStats (Stats [])
|
|
mc = ppStats (Stats [MemoCall 0 0])
|
|
fc = ppStats (Stats [FetchCall "" [] 0])
|
|
fw = ppStats (Stats [FetchWait HashMap.empty 0 1])
|
|
fs = ppStats (Stats [FetchStats "" 0 0 0 0 0 0 0 []])
|
|
assertEqual "empty stats -> empty string" r ""
|
|
assertEqual "memo call stats -> empty string" mc ""
|
|
assertEqual "fetch call stats -> empty string" fc ""
|
|
assertBool "fetch wait stats -> some data" (not $ null fw)
|
|
assertBool "fetch stats -> some data" (not $ null fs)
|
|
|
|
|
|
tests = TestList [ TestLabel "Aggregate Batches" aggregateBatches
|
|
, TestLabel "Fetch IDs Sync" fetchIdsSync
|
|
, TestLabel "Fetch IDs Background" fetchIdsBackground
|
|
, TestLabel "ppStats" ppStatsTest ]
|