Web.ActivityPub: Allow to specify 'resolved' and 'resolvedBy' for 'Ticket'

src/Vervis/API.hs

@@ -659,7 +659,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                 , TextPandocMarkdown
                 )
         checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
-                               content source muAssigned resolved mmr) = do
+                               content source muAssigned mresolved mmr) = do
             verifyNothingE mlocal "Ticket with 'id'"
             encodeRouteLocal <- getEncodeRouteLocal
             unless (encodeRouteLocal (SharerR shr) == attrib) $
@@ -669,7 +669,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
             uContext <- fromMaybeE muContext "Ticket without 'context'"
             context <- checkTracker "Ticket context" uContext
             verifyNothingE muAssigned "Ticket with 'assignedTo'"
-            when resolved $ throwE "Ticket resolved"
+            when (isJust mresolved) $ throwE "Ticket resolved"
             mmr' <- traverse (uncurry checkMR) mmr
             context' <- matchContextAndMR context mmr'
             return (context', summary, content, source)
@@ -1005,7 +1005,7 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
                         , AP.ticketContent      = desc
                         , AP.ticketSource       = source
                         , AP.ticketAssignedTo   = Nothing
-                        , AP.ticketIsResolved   = False
+                        , AP.ticketResolved     = Nothing
                         , AP.ticketAttachment   = mmr
                         }
                     , createTarget = Just uTarget
@@ -1399,7 +1399,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
         checkTicket
             shrUser
             (AP.Ticket mlocal attrib mpublished mupdated muContext summary
-             content source muAssigned resolved mmr) = do
+             content source muAssigned mresolved mmr) = do
                 verifyNothingE mlocal "Ticket with 'id'"
                 shrAttrib <- do
                     route <- fromMaybeE (decodeRouteLocal attrib) "Ticket attrib not a valid route"
@@ -1412,7 +1412,7 @@ offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTar
                 verifyNothingE mpublished "Ticket with 'published'"
                 verifyNothingE mupdated "Ticket with 'updated'"
                 verifyNothingE muAssigned "Ticket has 'assignedTo'"
-                when resolved $ throwE "Ticket is resolved"
+                when (isJust mresolved) $ throwE "Ticket is resolved"
 
                 mmr' <- traverse (uncurry checkMR) mmr
 

src/Vervis/Client.hs

@@ -246,7 +246,7 @@ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj = runEx
             , AP.ticketContent      = TextHtml descHtml
             , AP.ticketSource       = TextPandocMarkdown desc
             , AP.ticketAssignedTo   = Nothing
-            , AP.ticketIsResolved   = False
+            , AP.ticketResolved     = Nothing
             , AP.ticketAttachment   = Nothing
             }
         target = encodeRouteHome $ ProjectR shr prj
@@ -311,7 +311,7 @@ createTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) target context
             , AP.ticketContent      = TextHtml descHtml
             , AP.ticketSource       = TextPandocMarkdown desc
             , AP.ticketAssignedTo   = Nothing
-            , AP.ticketIsResolved   = False
+            , AP.ticketResolved     = Nothing
             , AP.ticketAttachment   = Nothing
             }
         create = Create

src/Vervis/Federation/Ticket.hs

@@ -133,7 +133,7 @@ checkOfferTicket author ticket uTarget = do
             else return $ Right u
 
     checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
-                           content source muAssigned resolved mmr) = do
+                           content source muAssigned mresolved mmr) = do
         verifyNothingE mlocal "Ticket with 'id'"
         unless (attrib == objUriLocal (remoteAuthorURI author)) $
             throwE "Author created ticket attibuted to someone else"
@@ -141,7 +141,7 @@ checkOfferTicket author ticket uTarget = do
         verifyNothingE mpublished "Ticket has 'published'"
         verifyNothingE mupdated "Ticket has 'updated'"
         verifyNothingE muAssigned "Ticket has 'assignedTo'"
-        when resolved $ throwE "Ticket is resolved"
+        when (isJust mresolved) $ throwE "Ticket is resolved"
 
         mmr' <- traverse (uncurry checkMR) mmr
 
@@ -567,7 +567,7 @@ checkCreateTicket author ticket muTarget = do
             , TextPandocMarkdown
             )
     checkTicket (AP.Ticket mlocal attrib mpublished mupdated muContext summary
-                           content source muAssigned resolved mmr) = do
+                           content source muAssigned mresolved mmr) = do
         (hTicket, tlocal) <- fromMaybeE mlocal "Ticket without 'id'"
         hl <- hostIsLocal hTicket
         when hl $ throwE "Remote author claims to create local ticket"
@@ -581,7 +581,7 @@ checkCreateTicket author ticket muTarget = do
         pub <- fromMaybeE mpublished "Ticket without 'published'"
         verifyNothingE mupdated "Ticket has 'updated'"
         verifyNothingE muAssigned "Ticket has 'assignedTo'"
-        when resolved $ throwE "Ticket is resolved"
+        when (isJust mresolved) $ throwE "Ticket is resolved"
 
         mmr' <- traverse (uncurry checkMR) mmr
         context' <- matchTicketAndMR (AP.ticketId tlocal) pub context mmr'

src/Vervis/Handler/Client.hs

@@ -460,7 +460,7 @@ postPublishR = do
                 , ticketContent      = TextHtml descHtml
                 , ticketSource       = TextPandocMarkdown desc
                 , ticketAssignedTo   = Nothing
-                , ticketIsResolved   = False
+                , ticketResolved     = Nothing
                 , ticketAttachment   = Nothing
                 }
             target = encodeRouteFed h $ ProjectR shr prj

