Fix up some queries

Author: ChrisPenner

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

@@ -418,7 +418,7 @@ type TextPathSegments = [Text]
 -- * main squeeze
 
 currentSchemaVersion :: SchemaVersion
-currentSchemaVersion = 22
+currentSchemaVersion = 23
 
 runCreateSql :: Transaction ()
 runCreateSql =
@@ -4039,6 +4039,7 @@ streamTempEntitiesSyncV3 rootCausalHash action = do
   Sqlite.queryStreamRow @(Hash32, BL.ByteString)
     [sql|
     SELECT entity_hash, entity_data
+      FROM syncv3_temp_entity
       WHERE root_causal = :rootCausalHash
       ORDER BY entity_depth ASC
     |]

codebase2/codebase-sqlite/sql/020-add-sync-v3-temp-tables.sql

@@ -1,7 +1,7 @@
 -- Add a new table for storing entities which are currently being synced
 
 CREATE TABLE syncv3_temp_entity (
-  root_causal INTEGER NOT NULL REFERENCES hash (id) ON DELETE CASCADE,
+  root_causal INTEGER NOT NULL,
   entity_hash TEXT NOT NULL,
   entity_kind TEXT NOT NULL,
   entity_data BLOB NOT NULL,

unison-cli/package.yaml

@@ -53,6 +53,7 @@ library:
     - megaparsec
     - memory
     - mtl
+    - network
     - network-simple
     - network-uri
     - nonempty-containers

unison-cli/src/Unison/Share/SyncV3.hs

@@ -108,7 +108,7 @@ syncFromCodeserver _shouldValidate codeserver branchRef hashJwt = do
         -- TODO: proper error handling
         Left err -> error $ show err
         Right () -> pure ()
-      Debug.debugLogM Debug.Temp "Done sync, flushing temp entities"
+      Debug.debugLogM Debug.Temp "!Done sync, flushing temp entities"
       causalId <- liftIO $ flushTemp codebase (Share.hashJWTHash hashJwt)
       pure $ Right (Sync.hash32ToCausalHash rootCausalHash, causalId)
 
@@ -129,11 +129,16 @@ doSync codebase SyncState {pendingRequestsVar, yetToRequestVar, toIngestQueue, r
   _ <- Ki.fork scope (receiverWorker onErr)
   _ <- Ki.fork scope (requesterWorker onErr)
   _ <- Ki.fork scope (ingestionWorker onErr)
+  let finished = do
+        pending <- readTVar pendingRequestsVar
+        yetToReq <- readTVar yetToRequestVar
+        guard $ Set.null pending && Set.null yetToReq
 
   Debug.debugLogM Debug.Temp "Awaiting completion"
   result <-
     atomically $
-      (Right <$> Ki.awaitAll scope)
+        (Right <$> finished)
+        <|> (Right <$> Ki.awaitAll scope)
         <|> (Left . Left <$> readTMVar errorVar)
         <|> (Left . Right <$> connectionClosed)
 
@@ -159,6 +164,7 @@ doSync codebase SyncState {pendingRequestsVar, yetToRequestVar, toIngestQueue, r
       Debug.debugLogM Debug.Temp "Requester waiting to send requests"
       atomically $ do
         requests <- readTVar yetToRequestVar
+        guard $ not (Set.null requests)
         writeTVar yetToRequestVar Set.empty
         modifyTVar' pendingRequestsVar (Set.union requests)
         send $ Msg $ ReceiverEntityRequest $ EntityRequestMsg (Set.toList requests)
@@ -211,11 +217,14 @@ flushTemp codebase rootCausalHash = do
                 Nothing -> pure ()
                 Just (hash, tempEntityBytes) ->
                   do
+                    Debug.debugLogM Debug.Temp $ "Flushing temp entity: " <> show hash
                     tempEntity <- case CBOR.deserialiseOrFailCBORBytes (CBOR.CBORBytes tempEntityBytes) of
                       -- TODO: proper error handling
                       Left err -> error $ show err
                       Right tempEntity -> pure tempEntity
+                    Debug.debugLogM Debug.Temp $ "Saving in main" <> show hash
                     void $ Q.saveTempEntityInMain v2HashHandle hash tempEntity
                     loop
         loop
+    Debug.debugLogM Debug.Temp "Flushed temp entities, getting causal hash id"
     Q.expectCausalHashIdByCausalHash (Sync.hash32ToCausalHash rootCausalHash)

unison-cli/unison-cli.cabal

@@ -248,6 +248,7 @@ library
     , megaparsec
     , memory
     , mtl
+    , network
     , network-simple
     , network-uri
     , nonempty-containers

unison-share-api/src/Unison/SyncV3/Types.hs

@@ -28,7 +28,6 @@ import Network.WebSockets (WebSocketsData)
 import Network.WebSockets qualified as WS
 import U.Codebase.Sqlite.Orphans ()
 import U.Codebase.Sqlite.TempEntity
-import Unison.Debug qualified as Debug
 import Unison.Hash32 (Hash32)
 import Unison.Prelude (tShow)
 import Unison.Server.Orphans ()
@@ -97,7 +96,6 @@ instance CBOR.Serialise FromReceiverMessageTag where
 
   decode = do
     tag <- CBOR.decode @Int
-    Debug.debugM Debug.Temp "Decoding FromReceiverMessageTag with tag" tag
     case tag of
       0 -> pure ReceiverInitStreamTag
       1 -> pure ReceiverEntityRequestTag
@@ -120,7 +118,6 @@ instance (ToJSON ah, FromJSON ah) => CBOR.Serialise (InitMsg ah) where
     CBOR.encode @BS.ByteString $ BL.toStrict $ Aeson.encode msg
 
   decode = do
-    Debug.debugLogM Debug.Temp "Decoding InitMsg from JSON via CBOR"
     bs <- CBOR.decode @BS.ByteString
     case Aeson.eitherDecode $ BL.fromStrict bs of
       Left err -> fail $ "Error decoding InitMsg from JSON: " <> err
@@ -147,7 +144,6 @@ instance (CBOR.Serialise h, ToJSON ah, FromJSON ah) => CBOR.Serialise (FromRecei
         <> CBOR.encode msg
   decode = do
     tag <- CBOR.decode @FromReceiverMessageTag
-    Debug.debugM Debug.Temp "Decoding FromReceiverMessage with tag" tag
     case tag of
       ReceiverInitStreamTag -> ReceiverInitStream <$> CBOR.decode @(InitMsg ah)
       ReceiverEntityRequestTag -> ReceiverEntityRequest <$> CBOR.decode @(EntityRequestMsg h)
@@ -367,7 +363,6 @@ instance (CBOR.Serialise a, CBOR.Serialise err) => CBOR.Serialise (MsgOrError er
 
   decode = do
     tag <- CBOR.decode @Int
-    Debug.debugM Debug.Temp "Decoding MsgOrError with tag" tag
     case tag of
       0 -> Msg <$> CBOR.decode
       1 -> Err <$> CBOR.decode