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