adding a default-branch endpoint to the server

server/src/Utopia/Web/Endpoints.hs

@@ -682,6 +682,20 @@ getGithubBranchContentEndpoint cookie owner repository branchName possibleCommit
     then notModified
     else pure contentResponse
 
+getGithubDefaultBranchContentEndpoint :: Maybe Text -> Text -> Text -> Maybe Text -> Maybe Text -> ServerMonad GetBranchContentResponse
+getGithubDefaultBranchContentEndpoint cookie owner repository possibleCommitSha Nothing = requireUser cookie $ \sessionUser -> do
+  -- No previous commit SHA was supplied.
+  getDefaultBranchContent (view (field @"_id") sessionUser) owner repository possibleCommitSha Nothing
+getGithubDefaultBranchContentEndpoint cookie owner repository possibleCommitSha justPreviousCommitSha@(Just _) = requireUser cookie $ \sessionUser -> do
+  -- A previous commit SHA was supplied, which may mean we want to return a 304.
+  contentResponse <- getDefaultBranchContent (view (field @"_id") sessionUser) owner repository possibleCommitSha justPreviousCommitSha
+  -- Check the previous commit SHA against the newly returned content.
+  let possibleNewCommitSha = firstOf (_Ctor @"GetBranchContentResponseSuccess" . field @"branch" . _Just . field @"originCommit") contentResponse
+  -- Return a 304 if the commits match.
+  if possibleNewCommitSha == justPreviousCommitSha
+    then notModified
+    else pure contentResponse
+
 getGithubUsersRepositoriesEndpoint :: Maybe Text -> ServerMonad GetUsersPublicRepositoriesResponse
 getGithubUsersRepositoriesEndpoint cookie = requireUser cookie $ \sessionUser -> do
   getUsersRepositories (view (field @"_id") sessionUser)
@@ -735,6 +749,7 @@ protected authCookie = logoutPage authCookie
                   :<|> githubSaveEndpoint authCookie
                   :<|> getGithubBranchesEndpoint authCookie
                   :<|> getGithubBranchContentEndpoint authCookie
+                  :<|> getGithubDefaultBranchContentEndpoint authCookie
                   :<|> getGithubBranchPullRequestEndpoint authCookie
                   :<|> getGithubUsersRepositoriesEndpoint authCookie
                   :<|> saveGithubAssetEndpoint authCookie

server/src/Utopia/Web/Executors/Common.hs

@@ -475,6 +475,18 @@ getGithubBranch githubSemaphore githubResources logger metrics pool userID owner
         Nothing -> pure Nothing
   pure $ either getBranchContentFailureFromReason getBranchContentSuccessFromContent result
 
+getDefaultGithubBranch :: (MonadBaseControl IO m, MonadIO m, MonadThrow m) => QSem -> GithubAuthResources -> FastLogger -> DB.DatabaseMetrics -> DBPool -> Text -> Text -> Text -> Maybe Text -> Maybe Text -> m GetBranchContentResponse
+getDefaultGithubBranch githubSemaphore githubResources logger metrics pool userID owner repository possibleCommitSha possiblePreviousCommitSha = do
+  defaultBranchResult <- runExceptT $ do
+    useAccessToken githubResources logger metrics pool userID $ \accessToken -> do
+      possibleRepo <- getRepository githubSemaphore accessToken owner repository
+      usersRepository <- maybe (throwE ("Repository " <> repository <> " not found.")) pure possibleRepo
+      let defaultBranch = view (field @"default_branch") usersRepository
+      lift $ getGithubBranch githubSemaphore githubResources logger metrics pool userID owner repository defaultBranch possibleCommitSha possiblePreviousCommitSha
+
+  pure $ either getBranchContentFailureFromReason identity defaultBranchResult
+
+
 convertUsersRepositoriesResultToUnfold :: Int -> GetUsersPublicRepositoriesResult -> Maybe (GetUsersPublicRepositoriesResult, Maybe Int)
 convertUsersRepositoriesResultToUnfold page result =
   -- We expect some X elements per page, if we get less than that, assume we've hit the end and should not

server/src/Utopia/Web/Executors/Development.hs

