filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

rename dir to final dir

Browse Source
This commit is contained in:
Filip Gralinski 2015-09-04 10:51:53 +02:00
parent c1ed05edf0
commit 3dfec2d6f4
1 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Handler/Shared.hs
View File

@ -11,7 +11,7 @@ import qualified Data.IntMap as IntMap
import Network.URI import Network.URI
import qualified Data.Text as T import qualified Data.Text as T
import Database.Persist.Sql (ConnectionPool, runSqlPool) import Database.Persist.Sql (ConnectionPool, runSqlPool, fromSqlKey)
import Control.Concurrent.Lifted (fork, threadDelay) import Control.Concurrent.Lifted (fork, threadDelay)
@ -19,6 +19,8 @@ import System.Process
import System.Exit import System.Exit
import System.Random import System.Random
import System.Directory (renameDirectory)
import PersistSHA1 import PersistSHA1
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
@ -86,16 +88,16 @@ cloneRepo url branch chan = do
then do then do
msg chan "Cloning..." msg chan "Cloning..."
r <- randomInt r <- randomInt
let repoDir = arena </> ("t" ++ show r) let tmpRepoDir = arena </> ("t" ++ show r)
(exitCode, _) <- runProgram Nothing gitPath ["clone", (exitCode, _) <- runProgram Nothing gitPath ["clone",
"--progress", "--progress",
"--branch", "--branch",
T.unpack branch, T.unpack branch,
T.unpack url, T.unpack url,
repoDir] chan tmpRepoDir] chan
case exitCode of case exitCode of
ExitSuccess -> do ExitSuccess -> do
(exitCode, out) <- runProgram (Just repoDir) gitPath ["rev-parse", "HEAD"] chan (exitCode, out) <- runProgram (Just tmpRepoDir) gitPath ["rev-parse", "HEAD"] chan
case exitCode of case exitCode of
ExitSuccess -> do ExitSuccess -> do
msg chan $ concat ["HEAD commit is ", commitId] msg chan $ concat ["HEAD commit is ", commitId]
@ -108,6 +110,9 @@ cloneRepo url branch chan = do
repoOwner=userId, repoOwner=userId,
repoReady=True, repoReady=True,
repoStamp=time } repoStamp=time }
let repoDir = getRepoDir repoId
liftIO $ renameDirectory tmpRepoDir repoDir
msg chan $ concat ["Repo is in ", (T.pack repoDir)]
return $ Just repoId return $ Just repoId
where commitId = T.replace "\n" "" out where commitId = T.replace "\n" "" out
commitRaw = fromTextToSHA1 commitId commitRaw = fromTextToSHA1 commitId
@ -121,6 +126,10 @@ cloneRepo url branch chan = do
err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText] err chan $ concat ["Wrong URL to a Git repo (note that one of the following protocols must be specified: ", validGitProtocolsAsText]
return Nothing return Nothing
getRepoDir :: Key Repo -> FilePath
getRepoDir repoId = arena </> repoIdAsString
where repoIdAsString = show $ fromSqlKey repoId
checkRepoUrl :: Text -> Bool checkRepoUrl :: Text -> Bool
checkRepoUrl url = case parsedURI of checkRepoUrl url = case parsedURI of
Just uri -> (uriScheme uri) `elem` (map (++":") validGitProtocols) Just uri -> (uriScheme uri) `elem` (map (++":") validGitProtocols)