From b1897a20c0b2550ce3f3b4fd8a8dd54472edd6a9 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Fri, 7 Jun 2019 04:26:32 +0000 Subject: [PATCH] Allow ticket author to be a remote actor --- config/models | 15 ++- migrations/2019_06_06.model | 11 ++ migrations/2019_06_06_mig.model | 24 ++++ src/Data/Either/Local.hs | 13 +++ src/Vervis/Form/Ticket.hs | 1 - src/Vervis/Handler/Group.hs | 2 +- src/Vervis/Handler/Repo/Git.hs | 2 +- src/Vervis/Handler/Ticket.hs | 115 +++++++++++++------- src/Vervis/Migration.hs | 12 ++ src/Vervis/Migration/Model.hs | 10 ++ src/Vervis/Ticket.hs | 73 ++++++++----- src/Vervis/Widget/Discussion.hs | 2 +- src/Vervis/Widget/Sharer.hs | 36 ++++-- src/Vervis/Widget/Ticket.hs | 6 +- src/Yesod/ActivityPub.hs | 44 ++++---- templates/group/list.hamlet | 4 +- templates/group/member/list.hamlet | 4 +- templates/project/claim-request/list.hamlet | 4 +- templates/project/collab/list.hamlet | 2 +- templates/repo/collab/list.hamlet | 2 +- templates/repo/patch.hamlet | 4 +- templates/sharer-link.hamlet | 19 ---- templates/ticket/claim-request/list.hamlet | 4 +- templates/ticket/dep/list.hamlet | 6 +- templates/ticket/one.hamlet | 11 +- templates/ticket/widget/summary.hamlet | 4 +- 26 files changed, 281 insertions(+), 149 deletions(-) create mode 100644 migrations/2019_06_06.model create mode 100644 migrations/2019_06_06_mig.model delete mode 100644 templates/sharer-link.hamlet diff --git a/config/models b/config/models index 59d0ed2..bb8e8c5 100644 --- a/config/models +++ b/config/models @@ -281,14 +281,13 @@ Ticket project ProjectId number Int created UTCTime - creator PersonId title Text source Text -- Pandoc Markdown description Text -- HTML assignee PersonId Maybe status TicketStatus closed UTCTime - closer PersonId + closer PersonId Maybe discuss DiscussionId followers FollowerSetId @@ -296,6 +295,18 @@ Ticket UniqueTicketDiscussion discuss UniqueTicketFollowers followers +TicketAuthorLocal + ticket TicketId + author PersonId + + UniqueTicketAuthorLocal ticket + +TicketAuthorRemote + ticket TicketId + author RemoteActorId + + UniqueTicketAuthorRemote ticket + TicketDependency parent TicketId child TicketId diff --git a/migrations/2019_06_06.model b/migrations/2019_06_06.model new file mode 100644 index 0000000..4c968fe --- /dev/null +++ b/migrations/2019_06_06.model @@ -0,0 +1,11 @@ +TicketAuthorLocal + ticket TicketId + author PersonId + + UniqueTicketAuthorLocal ticket + +TicketAuthorRemote + ticket TicketId + author RemoteActorId + + UniqueTicketAuthorRemote ticket diff --git a/migrations/2019_06_06_mig.model b/migrations/2019_06_06_mig.model new file mode 100644 index 0000000..5dbfbde --- /dev/null +++ b/migrations/2019_06_06_mig.model @@ -0,0 +1,24 @@ +TicketAuthorLocal + ticket TicketId + author Int64 + + UniqueTicketAuthorLocal ticket + +Ticket + project Int64 + number Int + created UTCTime + creator Int64 + title Text + source Text -- Pandoc Markdown + description Text -- HTML + assignee Int64 Maybe + status Text + closed UTCTime + closer Int64 + discuss Int64 + followers Int64 + + UniqueTicket project number + UniqueTicketDiscussion discuss + UniqueTicketFollowers followers diff --git a/src/Data/Either/Local.hs b/src/Data/Either/Local.hs index 19dbf51..ec6c932 100644 --- a/src/Data/Either/Local.hs +++ b/src/Data/Either/Local.hs @@ -17,11 +17,14 @@ module Data.Either.Local ( maybeRight , maybeLeft , requireEither + , requireEitherAlt ) where import Prelude +import Control.Applicative + maybeRight :: Either a b -> Maybe b maybeRight (Left _) = Nothing maybeRight (Right b) = Just b @@ -35,3 +38,13 @@ requireEither Nothing Nothing = Left False requireEither (Just _) (Just _) = Left True requireEither (Just x) Nothing = Right $ Left x requireEither Nothing (Just y) = Right $ Right y + +requireEitherAlt + :: Applicative f + => f (Maybe a) -> f (Maybe b) -> String -> String -> f (Either a b) +requireEitherAlt get1 get2 errNone errBoth = liftA2 mk get1 get2 + where + mk Nothing Nothing = error errNone + mk (Just _) (Just _) = error errBoth + mk (Just x) Nothing = Left x + mk Nothing (Just y) = Right y diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index 67f8199..4d0680f 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -123,7 +123,6 @@ editTicketContentAForm ticket = Ticket <$> pure (ticketProject ticket) <*> pure (ticketNumber ticket) <*> pure (ticketCreated ticket) - <*> pure (ticketCreator ticket) <*> areq textField "Title*" (Just $ ticketTitle ticket) <*> ( maybe "" (T.filter (/= '\r') . unTextarea) <$> aopt diff --git a/src/Vervis/Handler/Group.hs b/src/Vervis/Handler/Group.hs index 6afc254..35f75c3 100644 --- a/src/Vervis/Handler/Group.hs +++ b/src/Vervis/Handler/Group.hs @@ -52,7 +52,7 @@ import Vervis.Model.Group import Vervis.Model.Ident (ShrIdent, shr2text) import Vervis.Settings (widgetFile) import Vervis.Time (showDate) -import Vervis.Widget.Sharer (groupLinkW, personLinkW) +import Vervis.Widget.Sharer getGroupsR :: Handler Html getGroupsR = do diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs index 8a764e0..519e21c 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/src/Vervis/Handler/Repo/Git.hs @@ -78,7 +78,7 @@ import Vervis.Style import Vervis.Time (showDate) import Vervis.Widget (buttonW) import Vervis.Widget.Repo -import Vervis.Widget.Sharer (personLinkW) +import Vervis.Widget.Sharer import qualified Data.ByteString.Lazy as BL (ByteString) import qualified Data.Git.Local as G (createRepo) diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 7a3e675..646546f 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -96,6 +96,7 @@ import Yesod.Hashids import qualified Web.ActivityPub as AP +import Data.Either.Local import Data.Maybe.Local (partitionMaybePairs) import Database.Persist.Local import Yesod.Persist.Local @@ -117,7 +118,7 @@ import Vervis.TicketFilter (filterTickets) import Vervis.Time (showDate) import Vervis.Widget (buttonW) import Vervis.Widget.Discussion (discussionW) -import Vervis.Widget.Sharer (personLinkW) +import Vervis.Widget.Sharer import Vervis.Widget.Ticket getTicketsR :: ShrIdent -> PrjIdent -> Handler Html @@ -164,18 +165,18 @@ postTicketsR shar proj = do { ticketProject = pid , ticketNumber = projectNextTicket project , ticketCreated = now - , ticketCreator = author , ticketTitle = ntTitle nt , ticketSource = source , ticketDescription = descHtml , ticketAssignee = Nothing , ticketStatus = TSNew , ticketClosed = UTCTime (ModifiedJulianDay 0) 0 - , ticketCloser = author + , ticketCloser = Nothing , ticketDiscuss = did , ticketFollowers = fsid } tid <- insert ticket + insert_ $ TicketAuthorLocal tid author let mktparam (fid, v) = TicketParamText { ticketParamTextTicket = tid , ticketParamTextField = fid @@ -221,7 +222,7 @@ getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler TypedContent getTicketR shar proj num = do mpid <- maybeAuthId ( wshr, wfl, - author, massignee, closer, ticket, tparams, eparams, deps, rdeps) <- + author, massignee, mcloser, ticket, tparams, eparams, deps, rdeps) <- runDB $ do (jid, wshr, wid, wfl) <- do Entity s sharer <- getBy404 $ UniqueSharer shar @@ -238,19 +239,37 @@ getTicketR shar proj num = do , workflowIdent w ) Entity tid ticket <- getBy404 $ UniqueTicket jid num - author <- do - person <- get404 $ ticketCreator ticket - get404 $ personIdent person + author <- + requireEitherAlt + (do mtal <- getValBy $ UniqueTicketAuthorLocal tid + for mtal $ \ tal -> do + p <- getJust $ ticketAuthorLocalAuthor tal + getJust $ personIdent p + ) + (do mtar <- getValBy $ UniqueTicketAuthorRemote tid + for mtar $ \ tar -> do + ra <- getJust $ ticketAuthorRemoteAuthor tar + i <- getJust $ remoteActorInstance ra + return (i, ra) + ) + "Ticket doesn't have author" + "Ticket has both local and remote author" massignee <- for (ticketAssignee ticket) $ \ apid -> do person <- get404 apid sharer <- get404 $ personIdent person return (sharer, fromMaybe False $ (== apid) <$> mpid) - closer <- + mcloser <- case ticketStatus ticket of - TSClosed -> do - person <- get404 $ ticketCloser ticket - get404 $ personIdent person - _ -> return author + TSClosed -> + case ticketCloser ticket of + Just pidCloser -> Just <$> do + person <- getJust pidCloser + getJust $ personIdent person + Nothing -> error "Closer not set for closed ticket" + _ -> + case ticketCloser ticket of + Just _ -> error "Closer set for open ticket" + Nothing -> return Nothing tparams <- getTicketTextParams tid wid eparams <- getTicketEnumParams tid wid deps <- E.select $ E.from $ \ (dep `E.InnerJoin` t) -> do @@ -263,7 +282,7 @@ getTicketR shar proj num = do return t return ( wshr, wfl - , author, massignee, closer, ticket, tparams, eparams + , author, massignee, mcloser, ticket, tparams, eparams , deps, rdeps ) encodeHid <- getEncodeKeyHashid @@ -287,6 +306,10 @@ getTicketR shar proj num = do encodeRouteHome <- getEncodeRouteHome let siblingUri = encodeRouteHome . TicketR shar proj . ticketNumber . entityVal + host = + case author of + Left _ -> hLocal + Right (i, _) -> instanceHost i ticketAP = AP.Ticket { AP.ticketLocal = Just ( hLocal @@ -307,7 +330,11 @@ getTicketR shar proj num = do ) , AP.ticketAttributedTo = - encodeRouteLocal $ SharerR $ sharerIdent author + case author of + Left sharer -> + encodeRouteLocal $ SharerR $ sharerIdent sharer + Right (_inztance, actor) -> + remoteActorIdent actor , AP.ticketPublished = Just $ ticketCreated ticket , AP.ticketUpdated = Nothing , AP.ticketName = Just $ "#" <> T.pack (show num) @@ -322,7 +349,7 @@ getTicketR shar proj num = do , AP.ticketDependsOn = map siblingUri deps , AP.ticketDependedBy = map siblingUri rdeps } - provideHtmlAndAP ticketAP $(widgetFile "ticket/one") + provideHtmlAndAP' host ticketAP $(widgetFile "ticket/one") putTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html putTicketR shar proj num = do @@ -438,7 +465,7 @@ postTicketCloseR shr prj num = do [ TicketAssignee =. Nothing , TicketStatus =. TSClosed , TicketClosed =. now - , TicketCloser =. pid + , TicketCloser =. Just pid ] return True setMessage $ @@ -460,7 +487,7 @@ postTicketOpenR shr prj num = do TSClosed -> do update tid [ TicketStatus =. TSTodo - , TicketCloser =. ticketCreator ticket + , TicketCloser =. Nothing ] return True _ -> return False @@ -768,24 +795,42 @@ getTicketDeps forward shr prj num = do Entity sid _ <- getBy404 $ UniqueSharer shr Entity jid _ <- getBy404 $ UniqueProject prj sid Entity tid _ <- getBy404 $ UniqueTicket jid num - E.select $ E.from $ - \ ( td `E.InnerJoin` - ticket `E.InnerJoin` - person `E.InnerJoin` - sharer + fmap (map toRow) $ E.select $ E.from $ + \ ( td + `E.InnerJoin` t + `E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s) + `E.LeftOuterJoin` (tar `E.InnerJoin` ra `E.InnerJoin` i) ) -> do - E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId - E.on $ ticket E.^. TicketCreator E.==. person E.^. PersonId - E.on $ td E.^. to' E.==. ticket E.^. TicketId + E.on $ ra E.?. RemoteActorInstance E.==. i E.?. InstanceId + E.on $ tar E.?. TicketAuthorRemoteAuthor E.==. ra E.?. RemoteActorId + E.on $ E.just (t E.^. TicketId) E.==. tar E.?. TicketAuthorRemoteTicket + E.on $ p E.?. PersonIdent E.==. s E.?. SharerId + E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId + E.on $ E.just (t E.^. TicketId) E.==. tal E.?. TicketAuthorLocalTicket + E.on $ td E.^. to' E.==. t E.^. TicketId E.where_ $ td E.^. from' E.==. E.val tid - E.orderBy [E.asc $ ticket E.^. TicketNumber] + E.orderBy [E.asc $ t E.^. TicketNumber] return - ( ticket E.^. TicketNumber - , sharer - , ticket E.^. TicketTitle - , ticket E.^. TicketStatus + ( t E.^. TicketNumber + , s + , i + , ra + , t E.^. TicketTitle + , t E.^. TicketStatus ) defaultLayout $(widgetFile "ticket/dep/list") + where + toRow (E.Value number, ms, mi, mra, E.Value title, E.Value status) = + ( number + , case (ms, mi, mra) of + (Just s, Nothing, Nothing) -> + Left $ entityVal s + (Nothing, Just i, Just ra) -> + Right (entityVal i, entityVal ra) + _ -> error "Ticket author DB invalid state" + , title + , status + ) getTicketDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html getTicketDepsR = getTicketDeps True @@ -934,16 +979,6 @@ getTicketTeamR shr prj num = do [whamlet| 
#{encodePrettyToLazyText doc}
             |]
-    where
-    requireEitherAlt
-        :: Applicative f
-        => f (Maybe a) -> f (Maybe b) -> String -> String -> f (Either a b)
-    requireEitherAlt get1 get2 errNone errBoth = liftA2 mk get1 get2
-        where
-        mk Nothing  Nothing  = error errNone
-        mk (Just _) (Just _) = error errBoth
-        mk (Just x) Nothing  = Left x
-        mk Nothing  (Just y) = Right y
 
 getTicketEventsR :: ShrIdent -> PrjIdent -> Int -> Handler TypedContent
 getTicketEventsR shr prj num = error "TODO not implemented"
diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs
index 74e8785..955b86a 100644
--- a/src/Vervis/Migration.hs
+++ b/src/Vervis/Migration.hs
@@ -527,6 +527,18 @@ changes hLocal ctx =
                             [ Ticket201906Source      =. source
                             , Ticket201906Description =. content
                             ]
+      -- 91
+    , addEntities model_2019_06_06
+      -- 92
+    , unchecked $ lift $ do
+        tickets <- selectList ([] :: [Filter Ticket20190606]) []
+        let mklocal (Entity tid t) =
+                TicketAuthorLocal20190606 tid $ ticket20190606Creator t
+        insertMany_ $ map mklocal tickets
+      -- 93
+    , setFieldMaybe "Ticket" "closer"
+      -- 94
+    , removeField "Ticket" "creator"
     ]
 
 migrateDB :: MonadIO m => Text -> HashidsContext -> ReaderT SqlBackend m (Either Text (Int, Int))
