From cc36c8516aab0b1362daeb35f5edc33f2d6ff23a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 31 Mar 2023 14:34:18 -0400 Subject: [PATCH] Sped up sqlite inserts 2x when built with persistent 2.14.5.0 https://github.com/yesodweb/persistent/issues/1457 Sponsored-by: Dartmouth College's DANDI project --- CHANGELOG | 1 + Database/ContentIdentifier.hs | 5 ++-- Database/Export.hs | 7 ++--- Database/Fsck.hs | 3 ++- Database/Handle.hs | 3 +-- Database/Keys/SQL.hs | 3 ++- Database/Utility.hs | 27 +++++++++++++++++++ ..._13ce5ec87207d553388ec23663d9abcb._comment | 11 ++++++++ git-annex.cabal | 1 + 9 files changed, 52 insertions(+), 9 deletions(-) create mode 100644 Database/Utility.hs create mode 100644 doc/bugs/performance_regression__63___init_takes_times_more/comment_18_13ce5ec87207d553388ec23663d9abcb._comment diff --git a/CHANGELOG b/CHANGELOG index 699331bfc3..ff8ffdeb2a 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -2,6 +2,7 @@ git-annex (10.20230330) UNRELEASED; urgency=medium * git-annex.cabal: Prevent building with unix-compat 0.7 which removed System.PosixCompat.User. + * Sped up sqlite inserts 2x when built with persistent 2.14.5.0 -- Joey Hess Fri, 31 Mar 2023 12:48:54 -0400 diff --git a/Database/ContentIdentifier.hs b/Database/ContentIdentifier.hs index aa595a98ce..e304dca58f 100644 --- a/Database/ContentIdentifier.hs +++ b/Database/ContentIdentifier.hs @@ -36,6 +36,7 @@ module Database.ContentIdentifier ( import Database.Types import qualified Database.Queue as H import Database.Init +import Database.Utility import Annex.Locations import Annex.Common hiding (delete) import qualified Annex.Branch @@ -109,7 +110,7 @@ flushDbQueue (ContentIdentifierHandle h) = H.flushDbQueue h -- Be sure to also update the git-annex branch when using this. recordContentIdentifier :: ContentIdentifierHandle -> RemoteStateHandle -> ContentIdentifier -> Key -> IO () recordContentIdentifier h (RemoteStateHandle u) cid k = queueDb h $ do - void $ insertUnique $ ContentIdentifiers u cid k + void $ insertUniqueFast $ ContentIdentifiers u cid k getContentIdentifiers :: ContentIdentifierHandle -> RemoteStateHandle -> Key -> IO [ContentIdentifier] getContentIdentifiers (ContentIdentifierHandle h) (RemoteStateHandle u) k = @@ -132,7 +133,7 @@ getContentIdentifierKeys (ContentIdentifierHandle h) (RemoteStateHandle u) cid = recordAnnexBranchTree :: ContentIdentifierHandle -> Sha -> IO () recordAnnexBranchTree h s = queueDb h $ do deleteWhere ([] :: [Filter AnnexBranch]) - void $ insertUnique $ AnnexBranch $ toSSha s + void $ insertUniqueFast $ AnnexBranch $ toSSha s getAnnexBranchTree :: ContentIdentifierHandle -> IO Sha getAnnexBranchTree (ContentIdentifierHandle h) = H.queryDbQueue h $ do diff --git a/Database/Export.hs b/Database/Export.hs index b5c58afd0b..4e01752d9b 100644 --- a/Database/Export.hs +++ b/Database/Export.hs @@ -49,6 +49,7 @@ module Database.Export ( import Database.Types import qualified Database.Queue as H import Database.Init +import Database.Utility import Annex.Locations import Annex.Common hiding (delete) import Types.Export @@ -124,7 +125,7 @@ flushDbQueue (ExportHandle h _) = H.flushDbQueue h recordExportTreeCurrent :: ExportHandle -> Sha -> IO () recordExportTreeCurrent h s = queueDb h $ do deleteWhere ([] :: [Filter ExportTreeCurrent]) - void $ insertUnique $ ExportTreeCurrent $ toSSha s + void $ insertUniqueFast $ ExportTreeCurrent $ toSSha s getExportTreeCurrent :: ExportHandle -> IO (Maybe Sha) getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do @@ -136,7 +137,7 @@ getExportTreeCurrent (ExportHandle h _) = H.queryDbQueue h $ do addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO () addExportedLocation h k el = queueDb h $ do - void $ insertUnique $ Exported k ef + void $ insertUniqueFast $ Exported k ef let edirs = map (\ed -> ExportedDirectory (SFilePath (fromExportDirectory ed)) ef) (exportDirectories el) @@ -186,7 +187,7 @@ getExportTreeKey (ExportHandle h _) el = H.queryDbQueue h $ do addExportTree :: ExportHandle -> Key -> ExportLocation -> IO () addExportTree h k loc = queueDb h $ - void $ insertUnique $ ExportTree k ef + void $ insertUniqueFast $ ExportTree k ef where ef = SFilePath (fromExportLocation loc) diff --git a/Database/Fsck.hs b/Database/Fsck.hs index 61e932e3da..cccefefeda 100644 --- a/Database/Fsck.hs +++ b/Database/Fsck.hs @@ -29,6 +29,7 @@ module Database.Fsck ( import Database.Types import qualified Database.Queue as H +import Database.Utility import Database.Init import Annex.Locations import Utility.Exception @@ -88,7 +89,7 @@ closeDb (FsckHandle h u) = do addDb :: FsckHandle -> Key -> IO () addDb (FsckHandle h _) k = H.queueDb h checkcommit $ - void $ insertUnique $ Fscked k + void $ insertUniqueFast $ Fscked k where -- Commit queue after 1000 changes or 5 minutes, whichever comes first. -- The time based commit allows for an incremental fsck to be diff --git a/Database/Handle.hs b/Database/Handle.hs index c960375877..da7a0e173a 100644 --- a/Database/Handle.hs +++ b/Database/Handle.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE TypeFamilies, FlexibleContexts, OverloadedStrings #-} +{-# LANGUAGE TypeFamilies, FlexibleContexts, OverloadedStrings, CPP #-} module Database.Handle ( DbHandle, @@ -329,4 +329,3 @@ isDatabaseModified (DatabaseInodeCache a1 b1) (DatabaseInodeCache a2 b2) = takeMVarSafe :: MVar a -> IO (Either BlockedIndefinitelyOnMVar a) takeMVarSafe = try . takeMVar - diff --git a/Database/Keys/SQL.hs b/Database/Keys/SQL.hs index c97a4280b9..e190c90ab0 100644 --- a/Database/Keys/SQL.hs +++ b/Database/Keys/SQL.hs @@ -21,6 +21,7 @@ module Database.Keys.SQL where import Database.Types import Database.Handle +import Database.Utility import qualified Database.Queue as H import Utility.InodeCache import Git.FilePath @@ -121,7 +122,7 @@ removeAssociatedFile k f = queueDb $ addInodeCaches :: Key -> [InodeCache] -> WriteHandle -> IO () addInodeCaches k is = queueDb $ - forM_ is $ \i -> insertUnique $ Content k i + forM_ is $ \i -> insertUniqueFast $ Content k i (inodeCacheToFileSize i) (inodeCacheToEpochTime i) diff --git a/Database/Utility.hs b/Database/Utility.hs new file mode 100644 index 0000000000..55943fcc89 --- /dev/null +++ b/Database/Utility.hs @@ -0,0 +1,27 @@ +{- Persistent sqlite database utilities. + - + - Copyright 2023 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE TypeFamilies, CPP #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Database.Utility ( + insertUniqueFast, +) where + +import Control.Monad +import Database.Persist.Class + +{- insertUnique_ is 2x as fast as insertUnique, so use when available. + - + - It would be difficult to write the type signature here, since older + - versions of persistent have different constraints on insertUnique. + -} +#if MIN_VERSION_persistent(2,14,5) +insertUniqueFast x = void (insertUnique_ x) +#else +insertUniqueFast x = void (insertUnique x) +#endif diff --git a/doc/bugs/performance_regression__63___init_takes_times_more/comment_18_13ce5ec87207d553388ec23663d9abcb._comment b/doc/bugs/performance_regression__63___init_takes_times_more/comment_18_13ce5ec87207d553388ec23663d9abcb._comment new file mode 100644 index 0000000000..0ce3682574 --- /dev/null +++ b/doc/bugs/performance_regression__63___init_takes_times_more/comment_18_13ce5ec87207d553388ec23663d9abcb._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 18""" + date="2023-03-31T18:36:56Z" + content=""" +Implemented support for + in git-annex, +which does speed up sqlite inserts 2x. That will affect the scan in +question, since that inserts to the keys database. It also will speed up +some unrelated parts of git-annex. +"""]] diff --git a/git-annex.cabal b/git-annex.cabal index 365d19ce42..1fb739cf26 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -836,6 +836,7 @@ Executable git-annex Database.Keys.SQL Database.Queue Database.Types + Database.Utility Git Git.AutoCorrect Git.Branch -- 2.30.2