Add tickets-under-sharer route, just plain JSON view

This commit is contained in:
fr33domlover 2020-02-08 15:24:36 +00:00
parent 5e9dd3555d
commit 32173fe0c0
6 changed files with 106 additions and 10 deletions

View file

@ -392,7 +392,8 @@ TicketUnderProject
project TicketProjectLocalId
author TicketAuthorLocalId
UniqueTicketUnderProject project author
UniqueTicketUnderProjectProject project
UniqueTicketUnderProjectAuthor author
TicketDependency
parent TicketId

View file

@ -181,4 +181,8 @@
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/team TicketTeamR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/events TicketEventsR GET
/s/#ShrIdent/t SharerTicketsR GET
/s/#ShrIdent/t/#TicketAuthorLocalKeyHashid SharerTicketR GET
/s/#ShrIdent/p/#PrjIdent/w/+Texts WikiPageR GET

View file

@ -139,6 +139,7 @@ type SshKeyKeyHashid = KeyHashid SshKey
type MessageKeyHashid = KeyHashid Message
type LocalMessageKeyHashid = KeyHashid LocalMessage
type LocalTicketKeyHashid = KeyHashid LocalTicket
type TicketAuthorLocalKeyHashid = KeyHashid TicketAuthorLocal
type TicketDepKeyHashid = KeyHashid TicketDependency
-- This is where we define all of the routes in our application. For a full

View file

@ -51,6 +51,9 @@ module Vervis.Handler.Ticket
, getTicketParticipantsR
, getTicketTeamR
, getTicketEventsR
, getSharerTicketsR
, getSharerTicketR
)
where
@ -91,6 +94,7 @@ import qualified Database.Esqueleto as E
import Database.Persist.Sql.Graph.TransitiveReduction (trrFix)
import Data.Aeson.Encode.Pretty.ToEncoding
import Data.MediaType
import Network.FedURI
import Web.ActivityPub hiding (Ticket (..), TicketDependency)
import Yesod.ActivityPub
@ -98,6 +102,7 @@ import Yesod.Auth.Unverified
import Yesod.FedURI
import Yesod.Hashids
import Yesod.MonadSite
import Yesod.RenderSource
import qualified Web.ActivityPub as AP
@ -109,17 +114,16 @@ import Yesod.Persist.Local
import Vervis.API
import Vervis.Federation
import Vervis.FedURI
import Vervis.Form.Ticket
import Vervis.Foundation
import Vervis.Handler.Discussion
import Vervis.GraphProxy (ticketDepGraph)
import Data.MediaType
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Model.Ticket
import Vervis.Model.Workflow
import Vervis.Paginate
import Yesod.RenderSource
import Vervis.Settings
import Vervis.Style
import Vervis.Ticket
@ -1219,3 +1223,78 @@ getTicketTeamR shr prj ltkhid = do
getTicketEventsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketEventsR _shr _prj _ltkhid = error "TODO not implemented"
getSharerTicketsR :: ShrIdent -> Handler TypedContent
getSharerTicketsR shr = do
(total, pages, mpage) <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr
pid <- getKeyBy404 $ UniquePersonIdent sid
getPageAndNavCount (countTickets pid) (selectTickets pid)
encodeRouteHome <- getEncodeRouteHome
encodeRouteLocal <- getEncodeRouteLocal
encodeRoutePageLocal <- getEncodeRoutePageLocal
let pageUrl = encodeRoutePageLocal here
encodeTicketKey <- getEncodeKeyHashid
let ticketUrl = SharerTicketR shr . encodeTicketKey
case mpage of
Nothing -> provide $ Collection
{ collectionId = encodeRouteLocal here
, collectionType = CollectionTypeOrdered
, collectionTotalItems = Just total
, collectionCurrent = Nothing
, collectionFirst = Just $ pageUrl 1
, collectionLast = Just $ pageUrl pages
, collectionItems = [] :: [Text]
}
Just (tickets, navModel) ->
let current = nmCurrent navModel
in provide $ CollectionPage
{ collectionPageId = pageUrl current
, collectionPageType = CollectionPageTypeOrdered
, collectionPageTotalItems = Nothing
, collectionPageCurrent = Just $ pageUrl current
, collectionPageFirst = Just $ pageUrl 1
, collectionPageLast = Just $ pageUrl pages
, collectionPagePartOf = encodeRouteLocal here
, collectionPagePrev =
if current > 1
then Just $ pageUrl $ current - 1
else Nothing
, collectionPageNext =
if current < pages
then Just $ pageUrl $ current + 1
else Nothing
, collectionPageStartIndex = Nothing
, collectionPageItems =
map (encodeRouteHome . ticketUrl . E.unValue) tickets
}
where
here = SharerTicketsR shr
provide :: ActivityPub a => a URIMode -> Handler TypedContent
provide a = provideHtmlAndAP a $ redirectToPrettyJSON here
countTickets pid = fmap toOne $
E.select $ E.from $ \ (tal `E.LeftOuterJoin` tup) -> do
E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
E.where_ $
tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
E.isNothing (tup E.?. TicketUnderProjectId)
return $ E.count $ tal E.^. TicketAuthorLocalId
where
toOne [x] = E.unValue x
toOne [] = error "toOne = 0"
toOne _ = error "toOne > 1"
selectTickets pid off lim =
E.select $ E.from $ \ (tal `E.LeftOuterJoin` tup) -> do
E.on $ E.just (tal E.^. TicketAuthorLocalId) E.==. tup E.?. TicketUnderProjectAuthor
E.where_ $
tal E.^. TicketAuthorLocalAuthor E.==. E.val pid E.&&.
E.isNothing (tup E.?. TicketUnderProjectId)
E.orderBy [E.desc $ tal E.^. TicketAuthorLocalId]
E.offset $ fromIntegral off
E.limit $ fromIntegral lim
return $ tal E.^. TicketAuthorLocalId
getSharerTicketR
:: ShrIdent -> KeyHashid TicketAuthorLocal -> Handler TypedContent
getSharerTicketR shr talkhid = error "Not implemented yet"

View file

@ -1464,6 +1464,14 @@ changes hLocal ctx =
E.on $ tal E.^. TicketAuthorLocal223Ticket E.==. lt E.^. LocalTicket223Id
return (tpl E.^. TicketProjectLocal223Id, tal E.^. TicketAuthorLocal223Id)
insertMany_ $ map (uncurry TicketUnderProject223 . bimap E.unValue E.unValue) ids
-- 224
, addUnique "TicketUnderProject" $
Unique "UniqueTicketUnderProjectProject" ["project"]
-- 225
, addUnique "TicketUnderProject" $
Unique "UniqueTicketUnderProjectAuthor" ["author"]
-- 226
, removeUnique "TicketUnderProject" "UniqueTicketUnderProject"
]
migrateDB

View file

@ -1,6 +1,6 @@
$# This file is part of Vervis.
$#
$# Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
$# Written in 2019, 2020 by fr33domlover <fr33domlover@riseup.net>.
$#
$# ♡ Copying is an act of love. Please copy, reuse and share.
$#
@ -39,3 +39,6 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<span>
<a href=@{WorkflowsR shr}>
[🔁 Workflows]
<span>
<a href=@{SharerTicketsR shr}>
[🐛 Tickets]