From 9a2b9d8df785100cc783724ce510b0b79924d17a Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Fri, 6 Oct 2023 09:49:19 +0300 Subject: [PATCH] introduced cookie to state db files in order to make multi-repo work for single reference and as a first step to join all states into one db (here may be issues though) --- hbs2-git/git-hbs2/GitRemoteMain.hs | 5 +- hbs2-git/lib/HBS2Git/Evolve.hs | 2 - hbs2-git/lib/HBS2Git/State.hs | 97 +++++++++++++++++++++--------- hbs2-git/lib/HBS2Git/Types.hs | 10 +-- 4 files changed, 74 insertions(+), 40 deletions(-) diff --git a/hbs2-git/git-hbs2/GitRemoteMain.hs b/hbs2-git/git-hbs2/GitRemoteMain.hs index ef0bc331..fe0d3269 100644 --- a/hbs2-git/git-hbs2/GitRemoteMain.hs +++ b/hbs2-git/git-hbs2/GitRemoteMain.hs @@ -82,9 +82,6 @@ loop :: forall m . ( MonadIO m ) => [String] -> GitRemoteApp m () loop args = do - - setLogging @TRACE tracePrefix - trace $ "args:" <+> pretty args let ref' = case args of @@ -193,6 +190,8 @@ loop args = do other -> die $ show other + shutUp + where fromString' "" = Nothing fromString' x = Just $ fromString x diff --git a/hbs2-git/lib/HBS2Git/Evolve.hs b/hbs2-git/lib/HBS2Git/Evolve.hs index 1e290826..4dce1832 100644 --- a/hbs2-git/lib/HBS2Git/Evolve.hs +++ b/hbs2-git/lib/HBS2Git/Evolve.hs @@ -28,8 +28,6 @@ evolve = do migrateConfig generateCookie - shutUp - pure () diff --git a/hbs2-git/lib/HBS2Git/State.hs b/hbs2-git/lib/HBS2Git/State.hs index a5a9a13a..fb02bb08 100644 --- a/hbs2-git/lib/HBS2Git/State.hs +++ b/hbs2-git/lib/HBS2Git/State.hs @@ -95,9 +95,10 @@ dbEnv0 dbInit fp = do trace "dbEnv called" let dir = takeDirectory fp liftIO $ createDirectoryIfMissing True dir - env <- DBEnv fp <$> liftIO (newTVarIO Nothing) - void $ withDB env dbInit - pure env + env0 <- DBEnv fp "" <$> liftIO (newTVarIO Nothing) + void $ withDB env0 dbInit + cookie <- withDB env0 $ readOrCreateCookie + DBEnv fp cookie <$> liftIO (newTVarIO Nothing) dbEnv :: (MonadIO m, MonadMask m) => FilePath -> m DBEnv dbEnv = dbEnv0 stateInit @@ -107,6 +108,7 @@ dbEnvReadOnly = dbEnv0 none withDB :: (MonadIO m, MonadMask m) => DBEnv -> DB m a -> m a withDB env action = do + trace $ "** DB run with COOKIE" <+> viaShow (view dbCookie env) conn <- initConnection env finally (runReaderT (fromDB action) env) $ do -- NOTE: we could not close connection here. @@ -149,26 +151,36 @@ stateInit = do ) |] + forM_ ["logimported", "tranimported", "refimported"] $ \t -> do + here <- colExists conn t "cookie" + unless here $ liftIO do + liftIO $ execute_ conn [qc| + DROP TABLE IF EXISTS {t}; + |] + liftIO $ execute_ conn [qc| create table if not exists logimported ( hash text not null - , primary key (hash) + , cookie text not null + , primary key (hash, cookie) ) |] liftIO $ execute_ conn [qc| create table if not exists refimported ( hash text not null + , cookie text not null , timestamp DATETIME DEFAULT CURRENT_TIMESTAMP - , primary key (hash) + , primary key (hash, cookie) ) |] liftIO $ execute_ conn [qc| create table if not exists tranimported ( hash text not null + , cookie text not null , timestamp DATETIME DEFAULT CURRENT_TIMESTAMP - , primary key (hash) + , primary key (hash, cookie) ) |] @@ -230,13 +242,29 @@ stateInit = do ORDER BY r.refname; |] + void $ readOrCreateCookie + + where + colExists :: MonadIO m => Connection -> String -> String -> m Bool + colExists conn table col = do + let sql =[qc|PRAGMA table_info({table})|] + fields <- liftIO $ query_ conn sql + let fs = [x | ((_, x, _, _, _, _) :: (Int, String, String, Int, Maybe String, Int)) <- fields ] + pure ( col `elem` fs ) + +readOrCreateCookie :: MonadIO m => DB m Cookie +readOrCreateCookie = do cfn <- cookieFile cf <- liftIO $ readFile cfn <&> take 4096 - when (null cf) do + if null cf then do cookie <- stateGenCookie liftIO $ LBS.writeFile cfn (fromCookie cookie) - + pure cookie + else do + let cookie = Cookie (fromString cf) + statePutCookie cookie + pure cookie newtype Savepoint = Savepoint String @@ -351,59 +379,64 @@ statePutLogCommitParent row = do statePutLogImported :: MonadIO m => HashRef -> DB m () statePutLogImported h = do conn <- stateConnection + cookie <- asks (view dbCookie) liftIO $ execute conn [qc| - insert into logimported (hash) values(?) - on conflict (hash) do nothing - |] (Only h) - + insert into logimported (hash,cookie) values(?,?) + on conflict (hash,cookie) do nothing + |] (h,cookie) stateGetLogImported :: MonadIO m => HashRef -> DB m Bool stateGetLogImported h = do conn <- stateConnection + cookie <- asks (view dbCookie) r <- liftIO $ query @_ @(Only Int) conn [qc| - select 1 from logimported where hash = ? limit 1 - |] (Only h) + select 1 from logimported where hash = ? and cookie = ? limit 1 + |] (h, cookie) pure $ not $ null r - statePutRefImported :: MonadIO m => HashRef -> DB m () statePutRefImported h = do conn <- stateConnection + cookie <- asks (view dbCookie) liftIO $ execute conn [qc| - insert into refimported (hash) values(?) - on conflict (hash) do nothing - |] (Only h) + insert into refimported (hash,cookie) values(?,?) + on conflict (hash,cookie) do nothing + |] (h,cookie) stateGetRefImported :: MonadIO m => HashRef -> DB m Bool stateGetRefImported h = do conn <- stateConnection + cookie <- asks (view dbCookie) r <- liftIO $ query @_ @(Only Int) conn [qc| - select 1 from refimported where hash = ? limit 1 - |] (Only h) + select 1 from refimported where hash = ? and cookie = ? limit 1 + |] (h, cookie) pure $ not $ null r statePutTranImported :: MonadIO m => HashRef -> DB m () statePutTranImported h = do conn <- stateConnection + cookie <- asks (view dbCookie) liftIO $ execute conn [qc| - insert into tranimported (hash) values(?) - on conflict (hash) do nothing - |] (Only h) + insert into tranimported (hash, cookie) values(?, ?) + on conflict (hash, cookie) do nothing + |] (h, cookie) stateGetTranImported :: MonadIO m => HashRef -> DB m Bool stateGetTranImported h = do conn <- stateConnection + cookie <- asks (view dbCookie) r <- liftIO $ query @_ @(Only Int) conn [qc| - select 1 from tranimported where hash = ? limit 1 - |] (Only h) + select 1 from tranimported where hash = ? and cookie = ? limit 1 + |] (h, cookie) pure $ not $ null r stateGetAllTranImported :: MonadIO m => DB m [HashRef] stateGetAllTranImported = do conn <- stateConnection - results <- liftIO $ query_ conn [qc| - select hash from tranimported - |] + cookie <- asks (view dbCookie) + results <- liftIO $ query conn [qc| + select hash from tranimported where cookie = ? + |] (Only cookie) pure $ map fromOnly results stateGetImportedCommits :: MonadIO m => DB m [GitHash] @@ -462,6 +495,12 @@ stateUpdateCommitDepths = do savepointRelease sp +statePutCookie :: MonadIO m => Cookie -> DB m () +statePutCookie cookie = do + conn <- stateConnection + let sql = [qc|INSERT INTO cookie (cookie) values(?) ON CONFLICT(cookie) DO NOTHING|] + liftIO $ execute conn sql (Only cookie) + stateGenCookie :: (MonadIO m) => DB m Cookie stateGenCookie = do conn <- stateConnection @@ -478,5 +517,3 @@ stateGenCookie = do pure cookie - - diff --git a/hbs2-git/lib/HBS2Git/Types.hs b/hbs2-git/lib/HBS2Git/Types.hs index 7a27c791..8f36e338 100644 --- a/hbs2-git/lib/HBS2Git/Types.hs +++ b/hbs2-git/lib/HBS2Git/Types.hs @@ -52,11 +52,6 @@ type HBS2L4Proto = L4Proto -- FIXME: introduce-API-type type API = String -data DBEnv = - DBEnv { _dbFilePath :: FilePath - , _dbConn :: TVar (Maybe Connection) - } - newtype Cookie = Cookie { fromCookie :: ByteString } deriving newtype (Eq,Ord,Show) @@ -67,6 +62,11 @@ instance IsString Cookie where $ show $ pretty $ hashObject @HbSync (LBS.pack s) +data DBEnv = + DBEnv { _dbFilePath :: FilePath + , _dbCookie :: Cookie + , _dbConn :: TVar (Maybe Connection) + } makeLenses 'DBEnv