From ffb5dadac7310a58aa0c0889192e75accf3767dc Mon Sep 17 00:00:00 2001 From: Pere Lev Date: Fri, 16 Jun 2023 17:15:15 +0300 Subject: [PATCH] Link C2S handler with ClientMsg Person actor handler & port inviteC --- src/Control/Concurrent/Actor.hs | 1 + src/Vervis/API.hs | 266 ++++-------------------------- src/Vervis/Access.hs | 162 +----------------- src/Vervis/Actor.hs | 10 +- src/Vervis/Actor/Person/Client.hs | 186 ++++++++++++++++++++- src/Vervis/Actor2.hs | 58 ++++++- src/Vervis/Client.hs | 87 +++++++++- src/Vervis/Data/Collab.hs | 96 ++++++++++- src/Vervis/Data/Ticket.hs | 2 +- src/Vervis/Federation/Ticket.hs | 2 +- src/Vervis/Fetch.hs | 2 +- src/Vervis/Handler/Person.hs | 6 +- src/Vervis/Persist/Actor.hs | 2 +- src/Vervis/Persist/Collab.hs | 95 ++++++++++- src/Vervis/Persist/Ticket.hs | 5 +- 15 files changed, 564 insertions(+), 416 deletions(-) diff --git a/src/Control/Concurrent/Actor.hs b/src/Control/Concurrent/Actor.hs index 0c28e37..65c3b5f 100644 --- a/src/Control/Concurrent/Actor.hs +++ b/src/Control/Concurrent/Actor.hs @@ -17,6 +17,7 @@ module Control.Concurrent.Actor ( Stage (..) , TheaterFor () , ActFor () + , runActor , MonadActor (..) , asksEnv , Next () diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index e5cf13f..14636a8 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -17,7 +17,8 @@ {-# LANGUAGE DeriveGeneric #-} module Vervis.API - ( acceptC + ( handleViaActor + , acceptC --, addBundleC , applyC --, noteC @@ -26,7 +27,6 @@ module Vervis.API , createRepositoryC , createTicketTrackerC , followC - , inviteC , offerTicketC --, offerDepC , resolveC @@ -74,9 +74,11 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL +import Control.Concurrent.Actor import Database.Persist.JSON import Development.PatchMediaType import Network.FedURI +import Text.Read (readMaybe) import Web.ActivityPub hiding (Patch (..), Ticket, Follow, Repo (..), ActorLocal (..), ActorDetail (..), Actor (..)) import Web.Text import Yesod.ActivityPub @@ -95,8 +97,8 @@ import qualified Data.Git.Local as G (createRepo) import qualified Data.Text.UTF8.Local as TU import qualified Darcs.Local.Repository as D (createRepo) -import Vervis.Access import Vervis.ActivityPub +import Vervis.Actor hiding (hashLocalActor) import Vervis.Cloth import Vervis.Darcs import Vervis.Data.Actor @@ -127,6 +129,33 @@ import Vervis.Ticket import Vervis.Web.Delivery import Vervis.Web.Repo +handleViaActor + :: PersonId + -> Maybe + (Either + (LocalActorBy Key, LocalActorBy KeyHashid, OutboxItemId) + FedURI + ) + -> RecipientRoutes + -> [(Host, NonEmpty LocalURI)] + -> [Host] + -> AP.Action URIMode + -> ExceptT Text Handler OutboxItemId +handleViaActor personID maybeCap localRecips remoteRecips fwdHosts action = do + theater <- asksSite appTheater + let maybeCap' = first (\ (byKey, _, i) -> (byKey, i)) <$> maybeCap + msg = ClientMsg maybeCap' localRecips remoteRecips fwdHosts action + maybeResult <- + liftIO $ callIO theater (LocalActorPerson personID) (Right msg) + itemText <- + case maybeResult of + Nothing -> error "Person not found in theater" + Just (Left e) -> throwE e + Just (Right t) -> return t + case readMaybe $ T.unpack itemText of + Nothing -> error "read itemText failed" + Just outboxItemID -> return outboxItemID + verifyResourceAddressed :: (MonadSite m, YesodHashids (SiteEnv m)) => RecipientRoutes -> GrantResourceBy Key -> ExceptT Text m () @@ -1838,237 +1867,6 @@ followC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips re } } --- Meaning: The human wants to invite someone A to a resource R --- Behavior: --- * Some basic sanity checks --- * Parse the Invite --- * Make sure not inviting myself --- * Verify that a capability is specified --- * If resource is local, verify it exists in DB --- * Verify the target A and resource R are addressed in the Invite --- * Insert Invite to my inbox --- * Asynchrnously: --- * Deliver a request to the resource --- * Deliver a notification to the target --- * Deliver a notification to my followers -inviteC - :: Entity Person - -> Actor - -> Maybe - (Either - (LocalActorBy Key, LocalActorBy KeyHashid, OutboxItemId) - FedURI - ) - -> RecipientRoutes - -> [(Host, NonEmpty LocalURI)] - -> [Host] - -> AP.Action URIMode - -> AP.Invite URIMode - -> ExceptT Text Handler OutboxItemId -inviteC (Entity senderPersonID senderPerson) senderActor maybeCap localRecips remoteRecips fwdHosts action invite = do - error "Disabled for actor refactoring" -{- - -- Check input - (resource, recipient) <- parseInvite (Left senderPersonID) invite - _capID <- fromMaybeE maybeCap "No capability provided" - - -- If resource is remote, HTTP GET it and its managing actor, and insert to - -- our DB. If resource is local, find it in our DB. - resourceDB <- - bitraverse - (runDBExcept . flip getGrantResource "Grant context not found in DB") - (\ u@(ObjURI h lu) -> do - instanceID <- - lift $ withDB $ either entityKey id <$> insertBy' (Instance h) - result <- - ExceptT $ first (T.pack . show) <$> - fetchRemoteResource instanceID h lu - case result of - Left (Entity actorID actor) -> - return (remoteActorIdent actor, actorID, u) - Right (objectID, luManager, (Entity actorID _)) -> - return (objectID, actorID, ObjURI h luManager) - ) - resource - - -- If recipient is remote, HTTP GET it, make sure it's an actor, and insert - -- it to our DB. If recipient is local, find it in our DB. - recipientDB <- - bitraverse - (runDBExcept . flip getGrantRecip "Grant recipient not found in DB") - (\ u@(ObjURI h lu) -> do - instanceID <- - lift $ runDB $ either entityKey id <$> insertBy' (Instance h) - result <- - ExceptT $ first (T.pack . displayException) <$> - fetchRemoteActor' instanceID h lu - case result of - Left Nothing -> throwE "Recipient @id mismatch" - Left (Just err) -> throwE $ T.pack $ displayException err - Right Nothing -> throwE "Recipient isn't an actor" - Right (Just actor) -> return (entityKey actor, u) - ) - recipient - - -- Verify that resource and recipient are addressed by the Invite - bitraverse_ - (verifyResourceAddressed localRecips . bmap entityKey) - (\ (_, _, u) -> verifyRemoteAddressed remoteRecips u) - resourceDB - bitraverse_ - (verifyRecipientAddressed localRecips . bmap entityKey) - (verifyRemoteAddressed remoteRecips . snd) - recipientDB - - now <- liftIO getCurrentTime - senderHash <- encodeKeyHashid senderPersonID - - ? <- withDBExcept $ do - - - - - - - - - - - - - - - (obiidInvite, deliverHttpInvite) <- runDBExcept $ do - - -- Insert the Invite activity to author's outbox - inviteID <- lift $ insertEmptyOutboxItem (actorOutbox senderActor) now - _luInvite <- lift $ updateOutboxItem (LocalActorPerson senderPersonID) inviteID action - - -- Deliver the Invite activity to local recipients, and schedule - -- delivery for unavailable remote recipients - deliverHttpInvite <- do - sieve <- do - resourceHash <- bitraverse hashGrantResource pure resource - recipientHash <- bitraverse hashGrantRecip pure recipient - let sieveActors = catMaybes - [ case resourceHash of - Left (GrantResourceRepo r) -> Just $ LocalActorRepo r - Left (GrantResourceDeck d) -> Just $ LocalActorDeck d - Left (GrantResourceLoom l) -> Just $ LocalActorLoom l - Right _ -> Nothing - , case recipientHash of - Left (GrantRecipPerson p) -> Just $ LocalActorPerson p - Right _ -> Nothing - ] - sieveStages = catMaybes - [ Just $ LocalStagePersonFollowers senderHash - , case resourceHash of - Left (GrantResourceRepo r) -> Just $ LocalStageRepoFollowers r - Left (GrantResourceDeck d) -> Just $ LocalStageDeckFollowers d - Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l - Right _ -> Nothing - , case recipientHash of - Left (GrantRecipPerson p) -> Just $ LocalStagePersonFollowers p - Right _ -> Nothing - ] - return $ makeRecipientSet sieveActors sieveStages - let localRecipsFinal = localRecipSieve sieve False localRecips - deliverActivityDB - (LocalActorPerson senderHash) (personActor senderPerson) - localRecipsFinal remoteRecips fwdHosts inviteID action - - -- If resource is local, verify it has received the Grant - case resourceDB of - Left localResource -> do - let resourceActorID = - case localResource of - GrantResourceRepo (Entity _ r) -> repoActor r - GrantResourceDeck (Entity _ d) -> deckActor d - GrantResourceLoom (Entity _ l) -> loomActor l - verifyActorHasItem resourceActorID inviteID "Local topic didn't receive the Invite" - Right _ -> pure () - - -- If recipient is local, verify it has received the invite - case recipientDB of - Left (GrantRecipPerson (Entity _ p)) -> - verifyActorHasItem (personActor p) inviteID "Local recipient didn't receive the Invite" - Right _ -> pure () - - -- Return instructions for HTTP delivery to remote recipients - return (inviteID, deliverHttpInvite) - - - - - - - -- Notify the resource - - - - - - - - - - - -- Launch asynchronous HTTP delivery of the Grant activity - lift $ do - forkWorker "inviteC: async HTTP Grant delivery" deliverHttpInvite - - return obiidInvite - - where - - fetchRemoteResource instanceID host localURI = do - maybeActor <- withDB $ runMaybeT $ do - roid <- MaybeT $ getKeyBy $ UniqueRemoteObject instanceID localURI - MaybeT $ getBy $ UniqueRemoteActor roid - case maybeActor of - Just actor -> return $ Right $ Left actor - Nothing -> do - manager <- asksEnv getHttpManager - errorOrResource <- fetchResource manager host localURI - case errorOrResource of - Left maybeError -> - return $ Left $ maybe ResultIdMismatch ResultGetError maybeError - Right resource -> do - case resource of - ResourceActor (AP.Actor local detail) -> withDB $ do - roid <- either entityKey id <$> insertBy' (RemoteObject instanceID localURI) - let ra = RemoteActor - { remoteActorIdent = roid - , remoteActorName = - AP.actorName detail <|> AP.actorUsername detail - , remoteActorInbox = AP.actorInbox local - , remoteActorFollowers = AP.actorFollowers local - , remoteActorErrorSince = Nothing - } - Right . Left . either id id <$> insertByEntity' ra - ResourceChild luId luManager -> do - roid <- withDB $ either entityKey id <$> insertBy' (RemoteObject instanceID localURI) - result <- fetchRemoteActor' instanceID host luManager - return $ - case result of - Left e -> Left $ ResultSomeException e - Right (Left Nothing) -> Left ResultIdMismatch - Right (Left (Just e)) -> Left $ ResultGetError e - Right (Right Nothing) -> Left ResultNotActor - Right (Right (Just actor)) -> Right $ Right (roid, luManager, actor) - - verifyRecipientAddressed localRecips recipient = do - recipientHash <- hashGrantRecip recipient - fromMaybeE (verify recipientHash) "Recipient not addressed" - where - verify (GrantRecipPerson p) = do - routes <- lookup p $ recipPeople localRecips - guard $ routePerson routes - - hashGrantRecip (GrantRecipPerson k) = - GrantRecipPerson <$> encodeKeyHashid k --} - offerTicketC :: Entity Person -> Actor diff --git a/src/Vervis/Access.hs b/src/Vervis/Access.hs index ca1a757..111b731 100644 --- a/src/Vervis/Access.hs +++ b/src/Vervis/Access.hs @@ -13,11 +13,6 @@ - . -} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} - -- | In this module I'd like to collect all the operation access checks. When a -- given user asks to perform a certain operation, do we accept the request and -- perform the changes to our database etc.? The functions here should provide @@ -62,22 +57,6 @@ module Vervis.Access , checkRepoAccess' , checkRepoAccess , checkProjectAccess - - , GrantResourceBy (..) - , unhashGrantResourcePure - , unhashGrantResource - , unhashGrantResourceE - , unhashGrantResource' - , unhashGrantResourceE' - , unhashGrantResource404 - , hashGrantResource - , getGrantResource - , getGrantResource404 - - , grantResourceLocalActor - - , verifyCapability - , verifyCapability' ) where @@ -107,6 +86,8 @@ import Web.Actor.Persist (stageHashidsContext) import Yesod.Hashids import Yesod.MonadSite +import qualified Web.Actor.Persist as WAP + import Control.Monad.Trans.Except.Local import Data.Either.Local import Database.Persist.Local @@ -269,142 +250,3 @@ checkProjectAccess mpid op deckHash = do return $ topic E.^. CollabTopicDeckCollab asUser = fmap RoleID . deckCollabUser asAnon = fmap RoleID . deckCollabAnon - -data GrantResourceBy f - = GrantResourceRepo (f Repo) - | GrantResourceDeck (f Deck) - | GrantResourceLoom (f Loom) - deriving (Generic, FunctorB, TraversableB, ConstraintsB) - -deriving instance AllBF Eq f GrantResourceBy => Eq (GrantResourceBy f) - -unhashGrantResourcePure ctx = f - where - f (GrantResourceRepo r) = - GrantResourceRepo <$> decodeKeyHashidPure ctx r - f (GrantResourceDeck d) = - GrantResourceDeck <$> decodeKeyHashidPure ctx d - f (GrantResourceLoom l) = - GrantResourceLoom <$> decodeKeyHashidPure ctx l - -unhashGrantResource resource = do - ctx <- asksSite siteHashidsContext - return $ unhashGrantResourcePure ctx resource - -unhashGrantResourceE resource e = - ExceptT $ maybe (Left e) Right <$> unhashGrantResource resource - -unhashGrantResource' resource = do - ctx <- asksEnv stageHashidsContext - return $ unhashGrantResourcePure ctx resource - -unhashGrantResourceE' resource e = - ExceptT $ maybe (Left e) Right <$> unhashGrantResource' resource - -unhashGrantResource404 = maybe notFound return <=< unhashGrantResource - -hashGrantResource (GrantResourceRepo k) = - GrantResourceRepo <$> encodeKeyHashid k -hashGrantResource (GrantResourceDeck k) = - GrantResourceDeck <$> encodeKeyHashid k -hashGrantResource (GrantResourceLoom k) = - GrantResourceLoom <$> encodeKeyHashid k - -getGrantResource (GrantResourceRepo k) e = - GrantResourceRepo <$> getEntityE k e -getGrantResource (GrantResourceDeck k) e = - GrantResourceDeck <$> getEntityE k e -getGrantResource (GrantResourceLoom k) e = - GrantResourceLoom <$> getEntityE k e - -getGrantResource404 = maybe notFound return <=< getGrantResourceEntity - where - getGrantResourceEntity (GrantResourceRepo k) = - fmap GrantResourceRepo <$> getEntity k - getGrantResourceEntity (GrantResourceDeck k) = - fmap GrantResourceDeck <$> getEntity k - getGrantResourceEntity (GrantResourceLoom k) = - fmap GrantResourceLoom <$> getEntity k - -grantResourceLocalActor :: GrantResourceBy f -> LocalActorBy f -grantResourceLocalActor (GrantResourceRepo r) = LocalActorRepo r -grantResourceLocalActor (GrantResourceDeck d) = LocalActorDeck d -grantResourceLocalActor (GrantResourceLoom l) = LocalActorLoom l - -verifyCapability - :: MonadIO m - => (LocalActorBy Key, OutboxItemId) - -> Either PersonId RemoteActorId - -> GrantResourceBy Key - -> ExceptT Text (ReaderT SqlBackend m) () -verifyCapability (capActor, capItem) actor resource = do - - -- Find the activity itself by URI in the DB - nameExceptT "Capability activity not found" $ - verifyLocalActivityExistsInDB capActor capItem - - -- Find the Collab record for that activity - collabID <- do - maybeEnable <- lift $ getValBy $ UniqueCollabEnableGrant capItem - collabEnableCollab <$> - fromMaybeE maybeEnable "No CollabEnable for this activity" - - -- Find the recipient of that Collab - recipID <- - lift $ bimap collabRecipLocalPerson collabRecipRemoteActor <$> - requireEitherAlt - (getValBy $ UniqueCollabRecipLocal collabID) - (getValBy $ UniqueCollabRecipRemote collabID) - "No collab recip" - "Both local and remote recips for collab" - - -- Verify the recipient is the expected one - unless (recipID == actor) $ - throwE "Collab recipient is someone else" - - -- Find the local topic, on which this Collab gives access - topic <- lift $ do - maybeRepo <- getValBy $ UniqueCollabTopicRepo collabID - maybeDeck <- getValBy $ UniqueCollabTopicDeck collabID - maybeLoom <- getValBy $ UniqueCollabTopicLoom collabID - case (maybeRepo, maybeDeck, maybeLoom) of - (Nothing, Nothing, Nothing) -> error "Collab without topic" - (Just r, Nothing, Nothing) -> - return $ GrantResourceRepo $ collabTopicRepoRepo r - (Nothing, Just d, Nothing) -> - return $ GrantResourceDeck $ collabTopicDeckDeck d - (Nothing, Nothing, Just l) -> - return $ GrantResourceLoom $ collabTopicLoomLoom l - _ -> error "Collab with multiple topics" - - -- Verify that topic is indeed the sender of the Grant - unless (grantResourceLocalActor topic == capActor) $ - error "Grant sender isn't the topic" - - -- Verify the topic matches the resource specified - unless (topic == resource) $ - throwE "Capability topic is some other local resource" - - -- Since there are currently no roles, and grants allow only the "Admin" - -- role that supports every operation, we don't need to check role access - return () - -verifyCapability' - :: MonadIO m - => (LocalActorBy Key, OutboxItemId) - -> Either - (LocalActorBy Key, ActorId, OutboxItemId) - (RemoteAuthor, LocalURI, Maybe ByteString) - -> GrantResourceBy Key - -> ExceptT Text (ReaderT SqlBackend m) () -verifyCapability' cap actor resource = do - actorP <- processActor actor - verifyCapability cap actorP resource - where - processActor = bitraverse processLocal processRemote - where - processLocal (actorByKey, _, _) = - case actorByKey of - LocalActorPerson personID -> return personID - _ -> throwE "Non-person local actors can't get Grants at the moment" - processRemote (author, _, _) = pure $ remoteAuthorId author diff --git a/src/Vervis/Actor.hs b/src/Vervis/Actor.hs index c75ac3c..a78cd47 100644 --- a/src/Vervis/Actor.hs +++ b/src/Vervis/Actor.hs @@ -300,11 +300,11 @@ data Verse = Verse } data ClientMsg = ClientMsg - { _cmMaybeCap :: Maybe (Either (LocalActorBy Key, OutboxItemId) FedURI) - , _cmLocalRecips :: RecipientRoutes - , _cmRemoteRecips :: [(Host, NonEmpty LocalURI)] - , _cmFwdHosts :: [Host] - , _cmAction :: AP.Action URIMode + { cmMaybeCap :: Maybe (Either (LocalActorBy Key, OutboxItemId) FedURI) + , cmLocalRecips :: RecipientRoutes + , cmRemoteRecips :: [(Host, NonEmpty LocalURI)] + , cmFwdHosts :: [Host] + , cmAction :: AP.Action URIMode } type VerseExt = Either Verse ClientMsg diff --git a/src/Vervis/Actor/Person/Client.hs b/src/Vervis/Actor/Person/Client.hs index 5a28ca5..4b6ef88 100644 --- a/src/Vervis/Actor/Person/Client.hs +++ b/src/Vervis/Actor/Person/Client.hs @@ -18,23 +18,37 @@ module Vervis.Actor.Person.Client ) where +import Control.Applicative +import Control.Exception.Base import Control.Monad import Control.Monad.IO.Class import Control.Monad.Logger.CallStack import Control.Monad.Trans.Class import Control.Monad.Trans.Except import Control.Monad.Trans.Maybe +import Control.Monad.Trans.Reader +import Data.Barbie +import Data.Bifoldable +import Data.Bifunctor +import Data.Bitraversable import Data.ByteString (ByteString) import Data.Foldable +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe import Data.Text (Text) import Data.Time.Clock +import Data.Traversable import Database.Persist +import Database.Persist.Sql +import Optics.Core import Yesod.Persist.Core import qualified Data.Text as T import Control.Concurrent.Actor import Network.FedURI +import Web.Actor +import Web.Actor.Persist import Yesod.MonadSite import qualified Web.ActivityPub as AP @@ -42,15 +56,183 @@ import qualified Web.ActivityPub as AP import Control.Monad.Trans.Except.Local import Database.Persist.Local +import Vervis.Access +import Vervis.ActivityPub import Vervis.Actor +import Vervis.Actor2 import Vervis.Cloth +import Vervis.Data.Actor +import Vervis.Data.Collab import Vervis.Data.Discussion +import Vervis.Data.Follow import Vervis.FedURI -import Vervis.Federation.Util +import Vervis.Fetch import Vervis.Foundation import Vervis.Model +import Vervis.Persist.Actor +import Vervis.Persist.Collab import Vervis.Persist.Discussion +import Vervis.Persist.Follow +import Vervis.Recipient (makeRecipientSet, LocalStageBy (..), Aud (..), collectAudience, localRecipSieve) +import Vervis.RemoteActorStore import Vervis.Ticket +verifyResourceAddressed :: RecipientRoutes -> GrantResourceBy Key -> ActE () +verifyResourceAddressed localRecips resource = do + resourceHash <- hashGrantResource' resource + fromMaybeE (verify resourceHash) "Local resource not addressed" + where + verify (GrantResourceRepo r) = do + routes <- lookup r $ recipRepos localRecips + guard $ routeRepo routes + verify (GrantResourceDeck d) = do + routes <- lookup d $ recipDecks localRecips + guard $ routeDeck $ familyDeck routes + verify (GrantResourceLoom l) = do + routes <- lookup l $ recipLooms localRecips + guard $ routeLoom $ familyLoom routes + +verifyRecipientAddressed localRecips recipient = do + recipientHash <- hashGrantRecip recipient + fromMaybeE (verify recipientHash) "Recipient not addressed" + where + verify (GrantRecipPerson p) = do + routes <- lookup p $ recipPeople localRecips + guard $ routePerson routes + +verifyRemoteAddressed :: [(Host, NonEmpty LocalURI)] -> FedURI -> ActE () +verifyRemoteAddressed remoteRecips u = + fromMaybeE (verify u) "Given remote entity not addressed" + where + verify (ObjURI h lu) = do + lus <- lookup h remoteRecips + guard $ lu `elem` lus + +-- Meaning: The human wants to invite someone A to a resource R +-- Behavior: +-- * Some basic sanity checks +-- * Parse the Invite +-- * Make sure not inviting myself +-- * Verify that a capability is specified +-- * If resource is local, verify it exists in DB +-- * Verify the target A and resource R are addressed in the Invite +-- * Insert Invite to my inbox +-- * Asynchrnously deliver to: +-- * Resource+followers +-- * Target+followers +-- * My followers +clientInvite + :: UTCTime + -> PersonId + -> ClientMsg + -> AP.Invite URIMode + -> ActE OutboxItemId +clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHosts action) invite = do + + -- Check input + (resource, recipient) <- parseInvite (Left $ LocalActorPerson personMeID) invite + _capID <- fromMaybeE maybeCap "No capability provided" + + -- If resource is remote, HTTP GET it and its managing actor, and insert to + -- our DB. If resource is local, find it in our DB. + resourceDB <- + bitraverse + (withDBExcept . flip getGrantResource "Grant context not found in DB") + (\ u@(ObjURI h lu) -> do + instanceID <- + lift $ withDB $ either entityKey id <$> insertBy' (Instance h) + result <- + ExceptT $ first (T.pack . show) <$> + fetchRemoteResource instanceID h lu + case result of + Left (Entity actorID actor) -> + return (remoteActorIdent actor, actorID, u) + Right (objectID, luManager, (Entity actorID _)) -> + return (objectID, actorID, ObjURI h luManager) + ) + resource + + -- If recipient is remote, HTTP GET it, make sure it's an actor, and insert + -- it to our DB. If recipient is local, find it in our DB. + recipientDB <- + bitraverse + (withDBExcept . flip getGrantRecip "Grant recipient not found in DB") + (\ u@(ObjURI h lu) -> do + instanceID <- + lift $ withDB $ either entityKey id <$> insertBy' (Instance h) + result <- + ExceptT $ first (T.pack . displayException) <$> + fetchRemoteActor' instanceID h lu + case result of + Left Nothing -> throwE "Recipient @id mismatch" + Left (Just err) -> throwE $ T.pack $ displayException err + Right Nothing -> throwE "Recipient isn't an actor" + Right (Just actor) -> return (entityKey actor, u) + ) + recipient + + -- Verify that resource and recipient are addressed by the Invite + bitraverse_ + (verifyResourceAddressed localRecips . bmap entityKey) + (\ (_, _, u) -> verifyRemoteAddressed remoteRecips u) + resourceDB + bitraverse_ + (verifyRecipientAddressed localRecips . bmap entityKey) + (verifyRemoteAddressed remoteRecips . snd) + recipientDB + + (actorMeID, localRecipsFinal, inviteID) <- withDBExcept $ do + + -- Grab me from DB + (personMe, actorMe) <- lift $ do + p <- getJust personMeID + (p,) <$> getJust (personActor p) + + -- Insert the Invite activity to my outbox + inviteID <- lift $ insertEmptyOutboxItem' (actorOutbox actorMe) now + _luInvite <- lift $ updateOutboxItem' (LocalActorPerson personMeID) inviteID action + + -- Prepare local recipients for Invite delivery + sieve <- lift $ do + resourceHash <- bitraverse hashGrantResource' pure resource + recipientHash <- bitraverse hashGrantRecip pure recipient + senderHash <- encodeKeyHashid personMeID + let sieveActors = catMaybes + [ case resourceHash of + Left (GrantResourceRepo r) -> Just $ LocalActorRepo r + Left (GrantResourceDeck d) -> Just $ LocalActorDeck d + Left (GrantResourceLoom l) -> Just $ LocalActorLoom l + Right _ -> Nothing + , case recipientHash of + Left (GrantRecipPerson p) -> Just $ LocalActorPerson p + Right _ -> Nothing + ] + sieveStages = catMaybes + [ Just $ LocalStagePersonFollowers senderHash + , case resourceHash of + Left (GrantResourceRepo r) -> Just $ LocalStageRepoFollowers r + Left (GrantResourceDeck d) -> Just $ LocalStageDeckFollowers d + Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l + Right _ -> Nothing + , case recipientHash of + Left (GrantRecipPerson p) -> Just $ LocalStagePersonFollowers p + Right _ -> Nothing + ] + return $ makeRecipientSet sieveActors sieveStages + return + ( personActor personMe + , localRecipSieve sieve False localRecips + , inviteID + ) + + lift $ sendActivity + (LocalActorPerson personMeID) actorMeID localRecipsFinal remoteRecips + fwdHosts inviteID action + return inviteID + clientBehavior :: UTCTime -> PersonId -> ClientMsg -> ActE (Text, Act (), Next) -clientBehavior _ _ _ = throwE "ClientMsg handlers coming soon!" +clientBehavior now personID msg = + done . T.pack . show =<< + case AP.actionSpecific $ cmAction msg of + AP.InviteActivity invite -> clientInvite now personID msg invite + _ -> throwE "Unsupported activity type for C2S" diff --git a/src/Vervis/Actor2.hs b/src/Vervis/Actor2.hs index ce0f2e0..f93cbe3 100644 --- a/src/Vervis/Actor2.hs +++ b/src/Vervis/Actor2.hs @@ -28,13 +28,20 @@ module Vervis.Actor2 , makeAudSenderWithFollowers , getActivityURI , getActorURI + -- * Running actor pieces in Handler + , runAct + , runActE + -- * Fetching remote objects + , fetchRemoteResource ) where +import Control.Applicative import Control.Concurrent.STM.TVar import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Except +import Control.Monad.Trans.Maybe import Data.Barbie import Data.Bifunctor import Data.ByteString (ByteString) @@ -49,7 +56,7 @@ import Data.Traversable import Data.Typeable import Database.Persist.Sql import GHC.Generics -import UnliftIO.Exception +import UnliftIO.Exception hiding (Handler) import Web.Hashids import qualified Data.Aeson as A @@ -65,15 +72,19 @@ import Web.Actor.Deliver import Web.Actor.Persist import qualified Web.ActivityPub as AP +import qualified Yesod.MonadSite as YM import Control.Monad.Trans.Except.Local +import Database.Persist.Local import Vervis.Actor import Vervis.Data.Actor import Vervis.FedURI +import Vervis.Fetch import Vervis.Foundation import Vervis.Model hiding (Actor, Message) import Vervis.Recipient (renderLocalActor, localRecipSieve', localActorFollowers, Aud (..), ParsedAudience (..), parseAudience') +import Vervis.RemoteActorStore import Vervis.Settings askLatestInstanceKey :: Act (Maybe (Route App, ActorKey)) @@ -372,3 +383,48 @@ getActorURI (Left (actorByKey, _, _)) = do actorByHash <- hashLocalActor actorByKey return $ encodeRouteHome $ renderLocalActor actorByHash getActorURI (Right (author, _, _)) = pure $ remoteAuthorURI author + +runAct :: Act a -> Handler a +runAct act = do + theater <- YM.asksSite appTheater + env <- YM.asksSite appEnv + liftIO $ runActor theater env act + +runActE :: ActE a -> ExceptT Text Handler a +runActE (ExceptT act) = ExceptT $ runAct act + +fetchRemoteResource instanceID host localURI = do + maybeActor <- withDB $ runMaybeT $ do + roid <- MaybeT $ getKeyBy $ UniqueRemoteObject instanceID localURI + MaybeT $ getBy $ UniqueRemoteActor roid + case maybeActor of + Just actor -> return $ Right $ Left actor + Nothing -> do + manager <- asksEnv envHttpManager + errorOrResource <- AP.fetchResource manager host localURI + case errorOrResource of + Left maybeError -> + return $ Left $ maybe ResultIdMismatch ResultGetError maybeError + Right resource -> do + case resource of + AP.ResourceActor (AP.Actor local detail) -> withDB $ do + roid <- either entityKey id <$> insertBy' (RemoteObject instanceID localURI) + let ra = RemoteActor + { remoteActorIdent = roid + , remoteActorName = + AP.actorName detail <|> AP.actorUsername detail + , remoteActorInbox = AP.actorInbox local + , remoteActorFollowers = AP.actorFollowers local + , remoteActorErrorSince = Nothing + } + Right . Left . either id id <$> insertByEntity' ra + AP.ResourceChild luId luManager -> do + roid <- withDB $ either entityKey id <$> insertBy' (RemoteObject instanceID localURI) + result <- fetchRemoteActor' instanceID host luManager + return $ + case result of + Left e -> Left $ ResultSomeException e + Right (Left Nothing) -> Left ResultIdMismatch + Right (Left (Just e)) -> Left $ ResultGetError e + Right (Right Nothing) -> Left ResultNotActor + Right (Right (Just actor)) -> Right $ Right (roid, luManager, actor) diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 280364d..ab9083b 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2019, 2020, 2022 by fr33domlover . + - Written in 2019, 2020, 2022, 2023 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -37,6 +37,7 @@ module Vervis.Client , createDeck , createLoom , createRepo + , invite ) where @@ -78,7 +79,10 @@ import Data.Either.Local import Database.Persist.Local import Vervis.ActivityPub +import Vervis.Actor +import Vervis.Actor2 import Vervis.Cloth +import Vervis.Data.Collab import Vervis.Data.Ticket import Vervis.FedURI import Vervis.Foundation @@ -943,3 +947,84 @@ createRepo senderHash name desc = do } return (Nothing, audience, detail) + +invite + :: PersonId + -> FedURI + -> FedURI + -> ExceptT Text Handler (Maybe HTML, [Aud URIMode], AP.Invite URIMode) +invite personID uRecipient uResource = do + + theater <- asksSite appTheater + env <- asksSite appEnv + + let activity = AP.Invite (Left RoleAdmin) uRecipient uResource + (resource, recipient) <- + runActE $ parseInvite (Left $ LocalActorPerson personID) activity + + -- If resource is remote, we need to get it from DB/HTTP to determine its + -- managing actor & followers collection + resourceDB <- + bitraverse + hashGrantResource + (\ u@(ObjURI h lu) -> do + instanceID <- + lift $ runDB $ either entityKey id <$> insertBy' (Instance h) + result <- + ExceptT $ first (T.pack . show) <$> + runAct (fetchRemoteResource instanceID h lu) + case result of + Left (Entity _ actor) -> + return (actor, u) + Right (_objectID, luManager, (Entity _ actor)) -> + return (actor, ObjURI h luManager) + ) + resource + + -- If target is remote, get it via HTTP/DB to determine its followers + -- collection + recipientDB <- + bitraverse + (runActE . hashGrantRecip) + (\ u@(ObjURI h lu) -> do + instanceID <- + lift $ runDB $ either entityKey id <$> insertBy' (Instance h) + result <- + ExceptT $ first (T.pack . displayException) <$> + fetchRemoteActor instanceID h lu + case result of + Left Nothing -> throwE "Recipient @id mismatch" + Left (Just err) -> throwE $ T.pack $ displayException err + Right Nothing -> throwE "Recipient isn't an actor" + Right (Just actor) -> return (entityVal actor, u) + ) + recipient + + senderHash <- encodeKeyHashid personID + + let audResource = + case resourceDB of + Left (GrantResourceRepo r) -> + AudLocal [LocalActorRepo r] [LocalStageRepoFollowers r] + Left (GrantResourceDeck d) -> + AudLocal [LocalActorDeck d] [LocalStageDeckFollowers d] + Left (GrantResourceLoom l) -> + AudLocal [LocalActorLoom l] [LocalStageLoomFollowers l] + Right (remoteActor, ObjURI h lu) -> + AudRemote h + [lu] + (maybeToList $ remoteActorFollowers remoteActor) + audRecipient = + case recipientDB of + Left (GrantRecipPerson p) -> + AudLocal [] [LocalStagePersonFollowers p] + Right (remoteActor, ObjURI h lu) -> + AudRemote h + [lu] + (maybeToList $ remoteActorFollowers remoteActor) + audAuthor = + AudLocal [] [LocalStagePersonFollowers senderHash] + + audience = [audResource, audRecipient, audAuthor] + + return (Nothing, audience, activity) diff --git a/src/Vervis/Data/Collab.hs b/src/Vervis/Data/Collab.hs index 0209753..f8b09a7 100644 --- a/src/Vervis/Data/Collab.hs +++ b/src/Vervis/Data/Collab.hs @@ -20,6 +20,7 @@ module Vervis.Data.Collab ( GrantRecipBy (..) + , hashGrantRecip , parseInvite , parseJoin @@ -28,6 +29,20 @@ module Vervis.Data.Collab , parseReject , grantResourceActorID + + , GrantResourceBy (..) + , unhashGrantResourcePure + , unhashGrantResource + , unhashGrantResourceE + , unhashGrantResource' + , unhashGrantResourceE' + , unhashGrantResource404 + , hashGrantResource + , hashGrantResource' + , getGrantResource + , getGrantResource404 + + , grantResourceLocalActor ) where @@ -38,14 +53,15 @@ import Data.Bifunctor import Data.Bitraversable import Data.Functor.Identity import Data.Text (Text) +import Database.Persist import Database.Persist.Types import GHC.Generics +import Yesod.Core import Control.Concurrent.Actor import Data.Time.Clock import Network.FedURI import Web.Actor -import Web.Actor.Persist import Yesod.ActivityPub import Yesod.Actor import Yesod.FedURI @@ -53,12 +69,13 @@ import Yesod.Hashids import Yesod.MonadSite (asksSite) import qualified Web.ActivityPub as AP +import qualified Web.Actor.Persist as WAP import Control.Monad.Trans.Except.Local +import Database.Persist.Local -import Vervis.Access import Vervis.Actor -import Vervis.Actor2 +--import Vervis.Actor2 import Vervis.Data.Actor import Vervis.FedURI import Vervis.Foundation @@ -77,6 +94,9 @@ deriving instance AllBF Eq f GrantRecipBy => Eq (GrantRecipBy f) parseGrantRecip (PersonR p) = Just $ GrantRecipPerson p parseGrantRecip _ = Nothing +hashGrantRecip (GrantRecipPerson k) = + GrantRecipPerson <$> WAP.encodeKeyHashid k + unhashGrantRecipPure ctx = f where f (GrantRecipPerson p) = @@ -87,7 +107,7 @@ unhashGrantRecipOld resource = do return $ unhashGrantRecipPure ctx resource unhashGrantRecip resource = do - ctx <- asksEnv stageHashidsContext + ctx <- asksEnv WAP.stageHashidsContext return $ unhashGrantRecipPure ctx resource unhashGrantRecipEOld resource e = @@ -245,3 +265,71 @@ grantResourceActorID :: GrantResourceBy Identity -> ActorId grantResourceActorID (GrantResourceRepo (Identity r)) = repoActor r grantResourceActorID (GrantResourceDeck (Identity d)) = deckActor d grantResourceActorID (GrantResourceLoom (Identity l)) = loomActor l + +data GrantResourceBy f + = GrantResourceRepo (f Repo) + | GrantResourceDeck (f Deck) + | GrantResourceLoom (f Loom) + deriving (Generic, FunctorB, TraversableB, ConstraintsB) + +deriving instance AllBF Eq f GrantResourceBy => Eq (GrantResourceBy f) + +unhashGrantResourcePure ctx = f + where + f (GrantResourceRepo r) = + GrantResourceRepo <$> decodeKeyHashidPure ctx r + f (GrantResourceDeck d) = + GrantResourceDeck <$> decodeKeyHashidPure ctx d + f (GrantResourceLoom l) = + GrantResourceLoom <$> decodeKeyHashidPure ctx l + +unhashGrantResource resource = do + ctx <- asksSite siteHashidsContext + return $ unhashGrantResourcePure ctx resource + +unhashGrantResourceE resource e = + ExceptT $ maybe (Left e) Right <$> unhashGrantResource resource + +unhashGrantResource' resource = do + ctx <- asksEnv WAP.stageHashidsContext + return $ unhashGrantResourcePure ctx resource + +unhashGrantResourceE' resource e = + ExceptT $ maybe (Left e) Right <$> unhashGrantResource' resource + +unhashGrantResource404 = maybe notFound return <=< unhashGrantResource + +hashGrantResource (GrantResourceRepo k) = + GrantResourceRepo <$> encodeKeyHashid k +hashGrantResource (GrantResourceDeck k) = + GrantResourceDeck <$> encodeKeyHashid k +hashGrantResource (GrantResourceLoom k) = + GrantResourceLoom <$> encodeKeyHashid k + +hashGrantResource' (GrantResourceRepo k) = + GrantResourceRepo <$> WAP.encodeKeyHashid k +hashGrantResource' (GrantResourceDeck k) = + GrantResourceDeck <$> WAP.encodeKeyHashid k +hashGrantResource' (GrantResourceLoom k) = + GrantResourceLoom <$> WAP.encodeKeyHashid k + +getGrantResource (GrantResourceRepo k) e = + GrantResourceRepo <$> getEntityE k e +getGrantResource (GrantResourceDeck k) e = + GrantResourceDeck <$> getEntityE k e +getGrantResource (GrantResourceLoom k) e = + GrantResourceLoom <$> getEntityE k e + +getGrantResource404 = maybe notFound return <=< getGrantResourceEntity + where + getGrantResourceEntity (GrantResourceRepo k) = + fmap GrantResourceRepo <$> getEntity k + getGrantResourceEntity (GrantResourceDeck k) = + fmap GrantResourceDeck <$> getEntity k + getGrantResourceEntity (GrantResourceLoom k) = + fmap GrantResourceLoom <$> getEntity k + +grantResourceLocalActor :: GrantResourceBy f -> LocalActorBy f +grantResourceLocalActor (GrantResourceRepo r) = LocalActorRepo r +grantResourceLocalActor (GrantResourceDeck d) = LocalActorDeck d +grantResourceLocalActor (GrantResourceLoom l) = LocalActorLoom l diff --git a/src/Vervis/Data/Ticket.hs b/src/Vervis/Data/Ticket.hs index 31d3286..13e2206 100644 --- a/src/Vervis/Data/Ticket.hs +++ b/src/Vervis/Data/Ticket.hs @@ -75,7 +75,7 @@ import qualified Web.ActivityPub as AP import Control.Monad.Trans.Except.Local -import Vervis.Access +import Vervis.Data.Collab import Vervis.Foundation import Vervis.FedURI import Vervis.Model diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index b174baf..7a759e2 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -94,11 +94,11 @@ import qualified Data.Text.UTF8.Local as TU import Development.PatchMediaType -import Vervis.Access import Vervis.ActivityPub import Vervis.Actor import Vervis.Cloth import Vervis.Data.Actor +import Vervis.Data.Collab import Vervis.Data.Ticket import Vervis.Darcs import Vervis.Web.Delivery diff --git a/src/Vervis/Fetch.hs b/src/Vervis/Fetch.hs index 0393b72..e7553f4 100644 --- a/src/Vervis/Fetch.hs +++ b/src/Vervis/Fetch.hs @@ -80,7 +80,7 @@ import qualified Data.Git.Local as G (createRepo) import qualified Data.Text.UTF8.Local as TU import qualified Darcs.Local.Repository as D (createRepo) -import Vervis.Access +--import Vervis.Access import Vervis.ActivityPub import Vervis.Cloth import Vervis.Data.Actor diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index bd88f53..6693648 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -235,7 +235,6 @@ postPersonOutboxR personHash = do AP.CreatePatchTracker detail repos mlocal -> run createPatchTrackerC detail repos mlocal mtarget _ -> throwE "Unsupported Create 'object' type" - AP.InviteActivity invite -> run inviteC invite {- AddActivity (AP.Add obj target) -> case obj of @@ -254,7 +253,10 @@ postPersonOutboxR personHash = do _ -> throwE "Unsupported Offer 'object' type" AP.ResolveActivity resolve -> run resolveC resolve AP.UndoActivity undo -> run undoC undo - _ -> throwE "Unsupported activity type" + _ -> + handleViaActor + (entityKey eperson) maybeCap localRecips remoteRecips + fwdHosts action getPersonOutboxItemR :: KeyHashid Person -> KeyHashid OutboxItem -> Handler TypedContent diff --git a/src/Vervis/Persist/Actor.hs b/src/Vervis/Persist/Actor.hs index e278ed9..30e8776 100644 --- a/src/Vervis/Persist/Actor.hs +++ b/src/Vervis/Persist/Actor.hs @@ -59,7 +59,7 @@ import qualified Web.Actor.Persist as WAP import Control.Monad.Trans.Except.Local import Database.Persist.Local -import Vervis.Actor2 () +--import Vervis.Actor2 () import Vervis.Data.Actor import Vervis.FedURI import Vervis.Foundation diff --git a/src/Vervis/Persist/Collab.hs b/src/Vervis/Persist/Collab.hs index bfa4d6f..c57d50e 100644 --- a/src/Vervis/Persist/Collab.hs +++ b/src/Vervis/Persist/Collab.hs @@ -20,21 +20,36 @@ module Vervis.Persist.Collab , getTopicGrants , getTopicInvites , getTopicJoins + + , verifyCapability + , verifyCapability' ) where +import Control.Monad import Control.Monad.IO.Class +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except import Control.Monad.Trans.Reader +import Data.Bifunctor +import Data.Bitraversable +import Data.ByteString (ByteString) +import Data.Text (Text) import Data.Time.Clock import Database.Persist.Sql import qualified Database.Esqueleto as E +import Network.FedURI + +import Control.Monad.Trans.Except.Local +import Data.Either.Local import Database.Persist.Local -import Vervis.Access +import Vervis.Actor import Vervis.Data.Collab import Vervis.Model +import Vervis.Persist.Actor getCollabTopic :: MonadIO m => CollabId -> ReaderT SqlBackend m (GrantResourceBy Key) @@ -219,3 +234,81 @@ getTopicJoins topicCollabField topicActorField resourceID = (Just (personID, time), Nothing) -> (Left personID, time) (Nothing, Just (remoteActorID, time)) -> (Right remoteActorID, time) (Just _, Just _) -> error "Multi recip" + +verifyCapability + :: MonadIO m + => (LocalActorBy Key, OutboxItemId) + -> Either PersonId RemoteActorId + -> GrantResourceBy Key + -> ExceptT Text (ReaderT SqlBackend m) () +verifyCapability (capActor, capItem) actor resource = do + + -- Find the activity itself by URI in the DB + nameExceptT "Capability activity not found" $ + verifyLocalActivityExistsInDB capActor capItem + + -- Find the Collab record for that activity + collabID <- do + maybeEnable <- lift $ getValBy $ UniqueCollabEnableGrant capItem + collabEnableCollab <$> + fromMaybeE maybeEnable "No CollabEnable for this activity" + + -- Find the recipient of that Collab + recipID <- + lift $ bimap collabRecipLocalPerson collabRecipRemoteActor <$> + requireEitherAlt + (getValBy $ UniqueCollabRecipLocal collabID) + (getValBy $ UniqueCollabRecipRemote collabID) + "No collab recip" + "Both local and remote recips for collab" + + -- Verify the recipient is the expected one + unless (recipID == actor) $ + throwE "Collab recipient is someone else" + + -- Find the local topic, on which this Collab gives access + topic <- lift $ do + maybeRepo <- getValBy $ UniqueCollabTopicRepo collabID + maybeDeck <- getValBy $ UniqueCollabTopicDeck collabID + maybeLoom <- getValBy $ UniqueCollabTopicLoom collabID + case (maybeRepo, maybeDeck, maybeLoom) of + (Nothing, Nothing, Nothing) -> error "Collab without topic" + (Just r, Nothing, Nothing) -> + return $ GrantResourceRepo $ collabTopicRepoRepo r + (Nothing, Just d, Nothing) -> + return $ GrantResourceDeck $ collabTopicDeckDeck d + (Nothing, Nothing, Just l) -> + return $ GrantResourceLoom $ collabTopicLoomLoom l + _ -> error "Collab with multiple topics" + + -- Verify that topic is indeed the sender of the Grant + unless (grantResourceLocalActor topic == capActor) $ + error "Grant sender isn't the topic" + + -- Verify the topic matches the resource specified + unless (topic == resource) $ + throwE "Capability topic is some other local resource" + + -- Since there are currently no roles, and grants allow only the "Admin" + -- role that supports every operation, we don't need to check role access + return () + +verifyCapability' + :: MonadIO m + => (LocalActorBy Key, OutboxItemId) + -> Either + (LocalActorBy Key, ActorId, OutboxItemId) + (RemoteAuthor, LocalURI, Maybe ByteString) + -> GrantResourceBy Key + -> ExceptT Text (ReaderT SqlBackend m) () +verifyCapability' cap actor resource = do + actorP <- processActor actor + verifyCapability cap actorP resource + where + processActor = bitraverse processLocal processRemote + where + processLocal (actorByKey, _, _) = + case actorByKey of + LocalActorPerson personID -> return personID + _ -> throwE "Non-person local actors can't get Grants at the moment" + processRemote (author, _, _) = pure $ remoteAuthorId author diff --git a/src/Vervis/Persist/Ticket.hs b/src/Vervis/Persist/Ticket.hs index 2531330..62d740b 100644 --- a/src/Vervis/Persist/Ticket.hs +++ b/src/Vervis/Persist/Ticket.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2022 by fr33domlover . + - Written in 2022, 2023 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - @@ -45,13 +45,14 @@ import Control.Monad.Trans.Except.Local import Data.Either.Local import Database.Persist.Local -import Vervis.Access import Vervis.Cloth +import Vervis.Data.Collab import Vervis.Data.Ticket import Vervis.FedURI import Vervis.Foundation import Vervis.Model import Vervis.Persist.Actor +import Vervis.Persist.Collab import Vervis.Recipient getTicketResolve (Entity _ tr, resolve) = do