diff --git a/src/Vervis/Migration/Model.hs b/src/Vervis/Migration/Model.hs
index 7b8cf23..6dc10a5 100644
--- a/src/Vervis/Migration/Model.hs
+++ b/src/Vervis/Migration/Model.hs
@@ -57,6 +57,10 @@ module Vervis.Migration.Model
     , Message201906
     , Ticket201906Generic (..)
     , Ticket201906
+    , model_2019_06_06
+    , Ticket20190606Generic (..)
+    , Ticket20190606
+    , TicketAuthorLocal20190606Generic (..)
     )
 where
 
@@ -146,3 +150,9 @@ makeEntitiesMigration "201906"
 
 makeEntitiesMigration "201906"
     $(modelFile "migrations/2019_06_03.model")
+
+model_2019_06_06 :: [Entity SqlBackend]
+model_2019_06_06 = $(schema "2019_06_06")
+
+makeEntitiesMigration "20190606"
+    $(modelFile "migrations/2019_06_06_mig.model")
diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs
index c9daaf5..f53712d 100644
--- a/src/Vervis/Ticket.hs
+++ b/src/Vervis/Ticket.hs
@@ -47,34 +47,51 @@ getTicketSummaries
     -> Maybe (SqlExpr (Entity Ticket) -> [SqlExpr OrderBy])
     -> ProjectId
     -> AppDB [TicketSummary]
