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