Merge pull request #2209 from urbit/m/link-bugfix

link: listening & comments
This commit is contained in:
Fang 2020-01-30 00:51:22 +01:00 committed by GitHub
commit a26ec1db12
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
7 changed files with 328 additions and 64 deletions

View File

@ -1,30 +1,47 @@
:: link-listen-hook: get your friends' bookmarks
::
:: on-init, subscribes to all groups on this ship.
:: for every ship in a group, we subscribe to their link's local-pages
:: on-init, subscribes to all groups on this ship. for every ship in a group,
:: we subscribe to their link's local-pages and annotations
:: at the group path (through link-proxy-hook),
:: and forwards all entries into our link as submissions.
:: and forwards all entries into our link as submissions and comments.
::
:: if a subscription to a group member fails, we assume it's because their
:: group definition hasn't been updated to include us yet.
:: we retry with exponential backoff, maxing out at one hour timeouts.
::
/- *link, group-store
/+ default-agent, verb
/+ default-agent, verb, dbug
::
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
retry-timers=(map target @dr)
==
::
::TODO revert to annotations with new link-store subscription model
+$ what-target ?(%local-pages %allotations)
+$ target
$: what=what-target
who=ship
where=path
==
++ wire-to-target
|= =wire
^- target
?> ?=([what-target @ ^] wire)
[i.wire (slav %p i.t.wire) t.t.wire]
++ target-to-wire
|= target
^- wire
[what (scot %p who) where]
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -51,9 +68,9 @@
=^ cards state
(take-groups-sign:do sign)
[cards this]
?: ?=([%links @ ^] wire)
?: ?=([%links @ @ ^] wire)
=^ cards state
(take-links-sign:do (slav %p i.t.wire) t.t.wire sign)
(take-links-sign:do (wire-to-target t.wire) sign)
[cards this]
?: ?=([%forward ^] wire)
=^ cards state
@ -65,12 +82,22 @@
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%g %done *] sign-arvo)
(on-arvo:def wire sign-arvo)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%g %done *]
?~ error.sign-arvo [~ this]
=/ =tank leaf+"{(trip dap.bowl)}'s message went wrong!"
%- (slog tank tang.u.error.sign-arvo)
[~ this]
::
[%b %wake *]
?> ?=([%retry @ @ ^] wire)
?^ error.sign-arvo
=/ =tank leaf+"wake on {(spud wire)} went wrong!"
%- (slog tank u.error.sign-arvo)
[~ this]
:_ this
(take-retry:do (wire-to-target t.wire))
==
::
++ on-poke on-poke:def
++ on-peek on-peek:def
@ -106,7 +133,6 @@
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial (handle-group-initial !<(groups:group-store vase))
%group-update (handle-group-update !<(group-update:group-store vase))
@ -139,79 +165,141 @@
::
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
%. [i.whos pax.upd]
?: ?=(%remove -.upd)
end-link-subscription
start-link-subscription
%+ weld
$(whos t.whos)
(end-link-subscriptions i.whos pax.upd)
:+ (start-link-subscription %local-pages i.whos pax.upd)
(start-link-subscription %allotations i.whos pax.upd)
$(whos t.whos)
==
::
:: link subscriptions
::
++ start-link-subscription
|= [who=ship where=path]
|= =target
^- card
:* %pass
[%links (scot %p who) where]
[%links (target-to-wire target)]
%agent
[who %link-proxy-hook]
[who.target %link-proxy-hook]
%watch
[%local-pages where]
[what where]:target
==
::
++ end-link-subscription
++ end-link-subscriptions
|= [who=ship where=path]
^- card
^- (list card)
|^ ~[(end %local-pages) (end %allotations)]
::
++ end
|= what=what-target
:* %pass
[%links (scot %p who) where]
[%links (target-to-wire what who where)]
%agent
[who %link-proxy-hook]
%leave
~
==
--
::
++ take-links-sign
|= [who=ship where=path =sign:agent:gall]
|= [=target =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links who where] !!)
%kick [[(start-link-subscription who where)]~ state]
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links target] !!)
%kick [[(start-link-subscription target)]~ state]
::
%watch-ack
?~ p.sign [~ state]
:: our subscription request got rejected for whatever reason,
:: (most likely difference in group membership,)
:: so we don't try again.
::TODO but now the only way to retry is to remove from group and re-add...
:: this is a problem because our and their group may not update
:: simultaneously...
?~ p.sign
=. retry-timers (~(del by retry-timers) target)
[~ state]
:: our subscription request got rejected,
:: most likely because our group definition is out of sync with theirs.
:: set timer for retry.
::
(start-retry target)
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%link-update (handle-link-update who where !<(update vase))
%link-update
%- handle-link-update
[who.target where.target !<(update vase)]
==
==
::
++ start-retry
|= =target
^- (quip card _state)
=/ timer=@dr
%+ min ~h1
%+ mul 2
(~(gut by retry-timers) target ~s15)
=. retry-timers
(~(put by retry-timers) target timer)
:_ state
:_ ~
:* %pass
[%retry (target-to-wire target)]
[%arvo %b %wait (add now.bowl timer)]
==
::
++ take-retry
|= =target
^- (list card)
:: relevant: whether :who is still in group :where
::
=; relevant=?
?. relevant ~
[(start-link-subscription target)]~
?: %- ~(has by wex.bowl)
[[%links (target-to-wire target)] who.target %group-store]
|
%. who.target
%~ has in
=- (fall - *group:group-store)
.^ (unit group:group-store)
%gx
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
(snoc where.target %noun)
==
::
++ handle-link-update
|= [who=ship where=path =update]
^- (quip card _state)
?> ?=(%local-pages -.update)
?> =(src.bowl who)
:_ state
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%local-pages
%+ turn pages.update
|= =page
^- card
:* %pass
[%forward (scot %p who) where]
[%forward -.update (scot %p who) where]
%agent
[our.bowl %link-store]
%poke
%link-action
!>([%hear where src.bowl page])
==
::
%annotations
%+ turn notes.update
|= =note
^- card
:* %pass
[%forward -.update (scot %p who) where]
%agent
[our.bowl %link-store]
%poke
%link-action
!>([%read where url.update src.bowl note])
==
==
::
++ take-forward-sign
|= [=wire =sign:agent:gall]