-getTicketSummaries mfilt morder jid = do
-    let toSummary (Value n, Entity _ s, Value c, Value t, Value d, Value r) =
-            TicketSummary
-                { tsNumber    = n
-                , tsCreatedBy = s
-                , tsCreatedAt = c
-                , tsTitle     = t
-                , tsStatus    = d
-                , tsComments  = r
-                }
-    fmap (map toSummary) $ select $ from $
-        \ (t `InnerJoin` p `InnerJoin` s `InnerJoin` d `LeftOuterJoin` m) -> do
-            on $ just (d ^. DiscussionId) ==. m ?. MessageRoot
-            on $ t ^. TicketDiscuss ==. d ^. DiscussionId
-            on $ p ^. PersonIdent ==. s ^. SharerId
-            on $ t ^. TicketCreator ==. p ^. PersonId
-            where_ $ t  ^. TicketProject ==. val jid
-            groupBy (t ^. TicketId, s ^. SharerId)
-            for_ mfilt $ \ filt -> where_ $ filt t
-            for_ morder $ \ order -> orderBy $ order t
-            return
-                ( t ^. TicketNumber
-                , s
-                , t ^. TicketCreated
-                , t ^. TicketTitle
-                , t ^. TicketStatus
-                , count $ m ?. MessageId
-                )
+getTicketSummaries mfilt morder jid = fmap (map toSummary) $ select $ from $
+    \ ( t
+        `LeftOuterJoin` (tal `InnerJoin` p `InnerJoin` s)
+        `LeftOuterJoin` (tar `InnerJoin` ra `InnerJoin` i)
+        `InnerJoin` d
+        `LeftOuterJoin` m
+      ) -> do
+        on $ just (d ^. DiscussionId) ==. m ?. MessageRoot
+        on $ t ^. TicketDiscuss ==. d ^. DiscussionId
+        on $ ra ?. RemoteActorInstance ==. i ?. InstanceId
+        on $ tar ?. TicketAuthorRemoteAuthor ==. ra ?. RemoteActorId
+        on $ just (t ^. TicketId) ==. tar ?. TicketAuthorRemoteTicket
+        on $ p ?. PersonIdent ==. s ?. SharerId
+        on $ tal ?. TicketAuthorLocalAuthor ==. p ?. PersonId
+        on $ just (t ^. TicketId) ==. tal ?. TicketAuthorLocalTicket
+        where_ $ t  ^. TicketProject ==. val jid
+        groupBy $ t ^. TicketId
+        for_ mfilt $ \ filt -> where_ $ filt t
+        for_ morder $ \ order -> orderBy $ order t
+        return
+            ( t ^. TicketNumber
+            , s
+            , i
+            , ra
+            , t ^. TicketCreated
+            , t ^. TicketTitle
+            , t ^. TicketStatus
+            , count $ m ?. MessageId
+            )
+    where
+    toSummary (Value n, ms, mi, mra, Value c, Value t, Value d, Value r) =
+        TicketSummary
+            { tsNumber    = n
+            , tsCreatedBy =
+                case (ms, mi, mra) of
+                    (Just s, Nothing, Nothing) ->
+                        Left $ entityVal s
+                    (Nothing, Just i, Just ra) ->
+                        Right (entityVal i, entityVal ra)
+                    _ -> error "Ticket author DB invalid state"
+            , tsCreatedAt = c
+            , tsTitle     = t
+            , tsStatus    = d
+            , tsComments  = r
+            }
 
 -- | Get the child-parent ticket number pairs of all the ticket dependencies
 -- in the given project, in ascending order by child, and then ascending order
diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs
index f051b9c..637b229 100644
--- a/src/Vervis/Widget/Discussion.hs
+++ b/src/Vervis/Widget/Discussion.hs
@@ -45,7 +45,7 @@ import Vervis.Model
 import Vervis.Model.Ident
 import Vervis.Render (renderSourceT)
 import Vervis.Settings (widgetFile)
-import Vervis.Widget.Sharer (personLinkW)
+import Vervis.Widget.Sharer
 
 actorLinkW :: MessageTreeNodeAuthor -> Widget
 actorLinkW actor = $(widgetFile "widget/actor-link")
diff --git a/src/Vervis/Widget/Sharer.hs b/src/Vervis/Widget/Sharer.hs
index 2f584f6..865e658 100644
--- a/src/Vervis/Widget/Sharer.hs
+++ b/src/Vervis/Widget/Sharer.hs
@@ -15,28 +15,40 @@
 
 module Vervis.Widget.Sharer
     ( sharerLinkW
-    , personLinkW
-    , groupLinkW
+    , sharerLinkFedW
     )
 where
 
 import Prelude
 
-import Yesod.Core (Route)
+import Yesod.Core
+
+import Network.FedURI
 
 import Vervis.Foundation
 import Vervis.Model
 import Vervis.Model.Ident (ShrIdent, shr2text)
 import Vervis.Settings (widgetFile)
 
