Track and use last known remote hash in pullv2

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_causal_hash)
       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

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)

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_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;

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

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 ()

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"

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 ->

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,

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