SyncV2

package.yaml

@@ -44,7 +44,9 @@ dependencies:
 - bytestring
 - bytes
 - case-insensitive
+- cborg
 - clock
+- conduit
 - containers
 - cookie
 - cryptonite
@@ -94,7 +96,10 @@ dependencies:
 - servant-auth
 - servant-client
 - servant-server
+- servant-conduit
+- serialise
 - stm
+- stm-chans
 - text
 - these
 - time

share-api.cabal

@@ -94,6 +94,7 @@ library
       Share.Utils.Logging.Types
       Share.Utils.Postgres
       Share.Utils.Servant
+      Share.Utils.Servant.CBOR
       Share.Utils.Servant.Client
       Share.Utils.Servant.PathInfo
       Share.Utils.Servant.RawRequest
@@ -152,6 +153,9 @@ library
       Share.Web.UCM.Sync.HashJWT
       Share.Web.UCM.Sync.Impl
       Share.Web.UCM.Sync.Types
+      Share.Web.UCM.SyncV2.API
+      Share.Web.UCM.SyncV2.Impl
+      Share.Web.UCM.SyncV2.Queries
       Unison.PrettyPrintEnvDecl.Postgres
       Unison.Server.NameSearch.Postgres
       Unison.Server.Share.Definitions
@@ -208,7 +212,9 @@ library
     , bytes
     , bytestring
     , case-insensitive
+    , cborg
     , clock
+    , conduit
     , containers
     , cookie
     , cryptonite
@@ -252,13 +258,16 @@ library
     , raven-haskell
     , safe
     , semialign
+    , serialise
     , servant
     , servant-auth
     , servant-client
+    , servant-conduit
     , servant-server
     , share-auth
     , share-utils
     , stm
+    , stm-chans
     , text
     , these
     , time
@@ -351,7 +360,9 @@ executable share-api
     , bytes
     , bytestring
     , case-insensitive
+    , cborg
     , clock
+    , conduit
     , containers
     , cookie
     , cryptonite
@@ -395,14 +406,17 @@ executable share-api
     , raven-haskell
     , safe
     , semialign
+    , serialise
     , servant
     , servant-auth
     , servant-client
+    , servant-conduit
     , servant-server
     , share-api
     , share-auth
     , share-utils
     , stm
+    , stm-chans
     , text
     , these
     , time

sql/2024-09-00-00_sync_v2.sql

@@ -0,0 +1,36 @@
+CREATE TABLE serialized_components (
+    -- The user the term is sandboxed to.
+    user_id UUID NOT NULL REFERENCES users(id) ON DELETE CASCADE,
+    component_hash_id INTEGER NOT NULL REFERENCES component_hashes(id) ON DELETE CASCADE,
+
+    -- The serialized component
+    bytes_id INTEGER NOT NULL REFERENCES bytes(id) ON DELETE NO ACTION,
+
+    created_at TIMESTAMP NOT NULL DEFAULT NOW(),
+
+    PRIMARY KEY (user_id, component_hash_id) INCLUDE (bytes_id)
+);
+
+-- namespaces don't need to be sandboxed to user.
+CREATE TABLE serialized_namespaces (
+    namespace_hash_id INTEGER NOT NULL REFERENCES branch_hashes(id) ON DELETE NO ACTION,
+
+    -- The serialized namespace
+    bytes_id INTEGER NOT NULL REFERENCES bytes(id) ON DELETE NO ACTION,
+
+    created_at TIMESTAMP NOT NULL DEFAULT NOW(),
+
+    PRIMARY KEY (namespace_hash_id) INCLUDE (bytes_id)
+);
+
+CREATE TABLE serialized_patches (
+  patch_id INTEGER NOT NULL REFERENCES patches(id) ON DELETE CASCADE,
+  bytes_id INTEGER NOT NULL REFERENCES bytes(id) ON DELETE NO ACTION,
+  created_at TIMESTAMP NOT NULL DEFAULT NOW()
+);
+
+CREATE TABLE serialized_causals (
+  causal_id INTEGER NOT NULL REFERENCES causals(id) ON DELETE CASCADE,
+  bytes_id INTEGER NOT NULL REFERENCES bytes(id) ON DELETE NO ACTION,
+  created_at TIMESTAMP NOT NULL DEFAULT NOW()
+);

src/Share/Postgres.hs

@@ -19,7 +19,6 @@ module Share.Postgres
     Interp.DecodeValue (..),
     Interp.DecodeRow (..),
     Interp.DecodeField,
-    RawBytes (..),
     Only (..),
     QueryA (..),
     QueryM (..),