-link :: (ShrIdent -> Route App) -> Sharer -> Widget
-link route sharer = $(widgetFile "sharer-link")
-
 sharerLinkW :: Sharer -> Widget
-sharerLinkW = link SharerR
+sharerLinkW sharer =
+    [whamlet|
+        
+          $maybe name <- sharerName sharer
+            #{name}
+          $nothing
+            #{shr2text $ sharerIdent sharer}
+    |]
 
-personLinkW :: Sharer -> Widget
-personLinkW = link SharerR
-
-groupLinkW :: Sharer -> Widget
-groupLinkW = link SharerR
+sharerLinkFedW :: Either Sharer (Instance, RemoteActor) -> Widget
+sharerLinkFedW (Left sharer)             = sharerLinkW sharer
+sharerLinkFedW (Right (inztance, actor)) =
+    [whamlet|
+        
+          $maybe name <- remoteActorName actor
+            #{name}
+          $nothing
+            (?)
+    |]
+    where
+    uActor = l2f (instanceHost inztance) (remoteActorIdent actor)
diff --git a/src/Vervis/Widget/Ticket.hs b/src/Vervis/Widget/Ticket.hs
index 929764d..d359b0a 100644
--- a/src/Vervis/Widget/Ticket.hs
+++ b/src/Vervis/Widget/Ticket.hs
@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016 by fr33domlover .
+ - Written in 2016, 2019 by fr33domlover .
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -45,11 +45,11 @@ import Vervis.Model.Ticket
 import Vervis.Settings (widgetFile)
 import Vervis.Style
 import Vervis.Time (showDate)