View File

@ -21,7 +21,7 @@
:: to touch are +permitted, +initial-response, & maybe +handle-group-update.
::
/- group-store
/+ *link, default-agent, verb
/+ *link, default-agent, verb, dbug
|%
+$ state-0
$: %0
@ -36,6 +36,7 @@
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -101,7 +102,7 @@
:: we only expose /local-pages and /annotations,
:: and only to ships in the relevant group
::
?. ?=([?(%local-pages %annotations) ^] path) |
?. ?=([?(%local-pages %annotations %allotations) ^] path) |
=; group
?& ?=(^ group)
(~(has in u.group) who)

View File

@ -14,10 +14,13 @@
:: /local-pages/[some-group] all pages we saved by recency
:: /submissions/[some-group] all submissions by recency
:: comments
:: /allotations/[some-group] TMP all our comments in group
:: /annotations/[some-group]/[b64(url)] all our comments on url by recency
:: /discussions/[some-group]/[b64(url)] all known comments on url by recency
::
/+ *link, default-agent, verb
::TODO continue work from m/uplink-broad branch!
::
/+ *link, default-agent, verb, dbug
::
|%
+$ state-0
@ -44,6 +47,7 @@
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -112,6 +116,14 @@
[%submissions ^]
%+ give %link-update
[%submissions t.path (get-submissions:do t.path)]
::
[%allotations ^]
%+ turn
%~ tap by
(~(gut by discussions) t.path *(map url discussion))
|= [=url =discussion]
%+ give-single %link-update
[%annotations t.path url ours.discussion]
::
[%annotations @ ^]
%+ give %link-update
@ -126,6 +138,11 @@
|* [=mark =noun]
^- (list card)
[%give %fact ~ mark !>(noun)]~
::
++ give-single
|* [=mark =noun]
^- card
[%give %fact ~ mark !>(noun)]
--
::
++ on-leave on-leave:def
@ -197,7 +214,7 @@
:- %link-update
!>([%annotations path url [note]~])
:* [%give %fact [%annotations (snoc path url)]~ fact]
[%give %fact [%annotations path]~ fact]
[%give %fact [%allotations path]~ fact]
cards
==
:: +hear-submission: record page someone else saved

