link hooks: discover resources with metadata-store

Instead of assuming groups to be singular resources, now depends on
metadata-store to discover %link resources, and the groups associated
with those.

pkg/arvo/app/link-listen-hook.hoon

@@ -1,21 +1,33 @@
 ::  link-listen-hook: get your friends' bookmarks
 ::
-::    on-init, subscribes to all groups on this ship. for every ship in a group,
+::    subscribes to all %link resources in the metadata-store.
-::    we subscribe to their link's local-pages and annotations
+::    for all all ships in groups associated with those resources, we subscribe
-::    at the group path (through link-proxy-hook),
+::    to their link's local-pages and annotations at the resource path (through
-::    and forwards all entries into our link as submissions and comments.
+::    link-proxy-hook), and forward all entries into our link-store as
+::    submissions and comments.
 ::
-::    if a subscription to a group member fails, we assume it's because their
+::    if a subscription to a target fails, we assume it's because their
-::    group definition hasn't been updated to include us yet.
+::    metadata+groups definition hasn't been updated to include us yet.
 ::    we retry with exponential backoff, maxing out at one hour timeouts.
+::    to expede this process, we prod other potential listeners when we add
+::    them to our metadata+groups definition.
 ::
-/-  *link, group-store
+/-  *metadata-store, *link, group-store
-/+  default-agent, verb, dbug
+/+  metadata, default-agent, verb, dbug
 ::
 |%
 +$  state-0
   $:  %0
       retry-timers=(map target @dr)
+      ::  reasoning: the resources we're subscribed to,
+      ::             and the groups that cause that.
+      ::
+      ::    we don't strictly need to track this in state, but doing so heavily
+      ::    simplifies logic and reduces the amount of big scries we do.
+      ::    this also gives us the option to check & restore subscriptions,
+      ::    should we ever need that.
+      ::
+      reasoning=(jug [ship app-path] group-path)
   ==
 ::
 +$  what-target  ?(%local-pages %annotations)
@@ -52,7 +64,7 @@
   ++  on-init
     ^-  (quip card _this)
     :_  this
-    [watch-groups:do]~
+    ~[watch-metadata:do watch-groups:do]
   ::
   ++  on-save  !>(state)
   ++  on-load
@@ -63,26 +75,27 @@
   ++  on-agent
     |=  [=wire =sign:agent:gall]
     ^-  (quip card _this)
-    ?:  ?=([%groups ~] wire)
+    =^  cards  state
-      =^  cards  state
+      ?+  wire  ~|([dap.bowl %weird-agent-wire wire] !!)
+          [%metadata ~]
+        (take-metadata-sign:do sign)
+      ::
+          [%groups ~]
         (take-groups-sign:do sign)
-      [cards this]
+      ::
-    ?:  ?=([%links ?(%local-pages %annotations) @ ^] wire)
+          [%links ?(%local-pages %annotations) @ ^]
-      =^  cards  state
         (take-link-sign:do (wire-to-target t.wire) sign)
-      [cards this]
+      ::
-    ?:  ?=([%forward ^] wire)
+          [%forward ^]
-      =^  cards  state
         (take-forward-sign:do t.wire sign)
-      [cards this]
+      ::
-    ?:  ?=([%prod *] wire)
+          [%prod *]
-      ~|  [%weird-sign -.sign]
+        ?>  ?=(%poke-ack -.sign)
-      ?>  ?=(%poke-ack -.sign)
+        ?~  p.sign  [~ state]
-      ?~  p.sign  [~ this]
+        %-  (slog leaf+"prod failed" u.p.sign)
-      %-  (slog [leaf+"failed to prod" u.p.sign])
+        [~ state]
-      [~ this]
+      ==
-    ~|  [dap.bowl %weird-wire wire]
+    [cards this]
-    !!
   ::
   ++  on-poke
     |=  [=mark =vase]
@@ -122,8 +135,65 @@
 ::
 ::
 |_  =bowl:gall
++*  md  ~(. metadata bowl)
 ::
