From d2e64d2920bc287f025428a2b70b31ba09668f74 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Sun, 30 Jun 2019 16:53:53 +0000
Subject: [PATCH] Fix outbox item pretty display, it was highlighted but not
 pretty-encoded

---
 src/Vervis/Handler/Inbox.hs |  2 +-
 src/Web/ActivityPub.hs      |  2 +-
 src/Yesod/ActivityPub.hs    | 13 ++++++++-----
 3 files changed, 10 insertions(+), 7 deletions(-)

diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs
index 4e51fb1..f7b7465 100644
--- a/src/Vervis/Handler/Inbox.hs
+++ b/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
diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs
index 3aac68f..c8d5910 100644
--- a/src/Web/ActivityPub.hs
+++ b/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
diff --git a/src/Yesod/ActivityPub.hs b/src/Yesod/ActivityPub.hs
index da2658d..224b6eb 100644
--- a/src/Yesod/ActivityPub.hs
+++ b/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