sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 02:14:51 +09:00
Code Issues Activity

C2S: offerTicketC: Add VCS-type and patch-type consistency checks

Browse source
This commit is contained in:
fr33domlover 2022-09-21 17:45:38 +00:00
parent 23b5343ec2
commit e7ab9e701c
1 changed files with 48 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
src/Vervis/API.hs
View file

@ -2572,18 +2572,56 @@ offerTicketC (Entity senderPersonID senderPerson) senderActor summary audience t
unless (repoLoom targetRepo == Just loomID) $
throwE "Offer target loom doesn't have repo's consent to serve it"
for_ (justThere originOrBundle) $ \ (Material typ diffs) -> do
unless (repoVcs targetRepo == patchMediaTypeVCS typ) $
throwE "Patch type and local target repo VCS mismatch"
case (typ, diffs) of
(PatchMediaTypeDarcs, _ :| _ : _) ->
throwE "More than one Darcs dpatch file provided"
_ -> pure ()
originOrBundle' <-
bitraverse
(bitraverse
(\ (repoID, maybeBranch) -> do
repo <- getE repoID "MR origin local repo not found in DB"
return (repoID, repoVcs repo, maybeBranch)
)
pure
(\ origin -> do
(vcs, origin') <-
case origin of
Left (repoID, maybeBranch) -> do
repo <- getE repoID "MR origin local repo not found in DB"
return (repoVcs repo, Left (repoID, maybeBranch))
Right (vcs, remoteActorID, maybeBranch) ->
pure (vcs, Right (remoteActorID, maybeBranch))
unless (vcs == repoVcs targetRepo) $
throwE "Origin repo VCS differs from target repo VCS"
return origin'
)
pure
originOrBundle
-- Verify that the VCS of target repo, origin repo and patches
-- all match, and that branches are specified for Git and
-- aren't specified for Darcs
_ <- case repoVcs targetRepo of
VCSGit -> do
targetBranch <- fromMaybeE maybeTargetBranch "Local target repo is Git but no target branch specified"
maybeOrigin <- for (justHere originOrBundle') $ \case
Left (originRepoID, maybeOriginBranch) -> do
originBranch <- fromMaybeE maybeOriginBranch "Local origin repo is Git but no origin branch specified"
return (Left originRepoID, originBranch)
Right (remoteActorID, maybeOriginBranch) -> do
(_maybeURI, originBranch) <- fromMaybeE maybeOriginBranch "Remote origin repo is Git but no origin branch specified"
return (Right remoteActorID, originBranch)
return $ Left (targetBranch, maybeOrigin)
VCSDarcs -> do
verifyNothingE maybeTargetBranch "Local target repo is Darcs but target branch specified"
maybeOriginRepo <- for (justHere originOrBundle') $ \case
Left (originRepoID, maybeOriginBranch) -> do
verifyNothingE maybeOriginBranch "Local origin repo is Darcs but origin branch specified"
return $ Left originRepoID
Right (remoteActorID, maybeOriginBranch) -> do
verifyNothingE maybeOriginBranch "Remote origin repo is Darcs but origin branch specified"
return $ Right remoteActorID
return $ Right $ maybeOriginRepo
return (loomID, loomActor loom, originOrBundle', targetRepoID, maybeTargetBranch)
)
@ -2712,9 +2750,6 @@ offerTicketC (Entity senderPersonID senderPerson) senderActor summary audience t
return offerID
--unless (repoVcs r == patchMediaTypeVCS typ) $
-- throwE "Patch type and repo VCS mismatch"
where
fetchRepoE h lu = do
@ -2823,17 +2858,17 @@ offerTicketC (Entity senderPersonID senderPerson) senderActor summary audience t
-> Maybe Text
-> These
(Either
(RepoId, VersionControlSystem, Maybe Text)
(VersionControlSystem, RemoteActorId, Maybe (Maybe LocalURI, Text))
(RepoId, Maybe Text)
(RemoteActorId, Maybe (Maybe LocalURI, Text))
)
Material
-> AppDB (Route App)
insertMerge now loomID ticketID maybeBranch originOrBundle = do
clothID <- insert $ TicketLoom ticketID loomID maybeBranch
for_ (justHere originOrBundle) $ \case
Left (repoID, _, maybeOriginBranch) ->
Left (repoID, maybeOriginBranch) ->
insert_ $ MergeOriginLocal clothID repoID maybeOriginBranch
Right (_, remoteActorID, maybeOriginBranch) -> do
Right (remoteActorID, maybeOriginBranch) -> do
originID <- insert $ MergeOriginRemote clothID remoteActorID
for_ maybeOriginBranch $ \ (mlu, b) ->
insert_ $ MergeOriginRemoteBranch originID mlu b