Update S2S Accept handler to handle Accept on a Create/Ticket

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

migrations/2020_04_07_tpra.model

@@ -0,0 +1,8 @@
+TicketProjectRemoteAccept
+    ticket   TicketProjectRemoteId
+    activity RemoteActivityId
+    accept   Bool
+    result   LocalURI Maybe
+
+    UniqueTicketProjectRemoteAccept         ticket
+    UniqueTicketProjectRemoteAcceptActivity activity

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

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

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