From 32173fe0c0996071db6f1c2788c3cbdec139fbb7 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sat, 8 Feb 2020 15:24:36 +0000 Subject: [PATCH] Add tickets-under-sharer route, just plain JSON view --- config/models | 3 +- config/routes | 4 ++ src/Vervis/Foundation.hs | 13 ++--- src/Vervis/Handler/Ticket.hs | 83 +++++++++++++++++++++++++++++- src/Vervis/Migration.hs | 8 +++ templates/person/widget/nav.hamlet | 5 +- 6 files changed, 106 insertions(+), 10 deletions(-) diff --git a/config/models b/config/models index 6bcabf1..29be4c5 100644 --- a/config/models +++ b/config/models @@ -392,7 +392,8 @@ TicketUnderProject project TicketProjectLocalId author TicketAuthorLocalId - UniqueTicketUnderProject project author + UniqueTicketUnderProjectProject project + UniqueTicketUnderProjectAuthor author TicketDependency parent TicketId diff --git a/config/routes b/config/routes index e44dc77..481c9cf 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index 60073c6..f9d64ea 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -134,12 +134,13 @@ data App = App -- Aliases for the routes file, because it doesn't like spaces in path piece -- type names. -type OutboxItemKeyHashid = KeyHashid OutboxItem -type SshKeyKeyHashid = KeyHashid SshKey -type MessageKeyHashid = KeyHashid Message -type LocalMessageKeyHashid = KeyHashid LocalMessage -type LocalTicketKeyHashid = KeyHashid LocalTicket -type TicketDepKeyHashid = KeyHashid TicketDependency +type OutboxItemKeyHashid = KeyHashid OutboxItem +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 -- explanation of the syntax, please see: diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 62573e2..d3f26f0 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -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" diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 003d88d..53b1b6a 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -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 diff --git a/templates/person/widget/nav.hamlet b/templates/person/widget/nav.hamlet index b6f8036..2906146 100644 --- a/templates/person/widget/nav.hamlet +++ b/templates/person/widget/nav.hamlet @@ -1,6 +1,6 @@ $# This file is part of Vervis. $# -$# Written in 2019 by fr33domlover . +$# Written in 2019, 2020 by fr33domlover . $# $# ♡ Copying is an act of love. Please copy, reuse and share. $# @@ -39,3 +39,6 @@ $# . [🔁 Workflows] + + + [🐛 Tickets]