diff --git a/Handler/Query.hs b/Handler/Query.hs index 237b30c..87d6120 100644 --- a/Handler/Query.hs +++ b/Handler/Query.hs @@ -756,6 +756,25 @@ submissionHeader :: Maybe UserId -> Diff (FullSubmissionInfo, Maybe Text) -> Wid submissionHeader mUserId param = do showFullInfo <- handlerToWidget $ runDB $ canFullInfoBeShown param mUserId + app <- getYesod + let repoHost = appRepoHost $ appSettings app + let submissionToSubmissionUrl submission' + = getReadOnlySubmissionUrl (fsiScheme submission') + repoHost + (fsiChallengeRepo submission') + (challengeName $ fsiChallenge submission') + let publicSubmissionRepo = submissionToSubmissionUrl <$> submission + + let submissionToBrowsableUrl submission' + = browsableGitRepoBranch (fsiScheme submission') + repoHost + (fsiChallengeRepo submission') + (challengeName $ fsiChallenge submission') + (getPublicSubmissionBranch $ fsiSubmissionId submission') + + let browsableUrl = submissionToBrowsableUrl <$> submission + + $(widgetFile "submission-header") where variantSettings = ("out", ()) submission = fst <$> param @@ -763,12 +782,8 @@ submissionHeader mUserId param = do commitSha1AsText = fromSHA1ToText <$> submissionCommit <$> fsiSubmission <$> submission submitter = formatSubmitter <$> fsiUser <$> submission publicSubmissionBranch = getPublicSubmissionBranch <$> fsiSubmissionId <$> submission - publicSubmissionRepo = submissionToSubmissionUrl <$> submission - browsableUrl = submissionToBrowsableUrl <$> submission stamp = T.pack <$> show <$> submissionStamp <$> fsiSubmission <$> submission - submissionToSubmissionUrl submission' = getReadOnlySubmissionUrl (fsiScheme submission') (fsiChallengeRepo submission') $ challengeName $ fsiChallenge submission' - submissionToBrowsableUrl submission' = browsableGitRepoBranch (fsiScheme submission') (fsiChallengeRepo submission') (challengeName $ fsiChallenge submission') (getPublicSubmissionBranch $ fsiSubmissionId submission') queryResult :: Maybe UserId -> FullSubmissionInfo -> WidgetFor App () queryResult mUserId submission = do diff --git a/Handler/Shared.hs b/Handler/Shared.hs index e1f2091..4348905 100644 --- a/Handler/Shared.hs +++ b/Handler/Shared.hs @@ -80,15 +80,22 @@ getPublicSubmissionUrl SelfHosted repoHost _ bareRepoName = repoHost ++ bareRepo getPublicSubmissionUrl Branches _ (Just repo) _ = repoUrl repo getPublicSubmissionUrl NoInternalGitServer repoHost _ bareRepoName = repoHost ++ bareRepoName -getReadOnlySubmissionUrl :: RepoScheme -> Repo -> Text -> Text -getReadOnlySubmissionUrl SelfHosted _ bareRepoName = gitReadOnlyServer ++ bareRepoName -getReadOnlySubmissionUrl Branches repo _ = repoUrl repo -getReadOnlySubmissionUrl NoInternalGitServer repo _ = repoUrl repo +-- convert a git URL to a publicly available URL +publicRepoUrl :: Text -> Text +publicRepoUrl = T.replace "git@github.com:" "https://github.com/" + . T.replace "git@gitlab.com:" "https://gitlab.com/" -browsableGitRepoBranch :: RepoScheme -> Repo -> Text -> Text -> Text -browsableGitRepoBranch SelfHosted _ bareRepoName branch = (browsableGitRepo bareRepoName) ++ "/" ++ branch ++ "/" -browsableGitRepoBranch Branches repo _ branch = sshToHttps (repoUrl repo) branch -browsableGitRepoBranch NoInternalGitServer repo _ branch = sshToHttps (repoUrl repo) branch +getReadOnlySubmissionUrl :: RepoScheme -> Text -> Repo -> Text -> Text +getReadOnlySubmissionUrl SelfHosted _ _ bareRepoName = gitReadOnlyServer ++ bareRepoName +getReadOnlySubmissionUrl Branches _ repo _ = repoUrl repo +getReadOnlySubmissionUrl NoInternalGitServer repoHost _ bareRepoName = publicRepoUrl (repoHost ++ bareRepoName) + +browsableGitRepoBranch :: RepoScheme -> Text -> Repo -> Text -> Text -> Text +browsableGitRepoBranch SelfHosted _ _ bareRepoName branch = (browsableGitRepo bareRepoName) ++ "/" ++ branch ++ "/" +browsableGitRepoBranch Branches _ repo _ branch = sshToHttps (repoUrl repo) branch +browsableGitRepoBranch NoInternalGitServer repoHost repo _ branch + = sshToHttps (getPublicSubmissionUrl NoInternalGitServer repoHost (Just repo) branch) + branch sshToHttps :: Text -> Text -> Text sshToHttps url branch = "https://" ++ (T.replace ".git" "" $ T.replace ":" "/" $ T.replace "ssh://" "" $ T.replace "git@" "" url) ++ "/tree/" ++ branch diff --git a/Handler/Tables.hs b/Handler/Tables.hs index 0e39eb3..1513874 100644 --- a/Handler/Tables.hs +++ b/Handler/Tables.hs @@ -287,16 +287,21 @@ statusCellWidget :: Text -> RepoScheme -> Repo -> (SubmissionId, Submission, Var statusCellWidget challengeName repoScheme challengeRepo (submissionId, submission, variantId, _, mauthId) = do isReevaluable <- handlerToWidget $ runDB $ canBeReevaluated submissionId let isVisible = True + + app <- getYesod + let repoHost = appRepoHost $ appSettings app + + let maybeBrowsableUrl = if isPublic + then + Just $ browsableGitRepoBranch repoScheme repoHost challengeRepo challengeName publicSubmissionBranch + else + Nothing + $(widgetFile "submission-status") where commitHash = fromSHA1ToText $ submissionCommit submission isPublic = submissionIsPublic submission isOwner = (mauthId == Just (submissionSubmitter submission)) publicSubmissionBranch = getPublicSubmissionBranch submissionId - maybeBrowsableUrl = if isPublic - then - Just $ browsableGitRepoBranch repoScheme challengeRepo challengeName publicSubmissionBranch - else - Nothing getInfoLink :: Submission -> Maybe UserId -> Maybe (Route App) getInfoLink submission _ = Just $ QueryResultsR commitHash