1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-27 16:34:52 +09:00

Switch ticket routes to use the KeyHashid of LocalTicket instead of Ticket

This commit is contained in:
fr33domlover 2020-02-06 00:52:15 +00:00
parent cd5180a1d5
commit 443ff6daa1
23 changed files with 382 additions and 337 deletions

View file

@ -156,29 +156,29 @@
/s/#ShrIdent/p/#PrjIdent/t/!tree TicketTreeR GET
/s/#ShrIdent/p/#PrjIdent/t/!new TicketNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid TicketR GET PUT DELETE POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/edit TicketEditR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/accept TicketAcceptR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/close TicketCloseR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/open TicketOpenR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/claim TicketClaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/unclaim TicketUnclaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/assign TicketAssignR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/unassign TicketUnassignR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/follow TicketFollowR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/unfollow TicketUnfollowR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/cr ClaimRequestsTicketR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/cr/new ClaimRequestNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/d TicketDiscussionR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/d/!reply TicketTopReplyR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/d/#MessageKeyHashid TicketMessageR POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/d/#MessageKeyHashid/reply TicketReplyR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/deps TicketDepsR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/deps/!new TicketDepNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/deps/#TicketKeyHashid TicketDepOldR POST DELETE
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/rdeps TicketReverseDepsR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/participants TicketParticipantsR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/team TicketTeamR GET
/s/#ShrIdent/p/#PrjIdent/t/#TicketKeyHashid/events TicketEventsR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid TicketR GET PUT DELETE POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/edit TicketEditR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/accept TicketAcceptR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/close TicketCloseR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/open TicketOpenR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/claim TicketClaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unclaim TicketUnclaimR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/assign TicketAssignR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unassign TicketUnassignR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/follow TicketFollowR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/unfollow TicketUnfollowR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/cr ClaimRequestsTicketR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/cr/new ClaimRequestNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d TicketDiscussionR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/!reply TicketTopReplyR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/#MessageKeyHashid TicketMessageR POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/d/#MessageKeyHashid/reply TicketReplyR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps TicketDepsR GET POST
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps/!new TicketDepNewR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/deps/#LocalTicketKeyHashid TicketDepOldR POST DELETE
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/rdeps TicketReverseDepsR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/participants TicketParticipantsR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/team TicketTeamR GET
/s/#ShrIdent/p/#PrjIdent/t/#LocalTicketKeyHashid/events TicketEventsR GET
/s/#ShrIdent/p/#PrjIdent/w/+Texts WikiPageR GET

View file

@ -162,18 +162,14 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
(lmid, obiid, doc, remotesHttp) <- runDBExcept $ do
(pid, obid, shrUser) <- verifyIsLoggedInUser luAttrib "Note attributed to different actor"
(did, meparent, mcollections) <- case mticket of
Just (shr, prj, tkhid) -> do
Just (shr, prj, ltkhid) -> do
mt <- lift $ runMaybeT $ do
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
Entity jid j <- MaybeT $ getBy $ UniqueProject prj sid
tid <- decodeKeyHashidM tkhid
t <- MaybeT $ get tid
ltid <- decodeKeyHashidM ltkhid
lt <- MaybeT $ get ltid
t <- lift $ getJust $ localTicketTicket lt
guard $ ticketProject t == jid
lt <- lift $ do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return (sid, projectInbox j, projectFollowers j, t, lt)
(sid, ibidProject, fsidProject, _t, lt) <- fromMaybeE mt "Context: No such local ticket"
let did = localTicketDiscuss lt
@ -250,7 +246,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
-> ExceptT Text Handler
( Maybe (Either (ShrIdent, LocalMessageId) FedURI)
, [ShrIdent]
, Maybe (ShrIdent, PrjIdent, KeyHashid Ticket)
, Maybe (ShrIdent, PrjIdent, KeyHashid LocalTicket)
, [(Host, NonEmpty LocalURI)]
)
parseRecipsContextParent uContext muParent = do
@ -281,7 +277,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
then Left <$> parseComment luParent
else return $ Right uParent
parseContextTicket :: Monad m => LocalURI -> ExceptT Text m (ShrIdent, PrjIdent, KeyHashid Ticket)
parseContextTicket :: Monad m => LocalURI -> ExceptT Text m (ShrIdent, PrjIdent, KeyHashid LocalTicket)
parseContextTicket luContext = do
route <- case decodeRouteLocal luContext of
Nothing -> throwE "Local context isn't a valid route"
@ -294,7 +290,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
atMostSharer _ (shr, LocalSharerRelatedSet s [] []) = return $ if localRecipSharer s then Just shr else Nothing
atMostSharer e (_ , LocalSharerRelatedSet _ _ _ ) = throwE e
verifyTicketRecipients :: (ShrIdent, PrjIdent, KeyHashid Ticket) -> LocalRecipientSet -> ExceptT Text Handler [ShrIdent]
verifyTicketRecipients :: (ShrIdent, PrjIdent, KeyHashid LocalTicket) -> LocalRecipientSet -> ExceptT Text Handler [ShrIdent]
verifyTicketRecipients (shr, prj, num) recips = do
lsrSet <- fromMaybeE (lookupSorted shr recips) "Note with local context: No required recipients"
(prj', lprSet) <- verifySingleton (localRecipProjectRelated lsrSet) "Note project-related recipient sets"
@ -451,7 +447,7 @@ createNoteC host (Note mluNote luAttrib aud muParent muContext mpublished source
data Followee
= FolloweeSharer ShrIdent
| FolloweeProject ShrIdent PrjIdent
| FolloweeTicket ShrIdent PrjIdent (KeyHashid Ticket)
| FolloweeTicket ShrIdent PrjIdent (KeyHashid LocalTicket)
| FolloweeRepo ShrIdent RpIdent
followC
@ -544,18 +540,14 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = run
MaybeT $ getValBy $ UniqueProject prj sid
project <- fromMaybeE mproject "Follow object: No such project in DB"
return (projectFollowers project, projectInbox project, False, projectOutbox project)
getFollowee (FolloweeTicket shr prj tkhid) = do
getFollowee (FolloweeTicket shr prj ltkhid) = do
mproject <- lift $ runMaybeT $ do
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
Entity jid project <- MaybeT $ getBy $ UniqueProject prj sid
tid <- decodeKeyHashidM tkhid
ticket <- MaybeT $ get tid
ltid <- decodeKeyHashidM ltkhid
lticket <- MaybeT $ get ltid
ticket <- lift $ getJust $ localTicketTicket lticket
guard $ ticketProject ticket == jid
lticket <- lift $ do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return (lticket, project)
(lticket, project) <- fromMaybeE mproject "Follow object: No such ticket in DB"
return (localTicketFollowers lticket, projectInbox project, False, projectOutbox project)
@ -788,8 +780,8 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
persistJSONObjectFromDoc $ Doc hLocal emptyActivity
, outboxItemPublished = now
}
tid <- insertTicket jid {-tids-} {-num-} obiidAccept
docAccept <- insertAccept pidAuthor sid jid fsid luOffer obiidAccept tid
ltid <- insertTicket jid {-tids-} {-num-} obiidAccept
docAccept <- insertAccept pidAuthor sid jid fsid luOffer obiidAccept ltid
publishAccept pidAuthor sid jid fsid luOffer {-num-} obiidAccept docAccept
(pidsTeam, remotesTeam) <-
if localRecipProjectTeam project
@ -808,8 +800,8 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
insertToInbox ibid = do
ibiid <- insert $ InboxItem False
insert_ $ InboxItemLocal ibid obiid ibiid
insertAccept pidAuthor sid jid fsid luOffer obiid tid = do
tkhid <- encodeKeyHashid tid
insertAccept pidAuthor sid jid fsid luOffer obiid ltid = do
ltkhid <- encodeKeyHashid ltid
summary <-
TextHtml . TL.toStrict . renderHtml <$>
withUrlRenderer
@ -821,7 +813,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
<a href=@{ProjectR shrProject prjProject}>
./s/#{shr2text shrProject}/p/#{prj2text prjProject}
: #
<a href=@{TicketR shrProject prjProject tkhid}>
<a href=@{TicketR shrProject prjProject ltkhid}>
#{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}.
|]
hLocal <- asksSite siteInstanceHost
@ -846,7 +838,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
{ acceptObject = ObjURI hLocal luOffer
, acceptResult =
Just $ encodeRouteLocal $
TicketR shrProject prjProject tkhid
TicketR shrProject prjProject ltkhid
}
}
update
@ -870,7 +862,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
, ticketCloser = Nothing
, ticketAccept = obiidAccept
}
insert_ LocalTicket
ltid <- insert LocalTicket
{ localTicketTicket = tid
, localTicketDiscuss = did
, localTicketFollowers = fsid
@ -882,7 +874,7 @@ offerTicketC shrUser summary audience offer@(Offer ticket uTarget) = runExceptT
}
--insertMany_ $ map (TicketDependency tid) tidsDeps
-- insert_ $ Follow pidAuthor fsid False True
return tid
return ltid
publishAccept pidAuthor sid jid fsid luOffer {-num-} obiid doc = do
now <- liftIO getCurrentTime
let dont = Authority "dont-do.any-forwarding" Nothing

