Test no org emails on staging

Author: ChrisPenner

sql/2025-02-20_authz.sql

@@ -213,7 +213,6 @@ CREATE TRIGGER users_create_subject
 
 CREATE TABLE orgs (
   id UUID DEFAULT uuid_generate_v4() PRIMARY KEY,
-  -- There's no subject_id on the org, since the org is a user, and the user has a subject_id.
   user_id UUID UNIQUE NOT NULL REFERENCES users (id) ON DELETE CASCADE,
   -- Subject representing the org itself.
   -- Note that orgs also have a subject on their associated user, but since you can't log in as a subject that

sql/2025-04-30-contribution-diff-queue.sql

@@ -0,0 +1,13 @@
+-- Drop and re-create the contribution_diff_queue table without a primary key constraint on contribution_id.
+-- This allows us to insert redundant rows while a diff is being computed, rather than blocking due to row lock.
+
+DROP TABLE contribution_diff_queue;
+
+CREATE TABLE contribution_diff_queue (
+  contribution_id UUID REFERENCES contributions(id) ON DELETE CASCADE,
+  created_at TIMESTAMPTZ NOT NULL DEFAULT NOW()
+);
+
+-- Delete all previously-computed namespace diffs, because the diff payload is different now (we explicitly store
+-- errors).
+TRUNCATE namespace_diffs;

sql/2025-05-01_org-updates.sql

@@ -0,0 +1,27 @@
+ALTER TABLE users
+  -- Add is_org column
+  ADD COLUMN is_org boolean NOT NULL DEFAULT false,
+  -- Add check that primary_email is not null unless is_org is true
+  ADD CONSTRAINT primary_email_not_null_unless_org CHECK (
+    is_org OR primary_email IS NOT NULL
+  ),
+  -- Make primary_email nullable
+  ALTER COLUMN primary_email DROP NOT NULL;
+
+-- Update the is_org column for existing users
+WITH org_users(user_id) AS (
+  SELECT DISTINCT o.user_id
+  FROM orgs o
+) UPDATE users
+  SET is_org = true
+  WHERE id IN (SELECT ou.user_id FROM org_users ou);
+
+-- Add a 'creator_user_id' to orgs just to track where they came from.
+-- This is distinct from the owners in the auth roles.
+ALTER TABLE orgs
+  ADD COLUMN creator_user_id uuid NULL REFERENCES users (id) ON DELETE SET NULL
+;
+
+ALTER TABLE orgs
+  ADD COLUMN is_commercial boolean NOT NULL DEFAULT false
+;

src/Share/Backend.hs

@@ -231,7 +231,7 @@ displayType = \case
     pure (UserObject decl)
 
 evalDocRef ::
-  Codebase.CodebaseRuntime ->
+  Codebase.CodebaseRuntime IO ->
   V2.TermReference ->
   Codebase.CodebaseM e (Doc.EvaluatedDoc Symbol)
 evalDocRef (CodebaseRuntime {codeLookup, cachedEvalResult, unisonRuntime}) termRef = do
@@ -245,6 +245,7 @@ evalDocRef (CodebaseRuntime {codeLookup, cachedEvalResult, unisonRuntime}) termR
 
     typeOf :: Referent.Referent -> Codebase.CodebaseM e (Maybe (V1.Type Symbol ()))
     typeOf termRef = fmap void <$> Codebase.loadTypeOfReferent (Cv.referent1to2 termRef)
+
     eval :: V1.Term Symbol a -> Codebase.CodebaseM e (Maybe (V1.Term Symbol ()))
     eval (Term.amap (const mempty) -> tm) = do
       -- We use an empty ppe for evalutation, it's only used for adding additional context to errors.

src/Share/BackgroundJobs/Diffs/ContributionDiffs.hs

@@ -7,13 +7,13 @@ import Share.BackgroundJobs.Diffs.Queries qualified as DQ
 import Share.BackgroundJobs.Errors (reportError)
 import Share.BackgroundJobs.Monad (Background, withTag)
 import Share.BackgroundJobs.Workers (newWorker)
-import Share.Branch (Branch (..))
+import Share.Branch (branchCausals_)
 import Share.Codebase qualified as Codebase
 import Share.Contribution (Contribution (..))
+import Share.Env qualified as Env
 import Share.IDs
 import Share.IDs qualified as IDs
 import Share.Metrics qualified as Metrics
-import Share.NamespaceDiffs (NamespaceDiffError (MissingEntityError))
 import Share.Postgres qualified as PG
 import Share.Postgres.Contributions.Queries qualified as ContributionsQ
 import Share.Postgres.Notifications qualified as Notif
@@ -23,52 +23,81 @@ import Share.Utils.Logging qualified as Logging
 import Share.Web.Authorization qualified as AuthZ
 import Share.Web.Errors (EntityMissing (..), ErrorID (..))
 import Share.Web.Share.Diffs.Impl qualified as Diffs
+import System.Clock qualified as Clock
 
--- | Check every 10 minutes if we haven't heard on the notifications channel.
+-- | Check every 30 seconds if we haven't heard on the notifications channel.
 -- Just in case we missed a notification.
 maxPollingIntervalSeconds :: Int
-maxPollingIntervalSeconds = 10 * 60
+maxPollingIntervalSeconds = 30
 
 worker :: Ki.Scope -> Background ()
 worker scope = do
   authZReceipt <- AuthZ.backgroundJobAuthZ
+  badUnliftCodebaseRuntime <- Codebase.badAskUnliftCodebaseRuntime
+  unisonRuntime <- asks Env.sandboxedRuntime
+  let makeRuntime :: Codebase.CodebaseEnv -> IO (Codebase.CodebaseRuntime IO)
+      makeRuntime codebase = do
+        runtime <- Codebase.codebaseRuntime' unisonRuntime codebase
+        pure (badUnliftCodebaseRuntime runtime)
   newWorker scope "diffs:contributions" $ forever do
     Notif.waitOnChannel Notif.ContributionDiffChannel (maxPollingIntervalSeconds * 1000000)
-    processDiffs authZReceipt >>= \case
-      Left (contributionId, e) ->
-        withTag "contribution-id" (IDs.toText contributionId) $ do
-          reportError e
-      Right _ -> pure ()
+    processDiffs authZReceipt makeRuntime
 
-processDiffs :: AuthZ.AuthZReceipt -> Background (Either (ContributionId, NamespaceDiffError) ())
-processDiffs authZReceipt = Metrics.recordContributionDiffDuration . runExceptT $ do
-  mayContributionId <- PG.runTransaction DQ.claimContributionToDiff
-  for_ mayContributionId (diffContribution authZReceipt)
-  case mayContributionId of
-    Just contributionId -> do
-      Logging.textLog ("Recomputed contribution diff: " <> tShow contributionId)
-        & Logging.withTag ("contribution-id", tShow contributionId)
-        & Logging.withSeverity Logging.Info
-        & Logging.logMsg
-      -- Keep processing releases until we run out of them.
-      either throwError pure =<< lift (processDiffs authZReceipt)
-    Nothing -> pure ()
+-- Process diffs until we run out of them. We claim a diff in a transaction, commit it, then proceed to compute the
+-- diff. There's therefore a chance we claim a diff and fail to compute it (due to e.g. server restart). The current
+-- solution to these "at most once" semantics is to simply re-enqueue a diff job if necessary; e.g. in the view diff
+-- endpoint handler.
+processDiffs :: AuthZ.AuthZReceipt -> (Codebase.CodebaseEnv -> IO (Codebase.CodebaseRuntime IO)) -> Background ()
+processDiffs authZReceipt makeRuntime = do
+  let loop :: Background ()
+      loop = do
+        result <-
+          PG.runTransactionMode PG.RepeatableRead PG.ReadWrite do
+            DQ.claimContributionToDiff >>= \case
+              Nothing -> pure Nothing
+              Just contributionId -> do
+                startTime <- PG.transactionUnsafeIO (Clock.getTime Clock.Monotonic)
+                result <- PG.catchTransaction (maybeComputeAndStoreCausalDiff authZReceipt makeRuntime contributionId)
+                pure (Just (contributionId, startTime, result))
+        whenJust result \(contributionId, startTime, result) -> do
+          withTag "contribution-id" (IDs.toText contributionId) do
+            case result of
+              Left err -> reportError err
+              Right didWork -> do
+                when didWork do
+                  liftIO (Metrics.recordContributionDiffDuration startTime)
+                  Logging.textLog "Computed contribution diff"
+                    & Logging.withSeverity Logging.Info
+                    & Logging.logMsg
+          loop
+  loop
 
-diffContribution :: AuthZ.AuthZReceipt -> ContributionId -> ExceptT (ContributionId, NamespaceDiffError) Background ()
-diffContribution authZReceipt contributionId = withExceptT (contributionId,) . mapExceptT (withTag "contribution-id" (IDs.toText contributionId)) $ do
-  ( bestCommonAncestorCausalId,
-    project,
-    newBranch@Branch {causal = newBranchCausalId},
-    oldBranch@Branch {causal = oldBranchCausalId}
-    ) <- ExceptT $ PG.tryRunTransaction $ do
-    Contribution {bestCommonAncestorCausalId, sourceBranchId = newBranchId, targetBranchId = oldBranchId, projectId} <- ContributionsQ.contributionById contributionId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "contribution:missing") "Contribution not found")
-    project <- Q.projectById projectId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "project:missing") "Project not found")
-    newBranch <- Q.branchById newBranchId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "branch:missing") "Source branch not found")
-    oldBranch <- Q.branchById oldBranchId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "branch:missing") "Target branch not found")
-    pure (bestCommonAncestorCausalId, project, newBranch, oldBranch)
+-- Check whether a causal diff has already been computed, and if it hasn't, compute and store it. Otherwise, do nothing.
+-- Returns whether or not we did any work.
+maybeComputeAndStoreCausalDiff ::
+  AuthZ.AuthZReceipt ->
+  (Codebase.CodebaseEnv -> IO (Codebase.CodebaseRuntime IO)) ->
+  ContributionId ->
+  PG.Transaction EntityMissing Bool
+maybeComputeAndStoreCausalDiff authZReceipt makeRuntime contributionId = do
+  Contribution {bestCommonAncestorCausalId, sourceBranchId = newBranchId, targetBranchId = oldBranchId, projectId} <-
+    ContributionsQ.contributionById contributionId `whenNothingM` throwError (EntityMissing (ErrorID "contribution:missing") "Contribution not found")
+  project <- Q.projectById projectId `whenNothingM` throwError (EntityMissing (ErrorID "project:missing") "Project not found")
+  newBranch <- Q.branchById newBranchId `whenNothingM` throwError (EntityMissing (ErrorID "branch:missing") "Source branch not found")
+  oldBranch <- Q.branchById oldBranchId `whenNothingM` throwError (EntityMissing (ErrorID "branch:missing") "Target branch not found")
   let oldCodebase = Codebase.codebaseForProjectBranch authZReceipt project oldBranch
   let newCodebase = Codebase.codebaseForProjectBranch authZReceipt project newBranch
