Skip to content

Commit

Permalink
contacts: implement subscription retry
Browse files Browse the repository at this point in the history
  • Loading branch information
@mikolajpp
mikolajpp committed Sep 21, 2024
1 parent 2c0ea4a commit 723717c
Show file tree
Hide file tree
Showing 2 changed files with 111 additions and 25 deletions.
82 changes: 65 additions & 17 deletions desk/app/contacts.hoon
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,14 @@
:: .for: foreign profile
:: .sag: foreign subscription state
::
+| %molds
+$ card card:agent:gall
+$ state-1 [%1 rof=profile =book =peers]
+| %types
+$ card card:agent:gall
+$ state-1 $: %1
rof=profile
=book
=peers
retry=(map ship @da) :: retry sub at time
==
--
:: %- %^ agent:neg
:: notify=|
Expand All @@ -27,7 +32,6 @@
^- agent:gall
=| state-1
=* state -
::
=< |_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
Expand Down Expand Up @@ -67,15 +71,19 @@
=^ cards state abet:(agent:cor wire sign)
[cards this]
::
++ on-arvo on-arvo:def
++ on-arvo
|= [=wire sign=sign-arvo]
=^ cards state abet:(arvo:cor wire sign)
[cards this]
::
++ on-fail on-fail:def
--
::

