check fallback datacache for cacheResultWithInsert (#141)

Summary:
Pull Request resolved: #141

There are two ways into the DataFetch cache, through cacheResult, and dataFetch. The fallback only worked for dataFetch, and this diff adds cacheResult. This allows tests to inject state such as time through the fallback, and that should allow consistent tests

Differential Revision: D28534164

fbshipit-source-id: 64811913742c98708eb7f0cf3d651d3a12816323

Author: Dylan Yudaken

Haxl/Core/Fetch.hs

@@ -353,11 +353,19 @@ cacheResultWithInsert showFn insertFn req val = GenHaxl $ \e@Env{..} -> do
   mbRes <- DataCache.lookup req dataCache
   case mbRes of
     Nothing -> do
-      eitherResult <- Exception.try val
-      case eitherResult of
-        Left e -> rethrowAsyncExceptions e
-        _ -> return ()
-      let result = eitherToResultThrowIO eitherResult
+      let
+        getResult = do
+          eitherResult <- Exception.try val
+          case eitherResult of
+            Left e -> rethrowAsyncExceptions e
+            _ -> return ()
+          return $ eitherToResultThrowIO eitherResult
+      -- if there is a fallback configured try that
+      result <- case dataCacheFetchFallback of
+        Nothing -> getResult
+        Just (DataCacheLookup dcl) -> do
+          mbFallbackRes <- dcl req
+          maybe getResult return mbFallbackRes
       ivar <- newFullIVar result
       k <- nextCallId e
       insertFn req (DataCacheItem ivar k) dataCache

tests/DataCacheTest.hs

@@ -46,6 +46,14 @@ instance StateKey TestReq where
 
 instance ShowP TestReq where showp = show
 
+data CacheableReq x where CacheableInt :: Int -> CacheableReq Int
+  deriving Typeable
+deriving instance Eq (CacheableReq x)
+deriving instance Show (CacheableReq x)
+instance Hashable (CacheableReq x) where
+  hashWithSalt s (CacheableInt val) = hashWithSalt s (0::Int, val)
+
+
 newResult :: a -> IO (IVar u w a)
 newResult a = IVar <$> newIORef (IVarFull (Ok a NilWrites))
 
@@ -105,11 +113,15 @@ dcStrictnessTest = TestLabel "DataCache strictness" $ TestCase $ do
 dcFallbackTest :: Test
 dcFallbackTest = TestLabel "DataCache fallback" $ TestCase $ do
   env <- addLookup <$> initEnv (stateSet TestReqState stateEmpty) ()
-  r <- runHaxl env (dataFetch req)
+  (r,cached) <- runHaxl env (do
+                       a <- dataFetch req
+                       b <- cacheResult (CacheableInt 1234) (return 99999)
+                       return (a,b))
   (Stats stats) <- readIORef (statsRef env)
   assertEqual "fallback still has stats" 1
     (Prelude.length [x | x@FetchStats{} <- stats])
   assertEqual "dcFallbackTest found" 1 r
+  assertEqual "dcFallbackTest cached" 1234 cached
   rbad <- Control.Exception.try $ runHaxl env (dataFetch reqBad)
   assertBool "dcFallbackTest not found" $
     case rbad of
@@ -128,17 +140,23 @@ dcFallbackTest = TestLabel "DataCache fallback" $ TestCase $ do
         -- have to coerce on the way out as results are not Typeable
         -- so you better be sure you do it right!
         return $ unsafeCoerce . doReq <$> cast r
+      | typeOf r == typeRep (Proxy :: Proxy (CacheableReq Int)) =
+          return $ unsafeCoerce . doCache <$> cast r
       | otherwise = return Nothing
 
     doReq :: TestReq Int -> ResultVal Int ()
     doReq (Req r) = Ok r NilWrites
 
+    doCache :: CacheableReq Int -> ResultVal Int ()
+    doCache (CacheableInt i) = Ok i NilWrites
+
     req :: TestReq Int
     req = Req 1
 
     reqBad :: TestReq String
     reqBad = Req 2
 
+
 -- tests :: Assertion
 tests = TestList [ dcSoundnessTest
                  , dcStrictnessTest