c35a9047d3
This is a non-backwards compatable change, so not suitable for merging w/o a annex.version bump and transition code. Not yet tested. This improves performance of git-annex benchmark --databases across the board by 10-25%, since eg Key roundtrips as a ByteString. (serializeKey' produces a lazy ByteString, so there is still a copy involved in converting it to a strict ByteString. It may be faster to switch to using bytestring-strict-builder.) FilePath and Key are both stored as blobs. This avoids mojibake in some situations. It would be possible to use varchar instead, if persistent could avoid converting that to Text, but it seems there is no good way to do so. See doc/todo/sqlite_database_improvements.mdwn Eliminated some ugly artifacts of using Read/Show serialization; constructors and quoted strings are no longer stored in sqlite. Renamed SRef to SSha to reflect that it is only ever a git sha, not a ref name. Since it is limited to the characters in a sha, it is not affected by mojibake, so still uses String.
117 lines
3.6 KiB
Haskell
117 lines
3.6 KiB
Haskell
{- git-annex database benchmarks
|
|
-
|
|
- Copyright 2016-2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Database.Benchmark (benchmarkDbs) where
|
|
|
|
import Annex.Common
|
|
import Types.Benchmark
|
|
#ifdef WITH_BENCHMARK
|
|
import qualified Database.Keys.SQL as SQL
|
|
import qualified Database.Queue as H
|
|
import Database.Init
|
|
import Utility.Tmp.Dir
|
|
import Git.FilePath
|
|
import Types.Key
|
|
|
|
import Criterion.Main
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import qualified Data.ByteString.Char8 as B8
|
|
import System.Random
|
|
#endif
|
|
|
|
benchmarkDbs :: CriterionMode -> Annex ()
|
|
#ifdef WITH_BENCHMARK
|
|
benchmarkDbs mode = withTmpDirIn "." "benchmark" $ \tmpdir -> do
|
|
-- benchmark different sizes of databases
|
|
dbs <- mapM (benchDb tmpdir)
|
|
[ 1000
|
|
, 10000
|
|
-- , 100000
|
|
]
|
|
liftIO $ runMode mode
|
|
[ bgroup "keys database" $ flip concatMap dbs $ \db ->
|
|
[ getAssociatedFilesHitBench db
|
|
, getAssociatedFilesMissBench db
|
|
, getAssociatedKeyHitBench db
|
|
, getAssociatedKeyMissBench db
|
|
, addAssociatedFileOldBench db
|
|
, addAssociatedFileNewBench db
|
|
]
|
|
]
|
|
#else
|
|
benchmarkDbs _ = error "not built with criterion, cannot benchmark"
|
|
#endif
|
|
|
|
#ifdef WITH_BENCHMARK
|
|
|
|
getAssociatedFilesHitBench :: BenchDb -> Benchmark
|
|
getAssociatedFilesHitBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (hit)") $ nfIO $ do
|
|
n <- getStdRandom (randomR (1,num))
|
|
SQL.getAssociatedFiles (keyN n) (SQL.ReadHandle h)
|
|
|
|
getAssociatedFilesMissBench :: BenchDb -> Benchmark
|
|
getAssociatedFilesMissBench (BenchDb h num) = bench ("getAssociatedFiles from " ++ show num ++ " (miss)") $ nfIO $
|
|
SQL.getAssociatedFiles keyMiss (SQL.ReadHandle h)
|
|
|
|
getAssociatedKeyHitBench :: BenchDb -> Benchmark
|
|
getAssociatedKeyHitBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (hit)") $ nfIO $ do
|
|
n <- getStdRandom (randomR (1,num))
|
|
SQL.getAssociatedKey (fileN n) (SQL.ReadHandle h)
|
|
|
|
getAssociatedKeyMissBench :: BenchDb -> Benchmark
|
|
getAssociatedKeyMissBench (BenchDb h num) = bench ("getAssociatedKey from " ++ show num ++ " (miss)") $ nfIO $
|
|
SQL.getAssociatedKey fileMiss (SQL.ReadHandle h)
|
|
|
|
addAssociatedFileOldBench :: BenchDb -> Benchmark
|
|
addAssociatedFileOldBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (old)") $ nfIO $ do
|
|
n <- getStdRandom (randomR (1,num))
|
|
SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h)
|
|
H.flushDbQueue h
|
|
|
|
addAssociatedFileNewBench :: BenchDb -> Benchmark
|
|
addAssociatedFileNewBench (BenchDb h num) = bench ("addAssociatedFile to " ++ show num ++ " (new)") $ nfIO $ do
|
|
n <- getStdRandom (randomR (1,num))
|
|
SQL.addAssociatedFile (keyN n) (fileN (n+1)) (SQL.WriteHandle h)
|
|
H.flushDbQueue h
|
|
|
|
populateAssociatedFiles :: H.DbQueue -> Int -> IO ()
|
|
populateAssociatedFiles h num = do
|
|
forM_ [1..num] $ \n ->
|
|
SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h)
|
|
H.flushDbQueue h
|
|
|
|
keyN :: Int -> Key
|
|
keyN n = stubKey
|
|
{ keyName = B8.pack $ "key" ++ show n
|
|
, keyVariety = OtherKey "BENCH"
|
|
}
|
|
|
|
fileN :: Int -> TopFilePath
|
|
fileN n = asTopFilePath ("file" ++ show n)
|
|
|
|
keyMiss :: Key
|
|
keyMiss = keyN 0 -- 0 is never stored
|
|
|
|
fileMiss :: TopFilePath
|
|
fileMiss = fileN 0 -- 0 is never stored
|
|
|
|
data BenchDb = BenchDb H.DbQueue Int
|
|
|
|
benchDb :: FilePath -> Int -> Annex BenchDb
|
|
benchDb tmpdir num = do
|
|
liftIO $ putStrLn $ "setting up database with " ++ show num
|
|
initDb db SQL.createTables
|
|
h <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable
|
|
liftIO $ populateAssociatedFiles h num
|
|
return (BenchDb h num)
|
|
where
|
|
db = tmpdir </> show num </> "db"
|
|
|
|
#endif /* WITH_BENCHMARK */
|