SyncV2 WIP

Author: ChrisPenner

share-api.cabal

@@ -154,6 +154,7 @@ library
       Share.Web.UCM.Sync.Impl
       Share.Web.UCM.Sync.Types
       Share.Web.UCM.SyncStream.API
+      Share.Web.UCM.SyncStream.Impl
       Share.Web.UCM.SyncStream.Queries
       Unison.PrettyPrintEnvDecl.Postgres
       Unison.Server.NameSearch.Postgres

src/Share/Postgres.hs

@@ -19,7 +19,6 @@ module Share.Postgres
     Interp.DecodeValue (..),
     Interp.DecodeRow (..),
     Interp.DecodeField,
-    RawBytes (..),
     Only (..),
     QueryA (..),
     QueryM (..),
@@ -469,17 +468,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/Sync/Queries.hs

@@ -15,9 +15,7 @@ module Share.Postgres.Sync.Queries
   )
 where
 
-import Codec.CBOR.Encoding qualified as CBOR
 import Codec.CBOR.Write qualified as CBOR
-import Codec.Serialise (Serialise (..))
 import Codec.Serialise.Class qualified as CBOR
 import Control.Lens hiding (from)
 import Data.ByteString.Lazy.Char8 qualified as BL
@@ -64,11 +62,11 @@ import U.Codebase.Sqlite.Queries qualified as Share
 import U.Codebase.Sqlite.TempEntity (TempEntity)
 import U.Codebase.Sqlite.TempEntityType (TempEntityType)
 import U.Codebase.Sqlite.Term.Format qualified as TermFormat
-import U.Util.Base32Hex (Base32Hex (..))
 import Unison.Hash32
 import Unison.Hash32 qualified as Hash32
 import Unison.Sync.Common qualified as Share
 import Unison.Sync.Types qualified as Share
+import Unison.SyncV2.Types (EntityKind (..))
 
 data SyncQError
   = InvalidNamespaceBytes