src/Vervis/Handler/Patch.hs

@@ -176,7 +176,10 @@ getSharerPatchR shr talkhid = do
             , AP.ticketSource       = TextPandocMarkdown $ ticketSource ticket
             , AP.ticketAssignedTo   =
                 encodeRouteHome . SharerR . sharerIdent <$> massignee
-            , AP.ticketIsResolved   = ticketStatus ticket == TSClosed
+            , AP.ticketResolved     =
+                if ticketStatus ticket == TSClosed
+                    then Just (Nothing, Nothing)
+                    else Nothing
             , AP.ticketAttachment   = Just
                 ( case repo of
                     Left _ -> hLocal
@@ -461,7 +464,10 @@ getRepoPatchR shr rp ltkhid = do
             , AP.ticketSource       = TextPandocMarkdown $ ticketSource ticket
             , AP.ticketAssignedTo   =
                 encodeRouteHome . SharerR . sharerIdent <$> massignee
-            , AP.ticketIsResolved   = ticketStatus ticket == TSClosed
+            , AP.ticketResolved     =
+                if ticketStatus ticket == TSClosed
+                    then Just (Nothing, Nothing)
+                    else Nothing
             , AP.ticketAttachment   = Just
                 ( hLocal
                 , MergeRequest

src/Vervis/Handler/Ticket.hs

@@ -393,7 +393,10 @@ getProjectTicketR shar proj ltkhid = do
             , AP.ticketSource       = TextPandocMarkdown $ ticketSource ticket
             , AP.ticketAssignedTo   =
                 encodeRouteHome . SharerR . sharerIdent . fst <$> massignee
-            , AP.ticketIsResolved   = ticketStatus ticket == TSClosed
+            , AP.ticketResolved     =
+                if ticketStatus ticket == TSClosed
+                    then Just (Nothing, Nothing)
+                    else Nothing
             , AP.ticketAttachment   = Nothing
             }
     provideHtmlAndAP' host ticketAP $
@@ -1112,7 +1115,10 @@ getSharerTicketR shr talkhid = do
             , AP.ticketSource       = TextPandocMarkdown $ ticketSource ticket
             , AP.ticketAssignedTo   =
                 encodeRouteHome . SharerR . sharerIdent <$> massignee
-            , AP.ticketIsResolved   = ticketStatus ticket == TSClosed
+            , AP.ticketResolved     =
+                if ticketStatus ticket == TSClosed
+                    then Just (Nothing, Nothing)
+                    else Nothing
             , AP.ticketAttachment   = Nothing
             }
     provideHtmlAndAP ticketAP $ redirectToPrettyJSON here

src/Vervis/Migration.hs

@@ -765,7 +765,7 @@ changes hLocal ctx =
                         , ticketSource       =
                             TextPandocMarkdown $ ticket20190612Source ticket
                         , ticketAssignedTo   = Nothing
-                        , ticketIsResolved   = False
+                        , ticketResolved     = Nothing
                         , ticketAttachment   = Nothing
                         }
                     summary =

src/Web/ActivityPub.hs

@@ -1002,7 +1002,7 @@ data Ticket u = Ticket
     , ticketContent      :: TextHtml
     , ticketSource       :: TextPandocMarkdown
     , ticketAssignedTo   :: Maybe (ObjURI u)
-    , ticketIsResolved   :: Bool
+    , ticketResolved     :: Maybe (Maybe (ObjURI u), Maybe UTCTime)
     , ticketAttachment   :: Maybe (Authority u, MergeRequest u)
     }
 
@@ -1024,6 +1024,18 @@ instance ActivityPub Ticket where
 
         ObjURI a attributedTo <- o .: "attributedTo"
 
+        mresolved <- do
+            is <- o .:? "isResolved" .!= False
+            if is
+                then do
+                    at <- o .:? "resolved"
+                    by <- o .:? "resolvedBy"
+                    return $ Just (by, at)
+                else do
+                    verifyNothing "resolved"
+                    verifyNothing "resolvedBy"
+                    return Nothing
+
         fmap (a,) $
             Ticket
                 <$> parseTicketLocal o
@@ -1036,12 +1048,17 @@ instance ActivityPub Ticket where
                 <*> (TextHtml . sanitizeBalance <$> o .: "content")
                 <*> source .: "content"
                 <*> o .:? "assignedTo"
-                <*> o .: "isResolved"
+                <*> pure mresolved
                 <*> (traverse parseObject =<< o .:? "attachment")
+        where
+        verifyNothing t =
+            if t `M.member` o
+                then fail $ T.unpack t ++ " field found, expected none"
+                else return ()
 
     toSeries authority
         (Ticket local attributedTo published updated context {-name-}
-                summary content source assignedTo isResolved mmr)
+                summary content source assignedTo mresolved mmr)
 
             =   maybe mempty (uncurry encodeTicketLocal) local
             <> "type"         .=  ("Ticket" :: Text)
@@ -1058,7 +1075,14 @@ instance ActivityPub Ticket where
                     , "mediaType" .= ("text/markdown; variant=Pandoc" :: Text)
                     ]
             <> "assignedTo"   .=? assignedTo
-            <> "isResolved"   .=  isResolved
+            <> maybe
+                ("isResolved" .= False)
+                (\ (mby, mat)
+                    -> "isResolved" .= True
+                    <> "resolvedBy" .=? mby
+                    <> "resolved"   .=? mat
+                )
+                mresolved
             <> maybe
                 mempty
                 (\ (h, mr) -> "attachment" `pair` pairs (toSeries h mr))