Implement new contribution term & type diff endpoints

src/Share/Postgres/Causal/Queries.hs

@@ -14,8 +14,6 @@ module Share.Postgres.Causal.Queries
     expectPgNamespace,
     savePgNamespace,
     saveCausal,
-    loadNamespaceIdForCausal,
-    expectNamespaceIdForCausal,
     tryGetCachedSquashResult,
     saveSquashResult,
     saveV2BranchShallow,
@@ -385,20 +383,6 @@ expectPgNamespace branchHashId = do
             (nameSegmentId, (branchHashId, causalId))
       pure $ Map.fromList childList
 
-loadNamespaceIdForCausal :: (QueryM m) => CausalId -> m (Maybe BranchHashId)
-loadNamespaceIdForCausal causalId = runMaybeT do
-  MaybeT $
-    query1Col
-      [sql| SELECT namespace_hash_id
-            FROM causals
-              WHERE causals.id = #{causalId}
-    |]
-
-expectNamespaceIdForCausal :: (HasCallStack, QueryM m) => CausalId -> m BranchHashId
-expectNamespaceIdForCausal c = do
-  loadNamespaceIdForCausal c
-    `whenNothingM` unrecoverableError (MissingExpectedEntity $ "Expected namespace id for causal: " <> tShow c)
-
 -- | Crawls the namespace tree to find the causal id mounted at a given path from the provided
 -- root causal.
 -- Returns Nothing if there's no causal at the provided path (or if the root causal doesn't exist)

src/Share/Web/Share/Contributions/API.hs

@@ -46,12 +46,12 @@ type ContributionDiffEndpoint =
 type ContributionDiffTermsEndpoint =
   RequiredQueryParam "oldTerm" Name
     :> RequiredQueryParam "newTerm" Name
-    :> Get '[JSON] ShareTermDiffResponse
+    :> Get '[JSON] (Cached JSON ShareTermDiffResponse)
 
 type ContributionDiffTypesEndpoint =
   RequiredQueryParam "oldType" Name
     :> RequiredQueryParam "newType" Name
-    :> Get '[JSON] ShareTypeDiffResponse
+    :> Get '[JSON] (Cached JSON ShareTypeDiffResponse)
 
 type ListContributionsCursor = (UTCTime, ContributionId)
 

src/Share/Web/Share/Contributions/Impl.hs

@@ -42,8 +42,10 @@ import Share.Web.Share.Contributions.API
 import Share.Web.Share.Contributions.API qualified as API
 import Share.Web.Share.Contributions.Types
 import Share.Web.Share.Diffs.Impl qualified as Diffs
-import Share.Web.Share.Diffs.Types (ShareNamespaceDiffResponse (..))
+import Share.Web.Share.Diffs.Types (ShareNamespaceDiffResponse (..), ShareTermDiffResponse (..), ShareTypeDiffResponse (..))
 import Share.Web.Share.Types (UserDisplayInfo)
+import Unison.Name (Name)
+import Unison.Syntax.Name qualified as Name
 
 contributionsByProjectServer :: Maybe Session -> UserHandle -> ProjectSlug -> ServerT API.ContributionsByProjectAPI WebApp
 contributionsByProjectServer session handle projectSlug =
@@ -62,8 +64,8 @@ contributionsByProjectServer session handle projectSlug =
         addServerTag (Proxy @API.ContributionResourceServer) "contribution-number" (IDs.toText contributionNumber) $
           getContributionByNumberEndpoint session handle projectSlug contributionNumber
             :<|> updateContributionByNumberEndpoint session handle projectSlug contributionNumber
