1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 01:44:53 +09:00

C2S: Reimplement offerTicketC using the new tools

This commit is contained in:
fr33domlover 2020-07-07 07:26:51 +00:00
parent 511c3c60db
commit 2a6bba89d5
2 changed files with 191 additions and 306 deletions

View file

@ -115,33 +115,6 @@ import Vervis.Settings
import Vervis.Patch import Vervis.Patch
import Vervis.Ticket import Vervis.Ticket
verifyIsLoggedInUser
:: LocalURI
-> Text
-> ExceptT Text AppDB (PersonId, OutboxId, ShrIdent)
verifyIsLoggedInUser lu t = do
Entity pid p <- requireVerifiedAuth
s <- lift $ getJust $ personIdent p
route2local <- getEncodeRouteLocal
let shr = sharerIdent s
if route2local (SharerR shr) == lu
then return (pid, personOutbox p, shr)
else throwE t
verifyAuthor
:: ShrIdent
-> LocalURI
-> Text
-> ExceptT Text AppDB (PersonId, OutboxId)
verifyAuthor shr lu t = ExceptT $ do
Entity sid s <- getBy404 $ UniqueSharer shr
Entity pid p <- getBy404 $ UniquePersonIdent sid
encodeRouteLocal <- getEncodeRouteLocal
return $
if encodeRouteLocal (SharerR shr) == lu
then Right (pid, personOutbox p)
else Left t
parseComment :: LocalURI -> ExceptT Text Handler (ShrIdent, LocalMessageId) parseComment :: LocalURI -> ExceptT Text Handler (ShrIdent, LocalMessageId)
parseComment luParent = do parseComment luParent = do
route <- case decodeRouteLocal luParent of route <- case decodeRouteLocal luParent of
@ -508,6 +481,20 @@ createNoteC (Entity pidUser personUser) sharerUser summary audience note muTarge
update obiidCreate [OutboxItemActivity =. persistJSONObjectFromDoc create] update obiidCreate [OutboxItemActivity =. persistJSONObjectFromDoc create]
return create return create
checkFederation remoteRecips = do
federation <- asksSite $ appFederation . appSettings
unless (federation || null remoteRecips) $
throwE "Federation disabled, but remote recipients found"
verifyProjectRecip (Right _) _ = return ()
verifyProjectRecip (Left (shr, prj)) localRecips =
fromMaybeE verify "Local context project isn't listed as a recipient"
where
verify = do
sharerSet <- lookup shr localRecips
projectSet <- lookup prj $ localRecipProjectRelated sharerSet
guard $ localRecipProject $ localRecipProjectDirect projectSet
-- | Handle a Ticket submitted by a local user to their outbox. The ticket's -- | Handle a Ticket submitted by a local user to their outbox. The ticket's
-- context project may be local or remote. Return an error message if the -- context project may be local or remote. Return an error message if the
-- Ticket is rejected, otherwise the new 'TicketAuthorLocalId'. -- Ticket is rejected, otherwise the new 'TicketAuthorLocalId'.
@ -602,20 +589,6 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
_ -> throwE "Ticket context isn't a project route" _ -> throwE "Ticket context isn't a project route"
else return $ Right u else return $ Right u
checkFederation remoteRecips = do
federation <- asksSite $ appFederation . appSettings
unless (federation || null remoteRecips) $
throwE "Federation disabled, but remote recipients found"
verifyProjectRecip (Right _) _ = return ()
verifyProjectRecip (Left (shr, prj)) localRecips =
fromMaybeE verify "Local context project isn't listed as a recipient"
where
verify = do
sharerSet <- lookup shr localRecips
projectSet <- lookup prj $ localRecipProjectRelated sharerSet
guard $ localRecipProject $ localRecipProjectDirect projectSet
fetchTracker c u@(ObjURI h lu) = do fetchTracker c u@(ObjURI h lu) = do
hl <- hostIsLocal h hl <- hostIsLocal h
case (hl, c) of case (hl, c) of
@ -639,14 +612,6 @@ createTicketC (Entity pidUser personUser) sharerUser summary audience ticket muT
return (iid, era) return (iid, era)
return (iid, era, if lu == lu' then Nothing else Just lu') return (iid, era, if lu == lu' then Nothing else Just lu')
insertEmptyOutboxItem obid now = do
h <- asksSite siteInstanceHost
insert OutboxItem
{ outboxItemOutbox = obid
, outboxItemActivity = persistJSONObjectFromDoc $ Doc h emptyActivity
, outboxItemPublished = now
}
prepareProject now (Left (shr, prj)) = Left <$> do prepareProject now (Left (shr, prj)) = Left <$> do
mej <- lift $ runMaybeT $ do mej <- lift $ runMaybeT $ do
sid <- MaybeT $ getKeyBy $ UniqueSharer shr sid <- MaybeT $ getKeyBy $ UniqueSharer shr
@ -997,230 +962,140 @@ followC shrUser summary audience follow@(AP.Follow uObject muContext hide) = do
insert_ $ InboxItemLocal ibidAuthor obiidAccept ibiid insert_ $ InboxItemLocal ibidAuthor obiidAccept ibiid
offerTicketC offerTicketC
:: ShrIdent :: Entity Person
-> Sharer
-> Maybe TextHtml -> Maybe TextHtml
-> Audience URIMode -> Audience URIMode
-> AP.Ticket URIMode -> AP.Ticket URIMode
-> FedURI -> FedURI
-> ExceptT Text Handler OutboxItemId -> ExceptT Text Handler OutboxItemId
offerTicketC shrUser summary audience ticket uTarget = do offerTicketC (Entity pidUser personUser) sharerUser summary audience ticket uTarget = do
(hProject, shrProject, prjProject) <- parseTarget uTarget let shrUser = sharerIdent sharerUser
{-deps <- -} (title, desc, source, target) <- checkTicket shrUser ticket uTarget
checkOffer hProject shrProject prjProject
(localRecips, remoteRecips) <- do (localRecips, remoteRecips) <- do
mrecips <- parseAudience audience mrecips <- parseAudience audience
fromMaybeE mrecips "Offer with no recipients" fromMaybeE mrecips "Offer Ticket with no recipients"
federation <- asksSite $ appFederation . appSettings federation <- asksSite $ appFederation . appSettings
unless (federation || null remoteRecips) $ unless (federation || null remoteRecips) $
throwE "Federation disabled, but remote recipients specified" throwE "Federation disabled, but remote recipients specified"
checkRecips hProject shrProject prjProject localRecips verifyProjectRecip target localRecips
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
(obiid, doc, remotesHttp) <- runDBExcept $ do (obiidOffer, docOffer, remotesHttpOffer, maybeAccept) <- runDBExcept $ do
(pidAuthor, obidAuthor) <- mproject <-
verifyAuthor case target of
shrUser Left (shr, prj) -> Just <$> do
(AP.ticketAttributedTo ticket) mproj <- lift $ runMaybeT $ do
"Ticket attributed to different actor" Entity sid s <- MaybeT $ getBy $ UniqueSharer shr
mprojAndDeps <- do ej <- MaybeT $ getBy $ UniqueProject prj sid
targetIsLocal <- hostIsLocal hProject return (s, ej)
if targetIsLocal fromMaybeE mproj "Offer target no such local project in DB"
then Just <$> getProjectAndDeps shrProject prjProject {-deps-} Right _ -> return Nothing
else return Nothing (obiid, doc, luOffer) <- lift $ insertOfferToOutbox shrUser now (personOutbox personUser)
(obiid, doc, luOffer) <- lift $ insertToOutbox now obidAuthor remotesHttpOffer <- do
moreRemotes <- let sieve =
lift $ deliverLocal pidAuthor shrProject prjProject now mprojAndDeps obiid luOffer localRecips case target of
unless (federation || null moreRemotes) $ Left (shr, prj) ->
throwE "Federation disabled but remote collection members found" makeRecipientSet
remotesHttp <- lift $ deliverRemoteDB' hProject obiid remoteRecips moreRemotes [ LocalActorProject shr prj
return (obiid, doc, remotesHttp) ]
lift $ forkWorker "Outbox POST handler: async HTTP delivery" $ deliverRemoteHttp hProject obiid doc remotesHttp [ LocalPersonCollectionSharerFollowers shrUser
return obiid , LocalPersonCollectionProjectTeam shr prj
, LocalPersonCollectionProjectFollowers shr prj
]
Right _ ->
makeRecipientSet
[]
[LocalPersonCollectionSharerFollowers shrUser]
moreRemoteRecips <-
lift $
deliverLocal'
True
(LocalActorSharer shrUser)
(personInbox personUser)
obiid
(localRecipSieve sieve False localRecips)
unless (federation || null moreRemoteRecips) $
throwE "Federation disabled, but recipient collection remote members found"
lift $ deliverRemoteDB' (objUriAuthority uTarget) obiid remoteRecips moreRemoteRecips
maccept <- lift $ for mproject $ \ (s, Entity jid j) -> do
let shrJ = sharerIdent s
prj = projectIdent j
obiidAccept <- insertEmptyOutboxItem (projectOutbox j) now
ltid <- insertTicket pidUser now title desc source jid obiid obiidAccept
(docAccept, localRecipsAccept) <- insertAccept shrUser luOffer shrJ prj obiidAccept ltid
knownRemoteRecipsAccept <-
deliverLocal'
False
(LocalActorProject shrJ prj)
(projectInbox j)
obiidAccept
localRecipsAccept
(obiidAccept,docAccept,) <$> deliverRemoteDB'' [] obiidAccept [] knownRemoteRecipsAccept
return (obiid, doc, remotesHttpOffer, maccept)
lift $ do
forkWorker "offerTicketC: async HTTP Offer delivery" $ deliverRemoteHttp (objUriAuthority uTarget) obiidOffer docOffer remotesHttpOffer
for_ maybeAccept $ \ (obiidAccept, docAccept, remotesHttpAccept) ->
forkWorker "offerTicketC: async HTTP Accept delivery" $ deliverRemoteHttp' [] obiidAccept docAccept remotesHttpAccept
return obiidOffer
where where
checkOffer hProject shrProject prjProject = do checkTicket
verifyNothingE (AP.ticketLocal ticket) "Ticket with 'id'" shrUser
(AP.Ticket mlocal attrib mpublished mupdated muContext summary
content source muAssigned resolved mmr)
uTarget = do
verifyNothingE mlocal "Ticket with 'id'"
shrAttrib <- do
route <- fromMaybeE (decodeRouteLocal attrib) "Ticket attrib not a valid route"
case route of
SharerR shr -> return shr
_ -> throwE "Ticket attrib not a sharer route"
unless (shrAttrib == shrUser) $
throwE "Ticket attibuted to someone else"
verifyNothingE (AP.ticketPublished ticket) "Ticket with 'published'" verifyNothingE (AP.ticketPublished ticket) "Ticket with 'published'"
verifyNothingE (AP.ticketUpdated ticket) "Ticket with 'updated'" verifyNothingE (AP.ticketUpdated ticket) "Ticket with 'updated'"
-- verifyNothingE (AP.ticketName ticket) "Ticket with 'name'" for_ muContext $ \ uContext ->
verifyNothingE (AP.ticketAssignedTo ticket) "Ticket with 'assignedTo'" unless (uContext == uTarget) $ throwE "Offer target != ticket context"
when (AP.ticketIsResolved ticket) $ throwE "Ticket resolved" verifyNothingE muAssigned "Ticket has 'assignedTo'"
checkRecips hProject shrProject prjProject localRecips = do when resolved $ throwE "Ticket is resolved"
local <- hostIsLocal hProject verifyNothingE mmr "Ticket has 'attachment'"
if local target <- parseTarget uTarget
then traverse (verifyOfferRecips shrProject prjProject) localRecips return (summary, content, source, target)
else traverse (verifyOnlySharer . snd) localRecips
where where
verifyOfferRecips shr prj (shr', lsrSet) = parseTarget u@(ObjURI h lu) = do
if shr == shr' hl <- hostIsLocal h
then unless (lsrSet == offerRecips prj) $ if hl
throwE "Unexpected offer target recipient set" then Left <$> do
else verifyOnlySharer lsrSet route <- fromMaybeE (decodeRouteLocal lu) "Offer target is local but not a valid route"
where case route of
offerRecips prj = LocalSharerRelatedSet ProjectR shr prj -> return (shr, prj)
{ localRecipSharerDirect = LocalSharerDirectSet False False RepoR _ _ -> throwE "Offering patch to repo not implemented yet"
, localRecipSharerTicketRelated = [] _ -> throwE "Offer target is local but isn't a project/repo route"
, localRecipProjectRelated = else return $ Right u
[ ( prj insertOfferToOutbox shrUser now obid = do
, LocalProjectRelatedSet
{ localRecipProjectDirect =
LocalProjectDirectSet True True True
, localRecipProjectTicketRelated = []
}
)
]
, localRecipRepoRelated = []
}
verifyOnlySharer lsrSet = do
unless (null $ localRecipProjectRelated lsrSet) $
throwE "Unexpected recipients unrelated to offer target"
unless (null $ localRecipRepoRelated lsrSet) $
throwE "Unexpected recipients unrelated to offer target"
insertToOutbox now obid = do
hLocal <- asksSite siteInstanceHost hLocal <- asksSite siteInstanceHost
let activity mluAct = Doc hLocal Activity obiid <- insertEmptyOutboxItem obid now
{ activityId = mluAct encodeRouteLocal <- getEncodeRouteLocal
, activityActor = AP.ticketAttributedTo ticket obikhid <- encodeKeyHashid obiid
, activitySummary = Just summary let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
doc = Doc hLocal Activity
{ activityId = Just luAct
, activityActor = encodeRouteLocal $ SharerR shrUser
, activitySummary = summary
, activityAudience = audience , activityAudience = audience
, activitySpecific = , activitySpecific =
OfferActivity $ Offer (OfferTicket ticket) uTarget OfferActivity $ Offer (OfferTicket ticket) uTarget
} }
obiid <- insert OutboxItem
{ outboxItemOutbox = obid
, outboxItemActivity =
persistJSONObjectFromDoc $ activity Nothing
, outboxItemPublished = now
}
encodeRouteLocal <- getEncodeRouteLocal
obikhid <- encodeKeyHashid obiid
let luAct = encodeRouteLocal $ SharerOutboxItemR shrUser obikhid
doc = activity $ Just luAct
update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc] update obiid [OutboxItemActivity =. persistJSONObjectFromDoc doc]
return (obiid, doc, luAct) return (obiid, doc, luAct)
deliverLocal pidAuthor shrProject prjProject now mprojAndDeps obiid luOffer recips = do insertTicket pidAuthor now title desc source jid obiid obiidAccept = do
(pids, remotes) <- forCollect recips $ \ (shr, LocalSharerRelatedSet sharer _ _ projects _) -> do
(pids, remotes) <-
traverseCollect (uncurry $ deliverLocalProject shr) projects
pids' <- do
mpid <-
if localRecipSharer sharer
then runMaybeT $ do
sid <- MaybeT $ getKeyBy $ UniqueSharer shr
MaybeT $ getKeyBy $ UniquePersonIdent sid
else return Nothing
return $
case mpid of
Nothing -> pids
Just pid -> LO.insertSet pid pids
return (pids', remotes)
for_ (L.delete pidAuthor pids) $ \ pid -> do
ibid <- personInbox <$> getJust pid
ibiid <- insert $ InboxItem True
insert_ $ InboxItemLocal ibid obiid ibiid
return remotes
where
traverseCollect action values =
bimap collectPids collectRemotes . unzip <$> traverse action values
where
collectPids = foldl' LO.union []
collectRemotes = foldl' unionRemotes []
forCollect = flip traverseCollect
deliverLocalProject shr prj (LocalProjectRelatedSet project _) =
case mprojAndDeps of
Just (sid, jid, ibid, fsid{-, tids-})
| shr == shrProject &&
prj == prjProject &&
localRecipProject project -> do
insertToInbox ibid
{-
num <-
((subtract 1) . projectNextTicket) <$>
updateGet jid [ProjectNextTicket +=. 1]
-}
obiidAccept <- do
obidProject <- projectOutbox <$> getJust jid
now <- liftIO getCurrentTime
hLocal <- asksSite siteInstanceHost
insert OutboxItem
{ outboxItemOutbox = obidProject
, outboxItemActivity =
persistJSONObjectFromDoc $ Doc hLocal emptyActivity
, outboxItemPublished = now
}
ltid <- insertTicket jid {-tids-} {-num-} obiidAccept
docAccept <- insertAccept pidAuthor sid jid fsid luOffer obiidAccept ltid
publishAccept pidAuthor sid jid fsid luOffer {-num-} obiidAccept docAccept
(pidsTeam, remotesTeam) <-
if localRecipProjectTeam project
then getProjectTeam sid
else return ([], [])
(pidsFollowers, remotesFollowers) <-
if localRecipProjectFollowers project
then getFollowers fsid
else return ([], [])
return
( LO.union pidsTeam pidsFollowers
, unionRemotes remotesTeam remotesFollowers
)
_ -> return ([], [])
where
insertToInbox ibid = do
ibiid <- insert $ InboxItem False
insert_ $ InboxItemLocal ibid obiid ibiid
insertAccept pidAuthor sid jid fsid luOffer obiid ltid = do
ltkhid <- encodeKeyHashid ltid
summary <-
TextHtml . TL.toStrict . renderHtml <$>
withUrlRenderer
[hamlet|
<p>
<a href=@{SharerR shrUser}>
#{shr2text shrUser}
's ticket accepted by project #
<a href=@{ProjectR shrProject prjProject}>
./s/#{shr2text shrProject}/p/#{prj2text prjProject}
: #
<a href=@{ProjectTicketR shrProject prjProject ltkhid}>
#{preEscapedToHtml $ unTextHtml $ AP.ticketSummary ticket}.
|]
hLocal <- asksSite siteInstanceHost
encodeRouteLocal <- getEncodeRouteLocal
encodeRouteHome <- getEncodeRouteHome
obikhid <- encodeKeyHashid obiid
let recips =
map encodeRouteHome
[ SharerR shrUser
, ProjectTeamR shrProject prjProject
, ProjectFollowersR shrProject prjProject
]
doc = Doc hLocal Activity
{ activityId =
Just $ encodeRouteLocal $
ProjectOutboxItemR shrProject prjProject obikhid
, activityActor =
encodeRouteLocal $ ProjectR shrProject prjProject
, activitySummary = Just summary
, activityAudience = Audience recips [] [] [] [] []
, activitySpecific = AcceptActivity Accept
{ acceptObject = ObjURI hLocal luOffer
, acceptResult =
Just $ encodeRouteLocal $
ProjectTicketR shrProject prjProject ltkhid
}
}
update
obiid
[OutboxItemActivity =. persistJSONObjectFromDoc doc]
return doc
insertTicket jid {-tidsDeps-} {-next-} obiidAccept = do
did <- insert Discussion did <- insert Discussion
fsid <- insert FollowerSet fsid <- insert FollowerSet
tid <- insert Ticket tid <- insert Ticket
{ ticketNumber = Nothing { ticketNumber = Nothing
, ticketCreated = now , ticketCreated = now
, ticketTitle = unTextHtml $ AP.ticketSummary ticket , ticketTitle = unTextHtml title
, ticketSource = , ticketSource = unTextPandocMarkdown source
unTextPandocMarkdown $ AP.ticketSource ticket , ticketDescription = unTextHtml desc
, ticketDescription = unTextHtml $ AP.ticketContent ticket
, ticketAssignee = Nothing , ticketAssignee = Nothing
, ticketStatus = TSNew , ticketStatus = TSNew
, ticketClosed = UTCTime (ModifiedJulianDay 0) 0 , ticketClosed = UTCTime (ModifiedJulianDay 0) 0
@ -1248,28 +1123,37 @@ offerTicketC shrUser summary audience ticket uTarget = do
{ ticketUnderProjectProject = tclid { ticketUnderProjectProject = tclid
, ticketUnderProjectAuthor = talid , ticketUnderProjectAuthor = talid
} }
--insertMany_ $ map (TicketDependency tid) tidsDeps
-- insert_ $ Follow pidAuthor fsid False True
return ltid return ltid
publishAccept pidAuthor sid jid fsid luOffer {-num-} obiid doc = do insertAccept shrUser luOffer shrJ prj obiidAccept ltid = do
now <- liftIO getCurrentTime encodeRouteLocal <- getEncodeRouteLocal
let dont = Authority "dont-do.any-forwarding" Nothing encodeRouteHome <- getEncodeRouteHome
remotesHttp <- do hLocal <- asksSite siteInstanceHost
moreRemotes <- deliverLocal now sid fsid obiid obikhidAccept <- encodeKeyHashid obiidAccept
deliverRemoteDB' dont obiid [] moreRemotes ltkhid <- encodeKeyHashid ltid
site <- askSite let actors = [LocalActorSharer shrUser]
liftIO $ runWorker (deliverRemoteHttp dont obiid doc remotesHttp) site collections =
where [ LocalPersonCollectionProjectTeam shrJ prj
deliverLocal now sid fsid obiid = do , LocalPersonCollectionProjectFollowers shrJ prj
(pidsTeam, remotesTeam) <- getProjectTeam sid ]
(pidsFollowers, remotesFollowers) <- getFollowers fsid recips =
let pids = LO.insertSet pidAuthor $ LO.union pidsTeam pidsFollowers map encodeRouteHome $
remotes = unionRemotes remotesTeam remotesFollowers map renderLocalActor actors ++
for_ pids $ \ pid -> do map renderLocalPersonCollection collections
ibid <- personInbox <$> getJust pid doc = Doc hLocal Activity
ibiid <- insert $ InboxItem True { activityId =
insert_ $ InboxItemLocal ibid obiid ibiid Just $ encodeRouteLocal $
return remotes ProjectOutboxItemR shrJ prj obikhidAccept
, activityActor = encodeRouteLocal $ ProjectR shrJ prj
, activitySummary = Nothing
, activityAudience = Audience recips [] [] [] [] []
, activitySpecific = AcceptActivity Accept
{ acceptObject = ObjURI hLocal luOffer
, acceptResult =
Just $ encodeRouteLocal $ ProjectTicketR shrJ prj ltkhid
}
}
update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
return (doc, makeRecipientSet actors collections)
undoC undoC
:: ShrIdent :: ShrIdent

View file

@ -301,7 +301,7 @@ postSharerOutboxR shr = do
OfferActivity (Offer obj target) -> OfferActivity (Offer obj target) ->
case obj of case obj of
OfferTicket ticket -> OfferTicket ticket ->
offerTicketC shr summary audience ticket target offerTicketC eperson sharer summary audience ticket target
_ -> throwE "Unsupported Offer 'object' type" _ -> throwE "Unsupported Offer 'object' type"
UndoActivity undo -> UndoActivity undo ->
undoC shr summary audience undo undoC shr summary audience undo
@ -336,7 +336,7 @@ postPublishR = do
FormMissing -> throwE "Field(s) missing" FormMissing -> throwE "Field(s) missing"
FormFailure _l -> throwE "Invalid input, see below" FormFailure _l -> throwE "Invalid input, see below"
FormSuccess r -> return r FormSuccess r -> return r
bitraverse (bitraverse (publishComment ep s) (publishTicket ep s)) (bitraverse (openTicket shrAuthor) (follow shrAuthor)) input bitraverse (bitraverse (publishComment ep s) (publishTicket ep s)) (bitraverse (openTicket ep s) (follow shrAuthor)) input
case eid of case eid of
Left err -> setMessage $ toHtml err Left err -> setMessage $ toHtml err
Right id_ -> Right id_ ->
@ -412,11 +412,12 @@ postPublishR = do
_ -> error "Create object isn't a ticket" _ -> error "Create object isn't a ticket"
target = createTarget create target = createTarget create
createTicketC eperson sharer (Just summary) audience ticket target createTicketC eperson sharer (Just summary) audience ticket target
openTicket shrAuthor ((h, shr, prj), TextHtml title, TextPandocMarkdown desc) = do openTicket eperson sharer ((h, shr, prj), TextHtml title, TextPandocMarkdown desc) = do
encodeRouteLocal <- getEncodeRouteLocal encodeRouteLocal <- getEncodeRouteLocal
encodeRouteFed <- getEncodeRouteFed encodeRouteFed <- getEncodeRouteFed
local <- hostIsLocal h local <- hostIsLocal h
descHtml <- ExceptT . pure $ renderPandocMarkdown desc descHtml <- ExceptT . pure $ renderPandocMarkdown desc
let shrAuthor = sharerIdent sharer
summary <- summary <-
TextHtml . TL.toStrict . renderHtml <$> TextHtml . TL.toStrict . renderHtml <$>
withUrlRenderer withUrlRenderer
@ -459,7 +460,7 @@ postPublishR = do
, audienceGeneral = [] , audienceGeneral = []
, audienceNonActors = map (encodeRouteFed h) recipsC , audienceNonActors = map (encodeRouteFed h) recipsC
} }
offerTicketC shrAuthor (Just summary) audience ticketAP target offerTicketC eperson sharer (Just summary) audience ticketAP target
follow shrAuthor (uObject@(ObjURI hObject luObject), uRecip) = do follow shrAuthor (uObject@(ObjURI hObject luObject), uRecip) = do
(summary, audience, followAP) <- (summary, audience, followAP) <-
C.follow shrAuthor uObject uRecip False C.follow shrAuthor uObject uRecip False
@ -788,7 +789,7 @@ postProjectTicketsR shr prj = do
then Right <$> do then Right <$> do
(summary, audience, ticket, target) <- (summary, audience, ticket, target) <-
ExceptT $ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj ExceptT $ offerTicket shrAuthor (TextHtml title) (TextPandocMarkdown desc) shr prj
obiid <- offerTicketC shrAuthor (Just summary) audience ticket target obiid <- offerTicketC eperson sharer (Just summary) audience ticket target
ExceptT $ runDB $ do ExceptT $ runDB $ do
mtal <- getValBy $ UniqueTicketAuthorLocalOpen obiid mtal <- getValBy $ UniqueTicketAuthorLocalOpen obiid
return $ return $