Implement getTicketDepR, not used anywhere else yet

This patch also disables the ability to specify deps when creating a ticket,
because those deps won't be in the ticket object anymore. Instead of coding a
workaround and getting complications later, I just disabled that thing. It
wasn't really being used by anyone anyway.

config/models

@@ -328,8 +328,11 @@ TicketAuthorRemote
     UniqueTicketAuthorRemoteOffer offer
 
 TicketDependency
-    parent TicketId
+    parent  TicketId
-    child  TicketId
+    child   TicketId
+    author  PersonId
+    summary Text -- HTML
+    created UTCTime
 
     UniqueTicketDependency parent child
 

config/routes

@@ -147,6 +147,7 @@
 /s/#ShrIdent/p/#PrjIdent/t/#Int/deps/!new    TicketDepNewR         GET
 /s/#ShrIdent/p/#PrjIdent/t/#Int/deps/#Int    TicketDepOldR            POST DELETE
 /s/#ShrIdent/p/#PrjIdent/t/#Int/rdeps        TicketReverseDepsR    GET
+/tdeps/#TicketDepKeyHashid                   TicketDepR            GET
 /s/#ShrIdent/p/#PrjIdent/t/#Int/participants TicketParticipantsR   GET
 /s/#ShrIdent/p/#PrjIdent/t/#Int/team         TicketTeamR           GET
 /s/#ShrIdent/p/#PrjIdent/t/#Int/events       TicketEventsR         GET

migrations/2019_07_11.model

@@ -0,0 +1,71 @@
+Sharer
+    ident   ShrIdent
+    name    Text     Maybe
+    created UTCTime
+
+    UniqueSharer ident
+
+Person
+    ident               SharerId
+    login               Text
+    passphraseHash      ByteString
+    email               Text
+    verified            Bool
+    verifiedKey         Text
+    verifiedKeyCreated  UTCTime
+    resetPassKey        Text
+    resetPassKeyCreated UTCTime
+    about               Text
+    inbox               InboxId
+    outbox              OutboxId
+
+    UniquePersonIdent ident
+    UniquePersonLogin login
+    UniquePersonEmail email
+    UniquePersonInbox inbox
+    UniquePersonOutbox outbox
+
+Outbox
+
+Inbox
+
+Project
+    ident      PrjIdent
+    sharer     SharerId
+    name       Text          Maybe
+    desc       Text          Maybe
+    workflow   Int64
+    nextTicket Int
+    wiki       Int64         Maybe
+    collabUser Int64         Maybe
+    collabAnon Int64         Maybe
+    inbox      InboxId
+    outbox     OutboxId
+    followers  Int64
+
+Ticket
+    project     ProjectId
+    number      Int
+    created     UTCTime
+    title       Text                -- HTML
+    source      Text                -- Pandoc Markdown
+    description Text                -- HTML
+    assignee    PersonId      Maybe
+    status      Text
+    closed      UTCTime
+    closer      PersonId      Maybe
+    discuss     Int64
+    followers   Int64
+    accept      Int64
+
+    UniqueTicket project number
+    UniqueTicketDiscussion discuss
+    UniqueTicketFollowers followers
+    UniqueTicketAccept accept
+
+TicketDependency
+    parent  TicketId
+    child   TicketId
+    author  PersonId
+
+    UniqueTicketDependency parent child

src/Data/Aeson/Local.hs

@@ -19,8 +19,10 @@ module Data.Aeson.Local
     , fromEither
     , (.:|)
     , (.:|?)
+    , (.:+)
     , (.=?)
     , (.=%)
+    , (.=+)
     , WithValue (..)
     )
 where
@@ -59,6 +61,9 @@ o .:| t = o .: t <|> o .: (frg <> t)
 (.:|?) :: FromJSON a => Object -> Text -> Parser (Maybe a)
 o .:|? t = optional $ o .:| t
 
+(.:+) :: (FromJSON a, FromJSON b) => Object -> Text -> Parser (Either a b)
+o .:+ t = Left <$> o .: t <|> Right <$> o .: t
+
 infixr 8 .=?
 (.=?) :: ToJSON v => Text -> Maybe v -> Series
 _ .=? Nothing  = mempty
