From 4a362632be067ccc6bf2f433a31b2a018a3707eb Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Wed, 8 Apr 2020 17:02:04 +0000
Subject: [PATCH] Update S2S Accept handler to handle Accept on a Create/Ticket

---
 config/models                    |  9 ++++++++
 migrations/2020_04_07_tpra.model |  8 ++++++++
 src/Vervis/Federation/Offer.hs   | 35 ++++++++++++++++++++++++++++----
 src/Vervis/Migration.hs          |  2 ++
 src/Vervis/Migration/Model.hs    |  4 ++++
 5 files changed, 54 insertions(+), 4 deletions(-)
 create mode 100644 migrations/2020_04_07_tpra.model

diff --git a/config/models b/config/models
index 45015a6..8872e76 100644
--- a/config/models
+++ b/config/models
@@ -379,6 +379,15 @@ TicketProjectRemote
 
     UniqueTicketProjectRemote ticket
 
+TicketProjectRemoteAccept
+    ticket   TicketProjectRemoteId
+    activity RemoteActivityId
+    accept   Bool
+    result   LocalURI Maybe
+
+    UniqueTicketProjectRemoteAccept         ticket
+    UniqueTicketProjectRemoteAcceptActivity activity
+
 TicketAuthorLocal
     ticket LocalTicketId
     author PersonId
diff --git a/migrations/2020_04_07_tpra.model b/migrations/2020_04_07_tpra.model
new file mode 100644
index 0000000..1d5023e
--- /dev/null
+++ b/migrations/2020_04_07_tpra.model
@@ -0,0 +1,8 @@
+TicketProjectRemoteAccept
+    ticket   TicketProjectRemoteId
+    activity RemoteActivityId
+    accept   Bool
+    result   LocalURI Maybe
+
+    UniqueTicketProjectRemoteAccept         ticket
+    UniqueTicketProjectRemoteAcceptActivity activity
diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs
index 85db130..e936f8c 100644
--- a/src/Vervis/Federation/Offer.hs
+++ b/src/Vervis/Federation/Offer.hs
@@ -28,6 +28,7 @@ module Vervis.Federation.Offer
     )
 where
 
+import Control.Applicative
 import Control.Exception hiding (Handler)
 import Control.Monad
 import Control.Monad.Logger.CallStack
@@ -87,7 +88,7 @@ sharerAcceptF
     -> ActivityBody
     -> Accept URIMode
     -> ExceptT Text Handler Text
-sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) _) = do
+sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) mresult) = do
     luAccept <-
         fromMaybeE (activityId $ actbActivity body) "Accept without 'id'"
     lift $ runDB $ do
@@ -100,12 +101,17 @@ sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) _) = do
         case mractid of
             Nothing -> return $ "Activity already exists in inbox of " <> me
             Just ractid -> do
-                mv <- insertFollow pidRecip (personOutbox recip) ractid
+                mv <-
+                    runMaybeT
+                        $   Left  <$> insertFollow pidRecip (personOutbox recip) ractid
+                        <|> Right <$> updateTicket pidRecip (personOutbox recip) ractid
                 case mv of
                     Nothing ->
                         return $ "Activity inserted to inbox of " <> me
-                    Just () ->
+                    Just (Left ()) ->
                         return $ "Accept received for follow request by " <> me
+                    Just (Right ()) ->
+                        return $ "Accept received for ticket by " <> me
     where
     insertToInbox luAccept ibidRecip = do
         let iidAuthor = remoteAuthorInstance author
@@ -122,7 +128,7 @@ sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) _) = do
                 delete ibiid
                 return Nothing
             Just _ -> return $ Just ractid
-    insertFollow pidRecip obidRecip ractidAccept = runMaybeT $ do
+    insertFollow pidRecip obidRecip ractidAccept = do
         guard =<< hostIsLocal hOffer
         route <- MaybeT . pure $ decodeRouteLocal luOffer
         obiid <-
@@ -148,6 +154,27 @@ sharerAcceptF shr now author body (Accept (ObjURI hOffer luOffer) _) = do
             , followRemoteFollow = followRemoteRequestActivity frr
             , followRemoteAccept = ractidAccept
             }
+    updateTicket pidRecip obidRecip ractidAccept = do
+        guard =<< hostIsLocal hOffer
+        route <- MaybeT . pure $ decodeRouteLocal luOffer
+        obiid <-
+            case route of
+                SharerOutboxItemR shr' obikhid
+                    | shr == shr' -> decodeKeyHashidM obikhid
+                _ -> MaybeT $ pure Nothing
+        obi <- MaybeT $ get obiid
+        guard $ outboxItemOutbox obi == obidRecip
+        Entity talid tal <- MaybeT $ getBy $ UniqueTicketAuthorLocalOpen obiid
+        guard $ ticketAuthorLocalAuthor tal == pidRecip
+        Entity tprid tpr <- MaybeT $ getBy $ UniqueTicketProjectRemote talid
+        guard $ remoteAuthorId author == ticketProjectRemoteTracker tpr
+        _tpraid <- MaybeT $ insertUnique TicketProjectRemoteAccept
+            { ticketProjectRemoteAcceptTicket   = tprid
+            , ticketProjectRemoteAcceptActivity = ractidAccept
+            , ticketProjectRemoteAcceptAccept   = True
+            , ticketProjectRemoteAcceptResult   = mresult
+            }
+        return ()
 
 sharerRejectF
     :: ShrIdent
diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index 5933894..fe60c78 100644
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@@ -1509,6 +1509,8 @@ changes hLocal ctx =
     , renameField "RemoteMessage" "identNew" "ident"
       -- 234
     , addEntities model_2020_02_22
+      -- 235
+    , addEntities model_2020_04_07
     ]
 
 migrateDB
diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs
index 0662091..5cc28c4 100644
--- a/src/Vervis/Migration/Model.hs
+++ b/src/Vervis/Migration/Model.hs
@@ -181,6 +181,7 @@ module Vervis.Migration.Model
     , RemoteMessage227
     , RemoteMessage227Generic (..)
     , model_2020_02_22
+    , model_2020_04_07
     )
 where
 
@@ -355,3 +356,6 @@ makeEntitiesMigration "227"
 
 model_2020_02_22 :: [Entity SqlBackend]
 model_2020_02_22 = $(schema "2020_02_22_tpr")
+
+model_2020_04_07 :: [Entity SqlBackend]
+model_2020_04_07 = $(schema "2020_04_07_tpra")