NOTE: Federation is disabled on this instance!
You can test federation between the following instances:forge.angeley.es
code.angeley.es
By | fr33domlover |
At | 2020-08-13 |
Title | S2S & C2S: Switch from single-patch MR version to multi-patch bundle support |
Description |
Edit file config/models 0 → 0
+ | 453 | Bundle |
|
+ | 454 | ticket TicketId |
|
+ | 455 | ||
- | 457 | ticket TicketId |
|
+ | 460 | bundle BundleId |
|
… | … | … | … |
Edit file config/routes 0 → 0
- | 113 | /s/#ShrIdent/r/#RpIdent/pt RepoPatchesR GET |
|
- | 114 | ||
- | 115 | /s/#ShrIdent/r/#RpIdent/pt/#LocalTicketKeyHashid RepoPatchR GET |
|
- | 116 | /s/#ShrIdent/r/#RpIdent/pt/#LocalTicketKeyHashid/d RepoPatchDiscussionR GET |
|
- | 117 | /s/#ShrIdent/r/#RpIdent/pt/#LocalTicketKeyHashid/deps RepoPatchDepsR GET |
|
- | 118 | /s/#ShrIdent/r/#RpIdent/pt/#LocalTicketKeyHashid/rdeps RepoPatchReverseDepsR GET |
|
- | 119 | /s/#ShrIdent/r/#RpIdent/pt/#LocalTicketKeyHashid/followers RepoPatchFollowersR GET |
|
- | 120 | /s/#ShrIdent/r/#RpIdent/pt/#LocalTicketKeyHashid/events RepoPatchEventsR GET |
|
- | 121 | ||
- | 122 | /s/#ShrIdent/r/#RpIdent/pt/#LocalTicketKeyHashid/v/#PatchKeyHashid RepoPatchVersionR GET |
|
+ | 113 | /s/#ShrIdent/r/#RpIdent/mr RepoProposalsR GET |
|
+ | 114 | ||
+ | 115 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid RepoProposalR GET |
|
+ | 116 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid/d RepoProposalDiscussionR GET |
|
+ | 117 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid/deps RepoProposalDepsR GET |
|
+ | 118 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid/rdeps RepoProposalReverseDepsR GET |
|
+ | 119 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid/followers RepoProposalFollowersR GET |
|
+ | 120 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid/events RepoProposalEventsR GET |
|
+ | 121 | ||
+ | 122 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid/b/#BundleKeyHashid RepoProposalBundleR GET |
|
+ | 123 | /s/#ShrIdent/r/#RpIdent/mr/#LocalTicketKeyHashid/b/#BundleKeyHashid/pt/#PatchKeyHashid RepoProposalBundlePatchR GET |
|
… | … | … | … |
- | 207 | /s/#ShrIdent/pt SharerPatchesR GET |
|
- | 208 | ||
- | 209 | /s/#ShrIdent/pt/#TicketAuthorLocalKeyHashid SharerPatchR GET |
|
- | 210 | /s/#ShrIdent/pt/#TicketAuthorLocalKeyHashid/d SharerPatchDiscussionR GET |
|
- | 211 | /s/#ShrIdent/pt/#TicketAuthorLocalKeyHashid/deps SharerPatchDepsR GET |
|
- | 212 | /s/#ShrIdent/pt/#TicketAuthorLocalKeyHashid/rdeps SharerPatchReverseDepsR GET |
|
- | 213 | /s/#ShrIdent/pt/#TicketAuthorLocalKeyHashid/followers SharerPatchFollowersR GET |
|
- | 214 | /s/#ShrIdent/pt/#TicketAuthorLocalKeyHashid/events SharerPatchEventsR GET |
|
- | 215 | ||
- | 216 | /s/#ShrIdent/pt/#TicketAuthorLocalKeyHashid/v/#PatchKeyHashid SharerPatchVersionR GET |
|
+ | 208 | /s/#ShrIdent/mr SharerProposalsR GET |
|
+ | 209 | ||
+ | 210 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid SharerProposalR GET |
|
+ | 211 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid/d SharerProposalDiscussionR GET |
|
+ | 212 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid/deps SharerProposalDepsR GET |
|
+ | 213 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid/rdeps SharerProposalReverseDepsR GET |
|
+ | 214 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid/followers SharerProposalFollowersR GET |
|
+ | 215 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid/events SharerProposalEventsR GET |
|
+ | 216 | ||
+ | 217 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid/b/#BundleKeyHashid SharerProposalBundleR GET |
|
+ | 218 | /s/#ShrIdent/mr/#TicketAuthorLocalKeyHashid/b/#BundleKeyHashid/pt/#PatchKeyHashid SharerProposalBundlePatchR GET |
|
… | … | … | … |
Add file migrations/2020_08_10_bundle.model 0
Edit file migrations/2020_08_10_bundle.model 0 → 0
+ | 1 | Bundle |
|
+ | 2 | ticket TicketId |
|
… | … | … | … |
Add file migrations/2020_08_10_bundle_mig.model 0
Edit file migrations/2020_08_10_bundle_mig.model 0 → 0
+ | 1 | Person |
|
+ | 2 | ||
+ | 3 | Ticket |
|
+ | 4 | number Int Maybe |
|
+ | 5 | created UTCTime |
|
+ | 6 | title Text -- HTML |
|
+ | 7 | source Text -- Pandoc Markdown |
|
+ | 8 | description Text -- HTML |
|
+ | 9 | assignee PersonId Maybe |
|
+ | 10 | status Text |
|
+ | 11 | ||
+ | 12 | Bundle |
|
+ | 13 | ticket TicketId |
|
+ | 14 | ||
+ | 15 | Patch |
|
+ | 16 | ticket TicketId |
|
+ | 17 | bundle BundleId |
|
+ | 18 | created UTCTime |
|
+ | 19 | content Text |
|
… | … | … | … |
Edit file src/Vervis/API.hs 0 → 0
- | 210 | in [ -- LocalPersonCollectionSharerPatchTeam shr talkhid |
|
- | 211 | LocalPersonCollectionSharerPatchFollowers shr talkhid |
|
+ | 210 | in [ -- LocalPersonCollectionSharerProposalTeam shr talkhid |
|
+ | 211 | LocalPersonCollectionSharerProposalFollowers shr talkhid |
|
- | 218 | NoteContextRepoPatch shr rp ltid -> |
|
+ | 218 | NoteContextRepoProposal shr rp ltid -> |
|
- | 220 | in [ -- LocalPersonCollectionRepoPatchTeam shr rp ltkhid |
|
- | 221 | LocalPersonCollectionRepoPatchFollowers shr rp ltkhid |
|
+ | 220 | in [ -- LocalPersonCollectionRepoProposalTeam shr rp ltkhid |
|
+ | 221 | LocalPersonCollectionRepoProposalFollowers shr rp ltkhid |
|
… | … | … | … |
- | 254 | SharerPatchR shr talkhid -> |
|
+ | 254 | SharerProposalR shr talkhid -> |
|
- | 264 | RepoPatchR shr rp ltkhid -> |
|
- | 265 | NoteContextRepoPatch shr rp <$> |
|
+ | 264 | RepoProposalR shr rp ltkhid -> |
|
+ | 265 | NoteContextRepoProposal shr rp <$> |
|
… | … | … | … |
- | 332 | verifyContextRecip (Left (NoteContextRepoPatch shr rp _)) localRecips _ = |
|
+ | 332 | verifyContextRecip (Left (NoteContextRepoProposal shr rp _)) localRecips _ = |
|
… | … | … | … |
- | 363 | mticket <- lift $ getSharerPatch shr talid |
|
+ | 363 | mticket <- lift $ getSharerProposal shr talid |
|
… | … | … | … |
- | 375 | NoteContextRepoPatch shr rp ltid -> do |
|
+ | 375 | NoteContextRepoProposal shr rp ltid -> do |
|
- | 377 | mticket <- lift $ getRepoPatch shr rp ltid |
|
+ | 377 | mticket <- lift $ getRepoProposal shr rp ltid |
|
… | … | … | … |
- | 494 | verifyProjectRecip (Left (WTTProject shr prj)) localRecips = |
|
+ | 494 | verifyProjectRecip (Left (WITProject shr prj)) localRecips = |
|
- | 501 | verifyProjectRecip (Left (WTTRepo shr rp _ _ _)) localRecips = |
|
+ | 501 | verifyProjectRecip (Left (WITRepo shr rp _ _ _)) localRecips = |
|
… | … | … | … |
- | 533 | (talid, mptid) <- lift $ insertTicket now pidUser title desc source obiidCreate project |
|
- | 534 | docCreate <- lift $ insertCreateToOutbox shrUser blinded context title desc source now obiidCreate talid mptid |
|
+ | 533 | (talid, mbn) <- lift $ insertTicket now pidUser title desc source obiidCreate project |
|
+ | 534 | docCreate <- lift $ insertCreateToOutbox shrUser blinded context title desc source now obiidCreate talid mbn |
|
- | 538 | Left (WTTProject shr prj) -> |
|
+ | 538 | Left (WITProject shr prj) -> |
|
- | 546 | Left (WTTRepo shr rp _ _ _) -> |
|
+ | 546 | Left (WITRepo shr rp _ _ _) -> |
|
… | … | … | … |
- | 615 | , Maybe (Maybe LocalURI, PatchType, Text) |
|
+ | 615 | , Maybe (Maybe LocalURI, PatchType, NonEmpty Text) |
|
… | … | … | … |
- | 656 | ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, Text)) |
|
+ | 656 | ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, NonEmpty Text)) |
|
… | … | … | … |
- | 683 | , Text |
|
+ | 683 | , NonEmpty Text |
|
- | 685 | checkMR h (MergeRequest muOrigin luTarget epatch) = do |
|
+ | 685 | checkMR h (MergeRequest muOrigin luTarget ebundle) = do |
|
- | 688 | (typ, content) <- |
|
- | 689 | case epatch of |
|
- | 690 | Left _ -> throwE "MR patch specified as a URI" |
|
- | 691 | Right (hPatch, patch) -> checkPatch hPatch patch |
|
- | 692 | return (branch, typ, content) |
|
+ | 688 | (typ, diffs) <- |
|
+ | 689 | case ebundle of |
|
+ | 690 | Left _ -> throwE "MR bundle specified as a URI" |
|
+ | 691 | Right (hBundle, bundle) -> checkBundle hBundle bundle |
|
+ | 692 | return (branch, typ, diffs) |
|
… | … | … | … |
- | 715 | checkPatch |
|
- | 716 | :: Host |
|
- | 717 | -> AP.Patch URIMode |
|
- | 718 | -> ExceptT Text Handler |
|
- | 719 | ( PatchType |
|
- | 720 | , Text |
|
- | 721 | ) |
|
- | 722 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
- | 723 | encodeRouteLocal <- getEncodeRouteLocal |
|
- | 724 | verifyHostLocal h "Patch attributed to remote user" |
|
- | 725 | verifyNothingE mlocal "Patch with 'id'" |
|
- | 726 | unless (encodeRouteLocal (SharerR shr) == attrib) $ |
|
- | 727 | throwE "Ticket and Patch attrib mismatch" |
|
- | 728 | verifyNothingE mpub "Patch has 'published'" |
|
- | 729 | return (typ, content) |
|
+ | 715 | checkBundle _ (AP.BundleHosted _ _) = |
|
+ | 716 | throwE "Patches specified as URIs" |
|
+ | 717 | checkBundle h (AP.BundleOffer mlocal patches) = do |
|
+ | 718 | verifyNothingE mlocal "Bundle has 'id'" |
|
+ | 719 | (typ:|typs, diffs) <- NE.unzip <$> traverse (checkPatch h) patches |
|
+ | 720 | unless (all (== typ) typs) $ throwE "Different patch types" |
|
+ | 721 | return (typ, diffs) |
|
+ | 722 | where |
|
+ | 723 | checkPatch |
|
+ | 724 | :: Host |
|
+ | 725 | -> AP.Patch URIMode |
|
+ | 726 | -> ExceptT Text Handler |
|
+ | 727 | ( PatchType |
|
+ | 728 | , Text |
|
+ | 729 | ) |
|
+ | 730 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
+ | 731 | encodeRouteLocal <- getEncodeRouteLocal |
|
+ | 732 | verifyHostLocal h "Patch attributed to remote user" |
|
+ | 733 | verifyNothingE mlocal "Patch with 'id'" |
|
+ | 734 | unless (encodeRouteLocal (SharerR shr) == attrib) $ |
|
+ | 735 | throwE "Ticket and Patch attrib mismatch" |
|
+ | 736 | verifyNothingE mpub "Patch has 'published'" |
|
+ | 737 | return (typ, content) |
|
… | … | … | … |
- | 745 | , Text |
|
+ | 753 | , NonEmpty Text |
|
- | 752 | , Maybe (Maybe LocalURI, PatchType, Text) |
|
+ | 760 | , Maybe (Maybe LocalURI, PatchType, NonEmpty Text) |
|
- | 755 | matchContextAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WTTProject shr prj |
|
+ | 763 | matchContextAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WITProject shr prj |
|
- | 758 | matchContextAndMR (Left (Right (shr, rp))) (Just (branch, typ, content)) = do |
|
+ | 766 | matchContextAndMR (Left (Right (shr, rp))) (Just (branch, typ, diffs)) = do |
|
… | … | … | … |
- | 771 | return $ Left $ WTTRepo shr rp branch' vcs content |
|
+ | 779 | return $ Left $ WITRepo shr rp branch' vcs diffs |
|
- | 775 | matchContextAndMR (Right (ObjURI h lu)) (Just (branch, typ, content)) = do |
|
+ | 783 | matchContextAndMR (Right (ObjURI h lu)) (Just (branch, typ, diffs)) = do |
|
- | 780 | let patch = |
|
+ | 788 | let bundle = |
|
- | 783 | , content |
|
+ | 791 | , diffs |
|
- | 785 | return $ Right (h, lu, Just patch) |
|
+ | 793 | return $ Right (h, lu, Just bundle) |
|
- | 792 | (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, Text)) |
|
+ | 800 | (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, NonEmpty Text)) |
|
- | 799 | , Maybe (Maybe LocalURI, PatchType, Text) |
|
+ | 807 | , Maybe (Maybe LocalURI, PatchType, NonEmpty Text) |
|
- | 806 | checkTargetAndContext (Right (ObjURI hTarget luTarget)) (Right (hContext, luContext, mpatch)) = |
|
+ | 814 | checkTargetAndContext (Right (ObjURI hTarget luTarget)) (Right (hContext, luContext, mbundle)) = |
|
- | 808 | then return $ Right (hContext, luTarget, luContext, mpatch) |
|
+ | 816 | then return $ Right (hContext, luTarget, luContext, mbundle) |
|
- | 813 | (Left (shr, prj), WTTProject shr' prj') |
|
+ | 821 | (Left (shr, prj), WITProject shr' prj') |
|
- | 815 | (Right (shr, rp), WTTRepo shr' rp' _ _ _) |
|
+ | 823 | (Right (shr, rp), WITRepo shr' rp' _ _ _) |
|
- | 820 | fetchTracker (h, luTarget, luContext, mpatch) = do |
|
+ | 828 | fetchTracker (h, luTarget, luContext, mbundle) = do |
|
- | 830 | return (iid, era, if luTarget == luContext then Nothing else Just luContext, mpatch) |
|
- | 831 | ||
- | 832 | prepareProject now (Left (WTTProject shr prj)) = Left <$> do |
|
+ | 838 | return (iid, era, if luTarget == luContext then Nothing else Just luContext, mbundle) |
|
+ | 839 | ||
+ | 840 | prepareProject now (Left (WITProject shr prj)) = Left <$> do |
|
- | 839 | prepareProject now (Left (WTTRepo shr rp mb vcs diff)) = Left <$> do |
|
+ | 847 | prepareProject now (Left (WITRepo shr rp mb vcs diff)) = Left <$> do |
|
… | … | … | … |
- | 878 | mptid <- |
|
+ | 886 | mbn <- |
|
… | … | … | … |
- | 892 | Right (Entity rid _, mb, diff) -> Just <$> do |
|
+ | 900 | Right (Entity rid _, mb, diffs) -> Just <$> do |
|
- | 898 | insert $ Patch tid now diff |
|
- | 899 | Right (Entity raid _, mroid, mpatch) -> do |
|
+ | 906 | bnid <- insert $ Bundle tid |
|
+ | 907 | (bnid,) . toNE <$> |
|
+ | 908 | insertMany |
|
+ | 909 | (NE.toList $ NE.map (Patch bnid now) diffs) |
|
+ | 910 | Right (Entity raid _, mroid, mbundle) -> do |
|
- | 908 | for mpatch $ \ (_typ, diff) -> insert $ Patch tid now diff |
|
- | 909 | return (talid, mptid) |
|
- | 910 | ||
- | 911 | insertCreateToOutbox shrUser blinded context title desc source now obiidCreate talid mptid = do |
|
+ | 919 | for mbundle $ \ (_typ, diffs) -> do |
|
+ | 920 | bnid <- insert $ Bundle tid |
|
+ | 921 | (bnid,) . toNE <$> |
|
+ | 922 | insertMany |
|
+ | 923 | (NE.toList $ NE.map (Patch bnid now) diffs) |
|
+ | 924 | return (talid, mbn) |
|
+ | 925 | where |
|
+ | 926 | toNE = fromMaybe (error "No Patch IDs returned from DB") . NE.nonEmpty |
|
+ | 927 | ||
+ | 928 | insertCreateToOutbox shrUser blinded context title desc source now obiidCreate talid mbn = do |
|
- | 922 | mptkhid <- traverse encodeKeyHashid mptid |
|
+ | 939 | mkh <- for mbn $ \ (bnid, ptids) -> |
|
+ | 940 | (,) <$> encodeKeyHashid bnid |
|
+ | 941 | <*> traverse encodeKeyHashid ptids |
|
- | 930 | Left (WTTProject shr prj) -> |
|
+ | 949 | Left (WITProject shr prj) -> |
|
- | 933 | Left (WTTRepo shr rp mb vcs diff) -> |
|
+ | 952 | Left (WITRepo shr rp mb vcs diffs) -> |
|
+ | 954 | (bnkhid, ptkhids) = |
|
+ | 955 | case mkh of |
|
+ | 956 | Nothing -> error "mkh is Nothing" |
|
+ | 957 | Just v -> v |
|
+ | 958 | luBundle = |
|
+ | 959 | encodeRouteLocal $ |
|
+ | 960 | SharerProposalBundleR shrUser talkhid bnkhid |
|
+ | 961 | typ = |
|
+ | 962 | case vcs of |
|
+ | 963 | VCSDarcs -> PatchTypeDarcs |
|
+ | 964 | VCSGit -> error "createTicketC VCSGit" |
|
… | … | … | … |
- | 953 | , mrPatch = Right |
|
+ | 983 | , mrBundle = Right |
|
- | 955 | , AP.Patch |
|
- | 956 | { AP.patchLocal = Just |
|
+ | 985 | , AP.BundleOffer |
|
+ | 986 | (Just |
|
- | 958 | , PatchLocal |
|
- | 959 | { patchId = |
|
- | 960 | case mptkhid of |
|
- | 961 | Nothing -> error "mptkhid is Nothing" |
|
- | 962 | Just ptkhid -> |
|
+ | 988 | , BundleLocal |
|
+ | 989 | { bundleId = luBundle |
|
+ | 990 | , bundleContext = luTicket |
|
+ | 991 | , bundlePrevVersions = [] |
|
+ | 992 | , bundleCurrentVersion = Nothing |
|
+ | 993 | } |
|
+ | 994 | ) |
|
+ | 995 | ) |
|
+ | 996 | (NE.map |
|
+ | 997 | (\ (ptkhid, diff) -> AP.Patch |
|
+ | 998 | { AP.patchLocal = Just |
|
+ | 999 | ( hLocal |
|
+ | 1000 | , PatchLocal |
|
+ | 1001 | { patchId = |
|
- | 973 | SharerPatchVersionR shrUser talkhid ptkhid |
|
- | 974 | , patchContext = luTicket |
|
- | 975 | , patchPrevVersions = [] |
|
- | 976 | , patchCurrentVersion = Nothing |
|
+ | 1012 | SharerProposalBundlePatchR shrUser talkhid bnkhid ptkhid |
|
+ | 1013 | , patchContext = luBundle |
|
+ | 1014 | } |
|
+ | 1015 | ) |
|
+ | 1016 | , AP.patchAttributedTo = luAttrib |
|
+ | 1017 | , AP.patchPublished = Just now |
|
+ | 1018 | , AP.patchType = typ |
|
+ | 1019 | , AP.patchContent = diff |
|
- | 983 | , AP.patchAttributedTo = luAttrib |
|
- | 984 | , AP.patchPublished = Just now |
|
- | 985 | , AP.patchType = |
|
- | 986 | case vcs of |
|
- | 987 | VCSDarcs -> PatchTypeDarcs |
|
- | 988 | VCSGit -> error "createTicketC VCSGit" |
|
- | 989 | , AP.patchContent = diff |
|
- | 990 | } |
|
+ | 1026 | (NE.zip ptkhids diffs) |
|
+ | 1027 | ) |
|
- | 988 | Right (hContext, luTarget, luContext, mpatch) -> |
|
- | 989 | let mr (mluBranch, typ, diff) = MergeRequest |
|
- | 990 | { mrOrigin = Nothing |
|
- | 991 | , mrTarget = fromMaybe luContext mluBranch |
|
- | 992 | , mrPatch = Right |
|
- | 993 | ( hLocal |
|
- | 994 | , AP.Patch |
|
- | 995 | { AP.patchLocal = Just |
|
+ | 1025 | Right (hContext, luTarget, luContext, mbundle) -> |
|
+ | 1026 | let mr (mluBranch, typ, diffs) = |
|
+ | 1027 | let (bnkhid, ptkhids) = |
|
+ | 1028 | case mkh of |
|
+ | 1029 | Nothing -> error "mkh is Nothing" |
|
+ | 1030 | Just v -> v |
|
+ | 1031 | luBundle = |
|
+ | 1032 | encodeRouteLocal $ |
|
+ | 1033 | SharerProposalBundleR shrUser talkhid bnkhid |
|
+ | 1034 | in MergeRequest |
|
+ | 1035 | { mrOrigin = Nothing |
|
+ | 1036 | , mrTarget = fromMaybe luContext mluBranch |
|
+ | 1037 | , mrBundle = Right |
|
- | 1002 | , PatchLocal |
|
- | 1003 | { patchId = |
|
- | 1004 | case mptkhid of |
|
- | 1005 | Nothing -> error "mptkhid is Nothing" |
|
- | 1006 | Just ptkhid -> |
|
- | 1007 | encodeRouteLocal $ |
|
- | 1008 | SharerPatchVersionR shrUser talkhid ptkhid |
|
- | 1009 | , patchContext = luTicket |
|
- | 1010 | , patchPrevVersions = [] |
|
- | 1011 | , patchCurrentVersion = Nothing |
|
- | 1012 | } |
|
+ | 1044 | , AP.BundleOffer |
|
+ | 1045 | (Just |
|
+ | 1046 | ( hLocal |
|
+ | 1047 | , BundleLocal |
|
+ | 1048 | { bundleId = luBundle |
|
+ | 1049 | , bundleContext = luTicket |
|
+ | 1050 | , bundlePrevVersions = [] |
|
+ | 1051 | , bundleCurrentVersion = Nothing |
|
+ | 1052 | } |
|
+ | 1053 | ) |
|
+ | 1054 | ) |
|
+ | 1055 | (NE.map |
|
+ | 1056 | (\ (ptkhid, diff) -> AP.Patch |
|
+ | 1057 | { AP.patchLocal = Just |
|
+ | 1058 | ( hLocal |
|
+ | 1059 | , PatchLocal |
|
+ | 1060 | { patchId = |
|
+ | 1061 | encodeRouteLocal $ |
|
+ | 1062 | SharerProposalBundlePatchR shrUser talkhid bnkhid ptkhid |
|
+ | 1063 | , patchContext = luBundle |
|
+ | 1064 | } |
|
+ | 1065 | ) |
|
+ | 1066 | , AP.patchAttributedTo = luAttrib |
|
+ | 1067 | , AP.patchPublished = Just now |
|
+ | 1068 | , AP.patchType = typ |
|
+ | 1069 | , AP.patchContent = diff |
|
+ | 1070 | } |
|
+ | 1071 | ) |
|
+ | 1072 | (NE.zip ptkhids diffs) |
|
+ | 1073 | ) |
|
… | … | … | … |
- | 1033 | , AP.patchAttributedTo = luAttrib |
|
- | 1034 | , AP.patchPublished = Just now |
|
- | 1035 | , AP.patchType = typ |
|
- | 1036 | , AP.patchContent = diff |
|
- | 1034 | ) |
|
- | 1035 | } |
|
- | 1036 | , (hContext,) . mr <$> mpatch |
|
+ | 1091 | , (hContext,) . mr <$> mbundle |
|
… | … | … | … |
- | 1104 | | FolloweeSharerPatch ShrIdent (KeyHashid TicketAuthorLocal) |
|
+ | 1159 | | FolloweeSharerProposal ShrIdent (KeyHashid TicketAuthorLocal) |
|
- | 1108 | | FolloweeRepoPatch ShrIdent RpIdent (KeyHashid LocalTicket) |
|
+ | 1163 | | FolloweeRepoProposal ShrIdent RpIdent (KeyHashid LocalTicket) |
|
… | … | … | … |
- | 1167 | parseFollowee (SharerPatchR shr khid) = Just $ FolloweeSharerPatch shr khid |
|
+ | 1222 | parseFollowee (SharerProposalR shr khid) = Just $ FolloweeSharerProposal shr khid |
|
- | 1171 | parseFollowee (RepoPatchR shr rp khid) = Just $ FolloweeRepoPatch shr rp khid |
|
+ | 1226 | parseFollowee (RepoProposalR shr rp khid) = Just $ FolloweeRepoProposal shr rp khid |
|
- | 1176 | followeeActor (FolloweeSharerPatch shr _) = LocalActorSharer shr |
|
+ | 1231 | followeeActor (FolloweeSharerProposal shr _) = LocalActorSharer shr |
|
- | 1180 | followeeActor (FolloweeRepoPatch shr rp _) = LocalActorRepo shr rp |
|
+ | 1235 | followeeActor (FolloweeRepoProposal shr rp _) = LocalActorRepo shr rp |
|
… | … | … | … |
- | 1206 | getFollowee (FolloweeSharerPatch shr talkhid) = do |
|
+ | 1261 | getFollowee (FolloweeSharerProposal shr talkhid) = do |
|
- | 1210 | MaybeT $ getSharerPatch shr talid |
|
+ | 1265 | MaybeT $ getSharerProposal shr talid |
|
… | … | … | … |
- | 1233 | getFollowee (FolloweeRepoPatch shr rp ltkhid) = do |
|
+ | 1288 | getFollowee (FolloweeRepoProposal shr rp ltkhid) = do |
|
- | 1237 | MaybeT $ getRepoPatch shr rp ltid |
|
+ | 1292 | MaybeT $ getRepoProposal shr rp ltid |
|
… | … | … | … |
- | 1339 | Left (WTTProject shr prj) -> Just . Left <$> do |
|
+ | 1394 | Left (WITProject shr prj) -> Just . Left <$> do |
|
- | 1345 | Left (WTTRepo shr rp mb vcs diff) -> Just . Right <$> do |
|
+ | 1400 | Left (WITRepo shr rp mb vcs diffs) -> Just . Right <$> do |
|
- | 1352 | return (s, er, mb, diff) |
|
+ | 1407 | return (s, er, mb, diffs) |
|
- | 1358 | Left (WTTProject shr prj) -> |
|
+ | 1413 | Left (WITProject shr prj) -> |
|
- | 1366 | Left (WTTRepo shr rp _ _ _) -> |
|
+ | 1421 | Left (WITRepo shr rp _ _ _) -> |
|
… | … | … | … |
- | 1404 | Right (_, _, _, diff) -> insert_ $ Patch tid now diff |
|
+ | 1459 | Right (_, _, _, diffs) -> do |
|
+ | 1460 | bnid <- insert $ Bundle tid |
|
+ | 1461 | insertMany_ $ NE.toList $ NE.map (Patch bnid now) diffs |
|
… | … | … | … |
- | 1433 | ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, Text)) |
|
+ | 1490 | ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, NonEmpty Text)) |
|
… | … | … | … |
- | 1478 | checkMR h (MergeRequest muOrigin luTarget epatch) = do |
|
+ | 1535 | checkMR h (MergeRequest muOrigin luTarget ebundle) = do |
|
- | 1481 | (typ, content) <- |
|
- | 1482 | case epatch of |
|
- | 1483 | Left _ -> throwE "MR patch specified as a URI" |
|
- | 1484 | Right (hPatch, patch) -> checkPatch hPatch patch |
|
- | 1485 | return (branch, typ, content) |
|
+ | 1538 | (typ, diffs) <- |
|
+ | 1539 | case ebundle of |
|
+ | 1540 | Left _ -> throwE "MR bundle specified as a URI" |
|
+ | 1541 | Right (hBundle, bundle) -> checkBundle hBundle bundle |
|
+ | 1542 | return (branch, typ, diffs) |
|
… | … | … | … |
- | 1503 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
- | 1504 | verifyNothingE mlocal "Patch with 'id'" |
|
- | 1505 | hl <- hostIsLocal h |
|
- | 1506 | shrAttrib <- do |
|
- | 1507 | route <- fromMaybeE (decodeRouteLocal attrib) "Patch attrib not a valid route" |
|
- | 1508 | case route of |
|
- | 1509 | SharerR shr -> return shr |
|
- | 1510 | _ -> throwE "Patch attrib not a sharer route" |
|
- | 1511 | unless (hl && shrAttrib == shrUser) $ |
|
- | 1512 | throwE "Ticket and Patch attrib mismatch" |
|
- | 1513 | verifyNothingE mpub "Patch has 'published'" |
|
- | 1514 | return (typ, content) |
|
- | 1515 | matchTargetAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WTTProject shr prj |
|
+ | 1560 | checkBundle _ (AP.BundleHosted _ _) = |
|
+ | 1561 | throwE "Patches specified as URIs" |
|
+ | 1562 | checkBundle h (AP.BundleOffer mlocal patches) = do |
|
+ | 1563 | verifyNothingE mlocal "Bundle has 'id'" |
|
+ | 1564 | (typ:|typs, diffs) <- NE.unzip <$> traverse (checkPatch h) patches |
|
+ | 1565 | unless (all (== typ) typs) $ throwE "Different patch types" |
|
+ | 1566 | return (typ, diffs) |
|
+ | 1567 | where |
|
+ | 1568 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
+ | 1569 | verifyNothingE mlocal "Patch with 'id'" |
|
+ | 1570 | hl <- hostIsLocal h |
|
+ | 1571 | shrAttrib <- do |
|
+ | 1572 | route <- fromMaybeE (decodeRouteLocal attrib) "Patch attrib not a valid route" |
|
+ | 1573 | case route of |
|
+ | 1574 | SharerR shr -> return shr |
|
+ | 1575 | _ -> throwE "Patch attrib not a sharer route" |
|
+ | 1576 | unless (hl && shrAttrib == shrUser) $ |
|
+ | 1577 | throwE "Ticket and Patch attrib mismatch" |
|
+ | 1578 | verifyNothingE mpub "Patch has 'published'" |
|
+ | 1579 | return (typ, content) |
|
+ | 1580 | matchTargetAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WITProject shr prj |
|
- | 1526 | matchTargetAndMR (Left (Right (shr, rp))) (Just (branch, typ, content)) = do |
|
+ | 1591 | matchTargetAndMR (Left (Right (shr, rp))) (Just (branch, typ, diffs)) = do |
|
… | … | … | … |
- | 1539 | return $ Left $ WTTRepo shr rp branch' vcs content |
|
+ | 1604 | return $ Left $ WITRepo shr rp branch' vcs diffs |
|
- | 1543 | matchTargetAndMR (Right (ObjURI h lu)) (Just (branch, typ, content)) = do |
|
+ | 1608 | matchTargetAndMR (Right (ObjURI h lu)) (Just (branch, typ, diffs)) = do |
|
- | 1548 | let patch = |
|
+ | 1613 | let bundle = |
|
- | 1551 | , content |
|
+ | 1616 | , diffs |
|
- | 1553 | return $ Right (h, lu, Just patch) |
|
+ | 1618 | return $ Right (h, lu, Just bundle) |
|
… | … | … | … |
- | 1623 | , RepoPatchR shr rp |
|
+ | 1688 | , RepoProposalR shr rp |
|
… | … | … | … |
- | 1662 | verify (WorkItemRepoPatch shr rp _) = do |
|
+ | 1727 | verify (WorkItemRepoProposal shr rp _) = do |
|
… | … | … | … |
- | 1697 | workItemActor (WorkItemRepoPatch shr rp _) = LocalActorRepo shr rp |
|
+ | 1762 | workItemActor (WorkItemRepoProposal shr rp _) = LocalActorRepo shr rp |
|
… | … | … | … |
- | 1764 | WorkItemRepoPatch shr rp _ -> do |
|
+ | 1829 | WorkItemRepoProposal shr rp _ -> do |
|
… | … | … | … |
- | 1791 | WorkItemRepoPatch shr rp _ -> do |
|
+ | 1856 | WorkItemRepoProposal shr rp _ -> do |
|
… | … | … | … |
- | 1858 | workItemActor (WorkItemRepoPatch shr rp _) = LocalActorRepo shr rp |
|
+ | 1923 | workItemActor (WorkItemRepoProposal shr rp _) = LocalActorRepo shr rp |
|
… | … | … | … |
- | 2012 | WorkItemRepoPatch shr rp _ -> do |
|
+ | 2077 | WorkItemRepoProposal shr rp _ -> do |
|
… | … | … | … |
- | 2130 | WorkItemRepoPatch shr rp _ -> do |
|
+ | 2195 | WorkItemRepoProposal shr rp _ -> do |
|
… | … | … | … |
Edit file src/Vervis/ActivityPub.hs 0 → 0
- | 143 | | NoteContextRepoPatch ShrIdent RpIdent LocalTicketId |
|
+ | 143 | | NoteContextRepoProposal ShrIdent RpIdent LocalTicketId |
|
… | … | … | … |
- | 162 | SharerPatchR shr talkhid -> |
|
+ | 162 | SharerProposalR shr talkhid -> |
|
- | 168 | RepoPatchR shr rp ltkhid -> |
|
- | 169 | NoteContextRepoPatch shr rp <$> |
|
+ | 168 | RepoProposalR shr rp ltkhid -> |
|
+ | 169 | NoteContextRepoProposal shr rp <$> |
|
… | … | … | … |
- | 1035 | [ (rp, localRecipRepoPatchRelated r) |
|
+ | 1035 | [ (rp, localRecipRepoProposalRelated r) |
|
- | 1040 | map (second localRecipRepoPatchRelated) repos |
|
+ | 1040 | map (second localRecipRepoProposalRelated) repos |
|
… | … | … | … |
Edit file src/Vervis/ActivityPub/Recipient.hs 0 → 0
- | 110 | | LocalPersonCollectionSharerPatchFollowers ShrIdent (KeyHashid TicketAuthorLocal) |
|
+ | 110 | | LocalPersonCollectionSharerProposalFollowers ShrIdent (KeyHashid TicketAuthorLocal) |
|
- | 119 | | LocalPersonCollectionRepoPatchFollowers ShrIdent RpIdent (KeyHashid LocalTicket) |
|
+ | 119 | | LocalPersonCollectionRepoProposalFollowers ShrIdent RpIdent (KeyHashid LocalTicket) |
|
- | 130 | parseLocalPersonCollection (SharerPatchFollowersR shr talkhid) = |
|
- | 131 | Just $ LocalPersonCollectionSharerPatchFollowers shr talkhid |
|
+ | 130 | parseLocalPersonCollection (SharerProposalFollowersR shr talkhid) = |
|
+ | 131 | Just $ LocalPersonCollectionSharerProposalFollowers shr talkhid |
|
… | … | … | … |
- | 144 | parseLocalPersonCollection (RepoPatchFollowersR shr rp ltkhid) = |
|
- | 145 | Just $ LocalPersonCollectionRepoPatchFollowers shr rp ltkhid |
|
+ | 144 | parseLocalPersonCollection (RepoProposalFollowersR shr rp ltkhid) = |
|
+ | 145 | Just $ LocalPersonCollectionRepoProposalFollowers shr rp ltkhid |
|
- | 152 | renderLocalPersonCollection (LocalPersonCollectionSharerPatchFollowers shr talkhid) = SharerPatchFollowersR shr talkhid |
|
+ | 152 | renderLocalPersonCollection (LocalPersonCollectionSharerProposalFollowers shr talkhid) = SharerProposalFollowersR shr talkhid |
|
- | 159 | renderLocalPersonCollection (LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) = RepoPatchFollowersR shr rp ltkhid |
|
+ | 159 | renderLocalPersonCollection (LocalPersonCollectionRepoProposalFollowers shr rp ltkhid) = RepoProposalFollowersR shr rp ltkhid |
|
… | … | … | … |
- | 198 | | LocalRepoPatchRelated (KeyHashid LocalTicket) LocalPatchRecipientDirect |
|
+ | 198 | | LocalRepoProposalRelated (KeyHashid LocalTicket) LocalPatchRecipientDirect |
|
- | 209 | | LocalSharerPatchRelated (KeyHashid TicketAuthorLocal) LocalPatchRecipientDirect |
|
+ | 209 | | LocalSharerProposalRelated (KeyHashid TicketAuthorLocal) LocalPatchRecipientDirect |
|
… | … | … | … |
- | 240 | (LocalPersonCollectionSharerPatchFollowers shr talkhid) = |
|
+ | 240 | (LocalPersonCollectionSharerProposalFollowers shr talkhid) = |
|
- | 242 | LocalSharerPatchRelated talkhid LocalPatchFollowers |
|
+ | 242 | LocalSharerProposalRelated talkhid LocalPatchFollowers |
|
… | … | … | … |
- | 268 | (LocalPersonCollectionRepoPatchFollowers shr rp ltkhid) = |
|
+ | 268 | (LocalPersonCollectionRepoProposalFollowers shr rp ltkhid) = |
|
- | 270 | LocalRepoPatchRelated ltkhid LocalPatchFollowers |
|
+ | 270 | LocalRepoProposalRelated ltkhid LocalPatchFollowers |
|
… | … | … | … |
- | 317 | , localRecipRepoPatchRelated |
|
+ | 317 | , localRecipRepoProposalRelated |
|
… | … | … | … |
- | 333 | , localRecipSharerPatchRelated |
|
+ | 333 | , localRecipSharerProposalRelated |
|
… | … | … | … |
- | 361 | LocalSharerPatchRelated talkhid lpr -> |
|
+ | 361 | LocalSharerProposalRelated talkhid lpr -> |
|
… | … | … | … |
- | 414 | lrr2e (LocalRepoPatchRelated num ltrs) = Right (num, ltrs) |
|
+ | 414 | lrr2e (LocalRepoProposalRelated num ltrs) = Right (num, ltrs) |
|
… | … | … | … |
Edit file src/Vervis/Federation/Discussion.hs 0 → 0
- | 239 | mticket <- lift $ getSharerPatch shr talid |
|
+ | 239 | mticket <- lift $ getSharerProposal shr talid |
|
- | 241 | return (tal, lt, LocalPersonCollectionSharerPatchFollowers) |
|
+ | 241 | return (tal, lt, LocalPersonCollectionSharerProposalFollowers) |
|
… | … | … | … |
- | 300 | Left (NoteContextRepoPatch shr rp ltid) -> runDBExcept $ do |
|
+ | 300 | Left (NoteContextRepoProposal shr rp ltid) -> runDBExcept $ do |
|
- | 305 | mticket <- lift $ getRepoPatch shr rp ltid |
|
+ | 305 | mticket <- lift $ getRepoProposal shr rp ltid |
|
… | … | … | … |
- | 432 | Left (NoteContextRepoPatch _ _ _) -> return "Context is a repo-patch, ignoring activity" |
|
+ | 432 | Left (NoteContextRepoProposal _ _ _) -> return "Context is a repo-patch, ignoring activity" |
|
… | … | … | … |
- | 459 | mticket <- lift $ getSharerPatch shr talid |
|
+ | 459 | mticket <- lift $ getSharerProposal shr talid |
|
… | … | … | … |
- | 492 | Left (NoteContextRepoPatch shr rp ltid) -> do |
|
+ | 492 | Left (NoteContextRepoProposal shr rp ltid) -> do |
|
- | 496 | mticket <- lift $ getRepoPatch shr rp ltid |
|
+ | 496 | mticket <- lift $ getRepoProposal shr rp ltid |
|
… | … | … | … |
- | 521 | , LocalPersonCollectionRepoPatchFollowers shrRecip rpRecip ltkhid |
|
+ | 521 | , LocalPersonCollectionRepoProposalFollowers shrRecip rpRecip ltkhid |
|
… | … | … | … |
Edit file src/Vervis/Federation/Offer.hs 0 → 0
- | 226 | then LocalPersonCollectionSharerPatchFollowers |
|
+ | 226 | then LocalPersonCollectionSharerProposalFollowers |
|
… | … | … | … |
- | 428 | objRoute (SharerPatchR shr' talkhid) |
|
+ | 428 | objRoute (SharerProposalR shr' talkhid) |
|
- | 439 | (_, Entity _ lt, _, _, _, _) <- MaybeT $ getSharerPatch shr talid |
|
+ | 439 | (_, Entity _ lt, _, _, _, _) <- MaybeT $ getSharerProposal shr talid |
|
… | … | … | … |
- | 517 | objRoute (RepoPatchR shr' rp' ltkhid) |
|
+ | 517 | objRoute (RepoProposalR shr' rp' ltkhid) |
|
- | 526 | (_, _, _, Entity _ lt, _, _, _, _, _) <- MaybeT $ getRepoPatch shr rp ltid |
|
+ | 526 | (_, _, _, Entity _ lt, _, _, _, _, _) <- MaybeT $ getRepoProposal shr rp ltid |
|
… | … | … | … |
- | 695 | then LocalPersonCollectionSharerPatchFollowers shrRecip talkhid |
|
+ | 695 | then LocalPersonCollectionSharerProposalFollowers shrRecip talkhid |
|
… | … | … | … |
- | 869 | myWorkItem (WorkItemRepoPatch shr rp ltid) |
|
+ | 869 | myWorkItem (WorkItemRepoProposal shr rp ltid) |
|
- | 878 | LocalPersonCollectionRepoPatchFollowers shrRecip rpRecip ltkhid |
|
+ | 878 | LocalPersonCollectionRepoProposalFollowers shrRecip rpRecip ltkhid |
|
… | … | … | … |
Edit file src/Vervis/Federation/Ticket.hs 0 → 0
- | 105 | ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, Text)) |
|
+ | 105 | ( Either WorkItemTarget (Host, LocalURI, Maybe (Maybe LocalURI, PatchType, NonEmpty Text)) |
|
… | … | … | … |
- | 150 | checkMR h (MergeRequest muOrigin luTarget epatch) = do |
|
+ | 150 | checkMR h (MergeRequest muOrigin luTarget ebundle) = do |
|
- | 153 | (typ, content) <- |
|
- | 154 | case epatch of |
|
- | 155 | Left _ -> throwE "MR patch specified as a URI" |
|
- | 156 | Right (hPatch, patch) -> checkPatch hPatch patch |
|
- | 157 | return (branch, typ, content) |
|
+ | 153 | (typ, diffs) <- |
|
+ | 154 | case ebundle of |
|
+ | 155 | Left _ -> throwE "MR bundle specified as a URI" |
|
+ | 156 | Right (hBundle, bundle) -> checkBundle hBundle bundle |
|
+ | 157 | return (branch, typ, diffs) |
|
… | … | … | … |
- | 175 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
- | 176 | verifyNothingE mlocal "Patch with 'id'" |
|
- | 177 | unless (ObjURI h attrib == remoteAuthorURI author) $ |
|
- | 178 | throwE "Ticket and Patch attrib mismatch" |
|
- | 179 | verifyNothingE mpub "Patch has 'published'" |
|
- | 180 | return (typ, content) |
|
- | 181 | ||
- | 182 | matchTargetAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WTTProject shr prj |
|
+ | 175 | checkBundle _ (AP.BundleHosted _ _) = |
|
+ | 176 | throwE "Patches specified as URIs" |
|
+ | 177 | checkBundle h (AP.BundleOffer mlocal patches) = do |
|
+ | 178 | verifyNothingE mlocal "Bundle with 'id'" |
|
+ | 179 | (typ:|typs, diffs) <- NE.unzip <$> traverse (checkPatch h) patches |
|
+ | 180 | unless (all (== typ) typs) $ throwE "Different patch types" |
|
+ | 181 | return (typ, diffs) |
|
+ | 182 | where |
|
+ | 183 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
+ | 184 | verifyNothingE mlocal "Patch with 'id'" |
|
+ | 185 | unless (ObjURI h attrib == remoteAuthorURI author) $ |
|
+ | 186 | throwE "Ticket and Patch attrib mismatch" |
|
+ | 187 | verifyNothingE mpub "Patch has 'published'" |
|
+ | 188 | return (typ, content) |
|
+ | 189 | ||
+ | 190 | matchTargetAndMR (Left (Left (shr, prj))) Nothing = return $ Left $ WITProject shr prj |
|
- | 193 | matchTargetAndMR (Left (Right (shr, rp))) (Just (branch, typ, content)) = do |
|
+ | 201 | matchTargetAndMR (Left (Right (shr, rp))) (Just (branch, typ, diffs)) = do |
|
… | … | … | … |
- | 206 | return $ Left $ WTTRepo shr rp branch' vcs content |
|
+ | 214 | return $ Left $ WITRepo shr rp branch' vcs diffs |
|
- | 210 | matchTargetAndMR (Right (ObjURI h lu)) (Just (branch, typ, content)) = do |
|
+ | 218 | matchTargetAndMR (Right (ObjURI h lu)) (Just (branch, typ, diffs)) = do |
|
- | 215 | let patch = |
|
+ | 223 | let bundle = |
|
- | 218 | , content |
|
+ | 226 | , diffs |
|
- | 220 | return $ Right (h, lu, Just patch) |
|
+ | 228 | return $ Right (h, lu, Just bundle) |
|
… | … | … | … |
- | 239 | Left (WTTProject shr prj) -> do |
|
+ | 247 | Left (WITProject shr prj) -> do |
|
- | 244 | Left (WTTRepo shr rp _ _ _) -> do |
|
+ | 252 | Left (WITRepo shr rp _ _ _) -> do |
|
… | … | … | … |
- | 348 | targetRelevance (Left (WTTProject shr prj)) |
|
+ | 356 | targetRelevance (Left (WITProject shr prj)) |
|
… | … | … | … |
- | 405 | mmhttp <- for (targetRelevance target) $ \ (mb, vcs, diff) -> runDBExcept $ do |
|
+ | 413 | mmhttp <- for (targetRelevance target) $ \ (mb, vcs, diffs) -> runDBExcept $ do |
|
… | … | … | … |
- | 429 | insert_ $ Patch tid now diff |
|
+ | 437 | bnid <- insert $ Bundle tid |
|
+ | 438 | insertMany_ $ NE.toList $ NE.map (Patch bnid now) diffs |
|
… | … | … | … |
- | 459 | targetRelevance (Left (WTTRepo shr rp mb vcs diff)) |
|
- | 460 | | shr == shrRecip && rp == rpRecip = Just (mb, vcs, diff) |
|
+ | 468 | targetRelevance (Left (WITRepo shr rp mb vcs diffs)) |
|
+ | 469 | | shr == shrRecip && rp == rpRecip = Just (mb, vcs, diffs) |
|
… | … | … | … |
- | 497 | Just $ encodeRouteLocal $ RepoPatchR shr rp ltkhid |
|
+ | 506 | Just $ encodeRouteLocal $ RepoProposalR shr rp ltkhid |
|
- | 503 | data RemotePatch = RemotePatch |
|
- | 504 | { rpBranch :: Maybe LocalURI |
|
- | 505 | , rpType :: PatchType |
|
- | 506 | , rpContent :: Text |
|
+ | 512 | data RemoteBundle = RemoteBundle |
|
+ | 513 | { rpBranch :: Maybe LocalURI |
|
+ | 514 | , rpType :: PatchType |
|
+ | 515 | , rpDiffs :: NonEmpty Text |
|
- | 513 | , rwiPatch :: Maybe RemotePatch |
|
+ | 522 | , rwiBundle :: Maybe RemoteBundle |
|
- | 519 | , rwiPatch' :: Maybe RemotePatch |
|
+ | 528 | , rwiBundle' :: Maybe RemoteBundle |
|
… | … | … | … |
- | 571 | ( Either WorkItemTarget (Host, LocalURI, Maybe RemotePatch) |
|
+ | 580 | ( Either WorkItemTarget (Host, LocalURI, Maybe RemoteBundle) |
|
… | … | … | … |
- | 595 | mmr' <- traverse (uncurry checkMR) mmr |
|
+ | 604 | mmr' <- traverse (uncurry $ checkMR $ ticketId tlocal) mmr |
|
- | 601 | :: Host |
|
+ | 610 | :: LocalURI |
|
+ | 611 | -> Host |
|
- | 606 | , Maybe (LocalURI, LocalURI) |
|
- | 607 | , Maybe UTCTime |
|
- | 607 | , Text |
|
+ | 615 | , NonEmpty (Maybe LocalURI, Maybe UTCTime, Text) |
|
- | 609 | checkMR h (MergeRequest muOrigin luTarget epatch) = do |
|
+ | 617 | checkMR luTicket h (MergeRequest muOrigin luTarget ebundle) = do |
|
- | 612 | (mlocal, mpub, typ, content) <- |
|
- | 613 | case epatch of |
|
- | 614 | Left _ -> throwE "MR patch specified as a URI" |
|
- | 615 | Right (hPatch, patch) -> checkPatch hPatch patch |
|
- | 616 | return (branch, mlocal, mpub, typ, content) |
|
+ | 620 | (typ, patches) <- |
|
+ | 621 | case ebundle of |
|
+ | 622 | Left _ -> throwE "MR bundle specified as a URI" |
|
+ | 623 | Right (hBundle, bundle) -> checkBundle hBundle bundle |
|
+ | 624 | return (branch, typ, patches) |
|
… | … | … | … |
- | 639 | checkPatch |
|
- | 640 | :: Host |
|
- | 641 | -> AP.Patch URIMode |
|
- | 642 | -> ExceptT Text Handler |
|
- | 643 | ( Maybe (LocalURI, LocalURI) |
|
- | 644 | , Maybe UTCTime |
|
- | 645 | , PatchType |
|
- | 646 | , Text |
|
- | 647 | ) |
|
- | 648 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
- | 649 | mlocal' <- |
|
- | 650 | for mlocal $ |
|
- | 651 | \ (h', PatchLocal luId luContext versions mcurr) -> do |
|
- | 652 | unless (h == h') $ |
|
- | 653 | throwE "Patch & its author on different hosts" |
|
- | 654 | unless (null versions) $ |
|
- | 655 | throwE "Patch has versions" |
|
- | 656 | unless (isNothing mcurr) $ |
|
- | 657 | throwE "Patch has 'currentVersion'" |
|
- | 658 | return (luId, luContext) |
|
- | 659 | unless (ObjURI h attrib == remoteAuthorURI author) $ |
|
- | 660 | throwE "Ticket & Patch attrib mismatch" |
|
- | 661 | return (mlocal', mpub, typ, content) |
|
+ | 647 | checkBundle _ (AP.BundleHosted _ _) = |
|
+ | 648 | throwE "Patches specified as URIs" |
|
+ | 649 | checkBundle h (AP.BundleOffer mblocal patches) = do |
|
+ | 650 | for_ mblocal $ \ (h', BundleLocal _luId luCtx prevs mcurr) -> do |
|
+ | 651 | unless (h == h') $ |
|
+ | 652 | throwE "Bundle and author hosts differ" |
|
+ | 653 | unless (luCtx == luTicket) $ |
|
+ | 654 | throwE "Bundle 'context' doesn't match Ticket 'id'" |
|
+ | 655 | unless (null prevs) $ |
|
+ | 656 | throwE "Bundle has previous versions" |
|
+ | 657 | unless (isNothing mcurr) $ |
|
+ | 658 | throwE "Bundle has a more recent version" |
|
+ | 659 | (mlocal, mpub, typ, diff) :| patches' <- traverse (checkPatch h) patches |
|
+ | 660 | patches'' <- for patches' $ \ (mlocal', mpub', typ', diff') -> do |
|
+ | 661 | mluId <- for mlocal' $ \ (luId', luContext') -> do |
|
+ | 662 | for_ mlocal $ \ (_, luContext) -> |
|
+ | 663 | unless (luContext == luContext') $ |
|
+ | 664 | throwE "Patches have different context" |
|
+ | 665 | return luId' |
|
+ | 666 | unless (typ == typ') $ throwE "Different patch types" |
|
+ | 667 | return (mluId, mpub', diff') |
|
+ | 668 | return (typ, (fst <$> mlocal, mpub, diff) :| patches'') |
|
+ | 669 | where |
|
+ | 670 | checkPatch |
|
+ | 671 | :: Host |
|
+ | 672 | -> AP.Patch URIMode |
|
+ | 673 | -> ExceptT Text Handler |
|
+ | 674 | ( Maybe (LocalURI, LocalURI) |
|
+ | 675 | , Maybe UTCTime |
|
+ | 676 | , PatchType |
|
+ | 677 | , Text |
|
+ | 678 | ) |
|
+ | 679 | checkPatch h (AP.Patch mlocal attrib mpub typ content) = do |
|
+ | 680 | mlocal' <- |
|
+ | 681 | for mlocal $ |
|
+ | 682 | \ (h', PatchLocal luId luContext) -> do |
|
+ | 683 | unless (h == h') $ |
|
+ | 684 | throwE "Patch & its author on different hosts" |
|
+ | 685 | return (luId, luContext) |
|
+ | 686 | unless (ObjURI h attrib == remoteAuthorURI author) $ |
|
+ | 687 | throwE "Ticket & Patch attrib mismatch" |
|
+ | 688 | return (mlocal', mpub, typ, content) |
|
… | … | … | … |
- | 689 | , Maybe (LocalURI, LocalURI) |
|
- | 690 | , Maybe UTCTime |
|
- | 690 | , Text |
|
+ | 715 | , NonEmpty (Maybe LocalURI, Maybe UTCTime, Text) |
|
- | 692 | -> ExceptT Text Handler (Either WorkItemTarget (Host, LocalURI, Maybe RemotePatch)) |
|
- | 693 | matchTicketAndMR _ _ (Left (Left (shr, prj))) Nothing = return $ Left $ WTTProject shr prj |
|
+ | 717 | -> ExceptT Text Handler (Either WorkItemTarget (Host, LocalURI, Maybe RemoteBundle)) |
|
+ | 718 | matchTicketAndMR _ _ (Left (Left (shr, prj))) Nothing = return $ Left $ WITProject shr prj |
|
- | 696 | matchTicketAndMR luTicket pub (Left (Right (shr, rp))) (Just (branch, mlocal, mpub, typ, content)) = do |
|
+ | 721 | matchTicketAndMR luTicket pub (Left (Right (shr, rp))) (Just (branch, typ, patches)) = do |
|
- | 701 | _mluPatch <- for mlocal $ \ (luPatch, luPatchContext) -> do |
|
- | 702 | unless (luPatchContext == luTicket) $ |
|
- | 703 | throwE "Patch 'context' != Ticket 'id'" |
|
- | 704 | return luPatch |
|
- | 705 | for_ mpub $ \ pub' -> |
|
- | 706 | unless (pub == pub') $ |
|
- | 707 | throwE "Ticket & Patch 'published' differ" |
|
- | 709 | return $ Left $ WTTRepo shr rp branch' vcs content |
|
+ | 727 | diffs <- for patches $ \ (_mluId, mpub, diff) -> do |
|
+ | 728 | for_ mpub $ \ pub' -> |
|
+ | 729 | unless (pub == pub') $ |
|
+ | 730 | throwE "Ticket & Patch 'published' differ" |
|
+ | 731 | return diff |
|
+ | 732 | return $ Left $ WITRepo shr rp branch' vcs diffs |
|
- | 718 | matchTicketAndMR luTicket pub (Right (ObjURI h lu)) (Just (branch, mlocal, mpub, typ, content)) = do |
|
+ | 741 | matchTicketAndMR luTicket pub (Right (ObjURI h lu)) (Just (branch, typ, patches)) = do |
|
- | 723 | _mluPatch <- for mlocal $ \ (luPatch, luPatchContext) -> do |
|
- | 724 | unless (luPatchContext == luTicket) $ |
|
- | 725 | throwE "Patch 'context' != Ticket 'id'" |
|
- | 726 | return luPatch |
|
- | 727 | for_ mpub $ \ pub' -> |
|
- | 728 | unless (pub == pub') $ |
|
- | 729 | throwE "Ticket & Patch 'published' differ" |
|
- | 730 | let patch = |
|
- | 731 | RemotePatch |
|
+ | 746 | diffs <- for patches $ \ (_mluId, mpub, diff) -> do |
|
+ | 747 | for_ mpub $ \ pub' -> |
|
+ | 748 | unless (pub == pub') $ |
|
+ | 749 | throwE "Ticket & Patch 'published' differ" |
|
+ | 750 | return diff |
|
+ | 751 | let bundle = |
|
+ | 752 | RemoteBundle |
|
- | 732 | content |
|
- | 733 | return $ Right (h, lu, Just patch) |
|
+ | 753 | diffs |
|
+ | 754 | return $ Right (h, lu, Just bundle) |
|
- | 740 | -> Either WorkItemTarget (Host, LocalURI, Maybe RemotePatch) |
|
+ | 761 | -> Either WorkItemTarget (Host, LocalURI, Maybe RemoteBundle) |
|
- | 746 | Right (h, luCtx, mpatch) -> Right $ RemoteWorkItem h Nothing luCtx mpatch |
|
+ | 767 | Right (h, luCtx, mbundle) -> Right $ RemoteWorkItem h Nothing luCtx mbundle |
|
- | 753 | (Right (ObjURI hTarget luTarget), Right (hContext, luContext, mpatch)) -> |
|
+ | 774 | (Right (ObjURI hTarget luTarget), Right (hContext, luContext, mbundle)) -> |
|
- | 755 | then return $ Right $ RemoteWorkItem hTarget (Just luTarget) luContext mpatch |
|
+ | 776 | then return $ Right $ RemoteWorkItem hTarget (Just luTarget) luContext mbundle |
|
- | 760 | (Left (shr, prj), WTTProject shr' prj') |
|
+ | 781 | (Left (shr, prj), WITProject shr' prj') |
|
- | 763 | (Right (shr, rp), WTTRepo shr' rp' _ _ _) |
|
+ | 784 | (Right (shr, rp), WITRepo shr' rp' _ _ _) |
|
… | … | … | … |
- | 793 | checkTargetAndContextDB (Left (_, WTTProject shr prj)) = do |
|
+ | 814 | checkTargetAndContextDB (Left (_, WITProject shr prj)) = do |
|
- | 798 | checkTargetAndContextDB (Left (_, WTTRepo shr rp _ _ _)) = do |
|
+ | 819 | checkTargetAndContextDB (Left (_, WITRepo shr rp _ _ _)) = do |
|
… | … | … | … |
- | 990 | targetRelevance (Left (_, WTTProject shr prj)) |
|
+ | 1011 | targetRelevance (Left (_, WITProject shr prj)) |
|
… | … | … | … |
- | 1008 | mmhttp <- for (targetRelevance targetAndContext) $ \ (mb, vcs, diff) -> runDBExcept $ do |
|
+ | 1029 | mmhttp <- for (targetRelevance targetAndContext) $ \ (mb, vcs, diffs) -> runDBExcept $ do |
|
… | … | … | … |
- | 1020 | insert_ $ Patch tid published diff |
|
+ | 1041 | bnid <- insert $ Bundle tid |
|
+ | 1042 | insertMany_ $ NE.toList $ NE.map (Patch bnid published) diffs |
|
… | … | … | … |
- | 1066 | targetRelevance (Left (_, WTTRepo shr rp mb vcs diff)) |
|
- | 1067 | | shr == shrRecip && rp == rpRecip = Just (mb, vcs, diff) |
|
+ | 1088 | targetRelevance (Left (_, WITRepo shr rp mb vcs diffs)) |
|
+ | 1089 | | shr == shrRecip && rp == rpRecip = Just (mb, vcs, diffs) |
|
… | … | … | … |
- | 1101 | mticket <- lift $ getSharerPatch shrRecip talid |
|
+ | 1123 | mticket <- lift $ getSharerProposal shrRecip talid |
|
… | … | … | … |
- | 1195 | mticket <- lift $ getSharerPatch shrRecip talid |
|
+ | 1217 | mticket <- lift $ getSharerProposal shrRecip talid |
|
… | … | … | … |
- | 1214 | then LocalPersonCollectionSharerPatchFollowers |
|
+ | 1236 | then LocalPersonCollectionSharerProposalFollowers |
|
… | … | … | … |
- | 1272 | then LocalPersonCollectionSharerPatchFollowers |
|
+ | 1294 | then LocalPersonCollectionSharerProposalFollowers |
|
… | … | … | … |
- | 1494 | mticket <- lift $ getRepoPatch shrRecip rpRecip parentLtid |
|
+ | 1516 | mticket <- lift $ getRepoProposal shrRecip rpRecip parentLtid |
|
… | … | … | … |
- | 1547 | ticketRelevance shr rp (Left (WorkItemRepoPatch shr' rp' ltid)) |
|
+ | 1569 | ticketRelevance shr rp (Left (WorkItemRepoProposal shr' rp' ltid)) |
|
- | 1554 | mticket <- lift $ getRepoPatch shrRecip rpRecip ltid |
|
+ | 1576 | mticket <- lift $ getRepoProposal shrRecip rpRecip ltid |
|
… | … | … | … |
- | 1566 | LocalPersonCollectionRepoPatchFollowers |
|
+ | 1588 | LocalPersonCollectionRepoProposalFollowers |
|
… | … | … | … |
- | 1631 | LocalPersonCollectionRepoPatchFollowers |
|
+ | 1653 | LocalPersonCollectionRepoProposalFollowers |
|
- | 1638 | mticket <- lift $ getSharerPatch shr talid |
|
+ | 1660 | mticket <- lift $ getSharerProposal shr talid |
|
- | 1643 | verifyWorkItemExists (WorkItemRepoPatch shr rp ltid) = do |
|
- | 1644 | mticket <- lift $ getRepoPatch shr rp ltid |
|
+ | 1665 | verifyWorkItemExists (WorkItemRepoProposal shr rp ltid) = do |
|
+ | 1666 | mticket <- lift $ getRepoProposal shr rp ltid |
|
… | … | … | … |
- | 1690 | then LocalPersonCollectionSharerPatchFollowers |
|
+ | 1712 | then LocalPersonCollectionSharerProposalFollowers |
|
… | … | … | … |
- | 1750 | mticket <- lift $ getSharerPatch shrRecip talid |
|
+ | 1772 | mticket <- lift $ getSharerProposal shrRecip talid |
|
… | … | … | … |
- | 1774 | then LocalPersonCollectionSharerPatchFollowers |
|
+ | 1796 | then LocalPersonCollectionSharerProposalFollowers |
|
… | … | … | … |
- | 1957 | [ LocalPersonCollectionRepoPatchFollowers shrRecip rpRecip ltkhid |
|
+ | 1979 | [ LocalPersonCollectionRepoProposalFollowers shrRecip rpRecip ltkhid |
|
… | … | … | … |
- | 2006 | relevantObject (Left (WorkItemRepoPatch shr rp ltid)) |
|
+ | 2028 | relevantObject (Left (WorkItemRepoProposal shr rp ltid)) |
|
- | 2012 | mticket <- lift $ getRepoPatch shrRecip rpRecip ltid |
|
+ | 2034 | mticket <- lift $ getRepoProposal shrRecip rpRecip ltid |
|
… | … | … | … |
- | 2031 | [ LocalPersonCollectionRepoPatchFollowers shrRecip rpRecip ltkhid |
|
+ | 2053 | [ LocalPersonCollectionRepoProposalFollowers shrRecip rpRecip ltkhid |
|
… | … | … | … |
Edit file src/Vervis/Foundation.hs 0 → 0
- | 75 | import Web.ActivityPub hiding (Ticket, TicketDependency, Patch) |
|
+ | 75 | import Web.ActivityPub hiding (Ticket, TicketDependency, Bundle, Patch) |
|
… | … | … | … |
+ | 136 | type BundleKeyHashid = KeyHashid Bundle |
|
… | … | … | … |
Edit file src/Vervis/Handler/Patch.hs 0 → 0
- | 17 | ( getSharerPatchesR |
|
- | 18 | , getSharerPatchR |
|
- | 19 | , getSharerPatchDiscussionR |
|
- | 20 | , getSharerPatchDepsR |
|
- | 21 | , getSharerPatchReverseDepsR |
|
- | 22 | , getSharerPatchFollowersR |
|
- | 23 | , getSharerPatchEventsR |
|
- | 24 | , getSharerPatchVersionR |
|
- | 25 | ||
- | 26 | , getRepoPatchesR |
|
- | 27 | , getRepoPatchR |
|
- | 28 | , getRepoPatchDiscussionR |
|
- | 29 | , getRepoPatchDepsR |
|
- | 30 | , getRepoPatchReverseDepsR |
|
- | 31 | , getRepoPatchFollowersR |
|
- | 32 | , getRepoPatchEventsR |
|
- | 33 | , getRepoPatchVersionR |
|
+ | 17 | ( getSharerProposalsR |
|
+ | 18 | , getSharerProposalR |
|
+ | 19 | , getSharerProposalDiscussionR |
|
+ | 20 | , getSharerProposalDepsR |
|
+ | 21 | , getSharerProposalReverseDepsR |
|
+ | 22 | , getSharerProposalFollowersR |
|
+ | 23 | , getSharerProposalEventsR |
|
+ | 24 | , getSharerProposalBundleR |
|
+ | 25 | , getSharerProposalBundlePatchR |
|
+ | 26 | ||
+ | 27 | , getRepoProposalsR |
|
+ | 28 | , getRepoProposalR |
|
+ | 29 | , getRepoProposalDiscussionR |
|
+ | 30 | , getRepoProposalDepsR |
|
+ | 31 | , getRepoProposalReverseDepsR |
|
+ | 32 | , getRepoProposalFollowersR |
|
+ | 33 | , getRepoProposalEventsR |
|
+ | 34 | , getRepoProposalBundleR |
|
+ | 35 | , getRepoProposalBundlePatchR |
|
- | 43 | import Data.List.NonEmpty (NonEmpty (..)) |
|
+ | 45 | import Data.List.NonEmpty (NonEmpty (..), nonEmpty) |
|
… | … | … | … |
- | 55 | import Web.ActivityPub hiding (Ticket (..), Patch (..)) |
|
+ | 57 | import Web.ActivityPub hiding (Ticket (..), Patch (..), Bundle (..)) |
|
… | … | … | … |
- | 78 | getSharerPatchesR :: ShrIdent -> Handler TypedContent |
|
- | 79 | getSharerPatchesR = |
|
- | 80 | getSharerWorkItems SharerPatchesR SharerPatchR countPatches selectPatches |
|
+ | 80 | getSharerProposalsR :: ShrIdent -> Handler TypedContent |
|
+ | 81 | getSharerProposalsR = |
|
+ | 82 | getSharerWorkItems SharerProposalsR SharerProposalR countPatches selectPatches |
|
- | 90 | (E.from $ \ pt -> |
|
- | 91 | E.where_ $ lt E.^. LocalTicketTicket E.==. pt E.^. PatchTicket |
|
+ | 92 | (E.from $ \ bn -> |
|
+ | 93 | E.where_ $ lt E.^. LocalTicketTicket E.==. bn E.^. BundleTicket |
|
… | … | … | … |
- | 106 | (E.from $ \ pt -> |
|
- | 107 | E.where_ $ lt E.^. LocalTicketTicket E.==. pt E.^. PatchTicket |
|
+ | 108 | (E.from $ \ bn -> |
|
+ | 109 | E.where_ $ lt E.^. LocalTicketTicket E.==. bn E.^. BundleTicket |
|
- | 114 | getSharerPatchR |
|
+ | 116 | getSharerProposalR |
|
- | 116 | getSharerPatchR shr talkhid = do |
|
- | 117 | (ticket, ptid, repo, massignee) <- runDB $ do |
|
- | 118 | (_, _, Entity tid t, tp, _, ptid :| _) <- getSharerPatch404 shr talkhid |
|
- | 119 | (,,,) t ptid |
|
+ | 118 | getSharerProposalR shr talkhid = do |
|
+ | 119 | (ticket, bnid, repo, massignee) <- runDB $ do |
|
+ | 120 | (_, _, Entity tid t, tp, _, bnid :| _) <- getSharerProposal404 shr talkhid |
|
+ | 121 | (,,,) t bnid |
|
… | … | … | … |
- | 145 | encodePatchId <- getEncodeKeyHashid |
|
- | 146 | let patchAP = AP.Ticket |
|
+ | 147 | encodeBundleId <- getEncodeKeyHashid |
|
+ | 148 | let ticketAP = AP.Ticket |
|
- | 151 | encodeRouteLocal $ SharerPatchR shr talkhid |
|
+ | 153 | encodeRouteLocal $ SharerProposalR shr talkhid |
|
- | 153 | encodeRouteLocal $ SharerPatchDiscussionR shr talkhid |
|
+ | 155 | encodeRouteLocal $ SharerProposalDiscussionR shr talkhid |
|
- | 155 | encodeRouteLocal $ SharerPatchFollowersR shr talkhid |
|
+ | 157 | encodeRouteLocal $ SharerProposalFollowersR shr talkhid |
|
- | 158 | encodeRouteLocal $ SharerPatchEventsR shr talkhid |
|
+ | 160 | encodeRouteLocal $ SharerProposalEventsR shr talkhid |
|
- | 160 | encodeRouteLocal $ SharerPatchDepsR shr talkhid |
|
+ | 162 | encodeRouteLocal $ SharerProposalDepsR shr talkhid |
|
- | 162 | encodeRouteLocal $ SharerPatchReverseDepsR shr talkhid |
|
+ | 164 | encodeRouteLocal $ SharerProposalReverseDepsR shr talkhid |
|
… | … | … | … |
- | 201 | , mrPatch = |
|
+ | 203 | , mrBundle = |
|
- | 203 | SharerPatchVersionR shr talkhid $ |
|
- | 204 | encodePatchId ptid |
|
+ | 205 | SharerProposalBundleR shr talkhid $ |
|
+ | 206 | encodeBundleId bnid |
|
- | 208 | provideHtmlAndAP patchAP $ redirectToPrettyJSON here |
|
+ | 210 | provideHtmlAndAP ticketAP $ redirectToPrettyJSON here |
|
- | 210 | here = SharerPatchR shr talkhid |
|
- | 211 | ||
- | 212 | getSharerPatchDiscussionR |
|
+ | 212 | here = SharerProposalR shr talkhid |
|
+ | 213 | ||
+ | 214 | getSharerProposalDiscussionR |
|
- | 214 | getSharerPatchDiscussionR shr talkhid = |
|
- | 215 | getRepliesCollection (SharerPatchDiscussionR shr talkhid) $ do |
|
- | 216 | (_, Entity _ lt, _, _, _, _) <- getSharerPatch404 shr talkhid |
|
+ | 216 | getSharerProposalDiscussionR shr talkhid = |
|
+ | 217 | getRepliesCollection (SharerProposalDiscussionR shr talkhid) $ do |
|
+ | 218 | (_, Entity _ lt, _, _, _, _) <- getSharerProposal404 shr talkhid |
|
- | 219 | getSharerPatchDepsR |
|
+ | 221 | getSharerProposalDepsR |
|
- | 221 | getSharerPatchDepsR shr talkhid = |
|
+ | 223 | getSharerProposalDepsR shr talkhid = |
|
- | 224 | here = SharerPatchDepsR shr talkhid |
|
+ | 226 | here = SharerProposalDepsR shr talkhid |
|
- | 226 | (_, Entity ltid _, _, _, _, _) <- getSharerPatch404 shr talkhid |
|
+ | 228 | (_, Entity ltid _, _, _, _, _) <- getSharerProposal404 shr talkhid |
|
- | 229 | getSharerPatchReverseDepsR |
|
+ | 231 | getSharerProposalReverseDepsR |
|
- | 231 | getSharerPatchReverseDepsR shr talkhid = |
|
+ | 233 | getSharerProposalReverseDepsR shr talkhid = |
|
- | 234 | here = SharerPatchDepsR shr talkhid |
|
+ | 236 | here = SharerProposalDepsR shr talkhid |
|
- | 236 | (_, Entity ltid _, _, _, _, _) <- getSharerPatch404 shr talkhid |
|
+ | 238 | (_, Entity ltid _, _, _, _, _) <- getSharerProposal404 shr talkhid |
|
- | 239 | getSharerPatchFollowersR |
|
+ | 241 | getSharerProposalFollowersR |
|
- | 241 | getSharerPatchFollowersR shr talkhid = getFollowersCollection here getFsid |
|
+ | 243 | getSharerProposalFollowersR shr talkhid = getFollowersCollection here getFsid |
|
- | 243 | here = SharerPatchFollowersR shr talkhid |
|
+ | 245 | here = SharerProposalFollowersR shr talkhid |
|
- | 245 | (_, Entity _ lt, _, _, _, _) <- getSharerPatch404 shr talkhid |
|
+ | 247 | (_, Entity _ lt, _, _, _, _) <- getSharerProposal404 shr talkhid |
|
- | 248 | getSharerPatchEventsR |
|
+ | 250 | getSharerProposalEventsR |
|
- | 250 | getSharerPatchEventsR shr talkhid = do |
|
- | 251 | _ <- runDB $ getSharerPatch404 shr talkhid |
|
+ | 252 | getSharerProposalEventsR shr talkhid = do |
|
+ | 253 | _ <- runDB $ getSharerProposal404 shr talkhid |
|
- | 254 | (SharerPatchEventsR shr talkhid) |
|
- | 255 | ||
- | 256 | getSharerPatchVersionR |
|
+ | 256 | (SharerProposalEventsR shr talkhid) |
|
+ | 257 | ||
+ | 258 | getSharerProposalBundleR |
|
+ | 261 | -> KeyHashid Bundle |
|
+ | 262 | -> Handler TypedContent |
|
+ | 263 | getSharerProposalBundleR shr talkhid bnkhid = do |
|
+ | 264 | (ptids, prevs, mcurr) <- runDB $ do |
|
+ | 265 | (_, _, Entity tid _, _, _, v :| vs) <- getSharerProposal404 shr talkhid |
|
+ | 266 | bnid <- decodeKeyHashid404 bnkhid |
|
+ | 267 | bn <- get404 bnid |
|
+ | 268 | unless (bundleTicket bn == tid) notFound |
|
+ | 269 | ptids <- selectKeysList [PatchBundle ==. bnid] [Desc PatchId] |
|
+ | 270 | ptidsNE <- |
|
+ | 271 | case nonEmpty ptids of |
|
+ | 272 | Nothing -> error "Bundle without any Patches in DB" |
|
+ | 273 | Just ne -> return ne |
|
+ | 274 | let (prevs, mcurr) = |
|
+ | 275 | if bnid == v |
|
+ | 276 | then (vs, Nothing) |
|
+ | 277 | else ([], Just v) |
|
+ | 278 | return (ptidsNE, prevs, mcurr) |
|
+ | 279 | ||
+ | 280 | encodeRouteLocal <- getEncodeRouteLocal |
|
+ | 281 | encodeBNID <- getEncodeKeyHashid |
|
+ | 282 | encodePTID <- getEncodeKeyHashid |
|
+ | 283 | ||
+ | 284 | let versionRoute = SharerProposalBundleR shr talkhid . encodeBNID |
|
+ | 285 | local = BundleLocal |
|
+ | 286 | { bundleId = encodeRouteLocal here |
|
+ | 287 | , bundleContext = |
|
+ | 288 | encodeRouteLocal $ SharerProposalR shr talkhid |
|
+ | 289 | , bundlePrevVersions = |
|
+ | 290 | map (encodeRouteLocal . versionRoute) prevs |
|
+ | 291 | , bundleCurrentVersion = encodeRouteLocal . versionRoute <$> mcurr |
|
+ | 292 | } |
|
+ | 293 | bundleAP = |
|
+ | 294 | AP.BundleHosted |
|
+ | 295 | (Just local) |
|
+ | 296 | (NE.map |
|
+ | 297 | ( encodeRouteLocal |
|
+ | 298 | . SharerProposalBundlePatchR shr talkhid bnkhid |
|
+ | 299 | . encodePTID |
|
+ | 300 | ) |
|
+ | 301 | ptids |
|
+ | 302 | ) |
|
+ | 303 | provideHtmlAndAP bundleAP $ redirectToPrettyJSON here |
|
+ | 304 | where |
|
+ | 305 | here = SharerProposalBundleR shr talkhid bnkhid |
|
+ | 306 | ||
+ | 307 | getSharerProposalBundlePatchR |
|
+ | 308 | :: ShrIdent |
|
+ | 309 | -> KeyHashid TicketAuthorLocal |
|
+ | 310 | -> KeyHashid Bundle |
|
… | … | … | … |
- | 311 | getSharerPatchVersionR shr talkhid ptkhid = do |
|
- | 312 | (vcs, patch, (versions, mcurr)) <- runDB $ do |
|
- | 313 | (_, _, Entity tid _, repo, _, v :| vs) <- getSharerPatch404 shr talkhid |
|
+ | 363 | getSharerProposalBundlePatchR shr talkhid bnkhid ptkhid = do |
|
+ | 364 | (vcs, patch) <- runDB $ do |
|
+ | 365 | (_, _, _, repo, _, vers) <- getSharerProposal404 shr talkhid |
|
+ | 366 | bnid <- decodeKeyHashid404 bnkhid |
|
+ | 367 | unless (bnid `elem` vers) notFound |
|
- | 317 | (,,) <$> case repo of |
|
- | 318 | Left (_, Entity _ trl) -> |
|
- | 319 | repoVcs <$> getJust (ticketRepoLocalRepo trl) |
|
- | 320 | Right _ -> |
|
- | 321 | error "TODO determine mediaType of patch of remote repo" |
|
- | 322 | <*> do pt <- get404 ptid |
|
- | 323 | unless (patchTicket pt == tid) notFound |
|
- | 324 | return pt |
|
- | 325 | <*> pure (if ptid == v then (vs, Nothing) else ([], Just v)) |
|
+ | 371 | pt <- get404 ptid |
|
+ | 372 | unless (patchBundle pt == bnid) notFound |
|
+ | 373 | vcs <- |
|
+ | 374 | case repo of |
|
+ | 375 | Left (_, Entity _ trl) -> |
|
+ | 376 | repoVcs <$> getJust (ticketRepoLocalRepo trl) |
|
+ | 377 | Right _ -> |
|
+ | 378 | error "TODO determine mediaType of patch of remote repo" |
|
+ | 379 | return (vcs, pt) |
|
+ | 380 | ||
- | 328 | encodeRouteHome <- getEncodeRouteHome |
|
- | 329 | encodePatchId <- getEncodeKeyHashid |
|
- | 329 | let versionUrl = SharerPatchVersionR shr talkhid . encodePatchId |
|
- | 330 | versionAP = AP.Patch |
|
+ | 382 | ||
+ | 383 | let patchAP = AP.Patch |
|
- | 336 | encodeRouteLocal $ SharerPatchR shr talkhid |
|
- | 337 | , AP.patchPrevVersions = |
|
- | 338 | map (encodeRouteLocal . versionUrl) versions |
|
- | 339 | , AP.patchCurrentVersion = |
|
- | 340 | encodeRouteLocal . versionUrl <$> mcurr |
|
+ | 389 | encodeRouteLocal $ |
|
+ | 390 | SharerProposalBundleR shr talkhid bnkhid |
|
- | 348 | provideHtmlAndAP versionAP $ redirectToPrettyJSON here |
|
+ | 398 | provideHtmlAndAP patchAP $ redirectToPrettyJSON here |
|
- | 350 | here = SharerPatchVersionR shr talkhid ptkhid |
|
- | 351 | ||
- | 352 | getRepoPatchesR :: ShrIdent -> RpIdent -> Handler TypedContent |
|
- | 353 | getRepoPatchesR shr rp = do |
|
+ | 400 | here = SharerProposalBundlePatchR shr talkhid bnkhid ptkhid |
|
+ | 401 | ||
+ | 402 | getRepoProposalsR :: ShrIdent -> RpIdent -> Handler TypedContent |
|
+ | 403 | getRepoProposalsR shr rp = do |
|
- | 362 | let here = RepoPatchesR shr rp |
|
+ | 412 | let here = RepoProposalsR shr rp |
|
- | 369 | (Nothing, Nothing, Nothing) -> RepoPatchR shr rp $ encodeLT ltid |
|
- | 370 | (Just talid, Just shrA, Nothing) -> SharerPatchR shrA $ encodeTAL talid |
|
- | 371 | (Just _, Just _, Just _) -> RepoPatchR shr rp $ encodeLT ltid |
|
+ | 419 | (Nothing, Nothing, Nothing) -> RepoProposalR shr rp $ encodeLT ltid |
|
+ | 420 | (Just talid, Just shrA, Nothing) -> SharerProposalR shrA $ encodeTAL talid |
|
+ | 421 | (Just _, Just _, Just _) -> RepoProposalR shr rp $ encodeLT ltid |
|
… | … | … | … |
- | 454 | getRepoPatchR |
|
+ | 504 | getRepoProposalR |
|
- | 456 | getRepoPatchR shr rp ltkhid = do |
|
- | 457 | (ticket, ptid, trl, author, massignee, mresolved) <- runDB $ do |
|
- | 458 | (_, _, Entity tid t, _, _, Entity _ trl, ta, tr, ptid :| _) <- getRepoPatch404 shr rp ltkhid |
|
- | 459 | (,,,,,) t ptid trl |
|
+ | 506 | getRepoProposalR shr rp ltkhid = do |
|
+ | 507 | (ticket, bnid, trl, author, massignee, mresolved) <- runDB $ do |
|
+ | 508 | (_, _, Entity tid t, _, _, Entity _ trl, ta, tr, bnid :| _) <- getRepoProposal404 shr rp ltkhid |
|
+ | 509 | (,,,,,) t bnid trl |
|
… | … | … | … |
- | 498 | encodePatchId <- getEncodeKeyHashid |
|
+ | 548 | encodeBundleId <- getEncodeKeyHashid |
|
- | 504 | patchAP = AP.Ticket |
|
+ | 554 | ticketAP = AP.Ticket |
|
- | 509 | encodeRouteLocal $ RepoPatchR shr rp ltkhid |
|
+ | 559 | encodeRouteLocal $ RepoProposalR shr rp ltkhid |
|
- | 511 | encodeRouteLocal $ RepoPatchDiscussionR shr rp ltkhid |
|
+ | 561 | encodeRouteLocal $ RepoProposalDiscussionR shr rp ltkhid |
|
- | 513 | encodeRouteLocal $ RepoPatchFollowersR shr rp ltkhid |
|
+ | 563 | encodeRouteLocal $ RepoProposalFollowersR shr rp ltkhid |
|
- | 516 | encodeRouteLocal $ RepoPatchEventsR shr rp ltkhid |
|
+ | 566 | encodeRouteLocal $ RepoProposalEventsR shr rp ltkhid |
|
- | 518 | encodeRouteLocal $ RepoPatchDepsR shr rp ltkhid |
|
+ | 568 | encodeRouteLocal $ RepoProposalDepsR shr rp ltkhid |
|
- | 520 | encodeRouteLocal $ RepoPatchReverseDepsR shr rp ltkhid |
|
+ | 570 | encodeRouteLocal $ RepoProposalReverseDepsR shr rp ltkhid |
|
… | … | … | … |
- | 553 | , mrPatch = |
|
+ | 603 | , mrBundle = |
|
- | 555 | RepoPatchVersionR shr rp ltkhid $ |
|
- | 556 | encodePatchId ptid |
|
+ | 605 | RepoProposalBundleR shr rp ltkhid $ |
|
+ | 606 | encodeBundleId bnid |
|
- | 560 | provideHtmlAndAP' host patchAP $ redirectToPrettyJSON here |
|
+ | 610 | provideHtmlAndAP' host ticketAP $ redirectToPrettyJSON here |
|
- | 562 | here = RepoPatchR shr rp ltkhid |
|
- | 563 | ||
- | 564 | getRepoPatchDiscussionR |
|
+ | 612 | here = RepoProposalR shr rp ltkhid |
|
+ | 613 | ||
+ | 614 | getRepoProposalDiscussionR |
|
- | 566 | getRepoPatchDiscussionR shr rp ltkhid = |
|
- | 567 | getRepliesCollection (RepoPatchDiscussionR shr rp ltkhid) $ do |
|
- | 568 | (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid |
|
+ | 616 | getRepoProposalDiscussionR shr rp ltkhid = |
|
+ | 617 | getRepliesCollection (RepoProposalDiscussionR shr rp ltkhid) $ do |
|
+ | 618 | (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoProposal404 shr rp ltkhid |
|
- | 571 | getRepoPatchDepsR |
|
+ | 621 | getRepoProposalDepsR |
|
- | 573 | getRepoPatchDepsR shr rp ltkhid = |
|
+ | 623 | getRepoProposalDepsR shr rp ltkhid = |
|
- | 576 | here = RepoPatchDepsR shr rp ltkhid |
|
+ | 626 | here = RepoProposalDepsR shr rp ltkhid |
|
- | 578 | (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid |
|
+ | 628 | (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoProposal404 shr rp ltkhid |
|
- | 581 | getRepoPatchReverseDepsR |
|
+ | 631 | getRepoProposalReverseDepsR |
|
- | 583 | getRepoPatchReverseDepsR shr rp ltkhid = |
|
+ | 633 | getRepoProposalReverseDepsR shr rp ltkhid = |
|
- | 586 | here = RepoPatchReverseDepsR shr rp ltkhid |
|
+ | 636 | here = RepoProposalReverseDepsR shr rp ltkhid |
|
- | 588 | (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid |
|
+ | 638 | (_, _, _, Entity ltid _, _, _, _, _, _) <- getRepoProposal404 shr rp ltkhid |
|
- | 591 | getRepoPatchFollowersR |
|
+ | 641 | getRepoProposalFollowersR |
|
- | 593 | getRepoPatchFollowersR shr rp ltkhid = getFollowersCollection here getFsid |
|
+ | 643 | getRepoProposalFollowersR shr rp ltkhid = getFollowersCollection here getFsid |
|
- | 595 | here = RepoPatchFollowersR shr rp ltkhid |
|
+ | 645 | here = RepoProposalFollowersR shr rp ltkhid |
|
- | 597 | (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoPatch404 shr rp ltkhid |
|
+ | 647 | (_, _, _, Entity _ lt, _, _, _, _, _) <- getRepoProposal404 shr rp ltkhid |
|
- | 600 | getRepoPatchEventsR |
|
+ | 650 | getRepoProposalEventsR |
|
- | 602 | getRepoPatchEventsR shr rp ltkhid = do |
|
- | 603 | _ <- runDB $ getRepoPatch404 shr rp ltkhid |
|
+ | 652 | getRepoProposalEventsR shr rp ltkhid = do |
|
+ | 653 | _ <- runDB $ getRepoProposal404 shr rp ltkhid |
|
- | 606 | (RepoPatchEventsR shr rp ltkhid) |
|
- | 607 | ||
- | 608 | getRepoPatchVersionR |
|
+ | 656 | (RepoProposalEventsR shr rp ltkhid) |
|
+ | 657 | ||
+ | 658 | getRepoProposalBundleR |
|
+ | 662 | -> KeyHashid Bundle |
|
+ | 663 | -> Handler TypedContent |
|
+ | 664 | getRepoProposalBundleR shr rp ltkhid bnkhid = do |
|
+ | 665 | (ptids, prevs, mcurr) <- runDB $ do |
|
+ | 666 | (_, _, Entity tid _, _, _, _, _, _, v :| vs) <- getRepoProposal404 shr rp ltkhid |
|
+ | 667 | bnid <- decodeKeyHashid404 bnkhid |
|
+ | 668 | bn <- get404 bnid |
|
+ | 669 | unless (bundleTicket bn == tid) notFound |
|
+ | 670 | ptids <- selectKeysList [PatchBundle ==. bnid] [Desc PatchId] |
|
+ | 671 | ptidsNE <- |
|
+ | 672 | case nonEmpty ptids of |
|
+ | 673 | Nothing -> error "Bundle without any Patches in DB" |
|
+ | 674 | Just ne -> return ne |
|
+ | 675 | let (prevs, mcurr) = |
|
+ | 676 | if bnid == v |
|
+ | 677 | then (vs, Nothing) |
|
+ | 678 | else ([], Just v) |
|
+ | 679 | return (ptidsNE, prevs, mcurr) |
|
+ | 680 | ||
+ | 681 | encodeRouteLocal <- getEncodeRouteLocal |
|
+ | 682 | encodeBNID <- getEncodeKeyHashid |
|
+ | 683 | encodePTID <- getEncodeKeyHashid |
|
+ | 684 | ||
+ | 685 | let versionRoute = RepoProposalBundleR shr rp ltkhid . encodeBNID |
|
+ | 686 | local = BundleLocal |
|
+ | 687 | { bundleId = encodeRouteLocal here |
|
+ | 688 | , bundleContext = |
|
+ | 689 | encodeRouteLocal $ RepoProposalR shr rp ltkhid |
|
+ | 690 | , bundlePrevVersions = |
|
+ | 691 | map (encodeRouteLocal . versionRoute) prevs |
|
+ | 692 | , bundleCurrentVersion = encodeRouteLocal . versionRoute <$> mcurr |
|
+ | 693 | } |
|
+ | 694 | bundleAP = |
|
+ | 695 | AP.BundleHosted |
|
+ | 696 | (Just local) |
|
+ | 697 | (NE.map |
|
+ | 698 | ( encodeRouteLocal |
|
+ | 699 | . RepoProposalBundlePatchR shr rp ltkhid bnkhid |
|
+ | 700 | . encodePTID |
|
+ | 701 | ) |
|
+ | 702 | ptids |
|
+ | 703 | ) |
|
+ | 704 | provideHtmlAndAP bundleAP $ redirectToPrettyJSON here |
|
+ | 705 | where |
|
+ | 706 | here = RepoProposalBundleR shr rp ltkhid bnkhid |
|
+ | 707 | ||
+ | 708 | getRepoProposalBundlePatchR |
|
+ | 709 | :: ShrIdent |
|
+ | 710 | -> RpIdent |
|
+ | 711 | -> KeyHashid LocalTicket |
|
+ | 712 | -> KeyHashid Bundle |
|
… | … | … | … |
- | 665 | getRepoPatchVersionR shr rp ltkhid ptkhid = do |
|
- | 666 | (vcs, patch, author, (versions, mcurr)) <- runDB $ do |
|
- | 667 | (_, Entity _ repo, Entity tid _, _, _, _, ta, _, v :| vs) <- getRepoPatch404 shr rp ltkhid |
|
- | 668 | ptid <- decodeKeyHashid404 ptkhid |
|
- | 669 | (repoVcs repo,,,) |
|
- | 670 | <$> do pt <- get404 ptid |
|
- | 671 | unless (patchTicket pt == tid) notFound |
|
+ | 766 | getRepoProposalBundlePatchR shr rp ltkhid bnkhid ptkhid = do |
|
+ | 767 | (vcs, patch, author) <- runDB $ do |
|
+ | 768 | (_, Entity _ repo, _, _, _, _, ta, _, vers) <- getRepoProposal404 shr rp ltkhid |
|
+ | 769 | (,,) |
|
+ | 770 | <$> pure (repoVcs repo) |
|
+ | 771 | <*> do bnid <- decodeKeyHashid404 bnkhid |
|
+ | 772 | unless (bnid `elem` vers) notFound |
|
+ | 773 | ptid <- decodeKeyHashid404 ptkhid |
|
+ | 774 | pt <- get404 ptid |
|
+ | 775 | unless (patchBundle pt == bnid) notFound |
|
… | … | … | … |
- | 688 | <*> pure (if ptid == v then (vs, Nothing) else ([], Just v)) |
|
+ | 792 | ||
- | 690 | encodeRouteHome <- getEncodeRouteHome |
|
- | 691 | encodePatchId <- getEncodeKeyHashid |
|
- | 691 | let versionUrl = RepoPatchVersionR shr rp ltkhid . encodePatchId |
|
- | 692 | host = |
|
+ | 793 | ||
+ | 794 | let host = |
|
- | 696 | versionAP = AP.Patch |
|
- | 697 | { AP.patchLocal = Just |
|
+ | 798 | patchAP = AP.Patch |
|
+ | 799 | { AP.patchLocal = Just |
|
- | 700 | { AP.patchId = encodeRouteLocal here |
|
- | 701 | , AP.patchContext = |
|
- | 702 | encodeRouteLocal $ RepoPatchR shr rp ltkhid |
|
- | 703 | , AP.patchPrevVersions = |
|
- | 704 | map (encodeRouteLocal . versionUrl) versions |
|
- | 705 | , AP.patchCurrentVersion = |
|
- | 706 | encodeRouteLocal . versionUrl <$> mcurr |
|
+ | 802 | { AP.patchId = encodeRouteLocal here |
|
+ | 803 | , AP.patchContext = |
|
+ | 804 | encodeRouteLocal $ |
|
+ | 805 | RepoProposalBundleR shr rp ltkhid bnkhid |
|
… | … | … | … |
- | 718 | provideHtmlAndAP' host versionAP $ redirectToPrettyJSON here |
|
+ | 817 | provideHtmlAndAP' host patchAP $ redirectToPrettyJSON here |
|
- | 720 | here = RepoPatchVersionR shr rp ltkhid ptkhid |
|
+ | 819 | here = RepoProposalBundlePatchR shr rp ltkhid bnkhid ptkhid |
|
… | … | … | … |
Edit file src/Vervis/Handler/Ticket.hs 0 → 0
- | 1046 | E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup `E.LeftOuterJoin` pt) -> do |
|
- | 1047 | E.on $ E.just (lt E.^. LocalTicketTicket) E.==. pt E.?. PatchTicket |
|
+ | 1046 | E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup `E.LeftOuterJoin` bn) -> do |
|
+ | 1047 | E.on $ E.just (lt E.^. LocalTicketTicket) E.==. bn E.?. BundleTicket |
|
- | 1053 | E.isNothing (pt E.?. PatchId) |
|
+ | 1053 | E.isNothing (bn E.?. BundleId) |
|
- | 1060 | E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup `E.LeftOuterJoin` pt) -> do |
|
- | 1061 | E.on $ E.just (lt E.^. LocalTicketTicket) E.==. pt E.?. PatchTicket |
|
+ | 1060 | E.select $ E.from $ \ (tal `E.InnerJoin` lt `E.LeftOuterJoin` tup `E.LeftOuterJoin` bn) -> do |
|
+ | 1061 | E.on $ E.just (lt E.^. LocalTicketTicket) E.==. bn E.?. BundleTicket |
|
- | 1067 | E.isNothing (pt E.?. PatchId) |
|
+ | 1067 | E.isNothing (bn E.?. BundleId) |
|
… | … | … | … |
Edit file src/Vervis/Migration.hs 0 → 0
+ | 1755 | -- 279 |
|
+ | 1756 | , addEntities model_2020_08_10 |
|
+ | 1757 | -- 280 |
|
+ | 1758 | , addFieldRefRequired'' |
|
+ | 1759 | "Patch" |
|
+ | 1760 | (do tid <- insert $ Ticket280 Nothing defaultTime "" "" "" Nothing "TSNew" |
|
+ | 1761 | insertEntity $ Bundle280 tid |
|
+ | 1762 | ) |
|
+ | 1763 | (Just $ \ (Entity bnidTemp bnTemp) -> do |
|
+ | 1764 | pts <- selectList ([] :: [Filter Patch280]) [] |
|
+ | 1765 | for_ pts $ \ (Entity ptid pt) -> do |
|
+ | 1766 | bnid <- insert $ Bundle280 $ patch280Ticket pt |
|
+ | 1767 | update ptid [Patch280Bundle =. bnid] |
|
+ | 1768 | ||
+ | 1769 | delete bnidTemp |
|
+ | 1770 | delete $ bundle280Ticket bnTemp |
|
+ | 1771 | ) |
|
+ | 1772 | "bundle" |
|
+ | 1773 | "Bundle" |
|
+ | 1774 | -- 281 |
|
+ | 1775 | , removeField "Patch" "ticket" |
|
… | … | … | … |
Edit file src/Vervis/Migration/Model.hs 0 → 0
+ | 241 | , model_2020_08_10 |
|
+ | 242 | , Ticket280Generic (..) |
|
+ | 243 | , Bundle280Generic (..) |
|
+ | 244 | , Patch280 |
|
+ | 245 | , Patch280Generic (..) |
|
… | … | … | … |
+ | 478 | ||
+ | 479 | model_2020_08_10 :: [Entity SqlBackend] |
|
+ | 480 | model_2020_08_10 = $(schema "2020_08_10_bundle") |
|
+ | 481 | ||
+ | 482 | makeEntitiesMigration "280" |
|
+ | 483 | $(modelFile "migrations/2020_08_10_bundle_mig.model") |
|
… | … | … | … |
Edit file src/Vervis/Patch.hs 0 → 0
- | 17 | ( getSharerPatch |
|
- | 18 | , getSharerPatch404 |
|
- | 19 | , getRepoPatch |
|
- | 20 | , getRepoPatch404 |
|
+ | 17 | ( getSharerProposal |
|
+ | 18 | , getSharerProposal404 |
|
+ | 19 | , getRepoProposal |
|
+ | 20 | , getRepoProposal404 |
|
… | … | … | … |
- | 64 | getSharerPatch |
|
+ | 64 | getSharerProposal |
|
… | … | … | … |
- | 86 | , NonEmpty PatchId |
|
+ | 86 | , NonEmpty BundleId |
|
- | 89 | getSharerPatch shr talid = runMaybeT $ do |
|
+ | 89 | getSharerProposal shr talid = runMaybeT $ do |
|
- | 99 | ptids <- |
|
+ | 99 | bnids <- |
|
- | 101 | nonEmpty <$> selectKeysList [PatchTicket ==. tid] [Desc PatchId] |
|
+ | 101 | nonEmpty <$> selectKeysList [BundleTicket ==. tid] [Desc BundleId] |
|
… | … | … | … |
- | 121 | return (Entity talid tal, Entity ltid lt, Entity tid t, repo, mresolved, ptids) |
|
- | 122 | ||
- | 123 | getSharerPatch404 |
|
+ | 121 | return (Entity talid tal, Entity ltid lt, Entity tid t, repo, mresolved, bnids) |
|
+ | 122 | ||
+ | 123 | getSharerProposal404 |
|
… | … | … | … |
- | 143 | , NonEmpty PatchId |
|
+ | 143 | , NonEmpty BundleId |
|
- | 145 | getSharerPatch404 shr talkhid = do |
|
+ | 145 | getSharerProposal404 shr talkhid = do |
|
- | 147 | mpatch <- getSharerPatch shr talid |
|
+ | 147 | mpatch <- getSharerProposal shr talid |
|
- | 152 | getRepoPatch |
|
+ | 152 | getRepoProposal |
|
… | … | … | … |
- | 174 | , NonEmpty PatchId |
|
+ | 174 | , NonEmpty BundleId |
|
- | 177 | getRepoPatch shr rp ltid = runMaybeT $ do |
|
+ | 177 | getRepoProposal shr rp ltid = runMaybeT $ do |
|
- | 186 | ptids <- |
|
+ | 186 | bnids <- |
|
- | 188 | nonEmpty <$> selectKeysList [PatchTicket ==. tid] [Desc PatchId] |
|
+ | 188 | nonEmpty <$> selectKeysList [BundleTicket ==. tid] [Desc BundleId] |
|
… | … | … | … |
- | 203 | return (es, er, Entity tid t, Entity ltid lt, etcl, etrl, author, mresolved, ptids) |
|
- | 204 | ||
- | 205 | getRepoPatch404 |
|
+ | 203 | return (es, er, Entity tid t, Entity ltid lt, etcl, etrl, author, mresolved, bnids) |
|
+ | 204 | ||
+ | 205 | getRepoProposal404 |
|
… | … | … | … |
- | 225 | , NonEmpty PatchId |
|
+ | 225 | , NonEmpty BundleId |
|
- | 227 | getRepoPatch404 shr rp ltkhid = do |
|
+ | 227 | getRepoProposal404 shr rp ltkhid = do |
|
- | 229 | mpatch <- getRepoPatch shr rp ltid |
|
+ | 229 | mpatch <- getRepoProposal shr rp ltid |
|
… | … | … | … |
Edit file src/Vervis/Ticket.hs 0 → 0
- | 57 | import Data.Maybe (isJust) |
|
+ | 57 | import Data.Maybe |
|
… | … | … | … |
- | 499 | npatches <- lift $ count [PatchTicket ==. tid] |
|
- | 500 | guard $ npatches <= 0 |
|
+ | 499 | mbn <- lift $ selectFirst [BundleTicket ==. tid] [] |
|
+ | 500 | guard $ isNothing mbn |
|
… | … | … | … |
- | 602 | npatches <- lift $ count [PatchTicket ==. tid] |
|
- | 603 | guard $ npatches <= 0 |
|
+ | 602 | mbn <- lift $ selectFirst [BundleTicket ==. tid] [] |
|
+ | 603 | guard $ isNothing mbn |
|
… | … | … | … |
- | 763 | | WorkItemRepoPatch ShrIdent RpIdent LocalTicketId |
|
+ | 763 | | WorkItemRepoProposal ShrIdent RpIdent LocalTicketId |
|
… | … | … | … |
- | 776 | route (WorkItemSharerTicket shr talid True) = SharerPatchR shr (hashTALID talid) |
|
+ | 776 | route (WorkItemSharerTicket shr talid True) = SharerProposalR shr (hashTALID talid) |
|
- | 778 | route (WorkItemRepoPatch shr rp ltid) = RepoPatchR shr rp (hashLTID ltid) |
|
+ | 778 | route (WorkItemRepoProposal shr rp ltid) = RepoProposalR shr rp (hashLTID ltid) |
|
… | … | … | … |
- | 793 | (etcr,) . (> 0) <$> count [PatchTicket ==. tid] |
|
+ | 793 | (etcr,) . (> 0) <$> count [BundleTicket ==. tid] |
|
- | 797 | npatches <- lift $ count [PatchTicket ==. tid] |
|
+ | 797 | mbn <- lift $ selectFirst [BundleTicket ==. tid] [] |
|
- | 803 | when (npatches > 0) $ throwE "TPL but patches attached" |
|
+ | 803 | when (isJust mbn) $ throwE "TPL but patches attached" |
|
- | 806 | when (npatches < 1) $ throwE "TRL but no patches attached" |
|
+ | 806 | when (isNothing mbn) $ throwE "TRL but no patches attached" |
|
… | … | … | … |
- | 861 | return $ WorkItemRepoPatch (sharerIdent s) (repoIdent r) ltid |
|
+ | 861 | return $ WorkItemRepoProposal (sharerIdent s) (repoIdent r) ltid |
|
… | … | … | … |
- | 878 | SharerPatchR shr talkhid -> do |
|
+ | 878 | SharerProposalR shr talkhid -> do |
|
- | 884 | RepoPatchR shr rp ltkhid -> do |
|
+ | 884 | RepoProposalR shr rp ltkhid -> do |
|
- | 886 | return $ WorkItemRepoPatch shr rp ltid |
|
+ | 886 | return $ WorkItemRepoProposal shr rp ltid |
|
… | … | … | … |
- | 926 | workItemActor (WorkItemRepoPatch shr rp _) = LocalActorRepo shr rp |
|
+ | 926 | workItemActor (WorkItemRepoProposal shr rp _) = LocalActorRepo shr rp |
|
… | … | … | … |
Edit file src/Vervis/WorkItem.hs 0 → 0
- | 31 | -- import Control.Monad.Trans.Maybe |
|
- | 34 | -- import Data.Either |
|
- | 35 | -- import Data.Foldable (for_) |
|
+ | 33 | import Data.List.NonEmpty (NonEmpty) |
|
- | 37 | -- import Data.Traversable |
|
- | 39 | -- import Yesod.Core (notFound) |
|
- | 40 | -- import Yesod.Core.Content |
|
- | 41 | -- import Yesod.Persist.Core |
|
- | 42 | ||
- | 43 | -- import qualified Database.Esqueleto as E |
|
+ | 36 | ||
- | 52 | -- import Data.Either.Local |
|
- | 53 | -- import Data.Paginate.Local |
|
- | 54 | -- import Database.Persist.Local |
|
- | 55 | -- import Yesod.Persist.Local |
|
- | 59 | -- import Vervis.Model.Workflow |
|
- | 60 | -- import Vervis.Paginate |
|
- | 61 | -- import Vervis.Widget.Ticket (TicketSummary (..)) |
|
… | … | … | … |
- | 94 | workItemFollowers (WorkItemSharerTicket shr talid True) = LocalPersonCollectionSharerPatchFollowers shr $ hashTALID talid |
|
+ | 80 | workItemFollowers (WorkItemSharerTicket shr talid True) = LocalPersonCollectionSharerProposalFollowers shr $ hashTALID talid |
|
- | 96 | workItemFollowers (WorkItemRepoPatch shr rp ltid) = LocalPersonCollectionRepoPatchFollowers shr rp $ hashLTID ltid |
|
+ | 82 | workItemFollowers (WorkItemRepoProposal shr rp ltid) = LocalPersonCollectionRepoProposalFollowers shr rp $ hashLTID ltid |
|
… | … | … | … |
- | 187 | mticket <- lift $ getSharerPatch shr talid |
|
+ | 173 | mticket <- lift $ getSharerProposal shr talid |
|
… | … | … | … |
- | 216 | getWorkItem name (WorkItemRepoPatch shr rp ltid) = do |
|
- | 217 | mticket <- lift $ getRepoPatch shr rp ltid |
|
+ | 202 | getWorkItem name (WorkItemRepoProposal shr rp ltid) = do |
|
+ | 203 | mticket <- lift $ getRepoProposal shr rp ltid |
|
… | … | … | … |
- | 244 | = WTTProject ShrIdent PrjIdent |
|
- | 245 | | WTTRepo ShrIdent RpIdent (Maybe Text) VersionControlSystem Text |
|
+ | 230 | = WITProject ShrIdent PrjIdent |
|
+ | 231 | | WITRepo ShrIdent RpIdent (Maybe Text) VersionControlSystem (NonEmpty Text) |
|
… | … | … | … |
Edit file src/Web/ActivityPub.hs 0 → 0
+ | 52 | , BundleLocal (..) |
|
+ | 53 | , Bundle (..) |
|
… | … | … | … |
- | 831 | data PatchType = PatchTypeDarcs |
|
+ | 833 | data PatchType = PatchTypeDarcs deriving Eq |
|
… | … | … | … |
- | 846 | { patchId :: LocalURI |
|
- | 847 | , patchContext :: LocalURI |
|
- | 848 | , patchPrevVersions :: [LocalURI] |
|
- | 849 | , patchCurrentVersion :: Maybe LocalURI |
|
+ | 848 | { patchId :: LocalURI |
|
+ | 849 | , patchContext :: LocalURI |
|
- | 857 | verifyNothing "previousVersions" |
|
- | 858 | verifyNothing "currentVersion" |
|
- | 863 | <*> (traverse (withAuthorityO a . return) =<< o .:? "previousVersions" .!= []) |
|
- | 864 | <*> withAuthorityMaybeO a (o .:? "currentVersion") |
|
- | 870 | encodePatchLocal a (PatchLocal id_ context versions mcurrent) |
|
+ | 866 | encodePatchLocal a (PatchLocal id_ context) |
|
- | 873 | <> "previousVersions" .= map (ObjURI a) versions |
|
- | 874 | <> "currentVersion" .=? (ObjURI a <$> mcurrent) |
|
… | … | … | … |
+ | 902 | data BundleLocal = BundleLocal |
|
+ | 903 | { bundleId :: LocalURI |
|
+ | 904 | , bundleContext :: LocalURI |
|
+ | 905 | , bundlePrevVersions :: [LocalURI] |
|
+ | 906 | , bundleCurrentVersion :: Maybe LocalURI |
|
+ | 907 | } |
|
+ | 908 | ||
+ | 909 | parseBundleLocal |
|
+ | 910 | :: UriMode u => Object -> Parser (Maybe (Authority u, BundleLocal)) |
|
+ | 911 | parseBundleLocal o = do |
|
+ | 912 | mid <- o .:? "id" |
|
+ | 913 | case mid of |
|
+ | 914 | Nothing -> do |
|
+ | 915 | verifyNothing "context" |
|
+ | 916 | verifyNothing "previousVersions" |
|
+ | 917 | verifyNothing "currentVersion" |
|
+ | 918 | return Nothing |
|
+ | 919 | Just (ObjURI a id_) -> |
|
+ | 920 | fmap (Just . (a,)) $ |
|
+ | 921 | BundleLocal |
|
+ | 922 | <$> pure id_ |
|
+ | 923 | <*> withAuthorityO a (o .: "context") |
|
+ | 924 | <*> (traverse (withAuthorityO a . return) =<< o .:? "previousVersions" .!= []) |
|
+ | 925 | <*> withAuthorityMaybeO a (o .:? "currentVersion") |
|
+ | 926 | where |
|
+ | 927 | verifyNothing t = |
|
+ | 928 | if t `M.member` o |
|
+ | 929 | then fail $ T.unpack t ++ " field found, expected none" |
|
+ | 930 | else return () |
|
+ | 931 | ||
+ | 932 | encodeBundleLocal :: UriMode u => Authority u -> BundleLocal -> Series |
|
+ | 933 | encodeBundleLocal a (BundleLocal id_ context versions mcurrent) |
|
+ | 934 | = "id" .= ObjURI a id_ |
|
+ | 935 | <> "context" .= ObjURI a context |
|
+ | 936 | <> "previousVersions" .= map (ObjURI a) versions |
|
+ | 937 | <> "currentVersion" .=? (ObjURI a <$> mcurrent) |
|
+ | 938 | ||
+ | 939 | data Bundle u |
|
+ | 940 | = BundleHosted (Maybe BundleLocal) (NonEmpty LocalURI) |
|
+ | 941 | | BundleOffer (Maybe (Authority u, BundleLocal)) (NonEmpty (Patch u)) |
|
+ | 942 | ||
+ | 943 | instance ActivityPub Bundle where |
|
+ | 944 | jsonldContext _ = [as2Context, forgeContext] |
|
+ | 945 | ||
+ | 946 | parseObject o = do |
|
+ | 947 | typ <- o .: "type" |
|
+ | 948 | unless (typ == ("OrderedCollection" :: Text)) $ |
|
+ | 949 | fail "type isn't OrderedCollection" |
|
+ | 950 | ||
+ | 951 | mlocal <- parseBundleLocal o |
|
+ | 952 | mtotal <- o .:? "totalItems" |
|
+ | 953 | ||
+ | 954 | items <- toEither <$> o .: "orderedItems" <|> o .: "items" |
|
+ | 955 | case items of |
|
+ | 956 | Left (ObjURI h lu :| us) -> do |
|
+ | 957 | for_ mlocal $ \ (h', _) -> |
|
+ | 958 | unless (h == h') $ |
|
+ | 959 | fail "Patches in bundle not on the same host as bundle" |
|
+ | 960 | unless (all (== h) $ map objUriAuthority us) $ |
|
+ | 961 | fail "Patches in bundle on different hosts" |
|
+ | 962 | for_ mtotal $ \ total -> |
|
+ | 963 | unless (length us + 1 == total) $ |
|
+ | 964 | fail "Incorrect totalItems" |
|
+ | 965 | return (h, BundleHosted (snd <$> mlocal) $ lu :| map objUriLocal us) |
|
+ | 966 | Right (Doc h p :| ps) -> do |
|
+ | 967 | unless (all (== h) $ map docAuthority ps) $ |
|
+ | 968 | fail "Patches in bundle have different authors" |
|
+ | 969 | for_ mtotal $ \ total -> |
|
+ | 970 | unless (length ps + 1 == total) $ |
|
+ | 971 | fail "Incorrect totalItems" |
|
+ | 972 | return (h, BundleOffer mlocal $ p :| map docValue ps) |
|
+ | 973 | ||
+ | 974 | toSeries hBundle (BundleHosted mlocal lus) |
|
+ | 975 | = maybe mempty (encodeBundleLocal hBundle) mlocal |
|
+ | 976 | <> "type" .= ("OrderedCollection" :: Text) |
|
+ | 977 | <> "totalItems" .= length lus |
|
+ | 978 | <> "orderedItems" .= NE.map (ObjURI hBundle) lus |
|
+ | 979 | toSeries hAttrib (BundleOffer mlocal patches) |
|
+ | 980 | = maybe mempty (uncurry encodeBundleLocal) mlocal |
|
+ | 981 | <> "type" .= ("OrderedCollection" :: Text) |
|
+ | 982 | <> "totalItems" .= length patches |
|
+ | 983 | <> "orderedItems" .= NE.map (Doc hAttrib) patches |
|
+ | 984 | ||
… | … | … | … |
- | 1044 | , mrPatch :: Either (ObjURI u) (Authority u, Patch u) |
|
+ | 1121 | , mrBundle :: Either (ObjURI u) (Authority u, Bundle u) |
|
… | … | … | … |
- | 1065 | toSeries h (MergeRequest morigin target patch) |
|
+ | 1142 | toSeries h (MergeRequest morigin target bundle) |
|
- | 1069 | <> "object" .= fromEither (second (uncurry Doc) patch) |
|
+ | 1146 | <> "object" .= fromEither (second (uncurry Doc) bundle) |
|
… | … | … | … |