sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 01:04:52 +09:00
Code Issues Activity

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

Browse source
This commit is contained in:
fr33domlover 2019-06-30 16:53:53 +00:00
parent 84d5375319
commit d2e64d2920
3 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/Vervis/Handler/Inbox.hs
View file

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

2
src/Web/ActivityPub.hs
View file

@ -830,7 +830,7 @@ provideAP mk =
-- provideRepType typeActivityStreams2 $ return enc -- provideRepType typeActivityStreams2 $ return enc
provideRepType typeActivityStreams2LD $ toEncoding <$> mk 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 provideAP' = provideRepType typeActivityStreams2LD
data APGetError data APGetError

13
src/Yesod/ActivityPub.hs
View file

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