shrub/pkg/landscape/app/contact-store.hoon
Philip Monk e1419d1787 contact-store: no-op if adding old contact
%contact-store is responsible for sending updates about contacts, eg
profile color.  When it hears an update, it fans that out to its
subsribers, unless that update is stale.  If you reguarly fan out stale
updates, then they reverberate across the network indefinitely -- we
call this "echoing".

To cut off this echoing, all edits have a timestamp, and we consider any
updates from before this timestamp to be stale.  Additions are separate
from edits, and for them we instead do a value comparison on the contact
-- if it didn't change, we consider the update stale.

The problem with this scheme is that if an addition and edit happen one
after the other in quick succession, you might have the following
sequence:

- add comes in with timestamp T1
- edit comes in with timestamp T2 after T1
- we hear an echo of the add, and that errantly applies because it
  passes our "did the contact actually change" check
- we hear an echo of the edit, which applies because T2 is after T1
- GOTO 3

Each time we apply the stale update, we fan that out to our subscribers,
and if any two hosts subscribe to each other, this will loop.  This may
even loop unconditionally because the ship that made the profile changes
seems like it might not recognize that those changes didn't come from
itself, so it sends them to all the groups it's in.  If so, that's an
important issue to fix.

Fixes tloncorp/landscape-issues#1442
2022-12-12 13:03:41 -07:00

279 lines
7.7 KiB
Plaintext

