diff --git a/src/Vervis/Handler/Cloth.hs b/src/Vervis/Handler/Cloth.hs
index 649e094..125995f 100644
--- a/src/Vervis/Handler/Cloth.hs
+++ b/src/Vervis/Handler/Cloth.hs
@@ -83,7 +83,7 @@ import qualified Database.Esqueleto as E
import Development.PatchMediaType
import Network.FedURI
-import Web.ActivityPub hiding (Ticket (..), Patch (..), Bundle (..), Repo (..))
+import Web.ActivityPub hiding (Ticket (..), Patch (..), Bundle (..), Repo (..), ActorDetail (..))
import Yesod.ActivityPub
import Yesod.FedURI
import Yesod.Hashids
@@ -263,11 +263,12 @@ getClothR loomHash clothHash = do
where
getClothHtml = do
mpid <- maybeAuthId
- (ticket, author, tparams, eparams, cparams) <- handlerToWidget $ runDB $ do
- (_loom, _ticketloom, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr, _bundles) <-
+ (ticket, targetRepo, author, tparams, eparams, cparams, moriginRepo) <- handlerToWidget $ runDB $ do
+ (Entity _ loom, Entity _ cloth, Entity ticketID ticket, author, _maybe_ResolveAndEitherTrlOrTrr, proposal) <-
getCloth404 loomHash clothHash
- (ticket,,,,)
- <$> bitraverse
+ (ticket,,,,,,)
+ <$> getLocalRepo (loomRepo loom) (ticketLoomBranch cloth)
+ <*> bitraverse
(\ (Entity _ (TicketAuthorLocal _ personID _)) -> do
p <- getJust personID
(Entity personID p,) <$> getJust (personActor p)
@@ -282,6 +283,16 @@ getClothR loomHash clothHash = do
<*> getTicketTextParams ticketID --wid
<*> getTicketEnumParams ticketID --wid
<*> getTicketClasses ticketID --wid
+ <*> traverse
+ (bitraverse
+ (\ (Entity _(MergeOriginLocal _ originRepoID maybeBranch)) ->
+ getLocalRepo originRepoID maybeBranch
+ )
+ (\ (Entity _ (MergeOriginRemote _ r), mbranch) ->
+ getRemoteRepo r mbranch
+ )
+ )
+ (justThere proposal)
hashMessageKey <- handlerToWidget getEncodeKeyHashid
let desc :: Widget
desc = toWidget $ preEscapedToMarkup $ ticketDescription ticket
@@ -304,6 +315,25 @@ getClothR loomHash clothHash = do
(ClothUnfollowR loomHash clothHash)
(ticketFollowers ticket)
$(widgetFile "cloth/one")
+ where
+ getLocalRepo repoID mbranch = do
+ repo <- getJust repoID
+ actor <- getJust $ repoActor repo
+ repoHash <- encodeKeyHashid repoID
+ return (repoHash, actorName actor, mbranch)
+ getRemoteRepo remoteActorID mbranch = do
+ ra <- getJust remoteActorID
+ ro <- getJust $ remoteActorIdent ra
+ i <- getJust $ remoteObjectInstance ro
+ let h = instanceHost i
+ uRepo = ObjURI h (remoteObjectIdent ro)
+ return
+ ( uRepo
+ , remoteActorName ra
+ , mbranch <&>
+ \ (Entity _ (MergeOriginRemoteBranch _ mlu b)) ->
+ (ObjURI h <$> mlu, b)
+ )
getClothDiscussionR
:: KeyHashid Loom -> KeyHashid TicketLoom -> Handler TypedContent
diff --git a/templates/cloth/one.hamlet b/templates/cloth/one.hamlet
index 19258ad..5cc654c 100644
--- a/templates/cloth/one.hamlet
+++ b/templates/cloth/one.hamlet
@@ -19,6 +19,41 @@ $#