-::  groups subscription
+::  metadata subscription
+::
+++  watch-metadata
+  ^-  card
+  [%pass /metadata %agent [our.bowl %metadata-store] %watch /app-name/link]
+::
+++  take-metadata-sign
+  |=  =sign:agent:gall
+  ^-  (quip card _state)
+  ?-  -.sign
+    %poke-ack     ~|([dap.bowl %unexpected-poke-ack /metadata] !!)
+    %kick         [[watch-metadata]~ state]
+  ::
+      %watch-ack
+    ?~  p.sign  [~ state]
+    =/  =tank
+      :-  %leaf
+      "{(trip dap.bowl)} failed subscribe to metadata store. very wrong!"
+    %-  (slog tank u.p.sign)
+    [~ state]
+  ::
+      %fact
+    =*  mark  p.cage.sign
+    =*  vase  q.cage.sign
+    ?.  ?=(%metadata-update mark)
+      ~|  [dap.bowl %unexpected-mark mark]
+      !!
+    %-  handle-metadata-update
+    !<(metadata-update vase)
+  ==
+::
+++  handle-metadata-update
+  |=  upd=metadata-update
+  ^-  (quip card _state)
+  ?+  -.upd  [~ state]
+      %associations
+    =/  socs=(list [=group-path resource])
+      ~(tap in ~(key by associations.upd))
+    =|  cards=(list card)
+    |-  ::TODO  try for +roll maybe?
+    ?~  socs  [cards state]
+    =^  caz  state
+      =,  i.socs
+      ?.  =(%link app-name)  [~ state]
+      (listen-to-group app-path group-path)
+    $(socs t.socs, cards (weld cards caz))
+  ::
+      %add
+    ?>  =(%link app-name.resource.upd)
+    (listen-to-group app-path.resource.upd group-path.upd)
+  ::
+      %remove
+    ?>  =(%link app-name.resource.upd)
+    (leave-from-group app-path.resource.upd group-path.upd)
+  ==
+::
+::  groups subscriptions
 ::
 ++  watch-groups
   ^-  card
@@ -148,49 +218,98 @@
     =*  mark  p.cage.sign
     =*  vase  q.cage.sign
     ?+  mark  ~|([dap.bowl %unexpected-mark mark] !!)
-      %group-initial  (handle-group-initial !<(groups:group-store vase))
+      %group-initial  [~ state]  ::NOTE  initial handled using metadata
       %group-update   (handle-group-update !<(group-update:group-store vase))
     ==
   ==
 ::
-++  handle-group-initial
-  |=  =groups:group-store
-  ^-  (quip card _state)
-  =|  cards=(list card)
-  =/  groups=(list [=path =group:group-store])
-    ~(tap by groups)
-  |-
-  ?~  groups  [cards state]
-  =^  caz  state
-    %-  handle-group-update
-    [%add [group path]:i.groups]
-  $(cards (weld cards caz), groups t.groups)
-::
 ++  handle-group-update
   |=  upd=group-update:group-store
   ^-  (quip card _state)
-  :_  state
+  ?.  ?=(?(%path %add %remove) -.upd)
-  ?+  -.upd  ~
+    [~ state]
-      ?(%path %add %remove)
+  =/  socs=(list app-path)
-    =/  whos=(list ship)  ~(tap in members.upd)
+    (app-paths-from-group:md %link pax.upd)
-    |-  ^-  (list card)
+  =/  whos=(list ship)
-    ?~  whos  ~
+    ~(tap in members.upd)
-    ::  no need to subscribe to ourselves
+  =|  cards=(list card)
-    ::
+  |-
-    ?:  =(our.bowl i.whos)
+  =*  loop-socs  $
-      $(whos t.whos)
+  ?~  socs  [cards state]
+  |-
+  =*  loop-whos  $
+  ?~  whos  loop-socs(socs t.socs)
+  =^  caz  state
     ?:  ?=(%remove -.upd)
