From 5cf105fafb2ae9a0fe90df07e56459b0c9e7cb9c Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sun, 21 Jun 2020 12:31:11 +0000 Subject: [PATCH] Move checkDepAndTarget from Vervis.Federation.Ticket to Vervis.Ticket I'm moving it there because it's going to be used in C2S too, in offerDepC. --- src/Vervis/Federation/Ticket.hs | 57 ---------------------------- src/Vervis/Ticket.hs | 66 +++++++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 57 deletions(-) diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index 40de57e..f5f2cd4 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -891,63 +891,6 @@ sharerOfferDepF now shrRecip author body dep uTarget = do (Just _, Nothing) -> "Accepted new ticket dep, no inbox-forwarding to do" (Just _, Just _) -> "Accepted new ticket dep and ran inbox-forwarding of the Offer" where - checkDepAndTarget - (AP.TicketDependency id_ uParent uChild _attrib published updated) uTarget = do - verifyNothingE id_ "Dep with 'id'" - parent <- parseWorkItem "Dep parent" uParent - child <- parseWorkItem "Dep child" uChild - when (parent == child) $ - throwE "Parent and child are the same work item" - verifyNothingE published "Dep with 'published'" - verifyNothingE updated "Dep with 'updated'" - target <- parseTarget uTarget - checkParentAndTarget parent target - return (parent, child) - where - parseWorkItem name u@(ObjURI h lu) = do - hl <- hostIsLocal h - if hl - then Left <$> do - route <- - fromMaybeE (decodeRouteLocal lu) $ - name <> ": Not a valid route" - case route of - SharerTicketR shr talkhid -> do - talid <- decodeKeyHashidE talkhid $ name <> ": Invalid talkhid" - return $ WorkItemSharerTicket shr talid False - SharerPatchR shr talkhid -> do - talid <- decodeKeyHashidE talkhid $ name <> ": Invalid talkhid" - return $ WorkItemSharerTicket shr talid True - ProjectTicketR shr prj ltkhid -> do - ltid <- decodeKeyHashidE ltkhid $ name <> ": Invalid ltkhid" - return $ WorkItemProjectTicket shr prj ltid - RepoPatchR shr rp ltkhid -> do - ltid <- decodeKeyHashidE ltkhid $ name <> ": Invalid ltkhid" - return $ WorkItemRepoPatch shr rp ltid - _ -> throwE $ name <> ": not a work item route" - else return $ Right u - parseTarget u@(ObjURI h lu) = do - hl <- hostIsLocal h - if hl - then Left <$> do - route <- - fromMaybeE - (decodeRouteLocal lu) - "Offer local target isn't a valid route" - fromMaybeE - (parseLocalActor route) - "Offer local target isn't an actor route" - else return $ Right u - checkParentAndTarget (Left wi) (Left la) = - unless (workItemActor wi == la) $ - throwE "Parent and target mismatch" - where - workItemActor (WorkItemSharerTicket shr _ _) = LocalActorSharer shr - workItemActor (WorkItemProjectTicket shr prj _) = LocalActorProject shr prj - workItemActor (WorkItemRepoPatch shr rp _) = LocalActorRepo shr rp - checkParentAndTarget (Left _) (Right _) = throwE "Local parent but remote target" - checkParentAndTarget (Right _) (Left _) = throwE "Local target but remote parent" - checkParentAndTarget (Right _) (Right _) = return () ticketRelevance shr (Left (WorkItemSharerTicket shr' talid patch)) | shr == shr' = Just (talid, patch) ticketRelevance _ _ = Nothing diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index 4c98420..70a90ac 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -40,6 +40,8 @@ module Vervis.Ticket , getWorkItemRoute , askWorkItemRoute , getWorkItem + + , checkDepAndTarget ) where @@ -75,6 +77,7 @@ import Data.Paginate.Local import Database.Persist.Local import Yesod.Persist.Local +import Vervis.ActivityPub.Recipient import Vervis.FedURI import Vervis.Foundation import Vervis.Model @@ -814,3 +817,66 @@ getWorkItem ltid = (either error return =<<) $ runExceptT $ do p <- getJust $ ticketAuthorLocalAuthor tal s <- getJust $ personIdent p return $ WorkItemSharerTicket (sharerIdent s) talid patch + +checkDepAndTarget + :: (MonadSite m, SiteEnv m ~ App) + => TicketDependency URIMode + -> FedURI + -> ExceptT Text m (Either WorkItem FedURI, Either WorkItem FedURI) +checkDepAndTarget + (TicketDependency id_ uParent uChild _attrib published updated) uTarget = do + verifyNothingE id_ "Dep with 'id'" + parent <- parseWorkItem "Dep parent" uParent + child <- parseWorkItem "Dep child" uChild + when (parent == child) $ + throwE "Parent and child are the same work item" + verifyNothingE published "Dep with 'published'" + verifyNothingE updated "Dep with 'updated'" + target <- parseTarget uTarget + checkParentAndTarget parent target + return (parent, child) + where + parseWorkItem name u@(ObjURI h lu) = do + hl <- hostIsLocal h + if hl + then Left <$> do + route <- + fromMaybeE (decodeRouteLocal lu) $ + name <> ": Not a valid route" + case route of + SharerTicketR shr talkhid -> do + talid <- decodeKeyHashidE talkhid $ name <> ": Invalid talkhid" + return $ WorkItemSharerTicket shr talid False + SharerPatchR shr talkhid -> do + talid <- decodeKeyHashidE talkhid $ name <> ": Invalid talkhid" + return $ WorkItemSharerTicket shr talid True + ProjectTicketR shr prj ltkhid -> do + ltid <- decodeKeyHashidE ltkhid $ name <> ": Invalid ltkhid" + return $ WorkItemProjectTicket shr prj ltid + RepoPatchR shr rp ltkhid -> do + ltid <- decodeKeyHashidE ltkhid $ name <> ": Invalid ltkhid" + return $ WorkItemRepoPatch shr rp ltid + _ -> throwE $ name <> ": not a work item route" + else return $ Right u + parseTarget u@(ObjURI h lu) = do + hl <- hostIsLocal h + if hl + then Left <$> do + route <- + fromMaybeE + (decodeRouteLocal lu) + "Offer local target isn't a valid route" + fromMaybeE + (parseLocalActor route) + "Offer local target isn't an actor route" + else return $ Right u + checkParentAndTarget (Left wi) (Left la) = + unless (workItemActor wi == la) $ + throwE "Parent and target mismatch" + where + workItemActor (WorkItemSharerTicket shr _ _) = LocalActorSharer shr + workItemActor (WorkItemProjectTicket shr prj _) = LocalActorProject shr prj + workItemActor (WorkItemRepoPatch shr rp _) = LocalActorRepo shr rp + checkParentAndTarget (Left _) (Right _) = throwE "Local parent but remote target" + checkParentAndTarget (Right _) (Left _) = throwE "Local target but remote parent" + checkParentAndTarget (Right _) (Right _) = return ()