C2S: applyC: Implement the missing support for patching Git repos

This commit is contained in:
fr33domlover 2022-06-26 14:15:52 +00:00
parent 8186e64a26
commit b18c0cb255

View file

@ -112,6 +112,7 @@ import Vervis.ActorKey
import Vervis.Darcs
import Vervis.FedURI
import Vervis.Foundation
import Vervis.Git
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Role
@ -372,7 +373,7 @@ applyC (Entity pidUser personUser) sharerUser summary audience muCap (Apply uObj
mapplied <- case target of
Right _u -> return Nothing
Left (shrTarget, rpTarget, mb) -> Just <$> do
Left (shrTarget, rpTarget, mbranch) -> Just <$> do
-- Find the target repo in DB
mrepo <- lift $ runDB $ runMaybeT $ do
@ -496,8 +497,13 @@ applyC (Entity pidUser personUser) sharerUser summary audience muCap (Apply uObj
-- Apply patches
case repoVcs repoTarget of
VCSGit -> error "Patching a Git repo unsupported yet"
VCSGit -> do
branch <- fromMaybeE mbranch "Apply target is a Git repo, but branch not specified"
unless (all ((== PatchMediaTypeGit) . fst) patches) $
throwE "Trying to apply non-Git patch to a Git repo"
applyGitPatches shrTarget rpTarget branch $ NE.map snd patches
VCSDarcs -> do
verifyNothingE mbranch "Apply target is a branch of a Darcs repo"
patch <-
case patches of
_ :| (_ : _) -> throwE "Darcs repo given multiple patch bundles"