@@ -101,6 +100,7 @@ import Share.Utils.Logging qualified as Logging
 import Share.Web.App
 import Share.Web.Errors (ErrorID (..), SomeServerError, ToServerError (..), internalServerError, respondError, someServerError)
 import System.CPUTime (getCPUTime)
+import Unison.Debug qualified as UDebug
 
 data TransactionError e
   = Unrecoverable SomeServerError
@@ -334,7 +334,9 @@ instance QueryA (Transaction e) where
   statement q s = do
     transactionStatement q s
 
-  unrecoverableError e = Transaction (pure (Left (Unrecoverable (someServerError e))))
+  unrecoverableError e = do
+    UDebug.debugM UDebug.Temp "Unrecoverable error in transaction: " e
+    Transaction (pure (Left (Unrecoverable (someServerError e))))
 
 instance QueryM (Transaction e) where
   transactionUnsafeIO io = Transaction (Right <$> liftIO io)
@@ -343,7 +345,9 @@ instance QueryA (Session e) where
   statement q s = do
     lift $ Session.statement q s
 
-  unrecoverableError e = throwError (Unrecoverable (someServerError e))
+  unrecoverableError e = do
+    UDebug.debugM UDebug.Temp "Unrecoverable error in transaction: " e
+    throwError (Unrecoverable (someServerError e))
 
 instance QueryM (Session e) where
   transactionUnsafeIO io = lift $ liftIO io
@@ -356,7 +360,8 @@ instance QueryA (Pipeline e) where
 instance (QueryM m) => QueryA (ReaderT e m) where
   statement q s = lift $ statement q s
 
-  unrecoverableError e = lift $ unrecoverableError e
+  unrecoverableError e = do
+    lift $ unrecoverableError e
 
 instance (QueryM m) => QueryM (ReaderT e m) where
   transactionUnsafeIO io = lift $ transactionUnsafeIO io
@@ -469,17 +474,6 @@ cachedForOf trav s f = do
 cachedFor :: (Traversable t, Monad m, Ord a) => t a -> (a -> m b) -> m (t b)
 cachedFor = cachedForOf traversed
 
--- | Preferably you should use custom newtypes for your bytes, but you can use this with
--- deriving via to get the encoding/decoding instances.
-newtype RawBytes = RawBytes {unRawBytes :: ByteString}
-  deriving stock (Show, Eq, Ord)
-
-instance Interp.EncodeValue RawBytes where
-  encodeValue = contramap unRawBytes Encoders.bytea
-
-instance Interp.DecodeValue RawBytes where
-  decodeValue = RawBytes <$> Decoders.bytea
-
 -- | Useful when running queries using a join over `toTable` which may be empty.
 -- Without explicitly handling the empty case we'll waste time sending a query to PG
 -- that we know can't return any results.

src/Share/Postgres/Definitions/Queries.hs

@@ -39,6 +39,7 @@ import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Vector (Vector)
 import Data.Vector qualified as Vector
+import Servant (err500)
 import Share.Codebase.Types (CodebaseEnv (..), CodebaseM)
 import Share.IDs
 import Share.Postgres
@@ -49,9 +50,8 @@ import Share.Postgres.Hashes.Queries qualified as HashQ
 import Share.Postgres.IDs
 import Share.Prelude
 import Share.Utils.Logging qualified as Logging
-import Share.Utils.Postgres (OrdBy)
+import Share.Utils.Postgres (OrdBy, RawBytes (..))
 import Share.Web.Errors (ErrorID (..), InternalServerError (InternalServerError), ToServerError (..))
-import Servant (err500)
 import U.Codebase.Decl qualified as Decl
 import U.Codebase.Decl qualified as V2 hiding (Type)
 import U.Codebase.Decl qualified as V2Decl
@@ -270,7 +270,7 @@ expectTypeComponent componentRef = do
 
 -- | This isn't in CodebaseM so that we can run it in a normal transaction to build the Code
 -- Lookup.
-loadTermById :: QueryM m => UserId -> TermId -> m (Maybe (V2.Term Symbol, V2.Type Symbol))
+loadTermById :: (QueryM m) => UserId -> TermId -> m (Maybe (V2.Term Symbol, V2.Type Symbol))
 loadTermById codebaseUser termId = runMaybeT $ do
   (TermComponentElement trm typ) <-
     MaybeT $
@@ -288,7 +288,7 @@ loadTermById codebaseUser termId = runMaybeT $ do
       localIds = LocalIds.LocalIds {textLookup = Vector.fromList textLookup, defnLookup = Vector.fromList defnLookup}
   pure $ s2cTermWithType (localIds, trm, typ)
 
-termLocalTextReferences :: QueryM m => TermId -> m [Text]
+termLocalTextReferences :: (QueryM m) => TermId -> m [Text]
 termLocalTextReferences termId =
   queryListCol
     [sql|
@@ -299,7 +299,7 @@ termLocalTextReferences termId =
           ORDER BY local_index ASC
       |]
 
