diff --git a/config/routes b/config/routes index 37ab203..e44dc77 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/src/Vervis/API.hs b/src/Vervis/API.hs index 7e34530..ef5b488 100644 --- a/src/Vervis/API.hs +++ b/src/Vervis/API.hs @@ -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 ./s/#{shr2text shrProject}/p/#{prj2text prjProject} : # - + #{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 diff --git a/src/Vervis/ActivityPub.hs b/src/Vervis/ActivityPub.hs index 7d01c4d..d759e16 100644 --- a/src/Vervis/ActivityPub.hs +++ b/src/Vervis/ActivityPub.hs @@ -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 diff --git a/src/Vervis/ActivityPub/Recipient.hs b/src/Vervis/ActivityPub/Recipient.hs index 082ef8a..e02a70c 100644 --- a/src/Vervis/ActivityPub/Recipient.hs +++ b/src/Vervis/ActivityPub/Recipient.hs @@ -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 diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index b087d74..3680d78 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -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 diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index effacc8..1c6552f 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -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" diff --git a/src/Vervis/Federation/Discussion.hs b/src/Vervis/Federation/Discussion.hs index 0b73fd2..070f476 100644 --- a/src/Vervis/Federation/Discussion.hs +++ b/src/Vervis/Federation/Discussion.hs @@ -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 diff --git a/src/Vervis/Federation/Offer.hs b/src/Vervis/Federation/Offer.hs index 75376bb..0642677 100644 --- a/src/Vervis/Federation/Offer.hs +++ b/src/Vervis/Federation/Offer.hs @@ -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 diff --git a/src/Vervis/Federation/Ticket.hs b/src/Vervis/Federation/Ticket.hs index d084d21..26a77a3 100644 --- a/src/Vervis/Federation/Ticket.hs +++ b/src/Vervis/Federation/Ticket.hs @@ -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 ./s/#{shr2text shrRecip}/p/#{prj2text prjRecip} \: # - + #{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] diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index d532083..60073c6 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -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 diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index 5cb8369..cad9cd7 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -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 diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index fd9add3..eba7b72 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -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) diff --git a/src/Vervis/Handler/Sharer.hs b/src/Vervis/Handler/Sharer.hs index 0d1fddb..e1a7217 100644 --- a/src/Vervis/Handler/Sharer.hs +++ b/src/Vervis/Handler/Sharer.hs @@ -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) diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index c9a6415..a78455f 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -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 isn’t accepted yet. Can’t assign it." (TSClosed, _) -> msg "The ticket is closed. Can’t 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 isn’t accepted yet. Can’t assign it." (TSClosed, _) -> msg "The ticket is closed. Can’t 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" diff --git a/src/Vervis/Ticket.hs b/src/Vervis/Ticket.hs index d7d0557..ab7ce8d 100644 --- a/src/Vervis/Ticket.hs +++ b/src/Vervis/Ticket.hs @@ -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) -> diff --git a/src/Vervis/Widget/Ticket.hs b/src/Vervis/Widget/Ticket.hs index 5b1f82e..4d177ff 100644 --- a/src/Vervis/Widget/Ticket.hs +++ b/src/Vervis/Widget/Ticket.hs @@ -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 diff --git a/templates/ticket/assign.hamlet b/templates/ticket/assign.hamlet index 466db7b..959488c 100644 --- a/templates/ticket/assign.hamlet +++ b/templates/ticket/assign.hamlet @@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . -
+ ^{widget}
diff --git a/templates/ticket/claim-request/new.hamlet b/templates/ticket/claim-request/new.hamlet index 98808ae..cec19cf 100644 --- a/templates/ticket/claim-request/new.hamlet +++ b/templates/ticket/claim-request/new.hamlet @@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . - + ^{widget}
diff --git a/templates/ticket/dep/list.hamlet b/templates/ticket/dep/list.hamlet index 563b40f..5dc7060 100644 --- a/templates/ticket/dep/list.hamlet +++ b/templates/ticket/dep/list.hamlet @@ -32,9 +32,9 @@ $# . #{show status} $if forward - ^{buttonW DELETE "Remove" (TicketDepOldR shr prj tkhid $ encodeHid tid)} + ^{buttonW DELETE "Remove" (TicketDepOldR shr prj ltkhid $ encodeHid tid)} $if forward

- + Add new… diff --git a/templates/ticket/dep/new.hamlet b/templates/ticket/dep/new.hamlet index ccaa5bc..0bbd955 100644 --- a/templates/ticket/dep/new.hamlet +++ b/templates/ticket/dep/new.hamlet @@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . - + ^{widget}

diff --git a/templates/ticket/edit.hamlet b/templates/ticket/edit.hamlet index c9c8647..8b3b683 100644 --- a/templates/ticket/edit.hamlet +++ b/templates/ticket/edit.hamlet @@ -12,7 +12,7 @@ $# You should have received a copy of the CC0 Public Domain Dedication along $# with this software. If not, see $# . - + ^{widget}
diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet index d5be006..7c5c009 100644 --- a/templates/ticket/one.hamlet +++ b/templates/ticket/one.hamlet @@ -20,19 +20,19 @@ $# .
- + [🐤 Followers] - + [⤴ Dependencies] - + [⤷ Dependants] - + [✋ Claim requests] - + [✏ Edit] ^{followButton} @@ -44,9 +44,9 @@ $# . $if null rdeps
  • (none) $else - $forall et <- rdeps + $forall (E.Value ltid, Entity _ t) <- rdeps
  • - ^{ticketDepW shar proj et} + ^{ticketDepW shar proj ltid t}

    Depends on: @@ -55,9 +55,9 @@ $# . $if null deps

  • (none) $else - $forall et <- deps + $forall (E.Value ltid, Entity _ t) <- deps
  • - ^{ticketDepW shar proj et} + ^{ticketDepW shar proj ltid t}
    ^{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. - Ask to have it assigned to you + 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 - Assign to someone else + Assign to someone else .

    @@ -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)}

    Custom fields @@ -145,7 +145,7 @@ $if ticketStatus ticket /= TSClosed No

    - ^{buttonW DELETE "Delete this ticket" (TicketR shar proj khid)} + ^{buttonW DELETE "Delete this ticket" (TicketR shar proj ltkhid)}

    Discussion diff --git a/templates/ticket/widget/dep.hamlet b/templates/ticket/widget/dep.hamlet index 2921dcb..d3c4d24 100644 --- a/templates/ticket/widget/dep.hamlet +++ b/templates/ticket/widget/dep.hamlet @@ -22,5 +22,5 @@ $case ticketStatus ticket $of TSClosed ☒ - + #{ticketTitle ticket}