[Experimental] Add SyncV2 protocol

.gitignore

@@ -25,6 +25,7 @@ dist-newstyle
 *.hie
 *.prof
 *.prof.html
+*.profiterole.*
 *.hp
 *.ps
 /.direnv/

codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs

@@ -101,7 +101,7 @@ data BranchLocalIds' t d p c = LocalIds
     branchPatchLookup :: Vector p,
     branchChildLookup :: Vector c
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 -- | Bytes encoding a LocalBranch
 newtype LocalBranchBytes = LocalBranchBytes ByteString
@@ -110,6 +110,7 @@ newtype LocalBranchBytes = LocalBranchBytes ByteString
 data SyncBranchFormat' parent text defn patch child
   = SyncFull (BranchLocalIds' text defn patch child) LocalBranchBytes
   | SyncDiff parent (BranchLocalIds' text defn patch child) LocalBranchBytes
+  deriving (Eq, Show)
 
 type SyncBranchFormat = SyncBranchFormat' BranchObjectId TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Causal.hs

@@ -22,5 +22,6 @@ data SyncCausalFormat' causalHash valueHash = SyncCausalFormat
   { valueHash :: valueHash,
     parents :: Vector causalHash
   }
+  deriving stock (Eq, Show)
 
 type SyncCausalFormat = SyncCausalFormat' CausalHashId BranchHashId

codebase2/codebase-sqlite/U/Codebase/Sqlite/Decl/Format.hs

@@ -36,9 +36,11 @@ type SyncDeclFormat =
 
 data SyncDeclFormat' t d
   = SyncDecl (SyncLocallyIndexedComponent' t d)
+  deriving stock (Eq, Show)
 
 newtype SyncLocallyIndexedComponent' t d
   = SyncLocallyIndexedComponent (Vector (LocalIds' t d, ByteString))
+  deriving stock (Eq, Show)
 
 -- [OldDecl] ==map==> [NewDecl] ==number==> [(NewDecl, Int)] ==sort==> [(NewDecl, Int)] ==> permutation is map snd of that
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Entity.hs

@@ -24,6 +24,7 @@ data SyncEntity' text hash defn patch branchh branch causal
   | N (Namespace.SyncBranchFormat' branch text defn patch (branch, causal))
   | P (Patch.SyncPatchFormat' patch text hash defn)
   | C (Causal.SyncCausalFormat' causal branchh)
+  deriving stock (Eq, Show)
 
 entityType :: SyncEntity' text hash defn patch branchh branch causal -> TempEntityType
 entityType = \case

codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs

@@ -15,7 +15,7 @@ data LocalIds' t h = LocalIds
   { textLookup :: Vector t,
     defnLookup :: Vector h
   }
-  deriving (Functor, Show)
+  deriving stock (Functor, Show, Eq)
 
 type LocalIds = LocalIds' TextId ObjectId
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs

@@ -40,13 +40,15 @@ data PatchLocalIds' t h d = LocalIds
     patchHashLookup :: Vector h,
     patchDefnLookup :: Vector d
   }
+  deriving stock (Eq, Show)
 
 type SyncPatchFormat = SyncPatchFormat' PatchObjectId TextId HashId ObjectId
 
 data SyncPatchFormat' parent text hash defn
   = SyncFull (PatchLocalIds' text hash defn) ByteString
   | -- | p is the identity of the thing that the diff is relative to
     SyncDiff parent (PatchLocalIds' text hash defn) ByteString
+  deriving stock (Eq, Show)
 
 -- | Apply a list of patch diffs to a patch, left to right.
 applyPatchDiffs :: Patch -> [PatchDiff] -> Patch

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -228,6 +228,7 @@ module U.Codebase.Sqlite.Queries
     expectEntity,
     syncToTempEntity,
     insertTempEntity,
+    insertTempEntityV2,
     saveTempEntityInMain,
     expectTempEntity,
     deleteTempEntity,
@@ -315,6 +316,7 @@ import Data.Map.NonEmpty qualified as NEMap
 import Data.Maybe qualified as Maybe
 import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
+import Data.Set.NonEmpty (NESet)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import Data.Text.Lazy qualified as Text.Lazy
@@ -532,23 +534,18 @@ countWatches = queryOneCol [sql| SELECT COUNT(*) FROM watch |]
 
 saveHash :: Hash32 -> Transaction HashId
 saveHash hash = do
-  execute
-    [sql|
-      INSERT INTO hash (base32) VALUES (:hash)
-      ON CONFLICT DO NOTHING
-    |]
-  expectHashId hash
+  loadHashId hash >>= \case
+    Just h -> pure h
+    Nothing -> do
+      queryOneCol
+        [sql|
+          INSERT INTO hash (base32) VALUES (:hash)
+          RETURNING id
+        |]
 
 saveHashes :: Traversable f => f Hash32 -> Transaction (f HashId)
 saveHashes hashes = do
-  for_ hashes \hash ->
-    execute
-      [sql|
-        INSERT INTO hash (base32)
-        VALUES (:hash)
-        ON CONFLICT DO NOTHING
-      |]
-  traverse expectHashId hashes
+  for hashes saveHash
 
 saveHashHash :: Hash -> Transaction HashId
 saveHashHash = saveHash . Hash32.fromHash
@@ -623,13 +620,15 @@ expectBranchHashForCausalHash ch = do
 
 saveText :: Text -> Transaction TextId
 saveText t = do
-  execute
-    [sql|
-      INSERT INTO text (text)
-      VALUES (:t)
-      ON CONFLICT DO NOTHING
-    |]
-  expectTextId t
+  loadTextId t >>= \case
+    Just h -> pure h
+    Nothing -> do
+      queryOneCol
+        [sql|
+          INSERT INTO text (text)
+          VALUES (:t)
+          RETURNING id
+        |]
 
 saveTexts :: Traversable f => f Text -> Transaction (f TextId)
 saveTexts =
@@ -686,7 +685,7 @@ saveObject ::
   ObjectType ->
   ByteString ->
   Transaction ObjectId
-saveObject hh h t blob = do
+saveObject _hh h t blob = do
   execute
     [sql|
       INSERT INTO object (primary_hash_id, type_id, bytes)
@@ -697,9 +696,9 @@ saveObject hh h t blob = do
   saveHashObject h oId 2 -- todo: remove this from here, and add it to other relevant places once there are v1 and v2 hashes
   rowsModified >>= \case
     0 -> pure ()
-    _ -> do
-      hash <- expectHash32 h
-      tryMoveTempEntityDependents hh hash
+    _ -> pure ()
+      -- hash <- expectHash32 h
+      -- tryMoveTempEntityDependents hh hash
   pure oId
 
 expectObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a
@@ -957,7 +956,7 @@ saveCausal ::
   BranchHashId ->
   [CausalHashId] ->
   Transaction ()
-saveCausal hh self value parents = do
+saveCausal _hh self value parents = do
   execute
     [sql|
       INSERT INTO causal (self_hash_id, value_hash_id)
@@ -973,27 +972,27 @@ saveCausal hh self value parents = do
             INSERT INTO causal_parent (causal_id, parent_id)
             VALUES (:self, :parent)
           |]
-      flushCausalDependents hh self
+      -- flushCausalDependents hh self
 
-flushCausalDependents ::
+_flushCausalDependents ::
   HashHandle ->
   CausalHashId ->
   Transaction ()
-flushCausalDependents hh chId = do
+_flushCausalDependents hh chId = do
   hash <- expectHash32 (unCausalHashId chId)
-  tryMoveTempEntityDependents hh hash
+  _tryMoveTempEntityDependents hh hash
 
 -- | `tryMoveTempEntityDependents #foo` does this:
 --    0. Precondition: We just inserted object #foo.
 --    1. Look up the dependents of #foo
 --    2. Delete #foo as dependency from temp_entity_missing_dependency. e.g. (#bar, #foo), (#baz, #foo)
 --    3. For each like #bar and #baz with no more rows in temp_entity_missing_dependency,
 --        insert_entity them.
-tryMoveTempEntityDependents ::
+_tryMoveTempEntityDependents ::
   HashHandle ->
   Hash32 ->
   Transaction ()
-tryMoveTempEntityDependents hh dependency = do
+_tryMoveTempEntityDependents hh dependency = do
   dependents <-
     queryListCol
       [sql|
@@ -2993,6 +2992,35 @@ insertTempEntity entityHash entity missingDependencies = do
     entityType =
       Entity.entityType entity
 
+-- | Insert a new `temp_entity` row, and its associated 1+ `temp_entity_missing_dependency` rows.
+--
+-- Preconditions:
+--   1. The entity does not already exist in "main" storage (`object` / `causal`)
+--   2. The entity does not already exist in `temp_entity`.
+insertTempEntityV2 :: Hash32 -> TempEntity -> NESet Hash32 -> Transaction ()
+insertTempEntityV2 entityHash entity missingDependencies = do
+  execute
+    [sql|
+      INSERT INTO temp_entity (hash, blob, type_id)
+      VALUES (:entityHash, :entityBlob, :entityType)
+      ON CONFLICT DO NOTHING
+    |]
+
+  for_ missingDependencies \depHash ->
+    execute
+      [sql|
+        INSERT INTO temp_entity_missing_dependency (dependent, dependency)
+        VALUES (:entityHash, :depHash)
+      |]
+  where
+    entityBlob :: ByteString
+    entityBlob =
+      runPutS (Serialization.putTempEntity entity)
+
+    entityType :: TempEntityType
+    entityType =
+      Entity.entityType entity
+
 -- | Delete a row from the `temp_entity` table, if it exists.
 deleteTempEntity :: Hash32 -> Transaction ()
 deleteTempEntity hash =

codebase2/codebase-sqlite/U/Codebase/Sqlite/Term/Format.hs

@@ -49,6 +49,7 @@ newtype LocallyIndexedComponent' t d = LocallyIndexedComponent
 
 newtype SyncLocallyIndexedComponent' t d
   = SyncLocallyIndexedComponent (Vector (LocalIds' t d, ByteString))
+  deriving stock (Eq, Show)
 
 {-
 message = "hello, world"     -> ABT { ... { Term.F.Text "hello, world" } }    -> hashes to (#abc, 0)
@@ -127,6 +128,7 @@ data TermFormat' t d = Term (LocallyIndexedComponent' t d)
 type SyncTermFormat = SyncTermFormat' TextId ObjectId
 
 data SyncTermFormat' t d = SyncTerm (SyncLocallyIndexedComponent' t d)
+  deriving stock (Eq, Show)
 
 data WatchResultFormat
   = WatchResult WatchLocalIds Term

codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql

@@ -56,7 +56,8 @@ create table if not exists temp_entity (
 create table if not exists temp_entity_missing_dependency (
   dependent text not null references temp_entity(hash),
   dependency text not null,
-  dependencyJwt text not null,
+  -- TODO: this is just for testing
+  dependencyJwt text null,
   unique (dependent, dependency)
 );
 create index if not exists temp_entity_missing_dependency_ix_dependent on temp_entity_missing_dependency (dependent);

codebase2/codebase-sqlite/unison-codebase-sqlite.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 

hie.yaml

@@ -140,6 +140,9 @@ cradle:
     - path: "unison-share-api/src"
       component: "unison-share-api:lib"
 
+    - path: "unison-share-api/tests"
+      component: "unison-share-api:test:unison-share-api-tests"
+
     - path: "unison-share-projects-api/src"
       component: "unison-share-projects-api:lib"
 

lib/unison-pretty-printer/src/Unison/Util/AnnotatedText.hs

@@ -21,13 +21,13 @@ import Unison.Util.Monoid (intercalateMap)
 import Unison.Util.Range (Range (..), inRange)
 
 data Segment a = Segment {segment :: String, annotation :: Maybe a}
-  deriving (Eq, Show, Functor, Foldable, Generic)
+  deriving (Eq, Show, Ord, Functor, Foldable, Generic)
 
 toPair :: Segment a -> (String, Maybe a)
 toPair (Segment s a) = (s, a)
 
 newtype AnnotatedText a = AnnotatedText (Seq (Segment a))
-  deriving (Eq, Functor, Foldable, Show, Generic)
+  deriving (Eq, Functor, Foldable, Show, Ord, Generic)
 
 instance Semigroup (AnnotatedText a) where
   AnnotatedText (as :|> Segment "" _) <> bs = AnnotatedText as <> bs
@@ -204,7 +204,6 @@ snipWithContext margin source =
           -- if all annotations so far can be joined without .. separations
           if null rest
             then -- if this one can be joined to the new region without .. separation
-
               if withinMargin r0 r1
                 then -- add it to the first set and grow the compare region
                   (Just $ r0 <> r1, Map.insert r1 a1 taken, mempty)

lib/unison-sqlite/package.yaml

@@ -9,6 +9,7 @@ library:
 
   dependencies:
     - base
+    - containers
     - direct-sqlite
     - megaparsec
     - pretty-simple

lib/unison-sqlite/src/Unison/Sqlite.hs

@@ -19,6 +19,7 @@ module Unison.Sqlite
     Transaction,
     runTransaction,
     runTransactionWithRollback,
+    runTransactionExceptT,
     runReadOnlyTransaction,
     runWriteTransaction,
     cacheTransaction,