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-09-13 |
Title | C2S: addBundleC for adding a new patch bundle version to a Ticket |
Description |
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" |
|
… | … | … | … |