-            :<|> ( contributionDiffTermsEndpoint
-                     :<|> contributionDiffTypesEndpoint
+            :<|> ( contributionDiffTermsEndpoint session handle projectSlug contributionNumber
+                     :<|> contributionDiffTypesEndpoint session handle projectSlug contributionNumber
                      :<|> contributionDiffEndpoint session handle projectSlug contributionNumber
                  )
             :<|> mergeContributionEndpoint session handle projectSlug contributionNumber
@@ -238,9 +240,9 @@ contributionDiffEndpoint (AuthN.MaybeAuthedUserID mayCallerUserId) userHandle pr
   newPBSH <- Codebase.runCodebaseTransactionOrRespondError newCodebase $ do
     lift $ Q.projectBranchShortHandByBranchId newBranchId `whenNothingM` throwError (EntityMissing (ErrorID "branch:missing") "Source branch not found")
 
-  let cacheKeys = [IDs.toText contributionId, IDs.toText newPBSH, IDs.toText oldPBSH, Caching.causalIdCacheKey newBranchCausalId, Caching.causalIdCacheKey oldBranchCausalId]
+  let oldCausalId = fromMaybe oldBranchCausalId bestCommonAncestorCausalId
+  let cacheKeys = [IDs.toText contributionId, IDs.toText newPBSH, IDs.toText oldPBSH, Caching.causalIdCacheKey newBranchCausalId, Caching.causalIdCacheKey oldCausalId]
   Caching.cachedResponse authZReceipt "contribution-diff" cacheKeys do
-    let oldCausalId = fromMaybe oldBranchCausalId bestCommonAncestorCausalId
     namespaceDiff <- Diffs.diffCausals authZReceipt oldCausalId newBranchCausalId
     (newBranchCausalHash, oldCausalHash) <- PG.runTransaction $ do
       newBranchCausalHash <- CausalQ.expectCausalHashesByIdsOf id newBranchCausalId
@@ -258,6 +260,96 @@ contributionDiffEndpoint (AuthN.MaybeAuthedUserID mayCallerUserId) userHandle pr
   where
     projectShorthand = IDs.ProjectShortHand {userHandle, projectSlug}
 
+contributionDiffTermsEndpoint ::
+  Maybe Session ->
+  UserHandle ->
+  ProjectSlug ->
+  IDs.ContributionNumber ->
+  Name ->
+  Name ->
+  WebApp (Cached JSON ShareTermDiffResponse)
+contributionDiffTermsEndpoint (AuthN.MaybeAuthedUserID mayCallerUserId) userHandle projectSlug contributionNumber oldTermName newTermName =
+  do
+    ( project,
+      Contribution {contributionId, bestCommonAncestorCausalId},
+      oldBranch@Branch {causal = oldBranchCausalId, branchId = oldBranchId},
+      newBranch@Branch {causal = newBranchCausalId, branchId = newBranchId}
+      ) <- PG.runTransactionOrRespondError $ do
+      project@Project {projectId} <- Q.projectByShortHand projectShorthand `whenNothingM` throwError (EntityMissing (ErrorID "project:missing") "Project not found")
+      contribution@Contribution {sourceBranchId = newBranchId, targetBranchId = oldBranchId} <- ContributionsQ.contributionByProjectIdAndNumber projectId contributionNumber `whenNothingM` throwError (EntityMissing (ErrorID "contribution:missing") "Contribution 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")
+      pure (project, contribution, oldBranch, newBranch)
+    authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkContributionRead mayCallerUserId project
+    let oldCodebase = Codebase.codebaseForProjectBranch authZReceipt project oldBranch
+    let newCodebase = Codebase.codebaseForProjectBranch authZReceipt project newBranch
+    oldPBSH <- Codebase.runCodebaseTransactionOrRespondError oldCodebase $ do
+      lift $ Q.projectBranchShortHandByBranchId oldBranchId `whenNothingM` throwError (EntityMissing (ErrorID "branch:missing") "Target branch not found")
+    newPBSH <- Codebase.runCodebaseTransactionOrRespondError newCodebase $ do
+      lift $ Q.projectBranchShortHandByBranchId newBranchId `whenNothingM` throwError (EntityMissing (ErrorID "branch:missing") "Source branch not found")
+    let oldCausalId = fromMaybe oldBranchCausalId bestCommonAncestorCausalId
+    let cacheKeys = [IDs.toText contributionId, IDs.toText newPBSH, IDs.toText oldPBSH, Caching.causalIdCacheKey newBranchCausalId, Caching.causalIdCacheKey oldCausalId, Name.toText oldTermName, Name.toText newTermName]
+    Caching.cachedResponse authZReceipt "contribution-diff-terms" cacheKeys do
+      (oldBranchHashId, newBranchHashId) <- PG.runTransaction $ CausalQ.expectNamespaceIdsByCausalIdsOf both (oldCausalId, newBranchCausalId)
+      (oldTerm, newTerm, displayObjDiff) <- Diffs.diffTerms authZReceipt (oldCodebase, oldBranchHashId, oldTermName) (newCodebase, newBranchHashId, newTermName)
+      pure $
+        ShareTermDiffResponse
+          { project = projectShorthand,
+            oldBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand oldPBSH,
+            newBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand newPBSH,
+            oldTerm = oldTerm,
+            newTerm = newTerm,
+            diff = displayObjDiff
+          }
+  where
+    projectShorthand :: IDs.ProjectShortHand
+    projectShorthand = IDs.ProjectShortHand {userHandle, projectSlug}
+
+contributionDiffTypesEndpoint ::
+  Maybe Session ->
+  UserHandle ->
+  ProjectSlug ->
+  IDs.ContributionNumber ->
+  Name ->
+  Name ->
+  WebApp (Cached JSON ShareTypeDiffResponse)
+contributionDiffTypesEndpoint (AuthN.MaybeAuthedUserID mayCallerUserId) userHandle projectSlug contributionNumber oldTypeName newTypeName =
+  do
+    ( project,
+      Contribution {contributionId, bestCommonAncestorCausalId},
+      oldBranch@Branch {causal = oldBranchCausalId, branchId = oldBranchId},
+      newBranch@Branch {causal = newBranchCausalId, branchId = newBranchId}
+      ) <- PG.runTransactionOrRespondError $ do
+      project@Project {projectId} <- Q.projectByShortHand projectShorthand `whenNothingM` throwError (EntityMissing (ErrorID "project:missing") "Project not found")
+      contribution@Contribution {sourceBranchId = newBranchId, targetBranchId = oldBranchId} <- ContributionsQ.contributionByProjectIdAndNumber projectId contributionNumber `whenNothingM` throwError (EntityMissing (ErrorID "contribution:missing") "Contribution 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")
+      pure (project, contribution, oldBranch, newBranch)
+    authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkContributionRead mayCallerUserId project
+    let oldCodebase = Codebase.codebaseForProjectBranch authZReceipt project oldBranch
+    let newCodebase = Codebase.codebaseForProjectBranch authZReceipt project newBranch
+    oldPBSH <- Codebase.runCodebaseTransactionOrRespondError oldCodebase $ do
+      lift $ Q.projectBranchShortHandByBranchId oldBranchId `whenNothingM` throwError (EntityMissing (ErrorID "branch:missing") "Target branch not found")
+    newPBSH <- Codebase.runCodebaseTransactionOrRespondError newCodebase $ do
+      lift $ Q.projectBranchShortHandByBranchId newBranchId `whenNothingM` throwError (EntityMissing (ErrorID "branch:missing") "Source branch not found")
+    let oldCausalId = fromMaybe oldBranchCausalId bestCommonAncestorCausalId
+    let cacheKeys = [IDs.toText contributionId, IDs.toText newPBSH, IDs.toText oldPBSH, Caching.causalIdCacheKey newBranchCausalId, Caching.causalIdCacheKey oldCausalId, Name.toText oldTypeName, Name.toText newTypeName]
+    Caching.cachedResponse authZReceipt "contribution-diff-types" cacheKeys do
+      (oldBranchHashId, newBranchHashId) <- PG.runTransaction $ CausalQ.expectNamespaceIdsByCausalIdsOf both (oldCausalId, newBranchCausalId)
+      (oldType, newType, displayObjDiff) <- Diffs.diffTypes authZReceipt (oldCodebase, oldBranchHashId, oldTypeName) (newCodebase, newBranchHashId, newTypeName)
+      pure $
+        ShareTypeDiffResponse
+          { project = projectShorthand,
+            oldBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand oldPBSH,
+            newBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand newPBSH,
+            oldType = oldType,
+            newType = newType,
+            diff = displayObjDiff
+          }
+  where
+    projectShorthand :: IDs.ProjectShortHand
+    projectShorthand = IDs.ProjectShortHand {userHandle, projectSlug}
+
 mergeContributionEndpoint ::
   Maybe Session ->
   UserHandle ->

src/Share/Web/Share/Diffs/Impl.hs

@@ -67,12 +67,12 @@ diffCausals !_authZReceipt oldCausalId newCausalId = do
   -- Ensure name lookups for each thing we're diffing.
   -- We do this in two separate transactions to ensure we can still make progress even if we need to build name lookups.
   (oldBranchHashId, oldBranchNLReceipt) <- PG.runTransaction $ do
-    oldBranchHashId <- CausalQ.expectNamespaceIdForCausal oldCausalId
+    oldBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id oldCausalId
     oldBranchNLReceipt <- NLOps.ensureNameLookupForBranchId oldBranchHashId
     pure (oldBranchHashId, oldBranchNLReceipt)
 
   (newBranchHashId, newNLReceipt) <- PG.runTransaction $ do
-    newBranchHashId <- CausalQ.expectNamespaceIdForCausal newCausalId
+    newBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id newCausalId
     newNLReceipt <- NLOps.ensureNameLookupForBranchId newBranchHashId
     pure (newBranchHashId, newNLReceipt)
 

src/Share/Web/Share/Projects/Impl.hs

@@ -97,8 +97,8 @@ projectServer session handle =
                      :<|> contributionsByProjectServer session handle slug
                      :<|> ticketsByProjectServer session handle slug
                      :<|> ( diffNamespacesEndpoint session handle slug
-                              :<|> diffTermsEndpoint session handle slug
-                              :<|> diffTypesEndpoint session handle slug
+                              :<|> projectDiffTermsEndpoint session handle slug
+                              :<|> projectDiffTypesEndpoint session handle slug
                           )
                      :<|> createProjectEndpoint session handle slug
                      :<|> updateProjectEndpoint session handle slug
@@ -172,7 +172,7 @@ diffNamespacesEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle project
   where
     projectShortHand = IDs.ProjectShortHand {userHandle, projectSlug}
 
-diffTermsEndpoint ::
+projectDiffTermsEndpoint ::
   Maybe Session ->
   UserHandle ->
   ProjectSlug ->
@@ -181,7 +181,7 @@ diffTermsEndpoint ::
   Name ->
   Name ->
   WebApp ShareTermDiffResponse
-diffTermsEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle projectSlug oldShortHand newShortHand oldTermName newTermName =
+projectDiffTermsEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle projectSlug oldShortHand newShortHand oldTermName newTermName =
   do
     project <- PG.runTransactionOrRespondError do
       Q.projectByShortHand projectShortHand `whenNothingM` throwError (EntityMissing (ErrorID "project-not-found") ("Project not found: " <> IDs.toText @IDs.ProjectShortHand projectShortHand))
@@ -203,7 +203,7 @@ diffTermsEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle projectSlug
     projectShortHand :: IDs.ProjectShortHand
     projectShortHand = IDs.ProjectShortHand {userHandle, projectSlug}
 
-diffTypesEndpoint ::
+projectDiffTypesEndpoint ::
   Maybe Session ->
   UserHandle ->
   ProjectSlug ->
@@ -212,7 +212,7 @@ diffTypesEndpoint ::
   Name ->
   Name ->
   WebApp ShareTypeDiffResponse
-diffTypesEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle projectSlug oldShortHand newShortHand oldTypeName newTypeName =
+projectDiffTypesEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle projectSlug oldShortHand newShortHand oldTypeName newTypeName =
   do
     project <- PG.runTransactionOrRespondError do
       Q.projectByShortHand projectShortHand `whenNothingM` throwError (EntityMissing (ErrorID "project-not-found") ("Project not found: " <> IDs.toText @IDs.ProjectShortHand projectShortHand))
@@ -243,7 +243,7 @@ namespaceHashForBranchOrRelease authZReceipt Project {projectId, ownerUserId = p
       let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId (Branch.contributorId branch)
       let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
       Codebase.codebaseMToTransaction codebase do
-        branchHashId <- CausalQ.expectNamespaceIdForCausal causalId
+        branchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId
         pure (codebase, causalId, branchHashId)
   IDs.IsReleaseShortHand releaseShortHand -> do
     PG.runTransactionOrRespondError $ do
@@ -252,7 +252,7 @@ namespaceHashForBranchOrRelease authZReceipt Project {projectId, ownerUserId = p
       let codebaseLoc = Codebase.codebaseLocationForProjectRelease projectOwnerUserId
       let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
       Codebase.codebaseMToTransaction codebase do
-        branchHashId <- CausalQ.expectNamespaceIdForCausal causalId
+        branchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId
         pure (codebase, causalId, branchHashId)
 
 createProjectEndpoint :: Maybe Session -> UserHandle -> ProjectSlug -> CreateProjectRequest -> WebApp CreateProjectResponse

src/Unison/Server/Share/Definitions.hs

@@ -79,7 +79,7 @@ definitionForHQName ::
   HQ.HashQualified Name ->
   Codebase.CodebaseM e DefinitionDisplayResults
 definitionForHQName perspective rootCausalId renderWidth suffixifyBindings rt perspectiveQuery = do
-  rootBranchNamespaceHashId <- CausalQ.expectNamespaceIdForCausal rootCausalId
+  rootBranchNamespaceHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id rootCausalId
   (namesPerspective, query) <- NameLookupOps.relocateToNameRoot perspective perspectiveQuery rootBranchNamespaceHashId
   Debug.debugM Debug.Server "definitionForHQName: (namesPerspective, query)" (namesPerspective, query)
   -- Bias towards both relative and absolute path to queries,

src/Unison/Server/Share/RenderDoc.hs

@@ -14,7 +14,6 @@ import Data.Set qualified as Set
 import Share.Backend qualified as Backend
 import Share.Codebase.Types (CodebaseM, CodebaseRuntime)
 import Share.Postgres.Causal.Queries qualified as CausalQ
-import Share.Postgres.Causal.Queries qualified as HashQ
 import Share.Postgres.IDs (CausalId)
 import Share.Postgres.NameLookups.Ops qualified as NLOps
 import Share.Postgres.NameLookups.Types (PathSegments (..))
@@ -40,7 +39,7 @@ findAndRenderDoc ::
   Maybe Width ->
   CodebaseM e (Maybe Doc)
 findAndRenderDoc docNames runtime namespacePath rootCausalId _mayWidth = runMaybeT do
-  rootNamespaceHashId <- lift $ HashQ.expectNamespaceIdForCausal rootCausalId
+  rootNamespaceHashId <- lift $ CausalQ.expectNamespaceIdsByCausalIdsOf id rootCausalId
   namespaceCausal <- MaybeT $ CausalQ.loadCausalNamespaceAtPath rootCausalId namespacePath
   shallowBranchAtNamespace <- lift $ V2Causal.value namespaceCausal
   namesPerspective <- NLOps.namesPerspectiveForRootAndPath rootNamespaceHashId (coerce $ Path.toList namespacePath)