From a6fdbf7955cd86e4de18037c7f2df2fd1e93d8b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 5 Nov 2024 23:41:58 +0800 Subject: [PATCH] landscape: migrate Tlon infrastructure to the %groups desk The following agents are proprietary, and thus belong in the %groups desk: %bait, %bark, %contacts, %genuine, %growl, %reel and %settings. These, together with associated files, are removed in this commit and separately added to the %groups desk. The following agents remain: %docket, %hark, %storage, %treaty, %vitals. --- desk/app/bait.hoon | 224 ------ desk/app/bark.hoon | 142 ---- desk/app/contacts.hoon | 741 ------------------ desk/app/genuine.hoon | 95 --- desk/app/growl.hoon | 136 ---- desk/app/reel.hoon | 317 -------- desk/app/settings.hoon | 227 ------ desk/desk.bill | 8 +- desk/lib/contacts.hoon | 478 ------------ desk/lib/contacts/json-0.hoon | 135 ---- desk/lib/contacts/json-1.hoon | 151 ---- desk/lib/reel.hoon | 20 - desk/lib/settings.hoon | 147 ---- desk/mar/bait/describe.hoon | 12 - desk/mar/bait/undescribe.hoon | 11 - desk/mar/bark/add-recipient.hoon | 11 - desk/mar/bark/receive-summary.hoon | 20 - desk/mar/bark/remove-recipient.hoon | 11 - desk/mar/contact-0.hoon | 14 - desk/mar/contact-1.hoon | 16 - desk/mar/contact.hoon | 3 - desk/mar/contact/action-0.hoon | 15 - desk/mar/contact/action-1.hoon | 14 - desk/mar/contact/action.hoon | 2 - desk/mar/contact/book-0.hoon | 14 - desk/mar/contact/book.hoon | 14 - desk/mar/contact/directory-0.hoon | 14 - desk/mar/contact/directory.hoon | 14 - desk/mar/contact/news.hoon | 14 - desk/mar/contact/page-0.hoon | 14 - desk/mar/contact/page-1.hoon | 14 - desk/mar/contact/page.hoon | 14 - desk/mar/contact/response-0.hoon | 14 - desk/mar/contact/rolodex.hoon | 14 - desk/mar/contact/update-0.hoon | 12 - desk/mar/contact/update-1.hoon | 12 - desk/mar/contact/update.hoon | 2 - desk/mar/growl/summarize.hoon | 11 - desk/mar/reel/bait.hoon | 18 - desk/mar/reel/bite.hoon | 12 - desk/mar/reel/command.hoon | 19 - desk/mar/reel/confirmation.hoon | 12 - desk/mar/reel/describe.hoon | 14 - desk/mar/reel/description.hoon | 13 - desk/mar/reel/give-token-link.hoon | 11 - desk/mar/reel/metadata.hoon | 15 - desk/mar/reel/undescribe.hoon | 14 - desk/mar/reel/want-token-link.hoon | 11 - desk/mar/settings/data.hoon | 13 - desk/mar/settings/event.hoon | 16 - desk/sur/contacts-0.hoon | 60 -- desk/sur/contacts.hoon | 137 ---- desk/sur/reel.hoon | 17 - desk/sur/settings.hoon | 44 -- desk/ted/reel/set-ship.hoon | 18 - desk/tests/app/bait.hoon | 165 ---- desk/tests/app/contacts.hoon | 1093 --------------------------- desk/tests/app/reel.hoon | 120 --- desk/tests/lib/contacts-json-1.hoon | 252 ------ 59 files changed, 1 insertion(+), 5200 deletions(-) delete mode 100644 desk/app/bait.hoon delete mode 100644 desk/app/bark.hoon delete mode 100644 desk/app/contacts.hoon delete mode 100644 desk/app/genuine.hoon delete mode 100644 desk/app/growl.hoon delete mode 100644 desk/app/reel.hoon delete mode 100644 desk/app/settings.hoon delete mode 100644 desk/lib/contacts.hoon delete mode 100644 desk/lib/contacts/json-0.hoon delete mode 100644 desk/lib/contacts/json-1.hoon delete mode 100644 desk/lib/reel.hoon delete mode 100644 desk/lib/settings.hoon delete mode 100644 desk/mar/bait/describe.hoon delete mode 100644 desk/mar/bait/undescribe.hoon delete mode 100644 desk/mar/bark/add-recipient.hoon delete mode 100644 desk/mar/bark/receive-summary.hoon delete mode 100644 desk/mar/bark/remove-recipient.hoon delete mode 100644 desk/mar/contact-0.hoon delete mode 100644 desk/mar/contact-1.hoon delete mode 100644 desk/mar/contact.hoon delete mode 100644 desk/mar/contact/action-0.hoon delete mode 100644 desk/mar/contact/action-1.hoon delete mode 100644 desk/mar/contact/action.hoon delete mode 100644 desk/mar/contact/book-0.hoon delete mode 100644 desk/mar/contact/book.hoon delete mode 100644 desk/mar/contact/directory-0.hoon delete mode 100644 desk/mar/contact/directory.hoon delete mode 100644 desk/mar/contact/news.hoon delete mode 100644 desk/mar/contact/page-0.hoon delete mode 100644 desk/mar/contact/page-1.hoon delete mode 100644 desk/mar/contact/page.hoon delete mode 100644 desk/mar/contact/response-0.hoon delete mode 100644 desk/mar/contact/rolodex.hoon delete mode 100644 desk/mar/contact/update-0.hoon delete mode 100644 desk/mar/contact/update-1.hoon delete mode 100644 desk/mar/contact/update.hoon delete mode 100644 desk/mar/growl/summarize.hoon delete mode 100644 desk/mar/reel/bait.hoon delete mode 100644 desk/mar/reel/bite.hoon delete mode 100644 desk/mar/reel/command.hoon delete mode 100644 desk/mar/reel/confirmation.hoon delete mode 100644 desk/mar/reel/describe.hoon delete mode 100644 desk/mar/reel/description.hoon delete mode 100644 desk/mar/reel/give-token-link.hoon delete mode 100644 desk/mar/reel/metadata.hoon delete mode 100644 desk/mar/reel/undescribe.hoon delete mode 100644 desk/mar/reel/want-token-link.hoon delete mode 100644 desk/mar/settings/data.hoon delete mode 100644 desk/mar/settings/event.hoon delete mode 100644 desk/sur/contacts-0.hoon delete mode 100644 desk/sur/contacts.hoon delete mode 100644 desk/sur/reel.hoon delete mode 100644 desk/sur/settings.hoon delete mode 100644 desk/ted/reel/set-ship.hoon delete mode 100644 desk/tests/app/bait.hoon delete mode 100644 desk/tests/app/contacts.hoon delete mode 100644 desk/tests/app/reel.hoon delete mode 100644 desk/tests/lib/contacts-json-1.hoon diff --git a/desk/app/bait.hoon b/desk/app/bait.hoon deleted file mode 100644 index 08f7ae70..00000000 --- a/desk/app/bait.hoon +++ /dev/null @@ -1,224 +0,0 @@ -/- reel -/+ default-agent, verb, dbug, server, *reel -|% -+$ card card:agent:gall -+$ versioned-state - $% state-0 - state-1 - state-2 - == -:: -+$ state-0 - $: %0 - todd=(map [inviter=ship token=cord] description=cord) - == -+$ state-1 - $: %1 - token-metadata=(map [inviter=ship token=cord] metadata:reel) - == -+$ state-2 - $: %2 - token-metadata=(map token:reel metadata:reel) - == --- -:: -|% -++ landing-page - |= =metadata:reel - ^- manx - =/ description - ?. =(tag.metadata 'groups-0') "" - (trip (~(got by fields.metadata) 'description')) - ;html - ;head - ;title:"Lure" - == - ;body - ;p: {description} - Enter your @p: - ;form(method "post") - ;input(type "text", name "ship", id "ship", placeholder "~sampel"); - ;button(type "submit"):"Request invite" - == - ;script: ship = document.cookie.split("; ").find((row) => row.startsWith("ship="))?.split("=")[1]; document.getElementById("ship").value=(ship || "~sampel-palnet") - == - == -:: -++ sent-page - |= invitee=ship - ^- manx - ;html - ;head - ;title:"Lure" - == - ;body - Your invite has been sent! Go to your ship to accept it. - ;script: document.cookie="ship={(trip (scot %p invitee))}" - == - == --- -:: -=| state-2 -=* state - -:: -%- agent:dbug -%+ verb | -|_ =bowl:gall -+* this . - def ~(. (default-agent this %|) bowl) -:: -++ on-init - ^- (quip card _this) - [[%pass /eyre/connect %arvo %e %connect [~ /lure] dap.bowl]~ this] -:: -++ on-save !>(state) -++ on-load - |= old-state=vase - ^- (quip card _this) - =/ old !<(versioned-state old-state) - ?- -.old - %2 - `this(state old) - :: - %1 - =/ new-metadata - %- ~(gas by *(map token:reel metadata:reel)) - %+ turn - ~(tap by token-metadata.old) - |= [[inviter=ship =token:reel] meta=metadata:reel] - =/ new-token - (rap 3 (scot %p inviter) '/' token ~) - [new-token meta] - `this(state [%2 new-metadata]) - :: - %0 - `this(state *state-2) - == -:: -++ on-poke - |= [=mark =vase] - ^- (quip card _this) - ?+ mark (on-poke:def mark vase) - %handle-http-request - =+ !<([id=@ta inbound-request:eyre] vase) - |^ - :_ this - =/ full-line=request-line:server (parse-request-line:server url.request) - =/ line - ?: ?=([%lure @ *] site.full-line) - t.site.full-line - ?: ?=([@ @ *] site.full-line) - site.full-line - !! - ?+ method.request (give not-found:gen:server) - %'GET' (get-request line) - :: - %'POST' - ?~ body.request - (give-not-found 'body not found') - ?. =('ship=%7E' (end [3 8] q.u.body.request)) - (give-not-found 'ship not found in body') - =/ joiner (slav %p (cat 3 '~' (rsh [3 8] q.u.body.request))) - =; [=bite:reel inviter=(unit ship)] - ?~ inviter - (give-not-found 'inviter not found') - ^- (list card) - :: TODO: figure out if we need to send both pokes - :* :* %pass /bite %agent [u.inviter %reel] - %poke %reel-bite !>(bite) - == - :* %pass /bite %agent [our.bowl %reel] - %poke %reel-bite !>(bite) - == - (give (manx-response:gen:server (sent-page joiner))) - == - =/ =(pole knot) line - ?: ?=([@ @ ~] line) - =/ inviter (slav %p i.line) - =/ old-token i.t.line - :_ `inviter - [%bite-1 old-token joiner inviter] - =/ token - ?~ ext.full-line i.line - (crip "{(trip i.line)}.{(trip u.ext.full-line)}") - =/ =metadata:reel (~(gut by token-metadata) token *metadata:reel) - ?~ type=(~(get by fields.metadata) 'bite-type') - ~|("no bite type for token: {}" !!) - ?> =('2' u.type) - :- [%bite-2 token joiner metadata] - ?~ inviter-field=(~(get by fields.metadata) 'inviter') ~ - `(slav %p u.inviter-field) - == - ++ get-request - |= =(pole knot) - ^- (list card) - ?+ pole (give not-found:gen:server) - [%bait %who ~] - (give (json-response:gen:server s+(scot %p our.bowl))) - :: - [ship=@ name=@ %metadata ~] - =/ token (crip "{(trip ship.pole)}/{(trip name.pole)}") - =/ =metadata:reel - (~(gut by token-metadata) token *metadata:reel) - (give (json-response:gen:server (enjs-metadata metadata))) - :: - [token=@ %metadata ~] - =/ =metadata:reel - (~(gut by token-metadata) token.pole *metadata:reel) - (give (json-response:gen:server (enjs-metadata metadata))) - :: - [token=* ~] - =/ token (crip (join '/' pole)) - =/ =metadata:reel - (~(gut by token-metadata) token *metadata:reel) - (give (manx-response:gen:server (landing-page metadata))) - == - :: - ++ give-not-found - |= body=cord - (give [[404 ~] `(as-octs:mimes:html body)]) - ++ give - |= =simple-payload:http - (give-simple-payload:app:server id simple-payload) - -- - %bait-describe - =+ !<([=nonce:reel =metadata:reel] vase) - =/ =token:reel (scot %uv (end [3 16] eny.bowl)) - :_ this(token-metadata (~(put by token-metadata) token metadata)) - =/ =cage reel-confirmation+!>([nonce token]) - ~[[%pass /confirm/[nonce] %agent [src.bowl %reel] %poke cage]] - :: - %bait-undescribe - =+ !<(token=cord vase) - `this(token-metadata (~(del by token-metadata) token)) - :: - %bind-slash - :_ this - ~[[%pass /eyre/connect %arvo %e %connect [~ /] dap.bowl]] - :: - %unbind-slash - :_ this - ~[[%pass /eyre/connect %arvo %e %connect [~ /] %docket]] - == -:: -++ on-agent on-agent:def -++ on-watch - |= =path - ^- (quip card _this) - ?+ path (on-watch:def path) - [%http-response *] `this - == -++ on-leave on-leave:def -++ on-peek on-peek:def -++ on-arvo - |= [=wire =sign-arvo] - ^- (quip card _this) - ?+ sign-arvo (on-arvo:def wire sign-arvo) - [%eyre %bound *] - ~? !accepted.sign-arvo - [dap.bowl 'eyre bind rejected!' binding.sign-arvo] - [~ this] - == -:: -++ on-fail on-fail:def --- diff --git a/desk/app/bark.hoon b/desk/app/bark.hoon deleted file mode 100644 index bdebea42..00000000 --- a/desk/app/bark.hoon +++ /dev/null @@ -1,142 +0,0 @@ -:: bark: gathers summaries from ships, sends emails to their owners -:: -:: general flow is that bark gets configured with api keys and recipient -:: ships. on-demand, bark asks either all or a subset of recipients for -:: an activity summary (through the growl agent on their ships), and upon -:: receiving responses, uses the mailchimp api to upload the received -:: deets for that ship, and/or triggers an email send. -:: -/+ default-agent, verb, dbug -:: -|% -+$ card card:agent:gall -+$ state-0 - $: %0 - api=[tlon=@t mailchimp=[key=@t list-id=@t]] - recipients=(set ship) - == -:: -++ next-timer - |= now=@da - :: west-coast midnights for minimal ameri-centric disruption - %+ add ~d1.h7 - (sub now (mod now ~d1)) --- -:: -=| state-0 -=* state - -%- agent:dbug -%+ verb | -^- agent:gall -|_ =bowl:gall -+* this . - def ~(. (default-agent this %.n) bowl) -++ on-init - ^- (quip card _this) - :_ this - [%pass /fetch %arvo %b %wait (next-timer now.bowl)]~ -:: -++ on-arvo - |= [=wire sign=sign-arvo] - ^- (quip card _this) - ?+ wire ~|([%strange-wire wire] !!) - [%fetch ~] - ?> ?=(%wake +<.sign) - =^ caz this (on-poke %bark-generate-summaries !>(~)) - :_ this - :_ caz - [%pass /fetch %arvo %b %wait (next-timer now.bowl)] - :: - [%save-summary @ @ ~] - ?> ?=(%arow +<.sign) - ?: ?=(%& -.p.sign) [~ this] - %- (slog 'bark: failed to save summary' p.p.sign) - [~ this] - == -:: -++ on-poke - |= [=mark =vase] - ^- (quip card _this) - ?+ mark (on-poke:def mark vase) - %noun - =+ !<([m=@ n=*] vase) - $(mark m, vase (need (slew 3 vase))) - :: - %set-tlon-api-key - `this(tlon.api !<(@t vase)) - :: - %set-mailchimp-api-key - `this(mailchimp.api !<([key=@t list=@t] vase)) - :: - %bark-add-recipient - =+ !<(=ship vase) - ?> =(src.bowl ship) - `this(recipients (~(put in recipients) ship)) - :: - %bark-remove-recipient - =+ !<(=ship vase) - ?> =(src.bowl ship) - :_ this(recipients (~(del in recipients) ship)) - :_ ~ - :* %pass /save-summary/(scot %p src.bowl)/(scot %da now.bowl) - %arvo %k %fard - %landscape %save-summary %noun - !>(`[tlon.api mailchimp.api src.bowl %wipe ~]) - == - :: - %bark-generate-summaries - ?> =(src.bowl our.bowl) - :_ this - =- ~(tap in -) - ^- (set card) - %- ~(run in recipients) - |= =ship - ^- card - [%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)] - :: - %bark-target-summaries - ?> =(src.bowl our.bowl) - :_ this - %+ turn - (skim !<((list ship) vase) ~(has in recipients)) - |= =ship - ^- card - [%pass /request-summary %agent [ship %growl] %poke %growl-summarize !>(now.bowl)] - :: - %bark-receive-summary - =/ result - !< %- unit - $: requested=time - $= summary - ::NOTE see also /lib/summarize - $% [%life active=[s=@ud r=@ud g=@t] inactive=[d=@ud c=@ud g=@t c=@t]] - == == - vase - ?~ result - $(mark %bark-remove-recipient, vase !>(src.bowl)) - ::TODO maybe drop the result (or re-request) if the timestamp is too old? - :_ this - :~ :* %pass /save-summary/(scot %p src.bowl)/(scot %da requested.u.result) - %arvo %k %fard - %landscape %save-summary %noun - !>(`[tlon.api mailchimp.api src.bowl summary.u.result]) - == - == - == -++ on-watch on-watch:def -++ on-agent on-agent:def -++ on-fail - |= [=term =tang] - %- (slog 'bark: on-fail' term tang) - [~ this] -++ on-leave - |= =path - `this -++ on-save !>(state) -++ on-load - |= old-state=vase - ^- (quip card _this) - =/ old !<(state-0 old-state) - `this(state old) -++ on-peek on-peek:def --- diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon deleted file mode 100644 index 1d1f7df7..00000000 --- a/desk/app/contacts.hoon +++ /dev/null @@ -1,741 +0,0 @@ -/+ default-agent, dbug, verb, neg=negotiate -/+ *contacts -:: -:: performance, keep warm -/+ j0=contacts-json-0, j1=contacts-json-1, mark-warmer -:: -|% -:: conventions -:: -:: .con: a contact -:: .rof: our profile -:: .rol: [legacy] our full rolodex -:: .far: foreign peer -:: .for: foreign profile -:: .sag: foreign subscription state -:: -+| %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:dbug -%+ verb | -^- agent:gall -=| state-1 -=* state - -=< |_ =bowl:gall - +* this . - def ~(. (default-agent this %|) bowl) - cor ~(. raw bowl) - :: - ++ on-init - ^- (quip card _this) - =^ cards state abet:init:cor - [cards this] - :: - ++ on-save !>([state okay]) - :: - ++ on-load - |= old=vase - ^- (quip card _this) - =^ cards state abet:(load:cor old) - [cards this] - :: - ++ on-watch - |= =path - ^- (quip card _this) - =^ cards state abet:(peer:cor path) - [cards this] - :: - ++ on-poke - |= [=mark =vase] - ^- (quip card _this) - =^ cards state abet:(poke:cor mark vase) - [cards this] - :: - ++ on-peek peek:cor - ++ on-leave on-leave:def - :: - ++ on-agent - |= [=wire =sign:agent:gall] - ^- (quip card _this) - =^ cards state abet:(agent:cor wire sign) - [cards this] - :: - ++ 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 -:: -++ raw - =| out=(list card) - |_ =bowl:gall - :: - +| %generic - :: - ++ abet [(flop out) state] - ++ cor . - ++ emit |=(c=card cor(out [c out])) - ++ emil |=(c=(list card) cor(out (weld (flop c) out))) - ++ give |=(=gift:agent:gall (emit %give gift)) - ++ pass |=([=wire =note:agent:gall] (emit %pass wire note)) - :: - +| %operations - :: - :: +pub: publication management - :: - :: - /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 - :: is wrt the /contact/at/$date path, which exists to minimize - :: redundant network traffic. - :: - :: /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 - :: 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: do some benchmarking. - :: - ++ subs - ^- (set path) - %- ~(rep by sup.bowl) - |= [[duct ship pat=path] acc=(set path)] - ?.(?=([%v1 %contact *] pat) acc (~(put in acc) pat)) - ++ fact - |= [pat=(set path) u=update] - ^- gift:agent:gall - [%fact ~(tap in pat) %contact-update-1 !>(u)] - -- - :: - |% - :: +p-anon: delete our profile - :: - ++ p-anon ?.(?=([@ ^] rof) cor (p-commit-self ~)) - :: +p-self: edit our profile - :: - ++ p-self - |= con=(map @tas value) - =/ old=contact - ?.(?=([@ ^] rof) *contact con.rof) - =/ new=contact - (do-edit old con) - ?: =(old new) - cor - ?> (sane-contact new) - (p-commit-self new) - :: +p-page-spot: add ship as a contact - :: - ++ p-page-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-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 - |= [=kip mod=contact] - =/ =page - ~| "contact page {} does not exist" - (~(got by book) kip) - =/ old=contact - mod.page - =/ new=contact - (do-edit old mod) - ?: =(old new) - cor - ?> (sane-contact 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-commit-wipe kip) - :: +p-commit-self: publish modified profile - :: - ++ p-commit-self - |= con=contact - =/ p=profile [(mono wen.rof now.bowl) con] - =. rof p - :: - =. cor - (p-news-0 our.bowl (contact:to-0 con)) - =. cor - (p-response [%self con]) - (give (fact subs [%full p])) - :: +p-commit-page: publish new contact page - :: - ++ p-commit-page - |= [=kip =page] - =. book (~(put by book) kip page) - (p-response [%page kip page]) - :: +p-commit-edit: publish contact page update - :: - ++ p-commit-edit - |= [=kip =page] - =. book - (~(put by book) kip page) - (p-response [%page kip page]) - :: +p-commit-wipe: publish contact page wipe - :: - ++ p-commit-wipe - |= =kip - =. book - (~(del by book) kip) - (p-response [%wipe kip]) - :: +p-init: publish our profile - :: - ++ p-init - |= wen=(unit @da) - ?~ wen (give (fact ~ full+rof)) - ?: (gte u.wen wen.rof) cor - (give (fact ~ full+rof)) - :: +p-news-0: [legacy] publish news - :: - ++ p-news-0 - |= n=news-0:c0 - (give %fact ~[/news] %contact-news !>(n)) - :: +p-response: publish response - :: - ++ p-response - |= r=response - (give %fact ~[/v1/news] %contact-response-0 !>(r)) - -- - :: - :: +sub: subscription mgmt - :: - :: /contact/*: foreign profiles, _s-impl - :: - :: subscription state is tracked per peer in .sag - :: - :: ~: no subscription - :: %want: /contact/* requested - :: - :: for a given peer, we always have at most one subscription, - :: to /contact/* - :: - ++ sub - |^ |= who=ship - ^+ s-impl - ?< =(our.bowl who) - =/ old (~(get by peers) who) - ~(. s-impl who %live ?=(~ old) (fall old *foreign)) - :: - ++ 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 =. peers (~(put by peers) who [for sag]) - ?. new cor - :: NB: this assumes con.for is only set in +si-hear - :: - =. cor (p-news-0:pub who ~) - (p-response: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-response:pub [%peer who ~]) - == - :: - ++ si-take - |= [=wire =sign:agent:gall] - ^+ si-cor - ?- -.sign - %poke-ack ~|(strange-poke-ack+wire !!) - :: - %watch-ack ~| strange-watch-ack+wire - ?> ?=(%want sag) - ?~ p.sign si-cor - %- (slog 'contact-fail' u.p.sign) - =/ wake=@da (add now.bowl ~m30) - =. retry (~(put by retry) who wake) - %_ si-cor cor - (pass /retry/(scot %p who) %arvo %b %wait wake) - == - :: - %kick si-meet(sag ~) - :: - %fact ?+ p.cage.sign ~|(strange-fact+wire !!) - %contact-update-1 - (si-hear !<(update q.cage.sign)) - == == - :: - ++ si-hear - |= u=update - ^+ si-cor - ?. (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)) - =/ 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-response:pub %page who con.u mod.u.page) - (p-response:pub %peer who con.u) - == - :: - ++ si-meet - ^+ si-cor - :: - :: already subscribed - ?: ?=(%want 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-retry - ^+ si-cor - :: - ::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) - si-meet(sag ~) - :: - ++ si-drop si-snub(sas %dead) - :: - ++ si-snub - %_ si-cor - sag ~ - cor ?. ?=(%want sag) cor - :: retry is scheduled, cancel the timer - :: - ?^ 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 ~) - == - -- - -- - :: - :: +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, peers them) - ++ us - %+ fall - (bind (~(get by ful) our.bowl) convert) - *profile - :: - ++ 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 - %- profile:from-0 - [last-updated.con con(|6 groups.con)] - -- - :: - +| %implementation - :: - ++ init - (emit %pass /migrate %agent [our dap]:bowl %poke noun+!>(%migrate)) - :: - ++ load - |= old-vase=vase - ^+ 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 - :: 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:c0] 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 ~] - =/ fir=$@(~ profile) - ?~ for ~ - (profile:from-0 for) - :: no intent to connect - :: - ?: =(~ sag) - :- caz - (~(put by peers) who fir ~) - :_ (~(put by peers) who fir %want) - ?: (~(has by wex.bowl) [/contact who dap.bowl]) - caz - =/ =path [%v1 %contact ?~(fir / /at/(scot %da wen.fir))] - :_ caz - [%pass /contact %agent [who dap.bowl] %watch path] - (emil caz) - == - +$ state-0 [%0 rof=$@(~ profile-0:c0) rol=rolodex:c0] - +$ versioned-state - $% state-0 - state-1 - == - :: - ++ l-epic (give %fact [/epic ~] epic+!>(okay)) - -- - :: - ++ poke - |= [=mark =vase] - ^+ cor - ?+ mark ~|(bad-mark+mark !!) - %noun - ?+ q.vase !! - %migrate migrate - == - $? %contact-action - %contact-action-0 - %contact-action-1 - == - ?> =(our src):bowl - =/ act=action - ?- mark - :: - %contact-action-1 - !<(action vase) - :: upconvert legacy %contact-action - :: - ?(%contact-action %contact-action-0) - =/ act-0 !<(action-0:c0 vase) - ?. ?=(%edit -.act-0) - (to-action act-0) - :: v0 %edit needs special handling to evaluate - :: groups edit - :: - =/ groups=(set $>(%flag value)) - ?~ con.rof ~ - =+ set=(~(ges cy con.rof) groups+%flag) - (fall set ~) - [%self (to-self-edit p.act-0 groups)] - == - ?- -.act - %anon p-anon:pub - %self (p-self:pub p.act) - :: if we add a page for someone who is not a peer, - :: we meet them first - :: - %page =? cor &(?=(ship p.act) !(~(has by peers) p.act)) - si-abet:si-meet:(sub p.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)) - %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:c0 - :: /x/contact/her=@ -> $@(~ contact-0:c0) - :: - :: v1 scries - :: - :: /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 - :: /x/v1/peer/her=@p -> $contact - :: - ++ peek - |= pat=(pole knot) - ^- (unit (unit cage)) - ?+ pat [~ ~] - :: - [%x %all ~] - =/ rol-0=rolodex:c0 - %- ~(urn by peers) - |= [who=ship far=foreign] - ^- foreign-0:c0 - =/ mod=contact - ?~ page=(~(get by book) who) - ~ - mod.u.page - (foreign:to-0 (foreign-mod far mod)) - =/ lor-0=rolodex:c0 - ?: ?=(~ con.rof) rol-0 - (~(put by rol-0) our.bowl (profile:to-0 rof) ~) - ``contact-rolodex+!>(lor-0) - :: - [%x %contact her=@ ~] - ?~ who=(slaw %p her.pat) - [~ ~] - =/ 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:c0`tac) - :: - [%x %v1 %self ~] - ``contact-1+!>(`contact`con.rof) - :: - [%x %v1 %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=(slaw %p her.pat) - [~ ~] - =/ page=(unit page) - (~(get by book) u.who) - ``contact-page-0+!>(`^page`(fall page *^page)) - :: - [%u %v1 %book %id =cid ~] - ?~ id=(slaw %uv cid.pat) - [~ ~] - ``loob+!>((~(has by book) id+u.id)) - :: - [%x %v1 %book %id =cid ~] - ?~ id=(slaw %uv cid.pat) - [~ ~] - =/ page=(unit page) - (~(get by book) id+u.id) - ``contact-page-0+!>(`^page`(fall page *^page)) - :: - [%x %v1 %all ~] - =| dir=directory - :: export all ship contacts - :: - =. dir - %- ~(rep by book) - |= [[=kip =page] =_dir] - ?^ kip - dir - (~(put by dir) kip (contact-uni page)) - :: export all peers - :: - =. dir - %- ~(rep by peers) - |= [[who=ship far=foreign] =_dir] - ?~ for.far dir - ?: (~(has by dir) who) dir - (~(put by dir) who con.for.far) - ``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=(slaw %p her.pat) - [~ ~] - ?^ page=(~(get by book) u.who) - ``contact-1+!>((contact-uni u.page)) - ?~ far=(~(get by peers) u.who) - [~ ~] - ?~ 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=(slaw %p her.pat) - [~ ~] - ?~ far=(~(get by peers) u.who) - [~ ~] - ``contact-foreign-0+!>(`foreign`u.far) - == - :: - ++ peer - |= pat=(pole knot) - ^+ cor - ?+ pat ~|(bad-watch-path+pat !!) - :: - :: v0 - [%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)) - [%v1 %news ~] ~|(local-news+src.bowl ?>(=(our src):bowl cor)) - :: - [%epic ~] (give %fact ~ epic+!>(okay)) - == - :: - ++ agent - |= [=wire =sign:agent:gall] - ^+ cor - ?+ 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 - :: - [%epic ~] - 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.wire) - si-abet:si-retry:(sub who) - == - -- --- diff --git a/desk/app/genuine.hoon b/desk/app/genuine.hoon deleted file mode 100644 index 96711408..00000000 --- a/desk/app/genuine.hoon +++ /dev/null @@ -1,95 +0,0 @@ -/+ default-agent, verb, dbug, server -|% -++ give-payload - |= [id=@ta =simple-payload:http] - (give-simple-payload:app:server id simple-payload) -:: without removing the dots, there are intermittent mismatches when reading -:: the secret from the URL -++ serialize - |= eny=@uvJ - %- crip - %+ skip (trip (scot %uw eny)) - |= =cord - =(cord '.') -+$ card card:agent:gall -+$ versioned-state - $% state-0 - == -+$ state-0 - $: %0 - secret=@uvJ - == --- -:: -=| state-0 -=* state - -%- agent:dbug -%+ verb | -^- agent:gall -|_ =bowl:gall -+* this . - def ~(. (default-agent this %.n) bowl) -:: -++ on-init - :_ this(secret eny.bowl) - ~[[%pass /eyre/connect %arvo %e %connect [~ /genuine] dap.bowl]] -:: -++ on-poke - |= [=mark =vase] - ^- (quip card _this) - ?+ mark (on-poke:def mark vase) - %rotate - ?> =(src.bowl our.bowl) - `this(secret eny.bowl) - %handle-http-request - =+ !<([id=@ta inbound-request:eyre] vase) - :_ this - =/ full-line=request-line:server (parse-request-line:server url.request) - ?. ?=([%genuine @ ~] site.full-line) - (give-payload id not-found:gen:server) - =/ line i.t.site.full-line - ?+ method.request (give-payload id not-found:gen:server) - %'GET' - (give-payload id (json-response:gen:server b+=(line (serialize secret)))) - == - == -:: -++ on-agent on-agent:def -:: -++ on-watch - |= =path - ^- (quip card _this) - ?+ path (on-watch:def path) - [%http-response *] `this - == -:: -++ on-fail - |= [=term =tang] - (mean ':genuine +on-fail' term tang) -:: -++ on-leave on-leave:def -++ on-save !>(state) -:: -++ on-load - |= old-state=vase - ^- (quip card _this) - =/ old !<(versioned-state old-state) - `this(state old) -:: -++ on-arvo - |= [=wire =sign-arvo] - ^- (quip card _this) - ?+ sign-arvo (on-arvo:def wire sign-arvo) - [%eyre %bound *] - ~? !accepted.sign-arvo - [dap.bowl 'eyre bind rejected!' binding.sign-arvo] - [~ this] - == -:: -++ on-peek - |= =path - ^- (unit (unit cage)) - ?+ path [~ ~] - [%x %secret ~] ``json+!>([%s (serialize secret)]) - == --- diff --git a/desk/app/growl.hoon b/desk/app/growl.hoon deleted file mode 100644 index 0c00fc14..00000000 --- a/desk/app/growl.hoon +++ /dev/null @@ -1,136 +0,0 @@ -/- settings -/+ summarize, default-agent, verb, dbug -:: -|% -+$ card card:agent:gall -+$ state-1 [%1 enabled=_| bark-host=_~rilfet-palsum] --- -:: -:: This agent should eventually go into landscape -:: -=| state-1 -=* state - -%- agent:dbug -%+ verb | -^- agent:gall -|_ =bowl:gall -+* this . - def ~(. (default-agent this %.n) bowl) -:: -++ on-init - =^ caz this (on-poke %initialize !>(~)) - :_ this - ::NOTE sadly, we cannot subscribe to items that may not exist right now, - :: so we subscribe to the whole bucket instead - [[%pass /settings %agent [our.bowl %settings] %watch /desk/groups] caz] -:: -++ on-save !>(state) -++ on-load - |= old-state=vase - |^ ^- (quip card _this) - =+ !<(old=versioned-state old-state) - ?- -.old - :: %0 lost sync with the flag so must re-set, but not scry during load - :: - %0 [[%pass /re-set %arvo %b %wait now.bowl]~ this] - %1 [~ this(state old)] - == - :: - +$ versioned-state $%(state-0 state-1) - +$ state-0 [%0 enabled=_| bark-host=_~rilfet-palsum] - -- -:: -++ on-poke - |= [=mark =vase] - ^- (quip card _this) - ?+ mark (on-poke:def mark vase) - %noun - =+ !<([m=@ n=*] vase) - $(mark m, vase (need (slew 3 vase))) - :: - %set-host - ?> =(src.bowl our.bowl) - `this(bark-host !<(ship vase)) - :: - %initialize - =; consent=? - $(mark ?:(consent %enable %disable), vase !>(~)) - =/ bap=path /(scot %p our.bowl)/settings/(scot %da now.bowl) - ?. .^(? %gu (snoc bap %$)) | - =+ .^(=data:settings %gx (weld bap /desk/groups/settings-data)) - ?> ?=(%desk -.data) - =; =val:settings - ?:(?=(%b -.val) p.val |) - %+ %~ gut by - (~(gut by desk.data) %groups ~) - 'logActivity' - [%b |] - :: - %enable - :_ this(enabled %.y) - ~[[%pass /add-recipient %agent [bark-host %bark] %poke %bark-add-recipient !>(our.bowl)]] - :: - %disable - :_ this(enabled %.n) - ~[[%pass /remove-recipient %agent [bark-host %bark] %poke %bark-remove-recipient !>(our.bowl)]] - :: - %growl-summarize - ?. enabled - :_ this - ~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(~)]] - =/ requested !<(time vase) - =/ activity ~(summarize-activity summarize [our now]:bowl) - =/ inactivity ~(summarize-inactivity summarize [our now]:bowl) - :_ this - ~[[%pass /bark-summary %agent [bark-host %bark] %poke %bark-receive-summary !>(`[requested %life activity inactivity])]] - == -:: -++ on-agent - |= [=wire =sign:agent:gall] - ^- (quip card _this) - ?. ?=([%settings ~] wire) (on-agent:def wire sign) - ?- -.sign - %poke-ack !! - :: - %watch-ack - ?~ p.sign [~ this] - %- (slog 'growl failed settings subscription' u.p.sign) - [~ this] - :: - %kick - [[%pass /settings %agent [our.bowl %settings] %watch /desk/groups]~ this] - :: - %fact - ?. =(%settings-event p.cage.sign) (on-agent:def wire sign) - =+ !<(=event:settings q.cage.sign) - =/ new=(unit ?) - =; val=(unit val:settings) - ?~ val ~ - `?:(?=(%b -.u.val) p.u.val |) - ?+ event ~ - [%put-bucket %groups %groups *] `(~(gut by bucket.event) 'logActivity' b+|) - [%del-bucket %groups %groups] `b+| - [%put-entry %groups %groups %'logActivity' *] `val.event - [%del-entry %groups %groups %'logActivity'] `b+| - == - ?~ new [~ this] - ?: =(u.new enabled) [~ this] - (on-poke ?:(u.new %enable %disable) !>(~)) - == -:: -++ on-arvo - |= [=wire sign=sign-arvo] - ^- (quip card _this) - ?> =(/re-set wire) - ?> ?=(%wake +<.sign) - (on-poke %initialize !>(~)) -:: -++ on-watch on-watch:def -++ on-fail - |= [=term =tang] - (mean ':sub +on-fail' term tang) -++ on-leave - |= =path - `this -++ on-peek on-peek:def --- diff --git a/desk/app/reel.hoon b/desk/app/reel.hoon deleted file mode 100644 index c9deba6c..00000000 --- a/desk/app/reel.hoon +++ /dev/null @@ -1,317 +0,0 @@ -/- reel -/+ default-agent, verb, dbug, *reel -|% -+$ card card:agent:gall -+$ versioned-state - $% state-0 - state-1 - state-2 - state-3 - state-4 - == -:: -:: vic: URL of bait service -:: civ: @p of bait service -:: our-metadata: a mapping from nonce/token to metadata -:: open-link-requests: open requests for an existing foreign link, v0 -:: lure links only -:: open-describes: attempts to create a link waiting to be assigned a token -:: stable-id: a mapping from something the client can use to identify the -:: metadata to nonce and/or token -:: -+$ state-0 - $: %0 - vic=@t - civ=ship - descriptions=(map cord cord) - == -+$ state-1 - $: %1 - vic=@t - civ=ship - our-metadata=(map cord metadata:reel) - == -+$ state-2 - $: %2 - vic=@t - civ=ship - our-metadata=(map cord metadata:reel) - outstanding-pokes=(set (pair ship cord)) - == -+$ state-3 - $: %3 - vic=@t - civ=ship - our-metadata=(map cord metadata:reel) - outstanding-pokes=(set (pair ship cord)) - == -+$ state-4 - $: %4 - vic=@t - civ=ship - our-metadata=(map token:reel metadata:reel) - open-link-requests=(set (pair ship cord)) - open-describes=(set token:reel) - stable-id=(map cord token:reel) - == -++ flag ;~((glue fas) ;~(pfix sig fed:ag) sym) -:: url with old style token -++ url-for-token - |= [vic=cord token=cord] - (cat 3 vic token) --- -=| state-4 -=* state - -:: -%- agent:dbug -%+ verb | -|_ =bowl:gall -+* this . - def ~(. (default-agent this %|) bowl) -:: -++ on-init - ^- (quip card _this) - `this(vic 'https://tlon.network/lure/', civ ~loshut-lonreg) -:: -++ on-save !>(state) -++ on-load - |= old-state=vase - ^- (quip card _this) - =/ old !<(versioned-state old-state) - ?- -.old - %4 - =. state old - =^ new-md stable-id - %+ roll - ~(tap by our-metadata) - |= [[=token:reel =metadata:reel] [md=_our-metadata id=_stable-id]] - ?^ (slaw %uv token) [md id] - ?^ (rush token flag) - :- md - ?: (~(has by id) token) id - (~(put by id) token token) - =/ new (rap 3 (scot %p our.bowl) '/' token ~) - :- (~(put by md) new metadata) - (~(put by id) new new) - `this(our-metadata new-md) - %3 - `this(state [%4 vic.old civ.old our-metadata.old outstanding-pokes.old ~ ~]) - %2 - `this(state [%4 vic.old civ.old our-metadata.old ~ ~ ~]) - %1 - `this(state [%4 'https://tlon.network/lure/' ~loshut-lonreg ~ ~ ~ ~]) - %0 - `this(state [%4 'https://tlon.network/lure/' ~loshut-lonreg ~ ~ ~ ~]) - == -:: -++ on-poke - |= [=mark =vase] - ^- (quip card _this) - ?+ mark (on-poke:def mark vase) - %reel-command - ?> =(our.bowl src.bowl) - =+ !<(=command:reel vase) - ?- -.command - %set-service - :_ this(vic vic.command) - ~[[%pass /set-ship %arvo %k %fard q.byk.bowl %reel-set-ship %noun !>(vic.command)]] - %set-ship - :: since we're changing providers, we need to regenerate links - :: we'll use whatever key we currently have as the nonce - :_ this(civ civ.command, open-describes ~(key by our-metadata)) - %+ turn ~(tap by our-metadata) - |= [token=cord =metadata:reel] - ^- card - [%pass /describe %agent [civ %bait] %poke %bait-describe !>([token metadata])] - == - :: - %reel-bite - ?> =(civ src.bowl) - =+ !<(=bite:reel vase) - [[%give %fact ~[/bites] mark !>(bite)]~ this] - :: - %reel-describe - ?> =(our.bowl src.bowl) - =+ !<([id=cord =metadata:reel] vase) - =/ old-token (~(get by stable-id) id) - =. fields.metadata - %- ~(gas by fields.metadata) - :~ ['bite-type' '2'] - ['inviter' (scot %p src.bowl)] - ['group' id] - == - :: the nonce here is a temporary identifier for the metadata - :: a new one will be assigned by the bait provider and returned to us - =/ =nonce:reel (scot %da now.bowl) - :: delete old metadata if we have an existing token for this id - =? our-metadata ?=(^ old-token) - (~(del by our-metadata) u.old-token) - =. our-metadata (~(put by our-metadata) nonce metadata) - =. open-describes (~(put in open-describes) nonce) - =. stable-id (~(put by stable-id) id nonce) - :_ this - ~[[%pass /describe %agent [civ %bait] %poke %bait-describe !>([nonce metadata])]] - :: - %reel-confirmation - ?> =(civ src.bowl) - =+ !<(confirmation:reel vase) - =. open-describes (~(del in open-describes) nonce) - ?~ md=(~(get by our-metadata) nonce) - ~|("no metadata for nonce: {}" !!) - =/ ids=(list [id=cord =token:reel]) - %+ skim - ~(tap by stable-id) - |= [key=cord =token:reel] - =(nonce token) - ?~ ids - ~|("no stable id for nonce: {}" !!) - =* id -<.ids - :: update the token the id points to - =. stable-id (~(put by stable-id) id token) - :: swap out the nonce for the token in our-metadata - =. our-metadata - (~(put by (~(del by our-metadata) nonce)) token u.md) - :_ this - =/ url (cat 3 vic token) - =/ path (stab (cat 3 '/v1/id-link/' id)) - ~[[%give %fact ~[path] %json !>(s+url)]] - :: - %reel-undescribe - ?> =(our.bowl src.bowl) - =+ !<(=token:reel vase) - :: the token here should be the actual token given to us by the provider - :_ this(our-metadata (~(del by our-metadata) token)) - ~[[%pass /undescribe %agent [civ %bait] %poke %bait-undescribe !>(token)]] - :: old pokes for getting links, we no longer use these because all links - :: are unique to that ship/user and can be scried out - :: - %reel-want-token-link - =+ !<(=token:reel vase) - :_ this - =/ full-token - ?^ (rush token flag) token - (rap 3 (scot %p our.bowl) '/' token ~) - =/ result=(unit [cord cord]) - ?. (~(has by our-metadata) full-token) `[full-token ''] - `[full-token (url-for-token vic full-token)] - ~[[%pass [%token-link-want token ~] %agent [src dap]:bowl %poke %reel-give-token-link !>(result)]] - %reel-give-token-link - =+ !<(result=(unit [cord cord]) vase) - ?~ result `this - :_ this - =/ [token=cord url=cord] u.result - =/ path (stab (cat 3 '/token-link/' token)) - ~[[%give %fact ~[path] %json !>(?:(=('' url) ~ s+url))]] - == -:: -++ on-agent - |= [=wire =sign:agent:gall] - ^- (quip card _this) - =/ =(pole knot) wire - ?+ pole (on-agent:def wire sign) - [%token-link @ name=@ ~] - ?+ -.sign (on-agent:def wire sign) - %poke-ack - `this(open-link-requests (~(del in open-link-requests) [src.bowl name.pole])) - == - == -:: -++ on-watch - |= =(pole knot) - ^- (quip card _this) - ?> =(our.bowl src.bowl) - =/ any ?(%v0 %v1) - =? pole !?=([any *] pole) - [%v0 pole] - ?+ pole ~|("bad pole: {}" (on-watch:def pole)) - [any %bites ~] `this - :: old subscription for getting links, we no longer use these because all - :: links are unique to that ship/user and can be scried out - :: - [%v0 %token-link ship=@ token=@ ~] - =/ ship (slav %p ship.pole) - =/ key [ship token.pole] - ?~ (~(has in open-link-requests) key) `this - :_ this(open-link-requests (~(put in open-link-requests) key)) - =/ =dock [ship dap.bowl] - =/ =cage reel-want-token-link+!>(token.pole) - :~ [%pass +.pole %agent dock %poke cage] - [%pass /expire/[ship.pole]/[token.pole] %arvo %b [%wait (add ~h1 now.bowl)]] - == - :: - [%v1 %id-link id=*] - =/ id (crip +:(spud id.pole)) - ?~ token=(~(get by stable-id) id) `this - ?: (~(has in open-describes) u.token) - :: when the confirmation comes back we'll send the fact - `this - =/ url (cat 3 vic u.token) - :_ this - ~[[%give %fact ~[pole] %json !>(s+url)]] - == -:: -++ on-leave on-leave:def -++ on-peek - |= =(pole knot) - ^- (unit (unit cage)) - =/ any ?(%v0 %v1) - =? +.pole !?=([any *] +.pole) - [%v0 +.pole] - ?+ pole [~ ~] - [%x any %service ~] ``noun+!>(vic) - [%x any %bait ~] ``reel-bait+!>([vic civ]) - :: - [%x %v0 %outstanding-poke ship=@ name=@ ~] - =/ has (~(has in open-link-requests) [(slav %p ship.pole) name.pole]) - ``json+!>([%b has]) - :: - [%x %v1 %metadata ship=@ name=@ ~] - =/ id (rap 3 ship.pole '/' name.pole ~) - =/ token (~(get by stable-id) id) - ?~ token [~ ~] - =/ =metadata:reel (fall (~(get by our-metadata) u.token) *metadata:reel) - ``reel-metadata+!>(metadata) - :: - [%x %v0 %metadata name=@ ~] - :: old style tokens are directly in metadata - =/ id (rap 3 (scot %p our.bowl) '/' name.pole ~) - =/ =metadata:reel (fall (~(get by our-metadata) id) *metadata:reel) - ``reel-metadata+!>(metadata) - :: - [%x any %token-url token=*] - =/ =token:reel (crip +:(spud token.pole)) - =/ url (url-for-token vic token) - ``json+!>(s+url) - :: - [%x %v1 %id-url id=*] - =/ id (crip +:(spud id.pole)) - ?~ token=(~(get by stable-id) id) - ``json+!>(s+'') - =/ url (cat 3 vic u.token) - ``json+!>(s+url) - == -:: -++ on-arvo - |= [=wire =sign-arvo] - ^- (quip card:agent:gall _this) - ?+ wire (on-arvo:def wire sign-arvo) - [%set-ship ~] - ?> ?=([%khan %arow *] sign-arvo) - ?: ?=(%.n -.p.sign-arvo) - ((slog 'reel: fetch bait ship failed' p.p.sign-arvo) `this) - `this - :: - [%expire @ @ ~] - ?+ sign-arvo (on-arvo:def wire sign-arvo) - [%behn %wake *] - =/ target (slav %p i.t.wire) - =/ group i.t.t.wire - ?~ error.sign-arvo - :_ this(open-link-requests (~(del in open-link-requests) [target group])) - =/ path (welp /token-link t.wire) - ~[[%give %kick ~[path] ~]] - (on-arvo:def wire sign-arvo) - == - == -++ on-fail on-fail:def --- diff --git a/desk/app/settings.hoon b/desk/app/settings.hoon deleted file mode 100644 index 84d56d67..00000000 --- a/desk/app/settings.hoon +++ /dev/null @@ -1,227 +0,0 @@ -/- *settings -/+ verb, dbug, default-agent, agentio -|% -+$ card card:agent:gall -+$ versioned-state - $% state-0 - state-1 - state-2 - == -+$ state-0 [%0 settings=settings-0] -+$ state-1 [%1 settings=settings-1] -+$ state-2 [%2 =settings] --- -=| state-2 -=* state - -:: -%- agent:dbug -%+ verb | -^- agent:gall -=< - |_ =bowl:gall - +* this . - do ~(. +> bowl) - def ~(. (default-agent this %|) bowl) - io ~(. agentio bowl) - :: - ++ on-init - :: XX: deprecated; migration code - ^- (quip card _this) - :_ this - :~ :* %pass - /migrate - %agent - [our dap]:bowl - %poke - noun+!>(%migrate) - == == - :: - ++ on-save !>(state) - :: - ++ on-load - |= =old=vase - ^- (quip card _this) - =/ old ((soft versioned-state) q.old-vase) - ?~ old on-init - =/ old u.old - |- - ?- -.old - %0 $(old [%1 +.old]) - %1 $(old [%2 (~(put by *^settings) %landscape settings.old)]) - %2 `this(state old) - == - :: - ++ on-poke - |= [mar=mark vas=vase] - ^- (quip card _this) - ?> (team:title our.bowl src.bowl) - =^ cards state - ?+ mar (on-poke:def mar vas) - %settings-event - =/ evt=event !<(event vas) - ?- -.evt - %put-bucket (put-bucket:do [desk key bucket]:evt) - %del-bucket (del-bucket:do [desk key]:evt) - %put-entry (put-entry:do [desk buc key val]:evt) - %del-entry (del-entry:do [desk buc key]:evt) - == - :: - :: XX: deprecated; migration code - %noun - ?> ?=(%migrate !<(%migrate vas)) - =/ bas /(scot %p our.bowl)/settings-store/(scot %da now.bowl) - :- ~ - ?. .^(? %gu (weld bas /$)) - state - =/ ful .^(data %gx (weld bas /all/noun)) - ?+ -.ful (on-poke:def mar vas) - %all state(settings +.ful) - == - == - [cards this] - :: - ++ on-watch - |= pax=path - ^- (quip card _this) - ?> (team:title our.bowl src.bowl) - ?+ pax (on-watch:def pax) - [%all ~] - [~ this] - :: - [%desk @ ~] - =* desk i.t.pax - [~ this] - :: - [%bucket @ @ ~] - =* desk i.t.pax - =* bucket-key i.t.t.pax - ?> (~(has bi settings) desk bucket-key) - [~ this] - :: - [%entry @ @ @ ~] - =* desk i.t.pax - =* bucket-key i.t.t.pax - =* entry-key i.t.t.t.pax - =/ bucket (~(got bi settings) desk bucket-key) - ?> (~(has by bucket) entry-key) - [~ this] - == - :: - ++ on-peek - |= pax=path - ^- (unit (unit cage)) - ?+ pax (on-peek:def pax) - [%x %all ~] - ``settings-data+!>(`data`all+settings) - :: - [%x %desk @ ~] - =* desk i.t.t.pax - =/ desk-settings (~(gut by settings) desk ~) - ``settings-data+!>(desk+desk-settings) - :: - [%x %bucket @ @ ~] - =* desk i.t.t.pax - =* buc i.t.t.t.pax - =/ bucket=(unit bucket) (~(get bi settings) desk buc) - ?~ bucket [~ ~] - ``settings-data+!>(`data`bucket+u.bucket) - :: - [%x %entry @ @ @ ~] - =* desk i.t.t.pax - =* buc i.t.t.t.pax - =* key i.t.t.t.t.pax - =/ =bucket (~(gut bi settings) desk buc *bucket) - =/ entry=(unit val) (~(get by bucket) key) - ?~ entry [~ ~] - ``settings-data+!>(`data`entry+u.entry) - :: - [%x %has-bucket @ @ ~] - =/ desk i.t.t.pax - =/ buc i.t.t.t.pax - =/ has-bucket=? (~(has bi settings) desk buc) - ``noun+!>(`?`has-bucket) - :: - [%x %has-entry @ @ @ ~] - =* desk i.t.t.pax - =* buc i.t.t.t.pax - =* key i.t.t.t.t.pax - =/ =bucket (~(gut bi settings) desk buc *bucket) - =/ has-entry=? (~(has by bucket) key) - ``noun+!>(`?`has-entry) - == - :: - ++ on-agent on-agent:def - ++ on-leave on-leave:def - ++ on-arvo on-arvo:def - ++ on-fail on-fail:def - -- -:: -|_ bol=bowl:gall -:: -:: +put-bucket: put a bucket in the top level settings map, overwriting if it -:: already exists -:: -++ put-bucket - |= [=desk =key =bucket] - ^- (quip card _state) - =/ pas=(list path) - :~ /all - /desk/[desk] - /bucket/[desk]/[key] - == - :- [(give-event pas %put-bucket desk key bucket)]~ - state(settings (~(put bi settings) desk key bucket)) -:: -:: +del-bucket: delete a bucket from the top level settings map -:: -++ del-bucket - |= [=desk =key] - ^- (quip card _state) - =/ pas=(list path) - :~ /all - /desk/[desk] - /bucket/[key] - == - :- [(give-event pas %del-bucket desk key)]~ - state(settings (~(del bi settings) desk key)) -:: -:: +put-entry: put an entry in a bucket, overwriting if it already exists -:: if bucket does not yet exist, create it -:: -++ put-entry - |= [=desk buc=key =key =val] - ^- (quip card _state) - =/ pas=(list path) - :~ /all - /desk/[desk] - /bucket/[desk]/[buc] - /entry/[desk]/[buc]/[key] - == - =/ =bucket (~(put by (~(gut bi settings) desk buc *bucket)) key val) - :- [(give-event pas %put-entry desk buc key val)]~ - state(settings (~(put bi settings) desk buc bucket)) -:: -:: +del-entry: delete an entry from a bucket, fail quietly if bucket does not -:: exist -:: -++ del-entry - |= [=desk buc=key =key] - ^- (quip card _state) - =/ pas=(list path) - :~ /all - /desk/[desk] - /bucket/[desk]/[buc] - /entry/[desk]/[buc]/[key] - == - =/ bucket=(unit bucket) (~(get bi settings) desk buc) - ?~ bucket - [~ state] - =. u.bucket (~(del by u.bucket) key) - :- [(give-event pas %del-entry desk buc key)]~ - state(settings (~(put bi settings) desk buc u.bucket)) -:: -++ give-event - |= [pas=(list path) evt=event] - ^- card - [%give %fact pas %settings-event !>(evt)] --- diff --git a/desk/desk.bill b/desk/desk.bill index 5185c4ae..3bfce779 100644 --- a/desk/desk.bill +++ b/desk/desk.bill @@ -1,12 +1,6 @@ -:~ %bait - %contacts - %docket +:~ %docket %hark - %reel - %settings %storage %treaty %vitals - %growl - %genuine == diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon deleted file mode 100644 index 853b6191..00000000 --- a/desk/lib/contacts.hoon +++ /dev/null @@ -1,478 +0,0 @@ -/- *contacts, c0=contacts-0 -|% -:: -+| %contact -:: +cy: contact map engine -:: -++ cy - |_ c=contact - :: +typ: enforce type if value exists - :: - ++ typ - |* [key=@tas typ=value-type] - ^- ? - =/ val=(unit value) (~(get by c) key) - ?~ val & - ?~ u.val | - ?- typ - %text ?=(%text -.u.val) - %numb ?=(%numb -.u.val) - %date ?=(%date -.u.val) - %tint ?=(%tint -.u.val) - %ship ?=(%ship -.u.val) - %look ?=(%look -.u.val) - %flag ?=(%flag -.u.val) - %set ?=(%set -.u.val) - == - :: +get: typed get - :: - ++ get - |* [key=@tas typ=value-type] - ^- (unit _p:*$>(_typ value)) - =/ val=(unit value) (~(get by c) key) - ?~ val ~ - ?~ u.val !! - ~| "{} expected at {}" - ?- typ - %text ?>(?=(%text -.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)) - %flag ?>(?=(%flag -.u.val) (some p.u.val)) - %set ?>(?=(%set -.u.val) (some p.u.val)) - == - :: +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 -.u.val) - ~| "set expected at {}" !! - %- some - %- ~(run in p.u.val) - ?- typ - %text |=(v=value ?>(?=(%text -.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)) - %flag |=(v=value ?>(?=(%flag -.v) v)) - %set |=(v=value ?>(?=(%set -.v) v)) - == - :: +gos: got specialized to typed set - :: - ++ gos - |* [key=@tas typ=value-type] - ^- (set $>(_typ value)) - =/ val=value (~(got by c) key) - ?. ?=(%set -.val) - ~| "set expected at {}" !! - %- ~(run in p.val) - ?- typ - %text |=(v=value ?>(?=(%text -.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)) - %flag |=(v=value ?>(?=(%flag -.v) v)) - %set |=(v=value ?>(?=(%set -.v) v)) - == - :: +gut: typed gut with default - :: - ++ gut - |* [key=@tas def=value] - ^+ +.def - =/ val=value (~(gut by c) key ~) - ?~ val - +.def - ~| "{<-.def>} expected at {}" - ?- -.val - %text ?>(?=(%text -.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) - %flag ?>(?=(%flag -.def) p.val) - %set ?>(?=(%set -.def) p.val) - == - :: +gub: typed gut with bunt default - :: - ++ gub - |* [key=@tas typ=value-type] - ^+ +:*$>(_typ value) - =/ val=value (~(gut by c) key ~) - ?~ val - ?+ typ !! - %text *@t - %numb *@ud - %date *@da - %tint *@ux - %ship *@p - %look *@t - %flag *flag:g - %set *(set value) - == - ~| "{} expected at {}" - ?- typ - %text ?>(?=(%text -.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) - %flag ?>(?=(%flag -.val) p.val) - %set ?>(?=(%set -.val) p.val) - == - -- -:: -++ do-edit-0 - |= [c=contact-0:c0 f=field-0:c0] - ^+ 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)) - == -:: +sane-contact: verify contact sanity -:: -:: - restrict size of the jammed noun to 10kB -:: - prohibit 'data:' URLs in image data -:: - nickname and bio must be a %text -:: - avatar and cover must be a %look -:: - groups must be a %set of %flags -:: -++ sane-contact - |= con=contact - ^- ? - ?~ ((soft contact) con) - | - :: 10kB contact ought to be enough for anybody - :: - ?: (gth (met 3 (jam con)) 10.000) - | - :: field restrictions - :: - :: 1. %nickname field: max 64 characters - :: 2. %bio field: max 2048 characters - :: 3. data URLs in %avatar and %cover - :: are forbidden - :: - ?. (~(typ cy con) %nickname %text) | - =+ nickname=(~(get cy con) %nickname %text) - ?: ?& ?=(^ nickname) - (gth (met 3 u.nickname) 64) - == - | - ?. (~(typ cy con) %bio %text) | - =+ bio=(~(get cy con) %bio %text) - ?: ?& ?=(^ bio) - (gth (met 3 u.bio) 2.048) - == - | - ?. (~(typ cy con) %avatar %look) | - =+ avatar=(~(get cy con) %avatar %look) - ?: ?& ?=(^ avatar) - =('data:' (end 3^5 u.avatar)) - == - | - ?. (~(typ cy con) %cover %look) | - =+ cover=(~(get cy con) %cover %look) - ?: ?& ?=(^ cover) - =('data:' (end 3^5 u.cover)) - == - | - ?. (~(typ cy con) %groups %set) | - =+ groups=(~(get cy con) %groups %set) - :: verifying the type of the first set element is enough, - :: set uniformity is verified by +soft above. - :: - ?: ?& ?=(^ groups) - ?=(^ u.groups) - !?=(%flag -.n.u.groups) - == - | - & -:: +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 mod=(map @tas value)] - ^+ con - =/ don (~(uni by con) mod) - =/ del=(list @tas) - %- ~(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) - don -:: +from-0: legacy to new type -:: -++ from-0 - |% - :: +contact: convert legacy to contact - :: - ++ contact - |= o=contact-0:c0 - ^- ^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 look/u.avatar.o) - =? c ?=(^ cover.o) - (~(put by c) %cover look/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:c0 - ^- ^profile - [wen.o ?~(con.o ~ (contact con.o))] - :: - -- -:: +from: legacy from new type -:: -++ to-0 - |% - :: +contact: convert contact to legacy - :: - ++ contact - |= c=^contact - ^- $@(~ contact-0:c0) - ?~ c ~ - =| o=contact-0:c0 - %_ 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 %look) - cover - (~(get cy c) %cover %look) - groups - =/ groups - (~(get cy c) %groups %set) - ?~ groups ~ - ^- (set flag:g) - %- ~(run in u.groups) - |= val=value - ?> ?=(%flag -.val) - p.val - == - :: +profile: convert profile to legacy - :: - ++ profile - |= p=^profile - ^- 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:c0 - [wen.p (contact:to-0 (contact-uni con.p mod))] - :: +foreign: convert foreign to legacy - :: - ++ foreign - |= f=^foreign - ^- 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:c0 - [?~(for.f ~ (profile-mod:to-0 for.f mod)) sag.f] - -- -:: +contact-uni: merge contacts -:: -++ contact-uni - |= [c=contact mod=contact] - ^- contact - (~(uni by c) mod) -:: +foreign-contact: get foreign contact -:: -++ foreign-contact - |= far=foreign - ^- contact - ?~(for.far ~ con.for.far) -:: +foreign-mod: modify foreign profile with user overlay -:: -++ foreign-mod - |= [far=foreign mod=contact] - ^- foreign - ?~ for.far - far - far(con.for (contact-uni con.for.far mod)) -:: +sole-field-0: sole field is a field that does -:: not modify the groups set -:: -+$ sole-field-0 - $~ nickname+'' - $<(?(%add-group %del-group) field-0:c0) -:: +to-sole-edit: convert legacy sole field to contact edit -:: -:: modify any field except for groups -:: -++ to-sole-edit - |= edit-0=(list sole-field-0) - ^- contact - %+ roll edit-0 - |= $: fed=sole-field-0 - acc=(map @tas value) - == - ^+ 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-self-edit - |= [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 - :: edition map. for group operations (%add-group, %del-group) - :: we need to operate directly on (existing?) groups field in - :: the profile. - :: - :: .sed: sole field edits, no group edits - :: .ged: only group edit actions - :: - =* group-type ?(%add-group %del-group) - =* sole-edits (list $<(group-type field-0:c0)) - =* group-edits (list $>(group-type field-0:c0)) - :: sift edits - :: - =/ [sed=sole-edits ged=group-edits] - :: - :: XX why is casting neccessary here? - =- [(flop `sole-edits`-<) (flop `group-edits`->)] - %+ roll edit-0 - |= [f=field-0:c0 sed=sole-edits ged=group-edits] - ^+ [sed ged] - ?. ?=(group-type -.f) - :- [f sed] - ged - :- sed - [f ged] - :: edit favourite groups - :: - =. groups - %+ roll ged - |= [fav=$>(group-type field-0:c0) =_groups] - ?- -.fav - %add-group - (~(put in groups) flag/flag.fav) - %del-group - (~(del in groups) flag/flag.fav) - == - %+ ~(put by (to-sole-edit sed)) - %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:c0) - ^- action - ?- -.o - %anon [%anon ~] - :: - :: old %meet is now a no-op - %meet [%meet ~] - %heed [%meet p.o] - %drop [%drop p.o] - %snub [%snub p.o] - == -:: +mono: tick time -:: -++ mono - |= [old=@da new=@da] - ^- @da - ?: (lth old new) new - (add old ^~((rsh 3^2 ~s1))) --- diff --git a/desk/lib/contacts/json-0.hoon b/desk/lib/contacts/json-0.hoon deleted file mode 100644 index aa1abaf9..00000000 --- a/desk/lib/contacts/json-0.hoon +++ /dev/null @@ -1,135 +0,0 @@ -/- c=contacts, g=groups -/- legacy=contacts-0 -/+ gj=groups-json -=, legacy -|% -++ enjs - =, enjs:format - |% - :: XX shadowed for compat, +ship:enjs removes the ~ - :: - ++ ship - |=(her=@p n+(rap 3 '"' (scot %p her) '"' ~)) - :: - ++ action - |= a=action-0 - ^- 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 - ^- 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 - ^- 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 - ^- json - %- pairs - %- ~(rep by r) - |= [[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 - ^- 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) - :: 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) - ?> ?& =('"' (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) - %- of - :~ anon+ul - edit+(ar field) - meet+(ar ship) - heed+(ar ship) - drop+(ar ship) - snub+(ar ship) - == - :: - ++ contact - ^- $-(json contact-0) - %- ot - :~ nickname+so - bio+so - status+so - color+nu - avatar+(mu so) - cover+(mu so) - groups+(as flag:dejs:gj) - == - :: - ++ field - ^- $-(json field-0) - %- 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 deleted file mode 100644 index a65fc33c..00000000 --- a/desk/lib/contacts/json-1.hoon +++ /dev/null @@ -1,151 +0,0 @@ -/- c=contacts, g=groups -/+ gj=groups-json -|% -++ enjs - =, enjs:format - |% - :: - ++ 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:c - ^- json - ?- -.val - %text (pairs type+s/%text value+s/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 ~) - %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) ~) - == - :: - ++ contact - |= con=contact:c - ^- json - o+(~(run by con) value) - :: - ++ page - |= =page:c - ^- json - a+[(contact con.page) (contact mod.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:c] acc=_dir] - (~(put by acc) (scot %p who) (contact con)) - :: - ++ response - |= n=response:c - ^- json - %+ frond -.n - ?- -.n - %self (frond contact+(contact con.n)) - %page %- pairs - :~ kip+(kip kip.n) - contact+(contact con.n) - mod+(contact mod.n) - == - %wipe (frond kip+(kip kip.n)) - %peer %- pairs - :~ who+(ship who.n) - contact+(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: tag .wit parsed json with .mas - :: - ++ ta - |* [mas=@tas wit=fist] - |= jon=json - [mas (wit jon)] - :: - ++ value - ^- $-(json value:c) - |= jon=json - ?~ jon ~ - =/ [type=@tas val=json] - %. jon - (ot type+(se %tas) value+json ~) - ?+ type !! - %text %. val (ta %text so) - %numb %. val (ta %numb ni) - %date %. val (ta %date (se %da)) - %tint %. val - %+ ta %tint - %+ cu - |=(s=@t (slav %ux (cat 3 '0x' s))) - so - %ship %. val (ta %ship ship) - %look %. val (ta %look so) - %flag %. val (ta %flag flag:dejs:gj) - %set %. val (ta %set (as value)) - == - :: - ++ contact - ^- $-(json contact:c) - (om value) - :: - ++ action - ^- $-(json action:c) - %- of - :~ anon+ul - self+contact - page+(ot kip+kip 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/reel.hoon b/desk/lib/reel.hoon deleted file mode 100644 index e6738cec..00000000 --- a/desk/lib/reel.hoon +++ /dev/null @@ -1,20 +0,0 @@ -/- reel -|% -++ enjs-metadata - |= =metadata:reel - ^- json - =/ fields - %+ turn ~(tap by fields.metadata) - |= [key=cord value=cord] - ^- [cord json] - [key s+value] - %- pairs:enjs:format - :~ ['tag' s+tag.metadata] - ['fields' (pairs:enjs:format fields)] - == -++ dejs-metadata - %- ot:dejs:format - :~ tag+so:dejs:format - fields+(om so):dejs:format - == --- diff --git a/desk/lib/settings.hoon b/desk/lib/settings.hoon deleted file mode 100644 index b2f7cff7..00000000 --- a/desk/lib/settings.hoon +++ /dev/null @@ -1,147 +0,0 @@ -/- *settings -|% -++ enjs - =, enjs:format - |% - ++ data - |= dat=^data - ^- json - %+ frond -.dat - ?- -.dat - %all (settings +.dat) - %bucket (bucket +.dat) - %entry (value +.dat) - %desk (desk-settings +.dat) - == - :: - ++ settings - |= s=^settings - ^- json - [%o (~(run by s) desk-settings)] - :: - ++ desk-settings - |= s=(map key ^bucket) - [%o (~(run by s) bucket)] - :: - ++ event - |= evt=^event - ^- json - %+ frond -.evt - ?- -.evt - %put-bucket (put-bucket +.evt) - %del-bucket (del-bucket +.evt) - %put-entry (put-entry +.evt) - %del-entry (del-entry +.evt) - == - :: - ++ put-bucket - |= [d=desk k=key b=^bucket] - ^- json - %- pairs - :~ bucket-key+s+k - bucket+(bucket b) - desk+s+d - == - :: - ++ del-bucket - |= [d=desk k=key] - ^- json - %- pairs - :~ bucket-key+s+k - desk+s+d - == - :: - ++ put-entry - |= [d=desk b=key k=key v=val] - ^- json - %- pairs - :~ bucket-key+s+b - entry-key+s+k - value+(value v) - desk+s+d - == - :: - ++ del-entry - |= [d=desk buc=key =key] - ^- json - %- pairs - :~ bucket-key+s+buc - entry-key+s+key - desk+s+d - == - :: - ++ value - |= =val - ^- json - ?- -.val - %s val - %b val - %n (numb p.val) - %a [%a (turn p.val value)] - == - :: - ++ bucket - |= b=^bucket - ^- json - [%o (~(run by b) value)] - -- -:: -++ dejs - =, dejs:format - |% - ++ event - |= jon=json - ^- ^event - %. jon - %- of - :~ put-bucket+put-bucket - del-bucket+del-bucket - put-entry+put-entry - del-entry+del-entry - == - :: - ++ put-bucket - %- ot - :~ desk+so - bucket-key+so - bucket+bucket - == - :: - ++ del-bucket - %- ot - :~ desk+so - bucket-key+so - == - :: - ++ put-entry - %- ot - :~ desk+so - bucket-key+so - entry-key+so - value+value - == - :: - ++ del-entry - %- ot - :~ desk+so - bucket-key+so - entry-key+so - == - :: - ++ value - |= jon=json - ^- val - ?+ -.jon !! - %s jon - %b jon - %n [%n (rash p.jon dem)] - %a [%a (turn p.jon value)] - == - :: - ++ bucket - |= jon=json - ^- ^bucket - ?> ?=([%o *] jon) - (~(run by p.jon) value) - -- --- diff --git a/desk/mar/bait/describe.hoon b/desk/mar/bait/describe.hoon deleted file mode 100644 index f45b1af4..00000000 --- a/desk/mar/bait/describe.hoon +++ /dev/null @@ -1,12 +0,0 @@ -/- reel -|_ [token=cord =metadata:reel] -++ grad %noun -++ grab - |% - ++ noun (pair cord metadata:reel) - -- -++ grow - |% - ++ noun [token metadata] - -- --- diff --git a/desk/mar/bait/undescribe.hoon b/desk/mar/bait/undescribe.hoon deleted file mode 100644 index 2c8d5619..00000000 --- a/desk/mar/bait/undescribe.hoon +++ /dev/null @@ -1,11 +0,0 @@ -|_ token=cord -++ grad %noun -++ grab - |% - ++ noun cord - -- -++ grow - |% - ++ noun token - -- --- diff --git a/desk/mar/bark/add-recipient.hoon b/desk/mar/bark/add-recipient.hoon deleted file mode 100644 index 54a0b224..00000000 --- a/desk/mar/bark/add-recipient.hoon +++ /dev/null @@ -1,11 +0,0 @@ -|_ rec=ship -++ grad %noun -++ grab - |% - ++ noun ship - -- -++ grow - |% - ++ noun rec - -- --- diff --git a/desk/mar/bark/receive-summary.hoon b/desk/mar/bark/receive-summary.hoon deleted file mode 100644 index 293b0af6..00000000 --- a/desk/mar/bark/receive-summary.hoon +++ /dev/null @@ -1,20 +0,0 @@ -=> |% - +$ result - %- unit - $: requested=time - $= summary - ::NOTE see also /lib/summarize - $% [%life active=[s=@ud r=@ud g=@t] inactive=[d=@ud c=@ud g=@t c=@t]] - == == - -- -|_ =result -++ grad %noun -++ grab - |% - ++ noun ^result - -- -++ grow - |% - ++ noun result - -- --- diff --git a/desk/mar/bark/remove-recipient.hoon b/desk/mar/bark/remove-recipient.hoon deleted file mode 100644 index 54a0b224..00000000 --- a/desk/mar/bark/remove-recipient.hoon +++ /dev/null @@ -1,11 +0,0 @@ -|_ rec=ship -++ grad %noun -++ grab - |% - ++ noun ship - -- -++ grow - |% - ++ noun rec - -- --- diff --git a/desk/mar/contact-0.hoon b/desk/mar/contact-0.hoon deleted file mode 100644 index 4e355e84..00000000 --- a/desk/mar/contact-0.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- c=contacts, x=contacts-0 -/+ j=contacts-json-0 -|_ contact=contact-0:x -++ grad %noun -++ grow - |% - ++ noun contact - ++ json (contact:enjs:j contact) - -- -++ grab - |% - ++ noun contact-0:x - -- --- diff --git a/desk/mar/contact-1.hoon b/desk/mar/contact-1.hoon deleted file mode 100644 index e75a43d4..00000000 --- a/desk/mar/contact-1.hoon +++ /dev/null @@ -1,16 +0,0 @@ -/+ c=contacts -/+ j=contacts-json-1 -|_ contact=contact:c -++ grad %noun -++ grow - |% - ++ noun contact - ++ json (contact:enjs:j contact) - -- -++ grab - |% - ++ noun contact:c - ++ json contact:dejs:j - ++ contact contact:from-0:c - -- --- diff --git a/desk/mar/contact.hoon b/desk/mar/contact.hoon deleted file mode 100644 index aa4bd1cb..00000000 --- a/desk/mar/contact.hoon +++ /dev/null @@ -1,3 +0,0 @@ -/= contact-0 /mar/contact-0 -contact-0 - diff --git a/desk/mar/contact/action-0.hoon b/desk/mar/contact/action-0.hoon deleted file mode 100644 index 8ea2b57b..00000000 --- a/desk/mar/contact/action-0.hoon +++ /dev/null @@ -1,15 +0,0 @@ -/- c=contacts, legacy=contacts-0 -/+ j=contacts-json-0 -|_ action=action-0:legacy -++ grad %noun -++ grow - |% - ++ noun action - ++ json (action:enjs:j action) - -- -++ grab - |% - ++ noun action-0:legacy - ++ json action:dejs:j - -- --- diff --git a/desk/mar/contact/action-1.hoon b/desk/mar/contact/action-1.hoon deleted file mode 100644 index 45257928..00000000 --- a/desk/mar/contact/action-1.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- c=contacts -/+ j=contacts-json-1 -|_ action=action:c -++ grad %noun -++ grow - |% - ++ noun action - -- -++ grab - |% - ++ noun action:c - ++ json action:dejs:j - -- --- diff --git a/desk/mar/contact/action.hoon b/desk/mar/contact/action.hoon deleted file mode 100644 index f6020423..00000000 --- a/desk/mar/contact/action.hoon +++ /dev/null @@ -1,2 +0,0 @@ -/= mark /mar/contact/action-0 -mark diff --git a/desk/mar/contact/book-0.hoon b/desk/mar/contact/book-0.hoon deleted file mode 100644 index 2de84aae..00000000 --- a/desk/mar/contact/book-0.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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/book.hoon b/desk/mar/contact/book.hoon deleted file mode 100644 index 2de84aae..00000000 --- a/desk/mar/contact/book.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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 deleted file mode 100644 index b7c399c1..00000000 --- a/desk/mar/contact/directory-0.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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/directory.hoon b/desk/mar/contact/directory.hoon deleted file mode 100644 index b7c399c1..00000000 --- a/desk/mar/contact/directory.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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/news.hoon b/desk/mar/contact/news.hoon deleted file mode 100644 index 19f3bb3d..00000000 --- a/desk/mar/contact/news.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- c=contacts, x=contacts-0 -/+ j=contacts-json-0 -|_ news=news-0:x -++ grad %noun -++ grow - |% - ++ noun news - ++ json (news:enjs:j news) - -- -++ grab - |% - ++ noun news-0:x - -- --- diff --git a/desk/mar/contact/page-0.hoon b/desk/mar/contact/page-0.hoon deleted file mode 100644 index ca628447..00000000 --- a/desk/mar/contact/page-0.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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/page-1.hoon b/desk/mar/contact/page-1.hoon deleted file mode 100644 index ca628447..00000000 --- a/desk/mar/contact/page-1.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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/page.hoon b/desk/mar/contact/page.hoon deleted file mode 100644 index ca628447..00000000 --- a/desk/mar/contact/page.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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 deleted file mode 100644 index 92c29689..00000000 --- a/desk/mar/contact/response-0.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- 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/mar/contact/rolodex.hoon b/desk/mar/contact/rolodex.hoon deleted file mode 100644 index 4992264b..00000000 --- a/desk/mar/contact/rolodex.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- c=contacts, x=contacts-0 -/+ j=contacts-json-0 -|_ rol=rolodex:x -++ grad %noun -++ grow - |% - ++ noun rol - ++ json (rolodex:enjs:j rol) - -- -++ grab - |% - ++ noun rolodex:x - -- --- diff --git a/desk/mar/contact/update-0.hoon b/desk/mar/contact/update-0.hoon deleted file mode 100644 index 519391bd..00000000 --- a/desk/mar/contact/update-0.hoon +++ /dev/null @@ -1,12 +0,0 @@ -/- c=contacts, x=contacts-0 -|_ update=update-0:x -++ grad %noun -++ grow - |% - ++ noun update - -- -++ grab - |% - ++ noun update-0:x - -- --- diff --git a/desk/mar/contact/update-1.hoon b/desk/mar/contact/update-1.hoon deleted file mode 100644 index f5d9fc52..00000000 --- a/desk/mar/contact/update-1.hoon +++ /dev/null @@ -1,12 +0,0 @@ -/- c=contacts -|_ update=update:c -++ grad %noun -++ grow - |% - ++ noun update - -- -++ grab - |% - ++ noun update:c - -- --- diff --git a/desk/mar/contact/update.hoon b/desk/mar/contact/update.hoon deleted file mode 100644 index f143c73b..00000000 --- a/desk/mar/contact/update.hoon +++ /dev/null @@ -1,2 +0,0 @@ -/= mark /mar/contact/update-0 -mark diff --git a/desk/mar/growl/summarize.hoon b/desk/mar/growl/summarize.hoon deleted file mode 100644 index 62769894..00000000 --- a/desk/mar/growl/summarize.hoon +++ /dev/null @@ -1,11 +0,0 @@ -|_ requested=time -++ grad %noun -++ grab - |% - ++ noun time - -- -++ grow - |% - ++ noun requested - -- --- diff --git a/desk/mar/reel/bait.hoon b/desk/mar/reel/bait.hoon deleted file mode 100644 index 1b0b5e52..00000000 --- a/desk/mar/reel/bait.hoon +++ /dev/null @@ -1,18 +0,0 @@ -/- reel -|_ [vic=cord civ=ship] -++ grad %noun -++ grab - |% - ++ noun (pair cord ship) - ++ json - %- ot:dejs:format - :~ url+so:dejs:format - ship+(cu:dejs:format |=(=cord (slav %p cord)) so:dejs:format) - == - -- -++ grow - |% - ++ noun [vic civ] - ++ json (pairs:enjs:format ~[['url' s+vic] ['ship' s+(scot %p civ)]]) - -- --- diff --git a/desk/mar/reel/bite.hoon b/desk/mar/reel/bite.hoon deleted file mode 100644 index 54d2c56b..00000000 --- a/desk/mar/reel/bite.hoon +++ /dev/null @@ -1,12 +0,0 @@ -/- reel -|_ =bite:reel -++ grad %noun -++ grab - |% - ++ noun bite:reel - -- -++ grow - |% - ++ noun bite - -- --- diff --git a/desk/mar/reel/command.hoon b/desk/mar/reel/command.hoon deleted file mode 100644 index 139d3ffa..00000000 --- a/desk/mar/reel/command.hoon +++ /dev/null @@ -1,19 +0,0 @@ -/- reel -|_ =command:reel -++ grad %noun -++ grab - |% - ++ noun command:reel - ++ json - |= j=^json - :- %set-service - %. j - %- ot:dejs:format - :~ url+so:dejs:format - == - -- -++ grow - |% - ++ noun command - -- --- diff --git a/desk/mar/reel/confirmation.hoon b/desk/mar/reel/confirmation.hoon deleted file mode 100644 index 891aac88..00000000 --- a/desk/mar/reel/confirmation.hoon +++ /dev/null @@ -1,12 +0,0 @@ -/- reel -|_ =confirmation:reel -++ grad %noun -++ grab - |% - ++ noun confirmation:reel - -- -++ grow - |% - ++ noun confirmation - -- --- diff --git a/desk/mar/reel/describe.hoon b/desk/mar/reel/describe.hoon deleted file mode 100644 index 4c180aa7..00000000 --- a/desk/mar/reel/describe.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- reel -/+ *reel -|_ [token=cord =metadata:reel] -++ grad %noun -++ grab - |% - ++ noun (pair cord cord) - ++ json (ot:dejs:format ~[token+so:dejs:format metadata+dejs-metadata]) - -- -++ grow - |% - ++ noun [token metadata] - -- --- diff --git a/desk/mar/reel/description.hoon b/desk/mar/reel/description.hoon deleted file mode 100644 index 4479d478..00000000 --- a/desk/mar/reel/description.hoon +++ /dev/null @@ -1,13 +0,0 @@ -|_ description=cord -++ grad %noun -++ grab - |% - ++ noun cord - ++ json so:dejs:format - -- -++ grow - |% - ++ noun description - ++ json [%s description] - -- --- diff --git a/desk/mar/reel/give-token-link.hoon b/desk/mar/reel/give-token-link.hoon deleted file mode 100644 index e982d175..00000000 --- a/desk/mar/reel/give-token-link.hoon +++ /dev/null @@ -1,11 +0,0 @@ -|_ token-url=(unit [token=cord url=cord]) -++ grad %noun -++ grab - |% - ++ noun (unit (pair cord cord)) - -- -++ grow - |% - ++ noun token-url - -- --- diff --git a/desk/mar/reel/metadata.hoon b/desk/mar/reel/metadata.hoon deleted file mode 100644 index 179842b9..00000000 --- a/desk/mar/reel/metadata.hoon +++ /dev/null @@ -1,15 +0,0 @@ -/- reel -/+ *reel -|_ =metadata:reel -++ grad %noun -++ grab - |% - ++ noun metadata - ++ json dejs-metadata - -- -++ grow - |% - ++ noun metadata - ++ json (enjs-metadata metadata) - -- --- diff --git a/desk/mar/reel/undescribe.hoon b/desk/mar/reel/undescribe.hoon deleted file mode 100644 index 4787ac00..00000000 --- a/desk/mar/reel/undescribe.hoon +++ /dev/null @@ -1,14 +0,0 @@ -/- reel -/+ *reel -|_ token=cord -++ grad %noun -++ grab - |% - ++ noun (pair cord cord) - ++ json (ot:dejs:format ~[token+so:dejs:format]) - -- -++ grow - |% - ++ noun token - -- --- diff --git a/desk/mar/reel/want-token-link.hoon b/desk/mar/reel/want-token-link.hoon deleted file mode 100644 index 2c8d5619..00000000 --- a/desk/mar/reel/want-token-link.hoon +++ /dev/null @@ -1,11 +0,0 @@ -|_ token=cord -++ grad %noun -++ grab - |% - ++ noun cord - -- -++ grow - |% - ++ noun token - -- --- diff --git a/desk/mar/settings/data.hoon b/desk/mar/settings/data.hoon deleted file mode 100644 index a58b017e..00000000 --- a/desk/mar/settings/data.hoon +++ /dev/null @@ -1,13 +0,0 @@ -/+ *settings -|_ dat=data -++ grad %noun -++ grow - |% - ++ noun dat - ++ json (data:enjs dat) - -- -++ grab - |% - ++ noun data - -- --- diff --git a/desk/mar/settings/event.hoon b/desk/mar/settings/event.hoon deleted file mode 100644 index 7f03b313..00000000 --- a/desk/mar/settings/event.hoon +++ /dev/null @@ -1,16 +0,0 @@ -/+ *settings -|_ evt=event -++ grad %noun -++ grow - |% - ++ noun evt - ++ json - %+ frond:enjs:format %settings-event - (event:enjs evt) - -- -++ grab - |% - ++ noun event - ++ json event:dejs - -- --- diff --git a/desk/sur/contacts-0.hoon b/desk/sur/contacts-0.hoon deleted file mode 100644 index a019da82..00000000 --- a/desk/sur/contacts-0.hoon +++ /dev/null @@ -1,60 +0,0 @@ -/- 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/sur/contacts.hoon b/desk/sur/contacts.hoon deleted file mode 100644 index 414ad3c5..00000000 --- a/desk/sur/contacts.hoon +++ /dev/null @@ -1,137 +0,0 @@ -/- e=epic, g=groups -|% -:: -+| %compat -:: -++ okay `epic`1 -:: -+| %types -:: $value-type: contact field value type -:: -+$ value-type - $? %text - %numb - %date - %tint - %ship - %look - %flag - %set - == -:: $value: contact field value -:: -+$ value - $+ contact-value - $@ ~ - $% [%text p=@t] - [%numb p=@ud] - [%date p=@da] - :: - :: color - [%tint p=@ux] - [%ship p=ship] - :: - :: picture - [%look p=@ta] - :: - :: group - [%flag p=flag:g] - :: - :: uniform set - [%set p=$|((set value) unis)] - == -:: +unis: whether set is uniformly typed -:: -++ unis - |= set=(set value) - ^- ? - ?~ set & - =/ typ -.n.set - |- - ?& =(typ -.n.set) - ?~(l.set & $(set l.set)) - ?~(r.set & $(set r.set)) - == -:: $contact: contact data -:: -+$ contact (map @tas value) -:: $profile: contact profile -:: -:: .wen: last updated -:: .con: contact -:: -+$ profile [wen=@da con=contact] -:: $foreign: foreign profile -:: -:: .for: profile -:: .sag: connection status -:: -+$ foreign [for=$@(~ profile) sag=saga] -:: $page: contact page -:: -:: .con: peer contact -:: .mod: user overlay -:: -+$ page [con=contact mod=contact] -:: $cid: contact page id -:: -+$ cid @uvF -:: $kip: contact book key -:: -+$ kip $@(ship [%id cid]) -:: $book: contact book -:: -+$ book (map kip page) -:: $directory: merged contacts -:: -+$ directory (map ship contact) -:: $peers: network peers -:: -+$ peers (map ship foreign) -:: -+$ epic epic:e -:: -+$ saga - $? %want :: subscribing - ~ :: none intended - == -:: %anon: delete our profile -:: %self: edit our profile -:: %page: create a new contact page -:: %edit: edit a contact overlay -:: %wipe: delete a contact page -:: %meet: track a peer -:: %drop: discard a peer -:: %snub: unfollow a peer -:: -+$ action - $% [%anon ~] - [%self p=contact] - [%page p=kip q=contact] - [%edit p=kip q=contact] - [%wipe p=(list kip)] - [%meet p=(list ship)] - [%drop p=(list ship)] - [%snub p=(list ship)] - == -:: network update -:: -:: %full: our profile -:: -+$ update - $% [%full profile] - == -:: $response: local update -:: -:: %self: profile update -:: %page: contact page update -:: %wipe: contact page delete -:: %peer: peer update -:: -+$ response - $% [%self con=contact] - [%page =kip con=contact mod=contact] - [%wipe =kip] - [%peer who=ship con=contact] - == --- diff --git a/desk/sur/reel.hoon b/desk/sur/reel.hoon deleted file mode 100644 index 1f46275c..00000000 --- a/desk/sur/reel.hoon +++ /dev/null @@ -1,17 +0,0 @@ -|% -+$ command - $% [%set-service vic=@t] - [%set-ship civ=@p] - == -:: -+$ bite - $% [%bite-0 token=@ta ship=@p] - [%bite-1 token=@ta joiner=@p inviter=@p] - [%bite-2 =token joiner=@p =metadata] - == -:: -+$ token cord -+$ nonce @ta -+$ metadata [tag=term fields=(map cord cord)] -+$ confirmation [=nonce =token] --- diff --git a/desk/sur/settings.hoon b/desk/sur/settings.hoon deleted file mode 100644 index 9ba96830..00000000 --- a/desk/sur/settings.hoon +++ /dev/null @@ -1,44 +0,0 @@ -/+ *mip -|% -:: -++ settings-0 - =< settings - |% - +$ settings (map key bucket) - +$ bucket (map key val) - +$ val - $% [%s p=@t] - [%b p=?] - [%n p=@] - == - -- -:: -++ settings-1 - =< settings - |% - +$ settings (map key bucket) - -- -+$ bucket (map key val) -+$ key term -+$ val - $~ [%n 0] - $% [%s p=@t] - [%b p=?] - [%n p=@] - [%a p=(list val)] - == -:: -+$ settings (mip desk key bucket) -+$ event - $% [%put-bucket =desk =key =bucket] - [%del-bucket =desk =key] - [%put-entry =desk buc=key =key =val] - [%del-entry =desk buc=key =key] - == -+$ data - $% [%all =settings] - [%bucket =bucket] - [%desk desk=(map key bucket)] - [%entry =val] - == --- diff --git a/desk/ted/reel/set-ship.hoon b/desk/ted/reel/set-ship.hoon deleted file mode 100644 index 9e711501..00000000 --- a/desk/ted/reel/set-ship.hoon +++ /dev/null @@ -1,18 +0,0 @@ -/- spider -/+ *strandio -=, strand=strand:spider -=, strand-fail=strand-fail:libstrand:spider -^- thread:spider -|= arg=vase -=/ m (strand ,vase) -^- form:m -=+ !<(vic=cord arg) -;< our=@p bind:m get-our -=/ url - ?: =(vic 'https://tlon.network/lure/') - "https://tlon.network/v1/lure/bait/who" - "{(trip vic)}lure/bait/who" -;< =json bind:m (fetch-json url) -=/ =ship (slav %p (so:dejs:format json)) -;< ~ bind:m (poke [our %reel] reel-command+!>([%set-ship ship])) -(pure:m !>(~)) diff --git a/desk/tests/app/bait.hoon b/desk/tests/app/bait.hoon deleted file mode 100644 index e1bc3c3a..00000000 --- a/desk/tests/app/bait.hoon +++ /dev/null @@ -1,165 +0,0 @@ -/- r=reel, spider -/+ *test-agent, reel, strandio, server -/= bait-agent /app/bait -|% -++ dap %bait-test -++ vic 'https://tlon.network/lure/' -++ civ ~loshut-lonreg -++ eny - `@uv`0xffff.ffff.ffff.ffff.ffff.ffff.ffff.ffff -++ nonce `@ta`'~2000.1.1' -++ token `@t`(scot %uv (end [3 16] eny)) -+$ bait-state - $: %2 - metadata=(map token:r metadata:r) - == -++ test-bait-describe - %- eval-mare - =/ m (mare ,~) - ;< * bind:m (do-init dap bait-agent) - ;< * bind:m (jab-bowl |=(b=bowl b(our civ, src ~dev, eny eny))) - =/ =metadata:r [%test (my ['inviter' '~dev'] ['bite-type' '2'] ~)] - =/ describe [nonce metadata] - ;< caz=(list card) bind:m (do-poke %bait-describe !>(describe)) - ;< * bind:m - %+ ex-cards caz - ~[(ex-poke /confirm/[nonce] [~dev %reel] reel-confirmation+!>([nonce token]))] - ;< state=vase bind:m get-save - =+ !<(bait-state state) - (ex-equal !>(metadata) !>((my [token ^metadata] ~))) -++ test-bait-who-get - %- eval-mare - =/ m (mare ,~) - ;< * bind:m (do-init dap bait-agent) - ;< * bind:m (jab-bowl |=(b=bowl b(our ~dev))) - =/ simple-payload - (json-response:gen:server s+(scot %p ~dev)) - :: request 1: test old style tokens - =/ eyre-id %eyre-request-1 - =/ request=[id=@ta inbound-request:eyre] - [eyre-id (eyre-get-request '/lure/bait/who')] - ;< caz=(list card) bind:m (do-poke %handle-http-request !>(request)) - %+ ex-cards caz - (eyre-request-cards eyre-id simple-payload) -++ test-bait-metadata-get - %- eval-mare - =/ m (mare ,~) - ;< * bind:m (do-init dap bait-agent) - ;< * bind:m (jab-bowl |=(b=bowl b(our civ, src civ, eny eny))) - =/ =metadata:r [%test (my ['title' 'test-group'] ~)] - =/ init-state=bait-state - :- %2 - (my ['~zod/test' metadata] [token metadata] ~) - ;< * bind:m (do-load bait-agent `!>(init-state)) - =/ simple-payload - (json-response:gen:server (enjs-metadata:reel metadata)) - :: request 1: test old style tokens - =/ eyre-id %eyre-request-1 - =/ request=[id=@ta inbound-request:eyre] - [eyre-id (eyre-get-request '/lure/~zod/test/metadata')] - ;< caz=(list card) bind:m (do-poke %handle-http-request !>(request)) - ;< * bind:m - %+ ex-cards caz - (eyre-request-cards eyre-id simple-payload) - :: request 2: test new style tokens - =/ eyre-id %eyre-request-2 - =/ request=[id=@ta inbound-request:eyre] - [eyre-id (eyre-get-request (crip "/lure/{(trip token)}/metadata"))] - ;< caz=(list card) bind:m (do-poke %handle-http-request !>(request)) - %+ ex-cards caz - (eyre-request-cards eyre-id simple-payload) -:: -++ test-bait-bite-post - %- eval-mare - =/ m (mare ,~) - ;< * bind:m (do-init dap bait-agent) - ;< * bind:m (jab-bowl |=(b=bowl b(our civ, src civ, eny eny))) - =/ m1=metadata:r [%test (my ['title' 'test-group'] ~)] - =/ m2=metadata:r - :- %test - %- my - :~ ['title' 'test-group'] - ['bite-type' '2'] - ['inviter' '~dev'] - == - =/ init-state=bait-state - :- %2 - (my ['~zod/test' m1] [token m2] ~) - ;< * bind:m (do-load bait-agent `!>(init-state)) - =/ payload (as-octs:mimes:html 'ship=%7Erus') - =/ simple-payload - (manx-response:gen:server (sent-page ~rus)) - :: request 1: test new style tokens - =/ eyre-id %eyre-request-1 - =/ request=[id=@ta inbound-request:eyre] - [eyre-id (eyre-post-request (cat 3 '/lure/' token) payload)] - ;< caz=(list card) bind:m (do-poke %handle-http-request !>(request)) - ;< * bind:m - %+ ex-cards caz - =/ =cage reel-bite+!>([%bite-2 token ~rus m2]) - %+ welp - :~ (ex-poke /bite [~dev %reel] cage) - (ex-poke /bite [civ %reel] cage) - == - (eyre-request-cards eyre-id simple-payload) - :: request 2: test old style tokens - =/ eyre-id %eyre-request-2 - =/ request=[id=@ta inbound-request:eyre] - [eyre-id (eyre-post-request '/lure/~zod/test' payload)] - ;< caz=(list card) bind:m (do-poke %handle-http-request !>(request)) - %+ ex-cards caz - =/ =cage reel-bite+!>([%bite-1 `@ta`'test' ~rus ~zod]) - %+ welp - :~ (ex-poke /bite [~zod %reel] cage) - (ex-poke /bite [civ %reel] cage) - == - (eyre-request-cards eyre-id simple-payload) -++ eyre-get-request - |= url=@t - :* | - & - *address:eyre - :* %'GET' - url - ~ - ~ - == - == -:: -++ eyre-post-request - |= [url=@t payload=octs] - :* | - & - *address:eyre - :* %'POST' - url - ~ - `payload - == - == -++ eyre-request-cards - |= [id=@ta =simple-payload:http] - ^- (list $-(card tang)) - =/ paths ~[/http-response/[id]] - =/ header-cage - [%http-response-header !>(response-header.simple-payload)] - =/ data-cage - [%http-response-data !>(data.simple-payload)] - %- limo - :~ (ex-fact paths header-cage) - (ex-fact paths data-cage) - (ex-card [%give %kick paths ~]) - == -++ sent-page - |= invitee=ship - ^- manx - ;html - ;head - ;title:"Lure" - == - ;body - Your invite has been sent! Go to your ship to accept it. - ;script: document.cookie="ship={(trip (scot %p invitee))}" - == - == --- \ No newline at end of file diff --git a/desk/tests/app/contacts.hoon b/desk/tests/app/contacts.hoon deleted file mode 100644 index a4354215..00000000 --- a/desk/tests/app/contacts.hoon +++ /dev/null @@ -1,1093 +0,0 @@ -/- *contacts, c0=contacts-0 -/+ *test-agent -/+ c=contacts -/= contacts-agent /app/contacts -=* agent contacts-agent -:: 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] - ^- @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 -:: -++ test-poke-0-anon - %- 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:c0 - =. nickname.con-0 'Zod' - =. bio.con-0 'The first of the galaxies' - :: - =/ con-1=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] - =/ edit-0=(list field-0:c0) - ^- (list field-0:c0) - :~ nickname+'Zod' - bio+'The first of the galaxies' - == - :: foreign subscriber to /v1/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 /news) - :: - ;< ~ b (set-src our.bowl) - :: action-0:c0 profile %edit - :: - ;< caz=(list card) b (do-poke contact-action+!>([%edit edit-0])) - :: - =/ upd-0=update-0:c0 - [%full (add now.bowl (mul 2 tick)) ~] - =/ upd-1=update - [%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-response-0+!>([%self ~])) - (ex-fact ~[/v1/contact] contact-update-1+!>(upd-1)) - == -:: +test-poke-0-edit: v0 edit the profile -:: -++ test-poke-0-edit - %- 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:c0 - =. nickname.con-0 'Zod' - =. bio.con-0 'The first of the galaxies' - =. groups.con-0 (silt ~sampel-palnet^%oranges ~) - :: - =/ con=contact - %- malt - ^- (list (pair @tas value)) - :~ nickname+text/'Zod' - bio+text/'The first of the galaxies' - groups+set/(silt flag/~sampel-palnet^%oranges ~) - == - :: - =/ edit-0=(list field-0:c0) - ^- (list field-0:c0) - :~ 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 - :: - ;< ~ 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 /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:c0 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-response-0+!>([%self con])) - (ex-fact ~[/v1/contact] contact-update-1+!>([%full `@da`(add now.bowl tick) 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-response-0+!>([%self new-con])) - (ex-fact ~[/v1/contact] contact-update-1+!>([%full (add now.bowl (mul 2 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 - %- 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-response-0+!>([%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 - %- malt - ^- (list (pair @tas value)) - ~[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 ~[/news] contact-news+!>([our.bowl ~])) - (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 - :: - ;< 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) - =/ cag (need (need peek)) - %+ ex-equal - !>(cag) - !>(contact-1+!>(`contact`~)) -:: +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:c0 - =. nickname.con-0 'Zod' - =. bio.con-0 'The first of the galaxies' - :: - =/ con-1=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Zod' bio+text/'The first of the galaxies'] - :: - =/ upd-0=update-0:c0 - [%full (add now.bowl tick) con-0] - =/ upd-1=update - [%full (add now.bowl tick) 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 ~[/news] contact-news+!>([our.bowl con-0])) - (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 -:: -++ test-poke-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'] - :: - =/ resp=response - [%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) - :: create new contact page - :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v1 con-1])) - :: news is published on /v1/news - :: - ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-response-0+!>(resp)) - == - :: peek page in the book: new contact page is found - :: - ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/id/0v1) - =/ =cage (need (need peek)) - ;< ~ b - %+ ex-equal - !> [%contact-page-0 q.cage] - !> [%contact-page-0 !>(mypage)] - :: fail to create duplicate page - :: - %- ex-fail (do-poke contact-action-1+!>([%page id+0v1 con-1])) -:: +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 - =/ groups - ^- (list value) - :~ flag/~sampel-palnet^%apples - flag/~sampel-palnet^%oranges - == - =/ con-1=contact - %- malt - ^- (list (pair @tas value)) - :~ nickname+text/'Sun' - bio+text/'It is bright today' - groups+set/(silt groups) - == - :: - =/ resp=response - [%page id+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) - :: create new contact page - :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%page id+0v1 con-1])) - :: news is published on /v1/news - :: - ;< ~ b %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-response-0+!>(resp)) - == - :: peek page in the book: new contact page is found - :: - ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/id/0v1) - =/ =cage (need (need peek)) - %+ ex-equal - !> [%contact-page-0 q.cage] - !> [%contact-page-0 !>(mypage)] - :: delete favourite groups - :: -:: -++ 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 - %- 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) - :: 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 (contact:to-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-response-0+!>([%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 - !> cag - !> contact-foreign-0+!>(`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 !>([%meet ~[~sun]])) - (ex-cards caz ~) -:: -++ test-poke-page-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 - %- 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) - :: page ~sun to contact boook: he also becomes our peer - :: - ;< caz=(list card) b (do-poke contact-action-1+!>([%page ~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 ~])) - (ex-fact ~[/v1/news] contact-response-0+!>([%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-0+!>(`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])) - ;< ~ b - %+ ex-cards caz - :~ (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])) - == - :: ~sun contact page is edited - :: - ;< ~ b (set-src our.bowl) - =/ con-mod=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Bright Sun' avatar+look/'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-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-uni:c con-sun con-mod)) -:: -++ test-poke-page-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 - %- 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) - :: 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 (contact:to-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-response-0+!>([%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 - !> cag - !> contact-foreign-0+!>(`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+!>([%page ~sun ~])) - ;< ~ b - %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) - == - :: ~sun contact page is edited - :: - =/ con-mod=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Bright Sun' avatar+look/'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 (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 - :: - ;< 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-sun] %want]) - :: 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 - !> cag - !> [%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)) - ;< ~ b - %+ ex-equal - !> cag - !> 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]])) - ;< ~ b - %+ ex-cards caz - :~ :: (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 - :: - ;< peek=(unit (unit cage)) b (get-peek /x/v1/book/~sun) - =/ 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 - :: - ;< peek=(unit (unit cage)) b (get-peek /x/v1/peer/~sun) - =/ cag=cage (need (need peek)) - %+ ex-equal - !> cag - !> contact-foreign-0+!>(`foreign`[[now.bowl con-sun] %want]) -:: -++ 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 - %- 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) - :: 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 (contact:to-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-response-0+!>([%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 - !> cag - !> contact-foreign-0+!>(`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+!>([%page ~sun ~])) - ;< ~ b - %+ ex-cards caz - :~ (ex-fact ~[/v1/news] contact-response-0+!>([%page ~sun con-sun ~])) - == - :: ~sun contact page is edited - :: - =/ con-mod=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Bright Sun' avatar+look/'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 (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 - :: - ;< ~ 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-response-0+!>([%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 - !> cag - !> 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 ,~) - =* b bind:m - ^- form:m - ;< caz=(list card) b (do-init %contacts contacts-agent) - ;< =bowl b get-bowl - :: - =/ con-sun=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Sun' bio+text/'It is bright today'] - :: - ;< ~ b (set-src our.bowl) - ;< caz=(list card) b (do-watch /v1/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 (contact:to-0:c con-sun)])) - (ex-fact ~[/v1/news] contact-response-0+!>([%peer ~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 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-foreign-0+!>(`foreign`[[now.bowl con-sun] ~]) -:: -+| %peer -:: +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/b. -:: no update is sent. -:: -++ test-pub-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 (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])) - == - :: ~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 `@da`(add now.bowl tick) con])) - == - :: we update our profile, which advances the timestamp. - :: update is published. - :: - =+ 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 (contact:to-0: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 - :: 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 ~ -:: -:: +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 - %- 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 - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Sun' bio+text/'It is bright today'] - =/ con-mur=contact - %- malt - ^- (list (pair @tas value)) - ~[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:c0 q.cag) - ;< ~ b - %+ ex-equal - !> (~(got by rol) ~sun) - !> [[now.bowl (contact:to-0:c con-sun)] %want] - %+ ex-equal - !> (~(got by rol) ~mur) - !> [[now.bowl (contact:to-0:c con-mur)] %want] -:: -++ 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 - %- 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 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) - =/ cag=cage (need (need peek)) - ?> ?=(%contact-book-0 p.cag) - =/ =book !<(book q.cag) - ;< ~ b - %+ ex-equal - !> mod:(~(got by book) id+0v1) - !> con-1 - %+ ex-equal - !> 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 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) - ;< ~ 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 ,~) - =* b bind:m - ^- form:m - ;< caz=(list card) b (do-init %contacts contacts-agent) - ;< =bowl b get-bowl - :: - =/ con-sun=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Sun' bio+text/'It is bright today'] - =/ con-mur=contact - %- malt - ^- (list (pair @tas value)) - ~[nickname+text/'Mur' bio+text/'Murky waters'] - =/ con-mod=contact - %- malt - ^- (list (pair @tas value)) - ~[avatar+look/'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+!>([%page ~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-0 p.cag) - =/ dir !<(directory q.cag) - ;< ~ b - %+ ex-equal - !> (~(got by dir) ~sun) - !> (contact-uni:c con-sun con-mod) - %+ 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 ~m30)] - == - ;< caz=(list card) b - %+ do-arvo /retry/(scot %p ~sun) - [%behn %wake ~] - %+ ex-cards caz - :~ %^ ex-task /contact - [~sun %contacts] - [%watch /v1/contact] - == --- diff --git a/desk/tests/app/reel.hoon b/desk/tests/app/reel.hoon deleted file mode 100644 index ee7808db..00000000 --- a/desk/tests/app/reel.hoon +++ /dev/null @@ -1,120 +0,0 @@ -/- r=reel -/+ *test-agent -/= reel-agent /app/reel -|% -++ dap %reel-test -++ vic 'https://tlon.network/lure/' -++ civ ~loshut-lonreg -++ token '~bus/reel-test' -+$ reel-state - $: %4 - vic=@t - civ=ship - our-metadata=(map token:r metadata:r) - open-link-requests=(set (pair ship cord)) - open-describes=(set token:r) - stable-id=(map cord token:r) - == -++ test-reel-describe - %- eval-mare - =/ m (mare ,~) - ;< * bind:m (do-init dap reel-agent) - ;< * bind:m (jab-bowl |=(b=bowl b(our ~dev, src ~dev, now *@da))) - =/ =metadata:r [%test (my ['inviter' '~dev'] ['group' '~bus/reel-test'] ~)] - =/ describe [token metadata] - ;< caz=(list card) bind:m (do-poke %reel-describe !>(describe)) - ;< bw=bowl bind:m get-bowl - =/ nonce (scot %da now.bw) - =/ edited-md [%test (~(put by fields.metadata) 'bite-type' '2')] - :: make sure we're sending a describe request to the bait provider - ;< * bind:m - %+ ex-cards caz - =/ request [nonce edited-md] - ~[(ex-poke /describe [civ %bait] bait-describe+!>(request))] - ;< state=vase bind:m get-save - =+ !<(reel-state state) - :: ensure link metadata added to our state and has bite-type field - ;< * bind:m (ex-equal !>(our-metadata) !>((my [nonce edited-md] ~))) - :: ensure nonce is added to open-describes set - ;< * bind:m (ex-equal !>(open-describes) !>((sy [nonce] ~))) - :: ensure stable-id has an entry for the token - ;< * bind:m (ex-equal !>(stable-id) !>((my [token nonce] ~))) - :: simulate the bait provider returning the new metadata - ;< bw=bowl bind:m get-bowl - =/ real-token (shax (jam [dap eny.bw])) - ;< * bind:m (jab-bowl |=(b=bowl b(src civ))) - ;< * bind:m (do-poke %reel-confirmation !>([nonce real-token])) - ;< state=vase bind:m get-save - =+ !<(reel-state state) - ;< * bind:m (ex-equal !>(open-describes) !>(~)) - ;< * bind:m (ex-equal !>(stable-id) !>((sy [token real-token] ~))) - (ex-equal !>(our-metadata) !>((my [real-token edited-md] ~))) -:: -:: testing old way of distributing links from requester side -++ test-reel-token-link-requester - %- eval-mare - =/ m (mare ,~) - ;< * bind:m (do-init dap reel-agent) - ;< * bind:m (jab-bowl |=(b=bowl b(our ~dev, src ~dev, now *@da))) - ;< bw=bowl bind:m get-bowl - =/ request-path /token-link/(scot %p ~bus)/[dap] - :: simulate subscription from frontend for link - ;< caz=(list card) bind:m - (do-watch request-path) - =/ next (add now.bw ~h1) - =/ expire=wire /expire/(scot %p ~bus)/[dap] - ;< * bind:m - %+ ex-cards caz - =/ =cage reel-want-token-link+!>(dap) - :~ (ex-poke request-path [~bus dap] cage) - (ex-arvo expire %b %wait next) - == - ;< state=vase bind:m get-save - =+ !<(reel-state state) - =/ new-requests (sy [~bus dap] ~) - :: ensure that the request is in the open-link-requests set - ;< * bind:m (ex-equal !>(open-link-requests) !>(new-requests)) - ;< * bind:m (jab-bowl |=(b=bowl b(now next))) - ;< bw=bowl bind:m get-bowl - :: simulate link request expiring - ;< * bind:m (do-arvo expire %behn %wake ~) - ;< state=vase bind:m get-save - =+ !<(reel-state state) - :: make sure the request is removed from the open-link-requests set - ;< * bind:m (ex-equal !>(open-link-requests) !>(~)) - :: try to get the link again, but this time not expiring - ;< * bind:m (do-watch request-path) - =/ url (cat 3 vic '~bus/reel-test') - =/ response `[dap url] - ;< * bind:m (jab-bowl |=(b=bowl b(src ~bus))) - ;< caz=(list card) bind:m (do-poke %reel-give-token-link !>(response)) - %+ ex-cards caz - ~[(ex-fact ~[request-path] %json !>(s+url))] -:: -:: testing old way of distributing links from dispenser side -++ test-reel-token-link-dispenser - %- eval-mare - =/ m (mare ,~) - ;< * bind:m (do-init dap reel-agent) - ;< * bind:m (jab-bowl |=(b=bowl b(our ~bus, src ~bus))) - :: build state for link - =/ fields=(map cord cord) (my ['inviter' '~zod'] ~) - =/ init-state=vase - !> - :* %4 - vic - civ - (my [token %meta fields] ~) - ~ - ~ - (my [token token] ~) - == - ;< * bind:m (do-load reel-agent `init-state) - ;< * bind:m (jab-bowl |=(b=bowl b(src ~zod))) - :: simulate link request - ;< caz=(list card) bind:m (do-poke %reel-want-token-link !>(token)) - %+ ex-cards caz - =/ url (cat 3 vic '~bus/reel-test') - =/ =cage reel-give-token-link+!>(`[token url]) - ~[(ex-poke /token-link-want/[token] [~zod dap] cage)] --- \ No newline at end of file diff --git a/desk/tests/lib/contacts-json-1.hoon b/desk/tests/lib/contacts-json-1.hoon deleted file mode 100644 index 2c9766e3..00000000 --- a/desk/tests/lib/contacts-json-1.hoon +++ /dev/null @@ -1,252 +0,0 @@ -/- *contacts, g=groups -/+ *test -/+ c=contacts, j=contacts-json-1, mark-warmer -:: -/= c0 /mar/contact-0 -/= c1 /mar/contact -/~ mar * /mar/contact -:: -|% -:: -++ ex-equal - |= [a=vase b=vase] - (expect-eq b a) -:: -++ enjs-equal - |= [jon=json txt=@t] - %+ ex-equal - !> (en:json:html jon) - !> txt -:: -++ dejs-equal - |* [saf=$-(json *) txt=@t data=*] - %+ ex-equal - !> (saf (need (de:json:html txt))) - !> data -:: -++ test-ship - ;: weld - %+ enjs-equal - (ship:enjs:j ~sampel-palnet) - '"~sampel-palnet"' - :: - %^ dejs-equal ship:dejs:j - '"~sampel-palnet"' - ~sampel-palnet - == -++ test-cid - ;: weld - %+ enjs-equal - (cid:enjs:j 0v11abc) - '"0v11abc"' - :: - %^ dejs-equal cid:dejs:j - '"0v11abc"' - 0v11abc - == -++ test-kip - ;: weld - %+ enjs-equal - (kip:enjs:j ~sampel-palnet) - '"~sampel-palnet"' - :: - %+ enjs-equal - (kip:enjs:j id+0v11abc) - '"0v11abc"' - :: - %^ dejs-equal kip:dejs:j - '"~sampel-palnet"' - ~sampel-palnet - :: - %^ dejs-equal kip:dejs:j - '"0v11abc"' - id+0v11abc - == -++ test-value - ;: weld - :: submit null value to delete entry in contacts - :: - %^ dejs-equal value:dejs:j - 'null' - ~ - :: - %+ enjs-equal - (value:enjs:j text+'the lazy fox') - '{"type":"text","value":"the lazy fox"}' - :: - %^ dejs-equal value:dejs:j - '{"type":"text","value":"the lazy fox"}' - text+'the lazy fox' - :: - %+ enjs-equal - (value:enjs:j numb+42) - '{"type":"numb","value":42}' - :: - %^ dejs-equal value:dejs:j - '{"type":"numb","value":42}' - numb+42 - :: - %+ enjs-equal - (value:enjs:j date+~2024.9.11) - '{"type":"date","value":"~2024.9.11"}' - :: - %^ dejs-equal value:dejs:j - '{"type":"date","value":"~2024.9.11"}' - date+~2024.9.11 - :: - %+ enjs-equal - (value:enjs:j tint+0xcafe.babe) - '{"type":"tint","value":"cafe.babe"}' - :: - %^ dejs-equal value:dejs:j - '{"type":"tint","value":"cafe.babe"}' - tint+0xcafe.babe - :: - %+ enjs-equal - (value:enjs:j ship+~sampel-palnet) - '{"type":"ship","value":"~sampel-palnet"}' - :: - %^ dejs-equal value:dejs:j - '{"type":"ship","value":"~sampel-palnet"}' - ship+~sampel-palnet - :: - %+ enjs-equal - (value:enjs:j look+'https://ship.io/avatar.png') - '{"type":"look","value":"https://ship.io/avatar.png"}' - :: - %^ dejs-equal value:dejs:j - '{"type":"look","value":"https://ship.io/avatar.png"}' - look+'https://ship.io/avatar.png' - :: - %+ enjs-equal - (value:enjs:j flag+[~sampel-palnet %circle]) - '{"type":"flag","value":"~sampel-palnet/circle"}' - :: - %^ dejs-equal value:dejs:j - '{"type":"flag","value":"~sampel-palnet/circle"}' - flag+[~sampel-palnet %circle] - :: - %+ enjs-equal - %- value:enjs:j - 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"}]}' - :: - %^ dejs-equal value:dejs:j - '{"type":"set","value":[{"type":"flag","value":"~sampel-palnet/circle"},{"type":"flag","value":"~sampel-pardux/square"}]}' - set+(silt `(list value)`~[flag/[~sampel-palnet %circle] flag/[~sampel-pardux %square]]) - == -++ test-contact - ;: weld - %+ enjs-equal - %- contact:enjs:j - %- malt - ^- (list [@tas value]) - :~ name+text/'Sampel' - surname+text/'Palnet' - == - '{"name":{"type":"text","value":"Sampel"},"surname":{"type":"text","value":"Palnet"}}' - :: - %^ dejs-equal contact:dejs:j - '{"name":{"type":"text","value":"Sampel"},"surname":{"type":"text","value":"Palnet"}}' - ^- contact:c - %- malt - ^- (list [@tas value]) - :~ name+text/'Sampel' - surname+text/'Palnet' - == - == -++ test-action - =/ con=contact:c - %- malt - ^- (list [@tas value]) - :~ name+text/'Sampel' - == - =/ mod=contact:c - %- malt - ^- (list [@tas value]) - :~ surname+text/'Palnet' - == - :: - ;: weld - %^ dejs-equal action:dejs:j - '{"anon":null}' - [%anon ~] - :: - %^ dejs-equal action:dejs:j - '{"self":{"name":{"type":"text","value":"Sampel"}}}' - [%self con] - :: - %^ dejs-equal action:dejs:j - '{"page":{"kip":"0v1","contact":{"surname":{"type":"text","value":"Palnet"}}}}' - [%page id+0v1 mod] - :: - %^ dejs-equal action:dejs:j - '{"page":{"kip":"~sampel-palnet","contact":{"surname":{"type":"text","value":"Palnet"}}}}' - [%page ~sampel-palnet mod] - :: - %^ dejs-equal action:dejs:j - '{"wipe":["0v1", "0v2", "~sampel-palnet"]}' - [%wipe id+0v1 id+0v2 ~sampel-palnet ~] - :: - %^ dejs-equal action:dejs:j - '{"meet":["~sampel-palnet", "~master-botnet"]}' - [%meet ~sampel-palnet ~master-botnet ~] - :: - %^ dejs-equal action:dejs:j - '{"drop":["~sampel-palnet", "~master-botnet"]}' - [%drop ~sampel-palnet ~master-botnet ~] - :: - %^ dejs-equal action:dejs:j - '{"snub":["~sampel-palnet", "~master-botnet"]}' - [%snub ~sampel-palnet ~master-botnet ~] - == -++ test-response - =/ con=contact:c - %- malt - ^- (list [@tas value]) - :~ name+text/'Sampel' - == - =/ mod=contact:c - %- malt - ^- (list [@tas value]) - :~ surname+text/'Palnet' - == - ;: weld - %+ enjs-equal - (response:enjs:j [%self con]) - '{"self":{"contact":{"name":{"type":"text","value":"Sampel"}}}}' - :: - %+ enjs-equal - (response:enjs:j [%page id+0v1 con mod]) - ^~ %- en:json:html %- need %- de:json:html - ''' - { - "page": { - "mod":{"surname":{"type":"text","value":"Palnet"}}, - "kip":"0v1", - "contact":{"name":{"type":"text","value":"Sampel"}} - } - } - ''' - :: - %+ enjs-equal - (response:enjs:j [%wipe id+0v1]) - '{"wipe":{"kip":"0v1"}}' - :: - %+ enjs-equal - (response:enjs:j [%wipe ~sampel-palnet]) - '{"wipe":{"kip":"~sampel-palnet"}}' - :: - %+ enjs-equal - (response:enjs:j [%peer ~sampel-palnet con]) - ^~ %- en:json:html %- need %- de:json:html - ''' - { - "peer": { - "who":"~sampel-palnet", - "contact":{"name":{"type":"text","value":"Sampel"}} - } - } - ''' - == ---