-  -- This method saves the diff so it'll be there when we need it, so we don't need to do anything with it.
-  _ <-
-    Diffs.diffCausals authZReceipt (oldCodebase, oldBranchCausalId) (newCodebase, newBranchCausalId) bestCommonAncestorCausalId
-  pure ()
+  let oldCausal = oldBranch ^. branchCausals_
+  let newCausal = newBranch ^. branchCausals_
+  ContributionsQ.existsPrecomputedNamespaceDiff (oldCodebase, oldCausal) (newCodebase, newCausal) >>= \case
+    True -> pure False
+    False -> do
+      oldRuntime <- PG.transactionUnsafeIO (makeRuntime oldCodebase)
+      newRuntime <- PG.transactionUnsafeIO (makeRuntime newCodebase)
+      _ <-
+        Diffs.computeAndStoreCausalDiff
+          authZReceipt
+          (oldCodebase, oldRuntime, oldCausal)
+          (newCodebase, newRuntime, newCausal)
+          bestCommonAncestorCausalId
+      pure True

src/Share/BackgroundJobs/Diffs/Queries.hs

@@ -1,25 +1,33 @@
 module Share.BackgroundJobs.Diffs.Queries
-  ( submitContributionsToBeDiffed,
+  ( submitContributionToBeDiffed,
+    submitContributionsToBeDiffed,
     claimContributionToDiff,
   )
 where
 
-import Data.Foldable (toList)
-import Data.Set (Set)
 import Share.IDs
 import Share.Postgres
 import Share.Postgres.Notifications qualified as Notif
+import Unison.Prelude
+
+submitContributionToBeDiffed :: (QueryM m) => ContributionId -> m ()
+submitContributionToBeDiffed contributionId = do
+  execute_
+    [sql|
+      INSERT INTO contribution_diff_queue (contribution_id)
+      VALUES (#{contributionId})
+    |]
+  Notif.notifyChannel Notif.ContributionDiffChannel
 
 submitContributionsToBeDiffed :: (QueryM m) => Set ContributionId -> m ()
 submitContributionsToBeDiffed contributions = do
   execute_
     [sql|
-    WITH new_contributions(contribution_id) AS (
-      SELECT * FROM ^{singleColumnTable (toList contributions)}
-    )
-    INSERT INTO contribution_diff_queue (contribution_id)
-      SELECT nc.contribution_id FROM new_contributions nc
-      ON CONFLICT DO NOTHING
+      WITH new_contributions(contribution_id) AS (
+        SELECT * FROM ^{singleColumnTable (toList contributions)}
+      )
+      INSERT INTO contribution_diff_queue (contribution_id)
+        SELECT nc.contribution_id FROM new_contributions nc
     |]
   Notif.notifyChannel Notif.ContributionDiffChannel
 
@@ -28,16 +36,16 @@ claimContributionToDiff :: Transaction e (Maybe ContributionId)
 claimContributionToDiff = do
   query1Col
     [sql|
-    WITH chosen_contribution(contribution_id) AS (
-      SELECT q.contribution_id
-      FROM contribution_diff_queue q
-      ORDER BY q.created_at ASC
-      LIMIT 1
-      -- Skip any that are being synced by other workers.
-      FOR UPDATE SKIP LOCKED
-    )
-    DELETE FROM contribution_diff_queue
-      USING chosen_contribution
-      WHERE contribution_diff_queue.contribution_id = chosen_contribution.contribution_id
-    RETURNING chosen_contribution.contribution_id
+      WITH chosen_contribution(contribution_id) AS (
+        SELECT q.contribution_id
+        FROM contribution_diff_queue q
+        ORDER BY q.created_at ASC
+        LIMIT 1
+        -- Skip any that are being synced by other workers.
+        FOR UPDATE SKIP LOCKED
+      )
+      DELETE FROM contribution_diff_queue
+        USING chosen_contribution
+        WHERE contribution_diff_queue.contribution_id = chosen_contribution.contribution_id
+      RETURNING chosen_contribution.contribution_id
     |]

src/Share/Branch.hs

@@ -55,7 +55,7 @@ instance (Hasql.DecodeValue causal) => Hasql.DecodeRow (Branch causal) where
     creatorId <- PG.decodeField
     pure $ Branch {..}
 
-branchCausals_ :: Traversal (Branch causal) (Branch causal') causal causal'
+branchCausals_ :: Lens (Branch causal) (Branch causal') causal causal'
 branchCausals_ f Branch {..} = (\causal -> Branch {causal, ..}) <$> f causal
 
 branchCodebaseUser :: Branch causal -> UserId