s464900/gonito
1
0
Fork 0
forked from filipg/gonito
Code Issues Pull Requests Projects Releases Wiki Activity

refactored cloning cntd.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Handler/CreateChallenge.hs
View File

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

36
Handler/Shared.hs
View File

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

11
Handler/ShowChallenge.hs
View File

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