gonito/Handler/MakePublic.hs

61 lines
2.2 KiB
Haskell
Raw Normal View History

2016-02-15 11:43:47 +01:00
module Handler.MakePublic where
import Import
import Handler.Shared
import PersistSHA1
import Data.Text as T
2018-06-05 08:22:51 +02:00
import Handler.Runner
2016-02-15 11:43:47 +01:00
getMakePublicR :: SubmissionId -> Handler TypedContent
getMakePublicR submissionId = do
userId <- requireAuthId
runViewProgress $ doMakePublic userId submissionId
2016-02-15 11:43:47 +01:00
doMakePublic :: UserId -> SubmissionId -> Channel -> Handler ()
doMakePublic userId submissionId chan = do
isOwner <- checkWhetherGivenUserRepo userId submissionId
2016-02-15 11:43:47 +01:00
if not isOwner
then
err chan "Only the submitter can make a submission public!"
else do
msg chan "Making the submission public..."
runDB $ update submissionId [SubmissionIsPublic =. True]
submission <- runDB $ get404 submissionId
challenge <- runDB $ get404 $ submissionChallenge submission
2018-06-06 13:08:38 +02:00
repo <- runDB $ get404 $ challengePublicRepo challenge
2016-02-15 11:43:47 +01:00
let submissionRepoId = submissionRepo submission
submissionRepoDir <- getRepoDir submissionRepoId
2018-06-06 13:08:38 +02:00
app <- getYesod
let scheme = appRepoScheme $ appSettings app
2019-12-07 22:48:58 +01:00
let repoHost = appRepoHost $ appSettings app
2018-06-06 13:08:38 +02:00
2019-12-07 22:48:58 +01:00
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 ++ " ..."
2016-02-15 11:43:47 +01:00
let commit = submissionCommit submission
pushRepo submissionRepoDir commit (T.unpack $ targetRepoUrl) (T.unpack $ targetBranchName) chan
2016-02-15 11:43:47 +01:00
return ()
pushRepo :: String -> SHA1 -> String -> String -> Channel -> Handler ()
pushRepo repoDir commit targetRepoUrl targetBranchName chan = do
(_, _) <- runProgram (Just repoDir) gitPath [
2016-02-15 11:43:47 +01:00
"push",
2019-12-07 23:17:12 +01:00
(T.unpack $ fixGitRepoUrl $ T.pack targetRepoUrl),
2016-02-15 11:43:47 +01:00
(T.unpack $ fromSHA1ToText commit) ++ ":refs/heads/" ++ targetBranchName] chan
return ()
checkWhetherUserRepo :: SubmissionId -> Handler Bool
checkWhetherUserRepo submissionId = do
userId <- requireAuthId
checkWhetherGivenUserRepo userId submissionId
checkWhetherGivenUserRepo :: UserId -> SubmissionId -> Handler Bool
checkWhetherGivenUserRepo userId submissionId = do
submission <- runDB $ get404 submissionId
2016-02-15 11:43:47 +01:00
return $ userId == submissionSubmitter submission