-import Vervis.Widget.Sharer (personLinkW)
+import Vervis.Widget.Sharer
 
 data TicketSummary = TicketSummary
     { tsNumber    :: Int
-    , tsCreatedBy :: Sharer
+    , tsCreatedBy :: Either Sharer (Instance, RemoteActor)
     , tsCreatedAt :: UTCTime
     , tsTitle     :: Text
     , tsStatus    :: TicketStatus
diff --git a/src/Yesod/ActivityPub.hs b/src/Yesod/ActivityPub.hs
index 4e6023d..d689418 100644
--- a/src/Yesod/ActivityPub.hs
+++ b/src/Yesod/ActivityPub.hs
@@ -18,6 +18,7 @@ module Yesod.ActivityPub
     , deliverActivity
     , forwardActivity
     , provideHtmlAndAP
+    , provideHtmlAndAP'
     )
 where
 
@@ -121,25 +122,30 @@ provideHtmlAndAP
     => a -> WidgetFor site () -> HandlerFor site TypedContent
 provideHtmlAndAP object widget = do
     host <- getsYesod siteInstanceHost
+    provideHtmlAndAP' host object widget
+
+provideHtmlAndAP'
+    :: (YesodActivityPub site, ActivityPub a)
+    => Text -> a -> WidgetFor site () -> HandlerFor site TypedContent
+provideHtmlAndAP' host object widget = selectRep $ do
     let doc = Doc host object
