Add branch-history API

share-api/src/Share/Postgres/Causal/Queries.hs

@@ -25,6 +25,9 @@ module Share.Postgres.Causal.Queries
     hashCausal,
     bestCommonAncestor,
     isFastForward,
+    pagedCausalAncestors,
+    CausalDepth,
+    CausalHistoryCursor,
 
     -- * Sync
     expectCausalEntity,
@@ -54,6 +57,7 @@ import Share.Postgres.Patches.Queries qualified as PatchQ
 import Share.Postgres.Serialization qualified as S
 import Share.Postgres.Sync.Conversions qualified as Cv
 import Share.Prelude
+import Share.Utils.API (Cursor (..), CursorDirection (..), Limit (..), Paged, guardPaged, pagedOn)
 import Share.Utils.Postgres (OrdBy, ordered)
 import Share.Web.Authorization.Types (RolePermission (..))
 import Share.Web.Errors (MissingExpectedEntity (MissingExpectedEntity))
@@ -985,3 +989,54 @@ isFastForward fromCausalId toCausalId = do
         WHERE history.causal_id = #{fromCausalId}
   );
   |]
+
+type CausalHistoryCursor = (CausalHash, CausalDepth)
+
+type CausalDepth = Int64
+
+pagedCausalAncestors ::
+  (QueryM m) =>
+  CausalId ->
+  Limit ->
+  Maybe (Cursor CausalHistoryCursor) ->
+  m (Paged CausalHistoryCursor CausalHash)
+pagedCausalAncestors rootCausalId limit mayCursor =
+  do
+    let (filter, ordering, maybeReverse) = case mayCursor of
+          Nothing -> (mempty, [sql| ORDER BY (h.causal_depth, h.causal_hash) DESC |], id)
+          Just (Cursor (hash, depth) Next) -> ([sql| WHERE (h.causal_depth, h.causal_hash) < (#{depth}, #{hash}) |], [sql| ORDER BY (h.causal_depth, h.causal_hash) DESC  |], id)
+          Just (Cursor (hash, depth) Previous) -> ([sql| WHERE (h.causal_depth, h.causal_hash) > (#{depth}, #{hash}) |], [sql| ORDER BY (h.causal_depth , h.causal_hash) ASC |], reverse)
+    rawResults <-
+      queryListRows @(CausalHash, CausalDepth)
+        [sql|
+  WITH RECURSIVE history(causal_id, causal_hash, causal_depth) AS (
+      SELECT causal.id, causal.hash, cd.depth
+      FROM causals causal
+        JOIN causal_depth cd ON causal.id = cd.causal_id
+          WHERE causal.id = #{rootCausalId}
+      UNION
+      SELECT c.id, c.hash, cd.depth
+      FROM history h
+          JOIN causal_ancestors ca ON h.causal_id = ca.causal_id
+          JOIN causals c ON ca.ancestor_id = c.id
+          JOIN causal_depth cd ON c.id = cd.causal_id
+  ) SELECT h.causal_hash, h.causal_depth
+      FROM history h
+      ^{filter}
+      ^{ordering}
+      LIMIT #{limit + 1}
+    |]
+    let hasPrevPage = case mayCursor of
+          Just (Cursor _ Previous) -> length rawResults > fromIntegral (getLimit limit)
+          Just (Cursor _ Next) -> True
+          Nothing -> False
+    let hasNextPage = case mayCursor of
+          Just (Cursor _ Next) -> length rawResults > fromIntegral (getLimit limit)
+          Nothing -> length rawResults > fromIntegral (getLimit limit)
+          Just (Cursor _ Previous) -> True
+    pure rawResults
+      <&> maybeReverse
+      <&> take (fromIntegral (getLimit limit))
+      <&> pagedOn id
+      <&> guardPaged hasPrevPage hasNextPage
+      <&> fmap fst

share-api/src/Share/Web/Share/Branches/API.hs

@@ -4,13 +4,14 @@
 module Share.Web.Share.Branches.API where
 
 import Data.Time (UTCTime)
+import Servant
 import Share.IDs
+import Share.Postgres.Causal.Queries (CausalHistoryCursor)
 import Share.Utils.API
 import Share.Utils.Caching
-import Share.Web.Share.Branches.Types (BranchKindFilter, ShareBranch)
+import Share.Web.Share.Branches.Types (BranchHistoryResponse, BranchKindFilter, ShareBranch)
 import Share.Web.Share.CodeBrowsing.API (CodeBrowseAPI)
 import Share.Web.Share.Types
-import Servant
 import U.Codebase.HashTags (CausalHash)
 
 type ProjectBranchesAPI =
@@ -20,6 +21,7 @@ type ProjectBranchesAPI =
 type ProjectBranchResourceAPI =
   ( ("readme" :> ProjectBranchReadmeEndpoint)
       :<|> ("releaseNotes" :> ProjectBranchReleaseNotesEndpoint)
+      :<|> ("history" :> ProjectBranchHistoryEndpoint)
       :<|> ProjectBranchDetailsEndpoint
       :<|> ProjectBranchDeleteEndpoint
       :<|> CodeBrowseAPI
@@ -29,6 +31,11 @@ type ProjectBranchDetailsEndpoint = Get '[JSON] ShareBranch
 
 type ProjectBranchDeleteEndpoint = Delete '[JSON] ()
 
+type ProjectBranchHistoryEndpoint =
+  QueryParam "cursor" (Cursor CausalHistoryCursor)
+    :> QueryParam "limit" Limit
+    :> Get '[JSON] BranchHistoryResponse
+
 type ProjectBranchReadmeEndpoint =
   QueryParam "rootHash" CausalHash
     :> Get '[JSON] (Cached JSON ReadmeResponse)

share-api/src/Share/Web/Share/Branches/Impl.hs

@@ -20,6 +20,7 @@ import Share.IDs (BranchId, BranchShortHand (..), ProjectBranchShortHand (..), P
 import Share.IDs qualified as IDs
 import Share.OAuth.Session
 import Share.Postgres qualified as PG
+import Share.Postgres.Causal.Queries (CausalHistoryCursor)
 import Share.Postgres.Causal.Queries qualified as CausalQ
 import Share.Postgres.Contributions.Queries qualified as ContributionsQ
 import Share.Postgres.IDs (CausalId)
@@ -40,7 +41,7 @@ import Share.Web.Authorization qualified as AuthZ
 import Share.Web.Errors
 import Share.Web.Share.Branches.API (ListBranchesCursor)
 import Share.Web.Share.Branches.API qualified as API
-import Share.Web.Share.Branches.Types (BranchKindFilter (..), ShareBranch (..))
+import Share.Web.Share.Branches.Types (BranchHistoryCausal (..), BranchHistoryEntry (..), BranchHistoryResponse (..), BranchKindFilter (..), ShareBranch (..))
 import Share.Web.Share.Branches.Types qualified as API
 import Share.Web.Share.CodeBrowsing.API qualified as API
 import Share.Web.Share.Contributions.Types
@@ -87,6 +88,7 @@ branchesServer session userHandle projectSlug =
              hoistServer (Proxy @API.ProjectBranchResourceAPI) (addTags branchShortHand) $
                ( getProjectBranchReadmeEndpoint session userHandle projectSlug branchShortHand
                    :<|> getProjectBranchReleaseNotesEndpoint session userHandle projectSlug branchShortHand
+                   :<|> branchHistoryEndpoint session userHandle projectSlug branchShortHand
                    :<|> getProjectBranchDetailsEndpoint session userHandle projectSlug branchShortHand
                    :<|> deleteProjectBranchEndpoint session userHandle projectSlug branchShortHand
                    :<|> branchCodeBrowsingServer session userHandle projectSlug branchShortHand
@@ -491,6 +493,37 @@ deleteProjectBranchEndpoint session userHandle projectSlug branchShortHand = do
   PG.runTransaction $ Q.softDeleteBranch branchId
   pure ()
 
+branchHistoryEndpoint ::
+  Maybe Session ->
+  UserHandle ->
+  ProjectSlug ->
+  BranchShortHand ->
+  Maybe (Cursor CausalHistoryCursor) ->
+  Maybe Limit ->
+  WebApp BranchHistoryResponse
+branchHistoryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle projectSlug branchRef@(BranchShortHand {contributorHandle, branchName}) mayCursor mayLimit = do
+  (Project {ownerUserId = projectOwnerUserId, projectId}, Branch {causal = branchHead, contributorId}) <- getProjectBranch projectBranchShortHand
+  authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkProjectBranchRead callerUserId projectId
+  let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId
+  let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc
+  causalId <- resolveRootHash codebase branchHead Nothing
+  PG.runTransaction do
+    history <-
+      CausalQ.pagedCausalAncestors causalId limit mayCursor
+        <&> fmap \(causalHash) ->
+          BranchHistoryCausalEntry (BranchHistoryCausal {causalHash})
+    pure $
+      BranchHistoryResponse
+        { projectRef,
+          branchRef,
+          history
+        }
+  where
+    projectRef = ProjectShortHand {userHandle, projectSlug}
+    limit = fromMaybe defaultLimit mayLimit
+    defaultLimit = Limit 20
+    projectBranchShortHand = ProjectBranchShortHand {userHandle, projectSlug, contributorHandle, branchName}
+
 getProjectBranchDocEndpoint ::
   Text ->
   Set NameSegment ->

share-api/src/Share/Web/Share/Branches/Types.hs

@@ -12,7 +12,10 @@ import Servant.API (FromHttpApiData (..), ToHttpApiData (..))
 import Share.Branch (Branch (..))
 import Share.IDs
 import Share.IDs qualified as IDs
+import Share.Postgres.Causal.Queries (CausalHistoryCursor)
 import Share.Postgres.IDs
+import Share.Prelude
+import Share.Utils.API (Paged, (:++) (..))
 import Share.Web.Share.Contributions.Types (ShareContribution)
 import Share.Web.Share.DisplayInfo.Types (UserDisplayInfo)
 import Share.Web.Share.Projects.Types
@@ -75,3 +78,68 @@ instance ToHttpApiData BranchKindFilter where
   toQueryParam AllBranchKinds = "all"
   toQueryParam OnlyCoreBranches = "core"
   toQueryParam OnlyContributorBranches = "contributor"
+
+-- {
+--   "projectRef": "@unison/base",
+--   "branchRef": "main",
+--   "prevCursor": "c-asdf-1234",
+--   "nextCursor": "c-asdf-1234",
+--   "history": [
+--     {
+--       "tag": "Changeset",
+--       "causalHash": "#asdf-1234",
+--     }
+--   ]
+-- }
+
+data BranchHistoryResponse = BranchHistoryResponse
+  { projectRef :: ProjectShortHand,
+    branchRef :: BranchShortHand,
+    history :: Paged CausalHistoryCursor BranchHistoryEntry
+  }
+  deriving stock (Eq, Show)
+
+instance ToJSON BranchHistoryResponse where
+  toJSON BranchHistoryResponse {..} =
+    object
+      [ "projectRef" .= IDs.toText @ProjectShortHand projectRef,
+        "branchRef" .= IDs.toText @BranchShortHand branchRef,
+        "history" .= history
+      ]
+
+instance FromJSON BranchHistoryResponse where
+  parseJSON = withObject "BranchHistoryResponse" $ \o ->
+    BranchHistoryResponse
+      <$> (o .: "projectRef")
+      <*> (o .: "branchRef")
+      <*> o .: "history"
+
+data BranchHistoryCausal = BranchHistoryCausal
+  { causalHash :: CausalHash
+  }
+  deriving stock (Eq, Show)
+
+instance ToJSON BranchHistoryCausal where
+  toJSON BranchHistoryCausal {..} =
+    object
+      [ "causalHash" .= causalHash
+      ]
+
+instance FromJSON BranchHistoryCausal where
+  parseJSON = withObject "BranchHistoryCausal" $ \o ->
+    BranchHistoryCausal
+      <$> o .: "causalHash"
+
+data BranchHistoryEntry
+  = BranchHistoryCausalEntry BranchHistoryCausal
+  deriving stock (Eq, Show)
+
+instance ToJSON BranchHistoryEntry where
+  toJSON = \case
+    (BranchHistoryCausalEntry causal) ->
+      toJSON (causal :++ (object ["tag" .= ("Changeset" :: Text)]))
+
+instance FromJSON BranchHistoryEntry where
+  parseJSON v = do
+    causal <- parseJSON v
+    return $ BranchHistoryCausalEntry causal

transcripts/share-apis/branches/out/branch-history-next-page.json

@@ -0,0 +1,29 @@
+{
+  "body": {
+    "branchRef": "main",
+    "history": {
+      "items": [
+        {
+          "causalHash": "qt7njnf877g2q9g1f44eaigmcrgsdphc74jkdoos0i1pq6hguo03697adec2cb8lvgp71d4st3ss59g0haut5pfs5rpd4dru6pidt0g",
+          "tag": "Changeset"
+        },
+        {
+          "causalHash": "2k8f975ovhkm64bvog66rr8i7e4dripu8nkl7u62oif96if23lh5fh73n8p9qg21or98n4aljunidn6avonqpt1eu971h74iqlmgk5g",
+          "tag": "Changeset"
+        },
+        {
+          "causalHash": "n8b2r8o7u4f8ct0u79rhamnb16l3jhhr8986nudm6cgvg2j1fetouu0ojuiums5vtt8imsnsa7ek6lt18tcq3pf9knsinpsiqrq1r5o",
+          "tag": "Changeset"
+        }
+      ],
+      "nextCursor": "<CURSOR>",
+      "prevCursor": "<CURSOR>"
+    },
+    "projectRef": "@transcripts/branch-with-history"
+  },
+  "status": [
+    {
+      "status_code": 200
+    }
+  ]
+}

transcripts/share-apis/branches/out/branch-history-prev-page.json

@@ -0,0 +1,29 @@
+{
+  "body": {
+    "branchRef": "main",
+    "history": {
+      "items": [
+        {
+          "causalHash": "bpm4dqkous3flfcu8t07jhirta2i5kondhbqa7u3plg2racaohhdupam5k1bm7pnlbhpuphih36mdufuhsnv2832ri45u1nvn0j4qr8",
+          "tag": "Changeset"
+        },
+        {
+          "causalHash": "6h6qn76m9053vmg8a36cilbdnolked4uqh6bgm4qkpflpmr2pji3pais6f74k7364avo0rqn9kgdfje8pqldph0u52u8kjc8j923v00",
+          "tag": "Changeset"
+        },
+        {
+          "causalHash": "hqul4i7u7gud3u5ovcdgbgdsmvfnh3o98baolc5f5g35aic1j84jtd97otnn0reuig39jnnsp7376j4adsko3v12o4h09vqc2drbbd8",
+          "tag": "Changeset"
+        }
+      ],
+      "nextCursor": "<CURSOR>",
+      "prevCursor": null
+    },
+    "projectRef": "@transcripts/branch-with-history"
+  },
+  "status": [
+    {
+      "status_code": 200
+    }
+  ]
+}

transcripts/share-apis/branches/out/branch-history.json

@@ -0,0 +1,29 @@
+{
+  "body": {
+    "branchRef": "main",
+    "history": {
+      "items": [
+        {
+          "causalHash": "bpm4dqkous3flfcu8t07jhirta2i5kondhbqa7u3plg2racaohhdupam5k1bm7pnlbhpuphih36mdufuhsnv2832ri45u1nvn0j4qr8",
+          "tag": "Changeset"
+        },
+        {
+          "causalHash": "6h6qn76m9053vmg8a36cilbdnolked4uqh6bgm4qkpflpmr2pji3pais6f74k7364avo0rqn9kgdfje8pqldph0u52u8kjc8j923v00",
+          "tag": "Changeset"
+        },
+        {
+          "causalHash": "hqul4i7u7gud3u5ovcdgbgdsmvfnh3o98baolc5f5g35aic1j84jtd97otnn0reuig39jnnsp7376j4adsko3v12o4h09vqc2drbbd8",
+          "tag": "Changeset"
+        }
+      ],
+      "nextCursor": "<CURSOR>",
+      "prevCursor": null
+    },
+    "projectRef": "@transcripts/branch-with-history"
+  },
+  "status": [
+    {
+      "status_code": 200
+    }
+  ]
+}

transcripts/share-apis/branches/prelude.md

@@ -0,0 +1,19 @@
+```unison
+x1 = 1
+```
+
+```ucm
+branch-with-history/main> update
+branch-with-history/main> alias.term x1 x2
+branch-with-history/main> alias.term x2 x3
+branch-with-history/main> alias.term x3 x4
+branch-with-history/main> alias.term x4 x5
+branch-with-history/main> alias.term x5 x6
+branch-with-history/main> alias.term x6 x7
+branch-with-history/main> alias.term x7 x8
+branch-with-history/main> alias.term x8 x9
+branch-with-history/main> alias.term x9 x10
+branch-with-history/main> history
+branch-with-history/main> push @transcripts/branch-with-history/main
+```
+

transcripts/share-apis/branches/run.zsh

@@ -55,3 +55,15 @@ fetch "$test_user" DELETE branch-delete '/users/test/projects/publictestproject/
 # Branch should no longer exist
 fetch "$test_user" GET branch-details-deleted '/users/test/projects/publictestproject/branches/main'
 
+
+# Add some history to a branch.
+transcript_ucm transcript prelude.md
+
+fetch "$transcripts_user" GET branch-history '/users/transcripts/projects/branch-with-history/branches/main/history?limit=3'
+
+next_cursor=$(fetch_data_jq "$transcripts_user" GET branch-history-next-cursor '/users/transcripts/projects/branch-with-history/branches/main/history?limit=3' '.history.nextCursor')
+
+fetch "$transcripts_user" GET branch-history-next-page "/users/transcripts/projects/branch-with-history/branches/main/history?limit=3&cursor=$next_cursor" '.history.prevCursor'
+prev_cursor=$(fetch_data_jq "$transcripts_user" GET branch-history-prev-cursor "/users/transcripts/projects/branch-with-history/branches/main/history?limit=3&cursor=$next_cursor" '.history.prevCursor')
+
+fetch "$transcripts_user" GET branch-history-prev-page "/users/transcripts/projects/branch-with-history/branches/main/history?limit=3&cursor=$prev_cursor"