From 02ac5fbbc4af008bf031266cb75a446e26e7e2ac Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Sat, 21 Sep 2024 12:11:15 +0800 Subject: [PATCH] contacts: implement subscription retry --- desk/app/contacts.hoon | 90 +++++++++++++++++++++++++++--------- desk/tests/app/contacts.hoon | 52 +++++++++++++++++---- 2 files changed, 113 insertions(+), 29 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 1f5bbefe..8b8c8249 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -14,20 +14,24 @@ :: .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=| -:: [~.contacts^%1 ~ ~] -:: [~.contacts^[~.contacts^%1 ~ ~] ~ ~] +%- %^ agent:neg + notify=| + [~.contacts^%1 ~ ~] + [~.contacts^[~.contacts^%1 ~ ~] ~ ~] %- agent:dbug %+ verb | ^- agent:gall =| state-1 =* state - -:: =< |_ =bowl:gall +* this . def ~(. (default-agent this %|) bowl) @@ -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) @@ -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) @@ -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 @@ -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 ~) :: @@ -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 @@ -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 ~) == -- -- @@ -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)) @@ -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) @@ -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) :: @@ -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/"{} 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) + == -- -- diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 97d0ca83..6759b8e6 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -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] @@ -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])) @@ -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) @@ -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])) @@ -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) == @@ -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)) @@ -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 ,~) @@ -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])) == @@ -972,4 +974,38 @@ %+ 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 ~] + %+ ex-cards caz + :~ %^ ex-task /contact + [~sun %contacts] + [%watch /v1/contact] + == --