From 219349e95a25fd6d50e61e66365212472e5df3d3 Mon Sep 17 00:00:00 2001 From: Filip Gralinski Date: Sat, 7 Dec 2019 22:48:58 +0100 Subject: [PATCH] Fix opening --- Handler/MakePublic.hs | 3 ++- Handler/Shared.hs | 6 +++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/Handler/MakePublic.hs b/Handler/MakePublic.hs index 8ca4457..e13e8fd 100644 --- a/Handler/MakePublic.hs +++ b/Handler/MakePublic.hs @@ -32,8 +32,9 @@ doMakePublic userId submissionId chan = do app <- getYesod let scheme = appRepoScheme $ appSettings app + let repoHost = appRepoHost $ appSettings app - let targetRepoUrl = getPublicSubmissionUrl scheme (Just repo) $ challengeName challenge + let targetRepoUrl = getPublicSubmissionUrl scheme repoHost (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 diff --git a/Handler/Shared.hs b/Handler/Shared.hs index 03a9268..992afa2 100644 --- a/Handler/Shared.hs +++ b/Handler/Shared.hs @@ -70,9 +70,9 @@ gitReadOnlyServer = "git://" ++ serverAddress ++ "/" getPublicSubmissionBranch :: SubmissionId -> Text getPublicSubmissionBranch = T.pack . (printf "submission-%05d") . fromSqlKey -getPublicSubmissionUrl :: RepoScheme -> Maybe Repo -> Text -> Text -getPublicSubmissionUrl SelfHosted _ bareRepoName = gitServer ++ bareRepoName -getPublicSubmissionUrl Branches (Just repo) _ = repoUrl repo +getPublicSubmissionUrl :: RepoScheme -> Text -> Maybe Repo -> Text -> Text +getPublicSubmissionUrl SelfHosted repoHost _ bareRepoName = repoHost ++ bareRepoName +getPublicSubmissionUrl Branches _ (Just repo) _ = repoUrl repo getReadOnlySubmissionUrl :: RepoScheme -> Repo -> Text -> Text getReadOnlySubmissionUrl SelfHosted _ bareRepoName = gitReadOnlyServer ++ bareRepoName