S2S: deckOfferTicketF (i.e. local deck receives ticket from remote author)
This commit is contained in:
parent
0d922b0e5a
commit
ef8e1c1108
4 changed files with 178 additions and 102 deletions
|
@ -14,19 +14,20 @@
|
||||||
-}
|
-}
|
||||||
|
|
||||||
module Vervis.Federation.Ticket
|
module Vervis.Federation.Ticket
|
||||||
( personOfferTicketF
|
( --personOfferTicketF
|
||||||
, deckOfferTicketF
|
deckOfferTicketF
|
||||||
, repoOfferTicketF
|
--, repoOfferTicketF
|
||||||
|
|
||||||
, repoAddBundleF
|
--, repoAddBundleF
|
||||||
|
|
||||||
, repoApplyF
|
--, repoApplyF
|
||||||
|
--, loomApplyF
|
||||||
|
|
||||||
, deckOfferDepF
|
--, deckOfferDepF
|
||||||
, repoOfferDepF
|
--, repoOfferDepF
|
||||||
|
|
||||||
, deckResolveF
|
--, deckResolveF
|
||||||
, repoResolveF
|
--, repoResolveF
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -90,7 +91,9 @@ import Development.PatchMediaType
|
||||||
|
|
||||||
import Vervis.ActivityPub
|
import Vervis.ActivityPub
|
||||||
import Vervis.Cloth
|
import Vervis.Cloth
|
||||||
|
import Vervis.Data.Ticket
|
||||||
import Vervis.Darcs
|
import Vervis.Darcs
|
||||||
|
import Vervis.Delivery
|
||||||
import Vervis.FedURI
|
import Vervis.FedURI
|
||||||
import Vervis.Federation.Auth
|
import Vervis.Federation.Auth
|
||||||
import Vervis.Federation.Util
|
import Vervis.Federation.Util
|
||||||
|
@ -244,7 +247,7 @@ personOfferTicketF
|
||||||
-> KeyHashid Person
|
-> KeyHashid Person
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> AP.Ticket URIMode
|
-> AP.Ticket URIMode
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -315,120 +318,188 @@ deckOfferTicketF
|
||||||
-> KeyHashid Deck
|
-> KeyHashid Deck
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> AP.Ticket URIMode
|
-> AP.Ticket URIMode
|
||||||
-> FedURI
|
-> FedURI
|
||||||
-> ExceptT Text Handler Text
|
-> ExceptT Text Handler Text
|
||||||
deckOfferTicketF now recipHash author body mfwd luOffer ticket uTarget = do
|
deckOfferTicketF now recipDeckHash author body mfwd luOffer ticket uTarget = do
|
||||||
error "projectOfferTicketF temporarily disabled"
|
|
||||||
|
|
||||||
|
-- Check input
|
||||||
|
recipDeckID <- decodeKeyHashid404 recipDeckHash
|
||||||
|
(title, desc, source) <- do
|
||||||
|
let uAuthor@(ObjURI hAuthor _) = remoteAuthorURI author
|
||||||
|
WorkItemOffer {..} <- checkOfferTicket hAuthor ticket uTarget
|
||||||
|
unless (wioAuthor == Right (remoteAuthorURI author)) $
|
||||||
|
throwE "Offering a Ticket attributed to someone else"
|
||||||
|
case wioRest of
|
||||||
|
TAM_Task deckID ->
|
||||||
|
if deckID == recipDeckID
|
||||||
|
then return ()
|
||||||
|
else throwE
|
||||||
|
"Offer target is some other local deck, so I have \
|
||||||
|
\no use for this Offer. Was I supposed to receive \
|
||||||
|
\it?"
|
||||||
|
TAM_Merge _ _ ->
|
||||||
|
throwE
|
||||||
|
"Offer target is some local loom, so I have no use for \
|
||||||
|
\this Offer. Was I supposed to receive it?"
|
||||||
|
TAM_Remote _ _ ->
|
||||||
|
throwE
|
||||||
|
"Offer target is some remote tracker, so I have no use \
|
||||||
|
\for this Offer. Was I supposed to receive it?"
|
||||||
|
return (wioTitle, wioDesc, wioSource)
|
||||||
|
|
||||||
{-
|
-- Find recipient deck in DB, returning 404 if doesn't exist because we're
|
||||||
(target, summary, content, source) <- checkOfferTicket author ticket uTarget
|
-- in the deck's inbox post handler
|
||||||
mmhttp <- for (targetRelevance target) $ \ () -> lift $ runDB $ do
|
maybeHttp <- lift $ runDB $ do
|
||||||
Entity jid j <- do
|
(recipDeckActorID, recipDeckActor) <- do
|
||||||
sid <- getKeyBy404 $ UniqueSharer shrRecip
|
deck <- get404 recipDeckID
|
||||||
getBy404 $ UniqueProject prjRecip sid
|
let actorID = deckActor deck
|
||||||
a <- getJust $ projectActor j
|
(actorID,) <$> getJust actorID
|
||||||
mractid <- insertToInbox now author body (actorInbox a) luOffer False
|
|
||||||
for mractid $ \ ractid -> do
|
-- Insert the Offer to deck's inbox
|
||||||
mremotesHttpFwd <- for mfwd $ \ (localRecips, sig) -> do
|
mractid <- insertToInbox now author body (actorInbox recipDeckActor) luOffer False
|
||||||
|
for mractid $ \ offerID -> do
|
||||||
|
|
||||||
|
-- Forward the Offer activity to relevant local stages, and
|
||||||
|
-- schedule delivery for unavailable remote members of them
|
||||||
|
maybeHttpFwdOffer <- for mfwd $ \ (localRecips, sig) -> do
|
||||||
let sieve =
|
let sieve =
|
||||||
makeRecipientSet
|
makeRecipientSet
|
||||||
[]
|
[]
|
||||||
[ LocalPersonCollectionProjectTeam shrRecip prjRecip
|
[LocalStageDeckFollowers recipDeckHash]
|
||||||
, LocalPersonCollectionProjectFollowers shrRecip prjRecip
|
|
||||||
]
|
|
||||||
remoteRecips <-
|
remoteRecips <-
|
||||||
insertRemoteActivityToLocalInboxes
|
insertRemoteActivityToLocalInboxes False offerID $
|
||||||
False ractid $
|
localRecipSieve' sieve False False localRecips
|
||||||
localRecipSieve'
|
remoteRecipsHttp <-
|
||||||
sieve False False localRecips
|
deliverRemoteDB_D
|
||||||
(sig,) <$> deliverRemoteDB_J (actbBL body) ractid jid sig remoteRecips
|
(actbBL body) offerID recipDeckID sig remoteRecips
|
||||||
(obiidAccept, docAccept, fwdHostsAccept, recipsAccept) <- do
|
return $
|
||||||
obiidAccept <- insertEmptyOutboxItem (actorOutbox a) now
|
deliverRemoteHTTP_D
|
||||||
(_, ltid) <- insertLocalTicket now author (flip TicketProjectLocal jid) summary content source ractid obiidAccept
|
now recipDeckHash (actbBL body) sig remoteRecipsHttp
|
||||||
(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
|
|
||||||
insertAccept shrRecip prjRecip author luOffer ltid obiidAccept
|
-- Insert the new ticket to our DB
|
||||||
knownRemoteRecipsAccept <-
|
acceptID <- insertEmptyOutboxItem (actorOutbox recipDeckActor) now
|
||||||
deliverLocal'
|
taskID <- insertTask now title desc source recipDeckID offerID acceptID
|
||||||
False
|
|
||||||
(LocalActorProject shrRecip prjRecip)
|
-- Prepare an Accept activity and insert to deck's outbox
|
||||||
(actorInbox a)
|
(docAccept, localRecipsAccept, remoteRecipsAccept, fwdHostsAccept) <-
|
||||||
obiidAccept
|
insertAcceptToOutbox taskID acceptID
|
||||||
localRecipsAccept
|
|
||||||
(obiidAccept,docAccept,fwdHostsAccept,) <$>
|
-- Deliver the Accept to local recipients, and schedule delivery
|
||||||
deliverRemoteDB'' fwdHostsAccept obiidAccept remoteRecipsAccept knownRemoteRecipsAccept
|
-- for unavailable remote recipients
|
||||||
return (mremotesHttpFwd, obiidAccept, docAccept, fwdHostsAccept, recipsAccept)
|
knownRemoteRecipsAccept <-
|
||||||
case mmhttp of
|
deliverLocal'
|
||||||
Nothing -> return "Offer target isn't me, not using"
|
False (LocalActorDeck recipDeckHash) recipDeckActorID
|
||||||
Just mhttp ->
|
acceptID localRecipsAccept
|
||||||
case mhttp of
|
remoteRecipsHttpAccept <-
|
||||||
Nothing -> return "Activity already in my inbox, doing nothing"
|
deliverRemoteDB''
|
||||||
Just (mremotesHttpFwd, obiid, doc, fwdHosts, remotes) -> do
|
fwdHostsAccept acceptID remoteRecipsAccept
|
||||||
for_ mremotesHttpFwd $ \ (sig, remotes) ->
|
knownRemoteRecipsAccept
|
||||||
forkWorker "projectOfferTicketF inbox-forwarding" $
|
|
||||||
deliverRemoteHTTP_J now shrRecip prjRecip (actbBL body) sig remotes
|
-- Return instructions for HTTP inbox-forwarding of the Offer
|
||||||
forkWorker "projectOfferTicketF Accept HTTP delivery" $
|
-- activity, and for HTTP delivery of the Accept activity to
|
||||||
deliverRemoteHttp' fwdHosts obiid doc remotes
|
-- remote recipients
|
||||||
return $
|
return
|
||||||
case mremotesHttpFwd of
|
( maybeHttpFwdOffer
|
||||||
Nothing -> "Accepted new ticket, no inbox-forwarding to do"
|
, deliverRemoteHttp'
|
||||||
Just _ -> "Accepted new ticket and ran inbox-forwarding of the Offer"
|
fwdHostsAccept acceptID docAccept remoteRecipsHttpAccept
|
||||||
|
)
|
||||||
|
|
||||||
|
-- Launch asynchronous HTTP forwarding of the Offer activity and HTTP
|
||||||
|
-- delivery of the Accept activity
|
||||||
|
case maybeHttp of
|
||||||
|
Nothing -> return "I already have this activity in my inbox, doing nothing"
|
||||||
|
Just (maybeHttpFwdOffer, deliverHttpAccept) -> do
|
||||||
|
forkWorker "deckOfferTicketF Accept HTTP delivery" deliverHttpAccept
|
||||||
|
case maybeHttpFwdOffer of
|
||||||
|
Nothing -> return "Opened a ticket, no inbox-forwarding to do"
|
||||||
|
Just forwardHttpOffer -> do
|
||||||
|
forkWorker "deckOfferTicketF inbox-forwarding" forwardHttpOffer
|
||||||
|
return "Opened a ticket and ran inbox-forwarding of the Offer"
|
||||||
|
|
||||||
where
|
where
|
||||||
targetRelevance (Left (WITProject shr prj))
|
|
||||||
| shr == shrRecip && prj == prjRecip = Just ()
|
insertTask now title desc source deckID offerID acceptID = do
|
||||||
targetRelevance _ = Nothing
|
did <- insert Discussion
|
||||||
insertAccept shr prj author luOffer ltid obiidAccept = do
|
fsid <- insert FollowerSet
|
||||||
|
tid <- insert Ticket
|
||||||
|
{ ticketNumber = Nothing
|
||||||
|
, ticketCreated = now
|
||||||
|
, ticketTitle = title
|
||||||
|
, ticketSource = source
|
||||||
|
, ticketDescription = desc
|
||||||
|
, ticketStatus = TSNew
|
||||||
|
, ticketDiscuss = did
|
||||||
|
, ticketFollowers = fsid
|
||||||
|
, ticketAccept = acceptID
|
||||||
|
}
|
||||||
|
insert_ TicketAuthorRemote
|
||||||
|
{ ticketAuthorRemoteTicket = tid
|
||||||
|
, ticketAuthorRemoteAuthor = remoteAuthorId author
|
||||||
|
, ticketAuthorRemoteOpen = offerID
|
||||||
|
}
|
||||||
|
insert $ TicketDeck tid deckID
|
||||||
|
|
||||||
|
insertAcceptToOutbox
|
||||||
|
:: TicketDeckId
|
||||||
|
-> OutboxItemId
|
||||||
|
-> ReaderT SqlBackend Handler
|
||||||
|
( AP.Doc AP.Activity URIMode
|
||||||
|
, RecipientRoutes
|
||||||
|
, [(Host, NonEmpty LocalURI)]
|
||||||
|
, [Host]
|
||||||
|
)
|
||||||
|
insertAcceptToOutbox taskID acceptID = do
|
||||||
encodeRouteLocal <- getEncodeRouteLocal
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
encodeRouteHome <- getEncodeRouteHome
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
|
|
||||||
hLocal <- asksSite siteInstanceHost
|
hLocal <- asksSite siteInstanceHost
|
||||||
|
|
||||||
obikhidAccept <- encodeKeyHashid obiidAccept
|
taskHash <- encodeKeyHashid taskID
|
||||||
ltkhid <- encodeKeyHashid ltid
|
acceptHash <- encodeKeyHashid acceptID
|
||||||
|
|
||||||
ra <- getJust $ remoteAuthorId author
|
ra <- getJust $ remoteAuthorId author
|
||||||
|
|
||||||
let ObjURI hAuthor luAuthor = remoteAuthorURI author
|
let ObjURI hAuthor luAuthor = remoteAuthorURI author
|
||||||
|
|
||||||
audAuthor =
|
audSender =
|
||||||
AudRemote hAuthor [luAuthor] (maybeToList $ remoteActorFollowers ra)
|
AudRemote hAuthor
|
||||||
audProject =
|
[luAuthor]
|
||||||
AudLocal []
|
(maybeToList $ remoteActorFollowers ra)
|
||||||
[ LocalPersonCollectionProjectTeam shr prj
|
audTracker = AudLocal [] [LocalStageDeckFollowers recipDeckHash]
|
||||||
, LocalPersonCollectionProjectFollowers shr prj
|
|
||||||
]
|
|
||||||
|
|
||||||
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
(recipientSet, remoteActors, fwdHosts, audLocal, audRemote) =
|
||||||
collectAudience [audAuthor, audProject]
|
collectAudience [audSender, audTracker]
|
||||||
|
|
||||||
recips = map encodeRouteHome audLocal ++ audRemote
|
recips = map encodeRouteHome audLocal ++ audRemote
|
||||||
doc = Doc hLocal Activity
|
doc = AP.Doc hLocal AP.Activity
|
||||||
{ activityId =
|
{ AP.activityId =
|
||||||
Just $ encodeRouteLocal $
|
Just $ encodeRouteLocal $
|
||||||
ProjectOutboxItemR shr prj obikhidAccept
|
DeckOutboxItemR recipDeckHash acceptHash
|
||||||
, activityActor = encodeRouteLocal $ ProjectR shr prj
|
, AP.activityActor =
|
||||||
, activityCapability = Nothing
|
encodeRouteLocal $ DeckR recipDeckHash
|
||||||
, activitySummary = Nothing
|
, AP.activityCapability = Nothing
|
||||||
, activityAudience = Audience recips [] [] [] [] []
|
, AP.activitySummary = Nothing
|
||||||
, activitySpecific = AcceptActivity Accept
|
, AP.activityAudience = AP.Audience recips [] [] [] [] []
|
||||||
|
, AP.activityFulfills = []
|
||||||
|
, AP.activitySpecific = AP.AcceptActivity AP.Accept
|
||||||
{ acceptObject = ObjURI hAuthor luOffer
|
{ acceptObject = ObjURI hAuthor luOffer
|
||||||
, acceptResult =
|
, acceptResult =
|
||||||
Just $ encodeRouteLocal $ ProjectTicketR shr prj ltkhid
|
Just $ encodeRouteLocal $
|
||||||
|
TicketR recipDeckHash taskHash
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
update obiidAccept [OutboxItemActivity =. persistJSONObjectFromDoc doc]
|
|
||||||
|
update acceptID [OutboxItemActivity =. persistJSONObjectFromDoc doc]
|
||||||
return (doc, recipientSet, remoteActors, fwdHosts)
|
return (doc, recipientSet, remoteActors, fwdHosts)
|
||||||
-}
|
|
||||||
|
|
||||||
repoOfferTicketF
|
repoOfferTicketF
|
||||||
:: UTCTime
|
:: UTCTime
|
||||||
-> KeyHashid Repo
|
-> KeyHashid Repo
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> AP.Ticket URIMode
|
-> AP.Ticket URIMode
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -577,7 +648,7 @@ repoAddBundleF
|
||||||
-> KeyHashid Repo
|
-> KeyHashid Repo
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> NonEmpty (AP.Patch URIMode)
|
-> NonEmpty (AP.Patch URIMode)
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -739,7 +810,7 @@ repoApplyF
|
||||||
-> KeyHashid Repo
|
-> KeyHashid Repo
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> FedURI
|
-> FedURI
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -1297,7 +1368,7 @@ personOfferDepF
|
||||||
-> KeyHashid Person
|
-> KeyHashid Person
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> AP.TicketDependency URIMode
|
-> AP.TicketDependency URIMode
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -1504,7 +1575,7 @@ deckOfferDepF
|
||||||
-> KeyHashid Deck
|
-> KeyHashid Deck
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> AP.TicketDependency URIMode
|
-> AP.TicketDependency URIMode
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -1674,7 +1745,7 @@ repoOfferDepF
|
||||||
-> KeyHashid Repo
|
-> KeyHashid Repo
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> AP.TicketDependency URIMode
|
-> AP.TicketDependency URIMode
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -1869,7 +1940,7 @@ deckResolveF
|
||||||
-> KeyHashid Deck
|
-> KeyHashid Deck
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> Resolve URIMode
|
-> Resolve URIMode
|
||||||
-> ExceptT Text Handler Text
|
-> ExceptT Text Handler Text
|
||||||
|
@ -2006,7 +2077,7 @@ repoResolveF
|
||||||
-> KeyHashid Repo
|
-> KeyHashid Repo
|
||||||
-> RemoteAuthor
|
-> RemoteAuthor
|
||||||
-> ActivityBody
|
-> ActivityBody
|
||||||
-> Maybe (LocalRecipientSet, ByteString)
|
-> Maybe (RecipientRoutes, ByteString)
|
||||||
-> LocalURI
|
-> LocalURI
|
||||||
-> Resolve URIMode
|
-> Resolve URIMode
|
||||||
-> ExceptT Text Handler Text
|
-> ExceptT Text Handler Text
|
||||||
|
|
|
@ -97,6 +97,7 @@ import Vervis.Access
|
||||||
import Vervis.API
|
import Vervis.API
|
||||||
import Vervis.Federation.Auth
|
import Vervis.Federation.Auth
|
||||||
import Vervis.Federation.Collab
|
import Vervis.Federation.Collab
|
||||||
|
import Vervis.Federation.Ticket
|
||||||
import Vervis.FedURI
|
import Vervis.FedURI
|
||||||
import Vervis.Form.Project
|
import Vervis.Form.Project
|
||||||
import Vervis.Form.Ticket
|
import Vervis.Form.Ticket
|
||||||
|
@ -187,14 +188,16 @@ postDeckInboxR recipDeckHash =
|
||||||
-}
|
-}
|
||||||
AP.InviteActivity invite ->
|
AP.InviteActivity invite ->
|
||||||
topicInviteF now (GrantResourceDeck recipDeckHash) author body mfwd luActivity invite
|
topicInviteF now (GrantResourceDeck recipDeckHash) author body mfwd luActivity invite
|
||||||
{-
|
|
||||||
OfferActivity (Offer obj target) ->
|
OfferActivity (Offer obj target) ->
|
||||||
case obj of
|
case obj of
|
||||||
OfferTicket ticket ->
|
OfferTicket ticket ->
|
||||||
(,Nothing) <$> projectOfferTicketF now shrRecip prjRecip remoteAuthor body mfwd luActivity ticket target
|
(,Nothing) <$> deckOfferTicketF now recipDeckHash author body mfwd luActivity ticket target
|
||||||
|
{-
|
||||||
OfferDep dep ->
|
OfferDep dep ->
|
||||||
projectOfferDepF now shrRecip prjRecip remoteAuthor body mfwd luActivity dep target
|
projectOfferDepF now shrRecip prjRecip remoteAuthor body mfwd luActivity dep target
|
||||||
_ -> return ("Unsupported offer object type for projects", Nothing)
|
-}
|
||||||
|
_ -> return ("Unsupported offer object type for decks", Nothing)
|
||||||
|
{-
|
||||||
ResolveActivity resolve ->
|
ResolveActivity resolve ->
|
||||||
(,Nothing) <$> projectResolveF now shrRecip prjRecip remoteAuthor body mfwd luActivity resolve
|
(,Nothing) <$> projectResolveF now shrRecip prjRecip remoteAuthor body mfwd luActivity resolve
|
||||||
UndoActivity undo ->
|
UndoActivity undo ->
|
||||||
|
|
|
@ -1418,19 +1418,21 @@ encodeAdd h (Add obj target)
|
||||||
|
|
||||||
data Apply u = Apply
|
data Apply u = Apply
|
||||||
{ applyObject :: ObjURI u
|
{ applyObject :: ObjURI u
|
||||||
, applyTarget :: ObjURI u
|
, applyTarget :: Either (ObjURI u) (Authority u, Branch u)
|
||||||
}
|
}
|
||||||
|
|
||||||
parseApply :: UriMode u => Object -> Parser (Apply u)
|
parseApply :: UriMode u => Object -> Parser (Apply u)
|
||||||
parseApply o =
|
parseApply o =
|
||||||
Apply
|
Apply
|
||||||
<$> o .: "object"
|
<$> o .: "object"
|
||||||
<*> o .: "target"
|
<*> (second fromDoc <$> o .:+ "target")
|
||||||
|
where
|
||||||
|
fromDoc (Doc h v) = (h, v)
|
||||||
|
|
||||||
encodeApply :: UriMode u => Apply u -> Series
|
encodeApply :: UriMode u => Apply u -> Series
|
||||||
encodeApply (Apply obj target)
|
encodeApply (Apply obj target)
|
||||||
= "object" .= obj
|
= "object" .= obj
|
||||||
<> "target" .= target
|
<> "target" .=+ second (uncurry Doc) target
|
||||||
|
|
||||||
data CreateObject u
|
data CreateObject u
|
||||||
= CreateNote (Authority u) (Note u)
|
= CreateNote (Authority u) (Note u)
|
||||||
|
|
|
@ -151,7 +151,7 @@ library
|
||||||
--Vervis.Federation.Discussion
|
--Vervis.Federation.Discussion
|
||||||
--Vervis.Federation.Offer
|
--Vervis.Federation.Offer
|
||||||
--Vervis.Federation.Push
|
--Vervis.Federation.Push
|
||||||
--Vervis.Federation.Ticket
|
Vervis.Federation.Ticket
|
||||||
Vervis.Federation.Util
|
Vervis.Federation.Util
|
||||||
Vervis.FedURI
|
Vervis.FedURI
|
||||||
-- Vervis.Field.Key
|
-- Vervis.Field.Key
|
||||||
|
|
Loading…
Reference in a new issue