@@ -71,6 +76,11 @@ k .=% v =
         then mempty
         else k .= v
 
+infixr 8 .=+
+(.=+) :: (ToJSON a, ToJSON b) => Text -> Either a b -> Series
+k .=+ Left x  = k .= x
+k .=+ Right y = k .= y
+
 data WithValue a = WithValue
     { wvRaw    :: Object
     , wvParsed :: a

src/Vervis/API.hs

@@ -451,7 +451,8 @@ offerTicketC
     -> Handler (Either Text OutboxItemId)
 offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT $ do
     (hProject, shrProject, prjProject) <- parseTarget uTarget
-    deps <- checkOffer hProject shrProject prjProject
+    {-deps <- -}
+    checkOffer hProject shrProject prjProject
     (localRecips, remoteRecips) <- do
         mrecips <- parseAudience audience
         fromMaybeE mrecips "Offer with no recipients"
@@ -469,7 +470,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
         mprojAndDeps <- do
             targetIsLocal <- hostIsLocal hProject
             if targetIsLocal
-                then Just <$> getProjectAndDeps shrProject prjProject deps
+                then Just <$> getProjectAndDeps shrProject prjProject {-deps-}
                 else return Nothing
         (obiid, doc, luOffer) <- lift $ insertToOutbox now obidAuthor
         moreRemotes <-
@@ -488,10 +489,11 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
         verifyNothingE (AP.ticketName ticket) "Ticket with 'name'"
         verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'"
         when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved"
+        unless (null $ AP.ticketDependsOn ticket) $ throwE "Ticket has deps"
         unless (null $ AP.ticketDependedBy ticket) $ throwE "Ticket has rdeps"
-        traverse checkDep' $ AP.ticketDependsOn ticket
+        --traverse checkDep' $ AP.ticketDependsOn ticket
-        where
+        --where
-        checkDep' = checkDep hProject shrProject prjProject
+        --checkDep' = checkDep hProject shrProject prjProject
     checkRecips hProject shrProject prjProject localRecips = do
         local <- hostIsLocal hProject
         if local
@@ -570,7 +572,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
         forCollect = flip traverseCollect
         deliverLocalProject shr prj (LocalProjectRelatedSet project _) =
             case mprojAndDeps of
-                Just (sid, jid, ibid, fsid, tids)
+                Just (sid, jid, ibid, fsid{-, tids-})
                     | shr == shrProject &&
                       prj == prjProject &&
                       localRecipProject project -> do
@@ -579,7 +581,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
                             ((subtract 1) . projectNextTicket) <$>
                                 updateGet jid [ProjectNextTicket +=. 1]
                         (obiidAccept, docAccept) <- insertAccept pidAuthor sid jid fsid luOffer num
-                        insertTicket jid tids num obiidAccept
+                        insertTicket jid {-tids-} num obiidAccept
                         publishAccept pidAuthor sid jid fsid luOffer num obiidAccept docAccept
                         (pidsTeam, remotesTeam) <-
                             if localRecipProjectTeam project
@@ -653,7 +655,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
                         obiid
                         [OutboxItemActivity =. persistJSONObjectFromDoc doc]
                     return (obiid, doc)
-            insertTicket jid tidsDeps next obiidAccept = do
+            insertTicket jid {-tidsDeps-} next obiidAccept = do
                 did <- insert Discussion
                 fsid <- insert FollowerSet
                 tid <- insert Ticket
@@ -677,7 +679,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
                     , ticketAuthorLocalAuthor = pidAuthor
                     , ticketAuthorLocalOffer  = obiid
                     }
-                insertMany_ $ map (TicketDependency tid) tidsDeps
+                --insertMany_ $ map (TicketDependency tid) tidsDeps
                 insert_ $ Follow pidAuthor fsid False
             publishAccept pidAuthor sid jid fsid luOffer num obiid doc = do
                 now <- liftIO getCurrentTime

src/Vervis/ActivityPub.hs

@@ -35,7 +35,7 @@ module Vervis.ActivityPub
     , deliverRemoteHTTP
     , checkForward
     , parseTarget
