Add tickets-under-sharer route, just plain JSON view
This commit is contained in:
fr33domlover
parent
5e9dd3555d
commit
32173fe0c0
6 changed files with 106 additions and 10 deletions
|
|
@ -392,7 +392,8 @@ TicketUnderProject
|
|||
project TicketProjectLocalId
|
||||
author TicketAuthorLocalId
|
||||
|
||||
UniqueTicketUnderProject project author
|
||||
UniqueTicketUnderProjectProject project
|
||||
UniqueTicketUnderProjectAuthor author
|
||||
|
||||
TicketDependency
|
||||
parent TicketId
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
Loading…
Reference in a new issue