@@ -376,6 +376,17 @@ innerServerExecutor (GetBranchContent user owner repository branchName possibleC
     Just githubResources -> do
       result <- getGithubBranch githubSemaphore githubResources logger metrics pool user owner repository branchName possibleCommitSha possiblePreviousCommitSha
       pure $ action result
+innerServerExecutor (GetDefaultBranchContent user owner repository possibleCommitSha possiblePreviousCommitSha action) = do
+  githubSemaphore <- fmap _githubSemaphore ask
+  possibleGithubResources <- fmap _githubResources ask
+  metrics <- fmap _databaseMetrics ask
+  logger <- fmap _logger ask
+  pool <- fmap _projectPool ask
+  case possibleGithubResources of
+    Nothing -> throwError err501
+    Just githubResources -> do
+      result <- getDefaultGithubBranch githubSemaphore githubResources logger metrics pool user owner repository possibleCommitSha possiblePreviousCommitSha
+      pure $ action result
 innerServerExecutor (GetUsersRepositories user action) = do
   githubSemaphore <- fmap _githubSemaphore ask
   possibleGithubResources <- fmap _githubResources ask

server/src/Utopia/Web/Executors/Production.hs

@@ -293,6 +293,14 @@ innerServerExecutor (GetBranchContent user owner repository branchName possibleC
   pool <- fmap _projectPool ask
   result <- getGithubBranch githubSemaphore githubResources logger metrics pool user owner repository branchName possibleCommitSha possiblePreviousCommitSha
   pure $ action result
+innerServerExecutor (GetDefaultBranchContent user owner repository possibleCommitSha possiblePreviousCommitSha action) = do
+  githubSemaphore <- fmap _githubSemaphore ask
+  githubResources <- fmap _githubResources ask
+  metrics <- fmap _databaseMetrics ask
+  logger <- fmap _logger ask
+  pool <- fmap _projectPool ask
+  result <- getDefaultGithubBranch githubSemaphore githubResources logger metrics pool user owner repository possibleCommitSha possiblePreviousCommitSha
+  pure $ action result
 innerServerExecutor (GetUsersRepositories user action) = do
   githubSemaphore <- fmap _githubSemaphore ask
   githubResources <- fmap _githubResources ask

server/src/Utopia/Web/ServiceTypes.hs

@@ -138,6 +138,7 @@ data ServiceCallsF a = NotFound
                      | SaveToGithubRepo Text Text (Maybe Text) (Maybe Text) PersistentModel (SaveToGithubResponse -> a)
                      | GetBranchesFromGithubRepo Text Text Text (GetBranchesResponse -> a)
                      | GetBranchContent Text Text Text Text (Maybe Text) (Maybe Text) (GetBranchContentResponse -> a)
+                     | GetDefaultBranchContent Text Text Text (Maybe Text) (Maybe Text) (GetBranchContentResponse -> a)
                      | GetUsersRepositories Text (GetUsersPublicRepositoriesResponse -> a)
                      | SaveGithubAsset Text Text Text Text Text [Text] (GithubSaveAssetResponse -> a)
                      | GetPullRequestForBranch Text Text Text Text (GetBranchPullRequestResponse -> a)

server/src/Utopia/Web/Types.hs

@@ -146,6 +146,8 @@ type GithubSaveAssetAPI = "v1" :> "github" :> "branches" :> Capture "owner" Text
 
 type GithubBranchLoadAPI = "v1" :> "github" :> "branches" :> Capture "owner" Text :> Capture "repository" Text :> "branch" :> Capture "branchName" Text :> QueryParam "commit_sha" Text :> QueryParam "previous_commit_sha" Text :> Get '[JSON] GetBranchContentResponse
 
+type GithubDefaultBranchLoadAPI = "v1" :> "github" :> "branches" :> Capture "owner" Text :> Capture "repository" Text :> "default-branch" :> QueryParam "commit_sha" Text :> QueryParam "previous_commit_sha" Text :> Get '[JSON] GetBranchContentResponse
+
 type GithubBranchPullRequestAPI = "v1" :> "github" :> "branches" :> Capture "owner" Text :> Capture "repository" Text :> "branch" :> Capture "branchName" Text :> "pullrequest" :> Get '[JSON] GetBranchPullRequestResponse
 
 type GithubUsersRepositoriesAPI = "v1" :> "github" :> "user" :> "repositories" :> Get '[JSON] GetUsersPublicRepositoriesResponse
@@ -207,6 +209,7 @@ type Protected = LogoutAPI
             :<|> GithubSaveAPI
             :<|> GithubBranchesAPI
             :<|> GithubBranchLoadAPI
+            :<|> GithubDefaultBranchLoadAPI
             :<|> GithubBranchPullRequestAPI
             :<|> GithubUsersRepositoriesAPI
             :<|> GithubSaveAssetAPI