Upgrade sharerOfferTicketF to new utils

src/Vervis/Federation/Ticket.hs

@@ -102,6 +102,55 @@ checkOffer ticket hProject shrProject prjProject = do
     when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved"
     verifyNothingE (AP.ticketAttachment ticket) "Ticket with 'attachment'"
 
+checkOfferTicket
+    :: RemoteAuthor
+    -> AP.Ticket URIMode
+    -> FedURI
+    -> ExceptT
+        Text
+        Handler
+        ( Either (ShrIdent, PrjIdent) FedURI
+        , TextHtml
+        , TextHtml
+        , TextPandocMarkdown
+        )
+checkOfferTicket author ticket uTarget = do
+    target <- checkProject uTarget
+    (muContext, summary, content, source) <- checkTicket ticket
+    for_ muContext $
+        \ u -> unless (u == uTarget) $ throwE "Offer target != Ticket context"
+    return (target, summary, content, source)
+    where
+    checkProject u@(ObjURI h lu) = do
+        hl <- hostIsLocal h
+        if hl
+            then Left <$> do
+                route <-
+                    fromMaybeE
+                        (decodeRouteLocal lu)
+                        "Offer target is local but isn't a valid route"
+                case route of
+                    ProjectR shr prj -> return (shr, prj)
+                    _ ->
+                        throwE
+                            "Offer target is a valid local route, but isn't a \
+                            \project route"
+            else return $ Right u
+
+    checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
+                           content source muAssigned resolved mmr) = do
+        verifyNothingE mlocal "Ticket with 'id'"
+        unless (attrib == objUriLocal (remoteAuthorURI author)) $
+            throwE "Author created ticket attibuted to someone else"
+
+        verifyNothingE mpublished "Ticket has 'published'"
+        verifyNothingE mupdated "Ticket has 'updated'"
+        verifyNothingE muAssigned "Ticket has 'assignedTo'"
+        when resolved $ throwE "Ticket is resolved"
+        verifyNothingE mmr "Ticket has 'attachment'"
+
+        return (muContext, summary, content, source)
+
 sharerOfferTicketF
     :: UTCTime
     -> ShrIdent
@@ -113,45 +162,23 @@ sharerOfferTicketF
     -> FedURI
     -> ExceptT Text Handler Text
 sharerOfferTicketF now shrRecip author body mfwd luOffer ticket uTarget = do
-    (hProject, shrProject, prjProject) <- parseTarget uTarget
+    (target, _, _, _) <- checkOfferTicket author ticket uTarget
-    {-deps <- -}
+    mractid <- runDBExcept $ do
-    checkOffer ticket hProject shrProject prjProject
-    local <- hostIsLocal hProject
-    runDBExcept $ do
         ibidRecip <- lift $ do
             sid <- getKeyBy404 $ UniqueSharer shrRecip
-            p <- getValBy404 $ UniquePersonIdent sid
+            personInbox <$> getValBy404 (UniquePersonIdent sid)
-            return $ personInbox p
+        case target of
-        when local $ checkTargetAndDeps shrProject prjProject {-deps-}
+            Left (shr, prj) -> do
-        lift $ insertToInbox luOffer ibidRecip
+                mjid <- lift $ runMaybeT $ do
-    where
+                    sid <- MaybeT $ getKeyBy $ UniqueSharer shr
-    checkTargetAndDeps shrProject prjProject {-deps-} = do
+                    MaybeT $ getKeyBy $ UniqueProject prj sid
-        msid <- lift $ getKeyBy $ UniqueSharer shrProject
+                void $ fromMaybeE mjid "Offer target: No such local project"
-        sid <- fromMaybeE msid "Offer target: no such local sharer"
+            Right _ -> return ()
-        mjid <- lift $ getKeyBy $ UniqueProject prjProject sid
+        lift $ insertToInbox now author body ibidRecip luOffer True
-        jid <- fromMaybeE mjid "Offer target: no such local project"
+    return $
-        return ()
+        case mractid of
-        {-
+            Nothing -> "Activity already exists in my inbox"
-        for_ deps $ \ dep -> do
+            Just _ -> "Activity inserted to my inbox"
-            mt <- lift $ getBy $ UniqueTicket jid dep
-            unless (isJust mt) $
-                throwE "Local dep: No such ticket number in DB"
-        -}
-    insertToInbox luOffer ibidRecip = do
-        let iidAuthor = remoteAuthorInstance author
-        roid <-
-            either entityKey id <$> insertBy' (RemoteObject iidAuthor luOffer)
-        let jsonObj = persistJSONFromBL $ actbBL body
-            ract = RemoteActivity roid jsonObj now
-        ractid <- either entityKey id <$> insertBy' ract
-        ibiid <- insert $ InboxItem True
-        mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
-        let recip = shr2text shrRecip
-        case mibrid of
-            Nothing -> do
-                delete ibiid
-                return $ "Activity already exists in inbox of /s/" <> recip
-            Just _ -> return $ "Activity inserted to inbox of /s/" <> recip
 
 data OfferTicketRecipColl
     = OfferTicketRecipProjectFollowers