32
pkg/arvo/gen/dbug.hoon Normal file
View File

@ -0,0 +1,32 @@
:: +dbug: tell /lib/dbug app to print some generic state
::
:: :app +dbug
:: the entire bowl
:: :app +dbug [direction] [specifics]
:: all in subs matching the parameters
:: direction: %incoming or %outgoing
:: specifics:
:: [%ship ~ship] subscriptions to/from this ship
:: [%path /path] subscriptions on path containing /path
:: [%wire /wire] subscriptions on wire containing /wire
:: [%term %name] subscriptions to app %name
::
/+ *dbug
::
:- %say
|= $: :: environment
::
*
:: inline arguments
::
args=?(~ [what=?(%bowl %state) ~] [=what =about ~])
:: named arguments
::
~
==
:- %dbug
?- args
~ [%bowl *about]
[@ ~] [what.args *about]
[@ * ~] [what about]:args
==

View File

@ -0,0 +1,10 @@
:: link-store|note: write a note on a link in a path
::
/- *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path =url note=@t ~] ~]
==
:- %link-action
^- action
[%note path url note]

View File

@ -1,4 +1,4 @@
:: link-store|add: save a link to a path
:: link-store|save: save a link to a path
::
/- *link
:- %say

116
pkg/arvo/lib/dbug.hoon Normal file
View File

@ -0,0 +1,116 @@
:: dbug: agent wrapper for generic debugging tools
::
:: usage: %-(agent:dbug your-agent)
::
|%
+$ what
$? %bowl
%state
%incoming
%outgoing
==
::
+$ about
$% [%ship =ship]
[%path =path]
[%wire =wire]
[%term =term]
==
::
++ agent
|= =agent:gall
^- agent:gall
|_ =bowl:gall
+* this .
ag ~(. agent bowl)
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
?. ?=(%dbug mark)
=^ cards agent (on-poke:ag mark vase)
[cards this]
=/ dbug
!<([=what =about] vase)
=; out=^vase
((slog (sell out) ~) [~ this])
?- what.dbug
%bowl !>(bowl)
%state on-save:ag
::
%incoming
!>
%+ murn ~(tap by sup.bowl)
|= sub=[=duct [=ship =path]]
^- (unit _sub)
=; relevant=?
?:(relevant `sub ~)
?- -.about.dbug
%ship =(ship.sub ship.about.dbug)
%path ?=(^ (find path.about.dbug path.sub))
%wire %+ lien duct.sub
|=(=wire ?=(^ (find wire.about.dbug wire)))
%term !!
==
::
%outgoing
!>
%+ murn ~(tap by wex.bowl)
|= sub=[[=wire =ship =term] [acked=? =path]]
^- (unit _sub)
=; relevant=?
?:(relevant `sub ~)
?- -.about.dbug
%ship =(ship.sub ship.about.dbug)
%path ?=(^ (find path.about.dbug path.sub))
%wire ?=(^ (find wire.about.dbug wire.sub))
%term =(term.sub term.about.dbug)
==
==
::
++ on-init
^- (quip card:agent:gall agent:gall)
=^ cards agent on-init:ag
[cards this]
::
++ on-save on-save:ag
::
++ on-load
|= old-state=vase
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-load:ag old-state)
[cards this]
::
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-watch:ag path)
[cards this]
::
++ on-leave
|= =path
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-leave:ag path)
[cards this]
::
++ on-peek on-peek:ag
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-agent:ag wire sign)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-arvo:ag wire sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-fail:ag term tang)
[cards this]
--
--