Display pretty JSON on user page

This commit is contained in:
fr33domlover 2019-06-30 01:17:47 +00:00
parent 89f2f91199
commit add8a3a23b

View file

@ -35,6 +35,7 @@ import Text.Email.Local
import Network.FedURI import Network.FedURI
import Web.ActivityPub import Web.ActivityPub
import Yesod.ActivityPub
import Yesod.FedURI import Yesod.FedURI
import Vervis.ActorKey import Vervis.ActorKey
@ -127,24 +128,20 @@ getPersonNewR = redirect $ AuthR newAccountR
getPerson :: ShrIdent -> Sharer -> Person -> Handler TypedContent getPerson :: ShrIdent -> Sharer -> Person -> Handler TypedContent
getPerson shr sharer person = do getPerson shr sharer person = do
route2fed <- getEncodeRouteHome encodeRouteLocal <- getEncodeRouteLocal
route2local <- getEncodeRouteLocal let personAP = Actor
let (host, me) = f2l $ route2fed $ SharerR shr { actorId = encodeRouteLocal $ SharerR shr
selectRep $ do
provideRep $ do
secure <- getSecure
defaultLayout $(widgetFile "person")
provideAP $ pure $ Doc host Actor
{ actorId = me
, actorType = ActorTypePerson , actorType = ActorTypePerson
, actorUsername = Just $ shr2text shr , actorUsername = Just $ shr2text shr
, actorName = sharerName sharer , actorName = sharerName sharer
, actorSummary = Nothing , actorSummary = Nothing
, actorInbox = route2local $ SharerInboxR shr , actorInbox = encodeRouteLocal $ SharerInboxR shr
, actorOutbox = Just $ route2local $ SharerOutboxR shr , actorOutbox = Just $ encodeRouteLocal $ SharerOutboxR shr
, actorFollowers = Nothing , actorFollowers = Nothing
, actorPublicKeys = , actorPublicKeys =
[ Left $ route2local ActorKey1R [ Left $ encodeRouteLocal ActorKey1R
, Left $ route2local ActorKey2R , Left $ encodeRouteLocal ActorKey2R
] ]
} }
secure <- getSecure
provideHtmlAndAP personAP $(widgetFile "person")