graphql-engine/server/src-test/Hasura/IncrementalSpec.hs
Alexis King bf466e3b63
server: Fix fine-grained incremental cache invalidation (fix #3759) (#6027)
This issue was very tricky to track down, but fortunately easy to fix.
The interaction here is subtle enough that it’s difficult to put into
English what would go wrong in what circumstances, but the new unit test
captures precisely that interaction to ensure it remains fixed.
2020-10-27 14:52:19 -05:00

73 lines
2.7 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{-# LANGUAGE Arrows #-}
module Hasura.IncrementalSpec (spec) where
import Hasura.Prelude
import qualified Data.HashMap.Strict as M
import qualified Data.HashSet as S
import Control.Arrow.Extended
import Control.Monad.Unique
import Test.Hspec
import qualified Hasura.Incremental as Inc
spec :: Spec
spec = do
describe "cache" $ do
it "skips re-running rules if the input didnt change" $ do
let add1 :: (MonadState Integer m) => m ()
add1 = modify' (+1)
rule = proc (a, b) -> do
Inc.cache $ arrM (\_ -> add1) -< a
Inc.cache $ arrM (\_ -> add1 *> add1) -< b
(result1, state1) <- runStateT (Inc.build rule (False, False)) 0
state1 `shouldBe` 3
(result2, state2) <- runStateT (Inc.rebuild result1 (True, False)) 0
state2 `shouldBe` 1
(_, state3) <- runStateT (Inc.rebuild result2 (True, True)) 0
state3 `shouldBe` 2
it "tracks dependencies within nested uses of cache across multiple executions" do
let rule :: (MonadWriter String m, MonadUnique m)
=> Inc.Rule m (Inc.InvalidationKey, Inc.InvalidationKey) ()
rule = proc (key1, key2) -> do
dep1 <- Inc.newDependency -< key2
(key1, dep1) >- Inc.cache (proc (_, dep2) ->
dep2 >- Inc.cache (proc dep3 -> do
Inc.dependOn -< dep3
arrM tell -< "executed"))
returnA -< ()
let key1 = Inc.initialInvalidationKey
key2 = Inc.invalidate key1
(result1, log1) <- runWriterT $ Inc.build rule (key1, key1)
log1 `shouldBe` "executed"
(result2, log2) <- runWriterT $ Inc.rebuild result1 (key2, key1)
log2 `shouldBe` ""
(_, log3) <- runWriterT $ Inc.rebuild result2 (key2, key2)
log3 `shouldBe` "executed"
describe "keyed" $ do
it "preserves incrementalization when entries dont change" $ do
let rule :: (MonadWriter (S.HashSet (String, Integer)) m, MonadUnique m)
=> Inc.Rule m (M.HashMap String Integer) (M.HashMap String Integer)
rule = proc m ->
(| Inc.keyed (\k v -> do
Inc.cache $ arrM (tell . S.singleton) -< (k, v)
returnA -< v * 2)
|) m
(result1, log1) <- runWriterT . Inc.build rule $ M.fromList [("a", 1), ("b", 2)]
Inc.result result1 `shouldBe` M.fromList [("a", 2), ("b", 4)]
log1 `shouldBe` S.fromList [("a", 1), ("b", 2)]
(result2, log2) <- runWriterT . Inc.rebuild result1 $ M.fromList [("a", 1), ("b", 3), ("c", 4)]
Inc.result result2 `shouldBe` M.fromList [("a", 2), ("b", 6), ("c", 8)]
log2 `shouldBe` S.fromList [("b", 3), ("c", 4)]