refactored cloning cntd.

This commit is contained in:
Filip Gralinski 2018-06-04 22:14:39 +02:00
parent ae389aa144
commit 06970317a7
3 changed files with 38 additions and 29 deletions

View File

@ -52,19 +52,23 @@ postCreateChallengeR = do
doCreateChallenge :: Text -> Text -> Text -> Text -> Text -> Channel -> Handler ()
doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do
maybePublicRepoId <- cloneRepo (RepoCloningSpec {
cloningSpecRepo = RepoSpec {
repoSpecUrl = publicUrl,
repoSpecBranch = publicBranch,
repoSpecReferenceUrl = publicUrl,
repoSpecReferenceBranch = publicBranch}) chan
repoSpecBranch = publicBranch },
cloningSpecReferenceRepo = RepoSpec {
repoSpecUrl = publicUrl,
repoSpecBranch = publicBranch}}) chan
case maybePublicRepoId of
Just publicRepoId -> do
publicRepo <- runDB $ get404 publicRepoId
publicRepoDir <- getRepoDir publicRepoId
maybePrivateRepoId <- cloneRepo (RepoCloningSpec {
cloningSpecRepo = RepoSpec {
repoSpecUrl = privateUrl,
repoSpecBranch = privateBranch,
repoSpecReferenceUrl =(T.pack $ publicRepoDir),
repoSpecReferenceBranch = (repoBranch publicRepo)}) chan
repoSpecBranch = privateBranch },
cloningSpecReferenceRepo = RepoSpec {
repoSpecUrl =(T.pack $ publicRepoDir),
repoSpecBranch = (repoBranch publicRepo)}}) chan
case maybePrivateRepoId of
Just privateRepoId -> addChallenge name publicRepoId privateRepoId chan
Nothing -> return ()

View File

@ -123,23 +123,25 @@ validGitProtocolsAsText :: Text
validGitProtocolsAsText = T.pack $ intercalate ", " $ map (++"://") validGitProtocols
data RepoCloningSpec = RepoCloningSpec {
repoSpecUrl :: Text,
repoSpecBranch :: Text,
cloningSpecRepo :: RepoSpec,
cloningSpecReferenceRepo :: RepoSpec
}
repoSpecReferenceUrl :: Text,
repoSpecReferenceBranch :: Text
data RepoSpec = RepoSpec {
repoSpecUrl :: Text,
repoSpecBranch :: Text
}
cloneRepo :: RepoCloningSpec -> Channel -> Handler (Maybe (Key Repo))
cloneRepo repoSpec chan = do
let url = repoSpecUrl repoSpec
let branch = repoSpecBranch repoSpec
cloneRepo repoCloningSpec chan = do
let url = repoSpecUrl $ cloningSpecRepo repoCloningSpec
let branch = repoSpecBranch $ cloningSpecRepo repoCloningSpec
maybeRepo <- runDB $ getBy $ UniqueUrlBranch url branch
case maybeRepo of
Just _ -> do
err chan "Repo already there"
return Nothing
Nothing -> cloneRepo' repoSpec chan
Nothing -> cloneRepo' repoCloningSpec chan
updateRepo :: Key Repo -> Channel -> Handler Bool
updateRepo repoId chan = do
@ -187,8 +189,8 @@ getLastCommitMessage repoDir chan = do
ExitFailure _ -> Nothing
cloneRepo' :: RepoCloningSpec -> Channel -> Handler (Maybe (Key Repo))
cloneRepo' repoSpec chan = do
let url = repoSpecUrl repoSpec
cloneRepo' repoCloningSpec chan = do
let url = repoSpecUrl $ cloningSpecRepo repoCloningSpec
msg chan $ concat ["Preparing to clone repo ", url]
if checkRepoUrl url
then do
@ -196,7 +198,7 @@ cloneRepo' repoSpec chan = do
r <- randomInt
arenaDir <- arena
let tmpRepoDir = arenaDir </> ("t" ++ show r)
exitCode <- rawClone tmpRepoDir repoSpec chan
exitCode <- rawClone tmpRepoDir repoCloningSpec chan
case exitCode of
ExitSuccess -> do
maybeHeadCommit <- getHeadCommit tmpRepoDir chan
@ -206,7 +208,7 @@ cloneRepo' repoSpec chan = do
time <- liftIO getCurrentTime
repoId <- runDB $ insert $ Repo {
repoUrl=url,
repoBranch=repoSpecBranch repoSpec,
repoBranch=repoSpecBranch $ cloningSpecRepo repoCloningSpec,
repoCurrentCommit=commitRaw,
repoOwner=userId,
repoReady=True,
@ -225,11 +227,11 @@ cloneRepo' repoSpec chan = do
return Nothing
rawClone :: FilePath -> RepoCloningSpec -> Channel -> Handler (ExitCode)
rawClone tmpRepoDir repoSpec chan = do
let url = repoSpecUrl repoSpec
let branch = repoSpecBranch repoSpec
let referenceUrl = repoSpecReferenceUrl repoSpec
let referenceBranch = repoSpecReferenceBranch repoSpec
rawClone tmpRepoDir repoCloningSpec chan = do
let url = repoSpecUrl $ cloningSpecRepo repoCloningSpec
let branch = repoSpecBranch $ cloningSpecRepo repoCloningSpec
let referenceUrl = repoSpecUrl $ cloningSpecReferenceRepo repoCloningSpec
let referenceBranch = repoSpecBranch $ cloningSpecReferenceRepo repoCloningSpec
(exitCode, _) <- runProgram Nothing gitPath ["clone",
"--progress",
"--branch",

View File

@ -334,10 +334,13 @@ getSubmissionRepo challengeId url branch chan = do
repo <- runDB $ get404 repoId
repoDir <- getRepoDir repoId
let repoSpec = RepoCloningSpec {
cloningSpecRepo = RepoSpec {
repoSpecUrl = url,
repoSpecBranch = branch,
repoSpecReferenceUrl = (T.pack repoDir),
repoSpecReferenceBranch = (repoBranch repo)
repoSpecBranch = branch },
cloningSpecReferenceRepo = RepoSpec {
repoSpecUrl = (T.pack repoDir),
repoSpecBranch = (repoBranch repo)
}
}
cloneRepo' repoSpec chan