-termLocalComponentReferences :: QueryM m => TermId -> m [ComponentHash]
+termLocalComponentReferences :: (QueryM m) => TermId -> m [ComponentHash]
 termLocalComponentReferences termId =
   queryListCol
     [sql|
@@ -342,10 +342,10 @@ resolveConstructorTypeLocalIds (LocalIds.LocalIds {textLookup, defnLookup}) =
     substText i = textLookup ^?! ix (fromIntegral i)
     substHash i = unComponentHash $ (defnLookup ^?! ix (fromIntegral i))
 
-loadDeclKind :: PG.QueryM m => Reference.Id -> m (Maybe CT.ConstructorType)
+loadDeclKind :: (PG.QueryM m) => Reference.Id -> m (Maybe CT.ConstructorType)
 loadDeclKind = loadDeclKindsOf id
 
-loadDeclKindsOf :: PG.QueryM m => Traversal s t Reference.Id (Maybe CT.ConstructorType) -> s -> m t
+loadDeclKindsOf :: (PG.QueryM m) => Traversal s t Reference.Id (Maybe CT.ConstructorType) -> s -> m t
 loadDeclKindsOf trav s =
   s
     & unsafePartsOf trav %%~ \refIds -> do
@@ -517,7 +517,7 @@ constructorReferentsByPrefix prefix mayComponentIndex mayConstructorIndex = do
 --
 -- This is intentionally not in CodebaseM because this method is used to build the
 -- CodebaseEnv.
-loadCachedEvalResult :: QueryM m => UserId -> Reference.Id -> m (Maybe (V2.Term Symbol))
+loadCachedEvalResult :: (QueryM m) => UserId -> Reference.Id -> m (Maybe (V2.Term Symbol))
 loadCachedEvalResult codebaseOwnerUserId (Reference.Id hash compIndex) = runMaybeT do
   let compIndex' = pgComponentIndex compIndex
   (evalResultId :: EvalResultId, EvalResultTerm term) <-
@@ -557,12 +557,12 @@ loadCachedEvalResult codebaseOwnerUserId (Reference.Id hash compIndex) = runMayb
   pure $ resolveTermLocalIds localIds term
 
 -- | Get text ids for all provided texts, inserting any that don't already exist.
-ensureTextIds :: QueryM m => Traversable t => t Text -> m (t TextId)
+ensureTextIds :: (QueryM m) => (Traversable t) => t Text -> m (t TextId)
 ensureTextIds = ensureTextIdsOf traversed
 
 -- | Efficiently saves all Text's focused by the provided traversal into the database and
 -- replaces them with their corresponding Ids.
-ensureTextIdsOf :: QueryM m => Traversal s t Text TextId -> s -> m t
+ensureTextIdsOf :: (QueryM m) => Traversal s t Text TextId -> s -> m t
 ensureTextIdsOf trav s = do
   s
     & unsafePartsOf trav %%~ \texts -> do
@@ -589,12 +589,12 @@ ensureTextIdsOf trav s = do
         else pure results
 
 -- | Get text ids for all provided texts, inserting any that don't already exist.
-ensureBytesIds :: QueryM m => Traversable t => t BS.ByteString -> m (t BytesId)
+ensureBytesIds :: (QueryM m) => (Traversable t) => t BS.ByteString -> m (t BytesId)
 ensureBytesIds = ensureBytesIdsOf traversed
 
 -- | Efficiently saves all Text's focused by the provided traversal into the database and
 -- replaces them with their corresponding Ids.
-ensureBytesIdsOf :: QueryM m => Traversal s t BS.ByteString BytesId -> s -> m t
+ensureBytesIdsOf :: (QueryM m) => Traversal s t BS.ByteString BytesId -> s -> m t
 ensureBytesIdsOf trav s = do
   s
     & unsafePartsOf trav %%~ \bytestrings -> do
@@ -621,7 +621,7 @@ ensureBytesIdsOf trav s = do
         else pure results
 
 -- | Efficiently loads Texts for all TextIds focused by the provided traversal.
-expectTextsOf :: QueryM m => Traversal s t TextId Text -> s -> m t
+expectTextsOf :: (QueryM m) => Traversal s t TextId Text -> s -> m t
 expectTextsOf trav =
   unsafePartsOf trav %%~ \textIds -> do
     let numberedTextIds = zip [0 :: Int32 ..] textIds
@@ -649,7 +649,7 @@ localizeTerm tm = do
 
 -- | Replace all references in a term with local references.
 _localizeTermAndType ::
-  HasCallStack =>
+  (HasCallStack) =>
   V2.Term Symbol ->
   V2.Type Symbol ->
   Transaction e (PgLocalIds, TermFormat.Term, TermFormat.Type)
@@ -997,7 +997,7 @@ resolveLocalIdsOf trav s = do
         >>= HashQ.expectComponentHashesOf (traversed . LocalIds.h_)
 
 -- | Fetch term tags for all the provided Referents.
-termTagsByReferentsOf :: HasCallStack => Traversal s t Referent.Referent Tags.TermTag -> s -> Transaction e t
+termTagsByReferentsOf :: (HasCallStack) => Traversal s t Referent.Referent Tags.TermTag -> s -> Transaction e t
 termTagsByReferentsOf trav s = do
   s
     & unsafePartsOf trav %%~ \refs -> do
@@ -1080,7 +1080,7 @@ termTagsByReferentsOf trav s = do
         (refTagRow Tags.Test Decls.testResultListRef)
       ]
 
