diff --git a/src/Vervis/Discussion.hs b/src/Vervis/Discussion.hs
index f3761e5..2e0cb35 100644
--- a/src/Vervis/Discussion.hs
+++ b/src/Vervis/Discussion.hs
@@ -27,6 +27,7 @@ import Data.Graph.Inductive.Graph (mkGraph, lab')
import Data.Graph.Inductive.PatriciaTree (Gr)
import Data.Graph.Inductive.Query.DFS (dffWith)
import Data.Maybe (isNothing, mapMaybe)
+import Data.Text (Text)
import Data.Tree (Forest)
import Database.Esqueleto hiding (isNothing)
import Yesod.Persist.Core (runDB)
@@ -41,7 +42,7 @@ import Vervis.Model
data MessageTreeNodeAuthor
= MessageTreeNodeLocal LocalMessageId Sharer
- | MessageTreeNodeRemote FedURI
+ | MessageTreeNodeRemote Text LocalURI LocalURI
data MessageTreeNode = MessageTreeNode
{ mtnMessageId :: MessageId
@@ -63,13 +64,18 @@ getMessages getdid = runDB $ do
on $ rm ^. RemoteMessageAuthor ==. rs ^. RemoteActorId
on $ rm ^. RemoteMessageRest ==. m ^. MessageId
where_ $ m ^. MessageRoot ==. val did
- return (m, i ^. InstanceHost, rs ^. RemoteActorIdent)
+ return
+ ( m
+ , i ^. InstanceHost
+ , rm ^. RemoteMessageIdent
+ , rs ^. RemoteActorIdent
+ )
return $ map mklocal l ++ map mkremote r
where
mklocal (Entity mid m, Value lmid, Entity _ s) =
MessageTreeNode mid m $ MessageTreeNodeLocal lmid s
- mkremote (Entity mid m, Value h, Value lu) =
- MessageTreeNode mid m $ MessageTreeNodeRemote $ l2f h lu
+ mkremote (Entity mid m, Value h, Value luMsg, Value luAuthor) =
+ MessageTreeNode mid m $ MessageTreeNodeRemote h luMsg luAuthor
discussionTree :: [MessageTreeNode] -> Forest MessageTreeNode
discussionTree mss =
diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs
index d570fbb..895f6d3 100644
--- a/src/Vervis/Handler/Discussion.hs
+++ b/src/Vervis/Handler/Discussion.hs
@@ -85,8 +85,11 @@ getNode getdid mid = do
(Nothing, Just (Entity _rmid rm)) -> do
rs <- getJust $ remoteMessageAuthor rm
i <- getJust $ remoteActorInstance rs
- return $ MessageTreeNodeRemote $
- l2f (instanceHost i) (remoteActorIdent rs)
+ return $
+ MessageTreeNodeRemote
+ (instanceHost i)
+ (remoteMessageIdent rm)
+ (remoteActorIdent rs)
return $ MessageTreeNode mid m author
{-
diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs
index de40473..14dfdb7 100644
--- a/src/Vervis/Widget/Discussion.hs
+++ b/src/Vervis/Widget/Discussion.hs
@@ -33,9 +33,11 @@ import Yesod.Core.Widget
import qualified Data.Text as T (filter)
import Network.FedURI
+import Yesod.Hashids
import Data.EventTime.Local
import Data.Time.Clock.Local ()
+
import Vervis.Discussion
import Vervis.Foundation
import Vervis.MediaType (MediaType (Markdown))
@@ -48,18 +50,19 @@ import Vervis.Widget.Sharer (personLinkW)
actorLinkW :: MessageTreeNodeAuthor -> Widget
actorLinkW actor = $(widgetFile "widget/actor-link")
where
- shortURI (FedURI h p f) = h <> p <> f
+ shortURI h (LocalURI p f) = h <> p <> f
messageW
:: UTCTime -> MessageTreeNode -> (MessageId -> Route App) -> Widget
-messageW now (MessageTreeNode msgid msg author) reply =
+messageW now (MessageTreeNode msgid msg author) reply = do
+ encodeHid <- getEncodeKeyHashid
let showTime =
showEventTime .
intervalToEventTime .
FriendlyConvert .
diffUTCTime now
showContent = renderSourceT Markdown . T.filter (/= '\r')
- in $(widgetFile "discussion/widget/message")
+ $(widgetFile "discussion/widget/message")
messageTreeW
:: (MessageId -> Route App)
diff --git a/templates/discussion/widget/message.hamlet b/templates/discussion/widget/message.hamlet
index 5a802b2..4493557 100644
--- a/templates/discussion/widget/message.hamlet
+++ b/templates/discussion/widget/message.hamlet
@@ -14,7 +14,13 @@ $#