NOTE: Federation is disabled on this instance!

• forge.angeley.es
• code.angeley.es

• Edit file config/models 0 → 0

  -	371		closed UTCTime
  -	372		closer PersonId Maybe
  …	…	…	…

• Edit file src/Vervis/API.hs 0 → 0

  +		23	, resolveC
  …	…	…	…
  -	859		, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
  -	860		, ticketCloser = Nothing
  …	…	…	…
  -	1516		, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
  -	1517		, ticketCloser = Nothing
  …	…	…	…
  +		1582	verifyHosterRecip _ _ (Right _) = return ()
  +		1583	verifyHosterRecip localRecips name (Left wi) =
  +		1584	fromMaybeE (verify wi) $
  +		1585	name <> " ticket hoster actor isn't listed as a recipient"
  +		1586	where
  +		1587	verify (WorkItemSharerTicket shr _ _) = do
  +		1588	sharerSet <- lookup shr localRecips
  +		1589	guard $ localRecipSharer $ localRecipSharerDirect sharerSet
  +		1590	verify (WorkItemProjectTicket shr prj _) = do
  +		1591	sharerSet <- lookup shr localRecips
  +		1592	projectSet <- lookup prj $ localRecipProjectRelated sharerSet
  +		1593	guard $ localRecipProject $ localRecipProjectDirect projectSet
  +		1594	verify (WorkItemRepoPatch shr rp _) = do
  +		1595	sharerSet <- lookup shr localRecips
  +		1596	repoSet <- lookup rp $ localRecipRepoRelated sharerSet
  +		1597	guard $ localRecipRepo $ localRecipRepoDirect repoSet
  +		1598
  +		1599	workItemRecipSieve wiFollowers (WorkItemDetail ident context author) =
  +		1600	let authorC =
  +		1601	case author of
  +		1602	Left shr -> [LocalPersonCollectionSharerFollowers shr]
  +		1603	Right _ -> []
  +		1604	ticketC =
  +		1605	case ident of
  +		1606	Left (wi, _) -> [wiFollowers wi]
  +		1607	Right _ -> []
  +		1608	(contextA, contextC) =
  +		1609	case context of
  +		1610	Left local ->
  +		1611	case local of
  +		1612	Left (shr, prj) ->
  +		1613	( [LocalActorProject shr prj]
  +		1614	, [ LocalPersonCollectionProjectTeam shr prj
  +		1615	, LocalPersonCollectionProjectFollowers shr prj
  +		1616	]
  +		1617	)
  +		1618	Right (shr, rp) ->
  +		1619	( [LocalActorRepo shr rp]
  +		1620	, [ LocalPersonCollectionRepoTeam shr rp
  +		1621	, LocalPersonCollectionRepoFollowers shr rp
  +		1622	]
  +		1623	)
  +		1624	Right _ -> ([], [])
  +		1625	in (contextA, authorC ++ ticketC ++ contextC)
  +		1626
  +		1627	workItemActor (WorkItemSharerTicket shr _ _) = LocalActorSharer shr
  +		1628	workItemActor (WorkItemProjectTicket shr prj _) = LocalActorProject shr prj
  +		1629	workItemActor (WorkItemRepoPatch shr rp _) = LocalActorRepo shr rp
  +		1630
  +		1631	actorOutboxItem (LocalActorSharer shr) = SharerOutboxItemR shr
  +		1632	actorOutboxItem (LocalActorProject shr prj) = ProjectOutboxItemR shr prj
  +		1633	actorOutboxItem (LocalActorRepo shr rp) = RepoOutboxItemR shr rp
  +		1634
  …	…	…	…
  -	1751		runWorkerExcept action = do
  -	1752		site <- askSite
  -	1753		ExceptT $ liftIO $ runWorker (runExceptT action) site
  -	1754		verifyHosterRecip _ _ (Right _) = return ()
  -	1755		verifyHosterRecip localRecips name (Left wi) =
  -	1756		fromMaybeE (verify wi) $
  -	1757		name <> " ticket hoster actor isn't listed as a recipient"
  -	1758		where
  -	1759		verify (WorkItemSharerTicket shr _ _) = do
  -	1760		sharerSet <- lookup shr localRecips
  -	1761		guard $ localRecipSharer $ localRecipSharerDirect sharerSet
  -	1762		verify (WorkItemProjectTicket shr prj _) = do
  -	1763		sharerSet <- lookup shr localRecips
  -	1764		projectSet <- lookup prj $ localRecipProjectRelated sharerSet
  -	1765		guard $ localRecipProject $ localRecipProjectDirect projectSet
  -	1766		verify (WorkItemRepoPatch shr rp _) = do
  -	1767		sharerSet <- lookup shr localRecips
  -	1768		repoSet <- lookup rp $ localRecipRepoRelated sharerSet
  -	1769		guard $ localRecipRepo $ localRecipRepoDirect repoSet
  -	1767		workItemRecipSieve wiFollowers (WorkItemDetail ident context author) =
  -	1768		let authorC =
  -	1769		case author of
  -	1770		Left shr -> [LocalPersonCollectionSharerFollowers shr]
  -	1771		Right _ -> []
  -	1772		ticketC =
  -	1773		case ident of
  -	1774		Left (wi, _) -> [wiFollowers wi]
  -	1775		Right _ -> []
  -	1776		(contextA, contextC) =
  -	1777		case context of
  -	1778		Left local ->
  -	1779		case local of
  -	1780		Left (shr, prj) ->
  -	1781		( [LocalActorProject shr prj]
  -	1782		, [ LocalPersonCollectionProjectTeam shr prj
  -	1783		, LocalPersonCollectionProjectFollowers shr prj
  -	1784		]
  -	1785		)
  -	1786		Right (shr, rp) ->
  -	1787		( [LocalActorRepo shr rp]
  -	1788		, [ LocalPersonCollectionRepoTeam shr rp
  -	1789		, LocalPersonCollectionRepoFollowers shr rp
  -	1790		]
  -	1791		)
  -	1792		Right _ -> ([], [])
  -	1793		in (contextA, authorC ++ ticketC ++ contextC)
  …	…	…	…
  -	1846		where
  -	1847		authorAudience (Left shr) = AudLocal [LocalActorSharer shr] []
  -	1848		authorAudience (Right (ObjURI h lu)) = AudRemote h [lu] []
  -	1849		actorOutboxItem (LocalActorSharer shr) = SharerOutboxItemR shr
  -	1850		actorOutboxItem (LocalActorProject shr prj) = ProjectOutboxItemR shr prj
  -	1851		actorOutboxItem (LocalActorRepo shr rp) = RepoOutboxItemR shr rp
  +		1850
  +		1851	insertAcceptOnTicketStatus shrUser wi (WorkItemDetail _ ctx author) obiidResolve obiidAccept = do
  +		1852	encodeRouteLocal <- getEncodeRouteLocal
  +		1853	encodeRouteHome <- getEncodeRouteHome
  +		1854	wiFollowers <- askWorkItemFollowers
  +		1855	hLocal <- asksSite siteInstanceHost
  +		1856
  +		1857	obikhidResolve <- encodeKeyHashid obiidResolve
  +		1858	obikhidAccept <- encodeKeyHashid obiidAccept
  +		1859
  +		1860	let audAuthor =
  +		1861	AudLocal
  +		1862	[LocalActorSharer shrUser]
  +		1863	[LocalPersonCollectionSharerFollowers shrUser]
  +		1864	audTicketContext = contextAudience ctx
  +		1865	audTicketAuthor = authorAudience author
  +		1866	audTicketFollowers = AudLocal [] [wiFollowers wi]
  +		1867
  +		1868	(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
  +		1869	collectAudience $
  +		1870	audAuthor :
  +		1871	audTicketAuthor :
  +		1872	audTicketFollowers :
  +		1873	audTicketContext
  +		1874
  +		1875	actor = workItemActor wi
  +		1876	recips = map encodeRouteHome audLocal ++ audRemote
  +		1877	doc = Doc hLocal Activity
  +		1878	{ activityId =
  +		1879	Just $ encodeRouteLocal $
  +		1880	actorOutboxItem actor obikhidAccept
  +		1881	, activityActor = encodeRouteLocal $ renderLocalActor actor
  +		1882	, activitySummary = Nothing
  +		1883	, activityAudience = Audience recips [] [] [] [] []
  +		1884	, activitySpecific = AcceptActivity Accept
  +		1885	{ acceptObject =
  +		1886	encodeRouteHome $ SharerOutboxItemR shrUser obikhidResolve
  +		1887	, acceptResult = Nothing
  +		1888	}
  +		1889	}
  +		1890
  +		1891	update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
  +		1892	return (doc, recipientSet, remoteActors, fwdHosts)
  +		1893
  +		1894	resolveC
  +		1895	:: Entity Person
  +		1896	-> Sharer
  +		1897	-> Maybe TextHtml
  +		1898	-> Audience URIMode
  +		1899	-> Resolve URIMode
  +		1900	-> ExceptT Text Handler OutboxItemId
  +		1901	resolveC (Entity pidUser personUser) sharerUser summary audience (Resolve uObject) = do
  +		1902	let shrUser = sharerIdent sharerUser
  +		1903	object <- parseWorkItem "Resolve object" uObject
  +		1904	ParsedAudience localRecips remoteRecips blinded fwdHosts <- do
  +		1905	mrecips <- parseAudience audience
  +		1906	fromMaybeE mrecips "Offer Ticket with no recipients"
  +		1907	federation <- asksSite $ appFederation . appSettings
  +		1908	unless (federation || null remoteRecips) $
  +		1909	throwE "Federation disabled, but remote recipients specified"
  +		1910	verifyHosterRecip localRecips "Parent" object
  +		1911	now <- liftIO getCurrentTime
  +		1912	ticketDetail <- runWorkerExcept $ getWorkItemDetail "Object" object
  +		1913	(obiid, doc, remotesHttp, maybeAccept) <- runDBExcept $ do
  +		1914	(obiidResolve, docResolve, luResolve) <- lift $ insertResolveToOutbox shrUser now (personOutbox personUser) blinded
  +		1915	remotesHttpResolve <- do
  +		1916	wiFollowers <- askWorkItemFollowers
  +		1917	let sieve =
  +		1918	let (actors, colls) =
  +		1919	workItemRecipSieve wiFollowers ticketDetail
  +		1920	in makeRecipientSet
  +		1921	actors
  +		1922	(LocalPersonCollectionSharerFollowers shrUser :
  +		1923	colls
  +		1924	)
  +		1925	moreRemoteRecips <-
  +		1926	lift $
  +		1927	deliverLocal'
  +		1928	True
  +		1929	(LocalActorSharer shrUser)
  +		1930	(personInbox personUser)
  +		1931	obiidResolve
  +		1932	(localRecipSieve sieve False localRecips)
  +		1933	unless (federation || null moreRemoteRecips) $
  +		1934	throwE "Federation disabled, but recipient collection remote members found"
  +		1935	lift $ deliverRemoteDB'' fwdHosts obiidResolve remoteRecips moreRemoteRecips
  +		1936	maccept <-
  +		1937	case widIdent ticketDetail of
  +		1938	Right _ -> return Nothing
  +		1939	Left (wi, ltid) -> Just <$> do
  +		1940	mhoster <-
  +		1941	lift $ runMaybeT $
  +		1942	case wi of
  +		1943	WorkItemSharerTicket shr _ _ -> do
  +		1944	sid <- MaybeT $ getKeyBy $ UniqueSharer shr
  +		1945	p <- MaybeT (getValBy $ UniquePersonIdent sid)
  +		1946	return (personOutbox p, personInbox p)
  +		1947	WorkItemProjectTicket shr prj _ -> do
  +		1948	sid <- MaybeT $ getKeyBy $ UniqueSharer shr
  +		1949	j <- MaybeT (getValBy $ UniqueProject prj sid)
  +		1950	return (projectOutbox j, projectInbox j)
  +		1951	WorkItemRepoPatch shr rp _ -> do
  +		1952	sid <- MaybeT $ getKeyBy $ UniqueSharer shr
  +		1953	r <- MaybeT (getValBy $ UniqueRepo rp sid)
  +		1954	return (repoOutbox r, repoInbox r)
  +		1955	(obidHoster, ibidHoster) <- fromMaybeE mhoster "Ticket hoster not in DB"
  +		1956	obiidAccept <- lift $ insertEmptyOutboxItem obidHoster now
  +		1957	lift $ insertResolve ltid obiidResolve obiidAccept
  +		1958	(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
  +		1959	lift $ insertAcceptOnTicketStatus shrUser wi ticketDetail obiidResolve obiidAccept
  +		1960	knownRemoteRecipsAccept <-
  +		1961	lift $
  +		1962	deliverLocal'
  +		1963	False
  +		1964	(workItemActor wi)
  +		1965	ibidHoster
  +		1966	obiidAccept
  +		1967	localRecipsAccept
  +		1968	lift $ (obiidAccept,docAccept,fwdHostsAccept,) <$>
  +		1969	deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
  +		1970	return (obiidResolve, docResolve, remotesHttpResolve, maccept)
  +		1971	lift $ do
  +		1972	forkWorker "resolveC: async HTTP Resolve delivery" $ deliverRemoteHttp' fwdHosts obiid doc remotesHttp
  +		1973	for_ maybeAccept $ \ (obiidAccept, docAccept, fwdHostsAccept, remotesHttpAccept) ->
  +		1974	forkWorker "resolveC: async HTTP Accept delivery" $ deliverRemoteHttp' fwdHostsAccept obiidAccept docAccept remotesHttpAccept
  +		1975	return obiid
  +		1976	where
  +		1977	insertResolveToOutbox shrUser now obid blinded = do
  +		1978	hLocal <- asksSite siteInstanceHost
  +		1979	obiid <- insertEmptyOutboxItem obid now
  +		1980	encodeRouteLocal <- getEncodeRouteLocal
  +		1981	obikhid <- encodeKeyHashid obiid
  +		1982	let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
  +		1983	doc = Doc hLocal Activity
  +		1984	{ activityId = Just luAct
  +		1985	, activityActor = encodeRouteLocal $ SharerR shrUser
  +		1986	, activitySummary = summary
  +		1987	, activityAudience = blinded
  +		1988	, activitySpecific = ResolveActivity $ Resolve uObject
  +		1989	}
  +		1990	update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
  +		1991	return (obiid, doc, luAct)
  +		1992
  +		1993	insertResolve ltid obiidResolve obiidAccept = do
  +		1994	trid <- insert TicketResolve
  +		1995	{ ticketResolveTicket = ltid
  +		1996	, ticketResolveAccept = obiidAccept
  +		1997	}
  +		1998	insert_ TicketResolveLocal
  +		1999	{ ticketResolveLocalTicket = trid
  +		2000	, ticketResolveLocalActivity = obiidResolve
  +		2001	}
  +		2002	tid <- localTicketTicket <$> getJust ltid
  +		2003	update tid [TicketStatus =. TSClosed]
  …	…	…	…
  -	2002		:: ShrIdent
  +		2154	:: Entity Person
  +		2155	-> Sharer
  -	2008		undoC shrUser summary audience undo@(Undo luObject) = do
  +		2161	undoC (Entity _pidUser personUser) sharerUser summary audience undo@(Undo uObject) = do
  +		2162	let shrUser = sharerIdent sharerUser
  +		2163	object <- parseActivity uObject
  -	2013		fromMaybeE mrecips "Follow with no recipients"
  +		2168	fromMaybeE mrecips "Undo with no recipients"
  -	2017		route <-
  -	2018		fromMaybeE
  -	2019		(decodeRouteLocal luObject)
  -	2020		"Undo object isn't a valid route"
  -	2021		obiidOriginal <- case route of
  -	2022		SharerOutboxItemR shr obikhid
  -	2023		| shr == shrUser ->
  -	2024		decodeKeyHashidE obikhid "Undo object invalid obikhid"
  -	2025		_ -> throwE "Undo object isn't actor's outbox item route"
  -	2026		(obiidUndo, doc, remotesHttp) <- runDBExcept $ do
  -	2027		Entity _pidAuthor personAuthor <- lift $ getAuthor shrUser
  -	2028		obi <- do
  -	2029		mobi <- lift $ get obiidOriginal
  -	2030		fromMaybeE mobi "Undo object obiid doesn't exist in DB"
  -	2031		unless (outboxItemOutbox obi == personOutbox personAuthor) $
  -	2032		throwE "Undo object obiid belongs to different actor"
  -	2033		lift $ do
  -	2034		deleteFollow obiidOriginal
  -	2035		deleteFollowRemote obiidOriginal
  -	2036		deleteFollowRemoteRequest obiidOriginal
  -	2037		let obidAuthor = personOutbox personAuthor
  -	2038		(obiidUndo, doc, luUndo) <- insertUndoToOutbox obidAuthor blinded
  -	2039		let ibidAuthor = personInbox personAuthor
  -	2040		fsidAuthor = personFollowers personAuthor
  -	2041		knownRemotes <- deliverLocal shrUser ibidAuthor fsidAuthor obiidUndo localRecips
  -	2042		remotesHttp <- deliverRemoteDB'' fwdHosts obiidUndo remoteRecips knownRemotes
  -	2043		return (obiidUndo, doc, remotesHttp)
  -	2044		lift $ forkWorker "undoC: Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp' fwdHosts obiidUndo doc remotesHttp
  -	2045		return obiidUndo
  +		2172	now <- liftIO getCurrentTime
  +		2173	(obiid, doc, _lu, mwi) <- runDBExcept $ do
  +		2174	(obiidUndo, docUndo, luUndo) <- lift $ insertUndoToOutbox shrUser now (personOutbox personUser) blinded
  +		2175	mltid <- fmap join $ runMaybeT $ do
  +		2176	object' <- MaybeT $ getActivity object
  +		2177	deleteFollow shrUser object' <|> deleteResolve object'
  +		2178	mwi <- lift $ traverse getWorkItem mltid
  +		2179	return (obiidUndo, docUndo, luUndo, mwi)
  +		2180	mticketDetail <-
  +		2181	for mwi $ \ wi ->
  +		2182	(wi,) <$> runWorkerExcept (getWorkItemDetail "Object" $ Left wi)
  +		2183	wiFollowers <- askWorkItemFollowers
  +		2184	let sieve =
  +		2185	case mticketDetail of
  +		2186	Nothing -> makeRecipientSet [] [LocalPersonCollectionSharerFollowers shrUser]
  +		2187	Just (_wi, ticketDetail) ->
  +		2188	let (actors, colls) =
  +		2189	workItemRecipSieve wiFollowers ticketDetail
  +		2190	in makeRecipientSet
  +		2191	actors
  +		2192	(LocalPersonCollectionSharerFollowers shrUser :
  +		2193	colls
  +		2194	)
  +		2195	(remotes, maybeAccept) <- runDBExcept $ do
  +		2196	remotesHttpUndo <- do
  +		2197	moreRemoteRecips <-
  +		2198	lift $
  +		2199	deliverLocal'
  +		2200	True
  +		2201	(LocalActorSharer shrUser)
  +		2202	(personInbox personUser)
  +		2203	obiid
  +		2204	(localRecipSieve sieve True localRecips)
  +		2205	unless (federation || null moreRemoteRecips) $
  +		2206	throwE "Federation disabled, but recipient collection remote members found"
  +		2207	lift $ deliverRemoteDB'' fwdHosts obiid remoteRecips moreRemoteRecips
  +		2208	maccept <- for mticketDetail $ \ (wi, ticketDetail) -> do
  +		2209	mhoster <-
  +		2210	lift $ runMaybeT $
  +		2211	case wi of
  +		2212	WorkItemSharerTicket shr _ _ -> do
  +		2213	sid <- MaybeT $ getKeyBy $ UniqueSharer shr
  +		2214	p <- MaybeT (getValBy $ UniquePersonIdent sid)
  +		2215	return (personOutbox p, personInbox p)
  +		2216	WorkItemProjectTicket shr prj _ -> do
  +		2217	sid <- MaybeT $ getKeyBy $ UniqueSharer shr
  +		2218	j <- MaybeT (getValBy $ UniqueProject prj sid)
  +		2219	return (projectOutbox j, projectInbox j)
  +		2220	WorkItemRepoPatch shr rp _ -> do
  +		2221	sid <- MaybeT $ getKeyBy $ UniqueSharer shr
  +		2222	r <- MaybeT (getValBy $ UniqueRepo rp sid)
  +		2223	return (repoOutbox r, repoInbox r)
  +		2224	(obidHoster, ibidHoster) <- fromMaybeE mhoster "Ticket hoster not in DB"
  +		2225	obiidAccept <- lift $ insertEmptyOutboxItem obidHoster now
  +		2226	(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
  +		2227	lift $ insertAcceptOnTicketStatus shrUser wi ticketDetail obiid obiidAccept
  +		2228	knownRemoteRecipsAccept <-
  +		2229	lift $
  +		2230	deliverLocal'
  +		2231	False
  +		2232	(workItemActor wi)
  +		2233	ibidHoster
  +		2234	obiidAccept
  +		2235	localRecipsAccept
  +		2236	lift $ (obiidAccept,docAccept,fwdHostsAccept,) <$>
  +		2237	deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
  +		2238	return (remotesHttpUndo, maccept)
  +		2239	lift $ do
  +		2240	forkWorker "undoC: async HTTP Undo delivery" $
  +		2241	deliverRemoteHttp' fwdHosts obiid doc remotes
  +		2242	for_ maybeAccept $ \ (obiidAccept, docAccept, fwdHostsAccept, remotesHttpAccept) ->
  +		2243	forkWorker "undoC: async HTTP Accept delivery" $
  +		2244	deliverRemoteHttp' fwdHostsAccept obiidAccept docAccept remotesHttpAccept
  +		2245	return obiid
  …	…	…	…
  -	2092		getAuthor shr = do
  -	2093		sid <- getKeyBy404 $ UniqueSharer shr
  -	2094		getBy404 $ UniquePersonIdent sid
  -	2095		deleteFollow obiid = do
  -	2096		mfid <- getKeyBy $ UniqueFollowFollow obiid
  -	2097		traverse_ delete mfid
  -	2098		deleteFollowRemote obiid = do
  -	2099		mfrid <- getKeyBy $ UniqueFollowRemoteFollow obiid
  -	2100		traverse_ delete mfrid
  -	2101		deleteFollowRemoteRequest obiid = do
  -	2102		mfrrid <- getKeyBy $ UniqueFollowRemoteRequestActivity obiid
  -	2103		traverse_ delete mfrrid
  -	2104		insertUndoToOutbox obid blinded = do
  +		2292	insertUndoToOutbox shrUser now obid blinded = do
  +		2282	obiid <- insertEmptyOutboxItem obid now
  -	2096		let activity mluAct = Doc hLocal Activity
  -	2097		{ activityId = mluAct
  +		2285	obikhid <- encodeKeyHashid obiid
  +		2286	let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
  +		2287	doc = Doc hLocal Activity
  +		2288	{ activityId = Just luAct
  -	2103		, activitySpecific = UndoActivity undo
  +		2294	, activitySpecific = UndoActivity $ Undo uObject
  -	2105		now <- liftIO getCurrentTime
  -	2106		obiid <- insert OutboxItem
  -	2107		{ outboxItemOutbox = obid
  -	2108		, outboxItemActivity =
  -	2109		persistJSONObjectFromDoc $ activity Nothing
  -	2110		, outboxItemPublished = now
  -	2111		}
  -	2112		obikhid <- encodeKeyHashid obiid
  -	2113		let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
  -	2114		doc = activity $ Just luAct
  +		2289	deleteFollow shr (Left (actor, obiid)) = do
  +		2290	deleteFollowLocal <|> deleteFollowRemote <|> deleteFollowRequest
  +		2291	return Nothing
  +		2292	where
  +		2293	deleteFollowLocal = do
  +		2294	fid <- MaybeT $ lift $ getKeyBy $ UniqueFollowFollow obiid
  +		2295	unless (actor == LocalActorSharer shr) $
  +		2296	lift $ throwE "Undoing someone else's follow"
  +		2297	lift $ lift $ delete fid
  +		2298	deleteFollowRemote = do
  +		2299	frid <- MaybeT $ lift $ getKeyBy $ UniqueFollowRemoteFollow obiid
  +		2300	unless (actor == LocalActorSharer shr) $
  +		2301	lift $ throwE "Undoing someone else's follow"
  +		2302	lift $ lift $ delete frid
  +		2303	deleteFollowRequest = do
  +		2304	frrid <- MaybeT $ lift $ getKeyBy $ UniqueFollowRemoteRequestActivity obiid
  +		2305	unless (actor == LocalActorSharer shr) $
  +		2306	lift $ throwE "Undoing someone else's follow"
  +		2307	lift $ lift $ delete frrid
  +		2308	deleteFollow _ (Right _) = mzero
  +		2309
  +		2310	deleteResolve (Left (_, obiid)) = do
  +		2311	Entity trlid trl <- MaybeT $ lift $ getBy $ UniqueTicketResolveLocalActivity obiid
  +		2312	lift $ lift $ do
  +		2313	let trid = ticketResolveLocalTicket trl
  +		2314	tr <- getJust trid
  +		2315	delete trlid
  +		2316	delete trid
  +		2317	return $ Just $ ticketResolveTicket tr
  +		2318	deleteResolve (Right ractid) = do
  +		2319	Entity trrid trr <- MaybeT $ lift $ getBy $ UniqueTicketResolveRemoteActivity ractid
  +		2320	lift $ lift $ do
  +		2321	let trid = ticketResolveRemoteTicket trr
  +		2322	tr <- getJust trid
  +		2323	delete trrid
  +		2324	delete trid
  +		2325	return $ Just $ ticketResolveTicket tr
  +		2326
  …	…	…	…

• Edit file src/Vervis/ActivityPub.hs 0 → 0

  +		55	, parseActivity
  +		56	, getActivity
  …	…	…	…
  +		1215
  +		1216	parseActivity u@(ObjURI h lu) = do
  +		1217	hl <- hostIsLocal h
  +		1218	if hl
  +		1219	then Left <$> do
  +		1220	route <- fromMaybeE (decodeRouteLocal lu) "Object isn't a valid route"
  +		1221	case route of
  +		1222	SharerOutboxItemR shr obikhid ->
  +		1223	(LocalActorSharer shr,) <$>
  +		1224	decodeKeyHashidE obikhid "No such obikhid"
  +		1225	ProjectOutboxItemR shr prj obikhid -> do
  +		1226	(LocalActorProject shr prj,) <$>
  +		1227	decodeKeyHashidE obikhid "No such obikhid"
  +		1228	RepoOutboxItemR shr rp obikhid -> do
  +		1229	(LocalActorRepo shr rp,) <$>
  +		1230	decodeKeyHashidE obikhid "No such obikhid"
  +		1231	else return $ Right u
  +		1232
  +		1233	getActivity (Left (actor, obiid)) = Just . Left <$> do
  +		1234	obid <- getActorOutbox actor
  +		1235	obi <- do
  +		1236	mobi <- lift $ get obiid
  +		1237	fromMaybeE mobi "No such obiid"
  +		1238	unless (outboxItemOutbox obi == obid) $
  +		1239	throwE "Actor/obiid mismatch"
  +		1240	return (actor, obiid)
  +		1241	where
  +		1242	getActorOutbox (LocalActorSharer shr) = do
  +		1243	sid <- do
  +		1244	msid <- lift $ getKeyBy $ UniqueSharer shr
  +		1245	fromMaybeE msid "No such sharer"
  +		1246	p <- do
  +		1247	mp <- lift $ getValBy $ UniquePersonIdent sid
  +		1248	fromMaybeE mp "No such person"
  +		1249	return $ personOutbox p
  +		1250	getActorOutbox (LocalActorProject shr prj) = do
  +		1251	sid <- do
  +		1252	msid <- lift $ getKeyBy $ UniqueSharer shr
  +		1253	fromMaybeE msid "No such sharer"
  +		1254	j <- do
  +		1255	mj <- lift $ getValBy $ UniqueProject prj sid
  +		1256	fromMaybeE mj "No such project"
  +		1257	return $ projectOutbox j
  +		1258	getActorOutbox (LocalActorRepo shr rp) = do
  +		1259	sid <- do
  +		1260	msid <- lift $ getKeyBy $ UniqueSharer shr
  +		1261	fromMaybeE msid "No such sharer"
  +		1262	r <- do
  +		1263	mr <- lift $ getValBy $ UniqueRepo rp sid
  +		1264	fromMaybeE mr "No such repo"
  +		1265	return $ repoOutbox r
  +		1266	getActivity (Right u@(ObjURI h lu)) = lift $ runMaybeT $ Right <$> do
  +		1267	iid <- MaybeT $ getKeyBy $ UniqueInstance h
  +		1268	roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iid lu
  +		1269	MaybeT $ getKeyBy $ UniqueRemoteActivity roid
  …	…	…	…

• Edit file src/Vervis/Client.hs 0 → 0

  +		26	, resolve
  +		32	, unresolve
  …	…	…	…
  -	52		import Web.ActivityPub hiding (Follow, Ticket)
  +		54	import Web.ActivityPub hiding (Follow, Ticket, Project, Repo)
  +		64	import Data.Either.Local
  +		69	import Vervis.ActivityPub.Recipient
  +		75	import Vervis.Ticket
  +		76	import Vervis.WorkItem
  …	…	…	…
  +		330	resolve
  +		331	:: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
  +		332	=> ShrIdent
  +		333	-> FedURI
  +		334	-> m (Either Text (Maybe TextHtml, Audience URIMode, Resolve URIMode))
  +		335	resolve shrUser uObject = runExceptT $ do
  +		336	encodeRouteHome <- getEncodeRouteHome
  +		337	wiFollowers <- askWorkItemFollowers
  +		338	object <- parseWorkItem "Resolve object" uObject
  +		339	WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Object" object
  +		340	let audAuthor =
  +		341	AudLocal
  +		342	[LocalActorSharer shrUser]
  +		343	[LocalPersonCollectionSharerFollowers shrUser]
  +		344	audTicketContext = contextAudience context
  +		345	audTicketAuthor = authorAudience author
  +		346	audTicketFollowers =
  +		347	case ident of
  +		348	Left (wi, _ltid) -> AudLocal [] [wiFollowers wi]
  +		349	Right (ObjURI h _, luFollowers) -> AudRemote h [] [luFollowers]
  +		350
  +		351	(_, _, _, audLocal, audRemote) =
  +		352	collectAudience $
  +		353	audAuthor :
  +		354	audTicketAuthor :
  +		355	audTicketFollowers :
  +		356	audTicketContext
  +		357
  +		358	recips = map encodeRouteHome audLocal ++ audRemote
  +		359	return (Nothing, Audience recips [] [] [] [] [], Resolve uObject)
  +		360
  …	…	…	…
  -	387		encodeRouteLocal $ SharerOutboxItemR shrAuthor obikhidFollow
  +		424	encodeRouteHome $ SharerOutboxItemR shrAuthor obikhidFollow
  …	…	…	…
  +		519
  +		520	data ActorEntity
  +		521	= ActorPerson (Entity Person)
  +		522	| ActorProject (Entity Project)
  +		523	| ActorRepo (Entity Repo)
  +		524
  +		525	unresolve
  +		526	:: (MonadUnliftIO m, MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
  +		527	=> ShrIdent
  +		528	-> WorkItem
  +		529	-> m (Either Text (Maybe TextHtml, Audience URIMode, Undo URIMode))
  +		530	unresolve shrUser wi = runExceptT $ do
  +		531	encodeRouteHome <- getEncodeRouteHome
  +		532	wiFollowers <- askWorkItemFollowers
  +		533	WorkItemDetail ident context author <- runWorkerExcept $ getWorkItemDetail "Object" $ Left wi
  +		534	ltid <-
  +		535	case ident of
  +		536	Left (_, ltid) -> return ltid
  +		537	Right _ -> error "Local WorkItem expected!"
  +		538	uResolve <- runSiteDBExcept $ do
  +		539	mtrid <- lift $ getKeyBy $ UniqueTicketResolve ltid
  +		540	trid <- fromMaybeE mtrid "Ticket already isn't resolved"
  +		541	trx <-
  +		542	lift $
  +		543	requireEitherAlt
  +		544	(getValBy $ UniqueTicketResolveLocal trid)
  +		545	(getValBy $ UniqueTicketResolveRemote trid)
  +		546	"No TRX"
  +		547	"Both TRL and TRR"
  +		548	case trx of
  +		549	Left trl -> lift $ do
  +		550	let obiid = ticketResolveLocalActivity trl
  +		551	obid <- outboxItemOutbox <$> getJust obiid
  +		552	ent <- getOutboxActorEntity obid
  +		553	obikhid <- encodeKeyHashid obiid
  +		554	encodeRouteHome . flip outboxItemRoute obikhid <$>
  +		555	actorEntityPath ent
  +		556	Right trr -> lift $ do
  +		557	roid <-
  +		558	remoteActivityIdent <$>
  +		559	getJust (ticketResolveRemoteActivity trr)
  +		560	ro <- getJust roid
  +		561	i <- getJust $ remoteObjectInstance ro
  +		562	return $ ObjURI (instanceHost i) (remoteObjectIdent ro)
  +		563	let audAuthor =
  +		564	AudLocal
  +		565	[LocalActorSharer shrUser]
  +		566	[LocalPersonCollectionSharerFollowers shrUser]
  +		567	audTicketContext = contextAudience context
  +		568	audTicketAuthor = authorAudience author
  +		569	audTicketFollowers = AudLocal [] [wiFollowers wi]
  +		570
  +		571	(_, _, _, audLocal, audRemote) =
  +		572	collectAudience $
  +		573	audAuthor :
  +		574	audTicketAuthor :
  +		575	audTicketFollowers :
  +		576	audTicketContext
  +		577
  +		578	recips = map encodeRouteHome audLocal ++ audRemote
  +		579	return (Nothing, Audience recips [] [] [] [] [], Undo uResolve)
  +		580	where
  +		581	getOutboxActorEntity obid = do
  +		582	mp <- getBy $ UniquePersonOutbox obid
  +		583	mj <- getBy $ UniqueProjectOutbox obid
  +		584	mr <- getBy $ UniqueRepoOutbox obid
  +		585	case (mp, mj, mr) of
  +		586	(Nothing, Nothing, Nothing) -> error "obid not in use"
  +		587	(Just p, Nothing, Nothing) -> return $ ActorPerson p
  +		588	(Nothing, Just j, Nothing) -> return $ ActorProject j
  +		589	(Nothing, Nothing, Just r) -> return $ ActorRepo r
  +		590	actorEntityPath (ActorPerson (Entity _ p)) =
  +		591	LocalActorSharer . sharerIdent <$> getJust (personIdent p)
  +		592	actorEntityPath (ActorProject (Entity _ j)) =
  +		593	flip LocalActorProject (projectIdent j) . sharerIdent <$>
  +		594	getJust (projectSharer j)
  +		595	actorEntityPath (ActorRepo (Entity _ r)) =
  +		596	flip LocalActorRepo (repoIdent r) . sharerIdent <$>
  +		597	getJust (repoSharer r)
  +		598	outboxItemRoute (LocalActorSharer shr) = SharerOutboxItemR shr
  +		599	outboxItemRoute (LocalActorProject shr prj) = ProjectOutboxItemR shr prj
  +		600	outboxItemRoute (LocalActorRepo shr rp) = RepoOutboxItemR shr rp
  …	…	…	…

• Edit file src/Vervis/Federation/Offer.hs 0 → 0

  +		42	import Data.Either
  …	…	…	…
  -	537		undoF
  -	538		:: Route App
  -	539		-> AppDB (Entity a)
  -	540		-> (a -> InboxId)
  -	541		-> (a -> FollowerSetId)
  -	542		-> (Key a -> FollowerSetId -> AppDB (Maybe Text))
  -	543		-> UTCTime
  -	544		-> RemoteAuthor
  -	545		-> ActivityBody
  -	546		-> Maybe (LocalRecipientSet, ByteString)
  -	547		-> LocalURI
  -	548		-> Undo URIMode
  -	549		-> ExceptT Text Handler Text
  -	550		undoF
  -	551		recipRoute getRecip recipInbox recipFollowers trySubObjects
  -	552		now author body mfwd luUndo (Undo luObj) = do
  -	553		lift $ runDB $ do
  -	554		Entity idRecip recip <- getRecip
  -	555		ractid <- insertActivity luUndo
  -	556		mreason <- deleteRemoteFollow idRecip (recipFollowers recip)
  -	557		case mreason of
  -	558		Just reason -> return $ "Not using this Undo: " <> reason
  -	559		Nothing -> do
  -	560		inserted <- insertToInbox (recipInbox recip) ractid
  -	561		encodeRouteLocal <- getEncodeRouteLocal
  -	562		let me = localUriPath $ encodeRouteLocal recipRoute
  -	563		return $
  -	564		if inserted
  -	565		then "Undo applied and inserted to inbox of " <> me
  -	566		else "Undo applied and already exists in inbox of " <> me
  +		538	getFollow (Left _) = return Nothing
  +		539	getFollow (Right ractid) = getBy $ UniqueRemoteFollowFollow ractid
  +		540
  +		541	getResolve (Left (_, obiid)) = fmap Left <$> getBy (UniqueTicketResolveLocalActivity obiid)
  +		542	getResolve (Right ractid) = fmap Right <$> getBy (UniqueTicketResolveRemoteActivity ractid)
  +		543
  +		544	deleteResolve myWorkItem prepareAccept tr = do
  +		545	let (trid, trxid) =
  +		546	case tr of
  +		547	Left (Entity trlid trl) -> (ticketResolveLocalTicket trl, Left trlid)
  +		548	Right (Entity trrid trr) -> (ticketResolveRemoteTicket trr, Right trrid)
  +		549	ltid <- ticketResolveTicket <$> getJust trid
  +		550	wi <- getWorkItem ltid
  +		551	case myWorkItem wi of
  +		552	Nothing -> return ("Undo is of a TicketResolve but not my ticket", Nothing, Nothing)
  +		553	Just wiData -> do
  +		554	bitraverse delete delete trxid
  +		555	delete trid
  +		556	(colls, accept) <- prepareAccept wiData
  +		557	return ("Ticket unresolved", Just colls, Just accept)
  +		558
  +		559	deleteRemoteFollow myWorkItem author fsidRecip (Entity rfid rf)
  +		560	| remoteFollowActor rf /= remoteAuthorId author =
  +		561	return "Undo sent by different actor than the one who sent the Follow"
  +		562	| remoteFollowTarget rf == fsidRecip = do
  +		563	delete rfid
  +		564	return "Undo applied to sharer RemoteFollow"
  +		565	| otherwise = do
  +		566	r <- tryTicket $ remoteFollowTarget rf
  +		567	when (isRight r) $ delete rfid
  +		568	return $ either id id r
  -	569		insertActivity luUndo = do
  -	570		let iidAuthor = remoteAuthorInstance author
  -	571		roid <-
  -	572		either entityKey id <$> insertBy' (RemoteObject iidAuthor luUndo)
  -	573		let jsonObj = persistJSONFromBL $ actbBL body
  -	574		ract = RemoteActivity roid jsonObj now
  -	575		either entityKey id <$> insertBy' ract
  -	576		deleteRemoteFollow idRecip fsidRecip = do
  -	577		let iidAuthor = remoteAuthorInstance author
  -	578		mractidObj <- runMaybeT $ do
  -	579		roid <- MaybeT $ getKeyBy $ UniqueRemoteObject iidAuthor luObj
  -	580		MaybeT $ getKeyBy $ UniqueRemoteActivity roid
  -	581		case mractidObj of
  -	582		Nothing -> return $ Just "Undo object isn't a known activity"
  -	583		Just ractidObj -> do
  -	584		merf <- getBy $ UniqueRemoteFollowFollow ractidObj
  -	585		case merf of
  -	586		Nothing -> return $ Just "Undo object doesn't match an active RemoteFollow"
  -	587		Just (Entity rfid rf)
  -	588		| remoteFollowActor rf /= remoteAuthorId author ->
  -	589		return $ Just "Undo sent by different actor than the one who sent the Follow"
  -	590		| remoteFollowTarget rf == fsidRecip -> do
  -	591		delete rfid
  -	592		return Nothing
  -	593		| otherwise -> do
  -	594		mr <- trySubObjects idRecip (remoteFollowTarget rf)
  -	595		when (isNothing mr) $ delete rfid
  -	596		return mr
  -	597		insertToInbox ibidRecip ractid = do
  -	598		ibiid <- insert $ InboxItem False
  -	599		mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
  -	600		case mibrid of
  -	601		Nothing -> do
  -	602		delete ibiid
  -	603		return False
  -	604		Just _ -> return True
  -	605
  -	606		sharerUndoF
  -	607		:: ShrIdent
  -	608		-> UTCTime
  -	609		-> RemoteAuthor
  -	610		-> ActivityBody
  -	611		-> Maybe (LocalRecipientSet, ByteString)
  -	612		-> LocalURI
  -	613		-> Undo URIMode
  -	614		-> ExceptT Text Handler Text
  -	615		sharerUndoF shr =
  -	616		undoF
  -	617		(SharerR shr)
  -	618		getRecip
  -	619		personInbox
  -	620		personFollowers
  -	621		tryTicket
  -	622		where
  -	623		getRecip = do
  -	624		sid <- getKeyBy404 $ UniqueSharer shr
  -	625		getBy404 $ UniquePersonIdent sid
  -	626		tryTicket pid fsid = do
  +		571	tryTicket fsid = do
  -	572		Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this sharer"
  +		517	Nothing -> return $ Left "Undo object is a RemoteFollow, but not for me and not for a ticket"
  -	574		mtal <- getBy $ UniqueTicketAuthorLocal ltid
  -	575		case mtal of
  -	576		Just (Entity talid tal)
  -	577		| ticketAuthorLocalAuthor tal == pid -> do
  -	578		mtup <- getBy $ UniqueTicketUnderProjectAuthor talid
  -	579		return $
  -	580		case mtup of
  -	581		Nothing -> Nothing
  -	582		Just _ -> Just "Undo object is a RemoteFollow of a ticket authored by this sharer, but is hosted by the project"
  -	583		_ -> return $ Just "Undo object is a RemoteFollow of a ticket of another author"
  +		519	wi <- getWorkItem ltid
  +		520	return $
  +		521	if myWorkItem wi
  +		522	then Right "Undo applied to RemoteFollow of my ticket"
  +		523	else Left "Undo is of RemoteFollow of a ticket that isn't mine"
  +		524
  +		525	insertAcceptOnUndo actor author luUndo obiid auds = do
  +		526	encodeRouteLocal <- getEncodeRouteLocal
  +		527	encodeRouteHome <- getEncodeRouteHome
  +		528	hLocal <- asksSite siteInstanceHost
  +		529	obikhid <- encodeKeyHashid obiid
  +		530	let hAuthor = objUriAuthority $ remoteAuthorURI author
  +		531
  +		532	(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
  +		533	collectAudience auds
  +		534
  +		535	recips = map encodeRouteHome audLocal ++ audRemote
  +		536	doc = Doc hLocal Activity
  +		537	{ activityId =
  +		538	Just $ encodeRouteLocal $ actorOutboxItem actor obikhid
  +		539	, activityActor = encodeRouteLocal $ renderLocalActor actor
  +		540	, activitySummary = Nothing
  +		541	, activityAudience = Audience recips [] [] [] [] []
  +		542	, activitySpecific = AcceptActivity Accept
  +		543	{ acceptObject = ObjURI hAuthor luUndo
  +		544	, acceptResult = Nothing
  +		545	}
  +		546	}
  +		547	update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
  +		548	return (doc, recipientSet, remoteActors, fwdHosts)
  +		549	where
  +		550	actorOutboxItem (LocalActorSharer shr) = SharerOutboxItemR shr
  +		551	actorOutboxItem (LocalActorProject shr prj) = ProjectOutboxItemR shr prj
  +		552	actorOutboxItem (LocalActorRepo shr rp) = RepoOutboxItemR shr rp
  +		553
  +		554	sharerUndoF
  +		555	:: ShrIdent
  +		556	-> UTCTime
  +		557	-> RemoteAuthor
  +		558	-> ActivityBody
  +		559	-> Maybe (LocalRecipientSet, ByteString)
  +		560	-> LocalURI
  +		561	-> Undo URIMode
  +		562	-> ExceptT Text Handler Text
  +		563	sharerUndoF shrRecip now author body mfwd luUndo (Undo uObj) = do
  +		564	object <- parseActivity uObj
  +		565	mmmhttp <- runDBExcept $ do
  +		566	p <- lift $ do
  +		567	sid <- getKeyBy404 $ UniqueSharer shrRecip
  +		568	getValBy404 $ UniquePersonIdent sid
  +		569	mractid <- lift $ insertToInbox now author body (personInbox p) luUndo True
  +		570	for mractid $ \ ractid -> do
  +		571	mobject' <- getActivity object
  +		572	lift $ for mobject' $ \ object' -> do
  +		573	mobject'' <- runMaybeT $
  +		574	Left <$> MaybeT (getFollow object') <|>
  +		575	Right <$> MaybeT (getResolve object')
  +		576	for mobject'' $ \ object'' -> do
  +		577	(result, mfwdColl, macceptAuds) <-
  +		578	case object'' of
  +		579	Left erf -> (,Nothing,Nothing) <$> deleteRemoteFollow (isJust . myWorkItem) author (personFollowers p) erf
  +		580	Right tr -> deleteResolve myWorkItem prepareAccept tr
  +		581	mremotesHttpFwd <- for (liftA2 (,) mfwd mfwdColl) $ \ ((localRecips, sig), colls) -> do
  +		582	let sieve = makeRecipientSet [] colls
  +		583	remoteRecips <-
  +		584	insertRemoteActivityToLocalInboxes
  +		585	False ractid $
  +		586	localRecipSieve'
  +		587	sieve False False localRecips
  +		588	(sig,) <$> deliverRemoteDB_S (actbBL body) ractid (personIdent p) sig remoteRecips
  +		589	mremotesHttpAccept <- for macceptAuds $ \ acceptAuds -> do
  +		590	obiidAccept <- insertEmptyOutboxItem (personOutbox p) now
  +		591	(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
  +		592	insertAcceptOnUndo (LocalActorSharer shrRecip) author luUndo obiidAccept acceptAuds
  +		593	knownRemoteRecipsAccept <-
  +		594	deliverLocal'
  +		595	False
  +		596	(LocalActorSharer shrRecip)
  +		597	(personInbox p)
  +		598	obiidAccept
  +		599	localRecipsAccept
  +		600	(obiidAccept,docAccept,fwdHostsAccept,) <$>
  +		601	deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
  +		602	return (result, mremotesHttpFwd, mremotesHttpAccept)
  +		603	case mmmhttp of
  +		604	Nothing -> return "Activity already in my inbox"
  +		605	Just mmhttp ->
  +		606	case mmhttp of
  +		607	Nothing -> return "Undo object isn't a known activity"
  +		608	Just mhttp ->
  +		609	case mhttp of
  +		610	Nothing -> return "Undo object isn't in use"
  +		611	Just (msg, mremotesHttpFwd, mremotesHttpAccept) -> do
  +		612	for_ mremotesHttpFwd $ \ (sig, remotes) ->
  +		613	forkWorker "sharerUndoF inbox-forwarding" $
  +		614	deliverRemoteHTTP_S now shrRecip (actbBL body) sig remotes
  +		615	for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) ->
  +		616	forkWorker "sharerUndoF Accept HTTP delivery" $
  +		617	deliverRemoteHttp' fwdHosts obiid doc remotes
  +		618	let fwdMsg =
  +		619	case mremotesHttpFwd of
  +		620	Nothing -> "No inbox-forwarding"
  +		621	Just _ -> "Did inbox-forwarding"
  +		622	acceptMsg =
  +		623	case mremotesHttpAccept of
  +		624	Nothing -> "Didn't send Accept"
  +		625	Just _ -> "Sent Accept"
  +		626	return $ msg <> "; " <> fwdMsg <> "; " <> acceptMsg
  +		627	where
  +		628	myWorkItem (WorkItemSharerTicket shr talid patch)
  +		629	| shr == shrRecip = Just (talid, patch)
  +		630	myWorkItem _ = Nothing
  +		631
  +		632	prepareAccept (talid, patch) = do
  +		633	talkhid <- encodeKeyHashid talid
  +		634	ra <- getJust $ remoteAuthorId author
  +		635	let ObjURI hAuthor luAuthor = remoteAuthorURI author
  +		636	ticketFollowers =
  +		637	if patch
  +		638	then LocalPersonCollectionSharerPatchFollowers shrRecip talkhid
  +		639	else LocalPersonCollectionSharerTicketFollowers shrRecip talkhid
  +		640	audAuthor =
  +		641	AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
  +		642	audTicket =
  +		643	AudLocal [] [ticketFollowers]
  +		644	return ([ticketFollowers], [audAuthor, audTicket])
  …	…	…	…
  -	711		projectUndoF shr prj =
  -	712		undoF
  -	713		(ProjectR shr prj)
  -	714		getRecip
  -	715		projectInbox
  -	716		projectFollowers
  -	717		tryTicket
  +		772	projectUndoF shrRecip prjRecip now author body mfwd luUndo (Undo uObj) = do
  +		773	object <- parseActivity uObj
  +		774	mmmhttp <- runDBExcept $ do
  +		775	Entity jid j <- lift $ do
  +		776	sid <- getKeyBy404 $ UniqueSharer shrRecip
  +		777	getBy404 $ UniqueProject prjRecip sid
  +		778	mractid <- lift $ insertToInbox now author body (projectInbox j) luUndo False
  +		779	for mractid $ \ ractid -> do
  +		780	mobject' <- getActivity object
  +		781	lift $ for mobject' $ \ object' -> do
  +		782	mobject'' <- runMaybeT $
  +		783	Left <$> MaybeT (getFollow object') <|>
  +		784	Right <$> MaybeT (getResolve object')
  +		785	for mobject'' $ \ object'' -> do
  +		786	(result, mfwdColl, macceptAuds) <-
  +		787	case object'' of
  +		788	Left erf -> (,Nothing,Nothing) <$> deleteRemoteFollow (isJust . myWorkItem) author (projectFollowers j) erf
  +		789	Right tr -> deleteResolve myWorkItem prepareAccept tr
  +		790	mremotesHttpFwd <- for (liftA2 (,) mfwd mfwdColl) $ \ ((localRecips, sig), colls) -> do
  +		791	let sieve = makeRecipientSet [] colls
  +		792	remoteRecips <-
  +		793	insertRemoteActivityToLocalInboxes
  +		794	False ractid $
  +		795	localRecipSieve'
  +		796	sieve False False localRecips
  +		797	(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
  +		798	mremotesHttpAccept <- for macceptAuds $ \ acceptAuds -> do
  +		799	obiidAccept <- insertEmptyOutboxItem (projectOutbox j) now
  +		800	(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
  +		801	insertAcceptOnUndo (LocalActorProject shrRecip prjRecip) author luUndo obiidAccept acceptAuds
  +		802	knownRemoteRecipsAccept <-
  +		803	deliverLocal'
  +		804	False
  +		805	(LocalActorProject shrRecip prjRecip)
  +		806	(projectInbox j)
  +		807	obiidAccept
  +		808	localRecipsAccept
  +		809	(obiidAccept,docAccept,fwdHostsAccept,) <$>
  +		810	deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
  +		811	return (result, mremotesHttpFwd, mremotesHttpAccept)
  +		812	case mmmhttp of
  +		813	Nothing -> return "Activity already in my inbox"
  +		814	Just mmhttp ->
  +		815	case mmhttp of
  +		816	Nothing -> return "Undo object isn't a known activity"
  +		817	Just mhttp ->
  +		818	case mhttp of
  +		819	Nothing -> return "Undo object isn't in use"
  +		820	Just (msg, mremotesHttpFwd, mremotesHttpAccept) -> do
  +		821	for_ mremotesHttpFwd $ \ (sig, remotes) ->
  +		822	forkWorker "projectUndoF inbox-forwarding" $
  +		823	deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotes
  +		824	for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) ->
  +		825	forkWorker "projectUndoF Accept HTTP delivery" $
  +		826	deliverRemoteHttp' fwdHosts obiid doc remotes
  +		827	let fwdMsg =
  +		828	case mremotesHttpFwd of
  +		829	Nothing -> "No inbox-forwarding"
  +		830	Just _ -> "Did inbox-forwarding"
  +		831	acceptMsg =
  +		832	case mremotesHttpAccept of
  +		833	Nothing -> "Didn't send Accept"
  +		834	Just _ -> "Sent Accept"
  +		835	return $ msg <> "; " <> fwdMsg <> "; " <> acceptMsg
  …	…	…	…
  -	776		getRecip = do
  -	777		sid <- getKeyBy404 $ UniqueSharer shr
  -	778		getBy404 $ UniqueProject prj sid
  -	779		tryTicket jid fsid = do
  -	780		mlt <- getValBy $ UniqueLocalTicketFollowers fsid
  -	781		case mlt of
  -	782		Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this project"
  -	783		Just lt -> do
  -	784		mtpl <- runMaybeT $ do
  -	785		tclid <- MaybeT $ getKeyBy $ UniqueTicketContextLocal $ localTicketTicket lt
  -	786		tpl <- MaybeT $ getValBy $ UniqueTicketProjectLocal tclid
  -	787		return (tclid, tpl)
  -	788		case mtpl of
  -	789		Just (tclid, tpl)
  -	790		| ticketProjectLocalProject tpl == jid -> do
  -	791		mtup <- getBy $ UniqueTicketUnderProjectProject tclid
  -	792		return $
  -	793		case mtup of
  -	794		Nothing -> Just "Undo object is a RemoteFollow of a ticket under this project, but is hosted by the author"
  -	795		Just _ -> Nothing
  -	796		_ -> return $ Just "Undo object is a RemoteFollow of a ticket of another project"
  +		894	myWorkItem (WorkItemProjectTicket shr prj ltid)
  +		895	| shr == shrRecip && prj == prjRecip = Just ltid
  +		896	myWorkItem _ = Nothing
  +		897
  +		898	prepareAccept ltid = do
  +		899	ltkhid <- encodeKeyHashid ltid
  +		900	ra <- getJust $ remoteAuthorId author
  +		901	let ObjURI hAuthor luAuthor = remoteAuthorURI author
  +		902	ticketFollowers =
  +		903	LocalPersonCollectionProjectTicketFollowers shrRecip prjRecip ltkhid
  +		904	audAuthor =
  +		905	AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
  +		906	audTicket =
  +		907	AudLocal [] [ticketFollowers]
  +		908	return ([ticketFollowers], [audAuthor, audTicket])
  -	802		repoUndoF shr rp =
  -	803		undoF
  -	804		(RepoR shr rp)
  -	805		getRecip
  -	806		repoInbox
  -	807		repoFollowers
  -	808		tryPatch
  +		914	repoUndoF shrRecip rpRecip now author body mfwd luUndo (Undo uObj) = do
  +		915	object <- parseActivity uObj
  +		916	mmmhttp <- runDBExcept $ do
  +		917	Entity rid r <- lift $ do
  +		918	sid <- getKeyBy404 $ UniqueSharer shrRecip
  +		919	getBy404 $ UniqueRepo rpRecip sid
  +		920	mractid <- lift $ insertToInbox now author body (repoInbox r) luUndo False
  +		921	for mractid $ \ ractid -> do
  +		922	mobject' <- getActivity object
  +		923	lift $ for mobject' $ \ object' -> do
  +		924	mobject'' <- runMaybeT $
  +		925	Left <$> MaybeT (getFollow object') <|>
  +		926	Right <$> MaybeT (getResolve object')
  +		927	for mobject'' $ \ object'' -> do
  +		928	(result, mfwdColl, macceptAuds) <-
  +		929	case object'' of
  +		930	Left erf -> (,Nothing,Nothing) <$> deleteRemoteFollow (isJust . myWorkItem) author (repoFollowers r) erf
  +		931	Right tr -> deleteResolve myWorkItem prepareAccept tr
  +		932	mremotesHttpFwd <- for (liftA2 (,) mfwd mfwdColl) $ \ ((localRecips, sig), colls) -> do
  +		933	let sieve = makeRecipientSet [] colls
  +		934	remoteRecips <-
  +		935	insertRemoteActivityToLocalInboxes
  +		936	False ractid $
  +		937	localRecipSieve'
  +		938	sieve False False localRecips
  +		939	(sig,) <$> deliverRemoteDB_R (actbBL body) ractid rid sig remoteRecips
  +		940	mremotesHttpAccept <- for macceptAuds $ \ acceptAuds -> do
  +		941	obiidAccept <- insertEmptyOutboxItem (repoOutbox r) now
  +		942	(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
  +		943	insertAcceptOnUndo (LocalActorRepo shrRecip rpRecip) author luUndo obiidAccept acceptAuds
  +		944	knownRemoteRecipsAccept <-
  +		945	deliverLocal'
  +		946	False
  +		947	(LocalActorRepo shrRecip rpRecip)
  +		948	(repoInbox r)
  +		949	obiidAccept
  +		950	localRecipsAccept
  +		951	(obiidAccept,docAccept,fwdHostsAccept,) <$>
  +		952	deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
  +		953	return (result, mremotesHttpFwd, mremotesHttpAccept)
  +		954	case mmmhttp of
  +		955	Nothing -> return "Activity already in my inbox"
  +		956	Just mmhttp ->
  +		957	case mmhttp of
  +		958	Nothing -> return "Undo object isn't a known activity"
  +		959	Just mhttp ->
  +		960	case mhttp of
  +		961	Nothing -> return "Undo object isn't in use"
  +		962	Just (msg, mremotesHttpFwd, mremotesHttpAccept) -> do
  +		963	for_ mremotesHttpFwd $ \ (sig, remotes) ->
  +		964	forkWorker "repoUndoF inbox-forwarding" $
  +		965	deliverRemoteHTTP_R now shrRecip rpRecip (actbBL body) sig remotes
  +		966	for_ mremotesHttpAccept $ \ (obiid, doc, fwdHosts, remotes) ->
  +		967	forkWorker "repoUndoF Accept HTTP delivery" $
  +		968	deliverRemoteHttp' fwdHosts obiid doc remotes
  +		969	let fwdMsg =
  +		970	case mremotesHttpFwd of
  +		971	Nothing -> "No inbox-forwarding"
  +		972	Just _ -> "Did inbox-forwarding"
  +		973	acceptMsg =
  +		974	case mremotesHttpAccept of
  +		975	Nothing -> "Didn't send Accept"
  +		976	Just _ -> "Sent Accept"
  +		977	return $ msg <> "; " <> fwdMsg <> "; " <> acceptMsg
  …	…	…	…
  -	867		getRecip = do
  -	868		sid <- getKeyBy404 $ UniqueSharer shr
  -	869		getBy404 $ UniqueRepo rp sid
  -	870		tryPatch rid fsid = do
  -	871		mlt <- getValBy $ UniqueLocalTicketFollowers fsid
  -	872		case mlt of
  -	873		Nothing -> return $ Just "Undo object is a RemoteFollow, but isn't under this repo"
  -	874		Just lt -> do
  -	875		mtrl <- runMaybeT $ do
  -	876		tclid <- MaybeT $ getKeyBy $ UniqueTicketContextLocal $ localTicketTicket lt
  -	877		trl <- MaybeT $ getValBy $ UniqueTicketRepoLocal tclid
  -	878		return (tclid, trl)
  -	879		case mtrl of
  -	880		Just (tclid, trl)
  -	881		| ticketRepoLocalRepo trl == rid -> do
  -	882		mtup <- getBy $ UniqueTicketUnderProjectProject tclid
  -	883		return $
  -	884		case mtup of
  -	885		Nothing -> Just "Undo object is a RemoteFollow of a patch under this repo, but is hosted by the author"
  -	886		Just _ -> Nothing
  -	887		_ -> return $ Just "Undo object is a RemoteFollow of a ticket of another project"
  +		1036	myWorkItem (WorkItemRepoPatch shr rp ltid)
  +		1037	| shr == shrRecip && rp == rpRecip = Just ltid
  +		1038	myWorkItem _ = Nothing
  +		1039
  +		1040	prepareAccept ltid = do
  +		1041	ltkhid <- encodeKeyHashid ltid
  +		1042	ra <- getJust $ remoteAuthorId author
  +		1043	let ObjURI hAuthor luAuthor = remoteAuthorURI author
  +		1044	ticketFollowers =
  +		1045	LocalPersonCollectionRepoPatchFollowers shrRecip rpRecip ltkhid
  +		1046	audAuthor =
  +		1047	AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
  +		1048	audTicket =
  +		1049	AudLocal [] [ticketFollowers]
  +		1050	return ([ticketFollowers], [audAuthor, audTicket])
  …	…	…	…

• Edit file src/Vervis/Federation/Ticket.hs 0 → 0

  -	259		, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
  -	260		, ticketCloser = Nothing
  …	…	…	…
  -	805		, ticketClosed = UTCTime (ModifiedJulianDay 0) 0
  -	806		, ticketCloser = Nothing
  …	…	…	…

• Edit file src/Vervis/Form/Ticket.hs 0 → 0

  -	159		<*> pure (ticketClosed ticket)
  -	160		<*> pure (ticketCloser ticket)
  …	…	…	…

• Edit file src/Vervis/Handler/Client.hs 0 → 0

  +		37	, postProjectTicketCloseR
  +		38	, postProjectTicketOpenR
  …	…	…	…
  +		97	import Vervis.Ticket
  …	…	…	…
  +		253	getUser' :: Handler (Entity Person, Sharer)
  +		254	getUser' = do
  +		255	ep@(Entity _ p) <- requireVerifiedAuth
  +		256	s <- runDB $ getJust $ personIdent p
  +		257	return (ep, s)
  +		258
  …	…	…	…
  +		326	ResolveActivity resolve ->
  +		327	resolveC eperson sharer summary audience resolve
  -	320		undoC shr summary audience undo
  +		331	undoC eperson sharer summary audience undo
  …	…	…	…
  -	586		(shrAuthor, pidAuthor) <- getUser
  +		597	(ep@(Entity pid _), s) <- getUser'
  +		598	let shrAuthor = sharerIdent s
  -	590		ExceptT $ undoFollowSharer shrAuthor pidAuthor shrFollowee
  -	591		undoC shrAuthor (Just summary) audience undo
  +		602	ExceptT $ undoFollowSharer shrAuthor pid shrFollowee
  +		603	undoC ep s (Just summary) audience undo
  -	597		(shrAuthor, pidAuthor) <- getUser
  +		609	(ep@(Entity pid _), s) <- getUser'
  +		610	let shrAuthor = sharerIdent s
  -	601		ExceptT $ undoFollowProject shrAuthor pidAuthor shrFollowee prjFollowee
  -	602		undoC shrAuthor (Just summary) audience undo
  +		614	ExceptT $ undoFollowProject shrAuthor pid shrFollowee prjFollowee
  +		615	undoC ep s (Just summary) audience undo
  -	608		(shrAuthor, pidAuthor) <- getUser
  +		621	(ep@(Entity pid _), s) <- getUser'
  +		622	let shrAuthor = sharerIdent s
  -	612		ExceptT $ undoFollowTicket shrAuthor pidAuthor shrFollowee prjFollowee tkhidFollowee
  -	613		undoC shrAuthor (Just summary) audience undo
  +		626	ExceptT $ undoFollowTicket shrAuthor pid shrFollowee prjFollowee tkhidFollowee
  +		627	undoC ep s (Just summary) audience undo
  -	619		(shrAuthor, pidAuthor) <- getUser
  +		633	(ep@(Entity pid _), s) <- getUser'
  +		634	let shrAuthor = sharerIdent s
  -	623		ExceptT $ undoFollowRepo shrAuthor pidAuthor shrFollowee rpFollowee
  -	624		undoC shrAuthor (Just summary) audience undo
  +		638	ExceptT $ undoFollowRepo shrAuthor pid shrFollowee rpFollowee
  +		639	undoC ep s (Just summary) audience undo
  …	…	…	…
  +		869
  +		870	postProjectTicketCloseR
  +		871	:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
  +		872	postProjectTicketCloseR shr prj ltkhid = do
  +		873	encodeRouteHome <- getEncodeRouteHome
  +		874	ep@(Entity _ p) <- requireVerifiedAuth
  +		875	s <- runDB $ getJust $ personIdent p
  +		876	let uTicket = encodeRouteHome $ ProjectTicketR shr prj ltkhid
  +		877	result <- runExceptT $ do
  +		878	(summary, audience, specific) <- ExceptT $ resolve (sharerIdent s) uTicket
  +		879	resolveC ep s summary audience specific
  +		880	case result of
  +		881	Left e -> setMessage $ toHtml $ "Error: " <> e
  +		882	Right _obiid -> setMessage "Ticket closed"
  +		883	redirect $ ProjectTicketR shr prj ltkhid
  +		884
  +		885	postProjectTicketOpenR
  +		886	:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
  +		887	postProjectTicketOpenR shr prj ltkhid = do
  +		888	ep@(Entity _ p) <- requireVerifiedAuth
  +		889	ltid <- decodeKeyHashid404 ltkhid
  +		890	s <- runDB $ getJust $ personIdent p
  +		891	result <- runExceptT $ do
  +		892	(summary, audience, specific) <- ExceptT $ unresolve (sharerIdent s) (WorkItemProjectTicket shr prj ltid)
  +		893	undoC ep s summary audience specific
  +		894	case result of
  +		895	Left e -> setMessage $ toHtml $ "Error: " <> e
  +		896	Right _obiid -> setMessage "Ticket reopened"
  +		897	redirect $ ProjectTicketR shr prj ltkhid
  …	…	…	…

• Edit file src/Vervis/Handler/Ticket.hs 0 → 0

  -	26		, postProjectTicketCloseR
  -	27		, postProjectTicketOpenR
  …	…	…	…
  -	300		author, massignee, mcloser, ticket, lticket, tparams, eparams, cparams) <-
  +		298	author, massignee, ticket, lticket, tparams, eparams, cparams) <-
  …	…	…	…
  -	328		mcloser <-
  -	329		case ticketStatus ticket of
  -	330		TSClosed ->
  -	331		case ticketCloser ticket of
  -	332		Just pidCloser -> Just <$> do
  -	333		person <- getJust pidCloser
  -	334		getJust $ personIdent person
  -	335		Nothing -> error "Closer not set for closed ticket"
  -	336		_ ->
  -	337		case ticketCloser ticket of
  -	338		Just _ -> error "Closer set for open ticket"
  -	339		Nothing -> return Nothing
  -	333		, author', massignee, mcloser, ticket, lticket
  +		319	, author', massignee, ticket, lticket
  …	…	…	…
  -	504		redirect $ ProjectTicketR shr prj ltkhid
  -	505
  -	506		postProjectTicketCloseR
  -	507		:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
  -	508		postProjectTicketCloseR shr prj ltkhid = do
  -	509		pid <- requireAuthId
  -	510		now <- liftIO getCurrentTime
  -	511		succ <- runDB $ do
  -	512		(_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid
  -	513		case ticketStatus ticket of
  -	514		TSClosed -> return False
  -	515		_ -> do
  -	516		update tid
  -	517		[ TicketAssignee =. Nothing
  -	518		, TicketStatus =. TSClosed
  -	519		, TicketClosed =. now
  -	520		, TicketCloser =. Just pid
  -	521		]
  -	522		return True
  -	523		setMessage $
  -	524		if succ
  -	525		then "Ticket closed."
  -	526		else "Ticket is already closed."
  -	527		redirect $ ProjectTicketR shr prj ltkhid
  -	528
  -	529		postProjectTicketOpenR
  -	530		:: ShrIdent -> PrjIdent -> KeyHashid LocalTicket -> Handler Html
  -	531		postProjectTicketOpenR shr prj ltkhid = do
  -	532		pid <- requireAuthId
  -	533		now <- liftIO getCurrentTime
  -	534		succ <- runDB $ do
  -	535		(_es, _ej, Entity tid ticket, _elt, _etcl, _etpl, _author) <- getProjectTicket404 shr prj ltkhid
  -	536		case ticketStatus ticket of
  -	537		TSClosed -> do
  -	538		update tid
  -	539		[ TicketStatus =. TSTodo
  -	540		, TicketCloser =. Nothing
  -	541		]
  -	542		return True
  -	543		_ -> return False
  -	544		setMessage $
  -	545		if succ
  -	546		then "Ticket reopened"
  -	547		else "Ticket is already open."
  …	…	…	…

• Edit file src/Vervis/Migration.hs 0 → 0

  +		1751	-- 277
  +		1752	, removeField "Ticket" "closed"
  +		1753	-- 278
  +		1754	, removeField "Ticket" "closer"
  …	…	…	…

• Edit file src/Vervis/WorkItem.hs 0 → 0

  +		21	, authorAudience
  …	…	…	…
  +		138	authorAudience (Left shr) = AudLocal [LocalActorSharer shr] []
  +		139	authorAudience (Right (ObjURI h lu)) = AudRemote h [lu] []
  +		140
  …	…	…	…

• Edit file src/Web/ActivityPub.hs 0 → 0

  -	1347		{ undoObject :: LocalURI
  +		1347	{ undoObject :: ObjURI u
  -	1351		parseUndo a o = Undo <$> withAuthorityO a (o .: "object")
  +		1351	parseUndo a o = Undo <$> o .: "object"
  -	1354		encodeUndo a (Undo obj) = "object" .= ObjURI a obj
  +		1354	encodeUndo a (Undo obj) = "object" .= obj
  …	…	…	…

• Edit file src/Yesod/MonadSite.hs 0 → 0

  +		31	, runWorkerExcept
  …	…	…	…
  +		203	runWorkerExcept action = do
  +		204	site <- askSite
  +		205	ExceptT $ liftIO $ runWorker (runExceptT action) site
  +		206
  …	…	…	…

• Edit file templates/ticket/one.hamlet 0 → 0

  -	80		Closed on #{showDate $ ticketClosed ticket}
  -	81		$maybe closer <- mcloser
  -	82		by ^{sharerLinkW closer}.
  +		80	Closed on ___ by ___.
  …	…	…	…