From 590505a20bf68b79b3e7a460dd057581866efc11 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 17 Jan 2025 14:55:34 -0800 Subject: [PATCH 1/3] Track latest known remote for cloned/pushed projects --- .../U/Codebase/Sqlite/Queries.hs | 41 +++++++++++++++---- .../U/Codebase/Sqlite/RemoteProjectBranch.hs | 6 ++- .../sql/016-track-latest-remote-head.sql | 7 ++++ .../unison-codebase-sqlite.cabal | 1 + .../Codebase/SqliteCodebase/Migrations.hs | 3 +- unison-cli/src/Unison/Cli/Share/Projects.hs | 5 +++ 6 files changed, 52 insertions(+), 11 deletions(-) create mode 100644 codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 3d94e12f2f..4b223e2385 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -146,6 +146,7 @@ module U.Codebase.Sqlite.Queries -- ** remote project branches loadRemoteBranch, ensureRemoteProjectBranch, + setRemoteProjectBranchLastKnownCausalHash, expectRemoteProjectBranchName, setRemoteProjectBranchName, insertBranchRemoteMapping, @@ -258,6 +259,7 @@ module U.Codebase.Sqlite.Queries addProjectBranchReflogTable, addProjectBranchCausalHashIdColumn, addProjectBranchLastAccessedColumn, + trackLatestRemoteHead, -- ** schema version currentSchemaVersion, @@ -422,7 +424,7 @@ type TextPathSegments = [Text] -- * main squeeze currentSchemaVersion :: SchemaVersion -currentSchemaVersion = 18 +currentSchemaVersion = 19 runCreateSql :: Transaction () runCreateSql = @@ -492,6 +494,10 @@ addProjectBranchLastAccessedColumn :: Transaction () addProjectBranchLastAccessedColumn = executeStatements $(embedProjectStringFile "sql/015-add-project-branch-last-accessed.sql") +trackLatestRemoteHead :: Transaction () +trackLatestRemoteHead = + executeStatements $(embedProjectStringFile "sql/016-track-latest-remote-head.sql") + schemaVersion :: Transaction SchemaVersion schemaVersion = queryOneCol @@ -4140,7 +4146,8 @@ loadRemoteBranch rpid host rbid = project_id, branch_id, host, - name + name, + last_known_causal_hash FROM remote_project_branch WHERE @@ -4149,28 +4156,46 @@ loadRemoteBranch rpid host rbid = AND host = :host |] -ensureRemoteProjectBranch :: RemoteProjectId -> URI -> RemoteProjectBranchId -> ProjectBranchName -> Transaction () -ensureRemoteProjectBranch rpid host rbid name = +ensureRemoteProjectBranch :: RemoteProjectId -> URI -> RemoteProjectBranchId -> ProjectBranchName -> Maybe CausalHashId -> Transaction () +ensureRemoteProjectBranch rpid host rbid name lastKnownCausalHash = execute [sql| INSERT INTO remote_project_branch ( project_id, host, branch_id, - name) + name, + last_known_head) VALUES ( :rpid, :host, :rbid, - :name) + :name, + :lastKnownCausalHash + ) ON CONFLICT ( project_id, branch_id, host) - -- should this update the name instead? - DO NOTHING + DO UPDATE + SET name = :name, + last_known_causal_hash = :lastKnownCausalHash |] +setRemoteProjectBranchLastKnownCausalHash :: URI -> RemoteProjectId -> RemoteProjectBranchId -> CausalHashId -> Transaction () +setRemoteProjectBranchLastKnownCausalHash host rpid rbid causalHashId = + execute + [sql| + UPDATE + remote_project_branch + SET + last_known_causal_hash = :causalHashId + WHERE + project_id = :rpid + AND branch_id = :rbid + AND host = :host + |] + expectRemoteProjectBranchName :: URI -> RemoteProjectId -> RemoteProjectBranchId -> Transaction ProjectBranchName expectRemoteProjectBranchName host projectId branchId = queryOneCol diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/RemoteProjectBranch.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/RemoteProjectBranch.hs index 5e5638c274..6dff479efc 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/RemoteProjectBranch.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/RemoteProjectBranch.hs @@ -5,7 +5,7 @@ where import Network.URI (URI) import Network.URI.Orphans.Sqlite () -import U.Codebase.Sqlite.DbId (RemoteProjectBranchId, RemoteProjectId) +import U.Codebase.Sqlite.DbId (CausalHashId, RemoteProjectBranchId, RemoteProjectId) import Unison.Core.Orphans.Sqlite () import Unison.Core.Project (ProjectBranchName) import Unison.Prelude @@ -15,7 +15,9 @@ data RemoteProjectBranch = RemoteProjectBranch { projectId :: RemoteProjectId, branchId :: RemoteProjectBranchId, host :: URI, - name :: ProjectBranchName + name :: ProjectBranchName, + -- Note that there's no guarantee that the causals for this hash have been downloaded/synced into the codebase. + lastKnownCausalHash :: CausalHashId } deriving stock (Generic, Show) deriving anyclass (ToRow, FromRow) diff --git a/codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql b/codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql new file mode 100644 index 0000000000..cb92fb4eb3 --- /dev/null +++ b/codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql @@ -0,0 +1,7 @@ +-- Add a field for tracking the latest known causal hash for each remote project branch. +-- It's helpful for when we need to tell Share how much we know about a branch. + +ALTER TABLE remote_project + -- Note that there isn't a guarantee this hash has actually been synced into the codebase. + ADD COLUMN last_known_causal_hash INTEGER NULL REFERENCES hash(id) + ON DELETE SET NULL; diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index ac075bccfe..c183602974 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -25,6 +25,7 @@ extra-source-files: sql/013-add-project-branch-reflog-table.sql sql/014-add-project-branch-causal-hash-id.sql sql/015-add-project-branch-last-accessed.sql + sql/016-track-latest-remote-head.sql sql/create.sql source-repository head diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 32527471df..3e088d9995 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -85,7 +85,8 @@ migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath = sqlMigration 15 Q.addSquashResultTableIfNotExists, sqlMigration 16 Q.cdToProjectRoot, (17 {- This migration takes a raw sqlite connection -}, \conn -> migrateSchema16To17 conn), - sqlMigration 18 Q.addProjectBranchLastAccessedColumn + sqlMigration 18 Q.addProjectBranchLastAccessedColumn, + sqlMigration 19 Q.trackLatestRemoteHead ] where runT :: Sqlite.Transaction () -> Sqlite.Connection -> IO () diff --git a/unison-cli/src/Unison/Cli/Share/Projects.hs b/unison-cli/src/Unison/Cli/Share/Projects.hs index 52fbc56e8e..056e2790c3 100644 --- a/unison-cli/src/Unison/Cli/Share/Projects.hs +++ b/unison-cli/src/Unison/Cli/Share/Projects.hs @@ -49,9 +49,11 @@ import Unison.Codebase.Editor.Output qualified as Output import Unison.Hash32 (Hash32) import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) +import Unison.Share.API.Hash qualified as HashJWT import Unison.Share.API.Projects qualified as Share.API import Unison.Share.Codeserver (defaultCodeserver) import Unison.Share.Types (codeserverBaseURL) +import Unison.Sync.Common qualified as Sync -- | Get a project by id. -- @@ -193,14 +195,17 @@ onGotProjectBranch :: Share.API.ProjectBranch -> Cli RemoteProjectBranch onGotProjectBranch branch = do let projectId = RemoteProjectId (branch ^. #projectId) let branchId = RemoteProjectBranchId (branch ^. #branchId) + let causalHash = Sync.hash32ToCausalHash $ HashJWT.hashJWTHash (branch ^. #branchHead) projectName <- validateProjectName (branch ^. #projectName) branchName <- validateBranchName (branch ^. #branchName) Cli.runTransaction do + causalHashId <- Queries.saveCausalHash causalHash Queries.ensureRemoteProjectBranch projectId hardCodedUri branchId branchName + (Just causalHashId) pure RemoteProjectBranch { projectId, From e37674502dfb6c3c29a18a570e59364e3c64fa44 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Feb 2025 14:43:05 -0800 Subject: [PATCH 2/3] Use last-known remote branch instead of causal negotiation --- unison-cli/src/Unison/Cli/DownloadUtils.hs | 13 +++++++++++-- unison-cli/src/Unison/Share/SyncV2.hs | 12 ++++++++---- 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index 936b2b3fba..31139a0f2a 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -11,10 +11,13 @@ where import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVar, readTVarIO) import Data.List.NonEmpty (pattern (:|)) +import Data.Set qualified as Set import System.Console.Regions qualified as Console.Regions import System.IO.Unsafe (unsafePerformIO) import U.Codebase.HashTags (CausalHash) +import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.Queries qualified as Queries +import U.Codebase.Sqlite.RemoteProjectBranch qualified as SqliteRPB import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.Share.Projects qualified as Share @@ -77,9 +80,15 @@ downloadProjectBranchFromShare useSquashed branch = Cli.respond (Output.DownloadedEntities numDownloaded) SyncV2 -> do let branchRef = SyncV2.BranchRef (into @Text (ProjectAndBranch branch.projectName remoteProjectBranchName)) - let downloadedCallback = \_ -> pure () let shouldValidate = not $ Codeserver.isCustomCodeserver Codeserver.defaultCodeserver - result <- SyncV2.syncFromCodeserver shouldValidate Share.hardCodedBaseUrl branchRef causalHashJwt downloadedCallback + knownRemoteHash <- fmap (fromMaybe Set.empty) . Cli.runTransaction $ runMaybeT do + lastKnownCausalHashId <- SqliteRPB.lastKnownCausalHash <$> MaybeT (Q.loadRemoteBranch branch.projectId Share.hardCodedUri branch.branchId) + lastKnownCausalHash <- lift $ Q.expectCausalHash lastKnownCausalHashId + -- Check that we actually have this causal saved. + lift (Q.checkBranchExistsForCausalHash lastKnownCausalHash) >>= \case + True -> pure (Set.singleton lastKnownCausalHash) + False -> pure mempty + result <- SyncV2.syncFromCodeserver shouldValidate Share.hardCodedBaseUrl branchRef causalHashJwt knownRemoteHash result & onLeft \err0 -> do done case err0 of Share.SyncError pullErr -> diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 14870f208d..7e668782ac 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -155,16 +155,20 @@ syncFromCodeserver :: SyncV2.BranchRef -> -- | The hash to download. Share.HashJWT -> - -- | Callback that's given a number of entities we just downloaded. - (Int -> IO ()) -> + -- | Set of known hashes to avoid downloading. + -- If provided we'll skip the negotiation stage. + Set CausalHash -> Cli (Either (SyncError SyncV2.PullError) ()) -syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt _downloadedCallback = do +syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt providedKnownHashes = do Cli.Env {authHTTPClient, codebase} <- ask -- Every insert into SQLite checks the temp entity tables, but syncv2 doesn't actually use them, so it's faster -- if we clear them out before starting a sync. Cli.runTransaction Q.clearTempEntityTables runExceptT do - knownHashes <- ExceptT $ negotiateKnownCausals unisonShareUrl branchRef hashJwt + knownHashes <- + if Set.null providedKnownHashes + then ExceptT $ negotiateKnownCausals unisonShareUrl branchRef hashJwt + else pure (Set.map Sync.causalHashToHash32 providedKnownHashes) let hash = Share.hashJWTHash hashJwt ExceptT $ do (Cli.runTransaction (Q.entityLocation hash)) >>= \case From 1e9cb6c6dc80579d195f6b1c208a1c43b3e9ca5b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 13 Feb 2025 09:32:16 -0800 Subject: [PATCH 3/3] Add remote head hash in new codebases --- codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 2 +- codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql | 2 +- .../src/Unison/Codebase/SqliteCodebase/Operations.hs | 1 + 3 files changed, 3 insertions(+), 2 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 4b223e2385..e163e1cd26 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -4165,7 +4165,7 @@ ensureRemoteProjectBranch rpid host rbid name lastKnownCausalHash = host, branch_id, name, - last_known_head) + last_known_causal_hash) VALUES ( :rpid, :host, diff --git a/codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql b/codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql index cb92fb4eb3..bb220e9441 100644 --- a/codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql +++ b/codebase2/codebase-sqlite/sql/016-track-latest-remote-head.sql @@ -1,7 +1,7 @@ -- Add a field for tracking the latest known causal hash for each remote project branch. -- It's helpful for when we need to tell Share how much we know about a branch. -ALTER TABLE remote_project +ALTER TABLE remote_project_branch -- Note that there isn't a guarantee this hash has actually been synced into the codebase. ADD COLUMN last_known_causal_hash INTEGER NULL REFERENCES hash(id) ON DELETE SET NULL; diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index cef8475cbf..40f499b52f 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -100,6 +100,7 @@ createSchema = do (_, emptyCausalHashId) <- emptyCausalHash (_, ProjectBranch {projectId, branchId}) <- insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId Q.setCurrentProjectPath projectId branchId [] + Q.trackLatestRemoteHead where scratchProjectName = UnsafeProjectName "scratch" scratchBranchName = UnsafeProjectBranchName "main"