-    selectRep $ do
-        provideAP $ pure doc
-        provideRep $ do
-            mval <- lookupGetParam "prettyjson"
-            defaultLayout $
-                case mval of
-                    Just "true" ->
+    provideAP $ pure doc
+    provideRep $ do
+        mval <- lookupGetParam "prettyjson"
+        defaultLayout $
+            case mval of
+                Just "true" ->
+                    [whamlet|
+                        
#{encodePrettyToLazyText doc}
+                    |]
+                _ -> do
+                    widget
+                    mroute <- getCurrentRoute
+                    for_ mroute $ \ route -> do
+                        params <- reqGetParams <$> getRequest
+                        let pj = ("prettyjson", "true")
                         [whamlet|
-                            
#{encodePrettyToLazyText doc}
+                            

+                              
+                                [See JSON]
                         |]
-                    _ -> do
-                        widget
-                        mroute <- getCurrentRoute
-                        for_ mroute $ \ route -> do
-                            params <- reqGetParams <$> getRequest
-                            let pj = ("prettyjson", "true")
-                            [whamlet|
-                                

-                                  
-                                    [See JSON]
-                            |]
diff --git a/templates/group/list.hamlet b/templates/group/list.hamlet
index fc77322..95505ba 100644
--- a/templates/group/list.hamlet
+++ b/templates/group/list.hamlet
@@ -1,6 +1,6 @@
 $# This file is part of Vervis.
 $#
-$# Written in 2016 by fr33domlover .
+$# Written in 2016, 2019 by fr33domlover .
 $#
 $# ♡ Copying is an act of love. Please copy, reuse and share.
 $#
@@ -18,4 +18,4 @@ $# .