From 59ce8329268de76295d43a35376dd9f148b3f694 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] 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' ==