improve "branches" mode

Handler/MakePublic.hs

@@ -24,16 +24,20 @@ doMakePublic submissionId chan = do
     runDB $ update submissionId [SubmissionIsPublic =. True]
     submission <- runDB $ get404 submissionId
     challenge <- runDB $ get404 $ submissionChallenge submission
+    repo <- runDB $ get404 $ challengePublicRepo challenge
     let submissionRepoId = submissionRepo submission
     submissionRepoDir <- getRepoDir submissionRepoId
-    let targetRepoUrl = getPublicSubmissionUrl $ challengeName challenge
+
+    app <- getYesod
+    let scheme = appRepoScheme $ appSettings app
+
+    let targetRepoUrl = getPublicSubmissionUrl scheme (Just repo) $ challengeName challenge
     let targetBranchName = getPublicSubmissionBranch submissionId
     msg chan $ "Start pushing from " ++ (T.pack submissionRepoDir) ++ " to repo " ++ targetRepoUrl ++ ", branch " ++ targetBranchName ++ " ..."
     let commit = submissionCommit submission
     pushRepo submissionRepoDir commit (T.unpack $ targetRepoUrl) (T.unpack $ targetBranchName) chan
   return ()
 
-
 pushRepo :: String -> SHA1 -> String -> String -> Channel -> Handler ()
 pushRepo repoDir commit targetRepoUrl targetBranchName chan = do
   (exitCode, _) <- runProgram (Just repoDir) gitPath [

Handler/Shared.hs

@@ -62,8 +62,9 @@ gitReadOnlyServer = "git://" ++ serverAddress ++ "/"
 getPublicSubmissionBranch :: SubmissionId -> Text
 getPublicSubmissionBranch = T.pack . (printf "submission-%05d") . fromSqlKey
 
-getPublicSubmissionUrl :: Text -> Text
-getPublicSubmissionUrl bareRepoName = gitServer ++ bareRepoName
+getPublicSubmissionUrl :: RepoScheme -> Maybe Repo -> Text -> Text
+getPublicSubmissionUrl SelfHosted _ bareRepoName = gitServer ++ bareRepoName
+getPublicSubmissionUrl Branches (Just repo) _ = repoUrl repo
 
 getReadOnlySubmissionUrl :: Text -> Text
 getReadOnlySubmissionUrl bareRepoName = gitReadOnlyServer ++ bareRepoName