Handle switching to the right commit

(Though not robust)
This commit is contained in:
Filip Gralinski 2019-12-14 11:17:12 +01:00
parent 120c87e44a
commit 12fd6a1c58
2 changed files with 27 additions and 1 deletions

View File

@ -6,6 +6,8 @@ import Handler.Common
import Handler.Runner import Handler.Runner
import Handler.Shared import Handler.Shared
import qualified Data.Text as T
canBeReevaluated :: (YesodAuthPersist (HandlerSite m), MonadHandler m, PersistUniqueRead backend, AuthEntity (HandlerSite m) ~ User, AuthId (HandlerSite m) ~ Key User, BaseBackend backend ~ SqlBackend) => Key Submission -> ReaderT backend m Bool canBeReevaluated :: (YesodAuthPersist (HandlerSite m), MonadHandler m, PersistUniqueRead backend, AuthEntity (HandlerSite m) ~ User, AuthId (HandlerSite m) ~ Key User, BaseBackend backend ~ SqlBackend) => Key Submission -> ReaderT backend m Bool
canBeReevaluated submissionId = do canBeReevaluated submissionId = do
maybeUser <- maybeAuth maybeUser <- maybeAuth
@ -45,6 +47,12 @@ doReevaluateSubmission submissionId chan = do
status <- runDB $ canBeReevaluated submissionId status <- runDB $ canBeReevaluated submissionId
if status if status
then then
msg chan "Will re-evaluate!" do
mRepoDir <- getSubmissionRepoDir submissionId chan
case mRepoDir of
Just repoDir -> do
msg chan ("Will evaluate in " ++ (T.pack repoDir))
Nothing -> do
err chan "Something went wrong, won't evaluate"
else else
msg chan "Won't re-evaluate!" msg chan "Won't re-evaluate!"

View File

@ -165,6 +165,24 @@ updateRepo repoId chan = do
Nothing -> return False Nothing -> return False
_ -> return False _ -> return False
-- | Get a directionary with a submission.
-- It may reset a git repository which might be risky if a repository
-- is shared among a number of submissions.
getSubmissionRepoDir :: SubmissionId -> Channel -> Handler (Maybe FilePath)
getSubmissionRepoDir submissionId chan = do
submission <- runDB $ get404 submissionId
repoDir <- getRepoDir $ submissionRepo submission
let sha1Code = submissionCommit submission
-- this is not right... it should be fixed in the future
-- 1. All kinds of mayhem may ensue in case of concurrency
-- 2. ... especially if the repository is shared among a number of submissions
-- 3. The commit might not be actually there (it might have been garbage collected).
(exitCode, _) <- runProgram (Just repoDir) gitPath ["reset", "--hard", T.unpack $ fromSHA1ToText sha1Code] chan
case exitCode of
ExitSuccess -> return (Just repoDir)
ExitFailure _ -> return Nothing
getHeadCommit :: FilePath -> Channel -> Handler (Maybe SHA1) getHeadCommit :: FilePath -> Channel -> Handler (Maybe SHA1)
getHeadCommit repoDir chan = do getHeadCommit repoDir chan = do
(exitCode, out) <- runProgram (Just repoDir) gitPath ["rev-parse", "HEAD"] chan (exitCode, out) <- runProgram (Just repoDir) gitPath ["rev-parse", "HEAD"] chan