-    , checkDep
+    --, checkDep
     , getProjectAndDeps
     , deliverRemoteDB'
     , deliverRemoteHttp
@@ -398,6 +398,7 @@ parseTarget u = do
             ProjectR shr prj -> return (shr, prj)
             _ -> throwE "Expected project route, got non-project route"
 
+{-
 checkDep hProject shrProject prjProject u = do
     let (h, lu) = f2l u
     unless (h == hProject) $
@@ -416,16 +417,19 @@ checkDep hProject shrProject prjProject u = do
         case route of
             TicketR shr prj num -> return (shr, prj, num)
             _ -> throwE "Expected ticket route, got non-ticket route"
+-}
 
-getProjectAndDeps shr prj deps = do
+getProjectAndDeps shr prj {-deps-} = do
     msid <- lift $ getKeyBy $ UniqueSharer shr
     sid <- fromMaybeE msid "Offer target: no such local sharer"
     mej <- lift $ getBy $ UniqueProject prj sid
     Entity jid j <- fromMaybeE mej "Offer target: no such local project"
+    {-
     tids <- for deps $ \ dep -> do
         mtid <- lift $ getKeyBy $ UniqueTicket jid dep
         fromMaybeE mtid "Local dep: No such ticket number in DB"
-    return (sid, jid, projectInbox j, projectFollowers j, tids)
+    -}
+    return (sid, jid, projectInbox j, projectFollowers j{-, tids-})
 
 data Recip
     = RecipRA (Entity RemoteActor)

src/Vervis/Federation/Ticket.hs

@@ -72,7 +72,7 @@ import Vervis.Model.Ident
 import Vervis.Model.Ticket
 
 checkOffer
-    :: AP.Ticket -> Text -> ShrIdent -> PrjIdent -> ExceptT Text Handler [Int]
+    :: AP.Ticket -> Text -> ShrIdent -> PrjIdent -> ExceptT Text Handler ()
 checkOffer ticket hProject shrProject prjProject = do
     verifyNothingE (AP.ticketLocal ticket) "Ticket with 'id'"
     verifyNothingE (AP.ticketPublished ticket) "Ticket with 'published'"
@@ -80,10 +80,11 @@ checkOffer ticket hProject shrProject prjProject = do
     verifyNothingE (AP.ticketName ticket) "Ticket with 'name'"
     verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'"
     when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved"
+    unless (null $ AP.ticketDependsOn ticket) $ throwE "Ticket has deps"
     unless (null $ AP.ticketDependedBy ticket) $ throwE "Ticket has rdeps"
-    traverse checkDep' $ AP.ticketDependsOn ticket
+    --traverse checkDep' $ AP.ticketDependsOn ticket
-    where
+    --where
-    checkDep' = checkDep hProject shrProject prjProject
+    --checkDep' = checkDep hProject shrProject prjProject
 
 sharerOfferTicketF
     :: UTCTime
@@ -95,25 +96,29 @@ sharerOfferTicketF
 sharerOfferTicketF now shrRecip author body (Offer ticket uTarget) = do
     (hProject, shrProject, prjProject) <- parseTarget uTarget
     luOffer <- fromMaybeE (activityId $ actbActivity body) "Offer without 'id'"
-    deps <- checkOffer ticket hProject shrProject prjProject
+    {-deps <- -}
+    checkOffer ticket hProject shrProject prjProject
     local <- hostIsLocal hProject
     runDBExcept $ do
         ibidRecip <- lift $ do
             sid <- getKeyBy404 $ UniqueSharer shrRecip
             p <- getValBy404 $ UniquePersonIdent sid
             return $ personInbox p
-        when local $ checkTargetAndDeps shrProject prjProject deps
+        when local $ checkTargetAndDeps shrProject prjProject {-deps-}
         lift $ insertToInbox luOffer ibidRecip
     where
-    checkTargetAndDeps shrProject prjProject deps = do
+    checkTargetAndDeps shrProject prjProject {-deps-} = do
         msid <- lift $ getKeyBy $ UniqueSharer shrProject
         sid <- fromMaybeE msid "Offer target: no such local sharer"
         mjid <- lift $ getKeyBy $ UniqueProject prjProject sid
         jid <- fromMaybeE mjid "Offer target: no such local project"
