NOTE: Federation is disabled on this instance!
You can test federation between the following instances:forge.angeley.es
code.angeley.es
By | fr33domlover |
At | 2020-08-05 |
Title | Client: Add forms for resolving and unresolving a ticket/MR |
Description |
Edit file src/Vervis/Client.hs 0 → 0
- | 486 | -> WorkItem |
|
+ | 486 | -> FedURI |
|
- | 488 | unresolve shrUser wi = runExceptT $ do |
|
+ | 488 | unresolve shrUser uTicket = runExceptT $ do |
|
- | 491 | WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Object" $ Left wi |
|
- | 492 | ltid <- |
|
+ | 491 | ticket <- parseWorkItem "Ticket" uTicket |
|
+ | 492 | WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Ticket" ticket |
|
+ | 493 | uResolve <- |
|
- | 495 | Left (_, ltid) -> return ltid |
|
- | 496 | Right _ -> error "Local WorkItem expected!" |
|
- | 497 | uResolve <- runSiteDBExcept $ do |
|
- | 498 | mtrid <- lift $ getKeyBy $ UniqueTicketResolve ltid |
|
- | 499 | trid <- fromMaybeE mtrid "Ticket already isn't resolved" |
|
- | 500 | trx <- |
|
- | 501 | lift $ |
|
- | 502 | requireEitherAlt |
|
- | 503 | (getValBy $ UniqueTicketResolveLocal trid) |
|
- | 504 | (getValBy $ UniqueTicketResolveRemote trid) |
|
- | 505 | "No TRX" |
|
- | 506 | "Both TRL and TRR" |
|
- | 507 | case trx of |
|
- | 508 | Left trl -> lift $ do |
|
- | 509 | let obiid = ticketResolveLocalActivity trl |
|
- | 510 | obid <- outboxItemOutbox <$> getJust obiid |
|
- | 511 | ent <- getOutboxActorEntity obid |
|
- | 512 | obikhid <- encodeKeyHashid obiid |
|
- | 513 | encodeRouteHome . flip outboxItemRoute obikhid <$> |
|
- | 514 | actorEntityPath ent |
|
- | 515 | Right trr -> lift $ do |
|
- | 516 | roid <- |
|
- | 517 | remoteActivityIdent <$> |
|
- | 518 | getJust (ticketResolveRemoteActivity trr) |
|
- | 519 | ro <- getJust roid |
|
- | 520 | i <- getJust $ remoteObjectInstance ro |
|
- | 521 | return $ ObjURI (instanceHost i) (remoteObjectIdent ro) |
|
+ | 496 | Left (_, ltid) -> runSiteDBExcept $ do |
|
+ | 497 | mtrid <- lift $ getKeyBy $ UniqueTicketResolve ltid |
|
+ | 498 | trid <- fromMaybeE mtrid "Ticket already isn't resolved" |
|
+ | 499 | trx <- |
|
+ | 500 | lift $ |
|
+ | 501 | requireEitherAlt |
|
+ | 502 | (getValBy $ UniqueTicketResolveLocal trid) |
|
+ | 503 | (getValBy $ UniqueTicketResolveRemote trid) |
|
+ | 504 | "No TRX" |
|
+ | 505 | "Both TRL and TRR" |
|
+ | 506 | case trx of |
|
+ | 507 | Left trl -> lift $ do |
|
+ | 508 | let obiid = ticketResolveLocalActivity trl |
|
+ | 509 | obid <- outboxItemOutbox <$> getJust obiid |
|
+ | 510 | ent <- getOutboxActorEntity obid |
|
+ | 511 | obikhid <- encodeKeyHashid obiid |
|
+ | 512 | encodeRouteHome . flip outboxItemRoute obikhid <$> |
|
+ | 513 | actorEntityPath ent |
|
+ | 514 | Right trr -> lift $ do |
|
+ | 515 | roid <- |
|
+ | 516 | remoteActivityIdent <$> |
|
+ | 517 | getJust (ticketResolveRemoteActivity trr) |
|
+ | 518 | ro <- getJust roid |
|
+ | 519 | i <- getJust $ remoteObjectInstance ro |
|
+ | 520 | return $ ObjURI (instanceHost i) (remoteObjectIdent ro) |
|
+ | 521 | Right (u, _) -> do |
|
+ | 522 | manager <- asksSite appHttpManager |
|
+ | 523 | Doc _ t <- withExceptT T.pack $ AP.fetchAP manager $ Left u |
|
+ | 524 | case ticketResolved t of |
|
+ | 525 | Nothing -> throwE "Ticket already isn't resolved" |
|
+ | 526 | Just (muBy, _) -> fromMaybeE muBy "Ticket doesn't specify 'resolvedBy'" |
|
- | 532 | audTicketFollowers = AudLocal [] [wiFollowers wi] |
|
+ | 537 | audTicketFollowers = |
|
+ | 538 | case ident of |
|
+ | 539 | Left (wi, _ltid) -> AudLocal [] [wiFollowers wi] |
|
+ | 540 | Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers] |
|
… | … | … | … |
Edit file src/Vervis/Handler/Client.hs 0 → 0
+ | 214 | resolveForm :: Form FedURI |
|
+ | 215 | resolveForm = renderDivs $ areq fedUriField "Ticket" (Just deft) |
|
+ | 216 | where |
|
+ | 217 | deft = ObjURI (Authority "forge.angeley.es" Nothing) $ LocalURI "/s/fr33/p/sandbox/t/20YNl" |
|
+ | 218 | ||
+ | 219 | unresolveForm :: Form FedURI |
|
+ | 220 | unresolveForm = renderDivs $ areq fedUriField "Ticket" (Just deft) |
|
+ | 221 | where |
|
+ | 222 | deft = ObjURI (Authority "forge.angeley.es" Nothing) $ LocalURI "/s/fr33/p/sandbox/t/20YNl" |
|
+ | 223 | ||
… | … | … | … |
+ | 239 | -> Widget -> Enctype |
|
+ | 240 | -> Widget -> Enctype |
|
- | 233 | widget1 enctype1 widget2 enctype2 widget3 enctype3 widget4 enctype4 = |
|
+ | 245 | widget1 enctype1 |
|
+ | 246 | widget2 enctype2 |
|
+ | 247 | widget3 enctype3 |
|
+ | 248 | widget4 enctype4 |
|
+ | 249 | widget5 enctype5 |
|
+ | 250 | widget6 enctype6 = |
|
… | … | … | … |
+ | 276 | ||
+ | 277 | <h1>Resolve a ticket / MR |
|
+ | 278 | <form method=POST action=@{PublishR} enctype=#{enctype5}> |
|
+ | 279 | ^{widget5} |
|
+ | 280 | <input type=submit> |
|
+ | 281 | ||
+ | 282 | <h1>Unresolve a ticket / MR |
|
+ | 283 | <form method=POST action=@{PublishR} enctype=#{enctype6}> |
|
+ | 284 | ^{widget6} |
|
+ | 285 | <input type=submit> |
|
… | … | … | … |
+ | 323 | ((_result5, widget5), enctype5) <- |
|
+ | 324 | runFormPost $ identifyForm "f5" resolveForm |
|
+ | 325 | ((_result6, widget6), enctype6) <- |
|
+ | 326 | runFormPost $ identifyForm "f6" unresolveForm |
|
- | 302 | widget1 enctype1 widget2 enctype2 widget3 enctype3 widget4 enctype4 |
|
+ | 333 | widget1 enctype1 |
|
+ | 334 | widget2 enctype2 |
|
+ | 335 | widget3 enctype3 |
|
+ | 336 | widget4 enctype4 |
|
+ | 337 | widget5 enctype5 |
|
+ | 338 | widget6 enctype6 |
|
… | … | … | … |
+ | 395 | data Result |
|
+ | 396 | = ResultPublishComment ((Host, ShrIdent, PrjIdent, KeyHashid LocalTicket), Maybe FedURI, Text) |
|
+ | 397 | | ResultCreateTicket (FedURI, FedURI, TextHtml, TextPandocMarkdown) |
|
+ | 398 | | ResultOfferTicket ((Host, ShrIdent, PrjIdent), TextHtml, TextPandocMarkdown) |
|
+ | 399 | | ResultFollow (FedURI, FedURI) |
|
+ | 400 | | ResultResolve FedURI |
|
+ | 401 | | ResultUnresolve FedURI |
|
+ | 402 | ||
… | … | … | … |
+ | 424 | ((result5, widget5), enctype5) <- |
|
+ | 425 | runFormPost $ identifyForm "f5" resolveForm |
|
+ | 426 | ((result6, widget6), enctype6) <- |
|
+ | 427 | runFormPost $ identifyForm "f6" unresolveForm |
|
- | 385 | = Left . Left <$> result1 |
|
- | 386 | <|> Left . Right <$> result2 |
|
- | 387 | <|> Right . Left <$> result3 |
|
- | 388 | <|> Right . Right <$> result4 |
|
+ | 433 | = ResultPublishComment <$> result1 |
|
+ | 434 | <|> ResultCreateTicket <$> result2 |
|
+ | 435 | <|> ResultOfferTicket <$> result3 |
|
+ | 436 | <|> ResultFollow <$> result4 |
|
+ | 437 | <|> ResultResolve <$> result5 |
|
+ | 438 | <|> ResultUnresolve <$> result6 |
|
… | … | … | … |
- | 402 | bitraverse (bitraverse (publishComment ep s) (publishTicket ep s)) (bitraverse (openTicket ep s) (follow shrAuthor)) input |
|
+ | 452 | case input of |
|
+ | 453 | ResultPublishComment v -> publishComment ep s v |
|
+ | 454 | ResultCreateTicket v -> publishTicket ep s v |
|
+ | 455 | ResultOfferTicket v -> openTicket ep s v |
|
+ | 456 | ResultFollow v -> follow shrAuthor v |
|
+ | 457 | ResultResolve u -> do |
|
+ | 458 | (summary, audience, specific) <- ExceptT $ resolve shrAuthor u |
|
+ | 459 | resolveC ep s summary audience specific |
|
+ | 460 | ResultUnresolve u -> do |
|
+ | 461 | (summary, audience, specific) <- ExceptT $ unresolve shrAuthor u |
|
+ | 462 | undoC ep s summary audience specific |
|
… | … | … | … |
- | 415 | Right id_ -> |
|
- | 416 | case id_ of |
|
- | 417 | Left (Left obiid) -> do |
|
- | 418 | mlmid <- runDB $ getKeyBy $ UniqueLocalMessageCreate obiid |
|
- | 419 | case mlmid of |
|
- | 420 | Nothing -> error "noteC succeeded but no lmid found for obiid" |
|
- | 421 | Just lmid -> do |
|
- | 422 | lmkhid <- encodeKeyHashid lmid |
|
- | 423 | renderUrl <- getUrlRender |
|
- | 424 | let u = renderUrl $ MessageR shrAuthor lmkhid |
|
- | 425 | setMessage $ toHtml $ "Message created! ID: " <> u |
|
- | 426 | Left (Right obiid) -> do |
|
- | 427 | mtalid <- runDB $ getKeyBy $ UniqueTicketAuthorLocalOpen obiid |
|
- | 428 | case mtalid of |
|
- | 429 | Nothing -> error "createTicketC succeeded but no talid found for obiid" |
|
- | 430 | Just talid -> do |
|
- | 431 | talkhid <- encodeKeyHashid talid |
|
- | 432 | renderUrl <- getUrlRender |
|
- | 433 | let u = renderUrl $ SharerTicketR shrAuthor talkhid |
|
- | 434 | setMessage $ toHtml $ "Ticket created! ID: " <> u |
|
- | 435 | Right (Left _obiid) -> |
|
- | 436 | setMessage "Ticket offer published!" |
|
- | 437 | Right (Right _obiid) -> |
|
- | 438 | setMessage "Follow request published!" |
|
+ | 475 | Right _obiid -> setMessage "Activity published" |
|
+ | 459 | widget5 enctype5 |
|
+ | 460 | widget6 enctype6 |
|
… | … | … | … |
+ | 951 | encodeRouteHome <- getEncodeRouteHome |
|
- | 914 | ltid <- decodeKeyHashid404 ltkhid |
|
+ | 954 | let uTicket = encodeRouteHome $ ProjectTicketR shr prj ltkhid |
|
- | 917 | (summary, audience, specific) <- ExceptT $ unresolve (sharerIdent s) (WorkItemProjectTicket shr prj ltid) |
|
+ | 957 | (summary, audience, specific) <- ExceptT $ unresolve (sharerIdent s) uTicket |
|
… | … | … | … |