View file

@ -130,7 +130,7 @@ verifyHostLocal h t = do
parseContext
:: (MonadSite m, SiteEnv m ~ App)
=> FedURI
-> ExceptT Text m (Either (ShrIdent, PrjIdent, KeyHashid Ticket) FedURI)
-> ExceptT Text m (Either (ShrIdent, PrjIdent, KeyHashid LocalTicket) FedURI)
parseContext uContext = do
let ObjURI hContext luContext = uContext
local <- hostIsLocal hContext

View file

@ -86,8 +86,8 @@ data LocalPersonCollection
= LocalPersonCollectionSharerFollowers ShrIdent
| LocalPersonCollectionProjectTeam ShrIdent PrjIdent
| LocalPersonCollectionProjectFollowers ShrIdent PrjIdent
| LocalPersonCollectionTicketTeam ShrIdent PrjIdent (KeyHashid Ticket)
| LocalPersonCollectionTicketFollowers ShrIdent PrjIdent (KeyHashid Ticket)
| LocalPersonCollectionTicketTeam ShrIdent PrjIdent (KeyHashid LocalTicket)
| LocalPersonCollectionTicketFollowers ShrIdent PrjIdent (KeyHashid LocalTicket)
| LocalPersonCollectionRepoTeam ShrIdent RpIdent
| LocalPersonCollectionRepoFollowers ShrIdent RpIdent
@ -133,7 +133,7 @@ data LocalProjectRecipientDirect
data LocalProjectRecipient
= LocalProjectDirect LocalProjectRecipientDirect
| LocalTicketRelated (KeyHashid Ticket) LocalTicketRecipientDirect
| LocalTicketRelated (KeyHashid LocalTicket) LocalTicketRecipientDirect
deriving (Eq, Ord)
data LocalRepoRecipientDirect
@ -222,7 +222,7 @@ data LocalProjectDirectSet = LocalProjectDirectSet
data LocalProjectRelatedSet = LocalProjectRelatedSet
{ localRecipProjectDirect :: LocalProjectDirectSet
, localRecipTicketRelated :: [(KeyHashid Ticket, LocalTicketDirectSet)]
, localRecipTicketRelated :: [(KeyHashid LocalTicket, LocalTicketDirectSet)]
}
deriving Eq

View file

@ -191,7 +191,7 @@ followProject shrAuthor shrObject prjObject hide = do
followTicket
:: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
=> ShrIdent -> ShrIdent -> PrjIdent -> KeyHashid Ticket -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
=> ShrIdent -> ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Bool -> m (TextHtml, Audience URIMode, AP.Follow URIMode)
followTicket shrAuthor shrObject prjObject numObject hide = do
encodeRouteHome <- getEncodeRouteHome
let uObject = encodeRouteHome $ TicketR shrObject prjObject numObject
@ -333,7 +333,7 @@ undoFollowTicket
-> PersonId
-> ShrIdent
-> PrjIdent
-> KeyHashid Ticket
-> KeyHashid LocalTicket
-> m (Either Text (TextHtml, Audience URIMode, Undo URIMode))
undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
undoFollow shrAuthor pidAuthor getFsid "project" objRoute recipRoute
@ -347,14 +347,12 @@ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee numFollowee =
jid <- do
mjid <- lift $ getKeyBy $ UniqueProject prjFollowee sid
fromMaybeE mjid "No such local project"
tid <- decodeKeyHashidE numFollowee "Invalid hashid for context"
mt <- lift $ get tid
t <- fromMaybeE mt "Unfollow target no such local ticket"
ltid <- decodeKeyHashidE numFollowee "Invalid hashid for context"
mlt <- lift $ get ltid
lt <- fromMaybeE mlt "Unfollow target no such local ticket"
t <- lift $ getJust $ localTicketTicket lt
unless (ticketProject t == jid) $
throwE "Hashid doesn't match sharer/project"
lt <- do
mlt <- lift $ getValBy $ UniqueLocalTicket tid
fromMaybeE mlt "Unexpected, ticket doesn't have a LocalTicket!"
return $ localTicketFollowers lt
undoFollowRepo

View file

@ -112,7 +112,7 @@ prependError t a = do
Left e -> throwE $ t <> ": " <> e
Right x -> return x
parseTicket :: Monad m => (ShrIdent, PrjIdent) -> LocalURI -> ExceptT Text m (KeyHashid Ticket)
parseTicket :: Monad m => (ShrIdent, PrjIdent) -> LocalURI -> ExceptT Text m (KeyHashid LocalTicket)
parseTicket project luContext = do
route <- case decodeRouteLocal luContext of
Nothing -> throwE "Local context isn't a valid route"

View file

