From d6f293775ca85efb49d28b4a4777e0bc29f5c917 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Thu, 22 Aug 2024 22:57:28 +0800 Subject: [PATCH 01/44] contacts: draft new structures --- desk/sur/contacts.hoon | 106 +++++++++++++++++++++++++++++++++++------ 1 file changed, 92 insertions(+), 14 deletions(-) diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index d54de767..925a6dfa 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -16,7 +16,7 @@ :: we wait to be upgraded.) :: +| %compat -++ okay `epic`0 +++ okay `epic`1 ++ mar |% ++ base @@ -30,19 +30,66 @@ -- :: +| %types -+$ contact ++$ contact-0 $: nickname=@t bio=@t status=@t - color=@ux + color=@uxF avatar=(unit @t) cover=(unit @t) groups=(set flag:g) == :: -+$ foreign [for=$@(~ profile) sag=$@(~ saga)] -+$ profile [wen=@da con=$@(~ contact)] -+$ rolodex (map ship foreign) ++$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga)] ++$ profile-0 [wen=@da con=$@(~ contact-0)] ++$ rolodex-0 (map ship foreign-0) +:: ++$ contact contact-0 ++$ foreign foreign-0 ++$ profile profile-0 ++$ rolodex rolodex-0 ++$ field field-0 ++$ action action-0 ++$ news news-0 ++$ update update-0 +:: ++$ field-1 + $% [%text p=@t] + [%date p=@da] + [%quot p=@ud] + [%frac p=@rd] + :: + :: color + [%tint p=@ux] + [%ship p=ship] + :: + :: picture + [%look p=@ta] + :: + :: network resource + [%link p=@ta] + :: + :: geocode (XX introduce @x aura to Hoon) + [%geos @x] + [%tags p=(set @t)] + :: XX typechecker could be smarter here? + [%rows p=$@(~ (list field-1))] + [%set p=$@(~ (set field-1))] + == ++$ contact-1 (map @tas field-1) ++$ foreign-1 [for=$@(~ profile-1) sag=$@(~ saga)] +:: .wen: date +:: .con: contact +:: .mod: user modified +:: ++$ profile-1 [wen=@da con=(unit contact-1) mod=(unit contact-1)] +:: +:: contact id ++$ cid @uvF ++$ rolodex-1 + $% rox=(map cid @ta) + net=(map ship cid) + == :: +$ epic epic:e +$ saga @@ -53,18 +100,18 @@ == saga:e :: -+$ field ++$ field-0 $% [%nickname nickname=@t] [%bio bio=@t] [%status status=@t] - [%color color=@ux] + [%color color=@uxF] [%avatar avatar=(unit @t)] [%cover cover=(unit @t)] [%add-group =flag:g] [%del-group =flag:g] == :: -+$ action ++$ action-0 :: %anon: delete our profile :: %edit: change our profile :: %meet: track a peer @@ -73,17 +120,48 @@ :: %snub: unfollow a peer :: $% [%anon ~] - [%edit p=(list field)] + [%edit p=(list field-0)] [%meet p=(list ship)] [%heed p=(list ship)] [%drop p=(list ship)] [%snub p=(list ship)] == +:: network :: -+$ update :: network - $% [%full profile] ++$ update-0 + $% [%full profile-0] == +:: local +:: ++$ news-0 + [who=ship con=$@(~ contact-0)] +:: %anon: delete our profile +:: %edit: change profile +:: %meet: track a peer +:: %heed: follow a peer +:: %spot: discover contact peer +:: %drop: discard a peer +:: %snub: unfollow a peer :: -+$ news :: local - [who=ship con=$@(~ contact)] ++$ action-1 + $% [%anon ~] + [%edit p=ship q=(list (pair @t field-1))] + [%meet p=(list ship)] + [%heed p=(list ship)] + [%spot p=(list (pair ship cid))] + [%drop p=(list ship)] + [%snub p=(list ship)] + == +:: network +:: ++$ update-1 + $% [%full profile-1] + [%field (pair @tas (unit field-1))] + == +:: local +:: ++$ news-1 + $% [%full who=ship con=(unit contact-1)] + [%field who=ship fil=(pair @tas (unit field-1))] + == -- From fb20b2d3e49782e209a72664be0426e41a90dfcf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 27 Aug 2024 15:53:29 +0800 Subject: [PATCH 02/44] %contacts: structures v1 --- desk/app/contacts.hoon | 220 ++++++++++++++++++++++++++++++++++- desk/lib/contacts-json.hoon | 42 +++---- desk/sur/contacts.hoon | 133 ++++++++++++++------- desk/tests/app/contacts.hoon | 6 + 4 files changed, 337 insertions(+), 64 deletions(-) create mode 100644 desk/tests/app/contacts.hoon diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 51077350..3cd1cc44 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -14,7 +14,8 @@ :: +| %types +$ card card:agent:gall -+$ state-0 [%0 rof=$@(~ profile) rol=rolodex] ++$ state-0 [%0 rof=$@(~ profile-0) rol=rolodex-0] ++$ state-1 [%1 rof=$@(~ profile-1) rol=rolodex-1] -- :: %- agent:dbug @@ -70,8 +71,108 @@ :: +| %help :: -++ do-edit - |= [c=contact f=field] +:: +cy: contact map engine +:: +++ cy + |_ c=contact-1 + :: +get: get typed value + :: + ++ get + |* [key=@tas typ=value-type-1] + ^- (unit _p:*$>(_typ value-1)) + =/ val=(unit value-1) (~(get by c) key) + ?~ val ~ + ?~ u.val !! + ~| "{} expected at {}" + :: XX Hoon compiler really needs to eat more fish + :: ?> ?=($>(_typ value-1) -.u.val) + :: +.u.val + :: + ?- typ + %text ?>(?=(%text -.u.val) (some p.u.val)) + %date ?>(?=(%date -.u.val) (some p.u.val)) + %tint ?>(?=(%tint -.u.val) (some p.u.val)) + %ship ?>(?=(%ship -.u.val) (some p.u.val)) + %look ?>(?=(%look -.u.val) (some p.u.val)) + %cult ?>(?=(%cult -.u.val) (some p.u.val)) + %set ?>(?=(%set -.u.val) (some p.u.val)) + == + :: +gos: got specialized to set + :: + ++ gos + |* [key=@tas typ=value-type-1] + :: XX make Hoon compiler smarter + :: to be able to specialize to uniform set of + :: type typ. + :: =* vat $>(_typ value-1) + :: ^- (set _+:*vat) + :: + =/ val=value-1 (~(got by c) key) + ?~ val !! + ~| "set expected at {}" + ?> ?=(%set -.val) + p.val + :: +gut: got with default + :: + ++ gut + |* [key=@tas def=value-1] + ^+ +.def + =/ val=value-1 (~(gut by c) key ~) + ?~ val + +.def + ~| "{<-.def>} expected at {}" + :: XX wish for Hoon compiler to be smarter. + :: this results in fish-loop. + :: ?+ -.def !! + :: %text ?>(?=(%text -.val) +.val) + :: == + :: ?> ?=(_-.def -.val) + ?- -.val + %text ?>(?=(%text -.def) p.val) + %date ?>(?=(%date -.def) p.val) + %tint ?>(?=(%tint -.def) p.val) + %ship ?>(?=(%ship -.def) p.val) + %look ?>(?=(%look -.def) p.val) + %cult ?>(?=(%cult -.def) p.val) + %set ?>(?=(%set -.def) p.val) + == + :: +gub: got with bunt default + :: + ++ gub + |* [key=@tas typ=value-type-1] + ^+ +:*$>(_typ value-1) + =/ val=value-1 (~(gut by c) key ~) + ?~ val + ?+ typ !! + %text p:*$>(%text value-1) + %date p:*$>(%date value-1) + %tint p:*$>(%tint value-1) + %ship p:*$>(%ship value-1) + %look p:*$>(%look value-1) + %cult p:*$>(%cult value-1) + %set p:*$>(%set value-1) + == + :: ~| "{} expected to be {<-.def>}" + :: XX wish for Hoon compiler to be smarter. + :: this results in fish-loop. + :: ?+ -.def !! + :: %text ?>(?=(%text -.val) +.val) + :: == + :: ?> ?=(_-.def -.val) + :: + ?- typ + %text ?>(?=(_typ -.val) p.val) + %date ?>(?=(_typ -.val) p.val) + %tint ?>(?=(%tint -.val) p.val) + %ship ?>(?=(%ship -.val) p.val) + %look ?>(?=(%look -.val) p.val) + %cult ?>(?=(%cult -.val) p.val) + %set ?>(?=(%set -.val) p.val) + == + -- +++ do-edit do-edit-0 +++ do-edit-0 + |= [c=contact-0 f=field-0] ^+ c ?- -.f %nickname c(nickname nickname.f) @@ -95,6 +196,119 @@ :: %del-group c(groups (~(del in groups.c) flag.f)) == +++ do-edit-1 + |= [con=contact-1 edit=(list (pair @tas value-1))] + ^+ con + =/ don (~(gas by con) edit) + :: XX are these checks neccessary? + :: if so, we need to introduce link field. + :: + =+ avatar=(~(get cy don) %avatar %text) + ?: ?& ?=(^ avatar) + =('data:' (end 3^5 u.avatar)) + == + ~| "cannot add a data url to avatar" !! + =+ cover=(~(get cy don) %cover %text) + ?: ?& ?=(^ cover) + !=('data:' (end 3^5 u.cover)) + == + ~| "cannot add a data url to cover" !! + :: + don +:: +to-contact-1: convert contact-0 +:: +++ to-contact-1 + |= c=contact-0 + ^- contact-1 + =/ o=contact-1 + %- malt + ^- (list (pair @tas value-1)) + :~ nickname+text/nickname.c + bio+text/bio.c + status+text/status.c + color+tint/color.c + == + =? o ?=(^ avatar.c) + (~(put by o) %avatar text/u.avatar.c) + =? o ?=(^ cover.c) + (~(put by o) %cover text/u.cover.c) + =. o %+ ~(put by o) %groups + :- %set + %- ~(run in groups.c) + |= =flag:g + cult/flag + o +:: +to-contact-0: convert contact-1 +:: +++ to-contact-0 + |= c=contact-1 + ^- contact-0 + =| o=contact-0 + %= o + nickname + (~(gub cy c) %nickname %text) + bio + (~(gut cy c) %bio text/'') + status + (~(gut cy c) %status text/'') + color + (~(gut cy c) %color tint/0x0) + avatar + :: XX prohibit data: link + (~(get cy c) %avatar %text) + cover + :: XX prohibit data: link + (~(get cy c) %cover %text) + groups + ^- (set flag:g) + %- ~(run in (~(gos cy c) %groups %cult)) + |= val=value-1 + ?> ?=(%cult -.val) + p.val + == +:: +to-profile-1: convert profile-0 +:: +++ to-profile-1 + |= o=profile-0 + ^- profile-1 + [wen.o ?~(con.o ~ (to-contact-1 con.o))] +:: +gen-cid: generate new contact id +:: +++ gen-cid + |= [eny=@uvJ =book] + ^- cid + =/ nid=cid + (end [0 4] eny) + |- + ?. |(=(0x0 nid) (~(has by book) nid)) + nid + $(nid +(nid)) +:: +to-rolodex-1: convert rolodex-0 +:: +:: ++ to-rolodex-1 +:: |= [eny=@uvJ r=rolodex-0] +:: ^- rolodex-1 +:: %- ~(rep by r) +:: |= $: [=ship raf=foreign-0] +:: acc=rolodex-1 +:: == +:: =+ cid=(gen-cid eny book.acc) +:: =/ far=foreign-1 +:: ?~ for.raf +:: [~ sag.raf] +:: [(some cid) sag.raf] +:: %_ acc +:: book +:: ?~ for.raf book.acc +:: ?~ con.for.raf +:: (~(put by book.acc) cid *page) +:: %+ ~(put by book.acc) +:: cid +:: ^- page +:: [[wen.for.raf (to-contact-1 con.for.raf)] ~] +:: net +:: (~(put by net.acc) ship far) +:: == :: ++ mono |= [old=@da new=@da] diff --git a/desk/lib/contacts-json.hoon b/desk/lib/contacts-json.hoon index 2fc4730a..fb1ab6f2 100644 --- a/desk/lib/contacts-json.hoon +++ b/desk/lib/contacts-json.hoon @@ -9,21 +9,21 @@ ++ ship |=(her=@p n+(rap 3 '"' (scot %p her) '"' ~)) :: - ++ action - |= a=action:c + ++ action-0 + |= a=action-0:c ^- json %+ frond -.a ?- -.a %anon ~ - %edit a+(turn p.a field) + %edit a+(turn p.a field-0) %meet a+(turn p.a ship) %heed a+(turn p.a ship) %drop a+(turn p.a ship) %snub a+(turn p.a ship) == :: - ++ contact - |= c=contact:c + ++ contact-0 + |= c=contact-0:c ^- json %- pairs :~ nickname+s+nickname.c @@ -38,8 +38,8 @@ |=([f=flag:g j=(list json)] [s+(flag:enjs:gj f) j]) == :: - ++ field - |= f=field:c + ++ field-0 + |= f=field-0:c ^- json %+ frond -.f ?- -.f @@ -53,20 +53,20 @@ %del-group s+(flag:enjs:gj flag.f) == :: - ++ rolodex - |= r=rolodex:c + ++ rolodex-0 + |= r=rolodex-0:c ^- json %- pairs %- ~(rep by r) - |= [[who=@p foreign:c] j=(list [@t json])] - [[(scot %p who) ?.(?=([@ ^] for) ~ (contact con.for))] j] :: XX stale flag per sub state? + |= [[who=@p foreign-0:c] j=(list [@t json])] + [[(scot %p who) ?.(?=([@ ^] for) ~ (contact-0 con.for))] j] :: XX stale flag per sub state? :: - ++ news - |= n=news:c + ++ news-0 + |= n=news-0:c ^- json %- pairs :~ who+(ship who.n) - con+?~(con.n ~ (contact con.n)) + con+?~(con.n ~ (contact-0 con.n)) == -- :: @@ -92,19 +92,19 @@ (slav aur (cut 3 [1 (sub wyd 2)] p.jon)) == :: - ++ action - ^- $-(json action:c) + ++ action-0 + ^- $-(json action-0:c) %- of :~ anon+ul - edit+(ar field) + edit+(ar field-0) meet+(ar ship) heed+(ar ship) drop+(ar ship) snub+(ar ship) == :: - ++ contact - ^- $-(json contact:c) + ++ contact-0 + ^- $-(json contact-0:c) %- ot :~ nickname+so bio+so @@ -115,8 +115,8 @@ groups+(as flag:dejs:gj) == :: - ++ field - ^- $-(json field:c) + ++ field-0 + ^- $-(json field-0:c) %- of :~ nickname+so bio+so diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 925a6dfa..6e766b5f 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -34,7 +34,7 @@ $: nickname=@t bio=@t status=@t - color=@uxF + color=@ux avatar=(unit @t) cover=(unit @t) groups=(set flag:g) @@ -44,20 +44,39 @@ +$ profile-0 [wen=@da con=$@(~ contact-0)] +$ rolodex-0 (map ship foreign-0) :: -+$ contact contact-0 -+$ foreign foreign-0 -+$ profile profile-0 -+$ rolodex rolodex-0 -+$ field field-0 -+$ action action-0 -+$ news news-0 -+$ update update-0 :: -+$ field-1 ++$ value-type-1 + $? %text + %date + %tint + %look + %cult + %set + == +++ unis + |= set=(set value-1) + ^- ? + ?~ set & + =/ typ -.n.set + |- + ?^ l.set + ?. =(typ -.n.l.set) + | + $(set l.set) + ?^ r.set + ?. =(typ -.n.r.set) + | + $(set r.set) + ?. =(typ -.n.set) + | + & +:: $value-1: contact field value +:: ++$ value-1 + $+ contact-value-1 + $@ ~ $% [%text p=@t] [%date p=@da] - [%quot p=@ud] - [%frac p=@rd] :: :: color [%tint p=@ux] @@ -66,29 +85,48 @@ :: picture [%look p=@ta] :: - :: network resource - [%link p=@ta] + :: group + [%cult p=flag:g] :: - :: geocode (XX introduce @x aura to Hoon) - [%geos @x] - [%tags p=(set @t)] - :: XX typechecker could be smarter here? - [%rows p=$@(~ (list field-1))] - [%set p=$@(~ (set field-1))] + :: uniform set + [%set $|(p=(set value-1) unis)] == -+$ contact-1 (map @tas field-1) -+$ foreign-1 [for=$@(~ profile-1) sag=$@(~ saga)] -:: .wen: date -:: .con: contact -:: .mod: user modified +:: $contact-1: contact data +:: ++$ contact-1 (map @tas value-1) +:: $foreign-1: foreign profile +:: +:: .for: profile +:: .con: optional contact id +:: .sag: connection status :: -+$ profile-1 [wen=@da con=(unit contact-1) mod=(unit contact-1)] ++$ foreign-1 [for=$@(~ profile-1) cid=(unit cid) sag=$@(~ saga)] +:: $cid: contact page id +:: +:: generated from entropy and guaranteed non-zero +:: :: -:: contact id +$ cid @uvF +:: $profile-1: contact profile +:: +:: .wen: last updated +:: .con: contact +:: ++$ profile-1 [wen=@da con=contact-1] +:: $page: contact book page +:: ++$ page (pair (unit ship) $@(~ profile-1)) +:: $book: contact book +:: ++$ book (map cid page) +:: $rolodex-1: rolodex +:: +:: .book: contact book, original and modified +:: .net: network contacts +:: +$ rolodex-1 - $% rox=(map cid @ta) - net=(map ship cid) + $: =book + net=(map ship foreign-1) == :: +$ epic epic:e @@ -135,33 +173,48 @@ :: +$ news-0 [who=ship con=$@(~ contact-0)] -:: %anon: delete our profile -:: %edit: change profile +:: %anon: delete the profile +:: %page: create a new contact page +:: %edit: edit the profile or a contact page +:: %wipe: delete a page +:: %spot: associate a page :: %meet: track a peer -:: %heed: follow a peer -:: %spot: discover contact peer :: %drop: discard a peer :: %snub: unfollow a peer :: +$ action-1 $% [%anon ~] - [%edit p=ship q=(list (pair @t field-1))] - [%meet p=(list ship)] - [%heed p=(list ship)] + [%page p=(list (pair @tas value-1))] + :: + :: .p=~ edit the profile + [%edit p=(unit cid) q=(list (pair @tas value-1))] [%spot p=(list (pair ship cid))] + [%wipe p=(list cid)] + [%meet p=(list ship)] [%drop p=(list ship)] [%snub p=(list ship)] == :: network +:: +:: %full: deliver full profile :: +$ update-1 - $% [%full profile-1] - [%field (pair @tas (unit field-1))] + $% [%full $@(~ profile-1)] == :: local :: +:: user-modified fields take priority +:: +$ news-1 - $% [%full who=ship con=(unit contact-1)] - [%field who=ship fil=(pair @tas (unit field-1))] + $% [%full who=ship con=$@(~ contact-1)] == ++| %version +++ foreign foreign-0 +++ rolodex rolodex-0 +++ contact contact-0 +++ action action-0 +++ profile profile-0 +++ news news-0 +++ update update-0 +++ field field-0 -- diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon new file mode 100644 index 00000000..1e59578f --- /dev/null +++ b/desk/tests/app/contacts.hoon @@ -0,0 +1,6 @@ +/- *contacts +/+ *test +/= contacts-agent /app/contacts +=* agent contacts-agent +|% +-- From 97ea7f08a324f02a8bdc2f851e262b55556a5172 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Fri, 30 Aug 2024 16:07:45 +0800 Subject: [PATCH 03/44] contacts: minor improvement --- desk/app/contacts.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 3cd1cc44..00de0dd5 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -314,7 +314,7 @@ |= [old=@da new=@da] ^- @da ?: (lth old new) new - (add old ^~((div ~s1 (bex 16)))) + (add old ^~((rsh 3^2 ~s1))) :: +| %state :: From 5c5a936d553b544ec0050b738c4fb5ca96fe3c7c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Fri, 30 Aug 2024 16:10:01 +0800 Subject: [PATCH 04/44] contacts: improve surs --- desk/sur/contacts.hoon | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 6e766b5f..08452151 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -121,12 +121,14 @@ +$ book (map cid page) :: $rolodex-1: rolodex :: -:: .book: contact book, original and modified -:: .net: network contacts +:: .book: contact book +:: .peers: network contacts +:: .block: network blacklist :: +$ rolodex-1 $: =book - net=(map ship foreign-1) + peers=(map ship foreign-1) + block=(set ship) == :: +$ epic epic:e From 23096148682e765543d7639089feb36dd304e2cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Sat, 31 Aug 2024 12:48:46 +0800 Subject: [PATCH 05/44] contacts: move to state-1 --- desk/app/contacts.hoon | 734 +++++++++++++++++++--------------- desk/mar/contact/rolodex.hoon | 6 +- desk/sur/contacts.hoon | 27 +- 3 files changed, 423 insertions(+), 344 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 00de0dd5..3b8b95ca 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -21,7 +21,7 @@ %- agent:dbug %+ verb | ^- agent:gall -=| state-0 +=| state-1 =* state - :: =< |_ =bowl:gall @@ -109,7 +109,7 @@ :: =/ val=value-1 (~(got by c) key) ?~ val !! - ~| "set expected at {}" + ~| "set expected at {}" ?> ?=(%set -.val) p.val :: +gut: got with default @@ -161,8 +161,8 @@ :: ?> ?=(_-.def -.val) :: ?- typ - %text ?>(?=(_typ -.val) p.val) - %date ?>(?=(_typ -.val) p.val) + %text ?>(?=(%text -.val) p.val) + %date ?>(?=(%date -.val) p.val) %tint ?>(?=(%tint -.val) p.val) %ship ?>(?=(%ship -.val) p.val) %look ?>(?=(%look -.val) p.val) @@ -302,7 +302,7 @@ :: ?~ for.raf book.acc :: ?~ con.for.raf :: (~(put by book.acc) cid *page) -:: %+ ~(put by book.acc) +:: %+ ~(put by book.acc) :: cid :: ^- page :: [[wen.for.raf (to-contact-1 con.for.raf)] ~] @@ -310,6 +310,78 @@ :: (~(put by net.acc) ship far) :: == :: +++ to-edit-1 + |= edit-0=(list field-0) + ^- (list (pair @tas value-1)) + =; [edit-1=(list (pair @tas value-1)) groups=(set $>(%cult value-1))] + :_ edit-1 + [%groups set/groups] + :: + %+ roll edit-0 + |= $: fed=field-0 + acc=(list (pair @tas value-1)) + gan=(set $>(%cult value-1)) + == + :: + ^+ [acc gan] + :: XX improve this by taking out :_ gan + :: outside + ?- -.fed + :: + %nickname + :_ gan + :_ acc + [%nickname text/nickname.fed] + :: + %bio + :_ gan + :_ acc + [%bio text/bio.fed] + :: + %status + :_ gan + :_ acc + [%status text/status.fed] + :: + %color + :_ gan + :_ acc + [%color tint/color.fed] + :: + %avatar + ?~ avatar.fed [acc gan] + :_ gan + :_ acc + [%avatar look/u.avatar.fed] + :: + %cover + ?~ cover.fed [acc gan] + :_ gan + :_ acc + [%cover look/u.cover.fed] + :: + %add-group + :- acc + (~(put in gan) [%cult flag.fed]) + :: + %del-group + :- acc + (~(del in gan) [%cult flag.fed]) + == + +++ to-action-1 + :: o=$<(%meet action-0) + |= o=action-0 + ^- action-1 + ?- -.o + %anon [%anon ~] + %edit [%edit ~ (to-edit-1 p.o)] + %meet ~|(action-fail+%meet !!) + %heed ~|(action-fail+%heed !!) + %drop [%drop p.o] + %snub [%snub p.o] + == + ++ mono |= [old=@da new=@da] ^- @da @@ -348,49 +420,49 @@ :: /epic protocol versions are even more trivial, :: published ad-hoc, elsewhere. :: - ++ pub - => |% - :: if this proves to be too slow, the set of paths - :: should be maintained statefully: put on +p-init:pub, - :: filtered at some interval (on +load?) to avoid a space leak. - :: - ++ subs - ^- (set path) - %- ~(rep by sup.bowl) - |= [[duct ship pat=path] acc=(set path)] - ?.(?=([%contact *] pat) acc (~(put in acc) pat)) - :: - ++ fact - |= [pat=(set path) u=update] - ^- gift:agent:gall - [%fact ~(tap in pat) upd:mar !>(u)] - -- - :: - |% - ++ p-anon ?.(?=([@ ^] rof) cor (p-diff ~)) - :: - ++ p-edit - |= l=(list field) - =/ old ?.(?=([@ ^] rof) *contact con.rof) - =/ new (roll l |=([f=field c=_old] (do-edit c f))) - ?: =(old new) - cor - (p-diff:pub new) - :: - ++ p-diff - |= con=$@(~ contact) - =/ p=profile [?~(rof now.bowl (mono wen.rof now.bowl)) con] - (give:(p-news(rof p) our.bowl con) (fact subs full+p)) - :: - ++ p-init - |= wen=(unit @da) - ?~ rof cor - ?~ wen (give (fact ~ full+rof)) - ?: =(u.wen wen.rof) cor - ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: no future subs - :: - ++ p-news |=(n=news (give %fact [/news ~] %contact-news !>(n))) - -- + :: ++ pub + :: => |% + :: :: if this proves to be too slow, the set of paths + :: :: should be maintained statefully: put on +p-init:pub, + :: :: filtered at some interval (on +load?) to avoid a space leak. + :: :: + :: ++ subs + :: ^- (set path) + :: %- ~(rep by sup.bowl) + :: |= [[duct ship pat=path] acc=(set path)] + :: ?.(?=([%contact *] pat) acc (~(put in acc) pat)) + :: :: + :: ++ fact + :: |= [pat=(set path) u=update] + :: ^- gift:agent:gall + :: [%fact ~(tap in pat) upd:mar !>(u)] + :: -- + :: :: + :: |% + :: ++ p-anon ?.(?=([@ ^] rof) cor (p-diff ~)) + :: :: + :: ++ p-edit + :: |= l=(list field) + :: =/ old ?.(?=([@ ^] rof) *contact con.rof) + :: =/ new (roll l |=([f=field c=_old] (do-edit c f))) + :: ?: =(old new) + :: cor + :: (p-diff:pub new) + :: :: + :: ++ p-diff + :: |= con=$@(~ contact) + :: =/ p=profile [?~(rof now.bowl (mono wen.rof now.bowl)) con] + :: (give:(p-news(rof p) our.bowl con) (fact subs full+p)) + :: :: + :: ++ p-init + :: |= wen=(unit @da) + :: ?~ rof cor + :: ?~ wen (give (fact ~ full+rof)) + :: ?: =(u.wen wen.rof) cor + :: ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: no future subs + :: :: + :: ++ p-news |=(n=news (give %fact [/news ~] %contact-news !>(n))) + :: -- :: :: +sub: subscription mgmt :: @@ -410,205 +482,205 @@ :: for a given peer, we always have at most one subscription, :: to either /contact/* or /epic. :: - ++ sub - |^ |= who=ship - ^+ s-impl - ?< =(our.bowl who) - =/ old (~(get by rol) who) - ~(. s-impl who %live ?=(~ old) (fall old [~ ~])) - :: - ++ s-many - |= [l=(list ship) f=$-(_s-impl _s-impl)] - ^+ cor - %+ roll l - |= [who=@p acc=_cor] - ?: =(our.bowl who) acc - si-abet:(f (sub:acc who)) - :: - ++ s-impl - |_ [who=ship sas=?(%dead %live) new=? foreign] - :: - ++ si-cor . - :: - ++ si-abet - ^+ cor - ?- sas - %live =. rol (~(put by rol) who for sag) - :: NB: this assumes con.for is only set in +si-hear - :: - ?.(new cor (p-news:pub who ~)) - :: - %dead ?: new cor - =. rol (~(del by rol) who) - :: - :: this is not quite right, reflecting *total* deletion - :: as *contact* deletion. but it's close, and keeps /news simpler - :: - (p-news:pub who ~) - == - :: - ++ si-take - |= =sign:agent:gall - ^+ si-cor - ?- -.sign - %poke-ack ~|(strange-poke-ack+wire !!) - :: - %watch-ack ~| strange-watch-ack+wire - ?> ?=(%want sag) - ?~ p.sign si-cor(sag [%chi ~]) - %- (slog 'contact-fail' u.p.sign) - pe-peer:si-epic(sag %fail) - :: - %kick si-heed(sag ~) - :: - :: [compat] we *should* maintain backcompat here - :: - :: by either directly handling or upconverting - :: old actions. but if we don't, we'll fall back - :: to /epic and wait for our peer to upgrade. - :: - :: %fact's from the future are also /epic, - :: in case our peer downgrades. if not, we'll - :: handle it on +load. - :: - %fact ?+ p.cage.sign (si-odd p.cage.sign) - ?(upd:base:mar %contact-update-0) - (si-hear !<(update q.cage.sign)) - == == + :: ++ sub + :: |^ |= who=ship + :: ^+ s-impl + :: ?< =(our.bowl who) + :: =/ old (~(get by rol) who) + :: ~(. s-impl who %live ?=(~ old) (fall old [~ ~])) + :: :: + :: ++ s-many + :: |= [l=(list ship) f=$-(_s-impl _s-impl)] + :: ^+ cor + :: %+ roll l + :: |= [who=@p acc=_cor] + :: ?: =(our.bowl who) acc + :: si-abet:(f (sub:acc who)) + :: :: + :: ++ s-impl + :: |_ [who=ship sas=?(%dead %live) new=? foreign] + :: :: + :: ++ si-cor . + :: :: + :: ++ si-abet + :: ^+ cor + :: ?- sas + :: %live =. rol (~(put by rol) who for sag) + :: :: NB: this assumes con.for is only set in +si-hear + :: :: + :: ?.(new cor (p-news:pub who ~)) + :: :: + :: %dead ?: new cor + :: =. rol (~(del by rol) who) + :: :: + :: :: this is not quite right, reflecting *total* deletion + :: :: as *contact* deletion. but it's close, and keeps /news simpler + :: :: + :: (p-news:pub who ~) + :: == + :: :: + :: ++ si-take + :: |= =sign:agent:gall + :: ^+ si-cor + :: ?- -.sign + :: %poke-ack ~|(strange-poke-ack+wire !!) + :: :: + :: %watch-ack ~| strange-watch-ack+wire + :: ?> ?=(%want sag) + :: ?~ p.sign si-cor(sag [%chi ~]) + :: %- (slog 'contact-fail' u.p.sign) + :: pe-peer:si-epic(sag %fail) + :: :: + :: %kick si-heed(sag ~) + :: :: + :: :: [compat] we *should* maintain backcompat here + :: :: + :: :: by either directly handling or upconverting + :: :: old actions. but if we don't, we'll fall back + :: :: to /epic and wait for our peer to upgrade. + :: :: + :: :: %fact's from the future are also /epic, + :: :: in case our peer downgrades. if not, we'll + :: :: handle it on +load. + :: :: + :: %fact ?+ p.cage.sign (si-odd p.cage.sign) + :: ?(upd:base:mar %contact-update-0) + :: (si-hear !<(update q.cage.sign)) + :: == == - ++ si-hear - |= u=update - ^+ si-cor - ?: &(?=(^ for) (lte wen.u wen.for)) - si-cor - si-cor(for +.u, cor (p-news:pub who con.u)) - :: - ++ si-meet si-cor :: init key in +si-abet - :: - ++ si-heed - ^+ si-cor - ?. ?=(~ sag) - si-cor - =/ pat [%contact ?~(for / /at/(scot %da wen.for))] - %= si-cor - cor (pass /contact %agent [who dap.bowl] %watch pat) - sag %want - == - :: - ++ si-drop si-snub(sas %dead) - :: - ++ si-snub - %_ si-cor - sag ~ - cor ?+ sag cor - ?(%fail [?(%lev %dex) *]) - (pass /epic %agent [who dap.bowl] %leave ~) - :: - ?(%want [%chi *]) - (pass /contact %agent [who dap.bowl] %leave ~) - == == - :: - ++ si-odd - |= =mark - ^+ si-cor - =* upd *upd:base:mar - =* wid ^~((met 3 upd)) - ?. =(upd (end [3 wid] mark)) - ~&(fake-news+mark si-cor) :: XX unsub? - ?~ ver=(slaw %ud (rsh 3^+(wid) mark)) - ~&(weird-news+mark si-cor) :: XX unsub? - ?: =(okay u.ver) - ~|(odd-not-odd+mark !!) :: oops! - =. si-cor si-snub :: unsub before .sag update - =. sag ?:((lth u.ver okay) [%lev ~] [%dex u.ver]) - pe-peer:si-epic - :: - ++ si-epic - |% - ++ pe-take - |= =sign:agent:gall - ^+ si-cor - ?- -.sign - %poke-ack ~|(strange-poke-ack+wire !!) - :: - %watch-ack ?~ p.sign si-cor - %- (slog 'epic-fail' u.p.sign) - si-cor(sag %lost) - :: - %kick ?. ?=(?(%fail [?(%dex %lev) *]) sag) - si-cor :: XX strange - pe-peer - :: - %fact ?+ p.cage.sign - ~&(fact-not-epic+p.cage.sign si-cor) - %epic (pe-hear !<(epic q.cage.sign)) - == == - :: - ++ pe-hear - |= =epic - ^+ si-cor - ?. ?=(?(%fail [?(%dex %lev) *]) sag) - ~|(strange-epic+[okay epic] !!) :: get %kick'd - ?: =(okay epic) - ?: ?=(%fail sag) - si-cor(sag %lost) :: abandon hope - si-heed:si-snub - :: - :: handled generically to support peer downgrade - :: - si-cor(sag ?:((gth epic okay) [%dex epic] [%lev ~])) - :: - ++ pe-peer - si-cor(cor (pass /epic %agent [who dap.bowl] %watch /epic)) - -- - -- - -- + :: ++ si-hear + :: |= u=update + :: ^+ si-cor + :: ?: &(?=(^ for) (lte wen.u wen.for)) + :: si-cor + :: si-cor(for +.u, cor (p-news:pub who con.u)) + :: :: + :: ++ si-meet si-cor :: init key in +si-abet + :: :: + :: ++ si-heed + :: ^+ si-cor + :: ?. ?=(~ sag) + :: si-cor + :: =/ pat [%contact ?~(for / /at/(scot %da wen.for))] + :: %= si-cor + :: cor (pass /contact %agent [who dap.bowl] %watch pat) + :: sag %want + :: == + :: :: + :: ++ si-drop si-snub(sas %dead) + :: :: + :: ++ si-snub + :: %_ si-cor + :: sag ~ + :: cor ?+ sag cor + :: ?(%fail [?(%lev %dex) *]) + :: (pass /epic %agent [who dap.bowl] %leave ~) + :: :: + :: ?(%want [%chi *]) + :: (pass /contact %agent [who dap.bowl] %leave ~) + :: == == + :: :: + :: ++ si-odd + :: |= =mark + :: ^+ si-cor + :: =* upd *upd:base:mar + :: =* wid ^~((met 3 upd)) + :: ?. =(upd (end [3 wid] mark)) + :: ~&(fake-news+mark si-cor) :: XX unsub? + :: ?~ ver=(slaw %ud (rsh 3^+(wid) mark)) + :: ~&(weird-news+mark si-cor) :: XX unsub? + :: ?: =(okay u.ver) + :: ~|(odd-not-odd+mark !!) :: oops! + :: =. si-cor si-snub :: unsub before .sag update + :: =. sag ?:((lth u.ver okay) [%lev ~] [%dex u.ver]) + :: pe-peer:si-epic + :: :: + :: ++ si-epic + :: |% + :: ++ pe-take + :: |= =sign:agent:gall + :: ^+ si-cor + :: ?- -.sign + :: %poke-ack ~|(strange-poke-ack+wire !!) + :: :: + :: %watch-ack ?~ p.sign si-cor + :: %- (slog 'epic-fail' u.p.sign) + :: si-cor(sag %lost) + :: :: + :: %kick ?. ?=(?(%fail [?(%dex %lev) *]) sag) + :: si-cor :: XX strange + :: pe-peer + :: :: + :: %fact ?+ p.cage.sign + :: ~&(fact-not-epic+p.cage.sign si-cor) + :: %epic (pe-hear !<(epic q.cage.sign)) + :: == == + :: :: + :: ++ pe-hear + :: |= =epic + :: ^+ si-cor + :: ?. ?=(?(%fail [?(%dex %lev) *]) sag) + :: ~|(strange-epic+[okay epic] !!) :: get %kick'd + :: ?: =(okay epic) + :: ?: ?=(%fail sag) + :: si-cor(sag %lost) :: abandon hope + :: si-heed:si-snub + :: :: + :: :: handled generically to support peer downgrade + :: :: + :: si-cor(sag ?:((gth epic okay) [%dex epic] [%lev ~])) + :: :: + :: ++ pe-peer + :: si-cor(cor (pass /epic %agent [who dap.bowl] %watch /epic)) + :: -- + :: -- + :: -- :: +migrate: from :contact-store :: :: all known ships, non-default profiles, no subscriptions :: - ++ migrate - => |% - ++ legacy - |% - +$ rolodex (map ship contact) - +$ resource [=entity name=term] - +$ entity ship - +$ contact - $: nickname=@t - bio=@t - status=@t - color=@ux - avatar=(unit @t) - cover=(unit @t) - groups=(set resource) - last-updated=@da - == - -- - -- - :: - ^+ cor - =/ bas /(scot %p our.bowl)/contact-store/(scot %da now.bowl) - ?. .^(? gu+(weld bas /$)) cor - =/ ful .^(rolodex:legacy gx+(weld bas /all/noun)) - :: - |^ cor(rof us, rol them) - ++ us (biff (~(get by ful) our.bowl) convert) - :: - ++ them - ^- rolodex - %- ~(rep by (~(del by ful) our.bowl)) - |= [[who=ship con=contact:legacy] rol=rolodex] - (~(put by rol) who (convert con) ~) - :: - ++ convert - |= con=contact:legacy - ^- $@(~ profile) - ?: =(*contact:legacy con) ~ - [last-updated.con con(|6 groups.con)] - -- - :: - +| %implementation + :: ++ migrate + :: => |% + :: ++ legacy + :: |% + :: +$ rolodex (map ship contact) + :: +$ resource [=entity name=term] + :: +$ entity ship + :: +$ contact + :: $: nickname=@t + :: bio=@t + :: status=@t + :: color=@ux + :: avatar=(unit @t) + :: cover=(unit @t) + :: groups=(set resource) + :: last-updated=@da + :: == + :: -- + :: -- + :: :: + :: ^+ cor + :: =/ bas /(scot %p our.bowl)/contact-store/(scot %da now.bowl) + :: ?. .^(? gu+(weld bas /$)) cor + :: =/ ful .^(rolodex:legacy gx+(weld bas /all/noun)) + :: :: + :: |^ cor(rof us, rol them) + :: ++ us (biff (~(get by ful) our.bowl) convert) + :: :: + :: ++ them + :: ^- rolodex + :: %- ~(rep by (~(del by ful) our.bowl)) + :: |= [[who=ship con=contact:legacy] rol=rolodex] + :: (~(put by rol) who (convert con) ~) + :: :: + :: ++ convert + :: |= con=contact:legacy + :: ^- $@(~ profile) + :: ?: =(*contact:legacy con) ~ + :: [last-updated.con con(|6 groups.con)] + :: -- + :: + :: +| %implementation :: ++ init (emit %pass /migrate %agent [our dap]:bowl %poke noun+!>(%migrate)) @@ -617,120 +689,128 @@ |= old-vase=vase ^+ cor |^ =+ !<([old=versioned-state cool=epic] old-vase) - :: if there should be a sub (%chi saga), but there is none (in the - :: bowl), re-establish it. %kick handling used to be faulty. - :: we run this "repair" on every load, in the spirit of +inflate-io. - :: - =^ cards rol.old - %+ roll ~(tap by rol.old) - |= [[who=ship foreign] caz=(list card) rol=rolodex] - ?. ?& =([%chi ~] sag) - !(~(has by wex.bowl) [/contact who dap.bowl]) - == - [caz (~(put by rol) who for sag)] - :- :_ caz - =/ =path [%contact ?~(for / /at/(scot %da wen.for))] - [%pass /contact %agent [who dap.bowl] %watch path] - (~(put by rol) who for %want) - =. state old - =. cor (emil cards) - :: [compat] if our protocol version changed - :: - :: we first tell the world, then see if we can now understand - :: any of our friends who were sending messages from the future. - :: - ?:(=(okay cool) cor l-bump(cor l-epic)) + ?> ?=(%1 -.old) + cor(state old) + :: |^ =+ !<([old=versioned-state cool=epic] old-vase) + :: :: if there should be a sub (%chi saga), but there is none (in the + :: :: bowl), re-establish it. %kick handling used to be faulty. + :: :: we run this "repair" on every load, in the spirit of +inflate-io. + :: :: + :: =^ cards rol.old + :: %+ roll ~(tap by rol.old) + :: |= [[who=ship foreign] caz=(list card) rol=rolodex] + :: ?. ?& =([%chi ~] sag) + :: !(~(has by wex.bowl) [/contact who dap.bowl]) + :: == + :: [caz (~(put by rol) who for sag)] + :: :- :_ caz + :: =/ =path [%contact ?~(for / /at/(scot %da wen.for))] + :: [%pass /contact %agent [who dap.bowl] %watch path] + :: (~(put by rol) who for %want) + :: =. state old + :: =. cor (emil cards) + :: :: [compat] if our protocol version changed + :: :: + :: :: we first tell the world, then see if we can now understand + :: :: any of our friends who were sending messages from the future. + :: :: + :: ?:(=(okay cool) cor l-bump(cor l-epic)) :: +$ versioned-state $% state-0 + state-1 == :: - ++ l-epic (give %fact [/epic ~] epic+!>(okay)) - :: - ++ l-bump - ^+ cor - %- ~(rep by rol) - |= [[who=ship foreign] =_cor] - :: XX to fully support downgrade, we'd need to also - :: save an epic in %lev - :: - ?. ?& ?=([%dex *] sag) - =(okay ver.sag) - == - cor - si-abet:si-heed:si-snub:(sub:cor who) + :: ++ l-epic (give %fact [/epic ~] epic+!>(okay)) + :: :: + :: ++ l-bump + :: ^+ cor + :: %- ~(rep by rol) + :: |= [[who=ship foreign] =_cor] + :: :: XX to fully support downgrade, we'd need to also + :: :: save an epic in %lev + :: :: + :: ?. ?& ?=([%dex *] sag) + :: =(okay ver.sag) + :: == + :: cor + :: si-abet:si-heed:si-snub:(sub:cor who) -- :: ++ poke |= [=mark =vase] ^+ cor - :: [compat] we *should* maintain backcompat here - :: - :: by either directly handling or upconverting old actions - :: ?+ mark ~|(bad-mark+mark !!) %noun ?+ q.vase !! - %migrate migrate + %migrate ~|(%migrate-not-implemented !!) == :: ?(act:base:mar %contact-action-0) ?> =(our src):bowl - =/ act !<(action vase) - ?- -.act - %anon p-anon:pub - %edit (p-edit:pub p.act) - %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) - %heed (s-many:sub p.act |=(s=_s-impl:sub si-heed:s)) - %drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s)) - %snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s)) - == + =/ act + ?- mark + act:base:mar !<(action vase) + %contact-action-0 (to-action-1 !<(action-0 vase)) + == + ~|(%poke-not-implemented !!) + :: ?- -.act + :: %anon p-anon:pub + :: %edit (p-edit:pub p.act) + :: %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) + :: %heed (s-many:sub p.act |=(s=_s-impl:sub si-heed:s)) + :: %drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s)) + :: %snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s)) + :: == == :: ++ peek |= pat=(pole knot) ^- (unit (unit cage)) - ?+ pat [~ ~] - [%x %all ~] - =/ lor=rolodex - ?: |(?=(~ rof) ?=(~ con.rof)) rol - (~(put by rol) our.bowl rof ~) - ``contact-rolodex+!>(lor) - :: - [%x %contact her=@ ~] - ?~ who=`(unit @p)`(slaw %p her.pat) - [~ ~] - =/ tac=?(~ contact) - ?: =(our.bowl u.who) ?~(rof ~ con.rof) - =+ (~(get by rol) u.who) - ?: |(?=(~ -) ?=(~ for.u.-)) ~ - con.for.u.- - ?~ tac [~ ~] - ``contact+!>(`contact`tac) - == + ~|(bad-peek+pat !!) + :: ?+ pat [~ ~] + :: [%x %all ~] + :: =/ lor=rolodex + :: ?: |(?=(~ rof) ?=(~ con.rof)) rol + :: (~(put by rol) our.bowl rof ~) + :: ``contact-rolodex+!>(lor) + :: :: + :: [%x %contact her=@ ~] + :: ?~ who=`(unit @p)`(slaw %p her.pat) + :: [~ ~] + :: =/ tac=?(~ contact) + :: ?: =(our.bowl u.who) ?~(rof ~ con.rof) + :: =+ (~(get by rol) u.who) + :: ?: |(?=(~ -) ?=(~ for.u.-)) ~ + :: con.for.u.- + :: ?~ tac [~ ~] + :: ``contact+!>(`contact`tac) + :: == :: ++ peer |= pat=(pole knot) ^+ cor - ?+ pat ~|(bad-watch-path+pat !!) - [%contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) - [%contact ~] (p-init:pub ~) - [%epic ~] (give %fact ~ epic+!>(okay)) - [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) - == + ~|(bad-watch-path+pat !!) + :: ?+ pat ~|(bad-watch-path+pat !!) + :: [%contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) + :: [%contact ~] (p-init:pub ~) + :: [%epic ~] (give %fact ~ epic+!>(okay)) + :: [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) + :: == :: ++ agent |= [=wire =sign:agent:gall] ^+ cor - ?+ wire ~|(evil-agent+wire !!) - [%contact ~] si-abet:(si-take:(sub src.bowl) sign) - [%epic ~] si-abet:(pe-take:si-epic:(sub src.bowl) sign) - :: - [%migrate ~] - ?> ?=(%poke-ack -.sign) - ?~ p.sign cor - %- (slog leaf/"{} failed" u.p.sign) - cor - == + ~|(evil-agent+wire !!) + :: ?+ wire ~|(evil-agent+wire !!) + :: [%contact ~] si-abet:(si-take:(sub src.bowl) sign) + :: [%epic ~] si-abet:(pe-take:si-epic:(sub src.bowl) sign) + :: :: + :: [%migrate ~] + :: ?> ?=(%poke-ack -.sign) + :: ?~ p.sign cor + :: %- (slog leaf/"{} failed" u.p.sign) + :: cor + :: == -- -- diff --git a/desk/mar/contact/rolodex.hoon b/desk/mar/contact/rolodex.hoon index ad4049c2..e3aab8d8 100644 --- a/desk/mar/contact/rolodex.hoon +++ b/desk/mar/contact/rolodex.hoon @@ -1,14 +1,14 @@ /- c=contacts /+ j=contacts-json -|_ rol=rolodex:c +|_ rol=rolodex-0:c ++ grad %noun ++ grow |% ++ noun rol - ++ json (rolodex:enjs:j rol) + ++ json (rolodex-0:enjs:j rol) -- ++ grab |% - ++ noun rolodex:c + ++ noun rolodex-0:c -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 08452151..94c851e7 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -144,7 +144,7 @@ $% [%nickname nickname=@t] [%bio bio=@t] [%status status=@t] - [%color color=@uxF] + [%color color=@ux] [%avatar avatar=(unit @t)] [%cover cover=(unit @t)] [%add-group =flag:g] @@ -179,20 +179,18 @@ :: %page: create a new contact page :: %edit: edit the profile or a contact page :: %wipe: delete a page -:: %spot: associate a page :: %meet: track a peer +:: %spot: associate peer with a page :: %drop: discard a peer :: %snub: unfollow a peer :: +$ action-1 $% [%anon ~] - [%page p=(list (pair @tas value-1))] - :: - :: .p=~ edit the profile + [%page p=cid q=(list (pair @tas value-1))] [%edit p=(unit cid) q=(list (pair @tas value-1))] - [%spot p=(list (pair ship cid))] [%wipe p=(list cid)] [%meet p=(list ship)] + [%spot p=(list (pair ship (unit cid)))] [%drop p=(list ship)] [%snub p=(list ship)] == @@ -211,12 +209,13 @@ $% [%full who=ship con=$@(~ contact-1)] == +| %version -++ foreign foreign-0 -++ rolodex rolodex-0 -++ contact contact-0 -++ action action-0 -++ profile profile-0 -++ news news-0 -++ update update-0 -++ field field-0 +:: ++ foreign foreign-0 +:: ++ rolodex rolodex-0 +:: ++ contact contact-0 +:: ++ action action- +++ action action-1 +:: ++ profile profile-0 +:: ++ news news-0 +:: ++ update update-0 +:: ++ field field-0 -- From 41855fee0f910cd6b0b6a2c052050c43f4c85e94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 3 Sep 2024 12:44:38 +0800 Subject: [PATCH 06/44] contacts: implement new +pub core --- desk/app/contacts.hoon | 355 +++++++++++++++++++++++++++------ desk/mar/contact/action-0.hoon | 4 +- desk/sur/contacts.hoon | 40 ++-- 3 files changed, 316 insertions(+), 83 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 3b8b95ca..0843d63a 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -9,13 +9,14 @@ :: .con: a contact :: .rof: our profile :: .rol: our full rolodex +:: .per: foreign peer :: .for: foreign profile :: .sag: foreign subscription state :: +| %types +$ card card:agent:gall +$ state-0 [%0 rof=$@(~ profile-0) rol=rolodex-0] -+$ state-1 [%1 rof=$@(~ profile-1) rol=rolodex-1] ++$ state-1 [%1 rof=$@(~ profile-1) rolodex-1] -- :: %- agent:dbug @@ -242,7 +243,8 @@ :: ++ to-contact-0 |= c=contact-1 - ^- contact-0 + ^- $@(~ contact-0) + ?~ c ~ =| o=contact-0 %= o nickname @@ -272,17 +274,30 @@ |= o=profile-0 ^- profile-1 [wen.o ?~(con.o ~ (to-contact-1 con.o))] -:: +gen-cid: generate new contact id +:: +to-profile-0: convert profile-1 :: -++ gen-cid - |= [eny=@uvJ =book] - ^- cid - =/ nid=cid - (end [0 4] eny) - |- - ?. |(=(0x0 nid) (~(has by book) nid)) - nid - $(nid +(nid)) +++ to-profile-0 + |= p=profile-1 + ^- profile-0 + [wen.p (to-contact-0 con.p)] +:: +overlay: fuse peer contact with overlay +++ contact-overlay + |= [per=foreign-1 don=contact-1] + ^- contact-1 + ?~ for.per + don + (~(uni by con.for.per) don) +:: :: +gen-cid: generate new contact id +:: :: +:: ++ gen-cid +:: |= [eny=@uvJ =^book] +:: ^- cid +:: =/ nid=cid +:: (end [0 4] eny) +:: |- +:: ?. |(=(0x0 nid) (~(has by book) nid)) +:: nid +:: $(nid +(nid)) :: +to-rolodex-1: convert rolodex-0 :: :: ++ to-rolodex-1 @@ -376,12 +391,82 @@ ?- -.o %anon [%anon ~] %edit [%edit ~ (to-edit-1 p.o)] - %meet ~|(action-fail+%meet !!) - %heed ~|(action-fail+%heed !!) + :: + :: old %meet is now a no-op + %meet [%meet ~] + %heed [%meet p.o] %drop [%drop p.o] %snub [%snub p.o] == - + :: ?- -.n + :: :: + :: %self + :: ?~ con.n + :: [our.bowl ~] + :: =/ =contact-0 + :: (to-contact-0 con.n) + :: [our.bowl contact-0] + :: :: + :: %page + :: ?< ?=(~ who.n) + :: =/ =contact-0 + :: (~(uni by con.n) mod.n) + :: [u.who.n (to-contact-0 contact-0)] + :: :: + :: :: when we unspot a peer, we publish + :: :: his original contact, if there is one, + :: :: or announce deletion of his contact, if the + :: :: profile is missing or contact is empty. + :: :: + :: :: if we spot a peer, we publish + :: :: his effective profile. + :: :: + :: %spot + :: =/ =page + :: ~| "contact id {} not found" + :: (~(got by book) cid) + :: =* who u.p.page + :: ?< ?=(~ who) + :: =/ =foreign-1 + :: (~(got by peers) who) + :: :: unspot a peer + :: :: + :: ?: ?=(~ who.n) + :: ?~ for.foreign-1 + :: [%full who ~] + :: ?~ con.for.foreign-1 + :: [%full who ~] + :: [%full who (to-contact-0 con.for.foreign-1)] + :: :: spot a peer + :: :: + :: :: no profile, publish user overlay + :: :: + :: ?: ?| ?=(~ for.foreign-1) + :: ?=(~ con.for.foreign-1) + :: == + :: [%full who ?~(q.page ~ (to-contact-0 con.q.page))] + :: :: XX to-contact-0 should return $@(~ contact-0) + :: :: + :: =/ =contact-0 + :: %- to-contact-0 + :: (~(uni by con.for) q.page) + :: [%full who contact-0] + :: :: + :: :: when a contact associated with a peer is deleted + :: :: we publish his original profile, if it exists, or + :: :: announce its deletion. + :: :: + :: %wipe + :: =/ =page + :: ~| "contact id {} not found" + :: (~(got by book) cid) + :: ?< ?=(~ p.page) + :: =* who u.p.page + :: =/ =foreign-1 + :: :: XX In the meantime, the peer could be dropped + :: :: or deleted + :: (~(got by peers) who) +:: ++ mono |= [old=@da new=@da] ^- @da @@ -420,49 +505,187 @@ :: /epic protocol versions are even more trivial, :: published ad-hoc, elsewhere. :: - :: ++ pub - :: => |% - :: :: if this proves to be too slow, the set of paths - :: :: should be maintained statefully: put on +p-init:pub, - :: :: filtered at some interval (on +load?) to avoid a space leak. - :: :: - :: ++ subs - :: ^- (set path) - :: %- ~(rep by sup.bowl) - :: |= [[duct ship pat=path] acc=(set path)] - :: ?.(?=([%contact *] pat) acc (~(put in acc) pat)) - :: :: - :: ++ fact - :: |= [pat=(set path) u=update] - :: ^- gift:agent:gall - :: [%fact ~(tap in pat) upd:mar !>(u)] - :: -- - :: :: - :: |% - :: ++ p-anon ?.(?=([@ ^] rof) cor (p-diff ~)) - :: :: - :: ++ p-edit - :: |= l=(list field) - :: =/ old ?.(?=([@ ^] rof) *contact con.rof) - :: =/ new (roll l |=([f=field c=_old] (do-edit c f))) - :: ?: =(old new) - :: cor - :: (p-diff:pub new) - :: :: - :: ++ p-diff - :: |= con=$@(~ contact) - :: =/ p=profile [?~(rof now.bowl (mono wen.rof now.bowl)) con] - :: (give:(p-news(rof p) our.bowl con) (fact subs full+p)) - :: :: - :: ++ p-init - :: |= wen=(unit @da) - :: ?~ rof cor - :: ?~ wen (give (fact ~ full+rof)) - :: ?: =(u.wen wen.rof) cor - :: ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: no future subs - :: :: - :: ++ p-news |=(n=news (give %fact [/news ~] %contact-news !>(n))) - :: -- + ++ pub + => |% + :: if this proves to be too slow, the set of paths + :: should be maintained statefully: put on +p-init:pub, + :: filtered at some interval (on +load?) to avoid a space leak. + :: + :: XX number of peers is usually around 5.000. + :: this means that the number of subscribers is about the + :: same. Thus on each contact update we need to filter + :: over 5.000 elements. + :: + ++ subs-0 + ^- (set path) + %- ~(rep by sup.bowl) + |= [[duct ship pat=path] acc=(set path)] + ?.(?=([%contact *] pat) acc (~(put in acc) pat)) + ++ subs + ^- (set path) + %- ~(rep by sup.bowl) + |= [[duct ship pat=path] acc=(set path)] + ?.(?=([%v1 %contact *] pat) acc (~(put in acc) pat)) + :: + ++ fact-0 + |= [pat=(set path) u=update-0] + ^- gift:agent:gall + [%fact ~(tap in pat) %contact-update-0 !>(u)] + :: + ++ fact + |= [pat=(set path) u=update-1] + ^- gift:agent:gall + [%fact ~(tap in pat) upd:mar !>(u)] + -- + :: + |% + :: + ++ p-anon ?.(?=([@ ^] rof) cor (p-diff-profile ~)) + :: + ++ p-edit-profile + |= l=(list (pair @tas value-1)) + =/ old=contact-1 + ?.(?=([@ ^] rof) *contact-1 con.rof) + =/ new=contact-1 + (do-edit-1 old l) + ?: =(old new) + cor + (p-diff-profile new) + :: + ++ p-edit-contact + |= [=cid l=(list (pair @tas value-1))] + =/ =page + ~| "contact id {} not found" + (~(got by book) cid) + =/ old=contact-1 q.page + =/ new=contact-1 + (do-edit-1 old l) + ?: =(old new) + cor + (p-diff-contact cid p.page new) + :: + ++ p-wipe-contact + |= =cid + =/ =page + ~| "contact id {} not found" + (~(got by book) cid) + (p-diff-contact-wipe cid page) + :: XX can we spot someone who is not a peer? + :: Should we then meet them automatically? + :: + ++ p-spot-peer + |= [=cid who=(unit ship)] + =/ page=(unit page) + (~(get by book) cid) + ?~ page + ~| "contact id {} not found" !! + ?: =(p.u.page who) + cor + (p-diff-spot cid who u.page) + :: + ++ p-diff-profile + |= con=contact-1 + =/ p=profile-1 [?~(rof now.bowl (mono wen.rof now.bowl)) con] + =. rof p + :: + =. cor + (give (fact-0 subs-0 [%full (to-profile-0 p)])) + =. cor + (give (fact subs [%full p])) + =. cor + (p-news-0 our.bowl (to-contact-0 con)) + (p-news [%self con]) + :: +p-diff-contact: publish contact modification + :: + :: XX is there a way to guard against someone + :: using this arm to modify who out of band? + :: + :: .cid: contact id + :: .who: peer -- inherited from page + :: .con: contact + :: + ++ p-diff-contact + |= [=cid who=(unit ship) con=contact-1] + :: .who.page: guaranteed unchanged + :: + =/ =page [who con] + =. book + (~(put by book) cid page) + :: there is a spot peer + :: + =? cor ?=(^ who) + =/ peer=foreign-1 + :: XX spot unknown peer? + :: + (~(got by peers) u.who) + %+ p-news-0 u.who + (to-contact-0 (contact-overlay peer con)) + (p-news [%page cid con]) + :: + ++ p-diff-contact-wipe + |= [=cid =page] + =* who p.page + =. book + (~(del by book) cid) + :: unspot a peer + :: + =? cor ?=(^ who) + =/ peer=foreign-1 + (~(got by peers) u.who) + =. peers + (~(put by peers) u.who peer(cid ~)) + %+ p-news-0 u.who + (to-contact-0 ?~(for.peer ~ con.for.peer)) + (p-news [%wipe cid]) + :: +p-diff-spot: publish peer spot + :: + :: .cid: contact id + :: .who: new peer + :: .con: contact -- inherited from page + :: + :: XX spot unknown peer? + :: + ++ p-diff-spot + |= [=cid who=(unit ship) =page] + =. book + (~(put by book) cid [who q.page]) + :: .who peer spot + :: + =? cor ?=(^ who) + =/ peer=foreign-1 + (~(got by peers) u.who) + =. peers (~(put by peers) u.who peer(cid `cid)) + :: XX version .con, .for, etc. + :: + %+ p-news-0 u.who + (to-contact-0 (contact-overlay peer q.page)) + :: .p.page peer is unspot + :: + =? cor ?=(^ p.page) + =/ peer=foreign-1 + (~(got by peers) u.p.page) + =. peers (~(put by peers) u.p.page peer(cid ~)) + :: XX version .con, .for, etc. + :: + %+ p-news-0 u.p.page + (to-contact-0 ?~(for.peer ~ con.for.peer)) + (p-news [%spot cid who]) + :: + ++ p-init + |= wen=(unit @da) + ?~ rof cor + ?~ wen (give (fact ~ full+rof)) + ?: =(u.wen wen.rof) cor + ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: no future subs + :: + ++ p-news-0 + |= n=news-0 + (give %fact ~[/news] %contact-news !>(n)) + :: + ++ p-news + |= n=news-1 + (give %fact ~[/v1/news] %contact-news-1 !>(n)) + -- :: :: +sub: subscription mgmt :: @@ -740,19 +963,25 @@ ++ poke |= [=mark =vase] ^+ cor - ?+ mark ~|(bad-mark+mark !!) + ~& poke+mark + ?+ mark ~&(%bad-mark ~|(bad-mark+mark !!)) %noun ?+ q.vase !! %migrate ~|(%migrate-not-implemented !!) == - :: - ?(act:base:mar %contact-action-0) + $? %contact-action-1 + %contact-action-0 + act:base:mar + == ?> =(our src):bowl =/ act ?- mark - act:base:mar !<(action vase) - %contact-action-0 (to-action-1 !<(action-0 vase)) + %contact-action-1 + !<(action vase) + ?(act:base:mar %contact-action-0) + (to-action-1 !<(action-0 vase)) == + ~& act ~|(%poke-not-implemented !!) :: ?- -.act :: %anon p-anon:pub diff --git a/desk/mar/contact/action-0.hoon b/desk/mar/contact/action-0.hoon index 5f51d665..bdff052a 100644 --- a/desk/mar/contact/action-0.hoon +++ b/desk/mar/contact/action-0.hoon @@ -1,6 +1,6 @@ /- c=contacts -/+ j=contacts-json -|_ =action:c +/+ j=contacts-json-0 +|_ action=action-0:c ++ grad %noun ++ grow |% diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 94c851e7..0596061a 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -53,7 +53,7 @@ %cult %set == -++ unis +++ unis |= set=(set value-1) ^- ? ?~ set & @@ -72,7 +72,7 @@ & :: $value-1: contact field value :: -+$ value-1 ++$ value-1 $+ contact-value-1 $@ ~ $% [%text p=@t] @@ -104,7 +104,7 @@ :: $cid: contact page id :: :: generated from entropy and guaranteed non-zero -:: +:: :: +$ cid @uvF :: $profile-1: contact profile @@ -115,20 +115,18 @@ +$ profile-1 [wen=@da con=contact-1] :: $page: contact book page :: -+$ page (pair (unit ship) $@(~ profile-1)) ++$ page (pair (unit ship) contact-1) :: $book: contact book -:: +:: +$ book (map cid page) :: $rolodex-1: rolodex :: :: .book: contact book :: .peers: network contacts -:: .block: network blacklist :: +$ rolodex-1 $: =book peers=(map ship foreign-1) - block=(set ship) == :: +$ epic epic:e @@ -176,37 +174,43 @@ +$ news-0 [who=ship con=$@(~ contact-0)] :: %anon: delete the profile -:: %page: create a new contact page :: %edit: edit the profile or a contact page -:: %wipe: delete a page +:: %wipe: delete a contact page +:: %spot: associate page with a peer :: %meet: track a peer -:: %spot: associate peer with a page :: %drop: discard a peer :: %snub: unfollow a peer :: +$ action-1 $% [%anon ~] - [%page p=cid q=(list (pair @tas value-1))] [%edit p=(unit cid) q=(list (pair @tas value-1))] + [%spot p=(list (pair cid (unit ship)))] [%wipe p=(list cid)] [%meet p=(list ship)] - [%spot p=(list (pair ship (unit cid)))] [%drop p=(list ship)] [%snub p=(list ship)] == :: network -:: -:: %full: deliver full profile +:: +:: %full: our profile :: +$ update-1 - $% [%full $@(~ profile-1)] + $% [%full profile-1] == -:: local +:: $news-1: local update :: -:: user-modified fields take priority +:: %self: our profile +:: %page: contact page update +:: %spot: peer with contact page +:: %wipe: contact deleted +:: %peer: peer update or deletion :: +$ news-1 - $% [%full who=ship con=$@(~ contact-1)] + $% [%self con=contact-1] + [%page =cid con=contact-1] + [%wipe =cid] + [%spot =cid who=(unit ship)] + [%peer who=ship con=contact-1] == +| %version :: ++ foreign foreign-0 From 24f5deb887ed764a22905c2d0bf0038a112c62b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Thu, 5 Sep 2024 21:07:28 +0800 Subject: [PATCH 07/44] contacts: implement v1 scries --- desk/app/contacts.hoon | 326 ++++++++++++++++++++++++----------- desk/mar/contact.hoon | 16 +- desk/mar/contact/news.hoon | 6 +- desk/sur/contacts.hoon | 8 +- desk/tests/app/contacts.hoon | 300 +++++++++++++++++++++++++++++++- 5 files changed, 538 insertions(+), 118 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 0843d63a..6b9064fc 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -9,7 +9,7 @@ :: .con: a contact :: .rof: our profile :: .rol: our full rolodex -:: .per: foreign peer +:: .far: foreign peer :: .for: foreign profile :: .sag: foreign subscription state :: @@ -20,7 +20,7 @@ -- :: %- agent:dbug -%+ verb | +:: %+ verb | ^- agent:gall =| state-1 =* state - @@ -198,9 +198,9 @@ %del-group c(groups (~(del in groups.c) flag.f)) == ++ do-edit-1 - |= [con=contact-1 edit=(list (pair @tas value-1))] + |= [con=contact-1 edit=(map @tas value-1)] ^+ con - =/ don (~(gas by con) edit) + =/ don (~(uni by con) edit) :: XX are these checks neccessary? :: if so, we need to introduce link field. :: @@ -221,6 +221,7 @@ ++ to-contact-1 |= c=contact-0 ^- contact-1 + ~& contact-0-to-1+c =/ o=contact-1 %- malt ^- (list (pair @tas value-1)) @@ -233,7 +234,8 @@ (~(put by o) %avatar text/u.avatar.c) =? o ?=(^ cover.c) (~(put by o) %cover text/u.cover.c) - =. o %+ ~(put by o) %groups + =? o !?=(~ groups.c) + %+ ~(put by o) %groups :- %set %- ~(run in groups.c) |= =flag:g @@ -262,12 +264,20 @@ :: XX prohibit data: link (~(get cy c) %cover %text) groups + =/ groups + (~(get cy c) %groups %set) + ?~ groups ~ ^- (set flag:g) - %- ~(run in (~(gos cy c) %groups %cult)) + %- ~(run in u.groups) |= val=value-1 ?> ?=(%cult -.val) p.val == +:: +to-contact-0-mod: convert to contact-0 with overlay +:: +++ to-contact-0-mod + |= [c=contact-1 mod=contact-1] + (to-contact-0 (~(uni by c) mod)) :: +to-profile-1: convert profile-0 :: ++ to-profile-1 @@ -280,8 +290,27 @@ |= p=profile-1 ^- profile-0 [wen.p (to-contact-0 con.p)] -:: +overlay: fuse peer contact with overlay -++ contact-overlay +:: +++ to-profile-0-mod + |= [p=profile-1 mod=contact-1] + ^- profile-0 + [wen.p (to-contact-0-mod con.p mod)] +:: +++ to-foreign-0 + |= f=foreign-1 + ^- foreign-0 + [?~(for.f ~ (to-profile-0 for.f)) sag.f] +:: +to-foreign-0-mod: convert foreign-1 with contact overlay +:: +++ to-foreign-0-mod + |= [f=foreign-1 mod=contact-1] + ^- foreign-0 + [?~(for.f ~ (to-profile-0-mod for.f mod)) sag.f] +:: +contact-mod: fuse peer contact with overlay +:: +:: XX name is confusing rename +:: +++ contact-mod |= [per=foreign-1 don=contact-1] ^- contact-1 ?~ for.per @@ -327,14 +356,15 @@ :: ++ to-edit-1 |= edit-0=(list field-0) - ^- (list (pair @tas value-1)) - =; [edit-1=(list (pair @tas value-1)) groups=(set $>(%cult value-1))] - :_ edit-1 - [%groups set/groups] + ^- (map @tas value-1) + =; [edit-1=(map @tas value-1) groups=(set $>(%cult value-1))] + ?~ groups + edit-1 + (~(put by edit-1) %groups set/groups) :: %+ roll edit-0 |= $: fed=field-0 - acc=(list (pair @tas value-1)) + acc=(map @tas value-1) gan=(set $>(%cult value-1)) == :: @@ -345,35 +375,41 @@ :: %nickname :_ gan - :_ acc - [%nickname text/nickname.fed] + %+ ~(put by acc) + %nickname + text/nickname.fed :: %bio :_ gan - :_ acc - [%bio text/bio.fed] + %+ ~(put by acc) + %bio + text/bio.fed :: %status :_ gan - :_ acc - [%status text/status.fed] + %+ ~(put by acc) + %status + text/status.fed :: %color :_ gan - :_ acc - [%color tint/color.fed] + %+ ~(put by acc) + %color + tint/color.fed :: %avatar ?~ avatar.fed [acc gan] :_ gan - :_ acc - [%avatar look/u.avatar.fed] + %+ ~(put by acc) + %avatar + look/u.avatar.fed :: %cover ?~ cover.fed [acc gan] :_ gan - :_ acc - [%cover look/u.cover.fed] + %+ ~(put by acc) + %cover + look/u.cover.fed :: %add-group :- acc @@ -390,7 +426,7 @@ ^- action-1 ?- -.o %anon [%anon ~] - %edit [%edit ~ (to-edit-1 p.o)] + %edit [%self (to-edit-1 p.o)] :: :: old %meet is now a no-op %meet [%meet ~] @@ -514,7 +550,11 @@ :: XX number of peers is usually around 5.000. :: this means that the number of subscribers is about the :: same. Thus on each contact update we need to filter - :: over 5.000 elements. + :: over 5.000 elements: do some benchmarking. + :: + :: XX when there are no subscribers on a path, we still + :: send facts on an empty path. This is no problem, unless + :: it is used in ++peer :: ++ subs-0 ^- (set path) @@ -530,7 +570,7 @@ ++ fact-0 |= [pat=(set path) u=update-0] ^- gift:agent:gall - [%fact ~(tap in pat) %contact-update-0 !>(u)] + [%fact ~(tap in pat) %contact-update !>(u)] :: ++ fact |= [pat=(set path) u=update-1] @@ -540,40 +580,42 @@ :: |% :: - ++ p-anon ?.(?=([@ ^] rof) cor (p-diff-profile ~)) + ++ p-anon ?.(?=([@ ^] rof) cor (p-diff-self ~)) :: - ++ p-edit-profile - |= l=(list (pair @tas value-1)) + ++ p-self + |= e=(map @tas value-1) =/ old=contact-1 ?.(?=([@ ^] rof) *contact-1 con.rof) =/ new=contact-1 - (do-edit-1 old l) + (do-edit-1 old e) ?: =(old new) cor - (p-diff-profile new) + (p-diff-self new) :: - ++ p-edit-contact - |= [=cid l=(list (pair @tas value-1))] + ++ p-edit + |= [=cid e=(map @tas value-1)] =/ =page - ~| "contact id {} not found" - (~(got by book) cid) + =+ (~(get by book) cid) + ?~(- *page u.-) =/ old=contact-1 q.page =/ new=contact-1 - (do-edit-1 old l) + (do-edit-1 old e) ?: =(old new) cor - (p-diff-contact cid p.page new) + (p-diff-edit cid p.page new) :: - ++ p-wipe-contact - |= =cid + ++ p-wipe + |= del=(list cid) + %+ reel del + |= [=cid acc=_cor] =/ =page ~| "contact id {} not found" (~(got by book) cid) - (p-diff-contact-wipe cid page) + (p-diff-wipe cid page) :: XX can we spot someone who is not a peer? :: Should we then meet them automatically? :: - ++ p-spot-peer + ++ p-spot |= [=cid who=(unit ship)] =/ page=(unit page) (~(get by book) cid) @@ -581,9 +623,9 @@ ~| "contact id {} not found" !! ?: =(p.u.page who) cor - (p-diff-spot cid who u.page) + (p-diff-spot cid u.page who) :: - ++ p-diff-profile + ++ p-diff-self |= con=contact-1 =/ p=profile-1 [?~(rof now.bowl (mono wen.rof now.bowl)) con] =. rof p @@ -595,7 +637,7 @@ =. cor (p-news-0 our.bowl (to-contact-0 con)) (p-news [%self con]) - :: +p-diff-contact: publish contact modification + :: +p-diff-edit: publish contact page update :: :: XX is there a way to guard against someone :: using this arm to modify who out of band? @@ -604,7 +646,7 @@ :: .who: peer -- inherited from page :: .con: contact :: - ++ p-diff-contact + ++ p-diff-edit |= [=cid who=(unit ship) con=contact-1] :: .who.page: guaranteed unchanged :: @@ -615,14 +657,13 @@ :: =? cor ?=(^ who) =/ peer=foreign-1 - :: XX spot unknown peer? - :: + ~| unknown-peer+u.who (~(got by peers) u.who) %+ p-news-0 u.who - (to-contact-0 (contact-overlay peer con)) + (to-contact-0 (contact-mod peer con)) (p-news [%page cid con]) :: - ++ p-diff-contact-wipe + ++ p-diff-wipe |= [=cid =page] =* who p.page =. book @@ -631,9 +672,12 @@ :: =? cor ?=(^ who) =/ peer=foreign-1 + ~| unknown-peer+u.who (~(got by peers) u.who) =. peers (~(put by peers) u.who peer(cid ~)) + :: + :: v0 peer contact is modified %+ p-news-0 u.who (to-contact-0 ?~(for.peer ~ con.for.peer)) (p-news [%wipe cid]) @@ -641,42 +685,53 @@ :: :: .cid: contact id :: .who: new peer - :: .con: contact -- inherited from page - :: - :: XX spot unknown peer? + :: .page: associated page :: ++ p-diff-spot - |= [=cid who=(unit ship) =page] + |= [=cid =page who=(unit ship)] =. book (~(put by book) cid [who q.page]) - :: .who peer spot + :: spot a peer :: =? cor ?=(^ who) =/ peer=foreign-1 + ~| unknown-peer+u.who (~(got by peers) u.who) =. peers (~(put by peers) u.who peer(cid `cid)) :: XX version .con, .for, etc. :: %+ p-news-0 u.who - (to-contact-0 (contact-overlay peer q.page)) - :: .p.page peer is unspot + (to-contact-0 (contact-mod peer q.page)) + :: unspot a peer :: =? cor ?=(^ p.page) =/ peer=foreign-1 + ~| unknown-peer+u.p.page (~(got by peers) u.p.page) =. peers (~(put by peers) u.p.page peer(cid ~)) - :: XX version .con, .for, etc. + :: XX version .con, .for, etc. for clarity :: %+ p-news-0 u.p.page (to-contact-0 ?~(for.peer ~ con.for.peer)) (p-news [%spot cid who]) :: + ++ p-init-0 + |= wen=(unit @da) + ?~ rof cor + ?~ wen (give (fact ~ full+rof)) + ?: =(u.wen wen.rof) cor + :: + :: no future subs + ?>((lth u.wen wen.rof) (give (fact-0 ~ full+(to-profile-0 rof)))) + :: ++ p-init |= wen=(unit @da) ?~ rof cor ?~ wen (give (fact ~ full+rof)) ?: =(u.wen wen.rof) cor - ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: no future subs + :: + :: no future subs + ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: ++ p-news-0 |= n=news-0 @@ -963,8 +1018,7 @@ ++ poke |= [=mark =vase] ^+ cor - ~& poke+mark - ?+ mark ~&(%bad-mark ~|(bad-mark+mark !!)) + ?+ mark ~|(bad-mark+mark !!) %noun ?+ q.vase !! %migrate ~|(%migrate-not-implemented !!) @@ -981,51 +1035,127 @@ ?(act:base:mar %contact-action-0) (to-action-1 !<(action-0 vase)) == - ~& act - ~|(%poke-not-implemented !!) - :: ?- -.act - :: %anon p-anon:pub - :: %edit (p-edit:pub p.act) - :: %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) - :: %heed (s-many:sub p.act |=(s=_s-impl:sub si-heed:s)) - :: %drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s)) - :: %snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s)) - :: == + ?+ -.act ~|(%poke-not-implemented !!) + %anon p-anon:pub + %self (p-self:pub p.act) + %edit (p-edit:pub p.act q.act) + %spot (p-spot:pub p.act) + %wipe (p-wipe:pub p.act) + :: %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) + :: %heed (s-many:sub p.act |=(s=_s-impl:sub si-heed:s)) + :: %drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s)) + :: %snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s)) + == == + :: +peek: scry + :: + :: v0 scries + :: + :: /x/all -> $rolodex-0 + :: /x/contact/her=@ -> $@(~ contact-0) + :: + :: v1 scries + :: + :: /x/v1/self -> $@(~ $profile-1) + :: /x/v1/book -> $book + :: /x/v1/book/cid=@uv -> $page + :: /x/v1/peer/her=@p -> $foreign-1 + :: /x/v1/contact/her=@p -> $contact-1 (effective contact) :: ++ peek |= pat=(pole knot) ^- (unit (unit cage)) - ~|(bad-peek+pat !!) - :: ?+ pat [~ ~] - :: [%x %all ~] - :: =/ lor=rolodex - :: ?: |(?=(~ rof) ?=(~ con.rof)) rol - :: (~(put by rol) our.bowl rof ~) - :: ``contact-rolodex+!>(lor) - :: :: - :: [%x %contact her=@ ~] - :: ?~ who=`(unit @p)`(slaw %p her.pat) - :: [~ ~] - :: =/ tac=?(~ contact) - :: ?: =(our.bowl u.who) ?~(rof ~ con.rof) - :: =+ (~(get by rol) u.who) - :: ?: |(?=(~ -) ?=(~ for.u.-)) ~ - :: con.for.u.- - :: ?~ tac [~ ~] - :: ``contact+!>(`contact`tac) - :: == + ~& scry+pat + ?+ pat [~ ~] + :: + [%x %all ~] + =/ rol-0=rolodex-0 + %- ~(run by peers) + |= far=foreign-1 + ^- foreign-0 + =/ mod=contact-1 + ?~ cid.far + ~ + q:(~(got by book) u.cid.far) + (to-foreign-0-mod far mod) + =/ lor-0=rolodex-0 + ?: |(?=(~ rof) ?=(~ con.rof)) rol-0 + (~(put by rol-0) our.bowl (to-profile-0 rof) ~) + ``contact-rolodex+!>(lor-0) + :: + [%x %contact her=@ ~] + ?~ who=`(unit @p)`(slaw %p her.pat) + [~ ~] + =/ tac=?(~ contact-0) + ?: =(our.bowl u.who) + ?~(rof ~ (to-contact-0 con.rof)) + =+ (~(get by peers) u.who) + ?: |(?=(~ -) ?=(~ for.u.-)) ~ + (to-contact-0 con.for.u.-) + ?~ tac [~ ~] + :: XX smart compiler > Hoon compiler + ``contact+!>(`contact-0`tac) + :: + [%x %v1 %self ~] + ?~ rof ~ + ?~ con.rof [~ ~] + ``contact-1+!>(con.rof) + :: + [%x %v1 %book ~] + ``contact-book-1+!>(book) + :: + [%x %v1 %book cid=@uv ~] + ?~ cid=`(unit @uv)`(slaw %uv cid.pat) + [~ ~] + ?~ page=(~(get by book) u.cid) + [~ ~] + ``contact-page-1+!>(u.page) + :: XX is foreign-1 useful at all? + :: perhaps we return it because the profile + :: could be missing yet, but peer already + :: exists? + :: + [%x %v1 %peer her=@p ~] + ?~ who=`(unit @p)`(slaw %p her.pat) + [~ ~] + ?~ far=(~(get by peers) u.who) + [~ ~] + ``foreign-1+!>(u.far) + :: + [%x %v1 %contact her=@p ~] + ?~ who=`(unit @p)`(slaw %p her.pat) + [~ ~] + ?~ far=(~(get by peers) u.who) + ``contact-1+!>(^-(contact-1 ~)) + =/ con=contact-1 + ?~ for.u.far ~ + con.for.u.far + ?~ cid.u.far + ``contact-1+!>(con) + %- some %- some + :- %contact-1 + !> %- ~(uni by con) + q:(~(got by book) u.cid.u.far) + == :: ++ peer |= pat=(pole knot) ^+ cor - ~|(bad-watch-path+pat !!) - :: ?+ pat ~|(bad-watch-path+pat !!) - :: [%contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) - :: [%contact ~] (p-init:pub ~) - :: [%epic ~] (give %fact ~ epic+!>(okay)) - :: [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) - :: == + ?+ pat ~|(bad-watch-path+pat !!) + :: + [%contact %at wen=@ ~] (p-init-0:pub `(slav %da wen.pat)) + [%contact ~] (p-init-0:pub ~) + :: XX confirm that giving a fact on ~ outside of peer + :: does nothing + :: + [%v1 %contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) + [%v1 %contact ~] (p-init:pub ~) + :: + [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) + [%v1 %news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) + :: + [%epic ~] (give %fact ~ epic+!>(okay)) + == :: ++ agent |= [=wire =sign:agent:gall] diff --git a/desk/mar/contact.hoon b/desk/mar/contact.hoon index 9f9d9d9d..65a88985 100644 --- a/desk/mar/contact.hoon +++ b/desk/mar/contact.hoon @@ -1,14 +1,2 @@ -/- c=contacts -/+ j=contacts-json -|_ =contact:c -++ grad %noun -++ grow - |% - ++ noun contact - ++ json (contact:enjs:j contact) - -- -++ grab - |% - ++ noun contact:c - -- --- +/% contact-0 %contact-0 +contact-0 diff --git a/desk/mar/contact/news.hoon b/desk/mar/contact/news.hoon index 8d47ec02..de1ea35d 100644 --- a/desk/mar/contact/news.hoon +++ b/desk/mar/contact/news.hoon @@ -1,6 +1,6 @@ /- c=contacts -/+ j=contacts-json -|_ =news:c +/+ j=contacts-json-0 +|_ news=news-0:c ++ grad %noun ++ grow |% @@ -9,6 +9,6 @@ -- ++ grab |% - ++ noun news:c + ++ noun news-0:c -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 0596061a..6a98ce77 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -115,6 +115,8 @@ +$ profile-1 [wen=@da con=contact-1] :: $page: contact book page :: +:: Contact Page +:: +$ page (pair (unit ship) contact-1) :: $book: contact book :: @@ -183,8 +185,9 @@ :: +$ action-1 $% [%anon ~] - [%edit p=(unit cid) q=(list (pair @tas value-1))] - [%spot p=(list (pair cid (unit ship)))] + [%self p=(map @tas value-1)] + [%edit p=cid q=(map @tas value-1)] + [%spot p=(pair cid (unit ship))] [%wipe p=(list cid)] [%meet p=(list ship)] [%drop p=(list ship)] @@ -205,6 +208,7 @@ :: %wipe: contact deleted :: %peer: peer update or deletion :: +:: /news +$ news-1 $% [%self con=contact-1] [%page =cid con=contact-1] diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 1e59578f..674f81fd 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -1,6 +1,304 @@ /- *contacts -/+ *test +/+ *test-agent /= contacts-agent /app/contacts =* agent contacts-agent +:: |% ++| %help +++ mono + |= [old=@da new=@da] + ^- @da + ?: (lth old new) new + (add old ^~((rsh 3^2 ~s1))) +++ tick ^~((rsh 3^2 ~s1)) ++| %poke-0 +:: +:: +test-poke-anon-0: v0 delete the profile +:: +++ test-poke-anon-0 + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =| con-0=contact-0 + =. nickname.con-0 'Zod' + =. bio.con-0 'The first of the galaxies' + :: + =/ con-1=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] + =/ edit-0=(list field-0) + ^- (list field-0) + :~ nickname+'Zod' + bio+'The first of the galaxies' + == + :: foreign subscriber to /contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /contact) + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /news) + :: + ;< ~ b (set-src our.bowl) + :: action-0 profile %edit + :: + ;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0])) + :: + =/ upd-0=update-0 + [%full (mono now.bowl now.bowl) ~] + =/ upd-1=update-1 + [%full (mono now.bowl now.bowl) ~] + ;< caz=(list card) b (do-poke %contact-action !>([%anon ~])) + %+ ex-cards caz + :~ (ex-fact ~[/contact] %contact-update !>(upd-0)) + (ex-fact ~ %contact-update-1 !>(upd-1)) + (ex-fact ~[/news] %contact-news !>([our.bowl ~])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%self ~])) + == +:: +test-poke-edit-0: v0 edit the profile +:: +++ test-poke-edit-0 + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =| con-0=contact-0 + =. nickname.con-0 'Zod' + =. bio.con-0 'The first of the galaxies' + :: + =/ con-1=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] + :: + =/ upd-0=update-0 + [%full now.bowl con-0] + =/ upd-1=update-1 + [%full now.bowl con-1] + =/ edit-0=(list field-0) + ^- (list field-0) + :~ nickname+'Zod' + bio+'The first of the galaxies' + == + :: foreign subscriber to /contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /contact) + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /news) + :: + ;< ~ b (set-src our.bowl) + :: action-0 profile %edit + :: + ;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0])) + %+ ex-cards caz + :~ (ex-fact ~[/contact] %contact-update !>(upd-0)) + (ex-fact ~ %contact-update-1 !>(upd-1)) + (ex-fact ~[/news] %contact-news !>([our.bowl con-0])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%self con-1])) + == +:: +test-poke-meet-0: v0 meet a peer +:: +:: ++ test-poke-meet-0 +:: %- eval-mare +:: =/ m (mare ,~) +:: =* b bind:m +:: ^- form:m +:: ;< caz=(list card) b (do-init %contacts contacts-agent) +:: ;< =bowl b get-bowl +:: :: v0 %meet is no-op +:: :: +:: ;< caz=(list card) b (do-poke %contact-action !>([%meet ~[~sun]])) +:: (ex-cards caz ~) +:: ++| %poke +:: +test-poke-self: change the profile +:: +++ test-poke-self + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =| con-0=contact-0 + =. nickname.con-0 'Zod' + =. bio.con-0 'The first of the galaxies' + :: + =/ con-1=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] + :: + =/ upd-0=update-0 + [%full now.bowl con-0] + =/ upd-1=update-1 + [%full now.bowl con-1] + =/ edit-1 con-1 + :: foreign subscriber to /contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /v1/contact) + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /v1/news) + :: + ;< ~ b (set-src our.bowl) + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%self con-1])) + %+ ex-cards caz + :~ (ex-fact ~ %contact-update !>(upd-0)) + (ex-fact ~[/v1/contact] %contact-update-1 !>(upd-1)) + (ex-fact ~[/news] %contact-news !>([our.bowl con-0])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%self con-1])) + == +:: +test-poke-anon: delete the profile +:: +++ test-poke-anon + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-1=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] + :: + =/ edit-1 con-1 + :: foreign subscriber to /contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /v1/contact) + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /v1/news) + :: + ;< ~ b (set-src our.bowl) + :: edit the profile + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%self con-1])) + :: delete the profile + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%anon ~])) + :: contact update is published on /v1/contact + :: news is published on /news, /v1/news + :: + ;< ~ b %+ ex-cards caz + :~ (ex-fact ~ %contact-update !>([%full (add now.bowl tick) ~])) + (ex-fact ~[/v1/contact] %contact-update-1 !>([%full (add now.bowl tick) ~])) + (ex-fact ~[/news] %contact-news !>([our.bowl ~])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%self ~])) + == + :: v0 profile is empty + :: + ;< peek=(unit (unit cage)) b + (get-peek /x/contact/(scot %p our.bowl)) + ;< ~ b + %+ ex-equal + !>((need peek)) + !>(~) + :: profile is empty + :: + ;< peek=(unit (unit cage)) b + (get-peek /x/v1/self) + %+ ex-equal + !>((need peek)) + !>(~) +:: +test-poke-edit: edit the contact book +:: +++ test-poke-edit + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-1=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + :: + =/ =news-1 + [%page 0v1 con-1] + =/ mypage=^page + [p=~ q=con-1] + =/ edit-1 con-1 + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /v1/news) + :: + ;< ~ b (set-src our.bowl) + :: %edit new contact page + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit 0v1 con-1])) + :: news is published on /v1/news + :: + ;< ~ b %+ ex-cards caz + :~ (ex-fact ~[/v1/news] %contact-news-1 !>(news-1)) + == + :: peek page in the book: new contact page is found + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/0v1) + =/ cage (need (need peek)) + ?> ?=(%contact-page-1 p.cage) + %+ ex-equal + q.cage + !>(mypage) +:: ++| %peek-0 +:: +test-peek-0-all: v0 scry /all +:: +:: ++ test-peek-0-all (eval-mare (ex-equal !>(2) !>(2))) +:: +test-peek-0-contact: v0 scry /contact +:: +:: ++ test-peek-0-contact (eval-mare (ex-equal !>(2) !>(2))) +:: +test-poke-spot-edit: spot a peer +:: +:: ++ test-poke-spot +:: %- eval-mare +:: =/ m (mare ,~) +:: =* b bind:m +:: ^- form:m +:: ;< caz=(list card) b (do-init %contacts contacts-agent) +:: ;< =bowl b get-bowl +:: :: +:: =/ con-1=contact-1 +:: %- malt +:: ^- (list (pair @tas value-1)) +:: ~[nickname+text/'Sun' bio+text/'It is bright today'] +:: :: +:: =/ =news-1 +:: [%page 0v1 con-1] +:: =/ edit-1 con-1 +:: :: local subscriber to /news +:: :: +:: ;< ~ b (set-src our.bowl) +:: ;< caz=(list card) b (do-watch /v1/news) +:: :: +:: ;< ~ b (set-src our.bowl) +:: :: +:: ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit 0v1 con-1])) +:: ;< caz=(list card) b (do-poke %contact-action-1 %meet) +:: %+ ex-cards caz +:: :~ (ex-fact ~[/v1/news] %contact-news-1 !>(news-1)) +:: == -- From 207b31ce7ebedd0d37cbf41427a44de9aefa1dc8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Thu, 5 Sep 2024 21:23:19 +0800 Subject: [PATCH 08/44] contacts: unlink old page upon peer spot --- desk/app/contacts.hoon | 11 ++++++++--- desk/tests/app/contacts.hoon | 4 ++-- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 6b9064fc..ba1bd716 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -697,6 +697,11 @@ =/ peer=foreign-1 ~| unknown-peer+u.who (~(got by peers) u.who) + :: unlink peer page + :: + =? book ?=(^ cid.peer) + =/ sage=^page (~(got by book) u.cid.peer) + (~(put by book) u.cid.peer ~ q.sage) =. peers (~(put by peers) u.who peer(cid `cid)) :: XX version .con, .for, etc. :: @@ -722,7 +727,7 @@ ?: =(u.wen wen.rof) cor :: :: no future subs - ?>((lth u.wen wen.rof) (give (fact-0 ~ full+(to-profile-0 rof)))) + ?>((lth u.wen wen.rof) (give (fact-0 ~ full+(to-profile-0 rof)))) :: ++ p-init |= wen=(unit @da) @@ -731,7 +736,7 @@ ?: =(u.wen wen.rof) cor :: :: no future subs - ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) + ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: ++ p-news-0 |= n=news-0 @@ -1087,7 +1092,7 @@ ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] =/ tac=?(~ contact-0) - ?: =(our.bowl u.who) + ?: =(our.bowl u.who) ?~(rof ~ (to-contact-0 con.rof)) =+ (~(get by peers) u.who) ?: |(?=(~ -) ?=(~ for.u.-)) ~ diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 674f81fd..32ec6d1c 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -263,8 +263,8 @@ %+ ex-equal q.cage !>(mypage) -:: -+| %peek-0 +:: XX test spot of two different pages to the same ship +:: +| %peek-0 :: +test-peek-0-all: v0 scry /all :: :: ++ test-peek-0-all (eval-mare (ex-equal !>(2) !>(2))) From 0e8d423b8af2a0a6388834e97f9f8d848c3c495c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Fri, 6 Sep 2024 23:08:44 +0800 Subject: [PATCH 09/44] contacts: subscription client v1 --- desk/app/contacts.hoon | 453 +++++++++++++++-------------------- desk/sur/contacts.hoon | 13 +- desk/tests/app/contacts.hoon | 7 +- 3 files changed, 204 insertions(+), 269 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index ba1bd716..2d23272a 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -20,7 +20,7 @@ -- :: %- agent:dbug -:: %+ verb | +%+ verb | ^- agent:gall =| state-1 =* state - @@ -316,17 +316,6 @@ ?~ for.per don (~(uni by con.for.per) don) -:: :: +gen-cid: generate new contact id -:: :: -:: ++ gen-cid -:: |= [eny=@uvJ =^book] -:: ^- cid -:: =/ nid=cid -:: (end [0 4] eny) -:: |- -:: ?. |(=(0x0 nid) (~(has by book) nid)) -:: nid -:: $(nid +(nid)) :: +to-rolodex-1: convert rolodex-0 :: :: ++ to-rolodex-1 @@ -434,74 +423,6 @@ %drop [%drop p.o] %snub [%snub p.o] == - :: ?- -.n - :: :: - :: %self - :: ?~ con.n - :: [our.bowl ~] - :: =/ =contact-0 - :: (to-contact-0 con.n) - :: [our.bowl contact-0] - :: :: - :: %page - :: ?< ?=(~ who.n) - :: =/ =contact-0 - :: (~(uni by con.n) mod.n) - :: [u.who.n (to-contact-0 contact-0)] - :: :: - :: :: when we unspot a peer, we publish - :: :: his original contact, if there is one, - :: :: or announce deletion of his contact, if the - :: :: profile is missing or contact is empty. - :: :: - :: :: if we spot a peer, we publish - :: :: his effective profile. - :: :: - :: %spot - :: =/ =page - :: ~| "contact id {} not found" - :: (~(got by book) cid) - :: =* who u.p.page - :: ?< ?=(~ who) - :: =/ =foreign-1 - :: (~(got by peers) who) - :: :: unspot a peer - :: :: - :: ?: ?=(~ who.n) - :: ?~ for.foreign-1 - :: [%full who ~] - :: ?~ con.for.foreign-1 - :: [%full who ~] - :: [%full who (to-contact-0 con.for.foreign-1)] - :: :: spot a peer - :: :: - :: :: no profile, publish user overlay - :: :: - :: ?: ?| ?=(~ for.foreign-1) - :: ?=(~ con.for.foreign-1) - :: == - :: [%full who ?~(q.page ~ (to-contact-0 con.q.page))] - :: :: XX to-contact-0 should return $@(~ contact-0) - :: :: - :: =/ =contact-0 - :: %- to-contact-0 - :: (~(uni by con.for) q.page) - :: [%full who contact-0] - :: :: - :: :: when a contact associated with a peer is deleted - :: :: we publish his original profile, if it exists, or - :: :: announce its deletion. - :: :: - :: %wipe - :: =/ =page - :: ~| "contact id {} not found" - :: (~(got by book) cid) - :: ?< ?=(~ p.page) - :: =* who u.p.page - :: =/ =foreign-1 - :: :: XX In the meantime, the peer could be dropped - :: :: or deleted - :: (~(got by peers) who) :: ++ mono |= [old=@da new=@da] @@ -699,9 +620,10 @@ (~(got by peers) u.who) :: unlink peer page :: - =? book ?=(^ cid.peer) + =? cor ?=(^ cid.peer) =/ sage=^page (~(got by book) u.cid.peer) - (~(put by book) u.cid.peer ~ q.sage) + =. book (~(put by book) u.cid.peer ~ q.sage) + (p-news [%spot u.cid.peer ~]) =. peers (~(put by peers) u.who peer(cid `cid)) :: XX version .con, .for, etc. :: @@ -765,159 +687,172 @@ :: for a given peer, we always have at most one subscription, :: to either /contact/* or /epic. :: - :: ++ sub - :: |^ |= who=ship - :: ^+ s-impl - :: ?< =(our.bowl who) - :: =/ old (~(get by rol) who) - :: ~(. s-impl who %live ?=(~ old) (fall old [~ ~])) - :: :: - :: ++ s-many - :: |= [l=(list ship) f=$-(_s-impl _s-impl)] - :: ^+ cor - :: %+ roll l - :: |= [who=@p acc=_cor] - :: ?: =(our.bowl who) acc - :: si-abet:(f (sub:acc who)) - :: :: - :: ++ s-impl - :: |_ [who=ship sas=?(%dead %live) new=? foreign] - :: :: - :: ++ si-cor . - :: :: - :: ++ si-abet - :: ^+ cor - :: ?- sas - :: %live =. rol (~(put by rol) who for sag) - :: :: NB: this assumes con.for is only set in +si-hear - :: :: - :: ?.(new cor (p-news:pub who ~)) - :: :: - :: %dead ?: new cor - :: =. rol (~(del by rol) who) - :: :: - :: :: this is not quite right, reflecting *total* deletion - :: :: as *contact* deletion. but it's close, and keeps /news simpler - :: :: - :: (p-news:pub who ~) - :: == - :: :: - :: ++ si-take - :: |= =sign:agent:gall - :: ^+ si-cor - :: ?- -.sign - :: %poke-ack ~|(strange-poke-ack+wire !!) - :: :: - :: %watch-ack ~| strange-watch-ack+wire - :: ?> ?=(%want sag) - :: ?~ p.sign si-cor(sag [%chi ~]) - :: %- (slog 'contact-fail' u.p.sign) - :: pe-peer:si-epic(sag %fail) - :: :: - :: %kick si-heed(sag ~) - :: :: - :: :: [compat] we *should* maintain backcompat here - :: :: - :: :: by either directly handling or upconverting - :: :: old actions. but if we don't, we'll fall back - :: :: to /epic and wait for our peer to upgrade. - :: :: - :: :: %fact's from the future are also /epic, - :: :: in case our peer downgrades. if not, we'll - :: :: handle it on +load. - :: :: - :: %fact ?+ p.cage.sign (si-odd p.cage.sign) - :: ?(upd:base:mar %contact-update-0) - :: (si-hear !<(update q.cage.sign)) - :: == == - - :: ++ si-hear - :: |= u=update - :: ^+ si-cor - :: ?: &(?=(^ for) (lte wen.u wen.for)) - :: si-cor - :: si-cor(for +.u, cor (p-news:pub who con.u)) - :: :: - :: ++ si-meet si-cor :: init key in +si-abet - :: :: - :: ++ si-heed - :: ^+ si-cor - :: ?. ?=(~ sag) - :: si-cor - :: =/ pat [%contact ?~(for / /at/(scot %da wen.for))] - :: %= si-cor - :: cor (pass /contact %agent [who dap.bowl] %watch pat) - :: sag %want - :: == - :: :: - :: ++ si-drop si-snub(sas %dead) - :: :: - :: ++ si-snub - :: %_ si-cor - :: sag ~ - :: cor ?+ sag cor - :: ?(%fail [?(%lev %dex) *]) - :: (pass /epic %agent [who dap.bowl] %leave ~) - :: :: - :: ?(%want [%chi *]) - :: (pass /contact %agent [who dap.bowl] %leave ~) - :: == == - :: :: - :: ++ si-odd - :: |= =mark - :: ^+ si-cor - :: =* upd *upd:base:mar - :: =* wid ^~((met 3 upd)) - :: ?. =(upd (end [3 wid] mark)) - :: ~&(fake-news+mark si-cor) :: XX unsub? - :: ?~ ver=(slaw %ud (rsh 3^+(wid) mark)) - :: ~&(weird-news+mark si-cor) :: XX unsub? - :: ?: =(okay u.ver) - :: ~|(odd-not-odd+mark !!) :: oops! - :: =. si-cor si-snub :: unsub before .sag update - :: =. sag ?:((lth u.ver okay) [%lev ~] [%dex u.ver]) - :: pe-peer:si-epic - :: :: - :: ++ si-epic - :: |% - :: ++ pe-take - :: |= =sign:agent:gall - :: ^+ si-cor - :: ?- -.sign - :: %poke-ack ~|(strange-poke-ack+wire !!) - :: :: - :: %watch-ack ?~ p.sign si-cor - :: %- (slog 'epic-fail' u.p.sign) - :: si-cor(sag %lost) - :: :: - :: %kick ?. ?=(?(%fail [?(%dex %lev) *]) sag) - :: si-cor :: XX strange - :: pe-peer - :: :: - :: %fact ?+ p.cage.sign - :: ~&(fact-not-epic+p.cage.sign si-cor) - :: %epic (pe-hear !<(epic q.cage.sign)) - :: == == - :: :: - :: ++ pe-hear - :: |= =epic - :: ^+ si-cor - :: ?. ?=(?(%fail [?(%dex %lev) *]) sag) - :: ~|(strange-epic+[okay epic] !!) :: get %kick'd - :: ?: =(okay epic) - :: ?: ?=(%fail sag) - :: si-cor(sag %lost) :: abandon hope - :: si-heed:si-snub - :: :: - :: :: handled generically to support peer downgrade - :: :: - :: si-cor(sag ?:((gth epic okay) [%dex epic] [%lev ~])) - :: :: - :: ++ pe-peer - :: si-cor(cor (pass /epic %agent [who dap.bowl] %watch /epic)) - :: -- - :: -- - :: -- + ++ sub + |^ |= who=ship + ^+ s-impl + ?< =(our.bowl who) + =/ old (~(get by peers) who) + ~(. s-impl who %live ?=(~ old) (fall old *foreign-1)) + :: + ++ s-many + |= [l=(list ship) f=$-(_s-impl _s-impl)] + ^+ cor + %+ roll l + |= [who=@p acc=_cor] + ?: =(our.bowl who) acc + si-abet:(f (sub:acc who)) + :: + ++ s-impl + |_ [who=ship sas=?(%dead %live) new=? foreign-1] + :: + ++ si-cor . + :: + ++ si-abet + ^+ cor + ?- sas + %live =. peers (~(put by peers) who [for cid sag]) + :: NB: this assumes con.for is only set in +si-hear + :: + ?. new cor + =. cor (p-news-0:pub who ~) + (p-news:pub [%peer who ~]) + :: + %dead ?: new cor + =. peers (~(del by peers) who) + :: + :: this is not quite right, reflecting *total* deletion + :: as *contact* deletion. but it's close, and keeps /news simpler + :: + =. cor (p-news-0:pub who ~) + (p-news:pub [%peer who ~]) + == + :: + ++ si-take + |= =sign:agent:gall + ^+ si-cor + ?- -.sign + %poke-ack ~|(strange-poke-ack+wire !!) + :: + %watch-ack ~| strange-watch-ack+wire + ?> ?=(%want sag) + ?~ p.sign si-cor(sag [%chi ~]) + %- (slog 'contact-fail' u.p.sign) + pe-peer:si-epic(sag %fail) + :: + %kick si-meet(sag ~) + :: + :: [compat] we *should* maintain backcompat here + :: + :: by either directly handling or upconverting + :: old actions. but if we don't, we'll fall back + :: to /epic and wait for our peer to upgrade. + :: + :: %fact's from the future are also /epic, + :: in case our peer downgrades. if not, we'll + :: handle it on +load. + :: + %fact ?+ p.cage.sign (si-odd p.cage.sign) + :: XX make sure I have got it right here + :: + ?(upd:base:mar %contact-update-1) + (si-hear !<(update-1 q.cage.sign)) + == == + :: + ++ si-hear + |= u=update-1 + ^+ si-cor + ?: &(?=(^ for) (lte wen.u wen.for)) + si-cor + %= si-cor + for +.u + cor =. cor + (p-news-0:pub who (to-contact-0 con.u)) + (p-news:pub %peer who con.u) + == + :: + :: ++ si-meet si-cor :: init key in +si-abet + :: + ++ si-meet + ^+ si-cor + ?. ?=(~ sag) + si-cor + =/ pat [%v1 %contact ?~(for / /at/(scot %da wen.for))] + %= si-cor + cor (pass /contact %agent [who dap.bowl] %watch pat) + sag %want + == + :: + ++ si-drop si-snub(sas %dead) + :: + ++ si-snub + %_ si-cor + sag ~ + cor ?+ sag cor + ?(%fail [?(%lev %dex) *]) + (pass /epic %agent [who dap.bowl] %leave ~) + :: + ?(%want [%chi *]) + (pass /contact %agent [who dap.bowl] %leave ~) + == == + :: + ++ si-odd + |= =mark + ^+ si-cor + =* upd *upd:base:mar + =* wid ^~((met 3 upd)) + ?. =(upd (end [3 wid] mark)) + ~&(fake-news+mark si-cor) :: XX unsub? + ?~ ver=(slaw %ud (rsh 3^+(wid) mark)) + ~&(weird-news+mark si-cor) :: XX unsub? + ?: =(okay u.ver) + ~|(odd-not-odd+mark !!) :: oops! + =. si-cor si-snub :: unsub before .sag update + =. sag ?:((lth u.ver okay) [%lev ~] [%dex u.ver]) + pe-peer:si-epic + :: + ++ si-epic + |% + ++ pe-take + |= =sign:agent:gall + ^+ si-cor + ?- -.sign + %poke-ack ~|(strange-poke-ack+wire !!) + :: + %watch-ack ?~ p.sign si-cor + %- (slog 'epic-fail' u.p.sign) + si-cor(sag %lost) + :: + %kick ?. ?=(?(%fail [?(%dex %lev) *]) sag) + si-cor :: XX strange + pe-peer + :: + %fact ?+ p.cage.sign + ~&(fact-not-epic+p.cage.sign si-cor) + %epic (pe-hear !<(epic q.cage.sign)) + == == + :: + ++ pe-hear + |= =epic + ^+ si-cor + ?. ?=(?(%fail [?(%dex %lev) *]) sag) + ~|(strange-epic+[okay epic] !!) :: get %kick'd + ?: =(okay epic) + ?: ?=(%fail sag) + si-cor(sag %lost) :: abandon hope + si-meet:si-snub + :: + :: handled generically to support peer downgrade + :: + si-cor(sag ?:((gth epic okay) [%dex epic] [%lev ~])) + :: + ++ pe-peer + si-cor(cor (pass /epic %agent [who dap.bowl] %watch /epic)) + -- + -- + -- + :: XX can we just assume this migration happened + :: at %contacts v0 and cut it out? + :: :: +migrate: from :contact-store :: :: all known ships, non-default profiles, no subscriptions @@ -1040,16 +975,15 @@ ?(act:base:mar %contact-action-0) (to-action-1 !<(action-0 vase)) == - ?+ -.act ~|(%poke-not-implemented !!) + ?- -.act %anon p-anon:pub %self (p-self:pub p.act) %edit (p-edit:pub p.act q.act) - %spot (p-spot:pub p.act) %wipe (p-wipe:pub p.act) - :: %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) - :: %heed (s-many:sub p.act |=(s=_s-impl:sub si-heed:s)) - :: %drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s)) - :: %snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s)) + %spot (p-spot:pub p.act) + %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) + %drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s)) + %snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s)) == == :: +peek: scry @@ -1070,7 +1004,6 @@ ++ peek |= pat=(pole knot) ^- (unit (unit cage)) - ~& scry+pat ?+ pat [~ ~] :: [%x %all ~] @@ -1112,7 +1045,9 @@ [%x %v1 %book cid=@uv ~] ?~ cid=`(unit @uv)`(slaw %uv cid.pat) [~ ~] - ?~ page=(~(get by book) u.cid) + =/ page=(unit page) + (~(get by book) u.cid) + ?~ page [~ ~] ``contact-page-1+!>(u.page) :: XX is foreign-1 useful at all? @@ -1148,15 +1083,14 @@ ^+ cor ?+ pat ~|(bad-watch-path+pat !!) :: - [%contact %at wen=@ ~] (p-init-0:pub `(slav %da wen.pat)) [%contact ~] (p-init-0:pub ~) - :: XX confirm that giving a fact on ~ outside of peer - :: does nothing + [%contact %at wen=@ ~] (p-init-0:pub `(slav %da wen.pat)) + [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) + :: XX confirm that giving a fact in a gall agent on ~ outside of + :: on-watch does nothing (subs returns ~ on empty subscriber) :: - [%v1 %contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) [%v1 %contact ~] (p-init:pub ~) - :: - [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) + [%v1 %contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) [%v1 %news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) :: [%epic ~] (give %fact ~ epic+!>(okay)) @@ -1165,16 +1099,15 @@ ++ agent |= [=wire =sign:agent:gall] ^+ cor - ~|(evil-agent+wire !!) - :: ?+ wire ~|(evil-agent+wire !!) - :: [%contact ~] si-abet:(si-take:(sub src.bowl) sign) - :: [%epic ~] si-abet:(pe-take:si-epic:(sub src.bowl) sign) - :: :: - :: [%migrate ~] - :: ?> ?=(%poke-ack -.sign) - :: ?~ p.sign cor - :: %- (slog leaf/"{} failed" u.p.sign) - :: cor - :: == + ?+ wire ~|(evil-agent+wire !!) + [%contact ~] si-abet:(si-take:(sub src.bowl) sign) + [%epic ~] si-abet:(pe-take:si-epic:(sub src.bowl) sign) + :: + :: [%migrate ~] + :: ?> ?=(%poke-ack -.sign) + :: ?~ p.sign cor + :: %- (slog leaf/"{} failed" u.p.sign) + :: cor + == -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 6a98ce77..aa727214 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -116,10 +116,13 @@ :: $page: contact book page :: :: Contact Page +:: XX switch order in this pair +:: XX (pair contact-1 contact-1) +:: peer contact and user overlay :: +$ page (pair (unit ship) contact-1) :: $book: contact book -:: +:: XX next version (map $@(ship [%cid cid]) page) +$ book (map cid page) :: $rolodex-1: rolodex :: @@ -131,6 +134,7 @@ peers=(map ship foreign-1) == :: +:: +$ epic epic:e +$ saga $@ $? %want :: subscribing @@ -176,7 +180,7 @@ +$ news-0 [who=ship con=$@(~ contact-0)] :: %anon: delete the profile -:: %edit: edit the profile or a contact page +:: %edit: edit the contact page :: %wipe: delete a contact page :: %spot: associate page with a peer :: %meet: track a peer @@ -204,11 +208,10 @@ :: :: %self: our profile :: %page: contact page update -:: %spot: peer with contact page +:: %spot: contact page with peer :: %wipe: contact deleted -:: %peer: peer update or deletion +:: %peer: peer update :: -:: /news +$ news-1 $% [%self con=contact-1] [%page =cid con=contact-1] diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 32ec6d1c..e5750fa8 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -258,11 +258,10 @@ :: peek page in the book: new contact page is found :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/0v1) - =/ cage (need (need peek)) - ?> ?=(%contact-page-1 p.cage) + =/ =cage (need (need peek)) %+ ex-equal - q.cage - !>(mypage) + !> [%contact-page-1 q.cage] + !> [%contact-page-1 !>(mypage)] :: XX test spot of two different pages to the same ship :: +| %peek-0 :: +test-peek-0-all: v0 scry /all From 8e37e6adafaccd12b6f19bd11494d986ebb10247 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 9 Sep 2024 07:12:01 +0800 Subject: [PATCH 10/44] contacts: key book also by ship --- desk/app/contacts.hoon | 266 +++++++++++++++++------------------ desk/sur/contacts.hoon | 54 ++++--- desk/tests/app/contacts.hoon | 8 +- 3 files changed, 157 insertions(+), 171 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 2d23272a..e7357f0f 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -273,11 +273,11 @@ ?> ?=(%cult -.val) p.val == -:: +to-contact-0-mod: convert to contact-0 with overlay +:: +contact-mod: merge contacts :: -++ to-contact-0-mod +++ contact-mod |= [c=contact-1 mod=contact-1] - (to-contact-0 (~(uni by c) mod)) + (~(uni by c) mod) :: +to-profile-1: convert profile-0 :: ++ to-profile-1 @@ -294,7 +294,7 @@ ++ to-profile-0-mod |= [p=profile-1 mod=contact-1] ^- profile-0 - [wen.p (to-contact-0-mod con.p mod)] + [wen.p (to-contact-0 (contact-mod con.p mod))] :: ++ to-foreign-0 |= f=foreign-1 @@ -306,16 +306,20 @@ |= [f=foreign-1 mod=contact-1] ^- foreign-0 [?~(for.f ~ (to-profile-0-mod for.f mod)) sag.f] -:: +contact-mod: fuse peer contact with overlay +:: +foreign-mod: fuse peer contact with overlay :: -:: XX name is confusing rename +++ foreign-mod + |= [far=foreign-1 mod=contact-1] + ^- foreign-1 + ?~ for.far + far + far(con.for (contact-mod con.for.far mod)) +:: +foreign-contact: grab foreign contact :: -++ contact-mod - |= [per=foreign-1 don=contact-1] +++ foreign-contact + |= far=foreign-1 ^- contact-1 - ?~ for.per - don - (~(uni by con.for.per) don) + ?~(for.far ~ con.for.far) :: +to-rolodex-1: convert rolodex-0 :: :: ++ to-rolodex-1 @@ -501,7 +505,7 @@ :: |% :: - ++ p-anon ?.(?=([@ ^] rof) cor (p-diff-self ~)) + ++ p-anon ?.(?=([@ ^] rof) cor (p-send-self ~)) :: ++ p-self |= e=(map @tas value-1) @@ -511,42 +515,53 @@ (do-edit-1 old e) ?: =(old new) cor - (p-diff-self new) + (p-send-self new) + :: +p-page: create new contact page + :: + ++ p-page + |= [=cid con=contact-1] + ?: (~(has by book) id+cid) + ~| "contact page {} already exists" !! + (p-send-page cid con) + :: +p-edit: edit contact page overlay :: ++ p-edit - |= [=cid e=(map @tas value-1)] + |= [=kip mod=(map @tas value-1)] =/ =page - =+ (~(get by book) cid) - ?~(- *page u.-) - =/ old=contact-1 q.page + ~| "contact page {} does not exist" + (~(got by book) kip) + =/ old=contact-1 + q.page =/ new=contact-1 - (do-edit-1 old e) + (do-edit-1 q.page mod) ?: =(old new) cor - (p-diff-edit cid p.page new) + (p-send-edit kip p.page new) + :: +p-wipe: delete a contact page :: ++ p-wipe - |= del=(list cid) - %+ reel del - |= [=cid acc=_cor] - =/ =page - ~| "contact id {} not found" - (~(got by book) cid) - (p-diff-wipe cid page) - :: XX can we spot someone who is not a peer? - :: Should we then meet them automatically? + |= wip=(list kip) + %+ roll wip + |= [=kip acc=_cor] + =/ =page + ~| "contact id {} not found" + (~(got by book) kip) + (p-send-wipe kip page) + :: +p-spot: add as a contact :: ++ p-spot - |= [=cid who=(unit ship)] - =/ page=(unit page) - (~(get by book) cid) - ?~ page - ~| "contact id {} not found" !! - ?: =(p.u.page who) - cor - (p-diff-spot cid u.page who) + |= [who=ship mod=contact-1] + ?: (~(has by book) who) + ~| "peer {} is already a contact" !! + =/ con=contact-1 + ~| "peer {} not found" + =/ far=foreign-1 + (~(got by peers) who) + ?~ for.far *contact-1 + con.for.far + (p-send-spot who con mod) :: - ++ p-diff-self + ++ p-send-self |= con=contact-1 =/ p=profile-1 [?~(rof now.bowl (mono wen.rof now.bowl)) con] =. rof p @@ -558,89 +573,52 @@ =. cor (p-news-0 our.bowl (to-contact-0 con)) (p-news [%self con]) - :: +p-diff-edit: publish contact page update - :: - :: XX is there a way to guard against someone - :: using this arm to modify who out of band? + :: +p-send-page: publish new contact page :: - :: .cid: contact id - :: .who: peer -- inherited from page - :: .con: contact + ++ p-send-page + |= [=cid mod=contact-1] + =/ =page + [*contact-1 mod] + =. book (~(put by book) id+cid page) + (p-news [%page id+cid page]) + :: +p-send-edit: publish contact page update :: - ++ p-diff-edit - |= [=cid who=(unit ship) con=contact-1] - :: .who.page: guaranteed unchanged - :: - =/ =page [who con] + ++ p-send-edit + |= [=kip =page] =. book - (~(put by book) cid page) - :: there is a spot peer + (~(put by book) kip page) + :: this is a peer page, send v0 update :: - =? cor ?=(^ who) - =/ peer=foreign-1 - ~| unknown-peer+u.who - (~(got by peers) u.who) - %+ p-news-0 u.who - (to-contact-0 (contact-mod peer con)) - (p-news [%page cid con]) + =? cor ?=(ship kip) + %+ p-news-0 kip + (to-contact-0 (contact-mod page)) + (p-news [%page kip page]) :: - ++ p-diff-wipe - |= [=cid =page] - =* who p.page + ++ p-send-wipe + |= [=kip =page] =. book - (~(del by book) cid) - :: unspot a peer + (~(del by book) kip) + :: peer overlay lost :: - =? cor ?=(^ who) - =/ peer=foreign-1 - ~| unknown-peer+u.who - (~(got by peers) u.who) - =. peers - (~(put by peers) u.who peer(cid ~)) + =? cor &(?=(ship kip) !?=(~ q.page)) + :: =/ peer=foreign-1 + :: ~| unknown-peer+u.who + :: (~(got by peers) kip) :: :: v0 peer contact is modified - %+ p-news-0 u.who - (to-contact-0 ?~(for.peer ~ con.for.peer)) - (p-news [%wipe cid]) - :: +p-diff-spot: publish peer spot + %+ p-news-0 kip + (to-contact-0 p.page) + (p-news [%wipe kip]) + :: +p-send-spot: publish peer spot :: - :: .cid: contact id - :: .who: new peer - :: .page: associated page - :: - ++ p-diff-spot - |= [=cid =page who=(unit ship)] + ++ p-send-spot + |= [who=ship con=contact-1 mod=contact-1] =. book - (~(put by book) cid [who q.page]) - :: spot a peer - :: - =? cor ?=(^ who) - =/ peer=foreign-1 - ~| unknown-peer+u.who - (~(got by peers) u.who) - :: unlink peer page - :: - =? cor ?=(^ cid.peer) - =/ sage=^page (~(got by book) u.cid.peer) - =. book (~(put by book) u.cid.peer ~ q.sage) - (p-news [%spot u.cid.peer ~]) - =. peers (~(put by peers) u.who peer(cid `cid)) - :: XX version .con, .for, etc. - :: - %+ p-news-0 u.who - (to-contact-0 (contact-mod peer q.page)) - :: unspot a peer - :: - =? cor ?=(^ p.page) - =/ peer=foreign-1 - ~| unknown-peer+u.p.page - (~(got by peers) u.p.page) - =. peers (~(put by peers) u.p.page peer(cid ~)) - :: XX version .con, .for, etc. for clarity - :: - %+ p-news-0 u.p.page - (to-contact-0 ?~(for.peer ~ con.for.peer)) - (p-news [%spot cid who]) + (~(put by book) who con mod) + =. cor + %+ p-news-0 who + (to-contact-0 (~(uni by con) mod)) + (p-news [%page who con mod]) :: ++ p-init-0 |= wen=(unit @da) @@ -710,7 +688,7 @@ ++ si-abet ^+ cor ?- sas - %live =. peers (~(put by peers) who [for cid sag]) + %live =. peers (~(put by peers) who [for sag]) :: NB: this assumes con.for is only set in +si-hear :: ?. new cor @@ -765,8 +743,15 @@ si-cor %= si-cor for +.u - cor =. cor + cor =. cor (p-news-0:pub who (to-contact-0 con.u)) + :: update peer contact + :: + =/ page=(unit page) (~(get by book) who) + =? cor ?=(^ page) + ?: =(p.u.page con.u) cor + =. book (~(put by book) who u.page(p con.u)) + (p-news:pub %page who con.u q.u.page) (p-news:pub %peer who con.u) == :: @@ -978,9 +963,10 @@ ?- -.act %anon p-anon:pub %self (p-self:pub p.act) + %page (p-page:pub p.act q.act) + %spot (p-spot:pub p.act q.act) %edit (p-edit:pub p.act q.act) %wipe (p-wipe:pub p.act) - %spot (p-spot:pub p.act) %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) %drop (s-many:sub p.act |=(s=_s-impl:sub si-drop:s)) %snub (s-many:sub p.act |=(s=_s-impl:sub si-snub:s)) @@ -997,9 +983,10 @@ :: :: /x/v1/self -> $@(~ $profile-1) :: /x/v1/book -> $book - :: /x/v1/book/cid=@uv -> $page + :: /x/v1/book/her=@p -> $page + :: /x/v1/book/id/cid=@uv -> $page :: /x/v1/peer/her=@p -> $foreign-1 - :: /x/v1/contact/her=@p -> $contact-1 (effective contact) + :: /x/v1/contact/her=@p -> $contact-1 :: ++ peek |= pat=(pole knot) @@ -1008,14 +995,14 @@ :: [%x %all ~] =/ rol-0=rolodex-0 - %- ~(run by peers) - |= far=foreign-1 + %- ~(urn by peers) + |= [who=ship far=foreign-1] ^- foreign-0 =/ mod=contact-1 - ?~ cid.far + ?~ page=(~(get by book) who) ~ - q:(~(got by book) u.cid.far) - (to-foreign-0-mod far mod) + q.u.page + (to-foreign-0 (foreign-mod far mod)) =/ lor-0=rolodex-0 ?: |(?=(~ rof) ?=(~ con.rof)) rol-0 (~(put by rol-0) our.bowl (to-profile-0 rof) ~) @@ -1035,25 +1022,30 @@ ``contact+!>(`contact-0`tac) :: [%x %v1 %self ~] - ?~ rof ~ + ?~ rof [~ ~] ?~ con.rof [~ ~] ``contact-1+!>(con.rof) :: [%x %v1 %book ~] ``contact-book-1+!>(book) :: - [%x %v1 %book cid=@uv ~] - ?~ cid=`(unit @uv)`(slaw %uv cid.pat) + [%x %v1 %book her=@p ~] + ?~ who=`(unit @p)`(slaw %p her.pat) + [~ ~] + =/ page=(unit page) + (~(get by book) u.who) + ?~ page + [~ ~] + ``contact-page-1+!>(`^page`u.page) + :: + [%x %v1 %book %id =cid ~] + ?~ id=`(unit @uv)`(slaw %uv cid.pat) [~ ~] =/ page=(unit page) - (~(get by book) u.cid) + (~(get by book) id+u.id) ?~ page [~ ~] - ``contact-page-1+!>(u.page) - :: XX is foreign-1 useful at all? - :: perhaps we return it because the profile - :: could be missing yet, but peer already - :: exists? + ``contact-page-1+!>(`^page`u.page) :: [%x %v1 %peer her=@p ~] ?~ who=`(unit @p)`(slaw %p her.pat) @@ -1065,17 +1057,13 @@ [%x %v1 %contact her=@p ~] ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] - ?~ far=(~(get by peers) u.who) - ``contact-1+!>(^-(contact-1 ~)) - =/ con=contact-1 - ?~ for.u.far ~ - con.for.u.far - ?~ cid.u.far - ``contact-1+!>(con) - %- some %- some - :- %contact-1 - !> %- ~(uni by con) - q:(~(got by book) u.cid.u.far) + =/ page=(unit page) + (~(get by book) u.who) + :: + :: peer not in the contact book + ?~ page + [~ ~] + ``contact-1+!>((contact-mod u.page)) == :: ++ peer diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index aa727214..1ba39a95 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -97,33 +97,30 @@ :: $foreign-1: foreign profile :: :: .for: profile -:: .con: optional contact id :: .sag: connection status :: -+$ foreign-1 [for=$@(~ profile-1) cid=(unit cid) sag=$@(~ saga)] -:: $cid: contact page id -:: -:: generated from entropy and guaranteed non-zero -:: -:: -+$ cid @uvF ++$ foreign-1 [for=$@(~ profile-1) sag=$@(~ saga)] :: $profile-1: contact profile :: :: .wen: last updated :: .con: contact :: +$ profile-1 [wen=@da con=contact-1] -:: $page: contact book page +:: $page: contact page :: -:: Contact Page -:: XX switch order in this pair -:: XX (pair contact-1 contact-1) -:: peer contact and user overlay +:: .p: peer contact +:: .q: user overlay :: -+$ page (pair (unit ship) contact-1) ++$ page (pair contact-1 contact-1) +:: $cid: contact page id +:: ++$ cid @uvF +:: $kip: contact book key +:: ++$ kip $@(ship [%id cid]) :: $book: contact book -:: XX next version (map $@(ship [%cid cid]) page) -+$ book (map cid page) +:: ++$ book (map kip page) :: $rolodex-1: rolodex :: :: .book: contact book @@ -180,19 +177,22 @@ +$ news-0 [who=ship con=$@(~ contact-0)] :: %anon: delete the profile -:: %edit: edit the contact page +:: %self: edit the profile +:: %page: create a new contact page +:: %spot: add peer as a contact +:: %edit: edit a contact overlay :: %wipe: delete a contact page -:: %spot: associate page with a peer :: %meet: track a peer :: %drop: discard a peer :: %snub: unfollow a peer :: +$ action-1 $% [%anon ~] - [%self p=(map @tas value-1)] - [%edit p=cid q=(map @tas value-1)] - [%spot p=(pair cid (unit ship))] - [%wipe p=(list cid)] + [%self p=contact-1] + [%page p=cid q=contact-1] + [%spot p=ship q=contact-1] + [%edit p=kip q=contact-1] + [%wipe p=(list kip)] [%meet p=(list ship)] [%drop p=(list ship)] [%snub p=(list ship)] @@ -206,17 +206,15 @@ == :: $news-1: local update :: -:: %self: our profile +:: %self: profile update :: %page: contact page update -:: %spot: contact page with peer -:: %wipe: contact deleted +:: %wipe: contact page delete :: %peer: peer update :: +$ news-1 $% [%self con=contact-1] - [%page =cid con=contact-1] - [%wipe =cid] - [%spot =cid who=(unit ship)] + [%page =kip con=contact-1 mod=contact-1] + [%wipe =kip] [%peer who=ship con=contact-1] == +| %version diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index e5750fa8..f4a20bfd 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -237,7 +237,7 @@ ~[nickname+text/'Sun' bio+text/'It is bright today'] :: =/ =news-1 - [%page 0v1 con-1] + [%page id+0v1 ~ con-1] =/ mypage=^page [p=~ q=con-1] =/ edit-1 con-1 @@ -247,9 +247,9 @@ ;< caz=(list card) b (do-watch /v1/news) :: ;< ~ b (set-src our.bowl) - :: %edit new contact page + :: create new contact page :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit 0v1 con-1])) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v1 con-1])) :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz @@ -257,7 +257,7 @@ == :: peek page in the book: new contact page is found :: - ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/0v1) + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/id/0v1) =/ =cage (need (need peek)) %+ ex-equal !> [%contact-page-1 q.cage] From f8f328d7d6cdb5d4e487866c68daf8e7d74bec9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 9 Sep 2024 13:15:12 +0800 Subject: [PATCH 11/44] contacts: move helper core to /lib --- desk/app/contacts.hoon | 407 +++-------------------------------------- desk/lib/contacts.hoon | 365 ++++++++++++++++++++++++++++++++++++ 2 files changed, 388 insertions(+), 384 deletions(-) create mode 100644 desk/lib/contacts.hoon diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index e7357f0f..39b3aa83 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -1,5 +1,6 @@ /- *contacts /+ default-agent, dbug, verb +/+ *contacts :: performance, keep warm /+ contacts-json :: @@ -70,370 +71,6 @@ :: |% :: -+| %help -:: -:: +cy: contact map engine -:: -++ cy - |_ c=contact-1 - :: +get: get typed value - :: - ++ get - |* [key=@tas typ=value-type-1] - ^- (unit _p:*$>(_typ value-1)) - =/ val=(unit value-1) (~(get by c) key) - ?~ val ~ - ?~ u.val !! - ~| "{} expected at {}" - :: XX Hoon compiler really needs to eat more fish - :: ?> ?=($>(_typ value-1) -.u.val) - :: +.u.val - :: - ?- typ - %text ?>(?=(%text -.u.val) (some p.u.val)) - %date ?>(?=(%date -.u.val) (some p.u.val)) - %tint ?>(?=(%tint -.u.val) (some p.u.val)) - %ship ?>(?=(%ship -.u.val) (some p.u.val)) - %look ?>(?=(%look -.u.val) (some p.u.val)) - %cult ?>(?=(%cult -.u.val) (some p.u.val)) - %set ?>(?=(%set -.u.val) (some p.u.val)) - == - :: +gos: got specialized to set - :: - ++ gos - |* [key=@tas typ=value-type-1] - :: XX make Hoon compiler smarter - :: to be able to specialize to uniform set of - :: type typ. - :: =* vat $>(_typ value-1) - :: ^- (set _+:*vat) - :: - =/ val=value-1 (~(got by c) key) - ?~ val !! - ~| "set expected at {}" - ?> ?=(%set -.val) - p.val - :: +gut: got with default - :: - ++ gut - |* [key=@tas def=value-1] - ^+ +.def - =/ val=value-1 (~(gut by c) key ~) - ?~ val - +.def - ~| "{<-.def>} expected at {}" - :: XX wish for Hoon compiler to be smarter. - :: this results in fish-loop. - :: ?+ -.def !! - :: %text ?>(?=(%text -.val) +.val) - :: == - :: ?> ?=(_-.def -.val) - ?- -.val - %text ?>(?=(%text -.def) p.val) - %date ?>(?=(%date -.def) p.val) - %tint ?>(?=(%tint -.def) p.val) - %ship ?>(?=(%ship -.def) p.val) - %look ?>(?=(%look -.def) p.val) - %cult ?>(?=(%cult -.def) p.val) - %set ?>(?=(%set -.def) p.val) - == - :: +gub: got with bunt default - :: - ++ gub - |* [key=@tas typ=value-type-1] - ^+ +:*$>(_typ value-1) - =/ val=value-1 (~(gut by c) key ~) - ?~ val - ?+ typ !! - %text p:*$>(%text value-1) - %date p:*$>(%date value-1) - %tint p:*$>(%tint value-1) - %ship p:*$>(%ship value-1) - %look p:*$>(%look value-1) - %cult p:*$>(%cult value-1) - %set p:*$>(%set value-1) - == - :: ~| "{} expected to be {<-.def>}" - :: XX wish for Hoon compiler to be smarter. - :: this results in fish-loop. - :: ?+ -.def !! - :: %text ?>(?=(%text -.val) +.val) - :: == - :: ?> ?=(_-.def -.val) - :: - ?- typ - %text ?>(?=(%text -.val) p.val) - %date ?>(?=(%date -.val) p.val) - %tint ?>(?=(%tint -.val) p.val) - %ship ?>(?=(%ship -.val) p.val) - %look ?>(?=(%look -.val) p.val) - %cult ?>(?=(%cult -.val) p.val) - %set ?>(?=(%set -.val) p.val) - == - -- -++ do-edit do-edit-0 -++ do-edit-0 - |= [c=contact-0 f=field-0] - ^+ c - ?- -.f - %nickname c(nickname nickname.f) - %bio c(bio bio.f) - %status c(status status.f) - %color c(color color.f) - :: - %avatar ~| "cannot add a data url to avatar!" - ?> ?| ?=(~ avatar.f) - !=('data:' (end 3^5 u.avatar.f)) - == - c(avatar avatar.f) - :: - %cover ~| "cannot add a data url to cover!" - ?> ?| ?=(~ cover.f) - !=('data:' (end 3^5 u.cover.f)) - == - c(cover cover.f) - :: - %add-group c(groups (~(put in groups.c) flag.f)) - :: - %del-group c(groups (~(del in groups.c) flag.f)) - == -++ do-edit-1 - |= [con=contact-1 edit=(map @tas value-1)] - ^+ con - =/ don (~(uni by con) edit) - :: XX are these checks neccessary? - :: if so, we need to introduce link field. - :: - =+ avatar=(~(get cy don) %avatar %text) - ?: ?& ?=(^ avatar) - =('data:' (end 3^5 u.avatar)) - == - ~| "cannot add a data url to avatar" !! - =+ cover=(~(get cy don) %cover %text) - ?: ?& ?=(^ cover) - !=('data:' (end 3^5 u.cover)) - == - ~| "cannot add a data url to cover" !! - :: - don -:: +to-contact-1: convert contact-0 -:: -++ to-contact-1 - |= c=contact-0 - ^- contact-1 - ~& contact-0-to-1+c - =/ o=contact-1 - %- malt - ^- (list (pair @tas value-1)) - :~ nickname+text/nickname.c - bio+text/bio.c - status+text/status.c - color+tint/color.c - == - =? o ?=(^ avatar.c) - (~(put by o) %avatar text/u.avatar.c) - =? o ?=(^ cover.c) - (~(put by o) %cover text/u.cover.c) - =? o !?=(~ groups.c) - %+ ~(put by o) %groups - :- %set - %- ~(run in groups.c) - |= =flag:g - cult/flag - o -:: +to-contact-0: convert contact-1 -:: -++ to-contact-0 - |= c=contact-1 - ^- $@(~ contact-0) - ?~ c ~ - =| o=contact-0 - %= o - nickname - (~(gub cy c) %nickname %text) - bio - (~(gut cy c) %bio text/'') - status - (~(gut cy c) %status text/'') - color - (~(gut cy c) %color tint/0x0) - avatar - :: XX prohibit data: link - (~(get cy c) %avatar %text) - cover - :: XX prohibit data: link - (~(get cy c) %cover %text) - groups - =/ groups - (~(get cy c) %groups %set) - ?~ groups ~ - ^- (set flag:g) - %- ~(run in u.groups) - |= val=value-1 - ?> ?=(%cult -.val) - p.val - == -:: +contact-mod: merge contacts -:: -++ contact-mod - |= [c=contact-1 mod=contact-1] - (~(uni by c) mod) -:: +to-profile-1: convert profile-0 -:: -++ to-profile-1 - |= o=profile-0 - ^- profile-1 - [wen.o ?~(con.o ~ (to-contact-1 con.o))] -:: +to-profile-0: convert profile-1 -:: -++ to-profile-0 - |= p=profile-1 - ^- profile-0 - [wen.p (to-contact-0 con.p)] -:: -++ to-profile-0-mod - |= [p=profile-1 mod=contact-1] - ^- profile-0 - [wen.p (to-contact-0 (contact-mod con.p mod))] -:: -++ to-foreign-0 - |= f=foreign-1 - ^- foreign-0 - [?~(for.f ~ (to-profile-0 for.f)) sag.f] -:: +to-foreign-0-mod: convert foreign-1 with contact overlay -:: -++ to-foreign-0-mod - |= [f=foreign-1 mod=contact-1] - ^- foreign-0 - [?~(for.f ~ (to-profile-0-mod for.f mod)) sag.f] -:: +foreign-mod: fuse peer contact with overlay -:: -++ foreign-mod - |= [far=foreign-1 mod=contact-1] - ^- foreign-1 - ?~ for.far - far - far(con.for (contact-mod con.for.far mod)) -:: +foreign-contact: grab foreign contact -:: -++ foreign-contact - |= far=foreign-1 - ^- contact-1 - ?~(for.far ~ con.for.far) -:: +to-rolodex-1: convert rolodex-0 -:: -:: ++ to-rolodex-1 -:: |= [eny=@uvJ r=rolodex-0] -:: ^- rolodex-1 -:: %- ~(rep by r) -:: |= $: [=ship raf=foreign-0] -:: acc=rolodex-1 -:: == -:: =+ cid=(gen-cid eny book.acc) -:: =/ far=foreign-1 -:: ?~ for.raf -:: [~ sag.raf] -:: [(some cid) sag.raf] -:: %_ acc -:: book -:: ?~ for.raf book.acc -:: ?~ con.for.raf -:: (~(put by book.acc) cid *page) -:: %+ ~(put by book.acc) -:: cid -:: ^- page -:: [[wen.for.raf (to-contact-1 con.for.raf)] ~] -:: net -:: (~(put by net.acc) ship far) -:: == -:: -++ to-edit-1 - |= edit-0=(list field-0) - ^- (map @tas value-1) - =; [edit-1=(map @tas value-1) groups=(set $>(%cult value-1))] - ?~ groups - edit-1 - (~(put by edit-1) %groups set/groups) - :: - %+ roll edit-0 - |= $: fed=field-0 - acc=(map @tas value-1) - gan=(set $>(%cult value-1)) - == - :: - ^+ [acc gan] - :: XX improve this by taking out :_ gan - :: outside - ?- -.fed - :: - %nickname - :_ gan - %+ ~(put by acc) - %nickname - text/nickname.fed - :: - %bio - :_ gan - %+ ~(put by acc) - %bio - text/bio.fed - :: - %status - :_ gan - %+ ~(put by acc) - %status - text/status.fed - :: - %color - :_ gan - %+ ~(put by acc) - %color - tint/color.fed - :: - %avatar - ?~ avatar.fed [acc gan] - :_ gan - %+ ~(put by acc) - %avatar - look/u.avatar.fed - :: - %cover - ?~ cover.fed [acc gan] - :_ gan - %+ ~(put by acc) - %cover - look/u.cover.fed - :: - %add-group - :- acc - (~(put in gan) [%cult flag.fed]) - :: - %del-group - :- acc - (~(del in gan) [%cult flag.fed]) - == - -++ to-action-1 - :: o=$<(%meet action-0) - |= o=action-0 - ^- action-1 - ?- -.o - %anon [%anon ~] - %edit [%self (to-edit-1 p.o)] - :: - :: old %meet is now a no-op - %meet [%meet ~] - %heed [%meet p.o] - %drop [%drop p.o] - %snub [%snub p.o] - == -:: -++ mono - |= [old=@da new=@da] - ^- @da - ?: (lth old new) new - (add old ^~((rsh 3^2 ~s1))) -:: +| %state :: :: namespaced to avoid accidental direct reference @@ -601,10 +238,6 @@ :: peer overlay lost :: =? cor &(?=(ship kip) !?=(~ q.page)) - :: =/ peer=foreign-1 - :: ~| unknown-peer+u.who - :: (~(got by peers) kip) - :: :: v0 peer contact is modified %+ p-news-0 kip (to-contact-0 p.page) @@ -615,9 +248,12 @@ |= [who=ship con=contact-1 mod=contact-1] =. book (~(put by book) who con mod) - =. cor - %+ p-news-0 who - (to-contact-0 (~(uni by con) mod)) + :: XX think about this logic: rolodex-0 + :: is essentially peers now. + :: + :: =. cor + :: %+ p-news-0 who + :: (to-contact-0 (~(uni by con) mod)) (p-news [%page who con mod]) :: ++ p-init-0 @@ -697,11 +333,18 @@ :: %dead ?: new cor =. peers (~(del by peers) who) + =/ page=(unit page) + (~(get by book) who) :: :: this is not quite right, reflecting *total* deletion :: as *contact* deletion. but it's close, and keeps /news simpler :: =. cor (p-news-0:pub who ~) + :: peer is a contact, update page + :: + =? cor ?=(^ page) + =. book (~(put by book) who u.page(p ~)) + (p-news:pub %page who ~ q.u.page) (p-news:pub [%peer who ~]) == :: @@ -745,9 +388,9 @@ for +.u cor =. cor (p-news-0:pub who (to-contact-0 con.u)) + =/ page=(unit page) (~(get by book) who) :: update peer contact :: - =/ page=(unit page) (~(get by book) who) =? cor ?=(^ page) ?: =(p.u.page con.u) cor =. book (~(put by book) who u.page(p con.u)) @@ -985,8 +628,7 @@ :: /x/v1/book -> $book :: /x/v1/book/her=@p -> $page :: /x/v1/book/id/cid=@uv -> $page - :: /x/v1/peer/her=@p -> $foreign-1 - :: /x/v1/contact/her=@p -> $contact-1 + :: /x/v1/peer/her=@p -> $contact-1 :: ++ peek |= pat=(pole knot) @@ -1048,22 +690,19 @@ ``contact-page-1+!>(`^page`u.page) :: [%x %v1 %peer her=@p ~] + :: + :: not a peer ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] + :: + :: peer not found ?~ far=(~(get by peers) u.who) [~ ~] - ``foreign-1+!>(u.far) - :: - [%x %v1 %contact her=@p ~] - ?~ who=`(unit @p)`(slaw %p her.pat) - [~ ~] - =/ page=(unit page) - (~(get by book) u.who) :: - :: peer not in the contact book - ?~ page + :: peer has no profile + ?~ for.u.far [~ ~] - ``contact-1+!>((contact-mod u.page)) + ``contact-1+!>(con.for.u.far) == :: ++ peer diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon new file mode 100644 index 00000000..25afa2e6 --- /dev/null +++ b/desk/lib/contacts.hoon @@ -0,0 +1,365 @@ +/- *contacts +|% +:: +:: +cy: contact map engine +:: +++ cy + |_ c=contact-1 + :: +get: get typed value + :: + ++ get + |* [key=@tas typ=value-type-1] + ^- (unit _p:*$>(_typ value-1)) + =/ val=(unit value-1) (~(get by c) key) + ?~ val ~ + ?~ u.val !! + ~| "{} expected at {}" + :: XX Hoon compiler really needs to eat more fish + :: ?> ?=($>(_typ value-1) -.u.val) + :: +.u.val + :: + ?- typ + %text ?>(?=(%text -.u.val) (some p.u.val)) + %date ?>(?=(%date -.u.val) (some p.u.val)) + %tint ?>(?=(%tint -.u.val) (some p.u.val)) + %ship ?>(?=(%ship -.u.val) (some p.u.val)) + %look ?>(?=(%look -.u.val) (some p.u.val)) + %cult ?>(?=(%cult -.u.val) (some p.u.val)) + %set ?>(?=(%set -.u.val) (some p.u.val)) + == + :: +gos: got specialized to set + :: + ++ gos + |* [key=@tas typ=value-type-1] + :: XX make Hoon compiler smarter + :: to be able to specialize to uniform set of + :: type typ. + :: =* vat $>(_typ value-1) + :: ^- (set _+:*vat) + :: + =/ val=value-1 (~(got by c) key) + ?~ val !! + ~| "set expected at {}" + ?> ?=(%set -.val) + p.val + :: +gut: got with default + :: + ++ gut + |* [key=@tas def=value-1] + ^+ +.def + =/ val=value-1 (~(gut by c) key ~) + ?~ val + +.def + ~| "{<-.def>} expected at {}" + :: XX wish for Hoon compiler to be smarter. + :: this results in fish-loop. + :: ?+ -.def !! + :: %text ?>(?=(%text -.val) +.val) + :: == + :: ?> ?=(_-.def -.val) + ?- -.val + %text ?>(?=(%text -.def) p.val) + %date ?>(?=(%date -.def) p.val) + %tint ?>(?=(%tint -.def) p.val) + %ship ?>(?=(%ship -.def) p.val) + %look ?>(?=(%look -.def) p.val) + %cult ?>(?=(%cult -.def) p.val) + %set ?>(?=(%set -.def) p.val) + == + :: +gub: got with bunt default + :: + ++ gub + |* [key=@tas typ=value-type-1] + ^+ +:*$>(_typ value-1) + =/ val=value-1 (~(gut by c) key ~) + ?~ val + ?+ typ !! + %text p:*$>(%text value-1) + %date p:*$>(%date value-1) + %tint p:*$>(%tint value-1) + %ship p:*$>(%ship value-1) + %look p:*$>(%look value-1) + %cult p:*$>(%cult value-1) + %set p:*$>(%set value-1) + == + :: ~| "{} expected to be {<-.def>}" + :: XX wish for Hoon compiler to be smarter. + :: this results in fish-loop. + :: ?+ -.def !! + :: %text ?>(?=(%text -.val) +.val) + :: == + :: ?> ?=(_-.def -.val) + :: + ?- typ + %text ?>(?=(%text -.val) p.val) + %date ?>(?=(%date -.val) p.val) + %tint ?>(?=(%tint -.val) p.val) + %ship ?>(?=(%ship -.val) p.val) + %look ?>(?=(%look -.val) p.val) + %cult ?>(?=(%cult -.val) p.val) + %set ?>(?=(%set -.val) p.val) + == + -- +++ do-edit do-edit-0 +++ do-edit-0 + |= [c=contact-0 f=field-0] + ^+ c + ?- -.f + %nickname c(nickname nickname.f) + %bio c(bio bio.f) + %status c(status status.f) + %color c(color color.f) + :: + %avatar ~| "cannot add a data url to avatar!" + ?> ?| ?=(~ avatar.f) + !=('data:' (end 3^5 u.avatar.f)) + == + c(avatar avatar.f) + :: + %cover ~| "cannot add a data url to cover!" + ?> ?| ?=(~ cover.f) + !=('data:' (end 3^5 u.cover.f)) + == + c(cover cover.f) + :: + %add-group c(groups (~(put in groups.c) flag.f)) + :: + %del-group c(groups (~(del in groups.c) flag.f)) + == +++ do-edit-1 + |= [con=contact-1 edit=(map @tas value-1)] + ^+ con + =/ don (~(uni by con) edit) + :: XX are these checks neccessary? + :: if so, we need to introduce link field. + :: + =+ avatar=(~(get cy don) %avatar %text) + ?: ?& ?=(^ avatar) + =('data:' (end 3^5 u.avatar)) + == + ~| "cannot add a data url to avatar" !! + =+ cover=(~(get cy don) %cover %text) + ?: ?& ?=(^ cover) + !=('data:' (end 3^5 u.cover)) + == + ~| "cannot add a data url to cover" !! + :: + don +:: +to-contact-1: convert contact-0 +:: +++ to-contact-1 + |= c=contact-0 + ^- contact-1 + ~& contact-0-to-1+c + =/ o=contact-1 + %- malt + ^- (list (pair @tas value-1)) + :~ nickname+text/nickname.c + bio+text/bio.c + status+text/status.c + color+tint/color.c + == + =? o ?=(^ avatar.c) + (~(put by o) %avatar text/u.avatar.c) + =? o ?=(^ cover.c) + (~(put by o) %cover text/u.cover.c) + =? o !?=(~ groups.c) + %+ ~(put by o) %groups + :- %set + %- ~(run in groups.c) + |= =flag:g + cult/flag + o +:: +to-contact-0: convert contact-1 +:: +++ to-contact-0 + |= c=contact-1 + ^- $@(~ contact-0) + ?~ c ~ + =| o=contact-0 + %= o + nickname + (~(gub cy c) %nickname %text) + bio + (~(gut cy c) %bio text/'') + status + (~(gut cy c) %status text/'') + color + (~(gut cy c) %color tint/0x0) + avatar + :: XX prohibit data: link + (~(get cy c) %avatar %text) + cover + :: XX prohibit data: link + (~(get cy c) %cover %text) + groups + =/ groups + (~(get cy c) %groups %set) + ?~ groups ~ + ^- (set flag:g) + %- ~(run in u.groups) + |= val=value-1 + ?> ?=(%cult -.val) + p.val + == +:: +contact-mod: merge contacts +:: +++ contact-mod + |= [c=contact-1 mod=contact-1] + (~(uni by c) mod) +:: +to-profile-1: convert profile-0 +:: +++ to-profile-1 + |= o=profile-0 + ^- profile-1 + [wen.o ?~(con.o ~ (to-contact-1 con.o))] +:: +to-profile-0: convert profile-1 +:: +++ to-profile-0 + |= p=profile-1 + ^- profile-0 + [wen.p (to-contact-0 con.p)] +:: +++ to-profile-0-mod + |= [p=profile-1 mod=contact-1] + ^- profile-0 + [wen.p (to-contact-0 (contact-mod con.p mod))] +:: +++ to-foreign-0 + |= f=foreign-1 + ^- foreign-0 + [?~(for.f ~ (to-profile-0 for.f)) sag.f] +:: +to-foreign-0-mod: convert foreign-1 with contact overlay +:: +++ to-foreign-0-mod + |= [f=foreign-1 mod=contact-1] + ^- foreign-0 + [?~(for.f ~ (to-profile-0-mod for.f mod)) sag.f] +:: +foreign-mod: fuse peer contact with overlay +:: +++ foreign-mod + |= [far=foreign-1 mod=contact-1] + ^- foreign-1 + ?~ for.far + far + far(con.for (contact-mod con.for.far mod)) +:: +foreign-contact: grab foreign contact +:: +++ foreign-contact + |= far=foreign-1 + ^- contact-1 + ?~(for.far ~ con.for.far) +:: +to-rolodex-1: convert rolodex-0 +:: +:: ++ to-rolodex-1 +:: |= [eny=@uvJ r=rolodex-0] +:: ^- rolodex-1 +:: %- ~(rep by r) +:: |= $: [=ship raf=foreign-0] +:: acc=rolodex-1 +:: == +:: =+ cid=(gen-cid eny book.acc) +:: =/ far=foreign-1 +:: ?~ for.raf +:: [~ sag.raf] +:: [(some cid) sag.raf] +:: %_ acc +:: book +:: ?~ for.raf book.acc +:: ?~ con.for.raf +:: (~(put by book.acc) cid *page) +:: %+ ~(put by book.acc) +:: cid +:: ^- page +:: [[wen.for.raf (to-contact-1 con.for.raf)] ~] +:: net +:: (~(put by net.acc) ship far) +:: == +:: +++ to-edit-1 + |= edit-0=(list field-0) + ^- (map @tas value-1) + =; [edit-1=(map @tas value-1) groups=(set $>(%cult value-1))] + ?~ groups + edit-1 + (~(put by edit-1) %groups set/groups) + :: + %+ roll edit-0 + |= $: fed=field-0 + acc=(map @tas value-1) + gan=(set $>(%cult value-1)) + == + :: + ^+ [acc gan] + :: XX improve this by taking out :_ gan + :: outside + ?- -.fed + :: + %nickname + :_ gan + %+ ~(put by acc) + %nickname + text/nickname.fed + :: + %bio + :_ gan + %+ ~(put by acc) + %bio + text/bio.fed + :: + %status + :_ gan + %+ ~(put by acc) + %status + text/status.fed + :: + %color + :_ gan + %+ ~(put by acc) + %color + tint/color.fed + :: + %avatar + ?~ avatar.fed [acc gan] + :_ gan + %+ ~(put by acc) + %avatar + look/u.avatar.fed + :: + %cover + ?~ cover.fed [acc gan] + :_ gan + %+ ~(put by acc) + %cover + look/u.cover.fed + :: + %add-group + :- acc + (~(put in gan) [%cult flag.fed]) + :: + %del-group + :- acc + (~(del in gan) [%cult flag.fed]) + == + +++ to-action-1 + :: o=$<(%meet action-0) + |= o=action-0 + ^- action-1 + ?- -.o + %anon [%anon ~] + %edit [%self (to-edit-1 p.o)] + :: + :: old %meet is now a no-op + %meet [%meet ~] + %heed [%meet p.o] + %drop [%drop p.o] + %snub [%snub p.o] + == +:: +++ mono + |= [old=@da new=@da] + ^- @da + ?: (lth old new) new + (add old ^~((rsh 3^2 ~s1))) +-- From 6c21ce9819bb6d5c8c15e6644e7d66e3f69fa29a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 9 Sep 2024 13:15:34 +0800 Subject: [PATCH 12/44] contacts: test agent --- desk/sur/contacts.hoon | 2 +- desk/tests/app/contacts.hoon | 322 ++++++++++++++++++++++++++++++----- 2 files changed, 278 insertions(+), 46 deletions(-) diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 1ba39a95..ca9cbb70 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -124,7 +124,7 @@ :: $rolodex-1: rolodex :: :: .book: contact book -:: .peers: network contacts +:: .peers: network peers :: +$ rolodex-1 $: =book diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index f4a20bfd..79383d65 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -1,5 +1,6 @@ /- *contacts /+ *test-agent +/+ c=contacts /= contacts-agent /app/contacts =* agent contacts-agent :: @@ -13,9 +14,9 @@ ++ tick ^~((rsh 3^2 ~s1)) +| %poke-0 :: -:: +test-poke-anon-0: v0 delete the profile +:: +test-poke-0-anon: v0 delete the profile :: -++ test-poke-anon-0 +++ test-poke-0-anon %- eval-mare =/ m (mare ,~) =* b bind:m @@ -61,9 +62,9 @@ (ex-fact ~[/news] %contact-news !>([our.bowl ~])) (ex-fact ~[/v1/news] %contact-news-1 !>([%self ~])) == -:: +test-poke-edit-0: v0 edit the profile +:: +test-poke-0-edit: v0 edit the profile :: -++ test-poke-edit-0 +++ test-poke-0-edit %- eval-mare =/ m (mare ,~) =* b bind:m @@ -110,19 +111,91 @@ == :: +test-poke-meet-0: v0 meet a peer :: -:: ++ test-poke-meet-0 -:: %- eval-mare -:: =/ m (mare ,~) -:: =* b bind:m -:: ^- form:m -:: ;< caz=(list card) b (do-init %contacts contacts-agent) -:: ;< =bowl b get-bowl -:: :: v0 %meet is no-op -:: :: -:: ;< caz=(list card) b (do-poke %contact-action !>([%meet ~[~sun]])) -:: (ex-cards caz ~) +++ test-poke-0-meet + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: v0 %meet is no-op + :: + ;< caz=(list card) b (do-poke %contact-action !>([%meet ~[~sun]])) + (ex-cards caz ~) +:: +test-poke-heed-0: v0 heed a peer :: +++ test-poke-0-heed + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: v0 %heed is the new %meet + :: + ;< caz=(list card) b (do-poke %contact-action !>([%heed ~[~sun]])) + %+ ex-cards caz + :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) + (ex-fact ~[/news] contact-news+!>([~sun ~])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun ~])) + == +| %poke +:: +test-poke-anon: delete the profile +:: +++ test-poke-anon + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-1=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] + :: + =/ edit-1 con-1 + :: foreign subscriber to /contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /v1/contact) + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /v1/news) + :: + ;< ~ b (set-src our.bowl) + :: edit the profile + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%self con-1])) + :: delete the profile + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%anon ~])) + :: contact update is published on /v1/contact + :: news is published on /news, /v1/news + :: + ;< ~ b %+ ex-cards caz + :~ (ex-fact ~ %contact-update !>([%full (add now.bowl tick) ~])) + (ex-fact ~[/v1/contact] %contact-update-1 !>([%full (add now.bowl tick) ~])) + (ex-fact ~[/news] %contact-news !>([our.bowl ~])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%self ~])) + == + :: v0 profile is empty + :: + ;< peek=(unit (unit cage)) b + (get-peek /x/contact/(scot %p our.bowl)) + ;< ~ b + %+ ex-equal + !>((need peek)) + !>(~) + :: profile is empty + :: + ;< peek=(unit (unit cage)) b + (get-peek /x/v1/self) + %+ ex-equal + !>((need peek)) + !>(~) :: +test-poke-self: change the profile :: ++ test-poke-self @@ -165,9 +238,9 @@ (ex-fact ~[/news] %contact-news !>([our.bowl con-0])) (ex-fact ~[/v1/news] %contact-news-1 !>([%self con-1])) == -:: +test-poke-anon: delete the profile +:: +test-poke-page: create new contact page :: -++ test-poke-anon +++ test-poke-page %- eval-mare =/ m (mare ,~) =* b bind:m @@ -178,49 +251,37 @@ =/ con-1=contact-1 %- malt ^- (list (pair @tas value-1)) - ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] - :: - =/ edit-1 con-1 - :: foreign subscriber to /contact + ~[nickname+text/'Sun' bio+text/'It is bright today'] :: - ;< ~ b (set-src ~sun) - ;< caz=(list card) b (do-watch /v1/contact) + =/ =news-1 + [%page id+0v1 ~ con-1] + =/ mypage=^page + [p=~ q=con-1] :: local subscriber to /news :: ;< ~ b (set-src our.bowl) ;< caz=(list card) b (do-watch /v1/news) :: ;< ~ b (set-src our.bowl) - :: edit the profile - :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%self con-1])) - :: delete the profile + :: create new contact page :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%anon ~])) - :: contact update is published on /v1/contact - :: news is published on /news, /v1/news + ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v1 con-1])) + :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz - :~ (ex-fact ~ %contact-update !>([%full (add now.bowl tick) ~])) - (ex-fact ~[/v1/contact] %contact-update-1 !>([%full (add now.bowl tick) ~])) - (ex-fact ~[/news] %contact-news !>([our.bowl ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%self ~])) + :~ (ex-fact ~[/v1/news] %contact-news-1 !>(news-1)) == - :: v0 profile is empty + :: peek page in the book: new contact page is found :: - ;< peek=(unit (unit cage)) b - (get-peek /x/contact/(scot %p our.bowl)) + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/id/0v1) + =/ =cage (need (need peek)) ;< ~ b %+ ex-equal - !>((need peek)) - !>(~) - :: profile is empty + !> [%contact-page-1 q.cage] + !> [%contact-page-1 !>(mypage)] + :: fail to create duplicate page :: - ;< peek=(unit (unit cage)) b - (get-peek /x/v1/self) - %+ ex-equal - !>((need peek)) - !>(~) + %- ex-fail (do-poke %contact-action-1 !>([%page 0v1 con-1])) :: +test-poke-edit: edit the contact book :: ++ test-poke-edit @@ -262,6 +323,177 @@ %+ ex-equal !> [%contact-page-1 q.cage] !> [%contact-page-1 !>(mypage)] +:: +++ test-poke-spot-wipe + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-sun=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /news) + :: meet ~sun + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + :: ~sun publishes his contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + == + :: ~sun appears in peers + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> [%contact-1 q.cag] + !> [%contact-1 !>(con-sun)] + ;< ~ b (set-src ~sun) + :: ~sun is added to contacts + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) + == + :: ~sun contact page is edited + :: + =/ con-mod=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Bright Sun' avatar+text/'https://sun.io/sun.png'] + ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit ~sun con-mod])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun con-mod])) + == + :: despite the edit, ~sun peer contact is unchanged + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> [%contact-1 q.cag] + !> [%contact-1 !>(con-sun)] + :: however, ~sun's contact book page is changed + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> [%contact-page-1 q.cag] + !> [%contact-page-1 !>(`page:c`[con-sun con-mod])] + :: ~sun contact page is deleted + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%wipe ~[~sun]])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%wipe ~sun])) + == + :: ~sun contact page is removed + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) + ;< ~ b (ex-equal !>(peek) !>([~ ~])) + :: (ex-equal !>(2) !>(2)) + :: despite the removal, ~sun peer contact is unchanged + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + %+ ex-equal + !> [%contact-1 q.cag] + !> [%contact-1 !>(con-sun)] +:: +++ test-poke-drop + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-sun=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /news) + :: meet ~sun + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + :: ~sun publishes his contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + == + :: ~sun appears in peers + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> [%contact-1 q.cag] + !> [%contact-1 !>(con-sun)] + ;< ~ b (set-src ~sun) + :: ~sun is added to contacts + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) + == + :: ~sun contact page is edited + :: + =/ con-mod=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Bright Sun' avatar+text/'https://sun.io/sun.png'] + ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit ~sun con-mod])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun con-mod])) + == + :: ~sun is dropped + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%drop ~[~sun]])) + ;< ~ b + %+ ex-cards caz + :~ (ex-task /contact [~sun %contacts] %leave ~) + (ex-fact ~[/news] %contact-news !>([~sun ~])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun ~ con-mod])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun ~])) + == + :: ~sun is not found in peers + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + %+ ex-equal + !> peek + !> [~ ~] :: XX test spot of two different pages to the same ship :: +| %peek-0 :: +test-peek-0-all: v0 scry /all From fccb783c48759927c329a9d872a1c4b374ed55ce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 9 Sep 2024 16:24:06 +0800 Subject: [PATCH 13/44] contacts: more tests --- desk/app/contacts.hoon | 14 +- desk/lib/contacts.hoon | 1 + desk/tests/app/contacts.hoon | 239 +++++++++++++++++++++++++++++------ 3 files changed, 212 insertions(+), 42 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 39b3aa83..d5b07d1c 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -688,6 +688,14 @@ ?~ page [~ ~] ``contact-page-1+!>(`^page`u.page) + [%x %v1 %contact her=@p ~] + ?~ who=`(unit @p)`(slaw %p her.pat) + [~ ~] + ?~ far=(~(get by peers) u.who) + [~ ~] + ?~ page=(~(get by book) u.who) + ``contact-1+!>(`contact-1`?~(for.u.far ~ con.for.u.far)) + ``contact-1+!>((contact-mod u.page)) :: [%x %v1 %peer her=@p ~] :: @@ -709,13 +717,11 @@ |= pat=(pole knot) ^+ cor ?+ pat ~|(bad-watch-path+pat !!) - :: + :: v0 [%contact ~] (p-init-0:pub ~) [%contact %at wen=@ ~] (p-init-0:pub `(slav %da wen.pat)) [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) - :: XX confirm that giving a fact in a gall agent on ~ outside of - :: on-watch does nothing (subs returns ~ on empty subscriber) - :: + :: v1 [%v1 %contact ~] (p-init:pub ~) [%v1 %contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) [%v1 %news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 25afa2e6..8471f8b6 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -206,6 +206,7 @@ :: ++ contact-mod |= [c=contact-1 mod=contact-1] + ^- contact-1 (~(uni by c) mod) :: +to-profile-1: convert profile-0 :: diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 79383d65..3f06a8fd 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -6,12 +6,12 @@ :: |% +| %help +++ tick ^~((rsh 3^2 ~s1)) ++ mono |= [old=@da new=@da] ^- @da ?: (lth old new) new - (add old ^~((rsh 3^2 ~s1))) -++ tick ^~((rsh 3^2 ~s1)) + (add old tick) +| %poke-0 :: :: +test-poke-0-anon: v0 delete the profile @@ -324,6 +324,50 @@ !> [%contact-page-1 q.cage] !> [%contact-page-1 !>(mypage)] :: +++ test-poke-meet + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-sun=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /news) + :: meet ~sun + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + :: ~sun publishes his contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + == + :: ~sun appears in peers + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> [%contact-1 q.cag] + !> [%contact-1 !>(con-sun)] + ;< ~ b (set-src ~sun) + :: meet ~sun a second time: a no-op + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + (ex-cards caz ~) +:: ++ test-poke-spot-wipe %- eval-mare =/ m (mare ,~) @@ -396,8 +440,16 @@ =/ cag=cage (need (need peek)) ;< ~ b %+ ex-equal - !> [%contact-page-1 q.cag] + !> cag !> [%contact-page-1 !>(`page:c`[con-sun con-mod])] + :: and his effective contact is changed + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/contact/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> cag + !> [%contact-1 !>((contact-mod:c con-sun con-mod))] :: ~sun contact page is deleted :: ;< caz=(list card) b (do-poke %contact-action-1 !>([%wipe ~[~sun]])) @@ -494,42 +546,153 @@ %+ ex-equal !> peek !> [~ ~] -:: XX test spot of two different pages to the same ship -:: +| %peek-0 -:: +test-peek-0-all: v0 scry /all :: -:: ++ test-peek-0-all (eval-mare (ex-equal !>(2) !>(2))) -:: +test-peek-0-contact: v0 scry /contact +++ test-poke-snub + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-sun=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /news) + :: meet ~sun + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + :: ~sun publishes his contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + == + :: ~sun is added to contacts + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) + == + :: ~sun is snubbed + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%snub ~[~sun]])) + ;< ~ b + %+ ex-cards caz + :~ (ex-task /contact [~sun %contacts] %leave ~) + == + :: ~sun modifies his contact + :: + =/ con-mod=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Bright Sun' avatar+text/'https://sun.io/sun.png'] + ;< ~ b (set-src ~sun) + :: fact fails: no subscription + :: XX extend test-agent to allow this test + :: ;< ~ b %- ex-fail + :: %- do-agent + :: :* /contact + :: [~sun %contacts] + :: %fact + :: %contact-update-1 + :: !>([%full now.bowl (~(uni by con-sun) con-mod)]) + :: == + :: ~sun is still found in peers + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + %+ ex-equal + !> cag + !> contact-1+!>(con-sun) :: -:: ++ test-peek-0-contact (eval-mare (ex-equal !>(2) !>(2))) -:: +test-poke-spot-edit: spot a peer ++| %peek +++ test-peek-0-all + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-sun=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + =/ con-mur=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Mur' bio+text/'Murky waters'] + :: meet ~sun and ~mur + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun ~mur]])) + :: ~sun publishes his contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + :: ~mur publishes his contact + :: + ;< ~ b (set-src ~mur) + ;< caz=(list card) b + (do-agent /contact [~mur %contacts] %fact %contact-update-1 !>([%full now.bowl con-mur])) + :: peek all: two peers are found + :: + ;< peek=(unit (unit cage)) b (get-peek /x/all) + =/ cag=cage (need (need peek)) + ?> ?=(%contact-rolodex p.cag) + =/ rol !<(rolodex-0 q.cag) + ;< ~ b + %+ ex-equal + !> (~(got by rol) ~sun) + !> [[now.bowl (to-contact-0:c con-sun)] %want] + %+ ex-equal + !> (~(got by rol) ~mur) + !> [[now.bowl (to-contact-0:c con-mur)] %want] + :: (ex-equal !>(2) !>(2)) :: -:: ++ test-poke-spot -:: %- eval-mare -:: =/ m (mare ,~) -:: =* b bind:m -:: ^- form:m -:: ;< caz=(list card) b (do-init %contacts contacts-agent) -:: ;< =bowl b get-bowl -:: :: -:: =/ con-1=contact-1 -:: %- malt -:: ^- (list (pair @tas value-1)) -:: ~[nickname+text/'Sun' bio+text/'It is bright today'] -:: :: -:: =/ =news-1 -:: [%page 0v1 con-1] -:: =/ edit-1 con-1 -:: :: local subscriber to /news -:: :: -:: ;< ~ b (set-src our.bowl) -:: ;< caz=(list card) b (do-watch /v1/news) -:: :: -:: ;< ~ b (set-src our.bowl) -:: :: -:: ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit 0v1 con-1])) -:: ;< caz=(list card) b (do-poke %contact-action-1 %meet) -:: %+ ex-cards caz -:: :~ (ex-fact ~[/v1/news] %contact-news-1 !>(news-1)) -:: == +++ test-peek-book + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-1=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + =/ con-2=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Mur' bio+text/'Murky waters'] + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v1 con-1])) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v2 con-2])) + :: peek book: two contacts are found + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book) + =/ cag=cage (need (need peek)) + ?> ?=(%contact-book-1 p.cag) + =/ =book !<(book q.cag) + ;< ~ b + %+ ex-equal + !> q:(~(got by book) id+0v1) + !> con-1 + %+ ex-equal + !> q:(~(got by book) id+0v2) + !> con-2 -- From 172bd9b0a5ae22eeaf0c6c6bf6329a264f423007 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 9 Sep 2024 23:10:43 +0800 Subject: [PATCH 14/44] contacts: %drop now does not alter the contact book --- desk/app/contacts.hoon | 5 ----- desk/tests/app/contacts.hoon | 19 +++++++++++++------ 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index d5b07d1c..ae9ac326 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -340,11 +340,6 @@ :: as *contact* deletion. but it's close, and keeps /news simpler :: =. cor (p-news-0:pub who ~) - :: peer is a contact, update page - :: - =? cor ?=(^ page) - =. book (~(put by book) who u.page(p ~)) - (p-news:pub %page who ~ q.u.page) (p-news:pub [%peer who ~]) == :: diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 3f06a8fd..66280644 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -537,15 +537,22 @@ %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %leave ~) (ex-fact ~[/news] %contact-news !>([~sun ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun ~ con-mod])) (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun ~])) == :: ~sun is not found in peers :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + ;< ~ b + %+ ex-equal + !> peek + !> [~ ~] + :: but his contact is not modified + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) + =/ cag=cage (need (need peek)) %+ ex-equal - !> peek - !> [~ ~] + !> cag + !> contact-page-1+!>(`page:c`[con-sun con-mod]) :: ++ test-poke-snub %- eval-mare @@ -606,7 +613,7 @@ :: :* /contact :: [~sun %contacts] :: %fact - :: %contact-update-1 + :: %contact-update-1 :: !>([%full now.bowl (~(uni by con-sun) con-mod)]) :: == :: ~sun is still found in peers @@ -654,7 +661,7 @@ =/ cag=cage (need (need peek)) ?> ?=(%contact-rolodex p.cag) =/ rol !<(rolodex-0 q.cag) - ;< ~ b + ;< ~ b %+ ex-equal !> (~(got by rol) ~sun) !> [[now.bowl (to-contact-0:c con-sun)] %want] @@ -688,7 +695,7 @@ =/ cag=cage (need (need peek)) ?> ?=(%contact-book-1 p.cag) =/ =book !<(book q.cag) - ;< ~ b + ;< ~ b %+ ex-equal !> q:(~(got by book) id+0v1) !> con-1 From 03dc397c8e3cf6b623f7197f13e093fff3466125 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 10 Sep 2024 08:20:27 +0800 Subject: [PATCH 15/44] contacts: meet unknown peers upon %spot --- desk/app/contacts.hoon | 16 +++--- desk/tests/app/contacts.hoon | 94 +++++++++++++++++++++++++++++++----- 2 files changed, 92 insertions(+), 18 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index ae9ac326..5d0758e2 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -324,10 +324,11 @@ ++ si-abet ^+ cor ?- sas - %live =. peers (~(put by peers) who [for sag]) + %live ~& live+who + =. peers (~(put by peers) who [for sag]) + ?. new cor :: NB: this assumes con.for is only set in +si-hear :: - ?. new cor =. cor (p-news-0:pub who ~) (p-news:pub [%peer who ~]) :: @@ -598,11 +599,14 @@ ?(act:base:mar %contact-action-0) (to-action-1 !<(action-0 vase)) == + ~& poke+-.act ?- -.act %anon p-anon:pub %self (p-self:pub p.act) %page (p-page:pub p.act q.act) - %spot (p-spot:pub p.act q.act) + %spot =? cor !(~(has by peers) p.act) + si-abet:si-meet:(sub p.act) + (p-spot:pub p.act q.act) %edit (p-edit:pub p.act q.act) %wipe (p-wipe:pub p.act) %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) @@ -703,9 +707,9 @@ [~ ~] :: :: peer has no profile - ?~ for.u.far - [~ ~] - ``contact-1+!>(con.for.u.far) + :: ?~ for.u.far + :: [~ ~] + ``contact-foreign-1+!>(`foreign-1`u.far) == :: ++ peer diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 66280644..2d1a9dd8 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -3,7 +3,8 @@ /+ c=contacts /= contacts-agent /app/contacts =* agent contacts-agent -:: +:: XX consider structuring tests better +:: with functional 'micro' strands |% +| %help ++ tick ^~((rsh 3^2 ~s1)) @@ -359,8 +360,8 @@ =/ cag=cage (need (need peek)) ;< ~ b %+ ex-equal - !> [%contact-1 q.cag] - !> [%contact-1 !>(con-sun)] + !> cag + !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: meet ~sun a second time: a no-op :: @@ -368,6 +369,75 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) (ex-cards caz ~) :: +++ test-poke-spot-unknown + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-sun=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + :: local subscriber to /news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /news) + :: spot ~sun to contact boook: he also becomes our peer + :: + ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< ~ b + %+ ex-cards caz + :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) + (ex-fact ~[/news] %contact-news !>([~sun ~])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun ~])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun `page:c`[~ ~]])) + == + :: ~sun appears in peers + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> cag + !> contact-foreign-1+!>(`foreign-1`[~ %want]) + :: ~sun publishes his contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) + (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + == + :: ~sun contact page is edited + :: + ;< ~ b (set-src our.bowl) + =/ con-mod=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[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 + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> cag + !> [%contact-page-1 !>(`page:c`[con-sun con-mod])] + :: and his effective contact is changed + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/contact/~sun) + =/ cag=cage (need (need peek)) + %+ ex-equal + !> cag + !> [%contact-1 !>((contact-mod:c con-sun con-mod))] +:: ++ test-poke-spot-wipe %- eval-mare =/ m (mare ,~) @@ -403,8 +473,8 @@ =/ cag=cage (need (need peek)) ;< ~ b %+ ex-equal - !> [%contact-1 q.cag] - !> [%contact-1 !>(con-sun)] + !> cag + !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: ~sun is added to contacts :: @@ -432,8 +502,8 @@ =/ cag=cage (need (need peek)) ;< ~ b %+ ex-equal - !> [%contact-1 q.cag] - !> [%contact-1 !>(con-sun)] + !> cag + !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) :: however, ~sun's contact book page is changed :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) @@ -468,8 +538,8 @@ ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) =/ cag=cage (need (need peek)) %+ ex-equal - !> [%contact-1 q.cag] - !> [%contact-1 !>(con-sun)] + !> cag + !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) :: ++ test-poke-drop %- eval-mare @@ -506,8 +576,8 @@ =/ cag=cage (need (need peek)) ;< ~ b %+ ex-equal - !> [%contact-1 q.cag] - !> [%contact-1 !>(con-sun)] + !> cag + !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: ~sun is added to contacts :: @@ -622,7 +692,7 @@ =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> contact-1+!>(con-sun) + !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] ~]) :: +| %peek ++ test-peek-0-all From 7229969871ea71ced23d8685b9add8e4b894c8c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 10 Sep 2024 15:09:34 +0800 Subject: [PATCH 16/44] contacts: implement /x/v1/all scry --- desk/app/contacts.hoon | 36 +++++++++++++++++++------ desk/sur/contacts.hoon | 3 +++ desk/tests/app/contacts.hoon | 51 ++++++++++++++++++++++++++++++++++++ 3 files changed, 82 insertions(+), 8 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 5d0758e2..1383210f 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -324,8 +324,7 @@ ++ si-abet ^+ cor ?- sas - %live ~& live+who - =. peers (~(put by peers) who [for sag]) + %live =. peers (~(put by peers) who [for sag]) ?. new cor :: NB: this assumes con.for is only set in +si-hear :: @@ -599,7 +598,6 @@ ?(act:base:mar %contact-action-0) (to-action-1 !<(action-0 vase)) == - ~& poke+-.act ?- -.act %anon p-anon:pub %self (p-self:pub p.act) @@ -627,6 +625,8 @@ :: /x/v1/book -> $book :: /x/v1/book/her=@p -> $page :: /x/v1/book/id/cid=@uv -> $page + :: /x/v1/all -> (map ship contact-1) + :: /x/v1/contact/her=@p -> $contact-1 :: /x/v1/peer/her=@p -> $contact-1 :: ++ peek @@ -687,13 +687,37 @@ ?~ page [~ ~] ``contact-page-1+!>(`^page`u.page) + :: + [%x %v1 %all ~] + =| all=(map ship contact-1) + :: export all ship contacts + :: + =. all + %- ~(rep by book) + |= [[=kip =page] =_all] + ?^ kip + all + (~(put by all) kip (contact-mod page)) + :: export all peers + :: + =. all + %- ~(rep by peers) + |= [[who=ship far=foreign-1] =_all] + ?~ for.far all + ?: (~(has by all) who) all + (~(put by all) who `contact-1`con.for.far) + ?~ all + [~ ~] + ``contact-directory-1+!>(all) + :: [%x %v1 %contact her=@p ~] ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] ?~ far=(~(get by peers) u.who) [~ ~] ?~ page=(~(get by book) u.who) - ``contact-1+!>(`contact-1`?~(for.u.far ~ con.for.u.far)) + ?~ for.u.far [~ ~] + ``contact-1+!>(con.for.u.far) ``contact-1+!>((contact-mod u.page)) :: [%x %v1 %peer her=@p ~] @@ -705,10 +729,6 @@ :: peer not found ?~ far=(~(get by peers) u.who) [~ ~] - :: - :: peer has no profile - :: ?~ for.u.far - :: [~ ~] ``contact-foreign-1+!>(`foreign-1`u.far) == :: diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index ca9cbb70..8f382612 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -121,6 +121,9 @@ :: $book: contact book :: +$ book (map kip page) +:: $directory: merged contacts +:: ++$ directory (map ship contact-1) :: $rolodex-1: rolodex :: :: .book: contact book diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 2d1a9dd8..03f17a3c 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -772,4 +772,55 @@ %+ ex-equal !> q:(~(got by book) id+0v2) !> con-2 +++ test-peek-all + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-sun=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + =/ con-mur=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[nickname+text/'Mur' bio+text/'Murky waters'] + =/ con-mod=contact-1 + %- malt + ^- (list (pair @tas value-1)) + ~[avatar+text/'https://sun.io/sun.png'] + :: meet ~sun and ~mur + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun ~mur]])) + :: ~sun publishes his contact + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + :: ~sun is added to the contact book with user overlay + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun con-mod])) + :: ~mur publishes his contact + :: + ;< ~ b (set-src ~mur) + ;< caz=(list card) b + (do-agent /contact [~mur %contacts] %fact %contact-update-1 !>([%full now.bowl con-mur])) + :: peek all: two contacts are found + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/all) + =/ cag=cage (need (need peek)) + ?> ?=(%contact-directory-1 p.cag) + =/ dir !<(directory q.cag) + ;< ~ b + %+ ex-equal + !> (~(got by dir) ~sun) + !> (contact-mod:c con-sun con-mod) + %+ ex-equal + !> (~(got by dir) ~mur) + !> con-mur -- From c4efedc1d420af39aa514066557ddf7564ca9ec5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Wed, 11 Sep 2024 19:00:19 +0800 Subject: [PATCH 17/44] contacts: implement v1 json conversions --- desk/app/contacts.hoon | 6 +- desk/lib/contacts/json-0.hoon | 131 +++++++++++++++++++++++++++ desk/lib/contacts/json-1.hoon | 152 ++++++++++++++++++++++++++++++++ desk/lib/mark-warmer.hoon | 10 ++- desk/mar/contact-0.hoon | 14 +++ desk/mar/contact-1.hoon | 15 ++++ desk/mar/contact/action-1.hoon | 16 +++- desk/mar/contact/book.hoon | 14 +++ desk/mar/contact/directory.hoon | 14 +++ desk/mar/contact/news-1.hoon | 14 +++ desk/mar/contact/page-1.hoon | 14 +++ desk/mar/contact/update-0.hoon | 5 +- desk/mar/contact/update-1.hoon | 14 ++- desk/sur/contacts.hoon | 1 + 14 files changed, 409 insertions(+), 11 deletions(-) create mode 100644 desk/lib/contacts/json-0.hoon create mode 100644 desk/lib/contacts/json-1.hoon create mode 100644 desk/mar/contact-0.hoon create mode 100644 desk/mar/contact-1.hoon create mode 100644 desk/mar/contact/book.hoon create mode 100644 desk/mar/contact/directory.hoon create mode 100644 desk/mar/contact/news-1.hoon create mode 100644 desk/mar/contact/page-1.hoon diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 1383210f..84b3e574 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -2,7 +2,7 @@ /+ default-agent, dbug, verb /+ *contacts :: performance, keep warm -/+ contacts-json +/+ j0=contacts-json-0, j1=contacts-json-1 :: |% :: conventions @@ -621,11 +621,11 @@ :: :: v1 scries :: - :: /x/v1/self -> $@(~ $profile-1) + :: /x/v1/self -> $contact-1 :: /x/v1/book -> $book :: /x/v1/book/her=@p -> $page :: /x/v1/book/id/cid=@uv -> $page - :: /x/v1/all -> (map ship contact-1) + :: /x/v1/all -> $directory :: /x/v1/contact/her=@p -> $contact-1 :: /x/v1/peer/her=@p -> $contact-1 :: diff --git a/desk/lib/contacts/json-0.hoon b/desk/lib/contacts/json-0.hoon new file mode 100644 index 00000000..6f404217 --- /dev/null +++ b/desk/lib/contacts/json-0.hoon @@ -0,0 +1,131 @@ +/- c=contacts, g=groups +/+ gj=groups-json +|% +++ enjs + =, enjs:format + |% + :: XX shadowed for compat, +ship:enjs removes the ~ + :: + ++ ship + |=(her=@p n+(rap 3 '"' (scot %p her) '"' ~)) + :: + ++ action + |= a=action-0:c + ^- json + %+ frond -.a + ?- -.a + %anon ~ + %edit a+(turn p.a field) + %meet a+(turn p.a ship) + %heed a+(turn p.a ship) + %drop a+(turn p.a ship) + %snub a+(turn p.a ship) + == + :: + ++ contact + |= c=contact-0:c + ^- json + %- pairs + :~ nickname+s+nickname.c + bio+s+bio.c + status+s+status.c + color+s+(scot %ux color.c) + avatar+?~(avatar.c ~ s+u.avatar.c) + cover+?~(cover.c ~ s+u.cover.c) + :: + =- groups+a+- + %- ~(rep in groups.c) + |=([f=flag:g j=(list json)] [s+(flag:enjs:gj f) j]) + == + :: + ++ field + |= f=field-0:c + ^- json + %+ frond -.f + ?- -.f + %nickname s+nickname.f + %bio s+bio.f + %status s+status.f + %color s+(rsh 3^2 (scot %ux color.f)) :: XX confirm + %avatar ?~(avatar.f ~ s+u.avatar.f) + %cover ?~(cover.f ~ s+u.cover.f) + %add-group s+(flag:enjs:gj flag.f) + %del-group s+(flag:enjs:gj flag.f) + == + :: + ++ rolodex + |= r=rolodex-0:c + ^- json + %- pairs + %- ~(rep by r) + |= [[who=@p foreign-0:c] j=(list [@t json])] + [[(scot %p who) ?.(?=([@ ^] for) ~ (contact con.for))] j] :: XX stale flag per sub state? + :: + ++ news + |= n=news-0:c + ^- json + %- pairs + :~ who+(ship who.n) + con+?~(con.n ~ (contact con.n)) + == + -- +:: +++ dejs + =, dejs:format + |% + :: for performance, @p is serialized above to json %n (no escape) + :: for mark roundtrips, ships are parsed from either %s or %n + :: XX do this elsewhere in groups? + :: + ++ ship (se-ne %p) + ++ se-ne + |= aur=@tas + |= jon=json + ?+ jon !! + [%s *] (slav aur p.jon) + :: + [%n *] ~| bad-n+p.jon + =/ wyd (met 3 p.jon) + ?> ?& =('"' (end 3 p.jon)) + =('"' (cut 3 [(dec wyd) 1] p.jon)) + == + (slav aur (cut 3 [1 (sub wyd 2)] p.jon)) + == + :: + ++ action + ^- $-(json action-0:c) + %- of + :~ anon+ul + edit+(ar field) + meet+(ar ship) + heed+(ar ship) + drop+(ar ship) + snub+(ar ship) + == + :: + ++ contact + ^- $-(json contact-0:c) + %- ot + :~ nickname+so + bio+so + status+so + color+nu + avatar+(mu so) + cover+(mu so) + groups+(as flag:dejs:gj) + == + :: + ++ field + ^- $-(json field-0:c) + %- of + :~ nickname+so + bio+so + status+so + color+nu + avatar+(mu so) + cover+(mu so) + add-group+flag:dejs:gj + del-group+flag:dejs:gj + == + -- +-- diff --git a/desk/lib/contacts/json-1.hoon b/desk/lib/contacts/json-1.hoon new file mode 100644 index 00000000..66a72e93 --- /dev/null +++ b/desk/lib/contacts/json-1.hoon @@ -0,0 +1,152 @@ +/- c=contacts, g=groups +/+ gj=groups-json +|% +++ enjs + =, enjs:format + |% + :: XX shadowed for compat, +ship:enjs removes the ~ + :: + ++ ship + |=(her=@p n+(rap 3 '"' (scot %p her) '"' ~)) + :: + ++ cid + |= =cid:c + ^- json + s+(scot %uv cid) + :: + ++ kip + |= =kip:c + ^- json + ?@ kip + (ship kip) + (cid +.kip) + :: + ++ value + |= val=value-1:c + ^- json + ?- -.val + %text (pairs type+s/%text value+s/p.val ~) + %date (pairs type+s/%date value+s/(scot %da p.val) ~) + %tint (pairs type+s/%tint value+s/(rsh 3^2 (scot %ux p.val)) ~) + %ship (pairs type+s/%ship value+(ship p.val) ~) + %look (pairs type+s/%look value+s/p.val ~) + %cult (pairs type+s/%cult value+s/(flag:enjs:gj p.val) ~) + %set (pairs type+s/%set value+a/(turn ~(tap in p.val) value) ~) + == + :: + ++ contact + |= c=contact-1:c + ^- json + o+(~(run by c) value) + :: + ++ page + |= =page:c + ^- json + a+[(contact p.page) (contact q.page) ~] + :: +$ kip $@(@p [%id cid]) + :: +$ book (map kip page) + ++ book + |= =book:c + ^- json + =| kob=(map @ta json) + :- %o + %- ~(rep by book) + |= [[=kip:c =page:c] acc=_kob] + ?^ kip + (~(put by acc) (scot %uv +.kip) (^page page)) + (~(put by acc) (scot %p kip) (^page page)) + :: + ++ directory + |= =directory:c + ^- json + =| dir=(map @ta json) + :- %o + %- ~(rep by directory) + |= [[who=@p con=contact-1:c] acc=_dir] + (~(put by acc) (scot %p who) (contact con)) + :: + ++ news + |= n=news-1:c + ^- json + ?- -.n + %self (frond self+(contact con.n)) + %page %- pairs + :~ kip+(kip kip.n) + con+(contact con.n) + mod+(contact mod.n) + == + %wipe (frond kip+(kip kip.n)) + %peer %- pairs + :~ who+(ship who.n) + con+(contact con.n) + == + == + -- +:: +++ dejs + =, dejs:format + |% + :: + ++ ship (se %p) + :: + ++ cid + |= jon=json + ^- cid:c + ?> ?=(%s -.jon) + (slav %uv p.jon) + :: + ++ kip + |= jon=json + ^- kip:c + ?> ?=(%s -.jon) + ?: =('~' (end [3 1] p.jon)) + (ship jon) + id+(cid jon) + :: + ++ ta + |* [mas=@tas wit=fist] + |= jon=json + [mas (wit jon)] + :: + ++ value + ^- $-(json value-1:c) + |= jon=json + :: XX is there a way to do it in one go? + :: + =/ [type=@tas val=json] + %. jon + (ot text+(se %tas) value+json ~) + ?+ type !! + %text %. val (ta %text so) + %date %. val (ta %date (se %da)) + :: XX invert arguments in +cu: arguments likely + :: to be heavy should always be at the back + :: + %tint %. val + %+ ta %tint + %+ cu + |=(s=@t (slav %ux (cat 3 '0x' s))) + so + %ship %. val (ta %ship ship) + %look %. val (ta %look so) + %cult %. val (ta %cult flag:dejs:gj) + %set %. val (ta %set (as value)) + == + ++ contact + ^- $-(json contact-1:c) + (om value) + ++ action + ^- $-(json action-1:c) + %- of + :~ anon+ul + self+contact + page+(ot cid+cid contact+contact ~) + spot+(ot ship+ship contact+contact ~) + edit+(ot kip+kip contact+contact ~) + wipe+(ar kip) + meet+(ar ship) + drop+(ar ship) + snub+(ar ship) + == + -- +-- diff --git a/desk/lib/mark-warmer.hoon b/desk/lib/mark-warmer.hoon index 0bf6264f..ad40eb98 100644 --- a/desk/lib/mark-warmer.hoon +++ b/desk/lib/mark-warmer.hoon @@ -1,9 +1,15 @@ /$ rolo %contact-rolodex %json -/$ contact %contact %json +/$ contact %contact-0 %json +/$ contact-1 %contact-1 %json +/$ page-1 %contact-page-1 %json +/$ book-1 %contact-book %json +/$ dir-1 %contact-directory %json +/$ news-1 %contact-news-1 %json /$ skeins %hark-skeins %json /$ carpet %hark-carpet %json /$ blanket %hark-blanket %json /$ settings %settings-data %json -/$ creds %update %json +:: XX defunct? +:: /$ creds %update %json /$ storage %storage-update %json ~ diff --git a/desk/mar/contact-0.hoon b/desk/mar/contact-0.hoon new file mode 100644 index 00000000..b9383f83 --- /dev/null +++ b/desk/mar/contact-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-0 +|_ =contact-0:c +++ grad %noun +++ grow + |% + ++ noun contact-0 + ++ json (contact:enjs:j contact-0) + -- +++ grab + |% + ++ noun contact-0:c + -- +-- diff --git a/desk/mar/contact-1.hoon b/desk/mar/contact-1.hoon new file mode 100644 index 00000000..4418f7c0 --- /dev/null +++ b/desk/mar/contact-1.hoon @@ -0,0 +1,15 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ contact=contact-1:c +++ grad %noun +++ grow + |% + ++ noun contact + ++ json (contact:enjs:j contact) + -- +++ grab + |% + ++ noun contact-1:c + ++ json contact:dejs:j + -- +-- diff --git a/desk/mar/contact/action-1.hoon b/desk/mar/contact/action-1.hoon index 623b233e..3d8a88e1 100644 --- a/desk/mar/contact/action-1.hoon +++ b/desk/mar/contact/action-1.hoon @@ -1,2 +1,14 @@ -/= mark /mar/dummy -mark +/- c=contacts +/+ j=contacts-json-1 +|_ action=action-1:c +++ grad %noun +++ grow + |% + ++ noun action + -- +++ grab + |% + ++ noun action-1:c + ++ json action:dejs:j + -- +-- diff --git a/desk/mar/contact/book.hoon b/desk/mar/contact/book.hoon new file mode 100644 index 00000000..2de84aae --- /dev/null +++ b/desk/mar/contact/book.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ book=book:c +++ grad %noun +++ grow + |% + ++ noun book + ++ json (book:enjs:j book) + -- +++ grab + |% + ++ noun book:c + -- +-- diff --git a/desk/mar/contact/directory.hoon b/desk/mar/contact/directory.hoon new file mode 100644 index 00000000..6bdab661 --- /dev/null +++ b/desk/mar/contact/directory.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ directory=directory:c +++ grad %noun +++ grow + |% + ++ noun directory + ++ json (directory:enjs:j directory) + -- +++ grab + |% + ++ noun directory:c + -- +-- diff --git a/desk/mar/contact/news-1.hoon b/desk/mar/contact/news-1.hoon new file mode 100644 index 00000000..7671e4dc --- /dev/null +++ b/desk/mar/contact/news-1.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ news=news-1:c +++ grad %noun +++ grow + |% + ++ noun news + ++ json (news:enjs:j news) + -- +++ grab + |% + ++ noun news-1:c + -- +-- diff --git a/desk/mar/contact/page-1.hoon b/desk/mar/contact/page-1.hoon new file mode 100644 index 00000000..ca628447 --- /dev/null +++ b/desk/mar/contact/page-1.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =page:c +++ grad %noun +++ grow + |% + ++ noun page + ++ json (page:enjs:j page) + -- +++ grab + |% + ++ noun page:c + -- +-- diff --git a/desk/mar/contact/update-0.hoon b/desk/mar/contact/update-0.hoon index 3bec8608..8b7a43b6 100644 --- a/desk/mar/contact/update-0.hoon +++ b/desk/mar/contact/update-0.hoon @@ -1,5 +1,5 @@ /- c=contacts -|_ =update:c +|_ update=update-0:c ++ grad %noun ++ grow |% @@ -7,6 +7,7 @@ -- ++ grab |% - ++ noun update:c + ++ noun update-0:c + -- -- diff --git a/desk/mar/contact/update-1.hoon b/desk/mar/contact/update-1.hoon index 623b233e..d979d7a6 100644 --- a/desk/mar/contact/update-1.hoon +++ b/desk/mar/contact/update-1.hoon @@ -1,2 +1,12 @@ -/= mark /mar/dummy -mark +/- c=contacts +|_ update=update-1:c +++ grad %noun +++ grow + |% + ++ noun update + -- +++ grab + |% + ++ noun update-1:c + -- +-- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 8f382612..0e3d4fe6 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -90,6 +90,7 @@ :: :: uniform set [%set $|(p=(set value-1) unis)] + :: [%set p=(set value-1)] == :: $contact-1: contact data :: From 838634f39f9c733675b59f8af709abe7cd0472c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Fri, 13 Sep 2024 16:50:23 +0800 Subject: [PATCH 18/44] contacts: add lib-negotiate to /lib --- desk/lib/negotiate.hoon | 787 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 787 insertions(+) create mode 100644 desk/lib/negotiate.hoon diff --git a/desk/lib/negotiate.hoon b/desk/lib/negotiate.hoon new file mode 100644 index 00000000..87b00493 --- /dev/null +++ b/desk/lib/negotiate.hoon @@ -0,0 +1,787 @@ +:: negotiate: hands-off version negotiation +:: +:: v1.0.1: greenhorn ambassador +:: +:: automates negotiating poke & watch interface versions, letting the +:: underlying agent focus on talking to the outside world instead of +:: figuring out whether it can. +:: +:: usage +:: +:: to use this library, you must supply it with three things: +:: - a flag specifying whether the inner agent should be notified of version +:: negotiation events (matching & unmatching of external agents) +:: - a map of, per protocol your agent exposes, a version noun +:: - a map of, per agent name, a map of, per protocol, the version we expect +:: call this library's +agent arm with those three arguments, and then call +:: the resulting gate with your agent's door. +:: +:: this library will "capture" watches, leaves and pokes emitted by the +:: underlying agent. +:: watches will be registered as intent to subscribe. leaves rescind that +:: intent. when first attempting to open a subscription to another agent (a +:: specific $gill:gall), the library will start version negotiation with +:: that agent for each protocol configured for it. only once it has heard a +:: matching version from the remote agent for *all* protocols will the +:: library establish the subscriptions for which intent has been signalled. +:: if it hears a changed, non-matching version from a remote agent, it will +:: automatically close the subscriptions to that agent (and re-open them +:: whenever versions match again). +:: sending pokes will crash the agent if no version match has been +:: established. to avoid crashing when trying to send pokes, the inner agent +:: must take care to call +can-poke or +read-status to check, and +initiate +:: to explicitly initiate version negotiation if necessary. +:: once the library start negotiating versions with another agent, it never +:: stops listening to their versions. +:: +:: subsequent changes to the arguments given to this library will result in +:: similar subscription management behavior: we temporarily close +:: subscriptions for agents we have version mismatches with, and open ones +:: where we now do have matching versions. in upgrade scenarios, changing +:: the library arguments should generally suffice. +:: +:: if the flag at the start of the sample is set to true then, whenever we +:: start to match or stop matching with a specific gill, we send a poke to +:: the inner agent, marked %negotiate-notification, containing both a flag +:: indicating whether we now match, and the gill for which the notification +:: applies. +:: (the initial state, of not having negotiated at all, counts as "not +:: matching".) +:: +:: regardless of the value of the notify flag, subscription updates about +:: version compatibility will always be given on the following paths: +:: /~/negotiate/notify %negotiate-notifcation; [match=? =gill:gall] +:: /~/negotiate/notify/json %json; {'gill': '~ship/dude', 'match': true} +:: +:: if an agent was previously using epic, it can trivially upgrade into +:: this library by making the following changes: +:: - change its own epic version number +:: - keep exposing that on the /epic subscription endpoint +:: - remove all other epic-related negotiation logic +:: - use this library as normal +:: +|% ++$ protocol @ta ++$ version * ++$ config (map dude:gall (map protocol version)) ++$ status ?(%match %clash %await %unmet) +:: +++ initiate + |= =gill:gall + ^- card:agent:gall + [%give %fact [/~/negotiate/initiate]~ %negotiate-initiate-version !>(gill)] +:: +++ read-status + |= [bowl:gall =gill:gall] + .^ status + %gx (scot %p our) dap (scot %da now) + /~/negotiate/status/(scot %p p.gill)/[q.gill]/noun + == +:: +++ can-poke + |= [=bowl:gall =gill:gall] + ?=(%match (read-status bowl gill)) +:: +++ agent + |= [notify=? our-versions=(map protocol version) =our=config] + ^- $-(agent:gall agent:gall) + |^ agent + :: + +$ state-1 + $: %1 + ours=(map protocol version) + know=config + heed=(map [gill:gall protocol] (unit version)) + want=(map gill:gall (map wire path)) :: un-packed wires + == + :: + +$ card card:agent:gall + :: + ++ helper + |_ [=bowl:gall state-1] + +* state +<+ + ++ match + |= =gill:gall + ^- ? + ?: =([our dap]:bowl gill) & + ?~ need=(~(get by know) q.gill) & :: unversioned + %- ~(rep by u.need) ::NOTE +all:by is w/o key + |= [[p=protocol v=version] o=_&] + &(o =(``v (~(get by heed) [gill p]))) :: negotiated & matches + :: + ++ certain-mismatch + |= =gill:gall + ^- ? + ?: =([our dap]:bowl gill) | + ?~ need=(~(get by know) q.gill) | :: unversioned + %- ~(rep by u.need) + |= [[p=protocol v=version] o=_|] + =+ h=(~(get by heed) [gill p]) + |(o &(?=([~ ~ *] h) !=(v u.u.h))) :: negotiated & non-matching + :: + ++ get-status + |= =gill:gall + ^- status + ?: =([our dap]:bowl gill) %match + =/ need (~(gut by know) q.gill ~) + ?: =(~ need) %match + =/ need ~(tap in ~(key by need)) + ?. (levy need |=(p=protocol (~(has by heed) gill p))) + %unmet + ?: (lien need |=(p=protocol =(~ (~(got by heed) gill p)))) + %await + ?:((match gill) %match %clash) + :: +inflate: update state & manage subscriptions to be self-consistent + :: + :: get previously-unregistered subs from the bowl, put them in .want, + :: kill subscriptions for non-known-matching gills, and start version + :: negotiation where needed. + :: + ++ inflate + |= knew=(unit config) + ^- [[caz=(list card) kik=(list [wire gill:gall])] _state] + =* boat=boat:gall wex.bowl + :: establish subs from .want where versions match + :: + =/ open=(list card) + %- zing + %+ turn ~(tap by want) + |= [=gill:gall m=(map wire path)] + ?. (match gill) ~ + %+ murn ~(tap by m) + |= [=wire =path] + =. wire (pack-wire wire gill) + ?: (~(has by boat) [wire gill]) ~ :: already established + (some %pass wire %agent gill %watch path) + :: manage subs for new or non-matching gills + :: + =/ [init=(set [gill:gall protocol]) kill=(set [=wire =gill:gall])] + %+ roll ~(tap by boat) + |= $: [[=wire =gill:gall] [? =path]] + [init=(set [gill:gall protocol]) kill=(set [=wire =gill:gall])] + == + ^+ [init kill] + :: all subscriptions should be fully library-managed + :: + ?> ?=([%~.~ %negotiate *] wire) + :: ignore library-internal subscriptions + :: + ?: &(?=([%~.~ %negotiate @ *] wire) !=(%inner-watch i.t.t.wire)) + [init kill] + :: if we don't need a specific version, leave the sub as-is + :: + ?: =([our dap]:bowl gill) [init kill] + =/ need=(list [p=protocol v=version]) + ~(tap by (~(gut by know) q.gill ~)) + |- + ?~ need [init kill] + :: if we haven't negotiated yet, we should start doing so + :: + =/ hail=(unit (unit version)) + (~(get by heed) [gill p.i.need]) + ?~ hail + =. init (~(put in init) [gill p.i.need]) + =. kill (~(put in kill) [wire gill]) + $(need t.need) + :: kill the subscription if the versions don't match + :: + =? kill !=(u.hail `v.i.need) + (~(put in kill) [wire gill]) + $(need t.need) + :: + =^ inis state + =| caz=(list card) + =/ inz=(list [gill:gall protocol]) ~(tap in init) + |- + ?~ inz [caz state] + =^ car state (negotiate i.inz) + $(caz (weld car caz), inz t.inz) + :: + =/ notes=(list card) + ?~ knew ~ + %- zing + %+ turn ~(tap in `(set gill:gall)`(~(run in ~(key by heed)) head)) + |= =gill:gall + ^- (list card) + =/ did=? (match(know u.knew) gill) + =/ now=? (match gill) + ?: =(did now) ~ + %+ weld (notify-outer now gill) + ?. notify ~ + [(notify-inner now gill)]~ + :: + =^ leaves=(list card) want + %^ spin ~(tap in kill) want + |= [[=wire =gill:gall] =_want] + ^- [card _want] + :: kill wires come straight from the boat, so we don't modify them + :: for leaves, but _must_ trim them for .want + :: + :- [%pass wire %agent gill %leave ~] + =/ wan (~(gut by want) gill ~) + =. wan (~(del by wan) +:(trim-wire wire)) + ?~ wan (~(del by want) gill) + (~(put by want) gill wan) + :: + =/ kik=(list [wire gill:gall]) + %+ turn ~(tap in kill) + |= [w=wire g=gill:gall] + [+:(trim-wire w) g] + :: + [[:(weld leaves notes open inis) kik] state] + :: +play-card: handle watches, leaves and pokes specially + :: + ++ play-card + |= =card + ^- (quip ^card _state) + =* pass [[card]~ state] + :: handle cards targetted at us (the library) first + :: + ?: ?=([%give %fact [[%~.~ %negotiate *] ~] *] card) + ~| [%negotiate %unknown-inner-card card] + :: only supported card right now is for initiating negotiation + :: + ?> =([/~/negotiate/initiate]~ paths.p.card) + ?> =(%negotiate-initiate-version p.cage.p.card) + =+ !<(=gill:gall q.cage.p.card) + (negotiate-missing gill) + :: only capture agent cards + :: + ?. ?=([%pass * %agent *] card) + pass + :: always track the subscriptions we want to have + :: + =* gill=gill:gall [ship name]:q.card + =? want ?=(%watch -.task.q.card) + =/ wan (~(gut by want) gill ~) + ?: (~(has by wan) p.card) + ~& [%duplicate-wire dap=dap.bowl wire=p.card path=path.task.q.card] + want + %+ ~(put by want) gill + (~(put by wan) p.card path.task.q.card) + =? want ?=(%leave -.task.q.card) + =/ wan (~(gut by want) gill ~) + =. wan (~(del by wan) p.card) + ?~ wan (~(del by want) gill) + (~(put by want) gill wan) + :: stick the gill in the wire for watches and leaves, + :: so we can retrieve it later if needed + :: + =? p.card ?=(?(%watch %leave) -.task.q.card) + (pack-wire p.card gill) + :: if the target agent is ourselves, always let the card go + :: + ?: =([our dap]:bowl [ship name]:q.card) + pass + :: if we don't require versions for the target agent, let the card go + :: + =* dude=dude:gall name.q.card + ?. (~(has by know) dude) + pass + :: %leave is always free to happen + :: + ?: ?=(%leave -.task.q.card) + pass + :: if we know our versions match, we are free to emit the card + :: + ?: (match gill) + pass + :: pokes may not happen if we know we mismatch + :: + ?: ?=(?(%poke %poke-as) -.task.q.card) + ?: (certain-mismatch gill) + ::TODO if heed was (map gill (map protocol (u v))) we could + :: reasonably look up where the mismatch was... + ~| [%negotiate %poke-to-mismatching-gill gill] + !! + :: if we aren't certain of a match, ensure we've started negotiation + :: + =^ caz state (negotiate-missing gill) + [[card caz] state] + :: watches will get reestablished once our versions match, but if we + :: haven't started negotiation yet, we should do that now + :: + (negotiate-missing gill) + :: + ++ play-cards + |= cards=(list card) + ^- (quip card _state) + =| out=(list card) + |- + ?~ cards [out state] + =^ caz state (play-card i.cards) + $(out (weld out caz), cards t.cards) + :: + ++ negotiate-missing + |= =gill:gall + ^- (quip card _state) + ?: =([our dap]:bowl gill) [~ state] + =/ need=(list protocol) + ~(tap in ~(key by (~(gut by know) q.gill ~))) + =| out=(list card) + |- + ?~ need [out state] + ?: (~(has by heed) [gill i.need]) $(need t.need) + =^ caz state (negotiate gill i.need) + $(out (weld out caz), need t.need) + :: + ++ negotiate + |= for=[gill:gall protocol] + ^- (quip card _state) + ?< (~(has by heed) for) + :- [(watch-version for)]~ + state(heed (~(put by heed) for ~)) + :: + ++ ours-changed + |= [ole=(map protocol version) neu=(map protocol version)] + ^- (list card) + :: kick incoming subs for protocols we no longer support + :: + %+ weld + %+ turn ~(tap by (~(dif by ole) neu)) + |= [=protocol =version] + [%give %kick [/~/negotiate/version/[protocol]]~ ~] + :: give updates for protocols whose supported version changed + :: + %+ murn ~(tap by neu) + |= [=protocol =version] + ^- (unit card) + ?: =(`version (~(get by ole) protocol)) ~ + `[%give %fact [/~/negotiate/version/[protocol]]~ %noun !>(version)] + :: + ++ heed-changed + |= [for=[=gill:gall protocol] new=(unit version)] + ^- [[caz=(list card) kik=(list [wire gill:gall])] _state] + =/ hav=(unit version) + ~| %unrequested-heed + (~(got by heed) for) + ?: =(new hav) [[~ ~] state] + =/ did=? (match gill.for) + =. heed (~(put by heed) for new) + =/ now=? (match gill.for) + :: we need to notify subscribers, + :: and we may need to notify the inner agent + :: + =/ nos=(list card) + ?: =(did now) ~ + %+ weld (notify-outer now gill.for) + ?. notify ~ + [(notify-inner now gill.for)]~ + =^ a state (inflate ~) + [[(weld caz.a nos) kik.a] state] + :: + ++ pack-wire + |= [=wire =gill:gall] + ^+ wire + [%~.~ %negotiate %inner-watch (scot %p p.gill) q.gill wire] + :: + ++ trim-wire + |= =wire + ^- [gill=(unit gill:gall) =_wire] + ?. ?=([%~.~ %negotiate %inner-watch @ @ *] wire) [~ wire] + =, t.t.t.wire + [`[(slav %p i) i.t] t.t] + :: + ++ simulate-kicks + |= [kik=(list [=wire gill:gall]) inner=agent:gall] + ^- [[(list card) _inner] _state] + =| cards=(list card) + |- + ?~ kik [[cards inner] state] + =. wex.bowl (~(del by wex.bowl) (pack-wire i.kik) +.i.kik) + =^ caz inner + %. [wire.i.kik %kick ~] + %~ on-agent inner + inner-bowl(src.bowl p.i.kik) + =^ caz state (play-cards caz) + $(kik t.kik, cards (weld cards caz)) + :: + ++ notify-outer + |= event=[match=? =gill:gall] + ^- (list card) + =/ =path /~/negotiate/notify + =/ =json + :- %o + %- ~(gas by *(map @t json)) + =, event + :~ 'match'^b+match + 'gill'^s+(rap 3 (scot %p p.gill) '/' q.gill ~) + == + :~ [%give %fact [path]~ %negotiate-notification !>(event)] + [%give %fact [(snoc path %json)]~ %json !>(json)] + == + :: + ++ notify-inner + |= event=[match=? =gill:gall] + ^- card + :+ %pass /~/negotiate/notify + [%agent [our dap]:bowl %poke %negotiate-notification !>(event)] + :: + ++ watch-version + |= [=gill:gall =protocol] + ^- card + :+ %pass /~/negotiate/heed/(scot %p p.gill)/[q.gill]/[protocol] + [%agent gill %watch /~/negotiate/version/[protocol]] + :: + ++ retry-timer + |= [t=@dr p=path] + ^- card + :+ %pass [%~.~ %negotiate %retry p] + [%arvo %b %wait (add now.bowl t)] + :: +inner-bowl: partially-faked bowl for the inner agent + :: + :: the bowl as-is, but with library-internal subscriptions removed, + :: and temporarily-held subscriptions added in artificially. + :: + ++ inner-bowl + %_ bowl + sup + :: hide subscriptions coming in to this library + :: + %- ~(gas by *bitt:gall) + %+ skip ~(tap by sup.bowl) + |= [* * =path] + ?=([%~.~ %negotiate *] path) + :: + wex + %- ~(gas by *boat:gall) + %+ weld + :: make sure all the desired subscriptions are in the bowl, + :: even if that means we have to simulate an un-acked state + :: + ^- (list [[wire ship term] ? path]) + %- zing + %+ turn ~(tap by want) + |= [=gill:gall m=(map wire path)] + %+ turn ~(tap by m) + |= [=wire =path] + :- [wire gill] + (~(gut by wex.bowl) [wire gill] [| path]) + :: hide subscriptions going out from this library. + :: because these go into the +gas:by call _after_ the faked entries + :: generated above, these (the originals) take precedence in the + :: resulting bowl. + :: + %+ murn ~(tap by wex.bowl) + |= a=[[=wire gill:gall] ? path] + =^ g wire.a (trim-wire wire.a) + ?^ g (some a) + ?:(?=([%~.~ %negotiate *] wire.a) ~ (some a)) + == + -- + :: + ++ agent + |= inner=agent:gall + =| state-1 + =* state - + ^- agent:gall + !. :: we hide all the "straight into the inner agent" paths from traces + |_ =bowl:gall + +* this . + up ~(. helper bowl state) + og ~(. inner inner-bowl:up) + ++ on-init + ^- (quip card _this) + =. ours our-versions + =. know our-config + =^ cards inner on-init:og !: + =^ cards state (play-cards:up cards) + [cards this] + :: + ++ on-save !>([[%negotiate state] on-save:og]) + ++ on-load + |= ole=vase + ^- (quip card _this) + ?. ?=([[%negotiate *] *] q.ole) + =. ours our-versions + =. know our-config + :: upgrade the inner agent as normal, handling any new subscriptions + :: it creates like we normally do + :: + =^ cards inner (on-load:og ole) !: + =^ cards state (play-cards:up cards) + :: but then, for every subscription that was established prior to + :: using this library, simulate a kick, forcing the inner agent to + :: re-establish those subscriptions, letting us wrap them like we + :: will do for all its subs going forward. + :: this way, after this +on-load call finishes, we should never again + :: see %watch-ack, %kick or %fact signs with non-wrapped wires. + :: + =/ suz=(list [[=wire =gill:gall] [ack=? =path]]) + ~(tap by wex.bowl) + |- + ?~ suz [cards this] + =* sub i.suz + =. cards (snoc cards [%pass wire.sub %agent gill.sub %leave ~]) + =. wex.bowl (~(del by wex.bowl) -.sub) + =^ caz inner (on-agent:og wire.sub %kick ~) + =^ caz state (play-cards:up caz) + $(cards (weld cards caz), suz t.suz) + :: + |^ =+ !<([[%negotiate old=state-any] ile=vase] ole) + ?: ?=(%0 -.old) + :: version 0 didn't wrap all subscriptions, so we must simulate + :: kicks for those that weren't wrapped. + ::NOTE at the time of writing, we know the very bounded set of + :: ships running version %0 of this library, and we know no + :: version numbers are changing during this upgrade, so we + :: simply don't worry about calling +inflate, similar to the + :: "initial +on-load" case. + ::TODO that means we should probably obliterate the %0 type & + :: code branch once this has been deployed to the known ships. + :: + =. state old(- %1) + !: + ?> =(ours our-versions) + ?> =(know our-config) + =^ cards inner (on-load:og ile) + =^ cards state (play-cards:up cards) + =/ suz=(list [[=wire =gill:gall] [ack=? =path]]) + ~(tap by wex.bowl) + |- + ?~ suz [cards this] + =* sub i.suz + ?: ?=([%~.~ %negotiate *] wire.sub) + $(suz t.suz) + ~& [%negotiate dap.bowl %re-doing-sub sub] + =. cards (snoc cards [%pass wire.sub %agent gill.sub %leave ~]) + =. wex.bowl (~(del by wex.bowl) -.sub) + =^ caz inner (on-agent:og wire.sub %kick ~) + =^ caz state (play-cards:up caz) + $(cards (weld cards caz), suz t.suz) + ?> ?=(%1 -.old) + =. state old + =/ caz1 + ?: =(ours our-versions) ~ + (ours-changed:up ours our-versions) + =. ours our-versions + =/ knew know + =. know our-config + =^ a state (inflate:up `knew) + =^ caz2 inner (on-load:og ile) !: + =^ caz2 state (play-cards:up caz2) + =^ [caz3=(list card) nin=_inner] state + (simulate-kicks:up kik.a inner) + =. inner nin + [:(weld caz1 caz.a caz2 caz3) this] + :: + +$ state-any $%(state-0 state-1) + +$ state-0 + $: %0 + ours=(map protocol version) + know=config + heed=(map [gill:gall protocol] (unit version)) + want=(map gill:gall (map wire path)) :: unpacked wires + == + -- + :: + ++ on-watch + |= =path + ^- (quip card _this) + ?. ?=([%~.~ %negotiate *] path) + =^ cards inner (on-watch:og path) !: + =^ cards state (play-cards:up cards) + [cards this] + !: + ?+ t.t.path !! + [%version @ ~] :: /~/negotiate/version/[protocol] + :: it is important that we nack if we don't expose this protocol + :: + [[%give %fact ~ %noun !>((~(got by ours) i.t.t.t.path))]~ this] + :: + [%notify ?([%json ~] ~)] :: /~/negotiate/notify(/json) + ?> =(our src):bowl + [~ this] + == + :: + ++ on-agent + |= [=wire =sign:agent:gall] + ^- (quip card _this) + =^ gill=(unit gill:gall) wire + (trim-wire:up wire) + ?. ?=([%~.~ %negotiate *] wire) + =? want ?=(?([%kick ~] [%watch-ack ~ *]) sign) + !: ~| wire + =/ gill (need gill) + =/ wan (~(gut by want) gill ~) + =. wan (~(del by wan) wire) + ?~ wan (~(del by want) gill) + (~(put by want) gill wan) + =^ cards inner (on-agent:og wire sign) !: + =^ cards state (play-cards:up cards) + [cards this] + !: + ~| wire=t.t.wire + ?+ t.t.wire ~|([%negotiate %unexpected-wire] !!) + [%notify ~] [~ this] + :: + [%heed @ @ @ ~] + =/ for=[=gill:gall =protocol] + =* w t.t.t.wire + [[(slav %p i.w) i.t.w] i.t.t.w] + ?- -.sign + %fact + =* mark p.cage.sign + =* vase q.cage.sign + ?. =(%noun mark) + ~& [negotiate+dap.bowl %ignoring-unexpected-fact mark=mark] + [~ this] + =+ !<(=version vase) + =^ a state (heed-changed:up for `version) + =^ [caz=(list card) nin=_inner] state + (simulate-kicks:up kik.a inner) + =. inner nin + [(weld caz.a caz) this] + :: + %watch-ack + ?~ p.sign [~ this] + :: if we no longer care about this particular version, drop it + :: + ?. (~(has by (~(gut by know) q.gill.for ~)) protocol.for) + =. heed (~(del by heed) for) + [~ this] ::NOTE don't care, so shouldn't need to inflate + :: if we still care, consider the version "unknown" for now, + :: and try re-subscribing later + :: + =^ a state (heed-changed:up for ~) + =^ [caz=(list card) nin=_inner] state + (simulate-kicks:up kik.a inner) + =. inner nin + :: 30 minutes might cost us some responsiveness but in return we + :: save both ourselves and others from a lot of needless retries. + :: + [[(retry-timer:up ~m30 [%watch t.t.wire]) (weld caz.a caz)] this] + :: + %kick + :_ this + :: to prevent pathological kicks from exploding, we always + :: wait a couple seconds before resubscribing. + :: perhaps this is overly careful, but we cannot tell the + :: difference between "clog" kicks and "unexpected crash" kicks, + :: so we cannot take more accurate/appropriate action here. + :: + [(retry-timer:up ~s15 [%watch t.t.wire])]~ + :: + %poke-ack + ~& [negotiate+dap.bowl %unexpected-poke-ack wire] + [~ this] + == + == + :: + ++ on-peek + |= =path + ^- (unit (unit cage)) + ?: =(/x/whey path) + :+ ~ ~ + :- %mass + !> ^- (list mass) + :- %negotiate^&+state + =/ dat (on-peek:og path) + ?: ?=(?(~ [~ ~]) dat) ~ + (fall ((soft (list mass)) q.q.u.u.dat) ~) + ?: =(/x/dbug/state path) + ``noun+!>((slop on-save:og !>(negotiate=state))) + ?. ?=([@ %~.~ %negotiate *] path) + (on-peek:og path) + !: + ?. ?=(%x i.path) [~ ~] + ?+ t.t.t.path [~ ~] + [%version ~] ``noun+!>(ours) + :: + [%version @ @ @ ~] + =/ for=[gill:gall protocol] + =* p t.t.t.t.path + [[(slav %p i.p) i.t.p] i.t.t.p] + :^ ~ ~ %noun + !> ^- (unit version) + (~(gut by heed) for ~) + :: + [%status ?([%json ~] ~)] + :+ ~ ~ + =/ stas=(list [gill:gall status]) + %+ turn ~(tap in `(set gill:gall)`(~(run in ~(key by heed)) head)) + |=(=gill:gall [gill (get-status:up gill)]) + ?~ t.t.t.t.path + noun+!>((~(gas by *(map gill:gall status)) stas)) + ?> ?=([%json ~] t.t.t.t.path) + :- %json + !> ^- json + :- %o + %- ~(gas by *(map @t json)) + %+ turn stas + |= [=gill:gall =status] + [(rap 3 (scot %p p.gill) '/' q.gill ~) s+status] + :: + [%status @ @ ?([%json ~] ~)] + =/ for=gill:gall + =* p t.t.t.t.path + [(slav %p i.p) i.t.p] + =/ res=status + (get-status:up for) + ?~ t.t.t.t.t.t.path ``noun+!>(res) + ?> ?=([%json ~] t.t.t.t.t.t.path) + ``json+!>(`json`s+res) + :: + [%matching ?(~ [%json ~])] + :+ ~ ~ + =/ mats=(list [gill:gall ?]) + %+ turn ~(tap in `(set gill:gall)`(~(run in ~(key by heed)) head)) + |=(=gill:gall [gill (match:up gill)]) + ?~ t.t.t.t.path + noun+!>((~(gas by *(map gill:gall ?)) mats)) + ?> ?=([%json ~] t.t.t.t.path) + :- %json + !> ^- json + :- %o + %- ~(gas by *(map @t json)) + %+ turn mats + |= [=gill:gall match=?] + [(rap 3 (scot %p p.gill) '/' q.gill ~) b+match] + == + :: + ++ on-leave + |= =path + ^- (quip card _this) + ?: ?=([%~.~ %negotiate *] path) !: + [~ this] + =^ cards inner (on-leave:og path) !: + =^ cards state (play-cards:up cards) + [cards this] + :: + ++ on-arvo + |= [=wire sign=sign-arvo:agent:gall] + ^- (quip card _this) + ?. ?=([%~.~ %negotiate *] wire) + =^ cards inner (on-arvo:og wire sign) !: + =^ cards state (play-cards:up cards) + [cards this] + !: + ~| wire=t.t.wire + ?+ t.t.wire !! + [%retry *] + ?> ?=(%wake +<.sign) + ?+ t.t.t.wire !! + [%watch %heed @ @ @ ~] + =/ for=[gill:gall protocol] + =* w t.t.t.t.t.wire + [[(slav %p i.w) i.t.w] i.t.t.w] + [[(watch-version:up for)]~ this] + == + == + :: + ++ on-poke + |= [=mark =vase] + ^- (quip card _this) + =^ cards inner (on-poke:og +<) !: + =^ cards state (play-cards:up cards) + [cards this] + :: + ++ on-fail + |= [term tang] + ^- (quip card _this) + =^ cards inner (on-fail:og +<) !: + =^ cards state (play-cards:up cards) + [cards this] + -- + -- +-- From 2b6d83840a0359a52bd78683858523d6560a3402 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Fri, 13 Sep 2024 23:34:33 +0800 Subject: [PATCH 19/44] contacts: state migration --- desk/app/contacts.hoon | 294 ++++++++++++++++------------------------- desk/sur/contacts.hoon | 20 +-- 2 files changed, 120 insertions(+), 194 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 84b3e574..3508c99a 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -1,5 +1,5 @@ /- *contacts -/+ default-agent, dbug, verb +/+ default-agent, dbug, verb, neg=negotiate /+ *contacts :: performance, keep warm /+ j0=contacts-json-0, j1=contacts-json-1 @@ -17,11 +17,14 @@ +| %types +$ card card:agent:gall +$ state-0 [%0 rof=$@(~ profile-0) rol=rolodex-0] -+$ state-1 [%1 rof=$@(~ profile-1) rolodex-1] ++$ state-1 [%1 rof=$@(~ profile-1) =book =peers] -- -:: +%- %^ agent:neg + notify=| + [~.contacts^%1 ~ ~] + [~.contacts^[~.contacts^%1 ~ ~] ~ ~] %- agent:dbug -%+ verb | +%+ verb & ^- agent:gall =| state-1 =* state - @@ -248,12 +251,6 @@ |= [who=ship con=contact-1 mod=contact-1] =. book (~(put by book) who con mod) - :: XX think about this logic: rolodex-0 - :: is essentially peers now. - :: - :: =. cor - :: %+ p-news-0 who - :: (to-contact-0 (~(uni by con) mod)) (p-news [%page who con mod]) :: ++ p-init-0 @@ -285,21 +282,15 @@ :: :: +sub: subscription mgmt :: - :: /epic: foreign protocol versions, |si-epic:s-impl :: /contact/*: foreign profiles, |s-impl :: :: subscription state is tracked per peer in .sag :: :: ~: no subscription - :: %want: /contact/* being attempted - :: %fail: /contact/* failed, /epic being attempted - :: %lost: /epic failed - :: %chi: /contact/* established - :: %lev: we're (incompatibly) ahead of the publisher - :: %dex: we're behind the publisher + :: %want: /contact/* requested :: :: for a given peer, we always have at most one subscription, - :: to either /contact/* or /epic. + :: to /contact/* :: ++ sub |^ |= who=ship @@ -350,26 +341,11 @@ %poke-ack ~|(strange-poke-ack+wire !!) :: %watch-ack ~| strange-watch-ack+wire - ?> ?=(%want sag) - ?~ p.sign si-cor(sag [%chi ~]) - %- (slog 'contact-fail' u.p.sign) - pe-peer:si-epic(sag %fail) + si-cor :: %kick si-meet(sag ~) :: - :: [compat] we *should* maintain backcompat here - :: - :: by either directly handling or upconverting - :: old actions. but if we don't, we'll fall back - :: to /epic and wait for our peer to upgrade. - :: - :: %fact's from the future are also /epic, - :: in case our peer downgrades. if not, we'll - :: handle it on +load. - :: - %fact ?+ p.cage.sign (si-odd p.cage.sign) - :: XX make sure I have got it right here - :: + %fact ?+ p.cage.sign ~|(strange-fact+wire !!) ?(upd:base:mar %contact-update-1) (si-hear !<(update-1 q.cage.sign)) == == @@ -393,8 +369,6 @@ (p-news:pub %peer who con.u) == :: - :: ++ si-meet si-cor :: init key in +si-abet - :: ++ si-meet ^+ si-cor ?. ?=(~ sag) @@ -411,117 +385,59 @@ %_ si-cor sag ~ cor ?+ sag cor - ?(%fail [?(%lev %dex) *]) - (pass /epic %agent [who dap.bowl] %leave ~) - :: - ?(%want [%chi *]) + %want (pass /contact %agent [who dap.bowl] %leave ~) == == - :: - ++ si-odd - |= =mark - ^+ si-cor - =* upd *upd:base:mar - =* wid ^~((met 3 upd)) - ?. =(upd (end [3 wid] mark)) - ~&(fake-news+mark si-cor) :: XX unsub? - ?~ ver=(slaw %ud (rsh 3^+(wid) mark)) - ~&(weird-news+mark si-cor) :: XX unsub? - ?: =(okay u.ver) - ~|(odd-not-odd+mark !!) :: oops! - =. si-cor si-snub :: unsub before .sag update - =. sag ?:((lth u.ver okay) [%lev ~] [%dex u.ver]) - pe-peer:si-epic - :: - ++ si-epic - |% - ++ pe-take - |= =sign:agent:gall - ^+ si-cor - ?- -.sign - %poke-ack ~|(strange-poke-ack+wire !!) - :: - %watch-ack ?~ p.sign si-cor - %- (slog 'epic-fail' u.p.sign) - si-cor(sag %lost) - :: - %kick ?. ?=(?(%fail [?(%dex %lev) *]) sag) - si-cor :: XX strange - pe-peer - :: - %fact ?+ p.cage.sign - ~&(fact-not-epic+p.cage.sign si-cor) - %epic (pe-hear !<(epic q.cage.sign)) - == == - :: - ++ pe-hear - |= =epic - ^+ si-cor - ?. ?=(?(%fail [?(%dex %lev) *]) sag) - ~|(strange-epic+[okay epic] !!) :: get %kick'd - ?: =(okay epic) - ?: ?=(%fail sag) - si-cor(sag %lost) :: abandon hope - si-meet:si-snub - :: - :: handled generically to support peer downgrade - :: - si-cor(sag ?:((gth epic okay) [%dex epic] [%lev ~])) - :: - ++ pe-peer - si-cor(cor (pass /epic %agent [who dap.bowl] %watch /epic)) - -- -- -- - :: XX can we just assume this migration happened - :: at %contacts v0 and cut it out? :: :: +migrate: from :contact-store :: :: all known ships, non-default profiles, no subscriptions :: - :: ++ migrate - :: => |% - :: ++ legacy - :: |% - :: +$ rolodex (map ship contact) - :: +$ resource [=entity name=term] - :: +$ entity ship - :: +$ contact - :: $: nickname=@t - :: bio=@t - :: status=@t - :: color=@ux - :: avatar=(unit @t) - :: cover=(unit @t) - :: groups=(set resource) - :: last-updated=@da - :: == - :: -- - :: -- - :: :: - :: ^+ cor - :: =/ bas /(scot %p our.bowl)/contact-store/(scot %da now.bowl) - :: ?. .^(? gu+(weld bas /$)) cor - :: =/ ful .^(rolodex:legacy gx+(weld bas /all/noun)) - :: :: - :: |^ cor(rof us, rol them) - :: ++ us (biff (~(get by ful) our.bowl) convert) - :: :: - :: ++ them - :: ^- rolodex - :: %- ~(rep by (~(del by ful) our.bowl)) - :: |= [[who=ship con=contact:legacy] rol=rolodex] - :: (~(put by rol) who (convert con) ~) - :: :: - :: ++ convert - :: |= con=contact:legacy - :: ^- $@(~ profile) - :: ?: =(*contact:legacy con) ~ - :: [last-updated.con con(|6 groups.con)] - :: -- + ++ migrate + => |% + ++ legacy + |% + +$ rolodex (map ship contact) + +$ resource [=entity name=term] + +$ entity ship + +$ contact + $: nickname=@t + bio=@t + status=@t + color=@ux + avatar=(unit @t) + cover=(unit @t) + groups=(set resource) + last-updated=@da + == + -- + -- + :: + ^+ cor + =/ bas /(scot %p our.bowl)/contact-store/(scot %da now.bowl) + ?. .^(? gu+(weld bas /$)) cor + =/ ful .^(rolodex:legacy gx+(weld bas /all/noun)) + :: + |^ + cor(rof us, peers them) + ++ us (biff (~(get by ful) our.bowl) convert) + :: + ++ them + ^- ^peers + %- ~(rep by (~(del by ful) our.bowl)) + |= [[who=ship con=contact:legacy] =^peers] + (~(put by peers) who (convert con) ~) + :: + ++ convert + |= con=contact:legacy + ^- $@(~ profile-1) + ?: =(*contact:legacy con) ~ + [last-updated.con (to-contact-1 con(|6 groups.con))] + -- :: - :: +| %implementation + +| %implementation :: ++ init (emit %pass /migrate %agent [our dap]:bowl %poke noun+!>(%migrate)) @@ -530,40 +446,67 @@ |= old-vase=vase ^+ cor |^ =+ !<([old=versioned-state cool=epic] old-vase) - ?> ?=(%1 -.old) - cor(state old) - :: |^ =+ !<([old=versioned-state cool=epic] old-vase) - :: :: if there should be a sub (%chi saga), but there is none (in the - :: :: bowl), re-establish it. %kick handling used to be faulty. - :: :: we run this "repair" on every load, in the spirit of +inflate-io. - :: :: - :: =^ cards rol.old - :: %+ roll ~(tap by rol.old) - :: |= [[who=ship foreign] caz=(list card) rol=rolodex] - :: ?. ?& =([%chi ~] sag) - :: !(~(has by wex.bowl) [/contact who dap.bowl]) - :: == - :: [caz (~(put by rol) who for sag)] - :: :- :_ caz - :: =/ =path [%contact ?~(for / /at/(scot %da wen.for))] - :: [%pass /contact %agent [who dap.bowl] %watch path] - :: (~(put by rol) who for %want) - :: =. state old - :: =. cor (emil cards) - :: :: [compat] if our protocol version changed - :: :: - :: :: we first tell the world, then see if we can now understand - :: :: any of our friends who were sending messages from the future. - :: :: - :: ?:(=(okay cool) cor l-bump(cor l-epic)) + =? cor !=(okay cool) l-epic + :: + ?- -.old + %0 + =. rof ?~(rof.old ~ (to-profile-1 rof.old)) + =^ cards peers + %+ roll ~(tap by rol.old) + |= [[who=ship foreign-0] caz=(list card) =_peers] + =/ for-1=$@(~ profile-1) + ?~ for ~ + (to-profile-1 for) + :: in v0, any sag that is not null indicates intent to connect, + :: that could fail due to version mismatch or other reasons. + :: therefore, a v0 sag not equal to null means we should + :: subscribe to the peer at the new v1 endpoint. + :: + :: XX Should we manually leave all v0 /contact + :: connections? + :: XX Should we kick all our v0 /contact subscribers? + :: + :: no intent to connect + :: + ?: =(~ sag) + :_ (~(put by peers) who for-1 ~) + ?. (~(has by wex.bowl) [/contact who dap.bowl]) + caz + :: leave existing v0 connection + :: + :_ caz + [%pass /contact %agent [who dap.bowl] %leave ~] + :- :_ caz + =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] + [%pass /contact %agent [who dap.bowl] %watch path] + (~(put by peers) who for-1 %want) + :: + (emil cards) + :: + %1 + =. state old + =/ cards + %+ roll ~(tap by peers) + |= [[who=ship foreign-1] caz=(list card)] + :: intent to connect, resubscribe + :: + ?: ?& =(%want sag) + !(~(has by wex.bowl) [/contact who dap.bowl]) + == + =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] + :_ caz + [%pass /contact %agent [who dap.bowl] %watch path] + caz + (emil cards) + == :: +$ versioned-state $% state-0 state-1 == :: - :: ++ l-epic (give %fact [/epic ~] epic+!>(okay)) - :: :: + ++ l-epic (give %fact [/epic ~] epic+!>(okay)) + :: :: ++ l-bump :: ^+ cor :: %- ~(rep by rol) @@ -584,7 +527,7 @@ ?+ mark ~|(bad-mark+mark !!) %noun ?+ q.vase !! - %migrate ~|(%migrate-not-implemented !!) + %migrate migrate == $? %contact-action-1 %contact-action-0 @@ -659,7 +602,6 @@ ?: |(?=(~ -) ?=(~ for.u.-)) ~ (to-contact-0 con.for.u.-) ?~ tac [~ ~] - :: XX smart compiler > Hoon compiler ``contact+!>(`contact-0`tac) :: [%x %v1 %self ~] @@ -721,12 +663,8 @@ ``contact-1+!>((contact-mod u.page)) :: [%x %v1 %peer her=@p ~] - :: - :: not a peer ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] - :: - :: peer not found ?~ far=(~(get by peers) u.who) [~ ~] ``contact-foreign-1+!>(`foreign-1`u.far) @@ -753,13 +691,11 @@ ^+ cor ?+ wire ~|(evil-agent+wire !!) [%contact ~] si-abet:(si-take:(sub src.bowl) sign) - [%epic ~] si-abet:(pe-take:si-epic:(sub src.bowl) sign) - :: - :: [%migrate ~] - :: ?> ?=(%poke-ack -.sign) - :: ?~ p.sign cor - :: %- (slog leaf/"{} failed" u.p.sign) - :: cor + [%migrate ~] + ?> ?=(%poke-ack -.sign) + ?~ p.sign cor + %- (slog leaf/"{} failed" u.p.sign) + cor == -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 0e3d4fe6..f8076a0d 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -125,25 +125,15 @@ :: $directory: merged contacts :: +$ directory (map ship contact-1) -:: $rolodex-1: rolodex -:: -:: .book: contact book -:: .peers: network peers -:: -+$ rolodex-1 - $: =book - peers=(map ship foreign-1) - == +:: $peers: network peers :: ++$ peers (map ship foreign-1) :: +$ epic epic:e +$ saga - $@ $? %want :: subscribing - %fail :: %want failed - %lost :: epic %fail - ~ :: none intended - == - saga:e + $? %want :: subscribing + ~ :: none intended + == :: +$ field-0 $% [%nickname nickname=@t] From 9403a49581676e9bc50afab6936a15b2b5233410 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Sat, 14 Sep 2024 23:09:47 +0800 Subject: [PATCH 20/44] contacts: remove v0 /contact endpoints; fix +load in lib-negotiate --- desk/app/contacts.hoon | 86 ++++++++++++++++++---------------- desk/lib/negotiate.hoon | 10 +++- desk/mar/contact/action-0.hoon | 2 +- desk/sur/contacts.hoon | 22 ++++----- 4 files changed, 65 insertions(+), 55 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 3508c99a..0196b32a 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -9,14 +9,13 @@ :: :: .con: a contact :: .rof: our profile -:: .rol: our full rolodex +:: .rol: our full rolodex (v0) :: .far: foreign peer :: .for: foreign profile :: .sag: foreign subscription state :: +| %types +$ card card:agent:gall -+$ state-0 [%0 rof=$@(~ profile-0) rol=rolodex-0] +$ state-1 [%1 rof=$@(~ profile-1) =book =peers] -- %- %^ agent:neg @@ -121,21 +120,21 @@ :: send facts on an empty path. This is no problem, unless :: it is used in ++peer :: - ++ subs-0 - ^- (set path) - %- ~(rep by sup.bowl) - |= [[duct ship pat=path] acc=(set path)] - ?.(?=([%contact *] pat) acc (~(put in acc) pat)) + :: ++ subs-0 + :: ^- (set path) + :: %- ~(rep by sup.bowl) + :: |= [[duct ship pat=path] acc=(set path)] + :: ?.(?=([%contact *] pat) acc (~(put in acc) pat)) ++ subs ^- (set path) %- ~(rep by sup.bowl) |= [[duct ship pat=path] acc=(set path)] ?.(?=([%v1 %contact *] pat) acc (~(put in acc) pat)) :: - ++ fact-0 - |= [pat=(set path) u=update-0] - ^- gift:agent:gall - [%fact ~(tap in pat) %contact-update !>(u)] + :: ++ fact-0 + :: |= [pat=(set path) u=update-0] + :: ^- gift:agent:gall + :: [%fact ~(tap in pat) %contact-update !>(u)] :: ++ fact |= [pat=(set path) u=update-1] @@ -206,8 +205,6 @@ =/ p=profile-1 [?~(rof now.bowl (mono wen.rof now.bowl)) con] =. rof p :: - =. cor - (give (fact-0 subs-0 [%full (to-profile-0 p)])) =. cor (give (fact subs [%full p])) =. cor @@ -253,15 +250,6 @@ (~(put by book) who con mod) (p-news [%page who con mod]) :: - ++ p-init-0 - |= wen=(unit @da) - ?~ rof cor - ?~ wen (give (fact ~ full+rof)) - ?: =(u.wen wen.rof) cor - :: - :: no future subs - ?>((lth u.wen wen.rof) (give (fact-0 ~ full+(to-profile-0 rof)))) - :: ++ p-init |= wen=(unit @da) ?~ rof cor @@ -295,6 +283,9 @@ ++ sub |^ |= who=ship ^+ s-impl + :: XX it seems lib negotiate does not set a correct + :: src.bowl! + :: ?< =(our.bowl who) =/ old (~(get by peers) who) ~(. s-impl who %live ?=(~ old) (fall old *foreign-1)) @@ -451,12 +442,24 @@ ?- -.old %0 =. rof ?~(rof.old ~ (to-profile-1 rof.old)) - =^ cards peers + =^ caz=(list card) peers %+ roll ~(tap by rol.old) |= [[who=ship foreign-0] caz=(list card) =_peers] =/ for-1=$@(~ profile-1) ?~ for ~ (to-profile-1 for) + :: no intent to subscribe + :: + ?: =(~ sag) + :- caz + (~(put by peers) who for-1 ~) + :_ (~(put by peers) who for-1 %want) + ?: (~(has by wex.bowl) [/contact who dap.bowl]) + caz + =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] + :_ caz + [%pass /contact %agent [who dap.bowl] %watch path] + (emil caz) :: in v0, any sag that is not null indicates intent to connect, :: that could fail due to version mismatch or other reasons. :: therefore, a v0 sag not equal to null means we should @@ -468,20 +471,22 @@ :: :: no intent to connect :: - ?: =(~ sag) - :_ (~(put by peers) who for-1 ~) - ?. (~(has by wex.bowl) [/contact who dap.bowl]) - caz + :: ?: =(~ sag) + :: :- caz + :: (~(put by peers) who for-1 ~) :: leave existing v0 connection + :: XX it seems lib-negotiate handles this + :: :_ caz + :: [%pass /contact %agent [who dap.bowl] %leave ~] :: - :_ caz - [%pass /contact %agent [who dap.bowl] %leave ~] - :- :_ caz - =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] - [%pass /contact %agent [who dap.bowl] %watch path] - (~(put by peers) who for-1 %want) + :: XX it seems lib-negotiate will initiate this by + :: simulating a %kick + :: :- :_ caz + :: =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] + :: [%pass /contact %agent [who dap.bowl] %watch path] + :: (~(put by peers) who for-1 %want) :: - (emil cards) + :: (emil cards) :: %1 =. state old @@ -499,7 +504,7 @@ caz (emil cards) == - :: + +$ state-0 [%0 rof=$@(~ profile-0) rol=rolodex-0] +$ versioned-state $% state-0 state-1 @@ -537,7 +542,7 @@ =/ act ?- mark %contact-action-1 - !<(action vase) + !<(action-1 vase) ?(act:base:mar %contact-action-0) (to-action-1 !<(action-0 vase)) == @@ -631,7 +636,7 @@ ``contact-page-1+!>(`^page`u.page) :: [%x %v1 %all ~] - =| all=(map ship contact-1) + =| all=directory :: export all ship contacts :: =. all @@ -674,10 +679,10 @@ |= pat=(pole knot) ^+ cor ?+ pat ~|(bad-watch-path+pat !!) + :: :: v0 - [%contact ~] (p-init-0:pub ~) - [%contact %at wen=@ ~] (p-init-0:pub `(slav %da wen.pat)) [%news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) + :: :: v1 [%v1 %contact ~] (p-init:pub ~) [%v1 %contact %at wen=@ ~] (p-init:pub `(slav %da wen.pat)) @@ -690,7 +695,8 @@ |= [=wire =sign:agent:gall] ^+ cor ?+ wire ~|(evil-agent+wire !!) - [%contact ~] si-abet:(si-take:(sub src.bowl) sign) + [%contact ~] + si-abet:(si-take:(sub src.bowl) sign) [%migrate ~] ?> ?=(%poke-ack -.sign) ?~ p.sign cor diff --git a/desk/lib/negotiate.hoon b/desk/lib/negotiate.hoon index 87b00493..9c90d496 100644 --- a/desk/lib/negotiate.hoon +++ b/desk/lib/negotiate.hoon @@ -514,7 +514,15 @@ =* sub i.suz =. cards (snoc cards [%pass wire.sub %agent gill.sub %leave ~]) =. wex.bowl (~(del by wex.bowl) -.sub) - =^ caz inner (on-agent:og wire.sub %kick ~) + :: XX this seems wrong: src is not set + :: =^ caz inner (on-agent:og wire.sub %kick ~) + :: =^ caz inner + :: =. src.bowl.inner-bowl p.gill.i.suz + :: (on-agent:og wire.sub %kick ~) + =^ caz inner + %. [wire.sub %kick ~] + =. src.bowl p.gill.i.suz + ~(on-agent inner inner-bowl:up) =^ caz state (play-cards:up caz) $(cards (weld cards caz), suz t.suz) :: diff --git a/desk/mar/contact/action-0.hoon b/desk/mar/contact/action-0.hoon index bdff052a..9c9ac701 100644 --- a/desk/mar/contact/action-0.hoon +++ b/desk/mar/contact/action-0.hoon @@ -9,7 +9,7 @@ -- ++ grab |% - ++ noun action:c + ++ noun action-0:c ++ json action:dejs:j -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index f8076a0d..b177218d 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -40,11 +40,10 @@ groups=(set flag:g) == :: -+$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga)] ++$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga-0)] +$ profile-0 [wen=@da con=$@(~ contact-0)] +$ rolodex-0 (map ship foreign-0) :: -:: +$ value-type-1 $? %text %date @@ -90,7 +89,6 @@ :: :: uniform set [%set $|(p=(set value-1) unis)] - :: [%set p=(set value-1)] == :: $contact-1: contact data :: @@ -130,6 +128,14 @@ +$ peers (map ship foreign-1) :: +$ epic epic:e ++$ saga-0 + $@ $? %want :: subscribing + %fail :: %want failed + %lost :: epic %fail + ~ :: none intended + == + saga:e +:: +$ saga $? %want :: subscribing ~ :: none intended @@ -211,14 +217,4 @@ [%wipe =kip] [%peer who=ship con=contact-1] == -+| %version -:: ++ foreign foreign-0 -:: ++ rolodex rolodex-0 -:: ++ contact contact-0 -:: ++ action action- -++ action action-1 -:: ++ profile profile-0 -:: ++ news news-0 -:: ++ update update-0 -:: ++ field field-0 -- From 8b6ca48be8178f869a356a9b5e190ae46480fe30 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 16 Sep 2024 11:33:47 +0800 Subject: [PATCH 21/44] contacts: fix agent unit tests --- desk/app/contacts.hoon | 31 ++++++------ desk/tests/app/contacts.hoon | 94 ++++++++++++++++++------------------ 2 files changed, 63 insertions(+), 62 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 0196b32a..c6fb722b 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -23,7 +23,7 @@ [~.contacts^%1 ~ ~] [~.contacts^[~.contacts^%1 ~ ~] ~ ~] %- agent:dbug -%+ verb & +%+ verb | ^- agent:gall =| state-1 =* state - @@ -94,8 +94,8 @@ :: :: |pub: publication mgmt :: - :: - /news: local updates to our profile and rolodex - :: - /contact: updates to our profile + :: - /v1/news: local updates to our profile and rolodex + :: - /v1/contact: updates to our profile :: :: as these publications are trivial, |pub does *not* :: make use of the +abet pattern. the only behavior of note @@ -105,6 +105,11 @@ :: /epic protocol versions are even more trivial, :: published ad-hoc, elsewhere. :: + :: Facts are always send in the following order: + :: 1. (legacy) /news + :: 2. /v1/news + :: 3. /v1/contact + :: ++ pub => |% :: if this proves to be too slow, the set of paths @@ -147,14 +152,12 @@ ++ p-anon ?.(?=([@ ^] rof) cor (p-send-self ~)) :: ++ p-self - |= e=(map @tas value-1) + |= con=(map @tas value-1) =/ old=contact-1 ?.(?=([@ ^] rof) *contact-1 con.rof) - =/ new=contact-1 - (do-edit-1 old e) - ?: =(old new) + ?: =(old con) cor - (p-send-self new) + (p-send-self con) :: +p-page: create new contact page :: ++ p-page @@ -171,11 +174,9 @@ (~(got by book) kip) =/ old=contact-1 q.page - =/ new=contact-1 - (do-edit-1 q.page mod) - ?: =(old new) + ?: =(old mod) cor - (p-send-edit kip p.page new) + (p-send-edit kip p.page mod) :: +p-wipe: delete a contact page :: ++ p-wipe @@ -205,11 +206,11 @@ =/ p=profile-1 [?~(rof now.bowl (mono wen.rof now.bowl)) con] =. rof p :: - =. cor - (give (fact subs [%full p])) =. cor (p-news-0 our.bowl (to-contact-0 con)) - (p-news [%self con]) + =. cor + (p-news [%self con]) + (give (fact subs [%full p])) :: +p-send-page: publish new contact page :: ++ p-send-page diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 03f17a3c..9e9ee9c7 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -38,10 +38,10 @@ :~ nickname+'Zod' bio+'The first of the galaxies' == - :: foreign subscriber to /contact + :: foreign subscriber to /v1/contact :: ;< ~ b (set-src ~sun) - ;< caz=(list card) b (do-watch /contact) + ;< caz=(list card) b (do-watch /v1/contact) :: local subscriber to /news :: ;< ~ b (set-src our.bowl) @@ -58,10 +58,9 @@ [%full (mono now.bowl now.bowl) ~] ;< caz=(list card) b (do-poke %contact-action !>([%anon ~])) %+ ex-cards caz - :~ (ex-fact ~[/contact] %contact-update !>(upd-0)) - (ex-fact ~ %contact-update-1 !>(upd-1)) - (ex-fact ~[/news] %contact-news !>([our.bowl ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%self ~])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl ~])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self ~])) + (ex-fact ~[/v1/contact] contact-update-1+!>(upd-1)) == :: +test-poke-0-edit: v0 edit the profile :: @@ -91,24 +90,27 @@ :~ nickname+'Zod' bio+'The first of the galaxies' == - :: foreign subscriber to /contact + :: foreign subscriber to /v1/contact :: ;< ~ b (set-src ~sun) - ;< caz=(list card) b (do-watch /contact) + ;< caz=(list card) b (do-watch /v1/contact) :: local subscriber to /news :: ;< ~ b (set-src our.bowl) ;< caz=(list card) b (do-watch /news) + :: local subscriber to /v1/news + :: + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-watch /v1/news) :: ;< ~ b (set-src our.bowl) :: action-0 profile %edit :: ;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0])) %+ ex-cards caz - :~ (ex-fact ~[/contact] %contact-update !>(upd-0)) - (ex-fact ~ %contact-update-1 !>(upd-1)) - (ex-fact ~[/news] %contact-news !>([our.bowl con-0])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%self con-1])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self con-1])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full now.bowl con-1])) == :: +test-poke-meet-0: v0 meet a peer :: @@ -177,10 +179,9 @@ :: news is published on /news, /v1/news :: ;< ~ b %+ ex-cards caz - :~ (ex-fact ~ %contact-update !>([%full (add now.bowl tick) ~])) - (ex-fact ~[/v1/contact] %contact-update-1 !>([%full (add now.bowl tick) ~])) - (ex-fact ~[/news] %contact-news !>([our.bowl ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%self ~])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl ~])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self ~])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full (add now.bowl tick) ~])) == :: v0 profile is empty :: @@ -234,10 +235,9 @@ :: ;< caz=(list card) b (do-poke %contact-action-1 !>([%self con-1])) %+ ex-cards caz - :~ (ex-fact ~ %contact-update !>(upd-0)) - (ex-fact ~[/v1/contact] %contact-update-1 !>(upd-1)) - (ex-fact ~[/news] %contact-news !>([our.bowl con-0])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%self con-1])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self con-1])) + (ex-fact ~[/v1/contact] contact-update-1+!>(upd-1)) == :: +test-poke-page: create new contact page :: @@ -315,7 +315,7 @@ :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] %contact-news-1 !>(news-1)) + :~ (ex-fact ~[/v1/news] contact-news-1+!>(news-1)) == :: peek page in the book: new contact page is found :: @@ -351,8 +351,8 @@ (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) == :: ~sun appears in peers :: @@ -391,9 +391,9 @@ ;< ~ b %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) - (ex-fact ~[/news] %contact-news !>([~sun ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun `page:c`[~ ~]])) + (ex-fact ~[/news] contact-news+!>([~sun ~])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun ~])) + (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun `page:c`[~ ~]])) == :: ~sun appears in peers :: @@ -410,9 +410,9 @@ (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) == :: ~sun contact page is edited :: @@ -464,8 +464,8 @@ (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) == :: ~sun appears in peers :: @@ -482,7 +482,7 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) + :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) == :: ~sun contact page is edited :: @@ -493,8 +493,8 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun con-mod])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) + (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun con-mod])) == :: despite the edit, ~sun peer contact is unchanged :: @@ -525,8 +525,8 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%wipe ~[~sun]])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%wipe ~sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%wipe ~sun])) == :: ~sun contact page is removed :: @@ -567,8 +567,8 @@ (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) == :: ~sun appears in peers :: @@ -585,7 +585,7 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) + :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) == :: ~sun contact page is edited :: @@ -596,8 +596,8 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun con-mod])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) + (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun con-mod])) == :: ~sun is dropped :: @@ -606,8 +606,8 @@ ;< ~ b %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %leave ~) - (ex-fact ~[/news] %contact-news !>([~sun ~])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun ~])) + (ex-fact ~[/news] contact-news+!>([~sun ~])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun ~])) == :: ~sun is not found in peers :: @@ -650,8 +650,8 @@ (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] %contact-news !>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] %contact-news-1 !>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) == :: ~sun is added to contacts :: @@ -659,12 +659,12 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] %contact-news-1 !>([%page ~sun con-sun ~])) + :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) == :: ~sun is snubbed :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%snub ~[~sun]])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%snub ~[~sun]])) ;< ~ b %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %leave ~) From 666b4442473304584b9ae05ab15e8c61dd3ac48e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 16 Sep 2024 11:42:06 +0800 Subject: [PATCH 22/44] contacts: test v1 marks --- desk/tests/lib/contacts-json-1.hoon | 80 +++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 desk/tests/lib/contacts-json-1.hoon diff --git a/desk/tests/lib/contacts-json-1.hoon b/desk/tests/lib/contacts-json-1.hoon new file mode 100644 index 00000000..e04ecdca --- /dev/null +++ b/desk/tests/lib/contacts-json-1.hoon @@ -0,0 +1,80 @@ +/- *contacts, g=groups +/+ *test +/+ c=contacts, j=contacts-json-1 +:: +/= c0 /mar/contact-0 +/= c1 /mar/contact-1 +/~ mar * /mar/contact +:: +|% +:: +++ ex-equal + |= [a=vase b=vase] + (expect-eq b a) +:: +++ jex-equal + |= [jon=json txt=@t] + %+ ex-equal + !> (en:json:html jon) + !> txt +:: +++ test-ship + %+ jex-equal + (ship:enjs:j ~sampel-palnet) + '"~sampel-palnet"' +++ test-cid + %+ jex-equal + (cid:enjs:j 0v11abc) + '"0v11abc"' +++ test-kip + ;: weld + %+ jex-equal + (kip:enjs:j ~sampel-palnet) + '"~sampel-palnet"' + :: + %+ jex-equal + (kip:enjs:j id+0v11abc) + '"0v11abc"' + == +++ test-value + ;: weld + :: + %+ jex-equal + (value:enjs:j [%text 'the lazy fox']) + '{"type":"text","value":"the lazy fox"}' + :: + %+ jex-equal + (value:enjs:j [%date ~2024.9.11]) + '{"type":"date","value":"~2024.9.11"}' + :: + %+ jex-equal + (value:enjs:j [%tint 0xcafe.babe]) + '{"type":"tint","value":"cafe.babe"}' + :: + %+ jex-equal + (value:enjs:j [%ship ~sampel-palnet]) + '{"type":"ship","value":"~sampel-palnet"}' + :: + %+ jex-equal + (value:enjs:j [%look 'https://ship.io/avatar.png']) + '{"type":"look","value":"https://ship.io/avatar.png"}' + :: + %+ jex-equal + (value:enjs:j [%cult [~sampel-palnet %circle]]) + '{"type":"cult","value":"~sampel-palnet/circle"}' + :: + %+ jex-equal + %- value:enjs:j + [%set (silt `(list value-1)`~[cult/[~sampel-palnet %circle] cult/[~sampel-pardux %square]])] + '{"type":"set","value":[{"type":"cult","value":"~sampel-palnet/circle"},{"type":"cult","value":"~sampel-pardux/square"}]}' + == +++ test-contact + %+ jex-equal + %- contact:enjs:j + %- malt + ^- (list [@tas value-1]) + :~ name+text/'Sampel' + surname+text/'Palnet' + == + '{"name":{"type":"text","value":"Sampel"},"surname":{"type":"text","value":"Palnet"}}' +-- From 840c14cedca8ac97ee9ef0b068a496a6f1b08baf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 16 Sep 2024 12:02:53 +0800 Subject: [PATCH 23/44] contacts: contact page updates no longer broadcast v0 news --- desk/app/contacts.hoon | 18 +++++++++--------- desk/tests/app/contacts.hoon | 6 +++--- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index c6fb722b..3fabd9af 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -227,21 +227,21 @@ (~(put by book) kip page) :: this is a peer page, send v0 update :: - =? cor ?=(ship kip) - %+ p-news-0 kip - (to-contact-0 (contact-mod page)) + :: =? cor ?=(ship kip) + :: %+ p-news-0 kip + :: (to-contact-0 (contact-mod page)) (p-news [%page kip page]) :: ++ p-send-wipe |= [=kip =page] =. book (~(del by book) kip) - :: peer overlay lost - :: - =? cor &(?=(ship kip) !?=(~ q.page)) - :: v0 peer contact is modified - %+ p-news-0 kip - (to-contact-0 p.page) + :: :: peer overlay lost: v0 peer contact is modified + :: :: + :: =? cor &(?=(ship kip) !?=(~ q.page)) + :: :: v0 peer contact is modified + :: %+ p-news-0 kip + :: (to-contact-0 p.page) (p-news [%wipe kip]) :: +p-send-spot: publish peer spot :: diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 9e9ee9c7..8821d1ac 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -493,7 +493,7 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun con-mod])) == :: despite the edit, ~sun peer contact is unchanged @@ -525,7 +525,7 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%wipe ~[~sun]])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) (ex-fact ~[/v1/news] contact-news-1+!>([%wipe ~sun])) == :: ~sun contact page is removed @@ -596,7 +596,7 @@ ;< caz=(list card) b (do-poke %contact-action-1 !>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun con-mod])) == :: ~sun is dropped From 33bcbd9c159e126c9a3abc55bcabe09864f9ced9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 17 Sep 2024 14:50:50 +0800 Subject: [PATCH 24/44] contacts: improved contact editing; refactoring --- desk/app/contacts.hoon | 156 +++++++------ desk/lib/contacts.hoon | 336 +++++++++++++++------------- desk/lib/contacts/json-0.hoon | 18 +- desk/lib/contacts/json-1.hoon | 14 +- desk/mar/contact-0.hoon | 8 +- desk/mar/contact-1.hoon | 4 +- desk/mar/contact/action-0.hoon | 4 +- desk/mar/contact/action-1.hoon | 4 +- desk/mar/contact/news-1.hoon | 4 +- desk/mar/contact/news.hoon | 4 +- desk/mar/contact/rolodex.hoon | 8 +- desk/mar/contact/update-0.hoon | 4 +- desk/mar/contact/update-1.hoon | 4 +- desk/sur/contacts.hoon | 214 +++++++++--------- desk/tests/app/contacts.hoon | 282 +++++++++++++---------- desk/tests/lib/contacts-json-1.hoon | 6 +- 16 files changed, 590 insertions(+), 480 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 3fabd9af..b6a8b8be 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -1,6 +1,7 @@ /- *contacts /+ default-agent, dbug, verb, neg=negotiate /+ *contacts +:: :: performance, keep warm /+ j0=contacts-json-0, j1=contacts-json-1 :: @@ -16,7 +17,7 @@ :: +| %types +$ card card:agent:gall -+$ state-1 [%1 rof=$@(~ profile-1) =book =peers] ++$ state-1 [%1 rof=$@(~ profile) =book =peers] -- %- %^ agent:neg notify=| @@ -142,7 +143,7 @@ :: [%fact ~(tap in pat) %contact-update !>(u)] :: ++ fact - |= [pat=(set path) u=update-1] + |= [pat=(set path) u=update] ^- gift:agent:gall [%fact ~(tap in pat) upd:mar !>(u)] -- @@ -152,31 +153,39 @@ ++ p-anon ?.(?=([@ ^] rof) cor (p-send-self ~)) :: ++ p-self - |= con=(map @tas value-1) - =/ old=contact-1 - ?.(?=([@ ^] rof) *contact-1 con.rof) - ?: =(old con) + |= con=(map @tas value) + ?> (sane-contact con) + =/ old=contact + ?.(?=([@ ^] rof) *contact con.rof) + :: XX handle deletion of fields + =/ new=contact + (do-edit old con) + ?: =(old new) cor - (p-send-self con) + (p-send-self new) :: +p-page: create new contact page :: ++ p-page - |= [=cid con=contact-1] + |= [=cid con=contact] + ?> (sane-contact con) ?: (~(has by book) id+cid) ~| "contact page {} already exists" !! (p-send-page cid con) :: +p-edit: edit contact page overlay :: ++ p-edit - |= [=kip mod=(map @tas value-1)] + |= [=kip mod=(map @tas value)] + ?> (sane-contact mod) =/ =page ~| "contact page {} does not exist" (~(got by book) kip) - =/ old=contact-1 + =/ old=contact q.page - ?: =(old mod) + =/ new=contact + (do-edit old mod) + ?: =(old new) cor - (p-send-edit kip p.page mod) + (p-send-edit kip p.page new) :: +p-wipe: delete a contact page :: ++ p-wipe @@ -190,20 +199,21 @@ :: +p-spot: add as a contact :: ++ p-spot - |= [who=ship mod=contact-1] + |= [who=ship mod=contact] + ?> (sane-contact mod) ?: (~(has by book) who) ~| "peer {} is already a contact" !! - =/ con=contact-1 + =/ con=contact ~| "peer {} not found" - =/ far=foreign-1 + =/ far=foreign (~(got by peers) who) - ?~ for.far *contact-1 + ?~ for.far *contact con.for.far (p-send-spot who con mod) :: ++ p-send-self - |= con=contact-1 - =/ p=profile-1 [?~(rof now.bowl (mono wen.rof now.bowl)) con] + |= con=contact + =/ p=profile [?~(rof now.bowl (mono wen.rof now.bowl)) con] =. rof p :: =. cor @@ -214,9 +224,9 @@ :: +p-send-page: publish new contact page :: ++ p-send-page - |= [=cid mod=contact-1] + |= [=cid mod=contact] =/ =page - [*contact-1 mod] + [*contact mod] =. book (~(put by book) id+cid page) (p-news [%page id+cid page]) :: +p-send-edit: publish contact page update @@ -228,25 +238,25 @@ :: this is a peer page, send v0 update :: :: =? cor ?=(ship kip) - :: %+ p-news-0 kip - :: (to-contact-0 (contact-mod page)) + :: %+ p-news-0:legacy kip + :: (to-contact-0:legacy (contact-mod page)) (p-news [%page kip page]) :: ++ p-send-wipe |= [=kip =page] =. book (~(del by book) kip) - :: :: peer overlay lost: v0 peer contact is modified + :: XX :: peer overlay lost: v0 peer contact is modified :: :: :: =? cor &(?=(ship kip) !?=(~ q.page)) :: :: v0 peer contact is modified - :: %+ p-news-0 kip - :: (to-contact-0 p.page) + :: %+ p-news-0:legacy kip + :: (to-contact-0:legacy p.page) (p-news [%wipe kip]) :: +p-send-spot: publish peer spot :: ++ p-send-spot - |= [who=ship con=contact-1 mod=contact-1] + |= [who=ship con=contact mod=contact] =. book (~(put by book) who con mod) (p-news [%page who con mod]) @@ -261,11 +271,11 @@ ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) :: ++ p-news-0 - |= n=news-0 + |= n=news-0:legacy (give %fact ~[/news] %contact-news !>(n)) :: ++ p-news - |= n=news-1 + |= n=news (give %fact ~[/v1/news] %contact-news-1 !>(n)) -- :: @@ -289,7 +299,7 @@ :: ?< =(our.bowl who) =/ old (~(get by peers) who) - ~(. s-impl who %live ?=(~ old) (fall old *foreign-1)) + ~(. s-impl who %live ?=(~ old) (fall old *foreign)) :: ++ s-many |= [l=(list ship) f=$-(_s-impl _s-impl)] @@ -300,7 +310,7 @@ si-abet:(f (sub:acc who)) :: ++ s-impl - |_ [who=ship sas=?(%dead %live) new=? foreign-1] + |_ [who=ship sas=?(%dead %live) new=? foreign] :: ++ si-cor . :: @@ -327,7 +337,7 @@ == :: ++ si-take - |= =sign:agent:gall + |= [=wire =sign:agent:gall] ^+ si-cor ?- -.sign %poke-ack ~|(strange-poke-ack+wire !!) @@ -338,13 +348,14 @@ %kick si-meet(sag ~) :: %fact ?+ p.cage.sign ~|(strange-fact+wire !!) - ?(upd:base:mar %contact-update-1) - (si-hear !<(update-1 q.cage.sign)) + %contact-update-1 + (si-hear !<(update q.cage.sign)) == == :: ++ si-hear - |= u=update-1 + |= u=update ^+ si-cor + ?> (sane-contact con.u) ?: &(?=(^ for) (lte wen.u wen.for)) si-cor %= si-cor @@ -424,9 +435,9 @@ :: ++ convert |= con=contact:legacy - ^- $@(~ profile-1) + ^- $@(~ profile) ?: =(*contact:legacy con) ~ - [last-updated.con (to-contact-1 con(|6 groups.con))] + [last-updated.con (to-contact con(|6 groups.con))] -- :: +| %implementation @@ -442,13 +453,18 @@ :: ?- -.old %0 - =. rof ?~(rof.old ~ (to-profile-1 rof.old)) + =. rof ?~(rof.old ~ (to-profile rof.old)) =^ caz=(list card) peers %+ roll ~(tap by rol.old) - |= [[who=ship foreign-0] caz=(list card) =_peers] - =/ for-1=$@(~ profile-1) + |= [[who=ship foreign-0:legacy] caz=(list card) =_peers] + :: leave /epic if any + :: + =? caz (~(has by wex.bowl) [/epic who dap.bowl]) + :_ caz + [%pass /epic %agent [who dap.bowl] %leave ~] + =/ for-1=$@(~ profile) ?~ for ~ - (to-profile-1 for) + (to-profile for) :: no intent to subscribe :: ?: =(~ sag) @@ -493,7 +509,7 @@ =. state old =/ cards %+ roll ~(tap by peers) - |= [[who=ship foreign-1] caz=(list card)] + |= [[who=ship foreign] caz=(list card)] :: intent to connect, resubscribe :: ?: ?& =(%want sag) @@ -505,7 +521,7 @@ caz (emil cards) == - +$ state-0 [%0 rof=$@(~ profile-0) rol=rolodex-0] + +$ state-0 [%0 rof=$@(~ profile-0:legacy) rol=rolodex-0:legacy] +$ versioned-state $% state-0 state-1 @@ -535,17 +551,29 @@ ?+ q.vase !! %migrate migrate == - $? %contact-action-1 + $? act:base:mar %contact-action-0 - act:base:mar + %contact-action-1 == ?> =(our src):bowl - =/ act + =/ act=action ?- mark %contact-action-1 - !<(action-1 vase) + !<(action vase) + :: ?(act:base:mar %contact-action-0) - (to-action-1 !<(action-0 vase)) + =/ act-0 !<(action-0:legacy vase) + ?. ?=(%edit -.act-0) + (to-action act-0) + :: v0 %edit needs special handling to evaluate + :: groups edit + :: + =/ groups=(set $>(%cult value)) + ?~ rof ~ + =+ set=(~(ges cy con.rof) groups+%cult) + ?: =(~ set) ~ + (need set) + [%self (to-edit-1 p.act-0 groups)] == ?- -.act %anon p-anon:pub @@ -565,18 +593,18 @@ :: :: v0 scries :: - :: /x/all -> $rolodex-0 - :: /x/contact/her=@ -> $@(~ contact-0) + :: /x/all -> $rolodex-0:legacy + :: /x/contact/her=@ -> $@(~ contact-0:legacy) :: :: v1 scries :: - :: /x/v1/self -> $contact-1 + :: /x/v1/self -> $contact :: /x/v1/book -> $book :: /x/v1/book/her=@p -> $page :: /x/v1/book/id/cid=@uv -> $page :: /x/v1/all -> $directory - :: /x/v1/contact/her=@p -> $contact-1 - :: /x/v1/peer/her=@p -> $contact-1 + :: /x/v1/contact/her=@p -> $contact + :: /x/v1/peer/her=@p -> $contact :: ++ peek |= pat=(pole knot) @@ -584,16 +612,16 @@ ?+ pat [~ ~] :: [%x %all ~] - =/ rol-0=rolodex-0 + =/ rol-0=rolodex-0:legacy %- ~(urn by peers) - |= [who=ship far=foreign-1] - ^- foreign-0 - =/ mod=contact-1 + |= [who=ship far=foreign] + ^- foreign-0:legacy + =/ mod=contact ?~ page=(~(get by book) who) ~ q.u.page (to-foreign-0 (foreign-mod far mod)) - =/ lor-0=rolodex-0 + =/ lor-0=rolodex-0:legacy ?: |(?=(~ rof) ?=(~ con.rof)) rol-0 (~(put by rol-0) our.bowl (to-profile-0 rof) ~) ``contact-rolodex+!>(lor-0) @@ -601,19 +629,19 @@ [%x %contact her=@ ~] ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] - =/ tac=?(~ contact-0) + =/ tac=?(~ contact-0:legacy) ?: =(our.bowl u.who) ?~(rof ~ (to-contact-0 con.rof)) =+ (~(get by peers) u.who) ?: |(?=(~ -) ?=(~ for.u.-)) ~ (to-contact-0 con.for.u.-) ?~ tac [~ ~] - ``contact+!>(`contact-0`tac) + ``contact+!>(`contact-0:legacy`tac) :: [%x %v1 %self ~] ?~ rof [~ ~] ?~ con.rof [~ ~] - ``contact-1+!>(con.rof) + ``contact-1+!>(`contact`con.rof) :: [%x %v1 %book ~] ``contact-book-1+!>(book) @@ -650,10 +678,10 @@ :: =. all %- ~(rep by peers) - |= [[who=ship far=foreign-1] =_all] + |= [[who=ship far=foreign] =_all] ?~ for.far all ?: (~(has by all) who) all - (~(put by all) who `contact-1`con.for.far) + (~(put by all) who `contact`con.for.far) ?~ all [~ ~] ``contact-directory-1+!>(all) @@ -673,7 +701,7 @@ [~ ~] ?~ far=(~(get by peers) u.who) [~ ~] - ``contact-foreign-1+!>(`foreign-1`u.far) + ``contact-foreign-1+!>(`foreign`u.far) == :: ++ peer @@ -697,7 +725,7 @@ ^+ cor ?+ wire ~|(evil-agent+wire !!) [%contact ~] - si-abet:(si-take:(sub src.bowl) sign) + si-abet:(si-take:(sub src.bowl) wire sign) [%migrate ~] ?> ?=(%poke-ack -.sign) ?~ p.sign cor diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 8471f8b6..75249032 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -1,23 +1,18 @@ /- *contacts |% -:: :: +cy: contact map engine :: ++ cy - |_ c=contact-1 + |_ c=contact :: +get: get typed value :: ++ get - |* [key=@tas typ=value-type-1] - ^- (unit _p:*$>(_typ value-1)) - =/ val=(unit value-1) (~(get by c) key) + |* [key=@tas typ=value-type] + ^- (unit _p:*$>(_typ value)) + =/ val=(unit value) (~(get by c) key) ?~ val ~ ?~ u.val !! ~| "{} expected at {}" - :: XX Hoon compiler really needs to eat more fish - :: ?> ?=($>(_typ value-1) -.u.val) - :: +.u.val - :: ?- typ %text ?>(?=(%text -.u.val) (some p.u.val)) %date ?>(?=(%date -.u.val) (some p.u.val)) @@ -27,36 +22,53 @@ %cult ?>(?=(%cult -.u.val) (some p.u.val)) %set ?>(?=(%set -.u.val) (some p.u.val)) == + :: +ges: get specialized to set + :: + ++ ges + |* [key=@tas typ=value-type] + ^- (unit (set $>(_typ value))) + =/ val=(unit value) (~(get by c) key) + ?~ val ~ + ~| "set expected at {}" + ?> ?=(%set -.u.val) + %- some + %- ~(run in p.u.val) + ?- typ + %text |=(v=value ?>(?=(%text -.v) v)) + %date |=(v=value ?>(?=(%date -.v) v)) + %tint |=(v=value ?>(?=(%tint -.v) v)) + %ship |=(v=value ?>(?=(%ship -.v) v)) + %look |=(v=value ?>(?=(%look -.v) v)) + %cult |=(v=value ?>(?=(%cult -.v) v)) + %set |=(v=value ?>(?=(%set -.v) v)) + == :: +gos: got specialized to set :: ++ gos - |* [key=@tas typ=value-type-1] - :: XX make Hoon compiler smarter - :: to be able to specialize to uniform set of - :: type typ. - :: =* vat $>(_typ value-1) - :: ^- (set _+:*vat) - :: - =/ val=value-1 (~(got by c) key) - ?~ val !! + |* [key=@tas typ=value-type] + ^- (set $>(_typ value)) + =/ val=value (~(got by c) key) ~| "set expected at {}" ?> ?=(%set -.val) - p.val + %- ~(run in p.val) + ?- typ + %text |=(v=value ?>(?=(%text -.v) v)) + %date |=(v=value ?>(?=(%date -.v) v)) + %tint |=(v=value ?>(?=(%tint -.v) v)) + %ship |=(v=value ?>(?=(%ship -.v) v)) + %look |=(v=value ?>(?=(%look -.v) v)) + %cult |=(v=value ?>(?=(%cult -.v) v)) + %set |=(v=value ?>(?=(%set -.v) v)) + == :: +gut: got with default :: ++ gut - |* [key=@tas def=value-1] + |* [key=@tas def=value] ^+ +.def - =/ val=value-1 (~(gut by c) key ~) + =/ val=value (~(gut by c) key ~) ?~ val +.def ~| "{<-.def>} expected at {}" - :: XX wish for Hoon compiler to be smarter. - :: this results in fish-loop. - :: ?+ -.def !! - :: %text ?>(?=(%text -.val) +.val) - :: == - :: ?> ?=(_-.def -.val) ?- -.val %text ?>(?=(%text -.def) p.val) %date ?>(?=(%date -.def) p.val) @@ -69,27 +81,19 @@ :: +gub: got with bunt default :: ++ gub - |* [key=@tas typ=value-type-1] - ^+ +:*$>(_typ value-1) - =/ val=value-1 (~(gut by c) key ~) + |* [key=@tas typ=value-type] + ^+ +:*$>(_typ value) + =/ val=value (~(gut by c) key ~) ?~ val ?+ typ !! - %text p:*$>(%text value-1) - %date p:*$>(%date value-1) - %tint p:*$>(%tint value-1) - %ship p:*$>(%ship value-1) - %look p:*$>(%look value-1) - %cult p:*$>(%cult value-1) - %set p:*$>(%set value-1) + %text *@t + %date *@da + %tint *@ux + %ship *@p + %look *@t + %cult *flag:g + %set *(set value) == - :: ~| "{} expected to be {<-.def>}" - :: XX wish for Hoon compiler to be smarter. - :: this results in fish-loop. - :: ?+ -.def !! - :: %text ?>(?=(%text -.val) +.val) - :: == - :: ?> ?=(_-.def -.val) - :: ?- typ %text ?>(?=(%text -.val) p.val) %date ?>(?=(%date -.val) p.val) @@ -100,9 +104,9 @@ %set ?>(?=(%set -.val) p.val) == -- -++ do-edit do-edit-0 +:: ++ do-edit-0 - |= [c=contact-0 f=field-0] + |= [c=contact-0:legacy:legacy f=field-0:legacy] ^+ c ?- -.f %nickname c(nickname nickname.f) @@ -126,34 +130,54 @@ :: %del-group c(groups (~(del in groups.c) flag.f)) == -++ do-edit-1 - |= [con=contact-1 edit=(map @tas value-1)] - ^+ con - =/ don (~(uni by con) edit) - :: XX are these checks neccessary? - :: if so, we need to introduce link field. +:: +++ sane-contact + |= con=contact + ^- ? + :: 1kB contact should be enough for everyone :: - =+ avatar=(~(get cy don) %avatar %text) + ?: (gth (met 3 (jam con)) 1.000) + | + :: prohibit data URLs in the image links + :: + =+ avatar=(~(get cy con) %avatar %text) + :: XX restrict also on ?: ?& ?=(^ avatar) =('data:' (end 3^5 u.avatar)) == - ~| "cannot add a data url to avatar" !! - =+ cover=(~(get cy don) %cover %text) + | + =+ cover=(~(get cy con) %cover %text) ?: ?& ?=(^ cover) !=('data:' (end 3^5 u.cover)) == - ~| "cannot add a data url to cover" !! - :: + | + & +:: +++ do-edit + |= [con=contact edit=(map @tas value)] + ^+ con + =/ don (~(uni by con) edit) + =/ del=(list @tas) + :: XX accumulate new map? + :: + %- ~(rep by don) + |= [[key=@tas val=value] acc=(list @tas)] + ?. ?=(~ val) acc + [key acc] + =? don !=(~ del) + %+ roll del + |= [key=@tas acc=_don] + (~(del by don) key) + ?> (sane-contact don) don -:: +to-contact-1: convert contact-0 +:: +to-contact: convert contact-0:legacy:legacy :: -++ to-contact-1 - |= c=contact-0 - ^- contact-1 - ~& contact-0-to-1+c - =/ o=contact-1 +++ to-contact + |= c=contact-0:legacy + ^- contact + =/ o=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) :~ nickname+text/nickname.c bio+text/bio.c status+text/status.c @@ -170,22 +194,22 @@ |= =flag:g cult/flag o -:: +to-contact-0: convert contact-1 +:: +to-contact-0: convert contact :: ++ to-contact-0 - |= c=contact-1 - ^- $@(~ contact-0) + |= c=contact + ^- $@(~ contact-0:legacy) ?~ c ~ - =| o=contact-0 + =| o=contact-0:legacy %= o nickname (~(gub cy c) %nickname %text) bio - (~(gut cy c) %bio text/'') + (~(gub cy c) %bio %text) status - (~(gut cy c) %status text/'') + (~(gub cy c) %status %text) color - (~(gut cy c) %color tint/0x0) + (~(gub cy c) %color %tint) avatar :: XX prohibit data: link (~(get cy c) %avatar %text) @@ -198,158 +222,158 @@ ?~ groups ~ ^- (set flag:g) %- ~(run in u.groups) - |= val=value-1 + |= val=value ?> ?=(%cult -.val) p.val == :: +contact-mod: merge contacts :: ++ contact-mod - |= [c=contact-1 mod=contact-1] - ^- contact-1 + |= [c=contact mod=contact] + ^- contact (~(uni by c) mod) -:: +to-profile-1: convert profile-0 +:: +to-profile: convert profile-0:legacy :: -++ to-profile-1 - |= o=profile-0 - ^- profile-1 - [wen.o ?~(con.o ~ (to-contact-1 con.o))] -:: +to-profile-0: convert profile-1 +++ to-profile + |= o=profile-0:legacy + ^- profile + [wen.o ?~(con.o ~ (to-contact con.o))] +:: +to-profile-0:legacy: convert profile :: ++ to-profile-0 - |= p=profile-1 - ^- profile-0 + |= p=profile + ^- profile-0:legacy [wen.p (to-contact-0 con.p)] :: ++ to-profile-0-mod - |= [p=profile-1 mod=contact-1] - ^- profile-0 + |= [p=profile mod=contact] + ^- profile-0:legacy [wen.p (to-contact-0 (contact-mod con.p mod))] :: ++ to-foreign-0 - |= f=foreign-1 - ^- foreign-0 + |= f=foreign + ^- foreign-0:legacy [?~(for.f ~ (to-profile-0 for.f)) sag.f] -:: +to-foreign-0-mod: convert foreign-1 with contact overlay +:: +to-foreign-0-mod: convert foreign with contact overlay :: ++ to-foreign-0-mod - |= [f=foreign-1 mod=contact-1] - ^- foreign-0 + |= [f=foreign mod=contact] + ^- foreign-0:legacy [?~(for.f ~ (to-profile-0-mod for.f mod)) sag.f] :: +foreign-mod: fuse peer contact with overlay :: ++ foreign-mod - |= [far=foreign-1 mod=contact-1] - ^- foreign-1 + |= [far=foreign mod=contact] + ^- foreign ?~ for.far far far(con.for (contact-mod con.for.far mod)) :: +foreign-contact: grab foreign contact :: ++ foreign-contact - |= far=foreign-1 - ^- contact-1 + |= far=foreign + ^- contact ?~(for.far ~ con.for.far) -:: +to-rolodex-1: convert rolodex-0 :: -:: ++ to-rolodex-1 -:: |= [eny=@uvJ r=rolodex-0] -:: ^- rolodex-1 -:: %- ~(rep by r) -:: |= $: [=ship raf=foreign-0] -:: acc=rolodex-1 -:: == -:: =+ cid=(gen-cid eny book.acc) -:: =/ far=foreign-1 -:: ?~ for.raf -:: [~ sag.raf] -:: [(some cid) sag.raf] -:: %_ acc -:: book -:: ?~ for.raf book.acc -:: ?~ con.for.raf -:: (~(put by book.acc) cid *page) -:: %+ ~(put by book.acc) -:: cid -:: ^- page -:: [[wen.for.raf (to-contact-1 con.for.raf)] ~] -:: net -:: (~(put by net.acc) ship far) -:: == ++$ sole-field-0 + $~ nickname+'' + $<(?(%add-group %del-group) field-0:legacy) :: -++ to-edit-1 - |= edit-0=(list field-0) - ^- (map @tas value-1) - =; [edit-1=(map @tas value-1) groups=(set $>(%cult value-1))] - ?~ groups - edit-1 - (~(put by edit-1) %groups set/groups) - :: +++ to-sole-edit-1 + |= edit-0=(list sole-field-0) + ^- contact %+ roll edit-0 - |= $: fed=field-0 - acc=(map @tas value-1) - gan=(set $>(%cult value-1)) + |= $: fed=sole-field-0 + acc=(map @tas value) == - :: - ^+ [acc gan] - :: XX improve this by taking out :_ gan - :: outside + :: XX under a single ~put ? + ^+ acc ?- -.fed :: %nickname - :_ gan %+ ~(put by acc) %nickname text/nickname.fed :: %bio - :_ gan %+ ~(put by acc) %bio text/bio.fed :: %status - :_ gan %+ ~(put by acc) %status text/status.fed :: %color - :_ gan %+ ~(put by acc) %color tint/color.fed :: %avatar - ?~ avatar.fed [acc gan] - :_ gan + ?~ avatar.fed acc %+ ~(put by acc) %avatar look/u.avatar.fed :: %cover - ?~ cover.fed [acc gan] - :_ gan + ?~ cover.fed acc %+ ~(put by acc) %cover look/u.cover.fed - :: - %add-group - :- acc - (~(put in gan) [%cult flag.fed]) - :: - %del-group - :- acc - (~(del in gan) [%cult flag.fed]) == - -++ to-action-1 - :: o=$<(%meet action-0) - |= o=action-0 - ^- action-1 +:: +++ to-edit-1 + |= [edit-0=(list field-0:legacy) groups=(set value)] + ^- contact + :: translating v0 profile edit to v1 %self is non-trivial: + :: for field edits other than groups, we derive a contact + :: edit map. for group operations (%add-group, %del-group) + :: we need to operate directly on (existing?) groups field in + :: the profile. + :: + :: .tid: field edit actions, no group edit + :: .gid: only group edit actions + :: + =* group-type ?(%add-group %del-group) + =* sole-edits (list $<(group-type field-0:legacy)) + =* group-edits (list $>(group-type field-0:legacy)) + :: sift v0 edits + :: XX tall structure mode? + :: + =/ [sid=sole-edits gid=group-edits] + :: + :: XX why is casting neccessary here? + =- [(flop `sole-edits`-<) (flop `group-edits`->)] + %+ roll edit-0 + |= [f=field-0:legacy sid=sole-edits gid=group-edits] + ^+ [sid gid] + ?. ?=(group-type -.f) + :- [f sid] + gid + :- sid + [f gid] + :: edit groups + :: + =. groups + %+ roll gid + |= [ged=$>(group-type field-0:legacy) =_groups] + ?- -.ged + %add-group + (~(put in groups) cult/flag.ged) + %del-group + ~| "group {} not found" + (~(del in groups) cult/flag.ged) + == + %- ~(uni by (to-sole-edit-1 sid)) + ^- contact + [%groups^set/groups ~ ~] +:: +++ to-action + |= o=$<(%edit action-0:legacy) + ^- action ?- -.o %anon [%anon ~] - %edit [%self (to-edit-1 p.o)] :: :: old %meet is now a no-op %meet [%meet ~] diff --git a/desk/lib/contacts/json-0.hoon b/desk/lib/contacts/json-0.hoon index 6f404217..de66a895 100644 --- a/desk/lib/contacts/json-0.hoon +++ b/desk/lib/contacts/json-0.hoon @@ -10,7 +10,7 @@ |=(her=@p n+(rap 3 '"' (scot %p her) '"' ~)) :: ++ action - |= a=action-0:c + |= a=action-0:legacy:c ^- json %+ frond -.a ?- -.a @@ -23,7 +23,7 @@ == :: ++ contact - |= c=contact-0:c + |= c=contact-0:legacy:c ^- json %- pairs :~ nickname+s+nickname.c @@ -39,7 +39,7 @@ == :: ++ field - |= f=field-0:c + |= f=field-0:legacy:c ^- json %+ frond -.f ?- -.f @@ -54,15 +54,15 @@ == :: ++ rolodex - |= r=rolodex-0:c + |= r=rolodex-0:legacy:c ^- json %- pairs %- ~(rep by r) - |= [[who=@p foreign-0:c] j=(list [@t json])] + |= [[who=@p foreign-0:legacy:c] j=(list [@t json])] [[(scot %p who) ?.(?=([@ ^] for) ~ (contact con.for))] j] :: XX stale flag per sub state? :: ++ news - |= n=news-0:c + |= n=news-0:legacy:c ^- json %- pairs :~ who+(ship who.n) @@ -93,7 +93,7 @@ == :: ++ action - ^- $-(json action-0:c) + ^- $-(json action-0:legacy:c) %- of :~ anon+ul edit+(ar field) @@ -104,7 +104,7 @@ == :: ++ contact - ^- $-(json contact-0:c) + ^- $-(json contact-0:legacy:c) %- ot :~ nickname+so bio+so @@ -116,7 +116,7 @@ == :: ++ field - ^- $-(json field-0:c) + ^- $-(json field-0:legacy:c) %- of :~ nickname+so bio+so diff --git a/desk/lib/contacts/json-1.hoon b/desk/lib/contacts/json-1.hoon index 66a72e93..fe11f00c 100644 --- a/desk/lib/contacts/json-1.hoon +++ b/desk/lib/contacts/json-1.hoon @@ -22,7 +22,7 @@ (cid +.kip) :: ++ value - |= val=value-1:c + |= val=value:c ^- json ?- -.val %text (pairs type+s/%text value+s/p.val ~) @@ -35,7 +35,7 @@ == :: ++ contact - |= c=contact-1:c + |= c=contact:c ^- json o+(~(run by c) value) :: @@ -62,11 +62,11 @@ =| dir=(map @ta json) :- %o %- ~(rep by directory) - |= [[who=@p con=contact-1:c] acc=_dir] + |= [[who=@p con=contact:c] acc=_dir] (~(put by acc) (scot %p who) (contact con)) :: ++ news - |= n=news-1:c + |= n=news:c ^- json ?- -.n %self (frond self+(contact con.n)) @@ -109,7 +109,7 @@ [mas (wit jon)] :: ++ value - ^- $-(json value-1:c) + ^- $-(json value:c) |= jon=json :: XX is there a way to do it in one go? :: @@ -133,10 +133,10 @@ %set %. val (ta %set (as value)) == ++ contact - ^- $-(json contact-1:c) + ^- $-(json contact:c) (om value) ++ action - ^- $-(json action-1:c) + ^- $-(json action:c) %- of :~ anon+ul self+contact diff --git a/desk/mar/contact-0.hoon b/desk/mar/contact-0.hoon index b9383f83..1668866a 100644 --- a/desk/mar/contact-0.hoon +++ b/desk/mar/contact-0.hoon @@ -1,14 +1,14 @@ /- c=contacts /+ j=contacts-json-0 -|_ =contact-0:c +|_ contact=contact-0:legacy:c ++ grad %noun ++ grow |% - ++ noun contact-0 - ++ json (contact:enjs:j contact-0) + ++ noun contact + ++ json (contact:enjs:j contact) -- ++ grab |% - ++ noun contact-0:c + ++ noun contact-0:legacy:c -- -- diff --git a/desk/mar/contact-1.hoon b/desk/mar/contact-1.hoon index 4418f7c0..03897aa4 100644 --- a/desk/mar/contact-1.hoon +++ b/desk/mar/contact-1.hoon @@ -1,6 +1,6 @@ /- c=contacts /+ j=contacts-json-1 -|_ contact=contact-1:c +|_ contact=contact:c ++ grad %noun ++ grow |% @@ -9,7 +9,7 @@ -- ++ grab |% - ++ noun contact-1:c + ++ noun contact:c ++ json contact:dejs:j -- -- diff --git a/desk/mar/contact/action-0.hoon b/desk/mar/contact/action-0.hoon index 9c9ac701..eea44981 100644 --- a/desk/mar/contact/action-0.hoon +++ b/desk/mar/contact/action-0.hoon @@ -1,6 +1,6 @@ /- c=contacts /+ j=contacts-json-0 -|_ action=action-0:c +|_ action=action-0:legacy:c ++ grad %noun ++ grow |% @@ -9,7 +9,7 @@ -- ++ grab |% - ++ noun action-0:c + ++ noun action-0:legacy:c ++ json action:dejs:j -- -- diff --git a/desk/mar/contact/action-1.hoon b/desk/mar/contact/action-1.hoon index 3d8a88e1..45257928 100644 --- a/desk/mar/contact/action-1.hoon +++ b/desk/mar/contact/action-1.hoon @@ -1,6 +1,6 @@ /- c=contacts /+ j=contacts-json-1 -|_ action=action-1:c +|_ action=action:c ++ grad %noun ++ grow |% @@ -8,7 +8,7 @@ -- ++ grab |% - ++ noun action-1:c + ++ noun action:c ++ json action:dejs:j -- -- diff --git a/desk/mar/contact/news-1.hoon b/desk/mar/contact/news-1.hoon index 7671e4dc..db705bfe 100644 --- a/desk/mar/contact/news-1.hoon +++ b/desk/mar/contact/news-1.hoon @@ -1,6 +1,6 @@ /- c=contacts /+ j=contacts-json-1 -|_ news=news-1:c +|_ =news:c ++ grad %noun ++ grow |% @@ -9,6 +9,6 @@ -- ++ grab |% - ++ noun news-1:c + ++ noun news:c -- -- diff --git a/desk/mar/contact/news.hoon b/desk/mar/contact/news.hoon index de1ea35d..1f3ab55e 100644 --- a/desk/mar/contact/news.hoon +++ b/desk/mar/contact/news.hoon @@ -1,6 +1,6 @@ /- c=contacts /+ j=contacts-json-0 -|_ news=news-0:c +|_ news=news-0:legacy:c ++ grad %noun ++ grow |% @@ -9,6 +9,6 @@ -- ++ grab |% - ++ noun news-0:c + ++ noun news-0:legacy:c -- -- diff --git a/desk/mar/contact/rolodex.hoon b/desk/mar/contact/rolodex.hoon index e3aab8d8..ec4d9867 100644 --- a/desk/mar/contact/rolodex.hoon +++ b/desk/mar/contact/rolodex.hoon @@ -1,14 +1,14 @@ /- c=contacts -/+ j=contacts-json -|_ rol=rolodex-0:c +/+ j=contacts-json-0 +|_ rol=rolodex-0:legacy:c ++ grad %noun ++ grow |% ++ noun rol - ++ json (rolodex-0:enjs:j rol) + ++ json (rolodex:enjs:j rol) -- ++ grab |% - ++ noun rolodex-0:c + ++ noun rolodex-0:legacy:c -- -- diff --git a/desk/mar/contact/update-0.hoon b/desk/mar/contact/update-0.hoon index 8b7a43b6..4410d0d2 100644 --- a/desk/mar/contact/update-0.hoon +++ b/desk/mar/contact/update-0.hoon @@ -1,5 +1,5 @@ /- c=contacts -|_ update=update-0:c +|_ update=update-0:legacy:c ++ grad %noun ++ grow |% @@ -7,7 +7,7 @@ -- ++ grab |% - ++ noun update-0:c + ++ noun update-0:legacy:c -- -- diff --git a/desk/mar/contact/update-1.hoon b/desk/mar/contact/update-1.hoon index d979d7a6..f5d9fc52 100644 --- a/desk/mar/contact/update-1.hoon +++ b/desk/mar/contact/update-1.hoon @@ -1,5 +1,5 @@ /- c=contacts -|_ update=update-1:c +|_ update=update:c ++ grad %noun ++ grow |% @@ -7,6 +7,6 @@ -- ++ grab |% - ++ noun update-1:c + ++ noun update:c -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index b177218d..845175a2 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -30,21 +30,8 @@ -- :: +| %types -+$ contact-0 - $: nickname=@t - bio=@t - status=@t - color=@ux - avatar=(unit @t) - cover=(unit @t) - groups=(set flag:g) - == -:: -+$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga-0)] -+$ profile-0 [wen=@da con=$@(~ contact-0)] -+$ rolodex-0 (map ship foreign-0) :: -+$ value-type-1 ++$ value-type $? %text %date %tint @@ -52,27 +39,10 @@ %cult %set == -++ unis - |= set=(set value-1) - ^- ? - ?~ set & - =/ typ -.n.set - |- - ?^ l.set - ?. =(typ -.n.l.set) - | - $(set l.set) - ?^ r.set - ?. =(typ -.n.r.set) - | - $(set r.set) - ?. =(typ -.n.set) - | - & -:: $value-1: contact field value +:: $value: contact field value :: -+$ value-1 - $+ contact-value-1 ++$ value + $+ contact-value $@ ~ $% [%text p=@t] [%date p=@da] @@ -88,29 +58,48 @@ [%cult p=flag:g] :: :: uniform set - [%set $|(p=(set value-1) unis)] + [%set p=$|((set value) unis)] == -:: $contact-1: contact data +:: +unis: whether set is uniformly typed :: -+$ contact-1 (map @tas value-1) -:: $foreign-1: foreign profile -:: -:: .for: profile -:: .sag: connection status +++ unis + |= set=(set value) + ^- ? + ?~ set & + =/ typ -.n.set + |- + ?^ l.set + ?. =(typ -.n.l.set) + | + $(set l.set) + ?^ r.set + ?. =(typ -.n.r.set) + | + $(set r.set) + ?. =(typ -.n.set) + | + & +:: $contact: contact data :: -+$ foreign-1 [for=$@(~ profile-1) sag=$@(~ saga)] -:: $profile-1: contact profile ++$ contact (map @tas value) +:: $profile: contact profile :: :: .wen: last updated :: .con: contact :: -+$ profile-1 [wen=@da con=contact-1] ++$ profile [wen=@da con=contact] +:: $foreign: foreign profile +:: +:: .for: profile +:: .sag: connection status +:: ++$ foreign [for=$@(~ profile) sag=$@(~ saga)] :: $page: contact page :: :: .p: peer contact :: .q: user overlay :: -+$ page (pair contact-1 contact-1) ++$ page (pair contact contact) :: $cid: contact page id :: +$ cid @uvF @@ -122,60 +111,17 @@ +$ book (map kip page) :: $directory: merged contacts :: -+$ directory (map ship contact-1) ++$ directory (map ship contact) :: $peers: network peers :: -+$ peers (map ship foreign-1) ++$ peers (map ship foreign) :: +$ epic epic:e -+$ saga-0 - $@ $? %want :: subscribing - %fail :: %want failed - %lost :: epic %fail - ~ :: none intended - == - saga:e :: +$ saga $? %want :: subscribing ~ :: none intended == -:: -+$ field-0 - $% [%nickname nickname=@t] - [%bio bio=@t] - [%status status=@t] - [%color color=@ux] - [%avatar avatar=(unit @t)] - [%cover cover=(unit @t)] - [%add-group =flag:g] - [%del-group =flag:g] - == -:: -+$ action-0 - :: %anon: delete our profile - :: %edit: change our profile - :: %meet: track a peer - :: %heed: follow a peer - :: %drop: discard a peer - :: %snub: unfollow a peer - :: - $% [%anon ~] - [%edit p=(list field-0)] - [%meet p=(list ship)] - [%heed p=(list ship)] - [%drop p=(list ship)] - [%snub p=(list ship)] - == -:: network -:: -+$ update-0 - $% [%full profile-0] - == -:: local -:: -+$ news-0 - [who=ship con=$@(~ contact-0)] :: %anon: delete the profile :: %self: edit the profile :: %page: create a new contact page @@ -186,35 +132,97 @@ :: %drop: discard a peer :: %snub: unfollow a peer :: -+$ action-1 ++$ action $% [%anon ~] - [%self p=contact-1] - [%page p=cid q=contact-1] - [%spot p=ship q=contact-1] - [%edit p=kip q=contact-1] + [%self p=contact] + [%page p=cid q=contact] + [%spot p=ship q=contact] + [%edit p=kip q=contact] [%wipe p=(list kip)] [%meet p=(list ship)] [%drop p=(list ship)] [%snub p=(list ship)] == -:: network +:: network update :: :: %full: our profile :: -+$ update-1 - $% [%full profile-1] ++$ update + $% [%full profile] == -:: $news-1: local update +:: $news: local update :: :: %self: profile update :: %page: contact page update :: %wipe: contact page delete :: %peer: peer update :: -+$ news-1 - $% [%self con=contact-1] - [%page =kip con=contact-1 mod=contact-1] ++$ news + $% [%self con=contact] + [%page =kip con=contact mod=contact] [%wipe =kip] - [%peer who=ship con=contact-1] + [%peer who=ship con=contact] == ++| %legacy +:: +++ legacy + |% + +$ contact-0 + $: nickname=@t + bio=@t + status=@t + color=@ux + avatar=(unit @t) + cover=(unit @t) + groups=(set flag:g) + == + :: + +$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga-0)] + +$ profile-0 [wen=@da con=$@(~ contact-0)] + +$ rolodex-0 (map ship foreign-0) + :: + +$ saga-0 + $@ $? %want :: subscribing + %fail :: %want failed + %lost :: epic %fail + ~ :: none intended + == + saga:e + :: + +$ field-0 + $% [%nickname nickname=@t] + [%bio bio=@t] + [%status status=@t] + [%color color=@ux] + [%avatar avatar=(unit @t)] + [%cover cover=(unit @t)] + [%add-group =flag:g] + [%del-group =flag:g] + == + :: + +$ action-0 + :: %anon: delete our profile + :: %edit: change our profile + :: %meet: track a peer + :: %heed: follow a peer + :: %drop: discard a peer + :: %snub: unfollow a peer + :: + $% [%anon ~] + [%edit p=(list field-0)] + [%meet p=(list ship)] + [%heed p=(list ship)] + [%drop p=(list ship)] + [%snub p=(list ship)] + == + :: network + :: + +$ update-0 + $% [%full profile-0] + == + :: local + :: + +$ news-0 + [who=ship con=$@(~ contact-0)] + -- -- diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 8821d1ac..6fd668c9 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -25,16 +25,16 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0 + =| con-0=contact-0:legacy:legacy =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' :: - =/ con-1=contact-1 + =/ con-1=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] - =/ edit-0=(list field-0) - ^- (list field-0) + =/ edit-0=(list field-0:legacy) + ^- (list field-0:legacy) :~ nickname+'Zod' bio+'The first of the galaxies' == @@ -48,15 +48,15 @@ ;< caz=(list card) b (do-watch /news) :: ;< ~ b (set-src our.bowl) - :: action-0 profile %edit + :: action-0:legacy profile %edit :: - ;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0])) + ;< caz=(list card) b (do-poke contact-action+!>([%edit edit-0])) :: - =/ upd-0=update-0 + =/ upd-0=update-0:legacy [%full (mono now.bowl now.bowl) ~] - =/ upd-1=update-1 + =/ upd-1=update [%full (mono now.bowl now.bowl) ~] - ;< caz=(list card) b (do-poke %contact-action !>([%anon ~])) + ;< caz=(list card) b (do-poke contact-action+!>([%anon ~])) %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([our.bowl ~])) (ex-fact ~[/v1/news] contact-news-1+!>([%self ~])) @@ -72,23 +72,26 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0 + =| con-0=contact-0:legacy:legacy =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' + =. groups.con-0 (silt ~sampel-palnet^%oranges ~) :: - =/ con-1=contact-1 + =/ con=contact %- malt - ^- (list (pair @tas value-1)) - ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] + ^- (list (pair @tas value)) + :~ nickname+text/'Zod' + bio+text/'The first of the galaxies' + groups+set/(silt cult/~sampel-palnet^%oranges ~) + == :: - =/ upd-0=update-0 - [%full now.bowl con-0] - =/ upd-1=update-1 - [%full now.bowl con-1] - =/ edit-0=(list field-0) - ^- (list field-0) + =/ edit-0=(list field-0:legacy) + ^- (list field-0:legacy) :~ nickname+'Zod' bio+'The first of the galaxies' + add-group+~sampel-palnet^%apples + add-group+~sampel-palnet^%oranges + del-group+~sampel-palnet^%apples == :: foreign subscriber to /v1/contact :: @@ -104,14 +107,52 @@ ;< caz=(list card) b (do-watch /v1/news) :: ;< ~ b (set-src our.bowl) - :: action-0 profile %edit + :: action-0:legacy profile %edit :: ;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0])) - %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self con-1])) - (ex-fact ~[/v1/contact] contact-update-1+!>([%full now.bowl con-1])) - == + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self con])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full now.bowl con])) + == + :: profile is set + :: + ;< peek=(unit (unit cage)) b + (get-peek /x/v1/self) + =/ cag (need (need peek)) + ;< ~ b + %+ ex-equal + !> cag + !> contact-1+!>(con) + :: change groups + :: + ;< caz=(list card) b + (do-poke %contact-action !>([%edit del-group+~sampel-palnet^%oranges ~])) + =/ new-con + (~(put by con) groups+set/~) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0(groups ~)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self new-con])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full (add now.bowl tick) new-con])) + == + :: remove bio + :: + ;< caz=(list card) b + (do-poke %contact-action-1 !>([%self `contact`[%bio^~ ~ ~]])) + :: add oranges back + :: + ;< caz=(list card) b + (do-poke %contact-action !>([%edit add-group+~sampel-palnet^%oranges ~])) + :: profile is missing bio + :: + ;< peek=(unit (unit cage)) b + (get-peek /x/v1/self) + =/ cag (need (need peek)) + %+ ex-equal + !> cag + !> contact-1+!>(`contact`(~(del by con) %bio)) :: +test-poke-meet-0: v0 meet a peer :: ++ test-poke-0-meet @@ -153,9 +194,9 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-1=contact-1 + =/ con-1=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] :: =/ edit-1 con-1 @@ -171,10 +212,10 @@ ;< ~ b (set-src our.bowl) :: edit the profile :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%self con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%self con-1])) :: delete the profile :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%anon ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%anon ~])) :: contact update is published on /v1/contact :: news is published on /news, /v1/news :: @@ -208,18 +249,18 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0 + =| con-0=contact-0:legacy:legacy =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' :: - =/ con-1=contact-1 + =/ con-1=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] :: - =/ upd-0=update-0 + =/ upd-0=update-0:legacy [%full now.bowl con-0] - =/ upd-1=update-1 + =/ upd-1=update [%full now.bowl con-1] =/ edit-1 con-1 :: foreign subscriber to /contact @@ -233,7 +274,7 @@ :: ;< ~ b (set-src our.bowl) :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%self con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%self con-1])) %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0])) (ex-fact ~[/v1/news] contact-news-1+!>([%self con-1])) @@ -249,12 +290,12 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-1=contact-1 + =/ con-1=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] :: - =/ =news-1 + =/ =news [%page id+0v1 ~ con-1] =/ mypage=^page [p=~ q=con-1] @@ -266,11 +307,11 @@ ;< ~ b (set-src our.bowl) :: create new contact page :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] %contact-news-1 !>(news-1)) + :~ (ex-fact ~[/v1/news] contact-news-1+!>(news)) == :: peek page in the book: new contact page is found :: @@ -282,7 +323,7 @@ !> [%contact-page-1 !>(mypage)] :: fail to create duplicate page :: - %- ex-fail (do-poke %contact-action-1 !>([%page 0v1 con-1])) + %- ex-fail (do-poke contact-action-1+!>([%page 0v1 con-1])) :: +test-poke-edit: edit the contact book :: ++ test-poke-edit @@ -292,13 +333,20 @@ ^- form:m ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl - :: - =/ con-1=contact-1 + =/ groups + ^- (list value) + :~ cult/~sampel-palnet^%apples + cult/~sampel-palnet^%oranges + == + =/ con-1=contact %- malt - ^- (list (pair @tas value-1)) - ~[nickname+text/'Sun' bio+text/'It is bright today'] + ^- (list (pair @tas value)) + :~ nickname+text/'Sun' + bio+text/'It is bright today' + groups+set/(silt groups) + == :: - =/ =news-1 + =/ =news [%page id+0v1 ~ con-1] =/ mypage=^page [p=~ q=con-1] @@ -311,11 +359,11 @@ ;< ~ b (set-src our.bowl) :: create new contact page :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-news-1+!>(news-1)) + :~ (ex-fact ~[/v1/news] contact-news-1+!>(news)) == :: peek page in the book: new contact page is found :: @@ -324,6 +372,8 @@ %+ ex-equal !> [%contact-page-1 q.cage] !> [%contact-page-1 !>(mypage)] + :: delete favourite groups + :: :: ++ test-poke-meet %- eval-mare @@ -333,9 +383,9 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-sun=contact-1 + =/ con-sun=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] :: local subscriber to /news :: @@ -343,12 +393,12 @@ ;< caz=(list card) b (do-watch /news) :: meet ~sun :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%meet ~[~sun]])) :: ~sun publishes his contact :: ;< ~ b (set-src ~sun) ;< caz=(list card) b - (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) @@ -361,12 +411,12 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) + !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: meet ~sun a second time: a no-op :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + ;< caz=(list card) b (do-poke %contact-action !>([%meet ~[~sun]])) (ex-cards caz ~) :: ++ test-poke-spot-unknown @@ -377,9 +427,9 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-sun=contact-1 + =/ con-sun=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] :: local subscriber to /news :: @@ -387,7 +437,7 @@ ;< caz=(list card) b (do-watch /news) :: spot ~sun to contact boook: he also becomes our peer :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) @@ -402,12 +452,12 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign-1`[~ %want]) + !> contact-foreign-1+!>(`foreign`[~ %want]) :: ~sun publishes his contact :: ;< ~ b (set-src ~sun) ;< caz=(list card) b - (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) @@ -417,11 +467,11 @@ :: ~sun contact page is edited :: ;< ~ b (set-src our.bowl) - =/ con-mod=contact-1 + =/ con-mod=contact %- malt - ^- (list (pair @tas value-1)) + ^- (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])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) :: ~sun's contact book page is updated :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) @@ -436,7 +486,7 @@ =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> [%contact-1 !>((contact-mod:c con-sun con-mod))] + !> contact-1+!>((contact-mod:c con-sun con-mod)) :: ++ test-poke-spot-wipe %- eval-mare @@ -446,9 +496,9 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-sun=contact-1 + =/ con-sun=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] :: local subscriber to /news :: @@ -456,12 +506,12 @@ ;< caz=(list card) b (do-watch /news) :: meet ~sun :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%meet ~[~sun]])) :: ~sun publishes his contact :: ;< ~ b (set-src ~sun) ;< caz=(list card) b - (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) @@ -474,23 +524,23 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) + !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: ~sun is added to contacts :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) == :: ~sun contact page is edited :: - =/ con-mod=contact-1 + =/ con-mod=contact %- malt - ^- (list (pair @tas value-1)) + ^- (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])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) @@ -503,7 +553,7 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) + !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) :: however, ~sun's contact book page is changed :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) @@ -519,10 +569,10 @@ ;< ~ b %+ ex-equal !> cag - !> [%contact-1 !>((contact-mod:c con-sun con-mod))] + !> contact-1+!>((contact-mod:c con-sun con-mod)) :: ~sun contact page is deleted :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%wipe ~[~sun]])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%wipe ~[~sun]])) ;< ~ b %+ ex-cards caz :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) @@ -539,7 +589,7 @@ =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) + !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) :: ++ test-poke-drop %- eval-mare @@ -549,9 +599,9 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-sun=contact-1 + =/ con-sun=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] :: local subscriber to /news :: @@ -559,12 +609,12 @@ ;< caz=(list card) b (do-watch /news) :: meet ~sun :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%meet ~[~sun]])) :: ~sun publishes his contact :: ;< ~ b (set-src ~sun) ;< caz=(list card) b - (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) @@ -577,23 +627,23 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] %want]) + !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: ~sun is added to contacts :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) == :: ~sun contact page is edited :: - =/ con-mod=contact-1 + =/ con-mod=contact %- malt - ^- (list (pair @tas value-1)) + ^- (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])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) @@ -602,7 +652,7 @@ :: ~sun is dropped :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%drop ~[~sun]])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%drop ~[~sun]])) ;< ~ b %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %leave ~) @@ -632,9 +682,9 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-sun=contact-1 + =/ con-sun=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] :: local subscriber to /news :: @@ -642,12 +692,12 @@ ;< caz=(list card) b (do-watch /news) :: meet ~sun :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%meet ~[~sun]])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%meet ~[~sun]])) :: ~sun publishes his contact :: ;< ~ b (set-src ~sun) ;< caz=(list card) b - (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) @@ -656,7 +706,7 @@ :: ~sun is added to contacts :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) @@ -671,9 +721,9 @@ == :: ~sun modifies his contact :: - =/ con-mod=contact-1 + =/ con-mod=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Bright Sun' avatar+text/'https://sun.io/sun.png'] ;< ~ b (set-src ~sun) :: fact fails: no subscription @@ -683,7 +733,7 @@ :: :* /contact :: [~sun %contacts] :: %fact - :: %contact-update-1 + :: %contact-update :: !>([%full now.bowl (~(uni by con-sun) con-mod)]) :: == :: ~sun is still found in peers @@ -692,7 +742,7 @@ =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign-1`[[now.bowl con-sun] ~]) + !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] ~]) :: +| %peek ++ test-peek-0-all @@ -703,13 +753,13 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-sun=contact-1 + =/ con-sun=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] - =/ con-mur=contact-1 + =/ con-mur=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Mur' bio+text/'Murky waters'] :: meet ~sun and ~mur :: @@ -730,7 +780,7 @@ ;< peek=(unit (unit cage)) b (get-peek /x/all) =/ cag=cage (need (need peek)) ?> ?=(%contact-rolodex p.cag) - =/ rol !<(rolodex-0 q.cag) + =/ rol !<(rolodex-0:legacy q.cag) ;< ~ b %+ ex-equal !> (~(got by rol) ~sun) @@ -748,17 +798,17 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-1=contact-1 + =/ con-1=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] - =/ con-2=contact-1 + =/ con-2=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Mur' bio+text/'Murky waters'] :: - ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v1 con-1])) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%page 0v2 con-2])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v2 con-2])) :: peek book: two contacts are found :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book) @@ -780,17 +830,17 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =/ con-sun=contact-1 + =/ con-sun=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] - =/ con-mur=contact-1 + =/ con-mur=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[nickname+text/'Mur' bio+text/'Murky waters'] - =/ con-mod=contact-1 + =/ con-mod=contact %- malt - ^- (list (pair @tas value-1)) + ^- (list (pair @tas value)) ~[avatar+text/'https://sun.io/sun.png'] :: meet ~sun and ~mur :: @@ -800,16 +850,16 @@ :: ;< ~ b (set-src ~sun) ;< caz=(list card) b - (do-agent /contact [~sun %contacts] %fact %contact-update-1 !>([%full now.bowl con-sun])) + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) :: ~sun is added to the contact book with user overlay :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke %contact-action-1 !>([%spot ~sun con-mod])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun con-mod])) :: ~mur publishes his contact :: ;< ~ b (set-src ~mur) ;< caz=(list card) b - (do-agent /contact [~mur %contacts] %fact %contact-update-1 !>([%full now.bowl con-mur])) + (do-agent /contact [~mur %contacts] %fact contact-update-1+!>([%full now.bowl con-mur])) :: peek all: two contacts are found :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/all) diff --git a/desk/tests/lib/contacts-json-1.hoon b/desk/tests/lib/contacts-json-1.hoon index e04ecdca..f1891abc 100644 --- a/desk/tests/lib/contacts-json-1.hoon +++ b/desk/tests/lib/contacts-json-1.hoon @@ -3,7 +3,7 @@ /+ c=contacts, j=contacts-json-1 :: /= c0 /mar/contact-0 -/= c1 /mar/contact-1 +/= c1 /mar/contact /~ mar * /mar/contact :: |% @@ -65,14 +65,14 @@ :: %+ jex-equal %- value:enjs:j - [%set (silt `(list value-1)`~[cult/[~sampel-palnet %circle] cult/[~sampel-pardux %square]])] + [%set (silt `(list value)`~[cult/[~sampel-palnet %circle] cult/[~sampel-pardux %square]])] '{"type":"set","value":[{"type":"cult","value":"~sampel-palnet/circle"},{"type":"cult","value":"~sampel-pardux/square"}]}' == ++ test-contact %+ jex-equal %- contact:enjs:j %- malt - ^- (list [@tas value-1]) + ^- (list [@tas value]) :~ name+text/'Sampel' surname+text/'Palnet' == From 5e7ea0ed3989f5f1772643b1dbea1e6756c68e50 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 17 Sep 2024 15:05:44 +0800 Subject: [PATCH 25/44] contacts: fix contact sanity check placement --- desk/app/contacts.hoon | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index b6a8b8be..8bb2055f 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -154,7 +154,6 @@ :: ++ p-self |= con=(map @tas value) - ?> (sane-contact con) =/ old=contact ?.(?=([@ ^] rof) *contact con.rof) :: XX handle deletion of fields @@ -162,20 +161,20 @@ (do-edit old con) ?: =(old new) cor + ?> (sane-contact new) (p-send-self new) :: +p-page: create new contact page :: ++ p-page |= [=cid con=contact] - ?> (sane-contact con) ?: (~(has by book) id+cid) ~| "contact page {} already exists" !! + ?> (sane-contact con) (p-send-page cid con) :: +p-edit: edit contact page overlay :: ++ p-edit |= [=kip mod=(map @tas value)] - ?> (sane-contact mod) =/ =page ~| "contact page {} does not exist" (~(got by book) kip) @@ -185,6 +184,7 @@ (do-edit old mod) ?: =(old new) cor + ?> (sane-contact new) (p-send-edit kip p.page new) :: +p-wipe: delete a contact page :: @@ -200,7 +200,6 @@ :: ++ p-spot |= [who=ship mod=contact] - ?> (sane-contact mod) ?: (~(has by book) who) ~| "peer {} is already a contact" !! =/ con=contact @@ -209,6 +208,7 @@ (~(got by peers) who) ?~ for.far *contact con.for.far + ?> (sane-contact mod) (p-send-spot who con mod) :: ++ p-send-self From 1294dda6a2287642d09c390838a8340ae7458bd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Thu, 19 Sep 2024 14:15:37 +0800 Subject: [PATCH 26/44] contacts: refactor --- desk/app/contacts.hoon | 247 +++++++++++----------------- desk/lib/contacts-json.hoon | 1 + desk/lib/contacts.hoon | 109 ++++++------ desk/lib/contacts/json-0.hoon | 21 ++- desk/lib/contacts/json-1.hoon | 10 +- desk/lib/mark-warmer.hoon | 11 +- desk/lib/negotiate.hoon | 5 - desk/mar/contact.hoon | 3 +- desk/mar/contact/directory.hoon | 6 +- desk/mar/contact/page.hoon | 14 ++ desk/mar/contact/rolodex.hoon | 4 +- desk/mar/contact/update-0.hoon | 1 - desk/sur/contacts.hoon | 41 ++--- desk/tests/app/contacts.hoon | 137 ++++++++++----- desk/tests/lib/contacts-json-1.hoon | 2 +- 15 files changed, 313 insertions(+), 299 deletions(-) create mode 100644 desk/mar/contact/page.hoon diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 8bb2055f..b0c298fd 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -10,19 +10,19 @@ :: :: .con: a contact :: .rof: our profile -:: .rol: our full rolodex (v0) +:: .rol: [legacy] our full rolodex :: .far: foreign peer :: .for: foreign profile :: .sag: foreign subscription state :: -+| %types ++| %molds +$ card card:agent:gall +$ state-1 [%1 rof=$@(~ profile) =book =peers] -- -%- %^ agent:neg - notify=| - [~.contacts^%1 ~ ~] - [~.contacts^[~.contacts^%1 ~ ~] ~ ~] +:: %- %^ agent:neg +:: notify=| +:: [~.contacts^%1 ~ ~] +:: [~.contacts^[~.contacts^%1 ~ ~] ~ ~] %- agent:dbug %+ verb | ^- agent:gall @@ -93,7 +93,7 @@ :: +| %operations :: - :: |pub: publication mgmt + :: +pub: publication management :: :: - /v1/news: local updates to our profile and rolodex :: - /v1/contact: updates to our profile @@ -107,7 +107,7 @@ :: published ad-hoc, elsewhere. :: :: Facts are always send in the following order: - :: 1. (legacy) /news + :: 1. [legacy] /news :: 2. /v1/news :: 3. /v1/contact :: @@ -122,26 +122,11 @@ :: same. Thus on each contact update we need to filter :: over 5.000 elements: do some benchmarking. :: - :: XX when there are no subscribers on a path, we still - :: send facts on an empty path. This is no problem, unless - :: it is used in ++peer - :: - :: ++ subs-0 - :: ^- (set path) - :: %- ~(rep by sup.bowl) - :: |= [[duct ship pat=path] acc=(set path)] - :: ?.(?=([%contact *] pat) acc (~(put in acc) pat)) ++ subs ^- (set path) %- ~(rep by sup.bowl) |= [[duct ship pat=path] acc=(set path)] ?.(?=([%v1 %contact *] pat) acc (~(put in acc) pat)) - :: - :: ++ fact-0 - :: |= [pat=(set path) u=update-0] - :: ^- gift:agent:gall - :: [%fact ~(tap in pat) %contact-update !>(u)] - :: ++ fact |= [pat=(set path) u=update] ^- gift:agent:gall @@ -149,14 +134,15 @@ -- :: |% + :: +p-anon: delete our profile :: ++ p-anon ?.(?=([@ ^] rof) cor (p-send-self ~)) + :: +p-self: edit our profile :: ++ p-self |= con=(map @tas value) =/ old=contact ?.(?=([@ ^] rof) *contact con.rof) - :: XX handle deletion of fields =/ new=contact (do-edit old con) ?: =(old new) @@ -171,10 +157,24 @@ ~| "contact page {} already exists" !! ?> (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) + ~| "peer {} is already a contact" !! + =/ con=contact + ~| "peer {} not found" + =/ far=foreign + (~(got by peers) who) + ?~ for.far *contact + con.for.far + ?> (sane-contact mod) + (p-send-spot who con mod) :: +p-edit: edit contact page overlay :: ++ p-edit - |= [=kip mod=(map @tas value)] + |= [=kip mod=contact] =/ =page ~| "contact page {} does not exist" (~(got by book) kip) @@ -196,20 +196,7 @@ ~| "contact id {} not found" (~(got by book) kip) (p-send-wipe kip page) - :: +p-spot: add as a contact - :: - ++ p-spot - |= [who=ship mod=contact] - ?: (~(has by book) who) - ~| "peer {} is already a contact" !! - =/ con=contact - ~| "peer {} not found" - =/ far=foreign - (~(got by peers) who) - ?~ for.far *contact - con.for.far - ?> (sane-contact mod) - (p-send-spot who con mod) + :: +p-send-self: publish modified profile :: ++ p-send-self |= con=contact @@ -229,37 +216,28 @@ [*contact mod] =. book (~(put by book) id+cid page) (p-news [%page id+cid page]) + :: +p-send-spot: publish peer spot + :: + ++ p-send-spot + |= [who=ship con=contact mod=contact] + =. book + (~(put by book) who con mod) + (p-news [%page who con mod]) :: +p-send-edit: publish contact page update :: ++ p-send-edit |= [=kip =page] =. book (~(put by book) kip page) - :: this is a peer page, send v0 update - :: - :: =? cor ?=(ship kip) - :: %+ p-news-0:legacy kip - :: (to-contact-0:legacy (contact-mod page)) (p-news [%page kip page]) + :: +p-send-wipe: publish contact page wipe :: ++ p-send-wipe |= [=kip =page] =. book (~(del by book) kip) - :: XX :: peer overlay lost: v0 peer contact is modified - :: :: - :: =? cor &(?=(ship kip) !?=(~ q.page)) - :: :: v0 peer contact is modified - :: %+ p-news-0:legacy kip - :: (to-contact-0:legacy p.page) (p-news [%wipe kip]) - :: +p-send-spot: publish peer spot - :: - ++ p-send-spot - |= [who=ship con=contact mod=contact] - =. book - (~(put by book) who con mod) - (p-news [%page who con mod]) + :: +p-init: publish our profile :: ++ p-init |= wen=(unit @da) @@ -269,10 +247,12 @@ :: :: no future subs ?>((lth u.wen wen.rof) (give (fact ~ full+rof))) + :: +p-news-0: [legacy] publish news :: ++ p-news-0 |= n=news-0:legacy (give %fact ~[/news] %contact-news !>(n)) + :: +p-news: publish news :: ++ p-news |= n=news @@ -281,7 +261,7 @@ :: :: +sub: subscription mgmt :: - :: /contact/*: foreign profiles, |s-impl + :: /contact/*: foreign profiles, _s-impl :: :: subscription state is tracked per peer in .sag :: @@ -294,9 +274,6 @@ ++ sub |^ |= who=ship ^+ s-impl - :: XX it seems lib negotiate does not set a correct - :: src.bowl! - :: ?< =(our.bowl who) =/ old (~(get by peers) who) ~(. s-impl who %live ?=(~ old) (fall old *foreign)) @@ -326,8 +303,6 @@ :: %dead ?: new cor =. peers (~(del by peers) who) - =/ page=(unit page) - (~(get by book) who) :: :: this is not quite right, reflecting *total* deletion :: as *contact* deletion. but it's close, and keeps /news simpler @@ -358,12 +333,12 @@ ?> (sane-contact con.u) ?: &(?=(^ for) (lte wen.u wen.for)) si-cor - %= si-cor + %_ si-cor for +.u cor =. cor (p-news-0:pub who (to-contact-0 con.u)) =/ page=(unit page) (~(get by book) who) - :: update peer contact + :: update peer contact page :: =? cor ?=(^ page) ?: =(p.u.page con.u) cor @@ -374,7 +349,9 @@ :: ++ si-meet ^+ si-cor - ?. ?=(~ sag) + :: + :: already connected + ?: ?=(%want sag) si-cor =/ pat [%v1 %contact ?~(for / /at/(scot %da wen.for))] %= si-cor @@ -387,10 +364,9 @@ ++ si-snub %_ si-cor sag ~ - cor ?+ sag cor - %want - (pass /contact %agent [who dap.bowl] %leave ~) - == == + cor ?. ?=(%want sag) cor + (pass /contact %agent [who dap.bowl] %leave ~) + == -- -- :: @@ -454,6 +430,11 @@ ?- -.old %0 =. rof ?~(rof.old ~ (to-profile rof.old)) + :: migrate peers. for each peer + :: 1. leave /epic, if any + :: 2. subscribe if desired + :: 3. put into peers + :: =^ caz=(list card) peers %+ roll ~(tap by rol.old) |= [[who=ship foreign-0:legacy] caz=(list card) =_peers] @@ -462,48 +443,21 @@ =? caz (~(has by wex.bowl) [/epic who dap.bowl]) :_ caz [%pass /epic %agent [who dap.bowl] %leave ~] - =/ for-1=$@(~ profile) + =/ fir=$@(~ profile) ?~ for ~ (to-profile for) - :: no intent to subscribe + :: no intent to connect :: ?: =(~ sag) :- caz - (~(put by peers) who for-1 ~) - :_ (~(put by peers) who for-1 %want) + (~(put by peers) who fir ~) + :_ (~(put by peers) who fir %want) ?: (~(has by wex.bowl) [/contact who dap.bowl]) caz - =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] + =/ =path [%v1 %contact ?~(fir / /at/(scot %da wen.fir))] :_ caz [%pass /contact %agent [who dap.bowl] %watch path] (emil caz) - :: in v0, any sag that is not null indicates intent to connect, - :: that could fail due to version mismatch or other reasons. - :: therefore, a v0 sag not equal to null means we should - :: subscribe to the peer at the new v1 endpoint. - :: - :: XX Should we manually leave all v0 /contact - :: connections? - :: XX Should we kick all our v0 /contact subscribers? - :: - :: no intent to connect - :: - :: ?: =(~ sag) - :: :- caz - :: (~(put by peers) who for-1 ~) - :: leave existing v0 connection - :: XX it seems lib-negotiate handles this - :: :_ caz - :: [%pass /contact %agent [who dap.bowl] %leave ~] - :: - :: XX it seems lib-negotiate will initiate this by - :: simulating a %kick - :: :- :_ caz - :: =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] - :: [%pass /contact %agent [who dap.bowl] %watch path] - :: (~(put by peers) who for-1 %want) - :: - :: (emil cards) :: %1 =. state old @@ -521,26 +475,13 @@ caz (emil cards) == - +$ state-0 [%0 rof=$@(~ profile-0:legacy) rol=rolodex-0:legacy] + +$ state-0 [%0 rof=$@(~ profile-0:legacy) rol=rolodex:legacy] +$ versioned-state $% state-0 state-1 == :: ++ l-epic (give %fact [/epic ~] epic+!>(okay)) - :: - :: ++ l-bump - :: ^+ cor - :: %- ~(rep by rol) - :: |= [[who=ship foreign] =_cor] - :: :: XX to fully support downgrade, we'd need to also - :: :: save an epic in %lev - :: :: - :: ?. ?& ?=([%dex *] sag) - :: =(okay ver.sag) - :: == - :: cor - :: si-abet:si-heed:si-snub:(sub:cor who) -- :: ++ poke @@ -558,9 +499,8 @@ ?> =(our src):bowl =/ act=action ?- mark - %contact-action-1 - !<(action vase) :: + :: legacy %contact-action ?(act:base:mar %contact-action-0) =/ act-0 !<(action-0:legacy vase) ?. ?=(%edit -.act-0) @@ -573,12 +513,18 @@ =+ set=(~(ges cy con.rof) groups+%cult) ?: =(~ set) ~ (need set) - [%self (to-edit-1 p.act-0 groups)] + [%self (to-self-edit p.act-0 groups)] + :: + %contact-action-1 + !<(action vase) == ?- -.act %anon p-anon:pub %self (p-self:pub p.act) %page (p-page:pub p.act q.act) + :: if we spot someone who is not a peer, + :: we meet them first + :: %spot =? cor !(~(has by peers) p.act) si-abet:si-meet:(sub p.act) (p-spot:pub p.act q.act) @@ -593,7 +539,7 @@ :: :: v0 scries :: - :: /x/all -> $rolodex-0:legacy + :: /x/all -> $rolodex:legacy :: /x/contact/her=@ -> $@(~ contact-0:legacy) :: :: v1 scries @@ -610,9 +556,9 @@ |= pat=(pole knot) ^- (unit (unit cage)) ?+ pat [~ ~] - :: + :: [%x %all ~] - =/ rol-0=rolodex-0:legacy + =/ rol-0=rolodex:legacy %- ~(urn by peers) |= [who=ship far=foreign] ^- foreign-0:legacy @@ -621,31 +567,32 @@ ~ q.u.page (to-foreign-0 (foreign-mod far mod)) - =/ lor-0=rolodex-0:legacy + =/ lor-0=rolodex:legacy ?: |(?=(~ rof) ?=(~ con.rof)) rol-0 (~(put by rol-0) our.bowl (to-profile-0 rof) ~) ``contact-rolodex+!>(lor-0) - :: + :: [%x %contact her=@ ~] ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] =/ tac=?(~ contact-0:legacy) ?: =(our.bowl u.who) ?~(rof ~ (to-contact-0 con.rof)) - =+ (~(get by peers) u.who) - ?: |(?=(~ -) ?=(~ for.u.-)) ~ - (to-contact-0 con.for.u.-) + =+ far=(~(get by peers) u.who) + ?: |(?=(~ far) ?=(~ for.u.far)) ~ + (to-contact-0 con.for.u.far) ?~ tac [~ ~] ``contact+!>(`contact-0:legacy`tac) - :: + :: [%x %v1 %self ~] ?~ rof [~ ~] ?~ con.rof [~ ~] ``contact-1+!>(`contact`con.rof) - :: + :: [%x %v1 %book ~] - ``contact-book-1+!>(book) - :: + ?~ book [~ ~] + ``contact-book-0+!>(book) + :: [%x %v1 %book her=@p ~] ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] @@ -653,8 +600,8 @@ (~(get by book) u.who) ?~ page [~ ~] - ``contact-page-1+!>(`^page`u.page) - :: + ``contact-page-0+!>(`^page`u.page) + :: [%x %v1 %book %id =cid ~] ?~ id=`(unit @uv)`(slaw %uv cid.pat) [~ ~] @@ -662,30 +609,30 @@ (~(get by book) id+u.id) ?~ page [~ ~] - ``contact-page-1+!>(`^page`u.page) - :: + ``contact-page-0+!>(`^page`u.page) + :: [%x %v1 %all ~] - =| all=directory + =| dir=directory :: export all ship contacts :: - =. all + =. dir %- ~(rep by book) - |= [[=kip =page] =_all] + |= [[=kip =page] =_dir] ?^ kip - all - (~(put by all) kip (contact-mod page)) + dir + (~(put by dir) kip (contact-uni page)) :: export all peers :: - =. all + =. dir %- ~(rep by peers) - |= [[who=ship far=foreign] =_all] - ?~ for.far all - ?: (~(has by all) who) all - (~(put by all) who `contact`con.for.far) - ?~ all + |= [[who=ship far=foreign] =_dir] + ?~ for.far dir + ?: (~(has by dir) who) dir + (~(put by dir) who con.for.far) + ?~ dir [~ ~] - ``contact-directory-1+!>(all) - :: + ``contact-directory-0+!>(dir) + :: [%x %v1 %contact her=@p ~] ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] @@ -694,8 +641,8 @@ ?~ page=(~(get by book) u.who) ?~ for.u.far [~ ~] ``contact-1+!>(con.for.u.far) - ``contact-1+!>((contact-mod u.page)) - :: + ``contact-1+!>((contact-uni u.page)) + :: [%x %v1 %peer her=@p ~] ?~ who=`(unit @p)`(slaw %p her.pat) [~ ~] diff --git a/desk/lib/contacts-json.hoon b/desk/lib/contacts-json.hoon index fb1ab6f2..9c6b26e6 100644 --- a/desk/lib/contacts-json.hoon +++ b/desk/lib/contacts-json.hoon @@ -1,5 +1,6 @@ /- c=contacts, g=groups /+ gj=groups-json +=, legacy:c |% ++ enjs =, enjs:format diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 75249032..4025f5e8 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -4,7 +4,7 @@ :: ++ cy |_ c=contact - :: +get: get typed value + :: +get: typed get :: ++ get |* [key=@tas typ=value-type] @@ -22,15 +22,15 @@ %cult ?>(?=(%cult -.u.val) (some p.u.val)) %set ?>(?=(%set -.u.val) (some p.u.val)) == - :: +ges: get specialized to set + :: +ges: get specialized to typed set :: ++ ges |* [key=@tas typ=value-type] ^- (unit (set $>(_typ value))) =/ val=(unit value) (~(get by c) key) ?~ val ~ - ~| "set expected at {}" - ?> ?=(%set -.u.val) + ?. ?=(%set -.u.val) + ~| "set expected at {}" !! %- some %- ~(run in p.u.val) ?- typ @@ -42,14 +42,14 @@ %cult |=(v=value ?>(?=(%cult -.v) v)) %set |=(v=value ?>(?=(%set -.v) v)) == - :: +gos: got specialized to set + :: +gos: got specialized to typed set :: ++ gos |* [key=@tas typ=value-type] ^- (set $>(_typ value)) =/ val=value (~(got by c) key) - ~| "set expected at {}" - ?> ?=(%set -.val) + ?. ?=(%set -.val) + ~| "set expected at {}" !! %- ~(run in p.val) ?- typ %text |=(v=value ?>(?=(%text -.v) v)) @@ -60,7 +60,7 @@ %cult |=(v=value ?>(?=(%cult -.v) v)) %set |=(v=value ?>(?=(%set -.v) v)) == - :: +gut: got with default + :: +gut: typed gut with default :: ++ gut |* [key=@tas def=value] @@ -78,7 +78,7 @@ %cult ?>(?=(%cult -.def) p.val) %set ?>(?=(%set -.def) p.val) == - :: +gub: got with bunt default + :: +gub: typed gut with bunt default :: ++ gub |* [key=@tas typ=value-type] @@ -94,6 +94,7 @@ %cult *flag:g %set *(set value) == + ~| "{} expected at {}" ?- typ %text ?>(?=(%text -.val) p.val) %date ?>(?=(%date -.val) p.val) @@ -106,7 +107,7 @@ -- :: ++ do-edit-0 - |= [c=contact-0:legacy:legacy f=field-0:legacy] + |= [c=contact-0:legacy f=field-0:legacy] ^+ c ?- -.f %nickname c(nickname nickname.f) @@ -130,18 +131,21 @@ :: %del-group c(groups (~(del in groups.c) flag.f)) == +:: +sane-contact: verify contact sanity +:: +:: - restrict size of the jammed noun to 1kB +:: - prohibit 'data:' URLs in image data :: ++ sane-contact |= con=contact ^- ? - :: 1kB contact should be enough for everyone + :: 1kB contact ought to be enough for anybody :: ?: (gth (met 3 (jam con)) 1.000) | :: prohibit data URLs in the image links :: =+ avatar=(~(get cy con) %avatar %text) - :: XX restrict also on ?: ?& ?=(^ avatar) =('data:' (end 3^5 u.avatar)) == @@ -152,14 +156,17 @@ == | & +:: +do-edit: edit contact +:: +:: edit .con with .mod contact map. +:: unifies the two maps, and deletes any resulting fields +:: that are null. :: ++ do-edit - |= [con=contact edit=(map @tas value)] + |= [con=contact mod=(map @tas value)] ^+ con - =/ don (~(uni by con) edit) + =/ don (~(uni by con) mod) =/ del=(list @tas) - :: XX accumulate new map? - :: %- ~(rep by don) |= [[key=@tas val=value] acc=(list @tas)] ?. ?=(~ val) acc @@ -168,9 +175,8 @@ %+ roll del |= [key=@tas acc=_don] (~(del by don) key) - ?> (sane-contact don) don -:: +to-contact: convert contact-0:legacy:legacy +:: +to-contact: convert legacy to contact :: ++ to-contact |= c=contact-0:legacy @@ -194,14 +200,14 @@ |= =flag:g cult/flag o -:: +to-contact-0: convert contact +:: +to-contact-0: convert to legacy contact-0 :: ++ to-contact-0 |= c=contact ^- $@(~ contact-0:legacy) ?~ c ~ =| o=contact-0:legacy - %= o + %_ o nickname (~(gub cy c) %nickname %text) bio @@ -211,10 +217,8 @@ color (~(gub cy c) %color %tint) avatar - :: XX prohibit data: link (~(get cy c) %avatar %text) cover - :: XX prohibit data: link (~(get cy c) %cover %text) groups =/ groups @@ -226,49 +230,53 @@ ?> ?=(%cult -.val) p.val == -:: +contact-mod: merge contacts +:: +contact-uni: merge contacts :: -++ contact-mod +++ contact-uni |= [c=contact mod=contact] ^- contact (~(uni by c) mod) -:: +to-profile: convert profile-0:legacy +:: +to-profile: convert legacy to profile :: ++ to-profile |= o=profile-0:legacy ^- profile [wen.o ?~(con.o ~ (to-contact con.o))] -:: +to-profile-0:legacy: convert profile +:: +to-profile-0: convert to legacy profile-0 :: ++ to-profile-0 |= p=profile ^- profile-0:legacy [wen.p (to-contact-0 con.p)] +:: +to-profile-0-mod: convert to legacy profile-0 with +:: contact overlay :: ++ to-profile-0-mod |= [p=profile mod=contact] ^- profile-0:legacy - [wen.p (to-contact-0 (contact-mod con.p mod))] + [wen.p (to-contact-0 (contact-uni con.p mod))] +:: +to-foreign-0: convert to legacy foreign-0 :: ++ to-foreign-0 |= f=foreign ^- foreign-0:legacy [?~(for.f ~ (to-profile-0 for.f)) sag.f] -:: +to-foreign-0-mod: convert foreign with contact overlay +:: +to-foreign-0-mod: convert to legacy foreign-0 +:: with contact overlay :: ++ to-foreign-0-mod |= [f=foreign mod=contact] ^- foreign-0:legacy [?~(for.f ~ (to-profile-0-mod for.f mod)) sag.f] -:: +foreign-mod: fuse peer contact with overlay +:: +foreign-mod: modify foreign profile with user overlay :: ++ foreign-mod |= [far=foreign mod=contact] ^- foreign ?~ for.far far - far(con.for (contact-mod con.for.far mod)) -:: +foreign-contact: grab foreign contact + far(con.for (contact-uni con.for.far mod)) +:: +foreign-contact: get foreign contact :: ++ foreign-contact |= far=foreign @@ -278,57 +286,60 @@ +$ sole-field-0 $~ nickname+'' $<(?(%add-group %del-group) field-0:legacy) +:: +to-sole-edit: convert legacy sole field to contact edit +:: +:: modify any field except for groups :: -++ to-sole-edit-1 +++ to-sole-edit |= edit-0=(list sole-field-0) ^- contact %+ roll edit-0 |= $: fed=sole-field-0 acc=(map @tas value) == - :: XX under a single ~put ? ^+ acc ?- -.fed - :: + :: %nickname %+ ~(put by acc) %nickname text/nickname.fed - :: + :: %bio %+ ~(put by acc) %bio text/bio.fed - :: + :: %status %+ ~(put by acc) %status text/status.fed - :: + :: %color %+ ~(put by acc) %color tint/color.fed - :: + :: %avatar ?~ avatar.fed acc %+ ~(put by acc) %avatar look/u.avatar.fed - :: + :: %cover ?~ cover.fed acc %+ ~(put by acc) %cover look/u.cover.fed == +:: +to-self-edit: convert legacy to self edit :: -++ to-edit-1 +++ to-self-edit |= [edit-0=(list field-0:legacy) groups=(set value)] ^- contact - :: translating v0 profile edit to v1 %self is non-trivial: + :: converting v0 profile edit to v1 is non-trivial. :: for field edits other than groups, we derive a contact - :: edit map. for group operations (%add-group, %del-group) + :: edition map. for group operations (%add-group, %del-group) :: we need to operate directly on (existing?) groups field in :: the profile. :: @@ -338,8 +349,7 @@ =* group-type ?(%add-group %del-group) =* sole-edits (list $<(group-type field-0:legacy)) =* group-edits (list $>(group-type field-0:legacy)) - :: sift v0 edits - :: XX tall structure mode? + :: sift edits :: =/ [sid=sole-edits gid=group-edits] :: @@ -353,7 +363,7 @@ gid :- sid [f gid] - :: edit groups + :: edit favourite groups :: =. groups %+ roll gid @@ -362,12 +372,16 @@ %add-group (~(put in groups) cult/flag.ged) %del-group - ~| "group {} not found" (~(del in groups) cult/flag.ged) == - %- ~(uni by (to-sole-edit-1 sid)) + %- ~(uni by (to-sole-edit sid)) ^- contact [%groups^set/groups ~ ~] +:: +to-action: convert legacy to action +:: +:: convert any action except %edit. +:: %edit must be handled separately, since we need +:: access to existing groups to be able to process group edits. :: ++ to-action |= o=$<(%edit action-0:legacy) @@ -381,6 +395,7 @@ %drop [%drop p.o] %snub [%snub p.o] == +:: +mono: tick time :: ++ mono |= [old=@da new=@da] diff --git a/desk/lib/contacts/json-0.hoon b/desk/lib/contacts/json-0.hoon index de66a895..d3711a24 100644 --- a/desk/lib/contacts/json-0.hoon +++ b/desk/lib/contacts/json-0.hoon @@ -1,5 +1,6 @@ /- c=contacts, g=groups /+ gj=groups-json +=, legacy:c |% ++ enjs =, enjs:format @@ -10,7 +11,7 @@ |=(her=@p n+(rap 3 '"' (scot %p her) '"' ~)) :: ++ action - |= a=action-0:legacy:c + |= a=action-0 ^- json %+ frond -.a ?- -.a @@ -23,7 +24,7 @@ == :: ++ contact - |= c=contact-0:legacy:c + |= c=contact-0 ^- json %- pairs :~ nickname+s+nickname.c @@ -39,7 +40,7 @@ == :: ++ field - |= f=field-0:legacy:c + |= f=field-0 ^- json %+ frond -.f ?- -.f @@ -54,15 +55,15 @@ == :: ++ rolodex - |= r=rolodex-0:legacy:c + |= r=^rolodex ^- json %- pairs %- ~(rep by r) - |= [[who=@p foreign-0:legacy:c] j=(list [@t json])] + |= [[who=@p foreign-0] j=(list [@t json])] [[(scot %p who) ?.(?=([@ ^] for) ~ (contact con.for))] j] :: XX stale flag per sub state? :: ++ news - |= n=news-0:legacy:c + |= n=news-0 ^- json %- pairs :~ who+(ship who.n) @@ -83,6 +84,8 @@ |= jon=json ?+ jon !! [%s *] (slav aur p.jon) + :: XX this seems wrong: current JSON parser + :: would never pass a ship as a number :: [%n *] ~| bad-n+p.jon =/ wyd (met 3 p.jon) @@ -93,7 +96,7 @@ == :: ++ action - ^- $-(json action-0:legacy:c) + ^- $-(json action-0) %- of :~ anon+ul edit+(ar field) @@ -104,7 +107,7 @@ == :: ++ contact - ^- $-(json contact-0:legacy:c) + ^- $-(json contact-0) %- ot :~ nickname+so bio+so @@ -116,7 +119,7 @@ == :: ++ field - ^- $-(json field-0:legacy:c) + ^- $-(json field-0) %- of :~ nickname+so bio+so diff --git a/desk/lib/contacts/json-1.hoon b/desk/lib/contacts/json-1.hoon index fe11f00c..1ff6bb0d 100644 --- a/desk/lib/contacts/json-1.hoon +++ b/desk/lib/contacts/json-1.hoon @@ -4,7 +4,6 @@ ++ enjs =, enjs:format |% - :: XX shadowed for compat, +ship:enjs removes the ~ :: ++ ship |=(her=@p n+(rap 3 '"' (scot %p her) '"' ~)) @@ -43,8 +42,7 @@ |= =page:c ^- json a+[(contact p.page) (contact q.page) ~] - :: +$ kip $@(@p [%id cid]) - :: +$ book (map kip page) + :: ++ book |= =book:c ^- json @@ -102,6 +100,7 @@ ?: =('~' (end [3 1] p.jon)) (ship jon) id+(cid jon) + :: +ta: tag .wit parsed json with .mas :: ++ ta |* [mas=@tas wit=fist] @@ -119,9 +118,6 @@ ?+ type !! %text %. val (ta %text so) %date %. val (ta %date (se %da)) - :: XX invert arguments in +cu: arguments likely - :: to be heavy should always be at the back - :: %tint %. val %+ ta %tint %+ cu @@ -132,9 +128,11 @@ %cult %. val (ta %cult flag:dejs:gj) %set %. val (ta %set (as value)) == + :: ++ contact ^- $-(json contact:c) (om value) + :: ++ action ^- $-(json action:c) %- of diff --git a/desk/lib/mark-warmer.hoon b/desk/lib/mark-warmer.hoon index ad40eb98..fab2ff39 100644 --- a/desk/lib/mark-warmer.hoon +++ b/desk/lib/mark-warmer.hoon @@ -1,15 +1,14 @@ /$ rolo %contact-rolodex %json -/$ contact %contact-0 %json +/$ contact-0 %contact %json +/$ news-0 %contact-news %json /$ contact-1 %contact-1 %json -/$ page-1 %contact-page-1 %json -/$ book-1 %contact-book %json -/$ dir-1 %contact-directory %json +/$ page %contact-page %json +/$ book %contact-book %json +/$ dir %contact-directory %json /$ news-1 %contact-news-1 %json /$ skeins %hark-skeins %json /$ carpet %hark-carpet %json /$ blanket %hark-blanket %json /$ settings %settings-data %json -:: XX defunct? -:: /$ creds %update %json /$ storage %storage-update %json ~ diff --git a/desk/lib/negotiate.hoon b/desk/lib/negotiate.hoon index 9c90d496..236de8bc 100644 --- a/desk/lib/negotiate.hoon +++ b/desk/lib/negotiate.hoon @@ -514,11 +514,6 @@ =* sub i.suz =. cards (snoc cards [%pass wire.sub %agent gill.sub %leave ~]) =. wex.bowl (~(del by wex.bowl) -.sub) - :: XX this seems wrong: src is not set - :: =^ caz inner (on-agent:og wire.sub %kick ~) - :: =^ caz inner - :: =. src.bowl.inner-bowl p.gill.i.suz - :: (on-agent:og wire.sub %kick ~) =^ caz inner %. [wire.sub %kick ~] =. src.bowl p.gill.i.suz diff --git a/desk/mar/contact.hoon b/desk/mar/contact.hoon index 65a88985..aa4bd1cb 100644 --- a/desk/mar/contact.hoon +++ b/desk/mar/contact.hoon @@ -1,2 +1,3 @@ -/% contact-0 %contact-0 +/= contact-0 /mar/contact-0 contact-0 + diff --git a/desk/mar/contact/directory.hoon b/desk/mar/contact/directory.hoon index 6bdab661..b7c399c1 100644 --- a/desk/mar/contact/directory.hoon +++ b/desk/mar/contact/directory.hoon @@ -1,11 +1,11 @@ /- c=contacts /+ j=contacts-json-1 -|_ directory=directory:c +|_ dir=directory:c ++ grad %noun ++ grow |% - ++ noun directory - ++ json (directory:enjs:j directory) + ++ noun dir + ++ json (directory:enjs:j dir) -- ++ grab |% diff --git a/desk/mar/contact/page.hoon b/desk/mar/contact/page.hoon new file mode 100644 index 00000000..ca628447 --- /dev/null +++ b/desk/mar/contact/page.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =page:c +++ grad %noun +++ grow + |% + ++ noun page + ++ json (page:enjs:j page) + -- +++ grab + |% + ++ noun page:c + -- +-- diff --git a/desk/mar/contact/rolodex.hoon b/desk/mar/contact/rolodex.hoon index ec4d9867..1f7de769 100644 --- a/desk/mar/contact/rolodex.hoon +++ b/desk/mar/contact/rolodex.hoon @@ -1,6 +1,6 @@ /- c=contacts /+ j=contacts-json-0 -|_ rol=rolodex-0:legacy:c +|_ rol=rolodex:legacy:c ++ grad %noun ++ grow |% @@ -9,6 +9,6 @@ -- ++ grab |% - ++ noun rolodex-0:legacy:c + ++ noun rolodex:legacy:c -- -- diff --git a/desk/mar/contact/update-0.hoon b/desk/mar/contact/update-0.hoon index 4410d0d2..e9c89b79 100644 --- a/desk/mar/contact/update-0.hoon +++ b/desk/mar/contact/update-0.hoon @@ -8,6 +8,5 @@ ++ grab |% ++ noun update-0:legacy:c - -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 845175a2..0187e443 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -1,19 +1,5 @@ /- e=epic, g=groups |% -:: [compat] protocol-versioning scheme -:: -:: adopted from :groups, slightly modified. -:: -:: for our action/update marks, we -:: - *must* support our version (+okay) -:: - *should* support previous versions (especially actions) -:: - but *can't* support future versions -:: -:: in the case of updates at unsupported protocol versions, -:: we backoff and subscribe for version changes (/epic). -:: (this alone is unlikely to help with future versions, -:: but perhaps our peer will downgrade. in the meantime, -:: we wait to be upgraded.) :: +| %compat ++ okay `epic`1 @@ -30,6 +16,7 @@ -- :: +| %types +:: $value-type: contact field value type :: +$ value-type $? %text @@ -39,12 +26,13 @@ %cult %set == -:: $value: contact field value +:: $value: contact field value :: +$ value $+ contact-value $@ ~ $% [%text p=@t] + :: [%quot p=@ud] [%date p=@da] :: :: color @@ -79,40 +67,40 @@ ?. =(typ -.n.set) | & -:: $contact: contact data +:: $contact: contact data :: +$ contact (map @tas value) -:: $profile: contact profile +:: $profile: contact profile :: :: .wen: last updated :: .con: contact :: +$ profile [wen=@da con=contact] -:: $foreign: foreign profile +:: $foreign: foreign profile :: :: .for: profile :: .sag: connection status :: +$ foreign [for=$@(~ profile) sag=$@(~ saga)] -:: $page: contact page +:: $page: contact page :: :: .p: peer contact :: .q: user overlay :: +$ page (pair contact contact) -:: $cid: contact page id +:: $cid: contact page id :: +$ cid @uvF -:: $kip: contact book key +:: $kip: contact book key :: +$ kip $@(ship [%id cid]) -:: $book: contact book +:: $book: contact book :: +$ book (map kip page) -:: $directory: merged contacts +:: $directory: merged contacts :: +$ directory (map ship contact) -:: $peers: network peers +:: $peers: network peers :: +$ peers (map ship foreign) :: @@ -150,7 +138,7 @@ +$ update $% [%full profile] == -:: $news: local update +:: $news: local update :: :: %self: profile update :: %page: contact page update @@ -164,6 +152,7 @@ [%peer who=ship con=contact] == +| %legacy +:: XX move to /sur/contacts-0.hoon? :: ++ legacy |% @@ -179,7 +168,7 @@ :: +$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga-0)] +$ profile-0 [wen=@da con=$@(~ contact-0)] - +$ rolodex-0 (map ship foreign-0) + +$ rolodex (map ship foreign-0) :: +$ saga-0 $@ $? %want :: subscribing diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 6fd668c9..7f684a8d 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -3,8 +3,10 @@ /+ c=contacts /= contacts-agent /app/contacts =* agent contacts-agent -:: XX consider structuring tests better -:: with functional 'micro' strands +:: XX consider simplifying tests +:: with functional 'micro' strands, that set +:: a contact, subscribe to a peer etc. +:: |% +| %help ++ tick ^~((rsh 3^2 ~s1)) @@ -319,8 +321,8 @@ =/ =cage (need (need peek)) ;< ~ b %+ ex-equal - !> [%contact-page-1 q.cage] - !> [%contact-page-1 !>(mypage)] + !> [%contact-page-0 q.cage] + !> [%contact-page-0 !>(mypage)] :: fail to create duplicate page :: %- ex-fail (do-poke contact-action-1+!>([%page 0v1 con-1])) @@ -370,8 +372,8 @@ ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/id/0v1) =/ =cage (need (need peek)) %+ ex-equal - !> [%contact-page-1 q.cage] - !> [%contact-page-1 !>(mypage)] + !> [%contact-page-0 q.cage] + !> [%contact-page-0 !>(mypage)] :: delete favourite groups :: :: @@ -479,14 +481,14 @@ ;< ~ b %+ ex-equal !> cag - !> [%contact-page-1 !>(`page:c`[con-sun con-mod])] + !> [%contact-page-0 !>(`page:c`[con-sun con-mod])] :: and his effective contact is changed :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/contact/~sun) =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> contact-1+!>((contact-mod:c con-sun con-mod)) + !> contact-1+!>((contact-uni:c con-sun con-mod)) :: ++ test-poke-spot-wipe %- eval-mare @@ -561,7 +563,7 @@ ;< ~ b %+ ex-equal !> cag - !> [%contact-page-1 !>(`page:c`[con-sun con-mod])] + !> [%contact-page-0 !>(`page:c`[con-sun con-mod])] :: and his effective contact is changed :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/contact/~sun) @@ -569,7 +571,7 @@ ;< ~ b %+ ex-equal !> cag - !> contact-1+!>((contact-mod:c con-sun con-mod)) + !> contact-1+!>((contact-uni:c con-sun con-mod)) :: ~sun contact page is deleted :: ;< caz=(list card) b (do-poke contact-action-1+!>([%wipe ~[~sun]])) @@ -672,8 +674,16 @@ =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> contact-page-1+!>(`page:c`[con-sun con-mod]) + !> contact-page-0+!>(`page:c`[con-sun con-mod]) +:: +test-poke-snub: test snubbing a peer +:: +:: scenario :: +:: we heve a local subscriber to /news. we meet +:: 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 ,~) @@ -686,10 +696,9 @@ %- malt ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] - :: local subscriber to /news :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-watch /news) + ;< caz=(list card) b (do-watch /v1/news) :: meet ~sun :: ;< caz=(list card) b (do-poke contact-action-1+!>([%meet ~[~sun]])) @@ -703,14 +712,6 @@ :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) == - :: ~sun is added to contacts - :: - ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) - ;< ~ b - %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) - == :: ~sun is snubbed :: ;< ~ b (set-src our.bowl) @@ -719,23 +720,6 @@ %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %leave ~) == - :: ~sun modifies his contact - :: - =/ con-mod=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Bright Sun' avatar+text/'https://sun.io/sun.png'] - ;< ~ b (set-src ~sun) - :: fact fails: no subscription - :: XX extend test-agent to allow this test - :: ;< ~ b %- ex-fail - :: %- do-agent - :: :* /contact - :: [~sun %contacts] - :: %fact - :: %contact-update - :: !>([%full now.bowl (~(uni by con-sun) con-mod)]) - :: == :: ~sun is still found in peers :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) @@ -744,7 +728,76 @@ !> cag !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] ~]) :: ++| %peer +:: +test-peer-profile +:: +:: scenario +:: +:: ~sun subscribes to our /contact. we publish +:: our profile with current time-a. we then change +:: the profile, advancing the timestamp to time-b. +:: ~sun now subscribes to /contact/at/time-b. +:: no update is sent. +:: +++ test-peer-profile + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con=contact + %- malt + ^- (list (pair @tas value)) + ~[nickname+text/'Dev' bio+text/'Let\'s build'] + :: edit our profile + :: + ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (to-contact-0:c con)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self con])) + (ex-fact ~ contact-update-1+!>([%full now.bowl con])) + == + :: ~sun subscribes to /contact, profile is published + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /v1/contact) + ;< ~ b %+ ex-cards caz + :~ (ex-fact ~ contact-update-1+!>([%full now.bowl con])) + == + :: we update our profile, which advances the timestamp. + :: update is published. + :: + =+ now=(add now.bowl tick) + =. con (~(put by con) birthday+date/~2000.1.1) + ;< ~ b (set-src our.bowl) + ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (to-contact-0:c con)])) + (ex-fact ~[/v1/news] contact-news-1+!>([%self con])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full now con])) + == + :: ~sun resubscribes to /contact/at/old-now + :: update is sent + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /v1/contact/at/(scot %da now.bowl)) + ;< ~ b + %+ ex-cards caz + :~ (ex-fact ~ contact-update-1+!>([%full now con])) + == + :: ~sun subscribes to /contact/at/(add now.bowl tick). + :: no update is sent - already at latest + :: + ;< ~ b (set-src ~sun) + ;< caz=(list card) b (do-watch /v1/contact/at/(scot %da now)) + %+ ex-cards caz ~ +:: +| %peek +:: ++ test-peek-0-all %- eval-mare =/ m (mare ,~) @@ -780,7 +833,7 @@ ;< peek=(unit (unit cage)) b (get-peek /x/all) =/ cag=cage (need (need peek)) ?> ?=(%contact-rolodex p.cag) - =/ rol !<(rolodex-0:legacy q.cag) + =/ rol !<(rolodex:legacy q.cag) ;< ~ b %+ ex-equal !> (~(got by rol) ~sun) @@ -813,7 +866,7 @@ :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book) =/ cag=cage (need (need peek)) - ?> ?=(%contact-book-1 p.cag) + ?> ?=(%contact-book-0 p.cag) =/ =book !<(book q.cag) ;< ~ b %+ ex-equal @@ -864,12 +917,12 @@ :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/all) =/ cag=cage (need (need peek)) - ?> ?=(%contact-directory-1 p.cag) + ?> ?=(%contact-directory-0 p.cag) =/ dir !<(directory q.cag) ;< ~ b %+ ex-equal !> (~(got by dir) ~sun) - !> (contact-mod:c con-sun con-mod) + !> (contact-uni:c con-sun con-mod) %+ ex-equal !> (~(got by dir) ~mur) !> con-mur diff --git a/desk/tests/lib/contacts-json-1.hoon b/desk/tests/lib/contacts-json-1.hoon index f1891abc..99fe6494 100644 --- a/desk/tests/lib/contacts-json-1.hoon +++ b/desk/tests/lib/contacts-json-1.hoon @@ -1,6 +1,6 @@ /- *contacts, g=groups /+ *test -/+ c=contacts, j=contacts-json-1 +/+ c=contacts, j=contacts-json-1, mark-warmer :: /= c0 /mar/contact-0 /= c1 /mar/contact From b843ceb7fcdaad2de389e649afb565e6a8a3d437 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Thu, 19 Sep 2024 14:50:35 +0800 Subject: [PATCH 27/44] contacts: implement number field type %quot --- desk/app/contacts.hoon | 8 +++---- desk/lib/contacts.hoon | 6 +++++ desk/lib/contacts/json-1.hoon | 2 ++ desk/sur/contacts.hoon | 3 ++- desk/tests/lib/contacts-json-1.hoon | 34 ++++++++++++++++------------- 5 files changed, 33 insertions(+), 20 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index b0c298fd..ca2374a5 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -19,10 +19,10 @@ +$ card card:agent:gall +$ state-1 [%1 rof=$@(~ profile) =book =peers] -- -:: %- %^ agent:neg -:: notify=| -:: [~.contacts^%1 ~ ~] -:: [~.contacts^[~.contacts^%1 ~ ~] ~ ~] +%- %^ agent:neg + notify=| + [~.contacts^%1 ~ ~] + [~.contacts^[~.contacts^%1 ~ ~] ~ ~] %- agent:dbug %+ verb | ^- agent:gall diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 4025f5e8..e51776ca 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -15,6 +15,7 @@ ~| "{} expected at {}" ?- typ %text ?>(?=(%text -.u.val) (some p.u.val)) + %quot ?>(?=(%quot -.u.val) (some p.u.val)) %date ?>(?=(%date -.u.val) (some p.u.val)) %tint ?>(?=(%tint -.u.val) (some p.u.val)) %ship ?>(?=(%ship -.u.val) (some p.u.val)) @@ -35,6 +36,7 @@ %- ~(run in p.u.val) ?- typ %text |=(v=value ?>(?=(%text -.v) v)) + %quot |=(v=value ?>(?=(%quot -.v) v)) %date |=(v=value ?>(?=(%date -.v) v)) %tint |=(v=value ?>(?=(%tint -.v) v)) %ship |=(v=value ?>(?=(%ship -.v) v)) @@ -53,6 +55,7 @@ %- ~(run in p.val) ?- typ %text |=(v=value ?>(?=(%text -.v) v)) + %quot |=(v=value ?>(?=(%quot -.v) v)) %date |=(v=value ?>(?=(%date -.v) v)) %tint |=(v=value ?>(?=(%tint -.v) v)) %ship |=(v=value ?>(?=(%ship -.v) v)) @@ -71,6 +74,7 @@ ~| "{<-.def>} expected at {}" ?- -.val %text ?>(?=(%text -.def) p.val) + %quot ?>(?=(%quot -.def) p.val) %date ?>(?=(%date -.def) p.val) %tint ?>(?=(%tint -.def) p.val) %ship ?>(?=(%ship -.def) p.val) @@ -87,6 +91,7 @@ ?~ val ?+ typ !! %text *@t + %quot *@ud %date *@da %tint *@ux %ship *@p @@ -97,6 +102,7 @@ ~| "{} expected at {}" ?- typ %text ?>(?=(%text -.val) p.val) + %quot ?>(?=(%quot -.val) p.val) %date ?>(?=(%date -.val) p.val) %tint ?>(?=(%tint -.val) p.val) %ship ?>(?=(%ship -.val) p.val) diff --git a/desk/lib/contacts/json-1.hoon b/desk/lib/contacts/json-1.hoon index 1ff6bb0d..13d9850f 100644 --- a/desk/lib/contacts/json-1.hoon +++ b/desk/lib/contacts/json-1.hoon @@ -25,6 +25,7 @@ ^- json ?- -.val %text (pairs type+s/%text value+s/p.val ~) + %quot (pairs type+s/%quot value+(numb p.val) ~) %date (pairs type+s/%date value+s/(scot %da p.val) ~) %tint (pairs type+s/%tint value+s/(rsh 3^2 (scot %ux p.val)) ~) %ship (pairs type+s/%ship value+(ship p.val) ~) @@ -117,6 +118,7 @@ (ot text+(se %tas) value+json ~) ?+ type !! %text %. val (ta %text so) + %quot %. val (ta %quot ni) %date %. val (ta %date (se %da)) %tint %. val %+ ta %tint diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 0187e443..4f07ad1e 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -20,6 +20,7 @@ :: +$ value-type $? %text + %quot %date %tint %look @@ -32,7 +33,7 @@ $+ contact-value $@ ~ $% [%text p=@t] - :: [%quot p=@ud] + [%quot p=@ud] [%date p=@da] :: :: color diff --git a/desk/tests/lib/contacts-json-1.hoon b/desk/tests/lib/contacts-json-1.hoon index 99fe6494..9bf07649 100644 --- a/desk/tests/lib/contacts-json-1.hoon +++ b/desk/tests/lib/contacts-json-1.hoon @@ -12,64 +12,68 @@ |= [a=vase b=vase] (expect-eq b a) :: -++ jex-equal +++ jen-equal |= [jon=json txt=@t] %+ ex-equal !> (en:json:html jon) !> txt :: ++ test-ship - %+ jex-equal + %+ jen-equal (ship:enjs:j ~sampel-palnet) '"~sampel-palnet"' ++ test-cid - %+ jex-equal + %+ jen-equal (cid:enjs:j 0v11abc) '"0v11abc"' ++ test-kip ;: weld - %+ jex-equal + %+ jen-equal (kip:enjs:j ~sampel-palnet) '"~sampel-palnet"' :: - %+ jex-equal + %+ jen-equal (kip:enjs:j id+0v11abc) '"0v11abc"' == ++ test-value ;: weld :: - %+ jex-equal - (value:enjs:j [%text 'the lazy fox']) + %+ jen-equal + (value:enjs:j text+'the lazy fox') '{"type":"text","value":"the lazy fox"}' :: - %+ jex-equal - (value:enjs:j [%date ~2024.9.11]) + %+ jen-equal + (value:enjs:j quot+42) + '{"type":"quot","value":42}' + :: + %+ jen-equal + (value:enjs:j date+~2024.9.11) '{"type":"date","value":"~2024.9.11"}' :: - %+ jex-equal + %+ jen-equal (value:enjs:j [%tint 0xcafe.babe]) '{"type":"tint","value":"cafe.babe"}' :: - %+ jex-equal + %+ jen-equal (value:enjs:j [%ship ~sampel-palnet]) '{"type":"ship","value":"~sampel-palnet"}' :: - %+ jex-equal + %+ jen-equal (value:enjs:j [%look 'https://ship.io/avatar.png']) '{"type":"look","value":"https://ship.io/avatar.png"}' :: - %+ jex-equal + %+ jen-equal (value:enjs:j [%cult [~sampel-palnet %circle]]) '{"type":"cult","value":"~sampel-palnet/circle"}' :: - %+ jex-equal + %+ jen-equal %- value:enjs:j [%set (silt `(list value)`~[cult/[~sampel-palnet %circle] cult/[~sampel-pardux %square]])] '{"type":"set","value":[{"type":"cult","value":"~sampel-palnet/circle"},{"type":"cult","value":"~sampel-pardux/square"}]}' == ++ test-contact - %+ jex-equal + %+ jen-equal %- contact:enjs:j %- malt ^- (list [@tas value]) From b2accdd7e54acb59ecd2d0e6f4bd11e39c7aa59e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Fri, 20 Sep 2024 17:21:28 +0800 Subject: [PATCH 28/44] contacts: refactoring --- desk/app/contacts.hoon | 161 +++++++++++--------- desk/lib/contacts.hoon | 227 +++++++++++++++------------- desk/lib/contacts/json-0.hoon | 3 +- desk/lib/contacts/json-1.hoon | 14 +- desk/lib/mark-warmer.hoon | 8 +- desk/mar/contact-0.hoon | 6 +- desk/mar/contact/action-0.hoon | 6 +- desk/mar/contact/news.hoon | 6 +- desk/mar/contact/rolodex.hoon | 6 +- desk/mar/contact/update-0.hoon | 6 +- desk/sur/contacts.hoon | 111 ++------------ desk/tests/app/contacts.hoon | 188 ++++++++++++++--------- desk/tests/lib/contacts-json-1.hoon | 12 +- 13 files changed, 376 insertions(+), 378 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index ca2374a5..1f5bbefe 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -1,9 +1,8 @@ -/- *contacts /+ default-agent, dbug, verb, neg=negotiate /+ *contacts :: :: performance, keep warm -/+ j0=contacts-json-0, j1=contacts-json-1 +/+ j0=contacts-json-0, j1=contacts-json-1, mark-warmer :: |% :: conventions @@ -17,12 +16,12 @@ :: +| %molds +$ card card:agent:gall -+$ state-1 [%1 rof=$@(~ profile) =book =peers] ++$ state-1 [%1 rof=profile =book =peers] -- -%- %^ agent:neg - notify=| - [~.contacts^%1 ~ ~] - [~.contacts^[~.contacts^%1 ~ ~] ~ ~] +:: %- %^ agent:neg +:: notify=| +:: [~.contacts^%1 ~ ~] +:: [~.contacts^[~.contacts^%1 ~ ~] ~ ~] %- agent:dbug %+ verb | ^- agent:gall @@ -130,7 +129,7 @@ ++ fact |= [pat=(set path) u=update] ^- gift:agent:gall - [%fact ~(tap in pat) upd:mar !>(u)] + [%fact ~(tap in pat) %contact-update-1 !>(u)] -- :: |% @@ -179,34 +178,31 @@ ~| "contact page {} does not exist" (~(got by book) kip) =/ old=contact - q.page + mod.page =/ new=contact (do-edit old mod) ?: =(old new) cor ?> (sane-contact new) - (p-send-edit kip p.page new) + (p-send-edit kip con.page new) :: +p-wipe: delete a contact page :: ++ p-wipe |= wip=(list kip) %+ roll wip - |= [=kip acc=_cor] - =/ =page - ~| "contact id {} not found" - (~(got by book) kip) - (p-send-wipe kip page) + |= [=kip acc=_cor] + (p-send-wipe kip) :: +p-send-self: publish modified profile :: ++ p-send-self |= con=contact - =/ p=profile [?~(rof now.bowl (mono wen.rof now.bowl)) con] + =/ p=profile [(mono wen.rof now.bowl) con] =. rof p :: =. cor - (p-news-0 our.bowl (to-contact-0 con)) + (p-news-0 our.bowl (contact:from con)) =. cor - (p-news [%self con]) + (p-resp [%self con]) (give (fact subs [%full p])) :: +p-send-page: publish new contact page :: @@ -215,33 +211,32 @@ =/ =page [*contact mod] =. book (~(put by book) id+cid page) - (p-news [%page id+cid page]) + (p-resp [%page id+cid page]) :: +p-send-spot: publish peer spot :: ++ p-send-spot |= [who=ship con=contact mod=contact] =. book (~(put by book) who con mod) - (p-news [%page who con mod]) + (p-resp [%page who con mod]) :: +p-send-edit: publish contact page update :: ++ p-send-edit |= [=kip =page] =. book (~(put by book) kip page) - (p-news [%page kip page]) + (p-resp [%page kip page]) :: +p-send-wipe: publish contact page wipe :: ++ p-send-wipe - |= [=kip =page] + |= =kip =. book (~(del by book) kip) - (p-news [%wipe kip]) + (p-resp [%wipe kip]) :: +p-init: publish our profile :: ++ p-init |= wen=(unit @da) - ?~ rof cor ?~ wen (give (fact ~ full+rof)) ?: =(u.wen wen.rof) cor :: @@ -252,11 +247,11 @@ ++ p-news-0 |= n=news-0:legacy (give %fact ~[/news] %contact-news !>(n)) - :: +p-news: publish news + :: +p-resp: publish response :: - ++ p-news - |= n=news - (give %fact ~[/v1/news] %contact-news-1 !>(n)) + ++ p-resp + |= r=response + (give %fact ~[/v1/news] %contact-response-0 !>(r)) -- :: :: +sub: subscription mgmt @@ -299,7 +294,7 @@ :: NB: this assumes con.for is only set in +si-hear :: =. cor (p-news-0:pub who ~) - (p-news:pub [%peer who ~]) + (p-resp:pub [%peer who ~]) :: %dead ?: new cor =. peers (~(del by peers) who) @@ -308,7 +303,7 @@ :: as *contact* deletion. but it's close, and keeps /news simpler :: =. cor (p-news-0:pub who ~) - (p-news:pub [%peer who ~]) + (p-resp:pub [%peer who ~]) == :: ++ si-take @@ -336,15 +331,15 @@ %_ si-cor for +.u cor =. cor - (p-news-0:pub who (to-contact-0 con.u)) + (p-news-0:pub who (contact:from con.u)) =/ page=(unit page) (~(get by book) who) :: update peer contact page :: =? cor ?=(^ page) - ?: =(p.u.page con.u) cor - =. book (~(put by book) who u.page(p con.u)) - (p-news:pub %page who con.u q.u.page) - (p-news:pub %peer who con.u) + ?: =(con.u.page con.u) cor + =. book (~(put by book) who u.page(con con.u)) + (p-resp:pub %page who con.u mod.u.page) + (p-resp:pub %peer who con.u) == :: ++ si-meet @@ -401,7 +396,9 @@ :: |^ cor(rof us, peers them) - ++ us (biff (~(get by ful) our.bowl) convert) + ++ us %+ fall + ^- (unit profile) (bind (~(get by ful) our.bowl) convert) + *profile :: ++ them ^- ^peers @@ -411,9 +408,9 @@ :: ++ convert |= con=contact:legacy - ^- $@(~ profile) - ?: =(*contact:legacy con) ~ - [last-updated.con (to-contact con(|6 groups.con))] + ^- profile + %- profile:to + [last-updated.con con(|6 groups.con)] -- :: +| %implementation @@ -429,7 +426,7 @@ :: ?- -.old %0 - =. rof ?~(rof.old ~ (to-profile rof.old)) + =. rof ?~(rof.old *profile (profile:to rof.old)) :: migrate peers. for each peer :: 1. leave /epic, if any :: 2. subscribe if desired @@ -445,7 +442,7 @@ [%pass /epic %agent [who dap.bowl] %leave ~] =/ fir=$@(~ profile) ?~ for ~ - (to-profile for) + (profile:to for) :: no intent to connect :: ?: =(~ sag) @@ -492,7 +489,7 @@ ?+ q.vase !! %migrate migrate == - $? act:base:mar + $? %contact-action %contact-action-0 %contact-action-1 == @@ -501,18 +498,17 @@ ?- mark :: :: legacy %contact-action - ?(act:base:mar %contact-action-0) + ?(%contact-action %contact-action-0) =/ act-0 !<(action-0:legacy vase) ?. ?=(%edit -.act-0) (to-action act-0) :: v0 %edit needs special handling to evaluate :: groups edit :: - =/ groups=(set $>(%cult value)) - ?~ rof ~ - =+ set=(~(ges cy con.rof) groups+%cult) - ?: =(~ set) ~ - (need set) + =/ groups=(set $>(%flag value)) + ?~ con.rof ~ + =+ set=(~(ges cy con.rof) groups+%flag) + (fall set ~) [%self (to-self-edit p.act-0 groups)] :: %contact-action-1 @@ -565,51 +561,54 @@ =/ mod=contact ?~ page=(~(get by book) who) ~ - q.u.page - (to-foreign-0 (foreign-mod far mod)) + mod.u.page + (foreign:from (foreign-mod far mod)) =/ lor-0=rolodex:legacy - ?: |(?=(~ rof) ?=(~ con.rof)) rol-0 - (~(put by rol-0) our.bowl (to-profile-0 rof) ~) + ?: ?=(~ con.rof) rol-0 + (~(put by rol-0) our.bowl (profile:from rof) ~) ``contact-rolodex+!>(lor-0) :: [%x %contact her=@ ~] - ?~ who=`(unit @p)`(slaw %p her.pat) + ?~ who=(slaw %p her.pat) [~ ~] =/ tac=?(~ contact-0:legacy) ?: =(our.bowl u.who) - ?~(rof ~ (to-contact-0 con.rof)) + ?~(con.rof ~ (contact:from con.rof)) =+ far=(~(get by peers) u.who) ?: |(?=(~ far) ?=(~ for.u.far)) ~ - (to-contact-0 con.for.u.far) + (contact:from con.for.u.far) ?~ tac [~ ~] ``contact+!>(`contact-0:legacy`tac) :: [%x %v1 %self ~] - ?~ rof [~ ~] - ?~ con.rof [~ ~] ``contact-1+!>(`contact`con.rof) :: [%x %v1 %book ~] - ?~ book [~ ~] ``contact-book-0+!>(book) + :: + [%u %v1 %book her=@p ~] + ?~ who=(slaw %p her.pat) + [~ ~] + ``loob+!>((~(has by book) u.who)) :: [%x %v1 %book her=@p ~] - ?~ who=`(unit @p)`(slaw %p her.pat) + ?~ who=(slaw %p her.pat) [~ ~] =/ page=(unit page) (~(get by book) u.who) - ?~ page + ``contact-page-0+!>(`^page`(fall page *^page)) + :: + [%u %v1 %book %id =cid ~] + ?~ id=(slaw %uv cid.pat) [~ ~] - ``contact-page-0+!>(`^page`u.page) + ``loob+!>((~(has by book) id+u.id)) :: [%x %v1 %book %id =cid ~] - ?~ id=`(unit @uv)`(slaw %uv cid.pat) + ?~ id=(slaw %uv cid.pat) [~ ~] =/ page=(unit page) (~(get by book) id+u.id) - ?~ page - [~ ~] - ``contact-page-0+!>(`^page`u.page) + ``contact-page-0+!>(`^page`(fall page *^page)) :: [%x %v1 %all ~] =| dir=directory @@ -629,22 +628,38 @@ ?~ for.far dir ?: (~(has by dir) who) dir (~(put by dir) who con.for.far) - ?~ dir - [~ ~] ``contact-directory-0+!>(dir) + :: + [%u %v1 %contact her=@p ~] + ?~ who=(slaw %p her.pat) + [~ ~] + ?: (~(has by book) u.who) + ``loob+!>(&) + =- ``loob+!>(-) + ?~ far=(~(get by peers) u.who) + | + ?~ for.u.far + | + & :: [%x %v1 %contact her=@p ~] - ?~ who=`(unit @p)`(slaw %p her.pat) + ?~ who=(slaw %p her.pat) [~ ~] + ?^ page=(~(get by book) u.who) + ``contact-1+!>((contact-uni u.page)) ?~ far=(~(get by peers) u.who) [~ ~] - ?~ page=(~(get by book) u.who) - ?~ for.u.far [~ ~] - ``contact-1+!>(con.for.u.far) - ``contact-1+!>((contact-uni u.page)) + ?~ for.u.far + [~ ~] + ``contact-1+!>(con.for.u.far) + :: + [%u %v1 %peer her=@p ~] + ?~ who=(slaw %p her.pat) + [~ ~] + ``loob+!>((~(has by peers) u.who)) :: [%x %v1 %peer her=@p ~] - ?~ who=`(unit @p)`(slaw %p her.pat) + ?~ who=(slaw %p her.pat) [~ ~] ?~ far=(~(get by peers) u.who) [~ ~] diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index e51776ca..4b836192 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -1,5 +1,7 @@ -/- *contacts +/- *contacts, legacy=contacts-0 |% +:: ++| %contact :: +cy: contact map engine :: ++ cy @@ -15,12 +17,12 @@ ~| "{} expected at {}" ?- typ %text ?>(?=(%text -.u.val) (some p.u.val)) - %quot ?>(?=(%quot -.u.val) (some p.u.val)) + %numb ?>(?=(%numb -.u.val) (some p.u.val)) %date ?>(?=(%date -.u.val) (some p.u.val)) %tint ?>(?=(%tint -.u.val) (some p.u.val)) %ship ?>(?=(%ship -.u.val) (some p.u.val)) %look ?>(?=(%look -.u.val) (some p.u.val)) - %cult ?>(?=(%cult -.u.val) (some p.u.val)) + %flag ?>(?=(%flag -.u.val) (some p.u.val)) %set ?>(?=(%set -.u.val) (some p.u.val)) == :: +ges: get specialized to typed set @@ -36,12 +38,12 @@ %- ~(run in p.u.val) ?- typ %text |=(v=value ?>(?=(%text -.v) v)) - %quot |=(v=value ?>(?=(%quot -.v) v)) + %numb |=(v=value ?>(?=(%numb -.v) v)) %date |=(v=value ?>(?=(%date -.v) v)) %tint |=(v=value ?>(?=(%tint -.v) v)) %ship |=(v=value ?>(?=(%ship -.v) v)) %look |=(v=value ?>(?=(%look -.v) v)) - %cult |=(v=value ?>(?=(%cult -.v) v)) + %flag |=(v=value ?>(?=(%flag -.v) v)) %set |=(v=value ?>(?=(%set -.v) v)) == :: +gos: got specialized to typed set @@ -55,12 +57,12 @@ %- ~(run in p.val) ?- typ %text |=(v=value ?>(?=(%text -.v) v)) - %quot |=(v=value ?>(?=(%quot -.v) v)) + %numb |=(v=value ?>(?=(%numb -.v) v)) %date |=(v=value ?>(?=(%date -.v) v)) %tint |=(v=value ?>(?=(%tint -.v) v)) %ship |=(v=value ?>(?=(%ship -.v) v)) %look |=(v=value ?>(?=(%look -.v) v)) - %cult |=(v=value ?>(?=(%cult -.v) v)) + %flag |=(v=value ?>(?=(%flag -.v) v)) %set |=(v=value ?>(?=(%set -.v) v)) == :: +gut: typed gut with default @@ -74,12 +76,12 @@ ~| "{<-.def>} expected at {}" ?- -.val %text ?>(?=(%text -.def) p.val) - %quot ?>(?=(%quot -.def) p.val) + %numb ?>(?=(%numb -.def) p.val) %date ?>(?=(%date -.def) p.val) %tint ?>(?=(%tint -.def) p.val) %ship ?>(?=(%ship -.def) p.val) %look ?>(?=(%look -.def) p.val) - %cult ?>(?=(%cult -.def) p.val) + %flag ?>(?=(%flag -.def) p.val) %set ?>(?=(%set -.def) p.val) == :: +gub: typed gut with bunt default @@ -91,23 +93,23 @@ ?~ val ?+ typ !! %text *@t - %quot *@ud + %numb *@ud %date *@da %tint *@ux %ship *@p %look *@t - %cult *flag:g + %flag *flag:g %set *(set value) == ~| "{} expected at {}" ?- typ %text ?>(?=(%text -.val) p.val) - %quot ?>(?=(%quot -.val) p.val) + %numb ?>(?=(%numb -.val) p.val) %date ?>(?=(%date -.val) p.val) %tint ?>(?=(%tint -.val) p.val) %ship ?>(?=(%ship -.val) p.val) %look ?>(?=(%look -.val) p.val) - %cult ?>(?=(%cult -.val) p.val) + %flag ?>(?=(%flag -.val) p.val) %set ?>(?=(%set -.val) p.val) == -- @@ -145,9 +147,9 @@ ++ sane-contact |= con=contact ^- ? - :: 1kB contact ought to be enough for anybody + :: 5kB contact ought to be enough for anybody :: - ?: (gth (met 3 (jam con)) 1.000) + ?: (gth (met 3 (jam con)) 10.000) | :: prohibit data URLs in the image links :: @@ -182,98 +184,115 @@ |= [key=@tas acc=_don] (~(del by don) key) don -:: +to-contact: convert legacy to contact +:: +to: legacy to new type :: -++ to-contact - |= c=contact-0:legacy - ^- contact - =/ o=contact - %- malt - ^- (list (pair @tas value)) - :~ nickname+text/nickname.c - bio+text/bio.c - status+text/status.c - color+tint/color.c +++ to + |% + :: +contact: convert legacy to contact + :: + ++ contact + |= o=contact-0:legacy + ^- ^contact + =/ c=^contact + %- malt + ^- (list (pair @tas value)) + :~ nickname+text/nickname.o + bio+text/bio.o + status+text/status.o + color+tint/color.o + == + =? c ?=(^ avatar.o) + (~(put by c) %avatar text/u.avatar.o) + =? c ?=(^ cover.o) + (~(put by c) %cover text/u.cover.o) + =? c !?=(~ groups.o) + %+ ~(put by c) %groups + :- %set + %- ~(run in groups.o) + |= =flag:g + flag/flag + c + :: +profile: convert legacy to profile + :: + ++ profile + |= o=profile-0:legacy + ^- ^profile + [wen.o ?~(con.o ~ (contact con.o))] + :: + -- +:: +from: legacy from new type +:: +++ from + |% + :: +contact: convert contact to legacy + :: + ++ contact + |= c=^contact + ^- $@(~ contact-0:legacy) + ?~ c ~ + =| o=contact-0:legacy + %_ o + nickname + (~(gub cy c) %nickname %text) + bio + (~(gub cy c) %bio %text) + status + (~(gub cy c) %status %text) + color + (~(gub cy c) %color %tint) + avatar + (~(get cy c) %avatar %text) + cover + (~(get cy c) %cover %text) + groups + =/ groups + (~(get cy c) %groups %set) + ?~ groups ~ + ^- (set flag:g) + %- ~(run in u.groups) + |= val=value + ?> ?=(%flag -.val) + p.val == - =? o ?=(^ avatar.c) - (~(put by o) %avatar text/u.avatar.c) - =? o ?=(^ cover.c) - (~(put by o) %cover text/u.cover.c) - =? o !?=(~ groups.c) - %+ ~(put by o) %groups - :- %set - %- ~(run in groups.c) - |= =flag:g - cult/flag - o -:: +to-contact-0: convert to legacy contact-0 -:: -++ to-contact-0 - |= c=contact - ^- $@(~ contact-0:legacy) - ?~ c ~ - =| o=contact-0:legacy - %_ o - nickname - (~(gub cy c) %nickname %text) - bio - (~(gub cy c) %bio %text) - status - (~(gub cy c) %status %text) - color - (~(gub cy c) %color %tint) - avatar - (~(get cy c) %avatar %text) - cover - (~(get cy c) %cover %text) - groups - =/ groups - (~(get cy c) %groups %set) - ?~ groups ~ - ^- (set flag:g) - %- ~(run in u.groups) - |= val=value - ?> ?=(%cult -.val) - p.val - == + :: +profile: convert profile to legacy + :: + ++ profile + |= p=^profile + ^- profile-0:legacy + [wen.p (contact:from con.p)] + :: +profile-0-mod: convert profile with contact overlay + :: to legacy + :: + ++ profile-mod + |= [p=^profile mod=^contact] + ^- profile-0:legacy + [wen.p (contact:from (contact-uni con.p mod))] + :: +foreign: convert foreign to legacy + :: + ++ foreign + |= f=^foreign + ^- foreign-0:legacy + [?~(for.f ~ (profile:from for.f)) sag.f] + :: foreign-mod: convert foreign with contact overlay + :: to legacy + :: + ++ foreign-mod + |= [f=^foreign mod=^contact] + ^- foreign-0:legacy + [?~(for.f ~ (profile-mod:from for.f mod)) sag.f] + -- :: +contact-uni: merge contacts :: ++ contact-uni |= [c=contact mod=contact] ^- contact (~(uni by c) mod) -:: +to-profile: convert legacy to profile -:: -++ to-profile - |= o=profile-0:legacy - ^- profile - [wen.o ?~(con.o ~ (to-contact con.o))] -:: +to-profile-0: convert to legacy profile-0 -:: -++ to-profile-0 - |= p=profile - ^- profile-0:legacy - [wen.p (to-contact-0 con.p)] -:: +to-profile-0-mod: convert to legacy profile-0 with -:: contact overlay -:: -++ to-profile-0-mod - |= [p=profile mod=contact] - ^- profile-0:legacy - [wen.p (to-contact-0 (contact-uni con.p mod))] -:: +to-foreign-0: convert to legacy foreign-0 -:: -++ to-foreign-0 - |= f=foreign - ^- foreign-0:legacy - [?~(for.f ~ (to-profile-0 for.f)) sag.f] -:: +to-foreign-0-mod: convert to legacy foreign-0 -:: with contact overlay +:: +foreign-contact: get foreign contact :: -++ to-foreign-0-mod - |= [f=foreign mod=contact] - ^- foreign-0:legacy - [?~(for.f ~ (to-profile-0-mod for.f mod)) sag.f] +++ foreign-contact + |= far=foreign + ^- contact + ?~(for.far ~ con.for.far) :: +foreign-mod: modify foreign profile with user overlay :: ++ foreign-mod @@ -282,12 +301,8 @@ ?~ for.far far far(con.for (contact-uni con.for.far mod)) -:: +foreign-contact: get foreign contact -:: -++ foreign-contact - |= far=foreign - ^- contact - ?~(for.far ~ con.for.far) +:: +sole-field-0: sole field is a field that does +:: not modify the groups set :: +$ sole-field-0 $~ nickname+'' @@ -376,9 +391,9 @@ |= [ged=$>(group-type field-0:legacy) =_groups] ?- -.ged %add-group - (~(put in groups) cult/flag.ged) + (~(put in groups) flag/flag.ged) %del-group - (~(del in groups) cult/flag.ged) + (~(del in groups) flag/flag.ged) == %- ~(uni by (to-sole-edit sid)) ^- contact diff --git a/desk/lib/contacts/json-0.hoon b/desk/lib/contacts/json-0.hoon index d3711a24..aa1abaf9 100644 --- a/desk/lib/contacts/json-0.hoon +++ b/desk/lib/contacts/json-0.hoon @@ -1,6 +1,7 @@ /- c=contacts, g=groups +/- legacy=contacts-0 /+ gj=groups-json -=, legacy:c +=, legacy |% ++ enjs =, enjs:format diff --git a/desk/lib/contacts/json-1.hoon b/desk/lib/contacts/json-1.hoon index 13d9850f..32034488 100644 --- a/desk/lib/contacts/json-1.hoon +++ b/desk/lib/contacts/json-1.hoon @@ -25,12 +25,12 @@ ^- json ?- -.val %text (pairs type+s/%text value+s/p.val ~) - %quot (pairs type+s/%quot value+(numb p.val) ~) + %numb (pairs type+s/%numb value+(numb p.val) ~) %date (pairs type+s/%date value+s/(scot %da p.val) ~) %tint (pairs type+s/%tint value+s/(rsh 3^2 (scot %ux p.val)) ~) %ship (pairs type+s/%ship value+(ship p.val) ~) %look (pairs type+s/%look value+s/p.val ~) - %cult (pairs type+s/%cult value+s/(flag:enjs:gj p.val) ~) + %flag (pairs type+s/%flag value+s/(flag:enjs:gj p.val) ~) %set (pairs type+s/%set value+a/(turn ~(tap in p.val) value) ~) == :: @@ -42,7 +42,7 @@ ++ page |= =page:c ^- json - a+[(contact p.page) (contact q.page) ~] + a+[(contact con.page) (contact mod.page) ~] :: ++ book |= =book:c @@ -64,8 +64,8 @@ |= [[who=@p con=contact:c] acc=_dir] (~(put by acc) (scot %p who) (contact con)) :: - ++ news - |= n=news:c + ++ response + |= n=response:c ^- json ?- -.n %self (frond self+(contact con.n)) @@ -118,7 +118,7 @@ (ot text+(se %tas) value+json ~) ?+ type !! %text %. val (ta %text so) - %quot %. val (ta %quot ni) + %numb %. val (ta %numb ni) %date %. val (ta %date (se %da)) %tint %. val %+ ta %tint @@ -127,7 +127,7 @@ so %ship %. val (ta %ship ship) %look %. val (ta %look so) - %cult %. val (ta %cult flag:dejs:gj) + %flag %. val (ta %flag flag:dejs:gj) %set %. val (ta %set (as value)) == :: diff --git a/desk/lib/mark-warmer.hoon b/desk/lib/mark-warmer.hoon index fab2ff39..546cc6e7 100644 --- a/desk/lib/mark-warmer.hoon +++ b/desk/lib/mark-warmer.hoon @@ -2,10 +2,10 @@ /$ contact-0 %contact %json /$ news-0 %contact-news %json /$ contact-1 %contact-1 %json -/$ page %contact-page %json -/$ book %contact-book %json -/$ dir %contact-directory %json -/$ news-1 %contact-news-1 %json +/$ page-0 %contact-page-0 %json +/$ book-0 %contact-book-0 %json +/$ dir-0 %contact-directory-0 %json +/$ resp-0 %contact-response-0 %json /$ skeins %hark-skeins %json /$ carpet %hark-carpet %json /$ blanket %hark-blanket %json diff --git a/desk/mar/contact-0.hoon b/desk/mar/contact-0.hoon index 1668866a..4e355e84 100644 --- a/desk/mar/contact-0.hoon +++ b/desk/mar/contact-0.hoon @@ -1,6 +1,6 @@ -/- c=contacts +/- c=contacts, x=contacts-0 /+ j=contacts-json-0 -|_ contact=contact-0:legacy:c +|_ contact=contact-0:x ++ grad %noun ++ grow |% @@ -9,6 +9,6 @@ -- ++ grab |% - ++ noun contact-0:legacy:c + ++ noun contact-0:x -- -- diff --git a/desk/mar/contact/action-0.hoon b/desk/mar/contact/action-0.hoon index eea44981..8ea2b57b 100644 --- a/desk/mar/contact/action-0.hoon +++ b/desk/mar/contact/action-0.hoon @@ -1,6 +1,6 @@ -/- c=contacts +/- c=contacts, legacy=contacts-0 /+ j=contacts-json-0 -|_ action=action-0:legacy:c +|_ action=action-0:legacy ++ grad %noun ++ grow |% @@ -9,7 +9,7 @@ -- ++ grab |% - ++ noun action-0:legacy:c + ++ noun action-0:legacy ++ json action:dejs:j -- -- diff --git a/desk/mar/contact/news.hoon b/desk/mar/contact/news.hoon index 1f3ab55e..19f3bb3d 100644 --- a/desk/mar/contact/news.hoon +++ b/desk/mar/contact/news.hoon @@ -1,6 +1,6 @@ -/- c=contacts +/- c=contacts, x=contacts-0 /+ j=contacts-json-0 -|_ news=news-0:legacy:c +|_ news=news-0:x ++ grad %noun ++ grow |% @@ -9,6 +9,6 @@ -- ++ grab |% - ++ noun news-0:legacy:c + ++ noun news-0:x -- -- diff --git a/desk/mar/contact/rolodex.hoon b/desk/mar/contact/rolodex.hoon index 1f7de769..4992264b 100644 --- a/desk/mar/contact/rolodex.hoon +++ b/desk/mar/contact/rolodex.hoon @@ -1,6 +1,6 @@ -/- c=contacts +/- c=contacts, x=contacts-0 /+ j=contacts-json-0 -|_ rol=rolodex:legacy:c +|_ rol=rolodex:x ++ grad %noun ++ grow |% @@ -9,6 +9,6 @@ -- ++ grab |% - ++ noun rolodex:legacy:c + ++ noun rolodex:x -- -- diff --git a/desk/mar/contact/update-0.hoon b/desk/mar/contact/update-0.hoon index e9c89b79..519391bd 100644 --- a/desk/mar/contact/update-0.hoon +++ b/desk/mar/contact/update-0.hoon @@ -1,5 +1,5 @@ -/- c=contacts -|_ update=update-0:legacy:c +/- c=contacts, x=contacts-0 +|_ update=update-0:x ++ grad %noun ++ grow |% @@ -7,6 +7,6 @@ -- ++ grab |% - ++ noun update-0:legacy:c + ++ noun update-0:x -- -- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 4f07ad1e..8897173a 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -2,29 +2,20 @@ |% :: +| %compat +:: ++ okay `epic`1 -++ mar - |% - ++ base - |% - +$ act %contact-action - +$ upd %contact-update - -- - :: - ++ act `mark`^~((rap 3 *act:base '-' (scot %ud okay) ~)) - ++ upd `mark`^~((rap 3 *upd:base '-' (scot %ud okay) ~)) - -- :: +| %types :: $value-type: contact field value type :: +$ value-type $? %text - %quot + %numb %date %tint + %ship %look - %cult + %flag %set == :: $value: contact field value @@ -33,7 +24,7 @@ $+ contact-value $@ ~ $% [%text p=@t] - [%quot p=@ud] + [%numb p=@ud] [%date p=@da] :: :: color @@ -44,7 +35,7 @@ [%look p=@ta] :: :: group - [%cult p=flag:g] + [%flag p=flag:g] :: :: uniform set [%set p=$|((set value) unis)] @@ -57,17 +48,10 @@ ?~ set & =/ typ -.n.set |- - ?^ l.set - ?. =(typ -.n.l.set) - | - $(set l.set) - ?^ r.set - ?. =(typ -.n.r.set) - | - $(set r.set) - ?. =(typ -.n.set) - | - & + ?& =(typ -.n.set) + ?~(l.set & $(set l.set)) + ?~(r.set & $(set r.set)) + == :: $contact: contact data :: +$ contact (map @tas value) @@ -85,10 +69,10 @@ +$ foreign [for=$@(~ profile) sag=$@(~ saga)] :: $page: contact page :: -:: .p: peer contact -:: .q: user overlay +:: .con: peer contact +:: .mod: user overlay :: -+$ page (pair contact contact) ++$ page [con=contact mod=contact] :: $cid: contact page id :: +$ cid @uvF @@ -111,8 +95,8 @@ $? %want :: subscribing ~ :: none intended == -:: %anon: delete the profile -:: %self: edit the profile +:: %anon: delete our profile +:: %self: edit our profile :: %page: create a new contact page :: %spot: add peer as a contact :: %edit: edit a contact overlay @@ -146,73 +130,10 @@ :: %wipe: contact page delete :: %peer: peer update :: -+$ news ++$ response $% [%self con=contact] [%page =kip con=contact mod=contact] [%wipe =kip] [%peer who=ship con=contact] == -+| %legacy -:: XX move to /sur/contacts-0.hoon? -:: -++ legacy - |% - +$ contact-0 - $: nickname=@t - bio=@t - status=@t - color=@ux - avatar=(unit @t) - cover=(unit @t) - groups=(set flag:g) - == - :: - +$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga-0)] - +$ profile-0 [wen=@da con=$@(~ contact-0)] - +$ rolodex (map ship foreign-0) - :: - +$ saga-0 - $@ $? %want :: subscribing - %fail :: %want failed - %lost :: epic %fail - ~ :: none intended - == - saga:e - :: - +$ field-0 - $% [%nickname nickname=@t] - [%bio bio=@t] - [%status status=@t] - [%color color=@ux] - [%avatar avatar=(unit @t)] - [%cover cover=(unit @t)] - [%add-group =flag:g] - [%del-group =flag:g] - == - :: - +$ action-0 - :: %anon: delete our profile - :: %edit: change our profile - :: %meet: track a peer - :: %heed: follow a peer - :: %drop: discard a peer - :: %snub: unfollow a peer - :: - $% [%anon ~] - [%edit p=(list field-0)] - [%meet p=(list ship)] - [%heed p=(list ship)] - [%drop p=(list ship)] - [%snub p=(list ship)] - == - :: network - :: - +$ update-0 - $% [%full profile-0] - == - :: local - :: - +$ news-0 - [who=ship con=$@(~ contact-0)] - -- -- diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 7f684a8d..97d0ca83 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -1,4 +1,4 @@ -/- *contacts +/- *contacts, x=contacts-0 /+ *test-agent /+ c=contacts /= contacts-agent /app/contacts @@ -27,7 +27,7 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0:legacy:legacy + =| con-0=contact-0:x =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' :: @@ -35,8 +35,8 @@ %- malt ^- (list (pair @tas value)) ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] - =/ edit-0=(list field-0:legacy) - ^- (list field-0:legacy) + =/ edit-0=(list field-0:x) + ^- (list field-0:x) :~ nickname+'Zod' bio+'The first of the galaxies' == @@ -50,18 +50,18 @@ ;< caz=(list card) b (do-watch /news) :: ;< ~ b (set-src our.bowl) - :: action-0:legacy profile %edit + :: action-0:x profile %edit :: ;< caz=(list card) b (do-poke contact-action+!>([%edit edit-0])) :: - =/ upd-0=update-0:legacy - [%full (mono now.bowl now.bowl) ~] + =/ upd-0=update-0:x + [%full (add now.bowl (mul 2 tick)) ~] =/ upd-1=update - [%full (mono now.bowl now.bowl) ~] + [%full (add now.bowl (mul 2 tick)) ~] ;< caz=(list card) b (do-poke contact-action+!>([%anon ~])) %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([our.bowl ~])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self ~])) + (ex-fact ~[/v1/news] contact-response-0+!>([%self ~])) (ex-fact ~[/v1/contact] contact-update-1+!>(upd-1)) == :: +test-poke-0-edit: v0 edit the profile @@ -74,7 +74,7 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0:legacy:legacy + =| con-0=contact-0:x =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' =. groups.con-0 (silt ~sampel-palnet^%oranges ~) @@ -84,11 +84,11 @@ ^- (list (pair @tas value)) :~ nickname+text/'Zod' bio+text/'The first of the galaxies' - groups+set/(silt cult/~sampel-palnet^%oranges ~) + groups+set/(silt flag/~sampel-palnet^%oranges ~) == :: - =/ edit-0=(list field-0:legacy) - ^- (list field-0:legacy) + =/ edit-0=(list field-0:x) + ^- (list field-0:x) :~ nickname+'Zod' bio+'The first of the galaxies' add-group+~sampel-palnet^%apples @@ -109,14 +109,14 @@ ;< caz=(list card) b (do-watch /v1/news) :: ;< ~ b (set-src our.bowl) - :: action-0:legacy profile %edit + :: action-0:x profile %edit :: ;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self con])) - (ex-fact ~[/v1/contact] contact-update-1+!>([%full now.bowl con])) + (ex-fact ~[/v1/news] contact-response-0+!>([%self con])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full `@da`(add now.bowl tick) con])) == :: profile is set :: @@ -136,8 +136,8 @@ ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0(groups ~)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self new-con])) - (ex-fact ~[/v1/contact] contact-update-1+!>([%full (add now.bowl tick) new-con])) + (ex-fact ~[/v1/news] contact-response-0+!>([%self new-con])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full (add now.bowl (mul 2 tick)) new-con])) == :: remove bio :: @@ -183,7 +183,7 @@ %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) (ex-fact ~[/news] contact-news+!>([~sun ~])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun ~])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun ~])) == +| %poke :: +test-poke-anon: delete the profile @@ -223,10 +223,10 @@ :: ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([our.bowl ~])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self ~])) - (ex-fact ~[/v1/contact] contact-update-1+!>([%full (add now.bowl tick) ~])) + (ex-fact ~[/v1/news] contact-response-0+!>([%self ~])) + (ex-fact ~[/v1/contact] contact-update-1+!>([%full (add now.bowl (mul 2 tick)) ~])) == - :: v0 profile is empty + :: v0: profile is empty :: ;< peek=(unit (unit cage)) b (get-peek /x/contact/(scot %p our.bowl)) @@ -238,9 +238,10 @@ :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/self) + =/ cag (need (need peek)) %+ ex-equal - !>((need peek)) - !>(~) + !>(cag) + !>(contact-1+!>(`contact`~)) :: +test-poke-self: change the profile :: ++ test-poke-self @@ -251,7 +252,7 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0:legacy:legacy + =| con-0=contact-0:x =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' :: @@ -260,10 +261,10 @@ ^- (list (pair @tas value)) ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] :: - =/ upd-0=update-0:legacy - [%full now.bowl con-0] + =/ upd-0=update-0:x + [%full (add now.bowl tick) con-0] =/ upd-1=update - [%full now.bowl con-1] + [%full (add now.bowl tick) con-1] =/ edit-1 con-1 :: foreign subscriber to /contact :: @@ -279,7 +280,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%self con-1])) %+ ex-cards caz :~ (ex-fact ~[/news] contact-news+!>([our.bowl con-0])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self con-1])) + (ex-fact ~[/v1/news] contact-response-0+!>([%self con-1])) (ex-fact ~[/v1/contact] contact-update-1+!>(upd-1)) == :: +test-poke-page: create new contact page @@ -297,7 +298,7 @@ ^- (list (pair @tas value)) ~[nickname+text/'Sun' bio+text/'It is bright today'] :: - =/ =news + =/ resp=response [%page id+0v1 ~ con-1] =/ mypage=^page [p=~ q=con-1] @@ -313,7 +314,7 @@ :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-news-1+!>(news)) + :~ (ex-fact ~[/v1/news] contact-response-0+!>(resp)) == :: peek page in the book: new contact page is found :: @@ -337,8 +338,8 @@ ;< =bowl b get-bowl =/ groups ^- (list value) - :~ cult/~sampel-palnet^%apples - cult/~sampel-palnet^%oranges + :~ flag/~sampel-palnet^%apples + flag/~sampel-palnet^%oranges == =/ con-1=contact %- malt @@ -348,7 +349,7 @@ groups+set/(silt groups) == :: - =/ =news + =/ resp=response [%page id+0v1 ~ con-1] =/ mypage=^page [p=~ q=con-1] @@ -365,7 +366,7 @@ :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-news-1+!>(news)) + :~ (ex-fact ~[/v1/news] contact-response-0+!>(resp)) == :: peek page in the book: new contact page is found :: @@ -403,8 +404,8 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers :: @@ -444,8 +445,8 @@ %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) (ex-fact ~[/news] contact-news+!>([~sun ~])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun ~])) - (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun `page:c`[~ ~]])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun ~])) + (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun `page:c`[~ ~]])) == :: ~sun appears in peers :: @@ -462,9 +463,9 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun contact page is edited :: @@ -516,8 +517,8 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers :: @@ -534,7 +535,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) + :~ (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) == :: ~sun contact page is edited :: @@ -545,8 +546,8 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) - (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun con-mod])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c (~(uni by con-sun) con-mod))])) + (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun con-mod])) == :: despite the edit, ~sun peer contact is unchanged :: @@ -577,13 +578,14 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%wipe ~[~sun]])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%wipe ~sun])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%wipe ~sun])) == :: ~sun contact page is removed :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) - ;< ~ b (ex-equal !>(peek) !>([~ ~])) + =/ cag (need (need peek)) + ;< ~ b (ex-equal !>(cag) !>(contact-page-0+!>(*page:c))) :: (ex-equal !>(2) !>(2)) :: despite the removal, ~sun peer contact is unchanged :: @@ -619,8 +621,8 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers :: @@ -637,7 +639,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun ~])) + :~ (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) == :: ~sun contact page is edited :: @@ -648,8 +650,8 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c (~(uni by con-sun) con-mod))])) - (ex-fact ~[/v1/news] contact-news-1+!>([%page ~sun con-sun con-mod])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c (~(uni by con-sun) con-mod))])) + (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun con-mod])) == :: ~sun is dropped :: @@ -659,7 +661,7 @@ %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %leave ~) (ex-fact ~[/news] contact-news+!>([~sun ~])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun ~])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun ~])) == :: ~sun is not found in peers :: @@ -709,8 +711,8 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (to-contact-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%peer ~sun con-sun])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun is snubbed :: @@ -756,28 +758,28 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([our.bowl (to-contact-0:c con)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self con])) - (ex-fact ~ contact-update-1+!>([%full now.bowl con])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from:c con)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%self con])) + (ex-fact ~ contact-update-1+!>([%full `@da`(add now.bowl tick) con])) == :: ~sun subscribes to /contact, profile is published :: ;< ~ b (set-src ~sun) ;< caz=(list card) b (do-watch /v1/contact) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~ contact-update-1+!>([%full now.bowl con])) + :~ (ex-fact ~ contact-update-1+!>([%full `@da`(add now.bowl tick) con])) == :: we update our profile, which advances the timestamp. :: update is published. :: - =+ now=(add now.bowl tick) + =+ now=`@da`(add now.bowl (mul 2 tick)) =. con (~(put by con) birthday+date/~2000.1.1) ;< ~ b (set-src our.bowl) ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([our.bowl (to-contact-0:c con)])) - (ex-fact ~[/v1/news] contact-news-1+!>([%self con])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from:c con)])) + (ex-fact ~[/v1/news] contact-response-0+!>([%self con])) (ex-fact ~[/v1/contact] contact-update-1+!>([%full now con])) == :: ~sun resubscribes to /contact/at/old-now @@ -833,15 +835,14 @@ ;< peek=(unit (unit cage)) b (get-peek /x/all) =/ cag=cage (need (need peek)) ?> ?=(%contact-rolodex p.cag) - =/ rol !<(rolodex:legacy q.cag) + =/ rol !<(rolodex:x q.cag) ;< ~ b %+ ex-equal !> (~(got by rol) ~sun) - !> [[now.bowl (to-contact-0:c con-sun)] %want] + !> [[now.bowl (contact:from:c con-sun)] %want] %+ ex-equal !> (~(got by rol) ~mur) - !> [[now.bowl (to-contact-0:c con-mur)] %want] - :: (ex-equal !>(2) !>(2)) + !> [[now.bowl (contact:from:c con-mur)] %want] :: ++ test-peek-book %- eval-mare @@ -870,11 +871,56 @@ =/ =book !<(book q.cag) ;< ~ b %+ ex-equal - !> q:(~(got by book) id+0v1) + !> mod:(~(got by book) id+0v1) !> con-1 %+ ex-equal - !> q:(~(got by book) id+0v2) + !> mod:(~(got by book) id+0v2) !> con-2 +:: +++ test-peek-page + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con-1=contact + %- malt + ^- (list (pair @tas value)) + ~[nickname+text/'Sun' bio+text/'It is bright today'] + =/ con-2=contact + %- malt + ^- (list (pair @tas value)) + ~[nickname+text/'Mur' bio+text/'Murky waters'] + :: + ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v2 con-2])) + :: unknown page is not found + :: + ;< peek=(unit (unit cage)) b (get-peek /u/v1/book/id/0v3) + ;< ~ b (ex-equal q:(need (need peek)) !>(|)) + :: + :: two pages are found + :: + ;< peek=(unit (unit cage)) b (get-peek /u/v1/book/id/0v1) + ;< ~ b (ex-equal q:(need (need peek)) !>(&)) + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/id/0v1) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> cag + !> contact-page-0+!>(`page:c`[~ con-1]) + :: + ;< peek=(unit (unit cage)) b (get-peek /u/v1/book/id/0v2) + ;< ~ b (ex-equal q:(need (need peek)) !>(&)) + ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/id/0v2) + =/ cag=cage (need (need peek)) + :: ;< ~ b + %+ ex-equal + !> cag + !> contact-page-0+!>(`page:c`[~ con-2]) +:: ++ test-peek-all %- eval-mare =/ m (mare ,~) diff --git a/desk/tests/lib/contacts-json-1.hoon b/desk/tests/lib/contacts-json-1.hoon index 9bf07649..5b9cac72 100644 --- a/desk/tests/lib/contacts-json-1.hoon +++ b/desk/tests/lib/contacts-json-1.hoon @@ -44,8 +44,8 @@ '{"type":"text","value":"the lazy fox"}' :: %+ jen-equal - (value:enjs:j quot+42) - '{"type":"quot","value":42}' + (value:enjs:j numb+42) + '{"type":"numb","value":42}' :: %+ jen-equal (value:enjs:j date+~2024.9.11) @@ -64,13 +64,13 @@ '{"type":"look","value":"https://ship.io/avatar.png"}' :: %+ jen-equal - (value:enjs:j [%cult [~sampel-palnet %circle]]) - '{"type":"cult","value":"~sampel-palnet/circle"}' + (value:enjs:j [%flag [~sampel-palnet %circle]]) + '{"type":"flag","value":"~sampel-palnet/circle"}' :: %+ jen-equal %- value:enjs:j - [%set (silt `(list value)`~[cult/[~sampel-palnet %circle] cult/[~sampel-pardux %square]])] - '{"type":"set","value":[{"type":"cult","value":"~sampel-palnet/circle"},{"type":"cult","value":"~sampel-pardux/square"}]}' + [%set (silt `(list value)`~[flag/[~sampel-palnet %circle] flag/[~sampel-pardux %square]])] + '{"type":"set","value":[{"type":"flag","value":"~sampel-palnet/circle"},{"type":"flag","value":"~sampel-pardux/square"}]}' == ++ test-contact %+ jen-equal From a64ccadd61da41513c3ba4b1fa563306db9655a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Fri, 20 Sep 2024 17:26:36 +0800 Subject: [PATCH 29/44] import lib-subscriber --- desk/lib/subscriber.hoon | 47 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 desk/lib/subscriber.hoon diff --git a/desk/lib/subscriber.hoon b/desk/lib/subscriber.hoon new file mode 100644 index 00000000..51c89583 --- /dev/null +++ b/desk/lib/subscriber.hoon @@ -0,0 +1,47 @@ +=< subscriber +|% ++$ sub + $: =dock + =path + fires-at=@da + == +:: ++$ subs (map wire sub) +:: +++ verb | +++ subscriber + |_ [=subs bowl:gall] + ++ interval ~s30 + ++ handle-wakeup + |= =wire + ^- [(list card:agent:gall) _subs] + ?> ?=([%~.~ %retry *] wire) + ~? verb ['waking up' wire] + =/ sub (~(get by subs) t.t.wire) + ?~ sub [~ subs] + :- ~[[%pass t.t.wire %agent dock.u.sub %watch path.u.sub]] + (~(del by subs) t.t.wire) + ++ subscribe + |= [=wire =dock =path delay=?] + ^- [(list card:agent:gall) _subs] + ?: (~(has by subs) wire) + ((slog 'Duplicate subscription' >[wire dock]< ~) [~ subs]) + ?. delay [~[[%pass wire %agent dock %watch path]] subs] + ~? verb ['subscribing with delay' wire] + =/ fires-at (add now interval) + :_ (~(put by subs) wire [dock path fires-at]) + ~[[%pass (weld /~/retry wire) %arvo %b %wait fires-at]] + ++ unsubscribe + |= [=wire =dock] + ^- [(list card:agent:gall) _subs] + =/ leave [%pass wire %agent dock %leave ~] + =/ sub (~(get by subs) wire) + ?~ sub + ((slog 'No such subscription' >[wire]< ~) [~[leave] subs]) + ~? verb ['cancelling' wire] + :_ (~(del by subs) wire) + :~ [%pass (weld /~/retry wire) %arvo %b %rest fires-at.u.sub] + leave + == + -- +-- \ No newline at end of file From 8e3195939042cd538eee85aac3e0b2598fc871b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Sat, 21 Sep 2024 12:09:23 +0800 Subject: [PATCH 30/44] contacts: remove lib-subscriber lib-subscriber expects that subscription wires contain enough information to differentiate subscriptions, which is not true for in %contacts: the /contact wire does not carry peer information. --- desk/lib/subscriber.hoon | 47 ---------------------------------------- 1 file changed, 47 deletions(-) delete mode 100644 desk/lib/subscriber.hoon diff --git a/desk/lib/subscriber.hoon b/desk/lib/subscriber.hoon deleted file mode 100644 index 51c89583..00000000 --- a/desk/lib/subscriber.hoon +++ /dev/null @@ -1,47 +0,0 @@ -=< subscriber -|% -+$ sub - $: =dock - =path - fires-at=@da - == -:: -+$ subs (map wire sub) -:: -++ verb | -++ subscriber - |_ [=subs bowl:gall] - ++ interval ~s30 - ++ handle-wakeup - |= =wire - ^- [(list card:agent:gall) _subs] - ?> ?=([%~.~ %retry *] wire) - ~? verb ['waking up' wire] - =/ sub (~(get by subs) t.t.wire) - ?~ sub [~ subs] - :- ~[[%pass t.t.wire %agent dock.u.sub %watch path.u.sub]] - (~(del by subs) t.t.wire) - ++ subscribe - |= [=wire =dock =path delay=?] - ^- [(list card:agent:gall) _subs] - ?: (~(has by subs) wire) - ((slog 'Duplicate subscription' >[wire dock]< ~) [~ subs]) - ?. delay [~[[%pass wire %agent dock %watch path]] subs] - ~? verb ['subscribing with delay' wire] - =/ fires-at (add now interval) - :_ (~(put by subs) wire [dock path fires-at]) - ~[[%pass (weld /~/retry wire) %arvo %b %wait fires-at]] - ++ unsubscribe - |= [=wire =dock] - ^- [(list card:agent:gall) _subs] - =/ leave [%pass wire %agent dock %leave ~] - =/ sub (~(get by subs) wire) - ?~ sub - ((slog 'No such subscription' >[wire]< ~) [~[leave] subs]) - ~? verb ['cancelling' wire] - :_ (~(del by subs) wire) - :~ [%pass (weld /~/retry wire) %arvo %b %rest fires-at.u.sub] - leave - == - -- --- \ No newline at end of file From 730eb97a410141203f3e2c412a3a55061edb25ac 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 31/44] contacts: implement subscription retry --- desk/app/contacts.hoon | 90 +++++++++++++++++++++++-------- desk/mar/contact/book-0.hoon | 14 +++++ desk/mar/contact/directory-0.hoon | 14 +++++ desk/mar/contact/page-0.hoon | 14 +++++ desk/mar/contact/response-0.hoon | 14 +++++ desk/sur/contacts-0.hoon | 60 +++++++++++++++++++++ desk/tests/app/contacts.hoon | 52 +++++++++++++++--- 7 files changed, 229 insertions(+), 29 deletions(-) create mode 100644 desk/mar/contact/book-0.hoon create mode 100644 desk/mar/contact/directory-0.hoon create mode 100644 desk/mar/contact/page-0.hoon create mode 100644 desk/mar/contact/response-0.hoon create mode 100644 desk/sur/contacts-0.hoon 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/mar/contact/book-0.hoon b/desk/mar/contact/book-0.hoon new file mode 100644 index 00000000..2de84aae --- /dev/null +++ b/desk/mar/contact/book-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ book=book:c +++ grad %noun +++ grow + |% + ++ noun book + ++ json (book:enjs:j book) + -- +++ grab + |% + ++ noun book:c + -- +-- diff --git a/desk/mar/contact/directory-0.hoon b/desk/mar/contact/directory-0.hoon new file mode 100644 index 00000000..b7c399c1 --- /dev/null +++ b/desk/mar/contact/directory-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ dir=directory:c +++ grad %noun +++ grow + |% + ++ noun dir + ++ json (directory:enjs:j dir) + -- +++ grab + |% + ++ noun directory:c + -- +-- diff --git a/desk/mar/contact/page-0.hoon b/desk/mar/contact/page-0.hoon new file mode 100644 index 00000000..ca628447 --- /dev/null +++ b/desk/mar/contact/page-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =page:c +++ grad %noun +++ grow + |% + ++ noun page + ++ json (page:enjs:j page) + -- +++ grab + |% + ++ noun page:c + -- +-- diff --git a/desk/mar/contact/response-0.hoon b/desk/mar/contact/response-0.hoon new file mode 100644 index 00000000..92c29689 --- /dev/null +++ b/desk/mar/contact/response-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =response:c +++ grad %noun +++ grow + |% + ++ noun response + ++ json (response:enjs:j response) + -- +++ grab + |% + ++ noun response:c + -- +-- diff --git a/desk/sur/contacts-0.hoon b/desk/sur/contacts-0.hoon new file mode 100644 index 00000000..a019da82 --- /dev/null +++ b/desk/sur/contacts-0.hoon @@ -0,0 +1,60 @@ +/- e=epic, g=groups +|% ++$ contact-0 + $: nickname=@t + bio=@t + status=@t + color=@ux + avatar=(unit @t) + cover=(unit @t) + groups=(set flag:g) + == +:: ++$ foreign-0 [for=$@(~ profile-0) sag=$@(~ saga-0)] ++$ profile-0 [wen=@da con=$@(~ contact-0)] ++$ rolodex (map ship foreign-0) +:: ++$ saga-0 + $@ $? %want :: subscribing + %fail :: %want failed + %lost :: epic %fail + ~ :: none intended + == + saga:e +:: ++$ field-0 + $% [%nickname nickname=@t] + [%bio bio=@t] + [%status status=@t] + [%color color=@ux] + [%avatar avatar=(unit @t)] + [%cover cover=(unit @t)] + [%add-group =flag:g] + [%del-group =flag:g] + == +:: ++$ action-0 + :: %anon: delete our profile + :: %edit: change our profile + :: %meet: track a peer + :: %heed: follow a peer + :: %drop: discard a peer + :: %snub: unfollow a peer + :: + $% [%anon ~] + [%edit p=(list field-0)] + [%meet p=(list ship)] + [%heed p=(list ship)] + [%drop p=(list ship)] + [%snub p=(list ship)] + == +:: network +:: ++$ update-0 + $% [%full profile-0] + == +:: local +:: ++$ news-0 + [who=ship con=$@(~ contact-0)] +-- 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] + == -- From 75ba2b727b95bd82e7bf726265019072dc344216 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 23 Sep 2024 13:13:39 +0800 Subject: [PATCH 32/44] contacts: fix marks --- desk/app/contacts.hoon | 2 +- desk/mar/contact-1.hoon | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 8b8c8249..deeba991 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -696,7 +696,7 @@ [~ ~] ?~ far=(~(get by peers) u.who) [~ ~] - ``contact-foreign-1+!>(`foreign`u.far) + ``contact-foreign-0+!>(`foreign`u.far) == :: ++ peer diff --git a/desk/mar/contact-1.hoon b/desk/mar/contact-1.hoon index 03897aa4..da752a18 100644 --- a/desk/mar/contact-1.hoon +++ b/desk/mar/contact-1.hoon @@ -1,4 +1,4 @@ -/- c=contacts +/+ c=contacts /+ j=contacts-json-1 |_ contact=contact:c ++ grad %noun @@ -11,5 +11,6 @@ |% ++ noun contact:c ++ json contact:dejs:j + ++ contact contact:to:c -- -- From 6f820be428269df685e9aad03d628f93c508be63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 23 Sep 2024 14:34:42 +0800 Subject: [PATCH 33/44] contacts: rename conversion cores --- desk/app/contacts.hoon | 18 +++++++++--------- desk/lib/contacts.hoon | 14 +++++++------- desk/mar/contact-1.hoon | 2 +- desk/tests/app/contacts.hoon | 24 ++++++++++++------------ 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index deeba991..13ed0058 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -208,7 +208,7 @@ =. rof p :: =. cor - (p-news-0 our.bowl (contact:from con)) + (p-news-0 our.bowl (contact:to-0 con)) =. cor (p-resp [%self con]) (give (fact subs [%full p])) @@ -350,7 +350,7 @@ %_ si-cor for +.u cor =. cor - (p-news-0:pub who (contact:from con.u)) + (p-news-0:pub who (contact:to-0 con.u)) =/ page=(unit page) (~(get by book) who) :: update peer contact page :: @@ -442,7 +442,7 @@ ++ convert |= con=contact:legacy ^- profile - %- profile:to + %- profile:from-0 [last-updated.con con(|6 groups.con)] -- :: @@ -459,7 +459,7 @@ :: ?- -.old %0 - =. rof ?~(rof.old *profile (profile:to rof.old)) + =. rof ?~(rof.old *profile (profile:from-0 rof.old)) :: migrate peers. for each peer :: 1. leave /epic, if any :: 2. subscribe if desired @@ -475,7 +475,7 @@ [%pass /epic %agent [who dap.bowl] %leave ~] =/ fir=$@(~ profile) ?~ for ~ - (profile:to for) + (profile:from-0 for) :: no intent to connect :: ?: =(~ sag) @@ -595,10 +595,10 @@ ?~ page=(~(get by book) who) ~ mod.u.page - (foreign:from (foreign-mod far mod)) + (foreign:to-0 (foreign-mod far mod)) =/ lor-0=rolodex:legacy ?: ?=(~ con.rof) rol-0 - (~(put by rol-0) our.bowl (profile:from rof) ~) + (~(put by rol-0) our.bowl (profile:to-0 rof) ~) ``contact-rolodex+!>(lor-0) :: [%x %contact her=@ ~] @@ -606,10 +606,10 @@ [~ ~] =/ tac=?(~ contact-0:legacy) ?: =(our.bowl u.who) - ?~(con.rof ~ (contact:from con.rof)) + ?~(con.rof ~ (contact:to-0 con.rof)) =+ far=(~(get by peers) u.who) ?: |(?=(~ far) ?=(~ for.u.far)) ~ - (contact:from con.for.u.far) + (contact:to-0 con.for.u.far) ?~ tac [~ ~] ``contact+!>(`contact-0:legacy`tac) :: diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 4b836192..0fa97b8e 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -184,9 +184,9 @@ |= [key=@tas acc=_don] (~(del by don) key) don -:: +to: legacy to new type +:: +from-0: legacy to new type :: -++ to +++ from-0 |% :: +contact: convert legacy to contact :: @@ -222,7 +222,7 @@ -- :: +from: legacy from new type :: -++ from +++ to-0 |% :: +contact: convert contact to legacy :: @@ -259,27 +259,27 @@ ++ profile |= p=^profile ^- profile-0:legacy - [wen.p (contact:from con.p)] + [wen.p (contact:to-0 con.p)] :: +profile-0-mod: convert profile with contact overlay :: to legacy :: ++ profile-mod |= [p=^profile mod=^contact] ^- profile-0:legacy - [wen.p (contact:from (contact-uni con.p mod))] + [wen.p (contact:to-0 (contact-uni con.p mod))] :: +foreign: convert foreign to legacy :: ++ foreign |= f=^foreign ^- foreign-0:legacy - [?~(for.f ~ (profile:from for.f)) sag.f] + [?~(for.f ~ (profile:to-0 for.f)) sag.f] :: foreign-mod: convert foreign with contact overlay :: to legacy :: ++ foreign-mod |= [f=^foreign mod=^contact] ^- foreign-0:legacy - [?~(for.f ~ (profile-mod:from for.f mod)) sag.f] + [?~(for.f ~ (profile-mod:to-0 for.f mod)) sag.f] -- :: +contact-uni: merge contacts :: diff --git a/desk/mar/contact-1.hoon b/desk/mar/contact-1.hoon index da752a18..e75a43d4 100644 --- a/desk/mar/contact-1.hoon +++ b/desk/mar/contact-1.hoon @@ -11,6 +11,6 @@ |% ++ noun contact:c ++ json contact:dejs:j - ++ contact contact:to:c + ++ contact contact:from-0:c -- -- diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 6759b8e6..889742f2 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -406,7 +406,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers @@ -465,7 +465,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == @@ -519,7 +519,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers @@ -548,7 +548,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c (~(uni by con-sun) con-mod))])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c (~(uni by con-sun) con-mod))])) (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun con-mod])) == :: despite the edit, ~sun peer contact is unchanged @@ -580,7 +580,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%wipe ~[~sun]])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%wipe ~sun])) == :: ~sun contact page is removed @@ -623,7 +623,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers @@ -652,7 +652,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c (~(uni by con-sun) con-mod))])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c (~(uni by con-sun) con-mod))])) (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun con-mod])) == :: ~sun is dropped @@ -713,7 +713,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun is snubbed @@ -760,7 +760,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from:c con)])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from-0-0:c con)])) (ex-fact ~[/v1/news] contact-response-0+!>([%self con])) (ex-fact ~ contact-update-1+!>([%full `@da`(add now.bowl tick) con])) == @@ -780,7 +780,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from:c con)])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from-0-0:c con)])) (ex-fact ~[/v1/news] contact-response-0+!>([%self con])) (ex-fact ~[/v1/contact] contact-update-1+!>([%full now con])) == @@ -841,10 +841,10 @@ ;< ~ b %+ ex-equal !> (~(got by rol) ~sun) - !> [[now.bowl (contact:from:c con-sun)] %want] + !> [[now.bowl (contact:from-0-0:c con-sun)] %want] %+ ex-equal !> (~(got by rol) ~mur) - !> [[now.bowl (contact:from:c con-mur)] %want] + !> [[now.bowl (contact:from-0-0:c con-mur)] %want] :: ++ test-peek-book %- eval-mare From 06f71eb11e2c880991487c4607a971f0ef9d1816 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 23 Sep 2024 15:20:28 +0800 Subject: [PATCH 34/44] contacts: perform runtime type check for $contact --- desk/app/contacts.hoon | 10 +++++----- desk/lib/contacts.hoon | 2 +- desk/lib/contacts/json-1.hoon | 4 ++-- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 13ed0058..0e731aad 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -154,7 +154,7 @@ (do-edit old con) ?: =(old new) cor - ?> (sane-contact new) + ?> (sane-contact ;;(contact new)) (p-send-self new) :: +p-page: create new contact page :: @@ -162,7 +162,7 @@ |= [=cid con=contact] ?: (~(has by book) id+cid) ~| "contact page {} already exists" !! - ?> (sane-contact con) + ?> (sane-contact ;;(contact con)) (p-send-page cid con) :: +p-spot: add peer as a contact :: @@ -176,7 +176,7 @@ (~(got by peers) who) ?~ for.far *contact con.for.far - ?> (sane-contact mod) + ?> (sane-contact ;;(contact mod)) (p-send-spot who con mod) :: +p-edit: edit contact page overlay :: @@ -191,7 +191,7 @@ (do-edit old mod) ?: =(old new) cor - ?> (sane-contact new) + ?> (sane-contact ;;(contact new)) (p-send-edit kip con.page new) :: +p-wipe: delete a contact page :: @@ -343,7 +343,7 @@ ++ si-hear |= u=update ^+ si-cor - ?. (sane-contact con.u) + ?. (sane-contact ;;(contact con.u)) si-cor ?: &(?=(^ for) (lte wen.u wen.for)) si-cor diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 0fa97b8e..66b971a3 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -141,7 +141,7 @@ == :: +sane-contact: verify contact sanity :: -:: - restrict size of the jammed noun to 1kB +:: - restrict size of the jammed noun to 10kB :: - prohibit 'data:' URLs in image data :: ++ sane-contact diff --git a/desk/lib/contacts/json-1.hoon b/desk/lib/contacts/json-1.hoon index 32034488..f03ac48e 100644 --- a/desk/lib/contacts/json-1.hoon +++ b/desk/lib/contacts/json-1.hoon @@ -35,9 +35,9 @@ == :: ++ contact - |= c=contact:c + |= con=contact:c ^- json - o+(~(run by c) value) + o+(~(run by con) value) :: ++ page |= =page:c From 48b2548865683a7d3ebdff881820c11e4ed695fb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Mon, 23 Sep 2024 17:49:58 +0800 Subject: [PATCH 35/44] contacts: improve naming in ^pub --- desk/app/contacts.hoon | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 0e731aad..876926aa 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -143,7 +143,7 @@ |% :: +p-anon: delete our profile :: - ++ p-anon ?.(?=([@ ^] rof) cor (p-send-self ~)) + ++ p-anon ?.(?=([@ ^] rof) cor (p-commit-self ~)) :: +p-self: edit our profile :: ++ p-self @@ -155,7 +155,7 @@ ?: =(old new) cor ?> (sane-contact ;;(contact new)) - (p-send-self new) + (p-commit-self new) :: +p-page: create new contact page :: ++ p-page @@ -163,7 +163,7 @@ ?: (~(has by book) id+cid) ~| "contact page {} already exists" !! ?> (sane-contact ;;(contact con)) - (p-send-page cid con) + (p-commit-page cid con) :: +p-spot: add peer as a contact :: ++ p-spot @@ -177,7 +177,7 @@ ?~ for.far *contact con.for.far ?> (sane-contact ;;(contact mod)) - (p-send-spot who con mod) + (p-commit-spot who con mod) :: +p-edit: edit contact page overlay :: ++ p-edit @@ -192,17 +192,17 @@ ?: =(old new) cor ?> (sane-contact ;;(contact new)) - (p-send-edit kip con.page new) + (p-commit-edit kip con.page new) :: +p-wipe: delete a contact page :: ++ p-wipe |= wip=(list kip) %+ roll wip |= [=kip acc=_cor] - (p-send-wipe kip) - :: +p-send-self: publish modified profile + (p-commit-wipe kip) + :: +p-commit-self: publish modified profile :: - ++ p-send-self + ++ p-commit-self |= con=contact =/ p=profile [(mono wen.rof now.bowl) con] =. rof p @@ -212,31 +212,31 @@ =. cor (p-resp [%self con]) (give (fact subs [%full p])) - :: +p-send-page: publish new contact page + :: +p-commit-page: publish new contact page :: - ++ p-send-page + ++ p-commit-page |= [=cid mod=contact] =/ =page [*contact mod] =. book (~(put by book) id+cid page) (p-resp [%page id+cid page]) - :: +p-send-spot: publish peer spot + :: +p-commit-spot: publish peer spot :: - ++ p-send-spot + ++ p-commit-spot |= [who=ship con=contact mod=contact] =. book (~(put by book) who con mod) (p-resp [%page who con mod]) - :: +p-send-edit: publish contact page update + :: +p-commit-edit: publish contact page update :: - ++ p-send-edit + ++ p-commit-edit |= [=kip =page] =. book (~(put by book) kip page) (p-resp [%page kip page]) - :: +p-send-wipe: publish contact page wipe + :: +p-commit-wipe: publish contact page wipe :: - ++ p-send-wipe + ++ p-commit-wipe |= =kip =. book (~(del by book) kip) From c99da6bc8b2ef88bb81677621cc55cb87f3d8444 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 24 Sep 2024 10:17:26 +0800 Subject: [PATCH 36/44] contacts: fix +sane-contact; refactoring --- desk/app/contacts.hoon | 60 +++++++++++++++++++----------------- desk/lib/contacts.hoon | 6 ++-- desk/tests/app/contacts.hoon | 42 ++++++++++++------------- 3 files changed, 57 insertions(+), 51 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 876926aa..17467a8a 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -154,7 +154,7 @@ (do-edit old con) ?: =(old new) cor - ?> (sane-contact ;;(contact new)) + ?> (sane-contact new) (p-commit-self new) :: +p-page: create new contact page :: @@ -162,7 +162,7 @@ |= [=cid con=contact] ?: (~(has by book) id+cid) ~| "contact page {} already exists" !! - ?> (sane-contact ;;(contact con)) + ?> (sane-contact con) (p-commit-page cid con) :: +p-spot: add peer as a contact :: @@ -176,7 +176,7 @@ (~(got by peers) who) ?~ for.far *contact con.for.far - ?> (sane-contact ;;(contact mod)) + ?> (sane-contact mod) (p-commit-spot who con mod) :: +p-edit: edit contact page overlay :: @@ -191,7 +191,7 @@ (do-edit old mod) ?: =(old new) cor - ?> (sane-contact ;;(contact new)) + ?> (sane-contact new) (p-commit-edit kip con.page new) :: +p-wipe: delete a contact page :: @@ -210,7 +210,7 @@ =. cor (p-news-0 our.bowl (contact:to-0 con)) =. cor - (p-resp [%self con]) + (p-response [%self con]) (give (fact subs [%full p])) :: +p-commit-page: publish new contact page :: @@ -219,28 +219,28 @@ =/ =page [*contact mod] =. book (~(put by book) id+cid page) - (p-resp [%page id+cid page]) + (p-response [%page id+cid page]) :: +p-commit-spot: publish peer spot :: ++ p-commit-spot |= [who=ship con=contact mod=contact] =. book (~(put by book) who con mod) - (p-resp [%page who con mod]) + (p-response [%page who con mod]) :: +p-commit-edit: publish contact page update :: ++ p-commit-edit |= [=kip =page] =. book (~(put by book) kip page) - (p-resp [%page kip page]) + (p-response [%page kip page]) :: +p-commit-wipe: publish contact page wipe :: ++ p-commit-wipe |= =kip =. book (~(del by book) kip) - (p-resp [%wipe kip]) + (p-response [%wipe kip]) :: +p-init: publish our profile :: ++ p-init @@ -255,9 +255,9 @@ ++ p-news-0 |= n=news-0:legacy (give %fact ~[/news] %contact-news !>(n)) - :: +p-resp: publish response + :: +p-response: publish response :: - ++ p-resp + ++ p-response |= r=response (give %fact ~[/v1/news] %contact-response-0 !>(r)) -- @@ -302,7 +302,7 @@ :: NB: this assumes con.for is only set in +si-hear :: =. cor (p-news-0:pub who ~) - (p-resp:pub [%peer who ~]) + (p-response:pub [%peer who ~]) :: %dead ?: new cor =. peers (~(del by peers) who) @@ -311,7 +311,7 @@ :: as *contact* deletion. but it's close, and keeps /news simpler :: =. cor (p-news-0:pub who ~) - (p-resp:pub [%peer who ~]) + (p-response:pub [%peer who ~]) == :: ++ si-take @@ -330,7 +330,7 @@ =/ wake=@da (add now.bowl ~s10) =. retry (~(put by retry) who wake) %_ si-cor cor - (pass /~/retry/(scot %p who) %arvo %b %wait wake) + (pass /retry/(scot %p who) %arvo %b %wait wake) == :: %kick si-meet(sag ~) @@ -343,22 +343,22 @@ ++ si-hear |= u=update ^+ si-cor - ?. (sane-contact ;;(contact con.u)) + ?. (sane-contact con.u) si-cor ?: &(?=(^ for) (lte wen.u wen.for)) si-cor %_ si-cor for +.u cor =. cor - (p-news-0:pub who (contact:to-0 con.u)) + (p-news-0:pub who (contact:to-0 con.u)) =/ page=(unit page) (~(get by book) who) :: update peer contact page :: =? cor ?=(^ page) ?: =(con.u.page con.u) cor =. book (~(put by book) who u.page(con con.u)) - (p-resp:pub %page who con.u mod.u.page) - (p-resp:pub %peer who con.u) + (p-response:pub %page who con.u mod.u.page) + (p-response:pub %peer who con.u) == :: ++ si-meet @@ -375,6 +375,13 @@ :: ++ si-retry ^+ si-cor + :: + :: XX this works around a gall/behn bug: + :: the timer is identified by the whole duct. + :: it needn't be the same when gall passes our + :: card to behn. + ?. (~(has by retry) who) + si-cor =. retry (~(del by retry) who) si-meet(sag ~) :: @@ -386,13 +393,9 @@ cor ?. ?=(%want sag) cor :: 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 /retry/(scot %p who)/cancel %arvo %b %rest u.when) (pass /contact %agent [who dap.bowl] %leave ~) == -- @@ -429,9 +432,10 @@ :: |^ cor(rof us, peers them) - ++ us %+ fall - ^- (unit profile) (bind (~(get by ful) our.bowl) convert) - *profile + ++ us + %+ fall + (bind (~(get by ful) our.bowl) convert) + *profile :: ++ them ^- ^peers @@ -734,12 +738,12 @@ ^+ cor ?+ wire ~|(evil-vane+wire !!) :: - [%~.~ %retry her=@p ~] + [%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) + =+ who=(slav %p i.t.wire) si-abet:si-retry:(sub who) == -- diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 66b971a3..1e67a1be 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -147,7 +147,9 @@ ++ sane-contact |= con=contact ^- ? - :: 5kB contact ought to be enough for anybody + ?~ ((soft contact) con) + | + :: 10kB contact ought to be enough for anybody :: ?: (gth (met 3 (jam con)) 10.000) | @@ -221,7 +223,7 @@ :: -- :: +from: legacy from new type -:: +:: ++ to-0 |% :: +contact: convert contact to legacy diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 889742f2..f46f104a 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -406,7 +406,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers @@ -416,7 +416,7 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) + !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: meet ~sun a second time: a no-op :: @@ -457,7 +457,7 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign`[~ %want]) + !> contact-foreign-0+!>(`foreign`[~ %want]) :: ~sun publishes his contact :: ;< ~ b (set-src ~sun) @@ -465,7 +465,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == @@ -519,7 +519,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers @@ -529,7 +529,7 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) + !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: ~sun is added to contacts :: @@ -548,7 +548,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c (~(uni by con-sun) con-mod))])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c (~(uni by con-sun) con-mod))])) (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun con-mod])) == :: despite the edit, ~sun peer contact is unchanged @@ -558,7 +558,7 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) + !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] %want]) :: however, ~sun's contact book page is changed :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) @@ -580,7 +580,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%wipe ~[~sun]])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%wipe ~sun])) == :: ~sun contact page is removed @@ -595,7 +595,7 @@ =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) + !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] %want]) :: ++ test-poke-drop %- eval-mare @@ -623,7 +623,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun appears in peers @@ -633,7 +633,7 @@ ;< ~ b %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] %want]) + !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] %want]) ;< ~ b (set-src ~sun) :: ~sun is added to contacts :: @@ -652,7 +652,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%edit ~sun con-mod])) ;< ~ b %+ ex-cards caz - :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c (~(uni by con-sun) con-mod))])) + :~ :: (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c (~(uni by con-sun) con-mod))])) (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun con-mod])) == :: ~sun is dropped @@ -713,7 +713,7 @@ (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con-sun])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:from-0-0:c con-sun)])) + :~ (ex-fact ~[/news] contact-news+!>([~sun (contact:to-0:c con-sun)])) (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun con-sun])) == :: ~sun is snubbed @@ -730,7 +730,7 @@ =/ cag=cage (need (need peek)) %+ ex-equal !> cag - !> contact-foreign-1+!>(`foreign`[[now.bowl con-sun] ~]) + !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] ~]) :: +| %peer :: +test-peer-profile @@ -760,7 +760,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from-0-0:c con)])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:to-0:c con)])) (ex-fact ~[/v1/news] contact-response-0+!>([%self con])) (ex-fact ~ contact-update-1+!>([%full `@da`(add now.bowl tick) con])) == @@ -780,7 +780,7 @@ ;< caz=(list card) b (do-poke contact-action-1+!>([%self con])) ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:from-0-0:c con)])) + :~ (ex-fact ~[/news] contact-news+!>([our.bowl (contact:to-0:c con)])) (ex-fact ~[/v1/news] contact-response-0+!>([%self con])) (ex-fact ~[/v1/contact] contact-update-1+!>([%full now con])) == @@ -841,10 +841,10 @@ ;< ~ b %+ ex-equal !> (~(got by rol) ~sun) - !> [[now.bowl (contact:from-0-0:c con-sun)] %want] + !> [[now.bowl (contact:to-0:c con-sun)] %want] %+ ex-equal !> (~(got by rol) ~mur) - !> [[now.bowl (contact:from-0-0:c con-mur)] %want] + !> [[now.bowl (contact:to-0:c con-mur)] %want] :: ++ test-peek-book %- eval-mare @@ -997,11 +997,11 @@ [%watch-ack (some leaf+"outdated contacts" ~)] ;< ~ b %+ ex-cards caz - :~ %+ ex-arvo /~/retry/(scot %p ~sun) + :~ %+ ex-arvo /retry/(scot %p ~sun) [%b %wait (add now.bowl ~s10)] == ;< caz=(list card) b - %+ do-arvo /~/retry/(scot %p ~sun) + %+ do-arvo /retry/(scot %p ~sun) [%behn %wake ~] %+ ex-cards caz :~ %^ ex-task /contact From 5b7ed3469f2c1eb9de61a18489b38380aa788e10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 24 Sep 2024 12:17:48 +0800 Subject: [PATCH 37/44] contacts: refactoring --- desk/app/contacts.hoon | 56 ++++++++++++++++++------------------ desk/lib/contacts.hoon | 34 +++++++++++----------- desk/tests/app/contacts.hoon | 26 ++++++++--------- 3 files changed, 58 insertions(+), 58 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 17467a8a..f7cbc397 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -253,7 +253,7 @@ :: +p-news-0: [legacy] publish news :: ++ p-news-0 - |= n=news-0:legacy + |= n=news-0:c0 (give %fact ~[/news] %contact-news !>(n)) :: +p-response: publish response :: @@ -460,8 +460,24 @@ ^+ cor |^ =+ !<([old=versioned-state cool=epic] old-vase) =? cor !=(okay cool) l-epic - :: ?- -.old + :: + %1 + =. state old + =/ cards + %+ roll ~(tap by peers) + |= [[who=ship foreign] caz=(list card)] + :: intent to connect, resubscribe + :: + ?: ?& =(%want sag) + !(~(has by wex.bowl) [/contact who dap.bowl]) + == + =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] + :_ caz + [%pass /contact %agent [who dap.bowl] %watch path] + caz + (emil cards) + :: %0 =. rof ?~(rof.old *profile (profile:from-0 rof.old)) :: migrate peers. for each peer @@ -471,7 +487,7 @@ :: =^ caz=(list card) peers %+ roll ~(tap by rol.old) - |= [[who=ship foreign-0:legacy] caz=(list card) =_peers] + |= [[who=ship foreign-0:c0] caz=(list card) =_peers] :: leave /epic if any :: =? caz (~(has by wex.bowl) [/epic who dap.bowl]) @@ -492,24 +508,8 @@ :_ caz [%pass /contact %agent [who dap.bowl] %watch path] (emil caz) - :: - %1 - =. state old - =/ cards - %+ roll ~(tap by peers) - |= [[who=ship foreign] caz=(list card)] - :: intent to connect, resubscribe - :: - ?: ?& =(%want sag) - !(~(has by wex.bowl) [/contact who dap.bowl]) - == - =/ =path [%v1 %contact ?~(for / /at/(scot %da wen.for))] - :_ caz - [%pass /contact %agent [who dap.bowl] %watch path] - caz - (emil cards) == - +$ state-0 [%0 rof=$@(~ profile-0:legacy) rol=rolodex:legacy] + +$ state-0 [%0 rof=$@(~ profile-0:c0) rol=rolodex:c0] +$ versioned-state $% state-0 state-1 @@ -536,7 +536,7 @@ :: :: legacy %contact-action ?(%contact-action %contact-action-0) - =/ act-0 !<(action-0:legacy vase) + =/ act-0 !<(action-0:c0 vase) ?. ?=(%edit -.act-0) (to-action act-0) :: v0 %edit needs special handling to evaluate @@ -572,8 +572,8 @@ :: :: v0 scries :: - :: /x/all -> $rolodex:legacy - :: /x/contact/her=@ -> $@(~ contact-0:legacy) + :: /x/all -> $rolodex:c0 + :: /x/contact/her=@ -> $@(~ contact-0:c0) :: :: v1 scries :: @@ -591,16 +591,16 @@ ?+ pat [~ ~] :: [%x %all ~] - =/ rol-0=rolodex:legacy + =/ rol-0=rolodex:c0 %- ~(urn by peers) |= [who=ship far=foreign] - ^- foreign-0:legacy + ^- foreign-0:c0 =/ mod=contact ?~ page=(~(get by book) who) ~ mod.u.page (foreign:to-0 (foreign-mod far mod)) - =/ lor-0=rolodex:legacy + =/ lor-0=rolodex:c0 ?: ?=(~ con.rof) rol-0 (~(put by rol-0) our.bowl (profile:to-0 rof) ~) ``contact-rolodex+!>(lor-0) @@ -608,14 +608,14 @@ [%x %contact her=@ ~] ?~ who=(slaw %p her.pat) [~ ~] - =/ tac=?(~ contact-0:legacy) + =/ tac=?(~ contact-0:c0) ?: =(our.bowl u.who) ?~(con.rof ~ (contact:to-0 con.rof)) =+ far=(~(get by peers) u.who) ?: |(?=(~ far) ?=(~ for.u.far)) ~ (contact:to-0 con.for.u.far) ?~ tac [~ ~] - ``contact+!>(`contact-0:legacy`tac) + ``contact+!>(`contact-0:c0`tac) :: [%x %v1 %self ~] ``contact-1+!>(`contact`con.rof) diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 1e67a1be..27798e62 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -1,4 +1,4 @@ -/- *contacts, legacy=contacts-0 +/- *contacts, c0=contacts-0 |% :: +| %contact @@ -115,7 +115,7 @@ -- :: ++ do-edit-0 - |= [c=contact-0:legacy f=field-0:legacy] + |= [c=contact-0:c0 f=field-0:c0] ^+ c ?- -.f %nickname c(nickname nickname.f) @@ -193,7 +193,7 @@ :: +contact: convert legacy to contact :: ++ contact - |= o=contact-0:legacy + |= o=contact-0:c0 ^- ^contact =/ c=^contact %- malt @@ -217,7 +217,7 @@ :: +profile: convert legacy to profile :: ++ profile - |= o=profile-0:legacy + |= o=profile-0:c0 ^- ^profile [wen.o ?~(con.o ~ (contact con.o))] :: @@ -230,9 +230,9 @@ :: ++ contact |= c=^contact - ^- $@(~ contact-0:legacy) + ^- $@(~ contact-0:c0) ?~ c ~ - =| o=contact-0:legacy + =| o=contact-0:c0 %_ o nickname (~(gub cy c) %nickname %text) @@ -260,27 +260,27 @@ :: ++ profile |= p=^profile - ^- profile-0:legacy + ^- profile-0:c0 [wen.p (contact:to-0 con.p)] :: +profile-0-mod: convert profile with contact overlay :: to legacy :: ++ profile-mod |= [p=^profile mod=^contact] - ^- profile-0:legacy + ^- profile-0:c0 [wen.p (contact:to-0 (contact-uni con.p mod))] :: +foreign: convert foreign to legacy :: ++ foreign |= f=^foreign - ^- foreign-0:legacy + ^- foreign-0:c0 [?~(for.f ~ (profile:to-0 for.f)) sag.f] :: foreign-mod: convert foreign with contact overlay :: to legacy :: ++ foreign-mod |= [f=^foreign mod=^contact] - ^- foreign-0:legacy + ^- foreign-0:c0 [?~(for.f ~ (profile-mod:to-0 for.f mod)) sag.f] -- :: +contact-uni: merge contacts @@ -308,7 +308,7 @@ :: +$ sole-field-0 $~ nickname+'' - $<(?(%add-group %del-group) field-0:legacy) + $<(?(%add-group %del-group) field-0:c0) :: +to-sole-edit: convert legacy sole field to contact edit :: :: modify any field except for groups @@ -358,7 +358,7 @@ :: +to-self-edit: convert legacy to self edit :: ++ to-self-edit - |= [edit-0=(list field-0:legacy) groups=(set value)] + |= [edit-0=(list field-0:c0) groups=(set value)] ^- contact :: converting v0 profile edit to v1 is non-trivial. :: for field edits other than groups, we derive a contact @@ -370,8 +370,8 @@ :: .gid: only group edit actions :: =* group-type ?(%add-group %del-group) - =* sole-edits (list $<(group-type field-0:legacy)) - =* group-edits (list $>(group-type field-0:legacy)) + =* sole-edits (list $<(group-type field-0:c0)) + =* group-edits (list $>(group-type field-0:c0)) :: sift edits :: =/ [sid=sole-edits gid=group-edits] @@ -379,7 +379,7 @@ :: XX why is casting neccessary here? =- [(flop `sole-edits`-<) (flop `group-edits`->)] %+ roll edit-0 - |= [f=field-0:legacy sid=sole-edits gid=group-edits] + |= [f=field-0:c0 sid=sole-edits gid=group-edits] ^+ [sid gid] ?. ?=(group-type -.f) :- [f sid] @@ -390,7 +390,7 @@ :: =. groups %+ roll gid - |= [ged=$>(group-type field-0:legacy) =_groups] + |= [ged=$>(group-type field-0:c0) =_groups] ?- -.ged %add-group (~(put in groups) flag/flag.ged) @@ -407,7 +407,7 @@ :: access to existing groups to be able to process group edits. :: ++ to-action - |= o=$<(%edit action-0:legacy) + |= o=$<(%edit action-0:c0) ^- action ?- -.o %anon [%anon ~] diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index f46f104a..8b92314b 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -1,4 +1,4 @@ -/- *contacts, x=contacts-0 +/- *contacts, c0=contacts-0 /+ *test-agent /+ c=contacts /= contacts-agent /app/contacts @@ -29,7 +29,7 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0:x + =| con-0=contact-0:c0 =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' :: @@ -37,8 +37,8 @@ %- malt ^- (list (pair @tas value)) ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] - =/ edit-0=(list field-0:x) - ^- (list field-0:x) + =/ edit-0=(list field-0:c0) + ^- (list field-0:c0) :~ nickname+'Zod' bio+'The first of the galaxies' == @@ -52,11 +52,11 @@ ;< caz=(list card) b (do-watch /news) :: ;< ~ b (set-src our.bowl) - :: action-0:x profile %edit + :: action-0:c0 profile %edit :: ;< caz=(list card) b (do-poke contact-action+!>([%edit edit-0])) :: - =/ upd-0=update-0:x + =/ upd-0=update-0:c0 [%full (add now.bowl (mul 2 tick)) ~] =/ upd-1=update [%full (add now.bowl (mul 2 tick)) ~] @@ -76,7 +76,7 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0:x + =| con-0=contact-0:c0 =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' =. groups.con-0 (silt ~sampel-palnet^%oranges ~) @@ -89,8 +89,8 @@ groups+set/(silt flag/~sampel-palnet^%oranges ~) == :: - =/ edit-0=(list field-0:x) - ^- (list field-0:x) + =/ edit-0=(list field-0:c0) + ^- (list field-0:c0) :~ nickname+'Zod' bio+'The first of the galaxies' add-group+~sampel-palnet^%apples @@ -111,7 +111,7 @@ ;< caz=(list card) b (do-watch /v1/news) :: ;< ~ b (set-src our.bowl) - :: action-0:x profile %edit + :: action-0:c0 profile %edit :: ;< caz=(list card) b (do-poke %contact-action !>([%edit edit-0])) ;< ~ b @@ -254,7 +254,7 @@ ;< caz=(list card) b (do-init %contacts contacts-agent) ;< =bowl b get-bowl :: - =| con-0=contact-0:x + =| con-0=contact-0:c0 =. nickname.con-0 'Zod' =. bio.con-0 'The first of the galaxies' :: @@ -263,7 +263,7 @@ ^- (list (pair @tas value)) ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] :: - =/ upd-0=update-0:x + =/ upd-0=update-0:c0 [%full (add now.bowl tick) con-0] =/ upd-1=update [%full (add now.bowl tick) con-1] @@ -837,7 +837,7 @@ ;< peek=(unit (unit cage)) b (get-peek /x/all) =/ cag=cage (need (need peek)) ?> ?=(%contact-rolodex p.cag) - =/ rol !<(rolodex:x q.cag) + =/ rol !<(rolodex:c0 q.cag) ;< ~ b %+ ex-equal !> (~(got by rol) ~sun) From 9a2104075968116adc51ad48bbe41c609a0ef3d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Wed, 25 Sep 2024 12:05:41 +0800 Subject: [PATCH 38/44] contacts: validate %nickname, %bio fields --- desk/lib/contacts.hoon | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 27798e62..87508c9c 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -153,8 +153,23 @@ :: ?: (gth (met 3 (jam con)) 10.000) | - :: prohibit data URLs in the image links + :: field restrictions :: + :: 1. %nickname field: max 64 characters + :: 2. %bio field: max 2048 characters + :: 3. data URLs in %avatar and %cover + :: are forbidden + :: + =+ nickname=(~(get cy con) %nickname %text) + ?: ?& ?=(^ nickname) + (gth (met 3 u.nickname) 64) + == + | + =+ bio=(~(get cy con) %bio %text) + ?: ?& ?=(^ bio) + (gth (met 3 u.bio) 2.048) + == + | =+ avatar=(~(get cy con) %avatar %text) ?: ?& ?=(^ avatar) =('data:' (end 3^5 u.avatar)) From 5dd27e71f009abcaabaf716c784e7bde34205212 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Wed, 25 Sep 2024 12:36:10 +0800 Subject: [PATCH 39/44] contacts: fix lib-negotiate --- desk/lib/negotiate.hoon | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/desk/lib/negotiate.hoon b/desk/lib/negotiate.hoon index 236de8bc..71938dcd 100644 --- a/desk/lib/negotiate.hoon +++ b/desk/lib/negotiate.hoon @@ -515,9 +515,8 @@ =. cards (snoc cards [%pass wire.sub %agent gill.sub %leave ~]) =. wex.bowl (~(del by wex.bowl) -.sub) =^ caz inner - %. [wire.sub %kick ~] - =. src.bowl p.gill.i.suz - ~(on-agent inner inner-bowl:up) + =. src.bowl p.gill.sub + (on-agent:og wire.sub %kick ~) =^ caz state (play-cards:up caz) $(cards (weld cards caz), suz t.suz) :: From 853b707175a6ffef952299091f0bcdb7f7a96e27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Wed, 25 Sep 2024 14:05:11 +0800 Subject: [PATCH 40/44] contacts: unify %page and %spot pokes into %page --- desk/app/contacts.hoon | 54 +++++++++++++++-------------------- desk/lib/contacts/json-1.hoon | 3 +- desk/sur/contacts.hoon | 4 +-- desk/tests/app/contacts.hoon | 28 +++++++++--------- 4 files changed, 39 insertions(+), 50 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index f7cbc397..4016ba50 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -156,17 +156,9 @@ cor ?> (sane-contact new) (p-commit-self new) - :: +p-page: create new contact page - :: - ++ p-page - |= [=cid con=contact] - ?: (~(has by book) id+cid) - ~| "contact page {} already exists" !! - ?> (sane-contact con) - (p-commit-page cid con) - :: +p-spot: add peer as a contact + :: +p-page-spot: add ship as a contact :: - ++ p-spot + ++ p-page-spot |= [who=ship mod=contact] ?: (~(has by book) who) ~| "peer {} is already a contact" !! @@ -177,7 +169,17 @@ ?~ for.far *contact con.for.far ?> (sane-contact mod) - (p-commit-spot who con mod) + (p-commit-page who con mod) + :: +p-page: create new contact page + :: + ++ p-page + |= [=kip mod=contact] + ?@ kip + (p-page-spot kip mod) + ?: (~(has by book) kip) + ~| "contact page {} already exists" !! + ?> (sane-contact mod) + (p-commit-page kip ~ mod) :: +p-edit: edit contact page overlay :: ++ p-edit @@ -215,18 +217,9 @@ :: +p-commit-page: publish new contact page :: ++ p-commit-page - |= [=cid mod=contact] - =/ =page - [*contact mod] - =. book (~(put by book) id+cid page) - (p-response [%page id+cid page]) - :: +p-commit-spot: publish peer spot - :: - ++ p-commit-spot - |= [who=ship con=contact mod=contact] - =. book - (~(put by book) who con mod) - (p-response [%page who con mod]) + |= [=kip =page] + =. book (~(put by book) kip page) + (p-response [%page kip page]) :: +p-commit-edit: publish contact page update :: ++ p-commit-edit @@ -534,7 +527,10 @@ =/ act=action ?- mark :: - :: legacy %contact-action + %contact-action-1 + !<(action vase) + :: upconvert legacy %contact-action + :: ?(%contact-action %contact-action-0) =/ act-0 !<(action-0:c0 vase) ?. ?=(%edit -.act-0) @@ -547,20 +543,16 @@ =+ set=(~(ges cy con.rof) groups+%flag) (fall set ~) [%self (to-self-edit p.act-0 groups)] - :: - %contact-action-1 - !<(action vase) == ?- -.act %anon p-anon:pub %self (p-self:pub p.act) - %page (p-page:pub p.act q.act) - :: if we spot someone who is not a peer, + :: if we add a page for someone who is not a peer, :: we meet them first :: - %spot =? cor !(~(has by peers) p.act) + %page =? cor &(?=(ship p.act) !(~(has by peers) p.act)) si-abet:si-meet:(sub p.act) - (p-spot:pub p.act q.act) + (p-page:pub p.act q.act) %edit (p-edit:pub p.act q.act) %wipe (p-wipe:pub p.act) %meet (s-many:sub p.act |=(s=_s-impl:sub si-meet:s)) diff --git a/desk/lib/contacts/json-1.hoon b/desk/lib/contacts/json-1.hoon index f03ac48e..390f75b8 100644 --- a/desk/lib/contacts/json-1.hoon +++ b/desk/lib/contacts/json-1.hoon @@ -140,8 +140,7 @@ %- of :~ anon+ul self+contact - page+(ot cid+cid contact+contact ~) - spot+(ot ship+ship contact+contact ~) + page+(ot kip+kip contact+contact ~) edit+(ot kip+kip contact+contact ~) wipe+(ar kip) meet+(ar ship) diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 8897173a..05fef1ce 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -98,7 +98,6 @@ :: %anon: delete our profile :: %self: edit our profile :: %page: create a new contact page -:: %spot: add peer as a contact :: %edit: edit a contact overlay :: %wipe: delete a contact page :: %meet: track a peer @@ -108,8 +107,7 @@ +$ action $% [%anon ~] [%self p=contact] - [%page p=cid q=contact] - [%spot p=ship q=contact] + [%page p=kip q=contact] [%edit p=kip q=contact] [%wipe p=(list kip)] [%meet p=(list ship)] diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index 8b92314b..c29b7191 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -312,7 +312,7 @@ ;< ~ b (set-src our.bowl) :: create new contact page :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v1 con-1])) :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz @@ -328,7 +328,7 @@ !> [%contact-page-0 !>(mypage)] :: fail to create duplicate page :: - %- ex-fail (do-poke contact-action-1+!>([%page 0v1 con-1])) + %- ex-fail (do-poke contact-action-1+!>([%page id+0v1 con-1])) :: +test-poke-edit: edit the contact book :: ++ test-poke-edit @@ -364,7 +364,7 @@ ;< ~ b (set-src our.bowl) :: create new contact page :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v1 con-1])) :: news is published on /v1/news :: ;< ~ b %+ ex-cards caz @@ -424,7 +424,7 @@ ;< caz=(list card) b (do-poke %contact-action !>([%meet ~[~sun]])) (ex-cards caz ~) :: -++ test-poke-spot-unknown +++ test-poke-page-unknown %- eval-mare =/ m (mare ,~) =* b bind:m @@ -440,9 +440,9 @@ :: ;< ~ b (set-src our.bowl) ;< caz=(list card) b (do-watch /news) - :: spot ~sun to contact boook: he also becomes our peer + :: page ~sun to contact boook: he also becomes our peer :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page ~sun ~])) ;< ~ b %+ ex-cards caz :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) @@ -493,7 +493,7 @@ !> cag !> contact-1+!>((contact-uni:c con-sun con-mod)) :: -++ test-poke-spot-wipe +++ test-poke-page-wipe %- eval-mare =/ m (mare ,~) =* b bind:m @@ -534,7 +534,7 @@ :: ~sun is added to contacts :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page ~sun ~])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) @@ -638,7 +638,7 @@ :: ~sun is added to contacts :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun ~])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page ~sun ~])) ;< ~ b %+ ex-cards caz :~ (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) @@ -863,8 +863,8 @@ ^- (list (pair @tas value)) ~[nickname+text/'Mur' bio+text/'Murky waters'] :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) - ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v2 con-2])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v2 con-2])) :: peek book: two contacts are found :: ;< peek=(unit (unit cage)) b (get-peek /x/v1/book) @@ -896,8 +896,8 @@ ^- (list (pair @tas value)) ~[nickname+text/'Mur' bio+text/'Murky waters'] :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v1 con-1])) - ;< caz=(list card) b (do-poke contact-action-1+!>([%page 0v2 con-2])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v1 con-1])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v2 con-2])) :: unknown page is not found :: ;< peek=(unit (unit cage)) b (get-peek /u/v1/book/id/0v3) @@ -955,7 +955,7 @@ :: ~sun is added to the contact book with user overlay :: ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-poke contact-action-1+!>([%spot ~sun con-mod])) + ;< caz=(list card) b (do-poke contact-action-1+!>([%page ~sun con-mod])) :: ~mur publishes his contact :: ;< ~ b (set-src ~mur) From 1edc4a96f9ecf9fa55703e568d9dffdb78db4edf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Wed, 25 Sep 2024 14:18:58 +0800 Subject: [PATCH 41/44] contacts: adjust subscription retry timer to ~m30 --- desk/app/contacts.hoon | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 4016ba50..5d6ec150 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -317,10 +317,7 @@ ?> ?=(%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) + =/ wake=@da (add now.bowl ~m30) =. retry (~(put by retry) who wake) %_ si-cor cor (pass /retry/(scot %p who) %arvo %b %wait wake) From 412e084c475e6a31a6f6ceff219b87dfbd5c073e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Wed, 25 Sep 2024 14:50:13 +0800 Subject: [PATCH 42/44] contacts: fix docs --- desk/sur/contacts.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 05fef1ce..20f310bc 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -121,7 +121,7 @@ +$ update $% [%full profile] == -:: $news: local update +:: $response: local update :: :: %self: profile update :: %page: contact page update From 059284f7f3d9ad8745bee5e6207c10d28f63359f Mon Sep 17 00:00:00 2001 From: Mikolaj Date: Wed, 2 Oct 2024 17:10:37 +0800 Subject: [PATCH 43/44] contacts: fix +sane-contact data URL check Co-authored-by: Hunter Miller --- desk/lib/contacts.hoon | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon index 87508c9c..96da7819 100644 --- a/desk/lib/contacts.hoon +++ b/desk/lib/contacts.hoon @@ -177,7 +177,7 @@ | =+ cover=(~(get cy con) %cover %text) ?: ?& ?=(^ cover) - !=('data:' (end 3^5 u.cover)) + =('data:' (end 3^5 u.cover)) == | & From 384939f105516f9644da66707dfa16bc8097aa5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Thu, 10 Oct 2024 21:37:37 +0800 Subject: [PATCH 44/44] contacts: test profile timestamp logic; fix saga type The .saga field of $foreign used to be defined as a nullable type $@(~ saga). However, $saga itself can take on atomic values, breaking the semantics of $@. Hoon compiler does not catch this error at compile time, however validating the type (and any type containing it) is going to fail. --- desk/app/contacts.hoon | 9 ++-- desk/sur/contacts.hoon | 2 +- desk/tests/app/contacts.hoon | 94 +++++++++++++++++++++++++++++++++--- 3 files changed, 94 insertions(+), 11 deletions(-) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon index 5d6ec150..a32cc40b 100644 --- a/desk/app/contacts.hoon +++ b/desk/app/contacts.hoon @@ -366,10 +366,11 @@ ++ si-retry ^+ si-cor :: - :: XX this works around a gall/behn bug: - :: the timer is identified by the whole duct. - :: it needn't be the same when gall passes our - :: card to behn. + ::XX this works around a gall/behn bug: + :: the timer is identified by the duct. + :: it needn't be the same when gall passes our + :: card to behn. + :: ?. (~(has by retry) who) si-cor =. retry (~(del by retry) who) diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index 20f310bc..414ad3c5 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -66,7 +66,7 @@ :: .for: profile :: .sag: connection status :: -+$ foreign [for=$@(~ profile) sag=$@(~ saga)] ++$ foreign [for=$@(~ profile) sag=saga] :: $page: contact page :: :: .con: peer contact diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon index c29b7191..66da7c31 100644 --- a/desk/tests/app/contacts.hoon +++ b/desk/tests/app/contacts.hoon @@ -17,6 +17,23 @@ ^- @da ?: (lth old new) new (add old tick) +:: +filter: filter unwanted cards +:: +:: ++ filter +:: |= caz=(list card) +:: ^+ caz +:: %+ skip caz +:: |= =card +:: ?. ?=(%pass -.card) | +:: ?+ p.card | +:: [%~.~ %negotiate *] & +:: == +:: ++ ex-cards +:: |= [caz=(list card) exes=(list $-(card tang))] +:: %+ ^ex-cards +:: (filter caz) +:: exes +:: +| %poke-0 :: :: +test-poke-0-anon: v0 delete the profile @@ -733,17 +750,17 @@ !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] ~]) :: +| %peer -:: +test-peer-profile +:: +test-pub-profile :: :: scenario :: :: ~sun subscribes to our /contact. we publish -:: our profile with current time-a. we then change -:: the profile, advancing the timestamp to time-b. -:: ~sun now subscribes to /contact/at/time-b. +:: our profile with current time a. we then change +:: the profile, advancing the timestamp to time b. +:: ~sun now subscribes to /contact/at/b. :: no update is sent. :: -++ test-peer-profile +++ test-pub-profile %- eval-mare =/ m (mare ,~) =* b bind:m @@ -800,6 +817,71 @@ ;< caz=(list card) b (do-watch /v1/contact/at/(scot %da now)) %+ ex-cards caz ~ :: +:: +test-sub-profile +:: +:: scenario +:: +:: we subscribe to ~sun's /contact. we receive +:: her profile at time a. subsequently, another update +:: of the profile with older timestamp is received. +:: ~sun's profile is not updated. most recent update +:: at time b arrives. ~sun's profile is updated. +:: we are kicked off the subscription, and in +:: the result we subscribe to /contact/at/b +:: path. +:: +++ test-sub-profile + %- eval-mare + =/ m (mare ,~) + =* b bind:m + ^- form:m + ;< caz=(list card) b (do-init %contacts contacts-agent) + ;< =bowl b get-bowl + :: + =/ con=contact + %- malt + ^- (list (pair @tas value)) + ~[nickname+text/'Sun' bio+text/'It is sunny today'] + =/ mod=contact + %- ~(uni by con) + %- malt ^- (list (pair @tas value)) + ~[birthday+date/~2000.1.1] + ;< caz=(list card) b (do-poke contact-action-1+!>([%meet ~sun ~])) + ;< ~ b + %+ ex-cards caz + :~ (ex-task /contact [~sun %contacts] %watch /v1/contact) + (ex-fact ~[/news] contact-news+!>([~sun ~])) + (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~sun ~])) + == + ;< ~ b (set-src ~sun) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full now.bowl con])) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full (sub now.bowl tick) mod])) + :: ~sun's profile is unchanged + :: + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> cag + !> contact-foreign-0+!>(`foreign`[[now.bowl con] %want]) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %fact contact-update-1+!>([%full (add now.bowl tick) mod])) + ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) + =/ cag=cage (need (need peek)) + ;< ~ b + %+ ex-equal + !> cag + !> contact-foreign-0+!>(`foreign`[[(add now.bowl tick) mod] %want]) + ;< caz=(list card) b + (do-agent /contact [~sun %contacts] %kick ~) + %+ ex-cards caz + :~ %^ ex-task /contact + [~sun %contacts] + [%watch /v1/contact/at/(scot %da (add now.bowl tick))] + == +:: +| %peek :: ++ test-peek-0-all @@ -998,7 +1080,7 @@ ;< ~ b %+ ex-cards caz :~ %+ ex-arvo /retry/(scot %p ~sun) - [%b %wait (add now.bowl ~s10)] + [%b %wait (add now.bowl ~m30)] == ;< caz=(list card) b %+ do-arvo /retry/(scot %p ~sun)