diff --git a/Handler/CreateChallenge.hs b/Handler/CreateChallenge.hs index 4e0e070..319525e 100644 --- a/Handler/CreateChallenge.hs +++ b/Handler/CreateChallenge.hs @@ -51,12 +51,20 @@ postCreateChallengeR = do doCreateChallenge :: Text -> Text -> Text -> Text -> Text -> Channel -> Handler () doCreateChallenge name publicUrl publicBranch privateUrl privateBranch chan = do - maybePublicRepoId <- cloneRepo publicUrl publicBranch publicUrl publicBranch chan + maybePublicRepoId <- cloneRepo (RepoSpec { + repoSpecUrl = publicUrl, + repoSpecBranch = publicBranch, + repoSpecReferenceUrl = publicUrl, + repoSpecReferenceBranch = publicBranch}) chan case maybePublicRepoId of Just publicRepoId -> do publicRepo <- runDB $ get404 publicRepoId publicRepoDir <- getRepoDir publicRepoId - maybePrivateRepoId <- cloneRepo privateUrl privateBranch (T.pack $ publicRepoDir) (repoBranch publicRepo) chan + maybePrivateRepoId <- cloneRepo (RepoSpec { + repoSpecUrl = privateUrl, + repoSpecBranch = privateBranch, + repoSpecReferenceUrl =(T.pack $ publicRepoDir), + repoSpecReferenceBranch = (repoBranch publicRepo)}) chan case maybePrivateRepoId of Just privateRepoId -> addChallenge name publicRepoId privateRepoId chan Nothing -> return () diff --git a/Handler/Shared.hs b/Handler/Shared.hs index 5934229..a8bc8d2 100644 --- a/Handler/Shared.hs +++ b/Handler/Shared.hs @@ -122,14 +122,25 @@ validGitProtocols = ["git", "http", "https", "ssh"] validGitProtocolsAsText :: Text validGitProtocolsAsText = T.pack $ intercalate ", " $ map (++"://") validGitProtocols -cloneRepo :: Text -> Text -> Text -> Text -> Channel -> Handler (Maybe (Key Repo)) -cloneRepo url branch referenceUrl referenceBranch chan = do +data RepoSpec = RepoSpec { + repoSpecUrl :: Text, + repoSpecBranch :: Text, + + repoSpecReferenceUrl :: Text, + repoSpecReferenceBranch :: Text +} + + +cloneRepo :: RepoSpec -> Channel -> Handler (Maybe (Key Repo)) +cloneRepo repoSpec chan = do + let url = repoSpecUrl repoSpec + let branch = repoSpecBranch repoSpec maybeRepo <- runDB $ getBy $ UniqueUrlBranch url branch case maybeRepo of Just _ -> do err chan "Repo already there" return Nothing - Nothing -> cloneRepo' url branch referenceUrl referenceBranch chan + Nothing -> cloneRepo' repoSpec chan updateRepo :: Key Repo -> Channel -> Handler Bool updateRepo repoId chan = do @@ -176,8 +187,9 @@ getLastCommitMessage repoDir chan = do ExitSuccess -> Just out ExitFailure _ -> Nothing -cloneRepo' :: Text -> Text -> Text -> Text -> Channel -> Handler (Maybe (Key Repo)) -cloneRepo' url branch referenceUrl referenceBranch chan = do +cloneRepo' :: RepoSpec -> Channel -> Handler (Maybe (Key Repo)) +cloneRepo' repoSpec chan = do + let url = repoSpecUrl repoSpec msg chan $ concat ["Preparing to clone repo ", url] if checkRepoUrl url then do @@ -185,7 +197,7 @@ cloneRepo' url branch referenceUrl referenceBranch chan = do r <- randomInt arenaDir <- arena let tmpRepoDir = arenaDir ("t" ++ show r) - exitCode <- rawClone tmpRepoDir url branch referenceUrl referenceBranch chan + exitCode <- rawClone tmpRepoDir repoSpec chan case exitCode of ExitSuccess -> do maybeHeadCommit <- getHeadCommit tmpRepoDir chan @@ -195,7 +207,7 @@ cloneRepo' url branch referenceUrl referenceBranch chan = do time <- liftIO getCurrentTime repoId <- runDB $ insert $ Repo { repoUrl=url, - repoBranch=branch, + repoBranch=repoSpecBranch repoSpec, repoCurrentCommit=commitRaw, repoOwner=userId, repoReady=True, @@ -213,8 +225,12 @@ cloneRepo' url branch referenceUrl referenceBranch chan = do err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText] return Nothing -rawClone :: FilePath -> Text -> Text -> Text -> Text -> Channel -> Handler (ExitCode) -rawClone tmpRepoDir url branch referenceUrl referenceBranch chan = do +rawClone :: FilePath -> RepoSpec -> Channel -> Handler (ExitCode) +rawClone tmpRepoDir repoSpec chan = do + let url = repoSpecUrl repoSpec + let branch = repoSpecBranch repoSpec + let referenceUrl = repoSpecReferenceUrl repoSpec + let referenceBranch = repoSpecReferenceBranch repoSpec (exitCode, _) <- runProgram Nothing gitPath ["clone", "--progress", "--branch", diff --git a/Handler/ShowChallenge.hs b/Handler/ShowChallenge.hs index f3bfb79..e2efa7b 100644 --- a/Handler/ShowChallenge.hs +++ b/Handler/ShowChallenge.hs @@ -333,7 +333,13 @@ getSubmissionRepo challengeId url branch chan = do let repoId = challengePublicRepo challenge repo <- runDB $ get404 repoId repoDir <- getRepoDir repoId - cloneRepo' url branch (T.pack repoDir) (repoBranch repo) chan + let repoSpec = RepoSpec { + repoSpecUrl = url, + repoSpecBranch = branch, + repoSpecReferenceUrl = (T.pack repoDir), + repoSpecReferenceBranch = (repoBranch repo) + } + cloneRepo' repoSpec chan checkRepoAvailibility :: Key Challenge -> Key Repo -> Channel -> Handler Bool checkRepoAvailibility challengeId repoId chan = do