+        return ()
+        {-
         for_ deps $ \ dep -> do
             mt <- lift $ getBy $ UniqueTicket jid dep
             unless (isJust mt) $
                 throwE "Local dep: No such ticket number in DB"
+        -}
     insertToInbox luOffer ibidRecip = do
         let iidAuthor = remoteAuthorInstance author
             jsonObj = persistJSONFromBL $ actbBL body
@@ -219,16 +224,17 @@ projectOfferTicketF
                         (activityId $ actbActivity body)
                         "Offer without 'id'"
                 hLocal <- getsYesod siteInstanceHost
-                deps <- checkOffer ticket hLocal shrRecip prjRecip
+                {-deps <- -}
+                checkOffer ticket hLocal shrRecip prjRecip
                 msig <- checkForward shrRecip prjRecip
                 let colls =
                         findRelevantCollections hLocal $
                             activityAudience $ actbActivity body
                 mremotesHttp <- runDBExcept $ do
-                    (sid, jid, ibid, fsid, tids) <-
+                    (sid, jid, ibid, fsid{-, tids-}) <-
-                        getProjectAndDeps shrRecip prjRecip deps
+                        getProjectAndDeps shrRecip prjRecip {-deps-}
                     lift $ do
-                        mticket <- insertTicket luOffer jid ibid tids
+                        mticket <- insertTicket luOffer jid ibid {-tids-}
                         for mticket $ \ (ractid, num, obiidAccept, docAccept) -> do
                             msr <- for msig $ \ sig -> do
                                 remoteRecips <- deliverLocal ractid colls sid fsid
@@ -276,7 +282,7 @@ projectOfferTicketF
                     | shr == shrRecip && prj == prjRecip
                         -> Just OfferTicketRecipProjectFollowers
                 _ -> Nothing
-    insertTicket luOffer jid ibid deps = do
+    insertTicket luOffer jid ibid {-deps-} = do
         let iidAuthor = remoteAuthorInstance author
             raidAuthor = remoteAuthorId author
         ractid <- either entityKey id <$> insertBy' RemoteActivity
@@ -319,7 +325,7 @@ projectOfferTicketF
                     , ticketAuthorRemoteAuthor = raidAuthor
                     , ticketAuthorRemoteOffer  = ractid
                     }
-                insertMany_ $ map (TicketDependency tid) deps
+                -- insertMany_ $ map (TicketDependency tid) deps
                 insert_ $ RemoteFollow raidAuthor fsid False
                 return $ Just (ractid, next, obiidAccept, docAccept)
 

src/Vervis/Foundation.hs

@@ -133,6 +133,7 @@ data App = App
 type OutboxItemKeyHashid   = KeyHashid OutboxItem
 type MessageKeyHashid      = KeyHashid Message
 type LocalMessageKeyHashid = KeyHashid LocalMessage
+type TicketDepKeyHashid    = KeyHashid TicketDependency
 
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:

src/Vervis/Handler/Ticket.hs

@@ -48,6 +48,7 @@ module Vervis.Handler.Ticket
     , postTicketDepOldR
     , deleteTicketDepOldR
     , getTicketReverseDepsR
+    , getTicketDepR
     , getTicketParticipantsR
     , getTicketTeamR
     , getTicketEventsR
