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

@@ -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

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 ()