From 5491ecb0fcfe5c297ac0a8be755316d04521ee94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miko=C5=82aj=20Paraniak?= Date: Tue, 5 Nov 2024 23:49:25 +0800 Subject: [PATCH] desk: migrate Tlon infrastructure from %landscape The following agents are proprietary, and thus belong in the %groups desk: %bait, %bark, %contacts, %genuine, %growl, %reel and %settings. --- desk/app/bait.hoon | 224 +++++ desk/app/bark.hoon | 142 +++ desk/app/chat.hoon | 4 +- desk/app/contacts.hoon | 741 +++++++++++++++ desk/app/genuine.hoon | 95 ++ desk/app/groups.hoon | 10 +- desk/app/growl.hoon | 136 +++ desk/app/profile.hoon | 6 +- desk/app/profile/widgets.hoon | 12 +- desk/app/reel.hoon | 317 +++++++ desk/app/settings.hoon | 227 +++++ desk/app/storage.hoon | 222 +++++ desk/desk.bill | 3 +- 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/lib/storage-json.hoon | 62 ++ 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 | 14 + 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/reel/bite.hoon | 12 + desk/mar/reel/reel/command.hoon | 19 + desk/mar/reel/reel/confirmation.hoon | 12 + desk/mar/reel/reel/describe.hoon | 14 + desk/mar/reel/reel/description.hoon | 13 + desk/mar/reel/reel/give-token-link.hoon | 11 + desk/mar/reel/reel/metadata.hoon | 15 + desk/mar/reel/reel/undescribe.hoon | 14 + desk/mar/reel/reel/want-token-link.hoon | 11 + desk/mar/settings/data.hoon | 13 + desk/mar/settings/event.hoon | 16 + desk/mar/storage/action.hoon | 13 + desk/mar/storage/update.hoon | 14 + desk/sur/contacts-0.hoon | 75 ++ desk/sur/contacts.hoon | 191 ++-- desk/sur/settings.hoon | 44 + desk/sur/storage-0.hoon | 27 + desk/sur/storage-1.hoon | 29 + desk/sur/storage-2.hoon | 42 + desk/sur/storage.hoon | 52 ++ 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 ++++++ 70 files changed, 5644 insertions(+), 96 deletions(-) create mode 100644 desk/app/bait.hoon create mode 100644 desk/app/bark.hoon create mode 100644 desk/app/contacts.hoon create mode 100644 desk/app/genuine.hoon create mode 100644 desk/app/growl.hoon create mode 100644 desk/app/reel.hoon create mode 100644 desk/app/settings.hoon create mode 100644 desk/app/storage.hoon create mode 100644 desk/lib/contacts.hoon create mode 100644 desk/lib/contacts/json-0.hoon create mode 100644 desk/lib/contacts/json-1.hoon create mode 100644 desk/lib/reel.hoon create mode 100644 desk/lib/settings.hoon create mode 100644 desk/lib/storage-json.hoon create mode 100644 desk/mar/bait/describe.hoon create mode 100644 desk/mar/bait/undescribe.hoon create mode 100644 desk/mar/bark/add-recipient.hoon create mode 100644 desk/mar/bark/receive-summary.hoon create mode 100644 desk/mar/bark/remove-recipient.hoon create mode 100644 desk/mar/contact-0.hoon create mode 100644 desk/mar/contact-1.hoon create mode 100644 desk/mar/contact.hoon create mode 100644 desk/mar/contact/action-0.hoon create mode 100644 desk/mar/contact/action-1.hoon create mode 100644 desk/mar/contact/action.hoon create mode 100644 desk/mar/contact/book-0.hoon create mode 100644 desk/mar/contact/book.hoon create mode 100644 desk/mar/contact/directory-0.hoon create mode 100644 desk/mar/contact/directory.hoon create mode 100644 desk/mar/contact/news.hoon create mode 100644 desk/mar/contact/page-0.hoon create mode 100644 desk/mar/contact/page-1.hoon create mode 100644 desk/mar/contact/page.hoon create mode 100644 desk/mar/contact/response-0.hoon create mode 100644 desk/mar/contact/rolodex.hoon create mode 100644 desk/mar/contact/update-0.hoon create mode 100644 desk/mar/contact/update-1.hoon create mode 100644 desk/mar/contact/update.hoon create mode 100644 desk/mar/growl/summarize.hoon create mode 100644 desk/mar/reel/bait.hoon create mode 100644 desk/mar/reel/reel/bite.hoon create mode 100644 desk/mar/reel/reel/command.hoon create mode 100644 desk/mar/reel/reel/confirmation.hoon create mode 100644 desk/mar/reel/reel/describe.hoon create mode 100644 desk/mar/reel/reel/description.hoon create mode 100644 desk/mar/reel/reel/give-token-link.hoon create mode 100644 desk/mar/reel/reel/metadata.hoon create mode 100644 desk/mar/reel/reel/undescribe.hoon create mode 100644 desk/mar/reel/reel/want-token-link.hoon create mode 100644 desk/mar/settings/data.hoon create mode 100644 desk/mar/settings/event.hoon create mode 100644 desk/mar/storage/action.hoon create mode 100644 desk/mar/storage/update.hoon create mode 100644 desk/sur/contacts-0.hoon create mode 100644 desk/sur/settings.hoon create mode 100644 desk/sur/storage-0.hoon create mode 100644 desk/sur/storage-1.hoon create mode 100644 desk/sur/storage-2.hoon create mode 100644 desk/sur/storage.hoon create mode 100644 desk/ted/reel/set-ship.hoon create mode 100644 desk/tests/app/bait.hoon create mode 100644 desk/tests/app/contacts.hoon create mode 100644 desk/tests/app/reel.hoon create mode 100644 desk/tests/lib/contacts-json-1.hoon diff --git a/desk/app/bait.hoon b/desk/app/bait.hoon new file mode 100644 index 0000000000..08f7ae70e7 --- /dev/null +++ b/desk/app/bait.hoon @@ -0,0 +1,224 @@ +/- 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 new file mode 100644 index 0000000000..bdebea427b --- /dev/null +++ b/desk/app/bark.hoon @@ -0,0 +1,142 @@ +:: 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/chat.hoon b/desk/app/chat.hoon index db609efccc..c1e045dab6 100644 --- a/desk/app/chat.hoon +++ b/desk/app/chat.hoon @@ -1,7 +1,7 @@ /- c=chat, d=channels, g=groups, u=ui, e=epic, old=chat-2, activity /- meta /- ha=hark -/- contacts +/- contacts-0 /+ default-agent, verb-lib=verb, dbug, neg=negotiate /+ pac=dm /+ utils=channel-utils @@ -1750,7 +1750,7 @@ |= =diff:dm:c =? net.dm &(?=(%inviting net.dm) !from-self) %done =/ =wire /contacts/(scot %p ship) - =/ =cage [act:mar:contacts !>(`action:contacts`[%heed ~[ship]])] + =/ =cage contact-action+!>(`action-0:contacts-0`[%heed ~[ship]]) =. cor (emit %pass wire %agent [our.bowl %contacts] %poke cage) =/ old-unread di-unread =/ had=(unit [=time =writ:c]) diff --git a/desk/app/contacts.hoon b/desk/app/contacts.hoon new file mode 100644 index 0000000000..1d1f7df7ec --- /dev/null +++ b/desk/app/contacts.hoon @@ -0,0 +1,741 @@ +/+ 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 new file mode 100644 index 0000000000..9671140872 --- /dev/null +++ b/desk/app/genuine.hoon @@ -0,0 +1,95 @@ +/+ 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/groups.hoon b/desk/app/groups.hoon index 6d91854ceb..67a87bcff3 100644 --- a/desk/app/groups.hoon +++ b/desk/app/groups.hoon @@ -3,8 +3,8 @@ :: note: all subscriptions are handled by the subscriber library so :: we can have resubscribe loop protection. :: -/- g=groups, zero=groups-0, ha=hark, h=heap, d=channels, c=chat, tac=contacts, - activity +/- g=groups, zero=groups-0, ha=hark, h=heap, d=channels, c=chat, + tac=contacts-0, activity /- meta /- e=epic /+ default-agent, verb, dbug @@ -758,10 +758,10 @@ cor :: %fact - =+ !<(=update:tac q.cage.sign) - ?~ con.update cor + =+ !<(=update-0:tac q.cage.sign) + ?~ con.update-0 cor %- emil - %+ turn ~(tap in groups.con.update) + %+ turn ~(tap in groups.con.update-0) |= =flag:g [%pass /gangs/(scot %p p.flag)/[q.flag]/preview %agent [p.flag dap.bowl] %watch /groups/(scot %p p.flag)/[q.flag]/preview] == diff --git a/desk/app/growl.hoon b/desk/app/growl.hoon new file mode 100644 index 0000000000..0c00fc1499 --- /dev/null +++ b/desk/app/growl.hoon @@ -0,0 +1,136 @@ +/- 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/profile.hoon b/desk/app/profile.hoon index b555c9b039..49ab4f398f 100644 --- a/desk/app/profile.hoon +++ b/desk/app/profile.hoon @@ -5,7 +5,7 @@ :: other apps can poke this agent with widgets of their own, and the user :: can choose which widgets to display on their public page. :: -/- contacts +/- contacts-0 /+ dbug, verb, sigil, hutils=http-utils /= stock-widgets /app/profile/widgets :: @@ -175,8 +175,8 @@ :: ++ render-page ^- manx - =/ ours=(unit contact:contacts) - (get-contact:contacts bowl our.bowl) + =/ ours=(unit contact-0:contacts-0) + (get-contact:contacts-0 bowl our.bowl) |^ ;html ;+ head ;+ body diff --git a/desk/app/profile/widgets.hoon b/desk/app/profile/widgets.hoon index 49f670f10c..3ef0e9d035 100644 --- a/desk/app/profile/widgets.hoon +++ b/desk/app/profile/widgets.hoon @@ -1,20 +1,20 @@ :: profile: construct stock widgets :: -/- contacts +/- contacts-0 /+ sigil :: |= =bowl:gall -=/ ours=(unit contact:contacts) - =, contacts +=/ ours=(unit contact-0:contacts-0) + =, contacts-0 ::NOTE we scry for the full rolodex, because we are not guaranteed to :: have an entry for ourselves, and contacts doesn't expose a "safe" :: (as in crashless) endpoint for checking =+ .^ =rolodex /gx/(scot %p our.bowl)/contacts/(scot %da now.bowl)/all/contact-rolodex == - =/ =foreign (~(gut by rolodex) our.bowl *foreign) - ?: ?=([[@ ^] *] foreign) - `con.for.foreign + =/ =foreign-0 (~(gut by rolodex) our.bowl *foreign-0) + ?: ?=([[@ ^] *] foreign-0) + `con.for.foreign-0 ~ |^ %- ~(gas by *(map term [%0 @t %marl marl])) :~ [%profile %0 'Profile Header' %marl profile-widget] diff --git a/desk/app/reel.hoon b/desk/app/reel.hoon new file mode 100644 index 0000000000..c9deba6c79 --- /dev/null +++ b/desk/app/reel.hoon @@ -0,0 +1,317 @@ +/- 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 new file mode 100644 index 0000000000..84d56d67ad --- /dev/null +++ b/desk/app/settings.hoon @@ -0,0 +1,227 @@ +/- *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/app/storage.hoon b/desk/app/storage.hoon new file mode 100644 index 0000000000..dd246516a1 --- /dev/null +++ b/desk/app/storage.hoon @@ -0,0 +1,222 @@ +:: storage: +:: +:: stores s3 keys for uploading and sharing images and objects +:: +/- *storage +/+ storage-json, default-agent, verb, dbug +~% %s3-top ..part ~ +|% ++$ card card:agent:gall ++$ versioned-state + $% state-zero + state-one + state-two + state-three + == +:: ++$ state-zero [%0 =credentials:zero:past =configuration:zero:past] ++$ state-one [%1 =credentials:one:past =configuration:one:past] ++$ state-two [%2 =credentials:two:past =configuration:two:past] ++$ state-three [%3 =credentials =configuration] +-- +:: +=| state-three +=* state - +:: +%- agent:dbug +%+ verb | +^- agent:gall +~% %s3-agent-core ..card ~ +|_ =bowl:gall ++* this . + def ~(. (default-agent this %|) 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 + |= =vase + |^ + =/ old ((soft versioned-state) q.vase) + ?~ old on-init + =/ old u.old + |- + ?- -.old + %3 `this(state old) + %2 $(old (state-2-to-3 old)) + %1 $(old (state-1-to-2 old)) + %0 $(old (state-0-to-1 old)) + == + ++ state-0-to-1 + |= zer=state-zero + ^- state-one + :* %1 + credentials.zer + (configuration-0-to-1 configuration.zer) + == + :: + ++ configuration-0-to-1 + |= conf=configuration:zero:past + ^- configuration:one:past + :* buckets.conf + current-bucket.conf + '' + == + :: + ++ state-1-to-2 + |= one=state-one + ^- state-two + :* %2 + credentials.one + (configuration-1-to-2 configuration.one) + == + :: + ++ configuration-1-to-2 + |= conf=configuration:one:past + ^- configuration:two:past + :* buckets.conf + current-bucket.conf + region.conf + '' + %credentials + == + ++ state-2-to-3 + |= two=state-two + ^- state-three + :* %3 + credentials.two + (configuration-2-to-3 configuration.two) + == + ++ configuration-2-to-3 + |= conf=configuration:two:past + ^- ^configuration + :* buckets.conf + current-bucket.conf + region.conf + presigned-url.conf + service.conf + '' + == + -- +:: +++ on-poke + ~/ %s3-poke + |= [=mark =vase] + ^- (quip card _this) + |^ + ?> (team:title our.bowl src.bowl) + =^ cards state + ?+ mark (on-poke:def mark vase) + %storage-action + (poke-action !<(action vase)) + :: + :: XX: deprecated; migration code + %noun + ?> ?=(%migrate !<(%migrate vase)) + =/ bas /(scot %p our.bowl)/s3-store/(scot %da now.bowl) + :- ~ + ?. .^(? %gu (weld bas /$)) + state + =: + credentials + =/ ful .^(update %gx (weld bas /credentials/noun)) + ?+ -.ful (on-poke:def mark vase) + %credentials +.ful + == + :: + configuration + =/ ful .^(update %gx (weld bas /configuration/noun)) + ?+ -.ful (on-poke:def mark vase) + %configuration +.ful + == == + state + == + [cards this] + :: + ++ poke-action + |= act=action + ^- (quip card _state) + :- [%give %fact [/all]~ %storage-update !>(act)]~ + ?- -.act + %set-endpoint + state(endpoint.credentials endpoint.act) + :: + %set-access-key-id + state(access-key-id.credentials access-key-id.act) + :: + %set-secret-access-key + state(secret-access-key.credentials secret-access-key.act) + :: + %set-region + state(region.configuration region.act) + :: + %set-public-url-base + state(public-url-base.configuration public-url-base.act) + :: + %set-current-bucket + %_ state + current-bucket.configuration bucket.act + buckets.configuration (~(put in buckets.configuration) bucket.act) + == + :: + %add-bucket + state(buckets.configuration (~(put in buckets.configuration) bucket.act)) + :: + %remove-bucket + state(buckets.configuration (~(del in buckets.configuration) bucket.act)) + :: + %set-presigned-url + state(presigned-url.configuration url.act) + :: + %toggle-service + state(service.configuration service.act) + == + -- +:: +++ on-watch + ~/ %s3-watch + |= =path + ^- (quip card _this) + |^ + ?> (team:title our.bowl src.bowl) + =/ cards=(list card) + ?+ path (on-watch:def path) + [%all ~] + :~ (give %storage-update !>([%credentials credentials])) + (give %storage-update !>([%configuration configuration])) + == + == + [cards this] + :: + ++ give + |= =cage + ^- card + [%give %fact ~ cage] + -- +:: +++ on-leave on-leave:def +++ on-peek + ~/ %s3-peek + |= =path + ^- (unit (unit cage)) + ?. (team:title our.bowl src.bowl) ~ + ?+ path [~ ~] + [%x %credentials ~] + [~ ~ %storage-update !>(`update`[%credentials credentials])] + :: + [%x %configuration ~] + [~ ~ %storage-update !>(`update`[%configuration configuration])] + == +++ on-agent on-agent:def +++ on-arvo on-arvo:def +++ on-fail on-fail:def +-- diff --git a/desk/desk.bill b/desk/desk.bill index 6e12fa326c..d589195032 100644 --- a/desk/desk.bill +++ b/desk/desk.bill @@ -1,4 +1,5 @@ -:~ %groups +:~ %contacts + %groups %chat %heap %diary diff --git a/desk/lib/contacts.hoon b/desk/lib/contacts.hoon new file mode 100644 index 0000000000..853b619104 --- /dev/null +++ b/desk/lib/contacts.hoon @@ -0,0 +1,478 @@ +/- *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 new file mode 100644 index 0000000000..aa1abaf92f --- /dev/null +++ b/desk/lib/contacts/json-0.hoon @@ -0,0 +1,135 @@ +/- 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 new file mode 100644 index 0000000000..a65fc33c78 --- /dev/null +++ b/desk/lib/contacts/json-1.hoon @@ -0,0 +1,151 @@ +/- 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 new file mode 100644 index 0000000000..e6738cecef --- /dev/null +++ b/desk/lib/reel.hoon @@ -0,0 +1,20 @@ +/- 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 new file mode 100644 index 0000000000..b2f7cff7ad --- /dev/null +++ b/desk/lib/settings.hoon @@ -0,0 +1,147 @@ +/- *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/lib/storage-json.hoon b/desk/lib/storage-json.hoon new file mode 100644 index 0000000000..53115caba3 --- /dev/null +++ b/desk/lib/storage-json.hoon @@ -0,0 +1,62 @@ +/- *storage +|% +++ json-to-action + |= =json + ^- action + =, format + |^ (parse-json json) + ++ parse-json + %- of:dejs + :~ [%set-endpoint so:dejs] + [%set-access-key-id so:dejs] + [%set-secret-access-key so:dejs] + [%set-region so:dejs] + [%set-public-url-base so:dejs] + [%add-bucket so:dejs] + [%remove-bucket so:dejs] + [%set-current-bucket so:dejs] + [%set-presigned-url so:dejs] + [%toggle-service (su:dejs (perk %presigned-url %credentials ~))] + == + -- +:: +++ update-to-json + |= upd=update + ^- json + =, format + %+ frond:enjs %storage-update + %- pairs:enjs + :~ ?- -.upd + %set-current-bucket [%'setCurrentBucket' s+bucket.upd] + %add-bucket [%'addBucket' s+bucket.upd] + %set-region [%'setRegion' s+region.upd] + %set-public-url-base [%'setPublicUrlBase' s+public-url-base.upd] + %remove-bucket [%'removeBucket' s+bucket.upd] + %set-endpoint [%'setEndpoint' s+endpoint.upd] + %set-access-key-id [%'setAccessKeyId' s+access-key-id.upd] + %set-presigned-url [%'setPresignedUrl' s+url.upd] + %toggle-service [%'toggleService' s+service.upd] + %set-secret-access-key + [%'setSecretAccessKey' s+secret-access-key.upd] + :: + %credentials + :- %credentials + %- pairs:enjs + :~ [%endpoint s+endpoint.credentials.upd] + [%'accessKeyId' s+access-key-id.credentials.upd] + [%'secretAccessKey' s+secret-access-key.credentials.upd] + == + :: + %configuration + :- %configuration + %- pairs:enjs + :~ [%buckets a+(turn ~(tap in buckets.configuration.upd) |=(a=@t s+a))] + [%'currentBucket' s+current-bucket.configuration.upd] + [%'region' s+region.configuration.upd] + [%'publicUrlBase' s+public-url-base.configuration.upd] + [%'service' s+service.configuration.upd] + [%'presignedUrl' s+presigned-url.configuration.upd] + == + == + == +-- diff --git a/desk/mar/bait/describe.hoon b/desk/mar/bait/describe.hoon new file mode 100644 index 0000000000..f45b1af44e --- /dev/null +++ b/desk/mar/bait/describe.hoon @@ -0,0 +1,12 @@ +/- 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 new file mode 100644 index 0000000000..2c8d56194d --- /dev/null +++ b/desk/mar/bait/undescribe.hoon @@ -0,0 +1,11 @@ +|_ 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 new file mode 100644 index 0000000000..54a0b22428 --- /dev/null +++ b/desk/mar/bark/add-recipient.hoon @@ -0,0 +1,11 @@ +|_ 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 new file mode 100644 index 0000000000..293b0af657 --- /dev/null +++ b/desk/mar/bark/receive-summary.hoon @@ -0,0 +1,20 @@ +=> |% + +$ 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 new file mode 100644 index 0000000000..54a0b22428 --- /dev/null +++ b/desk/mar/bark/remove-recipient.hoon @@ -0,0 +1,11 @@ +|_ rec=ship +++ grad %noun +++ grab + |% + ++ noun ship + -- +++ grow + |% + ++ noun rec + -- +-- diff --git a/desk/mar/contact-0.hoon b/desk/mar/contact-0.hoon new file mode 100644 index 0000000000..4e355e84c4 --- /dev/null +++ b/desk/mar/contact-0.hoon @@ -0,0 +1,14 @@ +/- 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 new file mode 100644 index 0000000000..e75a43d4d2 --- /dev/null +++ b/desk/mar/contact-1.hoon @@ -0,0 +1,16 @@ +/+ 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 new file mode 100644 index 0000000000..aa4bd1cbf5 --- /dev/null +++ b/desk/mar/contact.hoon @@ -0,0 +1,3 @@ +/= contact-0 /mar/contact-0 +contact-0 + diff --git a/desk/mar/contact/action-0.hoon b/desk/mar/contact/action-0.hoon new file mode 100644 index 0000000000..fdcd700bf7 --- /dev/null +++ b/desk/mar/contact/action-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts, legacy=contacts-0 +/+ j=contacts-json-0 +|_ action=action-0:legacy +++ grad %noun +++ grow + |% + ++ noun 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 new file mode 100644 index 0000000000..45257928fc --- /dev/null +++ b/desk/mar/contact/action-1.hoon @@ -0,0 +1,14 @@ +/- 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 new file mode 100644 index 0000000000..f602042343 --- /dev/null +++ b/desk/mar/contact/action.hoon @@ -0,0 +1,2 @@ +/= mark /mar/contact/action-0 +mark diff --git a/desk/mar/contact/book-0.hoon b/desk/mar/contact/book-0.hoon new file mode 100644 index 0000000000..2de84aaef2 --- /dev/null +++ b/desk/mar/contact/book-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ book=book:c +++ grad %noun +++ grow + |% + ++ noun book + ++ json (book:enjs:j book) + -- +++ grab + |% + ++ noun book:c + -- +-- diff --git a/desk/mar/contact/book.hoon b/desk/mar/contact/book.hoon new file mode 100644 index 0000000000..2de84aaef2 --- /dev/null +++ b/desk/mar/contact/book.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ book=book:c +++ grad %noun +++ grow + |% + ++ noun book + ++ json (book:enjs:j book) + -- +++ grab + |% + ++ noun book:c + -- +-- diff --git a/desk/mar/contact/directory-0.hoon b/desk/mar/contact/directory-0.hoon new file mode 100644 index 0000000000..b7c399c1b7 --- /dev/null +++ b/desk/mar/contact/directory-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ dir=directory:c +++ grad %noun +++ grow + |% + ++ noun dir + ++ json (directory:enjs:j dir) + -- +++ grab + |% + ++ noun directory:c + -- +-- diff --git a/desk/mar/contact/directory.hoon b/desk/mar/contact/directory.hoon new file mode 100644 index 0000000000..b7c399c1b7 --- /dev/null +++ b/desk/mar/contact/directory.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ dir=directory:c +++ grad %noun +++ grow + |% + ++ noun dir + ++ json (directory:enjs:j dir) + -- +++ grab + |% + ++ noun directory:c + -- +-- diff --git a/desk/mar/contact/news.hoon b/desk/mar/contact/news.hoon new file mode 100644 index 0000000000..19f3bb3d5e --- /dev/null +++ b/desk/mar/contact/news.hoon @@ -0,0 +1,14 @@ +/- 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 new file mode 100644 index 0000000000..ca628447ad --- /dev/null +++ b/desk/mar/contact/page-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =page:c +++ grad %noun +++ grow + |% + ++ noun page + ++ json (page:enjs:j page) + -- +++ grab + |% + ++ noun page:c + -- +-- diff --git a/desk/mar/contact/page-1.hoon b/desk/mar/contact/page-1.hoon new file mode 100644 index 0000000000..ca628447ad --- /dev/null +++ b/desk/mar/contact/page-1.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =page:c +++ grad %noun +++ grow + |% + ++ noun page + ++ json (page:enjs:j page) + -- +++ grab + |% + ++ noun page:c + -- +-- diff --git a/desk/mar/contact/page.hoon b/desk/mar/contact/page.hoon new file mode 100644 index 0000000000..ca628447ad --- /dev/null +++ b/desk/mar/contact/page.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =page:c +++ grad %noun +++ grow + |% + ++ noun page + ++ json (page:enjs:j page) + -- +++ grab + |% + ++ noun page:c + -- +-- diff --git a/desk/mar/contact/response-0.hoon b/desk/mar/contact/response-0.hoon new file mode 100644 index 0000000000..92c2968987 --- /dev/null +++ b/desk/mar/contact/response-0.hoon @@ -0,0 +1,14 @@ +/- c=contacts +/+ j=contacts-json-1 +|_ =response:c +++ grad %noun +++ grow + |% + ++ noun response + ++ json (response:enjs:j response) + -- +++ grab + |% + ++ noun response:c + -- +-- diff --git a/desk/mar/contact/rolodex.hoon b/desk/mar/contact/rolodex.hoon new file mode 100644 index 0000000000..4992264b63 --- /dev/null +++ b/desk/mar/contact/rolodex.hoon @@ -0,0 +1,14 @@ +/- 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 new file mode 100644 index 0000000000..519391bdd3 --- /dev/null +++ b/desk/mar/contact/update-0.hoon @@ -0,0 +1,12 @@ +/- 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 new file mode 100644 index 0000000000..f5d9fc52e5 --- /dev/null +++ b/desk/mar/contact/update-1.hoon @@ -0,0 +1,12 @@ +/- 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 new file mode 100644 index 0000000000..f143c73b24 --- /dev/null +++ b/desk/mar/contact/update.hoon @@ -0,0 +1,2 @@ +/= mark /mar/contact/update-0 +mark diff --git a/desk/mar/growl/summarize.hoon b/desk/mar/growl/summarize.hoon new file mode 100644 index 0000000000..62769894a5 --- /dev/null +++ b/desk/mar/growl/summarize.hoon @@ -0,0 +1,11 @@ +|_ requested=time +++ grad %noun +++ grab + |% + ++ noun time + -- +++ grow + |% + ++ noun requested + -- +-- diff --git a/desk/mar/reel/bait.hoon b/desk/mar/reel/bait.hoon new file mode 100644 index 0000000000..1b0b5e5288 --- /dev/null +++ b/desk/mar/reel/bait.hoon @@ -0,0 +1,18 @@ +/- 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/reel/bite.hoon b/desk/mar/reel/reel/bite.hoon new file mode 100644 index 0000000000..54d2c56bb1 --- /dev/null +++ b/desk/mar/reel/reel/bite.hoon @@ -0,0 +1,12 @@ +/- reel +|_ =bite:reel +++ grad %noun +++ grab + |% + ++ noun bite:reel + -- +++ grow + |% + ++ noun bite + -- +-- diff --git a/desk/mar/reel/reel/command.hoon b/desk/mar/reel/reel/command.hoon new file mode 100644 index 0000000000..139d3ffa57 --- /dev/null +++ b/desk/mar/reel/reel/command.hoon @@ -0,0 +1,19 @@ +/- 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/reel/confirmation.hoon b/desk/mar/reel/reel/confirmation.hoon new file mode 100644 index 0000000000..891aac88c6 --- /dev/null +++ b/desk/mar/reel/reel/confirmation.hoon @@ -0,0 +1,12 @@ +/- reel +|_ =confirmation:reel +++ grad %noun +++ grab + |% + ++ noun confirmation:reel + -- +++ grow + |% + ++ noun confirmation + -- +-- diff --git a/desk/mar/reel/reel/describe.hoon b/desk/mar/reel/reel/describe.hoon new file mode 100644 index 0000000000..4c180aa796 --- /dev/null +++ b/desk/mar/reel/reel/describe.hoon @@ -0,0 +1,14 @@ +/- 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/reel/description.hoon b/desk/mar/reel/reel/description.hoon new file mode 100644 index 0000000000..4479d4783c --- /dev/null +++ b/desk/mar/reel/reel/description.hoon @@ -0,0 +1,13 @@ +|_ description=cord +++ grad %noun +++ grab + |% + ++ noun cord + ++ json so:dejs:format + -- +++ grow + |% + ++ noun description + ++ json [%s description] + -- +-- diff --git a/desk/mar/reel/reel/give-token-link.hoon b/desk/mar/reel/reel/give-token-link.hoon new file mode 100644 index 0000000000..e982d175c2 --- /dev/null +++ b/desk/mar/reel/reel/give-token-link.hoon @@ -0,0 +1,11 @@ +|_ 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/reel/metadata.hoon b/desk/mar/reel/reel/metadata.hoon new file mode 100644 index 0000000000..179842b952 --- /dev/null +++ b/desk/mar/reel/reel/metadata.hoon @@ -0,0 +1,15 @@ +/- 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/reel/undescribe.hoon b/desk/mar/reel/reel/undescribe.hoon new file mode 100644 index 0000000000..4787ac0032 --- /dev/null +++ b/desk/mar/reel/reel/undescribe.hoon @@ -0,0 +1,14 @@ +/- 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/reel/want-token-link.hoon b/desk/mar/reel/reel/want-token-link.hoon new file mode 100644 index 0000000000..2c8d56194d --- /dev/null +++ b/desk/mar/reel/reel/want-token-link.hoon @@ -0,0 +1,11 @@ +|_ token=cord +++ grad %noun +++ grab + |% + ++ noun cord + -- +++ grow + |% + ++ noun token + -- +-- diff --git a/desk/mar/settings/data.hoon b/desk/mar/settings/data.hoon new file mode 100644 index 0000000000..a58b017ef3 --- /dev/null +++ b/desk/mar/settings/data.hoon @@ -0,0 +1,13 @@ +/+ *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 new file mode 100644 index 0000000000..7f03b3139c --- /dev/null +++ b/desk/mar/settings/event.hoon @@ -0,0 +1,16 @@ +/+ *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/mar/storage/action.hoon b/desk/mar/storage/action.hoon new file mode 100644 index 0000000000..5304998d8e --- /dev/null +++ b/desk/mar/storage/action.hoon @@ -0,0 +1,13 @@ +/+ *storage-json +|_ act=action +++ grad %noun +++ grow + |% + ++ noun act + -- +++ grab + |% + ++ noun action + ++ json json-to-action + -- +-- diff --git a/desk/mar/storage/update.hoon b/desk/mar/storage/update.hoon new file mode 100644 index 0000000000..83499034f3 --- /dev/null +++ b/desk/mar/storage/update.hoon @@ -0,0 +1,14 @@ +/+ *storage-json +|_ upd=update +++ grad %noun +++ grow + |% + ++ noun upd + ++ json (update-to-json upd) + -- +:: +++ grab + |% + ++ noun update + -- +-- diff --git a/desk/sur/contacts-0.hoon b/desk/sur/contacts-0.hoon new file mode 100644 index 0000000000..91ba0d3342 --- /dev/null +++ b/desk/sur/contacts-0.hoon @@ -0,0 +1,75 @@ +/- 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)] +:: +++ get-contact + |= [=bowl:gall who=@p] + => :_ ..get-contact + [who=who our=our.bowl now=now.bowl] + ~+ ^- (unit contact-0) + =/ base=path /(scot %p our)/contacts/(scot %da now) + ?. ~+ .^(? %gu (weld base /$)) + ~ + =+ ~+ .^(rol=rolodex %gx (weld base /all/contact-rolodex)) + ?~ for=(~(get by rol) who) + ~ + ?. ?=([[@ ^] *] u.for) + ~ + `con.for.u.for +-- diff --git a/desk/sur/contacts.hoon b/desk/sur/contacts.hoon index bfdc750174..414ad3c517 100644 --- a/desk/sur/contacts.hoon +++ b/desk/sur/contacts.hoon @@ -1,104 +1,137 @@ /- e=epic, g=groups |% -:: [compat] protocol-versioning scheme :: -:: adopted from :groups, slightly modified. ++| %compat :: -:: for our action/update marks, we -:: - *must* support our version (+okay) -:: - *should* support previous versions (especially actions) -:: - but *can't* support future versions +++ okay `epic`1 :: -:: in the case of updates at unsupported protocol versions, -:: we backoff and subscribe for version changes (/epic). -:: (this alone is unlikely to help with future versions, -:: but perhaps our peer will downgrade. in the meantime, -:: we wait to be upgraded.) ++| %types +:: $value-type: contact field value type :: -+| %compat -++ okay `epic`0 -++ mar - |% - ++ base - |% - +$ act %contact-action - +$ upd %contact-update - -- - :: - ++ act `mark`^~((rap 3 *act:base '-' (scot %ud okay) ~)) - ++ upd `mark`^~((rap 3 *upd:base '-' (scot %ud okay) ~)) - -- ++$ value-type + $? %text + %numb + %date + %tint + %ship + %look + %flag + %set + == +:: $value: contact field value :: -+| %types -+$ contact - $: nickname=@t - bio=@t - status=@t - color=@ux - avatar=(unit @t) - cover=(unit @t) - groups=(set flag:g) ++$ 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)] -+$ profile [wen=@da con=$@(~ contact)] -+$ rolodex (map ship foreign) ++$ 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 - %fail :: %want failed - %lost :: epic %fail - ~ :: none intended - == - saga:e -:: -+$ field - $% [%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] + $? %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: 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)] + [%self p=contact] + [%page p=kip q=contact] + [%edit p=kip q=contact] + [%wipe p=(list kip)] [%meet p=(list ship)] - [%heed p=(list ship)] [%drop p=(list ship)] [%snub p=(list ship)] == +:: network update +:: +:: %full: our profile :: -+$ update :: network ++$ update $% [%full profile] == +:: $response: local update :: -+$ news :: local - [who=ship con=$@(~ contact)] -:: -++ get-contact - |= [=bowl:gall who=@p] - => :_ ..get-contact - [who=who our=our.bowl now=now.bowl] - ~+ ^- (unit contact) - =/ base=path /(scot %p our)/contacts/(scot %da now) - ?. ~+ .^(? %gu (weld base /$)) - ~ - =+ ~+ .^(rol=rolodex %gx (weld base /all/contact-rolodex)) - ?~ for=(~(get by rol) who) - ~ - ?. ?=([[@ ^] *] u.for) - ~ - `con.for.u.for +:: %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/settings.hoon b/desk/sur/settings.hoon new file mode 100644 index 0000000000..9ba9683092 --- /dev/null +++ b/desk/sur/settings.hoon @@ -0,0 +1,44 @@ +/+ *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/sur/storage-0.hoon b/desk/sur/storage-0.hoon new file mode 100644 index 0000000000..4f0ca04cb7 --- /dev/null +++ b/desk/sur/storage-0.hoon @@ -0,0 +1,27 @@ +|% ++$ credentials + $: endpoint=@t + access-key-id=@t + secret-access-key=@t + == +:: ++$ configuration + $: buckets=(set @t) + current-bucket=@t + == +:: ++$ action + $% [%set-endpoint endpoint=@t] + [%set-access-key-id access-key-id=@t] + [%set-secret-access-key secret-access-key=@t] + [%add-bucket bucket=@t] + [%remove-bucket bucket=@t] + [%set-current-bucket bucket=@t] + == +:: ++$ update + $% [%credentials =credentials] + [%configuration =configuration] + action + == +-- diff --git a/desk/sur/storage-1.hoon b/desk/sur/storage-1.hoon new file mode 100644 index 0000000000..c2a6175a77 --- /dev/null +++ b/desk/sur/storage-1.hoon @@ -0,0 +1,29 @@ +|% ++$ credentials + $: endpoint=@t + access-key-id=@t + secret-access-key=@t + == +:: ++$ configuration + $: buckets=(set @t) + current-bucket=@t + region=@t + == +:: ++$ action + $% [%set-endpoint endpoint=@t] + [%set-access-key-id access-key-id=@t] + [%set-secret-access-key secret-access-key=@t] + [%add-bucket bucket=@t] + [%remove-bucket bucket=@t] + [%set-current-bucket bucket=@t] + [%set-region region=@t] + == +:: ++$ update + $% [%credentials =credentials] + [%configuration =configuration] + action + == +-- diff --git a/desk/sur/storage-2.hoon b/desk/sur/storage-2.hoon new file mode 100644 index 0000000000..9e75d027fe --- /dev/null +++ b/desk/sur/storage-2.hoon @@ -0,0 +1,42 @@ +|% ++$ service ?(%presigned-url %credentials) ++$ credentials + $: endpoint=@t + access-key-id=@t + secret-access-key=@t + == +:: +:: $configuration: the upload configuration +:: +:: $buckets: the buckets available +:: $current-bucket: the current bucket we use to upload +:: $region: the region of the current bucket +:: $presigned-url: the presigned url endpoint +:: $service: whether to use a presigned url service or direct S3 uploads +:: ++$ configuration + $: buckets=(set @t) + current-bucket=@t + region=@t + presigned-url=@t + =service + == +:: ++$ action + $% [%set-endpoint endpoint=@t] + [%set-access-key-id access-key-id=@t] + [%set-secret-access-key secret-access-key=@t] + [%add-bucket bucket=@t] + [%remove-bucket bucket=@t] + [%set-current-bucket bucket=@t] + [%set-region region=@t] + [%set-presigned-url url=@t] + [%toggle-service =service] + == +:: ++$ update + $% [%credentials =credentials] + [%configuration =configuration] + action + == +-- diff --git a/desk/sur/storage.hoon b/desk/sur/storage.hoon new file mode 100644 index 0000000000..3808310e67 --- /dev/null +++ b/desk/sur/storage.hoon @@ -0,0 +1,52 @@ +/- zer=storage-0, uno=storage-1, dos=storage-2 +|% +++ past + |% + ++ zero zer + ++ one uno + ++ two dos + -- ++$ service ?(%presigned-url %credentials) ++$ credentials + $: endpoint=@t + access-key-id=@t + secret-access-key=@t + == +:: +:: $configuration: the upload configuration +:: +:: $buckets: the buckets available +:: $current-bucket: the current bucket we use to upload +:: $region: the region of the current bucket +:: $presigned-url: the presigned url endpoint +:: $service: whether to use a presigned url service or direct S3 uploads +:: $public-url-base: URL base to substitute into returned object URLs +:: ++$ configuration + $: buckets=(set @t) + current-bucket=@t + region=@t + presigned-url=@t + =service + public-url-base=@t + == +:: ++$ action + $% [%set-endpoint endpoint=@t] + [%set-access-key-id access-key-id=@t] + [%set-secret-access-key secret-access-key=@t] + [%add-bucket bucket=@t] + [%remove-bucket bucket=@t] + [%set-current-bucket bucket=@t] + [%set-region region=@t] + [%set-public-url-base public-url-base=@t] + [%set-presigned-url url=@t] + [%toggle-service =service] + == +:: ++$ update + $% [%credentials =credentials] + [%configuration =configuration] + action + == +-- diff --git a/desk/ted/reel/set-ship.hoon b/desk/ted/reel/set-ship.hoon new file mode 100644 index 0000000000..9e71150158 --- /dev/null +++ b/desk/ted/reel/set-ship.hoon @@ -0,0 +1,18 @@ +/- 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 new file mode 100644 index 0000000000..e1bc3c3a90 --- /dev/null +++ b/desk/tests/app/bait.hoon @@ -0,0 +1,165 @@ +/- 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 new file mode 100644 index 0000000000..a43542156c --- /dev/null +++ b/desk/tests/app/contacts.hoon @@ -0,0 +1,1093 @@ +/- *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 new file mode 100644 index 0000000000..ee7808db49 --- /dev/null +++ b/desk/tests/app/reel.hoon @@ -0,0 +1,120 @@ +/- 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 new file mode 100644 index 0000000000..2c9766e367 --- /dev/null +++ b/desk/tests/lib/contacts-json-1.hoon @@ -0,0 +1,252 @@ +/- *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"}} + } + } + ''' + == +--