@@ -635,4 +633,3 @@ saveSerializedNamespace hash serialised = do
         VALUES ((SELECT bh.id FROM branch_hashes bh where bh.base32 = #{hash}), #{bytesId})
       ON CONFLICT DO NOTHING
     |]
-

src/Share/Postgres/Sync/Types.hs

@@ -1,9 +1,9 @@
 module Share.Postgres.Sync.Types (TypedTempEntity (..)) where
 
+import Hasql.Interpolate qualified as Hasql
 import Share.Postgres (decodeField)
-import Share.Postgres qualified as PG
 import Share.Postgres.Serialization qualified as S
-import Hasql.Interpolate qualified as Hasql
+import Share.Utils.Postgres (RawBytes (..))
 import U.Codebase.Sqlite.TempEntity (TempEntity)
 
 -- | Helper for deserializing typed temp entities.
@@ -14,7 +14,7 @@ newtype TypedTempEntity = TypedTempEntity {unTypedTempEntity :: TempEntity}
 instance Hasql.DecodeRow TypedTempEntity where
   decodeRow = do
     entityType <- decodeField
-    PG.RawBytes entityBytes <- decodeField
+    RawBytes entityBytes <- decodeField
     case S.decodeTypedTempEntity entityType entityBytes of
       Left err -> fail (show err)
       Right tempEntity -> pure (TypedTempEntity tempEntity)

src/Share/Utils/Postgres.hs

@@ -1,17 +1,22 @@
 module Share.Utils.Postgres
   ( OrdBy (..),
     ordered,
+    RawBytes (..),
+    RawLazyBytes (..),
   )
 where
 
-import Share.Postgres qualified as PG
+import Data.ByteString.Lazy qualified as BL
+import Hasql.Decoders qualified as Decoders
+import Hasql.Encoders qualified as Encoders
+import Hasql.Interpolate qualified as Hasql
 import Share.Prelude
 
 -- | A type for propagating an application-code ordering through a database query.
 -- We can't trust the order returned by PG, so we make sure to order things explicitly.
 newtype OrdBy = OrdBy {unOrdBy :: Int32}
   deriving stock (Eq, Ord, Show)
-  deriving (PG.DecodeValue, PG.EncodeValue) via Int32
+  deriving (Hasql.DecodeValue, Hasql.EncodeValue) via Int32
 
 instance From Int OrdBy where
   from = OrdBy . fromIntegral
@@ -21,3 +26,25 @@ instance From Int32 OrdBy where
 
 ordered :: [a] -> [(OrdBy, a)]
 ordered = zip (OrdBy <$> [0 ..])
+
+-- | 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 Hasql.EncodeValue RawBytes where
+  encodeValue = contramap unRawBytes Encoders.bytea
+
+instance Hasql.DecodeValue RawBytes where
+  decodeValue = RawBytes <$> Decoders.bytea
+
+-- | Preferably you should use custom newtypes for your bytes, but you can use this with
+-- deriving via to get the encoding/decoding instances.
+newtype RawLazyBytes = RawLazyBytes {unLazyRawBytes :: BL.ByteString}
+  deriving stock (Show, Eq, Ord)
+
+instance Hasql.EncodeValue RawLazyBytes where
+  encodeValue = contramap (BL.toStrict . unLazyRawBytes) Encoders.bytea
+
+instance Hasql.DecodeValue RawLazyBytes where
+  decodeValue = RawLazyBytes . BL.fromStrict <$> Decoders.bytea

src/Share/Web/Impl.hs

@@ -24,7 +24,7 @@ import Share.Web.Support.Impl qualified as Support
 import Share.Web.Types
 import Share.Web.UCM.Projects.Impl qualified as UCMProjects
 import Share.Web.UCM.Sync.Impl qualified as Sync
-import Share.Web.UCM.SyncStream.API qualified as SyncStream
+import Share.Web.UCM.SyncStream.Impl qualified as SyncStream
 
 discoveryEndpoint :: WebApp DiscoveryDocument
 discoveryEndpoint = do

src/Share/Web/UCM/Sync/Impl.hs

@@ -9,6 +9,7 @@ module Share.Web.UCM.Sync.Impl
     -- This export can be removed once we've migrated away from sqlite.
     insertEntitiesToCodebase,
     ensureCausalIsFlushed,
+    repoInfoKind,
   )
 where
 
@@ -48,7 +49,7 @@ import Share.Web.Authentication qualified as AuthN
 import Share.Web.Authorization qualified as AuthZ
 import Share.Web.Errors
 import Share.Web.UCM.Sync.HashJWT qualified as HashJWT
-import Share.Web.UCM.Sync.Types (EntityBunch (..), EntityKind (..), entityKind)
+import Share.Web.UCM.Sync.Types (EntityBunch (..), RepoInfoKind (..), entityKind)
 import U.Codebase.Causal qualified as Causal
 import U.Codebase.Sqlite.Orphans ()
 import Unison.Codebase.Path qualified as Path
@@ -63,14 +64,9 @@ import Unison.Sync.EntityValidation qualified as Sync
 import Unison.Sync.Types (DownloadEntitiesError (..), DownloadEntitiesRequest (..), DownloadEntitiesResponse (..), GetCausalHashByPathRequest (..), GetCausalHashByPathResponse (..), NeedDependencies (..), RepoInfo (..), UploadEntitiesError (..), UploadEntitiesRequest (..), UploadEntitiesResponse (..))
 import Unison.Sync.Types qualified as Share
 import Unison.Sync.Types qualified as Sync
+import Unison.SyncV2.Types (EntityKind (..))
 import UnliftIO qualified
 
-data RepoInfoKind
-  = RepoInfoUser UserHandle
-  | RepoInfoProjectBranch ProjectBranchShortHand
-  | RepoInfoProjectRelease ProjectReleaseShortHand
-  deriving stock (Show)
-
 -- | Parse a `RepoInfo` into the correct codebase view, e.g.
 --
 -- >>> repoInfoKind (RepoInfo "@unison")