diff --git a/src/Vervis/Client.hs b/src/Vervis/Client.hs index 727cfd9..1e80c76 100644 --- a/src/Vervis/Client.hs +++ b/src/Vervis/Client.hs @@ -483,48 +483,56 @@ undoFollowRepo shrAuthor pidAuthor shrFollowee rpFollowee = unresolve :: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App) => ShrIdent - -> WorkItem + -> FedURI -> m (Either Text (Maybe TextHtml, Audience URIMode, Undo URIMode)) -unresolve shrUser wi = runExceptT $ do +unresolve shrUser uTicket = runExceptT $ do encodeRouteHome <- getEncodeRouteHome wiFollowers <- askWorkItemFollowers - WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Object" $ Left wi - ltid <- + ticket <- parseWorkItem "Ticket" uTicket + WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Ticket" ticket + uResolve <- case ident of - Left (_, ltid) -> return ltid - Right _ -> error "Local WorkItem expected!" - uResolve <- runSiteDBExcept $ do - mtrid <- lift $ getKeyBy $ UniqueTicketResolve ltid - trid <- fromMaybeE mtrid "Ticket already isn't resolved" - trx <- - lift $ - requireEitherAlt - (getValBy $ UniqueTicketResolveLocal trid) - (getValBy $ UniqueTicketResolveRemote trid) - "No TRX" - "Both TRL and TRR" - case trx of - Left trl -> lift $ do - let obiid = ticketResolveLocalActivity trl - obid <- outboxItemOutbox <$> getJust obiid - ent <- getOutboxActorEntity obid - obikhid <- encodeKeyHashid obiid - encodeRouteHome . flip outboxItemRoute obikhid <$> - actorEntityPath ent - Right trr -> lift $ do - roid <- - remoteActivityIdent <$> - getJust (ticketResolveRemoteActivity trr) - ro <- getJust roid - i <- getJust $ remoteObjectInstance ro - return $ ObjURI (instanceHost i) (remoteObjectIdent ro) + Left (_, ltid) -> runSiteDBExcept $ do + mtrid <- lift $ getKeyBy $ UniqueTicketResolve ltid + trid <- fromMaybeE mtrid "Ticket already isn't resolved" + trx <- + lift $ + requireEitherAlt + (getValBy $ UniqueTicketResolveLocal trid) + (getValBy $ UniqueTicketResolveRemote trid) + "No TRX" + "Both TRL and TRR" + case trx of + Left trl -> lift $ do + let obiid = ticketResolveLocalActivity trl + obid <- outboxItemOutbox <$> getJust obiid + ent <- getOutboxActorEntity obid + obikhid <- encodeKeyHashid obiid + encodeRouteHome . flip outboxItemRoute obikhid <$> + actorEntityPath ent + Right trr -> lift $ do + roid <- + remoteActivityIdent <$> + getJust (ticketResolveRemoteActivity trr) + ro <- getJust roid + i <- getJust $ remoteObjectInstance ro + return $ ObjURI (instanceHost i) (remoteObjectIdent ro) + Right (u, _) -> do + manager <- asksSite appHttpManager + Doc _ t <- withExceptT T.pack $ AP.fetchAP manager $ Left u + case ticketResolved t of + Nothing -> throwE "Ticket already isn't resolved" + Just (muBy, _) -> fromMaybeE muBy "Ticket doesn't specify 'resolvedBy'" let audAuthor = AudLocal [LocalActorSharer shrUser] [LocalPersonCollectionSharerFollowers shrUser] audTicketContext = contextAudience context audTicketAuthor = authorAudience author - audTicketFollowers = AudLocal [] [wiFollowers wi] + audTicketFollowers = + case ident of + Left (wi, _ltid) -> AudLocal [] [wiFollowers wi] + Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers] (_, _, _, audLocal, audRemote) = collectAudience $ diff --git a/src/Vervis/Handler/Client.hs b/src/Vervis/Handler/Client.hs index cb2be74..8282364 100644 --- a/src/Vervis/Handler/Client.hs +++ b/src/Vervis/Handler/Client.hs @@ -211,14 +211,31 @@ followForm = renderDivs $ (,) where deft = ObjURI (Authority "forge.angeley.es" Nothing) $ LocalURI "/s/fr33" +resolveForm :: Form FedURI +resolveForm = renderDivs $ areq fedUriField "Ticket" (Just deft) + where + deft = ObjURI (Authority "forge.angeley.es" Nothing) $ LocalURI "/s/fr33/p/sandbox/t/20YNl" + +unresolveForm :: Form FedURI +unresolveForm = renderDivs $ areq fedUriField "Ticket" (Just deft) + where + deft = ObjURI (Authority "forge.angeley.es" Nothing) $ LocalURI "/s/fr33/p/sandbox/t/20YNl" + activityWidget :: Widget -> Enctype -> Widget -> Enctype -> Widget -> Enctype -> Widget -> Enctype + -> Widget -> Enctype + -> Widget -> Enctype -> Widget activityWidget - widget1 enctype1 widget2 enctype2 widget3 enctype3 widget4 enctype4 = + widget1 enctype1 + widget2 enctype2 + widget3 enctype3 + widget4 enctype4 + widget5 enctype5 + widget6 enctype6 = [whamlet|