From 58e88d1e1b652e1814d06a6049bc71b7dc202e1f Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Wed, 15 Jul 2020 08:00:08 +0000
Subject: [PATCH] Upgrade sharerOfferTicketF to new utils

---
 src/Vervis/Federation/Ticket.hs | 101 ++++++++++++++++++++------------
 1 file changed, 64 insertions(+), 37 deletions(-)

diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs
index b38a3de..31d9532 100644
--- a/src/Vervis/Federation/Ticket.hs
+++ b/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
-    {-deps <- -}
-    checkOffer ticket hProject shrProject prjProject
-    local <- hostIsLocal hProject
-    runDBExcept $ do
+    (target, _, _, _) <- checkOfferTicket author ticket uTarget
+    mractid <- runDBExcept $ do
         ibidRecip <- lift $ do
             sid <- getKeyBy404 $ UniqueSharer shrRecip
-            p <- getValBy404 $ UniquePersonIdent sid
-            return $ personInbox p
-        when local $ checkTargetAndDeps shrProject prjProject {-deps-}
-        lift $ insertToInbox luOffer ibidRecip
-    where
-    checkTargetAndDeps shrProject prjProject {-deps-} = do
-        msid <- lift $ getKeyBy $ UniqueSharer shrProject
-        sid <- fromMaybeE msid "Offer target: no such local sharer"
-        mjid <- lift $ getKeyBy $ UniqueProject prjProject sid
-        jid <- fromMaybeE mjid "Offer target: no such local project"
-        return ()
-        {-
-        for_ deps $ \ dep -> do
-            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
+            personInbox <$> getValBy404 (UniquePersonIdent sid)
+        case target of
+            Left (shr, prj) -> do
+                mjid <- lift $ runMaybeT $ do
+                    sid <- MaybeT $ getKeyBy $ UniqueSharer shr
+                    MaybeT $ getKeyBy $ UniqueProject prj sid
+                void $ fromMaybeE mjid "Offer target: No such local project"
+            Right _ -> return ()
+        lift $ insertToInbox now author body ibidRecip luOffer True
+    return $
+        case mractid of
+            Nothing -> "Activity already exists in my inbox"
+            Just _ -> "Activity inserted to my inbox"
 
 data OfferTicketRecipColl
     = OfferTicketRecipProjectFollowers