@@ -889,10 +890,15 @@ postTicketDepsR shr prj num = do
     ((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
     case result of
         FormSuccess ctid -> do
+            pidAuthor <- requireVerifiedAuthId
+            now <- liftIO getCurrentTime
             runDB $ do
                 let td = TicketDependency
-                        { ticketDependencyParent = tid
+                        { ticketDependencyParent  = tid
-                        , ticketDependencyChild  = ctid
+                        , ticketDependencyChild   = ctid
+                        , ticketDependencyAuthor  = pidAuthor
+                        , ticketDependencySummary = "(A ticket dependency)"
+                        , ticketDependencyCreated = now
                         }
                 insert_ td
                 trrFix td ticketDepGraph
@@ -937,6 +943,51 @@ deleteTicketDepOldR shr prj pnum cnum = do
 getTicketReverseDepsR :: ShrIdent -> PrjIdent -> Int -> Handler Html
 getTicketReverseDepsR = getTicketDeps False
 
+getTicketDepR :: KeyHashid TicketDependency -> Handler TypedContent
+getTicketDepR tdkhid = do
+    tdid <- decodeKeyHashid404 tdkhid
+    ( td,
+      (sParent, jParent, tParent),
+      (sChild, jChild, tChild),
+      (sAuthor, pAuthor)
+      ) <- runDB $ do
+        tdep <- get404 tdid
+        (,,,) tdep
+            <$> getTicket (ticketDependencyParent tdep)
+            <*> getTicket (ticketDependencyChild tdep)
+            <*> getAuthor (ticketDependencyAuthor tdep)
+
+    encodeRouteLocal <- getEncodeRouteLocal
+    encodeRouteHome <- getEncodeRouteHome
+    let ticketRoute s j t =
+            TicketR (sharerIdent s) (projectIdent j) (ticketNumber t)
+        here = TicketDepR tdkhid
+        tdepAP = Relationship
+            { relationshipId           = Just $ encodeRouteHome here
+            , relationshipSubject      =
+                encodeRouteHome $ ticketRoute sParent jParent tParent
+            , relationshipProperty     = Left RelDependsOn
+            , relationshipObject       =
+                encodeRouteHome $ ticketRoute sChild jChild tChild
+            , relationshipAttributedTo =
+                encodeRouteLocal $ SharerR $ sharerIdent sAuthor
+            , relationshipPublished    = Just $ ticketDependencyCreated td
+            , relationshipUpdated      = Just $ ticketDependencyCreated td
+            , relationshipSummary      = TextHtml $ ticketDependencySummary td
+            }
+
+    provideHtmlAndAP tdepAP $ redirectToPrettyJSON here
+    where
+    getTicket tid = do
+        t <- getJust tid
+        j <- getJust $ ticketProject t
+        s <- getJust $ projectSharer j
+        return (s, j, t)
+    getAuthor pid = do
+        p <- getJust pid
+        s <- getJust $ personIdent p
+        return (s, p)
+
 getTicketParticipantsR :: ShrIdent -> PrjIdent -> Int -> Handler TypedContent
 getTicketParticipantsR shr prj num = getFollowersCollection here getFsid
     where

src/Vervis/Migration.hs

@@ -971,6 +971,40 @@ changes hLocal ctx =
         updateWhere
             [Ticket20190624Id <-. tids]
             [Ticket20190624Closer =. Nothing]
+      -- 127
+    , addFieldRefRequired''
+        "TicketDependency"
+        (do let user = "$$temp$$"
+            sid <-
+                insert $ Sharer127 (text2shr user) Nothing defaultTime
+            ibid <- insert Inbox127
+            obid <- insert Outbox127
+            insertEntity $
+                Person127
+                    sid user "" "e@ma.il" False "" defaultTime ""
+                    defaultTime "" ibid obid
+        )
+        (Just $ \ (Entity pidTemp pTemp) -> do
+            tds <- selectList ([] :: [Filter TicketDependency127]) []
+            for_ tds $ \ (Entity tdid td) -> do
+                t <- getJust $ ticketDependency127Parent td
+                j <- getJust $ ticket127Project t
+                mpid <- getKeyBy $ UniquePersonIdent127 $ project127Sharer j
+                let pid = fromMaybe (error "No Person found for Sharer") mpid
+                update tdid [TicketDependency127Author =. pid]
+
+            delete pidTemp
+            delete $ person127Ident pTemp
+        )
+        "author"
+        "Person"
+      -- 128
+    , addFieldPrimRequired
+        "TicketDependency"
+        ("(A ticket dependency)" :: Text)
+        "summary"
+      -- 129
+    , addFieldPrimRequired "TicketDependency" defaultTime "created"
     ]
 
 migrateDB

src/Vervis/Migration/Model.hs

@@ -110,6 +110,14 @@ module Vervis.Migration.Model
     , Ticket20190624Generic (..)
     , Ticket20190624
     , TicketAuthorLocal20190624Generic (..)
+    , Sharer127Generic (..)
+    , Person127Generic (..)
+    , Outbox127Generic (..)
+    , Inbox127Generic (..)
+    , Project127Generic (..)
+    , Ticket127Generic (..)
+    , TicketDependency127Generic (..)
+    , TicketDependency127
     )
 where
 
@@ -227,3 +235,6 @@ makeEntitiesMigration "20190616"
 
 makeEntitiesMigration "20190624"
     $(modelFile "migrations/2019_06_24.model")
+
+makeEntitiesMigration "127"
+    $(modelFile "migrations/2019_07_11.model")

src/Web/ActivityPub.hs

@@ -40,6 +40,8 @@ module Web.ActivityPub
 
       -- * Content objects
     , Note (..)
+    , RelationshipProperty (..)
+    , Relationship (..)
     , TextHtml (..)
     , TextPandocMarkdown (..)
     , TicketLocal (..)
@@ -554,6 +556,65 @@ instance ActivityPub Note where
         <> "content"      .=  content
         <> "mediaType"    .=  ("text/html" :: Text)
 
+data RelationshipProperty = RelDependsOn
+
+instance FromJSON RelationshipProperty where
+    parseJSON = withText "RelationshipProperty" parse
+        where
+        parse t
+            | t == "dependsOn" = pure RelDependsOn
+            | otherwise = fail $ "Unrecognized relationship: " ++ T.unpack t
+
+instance ToJSON RelationshipProperty where
+    toJSON = error "toJSON RelationshipProperty"
+    toEncoding at =
+        toEncoding $ case at of
+            RelDependsOn -> "dependsOn" :: Text
+
+data Relationship = Relationship
+    { relationshipId           :: Maybe FedURI
+    , relationshipSubject      :: FedURI
+    , relationshipProperty     :: Either RelationshipProperty Text
+    , relationshipObject       :: FedURI
+    , relationshipAttributedTo :: LocalURI
+    , relationshipPublished    :: Maybe UTCTime
+    , relationshipUpdated      :: Maybe UTCTime
+    , relationshipSummary      :: TextHtml
+    }
+
+instance ActivityPub Relationship where
+    jsonldContext _ = [as2Context, forgeContext]
+    parseObject o = do
+        typ <- o .: "type"
+        unless (typ == ("Relationship" :: Text)) $
+            fail "type isn't Relationship"
+
+        (h, attributedTo) <- f2l <$> o .: "attributedTo"
+
+        fmap (h,) $
+            Relationship
+                <$> o .:? "id"
+                <*> o .: "subject"
+                <*> o .:+ "relationship"
+                <*> o .: "object"
+                <*> pure attributedTo
+                <*> o .:? "published"
+                <*> o .:? "updated"
+                <*> (TextHtml . sanitizeBalance <$> o .: "summary")
+
+    toSeries host
+        (Relationship id_ subject property object attributedTo published
+                      updated summary)
+            =  "id"           .=? id_
+            <> "type"         .=  ("Relationship" :: Text)
+            <> "subject"      .=  subject
+            <> "relationship" .=+ property
+            <> "object"       .=  object
+            <> "attributedTo" .= l2f host attributedTo
+            <> "published"    .=? published
+            <> "updated"      .=? updated
+            <> "summary"      .=  summary
+
 newtype TextHtml = TextHtml
     { unTextHtml :: Text
     }

src/Yesod/ActivityPub.hs

@@ -19,6 +19,7 @@ module Yesod.ActivityPub
     , deliverActivityBL
     , deliverActivityBL'
     , forwardActivity
+    , redirectToPrettyJSON
     , provideHtmlAndAP
     , provideHtmlAndAP'
     , provideHtmlAndAP''
@@ -172,6 +173,10 @@ forwardActivity inbox sig rSender body = do
                 ]
     return result
 
+redirectToPrettyJSON
+    :: (MonadHandler m, HandlerSite m ~ site) => Route site -> m a
+redirectToPrettyJSON route = redirect (route, [("prettyjson", "true")])
+
 provideHtmlAndAP
     :: (YesodActivityPub site, ActivityPub a)
     => a -> WidgetFor site () -> HandlerFor site TypedContent