:: contact-store [landscape]:
::
:: data store that holds individual contact data
::
/- store=contact-store, *resource
/+ default-agent, dbug, *migrate, contact, verb
|%
+$ card card:agent:gall
+$ state-4
$: %4
=rolodex:store
allowed-groups=(set resource)
allowed-ships=(set ship)
is-public=_|
==
+$ versioned-state
$% [%0 *]
[%1 *]
[%2 *]
[%3 *]
state-4
==
--
::
=| state-4
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
con ~(. contact bowl)
::
++ on-init
=. rolodex (~(put by rolodex) our.bowl *contact:store)
[~ this(state state)]
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
?+ -.old
=. rolodex (~(put by rolodex) our.bowl *contact:store)
[~ this(state state)]
::
%4 [~ this(state old)]
==
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give [%initial rolodex is-public])
[%updates ~] ~
::
[%our ~]
%- give
:+ %add
our.bowl
=/ contact=(unit contact:store) (~(get by rolodex) our.bowl)
?~ contact *contact:store
u.contact
==
[cards this]
::
++ give
|= =update:store
^- (list card)
[%give %fact ~ [%contact-update-0 !>(update)]]~
--
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=^ cards state
?+ mark (on-poke:def mark vase)
%contact-update-0 (update !<(update:store vase))
%import (import q.vase)
==
[cards this]
::
++ update
|= =update:store
^- (quip card _state)
|^
?- -.update
%initial (handle-initial +.update)
%add (handle-add +.update)
%remove (handle-remove +.update)
%edit (handle-edit +.update)
%allow (handle-allow +.update)
%disallow (handle-disallow +.update)
%set-public (handle-set-public +.update)
==
::
++ handle-initial
|= [rolo=rolodex:store *]
^- (quip card _state)
=/ our-contact (~(got by rolodex) our.bowl)
=/ diff-rolo=rolodex:store
%- ~(gas by *rolodex:store)
%+ skim ~(tap in rolo)
|= [=ship =contact:store]
?~ local-con=(~(get by rolodex) ship) %.y
(gth last-updated.contact last-updated.u.local-con)
=/ new-rolo=rolodex:store
(~(uni by rolodex) diff-rolo)
=. new-rolo (~(put by new-rolo) our.bowl our-contact)
?: =(new-rolo rolodex) `state
:_ state(rolodex new-rolo)
(send-diff [%initial new-rolo is-public] %.n)
::
++ handle-add
|= [=ship =contact:store]
^- (quip card _state)
:: ensure difference
=/ old=(unit contact:store) (~(get by rolodex) ship)
?. ?| ?=(~ old)
:: if new contact is before existing contact, no-op
::
:: NB: last-updated.contact is often *@da, so this
:: effectively stops add from applying if we already have
:: a contact for them
::
?& (gth last-updated.contact last-updated.u.old)
!=(contact(last-updated *@da) u.old(last-updated *@da))
==
==
[~ state]
~| "cannot add a data url to cover!"
?> ?| ?=(~ cover.contact)
!=('data:' (cut 3 [0 5] u.cover.contact))
==
~| "cannot add a data url to avatar!"
?> ?| ?=(~ avatar.contact)
!=('data:' (cut 3 [0 5] u.avatar.contact))
==
:- (send-diff [%add ship contact] =(ship our.bowl))
state(rolodex (~(put by rolodex) ship contact))
::
++ handle-remove
|= =ship
^- (quip card _state)
?. (~(has by rolodex) ship)
[~ state]
:- (send-diff [%remove ship] =(ship our.bowl))
?: =(ship our.bowl)
state(rolodex (~(put by rolodex) our.bowl *contact:store))
state(rolodex (~(del by rolodex) ship))
::
++ handle-edit
|= [=ship =edit-field:store timestamp=@da]
|^
^- (quip card _state)
=/ old (fall (~(get by rolodex) ship) *contact:store)
?: (lte timestamp last-updated.old)
[~ state]
=/ contact (edit-contact old edit-field)
?: =(old contact)
[~ state]
~| "cannot add a data url to cover!"
?> ?| ?=(~ cover.contact)
!=('data:' (cut 3 [0 5] u.cover.contact))
==
~| "cannot add a data url to avatar!"
?> ?| ?=(~ avatar.contact)
!=('data:' (cut 3 [0 5] u.avatar.contact))
==
=. last-updated.contact timestamp
:- (send-diff [%edit ship edit-field timestamp] =(ship our.bowl))
state(rolodex (~(put by rolodex) ship contact))
::
++ edit-contact
|= [=contact:store edit=edit-field:store]
^- contact:store
?- -.edit
%nickname contact(nickname nickname.edit)
%bio contact(bio bio.edit)
%status contact(status status.edit)
%color contact(color color.edit)
%avatar contact(avatar avatar.edit)
%cover contact(cover cover.edit)
::
%add-group
contact(groups (~(put in groups.contact) resource.edit))
::
%remove-group
contact(groups (~(del in groups.contact) resource.edit))
==
--
::
++ handle-allow
|= =beings:store
^- (quip card _state)
:- (send-diff [%allow beings] %.n)
?- -.beings
%group state(allowed-groups (~(put in allowed-groups) resource.beings))
%ships state(allowed-ships (~(uni in allowed-ships) ships.beings))
==
::
++ handle-disallow
|= =beings:store
^- (quip card _state)
:- (send-diff [%disallow beings] %.y)
?- -.beings
%group state(allowed-groups (~(del in allowed-groups) resource.beings))
%ships state(allowed-ships (~(dif in allowed-ships) ships.beings))
==
::
++ handle-set-public
|= public=?
^- (quip card _state)
:_ state(is-public public)
(send-diff [%set-public public] %.n)
::
++ send-diff
|= [=update:store our=?]
^- (list card)
=/ paths=(list path)
?: our
[/updates /our /all ~]
[/updates /all ~]
[%give %fact paths %contact-update-0 !>(update)]~
--
::
++ import
|= arc=*
^- (quip card _state)
:: note: we are purposefully wiping all state before state-4
[~ *state-4]
--
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(`rolodex:store`rolodex)
::
[%x %contact @ ~]
=/ =ship (slav %p i.t.t.path)
=/ contact=(unit contact:store) (~(get by rolodex) ship)
?~ contact [~ ~]
:- ~ :- ~ :- %contact-update-0
!> ^- update:store
[%add ship u.contact]
::
[%x %allowed-ship @ ~]
=/ =ship (slav %p i.t.t.path)
``noun+!>(`?`(~(has in allowed-ships) ship))
::
[%x %is-public ~]
``noun+!>(`?`is-public)
::
[%x %allowed-groups ~]
``noun+!>(`(set resource)`allowed-groups)
::
[%x %is-allowed @ @ @ @ ~]
=/ is-personal =(i.t.t.t.t.t.path 'true')
=/ =resource
?: is-personal
[our.bowl %'']
[(slav %p i.t.t.path) i.t.t.t.path]
=/ =ship (slav %p i.t.t.t.t.path)
``json+!>(`json`b+(is-allowed:con resource ship))
==
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--