@ -103,18 +103,14 @@ sharerCreateNoteF now shrRecip author body (Note mluNote _ _ muParent muContext
where
checkContextParent context mparent = runExceptT $ do
case context of
Left (shr, prj, tkhid) -> do
Left (shr, prj, ltkhid) -> do
mdid <- lift $ runMaybeT $ do
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
jid <- MaybeT $ getKeyBy $ UniqueProject prj sid
tid <- decodeKeyHashidM tkhid
t <- MaybeT $ get tid
ltid <- decodeKeyHashidM ltkhid
lt <- MaybeT $ get ltid
t <- lift $ getJust $ localTicketTicket lt
guard $ ticketProject t == jid
lt <- lift $ do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return $ localTicketDiscuss lt
did <- fromMaybeE mdid "Context: No such local ticket"
for_ mparent $ \ parent ->
@ -196,17 +192,17 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
else Just <$> parseParent uParent
case context of
Right _ -> return $ recip <> " not using; context isn't local"
Left (shr, prj, tkhid) ->
Left (shr, prj, ltkhid) ->
if shr /= shrRecip || prj /= prjRecip
then return $ recip <> " not using; context is a different project"
else do
msig <- checkForward shrRecip prjRecip
hLocal <- getsYesod $ appInstanceHost . appSettings
let colls =
findRelevantCollections hLocal tkhid $
findRelevantCollections hLocal ltkhid $
activityAudience $ actbActivity body
mremotesHttp <- runDBExcept $ do
(sid, fsidProject, fsidTicket, jid, ibid, did, meparent) <- getContextAndParent tkhid mparent
(sid, fsidProject, fsidTicket, jid, ibid, did, meparent) <- getContextAndParent ltkhid mparent
lift $ join <$> do
mmid <- insertToDiscussion luCreate luNote published ibid did meparent fsidTicket
for mmid $ \ (ractid, mid) -> do
@ -238,17 +234,16 @@ projectCreateNoteF now shrRecip prjRecip author body (Note mluNote _ _ muParent
-> Just CreateNoteRecipTicketTeam
_ -> Nothing
recip = T.concat ["/s/", shr2text shrRecip, "/p/", prj2text prjRecip]
getContextAndParent tkhid mparent = do
getContextAndParent ltkhid mparent = do
mt <- do
sid <- lift $ getKeyBy404 $ UniqueSharer shrRecip
Entity jid j <- lift $ getBy404 $ UniqueProject prjRecip sid
tid <- decodeKeyHashidE tkhid "Context: Not a valid ticket khid"
mt <- lift $ get tid
for mt $ \ t -> do
ltid <- decodeKeyHashidE ltkhid "Context: Not a valid ticket khid"
mlt <- lift $ get ltid
for mlt $ \ lt -> do
t <- lift $ getJust $ localTicketTicket lt
unless (ticketProject t == jid) $
throwE "Context: Local ticket khid belongs to different project"
mlt <- lift $ getValBy $ UniqueLocalTicket tid
lt <- fromMaybeE mlt "No LocalTicket"
return (jid, projectInbox j, projectFollowers j, sid ,t, lt)
(jid, ibid, fsidProject, sid, _t, lt) <- fromMaybeE mt "Context: No such local ticket"
let did = localTicketDiscuss lt

View file

@ -383,17 +383,15 @@ projectFollowF shr prj =
| shr == shr' && prj == prj' = Just $ Just num
objRoute _ = Nothing
getRecip mtkhid = do
getRecip mltkhid = do
sid <- getKeyBy404 $ UniqueSharer shr
Entity jid j <- getBy404 $ UniqueProject prj sid
mt <- for mtkhid $ \ tkhid -> do
tid <- decodeKeyHashid404 tkhid
t <- get404 tid
mt <- for mltkhid $ \ ltkhid -> do
ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid
t <- getJust $ localTicketTicket lt
unless (ticketProject t == jid) notFound
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return lt
return (j, mt)
followers (j, Nothing) = projectFollowers j

View file

@ -275,7 +275,7 @@ projectOfferTicketF
, ticketCloser = Nothing
, ticketAccept = obiidAccept
}
insert_ LocalTicket
ltid <- insert LocalTicket
{ localTicketTicket = tid
, localTicketDiscuss = did
, localTicketFollowers = fsid
@ -285,7 +285,7 @@ projectOfferTicketF
, ticketAuthorRemoteAuthor = raidAuthor
, ticketAuthorRemoteOffer = ractid
}
docAccept <- insertAccept ra luOffer tid obiidAccept
docAccept <- insertAccept ra luOffer ltid obiidAccept
-- insertMany_ $ map (TicketDependency tid) deps
--insert_ $ RemoteFollow raidAuthor fsid False True
return $ Just (ractid, obiidAccept, docAccept)
@ -315,9 +315,9 @@ projectOfferTicketF
delete ibiid
return remotes
insertAccept ra luOffer tid obiid = do
insertAccept ra luOffer ltid obiid = do
let uAuthor@(ObjURI hAuthor luAuthor) = remoteAuthorURI author
tkhid <- encodeKeyHashid tid
ltkhid <- encodeKeyHashid ltid
summary <-
TextHtml . TL.toStrict . renderHtml <$>
withUrlRenderer
@ -332,7 +332,7 @@ projectOfferTicketF
<a href=@{ProjectR shrRecip prjRecip}>
./s/#{shr2text shrRecip}/p/#{prj2text prjRecip}
\: #
<a href=@{TicketR shrRecip prjRecip tkhid}>
<a href=@{TicketR shrRecip prjRecip ltkhid}>
#{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}.
|]
hLocal <- asksSite siteInstanceHost
@ -360,7 +360,7 @@ projectOfferTicketF
luOffer
, acceptResult =
Just $ encodeRouteLocal $
TicketR shrRecip prjRecip tkhid
TicketR shrRecip prjRecip ltkhid
}
}
update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]

View file

@ -138,7 +138,7 @@ type OutboxItemKeyHashid = KeyHashid OutboxItem
type SshKeyKeyHashid = KeyHashid SshKey
type MessageKeyHashid = KeyHashid Message
type LocalMessageKeyHashid = KeyHashid LocalMessage
type TicketKeyHashid = KeyHashid Ticket
type LocalTicketKeyHashid = KeyHashid LocalTicket
type TicketDepKeyHashid = KeyHashid TicketDependency
-- This is where we define all of the routes in our application. For a full

View file

@ -123,7 +123,7 @@ fedUriField = Field
}
ticketField
:: (Route App -> LocalURI) -> Field Handler (Host, ShrIdent, PrjIdent, KeyHashid Ticket)
:: (Route App -> LocalURI) -> Field Handler (Host, ShrIdent, PrjIdent, KeyHashid LocalTicket)
ticketField encodeRouteLocal = checkMMap toTicket fromTicket fedUriField
where
toTicket uTicket = runExceptT $ do
@ -154,7 +154,7 @@ projectField encodeRouteLocal = checkMMap toProject fromProject fedUriField
fromProject (h, shr, prj) = ObjURI h $ encodeRouteLocal $ ProjectR shr prj
publishCommentForm
:: Form ((Host, ShrIdent, PrjIdent, KeyHashid Ticket), Maybe FedURI, Text)
:: Form ((Host, ShrIdent, PrjIdent, KeyHashid LocalTicket), Maybe FedURI, Text)
publishCommentForm html = do
enc <- getEncodeRouteLocal
defk <- encodeKeyHashid $ E.toSqlKey 1
@ -448,7 +448,7 @@ postProjectFollowR shrObject prjObject = do
setFollowMessage shrAuthor eid
redirect $ ProjectR shrObject prjObject
postTicketFollowR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler ()
postTicketFollowR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler ()
postTicketFollowR shrObject prjObject tkhidObject = do
shrAuthor <- getUserShrIdent
(summary, audience, follow) <- followTicket shrAuthor shrObject prjObject tkhidObject False
@ -495,7 +495,7 @@ postProjectUnfollowR shrFollowee prjFollowee = do
setUnfollowMessage shrAuthor eid
redirect $ ProjectR shrFollowee prjFollowee
postTicketUnfollowR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler ()
postTicketUnfollowR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler ()
postTicketUnfollowR shrFollowee prjFollowee tkhidFollowee = do
(shrAuthor, pidAuthor) <- getUser
eid <- runExceptT $ do
@ -667,7 +667,7 @@ postTicketsR shr prj = do
Entity _ p <- requireVerifiedAuth
runDB $ sharerIdent <$> getJust (personIdent p)
etid <- runExceptT $ do
eltid <- runExceptT $ do
NewTicket title desc tparams eparams cparams <-
case result of
FormMissing -> throwE "Field(s) missing."
@ -701,18 +701,23 @@ postTicketsR shr prj = do
Left
"Offer processed successfully but no ticket \
\created"
Just tal ->
return $ Right $ ticketAuthorLocalTicket tal
case etid of
Just tal -> do
let tid = ticketAuthorLocalTicket tal
mltid <- getKeyBy $ UniqueLocalTicket tid
return $
case mltid of
Nothing -> Left "Weird, no LocalTicket created"
Just ltid -> Right ltid
case eltid of
Left e -> do
setMessage $ toHtml e
defaultLayout $(widgetFile "ticket/new")
Right tid -> do
tkhid <- encodeKeyHashid tid
Right ltid -> do
ltkhid <- encodeKeyHashid ltid
eobiidFollow <- runExceptT $ do
(summary, audience, follow) <- followTicket shrAuthor shr prj tkhid False
(summary, audience, follow) <- followTicket shrAuthor shr prj ltkhid False
ExceptT $ followC shrAuthor summary audience follow
case eobiidFollow of
Left e -> setMessage $ toHtml $ "Ticket created, but following it failed: " <> e
Right _ -> setMessage "Ticket created."
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid

View file