-      %+  weld
+      (leave-from-peer i.socs pax.upd i.whos)
-        $(whos t.whos)
+    (listen-to-peer i.socs pax.upd i.whos)
-      (end-link-subscriptions i.whos pax.upd)
+  loop-whos(whos t.whos, cards (weld cards caz))
-    :^    (start-link-subscription %local-pages i.whos pax.upd)
-        (start-link-subscription %annotations i.whos pax.upd)
-      (prod-other-listener i.whos pax.upd)
-    $(whos t.whos)
-  ==
 ::
 ::  link subscriptions
 ::
+++  listen-to-group
+  |=  [=app-path =group-path]
+  ^-  (quip card _state)
+  =/  peers=(list ship)
+    ~|  group-path
+    %~  tap  in
+    =-  (fall - *group:group-store)
+    %^  scry-for  (unit group:group-store)
+      %group-store
+    group-path
+  =|  cards=(list card)
+  |-
+  ?~  peers  [cards state]
+  =^  caz  state
+    (listen-to-peer app-path group-path i.peers)
+  $(peers t.peers, cards (weld cards caz))
+::
+++  leave-from-group
+  |=  [=app-path =group-path]
+  ^-  (quip card _state)
+  =/  peers=(list ship)
+    %~  tap  in
+    =-  (fall - *group:group-store)
+    %^  scry-for  (unit group:group-store)
+      %group-store
+    group-path
+  =|  cards=(list card)
+  |-
+  ?~  peers  [cards state]
+  =^  caz  state
+    (leave-from-peer app-path group-path i.peers)
+  $(peers t.peers, cards (weld cards caz))
+::
+++  listen-to-peer
+  |=  [=app-path =group-path who=ship]
+  ^-  (quip card _state)
+  ?:  =(our.bowl who)
+    [~ state]
+  :_  =-  state(reasoning -)
+      (~(put ju reasoning) [who app-path] group-path)
+  :-  (prod-other-listener who app-path)
+  ?^  (~(get ju reasoning) [who app-path])
+    ~
+  (start-link-subscriptions who app-path)
+::
+++  leave-from-peer
+  |=  [=app-path =group-path who=ship]
+  ^-  (quip card _state)
+  ?:  =(our.bowl who)
+    [~ state]
+  :_  =-  state(reasoning -)
+      (~(del ju reasoning) [who app-path] group-path)
+  ?.  (~(has ju reasoning) [who app-path] group-path)
+    ~
+  (end-link-subscriptions who app-path)
+::
+++  start-link-subscriptions
+  |=  [=ship =app-path]
+  ^-  (list card)
+  :~  (start-link-subscription %local-pages ship app-path)
+      (start-link-subscription %annotations ship app-path)
+  ==
+::
 ++  start-link-subscription
   |=  =target
   ^-  card
@@ -283,7 +402,7 @@
 ++  take-retry
   |=  =target
   ^-  (list card)
-  ::  relevant: whether :who is still in group :where
+  ::  relevant: whether :who is still associated with resource :where
   ::
   =;  relevant=?
     ?.  relevant  ~
@@ -291,16 +410,13 @@
   ?:  %-  ~(has by wex.bowl)
       [[%links (target-to-wire target)] who.target %link-proxy-hook]
     |
-  %.  who.target
+  %+  lien  (groups-from-resource:md %link where.target)
-  %~  has  in
+  |=  =group-path
-  =-  (fall - *group:group-store)
+  ^-  ?
-  .^  (unit group:group-store)
+  =-  (~(has in (fall - *group:group-store)) who.target)
-    %gx
+  %^  scry-for  (unit group:group-store)
-    (scot %p our.bowl)
     %group-store
-    (scot %da now.bowl)
+  group-path
-    (snoc where.target %noun)
-  ==
 ::
 ++  do-link-action
   |=  [=wire =action]
@@ -373,4 +489,14 @@
     ==
   %-  (slog tank u.p.sign)
   [~ state]