-typeTagsByReferencesOf :: HasCallStack => Traversal s t TypeReference Tags.TypeTag -> s -> Transaction e t
+typeTagsByReferencesOf :: (HasCallStack) => Traversal s t TypeReference Tags.TypeTag -> s -> Transaction e t
 typeTagsByReferencesOf trav s = do
   s
     & unsafePartsOf trav %%~ \refs -> do

src/Share/Postgres/Definitions/Types.hs

@@ -24,13 +24,13 @@ module Share.Postgres.Definitions.Types
   )
 where
 
-import Share.Postgres qualified as PG
-import Share.Postgres.Serialization qualified as S
-import Share.Prelude
 import Hasql.Decoders qualified as Decoders
 import Hasql.Decoders qualified as Hasql
 import Hasql.Encoders qualified as Encoders
 import Hasql.Interpolate (DecodeValue (..), EncodeValue (..))
+import Share.Postgres.Serialization qualified as S
+import Share.Prelude
+import Share.Utils.Postgres qualified as PG
 import U.Codebase.Decl qualified as DD
 import U.Codebase.Decl qualified as Decl
 import U.Codebase.Reference qualified as Reference

src/Share/Postgres/Orphans.hs

@@ -18,6 +18,7 @@ import Servant (err500)
 import Servant.API
 import Share.Prelude
 import Share.Utils.Logging qualified as Logging
+import Share.Utils.Postgres (RawLazyBytes (..))
 import Share.Web.Errors (ErrorID (..), ToServerError (..))
 import U.Codebase.HashTags (BranchHash (..), CausalHash (..), ComponentHash (..), PatchHash (..))
 import U.Codebase.Reference (Id' (Id), Reference' (..))
@@ -34,6 +35,7 @@ import Unison.Hash32 (Hash32)
 import Unison.Hash32 qualified as Hash32
 import Unison.Name (Name)
 import Unison.NameSegment.Internal (NameSegment (..))
+import Unison.SyncV2.Types (CBORBytes (..))
 import Unison.Syntax.Name qualified as Name
 
 -- Orphans for 'Hash'
@@ -215,6 +217,8 @@ instance Hasql.DecodeValue SqliteTermEdit.Typing where
           _ -> Nothing
       )
 
+deriving via RawLazyBytes instance Hasql.DecodeValue (CBORBytes t)
+
 instance ToServerError Hasql.SessionError where
   toServerError _ = (ErrorID "query-error", err500)
 

src/Share/Postgres/Search/DefinitionSearch/Queries.hs

@@ -36,6 +36,7 @@ import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.Server.Types (TermTag (..), TypeTag (..))
 import Unison.ShortHash (ShortHash)
+import Unison.ShortHash qualified as SH
 import Unison.Syntax.Name qualified as Name
 import Unison.Syntax.NameSegment qualified as NameSegment
 
@@ -191,11 +192,11 @@ searchTokenToText shouldAddWildcards = \case
     makeSearchToken typeMentionTypeByNameType (Text.toLower (reversedNameText name)) (Just occ)
       & addWildCard
   TypeMentionToken (Right sh) occ ->
-    makeSearchToken typeMentionTypeByHashType (into @Text @ShortHash sh) (Just occ)
+    makeSearchToken typeMentionTypeByHashType (SH.toText sh) (Just occ)
       & addWildCard
   TypeVarToken varId occ -> makeSearchToken typeVarType (varIdText varId) (Just occ)
   HashToken sh ->
-    makeSearchToken hashType (into @Text sh) Nothing
+    makeSearchToken hashType (SH.toText sh) Nothing
       & addWildCard
   TermTagToken termTag -> makeSearchToken tagType (termTagText termTag) Nothing
   TypeTagToken typTag -> makeSearchToken tagType (typeTagText typTag) Nothing