@ -128,20 +128,20 @@ getDiscussionMessage shr lmid = do
route2fed <- getEncodeRouteHome
uContext <- do
let did = messageRoot m
mlt <- getValBy $ UniqueLocalTicketDiscussion did
mlt <- getBy $ UniqueLocalTicketDiscussion did
mrd <- getValBy $ UniqueRemoteDiscussion did
case (mlt, mrd) of
(Nothing, Nothing) -> fail $ "DiscussionId #" ++ show did ++ " has no context"
(Just _, Just _) -> fail $ "DiscussionId #" ++ show did ++ " has both ticket and remote contexts"
(Just lt, Nothing) -> do
(Just (Entity ltid lt), Nothing) -> do
let tid = localTicketTicket lt
t <- getJust tid
j <- getJust $ ticketProject t
s <- getJust $ projectSharer j
let shr = sharerIdent s
prj = projectIdent j
tkhid <- encodeKeyHashid tid
return $ route2fed $ TicketR shr prj tkhid
ltkhid <- encodeKeyHashid ltid
return $ route2fed $ TicketR shr prj ltkhid
(Nothing, Just rd) -> do
i <- getJust $ remoteDiscussionInstance rd
return $ ObjURI (instanceHost i) (remoteDiscussionIdent rd)

View file

@ -145,14 +145,14 @@ getSharerFollowingR shr = do
return (s E.^. SharerIdent, j E.^. ProjectIdent)
return $ map (\ (E.Value shr, E.Value prj) -> ProjectR shr prj) pairs
getTickets fsids = do
lts <- selectList [LocalTicketFollowers <-. fsids] []
let tids = map (localTicketTicket . entityVal) lts
triples <- E.select $ E.from $ \ (t `E.InnerJoin` j `E.InnerJoin` s) -> do
ltids <- selectKeysList [LocalTicketFollowers <-. fsids] []
triples <- E.select $ E.from $ \ (lt `E.InnerJoin` t `E.InnerJoin` j `E.InnerJoin` s) -> do
E.on $ j E.^. ProjectSharer E.==. s E.^. SharerId
E.on $ t E.^. TicketProject E.==. j E.^. ProjectId
E.where_ $ t E.^. TicketId `E.in_` E.valList tids
E.on $ lt E.^. LocalTicketTicket E.==. t E.^. TicketId
E.where_ $ lt E.^. LocalTicketId `E.in_` E.valList ltids
return
(s E.^. SharerIdent, j E.^. ProjectIdent, t E.^. TicketId)
(s E.^. SharerIdent, j E.^. ProjectIdent, lt E.^. LocalTicketId)
encodeHid <- getEncodeKeyHashid
return $
map (\ (E.Value shr, E.Value prj, E.Value tid) -> TicketR shr prj $ encodeHid tid)

View file