+::
+++  scry-for
+  |*  [=mold =app-name =path]
+  .^  mold
+    %gx
+    (scot %p our.bowl)
+    app-name
+    (scot %da now.bowl)
+    (snoc `^path`path %noun)
+  ==
 --

pkg/arvo/app/link-proxy-hook.hoon

@@ -4,12 +4,11 @@
 ::    stores if permission conditions are met.
 ::    the patterns herein should one day be generalized into a proxy-hook lib.
 ::
-::    this adopts a very primitive view of groups-store as containing only
+::    this uses metadata-store to discover resources and their associated
-::    groups of interesting (rather than uninteresting) ships. it sets the
+::    groups. it sets the permission condition to be that a ship must be in a
-::    permission condition to be that ship must be in group matching the path
+::    group associated with the resource it's subscribing to.
-::    it's subscribing to.
+::    we check this on-watch, but also subscribe to metadata & groups so that
-::    we check this on-watch, but also subscribe to groups so that we can kick
+::    we can kick subscriptions if needed (eg ship removed from group).
-::    subscriptions if needed (eg ship removed from group).
 ::
 ::    we deduplicate incoming subscriptions on the same path, ensuring we have
 ::    exactly one local subscription per unique incoming subscription path.
@@ -18,10 +17,10 @@
 ::    become part of the stores standard anyway.
 ::
 ::    when adding support for new paths, the only things you'll likely want
-::    to touch are +permitted, +initial-response, & maybe +handle-group-update.
+::    to touch are +permitted, +initial-response, & +kick-proxies.
 ::
-/-  group-store
+/-  group-store, *metadata-store
-/+  *link, default-agent, verb, dbug
+/+  *link, metadata, default-agent, verb, dbug
 |%
 +$  state-0
   $:  %0
@@ -48,7 +47,7 @@
   ++  on-init
     ^-  (quip card _this)
     :_  this
-    [watch-groups:do]~
+    ~[watch-groups:do watch-metadata:do]
   ::
   ++  on-save  !>(state)
   ++  on-load
@@ -96,11 +95,15 @@
   --
 ::
 |_  =bowl:gall
++*  md  ~(. metadata bowl)
+::
+::  permissions
+::
 ++  permitted
   |=  [who=ship =path]
   ^-  ?
-  ::  we only expose group-specific /local-pages and /annotations,
+  ::  we only expose /local-pages and /annotations,
-  ::  and only to ships in the relevant group.
+  ::  to ships in the groups associated with the resource.
   ::  (no url-specific annotations subscriptions, either.)
   ::
   =/  target=(unit ^path)
@@ -110,12 +113,75 @@
       `t.t.path
     ~
   ?~  target  |
-  =;  group
+  ~?  !.^(? %gu (scot %p our.bowl) %metadata-store (scot %da now.bowl) ~)
-    ?&  ?=(^ group)
+    %woah-md-s-not-booted  ::TODO  fallback if needed
-        (~(has in u.group) who)
+  %+  lien  (groups-from-resource:md %link u.target)
-    ==
+  |=  =group-path
-  %+  scry-for  (unit group:group-store)
+  ^-  ?
-  [%group-store u.target]
+  =-  (~(has in (fall - *group:group-store)) who)
+  %^  scry-for  (unit group:group-store)
+    %group-store
+  group-path
+::
+++  kick-revoked-permissions
+  |=  [=path who=(list ship)]
+  ^-  (list card)
+  %+  murn  who
+  |=  =ship
+  ^-  (unit card)
+  ::  no need to remove to ourselves
+  ::
+  ?:  =(our.bowl ship)  ~
+  ?:  (permitted ship path)  ~
+  `(kick-proxies ship path)
+::
+::  metadata subscription
+::
+++  watch-metadata
+  ^-  card
+  [%pass /metadata %agent [our.bowl %metadata-store] %watch /app-name/link]
+::
+++  take-metadata-sign
+  |=  =sign:agent:gall
+  ^-  (quip card _state)
+  ?-  -.sign
+    %poke-ack     ~|([dap.bowl %unexpected-poke-ack /metadata] !!)
+    %kick         [[watch-metadata]~ state]
+  ::
+      %watch-ack
+    ?~  p.sign  [~ state]
+    =/  =tank
+      :-  %leaf
+      "{(trip dap.bowl)} failed subscribe to metadata store. very wrong!"
+    %-  (slog tank u.p.sign)
+    [~ state]
+  ::
+      %fact
+    =*  mark  p.cage.sign
+    =*  vase  q.cage.sign
+    ?.  ?=(%metadata-update mark)
+      ~|  [dap.bowl %unexpected-mark mark]
+      !!
+    %-  handle-metadata-update
+    !<(metadata-update vase)
+  ==
+::
+++  handle-metadata-update
+  |=  upd=metadata-update
+  ^-  (quip card _state)
+  :_  state
+  ?.  ?=(%remove -.upd)  ~
+  ?>  =(%link app-name.resource.upd)
+  ::  if a group is no longer associated with a resource,
+  ::  we need to re-check permissions for everyone in that group.
+  ::
+  %+  kick-revoked-permissions
+    app-path.resource.upd
+  %~  tap  in
+  =-  (fall - *group:group-store)
+  %^  scry-for  (unit group:group-store)
+    %group-store
+  group-path.upd
 ::
 ::  groups subscription
 ::TODO  largely copied from link-listen-hook. maybe make a store-listener lib?
