Background Task to validate all components and reject invalid components from sync

Makefile

@@ -30,7 +30,7 @@ $(target_dir):
 $(exe): $(shell find . unison -type f -name '*.hs') $(shell find . unison -type f -name '*.yaml')
 	@echo $(exe)
 	@echo $@
-	stack build $(STACK_FLAGS) share-api:share-api
+	stack build $(STACK_FLAGS)
 
 $(installed_share): $(exe) $(target_dir)
 	cp $(exe) $(installed_share)
@@ -109,3 +109,24 @@ transcripts: $(installed_share)
 		kill $$SERVER_PID 2>/dev/null || true; \
 	) 
 	@echo "Transcripts complete!";
+
+task-runner: $(installed_share)
+	@echo "Taking down any existing docker dependencies"
+	@docker compose -f docker/docker-compose.base.yml down || true
+	@trap 'docker compose -f docker/docker-compose.base.yml down' EXIT INT TERM
+	@echo "Booting up task docker dependencies..."
+	docker compose -f docker/docker-compose.base.yml up --remove-orphans --detach
+	@while  ! (  pg_isready --host localhost -U postgres -p 5432 >/dev/null 2>&1 && redis-cli -p 6379 ping  >/dev/null 2>&1 && VAULT_ADDR=http://localhost:8200 vault status >/dev/null 2>&1 )  do \
+	  sleep 1; \
+	done;
+	./transcripts/configure_transcript_database.zsh
+	@echo "Booting up share";
+	( . ./local.env ; \
+		$(exe) & \
+		SERVER_PID=$$!; \
+		trap "kill $$SERVER_PID 2>/dev/null || true" EXIT INT TERM; \
+		echo "Running task"; \
+		stack exec share-task-runner; \
+		kill $$SERVER_PID 2>/dev/null || true; \
+	) 
+	@echo "Task complete!";

docker/share-task-runner-entrypoint.sh

@@ -2,12 +2,6 @@
 
 set -ex
 
-echo SHARE_REDIS: "$SHARE_REDIS"
-
-if [ -n "$NOMAD_PORT_enlil_http" ]; then
-    export SHARE_SERVER_PORT="$NOMAD_PORT_enlil_http"
-fi
-
 export SHARE_IP=0.0.0.0
 
 exec 2>&1

share-api/src/Share/Web/UCM/Sync/Impl.hs

@@ -52,6 +52,7 @@ import Share.Web.Errors
 import Share.Web.UCM.Sync.HashJWT qualified as HashJWT
 import Share.Web.UCM.Sync.Types (EntityBunch (..), RepoInfoKind (..), entityKind)
 import U.Codebase.Causal qualified as Causal
+import U.Codebase.Sqlite.HashHandle qualified as HH
 import U.Codebase.Sqlite.Orphans ()
 import Unison.Codebase.Path qualified as Path
 import Unison.Hash32 (Hash32)
@@ -259,7 +260,11 @@ insertEntitiesToCodebase codebase entities = do
     mayErrs <- PG.transactionUnsafeIO $ batchValidateEntities maxParallelismPerUploadRequest isComponentHashMismatchAllowedIO isCausalHashMismatchAllowedIO unsavedEntities
     case mayErrs of
       Nothing -> pure ()
-      Just (err :| _errs) -> throwError err
+      Just (err :| _errs) ->
+        case err of
+          Right e -> throwError e
+          Left (HH.IncompleteElementOrderingError (ComponentHash hash)) ->
+            throwError $ Sync.InvalidByteEncoding (Hash32.fromHash hash) Sync.TermComponentType "Incomplete element ordering in term components"
     SyncQ.saveTempEntities codebase unsavedEntities
     let hashesNowInTemp = Set.fromList (fst <$> Foldable.toList unsavedEntities) <> (Set.fromList . Foldable.toList $ hashesAlreadyInTemp)
     pure hashesNowInTemp
@@ -393,7 +398,7 @@ batchValidateEntities ::
   (ComponentHash -> ComponentHash -> IO Bool) ->
   (CausalHash -> CausalHash -> IO Bool) ->
   f (Hash32, Sync.Entity Text Hash32 Hash32) ->
-  IO (Maybe (NonEmpty (Sync.EntityValidationError)))
+  IO (Maybe (NonEmpty (Either HH.HashingFailure Sync.EntityValidationError)))
 batchValidateEntities maxParallelism checkIfComponentHashMismatchIsAllowed checkIfCausalHashMismatchIsAllowed entities = do
   errs <- UnliftIO.pooledForConcurrentlyN maxParallelism entities \(hash, entity) ->
     validateEntity checkIfComponentHashMismatchIsAllowed checkIfCausalHashMismatchIsAllowed hash entity
@@ -405,16 +410,16 @@ validateEntity ::
   (CausalHash -> CausalHash -> m Bool) ->
   Hash32 ->
   Share.Entity Text Hash32 Hash32 ->
-  m (Maybe Sync.EntityValidationError)
+  m (Maybe (Either HH.HashingFailure Sync.EntityValidationError))
 validateEntity checkIfComponentHashMismatchIsAllowed checkIfCausalHashMismatchIsAllowed hash entity = do
   case (Sync.validateEntity hash entity) of
-    Just err@(Sync.EntityHashMismatch Sync.TermComponentType (Sync.HashMismatchForEntity {supplied = expectedHash, computed = actualHash})) ->
+    Just (Right (err@(Sync.EntityHashMismatch Sync.TermComponentType (Sync.HashMismatchForEntity {supplied = expectedHash, computed = actualHash})))) ->
       checkIfComponentHashMismatchIsAllowed (ComponentHash . Hash32.toHash $ expectedHash) (ComponentHash . Hash32.toHash $ actualHash) >>= \case
-        False -> pure (Just err)
+        False -> pure (Just $ Right err)
         True -> pure Nothing
-    Just err@(Sync.EntityHashMismatch Sync.CausalType (Sync.HashMismatchForEntity {supplied = expectedHash, computed = actualHash})) ->
+    Just (Right (err@(Sync.EntityHashMismatch Sync.CausalType (Sync.HashMismatchForEntity {supplied = expectedHash, computed = actualHash})))) ->
       checkIfCausalHashMismatchIsAllowed (CausalHash . Hash32.toHash $ expectedHash) (CausalHash . Hash32.toHash $ actualHash) >>= \case
-        False -> pure (Just err)
+        False -> pure (Just $ Right err)
         True -> pure Nothing
     Just err ->
       -- This shouldn't happen unless the ucm client is buggy or malicious

share-task-runner/src/Share/Tasks/AmbiguousComponentCheck.hs

@@ -8,6 +8,7 @@ import Share.Postgres.Cursors qualified as PG
 import Share.Prelude
 import Share.Utils.Logging (Loggable (..))
 import Share.Utils.Logging qualified as Logging
+import U.Codebase.Sqlite.HashHandle qualified as HH
 import U.Codebase.Sqlite.TempEntity
 import Unison.Hash32
 import Unison.Sync.EntityValidation qualified as EV
@@ -17,7 +18,7 @@ import Unison.Util.Servant.CBOR qualified as CBOR
 
 data AmbiguousComponentCheckError
   = TaskAmbiguousComponentCheckError Hash32
-  | TaskEntityValidationError Hash32 Sync.EntityValidationError
+  | TaskEntityValidationError Hash32 (Either HH.HashingFailure Sync.EntityValidationError)
   | TaskEntityDecodingError Hash32 CBOR.DeserialiseFailure
   deriving (Show, Eq)
 
@@ -51,12 +52,15 @@ run = withWorkerName "ambiguous-component-task" do
       PG.newRowCursor @(CBORBytes TempEntity, Hash32)
         "component_cursor"
         [PG.sql|
-      (SELECT DISTINCT ON (t.component_hash_id) bytes.bytes, ch.base32
-        FROM terms t
-          JOIN serialized_components sc ON t.component_hash_id = sc.component_hash_id
-          JOIN bytes ON sc.bytes_id = bytes.id
-          JOIN component_hashes ch ON t.component_hash_id = ch.id
-      )
+        WITH component_hash_ids(component_hash_id) AS (
+          SELECT DISTINCT component_hash_id
+          FROM terms t
+            WHERE t.component_index = 1
+        ) SELECT DISTINCT ON (bytes.id) bytes.bytes, ch.base32
+            FROM component_hash_ids chi
+              JOIN serialized_components sc ON chi.component_hash_id = sc.component_hash_id
+              JOIN bytes ON sc.bytes_id = bytes.id
+              JOIN component_hashes ch ON chi.component_hash_id = ch.id
       |]
     PG.foldBatched cursor 100 \rows -> do
       rows