@ -161,7 +161,9 @@ getTicketsR shr prj = selectRep $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
let countAllTickets = count [TicketProject ==. jid]
selectTickets off lim = selectList [TicketProject ==. jid] [Desc TicketId, OffsetBy off, LimitTo lim]
selectTickets off lim = do
tids <- selectKeysList [TicketProject ==. jid] [Desc TicketId, OffsetBy off, LimitTo lim]
selectKeysList [LocalTicketTicket <-. tids] [Desc LocalTicketTicket]
getPageAndNavCount countAllTickets selectTickets
encodeRouteHome <- getEncodeRouteHome
@ -203,8 +205,7 @@ getTicketsR shr prj = selectRep $ do
else Nothing
, collectionPageStartIndex = Nothing
, collectionPageItems =
map (encodeRouteHome . ticketUrl . entityKey)
tickets
map (encodeRouteHome . ticketUrl) tickets
}
where
here = TicketsR shr prj
@ -228,8 +229,8 @@ getTicketNewR shr prj = do
((_result, widget), enctype) <- runFormPost $ newTicketForm wid
defaultLayout $(widgetFile "ticket/new")
getTicketR :: ShrIdent -> PrjIdent -> TicketKeyHashid -> Handler TypedContent
getTicketR shar proj khid = do
getTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketR shar proj ltkhid = do
mpid <- maybeAuthId
( wshr, wfl,
author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams,
@ -249,14 +250,11 @@ getTicketR shar proj khid = do
, projectWorkflow project
, workflowIdent w
)
tid <- decodeKeyHashid404 khid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
lticket <- do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
author <-
requireEitherAlt
(do mtal <- getValBy $ UniqueTicketAuthorLocal tid
@ -292,14 +290,16 @@ getTicketR shar proj khid = do
tparams <- getTicketTextParams tid wid
eparams <- getTicketEnumParams tid wid
cparams <- getTicketClasses tid wid
deps <- E.select $ E.from $ \ (dep `E.InnerJoin` t) -> do
deps <- E.select $ E.from $ \ (dep `E.InnerJoin` t `E.InnerJoin` lt) -> do
E.on $ t E.^. TicketId E.==. lt E.^. LocalTicketTicket
E.on $ dep E.^. TicketDependencyChild E.==. t E.^. TicketId
E.where_ $ dep E.^. TicketDependencyParent E.==. E.val tid
return t
rdeps <- E.select $ E.from $ \ (dep `E.InnerJoin` t) -> do
return (lt E.^. LocalTicketId, t)
rdeps <- E.select $ E.from $ \ (dep `E.InnerJoin` t `E.InnerJoin` lt) -> do
E.on $ t E.^. TicketId E.==. lt E.^. LocalTicketTicket
E.on $ dep E.^. TicketDependencyParent E.==. t E.^. TicketId
E.where_ $ dep E.^. TicketDependencyChild E.==. E.val tid
return t
return (lt E.^. LocalTicketId, t)
return
( wshr, wfl
, author, massignee, mcloser, ticket, lticket
@ -312,8 +312,8 @@ getTicketR shar proj khid = do
discuss =
discussionW
(return $ localTicketDiscuss lticket)
(TicketTopReplyR shar proj khid)
(TicketReplyR shar proj khid . encodeHid)
(TicketTopReplyR shar proj ltkhid)
(TicketReplyR shar proj ltkhid . encodeHid)
cRelevant <- newIdent
cIrrelevant <- newIdent
let relevant filt =
@ -334,21 +334,21 @@ getTicketR shar proj khid = do
( hLocal
, AP.TicketLocal
{ AP.ticketId =
encodeRouteLocal $ TicketR shar proj khid
encodeRouteLocal $ TicketR shar proj ltkhid
, AP.ticketContext =
encodeRouteLocal $ ProjectR shar proj
, AP.ticketReplies =
encodeRouteLocal $ TicketDiscussionR shar proj khid
encodeRouteLocal $ TicketDiscussionR shar proj ltkhid
, AP.ticketParticipants =
encodeRouteLocal $ TicketParticipantsR shar proj khid
encodeRouteLocal $ TicketParticipantsR shar proj ltkhid
, AP.ticketTeam =
encodeRouteLocal $ TicketTeamR shar proj khid
encodeRouteLocal $ TicketTeamR shar proj ltkhid
, AP.ticketEvents =
encodeRouteLocal $ TicketEventsR shar proj khid
encodeRouteLocal $ TicketEventsR shar proj ltkhid
, AP.ticketDeps =
encodeRouteLocal $ TicketDepsR shar proj khid
encodeRouteLocal $ TicketDepsR shar proj ltkhid
, AP.ticketReverseDeps =
encodeRouteLocal $ TicketReverseDepsR shar proj khid
encodeRouteLocal $ TicketReverseDepsR shar proj ltkhid
}
)
@ -371,18 +371,20 @@ getTicketR shar proj khid = do
provideHtmlAndAP' host ticketAP $
let followButton =
followW
(TicketFollowR shar proj khid)
(TicketUnfollowR shar proj khid)
(TicketFollowR shar proj ltkhid)
(TicketUnfollowR shar proj ltkhid)
(return $ localTicketFollowers lticket)
in $(widgetFile "ticket/one")
putTicketR :: ShrIdent -> PrjIdent -> TicketKeyHashid -> Handler Html
putTicketR shr prj tkhid = do
putTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
putTicketR shr prj ltkhid = do
(tid, ticket, wid) <- runDB $ do
Entity sid _sharer <- getBy404 $ UniqueSharer shr
Entity pid project <- getBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == pid) notFound
return (tid, ticket, projectWorkflow project)
((result, widget), enctype) <-
@ -393,7 +395,7 @@ putTicketR shr prj tkhid = do
case renderPandocMarkdown $ ticketSource ticket' of
Left err -> do
setMessage $ toHtml err
redirect $ TicketEditR shr prj tkhid
redirect $ TicketEditR shr prj ltkhid
Right t -> return t
let ticket'' = ticket' { ticketDescription = newDescHtml }
runDB $ do
@ -432,7 +434,7 @@ putTicketR shr prj tkhid = do
}
insertMany_ $ map mkcparam cins
setMessage "Ticket updated."
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
FormMissing -> do
setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/edit")
@ -440,41 +442,46 @@ putTicketR shr prj tkhid = do
setMessage "Ticket update failed, see errors below."
defaultLayout $(widgetFile "ticket/edit")
deleteTicketR :: ShrIdent -> PrjIdent -> TicketKeyHashid -> Handler Html
deleteTicketR _shr _prj _tkhid =
deleteTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
deleteTicketR _shr _prj _ltkhid =
--TODO: I can easily implement this, but should it even be possible to
--delete tickets?
error "Not implemented"
postTicketR :: ShrIdent -> PrjIdent -> TicketKeyHashid -> Handler Html
postTicketR shr prj tkhid = do
postTicketR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketR shr prj ltkhid = do
mmethod <- lookupPostParam "_method"
case mmethod of
Just "PUT" -> putTicketR shr prj tkhid
Just "DELETE" -> deleteTicketR shr prj tkhid
Just "PUT" -> putTicketR shr prj ltkhid
Just "DELETE" -> deleteTicketR shr prj ltkhid
_ -> notFound
getTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
getTicketEditR shr prj tkhid = do
getTicketEditR :: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketEditR shr prj ltkhid = do
(tid, ticket, wid) <- runDB $ do
Entity sid _sharer <- getBy404 $ UniqueSharer shr
Entity pid project <- getBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == pid) notFound
return (tid, ticket, projectWorkflow project)
((_result, widget), enctype) <-
runFormPost $ editTicketContentForm tid ticket wid
defaultLayout $(widgetFile "ticket/edit")
postTicketAcceptR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketAcceptR shr prj tkhid = do
postTicketAcceptR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketAcceptR shr prj ltkhid = do
succ <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
return $ Entity tid ticket
case ticketStatus ticket of
@ -486,18 +493,21 @@ postTicketAcceptR shr prj tkhid = do
if succ
then "Ticket accepted."
else "Ticket is already accepted."
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
postTicketCloseR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketCloseR shr prj tkhid = do
postTicketCloseR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketCloseR shr prj ltkhid = do
pid <- requireAuthId
now <- liftIO getCurrentTime
succ <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
return $ Entity tid ticket
case ticketStatus ticket of
@ -514,18 +524,21 @@ postTicketCloseR shr prj tkhid = do
if succ
then "Ticket closed."
else "Ticket is already closed."
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
postTicketOpenR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketOpenR shr prj tkhid = do
postTicketOpenR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketOpenR shr prj ltkhid = do
pid <- requireAuthId
now <- liftIO getCurrentTime
succ <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
return $ Entity tid ticket
case ticketStatus ticket of
@ -540,17 +553,20 @@ postTicketOpenR shr prj tkhid = do
if succ
then "Ticket reopened"
else "Ticket is already open."
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
postTicketClaimR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketClaimR shr prj tkhid = do
postTicketClaimR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketClaimR shr prj ltkhid = do
pid <- requireAuthId
mmsg <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
return $ Entity tid ticket
case (ticketStatus ticket, ticketAssignee ticket) of
@ -567,17 +583,20 @@ postTicketClaimR shr prj tkhid = do
update tid [TicketAssignee =. Just pid]
return Nothing
setMessage $ fromMaybe "The ticket is now assigned to you." mmsg
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
postTicketUnclaimR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketUnclaimR shr prj tkhid = do
postTicketUnclaimR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketUnclaimR shr prj ltkhid = do
pid <- requireAuthId
mmsg <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
return $ Entity tid ticket
case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
@ -597,21 +616,24 @@ postTicketUnclaimR shr prj tkhid = do
update tid [TicketAssignee =. Nothing]
return Nothing
setMessage $ fromMaybe "The ticket is now unassigned." mmsg
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
getTicketAssignR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
getTicketAssignR shr prj tkhid = do
getTicketAssignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketAssignR shr prj ltkhid = do
vpid <- requireAuthId
(jid, Entity tid ticket) <- runDB $ do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity j _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == j) notFound
return (j, Entity tid ticket)
let msg t = do
setMessage t
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
case (ticketStatus ticket, ticketAssignee ticket) of
(TSNew, _) -> msg "The ticket isnt accepted yet. Cant assign it."
(TSClosed, _) -> msg "The ticket is closed. Cant assign it."
@ -621,19 +643,22 @@ getTicketAssignR shr prj tkhid = do
runFormPost $ assignTicketForm vpid jid
defaultLayout $(widgetFile "ticket/assign")
postTicketAssignR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketAssignR shr prj tkhid = do
postTicketAssignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketAssignR shr prj ltkhid = do
vpid <- requireAuthId
(jid, Entity tid ticket) <- runDB $ do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity j _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == j) notFound
return (j, Entity tid ticket)
let msg t = do
setMessage t
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
case (ticketStatus ticket, ticketAssignee ticket) of
(TSNew, _) -> msg "The ticket isnt accepted yet. Cant assign it."
(TSClosed, _) -> msg "The ticket is closed. Cant assign it."
@ -657,15 +682,18 @@ postTicketAssignR shr prj tkhid = do
setMessage "Ticket assignment failed, see errors below."
defaultLayout $(widgetFile "ticket/assign")
postTicketUnassignR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketUnassignR shr prj tkhid = do
postTicketUnassignR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketUnassignR shr prj ltkhid = do
pid <- requireAuthId
mmsg <- runDB $ do
Entity tid ticket <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity p _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == p) notFound
return $ Entity tid ticket
case ((== pid) <$> ticketAssignee ticket, ticketStatus ticket) of
@ -685,7 +713,7 @@ postTicketUnassignR shr prj tkhid = do
update tid [TicketAssignee =. Nothing]
return Nothing
setMessage $ fromMaybe "The ticket is now unassigned." mmsg
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
-- | The logged-in user gets a list of the ticket claim requests they have
-- opened, in any project.
@ -693,16 +721,17 @@ getClaimRequestsPersonR :: Handler Html
getClaimRequestsPersonR = do
pid <- requireAuthId
rqs <- runDB $ E.select $ E.from $
\ (tcr `E.InnerJoin` ticket `E.InnerJoin` project `E.InnerJoin` sharer) -> do
\ (tcr `E.InnerJoin` ticket `E.InnerJoin` lticket `E.InnerJoin` project `E.InnerJoin` sharer) -> do
E.on $ project E.^. ProjectSharer E.==. sharer E.^. SharerId
E.on $ ticket E.^. TicketProject E.==. project E.^. ProjectId
E.on $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket
E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
E.where_ $ tcr E.^. TicketClaimRequestPerson E.==. E.val pid
E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
return
( sharer E.^. SharerIdent
, project E.^. ProjectIdent
, ticket E.^. TicketId
, lticket E.^. LocalTicketId
, ticket E.^. TicketTitle
, tcr E.^. TicketClaimRequestCreated
)
@ -718,17 +747,19 @@ getClaimRequestsProjectR shr prj = do
E.select $ E.from $
\ ( tcr `E.InnerJoin`
ticket `E.InnerJoin`
lticket `E.InnerJoin`
person `E.InnerJoin`
sharer
) -> do
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
E.on $ tcr E.^. TicketClaimRequestPerson E.==. person E.^. PersonId
E.on $ ticket E.^. TicketId E.==. lticket E.^. LocalTicketTicket
E.on $ tcr E.^. TicketClaimRequestTicket E.==. ticket E.^. TicketId
E.where_ $ ticket E.^. TicketProject E.==. E.val jid
E.orderBy [E.desc $ tcr E.^. TicketClaimRequestCreated]
return
( sharer
, ticket E.^. TicketId
, lticket E.^. LocalTicketId
, ticket E.^. TicketTitle
, tcr E.^. TicketClaimRequestCreated
)
@ -737,13 +768,15 @@ getClaimRequestsProjectR shr prj = do
-- | Get a list of ticket claim requests for a given ticket.
getClaimRequestsTicketR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
getClaimRequestsTicketR shr prj tkhid = do
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getClaimRequestsTicketR shr prj ltkhid = do
rqs <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
E.select $ E.from $ \ (tcr `E.InnerJoin` person `E.InnerJoin` sharer) -> do
E.on $ person E.^. PersonIdent E.==. sharer E.^. SharerId
@ -753,14 +786,15 @@ getClaimRequestsTicketR shr prj tkhid = do
return (sharer, tcr)
defaultLayout $(widgetFile "ticket/claim-request/list")
getClaimRequestNewR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
getClaimRequestNewR shr prj tkhid = do
getClaimRequestNewR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getClaimRequestNewR shr prj ltkhid = do
((_result, widget), etype) <- runFormPost claimRequestForm
defaultLayout $(widgetFile "ticket/claim-request/new")
postClaimRequestsTicketR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postClaimRequestsTicketR shr prj tkhid = do
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postClaimRequestsTicketR shr prj ltkhid = do
((result, widget), etype) <- runFormPost claimRequestForm
case result of
FormSuccess msg -> do
@ -770,8 +804,10 @@ postClaimRequestsTicketR shr prj tkhid = do
tid <- do
Entity s _ <- getBy404 $ UniqueSharer shr
Entity j _ <- getBy404 $ UniqueProject prj s
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == j) notFound
return tid
let cr = TicketClaimRequest
@ -782,7 +818,7 @@ postClaimRequestsTicketR shr prj tkhid = do
}
insert_ cr
setMessage "Ticket claim request opened."
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
FormMissing -> do
setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/claim-request/new")
@ -791,44 +827,41 @@ postClaimRequestsTicketR shr prj tkhid = do
defaultLayout $(widgetFile "ticket/claim-request/new")
selectDiscussionId
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> AppDB DiscussionId
selectDiscussionId shar proj tkhid = do
Entity sid _sharer <- getBy404 $ UniqueSharer shar
Entity pid _project <- getBy404 $ UniqueProject proj sid
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> AppDB DiscussionId
selectDiscussionId shr prj ltkhid = do
Entity sid _sharer <- getBy404 $ UniqueSharer shr
Entity pid _project <- getBy404 $ UniqueProject prj sid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == pid) notFound
lticket <- do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return $ localTicketDiscuss lticket
getTicketDiscussionR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
getTicketDiscussionR shar proj tkhid = do
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketDiscussionR shar proj ltkhid = do
encodeHid <- getEncodeKeyHashid
getDiscussion
(TicketReplyR shar proj tkhid . encodeHid)
(TicketTopReplyR shar proj tkhid)
(selectDiscussionId shar proj tkhid)
(TicketReplyR shar proj ltkhid . encodeHid)
(TicketTopReplyR shar proj ltkhid)
(selectDiscussionId shar proj ltkhid)
postTicketDiscussionR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketDiscussionR shr prj tkhid = do
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketDiscussionR shr prj ltkhid = do
hLocal <- getsYesod $ appInstanceHost . appSettings
postTopReply
hLocal
[ProjectR shr prj]
[ ProjectFollowersR shr prj
, TicketParticipantsR shr prj tkhid
, TicketTeamR shr prj tkhid
, TicketParticipantsR shr prj ltkhid
, TicketTeamR shr prj ltkhid
]
(TicketR shr prj tkhid)
(TicketR shr prj ltkhid)
(ProjectR shr prj)
(TicketDiscussionR shr prj tkhid)
(const $ TicketR shr prj tkhid)
(TicketDiscussionR shr prj ltkhid)
(const $ TicketR shr prj ltkhid)
getMessageR :: ShrIdent -> KeyHashid LocalMessage -> Handler TypedContent
getMessageR shr hid = do
@ -838,10 +871,10 @@ getMessageR shr hid = do
postTicketMessageR
:: ShrIdent
-> PrjIdent
-> KeyHashid Ticket
-> KeyHashid LocalTicket
-> KeyHashid Message
-> Handler Html
postTicketMessageR shr prj tkhid mkhid = do
postTicketMessageR shr prj ltkhid mkhid = do
encodeHid <- getEncodeKeyHashid
mid <- decodeKeyHashid404 mkhid
hLocal <- getsYesod $ appInstanceHost . appSettings
@ -849,33 +882,36 @@ postTicketMessageR shr prj tkhid mkhid = do
hLocal
[ProjectR shr prj]
[ ProjectFollowersR shr prj
, TicketParticipantsR shr prj tkhid
, TicketTeamR shr prj tkhid
, TicketParticipantsR shr prj ltkhid
, TicketTeamR shr prj ltkhid
]
(TicketR shr prj tkhid)
(TicketR shr prj ltkhid)
(ProjectR shr prj)
(TicketReplyR shr prj tkhid . encodeHid)
(TicketMessageR shr prj tkhid . encodeHid)
(const $ TicketR shr prj tkhid)
(selectDiscussionId shr prj tkhid)
(TicketReplyR shr prj ltkhid . encodeHid)
(TicketMessageR shr prj ltkhid . encodeHid)
(const $ TicketR shr prj ltkhid)
(selectDiscussionId shr prj ltkhid)
mid
getTicketTopReplyR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
getTicketTopReplyR shar proj tkhid =
getTopReply $ TicketDiscussionR shar proj tkhid
getTicketTopReplyR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketTopReplyR shr prj ltkhid =
getTopReply $ TicketDiscussionR shr prj ltkhid
getTicketReplyR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> KeyHashid Message -> Handler Html
getTicketReplyR shar proj tkhid hid = do
getTicketReplyR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid Message -> Handler Html
getTicketReplyR shr prj ltkhid mkhid = do
encodeHid <- getEncodeKeyHashid
mid <- decodeKeyHashid404 hid
mid <- decodeKeyHashid404 mkhid
getReply
(TicketReplyR shar proj tkhid . encodeHid)
(TicketMessageR shar proj tkhid . encodeHid)
(selectDiscussionId shar proj tkhid)
(TicketReplyR shr prj ltkhid . encodeHid)
(TicketMessageR shr prj ltkhid . encodeHid)
(selectDiscussionId shr prj ltkhid)
mid
getTicketDeps :: Bool -> ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent
getTicketDeps forward shr prj tkhid = do
getTicketDeps
:: Bool -> ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketDeps forward shr prj ltkhid = do
(deps, rows) <- unzip <$> runDB getDepsFromDB
depsAP <- makeDepsCollection deps
encodeHid <- getEncodeKeyHashid
@ -888,12 +924,15 @@ getTicketDeps forward shr prj tkhid = do
if forward then TicketDependencyChild else TicketDependencyParent
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
fmap (map toRow) $ E.select $ E.from $
\ ( td
`E.InnerJoin` t
`E.InnerJoin` lt
`E.LeftOuterJoin` (tal `E.InnerJoin` p `E.InnerJoin` s)
`E.LeftOuterJoin` (tar `E.InnerJoin` ra `E.InnerJoin` ro `E.InnerJoin` i)
) -> do
@ -904,12 +943,13 @@ getTicketDeps forward shr prj tkhid = do
E.on $ p E.?. PersonIdent E.==. s E.?. SharerId
E.on $ tal E.?. TicketAuthorLocalAuthor E.==. p E.?. PersonId
E.on $ E.just (t E.^. TicketId) E.==. tal E.?. TicketAuthorLocalTicket
E.on $ t E.^. TicketId E.==. lt E.^. LocalTicketTicket
E.on $ td E.^. to' E.==. t E.^. TicketId
E.where_ $ td E.^. from' E.==. E.val tid
E.orderBy [E.asc $ t E.^. TicketId]
return
( td E.^. TicketDependencyId
, t E.^. TicketId
, lt E.^. LocalTicketId
, s
, i
, ro
@ -918,9 +958,9 @@ getTicketDeps forward shr prj tkhid = do
, t E.^. TicketStatus
)
where
toRow (E.Value dep, E.Value tid, ms, mi, mro, mra, E.Value title, E.Value status) =
toRow (E.Value dep, E.Value ltid, ms, mi, mro, mra, E.Value title, E.Value status) =
( dep
, ( tid
, ( ltid
, case (ms, mi, mro, mra) of
(Just s, Nothing, Nothing, Nothing) ->
Left $ entityVal s
@ -937,7 +977,7 @@ getTicketDeps forward shr prj tkhid = do
encodeKeyHashid <- getEncodeKeyHashid
let here =
let route = if forward then TicketDepsR else TicketReverseDepsR
in route shr prj tkhid
in route shr prj ltkhid
return Collection
{ collectionId = encodeRouteLocal here
, collectionType = CollectionTypeUnordered
@ -950,16 +990,19 @@ getTicketDeps forward shr prj tkhid = do
}
getTicketDepsR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketDepsR = getTicketDeps True
postTicketDepsR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
postTicketDepsR shr prj tkhid = do
postTicketDepsR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
postTicketDepsR shr prj ltkhid = do
(jid, tid) <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
return (jid, tid)
((result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
@ -978,7 +1021,7 @@ postTicketDepsR shr prj tkhid = do
insert_ td
trrFix td ticketDepGraph
setMessage "Ticket dependency added."
redirect $ TicketR shr prj tkhid
redirect $ TicketR shr prj ltkhid
FormMissing -> do
setMessage "Field(s) missing."
defaultLayout $(widgetFile "ticket/dep/new")
@ -986,37 +1029,46 @@ postTicketDepsR shr prj tkhid = do
setMessage "Submission failed, see errors below."
defaultLayout $(widgetFile "ticket/dep/new")
getTicketDepNewR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler Html
getTicketDepNewR shr prj tkhid = do
getTicketDepNewR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
getTicketDepNewR shr prj ltkhid = do
(jid, tid) <- runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
ticket <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lticket <- get404 ltid
let tid = localTicketTicket lticket
ticket <- getJust tid
unless (ticketProject ticket == jid) notFound
return (jid, tid)
((_result, widget), enctype) <- runFormPost $ ticketDepForm jid tid
defaultLayout $(widgetFile "ticket/dep/new")
postTicketDepOldR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> KeyHashid Ticket -> Handler Html
postTicketDepOldR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid LocalTicket -> Handler Html
postTicketDepOldR shr prj pnum cnum = do
mmethod <- lookupPostParam "_method"
case mmethod of
Just "DELETE" -> deleteTicketDepOldR shr prj pnum cnum
_ -> notFound
deleteTicketDepOldR :: ShrIdent -> PrjIdent -> KeyHashid Ticket -> KeyHashid Ticket -> Handler Html
deleteTicketDepOldR
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> KeyHashid LocalTicket -> Handler Html
deleteTicketDepOldR shr prj pnum cnum = do
runDB $ do
Entity sid _ <- getBy404 $ UniqueSharer shr
Entity jid _ <- getBy404 $ UniqueProject prj sid
ptid <- decodeKeyHashid404 pnum
pt <- get404 ptid
pltid <- decodeKeyHashid404 pnum
plt <- get404 pltid
let ptid = localTicketTicket plt
pt <- getJust ptid
unless (ticketProject pt == jid) notFound
ctid <- decodeKeyHashid404 cnum
ct <- get404 ctid
cltid <- decodeKeyHashid404 cnum
clt <- get404 cltid
let ctid = localTicketTicket clt
ct <- getJust ctid
unless (ticketProject ct == jid) notFound
Entity tdid _ <- getBy404 $ UniqueTicketDependency ptid ctid
@ -1025,15 +1077,15 @@ deleteTicketDepOldR shr prj pnum cnum = do
redirect $ TicketDepsR shr prj pnum
getTicketReverseDepsR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketReverseDepsR = getTicketDeps False
getTicketDepR :: KeyHashid TicketDependency -> Handler TypedContent
getTicketDepR tdkhid = do
tdid <- decodeKeyHashid404 tdkhid
( td,
(sParent, jParent, tParent),
(sChild, jChild, tChild),
(sParent, jParent, ltParent),
(sChild, jChild, ltChild),
(sAuthor, pAuthor)
) <- runDB $ do
tdep <- get404 tdid
@ -1045,15 +1097,15 @@ getTicketDepR tdkhid = do
encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome
encodeHid <- getEncodeKeyHashid
let ticketRoute s j t =
TicketR (sharerIdent s) (projectIdent j) (encodeHid t)
let ticketRoute s j lt =
TicketR (sharerIdent s) (projectIdent j) (encodeHid lt)
here = TicketDepR tdkhid
tdepAP = AP.TicketDependency
{ ticketDepId = Just $ encodeRouteHome here
, ticketDepParent =
encodeRouteHome $ ticketRoute sParent jParent tParent
encodeRouteHome $ ticketRoute sParent jParent ltParent
, ticketDepChild =
encodeRouteHome $ ticketRoute sChild jChild tChild
encodeRouteHome $ ticketRoute sChild jChild ltChild
, ticketDepAttributedTo =
encodeRouteLocal $ SharerR $ sharerIdent sAuthor
, ticketDepPublished = Just $ ticketDependencyCreated td
@ -1065,40 +1117,44 @@ getTicketDepR tdkhid = do
where
getTicket tid = do
t <- getJust tid
ltid <- do
mltid <- getKeyBy $ UniqueLocalTicket tid
case mltid of
Nothing -> error "No LocalTicket"
Just ltid -> return ltid
j <- getJust $ ticketProject t
s <- getJust $ projectSharer j
return (s, j, tid)
return (s, j, ltid)
getAuthor pid = do
p <- getJust pid
s <- getJust $ personIdent p
return (s, p)
getTicketParticipantsR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent
getTicketParticipantsR shr prj tkhid = getFollowersCollection here getFsid
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketParticipantsR shr prj ltkhid = getFollowersCollection here getFsid
where
here = TicketParticipantsR shr prj tkhid
here = TicketParticipantsR shr prj ltkhid
getFsid = do
sid <- getKeyBy404 $ UniqueSharer shr
jid <- getKeyBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
t <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid
let tid = localTicketTicket lt
t <- getJust tid
unless (ticketProject t == jid) notFound
lt <- do
mlt <- getValBy $ UniqueLocalTicket tid
case mlt of
Nothing -> error "No LocalTicket"
Just lt -> return lt
return $ localTicketFollowers lt
getTicketTeamR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent
getTicketTeamR shr prj tkhid = do
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketTeamR shr prj ltkhid = do
memberShrs <- runDB $ do
sid <- getKeyBy404 $ UniqueSharer shr
jid <- getKeyBy404 $ UniqueProject prj sid
tid <- decodeKeyHashid404 tkhid
t <- get404 tid
ltid <- decodeKeyHashid404 ltkhid
lt <- get404 ltid
let tid = localTicketTicket lt
t <- getJust tid
unless (ticketProject t == jid) notFound
id_ <-
requireEitherAlt
@ -1118,7 +1174,7 @@ getTicketTeamR shr prj tkhid = do
map (sharerIdent . entityVal) <$>
selectList [SharerId <-. sids] []
let here = TicketTeamR shr prj tkhid
let here = TicketTeamR shr prj ltkhid
encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome
@ -1134,5 +1190,5 @@ getTicketTeamR shr prj tkhid = do
provideHtmlAndAP team $ redirectToPrettyJSON here
getTicketEventsR
:: ShrIdent -> PrjIdent -> KeyHashid Ticket -> Handler TypedContent
getTicketEventsR _shr _prj _tkhid = error "TODO not implemented"
:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler TypedContent
getTicketEventsR _shr _prj _ltkhid = error "TODO not implemented"

View file

@ -81,6 +81,7 @@ getTicketSummaries mfilt morder offlim jid = do
limit $ fromIntegral lim
return
( t ^. TicketId
, lt ^. LocalTicketId
, s
, i
, ro
@ -91,13 +92,13 @@ getTicketSummaries mfilt morder offlim jid = do
, count $ m ?. MessageId
)
for tickets $
\ (Value tid, ms, mi, mro, mra, Value c, Value t, Value d, Value r) -> do
\ (Value tid, Value ltid, ms, mi, mro, mra, Value c, Value t, Value d, Value r) -> do
labels <- select $ from $ \ (tpc `InnerJoin` wf) -> do
on $ tpc ^. TicketParamClassField ==. wf ^. WorkflowFieldId
where_ $ tpc ^. TicketParamClassTicket ==. val tid
return wf
return TicketSummary
{ tsId = tid
{ tsId = ltid
, tsCreatedBy =
case (ms, mi, mro, mra) of
(Just s, Nothing, Nothing, Nothing) ->

View file

@ -52,7 +52,7 @@ import Vervis.Time (showDate)
import Vervis.Widget.Sharer
data TicketSummary = TicketSummary
{ tsId :: TicketId
{ tsId :: LocalTicketId
, tsCreatedBy :: Either Sharer (Instance, RemoteObject, RemoteActor)
, tsCreatedAt :: UTCTime
, tsTitle :: Text
@ -61,8 +61,8 @@ data TicketSummary = TicketSummary
, tsComments :: Int
}
ticketDepW :: ShrIdent -> PrjIdent -> Entity Ticket -> Widget
ticketDepW shr prj (Entity tid ticket) = do
ticketDepW :: ShrIdent -> PrjIdent -> LocalTicketId -> Ticket -> Widget
ticketDepW shr prj ltid ticket = do
encodeTicketKey <- getEncodeKeyHashid
cNew <- newIdent
cTodo <- newIdent

View file

@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
<form method=POST action=@{TicketAssignR shr prj tkhid} enctype=#{enctype}>
<form method=POST action=@{TicketAssignR shr prj ltkhid} enctype=#{enctype}>
^{widget}
<div class="submit">
<input type="submit">

View file

@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
<form method=POST action=@{ClaimRequestsTicketR shr prj tkhid} enctype=#{etype}>
<form method=POST action=@{ClaimRequestsTicketR shr prj ltkhid} enctype=#{etype}>
^{widget}
<div class="submit">
<input type="submit">

View file

@ -32,9 +32,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
#{show status}
$if forward
<td>
^{buttonW DELETE "Remove" (TicketDepOldR shr prj tkhid $ encodeHid tid)}
^{buttonW DELETE "Remove" (TicketDepOldR shr prj ltkhid $ encodeHid tid)}
$if forward
<p>
<a href=@{TicketDepNewR shr prj tkhid}>
<a href=@{TicketDepNewR shr prj ltkhid}>
Add new…

View file

@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
<form method=POST action=@{TicketDepsR shr prj tkhid} enctype=#{enctype}>
<form method=POST action=@{TicketDepsR shr prj ltkhid} enctype=#{enctype}>
^{widget}
<div class="submit">
<input type="submit">

View file

@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along
$# with this software. If not, see
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
<form method=POST action=@{TicketR shr prj tkhid} enctype=#{enctype}>
<form method=POST action=@{TicketR shr prj ltkhid} enctype=#{enctype}>
<input type=hidden name=_method value=PUT>
^{widget}
<div class="submit">

View file

@ -20,19 +20,19 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<div>
<span>
<a href=@{TicketParticipantsR shar proj khid}>
<a href=@{TicketParticipantsR shar proj ltkhid}>
[🐤 Followers]
<span>
<a href=@{TicketDepsR shar proj khid}>
<a href=@{TicketDepsR shar proj ltkhid}>
[⤴ Dependencies]
<span>
<a href=@{TicketReverseDepsR shar proj khid}>
<a href=@{TicketReverseDepsR shar proj ltkhid}>
[⤷ Dependants]
<span>
<a href=@{ClaimRequestsTicketR shar proj khid}>
<a href=@{ClaimRequestsTicketR shar proj ltkhid}>
[✋ Claim requests]
<span>
<a href=@{TicketEditR shar proj khid}>
<a href=@{TicketEditR shar proj ltkhid}>
[✏ Edit]
^{followButton}
@ -44,9 +44,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
$if null rdeps
<li>(none)
$else
$forall et <- rdeps
$forall (E.Value ltid, Entity _ t) <- rdeps
<li>
^{ticketDepW shar proj et}
^{ticketDepW shar proj ltid t}
<p>
Depends on:
@ -55,9 +55,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
$if null deps
<li>(none)
$else
$forall et <- deps
$forall (E.Value ltid, Entity _ t) <- deps
<li>
^{ticketDepW shar proj et}
^{ticketDepW shar proj ltid t}
<div>^{desc}
@ -67,23 +67,23 @@ $if ticketStatus ticket /= TSClosed
$if me
Assigned to you.
^{buttonW POST "Unclaim this ticket" (TicketUnclaimR shar proj khid)}
^{buttonW POST "Unclaim this ticket" (TicketUnclaimR shar proj ltkhid)}
$else
Assigned to ^{sharerLinkW assignee}.
^{buttonW POST "Unassign this ticket" (TicketUnassignR shar proj khid)}
^{buttonW POST "Unassign this ticket" (TicketUnassignR shar proj ltkhid)}
$nothing
Not assigned.
<a href=@{ClaimRequestNewR shar proj khid}>Ask to have it assigned to you
<a href=@{ClaimRequestNewR shar proj ltkhid}>Ask to have it assigned to you
or
^{buttonW POST "Claim this ticket" (TicketClaimR shar proj khid)}
^{buttonW POST "Claim this ticket" (TicketClaimR shar proj ltkhid)}
or
<a href=@{TicketAssignR shar proj khid}>Assign to someone else
<a href=@{TicketAssignR shar proj ltkhid}>Assign to someone else
.
<p>
@ -92,18 +92,18 @@ $if ticketStatus ticket /= TSClosed
$of TSNew
Open, new.
^{buttonW POST "Accept this ticket" (TicketAcceptR shar proj khid)}
^{buttonW POST "Close this ticket" (TicketCloseR shar proj khid)}
^{buttonW POST "Accept this ticket" (TicketAcceptR shar proj ltkhid)}
^{buttonW POST "Close this ticket" (TicketCloseR shar proj ltkhid)}
$of TSTodo
Open, to do.
^{buttonW POST "Close this ticket" (TicketCloseR shar proj khid)}
^{buttonW POST "Close this ticket" (TicketCloseR shar proj ltkhid)}
$of TSClosed
Closed on #{showDate $ ticketClosed ticket}
$maybe closer <- mcloser
by ^{sharerLinkW closer}.
^{buttonW POST "Reopen this ticket" (TicketOpenR shar proj khid)}
^{buttonW POST "Reopen this ticket" (TicketOpenR shar proj ltkhid)}
<h3>Custom fields
@ -145,7 +145,7 @@ $if ticketStatus ticket /= TSClosed
No
<p>
^{buttonW DELETE "Delete this ticket" (TicketR shar proj khid)}
^{buttonW DELETE "Delete this ticket" (TicketR shar proj ltkhid)}
<h3>Discussion

View file

@ -22,5 +22,5 @@ $case ticketStatus ticket
$of TSClosed
<span .#{cClosed}>
<a href=@{TicketR shr prj $ encodeTicketKey tid}>
<a href=@{TicketR shr prj $ encodeTicketKey ltid}>
#{ticketTitle ticket}