@@ -153,29 +219,26 @@
   ^-  (quip card _state)
   :_  state
   ?.  ?=(%remove -.upd)  ~
-  =/  whos=(list ship)  ~(tap in members.upd)
+  ::  if someone was removed from a group, find all link resources associated
-  |-  ^-  (list card)
+  ::  with that group, then kick their subscriptions if they're no longer
-  ?~  whos  ~
-  ::  no need to remove to ourselves
   ::
-  ?:  =(our.bowl i.whos)
+  %-  zing
-    $(whos t.whos)
+  %+  turn  (app-paths-from-group:md %link pax.upd)
-  :_  $(whos t.whos)
+  |=  =app-path
-  ::NOTE  this depends kind of unfortunately on the fact that we only accept
+  ^-  (list card)
-  ::      subscriptions to /local-pages//* paths. it'd be more correct if we
+  %+  kick-revoked-permissions
-  ::      "just" looked at all paths in the map, and found the matching ones.
+    app-path
-  ::TODO  what exactly did i mean by this?
+  ~(tap in members.upd)
-  %+  kick-proxies  i.whos
-  :~  [%local-pages pax.upd]
-      [%annotations '' pax.upd]
-  ==
 ::
 ::  proxy subscriptions
 ::
 ++  kick-proxies
-  |=  [who=ship paths=(list path)]
+  |=  [who=ship =path]
   ^-  card
-  [%give %kick paths `who]
+  =-  [%give %kick - `who]
+  :~  [%local-pages path]
+      [%annotations %$ path]
+  ==
 ::
 ++  handle-proxy-sign
   |=  [=wire =sign:agent:gall]
@@ -211,14 +274,10 @@
     [%give %fact ~ %link-initial !>(initial)]
   ?+  path  !!
       [%local-pages ^]
-    :-  %local-pages
+    [%local-pages .^((map ^path pages) %gx path)]
-    %+  scry-for  (map ^path pages)
-    [%link-store path]
   ::
       [%annotations %$ ^]
-    :-  %annotations
+    [%annotations .^((per-path-url notes) %gx %$ t.t.path)]
-    %+  scry-for  (per-path-url notes)
-    [%link-store path]
   ==
 ::
 ++  start-proxy
@@ -249,12 +308,14 @@
   ::
   [(proxy-pass-link-store path %leave ~)]~
 ::
+::  helpers
+::
 ++  scry-for
-  |*  [=mold app=term =path]
+  |*  [=mold =app-name =path]
   .^  mold
     %gx
     (scot %p our.bowl)
-    app
+    app-name
     (scot %da now.bowl)
     (snoc `^path`path %noun)
   ==