[inferno-vc] Make cached client store all files under the same dir so…

… we also have cache hits on deps
plow-technologies · Oct 10, 2024 · 8608611 · 8608611
1 parent a898541
commit 8608611
Show file tree

Hide file tree

Showing 3 changed files with 8 additions and 5 deletions.
diff --git a/inferno-vc/CHANGELOG.md b/inferno-vc/CHANGELOG.md
@@ -1,6 +1,9 @@
 # Revision History for inferno-vc
 *Note*: we use https://pvp.haskell.org/ (MAJOR.MAJOR.MINOR.PATCH)
 
+## 0.3.8.0 -- 2024-10-10
+* Improve cache-hit ratio
+
 ## 0.3.7.1 -- 2024-09-23
 * Fix overflowing threadDelay on armv7l
 

diff --git a/inferno-vc/inferno-vc.cabal b/inferno-vc/inferno-vc.cabal
@@ -1,6 +1,6 @@
 cabal-version:       >=1.10
 name:                inferno-vc
-version:             0.3.7.1
+version:             0.3.8.0
 synopsis:            Version control server for Inferno
 description:         A version control server for Inferno scripts
 category:            DSL,Scripting

diff --git a/inferno-vc/src/Inferno/VersionControl/Client/Cached.hs b/inferno-vc/src/Inferno/VersionControl/Client/Cached.hs
@@ -79,7 +79,7 @@ data CachedVCClientError
 
 initVCCachedClient :: FilePath -> IO VCCacheEnv
 initVCCachedClient cachePath = do
-  createDirectoryIfMissing True $ cachePath </> "deps"
+  createDirectoryIfMissing True cachePath
   cacheInFlight <- newTVarIO mempty
   pure VCCacheEnv {cachePath, cacheInFlight}
 
@@ -106,12 +106,12 @@ fetchVCObjectClosure fetchVCObjects remoteFetchVCObjectClosureHashes objHash = d
   env@VCCacheEnv {cachePath} <- asks getTyped
   deps <-
     withInFlight env [objHash] $
-      liftIO (doesFileExist $ cachePath </> "deps" </> show objHash) >>= \case
+      liftIO (doesFileExist $ cachePath </> show objHash) >>= \case
         False -> do
           deps <- liftServantClient $ remoteFetchVCObjectClosureHashes objHash
           liftIO
             $ atomicWriteFile
-              (cachePath </> "deps" </> show objHash)
+              (cachePath </> show objHash)
             $ BL.concat [BL.fromStrict (vcObjectHashToByteString h) <> "\n" | h <- deps]
           pure deps
         True -> fetchVCObjectClosureHashes objHash
@@ -149,7 +149,7 @@ fetchVCObjectClosureHashes ::
   m [VCObjectHash]
 fetchVCObjectClosureHashes h = do
   VCCacheEnv {cachePath} <- asks getTyped
-  let fp = cachePath </> "deps" </> show h
+  let fp = cachePath </> show h
   readVCObjectHashTxt fp
 
 readVCObjectHashTxt ::