NOTE: Federation is disabled on this instance!

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

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

  -	17		( noteC
  +		17	( addBundleC
  +		18	, noteC
  …	…	…	…
  +		124	addBundleC
  +		125	:: Entity Person
  +		126	-> Sharer
  +		127	-> Maybe TextHtml
  +		128	-> Audience URIMode
  +		129	-> NonEmpty (AP.Patch URIMode)
  +		130	-> FedURI
  +		131	-> ExceptT Text Handler OutboxItemId
  +		132	addBundleC (Entity pidUser personUser) sharerUser summary audience patches uTarget = do
  +		133	let shrUser = sharerIdent sharerUser
  +		134	ticket <- do
  +		135	t <- parseWorkItem "Target" uTarget
  +		136	bitraverse
  +		137	(\ wi ->
  +		138	case wi of
  +		139	WorkItemSharerTicket shr talid patch -> do
  +		140	unless patch $ throwE "Target is a non-MR sharer-ticket"
  +		141	return $ Left (shr, talid)
  +		142	WorkItemProjectTicket _ _ _ ->
  +		143	throwE "Target is a project-ticket"
  +		144	WorkItemRepoProposal shr rp ltid ->
  +		145	return $ Right (shr, rp, ltid)
  +		146	)
  +		147	pure
  +		148	t
  +		149	(typ, diffs) <- do
  +		150	((typ, diff) :| rest) <-
  +		151	for patches $ \ (AP.Patch mlocal attrib mpub typ content) -> do
  +		152	verifyNothingE mlocal "Patch with 'id'"
  +		153	shrAttrib <- do
  +		154	route <- fromMaybeE (decodeRouteLocal attrib) "Patch attrib not a valid route"
  +		155	case route of
  +		156	SharerR shr -> return shr
  +		157	_ -> throwE "Patch attrib not a sharer route"
  +		158	unless (shrAttrib == shrUser) $
  +		159	throwE "Add and Patch attrib mismatch"
  +		160	verifyNothingE mpub "Patch has 'published'"
  +		161	return (typ, content)
  +		162	let (typs, diffs) = unzip rest
  +		163	unless (all (== typ) typs) $ throwE "Patches of different media types"
  +		164	return (typ, diff :| diffs)
  +		165	ParsedAudience localRecips remoteRecips blinded fwdHosts <- do
  +		166	mrecips <- parseAudience audience
  +		167	fromMaybeE mrecips "Add Bundle with no recipients"
  +		168	federation <- asksSite $ appFederation . appSettings
  +		169	unless (federation || null remoteRecips) $
  +		170	throwE "Federation disabled, but remote recipients specified"
  +		171	let ticketWI = first toWorkItem ticket
  +		172	verifyHosterRecip localRecips "Ticket" ticketWI
  +		173	now <- liftIO getCurrentTime
  +		174	ticketDetail <- runWorkerExcept $ getWorkItemDetail "Ticket" ticketWI
  +		175	(obiidAdd, docAdd, remotesHttpAdd, maybeAccept) <- runDBExcept $ do
  +		176	(obiid, doc, luAdd) <- lift $ insertAddToOutbox shrUser now (personOutbox personUser) blinded
  +		177	remotesHttpAdd <- do
  +		178	wiFollowers <- askWorkItemFollowers
  +		179	let sieve =
  +		180	let (ticketA, ticketC) =
  +		181	workItemRecipSieve wiFollowers ticketDetail
  +		182	in makeRecipientSet
  +		183	ticketA
  +		184	(LocalPersonCollectionSharerFollowers shrUser :
  +		185	ticketC
  +		186	)
  +		187	moreRemoteRecips <-
  +		188	lift $
  +		189	deliverLocal'
  +		190	True
  +		191	(LocalActorSharer shrUser)
  +		192	(personInbox personUser)
  +		193	obiid
  +		194	(localRecipSieve sieve False localRecips)
  +		195	unless (federation || null moreRemoteRecips) $
  +		196	throwE "Federation disabled, but recipient collection remote members found"
  +		197	lift $ deliverRemoteDB'' fwdHosts obiid remoteRecips moreRemoteRecips
  +		198	maccept <-
  +		199	case widIdent ticketDetail of
  +		200	Right _ -> return Nothing
  +		201	Left (wi, ltid) -> Just <$> do
  +		202	let local =
  +		203	case ticket of
  +		204	Left l -> l
  +		205	Right _ -> error "Impossible wi"
  +		206	mhoster <-
  +		207	case local of
  +		208	Left (shr, _) -> lift $ runMaybeT $ do
  +		209	sid <- MaybeT $ getKeyBy $ UniqueSharer shr
  +		210	p <- MaybeT (getValBy $ UniquePersonIdent sid)
  +		211	return (personOutbox p, personInbox p)
  +		212	Right (shr, rp, _) -> runMaybeT $ do
  +		213	sid <- MaybeT $ lift $ getKeyBy $ UniqueSharer shr
  +		214	r <- MaybeT (lift $ getValBy $ UniqueRepo rp sid)
  +		215	unless (repoVcs r == patchMediaTypeVCS typ) $
  +		216	lift $ throwE "Patch type and repo VCS mismatch"
  +		217	return (repoOutbox r, repoInbox r)
  +		218	(obidHoster, ibidHoster) <- fromMaybeE mhoster "Ticket hoster not in DB"
  +		219	obiidAccept <- lift $ insertEmptyOutboxItem obidHoster now
  +		220	tid <- lift $ localTicketTicket <$> getJust ltid
  +		221	bnid <- lift $ insert $ Bundle tid
  +		222	lift $ insertMany_ $ NE.toList $ NE.map (Patch bnid now typ) diffs
  +		223	(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
  +		224	lift $ insertAccept shrUser local ticketDetail obiid obiidAccept bnid
  +		225	knownRemoteRecipsAccept <-
  +		226	lift $
  +		227	deliverLocal'
  +		228	False
  +		229	(workItemActor wi)
  +		230	ibidHoster
  +		231	obiidAccept
  +		232	localRecipsAccept
  +		233	lift $ (obiidAccept,docAccept,fwdHostsAccept,) <$>
  +		234	deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
  +		235	return (obiid, doc, remotesHttpAdd, maccept)
  +		236	lift $ do
  +		237	forkWorker "addBundleC: async HTTP Offer delivery" $
  +		238	deliverRemoteHttp' fwdHosts obiidAdd docAdd remotesHttpAdd
  +		239	for_ maybeAccept $ \ (obiidAccept, docAccept, fwdHostsAccept, remotesHttpAccept) ->
  +		240	forkWorker "addBundleC: async HTTP Accept delivery" $
  +		241	deliverRemoteHttp' fwdHostsAccept obiidAccept docAccept remotesHttpAccept
  +		242	return obiidAdd
  +		243	where
  +		244	toWorkItem (Left (shr, talid)) = WorkItemSharerTicket shr talid True
  +		245	toWorkItem (Right (shr, rp, ltid)) = WorkItemRepoProposal shr rp ltid
  +		246
  +		247	insertAddToOutbox shrUser now obid blinded = do
  +		248	hLocal <- asksSite siteInstanceHost
  +		249	obiid <- insertEmptyOutboxItem obid now
  +		250	encodeRouteLocal <- getEncodeRouteLocal
  +		251	obikhid <- encodeKeyHashid obiid
  +		252	let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
  +		253	doc = Doc hLocal Activity
  +		254	{ activityId = Just luAct
  +		255	, activityActor = encodeRouteLocal $ SharerR shrUser
  +		256	, activitySummary = summary
  +		257	, activityAudience = blinded
  +		258	, activitySpecific =
  +		259	AddActivity $ AP.Add (Right $ AddBundle patches) uTarget
  +		260	}
  +		261	update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
  +		262	return (obiid, doc, luAct)
  +		263
  +		264	workItemActor (WorkItemSharerTicket shr _ _) = LocalActorSharer shr
  +		265	workItemActor (WorkItemProjectTicket shr prj _) = LocalActorProject shr prj
  +		266	workItemActor (WorkItemRepoProposal shr rp _) = LocalActorRepo shr rp
  +		267
  +		268	insertAccept shrUser local (WorkItemDetail _ ctx ticketAuthor) obiidAdd obiidAccept bnid = do
  +		269	let wi = toWorkItem local
  +		270	encodeRouteLocal <- getEncodeRouteLocal
  +		271	encodeRouteHome <- getEncodeRouteHome
  +		272	wiFollowers <- askWorkItemFollowers
  +		273	wiBundleRoute <- getWiBundleRoute
  +		274	hLocal <- asksSite siteInstanceHost
  +		275
  +		276	obikhidAdd <- encodeKeyHashid obiidAdd
  +		277	obikhidAccept <- encodeKeyHashid obiidAccept
  +		278	bnkhid <- encodeKeyHashid bnid
  +		279
  +		280	let audAuthor =
  +		281	AudLocal
  +		282	[LocalActorSharer shrUser]
  +		283	[LocalPersonCollectionSharerFollowers shrUser]
  +		284	audTicketContext = contextAudience ctx
  +		285	audTicketAuthor = authorAudience ticketAuthor
  +		286	audTicketFollowers = AudLocal [] [wiFollowers wi]
  +		287
  +		288	(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
  +		289	collectAudience $
  +		290	audAuthor :
  +		291	audTicketAuthor :
  +		292	audTicketFollowers :
  +		293	audTicketContext
  +		294
  +		295	actor = workItemActor wi
  +		296	recips = map encodeRouteHome audLocal ++ audRemote
  +		297	doc = Doc hLocal Activity
  +		298	{ activityId =
  +		299	Just $ encodeRouteLocal $
  +		300	actorOutboxItem actor obikhidAccept
  +		301	, activityActor = encodeRouteLocal $ renderLocalActor actor
  +		302	, activitySummary = Nothing
  +		303	, activityAudience = Audience recips [] [] [] [] []
  +		304	, activitySpecific = AcceptActivity Accept
  +		305	{ acceptObject =
  +		306	encodeRouteHome $ SharerOutboxItemR shrUser obikhidAdd
  +		307	, acceptResult =
  +		308	Just $ encodeRouteLocal $ wiBundleRoute local bnkhid
  +		309	}
  +		310	}
  +		311
  +		312	update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
  +		313	return (doc, recipientSet, remoteActors, fwdHosts)
  +		314	where
  +		315	getWiBundleRoute = do
  +		316	hashLTID <- getEncodeKeyHashid
  +		317	hashTALID <- getEncodeKeyHashid
  +		318	return $ \ wi ->
  +		319	case wi of
  +		320	Left (shr, talid) ->
  +		321	SharerProposalBundleR shr $ hashTALID talid
  +		322	Right (shr, rp, ltid) ->
  +		323	RepoProposalBundleR shr rp $ hashLTID ltid
  +		324
  …	…	…	…

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

  +		378	AddActivity (AP.Add obj target) ->
  +		379	case obj of
  +		380	Right (AddBundle patches) ->
  +		381	addBundleC eperson sharer summary audience patches target
  +		382	_ -> throwE "Unsupported Add 'object' type"
  …	…	…	…