Fix outbox item pretty display, it was highlighted but not pretty-encoded

src/Vervis/Handler/Inbox.hs

@@ -496,7 +496,7 @@ getOutboxItem here getObid obikhid = do
         obid <- getObid
         obi <- get404 obiid
         unless (outboxItemOutbox obi == obid) notFound
-        return $ BL.fromStrict $ persistJSONBytes $ outboxItemActivity obi
+        return $ outboxItemActivity obi
     provideHtmlAndAP'' body $ redirect (here, [("prettyjson", "true")])
 
 getSharerOutboxR :: ShrIdent -> Handler TypedContent

src/Web/ActivityPub.hs

@@ -830,7 +830,7 @@ provideAP mk =
     -- provideRepType typeActivityStreams2   $ return enc
     provideRepType typeActivityStreams2LD $ toEncoding <$> mk
 
-provideAP' :: Monad m => m BL.ByteString -> Writer (Endo [ProvidedRep m]) ()
+provideAP' :: Monad m => m ByteString -> Writer (Endo [ProvidedRep m]) ()
 provideAP' = provideRepType typeActivityStreams2LD
 
 data APGetError

src/Yesod/ActivityPub.hs

@@ -28,6 +28,7 @@ where
 import Control.Exception
 import Control.Monad.Logger.CallStack
 import Data.Aeson
+import Data.Aeson.Encode.Pretty
 import Data.ByteString (ByteString)
 import Data.Foldable
 import Data.List.NonEmpty (NonEmpty)
@@ -42,6 +43,7 @@ import qualified Data.Text as T
 
 import Network.HTTP.Signature
 
+import Database.Persist.JSON
 import Network.FedURI
 import Web.ActivityPub
 import Yesod.MonadSite
@@ -212,10 +214,10 @@ provideHtmlAndAP' host object widget = selectRep $ do
                         |]
 
 provideHtmlAndAP''
-    :: YesodActivityPub site
-    => BL.ByteString -> WidgetFor site () -> HandlerFor site TypedContent
+    :: Yesod site
+    => PersistJSON a -> WidgetFor site () -> HandlerFor site TypedContent
 provideHtmlAndAP'' body widget = selectRep $ do
-    provideAP' $ pure body
+    provideAP' $ pure $ persistJSONBytes body
     provideRep $ do
         mval <- lookupGetParam "prettyjson"
         defaultLayout $
@@ -227,9 +229,10 @@ provideHtmlAndAP'' body widget = selectRep $ do
                                 Just "hl2" -> False
                                 Just "sky" -> True
                                 Just _ -> error "Invalid highlight style"
+                        pretty = encodePretty $ persistJSONObject body
                     if sky
-                        then renderPrettyJSONSkylighting' body
-                        else renderPrettyJSON' body
+                        then renderPrettyJSONSkylighting' pretty
+                        else renderPrettyJSON' pretty
                 _ -> do
                     widget
                     mroute <- getCurrentRoute