diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index cd2933d..032d3c0 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -115,6 +115,7 @@ import Vervis.Model.Ticket import Vervis.Path import Vervis.Persist.Actor import Vervis.Persist.Collab +import Vervis.Persist.Ticket import Vervis.Recipient import Vervis.RemoteActorStore import Vervis.Settings @@ -597,24 +598,10 @@ applyC -> Audience URIMode -> Apply URIMode -> ExceptT Text Handler OutboxItemId -applyC (Entity senderPersonID senderPerson) senderActor muCap summary audience (AP.Apply uObject target) = do +applyC (Entity senderPersonID senderPerson) senderActor muCap summary audience apply = do -- Check input - maybeLocalTarget <- do - bundle <- parseProposalBundle "Apply object" uObject - targetTip <- nameExceptT "Apply target" $ checkTip target - let maybeLocal = - case targetTip of - TipLocalRepo repoID -> Just (repoID, Nothing) - TipLocalBranch repoID branch -> Just (repoID, Just branch) - TipRemote _ -> Nothing - TipRemoteBranch _ _ -> Nothing - for maybeLocal $ \ (repoID, maybeBranch) -> do - (loomID, clothID, bundleID) <- - case bundle of - Left b -> pure b - Right _ -> throwE "Applying a remote bundle on local loom" - return (repoID, maybeBranch, loomID, clothID, bundleID) + maybeLocalTarget <- checkApplyLocalLoom apply ParsedAudience localRecips remoteRecips blinded fwdHosts <- do mrecips <- parseAudience audience fromMaybeE mrecips "Apply with no recipients" @@ -636,89 +623,23 @@ applyC (Entity senderPersonID senderPerson) senderActor muCap summary audience ( maybeLocalTargetDB <- for maybeLocalTarget $ \ (repoID, maybeBranch, loomID, clothID, bundleID) -> runDBExcept $ do - -- Find the bundle and its loom in DB - (loom, clothBranch, ticketID, maybeResolve, latest) <- do - maybeBundle <- lift $ runMaybeT $ do - (Entity _ loom, Entity _ cloth, Entity ticketID _, _author, resolve, proposal) <- - MaybeT $ getCloth loomID clothID - bundle <- MaybeT $ get bundleID - guard $ bundleTicket bundle == clothID - latest :| _prevs <- - case justHere proposal of - Nothing -> - error "Why didn't getCloth find any bundles" - Just bundles -> return bundles - return (loom, ticketLoomBranch cloth, ticketID, resolve, latest) - fromMaybeE maybeBundle "" - - -- Verify the target repo/branch iof the Apply is identical to the - -- target repo/branch of the MR - unless (maybeBranch == clothBranch) $ - throwE "Apply target != MR target" - - -- Find target repo in DB and verify it consents to being served by - -- the loom - unless (repoID == loomRepo loom) $ - throwE "MR target repo isn't the one served by the Apply object bundle's loom" - repo <- getE repoID "Apply target: No such local repo in DB" - unless (repoLoom repo == Just loomID) $ - throwE "Apply object bunde's loom doesn't have repo's consent to serve it" - - -- Verify that VCS type matches the presence of a branch: - -- Branch specified for Git, isn't specified for Darcs - case (repoVcs repo, maybeBranch) of - (VCSDarcs, Nothing) -> pure () - (VCSGit, Just _) -> pure () - _ -> throwE "VCS type and branch presence mismatch" - - -- Verify the MR isn't already resolved and the bundle is the - -- latest version - unless (isNothing maybeResolve) $ - throwE "MR is already resolved" - unless (bundleID == latest) $ - throwE "Bundle isn't the latest version" - - -- Verify the sender is authorized by the loom to apply a patch - capability <- - case capID of - Left (actor, _, item) -> return (actor, item) - Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local loom" - verifyCapability capability (Left senderPersonID) (GrantResourceLoom loomID) - - -- Get the patches from DB, verify VCS match just in case - diffs <- do - ps <- - lift $ map entityVal <$> - selectList [PatchBundle ==. bundleID] [Asc PatchId] - let patchVCS = patchMediaTypeVCS . patchType - case NE.nonEmpty ps of - Nothing -> error "Bundle without patches" - Just ne -> - if all ((== repoVcs repo) . patchVCS) ne - then return $ NE.map patchContent ne - else throwE "Patch type mismatch with repo VCS type" + -- Find the repo and the bundle in our DB, and verify that the loom + -- hosting the bundle is willing to accept the request from sender + -- to apply this specific bundle to this repo/branch + (loom, ticketID, diffs) <- + checkApplyDB + (Left senderPersonID) + capID + (repoID, maybeBranch) + (loomID, clothID, bundleID) return (Entity loomID loom, clothID, ticketID, repoID, maybeBranch, diffs) -- Apply patches - for_ maybeLocalTargetDB $ \ (_, _, _, repoID, maybeBranch, diffs) -> do - repoPath <- do - repoHash <- encodeKeyHashid repoID - repoDir <- askRepoDir repoHash - liftIO $ makeAbsolute repoDir - case maybeBranch of - Just branch -> do - ExceptT $ liftIO $ runExceptT $ - withSystemTempDirectory "vervis-applyC" $ - applyGitPatches repoPath (T.unpack branch) diffs - Nothing -> do - patch <- - case diffs of - t :| [] -> return t - _ :| (_ : _) -> - throwE "Darcs repo given multiple patch bundles" - applyDarcsPatch repoPath patch + for_ maybeLocalTargetDB $ + \ (_, _, _, repoID, maybeBranch, diffs) -> + applyPatches repoID maybeBranch diffs senderHash <- encodeKeyHashid senderPersonID now <- liftIO getCurrentTime @@ -824,7 +745,7 @@ applyC (Entity senderPersonID senderPerson) senderActor muCap summary audience ( , activitySummary = summary , activityAudience = blinded , activityFulfills = [] - , activitySpecific = ApplyActivity $ Apply uObject target + , activitySpecific = ApplyActivity apply } update applyID [OutboxItemActivity =. persistJSONObjectFromDoc doc] return (luApply, doc) diff --git a/src/Vervis/Data/Ticket.hs b/src/Vervis/Data/Ticket.hs index 81c5951..d29ca1d 100644 --- a/src/Vervis/Data/Ticket.hs +++ b/src/Vervis/Data/Ticket.hs @@ -19,8 +19,8 @@ module Vervis.Data.Ticket , Merge (..) , TrackerAndMerge (..) , WorkItemOffer (..) - , checkTip , checkOfferTicket + , checkApplyLocalLoom -- These are exported only for Vervis.Client , Tracker (..) @@ -50,6 +50,7 @@ import Control.Monad.Trans.Except.Local import Vervis.Foundation import Vervis.FedURI import Vervis.Model +import Vervis.Ticket data Tip = TipLocalRepo RepoId @@ -199,3 +200,30 @@ checkOfferTicket host ticket uTarget = do unless (tracker == target) $ throwE "Offer target != ticket context" tam <- checkTrackerAndMerge target maybeBundle return $ WorkItemOffer author title desc source tam + +checkApply + :: AP.Apply URIMode + -> ExceptT Text Handler + (Either (LoomId, TicketLoomId, BundleId) FedURI, Tip) +checkApply (AP.Apply uObject target) = + (,) <$> parseProposalBundle "Apply object" uObject + <*> nameExceptT "Apply target" (checkTip target) + +checkApplyLocalLoom + :: AP.Apply URIMode + -> ExceptT Text Handler + (Maybe (RepoId, Maybe Text, LoomId, TicketLoomId, BundleId)) +checkApplyLocalLoom apply = do + (bundle, targetTip) <- checkApply apply + let maybeLocal = + case targetTip of + TipLocalRepo repoID -> Just (repoID, Nothing) + TipLocalBranch repoID branch -> Just (repoID, Just branch) + TipRemote _ -> Nothing + TipRemoteBranch _ _ -> Nothing + for maybeLocal $ \ (repoID, maybeBranch) -> do + (loomID, clothID, bundleID) <- + case bundle of + Left b -> pure b + Right _ -> throwE "Applying a remote bundle on local loom" + return (repoID, maybeBranch, loomID, clothID, bundleID) diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 73be9f9..42d6fda 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -20,8 +20,7 @@ module Vervis.Federation.Ticket --, repoAddBundleF - --, repoApplyF - --, loomApplyF + , loomApplyF --, deckOfferDepF --, repoOfferDepF @@ -94,6 +93,7 @@ import Development.PatchMediaType import Vervis.ActivityPub import Vervis.Cloth +import Vervis.Data.Actor import Vervis.Data.Ticket import Vervis.Darcs import Vervis.Delivery @@ -107,6 +107,7 @@ import Vervis.Model import Vervis.Model.Role import Vervis.Model.Ticket import Vervis.Path +import Vervis.Persist.Ticket import Vervis.Query import Vervis.Recipient import Vervis.Ticket @@ -499,6 +500,12 @@ deckOfferTicketF now recipDeckHash author body mfwd luOffer ticket uTarget = do update acceptID [OutboxItemActivity =. persistJSONObjectFromDoc doc] return (doc, recipientSet, remoteActors, fwdHosts) +activityAlreadyInInbox hAct luAct inboxID = fmap isJust . runMaybeT $ do + instanceID <- MaybeT $ getKeyBy $ UniqueInstance hAct + remoteObjectID <- MaybeT $ getKeyBy $ UniqueRemoteObject instanceID luAct + remoteActivityID <- MaybeT $ getKeyBy $ UniqueRemoteActivity remoteObjectID + MaybeT $ getBy $ UniqueInboxItemRemote inboxID remoteActivityID + loomOfferTicketF :: UTCTime -> KeyHashid Loom @@ -577,13 +584,11 @@ loomOfferTicketF now recipLoomHash author body mfwd luOffer ticket uTarget = do -- Has the loom already received this activity to its inbox? If yes, we -- won't process it again - maybeAlreadyInInbox <- runMaybeT $ do - instanceID <- MaybeT $ getKeyBy $ UniqueInstance $ objUriAuthority $ remoteAuthorURI author - remoteObjectID <- MaybeT $ getKeyBy $ UniqueRemoteObject instanceID luOffer - remoteActivityID <- MaybeT $ getKeyBy $ UniqueRemoteActivity remoteObjectID - MaybeT $ getBy $ UniqueInboxItemRemote (actorInbox actor) remoteActivityID + alreadyInInbox <- do + let hOffer = objUriAuthority $ remoteAuthorURI author + activityAlreadyInInbox hOffer luOffer (actorInbox actor) - return (recipLoomRepoID, recipLoomActor, isJust maybeAlreadyInInbox) + return (recipLoomRepoID, recipLoomActor, alreadyInInbox) if alreadyInInbox then return ("I already have this activity in my inbox, ignoring", Nothing) @@ -1169,564 +1174,204 @@ repoAddBundleF now recipHash author body mfwd luAdd patches uTarget = do shrRecip rpRecip (hashLTID ltid) -} -repoApplyF +loomApplyF :: UTCTime - -> KeyHashid Repo + -> KeyHashid Loom -> RemoteAuthor -> ActivityBody -> Maybe (RecipientRoutes, ByteString) -> LocalURI - -> FedURI - -> FedURI + -> AP.Apply URIMode -> ExceptT Text Handler (Text, Maybe (ExceptT Text Worker Text)) -repoApplyF now recipHash author body mfwd luApply uObject uTarget = do - error "repoApplyF temporarily disabled" +loomApplyF now recipLoomHash author body mfwd luApply apply = (,Nothing) <$> do - -{- - - - -- Verify the patch bundle URI is one of: - -- * A local sharer-hosted bundle - -- * A local repo-hosted bundle under the receiving repo - -- * A remote URI - bundle <- do - b <- parseProposalBundle "repoApplyF Apply object, a URI" uObject - case b of - Left (Right (shr, rp, ltid, bnid)) -> - if shr == shrRecip && rp == rpRecip - then return $ Left $ Right (ltid, bnid) - else throwE "Bundle is some other local repo's repo-hosted bundle" - Left (Left x) -> return $ Left $ Left x - Right u -> return $ Right u - - -- Verify the apply's target is one of: - -- * The URI of the receiving repo - -- * A local branch URI under the receiving repo - -- * A remote URI - mbranch <- do - target <- checkBranch' uTarget - case target of - Left (shr, rp, mb) | shr == shrRecip && rp == rpRecip -> return mb - _ -> throwE "Apply target isn't me, so, ignoring this activity" + -- Check input + recipLoomID <- decodeKeyHashid404 recipLoomHash + (repoID, maybeBranch, clothID, bundleID) <- do + maybeLocalTarget <- checkApplyLocalLoom apply + (repoID, maybeBranch, loomID, clothID, bundleID) <- + fromMaybeE + maybeLocalTarget + "Bundle doesn't belong to a local loom, in particular not to \ + \me, so I won't apply it. Was I supposed to receive it?" + unless (loomID == recipLoomID) $ + throwE + "Bundle belongs to some other local loom, so I won't apply \ + \it. Was I supposed to receive it?" + return (repoID, maybeBranch, clothID, bundleID) -- Verify the capability URI is one of: -- * Outbox item URI of a local actor, i.e. a local activity -- * A remote URI - capID <- do + uCap <- do let muCap = activityCapability $ actbActivity body - uCap <- fromMaybeE muCap "Asking to apply patch but no capability provided" - parseActivityURI "Apply capability" uCap + fromMaybeE muCap "Asking to apply patch but no capability provided" + capID <- nameExceptT "Apply capability" $ parseActivityURI uCap - -- Make sure receiving repo exists in DB, otherwise its inbox doesn't exist - -- either thus we return 404 - Entity ridRecip repoRecip <- lift $ runDB $ do - sid <- getKeyBy404 $ UniqueSharer shrRecip - getBy404 $ UniqueRepo rpRecip sid - return $ (,) "Ran initial checks, doing the rest asynchronously" $ Just $ do + maybeNewApply <- runDBExcept $ do - -- Check in DB whether the provided capability matches a DB - -- record we have, and that it includes permission to apply MRs - runSiteDBExcept $ do - -- Find the activity itself by URI in the DB - act <- do - mact <- getActivity capID - fromMaybeE mact "Capability activity not known to me" - -- Find the Collab record for that activity - cid <- - case act of - Left (_actor, obiid) -> do - mcsl <- lift $ getValBy $ UniqueCollabSenderLocalActivity obiid - collabSenderLocalCollab <$> - fromMaybeE mcsl "Capability is a local activity but no matching capability" - Right ractid -> do - mcsr <- lift $ getValBy $ UniqueCollabSenderRemoteActivity ractid - collabSenderRemoteCollab <$> - fromMaybeE mcsr "Capability is a known remote activity but no matching capability" - -- Find the recipient of that Collab - raidCollab <- do - mcrr <- lift $ getValBy $ UniqueCollabRecipRemote cid - crr <- fromMaybeE mcrr "No remote recip for capability" - mcrl <- lift $ getBy $ UniqueCollabRecipLocal cid - verifyNothingE mcrl "Both local & remote recip for capability!" - return $ collabRecipRemoteActor crr - -- Verify the recipient is the author of the Apply activity - unless (raidCollab == remoteAuthorId author) $ - throwE "Collab recipient isn't the Apply author" - -- Find the repo to which this Collab gives access - ridCap <- do - mctlr <- lift $ getValBy $ UniqueCollabTopicLocalRepo cid - rid <- - collabTopicLocalRepoRepo <$> - fromMaybeE mctlr "Collab isn't for a repo" - mctlj <- lift $ getBy $ UniqueCollabTopicLocalProject cid - verifyNothingE mctlj "Collab topic duplicate, found project" - mctr <- lift $ getBy $ UniqueCollabTopicRemote cid - verifyNothingE mctr "Collab topic duplicate, found remote" - return rid - -- Verify that repo is us - unless (ridCap == ridRecip) $ - throwE "Capability topic is some other local repo" - -- Find the collaborator's role in the repo - mrlid <- - lift $ fmap collabRoleLocalRole <$> - getValBy (UniqueCollabRoleLocal cid) - -- If no role specified, that means Developer role with - -- access to apply changes to repo source code, otherwise - -- make sure the specified role (or an ancestor of it) has - -- access to the relevant operation - for_ mrlid $ \ rlid -> do - let roleHas role op = getBy $ UniqueRoleAccess role op - ancestorHas = flip getProjectRoleAncestorWithOpQ - roleHasAccess role op = - fmap isJust . runMaybeT $ - MaybeT (roleHas role op) <|> - MaybeT (ancestorHas role op) - has <- lift $ roleHasAccess rlid ProjOpApplyPatch - unless has $ - throwE - "Apply author's role in repo doesn't have \ - \ApplyPatch access" + -- Find recipient loom in DB, returning 404 if doesn't exist because + -- we're in the loom's inbox post handler + recipLoom <- lift $ get404 recipLoomID + let recipLoomActorID = loomActor recipLoom + recipLoomActor <- lift $ getJust recipLoomActorID - -- We verified apply permission, now let's examine the bundle itself - case bundle of - Left (Left (shr, talid, bnid)) -> do - -- Verify we have this ticket and bundle in the DB - -- Verify the ticket is listed under the repo - -- Verify the bundle is the latest version - mticket <- lift $ runSiteDB $ getSharerProposal shr talid - (_, Entity ltid _, _, context, mresolved, bnid' :| _) <- fromMaybeE mticket "Apply object: No such local ticket" - case context of - Left (_, Entity _ trl) -> - unless (ticketRepoLocalRepo trl == ridRecip) $ - throwE "Apply object: Ticket under some other local repo" - Right _ -> throwE "Apply object: Ticket not under a local repo" - _ <- fromMaybeE mresolved "Apply object: Proposal already applied" - unless (bnid == bnid') $ - throwE "Apply object: Bundle isn't the latest version" + -- Has the loom already received this activity to its inbox? If yes, we + -- won't process it again + alreadyInInbox <- lift $ do + let hOffer = objUriAuthority $ remoteAuthorURI author + activityAlreadyInInbox hOffer luApply (actorInbox recipLoomActor) - -- Grab the bundle's patches from DB and apply them - patches <- lift $ runSiteDB $ selectList [PatchBundle ==. bnid] [Asc PatchId] - case repoVcs repoRecip of - VCSGit -> do - branch <- fromMaybeE mbranch "Apply target is a Git repo, branch not specified" - patches' <- - case NE.nonEmpty patches of - Nothing -> error "No patches found in DB" - Just ps -> return ps - let essence (Patch _ _ typ t) = (typ, t) - patches'' = NE.map (essence . entityVal) patches' - unless (all ((== PatchMediaTypeGit) . fst) patches'') $ - throwE "Trying to apply non-Git patch to a Git repo" - applyGitPatches shrRecip rpRecip branch $ NE.map snd patches'' - VCSDarcs -> do - verifyNothingE mbranch "Apply target is a branch of a Darcs repo" - patch <- - case patches of - [] -> error "Local repo-bundle without any patches found" - _ : (_ : _) -> throwE "Darcs repo given multiple patch bundles" - (Entity _ (Patch _ _ typ t)) : [] -> - case typ of - PatchMediaTypeDarcs -> return t - _ -> throwE "Trying to apply non-Darcs patch to a Darcs repo" - applyDarcsPatch shrRecip rpRecip patch + -- Find the repo and the bundle in our DB, and verify that the loom is + -- willing to accept the request from sender to apply this specific + -- bundle to this repo/branch + if alreadyInInbox + then pure Nothing + else Just <$> do + (_, ticketID, diffs) <- + checkApplyDB + (Right $ remoteAuthorId author) capID + (repoID, maybeBranch) (recipLoomID, clothID, bundleID) + return (Entity recipLoomActorID recipLoomActor, ticketID, diffs) - -- Insert Apply activity to repo's inbox - -- Produce an Accept activity and deliver locally - -- Mark the ticket as resolved - mhttp <- lift $ runSiteDB $ do - mractid <- insertToInbox now author body (repoInbox repoRecip) luApply False - for mractid $ \ ractid -> do - mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do - talkhid <- encodeKeyHashid talid - let sieve = - makeRecipientSet - [] - [ LocalPersonCollectionSharerProposalFollowers shrRecip talkhid - , LocalPersonCollectionRepoTeam shrRecip rpRecip - , LocalPersonCollectionRepoFollowers shrRecip rpRecip - ] - remoteRecips <- - insertRemoteActivityToLocalInboxes - False ractid $ - localRecipSieve' - sieve False False localRecips - (sig,) <$> deliverRemoteDB_R (actbBL body) ractid ridRecip sig remoteRecips - obiidAccept <- insertEmptyOutboxItem (repoOutbox repoRecip) now + case maybeNewApply of + Nothing -> + return "I already have this activity in my inbox, doing nothing" + Just (Entity recipLoomActorID recipLoomActor, ticketID, diffs) -> do - _ <- insertResolve author ltid ractid obiidAccept + -- Apply patches + applyPatches repoID maybeBranch diffs - (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- - insertAcceptLocalSharer luApply shr talid obiidAccept + maybeHttp <- lift $ runDB $ do - knownRemoteRecipsAccept <- - deliverLocal' - False - (LocalActorRepo shrRecip rpRecip) - (repoInbox repoRecip) - obiidAccept - localRecipsAccept - (mremotesHttpFwd, obiidAccept, docAccept, fwdHostsAccept,) <$> - deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept + -- Insert the Apply to loom's inbox + mractid <- insertToInbox now author body (actorInbox recipLoomActor) luApply False + for mractid $ \ applyID -> do - -- Run inbox-forwarding on the Apply activity - -- Deliver Accept activity to remote recipients via HTTP - case mhttp of - Nothing -> return "I already have this activity in my inbox, doing nothing" - Just (mremotesHttpFwd, obiid, doc, fwdHosts, recips) -> do - for_ mremotesHttpFwd $ \ (sig, remotes) -> - forkWorker "repoApplyF inbox-forwarding" $ - deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes - forkWorker "repoApplyF Accept HTTP delivery" $ - deliverRemoteHttp' fwdHosts obiid doc recips + -- Forward the Apply activity to relevant local stages, and + -- schedule delivery for unavailable remote members of them + maybeHttpFwdApply <- for mfwd $ \ (localRecips, sig) -> do + clothHash <- encodeKeyHashid clothID + let sieve = + makeRecipientSet + [] + [ LocalStageLoomFollowers recipLoomHash + , LocalStageClothFollowers recipLoomHash clothHash + ] + remoteRecips <- + insertRemoteActivityToLocalInboxes False applyID $ + localRecipSieve' sieve False False localRecips + remoteRecipsHttp <- + deliverRemoteDB_L + (actbBL body) applyID recipLoomID sig remoteRecips return $ - if isJust mremotesHttpFwd - then "Applied patches, did inbox-forwarding" - else "Applied patches, no inbox-forwarding to do" + deliverRemoteHTTP_L + now recipLoomHash (actbBL body) sig remoteRecipsHttp - Left (Right (ltid, bnid)) -> do - -- Verify we have this ticket and bundle in the DB, and that - -- the bundle is the latest version - mticket <- lift $ runSiteDB $ getRepoProposal shrRecip rpRecip ltid - (_, _, _, _, _, _, _, mresolved, bnid' :| _) <- fromMaybeE mticket "Apply object: No such local ticket" - _ <- fromMaybeE mresolved "Apply object: Proposal already applied" - unless (bnid == bnid') $ - throwE "Apply object: Bundle isn't the latest version" + -- Mark ticket in DB as resolved by the Apply + acceptID <- + insertEmptyOutboxItem (actorOutbox recipLoomActor) now + insertResolve ticketID applyID acceptID - -- Grab the bundle's patches from DB and apply them - patches <- lift $ runSiteDB $ selectList [PatchBundle ==. bnid] [Asc PatchId] - case repoVcs repoRecip of - VCSGit -> do - branch <- fromMaybeE mbranch "Apply target is a Git repo, branch not specified" - patches' <- - case NE.nonEmpty patches of - Nothing -> error "No patches found in DB" - Just ps -> return ps - let essence (Patch _ _ typ t) = (typ, t) - patches'' = NE.map (essence . entityVal) patches' - unless (all ((== PatchMediaTypeGit) . fst) patches'') $ - throwE "Trying to apply non-Git patch to a Git repo" - applyGitPatches shrRecip rpRecip branch $ NE.map snd patches'' - VCSDarcs -> do - verifyNothingE mbranch "Apply target is a branch of a Darcs repo" - patch <- - case patches of - [] -> error "Local repo-bundle without any patches found" - _ : (_ : _) -> throwE "Darcs repo given multiple patch bundles" - (Entity _ (Patch _ _ typ t)) : [] -> - case typ of - PatchMediaTypeDarcs -> return t - _ -> throwE "Trying to apply non-Darcs patch to a Darcs repo" - applyDarcsPatch shrRecip rpRecip patch + -- Prepare an Accept activity and insert to loom's outbox + (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- + insertAcceptToOutbox uCap clothID acceptID - -- Insert Apply activity to repo's inbox - -- Produce an Accept activity and deliver locally - -- Mark the ticket as resolved - mhttp <- lift $ runSiteDB $ do - mractid <- insertToInbox now author body (repoInbox repoRecip) luApply False - for mractid $ \ ractid -> do - mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do - ltkhid <- encodeKeyHashid ltid - let sieve = - makeRecipientSet - [] - [ LocalPersonCollectionRepoProposalFollowers shrRecip rpRecip ltkhid - , LocalPersonCollectionRepoTeam shrRecip rpRecip - , LocalPersonCollectionRepoFollowers shrRecip rpRecip - ] - remoteRecips <- - insertRemoteActivityToLocalInboxes - False ractid $ - localRecipSieve' - sieve False False localRecips - (sig,) <$> deliverRemoteDB_R (actbBL body) ractid ridRecip sig remoteRecips - obiidAccept <- insertEmptyOutboxItem (repoOutbox repoRecip) now + -- Deliver the Accept to local recipients, and schedule delivery + -- for unavailable remote recipients + knownRemoteRecipsAccept <- + deliverLocal' + False (LocalActorLoom recipLoomHash) recipLoomActorID + acceptID localRecipsAccept + remoteRecipsHttpAccept <- + deliverRemoteDB'' + fwdHostsAccept acceptID remoteRecipsAccept + knownRemoteRecipsAccept - _ <- insertResolve author ltid ractid obiidAccept + -- Return instructions for HTTP inbox-forwarding of the Apply + -- activity, and for HTTP delivery of the Accept activity to + -- remote recipients + return + ( maybeHttpFwdApply + , deliverRemoteHttp' + fwdHostsAccept acceptID docAccept remoteRecipsHttpAccept + ) - (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- - insertAcceptLocalRepo luApply ltid obiidAccept - - knownRemoteRecipsAccept <- - deliverLocal' - False - (LocalActorRepo shrRecip rpRecip) - (repoInbox repoRecip) - obiidAccept - localRecipsAccept - (mremotesHttpFwd, obiidAccept, docAccept, fwdHostsAccept,) <$> - deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept - - -- Run inbox-forwarding on the Apply activity - -- Deliver Accept activity to remote recipients via HTTP - case mhttp of - Nothing -> return "I already have this activity in my inbox, doing nothing" - Just (mremotesHttpFwd, obiid, doc, fwdHosts, recips) -> do - for_ mremotesHttpFwd $ \ (sig, remotes) -> - forkWorker "repoApplyF inbox-forwarding" $ - deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes - forkWorker "repoApplyF Accept HTTP delivery" $ - deliverRemoteHttp' fwdHosts obiid doc recips - return $ - if isJust mremotesHttpFwd - then "Applied patches, did inbox-forwarding" - else "Applied patches, no inbox-forwarding to do" - - Right uBundle@(ObjURI hBundle luBundle) -> do - - -- Verify it's a latest-version bundle pointed by a ticket we - -- have listed under the receiving repo - manager <- asksSite appHttpManager - Doc h b <- withExceptT T.pack $ AP.fetchAP manager $ Left uBundle - (BundleLocal bid ctx _prevs mcurr, lus) <- - case b of - BundleHosted Nothing _ -> throwE "No bundle @id" - BundleHosted (Just l) ps -> return (l, ps) - BundleOffer _ _ -> throwE "Why does bundle contain patch objects" - unless (h == hBundle && bid == luBundle) $ - throwE "Bundle 'id' differs from the URI we fetched" - for_ mcurr $ \ curr -> - throwE $ - if curr == bid - then "Bundle currentVersion points to itself" - else "Bundle isn't the latest version" - let uTicket = ObjURI h ctx - Doc _ ticket <- withExceptT T.pack $ AP.fetchAP manager $ Left uTicket - (_, tlocal) <- fromMaybeE (AP.ticketLocal ticket) "Ticket has no @id" - (h', mr) <- fromMaybeE (AP.ticketAttachment ticket) "Ticket has no 'attachment'" - unless (ObjURI h' (mrTarget mr) == uTarget) $ - throwE "Ticket MR target isn't me / branch" - case mrBundle mr of - Left u -> - if u == uBundle - then pure () - else throwE "Bundle isn't the one pointed by ticket" - Right _ -> throwE "Ticket has bundle object instead of just URI" - e <- runSiteDBExcept $ getRemoteTicketByURI uTicket - case e of - Right (_, _, _, _, _, Right (Entity _ trl)) - | ticketRepoLocalRepo trl == ridRecip -> pure () - _ -> throwE "I don't have the ticket listed under me" - - -- HTTP GET all the patches, examine and apply them - patches <- for lus $ \ luPatch -> do - Doc _ (AP.Patch mlocal _luAttrib _mpub typ content) <- - withExceptT T.pack $ AP.fetchAP manager $ Left $ ObjURI hBundle luPatch - (h, PatchLocal luP luC) <- fromMaybeE mlocal "No patch @id" - unless (ObjURI h luP == ObjURI hBundle luPatch) $ - throwE "Patch @id doesn't match the URI we fetched" - unless (luC == luBundle) $ - throwE "Patch doesn't point back to the bundle" - unless (patchMediaTypeVCS typ == repoVcs repoRecip) $ - throwE "Patch type and repo VCS mismatch" - return (typ, content) - case repoVcs repoRecip of - VCSGit -> do - branch <- fromMaybeE mbranch "Apply target is a Git repo, branch not specified" - unless (all ((== PatchMediaTypeGit) . fst) patches) $ - throwE "Trying to apply non-Git patch to a Git repo" - applyGitPatches shrRecip rpRecip 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" - (typ, t) :| [] -> - case typ of - PatchMediaTypeDarcs -> return t - _ -> throwE "Trying to apply non-Darcs patch to a Darcs repo" - applyDarcsPatch shrRecip rpRecip patch - - -- Insert Apply activity to repo's inbox - -- Produce an Accept activity and deliver locally - mhttp <- lift $ runSiteDB $ do - mractid <- insertToInbox now author body (repoInbox repoRecip) luApply False - for mractid $ \ ractid -> do - mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do - let sieve = - makeRecipientSet - [] - [ LocalPersonCollectionRepoTeam shrRecip rpRecip - , LocalPersonCollectionRepoFollowers shrRecip rpRecip - ] - remoteRecips <- - insertRemoteActivityToLocalInboxes - False ractid $ - localRecipSieve' - sieve False False localRecips - (sig,) <$> deliverRemoteDB_R (actbBL body) ractid ridRecip sig remoteRecips - obiidAccept <- insertEmptyOutboxItem (repoOutbox repoRecip) now - - (docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <- - insertAcceptRemote luApply hBundle tlocal obiidAccept - - knownRemoteRecipsAccept <- - deliverLocal' - False - (LocalActorRepo shrRecip rpRecip) - (repoInbox repoRecip) - obiidAccept - localRecipsAccept - (mremotesHttpFwd, obiidAccept, docAccept, fwdHostsAccept,) <$> - deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept - - -- Run inbox-forwarding on the Apply activity - -- Deliver Accept activity to remote recipients via HTTP - case mhttp of - Nothing -> return "I already have this activity in my inbox, doing nothing" - Just (mremotesHttpFwd, obiid, doc, fwdHosts, recips) -> do - for_ mremotesHttpFwd $ \ (sig, remotes) -> - forkWorker "repoApplyF inbox-forwarding" $ - deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes - forkWorker "repoApplyF Accept HTTP delivery" $ - deliverRemoteHttp' fwdHosts obiid doc recips - return $ - if isJust mremotesHttpFwd - then "Applied patches, did inbox-forwarding" - else "Applied patches, no inbox-forwarding to do" - - {- - TODO to be clear: When a repo receives a Ticket, does it store the whole - ticket and bundle and patches in DB? - ANSWER: Yes, it does - - And when a repo is notified on a new bundle version for such a - remotely hosted Ticket, does it store this new bundle and its patches - in the local DB? - ANSWER: No, it stores only for a repo-hosted own Ticket - - TODO if I'm the target, am I a darcs repo? - - TODO if a branch of mine is the target, am I a git repo? - -} + -- Launch asynchronous HTTP forwarding of the Apply activity and HTTP + -- delivery of the Accept activity + case maybeHttp of + Nothing -> + return + "When I started serving this activity, I didn't have it in my inbox, \ + \but now suddenly it seems I already do, so ignoring" + Just (maybeHttpFwdApply, deliverHttpAccept) -> do + forkWorker "loomApplyF Accept HTTP delivery" deliverHttpAccept + case maybeHttpFwdApply of + Nothing -> return "Applied the patch(es), no inbox-forwarding to do" + Just forwardHttpApply -> do + forkWorker "loomApplyF inbox-forwarding" forwardHttpApply + return "Applied the patch(es) and ran inbox-forwarding of the Apply" where - insertAcceptRemote luApply hTicket tlocal obiidAccept = do + + insertResolve ticketID applyID acceptID = do + trid <- insert TicketResolve + { ticketResolveTicket = ticketID + , ticketResolveAccept = acceptID + } + insert_ TicketResolveRemote + { ticketResolveRemoteTicket = trid + , ticketResolveRemoteActivity = applyID + , ticketResolveRemoteActor = remoteAuthorId author + } + update ticketID [TicketStatus =. TSClosed] + + insertAcceptToOutbox uCap clothID acceptID = do encodeRouteLocal <- getEncodeRouteLocal encodeRouteHome <- getEncodeRouteHome hLocal <- asksSite siteInstanceHost - obikhidAccept <- encodeKeyHashid obiidAccept + + clothHash <- encodeKeyHashid clothID + acceptHash <- encodeKeyHashid acceptID + ra <- getJust $ remoteAuthorId author + let ObjURI hAuthor luAuthor = remoteAuthorURI author - audAuthor = - AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra) - - audTicket = - AudRemote hTicket [] [AP.ticketParticipants tlocal] - - audRepo = + audSender = + AudRemote hAuthor + [luAuthor] + (maybeToList $ remoteActorFollowers ra) + audTracker = AudLocal [] - [ LocalPersonCollectionRepoTeam shrRecip rpRecip - , LocalPersonCollectionRepoFollowers shrRecip rpRecip + [ LocalStageLoomFollowers recipLoomHash + , LocalStageClothFollowers recipLoomHash clothHash ] (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = - collectAudience [audAuthor, audTicket, audRepo] + collectAudience [audSender, audTracker] recips = map encodeRouteHome audLocal ++ audRemote - doc = Doc hLocal Activity - { activityId = + doc = AP.Doc hLocal AP.Activity + { AP.activityId = Just $ encodeRouteLocal $ - RepoOutboxItemR shrRecip rpRecip obikhidAccept - , activityActor = encodeRouteLocal $ RepoR shrRecip rpRecip - , activityCapability = Nothing - , activitySummary = Nothing - , activityAudience = Audience recips [] [] [] [] [] - , activitySpecific = AcceptActivity Accept + LoomOutboxItemR recipLoomHash acceptHash + , AP.activityActor = + encodeRouteLocal $ LoomR recipLoomHash + , AP.activityCapability = Just uCap + , AP.activitySummary = Nothing + , AP.activityAudience = AP.Audience recips [] [] [] [] [] + , AP.activityFulfills = [] + , AP.activitySpecific = AP.AcceptActivity AP.Accept { acceptObject = ObjURI hAuthor luApply , acceptResult = Nothing } } - update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] + + update acceptID [OutboxItemActivity =. persistJSONObjectFromDoc doc] return (doc, recipientSet, remoteActors, fwdHosts) - insertAcceptLocalRepo luApply ltid obiidAccept = do - encodeRouteLocal <- getEncodeRouteLocal - encodeRouteHome <- getEncodeRouteHome - hLocal <- asksSite siteInstanceHost - obikhidAccept <- encodeKeyHashid obiidAccept - ltkhid <- encodeKeyHashid ltid - ra <- getJust $ remoteAuthorId author - let ObjURI hAuthor luAuthor = remoteAuthorURI author - - audAuthor = - AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra) - - audTicket = - AudLocal [] [LocalPersonCollectionRepoProposalFollowers shrRecip rpRecip ltkhid] - - audRepo = - AudLocal - [] - [ LocalPersonCollectionRepoTeam shrRecip rpRecip - , LocalPersonCollectionRepoFollowers shrRecip rpRecip - ] - - (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = - collectAudience [audAuthor, audTicket, audRepo] - - recips = map encodeRouteHome audLocal ++ audRemote - doc = Doc hLocal Activity - { activityId = - Just $ encodeRouteLocal $ - RepoOutboxItemR shrRecip rpRecip obikhidAccept - , activityActor = encodeRouteLocal $ RepoR shrRecip rpRecip - , activityCapability = Nothing - , activitySummary = Nothing - , activityAudience = Audience recips [] [] [] [] [] - , activitySpecific = AcceptActivity Accept - { acceptObject = ObjURI hAuthor luApply - , acceptResult = Nothing - } - } - update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] - return (doc, recipientSet, remoteActors, fwdHosts) - - insertAcceptLocalSharer luApply shr talid obiidAccept = do - encodeRouteLocal <- getEncodeRouteLocal - encodeRouteHome <- getEncodeRouteHome - hLocal <- asksSite siteInstanceHost - obikhidAccept <- encodeKeyHashid obiidAccept - talkhid <- encodeKeyHashid talid - ra <- getJust $ remoteAuthorId author - let ObjURI hAuthor luAuthor = remoteAuthorURI author - - audAuthor = - AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra) - - audTicket = - AudLocal [] [LocalPersonCollectionSharerProposalFollowers shr talkhid] - - audRepo = - AudLocal - [] - [ LocalPersonCollectionRepoTeam shrRecip rpRecip - , LocalPersonCollectionRepoFollowers shrRecip rpRecip - ] - - (recipientSet, remoteActors, fwdHosts, audLocal, audRemote) = - collectAudience [audAuthor, audTicket, audRepo] - - recips = map encodeRouteHome audLocal ++ audRemote - doc = Doc hLocal Activity - { activityId = - Just $ encodeRouteLocal $ - RepoOutboxItemR shrRecip rpRecip obikhidAccept - , activityActor = encodeRouteLocal $ RepoR shrRecip rpRecip - , activityCapability = Nothing - , activitySummary = Nothing - , activityAudience = Audience recips [] [] [] [] [] - , activitySpecific = AcceptActivity Accept - { acceptObject = ObjURI hAuthor luApply - , acceptResult = Nothing - } - } - update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc] - return (doc, recipientSet, remoteActors, fwdHosts) --} - personOfferDepF :: UTCTime -> KeyHashid Person diff --git a/src/Vervis/Handler/Loom.hs b/src/Vervis/Handler/Loom.hs index f9fa200..560cd48 100644 --- a/src/Vervis/Handler/Loom.hs +++ b/src/Vervis/Handler/Loom.hs @@ -142,6 +142,8 @@ postLoomInboxR recipLoomHash = case specific of AP.AcceptActivity accept -> loomAcceptF now recipLoomHash author body mfwd luActivity accept + AP.ApplyActivity apply-> + loomApplyF now recipLoomHash author body mfwd luActivity apply AP.InviteActivity invite -> topicInviteF now (GrantResourceLoom recipLoomHash) author body mfwd luActivity invite AP.OfferActivity (AP.Offer obj target) -> diff --git a/src/Vervis/Persist/Ticket.hs b/src/Vervis/Persist/Ticket.hs new file mode 100644 index 0000000..deee9fe --- /dev/null +++ b/src/Vervis/Persist/Ticket.hs @@ -0,0 +1,144 @@ +{- This file is part of Vervis. + - + - Written in 2022 by fr33domlover . + - + - ♡ Copying is an act of love. Please copy, reuse and share. + - + - The author(s) have dedicated all copyright and related and neighboring + - rights to this software to the public domain worldwide. This software is + - distributed without any warranty. + - + - You should have received a copy of the CC0 Public Domain Dedication along + - with this software. If not, see + - . + -} + +module Vervis.Persist.Ticket + ( checkApplyDB + ) +where + +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe +import Data.Text (Text) +import Data.These +import Database.Persist + +import qualified Data.List.NonEmpty as NE + +import Development.PatchMediaType +import Yesod.Hashids + +import Control.Monad.Trans.Except.Local +import Database.Persist.Local + +import Vervis.Access +import Vervis.Cloth +import Vervis.FedURI +import Vervis.Foundation +import Vervis.Model +import Vervis.Recipient + +-- | Given: +-- +-- * A local tip (i.e. a repository or a branch), parsed from a URI +-- * A local bundle to apply to it, parsed from a URI +-- * A local or remote actor requesting to apply the bundle to the tip, already +-- known to be in our DB +-- * An activity URI provided by that actor as a capability, parsed from URI +-- +-- Find the tip and the bundle in our DB, and verify that the loom hosting the +-- bundle is willing to accept the request from that specific actor to apply +-- that bundle to that repo. More specifically: +-- +-- * Verify the tip matches the MR target +-- * Verify that the loom and the repo are linked +-- * Verify that a branch is specified if repo is Git, isn't specified if Darcs +-- * Verify the MR isn't already resolved +-- * Verify bundle is the latest version of the MR +-- * Verify the requester actor is authorized to apply +-- * Verify that patch type matches repo VCS type +-- +-- Returns: +-- +-- * The loom (so it can send an Accept after applying) +-- * The MR's ticket ID (so it can be marked as resolved after applying) +-- * The actual patch diffs, in first-to-last order +checkApplyDB + :: Either PersonId RemoteActorId -- ^ Actor requesting to apply + -> (Either + (LocalActorBy Key, LocalActorBy KeyHashid, OutboxItemId) + FedURI + ) -- ^ Capability specified by the actor + -> (RepoId, Maybe Text) -- ^ Repository (or branch) to apply to + -> (LoomId, TicketLoomId, BundleId) -- ^ Parsed bundle URI to apply + -> ExceptT Text AppDB (Loom, TicketId, NonEmpty Text) +checkApplyDB actor capID (repoID, maybeBranch) (loomID, clothID, bundleID) = do + + -- Find the bundle and its loom in DB + (loom, clothBranch, ticketID, maybeResolve, latest) <- do + maybeBundle <- lift $ runMaybeT $ do + (Entity _ loom, Entity _ cloth, Entity ticketID _, _author, resolve, proposal) <- + MaybeT $ getCloth loomID clothID + bundle <- MaybeT $ get bundleID + guard $ bundleTicket bundle == clothID + latest :| _prevs <- + case justHere proposal of + Nothing -> + error "Why didn't getCloth find any bundles" + Just bundles -> return bundles + return (loom, ticketLoomBranch cloth, ticketID, resolve, latest) + fromMaybeE maybeBundle "Apply object bundle not found in DB" + + -- Verify the target repo/branch of the Apply is identical to the + -- target repo/branch of the MR + unless (maybeBranch == clothBranch) $ + throwE "Apply target != MR target" + + -- Find target repo in DB and verify it consents to being served by + -- the loom + unless (repoID == loomRepo loom) $ + throwE "MR target repo isn't the one served by the Apply object bundle's loom" + repo <- getE repoID "Apply target: No such local repo in DB" + unless (repoLoom repo == Just loomID) $ + throwE "Apply object bunde's loom doesn't have repo's consent to serve it" + + -- Verify that VCS type matches the presence of a branch: + -- Branch specified for Git, isn't specified for Darcs + case (repoVcs repo, maybeBranch) of + (VCSDarcs, Nothing) -> pure () + (VCSGit, Just _) -> pure () + _ -> throwE "VCS type and branch presence mismatch" + + -- Verify the MR isn't already resolved and the bundle is the + -- latest version + unless (isNothing maybeResolve) $ + throwE "MR is already resolved" + unless (bundleID == latest) $ + throwE "Bundle isn't the latest version" + + -- Verify the sender is authorized by the loom to apply a patch + capability <- + case capID of + Left (capActor, _, capItem) -> return (capActor, capItem) + Right _ -> throwE "Capability is a remote URI, i.e. not authored by the local loom" + verifyCapability capability actor (GrantResourceLoom loomID) + + -- Get the patches from DB, verify VCS match just in case + diffs <- do + ps <- + lift $ map entityVal <$> + selectList [PatchBundle ==. bundleID] [Asc PatchId] + let patchVCS = patchMediaTypeVCS . patchType + case NE.nonEmpty ps of + Nothing -> error "Bundle without patches" + Just ne -> + if all ((== repoVcs repo) . patchVCS) ne + then return $ NE.map patchContent ne + else throwE "Patch type mismatch with repo VCS type" + + return (loom, ticketID, diffs) diff --git a/src/Vervis/Web/Repo.hs b/src/Vervis/Web/Repo.hs index d67fdfd..07528fb 100644 --- a/src/Vervis/Web/Repo.hs +++ b/src/Vervis/Web/Repo.hs @@ -16,11 +16,13 @@ module Vervis.Web.Repo ( serveCommit , generatePatches + , applyPatches ) where import Control.Monad import Control.Monad.Trans.Except +import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) import Data.Text.Encoding import Data.Time.Clock @@ -47,6 +49,7 @@ import Data.Patch.Local hiding (Patch) import qualified Data.Patch.Local as P +import Vervis.Darcs import Vervis.FedURI import Vervis.Foundation import Vervis.Git @@ -138,3 +141,24 @@ generatePatches (clothID, targetRepoID, hasBundle, tipInfo) = unless hasBundle $ lift $ runSiteDB $ do bundleID <- insert $ Bundle clothID True insertMany_ $ NE.toList $ NE.map (Patch bundleID now PatchMediaTypeGit) $ NE.reverse patches + +applyPatches + :: (MonadSite m, SiteEnv m ~ App) + => RepoId -> Maybe Text -> NonEmpty Text -> ExceptT Text m () +applyPatches repoID maybeBranch diffs = do + repoPath <- do + repoHash <- encodeKeyHashid repoID + repoDir <- askRepoDir repoHash + liftIO $ makeAbsolute repoDir + case maybeBranch of + Just branch -> do + ExceptT $ liftIO $ runExceptT $ + withSystemTempDirectory "vervis-applyPatches" $ + applyGitPatches repoPath (T.unpack branch) diffs + Nothing -> do + patch <- + case diffs of + t :| [] -> return t + _ :| (_ : _) -> + throwE "Darcs repo given multiple patch bundles" + applyDarcsPatch repoPath patch diff --git a/vervis.cabal b/vervis.cabal index db29ad5..d5b0c75 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -210,6 +210,7 @@ library Vervis.Persist.Actor Vervis.Persist.Collab + Vervis.Persist.Ticket Vervis.Query Vervis.Readme