diff --git a/Handler/MakePublic.hs b/Handler/MakePublic.hs index 8e92b96..bac1fb2 100644 --- a/Handler/MakePublic.hs +++ b/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 [ diff --git a/Handler/Shared.hs b/Handler/Shared.hs index bdc0d27..2d0a356 100644 --- a/Handler/Shared.hs +++ b/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