Pretty JSON display for getActorKey1/2 and getOutboxItemR

This commit is contained in:
fr33domlover 2019-06-15 19:03:39 +00:00
parent 499479b662
commit ade24bb534

View file

@ -92,6 +92,7 @@ import qualified Network.HTTP.Signature as S (Algorithm (..))
import Database.Persist.JSON import Database.Persist.JSON
import Network.FedURI import Network.FedURI
import Web.ActivityPub import Web.ActivityPub
import Yesod.ActivityPub
import Yesod.Auth.Unverified import Yesod.Auth.Unverified
import Yesod.FedURI import Yesod.FedURI
import Yesod.Hashids import Yesod.Hashids
@ -426,18 +427,14 @@ getOutboxR shr = do
getOutboxItemR :: ShrIdent -> KeyHashid OutboxItem -> Handler TypedContent getOutboxItemR :: ShrIdent -> KeyHashid OutboxItem -> Handler TypedContent
getOutboxItemR shr obikhid = do getOutboxItemR shr obikhid = do
obiid <- decodeKeyHashid404 obikhid obiid <- decodeKeyHashid404 obikhid
doc <- runDB $ do Doc h act <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr sid <- getKeyBy404 $ UniqueSharer shr
p <- getValBy404 $ UniquePersonIdent sid p <- getValBy404 $ UniquePersonIdent sid
obi <- get404 obiid obi <- get404 obiid
unless (outboxItemOutbox obi == personOutbox p) notFound unless (outboxItemOutbox obi == personOutbox p) notFound
return $ persistJSONValue $ outboxItemActivity obi return $ persistJSONValue $ outboxItemActivity obi
selectRep $ do let here = OutboxItemR shr obikhid
provideAP $ pure doc provideHtmlAndAP' h act $ redirect (here, [("prettyjson", "true")])
provideRep $ defaultLayout $
[whamlet|
<div><pre>#{AEP.encodePrettyToLazyText doc}
|]
postOutboxR :: ShrIdent -> Handler Html postOutboxR :: ShrIdent -> Handler Html
postOutboxR shrAuthor = do postOutboxR shrAuthor = do
@ -491,19 +488,18 @@ postOutboxR shrAuthor = do
defaultLayout $ activityWidget shrAuthor widget enctype defaultLayout $ activityWidget shrAuthor widget enctype
getActorKey :: ((ActorKey, ActorKey, Bool) -> ActorKey) -> Route App -> Handler TypedContent getActorKey :: ((ActorKey, ActorKey, Bool) -> ActorKey) -> Route App -> Handler TypedContent
getActorKey choose route = selectRep $ provideAP $ do getActorKey choose route = do
actorKey <- actorKey <-
liftIO . fmap (actorKeyPublicBin . choose) . readTVarIO =<< liftIO . fmap (actorKeyPublicBin . choose) . readTVarIO =<<
getsYesod appActorKeys getsYesod appActorKeys
route2uri <- getEncodeRouteHome encodeRouteLocal <- getEncodeRouteLocal
let (host, id_) = f2l $ route2uri route let key = PublicKey
return $ Doc host PublicKey { publicKeyId = encodeRouteLocal route
{ publicKeyId = id_
, publicKeyExpires = Nothing , publicKeyExpires = Nothing
, publicKeyOwner = OwnerInstance , publicKeyOwner = OwnerInstance
, publicKeyMaterial = actorKey , publicKeyMaterial = actorKey
--, publicKeyAlgo = Just AlgorithmEd25519
} }
provideHtmlAndAP key $ redirect (route, [("prettyjson", "true")])
getActorKey1R :: Handler TypedContent getActorKey1R :: Handler TypedContent
getActorKey1R = getActorKey (\ (k1, _, _) -> k1) ActorKey1R getActorKey1R = getActorKey (\ (k1, _, _) -> k1) ActorKey1R