|%
::
+| %state
::
:: namespaced to avoid accidental direct reference
:: namespaced to avoid accidental direct reference
::
++ raw
=| out=(list card)
Expand Down Expand Up @@ -157,7 +165,7 @@
?> (sane-contact con)
(p-send-page cid con)
:: +p-spot: add peer as a contact
::
::
++ p-spot
|= [who=ship mod=contact]
?: (~(has by book) who)
Expand Down Expand Up @@ -247,7 +255,7 @@
++ p-news-0
|= n=news-0:legacy
(give %fact ~[/news] %contact-news !>(n))
:: +p-resp: publish response
:: +p-resp: publish response
::
++ p-resp
|= r=response
Expand Down Expand Up @@ -313,7 +321,17 @@
%poke-ack ~|(strange-poke-ack+wire !!)
::
%watch-ack ~| strange-watch-ack+wire
si-cor
?> ?=(%want sag)
?~ p.sign si-cor
%- (slog 'contact-fail' u.p.sign)
:: schedule retry 30m later
:: XX set production timer
::
=/ wake=@da (add now.bowl ~s10)
=. retry (~(put by retry) who wake)
%_ si-cor cor
(pass /~/retry/(scot %p who) %arvo %b %wait wake)
==
::
%kick si-meet(sag ~)
::
Expand All @@ -325,7 +343,8 @@
++ si-hear
|= u=update
^+ si-cor
?> (sane-contact con.u)
?. (sane-contact con.u)
si-cor
?: &(?=(^ for) (lte wen.u wen.for))
si-cor
%_ si-cor
Expand All @@ -345,22 +364,36 @@
++ si-meet
^+ si-cor
::
:: already connected
:: already subscribed
?: ?=(%want sag)
si-cor
=/ pat [%v1 %contact ?~(for / /at/(scot %da wen.for))]
%= si-cor
%_ si-cor
cor (pass /contact %agent [who dap.bowl] %watch pat)
sag %want
==
::
++ si-retry
^+ si-cor
=. retry (~(del by retry) who)
si-meet(sag ~)
::
++ si-drop si-snub(sas %dead)
::
++ si-snub
%_ si-cor
sag ~
cor ?. ?=(%want sag) cor
(pass /contact %agent [who dap.bowl] %leave ~)
:: retry is scheduled, cancel the timer
::
:: XX make sure this is correct: if we received
:: negative %watch-ack there is no need to %leave the
:: subscription
::
?^ when=(~(get by retry) who)
=. retry (~(del by retry) who)
(pass /~/retry/(scot %p who)/cancel %arvo %b %rest u.when)
(pass /contact %agent [who dap.bowl] %leave ~)
==
--
--
Expand Down Expand Up @@ -502,7 +535,7 @@
=/ act-0 !<(action-0:legacy vase)
?. ?=(%edit -.act-0)
(to-action act-0)
:: v0 %edit needs special handling to evaluate
:: v0 %edit needs special handling to evaluate
:: groups edit
::
=/ groups=(set $>(%flag value))
Expand Down Expand Up @@ -596,7 +629,7 @@
[~ ~]
=/ page=(unit page)
(~(get by book) u.who)
``contact-page-0+!>(`^page`(fall page *^page))
``contact-page-0+!>(`^page`(fall page *^page))
::
[%u %v1 %book %id =cid ~]
?~ id=(slaw %uv cid.pat)
Expand Down Expand Up @@ -649,7 +682,7 @@
``contact-1+!>((contact-uni u.page))
?~ far=(~(get by peers) u.who)
[~ ~]
?~ for.u.far
?~ for.u.far
[~ ~]
``contact-1+!>(con.for.u.far)
::
Expand Down Expand Up @@ -688,11 +721,26 @@
?+ wire ~|(evil-agent+wire !!)
[%contact ~]
si-abet:(si-take:(sub src.bowl) wire sign)
::
[%migrate ~]
?> ?=(%poke-ack -.sign)
?~ p.sign cor
%- (slog leaf/"{<wire>} failed" u.p.sign)
cor
==
::
++ arvo
|= [=wire sign=sign-arvo]
^+ cor
?+ wire ~|(evil-vane+wire !!)
::
[%~.~ %retry her=@p ~]
:: XX technically, the timer could fail.
:: it should be ok to still retry.
::
?> ?=([%behn %wake *] sign)
=+ who=(slav %p i.t.t.wire)
si-abet:si-retry:(sub who)
==
--
--
54 changes: 46 additions & 8 deletions desk/tests/app/contacts.hoon
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,12 +3,14 @@
/+ c=contacts
/= contacts-agent /app/contacts
=* agent contacts-agent
:: XX consider simplifying tests
:: XX consider simplifying tests
:: with functional 'micro' strands, that set
:: a contact, subscribe to a peer etc.
::
|%
::
+| %help
::
++ tick ^~((rsh 3^2 ~s1))
++ mono
|= [old=@da new=@da]
Expand Down Expand Up @@ -112,7 +114,7 @@
:: action-0:x profile %edit
::
;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0]))
;< ~ b
;< ~ b
%+ ex-cards caz
:~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0]))
(ex-fact ~[/v1/news] contact-response-0+!>([%self con]))
Expand All @@ -123,7 +125,7 @@
;< peek=(unit (unit cage)) b
(get-peek /x/v1/self)
=/ cag (need (need peek))
;< ~ b
;< ~ b
%+ ex-equal
!> cag
!> contact-1+!>(con)
Expand All @@ -133,7 +135,7 @@
(do-poke %contact-action !>([%edit del-group+~sampel-palnet^%oranges ~]))
=/ new-con
(~(put by con) groups+set/~)
;< ~ b
;< ~ b
%+ ex-cards caz
:~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0(groups ~)]))
(ex-fact ~[/v1/news] contact-response-0+!>([%self new-con]))
Expand Down Expand Up @@ -344,7 +346,7 @@
=/ con-1=contact
%- malt
^- (list (pair @tas value))
:~ nickname+text/'Sun'
:~ nickname+text/'Sun'
bio+text/'It is bright today'
groups+set/(silt groups)
==
Expand Down Expand Up @@ -475,7 +477,7 @@
^- (list (pair @tas value))
~[nickname+text/'Bright Sun' avatar+text/'https://sun.io/sun.png']
;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod]))
:: ~sun's contact book page is updated
:: ~sun's contact book page is updated
::
;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun)
=/ cag=cage (need (need peek))
Expand Down Expand Up @@ -685,7 +687,7 @@
:: a peer ~sun. ~sun publishes his contact. subsequently,
:: ~sun is added to the contact book. we now snub ~sun.
:: ~sun is still found in peers.
::
::
++ test-poke-snub
%- eval-mare
=/ m (mare ,~)
Expand Down Expand Up @@ -787,7 +789,7 @@
::
;< ~ b (set-src ~sun)
;< caz=(list card) b (do-watch /v1/contact/at/(scot %da now.bowl))
;< ~ b
;< ~ b
%+ ex-cards caz
:~ (ex-fact ~ contact-update-1+!>([%full now con]))
==
Expand Down Expand Up @@ -972,4 +974,40 @@
%+ ex-equal
!> (~(got by dir) ~mur)
!> con-mur
:: +test-retry: test resubscription logic
::
:: scenario
::
:: we %meet ~sun. however, ~sun is running incompatible version.
:: negative %watch-ack arrives. we setup the timer to retry.
:: the timer fires. we resubscribe.
::
++ test-retry
%- eval-mare
=/ m (mare ,~)
=* b bind:m
^- form:m
::
;< caz=(list card) b (do-init %contacts contacts-agent)
;< =bowl b get-bowl
;< caz=(list card) b (do-poke contact-action-1+!>([%meet ~[~sun]]))
;< caz=(list card) b
%^ do-agent /contact
[~sun %contacts]
[%watch-ack (some leaf+"outdated contacts" ~)]
;< ~ b
%+ ex-cards caz
:~ %+ ex-arvo /~/retry/(scot %p ~sun)
[%b %wait (add now.bowl ~s10)]
==
;< caz=(list card) b
%+ do-arvo /~/retry/(scot %p ~sun)
[%behn %wake ~]
;< ~ b
%+ ex-cards caz
:~ %^ ex-task /contact
[~sun %contacts]
[%watch /v1/contact]
==
(ex-equal !>(~) !>(~))
--

0 comments on commit 723717c

Please sign in to comment.