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

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