ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-11-24 10:33:22 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into release/next-vere

Browse Source 
* master: (390 commits)
  glob: update to 0v4.fpa4r.s6dtc.h8tps.62jv0.qn0fj
  notifications: prevent safari shrinkage
  glob: update to 0v5.91i1u.1g535.t3de3.6c3ih.fanmv
  Sidebar: loosen property access
  launch: loosen property access in unread count
  notifications: fix scroll to load
  glob: update to 0v1.pak02.pfla3.gh56f.qhc6h.3h881
  inbox: fix graph resource redirects
  inbox: fix link routing and rendering
  glob: update to 0v4.3fbh4.p7j6i.2pi9g.d1ltq.5u7uu
  hark-fe: fix crash
  hark: update graph marks for editable comments
  graph-store: change atom to %1 for all migrated comments
  glob: update to 0v5.67obv.15auf.c2rc7.jpcu2.iain3
  inbox: correct notification order
  inbox: redirect invites correctly
  publish: Restore basic 'add writers' form
  interface: show currently editing comment as pending
  landscape: preclude dropdown duplicates on exact match
  interface: links and publish comments both work
  ...
This commit is contained in:
Joe Bryan 2020-11-20 13:16:53 -08:00
commit 7723ba2da8
270 changed files with 9361 additions and 8992 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
pkg/arvo/app/chat-cli.hoon
View File

@ -10,7 +10,7 @@
:: and trust it to take care of the rest.
::
/- view=chat-view, hook=chat-hook, *group,
*permission-store, *group-store, *invite-store,
*permission-store, *group-store, inv=invite-store,
sole
/+ shoe, default-agent, verb, dbug, store=chat-store,
group-store, grpl=group, resource
@ -27,7 +27,7 @@
+$ state-2
$: %2
grams=(list mail) :: all messages
known=(set [target serial]) :: known message lookup
known=(set [target serial:store]) :: known message lookup
count=@ud :: (lent grams)
bound=(map target glyph) :: bound circle glyphs
binds=(jug glyph target) :: circle glyph lookup
@ -54,7 +54,7 @@
::
+$ state-0
$: grams=(list [[=ship =path] envelope:store]) :: all messages
known=(set [[=ship =path] serial]) :: known message lookup
known=(set [[=ship =path] serial:store]) :: known message lookup
count=@ud :: (lent grams)
bound=(map [=ship =path] glyph) :: bound circle glyphs
binds=(jug glyph [=ship =path]) :: circle glyph lookup
@ -161,7 +161,7 @@
%fact
?+ p.cage.sign ~|([%chat-cli-bad-sub-mark wire p.cage.sign] !!)
%chat-update (diff-chat-update:tc wire !<(update:store q.cage.sign))
%invite-update (handle-invite-update:tc !<(invite-update q.cage.sign))
%invite-update (handle-invite-update:tc !<(update:inv q.cage.sign))
==
==
[cards this]
@ -224,9 +224,9 @@
grams ~ ::NOTE this only impacts historic message lookup in chat-cli
::
known
^- (set [target serial])
^- (set [target serial:store])
%- ~(run in known.u.old)
|= [t=[ship path] s=serial]
|= [t=[ship path] s=serial:store]
[`target`[| t] s]
::
bound
@ -324,7 +324,7 @@
:: +handle-invite-update: get new invites
::
++ handle-invite-update
|= upd=invite-update
|= upd=update:inv
^- (quip card _state)
?+ -.upd [~ state]
%invite [[(show-invite:sh-out invite.upd) ~] state]
@ -534,10 +534,10 @@
:: ;~(pfix ace ;~(plug i.opt $(opt t.opt)))
:: --
::
++ group ;~((glue net) ship sym)
++ group ;~((glue fas) ship sym)
++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib
++ ship ;~(pfix sig fed:ag)
++ path ;~(pfix net ;~(plug urs:ab (easy ~))) ::NOTE short only, tmp
++ path ;~(pfix fas ;~(plug urs:ab (easy ~))) ::NOTE short only, tmp
:: +mang: un/managed indicator prefix
::
:: deprecated, as sig prefix is no longer used
@ -619,7 +619,7 @@
++ letter
;~ pose
(stag %url turl)
(stag %me ;~(pfix vat text))
(stag %me ;~(pfix pat text))
(stag %text ;~(less mic hax text))
==
:: +turl: url parser
@ -722,12 +722,11 @@
%poke
%invite-action
::
!>
^- invite-action
:^ %invite /chat
!> ^- action:inv
:^ %invite %chat
(shax (jam [our-self where] who))
^- invite
[our-self %chat-hook where who '']
^- invite:inv
[our-self %chat-hook (de-path:resource where) who '']
==
:: +set-target: set audience, update prompt
::
@ -865,7 +864,7 @@
|= =letter:store
^- (quip card _state)
~! bowl
=/ =serial (shaf %msg-uid eny.bowl)
=/ =serial:store (shaf %msg-uid eny.bowl)
:_ state
^- (list card)
%+ turn ~(tap in audience)
@ -1132,11 +1131,9 @@
:: +show-invite: print incoming invite notification
::
++ show-invite
|= invite
|= invite:inv
^- card
%- note
%+ weld "invited to: "
~(phat tr (path-to-target path))
(note "invited to: {(scow %p entity.resource)} {(trip name.resource)}")
--
::
:: +tr: render targets

31
pkg/arvo/app/chat-hook.hoon
View File

@ -2,7 +2,7 @@
:: mirror chat data from foreign to local based on read permissions
:: allow sending chat messages to foreign paths based on write perms
::
/- *permission-store, *invite-store, *metadata-store,
/- *permission-store, inv=invite-store, *metadata-store,
*permission-hook, *group-store, *permission-group-hook, ::TMP for upgrade
hook=chat-hook,
view=chat-view,
@ -52,7 +52,7 @@
+$ poke
$% [%chat-action action:store]
[%permission-action permission-action]
[%invite-action invite-action]
[%invite-action action:inv]
[%chat-view-action action:view]
==
::
@ -77,7 +77,7 @@
++ on-init
^- (quip card _this)
:_ this(invite-created %.y)
:~ (invite-poke:cc [%create /chat])
:~ (invite-poke:cc [%create %chat])
[%pass /invites %agent [our.bol %invite-store] %watch /invitatory/chat]
watch-groups:cc
==
@ -406,7 +406,7 @@
::
%invite-update
=^ cards state
(fact-invite-update:cc wire !<(invite-update q.cage.sign))
(fact-invite-update:cc wire !<(update:inv q.cage.sign))
[cards this]
::
%group-update
@ -719,15 +719,18 @@
==
::
++ fact-invite-update
|= [wir=wire fact=invite-update]
|= [wir=wire fact=update:inv]
^- (quip card _state)
:_ state
?+ -.fact ~
%accepted
=/ ask-history ?~((chat-scry path.invite.fact) %.y %.n)
=* shp ship.invite.fact
=* app-path path.invite.fact
~[(chat-view-poke [%join shp app-path ask-history])]
=* resource resource.invite.fact
=/ =path [(scot %p entity.resource) name.resource ~]
:_ ~
%- chat-view-poke
:^ %join ship.invite.fact
path
?=(~ (chat-scry path))
==
::
++ fact-group-update
@ -919,9 +922,9 @@
[%pass / %agent [our.bol %chat-view] %poke %chat-view-action !>(act)]
::
++ invite-poke
|= act=invite-action
|= =action:inv
^- card
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(act)]
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(action)]
::
++ sec-to-perm
|= [pax=path =kind]
@ -936,9 +939,9 @@
[%mailbox pax]
::
++ invite-scry
|= uid=serial
^- (unit invite)
%^ scry (unit invite)
|= uid=serial:inv
^- (unit invite:inv)
%^ scry (unit invite:inv)
%invite-store
/invite/chat/(scot %uv uid)
::

15
pkg/arvo/app/chat-view.hoon
View File

@ -6,7 +6,7 @@
/- *permission-store,
*permission-hook,
*group,
*invite-store,
inv=invite-store,
*metadata-store,
group-hook,
*permission-group-hook,
@ -220,8 +220,7 @@
~& %chat-already-exists
~
%- zing
:~ (create-chat app-path.act allow-history.act)
%- create-group
:~ %- create-group
:* group-path.act
app-path.act
policy.act
@ -231,6 +230,7 @@
managed.act
==
(create-metadata title.act description.act group-path.act app-path.act)
(create-chat app-path.act allow-history.act)
==
::
%delete
@ -407,13 +407,14 @@
^- card
=/ managed=?
!=(ship+app-path group-path)
=/ =invite
=/ =invite:inv
:* our.bol
?:(managed %contact-hook %chat-hook)
?:(managed group-path app-path)
(de-path:resource ?:(managed group-path ship+app-path))
ship ''
==
=/ act=invite-action [%invite ?:(managed /contacts /chat) (shaf %msg-uid eny.bol) invite]
=/ act=action:inv
[%invite ?:(managed %contacts %chat) (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
::
++ chat-scry
@ -487,8 +488,8 @@
(en-path:resource rid)
?> ?=(^ path)
:~ (group-pull-hook-poke %add ship rid)
(chat-hook-poke %add-synced ship t.path ask-history)
(metadata-hook-poke %add-synced ship path)
(chat-hook-poke %add-synced ship t.path ask-history)
==
::
++ diff-chat-update

16
pkg/arvo/app/contact-hook.hoon
View File

@ -4,7 +4,7 @@
/- group-hook,
*contact-hook,
*contact-view,
*invite-store,
inv=invite-store,
*metadata-hook,
*metadata-store,
*group
@ -44,7 +44,7 @@
++ on-init
^- (quip card _this)
:_ this(invite-created %.y)
:~ (invite-poke:cc [%create /contacts])
:~ (invite-poke:cc [%create %contacts])
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]
[%pass /group %agent [our.bol %group-store] %watch /groups]
==
@ -467,20 +467,10 @@
(contact-poke [%delete path])
(contact-poke [%remove path ship])
==
::
++ send-invite-poke
|= [=path =ship]
^- card
=/ =invite
:* our.bol %contact-hook
path ship ''
==
=/ act=invite-action [%invite /contacts (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
--
::
++ invite-poke
|= act=invite-action
|= act=action:inv
^- card
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(act)]
::

21
pkg/arvo/app/contact-view.hoon
View File

@ -5,7 +5,7 @@
::
/-
group-hook,
*invite-store,
inv=invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
@ -161,27 +161,22 @@
%+ turn
~(tap in pending.policy.act)
|= =ship
(send-invite our.bol %contacts path ship '')
(send-invite our.bol %contacts rid ship '')
==
::
%join
=/ =path
(en-path:resource resource.act)
=/ =cage
:- %group-update
!> ^- update:group-store
[%add-members resource.act (sy our.bol ~)]
=/ =wire
[%join-group path]
[%join-group (en-path:resource resource.act)]
[%pass wire %agent [entity.resource.act %group-push-hook] %poke cage]~
::
%invite
=* rid resource.act
=/ =path
(en-path:resource rid)
=/ =group
(need (scry-group:grp rid))
:- (send-invite entity.rid %contacts path ship.act text.act)
=/ =group (need (scry-group:grp rid))
:- (send-invite entity.rid %contacts rid ship.act text.act)
?. ?=(%invite -.policy.group) ~
~[(add-pending rid ship.act)]
::
@ -276,12 +271,12 @@
[%pass / %agent [entity.rid app] %poke cage]
::
++ send-invite
|= =invite
|= =invite:inv
^- card
=/ =cage
:- %invite-action
!> ^- invite-action
[%invite /contacts (shaf %invite-uid eny.bol) invite]
!> ^- action:inv
[%invite %contacts (shaf %invite-uid eny.bol) invite]
[%pass / %agent [recipient.invite %invite-hook] %poke cage]
::
++ contact-poke

17
pkg/arvo/app/dojo.hoon
View File

@ -165,7 +165,7 @@
==
==
::
;~ pfix net
;~ pfix fas
;~ pose
(parse-variable (cold %sur hep) ;~(pfix gap parse-cables))
(parse-variable (cold %lib lus) ;~(pfix gap parse-cables))
@ -179,8 +179,8 @@
++ parse-sink
;~ pose
;~(plug (cold %file tar) parse-beam)
;~(plug (cold %flat vat) (most net sym))
;~(plug (cold %pill dot) (most net sym))
;~(plug (cold %flat pat) (most fas sym))
;~(plug (cold %pill dot) (most fas sym))
;~(plug (cold %http lus) (stag %post parse-url))
;~(plug (cold %http hep) (stag %put parse-url))
(stag %show (cook $?($1 $2 $3 $4 $5) (cook lent (stun [1 5] wut))))
@ -218,6 +218,7 @@
;~(plug (cold %ur lus) parse-url)
;~(plug (cold %ge lus) parse-model)
;~(plug (cold %te hep) sym (star ;~(pfix ace parse-source)))
;~(plug (cold %as pam) sym ;~(pfix ace parse-source))
;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source))
parse-value
==
@ -227,7 +228,7 @@
;~ pose
;~ plug
;~(pfix sig fed:ag)
;~(pose ;~(pfix net sym) (easy default-app))
;~(pose ;~(pfix fas sym) (easy default-app))
==
%+ stag our
;~(pose sym (easy default-app))
@ -262,7 +263,7 @@
auri:de-purl:html
::
++ parse-model ;~(plug parse-server parse-config)
++ parse-server (stag 0 (most net sym))
++ parse-server (stag 0 (most fas sym))
++ parse-hoon tall:hoon-parser
::
++ parse-rood
@ -283,10 +284,10 @@
==
++ parse-value
;~ pose
;~(plug (cold %as pad) sym ;~(pfix ace parse-source))
(stag %sa ;~(pfix tar pad sym))
;~(plug (cold %as pam) sym ;~(pfix ace parse-source))
(stag %sa ;~(pfix tar pam sym))
(stag %ex parse-hoon)
(stag %tu (ifix [lac rac] (most ace parse-source)))
(stag %tu (ifix [sel ser] (most ace parse-source)))
==
::
++ parse-config

4
pkg/arvo/app/glob.hoon
View File

@ -5,7 +5,7 @@
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v2.1vtfh.0l23v.30s7f.n57l9.dpjvi
++ hash 0v4.fpa4r.s6dtc.h8tps.62jv0.qn0fj
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0
@ -89,7 +89,7 @@
=+ .^(=map=tube:clay %cc (weld home /map/mime))
=+ .^(arch %cy (weld home /app/landscape/js/bundle))
=/ bundle-hash=@t
%- need
%- need
^- (unit @t)
%- ~(rep by dir)
|= [[file=@t ~] out=(unit @t)]

4
pkg/arvo/app/graph-pull-hook.hoon
View File

@ -20,6 +20,7 @@
+* this .
def ~(. (default-agent this %|) bowl)
dep ~(. (default:pull-hook this config) bowl)
gra ~(. graph bowl)
::
++ on-init on-init:def
++ on-save !>(~)
@ -35,6 +36,7 @@
|= [=resource =tang]
^- (quip card _this)
:_ this
?. (~(has in get-keys:gra) resource) ~
=- [%pass /pull-nack %agent [our.bowl %graph-store] %poke %graph-update -]~
!> ^- update:store
[%0 now.bowl [%archive-graph resource]]
@ -42,7 +44,7 @@
++ on-pull-kick
|= =resource
^- (unit path)
=/ maybe-time (peek-update-log:graph resource)
=/ maybe-time (peek-update-log:gra resource)
?~ maybe-time `/
`/(scot %da u.maybe-time)
--

20
pkg/arvo/app/graph-push-hook.hoon
View File

@ -32,6 +32,22 @@
?| (is-member:grp src.bowl i.group-paths)
(is-admin:grp src.bowl i.group-paths)
==
::
++ is-allowed-remove
|= [=resource:res indices=(set index:store) =bowl:gall]
^- ?
=/ gra ~(. graph bowl)
?. (is-allowed resource bowl %.n)
%.n
%+ levy
~(tap in indices)
|= =index:store
^- ?
=/ =node:store
(got-node:gra resource index)
?| =(author.post.node src.bowl)
(is-allowed resource bowl %.y)
==
--
::
%- agent:dbug
@ -63,7 +79,7 @@
%add-graph (is-allowed resource.q.update bowl %.y)
%remove-graph (is-allowed resource.q.update bowl %.y)
%add-nodes (is-allowed resource.q.update bowl %.n)
%remove-nodes (is-allowed resource.q.update bowl %.y)
%remove-nodes (is-allowed-remove resource.q.update indices.q.update bowl)
%add-signatures (is-allowed resource.uid.q.update bowl %.n)
%remove-signatures (is-allowed resource.uid.q.update bowl %.y)
%archive-graph (is-allowed resource.q.update bowl %.y)
@ -108,6 +124,8 @@
(get-graph:gra resource)
:: resubscribe
::
?~ (get-update-log:gra resource)
(get-graph:gra resource)
=/ =time (slav %da i.path)
=/ =update-log:store (get-update-log-subset:gra resource time)
[%0 now.bowl [%run-updates resource update-log]]

300
pkg/arvo/app/graph-store.hoon
View File

@ -7,14 +7,20 @@
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
state-2
==
::
+$ state-0 [%0 network:store]
+$ state-1 [%1 network:store]
+$ state-2 [%2 network:store]
::
++ orm orm:store
++ orm-log orm-log:store
+$ debug-input [%validate-graph =resource:store]
--
::
=| state-0
=| state-2
=* state -
::
%- agent:dbug
@ -27,9 +33,160 @@
++ on-init [~ this]
++ on-save !>(state)
++ on-load
|= old=vase
|= =old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
=+ !<(old=versioned-state old-vase)
=| cards=(list card)
|^
?- -.old
%0
%_ $
-.old %1
::
validators.old
(~(put in validators.old) %graph-validator-link)
::
cards
%+ weld cards
%+ turn
~(tap in (~(put in validators.old) %graph-validator-link))
|= validator=@t
^- card
=/ =wire /validator/[validator]
=/ =rave:clay [%sing %b [%da now.bowl] /[validator]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
::
graphs.old
%- ~(run by graphs.old)
|= [=graph:store q=(unit mark)]
^- [graph:store (unit mark)]
:- (convert-unix-timestamped-graph graph)
?^ q q
`%graph-validator-link
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:store)
==
::
%1
%_ $
-.old %2
graphs.old (~(run by graphs.old) change-revision-graph)
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:store)
==
::
%2 [cards this(state old)]
==
::
++ change-revision-graph
|= [=graph:store q=(unit mark)]
^- [graph:store (unit mark)]
|^
:_ q
?+ q graph
[~ %graph-validator-link] convert-links
[~ %graph-validator-publish] convert-publish
==
::
++ convert-links
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:: top-level
::
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^atom =node:store]
^- [^^atom node:store]
:: existing comments get turned into containers for revisions
::
:^ atom
post.node(contents ~, hash ~)
%graph
%+ gas:orm *graph:store
:_ ~ :- %1
:_ [%empty ~]
post.node(index (snoc index.post.node atom), hash ~)
::
++ convert-publish
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:: top-level
::
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^atom =node:store]
^- [^^atom node:store]
:: existing container for publish note revisions
::
?+ atom !!
%1 [atom node]
%2
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^^atom =node:store]
^- [^^^atom node:store]
:+ atom post.node(contents ~, hash ~)
:- %graph
%+ gas:orm *graph:store
:_ ~ :- %1
:_ [%empty ~]
post.node(index (snoc index.post.node atom), hash ~)
==
--
::
++ maybe-unix-to-da
|= =atom
^- @
:: (bex 127) is roughly 226AD
?. (lte atom (bex 127))
atom
(add ~1970.1.1 (div (mul ~s1 atom) 1.000))
::
++ convert-unix-timestamped-node
|= =node:store
^- node:store
=. index.post.node
(convert-unix-timestamped-index index.post.node)
?. ?=(%graph -.children.node)
node
:+ post.node
%graph
(convert-unix-timestamped-graph p.children.node)
::
++ convert-unix-timestamped-index
|= =index:store
(turn index maybe-unix-to-da)
::
++ convert-unix-timestamped-graph
|= =graph:store
%+ gas:orm *graph:store
%+ turn
(tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:- (maybe-unix-to-da atom)
(convert-unix-timestamped-node node)
--
::
++ on-watch
~/ %graph-store-watch
@ -60,6 +217,7 @@
=^ cards state
?+ mark (on-poke:def mark vase)
%graph-update (graph-update !<(update:store vase))
%noun (debug !<(debug-input vase))
==
[cards this]
::
@ -68,6 +226,7 @@
^- (quip card _state)
|^
?> ?=(%0 -.update)
=? p.update =(p.update *time) now.bowl
?- -.q.update
%add-graph (add-graph +.q.update)
%remove-graph (remove-graph +.q.update)
@ -86,23 +245,30 @@
==
::
++ add-graph
|= [=resource:store =graph:store mark=(unit mark:store)]
|= $: =resource:store
=graph:store
mark=(unit mark:store)
overwrite=?
==
^- (quip card _state)
?< (~(has by archive) resource)
?< (~(has by graphs) resource)
?> ?| overwrite
?& !(~(has by archive) resource)
!(~(has by graphs) resource)
== ==
?> (validate-graph graph mark)
:_ %_ state
graphs (~(put by graphs) resource [graph mark])
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
archive (~(del by archive) resource)
validators
?~ mark validators
(~(put in validators) u.mark)
==
%- zing
:~ (give [/updates /keys ~] [%add-graph resource graph mark])
:~ (give [/updates /keys ~] [%add-graph resource graph mark overwrite])
?~ mark ~
?: (~(has in validators) u.mark) ~
=/ wire (weld /graph (en-path:res resource))
=/ wire /validator/[u.mark]
=/ =rave:clay [%sing %b [%da now.bowl] /[u.mark]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
@ -395,52 +561,57 @@
^- (quip card _state)
?< (~(has by archive) resource)
?> (~(has by graphs) resource)
:_ state
%+ turn (tap:orm-log update-log)
|= [=time update=logged-update:store]
^- card
?> ?=(%0 -.update)
:* %pass
/run-updates/(scot %da time)
%agent
[our.bowl %graph-store]
%poke
:- %graph-update
!>
^- update:store
?- -.q.update
%add-nodes update(resource.q resource)
%remove-nodes update(resource.q resource)
%add-signatures update(resource.uid.q resource)
%remove-signatures update(resource.uid.q resource)
==
==
::
++ validate-graph
|= [=graph:store mark=(unit mark:store)]
^- ?
?~ mark %.y
?~ graph %.y
=/ =dais:clay
.^ =dais:clay
%cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[u.mark]
=/ updates=(list [=time upd=logged-update:store])
(tap:orm-log update-log)
=| cards=(list card)
|- ^- (quip card _state)
?~ updates
[cards state]
=* update upd.i.updates
=^ crds state
%- graph-update
^- update:store
?- -.q.update
%add-nodes update(resource.q resource)
%remove-nodes update(resource.q resource)
%add-signatures update(resource.uid.q resource)
%remove-signatures update(resource.uid.q resource)
==
%+ roll (tap:orm graph)
|= [[=atom =node:store] out=?]
?& out
=(%& -:(mule |.((vale:dais [atom post.node]))))
?- -.children.node
%empty %.y
%graph ^$(graph p.children.node)
==
==
$(cards (weld cards crds), updates t.updates)
::
++ give
|= [paths=(list path) update=update-0:store]
^- (list card)
[%give %fact paths [%graph-update !>([%0 now.bowl update])]]~
--
::
++ debug
|= =debug-input
^- (quip card _state)
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource.debug-input)
?> (validate-graph graph mark)
[~ state]
::
++ validate-graph
|= [=graph:store mark=(unit mark:store)]
^- ?
?~ mark %.y
?~ graph %.y
=/ =dais:clay
.^ =dais:clay
%cb
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[u.mark]
==
%+ roll (tap:orm graph)
|= [[=atom =node:store] out=?]
?& out
=(%& -:(mule |.((vale:dais [atom post.node]))))
?- -.children.node
%empty %.y
%graph ^$(graph p.children.node)
==
==
--
::
++ on-peek
@ -450,6 +621,14 @@
|^
?> (team:title our.bowl src.bowl)
?+ path (on-peek:def path)
[%x %graph-mark @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result [~ ~]
``noun+!>(q.u.result)
::
[%x %keys ~]
:- ~ :- ~ :- %graph-update
!>(`update:store`[%0 now.bowl [%keys ~(key by graphs)]])
@ -472,7 +651,7 @@
!> ^- update:store
:+ %0
now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result]
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
::
:: note: near-duplicate of /x/graph
::
@ -488,7 +667,7 @@
!> ^- update:store
:+ %0
now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result]
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
::
[%x %graph-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
@ -513,7 +692,7 @@
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ =index:store
(turn t.t.t.t.path |=(=cord (slav %ud cord)))
(turn t.t.t.t.path (cury slav %ud))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
:- ~ :- ~ :- %graph-update
@ -543,7 +722,7 @@
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(subset:orm p.children.u.node start end))
%+ turn (tap:orm `graph:store`(subset:orm p.children.u.node end start))
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
@ -556,7 +735,8 @@
=/ end=(unit time) (slaw %da i.t.t.t.t.t.path)
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
``noun+!>((subset:orm-log u.update-log start end))
:: orm-log is ordered backwards, so swap start and end
``noun+!>((subset:orm-log u.update-log end start))
::
[%x %update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
@ -600,15 +780,15 @@
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ -.sign-arvo (on-arvo:def wire sign-arvo)
%c
?+ wire (on-arvo:def wire sign-arvo)
::
:: old wire, do nothing
[%graph *] [~ this]
::
[%validator @ ~]
:_ this
?> ?=([%graph @ *] wire)
=/ =resource:store (de-path:res t.wire)
=/ gra=(unit marked-graph:store) (~(get by graphs) resource)
?~ gra ~
?~ q.u.gra ~
=/ =rave:clay [%next %b [%da now.bowl] /[u.q.u.gra]]
=* validator i.t.wire
=/ =rave:clay [%next %b [%da now.bowl] /[validator]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
::

214
pkg/arvo/app/hark-chat-hook.hoon Normal file
View File

@ -0,0 +1,214 @@
:: hark-chat-hook: notifications for chat-store [landscape]
::
/- store=hark-store, post, group-store, metadata-store, hook=hark-chat-hook
/+ resource, metadata, default-agent, dbug, chat-store, grpl=group
::
~% %hark-chat-hook-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
::
+$ state-0
$: %0
watching=(set path)
mentions=_&
==
::
--
::
=| state-0
=* state -
::
=>
|_ =bowl:gall
::
++ give
|= [paths=(list path) =update:hook]
^- (list card)
[%give %fact paths hark-chat-hook-update+!>(update)]~
::
++ watch-chat
^- card
[%pass /chat %agent [our.bowl %chat-store] %watch /all]
--
%- agent:dbug
^- agent:gall
~% %hark-chat-hook-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
grp ~(. grpl bowl)
::
++ on-init
:_ this
~[watch-chat:ha]
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
:_ this(state !<(state-0 old))
?: (~(has by wex.bowl) [/chat our.bowl %chat-store])
~
~[watch-chat:ha]
::
++ on-watch
|= =path
^- (quip card _this)
=^ cards state
?+ path (on-watch:def path)
::
[%updates ~]
:_ state
%+ give:ha ~
:* %initial
watching
==
==
[cards this]
::
++ on-poke
~/ %hark-chat-hook-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-chat-hook-action
(hark-chat-hook-action !<(action:hook vase))
==
[cards this]
::
++ hark-chat-hook-action
|= =action:hook
^- (quip card _state)
|^
:- (give:ha ~[/updates] action)
?- -.action
%listen (listen +.action)
%ignore (ignore +.action)
%set-mentions (set-mentions +.action)
==
++ listen
|= chat=path
^+ state
state(watching (~(put in watching) chat))
::
++ ignore
|= chat=path
^+ state
state(watching (~(del in watching) chat))
::
++ set-mentions
|= ment=?
^+ state
state(mentions ment)
--
--
::
++ on-agent
~/ %hark-chat-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
?. ?=([%chat ~] wire)
~
~[watch-chat:ha]
::
%fact
?. ?=(%chat-update p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(chat-update !<(update:chat-store q.cage.sign))
[cards this]
==
::
++ chat-update
|= =update:chat-store
^- (quip card _state)
?+ -.update `state
%initial (process-initial +.update)
%create (process-new +.update)
::
%message
:_ state
(process-envelope path.update envelope.update)
::
%messages
:_ state
%- zing
(turn envelopes.update (cury process-envelope path.update))
==
++ process-initial
|= =inbox:chat-store
^- (quip card _state)
=/ keys=(list path)
~(tap in ~(key by inbox))
=| cards=(list card)
|-
?~ keys
[cards state]
=* path i.keys
=^ cs state
(process-new path)
$(cards (weld cards cs), keys t.keys)
::
++ process-new
|= chat=path
^- (quip card _state)
=/ groups=(list path)
(groups-from-resource:met %chat chat)
?~ groups
`state
?: (is-managed-path:grp i.groups)
`state
`state(watching (~(put in watching) chat))
::
++ is-mention
|= =envelope:chat-store
?. ?=(%text -.letter.envelope) %.n
?& mentions
?= ^
(find (scow %p our.bowl) (trip text.letter.envelope))
==
::
++ is-notification
|= [=path =envelope:chat-store]
?& (~(has in watching) path)
!=(author.envelope our.bowl)
==
::
++ process-envelope
|= [=path =envelope:chat-store]
^- (list card)
=/ mention=?
(is-mention envelope)
?. ?|(mention (is-notification path envelope))
~
=/ =index:store
[%chat path mention]
=/ =contents:store
[%chat ~[envelope]]
~[(poke-store %add index when.envelope %.n contents)]
::
++ poke-store
|= =action:store
^- card
=- [%pass /store %agent [our.bowl %hark-store] %poke -]
hark-action+!>(action)
--
::
++ on-peek on-peek:def
::
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

267
pkg/arvo/app/hark-graph-hook.hoon Normal file
View File

@ -0,0 +1,267 @@
:: hark-graph-hook: notifications for graph-store [landscape]
::
/- store=hark-store, post, group-store, metadata-store, hook=hark-graph-hook
/+ resource, metadata, default-agent, dbug, graph-store
::
~% %hark-graph-hook-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
::
+$ state-0
$: %0
watching=(set [resource index:post])
mentions=_&
watch-on-self=_&
==
::
--
::
=| state-0
=* state -
::
=>
|_ =bowl:gall
::
++ scry
|* [=mold p=path]
?> ?=(^ p)
?> ?=(^ t.p)
.^(mold i.p (scot %p our.bowl) i.t.p (scot %da now.bowl) t.t.p)
::
++ give
|= [paths=(list path) =update:hook]
^- (list card)
[%give %fact paths hark-graph-hook-update+!>(update)]~
::
++ watch-graph
^- card
[%pass /graph %agent [our.bowl %graph-store] %watch /updates]
--
%- agent:dbug
^- agent:gall
~% %hark-graph-hook-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
::
++ on-init
:_ this
~[watch-graph:ha]
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
`this(state !<(state-0 old))
::
++ on-watch
|= =path
^- (quip card _this)
=^ cards state
?+ path (on-watch:def path)
::
[%updates ~]
:_ state
%+ give:ha ~
:* %initial
watching
mentions
watch-on-self
==
==
[cards this]
::
++ on-poke
~/ %hark-graph-hook-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-graph-hook-action
(hark-graph-hook-action !<(action:hook vase))
==
[cards this]
::
++ hark-graph-hook-action
|= =action:hook
^- (quip card _state)
|^
:- (give:ha ~[/updates] action)
?- -.action
%listen (listen +.action)
%ignore (ignore +.action)
%set-mentions (set-mentions +.action)
%set-watch-on-self (set-watch-on-self +.action)
==
++ listen
|= [graph=resource =index:post]
^+ state
state(watching (~(put in watching) [graph index]))
::
++ ignore
|= [graph=resource =index:post]
^+ state
state(watching (~(del in watching) [graph index]))
::
++ set-mentions
|= ment=?
^+ state
state(mentions ment)
::
++ set-watch-on-self
|= self=?
^+ state
state(watch-on-self self)
--
--
::
++ on-agent
~/ %hark-graph-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
?. ?=([%graph ~] wire)
~
~[watch-graph:ha]
::
%fact
?. ?=(%graph-update p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(graph-update !<(update:graph-store q.cage.sign))
[cards this]
==
++ add-graph
|= rid=resource
^- (quip card _state)
?. &(watch-on-self =(our.bowl entity.rid))
[~ state]
`state(watching (~(put in watching) [rid ~]))
::
++ graph-update
|= =update:graph-store
^- (quip card _state)
?: ?=(%add-graph -.q.update)
(add-graph resource.q.update)
?. ?=(%add-nodes -.q.update)
[~ state]
=/ group=resource
(need (group-from-app-resource:met %graph resource.q.update))
=/ =metadata:metadata-store
(need (peek-metadata:met %graph group resource.q.update))
=* rid resource.q.update
=+ %+ scry:ha
,mark=(unit mark)
/gx/graph-store/graph-mark/(scot %p entity.rid)/[name.rid]/noun
=+ %+ scry:ha
,=tube:clay
/cc/[q.byk.bowl]/[(fall mark %graph-validator-link)]/notification-kind
=/ nodes=(list [p=index:graph-store q=node:graph-store])
~(tap by nodes.q.update)
=| cards=(list card)
|^
?~ nodes
[cards state]
=* index p.i.nodes
=* node q.i.nodes
=^ node-cards state
(check-node node tube)
%_ $
nodes t.nodes
cards (weld node-cards cards)
==
::
++ check-node-children
|= [=node:graph-store =tube:clay]
^- (quip card _state)
?: ?=(%empty -.children.node)
[~ state]
=/ children=(list [=atom =node:graph-store])
(tap:orm:graph-store p.children.node)
=| cards=(list card)
|- ^- (quip card _state)
?~ children
[cards state]
=^ new-cards state
(check-node node.i.children tube)
%_ $
cards (weld cards new-cards)
children t.children
==
::
++ check-node
|= [=node:graph-store =tube:clay]
^- (quip card _state)
=^ child-cards state
(check-node-children node tube)
?: =(our.bowl author.post.node)
=^ self-cards state
(self-post node)
:_ state
(weld child-cards self-cards)
=+ !< notif-kind=(unit [name=@t parent-lent=@ud])
(tube !>([0 post.node]))
?~ notif-kind
[child-cards state]
=/ desc=@t
?: (is-mention contents.post.node)
%mention
name.u.notif-kind
=/ parent=index:post
(scag parent-lent.u.notif-kind index.post.node)
?. ?| =(desc %mention)
(~(has in watching) [rid parent])
==
[child-cards state]
=/ notif-index=index:store
[%graph group rid module.metadata desc]
=/ =contents:store
[%graph (limo post.node ~)]
:_ state
%+ snoc child-cards
(add-unread notif-index [time-sent.post.node %.n contents])
::
++ is-mention
|= contents=(list content:post)
^- ?
?. mentions %.n
?~ contents %.n
?. ?=(%mention -.i.contents)
$(contents t.contents)
?: =(our.bowl ship.i.contents)
%.y
$(contents t.contents)
::
++ self-post
|= =node:graph-store
^- (quip card _state)
?. ?=(%.y watch-on-self)
[~ state]
`state(watching (~(put in watching) [rid index.post.node]))
::
++ add-unread
|= [=index:store =notification:store]
^- card
=- [%pass / %agent [our.bowl %hark-store] %poke -]
hark-action+!>([%add index notification])
::
--
--
::
++ on-peek on-peek:def
::
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

169
pkg/arvo/app/hark-group-hook.hoon Normal file
View File

@ -0,0 +1,169 @@
:: hark-group-hook: notifications for groups [landscape]
::
/- store=hark-store, post, group-store, metadata-store, hook=hark-group-hook
/+ resource, metadata, default-agent, dbug, graph-store
::
~% %hark-group-hook-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
::
+$ state-0
$: %0
watching=(set resource)
==
::
--
::
=| state-0
=* state -
::
=<
%- agent:dbug
^- agent:gall
~% %hark-group-hook-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
::
++ on-init
:_ this
:~ watch-metadata:ha
watch-groups:ha
==
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
`this(state !<(state-0 old))
::
++ on-watch
|= =path
?. ?=([%updates ~] path)
(on-watch:def path)
:_ this
=; =cage
[%give %fact ~ cage]~
:- %hark-group-hook-update
!> ^- update:hook
[%initial watching]
::
++ on-poke
~/ %hark-group-hook-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-group-hook-action
(hark-group-hook-action !<(action:hook vase))
==
[cards this]
::
++ hark-group-hook-action
|= =action:hook
^- (quip card _state)
|^
?- -.action
%listen (listen +.action)
%ignore (ignore +.action)
==
++ listen
|= group=resource
^- (quip card _state)
:- (give %listen group)
state(watching (~(put in watching) group))
::
++ ignore
|= group=resource
^- (quip card _state)
:- (give %ignore group)
state(watching (~(del in watching) group))
::
++ give
|= =update:hook
^- (list card)
[%give %fact ~[/updates] %hark-group-hook-update !>(update)]~
--
--
::
++ on-agent
~/ %hark-group-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
?+ wire ~
[%group ~] ~[watch-groups:ha]
[%metadata ~] ~[watch-metadata:ha]
==
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%group-update
=^ cards state
(group-update !<(update:group-store q.cage.sign))
[cards this]
::
%metadata-update
=^ cards state
(metadata-update !<(metadata-update:metadata-store q.cage.sign))
[cards this]
==
==
::
++ group-update
|= =update:group-store
^- (quip card _state)
?. ?=(?(%add-members %remove-members) -.update)
[~ state]
?. (~(has in watching) resource.update)
[~ state]
=/ =contents:store
[%group ~[update]]
=/ =notification:store [now.bowl %.n contents]
=/ =index:store
[%group resource.update -.update]
:_ state
~[(add-unread index notification)]
:: +metadata-update is stubbed for now, for the following reasons
:: - There's no semantic difference in metadata-store between
:: adding and editing a channel
:: - We have no way of retrieving old metadata to e.g. get a
:: channel's old name when it is renamed
++ metadata-update
|= update=metadata-update:metadata-store
^- (quip card _state)
[~ state]
::
++ add-unread
|= [=index:store =notification:store]
^- card
=- [%pass / %agent [our.bowl %hark-store] %poke -]
hark-action+!>([%add index notification])
--
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
|_ =bowl:gall
+* met ~(. metadata bowl)
::
++ watch-groups
^- card
[%pass /group %agent [our.bowl %group-store] %watch /groups]
::
++ watch-metadata
^- card
[%pass /metadata %agent [our.bowl %metadata-store] %watch /updates]
--

363
pkg/arvo/app/hark-store.hoon Normal file
View File

@ -0,0 +1,363 @@
:: hark-store: notifications [landscape]
::
/- store=hark-store, post, group-store, metadata-store
/+ resource, metadata, default-agent, dbug, graph-store
::
~% %hark-store-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
::
+$ state-0
$: %0
=notifications:store
archive=notifications:store
last-seen=@da
dnd=_|
==
+$ inflated-state
$: state-0
cache
==
:: $cache: useful to have precalculated, but can be derived from state
:: albeit expensively
+$ cache
$: unread-count=@ud
by-index=(jug index:store @da)
~
==
::
++ orm ((ordered-map @da timebox:store) gth)
--
::
=| inflated-state
=* state -
::
=<
%- agent:dbug
^- agent:gall
~% %hark-store-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
::
++ on-init
:_ this
~[autoseen-timer]
::
++ on-save !>(-.state)
++ on-load
|= =old=vase
^- (quip card _this)
=/ old
!<(state-0 old-vase)
=. notifications.old
(gas:orm *notifications:store (tap:orm notifications.old))
=. archive.old
(gas:orm *notifications:store (tap:orm archive.old))
`this(-.state old, +.state (inflate-cache old))
::
++ on-watch
|= =path
^- (quip card _this)
|^
?+ path (on-watch:def path)
::
[%updates ~]
:_ this
[%give %fact ~ hark-update+!>(initial-updates)]~
==
::
++ initial-updates
^- update:store
:- %more
^- (list update:store)
:- unreads
:+ [%set-dnd dnd]
[%count unread-count]
%+ weld
%+ turn
%+ scag 3
(tap-nonempty:ha archive)
(timebox-update &)
%+ turn
%+ scag 3
(tap-nonempty:ha notifications)
(timebox-update |)
::
++ unreads
^- update:store
:- %unreads
^- (list [index:store @ud])
%+ turn
~(tap by by-index)
|=([=index:store =(set @da)] [index ~(wyt in set)])
::
++ timebox-update
|= archived=?
|= [time=@da =timebox:store]
^- update:store
[%timebox time archived ~(tap by timebox)]
--
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
::
[%x %recent ?(%archive %inbox) @ @ ~]
=/ is-archive
=(%archive i.t.t.path)
=/ offset=@ud
(slav %ud i.t.t.t.path)
=/ length=@ud
(slav %ud i.t.t.t.t.path)
:^ ~ ~ %hark-update
!> ^- update:store
:- %more
%+ turn
%+ scag length
%+ slag offset
%- tap-nonempty:ha
?:(is-archive archive notifications)
|= [time=@da =timebox:store]
^- update:store
:^ %timebox time is-archive
~(tap by timebox)
==
::
++ on-poke
~/ %hark-store-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-action (hark-action !<(action:store vase))
==
[cards this]
::
++ hark-action
|= =action:store
^- (quip card _state)
|^
?- -.action
%add (add +.action)
%archive (do-archive +.action)
%seen seen
%read (read +.action)
%read-index (read-index +.action)
%unread (unread +.action)
%set-dnd (set-dnd +.action)
==
++ add
|= [=index:store =notification:store]
^- (quip card _state)
=/ =timebox:store
(gut-orm:ha notifications last-seen)
=/ existing-notif
(~(get by timebox) index)
=/ new=notification:store
?~ existing-notif
notification
(merge-notification:ha u.existing-notif notification)
=/ new-timebox=timebox:store
(~(put by timebox) index new)
:- (give:ha [/updates]~ %added last-seen index new)
%_ state
+ ?~(existing-notif (upd-unreads:ha index last-seen %.n) +.state)
notifications (put:orm notifications last-seen new-timebox)
==
++ read-index
|= =index:store
^- (quip card _state)
=/ times=(list @da)
~(tap in (~(gut by by-index) index ~))
=| cards=(list card)
|-
?~ times
[cards state]
=* time i.times
=^ crds state
(read time index)
$(cards (weld cards crds), times t.times)
::
++ do-archive
|= [time=@da =index:store]
^- (quip card _state)
=/ =timebox:store
(gut-orm:ha notifications time)
=/ =notification:store
(~(got by timebox) index)
=/ new-timebox=timebox:store
(~(del by timebox) index)
:- (give:ha [/updates]~ %archive time index)
%_ state
+ ?.(read.notification (upd-unreads:ha index time %.y) +.state)
::
notifications
(put:orm notifications time new-timebox)
::
archive
%^ jub-orm:ha archive time
|= archive-box=timebox:store
^- timebox:store
(~(put by archive-box) index notification(read %.y))
==
::
++ read
|= [time=@da =index:store]
^- (quip card _state)
:- (give:ha [/updates]~ %read time index)
%_ state
+ (upd-unreads:ha index time %.y)
unread-count (dec unread-count)
notifications (change-read-status:ha time index %.y)
==
::
++ unread
|= [time=@da =index:store]
^- (quip card _state)
:- (give:ha [/updates]~ %unread time index)
%_ state
+ (upd-unreads:ha index time %.n)
unread-count +(unread-count)
notifications (change-read-status:ha time index %.n)
==
::
++ seen
^- (quip card _state)
:_ state(last-seen now.bowl)
:~ cancel-autoseen:ha
autoseen-timer:ha
==
::
++ set-dnd
|= d=?
^- (quip card _state)
:_ state(dnd d)
(give:ha [/updates]~ %set-dnd d)
--
--
::
++ on-agent on-agent:def
::
++ on-leave on-leave:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%autoseen ~] wire)
(on-arvo:def wire sign-arvo)
?> ?=([%b %wake *] sign-arvo)
:_ this(last-seen now.bowl)
~[autoseen-timer:ha]
::
++ on-fail on-fail:def
--
|_ =bowl:gall
+* met ~(. metadata bowl)
::
++ tap-nonempty
|= =notifications:store
^- (list [@da timebox:store])
%+ skip (tap:orm notifications)
|=([@da =timebox:store] =(0 ~(wyt by timebox)))
::
++ merge-notification
|= [existing=notification:store new=notification:store]
^- notification:store
?- -.contents.existing
::
%chat
?> ?=(%chat -.contents.new)
existing(list.contents (weld list.contents.existing list.contents.new))
::
%graph
?> ?=(%graph -.contents.new)
existing(list.contents (weld list.contents.existing list.contents.new))
::
%group
?> ?=(%group -.contents.new)
existing(list.contents (weld list.contents.existing list.contents.new))
==
::
++ change-read-status
|= [time=@da =index:store read=?]
^+ notifications
%^ jub-orm notifications time
|= =timebox:store
%+ ~(jab by timebox) index
|= =notification:store
?> !=(read read.notification)
notification(read read)
:: +key-orm: +key:by for ordered maps
++ key-orm
|= =notifications:store
^- (list @da)
(turn (tap:orm notifications) |=([key=@da =timebox:store] key))
:: +jub-orm: combo +jab/+gut for ordered maps
:: TODO: move to zuse.hoon
++ jub-orm
|= [=notifications:store time=@da fun=$-(timebox:store timebox:store)]
^- notifications:store
=/ =timebox:store
(fun (gut-orm notifications time))
(put:orm notifications time timebox)
:: +gut-orm: +gut:by for ordered maps
:: TODO: move to zuse.hoon
++ gut-orm
|= [=notifications:store time=@da]
^- timebox:store
(fall (get:orm notifications time) ~)
::
++ autoseen-interval ~h3
++ cancel-autoseen
^- card
[%pass /autoseen %arvo %b %rest (add last-seen autoseen-interval)]
::
++ autoseen-timer
^- card
[%pass /autoseen %arvo %b %wait (add now.bowl autoseen-interval)]
::
++ give
|= [paths=(list path) update=update:store]
^- (list card)
[%give %fact paths [%hark-update !>(update)]]~
::
++ upd-unreads
|= [=index:store time=@da read=?]
^+ +.state
%_ +.state
::
by-index
%. [index time]
?: read
~(del ju by-index)
~(put ju by-index)
==
::
++ inflate-cache
|= state-0
^+ +.state
=/ nots=(list [p=@da =timebox:store])
(tap:orm notifications)
|- =* outer $
?~ nots
+.state
=/ unreads ~(tap by timebox.i.nots)
|- =* inner $
?~ unreads
outer(nots t.nots)
=* notification q.i.unreads
=* index p.i.unreads
?: read.notification
inner(unreads t.unreads)
=. +.state
(upd-unreads index p.i.nots %.n)
inner(unreads t.unreads)
--

101
pkg/arvo/app/herm.hoon Normal file
View File

@ -0,0 +1,101 @@
:: herm: stand-in for term.c with http interface
::
/+ default-agent, dbug, verb
=, able:jael
|%
+$ state-0 [%0 ~]
--
::
=| state-0
=* state -
%+ verb |
%- agent:dbug
^- agent:gall
=> |%
++ request-tube
|= [bowl:gall from=mark to=mark next=?]
^- card:agent:gall
:* %pass /tube/[from]/[to]
%arvo %c %warp
our q.byk ~
::
?: next
[%next %c da+now /[from]/[to]]
[%sing %c da+now /[from]/[to]]
==
--
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card:agent:gall _this)
:_ this
:: set up dill session subscription,
:: and ensure the tubes we use are in cache
::
:~ [%pass [%view %$ ~] %arvo %d %view ~]
(request-tube bowl %blit %json |)
(request-tube bowl %json %belt |)
==
::
++ on-save !>([%0 ~])
++ on-load
|= old=vase
^- (quip card:agent:gall _this)
[~ this(state [%0 ~])]
::
++ on-watch
|= =path
^- (quip card:agent:gall _this)
?> ?=([%session @ ~] path)
:_ this
:: scry prompt and cursor position out of dill for initial response
::
=/ base=^path
/dx/(scot %p our.bowl)//(scot %da now.bowl)/sessions
:~ [%give %fact ~ %blit !>(.^(blit:dill (weld base //line)))]
[%give %fact ~ %blit !>(`blit:dill`hop+.^(@ud (weld base //cursor)))]
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall _this)
?+ wire !!
:: pass on dill blits for the session
::
[%view %$ ~]
?. ?=([%d %blit *] sign-arvo)
~| [%unexpected-sign [- +<]:sign-arvo]
!!
:_ this
%+ turn p.sign-arvo
|= =blit:dill
[%give %fact [%session %$ ~]~ %blit !>(blit)]
::
:: ensure the tubes we need remain in cache
::
[%tube @ @ ~]
=* from i.t.wire
=* to i.t.t.wire
?. ?=([%c %writ *] sign-arvo)
~| [%unexpected-sign [- +<]:sign-arvo]
!!
:_ this
[(request-tube bowl from to &)]~
==
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall _this)
?. ?=(%belt mark)
~| [%unexpected-mark mark]
!!
:_ this
[%pass [%belt %$ ~] %arvo %d %belt !<(belt:dill vase)]~
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-fail on-fail:def
--

3
pkg/arvo/app/hood.hoon
View File

@ -2,7 +2,7 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$: %10
$: %11
drum=state:drum
helm=state:helm
kiln=state:kiln
@ -13,6 +13,7 @@
[%7 drum=state:drum helm=state:helm kiln=state:kiln]
[%8 drum=state:drum helm=state:helm kiln=state:kiln]
[%9 drum=state:drum helm=state:helm kiln=state:kiln]
[%10 drum=state:drum helm=state:helm kiln=state:kiln]
==
+$ any-state-tuple
$: drum=any-state:drum

196
pkg/arvo/app/invite-hook.hoon
View File

@ -1,123 +1,121 @@
:: invite-hook [landscape]:
:: invite-hook [landscape]: receive invites from any source
::
:: receive invites from any source
:: only handles %invite actions:
:: - can be poked by the host team to send an invite out to someone.
:: - can be poked by foreign ships to send an invite to us.
::
:: only handles %invite actions. accepts json, but only from the host team.
:: can be poked by the host team to send an invite out to someone.
:: can be poked by foreign ships to send an invite to us.
::
/+ *invite-json, default-agent, verb, dbug
/- *invite-store
/+ default-agent, dbug
::
|%
+$ state-0 [%0 ~]
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
[~ this]
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
:_ this
?+ mark (on-poke:def mark vase)
%json
:: only accept json from ourselves.
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init [~ this]
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
:_ this
?+ mark (on-poke:def mark vase)
%invite-action
=/ act=action !<(action vase)
?+ -.act ~
%invites
?. (team:title [our src]:bowl) ~
:: outgoing. we must be inviting other ships. send them each an invite
::
?> (team:title our.bowl src.bowl)
=/ act (json-to-action !<(json vase))
?> ?=(%invite -.act)
[(invite-hook-poke:do recipient.invite.act act)]~
%+ turn ~(tap in recipients.invites.act)
|= recipient=ship
^- card
?< (team:title our.bowl recipient)
%+ invite-hook-poke recipient
:^ %invite term.act uid.act
^- invite
:* ship.invites.act
app.invites.act
resource.invites.act
recipient
text.invites.act
==
::
%invite-action
=/ act=invite-action !<(invite-action vase)
?. ?=(%invite -.act) ~
?: (team:title our.bowl src.bowl)
%invite
?: (team:title [our src]:bowl)
:: outgoing. we must be inviting another ship. send them the invite.
::
?< (team:title our.bowl recipient.invite.act)
[(invite-hook-poke:do recipient.invite.act act)]~
[(invite-hook-poke recipient.invite.act act)]~
:: else incoming. ensure invitatory exists and invite is not a duplicate.
::
?> ?=(^ (invitatory-scry:do path.act))
?> ?=(~ (invite-scry:do path.act uid.act))
[(invite-poke:do path.act act)]~
?> ?=(^ (invitatory-scry term.act))
?> ?=(~ (invite-scry term.act uid.act))
[(invite-poke term.act act)]~
==
==
::
++ invite-hook-poke
|= [=ship =action]
^- card
:* %pass
/invite-hook
%agent
[ship %invite-hook]
%poke
%invite-action
!>(action)
==
::
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ invite-poke
|= [=term =action]
^- card
:* %pass
/[term]
%agent
[our.bowl %invite-store]
%poke
%invite-action
!>(action)
==
::
++ invitatory-scry
|= =term
.^ (unit invitatory)
%gx
%+ weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invitatory
/[term]/noun
==
::
++ invite-scry
|= [=term uid=serial]
.^ (unit invite)
%gx
%+ weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invite
/[term]/(scot %uv uid)/noun
==
--
::
|_ =bowl:gall
::
++ invite-hook-poke
|= [=ship action=invite-action]
^- card
:* %pass
/invite-hook
%agent
[ship %invite-hook]
%poke
%invite-action
!>(action)
==
::
++ invite-poke
|= [=path action=invite-action]
^- card
:* %pass
path
%agent
[our.bowl %invite-store]
%poke
%invite-action
!>(action)
==
::
++ invitatory-scry
|= pax=path
^- (unit invitatory)
=. pax
;: weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invitatory
pax
/noun
==
.^((unit invitatory) %gx pax)
::
++ invite-scry
|= [pax=path uid=serial]
^- (unit invite)
=. pax
;: weld
/(scot %p our.bowl)/invite-store/(scot %da now.bowl)/invite
pax
/(scot %uv uid)/noun
==
.^((unit invite) %gx pax)
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

353
pkg/arvo/app/invite-store.hoon
View File

@ -1,184 +1,209 @@
:: invite-store [landscape]
/+ *invite-json, default-agent, dbug
/- store=invite-store
/+ res=resource, default-agent, dbug
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
$% state-0
state-1
==
::
+$ state-zero
$: %0
=invites
+$ invitatory-0 (map serial:store invite-0)
+$ invite-0
$: =ship :: ship to subscribe to upon accepting invite
app=@tas :: app to subscribe to upon accepting invite
=path :: path to subscribe to upon accepting invite
recipient=ship :: recipient to receive invite
text=cord :: text to describe the invite
==
::
+$ state-0 [%0 invites=(map path invitatory-0)]
+$ state-1 [%1 =invites:store]
--
::
=| state-zero
=| state-1
=* state -
%- agent:dbug
^- agent:gall
=<
|_ bol=bowl:gall
+* this .
inv-core +>
ic ~(. inv-core bol)
def ~(. (default-agent this %|) bol)
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:- ~
%_ this
invites.state
%- ~(gas by *invites:store)
[%graph *invitatory:store]~
==
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
`this(state old)
:- =- [%pass / %agent [our.bowl %invite-store] %poke %invite-action -]~
!> ^- action:store
[%create %graph]
%= this
state
:- %1
%- ~(gas by *invites:store)
%+ murn ~(tap by invites.old)
|= [=path =invitatory-0]
^- (unit [term invitatory:store])
?. ?=([@ ~] path) ~
:- ~
:- i.path
%- ~(gas by *invitatory:store)
%+ murn ~(tap by invitatory-0)
|= [=serial:store =invite-0]
^- (unit [serial:store invite:store])
=/ resource=(unit resource:res) (de-path-soft:res path.invite-0)
?~ resource ~
:- ~
:- serial
^- invite:store
:* ship.invite-0
app.invite-0
u.resource
recipient.invite-0
text.invite-0
==
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-leave on-leave:def
++ on-fail on-fail:def
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] [%give %fact ~ %invite-update !>([%initial invites])]~
[%updates ~] ~
[%invitatory @ ~]
=/ inv=invitatory:store (~(got by invites) i.t.path)
[%give %fact ~ %invite-update !>([%invitatory inv])]~
==
[cards this]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%invite-action (poke-invite-action !<(action:store vase))
==
[cards this]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bol src.bol)
=^ cards state
?+ mark (on-poke:def mark vase)
%json (poke-invite-action:ic (json-to-action !<(json vase)))
%invite-action (poke-invite-action:ic !<(invite-action vase))
==
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] [%give %fact ~ %invite-update !>([%initial invites])]~
[%updates ~] ~
[%invitatory *]
=/ inv=invitatory (~(got by invites) t.path)
[%give %fact ~ %invite-update !>([%invitatory inv])]~
==
[cards this]
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] (peek-x-all:ic t.t.path)
[%x %invitatory *] (peek-x-invitatory:ic t.t.path)
[%x %invite *] (peek-x-invite:ic t.t.path)
++ poke-invite-action
|= =action:store
^- (quip card _state)
?- -.action
%create (handle-create +.action)
%delete (handle-delete +.action)
%invite (handle-invite +.action)
%accept (handle-accept +.action)
%decline (handle-decline +.action)
%invites ~|('only send this to %invite-hook' !!)
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ handle-create
|= =term
^- (quip card _state)
?: (~(has by invites) term)
[~ state]
:- (send-diff term [%create term])
state(invites (~(put by invites) term *invitatory:store))
::
++ handle-delete
|= =term
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
:- (send-diff term [%delete term])
state(invites (~(del by invites) term))
::
++ handle-invite
|= [=term =serial:store =invite:store]
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
=/ container (~(got by invites) term)
=. serial (sham eny.bowl)
=. container (~(put by container) serial invite)
:- (send-diff term [%invite term serial invite])
state(invites (~(put by invites) term container))
::
++ handle-accept
|= [=term =serial:store]
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
=/ container (~(got by invites) term)
=/ invite (~(get by container) serial)
?~ invite
[~ state]
=. container (~(del by container) serial)
:- (send-diff term [%accepted term serial u.invite])
state(invites (~(put by invites) term container))
::
++ handle-decline
|= [=term =serial:store]
^- (quip card _state)
?. (~(has by invites) term)
[~ state]
=/ container (~(got by invites) term)
=/ invite (~(get by container) serial)
?~ invite
[~ state]
=. container (~(del by container) serial)
:- (send-diff term [%decline term serial])
state(invites (~(put by invites) term container))
::
++ update-subscribers
|= [=path =update:store]
^- card
[%give %fact ~[path] %invite-update !>(update)]
::
++ send-diff
|= [=term =update:store]
^- (list card)
:~ (update-subscribers /all update)
(update-subscribers /updates update)
(update-subscribers /invitatory/[term] update)
==
--
::
|_ bol=bowl:gall
::
++ peek-x-all
|= pax=path
++ on-peek
|= =path
^- (unit (unit cage))
[~ ~ %noun !>(invites)]
::
++ peek-x-invitatory
|= pax=path
^- (unit (unit cage))
?~ pax
~
=/ invitatory=(unit invitatory) (~(get by invites) pax)
[~ ~ %noun !>(invitatory)]
::
++ peek-x-invite
|= pax=path
^- (unit (unit cage))
:: /:path/:uid
=/ pas (flop pax)
?~ pas
~
=/ uid=serial (slav %uv i.pas)
=. pax (scag (dec (lent pax)) `(list @ta)`pax)
=/ invitatory=(unit invitatory) (~(get by invites) pax)
?~ invitatory
~
=/ invite=(unit invite) (~(get by u.invitatory) uid)
[~ ~ %noun !>(invite)]
::
++ poke-invite-action
|= action=invite-action
^- (quip card _state)
?> (team:title our.bol src.bol)
?- -.action
%create (handle-create action)
%delete (handle-delete action)
%invite (handle-invite action)
%accept (handle-accept action)
%decline (handle-decline action)
?+ path (on-peek:def path)
[%x %all ~]
``noun+!>(invites)
::
[%x %invitatory @ ~]
:^ ~ ~ %noun
!> ^- (unit invitatory:store)
(~(get by invites) i.t.t.path)
::
[%x %invite @ @ ~]
=* term i.t.t.path
=/ =serial:store (slav %uv i.t.t.t.path)
?. (~(has by invites) term)
~
=/ =invitatory:store (~(got by invites) term)
:^ ~ ~ %noun
!> ^- (unit invite:store)
(~(get by invitatory) serial)
==
::
++ handle-create
|= act=invite-action
^- (quip card _state)
?> ?=(%create -.act)
?: (~(has by invites) path.act)
[~ state]
:- (send-diff path.act act)
state(invites (~(put by invites) path.act *invitatory))
::
++ handle-delete
|= act=invite-action
^- (quip card _state)
?> ?=(%delete -.act)
?. (~(has by invites) path.act)
[~ state]
:- (send-diff path.act act)
state(invites (~(del by invites) path.act))
::
++ handle-invite
|= act=invite-action
^- (quip card _state)
?> ?=(%invite -.act)
?. (~(has by invites) path.act)
[~ state]
=/ container (~(got by invites) path.act)
=. uid.act (sham eny.bol)
=. container (~(put by container) uid.act invite.act)
:- (send-diff path.act act)
state(invites (~(put by invites) path.act container))
::
++ handle-accept
|= act=invite-action
^- (quip card _state)
?> ?=(%accept -.act)
?. (~(has by invites) path.act)
[~ state]
=/ container (~(got by invites) path.act)
=/ invite (~(get by container) uid.act)
?~ invite
[~ state]
=. container (~(del by container) uid.act)
:- (send-diff path.act [%accepted path.act uid.act u.invite])
state(invites (~(put by invites) path.act container))
::
++ handle-decline
|= act=invite-action
^- (quip card _state)
?> ?=(%decline -.act)
?. (~(has by invites) path.act)
[~ state]
=/ container (~(got by invites) path.act)
=/ invite (~(get by container) uid.act)
?~ invite
[~ state]
=. container (~(del by container) uid.act)
:- (send-diff path.act act)
state(invites (~(put by invites) path.act container))
::
++ update-subscribers
|= [pax=path upd=invite-update]
^- card
[%give %fact ~[pax] %invite-update !>(upd)]
::
++ send-diff
|= [pax=path upd=invite-update]
^- (list card)
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%invitatory pax] upd)
==
::
--

BIN
pkg/arvo/app/landscape/img/chat.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 4.7 KiB

BIN
pkg/arvo/app/landscape/img/chatswitcherclosed.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.3 KiB

BIN
pkg/arvo/app/landscape/img/chatswitcherlink.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/landscape/img/chevron.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 453 B

BIN
pkg/arvo/app/landscape/img/codeeval.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 611 B

BIN
pkg/arvo/app/landscape/img/dojo.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 2.2 KiB

BIN
pkg/arvo/app/landscape/img/link.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.3 KiB

BIN
pkg/arvo/app/landscape/img/links.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.3 KiB

BIN
pkg/arvo/app/landscape/img/popout.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1.5 KiB

BIN
pkg/arvo/app/landscape/img/publish.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 3.7 KiB

BIN
pkg/arvo/app/landscape/img/search.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 951 B

BIN
pkg/arvo/app/landscape/img/send.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 1010 B

BIN
pkg/arvo/app/landscape/img/spinner.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 679 B

2
pkg/arvo/app/landscape/index.html
View File

@ -24,6 +24,6 @@
<div id="portal-root"></div>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~landscape/js/bundle/index.5fd962a0b23fc798e999.js"></script>
<script src="/~landscape/js/bundle/index.c099f574cf3ccea90625.js"></script>
</body>
</html>

64
pkg/arvo/app/launch.hoon
View File

@ -12,6 +12,7 @@
[%3 *]
[%4 state-zero]
[%5 state-zero]
[%6 state-zero]
==
::
+$ state-zero
@ -21,7 +22,7 @@
==
--
::
=| [%5 state-zero]
=| [%6 state-zero]
=* state -
%- agent:dbug
^- agent:gall
@ -36,27 +37,42 @@
%_ new-state
tiles
%- ~(gas by *tiles:store)
%+ turn `(list term)`[%weather %clock %dojo ~]
%+ turn `(list term)`[%weather %clock %term ~]
|= =term
:- term
^- tile:store
?+ term [[%custom ~] %.y]
%dojo [[%basic 'Dojo' '/~landscape/img/Dojo.png' '/~dojo'] %.y]
?+ term [[%custom ~] %.y]
%term [[%basic 'Terminal' '/~landscape/img/term.png' '/~term'] %.y]
==
tile-ordering [%weather %clock %dojo ~]
tile-ordering [%weather %clock %term ~]
==
[~ this(state [%5 new-state])]
[~ this(state [%6 new-state])]
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
=/ old-state !<(versioned-state old)
|-
=| cards=(list card)
|- ^- (quip card _this)
?: ?=(%6 -.old-state)
[cards this(state old-state)]
?: ?=(%5 -.old-state)
`this(state old-state)
:: replace %dojo with %term
::
=. tiles.old-state
%+ ~(put by (~(del by tiles.old-state) %dojo))
%term
:_ is-shown:(~(gut by tiles.old-state) %dojo *tile:store)
[%basic 'Terminal' '/~landscape/img/term.png' '/~term']
=. tile-ordering.old-state
%+ turn tile-ordering.old-state
|=(t=term ?:(=(%dojo t) %term t))
$(old-state [%6 +.old-state])
?: ?=(%4 -.old-state)
:- [%pass / %arvo %e %disconnect [~ /]]~
=. cards
%+ snoc cards
[%pass / %arvo %e %disconnect [~ /]]
=. tiles.old-state
(~(del by tiles.old-state) %chat)
=. tiles.old-state
@ -65,7 +81,7 @@
(~(del by tiles.old-state) %links)
=. tile-ordering.old-state
(skip tile-ordering.old-state |=(=term ?=(?(%links %chat %publish) term)))
this(state [%5 +.old-state])
$(old-state [%5 +.old-state])
=/ new-state *state-zero
=. new-state
%_ new-state
@ -80,18 +96,22 @@
==
tile-ordering [%weather %clock %dojo ~]
==
:_ this(state [%5 new-state])
%+ welp
:~ [%pass / %arvo %e %disconnect [~ /]]
:* %pass /srv %agent [our.bowl %file-server]
%poke %file-server-action
!>([%serve-dir / /app/landscape %.n %.y])
==
==
%+ turn ~(tap by wex.bowl)
|= [[=wire =ship =term] *]
^- card
[%pass wire %agent [ship term] %leave ~]
%_ $
old-state [%5 new-state]
::
cards
%+ welp
:~ [%pass / %arvo %e %disconnect [~ /]]
:* %pass /srv %agent [our.bowl %file-server]
%poke %file-server-action
!>([%serve-dir / /app/landscape %.n %.y])
==
==
%+ turn ~(tap by wex.bowl)
|= [[=wire =ship =term] *]
^- card
[%pass wire %agent [ship term] %leave ~]
==
::
++ on-poke
|= [=mark =vase]

2
pkg/arvo/app/link-store.hoon
View File

@ -116,7 +116,7 @@
|= [=resource =graph:gra]
^- card
%- poke-graph-store
[%0 now.bowl %add-graph resource graph `%graph-validator-link]
[%0 now.bowl %add-graph resource graph `%graph-validator-link %.y]
::
++ archive-graph
|= =resource

91
pkg/arvo/app/metadata-store.hoon
View File

@ -10,7 +10,7 @@
:: encode group-path and app-path using (scot %t (spat group-path))
::
:: +watch paths:
:: /all assocations + updates
:: /all associations + updates
:: /updates just updates
:: /app-name/%app-name specific app's associations + updates
::
@ -57,6 +57,7 @@
+$ state-3 [%3 base-state-1]
+$ state-4 [%4 base-state-1]
+$ state-5 [%5 base-state-1]
+$ state-6 [%6 base-state-1]
+$ versioned-state
$% state-0
state-1
@ -64,10 +65,11 @@
state-3
state-4
state-5
state-6
==
--
::
=| state-5
=| state-6
=* state -
%+ verb |
%- agent:dbug
@ -86,29 +88,37 @@
=/ old !<(versioned-state vase)
=| cards=(list card)
|^
?: ?=(%5 -.old)
?: ?=(%6 -.old)
[cards this(state old)]
?: ?=(%4 -.old)
%_ $
-.old %5
::
group-indices.old
%- ~(gas ju *(jug group-path md-resource))
~(tap in ~(key by associations.old))
::
app-indices.old
%- ~(gas ju *(jug app-name [group-path app-path]))
%+ turn ~(tap in ~(key by associations.old))
|= [g=group-path r=md-resource]
^- [app-name [group-path app-path]]
[app-name.r [g app-path.r]]
?: ?=(%5 -.old)
=/ =^associations
(migrate-app-to-graph-store %publish associations.old)
%_ $
-.old %6
associations.old associations
::
resource-indices.old
%- ~(gas ju *(jug md-resource group-path))
%+ turn ~(tap in ~(key by associations.old))
|= [g=group-path r=md-resource]
^- [md-resource group-path]
[r g]
(rebuild-resource-indices associations)
::
app-indices.old
(rebuild-app-indices associations)
::
group-indices.old
(rebuild-group-indices associations)
==
?: ?=(%4 -.old)
%_ $
-.old %5
::
resource-indices.old
(rebuild-resource-indices associations.old)
::
app-indices.old
(rebuild-app-indices associations.old)
::
group-indices.old
(rebuild-group-indices associations.old)
==
?: ?=(%3 -.old)
$(old [%4 +.old])
@ -147,6 +157,43 @@
==
$(old new-state-1)
::
++ rebuild-resource-indices
|= =^associations
%- ~(gas ju *(jug md-resource group-path))
%+ turn ~(tap in ~(key by associations))
|= [g=group-path r=md-resource]
^- [md-resource group-path]
[r g]
::
++ rebuild-group-indices
|= =^associations
%- ~(gas ju *(jug group-path md-resource))
~(tap in ~(key by associations))
::
++ rebuild-app-indices
|= =^associations
%- ~(gas ju *(jug app-name [group-path app-path]))
%+ turn ~(tap in ~(key by associations))
|= [g=group-path r=md-resource]
^- [app-name [group-path app-path]]
[app-name.r [g app-path.r]]
::
++ migrate-app-to-graph-store
|= [app=@tas =^associations]
^+ associations
%- malt
%+ turn ~(tap by associations)
|= [[=group-path =md-resource] m=metadata]
^- [[^group-path ^md-resource] metadata]
?. =(app-name.md-resource app)
[[group-path md-resource] m]
=/ new-app-path=path
?. ?=([@ @ ~] app-path.md-resource)
app-path.md-resource
ship+app-path.md-resource
[[group-path [%graph new-app-path]] m(module app)]
::
++ poke-md-hook
|= act=metadata-hook-action
^- card

222
pkg/arvo/app/observe-hook.hoon Normal file
View File

@ -0,0 +1,222 @@
:: observe-hook:
::
:: helper that observes an app at a particular path and forwards all facts
:: to a particular thread. kills the subscription if the thread crashes
::
/- sur=observe-hook
/+ default-agent, dbug
::
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
==
::
+$ serial @uv
+$ state-0 [%0 observers=(map serial observer:sur)]
++ got-by-val
|= [a=(map serial observer:sur) b=observer:sur]
^- serial
%- need
%+ roll ~(tap by a)
|= [[key=serial val=observer:sur] output=(unit serial)]
?:(=(val b) `key output)
--
::
%- agent:dbug
=| state-0
=* state -
::
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
|^ ^- (quip card _this)
:_ this
:_ ~
(act /inv-gra [%watch %invite-store /invitatory/graph %invite-accepted-graph])
::
++ act
|= [=wire =action:sur]
^- card
:* %pass
wire
%agent
[our.bowl %observe-hook]
%poke
%observe-action
!> ^- action:sur
action
==
--
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
`this(state !<(state-0 old-vase))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?. ?=(%observe-action mark)
(on-poke:def mark vase)
=/ =action:sur !<(action:sur vase)
=* observer observer.action
=/ vals (silt ~(val by observers))
?- -.action
%watch
?: ?|(=(app.observer %spider) =(app.observer %observe-hook))
~|('we avoid infinite loops' !!)
?: (~(has in vals) observer)
~|('duplicate observer' !!)
:_ this(observers (~(put by observers) (sham eny.bowl) observer))
:_ ~
:* %pass
/observer/(scot %uv (sham eny.bowl))
%agent
[our.bowl app.observer]
%watch
path.observer
==
::
%ignore
?. (~(has in vals) observer)
~|('cannot remove nonexistent observer' !!)
=/ key (got-by-val observers observer)
:_ this(observers (~(del by observers) key))
:_ ~
:* %pass
/observer/(scot %uv key)
%agent
[our.bowl app.observer]
%leave
~
==
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ wire (on-agent:def wire sign)
[%observer @ ~] on-observer
[%thread-result @ ~] on-thread-result
[%thread-start @ @ ~] on-thread-start
==
::
++ on-observer
?> ?=([%observer @ ~] wire)
?+ -.sign (on-agent:def wire sign)
%watch-ack
?~ p.sign [~ this]
=/ =serial (slav %uv i.t.wire)
~& watch-ack-deleting-observer+(~(got by observers) serial)
[~ this(observers (~(del by observers) serial))]
::
%kick
=/ =serial (slav %uv i.t.wire)
=/ =observer:sur (~(got by observers) serial)
:_ this
:_ ~
:* %pass
wire
%agent
[our.bowl app.observer]
%watch
path.observer
==
::
%fact
=/ =serial (slav %uv i.t.wire)
=/ =observer:sur (~(got by observers) serial)
=/ tid (scot %uv (sham eny.bowl))
:_ this
:~ :* %pass
[%thread-result i.t.wire ~]
%agent
[our.bowl %spider]
%watch
[%thread-result tid ~]
==
:* %pass
[%thread-start i.t.wire tid ~]
%agent
[our.bowl %spider]
%poke
%spider-start
!>([~ `tid thread.observer (slop q.cage.sign !>(~))])
== ==
==
::
++ on-thread-result
?> ?=([%thread-result @ ~] wire)
?+ -.sign (on-agent:def wire sign)
%kick [~ this]
%watch-ack [~ this]
::
%fact
?. =(p.cage.sign %thread-fail)
:_ this
:_ ~
:* %pass
wire
%agent
[our.bowl %spider]
%leave
~
==
=/ =serial (slav %uv i.t.wire)
=/ =observer:sur (~(got by observers) serial)
~& observer-failed+observer
:_ this(observers (~(del by observers) serial))
:~ :* %pass
[%observer i.t.wire ~]
%agent
[our.bowl app.observer]
%leave
~
==
:* %pass
wire
%agent
[our.bowl %spider]
%leave
~
==
==
==
::
++ on-thread-start
?> ?=([%thread-start @ @ ~] wire)
?. ?=(%poke-ack -.sign) (on-agent:def wire sign)
?~ p.sign [~ this]
=/ =serial (slav %uv i.t.wire)
=/ =observer:sur (~(got by observers) serial)
~& added-invalid-observer+observer
:_ this(observers (~(del by observers) serial))
:~ :* %pass
[%observer i.t.wire ~]
%agent
[our.bowl app.observer]
%leave
~
==
:* %pass
wire
%agent
[our.bowl app.observer]
%leave
~
== ==
--
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

2236
pkg/arvo/app/publish.hoon
View File

File diff suppressed because it is too large Load Diff

76
pkg/arvo/app/soto.hoon
View File

@ -1,74 +1,4 @@
:: soto [tombstone]: former dojo relay for urbit's landscape interface
::
:: soto [landscape]: A Dojo relay for Urbit's Landscape interface
::
:: Relays sole-effects to subscribers and forwards sole-action pokes
::
/- sole
/+ *soto, default-agent
|%
+$ card card:agent:gall
::
+$ versioned-state
$@ state-null
state-zero
::
+$ state-null ~
::
+$ state-zero [%0 ~]
--
=| state-zero
=* state -
^- agent:gall
|_ bol=bowl:gall
+* this .
soto-core +>
sc ~(. soto-core bol)
def ~(. (default-agent this %|) bol)
::
++ on-init
:_ this
:_ ~
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~dojo' /app/landscape %.n %.y])
==
++ on-save !>(state)
::
++ on-load
|= old-vase=vase
=/ old
!<(versioned-state old-vase)
?^ old
[~ this(state old)]
:_ this(state [%0 ~])
:~ [%pass /bind/soto %arvo %e %disconnect [~ /'~dojo']]
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~dojo' /app/landscape %.n %.y])
==
==
::
++ on-poke on-poke:def
++ on-watch
|= pax=path
^- (quip card _this)
?+ pax (on-watch:def pax)
[%sototile ~]
:_ this
[%give %fact ~ %json !>(~)]~
==
::
++ on-agent on-agent:def
::
++ on-arvo
|= [wir=wire sin=sign-arvo]
^- (quip card _this)
?: ?=(%bound +<.sin)
[~ this]
(on-arvo:def wir sin)
::
++ on-fail on-fail:def
++ on-leave on-leave:def
++ on-peek on-peek:def
::
--
/+ default-agent
(default-agent *agent:gall %|)

2
pkg/arvo/app/spider.hoon
View File

@ -1,5 +1,5 @@
/- spider
/+ libstrand=strand, default-agent, verb, server
/+ libstrand=strand, default-agent, verb, server
=, strand=strand:libstrand
|%
+$ card card:agent:gall

4
pkg/arvo/gen/graph-store/add-graph.hoon
View File

@ -3,8 +3,8 @@
/+ *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=resource mark=(unit mark) ~] ~]
[[=resource mark=(unit mark) overwrite=? ~] ~]
==
:- %graph-update
^- update
[%0 now [%add-graph resource (gas:orm ~ ~) mark]]
[%0 now [%add-graph resource (gas:orm ~ ~) mark overwrite]]

1
pkg/arvo/lib/base64.hoon
View File

@ -3,6 +3,7 @@
:: pad: include padding when encoding, require when decoding
:: url: use url-safe characters '-' for '+' and '_' for '/'
::
::
=+ [pad=& url=|]
|%
::

4
pkg/arvo/lib/bip32.hoon
View File

@ -81,11 +81,11 @@
++ derivation-path
;~ pfix
;~(pose (jest 'm/') (easy ~))
%+ most net
%+ most fas
;~ pose
%+ cook
|=(i=@ (add i (bex 31)))
;~(sfix dem say)
;~(sfix dem soq)
::
dem
== ==

164
pkg/arvo/lib/graph-store.hoon
View File

@ -34,6 +34,79 @@
++ enjs
=, enjs:format
|%
::
++ signatures
|= s=^signatures
^- json
[%a (turn ~(tap in s) signature)]
::
++ signature
|= s=^signature
^- json
%- pairs
:~ [%signature s+(scot %ux p.s)]
[%ship (ship q.s)]
[%life (numb r.s)]
==
::
++ index
|= i=^index
^- json
?: =(~ i) s+'/'
=/ j=^tape ""
|-
?~ i [%s (crip j)]
=/ k=json (numb i.i)
?> ?=(%n -.k)
%_ $
i t.i
j (weld j (weld "/" (trip +.k)))
==
::
++ uid
|= u=^uid
^- json
%- pairs
:~ [%resource (enjs:res resource.u)]
[%index (index index.u)]
==
::
++ content
|= c=^content
^- json
?- -.c
%mention (frond %mention (ship ship.c))
%text (frond %text s+text.c)
%url (frond %url s+url.c)
%reference (frond %reference (uid uid.c))
%code
%+ frond %code
%- pairs
:- [%expression s+expression.c]
:_ ~
:- %output
:: virtualize output rendering, +tank:enjs:format might crash
::
=/ result=(each (list json) tang)
(mule |.((turn output.c tank)))
?- -.result
%& a+p.result
%| a+[a+[%s '[[output rendering error]]']~]~
==
==
::
++ post
|= p=^post
^- json
%- pairs
:~ [%author (ship author.p)]
[%index (index index.p)]
[%time-sent (time time-sent.p)]
[%contents [%a (turn contents.p content)]]
[%hash ?~(hash.p ~ s+(scot %ux u.hash.p))]
[%signatures (signatures signatures.p)]
==
::
++ update
|= upd=^update
^- json
@ -50,6 +123,7 @@
:~ [%resource (enjs:res resource.upd)]
[%graph (graph graph.upd)]
[%mark ?~(mark.upd ~ s+u.mark.upd)]
[%overwrite b+overwrite.upd]
==
::
%remove-graph
@ -132,20 +206,6 @@
:~ (index [a]~)
(node n)
==
::
++ index
|= i=^index
^- json
=/ j=^tape ""
|-
?~ i [%s (crip j)]
=/ k=json (numb i.i)
?> ?=(%n -.k)
%_ $
i t.i
j (weld j (weld "/" (trip +.k)))
==
::
++ node
|= n=^node
^- json
@ -158,41 +218,7 @@
==
==
::
++ post
|= p=^post
^- json
%- pairs
:~ [%author (ship author.p)]
[%index (index index.p)]
[%time-sent (time time-sent.p)]
[%contents [%a (turn contents.p content)]]
[%hash ?~(hash.p ~ s+(scot %ux u.hash.p))]
[%signatures (signatures signatures.p)]
==
::
++ content
|= c=^content
^- json
?- -.c
%text (frond %text s+text.c)
%url (frond %url s+url.c)
%reference (frond %reference (uid uid.c))
%code
%+ frond %code
%- pairs
:- [%expression s+expression.c]
:_ ~
:- %output
:: virtualize output rendering, +tank:enjs:format might crash
::
=/ result=(each (list json) tang)
(mule |.((turn output.c tank)))
?- -.result
%& a+p.result
%| a+[a+[%s '[[output rendering error]]']~]~
==
==
::
::
++ nodes
|= m=(map ^index ^node)
^- json
@ -210,27 +236,6 @@
^- json
[%a (turn ~(tap in i) index)]
::
++ uid
|= u=^uid
^- json
%- pairs
:~ [%resource (enjs:res resource.u)]
[%index (index index.u)]
==
::
++ signatures
|= s=^signatures
^- json
[%a (turn ~(tap in s) signature)]
::
++ signature
|= s=^signature
^- json
%- pairs
:~ [%signature s+(scot %ux p.s)]
[%ship (ship q.s)]
[%life (numb r.s)]
==
--
--
::
@ -272,6 +277,7 @@
:~ [%resource dejs:res]
[%graph graph]
[%mark (mu so)]
[%overwrite bo]
==
::
++ graph
@ -295,14 +301,19 @@
[%nodes nodes]
==
::
++ nodes (op ;~(pfix net (more net dem)) node)
++ nodes (op ;~(pfix fas (more fas dem)) node)
::
++ node
%- ot
:~ [%post post]
:: TODO: support adding nodes with children by supporting the
:: graph key
[%children (of [%empty ul]~)]
[%children internal-graph]
==
::
++ internal-graph
^- $-(json ^internal-graph)
%- of
:~ [%empty ul]
[%graph graph]
==
::
++ post
@ -317,7 +328,8 @@
::
++ content
%- of
:~ [%text so]
:~ [%mention (su ;~(pfix sig fed:ag))]
[%text so]
[%url so]
[%reference uid]
[%code eval]
@ -366,7 +378,7 @@
[%index index]
==
::
++ index (su ;~(pfix net (more net dem)))
++ index (su ;~(pfix fas (more fas dem)))
::
++ add-tag
%- ot

20
pkg/arvo/lib/graph.hoon
View File

@ -17,6 +17,18 @@
%+ scry-for update:store
/graph/(scot %p entity.res)/[name.res]
::
++ got-node
|= [res=resource =index:store]
^- node:store
=+ %+ scry-for ,=update:store
%+ weld
/node/(scot %p entity.res)/[name.res]
(turn index (cury scot %ud))
?> ?=(%0 -.update)
?> ?=(%add-nodes -.q.update)
?> ?=(^ nodes.q.update)
q.n.nodes.q.update
::
++ get-update-log
|= rid=resource
^- update-log:store
@ -33,4 +45,12 @@
^- update-log:store
%+ scry-for update-log:store
/update-log-subset/(scot %p entity.res)/[name.res]/(scot %da start)/'~'
::
++ get-keys
^- resources
=+ %+ scry-for ,=update:store
/keys
?> ?=(%0 -.update)
?> ?=(%keys -.q.update)
resources.q.update
--

30
pkg/arvo/lib/hark/chat-hook.hoon Normal file
View File

@ -0,0 +1,30 @@
/- sur=hark-chat-hook
^?
=< [. sur]
=, sur
|%
++ dejs
=, dejs:format
|%
++ action
%- of
:~ listen+pa
ignore+pa
set-mentions+bo
==
--
::
++ enjs
=, enjs:format
|%
++ update
|= upd=^update
%+ frond -.upd
?- -.upd
?(%listen %ignore) (path chat.upd)
%set-mentions b+mentions.upd
%initial a+(turn ~(tap in watching.upd) path)
==
--
--

66
pkg/arvo/lib/hark/graph-hook.hoon Normal file
View File

@ -0,0 +1,66 @@
/- sur=hark-graph-hook, post
/+ graph-store, resource
^?
=< [. sur]
=, sur
|%
++ dejs
=, dejs:format
|%
::
++ index
^- $-(json index:graph-store)
(su ;~(pfix net (more net dem)))
::
++ graph-index
%- ot
:~ graph+dejs-path:resource
index+index
==
::
++ action
%- of
:~ listen+graph-index
ignore+graph-index
set-mentions+bo
set-watch-on-self+bo
==
--
::
++ enjs
=, enjs:format
|%
::
++ graph-index
|= [graph=resource =index:post]
%- pairs
:~ graph+s+(enjs-path:resource graph)
index+(index:enjs:graph-store index)
==
::
++ action
|= act=^action
^- json
%+ frond -.act
?- -.act
%set-watch-on-self b+watch-on-self.act
%set-mentions b+mentions.act
?(%listen %ignore) (graph-index graph.act index.act)
==
::
::
::
++ update
|= upd=^update
^- json
?. ?=(%initial -.upd)
(action upd)
%+ frond -.upd
%- pairs
:~ 'watchOnSelf'^b+watch-on-self.upd
'mentions'^b+mentions.upd
:+ %watching %a
(turn ~(tap in watching.upd) graph-index)
==
--
--

34
pkg/arvo/lib/hark/group-hook.hoon Normal file
View File

@ -0,0 +1,34 @@
/- sur=hark-group-hook
/+ resource
^?
=< [. sur]
=, sur
|%
++ dejs
=, dejs:format
|%
++ action
%- of
:~ listen+dejs-path:resource
ignore+dejs-path:resource
==
--
::
++ enjs
=, enjs:format
|%
++ res
(cork enjs-path:resource (lead %s))
::
++ update
|= upd=^update
%+ frond -.upd
?- -.upd
?(%listen %ignore) (res group.upd)
::
%initial
:- %a
(turn ~(tap in watching.upd) res)
==
--
--

226
pkg/arvo/lib/hark/store.hoon Normal file
View File

@ -0,0 +1,226 @@
/- sur=hark-store, post
/+ resource, graph-store, group-store, chat-store
^?
=< [. sur]
=, sur
|%
++ dejs
=, dejs:format
|%
++ index
%- of
:~ graph+graph-index
group+group-index
chat+chat-index
==
::
++ chat-index
%- ot
:~ chat+pa
mention+bo
==
::
++ group-index
%- ot
:~ group+dejs-path:resource
description+so
==
::
++ graph-index
%- ot
:~ group+dejs-path:resource
graph+dejs-path:resource
module+so
description+so
==
:: parse date as @ud
:: TODO: move to zuse
++ sd
|= jon=json
^- @da
?> ?=(%s -.jon)
`@da`(rash p.jon dem:ag)
::
++ notif-ref
^- $-(json [@da ^index])
%- ot
:~ time+sd
index+index
==
::
++ add
|= jon=json
[*^index *notification]
::
++ action
^- $-(json ^action)
%- of
:~ seen+ul
archive+notif-ref
unread+notif-ref
read+notif-ref
add+add
set-dnd+bo
read-index+index
==
--
::
++ enjs
=, enjs:format
|%
++ update
|= upd=^update
^- json
|^
%+ frond -.upd
?+ -.upd a+~
%added (added +.upd)
%timebox (timebox +.upd)
%set-dnd b+dnd.upd
%count (numb count.upd)
%unreads (unreads unreads.upd)
%more (more +.upd)
::
?(%archive %read %unread)
(notif-ref +.upd)
==
::
++ unreads
|= l=(list [^index @ud])
^- json
:- %a
^- (list json)
%+ turn l
|= [idx=^index unread=@ud]
%- pairs
:~ unread+(numb unread)
index+(index idx)
==
::
++ added
|= [tim=@da idx=^index not=^notification]
^- json
%- pairs
:~ time+s+(scot %ud tim)
index+(index idx)
notification+(notification not)
==
::
++ notif-ref
|= [tim=@da idx=^index]
^- json
%- pairs
:~ time+s+(scot %ud tim)
index+(index idx)
==
::
++ more
|= upds=(list ^update)
^- json
a+(turn upds update)
::
++ index
|= =^index
%+ frond -.index
|^
?- -.index
%graph (graph-index +.index)
%group (group-index +.index)
%chat (chat-index +.index)
==
::
++ chat-index
|= [chat=^path mention=?]
^- json
%- pairs
:~ chat+(path chat)
mention+b+mention
==
::
++ graph-index
|= [group=resource graph=resource module=@t description=@t]
^- json
%- pairs
:~ group+s+(enjs-path:resource group)
graph+s+(enjs-path:resource graph)
module+s+module
description+s+description
==
::
++ group-index
|= [group=resource description=@t]
^- json
%- pairs
:~ group+s+(enjs-path:resource group)
description+s+description
==
--
::
++ notification
|= ^notification
^- json
%- pairs
:~ time+(time date)
read+b+read
contents+(^contents contents)
==
::
++ contents
|= =^contents
^- json
%+ frond -.contents
|^
?- -.contents
%graph (graph-contents +.contents)
%group (group-contents +.contents)
%chat (chat-contents +.contents)
==
::
++ chat-contents
|= =(list envelope:chat-store)
^- json
:- %a
(turn list envelope:enjs:chat-store)
::
++ graph-contents
|= =(list post:post)
^- json
:- %a
(turn list post:enjs:graph-store)
::
++ group-contents
|= =(list ^group-contents)
^- json
:- %a
%+ murn list
|= =^group-contents
?. ?=(?(%add-members %remove-members) -.group-contents)
~
`(update:enjs:group-store group-contents)
--
::
++ indexed-notification
|= [=^index =^notification]
%- pairs
:~ index+(^index index)
notification+(^notification notification)
==
::
++ timebox
|= [tim=@da arch=? l=(list [^index ^notification])]
^- json
%- pairs
:~ time+s+(scot %ud tim)
archive+b+arch
:- %notifications
^- json
:- %a
%+ turn l
|= [=^index =^notification]
^- json
(indexed-notification index notification)
==
--
--
--

34
pkg/arvo/lib/hood/drum.hoon
View File

@ -91,7 +91,7 @@
%chat-hook
%chat-view
%chat-cli
%soto
%herm
%contact-store
%contact-hook
%contact-view
@ -107,6 +107,11 @@
%graph-store
%graph-pull-hook
%graph-push-hook
%hark-store
%hark-graph-hook
%hark-group-hook
%hark-chat-hook
%observe-hook
==
::
++ deft-fish :: default connects
@ -209,7 +214,7 @@
==
::
++ on-load
|= [hood-version=?(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10) old=any-state]
|= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=. sat old
=. dev (~(gut by bin) ost *source)
@ -237,10 +242,17 @@
=> (se-born | %home %group-push-hook)
(se-born | %home %group-pull-hook)
=? ..on-load (lte hood-version %9)
(se-born | %home %graph-store)
(se-born | %home %graph-store)
=? ..on-load (lte hood-version %10)
=> (se-born | %home %graph-push-hook)
(se-born | %home %graph-pull-hook)
=? ..on-load (lte hood-version %11)
=> (se-born | %home %hark-graph-hook)
=> (se-born | %home %hark-group-hook)
=> (se-born | %home %hark-chat-hook)
=> (se-born | %home %hark-store)
=> (se-born | %home %observe-hook)
(se-born | %home %herm)
..on-load
::
++ reap-phat :: ack connect
@ -556,7 +568,6 @@
++ se-show :: show buffer, raw
|= lin/(pair @ud stub)
^+ +>
=. p.lin (add p.lin (lent-stye:klr q.lin))
?: =(mir lin) +>
=. +> ?:(=(p.mir p.lin) +> (se-blit %hop p.lin))
=. +> ?:(=(q.mir q.lin) +> (se-blit %pom q.lin))
@ -1120,25 +1131,10 @@
(fall p.q.a p.q.b)
(fall q.q.a q.q.b)
::
++ lent-stye
|= a/stub ^- @
(roll (lnts-stye a) add)
::
++ lent-char
|= a/stub ^- @
(roll (lnts-char a) add)
::
++ lnts-stye :: stub pair head lengths
|= a/stub ^- (list @)
%+ turn a
|= a/(pair stye (list @c))
;: add :: presumes impl of cvrt:ansi in %dill
(mul 5 2) :: bg
(mul 5 2) :: fg
=+ b=~(wyt in p.p.a) :: effect
?:(=(0 b) 0 (mul 4 +(b)))
==
::
++ lnts-char :: stub pair tail lengths
|= a/stub ^- (list @)
%+ turn a

43
pkg/arvo/lib/invite-json.hoon
View File

@ -1,4 +1,5 @@
/- *invite-store
/+ resource
|%
++ slan |=(mod/@tas |=(txt/@ta (need (slaw mod txt))))
::
@ -12,9 +13,9 @@
^- json
%- pairs:enjs:format
%+ turn ~(tap by inv)
|= [=path =invitatory]
|= [=term =invitatory]
^- [cord json]
[(spat path) (invitatory-to-json invitatory)]
[term (invitatory-to-json invitatory)]
::
++ invitatory-to-json
|= =invitatory
@ -33,13 +34,13 @@
%- pairs
:~ [%ship (ship ship.invite)]
[%app [%s app.invite]]
[%path (path path.invite)]
[%resource (enjs:resource resource.invite)]
[%recipient (ship recipient.invite)]
[%text [%s text.invite]]
==
::
++ update-to-json
|= upd=invite-update
|= upd=update
=, enjs:format
^- json
%+ frond %invite-update
@ -50,15 +51,15 @@
[%initial (invites-to-json invites.upd)]
?: =(%create -.upd)
?> ?=(%create -.upd)
[%create (pairs [%path (path path.upd)]~)]
[%create (pairs [%term s+term.upd]~)]
?: =(%delete -.upd)
?> ?=(%delete -.upd)
[%delete (pairs [%path (path path.upd)]~)]
[%delete (pairs [%term s+term.upd]~)]
?: =(%accepted -.upd)
?> ?=(%accepted -.upd)
:- %accepted
%- pairs
:~ [%path (path path.upd)]
:~ [%term s+term.upd]
[%uid s+(scot %uv uid.upd)]
[%invite (invite-to-json invite.upd)]
==
@ -66,14 +67,14 @@
?> ?=(%decline -.upd)
:- %decline
%- pairs
:~ [%path (path path.upd)]
:~ [%term s+term.upd]
[%uid s+(scot %uv uid.upd)]
==
?: =(%invite -.upd)
?> ?=(%invite -.upd)
:- %invite
%- pairs
:~ [%path (path path.upd)]
:~ [%term s+term.upd]
[%uid s+(scot %uv uid.upd)]
[%invite (invite-to-json invite.upd)]
==
@ -88,53 +89,45 @@
::
++ json-to-action
|= jon=json
^- invite-action
^- action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
:~ [%create so]
[%delete so]
[%invite invite]
[%accept accept]
[%decline decline]
==
::
++ create
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
::
++ invite
%- ot
:~ [%path pa]
:~ [%term so]
[%uid seri]
[%invite invi]
==
::
++ accept
%- ot
:~ [%path pa]
:~ [%term so]
[%uid seri]
==
::
++ decline
%- ot
:~ [%path pa]
:~ [%term so]
[%uid seri]
==
::
++ invi
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%app (se %tas)]
[%path pa]
[%app so]
[%resource dejs:resource]
[%recipient (su ;~(pfix sig fed:ag))]
[%text so]
==
--
--

6
pkg/arvo/lib/language-server/build.hoon
View File

@ -7,13 +7,13 @@
=/ parse-pair
%+ cook
|=([row=@ud col=@ud] [(dec row) col])
(ifix [lac rac] ;~((glue ace) dem dem))
(ifix [sel ser] ;~((glue ace) dem dem))
=/ parse-path
%+ cook
|=(p=path (slag 3 p))
(ifix [net (jest '::')] (more net urs:ab))
(ifix [fas (jest '::')] (more fas urs:ab))
=/ parse-full
;~(plug parse-path ;~(sfix ;~((glue dot) parse-pair parse-pair) ban))
;~(plug parse-path ;~(sfix ;~((glue dot) parse-pair parse-pair) gar))
(rust tape parse-full)
::
++ get-errors-from-tang

14
pkg/arvo/lib/language-server/parser.hoon
View File

@ -11,7 +11,7 @@
:: parse optional /? and ignore
::
;~ pose
(cold ~ ;~(plug net wut gap dem gap))
(cold ~ ;~(plug fas wut gap dem gap))
(easy ~)
==
::
@ -20,7 +20,7 @@
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net hep gap)
;~ pfix ;~(plug fas hep gap)
(most ;~(plug com gaw) taut-rule)
==
gap
@ -32,7 +32,7 @@
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net lus gap)
;~ pfix ;~(plug fas lus gap)
(most ;~(plug com gaw) taut-rule)
==
gap
@ -44,9 +44,9 @@
;~ sfix
%+ cook |=((list [face=term =path]) +<)
%+ more gap
;~ pfix ;~(plug net tis gap)
;~ pfix ;~(plug fas tis gap)
%+ cook |=([term path] +<)
;~(plug sym ;~(pfix ;~(plug gap net) (more net urs:ab)))
;~(plug sym ;~(pfix ;~(plug gap fas) (more fas urs:ab)))
==
gap
==
@ -57,12 +57,12 @@
;~ sfix
%+ cook |=((list [face=term =mark =path]) +<)
%+ more gap
;~ pfix ;~(plug net tar gap)
;~ pfix ;~(plug fas tar gap)
%+ cook |=([term mark path] +<)
;~ plug
sym
;~(pfix ;~(plug gap cen) sym)
;~(pfix ;~(plug gap net) (more net urs:ab))
;~(pfix ;~(plug gap fas) (more fas urs:ab))
==
==
gap

22
pkg/arvo/lib/metadata.hoon
View File

@ -1,6 +1,7 @@
:: metadata: helpers for getting data from the metadata-store
::
/- *metadata-store
/+ res=resource
::
|_ =bowl:gall
++ app-paths-from-group
@ -21,6 +22,27 @@
?. =(app-name.md-resource app-name) ~
`app-path.md-resource
::
++ peek-metadata
|= [app-name=term =group=resource:res =app=resource:res]
^- (unit metadata)
=/ group-cord=cord (scot %t (spat (en-path:res group-resource)))
=/ app-cord=cord (scot %t (spat (en-path:res app-resource)))
=/ our=cord (scot %p our.bowl)
=/ now=cord (scot %da now.bowl)
.^ (unit metadata)
%gx (scot %p our.bowl) %metadata-store (scot %da now.bowl)
%metadata group-cord app-name app-cord /noun
==
::
++ group-from-app-resource
|= [app=term =app=resource:res]
^- (unit resource:res)
=/ app-path (en-path:res app-resource)
=/ group-paths (groups-from-resource app app-path)
?~ group-paths
~
`(de-path:res i.group-paths)
::
++ groups-from-resource
|= =md-resource
^- (list group-path)

238
pkg/arvo/lib/publish.hoon
View File

@ -1,240 +1,4 @@
/- sur=publish
/+ elem-to-react-json
^?
=< [. sur]
=, sur
|%
::
++ enjs
=, enjs:format
|%
::
++ tang
|= tan=^tang
%- wall
%- zing
%+ turn tan
|= a=^tank
(wash [0 80] a)
::
++ note-build
|= build=(each manx ^tang)
^- json
?: ?=(%.y -.build)
%- pairs
:~ success+b+%.y
result+(elem-to-react-json p.build)
==
%- pairs
:~ success+b+%.n
result+(tang p.build)
==
::
++ notebooks-list
|= [our=@p books=(map @tas notebook) subs=(map [@p @tas] notebook)]
^- json
:- %a
%+ weld
%+ turn ~(tap by books)
|= [name=@tas book=notebook]
(notebook-short book)
%+ turn ~(tap by subs)
|= [[host=@p name=@tas] book=notebook]
(notebook-short book)
::
++ notebooks-map
|= [our=@p books=(map [@p @tas] notebook)]
^- json
=/ notebooks-map=json
%- ~(rep by books)
|= [[[host=@p book-name=@tas] book=notebook] out=json]
^- json
=/ host-ta (scot %p host)
?~ out
(frond host-ta (frond book-name (notebook-short book)))
?> ?=(%o -.out)
=/ books (~(get by p.out) host-ta)
?~ books
:- %o
(~(put by p.out) host-ta (frond book-name (notebook-short book)))
?> ?=(%o -.u.books)
=. p.u.books (~(put by p.u.books) book-name (notebook-short book))
:- %o
(~(put by p.out) host-ta u.books)
=? notebooks-map ?=(~ notebooks-map)
[%o ~]
notebooks-map
::
++ notebook-short
|= book=notebook
^- json
%- pairs
:~ title+s+title.book
date-created+(time date-created.book)
about+s+description.book
num-notes+(numb ~(wyt by notes.book))
num-unread+(numb (count-unread notes.book))
comments+b+comments.book
writers-group-path+s+(spat writers.book)
subscribers-group-path+s+(spat subscribers.book)
==
::
++ notebook-full
|= [host=@p book-name=@tas book=notebook]
^- json
%- pairs
:~ title+s+title.book
about+s+description.book
date-created+(time date-created.book)
num-notes+(numb ~(wyt by notes.book))
num-unread+(numb (count-unread notes.book))
notes-by-date+(notes-by-date notes.book)
comments+b+comments.book
writers-group-path+s+(spat writers.book)
subscribers-group-path+s+(spat subscribers.book)
==
::
++ note-presentation
|= [book=notebook note-name=@tas not=note]
^- (map @t json)
=/ notes-list=(list [@tas note])
%+ sort ~(tap by notes.book)
|= [[@tas n1=note] [@tas n2=note]]
(gte date-created.n1 date-created.n2)
=/ idx=@ (need (find [note-name not]~ notes-list))
=/ next=(unit [name=@tas not=note])
?: =(idx 0) ~
`(snag (dec idx) notes-list)
=/ prev=(unit [name=@tas not=note])
?: =(+(idx) (lent notes-list)) ~
`(snag +(idx) notes-list)
=/ current=json (note-full note-name not)
?> ?=(%o -.current)
=. p.current (~(put by p.current) %prev-note ?~(prev ~ s+name.u.prev))
=. p.current (~(put by p.current) %next-note ?~(next ~ s+name.u.next))
=/ notes=(list [@t json]) [note-name current]~
=? notes ?=(^ prev)
[[name.u.prev (note-short name.u.prev not.u.prev)] notes]
=? notes ?=(^ next)
[[name.u.next (note-short name.u.next not.u.next)] notes]
%- my
:~ notes+(pairs notes)
notes-by-date+a+(turn notes-list |=([name=@tas *] s+name))
==
::
++ note-full
|= [note-name=@tas =note]
^- json
%- pairs
:~ note-id+s+note-name
author+s+(scot %p author.note)
title+s+title.note
date-created+(time date-created.note)
snippet+s+snippet.note
file+s+file.note
num-comments+(numb ~(wyt by comments.note))
comments+(comments-page:enjs comments.note 0 50)
read+b+read.note
pending+b+pending.note
==
::
++ notes-by-date
|= notes=(map @tas note)
^- json
=/ notes-list=(list [@tas note])
%+ sort ~(tap by notes)
|= [[@tas n1=note] [@tas n2=note]]
(gte date-created.n1 date-created.n2)
:- %a
%+ turn notes-list
|= [name=@tas note]
^- json
[%s name]
::
++ note-short
|= [note-name=@tas =note]
^- json
%- pairs
:~ note-id+s+note-name
author+s+(scot %p author.note)
title+s+title.note
date-created+(time date-created.note)
num-comments+(numb ~(wyt by comments.note))
read+b+read.note
snippet+s+snippet.note
pending+b+pending.note
==
::
++ notes-page
|= [notes=(map @tas note) start=@ud length=@ud]
^- (map @t json)
=/ notes-list=(list [@tas note])
%+ sort ~(tap by notes)
|= [[@tas n1=note] [@tas n2=note]]
(gte date-created.n1 date-created.n2)
%- my
:~ notes-by-date+a+(turn notes-list |=([name=@tas *] s+name))
notes+o+(^notes-list (scag length (slag start notes-list)))
==
::
++ notes-list
|= notes=(list [@tas note])
^- (map @t json)
%+ roll notes
|= [[name=@tas not=note] out-map=(map @t json)]
^- (map @t json)
(~(put by out-map) name (note-short name not))
::
++ comments-page
|= [comments=(map @da ^comment) start=@ud end=@ud]
^- json
=/ coms=(list [@da ^comment])
%+ sort ~(tap by comments)
|= [[d1=@da ^comment] [d2=@da ^comment]]
(gte d1 d2)
%- comments-list
(scag end (slag start coms))
::
++ comments-list
|= comments=(list [@da ^comment])
^- json
:- %a
(turn comments comment)
::
++ comment
|= [date=@da com=^comment]
^- json
%+ frond
(scot %da date)
%- pairs
:~ author+s+(scot %p author.com)
date-created+(time date-created.com)
content+s+content.com
pending+b+pending.com
==
--
::
++ string-to-symbol
|= tap=tape
^- @tas
%- crip
%+ turn tap
|= a=@
?: ?| &((gte a 'a') (lte a 'z'))
&((gte a '0') (lte a '9'))
==
a
?: &((gte a 'A') (lte a 'Z'))
(add 32 a)
'-'
::
++ count-unread
|= notes=(map @tas note)
^- @ud
%- ~(rep by notes)
|= [[key=@tas val=note] count=@ud]
?: read.val
count
+(count)
::
--
sur

58
pkg/arvo/lib/pull-hook.hoon
View File

@ -38,16 +38,24 @@
push-hook-name=term
==
::
:: $state-0: state for the pull hook
:: $base-state-0: state for the pull hook
::
:: .tracking: a map of resources we are pulling, and the ships that
:: we are pulling them from.
:: .inner-state: state given to internal door
::
+$ state-0
$: %0
tracking=(map resource ship)
inner-state=vase
+$ base-state-0
$: tracking=(map resource ship)
inner-state=vase
==
::
+$ state-0 [%0 base-state-0]
::
+$ state-1 [%1 base-state-0]
::
+$ versioned-state
$% state-0
state-1
==
::
++ default
@ -133,7 +141,7 @@
++ agent
|* =config
|= =(pull-hook config)
=| state-0
=| state-1
=* state -
^- agent:gall
=<
@ -149,12 +157,40 @@
[cards this]
++ on-load
|= =old=vase
^- [(list card:agent:gall) agent:gall]
=/ old
!<(state-0 old-vase)
=^ cards pull-hook
(on-load:og inner-state.old)
[cards this(state old)]
!<(versioned-state old-vase)
=| cards=(list card:agent:gall)
|^
?- -.old
%1
=^ og-cards pull-hook
(on-load:og inner-state.old)
[(weld cards og-cards) this(state old)]
::
%0
%_ $
-.old %1
::
cards
(weld cards (missing-subscriptions tracking.old))
==
==
++ missing-subscriptions
|= tracking=(map resource ship)
^- (list card:agent:gall)
%+ murn
~(tap by tracking)
|= [rid=resource =ship]
^- (unit card:agent:gall)
=/ =path
resource+(en-path:resource rid)
=/ =wire
(make-wire pull+path)
?: (~(has by wex.bowl) [wire ship push-hook-name.config])
~
`[%pass wire %agent [ship push-hook-name.config] %watch path]
--
::
++ on-save
^- vase
=. inner-state

72
pkg/arvo/lib/push-hook.hoon
View File

@ -45,17 +45,24 @@
pull-hook-name=term
==
::
:: $state-0: state for the push hook
:: $base-state-0: state for the push hook
::
:: .sharing: resources that the push hook is proxying
:: .inner-state: state given to internal door
::
+$ state-0
$: %0
sharing=(set resource)
inner-state=vase
+$ base-state-0
$: sharing=(set resource)
inner-state=vase
==
::
+$ state-0 [%0 base-state-0]
::
+$ state-1 [%1 base-state-0]
::
+$ versioned-state
$% state-0
state-1
==
++ push-hook
|* =config
$_ ^|
@ -144,7 +151,7 @@
++ agent
|* =config
|= =(push-hook config)
=| state-0
=| state-1
=* state -
^- agent:gall
=<
@ -163,10 +170,39 @@
++ on-load
|= =old=vase
=/ old
!<(state-0 old-vase)
=^ cards push-hook
(on-load:og inner-state.old)
`this(state old)
!<(versioned-state old-vase)
=| cards=(list card:agent:gall)
|^
?- -.old
%1
=^ og-cards push-hook
(on-load:og inner-state.old)
[(weld cards og-cards) this(state old)]
::
%0
%_ $
-.old %1
::
cards
=/ paths=(list path)
kicked-watches
?~ paths cards
:_ cards
[%give %kick paths ~]
==
==
::
++ kicked-watches
^- (list path)
%~ tap in
%+ roll
~(val by sup.bowl)
|= [[=ship =path] out=(set path)]
?~ path out
?. (lth 4 (lent path))
out
(~(put in out) path)
--
::
++ on-save
=. inner-state
@ -282,14 +318,15 @@
|= rid=resource
=/ pax=path
[%resource (en-path:resource rid)]
=/ paths=(list path)
=/ paths=(set path)
%- sy
%+ turn
(incoming-subscriptions pax)
|=([ship pox=path] pax)
|=([ship pox=path] pox)
=. sharing
(~(del in sharing) rid)
:_ state
[%give %kick ~[pax] ~]~
[%give %kick ~(tap in paths) ~]~
::
++ revoke
|= [ships=(set ship) rid=resource]
@ -334,9 +371,14 @@
=/ rid=(unit resource)
(resource-for-update:og vase)
?~ rid ~
=/ =path
=/ prefix=path
resource+(en-path:resource u.rid)
[%give %fact ~[path] update-mark.config vase]~
=/ paths=(list path)
%+ turn
(incoming-subscriptions prefix)
|=([ship pax=path] pax)
?~ paths ~
[%give %fact paths update-mark.config vase]~
::
++ forward-update
|= =vase

7
pkg/arvo/lib/resource.hoon
View File

@ -37,6 +37,13 @@
%- spat
(en-path resource)
::
++ dejs-path
%- su:dejs:format
;~ pfix
(jest '/ship/')
;~((glue fas) ;~(pfix sig fed:ag) urs:ab)
==
::
++ dejs
=, dejs:format
^- $-(json resource)

25
pkg/arvo/lib/verb.hoon
View File

@ -12,26 +12,26 @@
::
++ on-init
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-init")
%- (print bowl |.("{<dap.bowl>}: on-init"))
=^ cards agent on-init:ag
[[(emit-event %on-init ~) cards] this]
::
++ on-save
^- vase
%- (print bowl "{<dap.bowl>}: on-save")
%- (print bowl |.("{<dap.bowl>}: on-save"))
on-save:ag
::
++ on-load
|= old-state=vase
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-load")
%- (print bowl |.("{<dap.bowl>}: on-load"))
=^ cards agent (on-load:ag old-state)
[[(emit-event %on-load ~) cards] this]
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-poke with mark {<mark>}")
%- (print bowl |.("{<dap.bowl>}: on-poke with mark {<mark>}"))
?: ?=(%verb mark)
?- !<(?(%loud %bowl) vase)
%loud `this(loud !loud)
@ -43,7 +43,7 @@
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-watch on path {<path>}")
%- (print bowl |.("{<dap.bowl>}: on-watch on path {<path>}"))
=^ cards agent
?: ?=([%verb %events ~] path)
[~ agent]
@ -53,7 +53,7 @@
++ on-leave
|= =path
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-leave on path {<path>}")
%- (print bowl |.("{<dap.bowl>}: on-leave on path {<path>}"))
?: ?=([%verb %event ~] path)
[~ this]
=^ cards agent (on-leave:ag path)
@ -62,39 +62,40 @@
++ on-peek
|= =path
^- (unit (unit cage))
%- (print bowl "{<dap.bowl>}: on-peek on path {<path>}")
%- (print bowl |.("{<dap.bowl>}: on-peek on path {<path>}"))
(on-peek:ag path)
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-agent on wire {<wire>}, {<-.sign>}")
%- (print bowl |.("{<dap.bowl>}: on-agent on wire {<wire>}, {<-.sign>}"))
=^ cards agent (on-agent:ag wire sign)
[[(emit-event %on-agent wire -.sign) cards] this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-arvo on wire {<wire>}, {<[- +<]:sign-arvo>}")
%- %+ print bowl |.
"{<dap.bowl>}: on-arvo on wire {<wire>}, {<[- +<]:sign-arvo>}"
=^ cards agent (on-arvo:ag wire sign-arvo)
[[(emit-event %on-arvo wire [- +<]:sign-arvo) cards] this]
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:gall agent:gall)
%- (print bowl "{<dap.bowl>}: on-fail with term {<term>}")
%- (print bowl |.("{<dap.bowl>}: on-fail with term {<term>}"))
=^ cards agent (on-fail:ag term tang)
[[(emit-event %on-fail term) cards] this]
--
::
++ print
|= [=bowl:gall =tape]
|= [=bowl:gall render=(trap tape)]
^+ same
=? . bowl-print
%- (slog >bowl< ~)
.
?. loud same
%- (slog leaf+tape ~)
%- (slog [%leaf $:render] ~)
same
::
++ emit-event

29
pkg/arvo/mar/belt.hoon Normal file
View File

@ -0,0 +1,29 @@
:: belt: runtime belt structure
::
|_ =belt:dill
++ grad %noun
:: +grab: convert from
::
++ grab
|%
++ noun belt:dill
++ json
^- $-(^json belt:dill)
=, dejs:format
%- of
:~ aro+(su (perk %d %l %r %u ~))
bac+ul
ctl+(cu taft so)
del+ul
met+(cu taft so)
ret+ul
txt+(ar (cu taft so))
==
--
:: +grow: convert to
::
++ grow
|%
++ noun belt
--
--

58
pkg/arvo/mar/blit.hoon Normal file
View File

@ -0,0 +1,58 @@
:: blit: runtime blit structure
::
/+ base64
::
|_ =blit:dill
++ grad %noun
:: +grab: convert from
::
++ grab
|%
++ noun blit:dill
--
:: +grow: convert to
::
++ grow
|%
++ noun blit
++ json
^- ^json
=, enjs:format
%+ frond -.blit
?- -.blit
%bel b+&
%clr b+&
%hop (numb p.blit)
%lin a+(turn p.blit |=(c=@c s+(tuft c)))
%mor b+&
%url s+p.blit
::
%sag
%- pairs
:~ 'path'^(path p.blit)
'file'^s+(en:base64 (as-octs:mimes:html (jam q.blit)))
==
::
%sav
%- pairs
:~ 'path'^(path p.blit)
'file'^s+(en:base64 (as-octs:mimes:html q.blit))
==
::
%klr
:- %a
%+ turn p.blit
|= [=stye text=(list @c)]
%- pairs
:~ 'text'^a+(turn text |=(c=@c s+(tuft c)))
::
:- 'stye'
%- pairs
:~ 'back'^[?~(. ~ s+.)]:p.q.stye
'fore'^[?~(. ~ s+.)]:q.q.stye
'deco'^a+(turn ~(tap in p.stye) |=(d=deco ?~(d ~ s+d)))
==
==
==
--
--

15
pkg/arvo/mar/graph/validator/link.hoon
View File

@ -3,6 +3,11 @@
++ grow
|%
++ noun i
++ notification-kind
?+ index.p.i ~
[@ ~] `[%link 0]
[@ @ @ ~] `[%comment 1]
==
--
++ grab
|%
@ -16,10 +21,16 @@
?> ?=([[%text @] [%url @] ~] contents.p.ip)
ip
::
:: comment on link post; comment text
:: comment on link post; container structure
::
[@ @ ~]
?> ?=([[%text @] ~] contents.p.ip)
?> ?=(~ contents.p.ip)
ip
::
:: comment on link post; comment text
::
[@ @ @ ~]
?> ?=(^ contents.p.ip)
ip
==
--

59
pkg/arvo/mar/graph/validator/publish.hoon Normal file
View File

@ -0,0 +1,59 @@
/- *post
|_ i=indexed-post
++ grow
|%
++ noun i
:: +notification-kind
:: Ignore all containers, only notify on content
::
++ notification-kind
?+ index.p.i ~
[@ %1 @ ~] `[%note 0]
[@ %2 @ @ ~] `[%comment 1]
==
--
++ grab
|%
:: +noun: Validate publish post
::
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?+ index.p.ip !!
:: top level post must have no content
[@ ~]
?> ?=(~ contents.p.ip)
ip
:: container for revisions
::
[@ %1 ~]
?> ?=(~ contents.p.ip)
ip
:: specific revision
:: first content is the title
:: revisions are numbered by the revision count
:: starting at one
[@ %1 @ ~]
?> ?=([* * *] contents.p.ip)
?> ?=(%text -.i.contents.p.ip)
ip
:: container for comments
::
[@ %2 ~]
?> ?=(~ contents.p.ip)
ip
:: container for comment revisions
::
[@ %2 @ ~]
?> ?=(~ contents.p.ip)
ip
:: specific comment revision
::
[@ %2 @ @ ~]
?> ?=(^ contents.p.ip)
ip
==
--
::
++ grad %noun
--

13
pkg/arvo/mar/hark/action.hoon Normal file
View File

@ -0,0 +1,13 @@
/+ *hark-store
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action
++ json action:dejs
--
--

13
pkg/arvo/mar/hark/chat-hook-action.hoon Normal file
View File

@ -0,0 +1,13 @@
/+ *hark-chat-hook
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action
++ json action:dejs
--
--

16
pkg/arvo/mar/hark/chat-hook-update.hoon Normal file
View File

@ -0,0 +1,16 @@
/+ *hark-chat-hook
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json
%+ frond:enjs:format
%hark-chat-hook-update
(update:enjs upd)
--
++ grab
|%
++ noun update
--
--

13
pkg/arvo/mar/hark/graph-hook-action.hoon Normal file
View File

@ -0,0 +1,13 @@
/+ *hark-graph-hook
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action
++ json action:dejs
--
--

17
pkg/arvo/mar/hark/graph-hook-update.hoon Normal file
View File

@ -0,0 +1,17 @@
/+ *hark-graph-hook
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json
%+ frond:enjs:format
%hark-graph-hook-update
(update:enjs upd)
--
++ grab
|%
++ noun update
++ json update:dejs
--
--

13
pkg/arvo/mar/hark/group-hook-action.hoon Normal file
View File

@ -0,0 +1,13 @@
/+ *hark-group-hook
|_ act=action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun action
++ json action:dejs
--
--

16
pkg/arvo/mar/hark/group-hook-update.hoon Normal file
View File

@ -0,0 +1,16 @@
/+ *hark-group-hook
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json
%+ frond:enjs:format
%hark-group-hook-update
(update:enjs upd)
--
++ grab
|%
++ noun update
--
--

15
pkg/arvo/mar/hark/update.hoon Normal file
View File

@ -0,0 +1,15 @@
/+ *hark-store
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json
%+ frond:enjs:format 'harkUpdate'
(update:enjs upd)
--
++ grab
|%
++ noun update
--
--

4
pkg/arvo/mar/invite/action.hoon
View File

@ -1,6 +1,6 @@
/+ *invite-json
=, dejs:format
|_ act=invite-action
|_ act=action
++ grad %noun
++ grow
|%
@ -8,7 +8,7 @@
--
++ grab
|%
++ noun invite-action
++ noun action
++ json
|= jon=^json
(json-to-action jon)

10
pkg/arvo/mar/invite/update.hoon
View File

@ -1,15 +1,15 @@
/- store=invite-store
/+ *invite-json
|_ upd=invite-update
|_ =update:store
++ grad %noun
++ grow
|%
++ noun upd
++ json (update-to-json upd)
++ noun update
++ json (update-to-json update)
--
::
++ grab
|%
++ noun invite-update
++ noun update:store
--
::
--

4
pkg/arvo/mar/lens/command.hoon
View File

@ -37,7 +37,7 @@
%- su
;~ plug
sym
;~(pfix col (more net (cook crip (star ;~(less net prn)))))
;~(pfix col (more fas (cook crip (star ;~(less fas prn)))))
==
listen-api+(su ;~(plug sym ;~(pfix col sym)))
export+so
@ -61,7 +61,7 @@
%- su
;~ plug
sym
;~(pfix col (more net (cook crip (star ;~(less net prn)))))
;~(pfix col (more fas (cook crip (star ;~(less fas prn)))))
==
command+so
app+(su sym)

13
pkg/arvo/mar/observe/action.hoon Normal file
View File

@ -0,0 +1,13 @@
/- sur=observe-hook
|_ =action:sur
++ grad %noun
++ grow
|%
++ noun action
--
::
++ grab
|%
++ noun action:sur
--
--

118
pkg/arvo/mar/publish/action.hoon
View File

@ -1,6 +1,6 @@
::
:::: /hoon/action/publish/mar
::
:: tombstoned, now unused
/- *publish
=, format
::
@ -16,121 +16,5 @@
++ grab
|%
++ noun action
++ json
|= jon=^json
=, dejs:format
;; action
|^ %. jon
%- of
:~ new-book+new-book
new-note+new-note
new-comment+new-comment
edit-book+edit-book
edit-note+edit-note
edit-comment+edit-comment
del-book+del-book
del-note+del-note
del-comment+del-comment
subscribe+subscribe
unsubscribe+unsubscribe
read+read
groupify+groupify
==
::
++ new-book
%- ot
:~ book+so
title+so
about+so
coms+bo
group+group-info
==
::
++ new-note
%- ot
:~ who+(su fed:ag)
book+so
note+so
title+so
body+so
==
::
++ new-comment
%- ot
:~ who+(su fed:ag)
book+so
note+so
body+so
==
::
++ edit-book
%- ot
:~ book+so
title+so
about+so
coms+bo
group+(mu group-info)
==
::
++ edit-note
%- ot
:~ who+(su fed:ag)
book+so
note+so
title+so
body+so
==
::
++ edit-comment
%- ot
:~ who+(su fed:ag)
book+so
note+so
comment+so
body+so
==
::
++ del-book (ot book+so ~)
::
++ del-note (ot who+(su fed:ag) book+so note+so ~)
::
++ del-comment
%- ot
:~ who+(su fed:ag)
book+so
note+so
comment+so
==
++ subscribe
%- ot
:~ who+(su fed:ag)
book+so
==
++ unsubscribe
%- ot
:~ who+(su fed:ag)
book+so
==
++ read
%- ot
:~ who+(su fed:ag)
book+so
note+so
==
++ groupify
%- ot
:~ book+so
target+(mu pa)
inclusive+bo
==
++ group-info
%- ot
:~ group-path+pa
invitees+set-ship
use-preexisting+bo
make-managed+bo
==
++ set-ship (as (su fed:ag))
--
--
--

21
pkg/arvo/mar/publish/info.hoon
View File

@ -1,25 +1,12 @@
::
:::: /hoon/info/publish/mar
:: tombstoned, now unused
::
/- *publish
!:
|_ info=notebook-info
::
::
++ grow
|%
++ mime
:- /text/x-publish-info
(as-octs:mimes:html (of-wain:format txt))
++ txt
^- wain
:~ (cat 3 'title: ' title.info)
(cat 3 'description: ' description.info)
(cat 3 'comments: ' ?:(comments.info 'on' 'off'))
(cat 3 'writers: ' (spat writers.info))
(cat 3 'subscribers: ' (spat subscribers.info))
==
--
++ grab
|%
++ mime
@ -49,10 +36,10 @@
(key-val (jest 'description: ') (cook crip (star prn)))
%+ key-val (jest 'comments: ')
(cook |=(a=@ =(%on a)) ;~(pose (jest %on) (jest %off)))
(key-val (jest 'writers: ') ;~(pfix net (more net urs:ab)))
(key-val (jest 'writers: ') ;~(pfix fas (more fas urs:ab)))
;~ pose
(key-val (jest 'subscribers: ') ;~(pfix net (more net urs:ab)))
;~(pfix (jest 'subscribers: ') ;~(pfix net (more net urs:ab)))
(key-val (jest 'subscribers: ') ;~(pfix fas (more fas urs:ab)))
;~(pfix (jest 'subscribers: ') ;~(pfix fas (more fas urs:ab)))
==
==
++ both-parser

68
pkg/arvo/mar/publish/primary-delta.hoon
View File

@ -13,73 +13,5 @@
++ grow
|%
++ noun del
++ json
%+ frond:enjs:format %publish-update
%+ frond:enjs:format -.del
?- -.del
%add-book
%+ frond:enjs:format (scot %p host.del)
%+ frond:enjs:format book.del
(notebook-short:enjs data.del)
::
%add-note
%+ frond:enjs:format (scot %p host.del)
%+ frond:enjs:format book.del
(note-full:enjs note.del data.del)
::
%add-comment
%- pairs:enjs:format
:~ host+s+(scot %p host.del)
book+s+book.del
note+s+note.del
comment+(comment:enjs comment-date.del data.del)
==
::
%edit-book
%+ frond:enjs:format (scot %p host.del)
%+ frond:enjs:format book.del
(notebook-short:enjs data.del)
::
%edit-note
%+ frond:enjs:format (scot %p host.del)
%+ frond:enjs:format book.del
(note-full:enjs note.del data.del)
::
%edit-comment
%- pairs:enjs:format
:~ host+s+(scot %p host.del)
book+s+book.del
note+s+note.del
comment+(comment:enjs comment-date.del data.del)
==
::
%del-book
%- pairs:enjs:format
:~ host+s+(scot %p host.del)
book+s+book.del
==
::
%del-note
%- pairs:enjs:format
:~ host+s+(scot %p host.del)
book+s+book.del
note+s+note.del
==
::
%del-comment
%- pairs:enjs:format
:~ host+s+(scot %p host.del)
book+s+book.del
note+s+note.del
comment+s+(scot %da comment.del)
==
::
%read
%- pairs:enjs:format
:~ host+s+(scot %p who.del)
book+s+book.del
note+s+note.del
==
==
--
--

14
pkg/arvo/ren/publish/comments.hoon
View File

@ -1,14 +0,0 @@
/- publish
/+ publish
/= result
/^ (list comment:publish)
/;
|= comments=(map knot comment:publish)
^- (list [comment-info:publish @t])
%+ sort ~(val by comments)
|= [a=comment:publish b=comment:publish]
^- ?
(gte date-created.info.a date-created.info.b)
::
/_ /publish-comment/
result

20
pkg/arvo/ren/publish/post.hoon
View File

@ -1,20 +0,0 @@
/- publish
/+ publish, cram, elem-to-react-json
/= args /$ ,[beam *]
/= result
/^ [post-info:publish manx @t]
/;
|= $: post-front=(map knot cord)
post-content=manx
post-raw=wain
~
==
:+ (front-to-post-info:publish post-front)
post-content
(of-wain:format (slag 11 post-raw))
::
/. /&front&/udon/
/&elem&/udon/
/&txt&/udon/
==
result

10
pkg/arvo/ren/run.hoon
View File

@ -1,10 +0,0 @@
:: For testing purposes
::
:::: /hoon/run/ren
::
/? 310
/, /ren/run /~ ~|(%loop !!)
/ /!noun/
==
~& run+-.-
~

4
pkg/arvo/ren/test-gen.hoon
View File

@ -1,4 +0,0 @@
/+ test-runner
/= test-core /!noun/
::
(get-test-arms:test-runner !>(test-core))

2
pkg/arvo/sur/graph-store.hoon
View File

@ -42,7 +42,7 @@
::
+$ update-0
$% logged-update-0
[%add-graph =resource =graph mark=(unit mark)]
[%add-graph =resource =graph mark=(unit mark) overwrite=?]
[%remove-graph =resource]
::
[%add-tag =term =resource]

15
pkg/arvo/sur/hark-chat-hook.hoon Normal file
View File

@ -0,0 +1,15 @@
^?
|%
+$ action
$% [?(%listen %ignore) chat=path]
[%set-mentions mentions=?]
==
::
+$ update
$%
action
$: %initial
watching=(set path)
==
==
--

20
pkg/arvo/sur/hark-graph-hook.hoon Normal file
View File

@ -0,0 +1,20 @@
/- *resource, graph-store, post
^?
|%
+$ action
$%
[?(%listen %ignore) graph=resource =index:post]
[%set-mentions mentions=?]
[%set-watch-on-self watch-on-self=?]
==
::
+$ update
$%
action
$: %initial
watching=(set [resource index:post])
mentions=_&
watch-on-self=_&
==
==
--

11
pkg/arvo/sur/hark-group-hook.hoon Normal file
View File

@ -0,0 +1,11 @@
/- *resource
^?
|%
+$ action
[?(%listen %ignore) group=resource]
::
+$ update
$% action
[%initial watching=(set resource)]
==
--

52
pkg/arvo/sur/hark-store.hoon Normal file
View File

@ -0,0 +1,52 @@
/- *resource, graph-store, post, group-store, metadata-store, chat-store
^?
|%
+$ index
$% [%graph group=resource graph=resource module=@t description=@t]
[%group group=resource description=@t]
[%chat chat=path mention=?]
==
::
+$ group-contents
$~ [%add-members *resource ~]
$% $>(?(%add-members %remove-members) update:group-store)
metadata-action:metadata-store
==
::
+$ notification
[date=@da read=? =contents]
::
+$ contents
$% [%graph =(list post:post)]
[%group =(list group-contents)]
[%chat =(list envelope:chat-store)]
==
::
+$ timebox
(map index notification)
::
+$ notifications
((mop @da timebox) gth)
::
+$ action
$% [%add =index =notification]
[%archive time=@da index]
[%read time=@da index]
[%read-index index]
[%unread time=@da index]
[%set-dnd dnd=?]
[%seen ~]
==
::
++ indexed-notification
[index notification]
::
+$ update
$% action
[%more more=(list update)]
[%added time=@da =index =notification]
[%timebox time=@da archived=? =(list [index notification])]
[%count count=@ud]
[%unreads unreads=(list [index @ud])]
==
--

40
pkg/arvo/sur/invite-store.hoon
View File

@ -1,45 +1,49 @@
/- *resource
|%
++ serial @uvH
::
+$ invite
$: =ship :: ship to subscribe to upon accepting invite
app=@tas :: app to subscribe to upon accepting invite
=path :: path to subscribe to upon accepting invite
=resource :: resource to subscribe to upon accepting invite
recipient=ship :: recipient to receive invite
text=cord :: text to describe the invite
==
::
:: +invites: each application using invites creates its own path that
+$ multi-invite
$: =ship :: ship to subscribe to upon accepting invite
app=@tas :: app to subscribe to upon accepting invite
=resource :: resource to subscribe to upon accepting invite
recipients=(set ship) :: recipient to receive invite
text=cord :: text to describe the invite
==
::
:: +invites: each application using invites creates its own resource that
:: contains a map of serial to invite. this allows it to only receive
:: invites that it is concerned with
::
+$ invites (map path invitatory) :: main data structure
+$ invites (map term invitatory) :: main data structure
::
+$ invitatory (map serial invite) :: containing or conveying an invitation
::
::
+$ invite-base
$% [%create =path] :: create a path
[%delete =path] :: delete a path
[%invite =path uid=serial =invite] :: receive an invite at path/uid
[%decline =path uid=serial] :: decline an invite at path/uid
$% [%create =term] :: create a resource
[%delete =term] :: delete a resource
[%invite =term uid=serial =invite] :: receive an invite at term/uid
[%decline =term uid=serial] :: decline an invite at term/uid
==
::
+$ invite-action
+$ action
$% invite-base
[%accept =path uid=serial] :: accept an invite at path/uid
[%accept =term uid=serial] :: accept an invite at term/uid
[%invites =term uid=serial invites=multi-invite]
==
::
+$ invite-update
+$ update
$% invite-base
[%initial =invites]
[%invitatory =invitatory] :: receive invitatory
[%accepted =path uid=serial =invite] :: an invite has been accepted
==
::
+$ invite-diff
$% [%invite-initial invites]
[%invite-update invite-update]
[%invitatory =invitatory] :: receive invitatory
[%accepted =term uid=serial =invite] :: an invite has been accepted
==
--

7
pkg/arvo/sur/observe-hook.hoon Normal file
View File

@ -0,0 +1,7 @@
|%
+$ observer [app=term =path thread=term]
+$ action
$% [%watch =observer]
[%ignore =observer]
==
--

1
pkg/arvo/sur/post.hoon
View File

@ -28,6 +28,7 @@
::
+$ content
$% [%text text=cord]
[%mention =ship]
[%url url=cord]
[%code expression=cord output=(list tank)]
[%reference =uid]

372
pkg/arvo/sys/hoon.hoon
View File

@ -5595,47 +5595,59 @@
::
:::: 4h: parsing (ascii glyphs)
::
++ ace (just ' ')
++ ban (just '>')
++ bar (just '|')
++ bas (just '\\') :: XX deprecated
++ bat (just '\\')
++ buc (just '$') :: XX deprecated
++ bus (just '$')
++ cab (just '_')
++ cen (just '%')
++ col (just ':')
++ com (just ',')
++ dot (just '.')
++ fas (just '/') :: XX deprecated?
++ gal (just '<') :: XX deprecated
++ gar (just '>') :: XX deprecated
++ vat (just '@') :: pronounced "at"
++ hax (just '#')
++ hep (just '-') :: pronounced "ep"
++ ket (just '^')
++ leb (just '{')
++ led (just '<')
++ lob (just '{')
++ lit (just '(')
++ lac (just '[')
++ lus (just '+')
++ mic (just ';') :: pronounced "mick"
++ net (just '/')
++ pad (just '&')
++ rac (just ']')
++ reb (just '}')
++ rob (just '}')
++ rit (just ')')
++ say (just '\'')
++ sig (just '~')
++ tar (just '*')
++ tec (just '`')
++ tis (just '=') :: pronounced "is"
++ toc (just '"') :: XX deprecated
++ yel (just '"')
++ wut (just '?')
++ zap (just '!')
++ ace (just ' ') :: spACE
++ bar (just '|') :: vertical BAR
++ bas (just '\\') :: Back Slash (escaped)
++ buc (just '$') :: dollars BUCks
++ cab (just '_') :: CABoose
++ cen (just '%') :: perCENt
++ col (just ':') :: COLon
++ com (just ',') :: COMma
++ doq (just '"') :: Double Quote
++ dot (just '.') :: dot dot dot ...
++ fas (just '/') :: Forward Slash
++ gal (just '<') :: Greater Left
++ gar (just '>') :: Greater Right
++ hax (just '#') :: Hash
++ hep (just '-') :: HyPhen
++ kel (just '{') :: Curly Left
++ ker (just '}') :: Curly Right
++ ket (just '^') :: CareT
++ lus (just '+') :: pLUS
++ mic (just ';') :: seMIColon
++ pal (just '(') :: Paren Left
++ pam (just '&') :: AMPersand pampersand
++ par (just ')') :: Paren Right
++ pat (just '@') :: AT pat
++ sel (just '[') :: Square Left
++ ser (just ']') :: Square Right
++ sig (just '~') :: SIGnature squiggle
++ soq (just '\'') :: Single Quote
++ tar (just '*') :: sTAR
++ tic (just '`') :: backTiCk
++ tis (just '=') :: 'tis tis, it is
++ wut (just '?') :: wut, what?
++ zap (just '!') :: zap! bang! crash!!
::
++ ban (just '>') :: XX deprecated, use gar
++ bat (just '\\') :: XX deprecated, use bas
++ bus (just '$') :: XX deprecated, use buc
++ lac (just '[') :: XX deprecated, use sel
++ leb (just '{') :: XX deprecated, use kel
++ led (just '<') :: XX deprecated, use gal
++ lit (just '(') :: XX deprecated, use pal
++ lob (just '{') :: XX deprecated, use kel
++ net (just '/') :: XX deprecated, use fas
++ pad (just '&') :: XX deprecated, use pam
++ rac (just ']') :: XX deprecated, use ser
++ reb (just '}') :: XX deprecated, use ker
++ rit (just ')') :: XX deprecated, use par
++ rob (just '}') :: XX deprecated, use ker
++ say (just '\'') :: XX deprecated, use soq
++ tec (just '`') :: XX deprecated, use tic
++ toc (just '"') :: XX deprecated, use doq
++ vat (just '@') :: XX deprecated, use pat
++ yel (just '"') :: XX deprecated, use doq
::
:::: 4i: parsing (useful idioms)
::
@ -5662,8 +5674,8 @@
==
++ gaw (cold ~ (star ;~(pose vul gah))) :: classic white
++ gay ;~(pose gap (easy ~)) ::
++ gon ;~(pose ;~(plug bat gay net) (easy ~)) :: long numbers \ /
++ gul ;~(pose (cold 2 led) (cold 3 ban)) :: axis syntax < >
++ gon ;~(pose ;~(plug bas gay fas) (easy ~)) :: long numbers \ /
++ gul ;~(pose (cold 2 gal) (cold 3 gar)) :: axis syntax < >
++ hex (bass 16 (most gon hit)) :: hex to atom
++ hig (shim 'A' 'Z') :: uppercase
++ hit ;~ pose :: hex digits
@ -5703,13 +5715,13 @@
;~(less ;~(plug (just `@`10) soz) (just `@`10))
==
++ qit ;~ pose :: chars in a cord
;~(less bat say prn)
;~(pfix bat ;~(pose bat say mes)) :: escape chars
;~(less bas soq prn)
;~(pfix bas ;~(pose bas soq mes)) :: escape chars
==
++ qut ;~ simu say :: cord
++ qut ;~ simu soq :: cord
;~ pose
;~ less soz
(ifix [say say] (boss 256 (more gon qit)))
(ifix [soq soq] (boss 256 (more gon qit)))
==
=+ hed=;~(pose ;~(plug (plus ace) vul) (just '\0a'))
%- iny %+ ifix
@ -5718,7 +5730,7 @@
(boss 256 (star qat))
==
==
++ soz ;~(plug say say say) :: delimiting '''
++ soz ;~(plug soq soq soq) :: delimiting '''
++ sym :: symbol
%+ cook
|=(a/tape (rap 3 ^-((list @) a)))
@ -5819,7 +5831,7 @@
(cook tuft (ifix [sig dot] hex))
;~(pfix sig ;~(pose sig dot))
==
++ voy ;~(pfix bat ;~(pose bat say bix))
++ voy ;~(pfix bas ;~(pose bas soq bix))
--
++ ag
|%
@ -6356,7 +6368,7 @@
++ spat |=(pax/path (crip (spud pax))) :: render path to cord
++ spud |=(pax/path ~(ram re (smyt pax))) :: render path to tape
++ stab :: parse cord to path
=+ fel=;~(pfix net (more net urs:ab))
=+ fel=;~(pfix fas (more fas urs:ab))
|=(zep/@t `path`(rash zep fel))
::
:::: 4n: virtualization
@ -9754,18 +9766,7 @@
^- (pair type type)
(~(mull et hyp rig) gol dox)
::
++ felt
~/ %felt
|= lap/opal
^- type
?- -.lap
%& p.lap
%| %- fork
%+ turn ~(tap in q.lap)
|= [a=type *]
?> ?=([%core *] a)
[%core q.q.a q.a]
==
++ felt !!
:: ::
++ feel :: detect existence
|= rot/(list wing)
@ -9814,7 +9815,12 @@
==
::
%&
=. sut (felt q.p.mor)
=. sut
=* lap q.p.mor
?- -.lap
%& p.lap
%| (fork (turn ~(tap in q.lap) head))
==
=> :_ +
:* axe=`axis`1
lon=p.p.mor
@ -12176,7 +12182,7 @@
++ gash %+ cook :: parse path
|= a/(list tyke) ^- tyke
?~(a ~ (weld i.a $(a t.a)))
(more net limp)
(more fas limp)
++ gasp ;~ pose :: parse =path= etc.
%+ cook
|=({a/tyke b/tyke c/tyke} :(weld a b c))
@ -12189,9 +12195,9 @@
==
++ glam ~+((glue ace))
++ hasp ;~ pose :: path element
(ifix [lac rac] wide)
(stag %cncl (ifix [lit rit] (most ace wide)))
(stag %sand (stag %tas (cold %$ bus)))
(ifix [sel ser] wide)
(stag %cncl (ifix [pal par] (most ace wide)))
(stag %sand (stag %tas (cold %$ buc)))
(stag %sand (stag %t qut))
%+ cook
|=(a/coin [%sand ?:(?=({~ $tas *} a) %tas %ta) ~(rent co a)])
@ -12201,7 +12207,7 @@
|= {a/(list) b/tyke}
?~ a b
$(a t.a, b [`[%sand %tas %$] b])
;~(plug (star net) gasp)
;~(plug (star fas) gasp)
++ mota %+ cook
|=({a/tape b/tape} (rap 3 (weld a b)))
;~(plug (star low) (star hig))
@ -12257,7 +12263,7 @@
++ body
;~ pose
;~ plug :: can duplicate ::
(into ;~(pfix (punt ;~(plug null col ban step)) line))
(into ;~(pfix (punt ;~(plug null col gar step)) line))
(easy ~)
==
;~ plug
@ -12289,11 +12295,11 @@
::
++ indo
|* bod/rule
;~(pfix col ban ;~(sfix bod (just `@`10) (punt gap)))
;~(pfix col gar ;~(sfix bod (just `@`10) (punt gap)))
::
++ exit
|* bod/rule
;~(pfix (star ace) col led step bod)
;~(pfix (star ace) col gal step bod)
::
:: fill: full definition
::
@ -12379,7 +12385,7 @@
++ porc
;~ plug
(cook |=(a/(list) (lent a)) (star cen))
;~(pfix net gash)
;~(pfix fas gash)
==
::
++ rump
@ -12389,7 +12395,7 @@
;~(plug rope ;~(pose (stag ~ wede) (easy ~)))
::
++ rood
;~ pfix net
;~ pfix fas
(stag %clsg poor)
==
::
@ -12478,7 +12484,7 @@
++ wide-attrs :: wide attributes
%+ cook |=(a/(unit mart:hoot) (fall a ~))
%- punt
%+ ifix [lit rit]
%+ ifix [pal par]
%+ more (jest ', ')
;~((glue ace) a-mane hopefully-quote)
::
@ -12494,7 +12500,7 @@
++ wide-paren-elems :: wide flow
%+ cook |=(a/marl:hoot a)
%+ cook join-tops
(ifix [lit rit] (more ace wide-inner-top))
(ifix [pal par] (more ace wide-inner-top))
::
::+|
::
@ -12515,7 +12521,7 @@
%+ cook |=(a/marl:hoot a)
;~ pose
;~ less (jest '"""')
(ifix [yel yel] (cook collapse-chars quote-innards))
(ifix [doq doq] (cook collapse-chars quote-innards))
==
::
%- inde
@ -12527,14 +12533,14 @@
%+ cook |=(a/(list $@(@ tuna:hoot)) a)
%- star
;~ pose
;~(pfix bas ;~(pose (mask "-+*%;\{") bas yel bix:ab))
;~(pfix bas ;~(pose (mask "-+*%;\{") bas doq bix:ab))
inline-embed
;~(less bas lob ?:(in-tall-form fail toc) prn)
;~(less bas kel ?:(in-tall-form fail doq) prn)
?:(lin fail ;~(less (jest '\0a"""') (just '\0a')))
==
::
++ bracketed-elem :: bracketed element
%+ ifix [lob rob]
%+ ifix [kel ker]
;~(plug tag-head wide-elems)
::
++ wrapped-elems :: wrapped tuna
@ -12587,7 +12593,7 @@
;~ plug
(punt ;~(plug (cold %id hax) (cook trip sym)))
(cook en-class (star ;~(plug (cold %class dot) sym)))
(punt ;~(plug ;~(pose (cold %href net) (cold %src vat)) soil))
(punt ;~(plug ;~(pose (cold %href fas) (cold %src pat)) soil))
(easy ~)
==
::
@ -12604,7 +12610,7 @@
(stag %& tall-elem)
(stag %| wide-quote)
(stag %| ;~(pfix tis tall-tail))
(stag %& ;~(pfix ban gap (stag [%div ~] cram)))
(stag %& ;~(pfix gar gap (stag [%div ~] cram)))
(stag %| ;~(plug ;~((glue gap) tuna-mode tall) (easy ~)))
(easy %| [;/("\0a")]~)
==
@ -13067,20 +13073,20 @@
(cold [%end %stet] duz) :: == end of markdown
::
(cold [%one %rule] ;~(plug hep hep hep)) :: --- horizontal ruler
(cold [%one %fens] ;~(plug tec tec tec)) :: ``` code fence
(cold [%one %fens] ;~(plug tic tic tic)) :: ``` code fence
(cold [%one %expr] mic) :: ;sail expression
::
(cold [%new %head] ;~(plug (star hax) ace)) :: # heading
(cold [%new %lint] ;~(plug hep ace)) :: - line item
(cold [%new %lite] ;~(plug lus ace)) :: + line item
(cold [%new %bloc] ;~(plug ban ace)) :: > block-quote
(cold [%new %bloc] ;~(plug gar ace)) :: > block-quote
::
(easy [%old %text]) :: anything else
==
==
::
::
++ calf :: cash but for tec tec
++ calf :: cash but for tic tic
|* tem=rule
%- star
;~ pose
@ -13187,17 +13193,17 @@
::
:: "quoted text"
::
(stag %quod (ifix [yel yel] (cool (cash yel) werk)))
(stag %quod (ifix [doq doq] (cool (cash doq) werk)))
::
:: `classic markdown quote`
::
(stag %code (ifix [tec tec] (calf tec)))
(stag %code (ifix [tic tic] (calf tic)))
::
:: ++arm, +-arm, +$arm, +*arm, ++arm:core, ...
::
%+ stag %code
;~ plug
lus ;~(pose lus hep bus tar)
lus ;~(pose lus hep buc tar)
low (star ;~(pose nud low hep col))
==
::
@ -13205,8 +13211,8 @@
::
%+ stag %link
;~ (glue (punt whit))
(ifix [lac rac] (cool (cash rac) werk))
(ifix [lit rit] (cash rit))
(ifix [sel ser] (cool (cash ser) werk))
(ifix [pal par] (cash par))
==
::
:: ![alt text](url)
@ -13214,8 +13220,8 @@
%+ stag %mage
;~ pfix zap
;~ (glue (punt whit))
(ifix [lac rac] (cash rac))
(ifix [lit rit] (cash rit))
(ifix [sel ser] (cash ser))
(ifix [pal par] (cash par))
==
==
::
@ -13243,7 +13249,7 @@
tash:so
;~(pfix dot perd:so)
;~(pfix sig ;~(pose twid:so (easy [%$ %n 0])))
;~(pfix cen ;~(pose sym bus pad bar qut nuck:so))
;~(pfix cen ;~(pose sym buc pam bar qut nuck:so))
==
::
;~(simu whit (easy ~))
@ -13313,22 +13319,22 @@
%+ cold [[%hr ~] ~]~
;~(plug (star ace) hep hep hep (star hep) (just '\0a'))
::
++ tecs
;~(plug tec tec tec (just '\0a'))
++ tics
;~(plug tic tic tic (just '\0a'))
::
++ fens
|= col/@u ~+
=/ ind (stun [(dec col) (dec col)] ace)
=/ ind-tecs ;~(plug ind tecs)
=/ ind-tics ;~(plug ind tics)
%+ cook |=(txt/tape `tarp`[[%pre ~] ;/(txt) ~]~)
::
:: leading outdent is ok since container may
:: have already been parsed and consumed
%+ ifix [;~(plug (star ace) tecs) ind-tecs]
%+ ifix [;~(plug (star ace) tics) ind-tics]
%^ stir "" |=({a/tape b/tape} "{a}\0a{b}")
;~ pose
%+ ifix [ind (just '\0a')]
;~(less tecs (star prn))
;~(less tics (star prn))
::
(cold "" ;~(plug (star ace) (just '\0a')))
==
@ -13396,11 +13402,11 @@
;~(pfix com (stag %bsmc wide))
:- '$'
;~ pose
;~ pfix bus
;~ pfix buc
;~ pose
:: XX all three deprecated
::
(stag %leaf (stag %tas (cold %$ bus)))
(stag %leaf (stag %tas (cold %$ buc)))
(stag %leaf (stag %t qut))
(stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so))
==
@ -13411,8 +13417,8 @@
;~ pose
;~ pfix cen
;~ pose
(stag %leaf (stag %tas (cold %$ bus)))
(stag %leaf (stag %f (cold & pad)))
(stag %leaf (stag %tas (cold %$ buc)))
(stag %leaf (stag %f (cold & pam)))
(stag %leaf (stag %f (cold | bar)))
(stag %leaf (stag %t qut))
(stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so))
@ -13422,7 +13428,7 @@
:- '('
%+ cook |=(spec +<)
%+ stag %make
%+ ifix [lit rit]
%+ ifix [pal par]
;~ plug
wide
;~(pose ;~(pfix ace (most ace wyde)) (easy ~))
@ -13430,19 +13436,19 @@
:- '{'
:: XX deprecated
::
(stag %bscl (ifix [lob rob] (most ace wyde)))
(stag %bscl (ifix [kel ker] (most ace wyde)))
:- '['
(stag %bscl (ifix [lac rac] (most ace wyde)))
(stag %bscl (ifix [sel ser] (most ace wyde)))
:- '*'
(cold [%base %noun] tar)
:- '/'
;~(pfix net (stag %loop ;~(pose (cold %$ bus) sym)))
;~(pfix fas (stag %loop ;~(pose (cold %$ buc) sym)))
:- '@'
;~(pfix vat (stag %base (stag %atom mota)))
;~(pfix pat (stag %base (stag %atom mota)))
:- '?'
;~ pose
%+ stag %bswt
;~(pfix wut (ifix [lit rit] (most ace wyde)))
;~(pfix wut (ifix [pal par] (most ace wyde)))
::
(cold [%base %flag] wut)
==
@ -13471,7 +13477,7 @@
==
:- ['a' 'z']
;~ pose
(stag %bsts ;~(plug sym ;~(pfix ;~(pose net tis) wyde)))
(stag %bsts ;~(plug sym ;~(pfix ;~(pose fas tis) wyde)))
(stag %like (most col rope))
==
==
@ -13495,11 +13501,11 @@
;~(pfix cab (stag %ktcl (stag %bscb wide)))
:- '$'
;~ pose
;~ pfix bus
;~ pfix buc
;~ pose
:: XX: these are all obsolete in hoon 142
::
(stag %leaf (stag %tas (cold %$ bus)))
(stag %leaf (stag %tas (cold %$ buc)))
(stag %leaf (stag %t qut))
(stag %leaf (sear |=(a/coin ?:(?=($$ -.a) (some +.a) ~)) nuck:so))
==
@ -13510,8 +13516,8 @@
;~ pfix cen
;~ pose
(stag %clsg (sear |~({a/@ud b/tyke} (posh ~ ~ a b)) porc))
(stag %rock (stag %tas (cold %$ bus)))
(stag %rock (stag %f (cold & pad)))
(stag %rock (stag %tas (cold %$ buc)))
(stag %rock (stag %f (cold & pam)))
(stag %rock (stag %f (cold | bar)))
(stag %rock (stag %t qut))
(cook (jock &) nuck:so)
@ -13521,26 +13527,26 @@
:- '&'
;~ pose
(cook |=(a/wing [%cnts a ~]) rope)
(stag %wtpd ;~(pfix pad (ifix [lit rit] (most ace wide))))
;~(plug (stag %rock (stag %f (cold & pad))) wede)
(stag %sand (stag %f (cold & pad)))
(stag %wtpd ;~(pfix pam (ifix [pal par] (most ace wide))))
;~(plug (stag %rock (stag %f (cold & pam))) wede)
(stag %sand (stag %f (cold & pam)))
==
:- '\''
(stag %sand (stag %t qut))
:- '('
(stag %cncl (ifix [lit rit] (most ace wide)))
(stag %cncl (ifix [pal par] (most ace wide)))
:- '{'
(stag %ktcl (stag %bscl (ifix [lob rob] (most ace wyde))))
(stag %ktcl (stag %bscl (ifix [kel ker] (most ace wyde))))
:- '*'
;~ pose
(stag %kttr ;~(pfix tar wyde))
(cold [%base %noun] tar)
==
:- '@'
;~(pfix vat (stag %base (stag %atom mota)))
;~(pfix pat (stag %base (stag %atom mota)))
:- '+'
;~ pose
(stag %dtls ;~(pfix lus (ifix [lit rit] wide)))
(stag %dtls ;~(pfix lus (ifix [pal par] wide)))
::
%+ cook
|= a/(list (list woof))
@ -13574,14 +13580,14 @@
:- ':'
;~ pfix col
;~ pose
(stag %mccl (ifix [lit rit] (most ace wide)))
;~(pfix net (stag %mcnt wide))
(stag %mccl (ifix [pal par] (most ace wide)))
;~(pfix fas (stag %mcnt wide))
==
==
:- '='
;~ pfix tis
;~ pose
(stag %dtts (ifix [lit rit] ;~(glam wide wide)))
(stag %dtts (ifix [pal par] ;~(glam wide wide)))
::
%+ sear
:: mainly used for +skin formation
@ -13596,7 +13602,7 @@
:- '?'
;~ pose
%+ stag %ktcl
(stag %bswt ;~(pfix wut (ifix [lit rit] (most ace wyde))))
(stag %bswt ;~(pfix wut (ifix [pal par] (most ace wyde))))
::
(cold [%base %flag] wut)
==
@ -13608,16 +13614,16 @@
(cold [%base %cell] ket)
==
:- '`'
;~ pfix tec
;~ pfix tic
;~ pose
%+ cook
|=({a/@ta b/hoon} [%ktls [%sand a 0] [%ktls [%sand %$ 0] b]])
;~(pfix vat ;~(plug mota ;~(pfix tec wide)))
;~(pfix pat ;~(plug mota ;~(pfix tic wide)))
;~ pfix tar
(stag %kthp (stag [%base %noun] ;~(pfix tec wide)))
(stag %kthp (stag [%base %noun] ;~(pfix tic wide)))
==
(stag %kthp ;~(plug wyde ;~(pfix tec wide)))
(stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tec wide))))
(stag %kthp ;~(plug wyde ;~(pfix tic wide)))
(stag %ktls ;~(pfix lus ;~(plug wide ;~(pfix tic wide))))
(cook |=(a/hoon [[%rock %n ~] a]) wide)
==
==
@ -13631,7 +13637,7 @@
:- '|'
;~ pose
(cook |=(a/wing [%cnts a ~]) rope)
(stag %wtbr ;~(pfix bar (ifix [lit rit] (most ace wide))))
(stag %wtbr ;~(pfix bar (ifix [pal par] (most ace wide))))
;~(plug (stag %rock (stag %f (cold | bar))) wede)
(stag %sand (stag %f (cold | bar)))
==
@ -13641,11 +13647,11 @@
::
;~ pfix sig
;~ pose
(stag %clsg (ifix [lac rac] (most ace wide)))
(stag %clsg (ifix [sel ser] (most ace wide)))
::
%+ stag %cnsg
%+ ifix
[lit rit]
[pal par]
;~(glam rope wide (most ace wide))
::
(cook (jock |) twid:so)
@ -13657,18 +13663,18 @@
:- '/'
rood
:- '<'
(ifix [led ban] (stag %tell (most ace wide)))
(ifix [gal gar] (stag %tell (most ace wide)))
:- '>'
(ifix [ban led] (stag %yell (most ace wide)))
(ifix [gar gal] (stag %yell (most ace wide)))
==
++ soil
;~ pose
;~ less (jest '"""')
%+ ifix [yel yel]
%+ ifix [doq doq]
%- star
;~ pose
;~(pfix bas ;~(pose bas yel lob bix:ab))
;~(less yel bas lob prn)
;~(pfix bas ;~(pose bas doq kel bix:ab))
;~(less doq bas kel prn)
(stag ~ sump)
==
==
@ -13677,13 +13683,13 @@
[(jest '"""\0a') (jest '\0a"""')]
%- star
;~ pose
;~(pfix bas ;~(pose bas lob bix:ab))
;~(less bas lob prn)
;~(pfix bas ;~(pose bas kel bix:ab))
;~(less bas kel prn)
;~(less (jest '\0a"""') (just `@`10))
(stag ~ sump)
==
==
++ sump (ifix [lob rob] (stag %cltr (most ace wide)))
++ sump (ifix [kel ker] (stag %cltr (most ace wide)))
++ norm :: rune regular form
|= tol/?
|%
@ -13691,18 +13697,18 @@
%- stew
^. stet ^. limo
:~ :- '$'
;~ pfix bus
;~ pfix buc
%- stew
^. stet ^. limo
:~ [':' (rune col %bscl exqs)]
['%' (rune cen %bscn exqs)]
['<' (rune led %bsld exqb)]
['>' (rune ban %bsbn exqb)]
['<' (rune gal %bsld exqb)]
['>' (rune gar %bsbn exqb)]
['^' (rune ket %bskt exqb)]
['~' (rune sig %bssg exqd)]
['|' (rune bar %bsbr exqc)]
['&' (rune pad %bspd exqc)]
['@' (rune vat %bsvt exqb)]
['&' (rune pam %bspd exqc)]
['@' (rune pat %bsvt exqb)]
['_' (rune cab %bscb expa)]
['-' (rune hep %bshp exqb)]
['=' (rune tis %bsts exqg)]
@ -13749,7 +13755,7 @@
^. stet ^. limo
:~ ['_' (rune cab %brcb exqr)]
['%' (runo cen %brcn ~ expe)]
['@' (runo vat %brvt ~ expe)]
['@' (runo pat %brvt ~ expe)]
[':' (rune col %brcl expb)]
['.' (rune dot %brdt expa)]
['-' (rune hep %brhp expa)]
@ -13758,21 +13764,21 @@
['*' (rune tar %brtr exqc)]
['=' (rune tis %brts exqc)]
['?' (rune wut %brwt expa)]
['$' (rune bus %brbs exqe)]
['$' (rune buc %brbs exqe)]
==
==
:- '$'
;~ pfix bus
;~ pfix buc
%- stew
^. stet ^. limo
:~ ['@' (stag %ktcl (rune vat %bsvt exqb))]
:~ ['@' (stag %ktcl (rune pat %bsvt exqb))]
['_' (stag %ktcl (rune cab %bscb expa))]
[':' (stag %ktcl (rune col %bscl exqs))]
['%' (stag %ktcl (rune cen %bscn exqs))]
['<' (stag %ktcl (rune led %bsld exqb))]
['>' (stag %ktcl (rune ban %bsbn exqb))]
['<' (stag %ktcl (rune gal %bsld exqb))]
['>' (stag %ktcl (rune gar %bsbn exqb))]
['|' (stag %ktcl (rune bar %bsbr exqc))]
['&' (stag %ktcl (rune pad %bspd exqc))]
['&' (stag %ktcl (rune pam %bspd exqc))]
['^' (stag %ktcl (rune ket %bskt exqb))]
['~' (stag %ktcl (rune sig %bssg exqd))]
['-' (stag %ktcl (rune hep %bshp exqb))]
@ -13828,7 +13834,7 @@
['.' (rune dot %ktdt expb)]
['-' (rune hep %kthp exqc)]
['+' (rune lus %ktls expb)]
['&' (rune pad %ktpd expa)]
['&' (rune pam %ktpd expa)]
['~' (rune sig %ktsg expa)]
['=' (rune tis %ktts expj)]
['?' (rune wut %ktwt expa)]
@ -13842,14 +13848,14 @@
%- stew
^. stet ^. limo
:~ ['|' (rune bar %sgbr expb)]
['$' (rune bus %sgbs expf)]
['$' (rune buc %sgbs expf)]
['_' (rune cab %sgcb expb)]
['%' (rune cen %sgcn hind)]
['/' (rune net %sgnt hine)]
['<' (rune led %sgld hinb)]
['>' (rune ban %sgbn hinb)]
['/' (rune fas %sgnt hine)]
['<' (rune gal %sgld hinb)]
['>' (rune gar %sgbn hinb)]
['+' (rune lus %sgls hinc)]
['&' (rune pad %sgpd hinf)]
['&' (rune pam %sgpd hinf)]
['?' (rune wut %sgwt hing)]
['=' (rune tis %sgts expb)]
['!' (rune zap %sgzp expb)]
@ -13860,7 +13866,7 @@
%- stew
^. stet ^. limo
:~ [':' (rune col %mccl expi)]
['/' (rune net %mcnt expa)]
['/' (rune fas %mcnt expa)]
['<' (rune gal %mcgl exp1)]
['~' (rune sig %mcsg expi)]
[';' (rune mic %mcmc exqc)]
@ -13875,10 +13881,10 @@
['?' (rune wut %tswt expw)]
['^' (rune ket %tskt expt)]
[':' (rune col %tscl expp)]
['/' (rune net %tsnt expo)]
['/' (rune fas %tsnt expo)]
[';' (rune mic %tsmc expo)]
['<' (rune led %tsld expb)]
['>' (rune ban %tsbn expb)]
['<' (rune gal %tsld expb)]
['>' (rune gar %tsbn expb)]
['-' (rune hep %tshp expb)]
['*' (rune tar %tstr expg)]
[',' (rune com %tscm expb)]
@ -13893,15 +13899,15 @@
:~ ['|' (rune bar %wtbr exps)]
[':' (rune col %wtcl expc)]
['.' (rune dot %wtdt expc)]
['<' (rune led %wtld expb)]
['>' (rune ban %wtbn expb)]
['<' (rune gal %wtld expb)]
['>' (rune gar %wtbn expb)]
['-' ;~(pfix hep (toad txhp))]
['^' ;~(pfix ket (toad tkkt))]
['=' ;~(pfix tis (toad txts))]
['#' ;~(pfix hax (toad txhx))]
['+' ;~(pfix lus (toad txls))]
['&' (rune pad %wtpd exps)]
['@' ;~(pfix vat (toad tkvt))]
['&' (rune pam %wtpd exps)]
['@' ;~(pfix pat (toad tkvt))]
['~' ;~(pfix sig (toad tksg))]
['!' (rune zap %wtzp expa)]
==
@ -13914,9 +13920,9 @@
['.' ;~(pfix dot (toad |.(loaf(bug |))))]
[',' (rune com %zpcm expb)]
[';' (rune mic %zpmc expb)]
['>' (rune ban %zpbn expa)]
['<' (rune led %zpld exqc)]
['@' (rune vat %zpvt expy)]
['>' (rune gar %zpbn expa)]
['<' (rune gal %zpld exqc)]
['@' (rune pat %zpvt expy)]
['=' (rune tis %zpts expa)]
['?' (rune wut %zpwt hinh)]
==
@ -13931,7 +13937,7 @@
(jest '+-') :: XX deprecated
==
;~ plug
;~(pfix gap ;~(pose (cold %$ bus) sym))
;~(pfix gap ;~(pose (cold %$ buc) sym))
;~(pfix gap loaf)
==
==
@ -13965,14 +13971,14 @@
;~ pfix (jest '+*')
;~ plug
;~(pfix gap sym)
;~(pfix gap (ifix [lac rac] (most ace sym)))
;~(pfix gap (ifix [sel ser] (most ace sym)))
;~(pfix gap loan)
==
==
==
:: parses a or [a b c] or a b c ==
++ lynx
=/ wid (ifix [lac rac] (most ace sym))
=/ wid (ifix [sel ser] (most ace sym))
=/ tal
;~ sfix
(most gap sym)
@ -14052,7 +14058,7 @@
++ toad :: untrap parser exp
=+ har=expa
|@ ++ $
=+ dur=(ifix [lit rit] $:har(tol |))
=+ dur=(ifix [pal par] $:har(tol |))
?:(tol ;~(pose ;~(pfix gap $:har(tol &)) dur) dur)
--
::
@ -14203,12 +14209,12 @@
++ hine |.(;~(gunk bonk loaf)) :: jet-hint and hoon
++ hinf |. :: 0-3 >s, two hoons
;~ pose
;~(gunk (cook lent (stun [1 3] ban)) loaf loaf)
;~(gunk (cook lent (stun [1 3] gar)) loaf loaf)
(stag 0 ;~(gunk loaf loaf))
==
++ hing |. :: 0-3 >s, three hoons
;~ pose
;~(gunk (cook lent (stun [1 3] ban)) loaf loaf loaf)
;~(gunk (cook lent (stun [1 3] gar)) loaf loaf loaf)
(stag 0 ;~(gunk loaf loaf loaf))
==
++ bonk :: jet signature
@ -14224,7 +14230,7 @@
;~ gunk
;~ pose
dem
(ifix [lac rac] ;~(plug dem ;~(pfix ace dem)))
(ifix [sel ser] ;~(plug dem ;~(pfix ace dem)))
==
loaf
==
@ -14237,7 +14243,7 @@
;~ pose
(cold ~ sig)
%+ ifix
?:(tol [;~(plug duz gap) ;~(plug gap duz)] [lit rit])
?:(tol [;~(plug duz gap) ;~(plug gap duz)] [pal par])
(more mash ;~(gunk ;~(pfix cen sym) loaf))
==
--
@ -14275,7 +14281,7 @@
;~(plug (cold %ket ket) wide)
;~ plug
(easy %lit)
(ifix [lit rit] lobo)
(ifix [pal par] lobo)
==
==
==
@ -14287,7 +14293,7 @@
%+ cook |=(hoon +<)
%+ stag %cltr
%+ ifix
[;~(plug lac gap) ;~(plug gap rac)]
[;~(plug sel gap) ;~(plug gap ser)]
(most gap tall)
::
++ ropa (most col rope)
@ -14300,13 +14306,13 @@
(cold [%| 0 ~] com)
%+ cook
|=({a/(list) b/term} ?~(a b [%| (lent a) `b]))
;~(plug (star ket) ;~(pose sym (cold %$ bus)))
;~(plug (star ket) ;~(pose sym (cold %$ buc)))
::
%+ cook
|=(a/axis [%& a])
;~ pose
;~(pfix lus dim:ag)
;~(pfix pad (cook |=(a/@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag))
;~(pfix pam (cook |=(a/@ ?:(=(0 a) 0 (mul 2 +($(a (dec a)))))) dim:ag))
;~(pfix bar (cook |=(a/@ ?:(=(0 a) 1 +((mul 2 $(a (dec a)))))) dim:ag))
ven
(cold 1 dot)
@ -14332,9 +14338,7 @@
term
[%name term %spec u.unit %base %noun]
;~ plug sym
:: XX: net deprecated
::
(punt ;~(pfix ;~(pose net tis) wyde))
(punt ;~(pfix ;~(pose fas tis) wyde))
==
::
%+ cook
@ -14352,7 +14356,7 @@
++ wede :: wide bulb
:: XX: lus deprecated
::
;~(pfix ;~(pose lus net) wide)
;~(pfix ;~(pose lus fas) wide)
++ wide :: full wide form
%+ knee *hoon
|.(~+((wart ;~(pose expression:(norm |) long apex:(sail |)))))

37
pkg/arvo/sys/vane/ames.hoon
View File

@ -785,23 +785,35 @@
~ ``noun+!>(u.peer)
::
[%forward-lane ~]
:: find lane for u.who, or their galaxy
::
:: this duplicates the routing hack from +send-blob:event-core
:: so long as neither the peer nor the peer's sponsoring galaxy is us:
::
:: - no route to the peer: send to the peer's sponsoring galaxy
:: - direct route to the peer: use that
:: - indirect route to the peer: send to both that route and the
:: the peer's sponsoring galaxy
::
:^ ~ ~ %noun
!> ^- (list lane)
=/ ship-state (~(get by peers.ames-state) u.who)
?. ?=([~ %known *] ship-state)
?. ?& ?=([~ %known *] peer)
!=(our u.who)
==
~
=/ peer-state +.u.ship-state
?. =(~ route.peer-state) ::NOTE avoid tmi
[lane:(need route.peer-state)]~
|- ^- (list lane)
?: ?=(%czar (clan:title sponsor.peer-state))
[%& sponsor.peer-state]~
=/ next (~(get by peers.ames-state) sponsor.peer-state)
=; zar=(trap (list lane))
?~ route.u.peer $:zar
=* rot u.route.u.peer
?:(direct.rot [lane.rot ~] [lane.rot $:zar])
::
|. ^- (list lane)
?: ?=(%czar (clan:title sponsor.u.peer))
?: =(our sponsor.u.peer)
~
[%& sponsor.u.peer]~
=/ next (~(get by peers.ames-state) sponsor.u.peer)
?. ?=([~ %known *] next)
~
$(peer-state +.u.next)
$(peer next)
==
::
[%bones @ ~]
@ -1034,6 +1046,9 @@
++ on-hear-open
|= [=lane =packet ok=?]
^+ event-core
:: assert the comet can't pretend to be a moon or other address
::
?> ?=(%pawn (clan:title sndr.packet))
:: if we already know .sndr, ignore duplicate attestation
::
=/ ship-state (~(get by peers.ames-state) sndr.packet)

60
pkg/arvo/sys/vane/clay.hoon
View File

@ -561,7 +561,7 @@
++ vale
|= =noun
^+ sam
(slam (slap cor ^~((ream 'noun:grab'))) !>(noun))
(slam (slap cor !,(*hoon noun:grab)) !>(noun))
++ volt
|= =noun
^+ sam
@ -577,22 +577,23 @@
^- vase
%+ slap
(with-faces cor+cor sam+sam new+new ~)
^~((ream '(diff:~(grad cor sam) new)'))
!, *hoon
(diff:~(grad cor sam) new)
++ form fom
++ join
|= [a=vase b=vase]
^- (unit (unit vase))
?: =(q.a q.b)
~
=; res `?~(q.res ~ `(slap res ^~((ream '?~(. !! u)'))))
(slam (slap cor ^~((ream 'join:grad'))) (slop a b))
=; res `?~(q.res ~ `(slap res !,(*hoon ?~(. !! u))))
(slam (slap cor !,(*hoon join:grad)) (slop a b))
++ mash
|= [a=[=ship =desk diff=vase] b=[=ship =desk diff=vase]]
^- (unit vase)
?: =(q.diff.a q.diff.b)
~
:- ~
%+ slam (slap cor ^~((ream 'mash:grad')))
%+ slam (slap cor !,(*hoon mash:grad))
%+ slop
:(slop !>(ship.a) !>(desk.a) diff.a)
:(slop !>(ship.b) !>(desk.b) diff.b)
@ -601,11 +602,12 @@
^+ sam
%+ slap
(with-faces cor+cor sam+sam diff+diff ~)
^~((ream '(pact:~(grad cor sam) diff)'))
!, *hoon
(pact:~(grad cor sam) diff)
++ vale
|= =noun
^+ sam
(slam (slap cor ^~((ream 'noun:grab'))) !>(noun))
(slam (slap cor !,(*hoon noun:grab)) !>(noun))
++ volt
|= =noun
^+ sam
@ -637,7 +639,7 @@
:: try +grow; is there a +grow core with a .b arm?
::
=^ old=vase nub (build-fit %mar a)
?: =/ ram (mule |.((slap old ^~((ream 'grow')))))
?: =/ ram (mule |.((slap old !,(*hoon grow))))
?: ?=(%| -.ram) %.n
=/ lab (mule |.((slob b p.p.ram)))
?: ?=(%| -.lab) %.n
@ -650,22 +652,28 @@
^- vase
%+ slap
(with-faces old+old sam+sam ~)
%- ream
;: (cury cat 3)
'!: '
'~! old=old '
'~! sam=sam '
b ':~(grow old sam)'
==
:+ %sgzp !,(*hoon old=old)
:+ %sgzp !,(*hoon sam=sam)
:+ %tsld [%limb b]
!, *hoon
~(grow old sam)
:: try direct +grab
::
=^ new=vase nub (build-fit %mar b)
=/ rab (mule |.((slap new (ream (cat 3 a ':grab')))))
=/ rab
%- mule |.
%+ slap new
:+ %tsld [%limb a]
[%limb %grab]
?: &(?=(%& -.rab) ?=(^ q.p.rab))
:_(nub |=(sam=vase ~|([%grab a b] (slam p.rab sam))))
:: try +jump
::
=/ jum (mule |.((slap old (ream (cat 3 b ':jump')))))
=/ jum
%- mule |.
%+ slap old
:+ %tsld [%limb b]
[%limb %jump]
?: ?=(%& -.jum)
(compose-casts a !<(mark p.jum) b)
:: try indirect +grab
@ -803,7 +811,7 @@
:: parse optional /? and ignore
::
;~ pose
(cold ~ ;~(plug net wut gap dem gap))
(cold ~ ;~(plug fas wut gap dem gap))
(easy ~)
==
::
@ -812,7 +820,7 @@
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net hep gap)
;~ pfix ;~(plug fas hep gap)
(most ;~(plug com gaw) taut-rule)
==
gap
@ -824,7 +832,7 @@
;~ sfix
%+ cook |=((list (list taut)) (zing +<))
%+ more gap
;~ pfix ;~(plug net lus gap)
;~ pfix ;~(plug fas lus gap)
(most ;~(plug com gaw) taut-rule)
==
gap
@ -836,9 +844,9 @@
;~ sfix
%+ cook |=((list [face=term =path]) +<)
%+ more gap
;~ pfix ;~(plug net tis gap)
;~ pfix ;~(plug fas tis gap)
%+ cook |=([term path] +<)
;~(plug sym ;~(pfix ;~(plug gap net) (more net urs:ab)))
;~(plug sym ;~(pfix ;~(plug gap fas) (more fas urs:ab)))
==
gap
==
@ -849,12 +857,12 @@
;~ sfix
%+ cook |=((list [face=term =mark =path]) +<)
%+ more gap
;~ pfix ;~(plug net tar gap)
;~ pfix ;~(plug fas tar gap)
%+ cook |=([term mark path] +<)
;~ plug
sym
;~(pfix ;~(plug gap cen) sym)
;~(pfix ;~(plug gap net) (more net urs:ab))
;~(pfix ;~(plug gap fas) (more fas urs:ab))
==
==
gap
@ -1597,7 +1605,7 @@
~> %mean.%arvo-parse-fail
(path-to-hoon data /sys/arvo/hoon)
~> %mean.%arvo-compile-fail
(slap (slap hoon gen) (ream '..is'))
(slap (slap hoon gen) !,(*^hoon ..is))
::
++ build-zuse
|= arvo=vase
@ -4384,7 +4392,7 @@
%+ rain /sys/arvo/hoon
(lobe-to-cord (~(got by data) /sys/arvo/hoon))
~> %mean.%arvo-compile-fail
(slap (slap hoon gen) (ream '..is'))
(slap (slap hoon gen) !,(*^hoon ..is))
::
++ build-zuse
|= arvo=vase

172
pkg/arvo/sys/vane/dill.hoon
View File

@ -8,9 +8,10 @@
-- ::
=> |% :: console protocol
++ axle ::
$: %3 ::
$: %4 ::TODO replace ducts with session ids ::
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
eye=(jug duct duct) :: outside listeners
lit/? :: boot in lite mode
$= veb :: vane verbosities
$~ (~(put by *(map @tas log-level)) %hole %soft) :: quiet packet crashes
@ -21,7 +22,7 @@
tem/(unit (list dill-belt)) :: pending, reverse
wid/_80 :: terminal width
pos/@ud :: cursor position
see/(list @c) :: current line
see=$%([%lin (list @c)] [%klr stub]) :: current line
== ::
+$ log-level ?(%hush %soft %loud) :: none, line, full
-- => ::
@ -151,7 +152,11 @@
::
++ done :: return gift
|= git/gift:able
+>(moz :_(moz [hen %give git]))
=- +>.$(moz (weld - moz))
%+ turn
:- hen
~(tap in (~(get ju eye.all) hen))
|=(=duct [duct %give git])
::
++ deal :: pass to %gall
|= [=wire =deal:gall]
@ -161,7 +166,7 @@
|= [=wire =note]
+>(moz :_(moz [hen %pass wire note]))
::
++ from :: receive belt
++ from :: receive blit
|= bit/dill-blit
^+ +>
?: ?=($mor -.bit)
@ -172,86 +177,33 @@
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
[%lin see]
see
[%hop pos]
==
?: ?=($klr -.bit)
%+ done %blit
:~ [%lin (cvrt:ansi p.bit)]
:~ [%klr p.bit]
[%mor ~]
[%lin see]
see
[%hop pos]
==
?: ?=($pro -.bit)
(done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~])
=. see [%lin p.bit]
(done %blit [see [%hop pos] ~])
?: ?=($pom -.bit)
=. see (cvrt:ansi p.bit)
(done %blit [[%lin see] [%hop pos] ~])
::NOTE treat "styled prompt" without style as plain prompt,
:: to allow rendering by older runtimes
::TODO remove me once v0.10.9+ has high/guaranteed adoption
::
?: (levy p.bit (cork head |*(s=stye =(*stye s))))
$(bit [%pro (zing (turn p.bit tail))])
=. see [%klr p.bit]
(done %blit [see [%hop pos] ~])
?: ?=($hop -.bit)
(done(pos p.bit) %blit [bit ~])
?: ?=($qit -.bit)
(dump %logo ~)
(done %blit [bit ~])
::
++ ansi
|%
++ cvrt :: stub to (list @c)
|= a/stub :: with ANSI codes
^- (list @c)
%- zing %+ turn a
|= a/(pair stye (list @c))
^- (list @c)
;: weld
?: =(0 ~(wyt in p.p.a)) ~
`(list @c)`(zing (turn ~(tap in p.p.a) ef))
(bg p.q.p.a)
(fg q.q.p.a)
q.a
?~(p.p.a ~ (ef ~))
(bg ~)
(fg ~)
==
::
++ ef |=(a/^deco (scap (deco a))) :: ANSI effect
::
++ fg |=(a/^tint (scap (tint a))) :: ANSI foreground
::
++ bg :: ANSI background
|= a/^tint
%- scap
=>((tint a) [+(p) q]) :: (add 10 fg)
::
++ scap :: ANSI escape seq
|= a/$@(@ (pair @ @))
%- (list @c)
:+ 27 '[' :: "\033[{a}m"
?@(a :~(a 'm') :~(p.a q.a 'm'))
::
++ deco :: ANSI effects
|= a/^deco ^- @
?- a
~ '0'
$br '1'
$un '4'
$bl '5'
==
::
++ tint :: ANSI colors (fg)
|= a/^tint
^- (pair @ @)
:- '3'
?- a
$k '0'
$r '1'
$g '2'
$y '3'
$b '4'
$m '5'
$c '6'
$w '7'
~ '9'
==
--
:: XX move
::
++ sein
@ -398,7 +350,7 @@
=* duc (need hey.all)
=/ app %hood
=/ see (tuba "<awaiting {(trip app)}, this may take a minute>")
=/ zon=axon [app input=[~ ~] width=80 cursor=(lent see) see]
=/ zon=axon [app input=[~ ~] width=80 cursor=(lent see) lin+see]
::
=^ moz all abet:(~(into as duc zon) ~)
[moz ..^$]
@ -422,7 +374,29 @@
=. veb.all (~(put by veb.all) tag.task level.task)
[~ ..^$]
::
?: ?=(%view -.task)
:: crash on viewing non-existent session
::
~| [%no-session session.task]
?> =(~ session.task)
=/ session (need hey.all)
=/ =axon (~(got by dug.all) session)
:: register the viewer and send them the prompt line
::
:- [hen %give %blit [see.axon]~]~
..^$(eye.all (~(put ju eye.all) session hen))
::
?: ?=(%flee -.task)
:- ~
~| [%no-session session.task]
?> =(~ session.task)
=/ session (need hey.all)
..^$(eye.all (~(del ju eye.all) session hen))
::
=/ nus (ax hen)
=? nus &(?=(~ nus) ?=(^ hey.all))
::TODO allow specifying target session in task
(ax u.hey.all)
?~ nus
:: :hen is an unrecognized duct
:: could be before %boot (or %boot failed)
@ -441,7 +415,7 @@
++ axle-1
$: $1
hey/(unit duct)
dug/(map duct axon)
dug/(map duct axon-3)
lit/?
$= hef
$: a/(unit mass)
@ -457,10 +431,11 @@
$~ (~(put by *(map @tas log-level)) %hole %soft)
(map @tas log-level)
==
::
++ axle-2
$: %2
hey/(unit duct)
dug/(map duct axon)
dug/(map duct axon-3)
lit/?
dog/_|
$= hef
@ -478,29 +453,68 @@
(map @tas log-level)
==
::
++ axle-any
$%(axle-1 axle-2 axle)
+$ axle-3
$: %3
hey=(unit duct)
dug=(map duct axon-3)
lit=?
$= veb
$~ (~(put by *(map @tas log-level)) %hole %soft)
(map @tas log-level)
==
+$ axon-3
$: ram=term
tem=(unit (list dill-belt))
wid=_80
pos=@ud
see=(list @c)
==
::
+$ axle-any
$%(axle-1 axle-2 axle-3 axle)
--
::
|= old=axle-any
?- -.old
%1 $(old [%2 [hey dug lit dog=& hef veb]:old])
%2 $(old [%3 [hey dug lit veb]:old])
%3 ..^$(all old)
%3 =- $(old [%4 hey.old - ~ lit.old veb.old])
(~(run by dug.old) |=(a=axon-3 a(see lin+see.a)))
%4 ..^$(all old)
==
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
^- (unit (unit cage))
?. ?=(%& -.why) ~
=* his p.why
::TODO don't special-case whey scry
::
?: &(=(ren %$) =(tyl /whey))
=/ maz=(list mass)
:~ hey+&+hey.all
dug+&+dug.all
==
``mass+!>(maz)
[~ ~]
:: only respond for the local identity, %$ desk, current timestamp
::
?. ?& =(&+our why)
=([%$ %da now] lot)
=(%$ syd)
==
~
:: /dx/sessions//line blit current line (prompt) of default session
:: /dx/sessions//cursor @ud current cursor position of default session
::TODO support asking for specific sessions once session ids are real
::
?. ?=(%x ren) ~
?+ tyl ~
[%sessions %$ *]
?~ hey.all [~ ~]
?~ session=(~(get by dug.all) u.hey.all) [~ ~]
?+ t.t.tyl ~
[%line ~] ``blit+!>(`blit`see.u.session)
[%cursor ~] ``atom+!>(pos.u.session)
==
==
::
++ stay all
::

90
pkg/arvo/sys/vane/eyre.hoon
View File

@ -462,7 +462,7 @@
==
;body
;h1:"Internal Server Error"
;p:"There was an error while handling the request for {<(trip url)>}."
;p:"There was an error while handling the request for {(trip url)}."
;* ?: authorized
;=
;code:"*{(render-tang-to-marl 80 t)}"
@ -478,7 +478,7 @@
::
=/ code-as-tape=tape (format-ud-as-integer code)
=/ message=tape
?+ code "{<code>} Error"
?+ code "{(scow %ud code)} Error"
%400 "Bad Request"
%403 "Forbidden"
%404 "Not Found"
@ -495,7 +495,7 @@
==
;body
;h1:"{message}"
;p:"There was an error while handling the request for {<(trip url)>}."
;p:"There was an error while handling the request for {(trip url)}."
;* ?: authorized
;=
;code:"{t}"
@ -590,8 +590,12 @@
=* headers header-list.request
:: for requests from localhost, respect the "forwarded" header
::
=? address =([%ipv4 .127.0.0.1] address)
(fall (forwarded-for headers) address)
=/ [secure=? =^address]
=* same [secure address]
?. =([%ipv4 .127.0.0.1] address) same
?~ forwards=(forwarded-params headers) same
:- (fall (forwarded-secure u.forwards) secure)
(fall (forwarded-for u.forwards) address)
::
=/ host (get-header:http 'host' headers)
=/ [=action suburl=@t]
@ -995,7 +999,7 @@
~
:: is there an urbauth cookie?
::
?~ urbauth=(get-header:http (crip "urbauth-{<our>}") u.cookies)
?~ urbauth=(get-header:http (crip "urbauth-{(scow %p our)}") u.cookies)
~
:: if it's formatted like a valid session cookie, produce it
::
@ -1035,7 +1039,7 @@
^- @t
%- crip
=; max-age=tape
"urbauth-{<our>}={<session>}; Path=/; Max-Age={max-age}"
"urbauth-{(scow %p our)}={(scow %uv session)}; Path=/; Max-Age={max-age}"
%- format-ud-as-integer
?. extend 0
(div (msec:milly session-timeout) 1.000)
@ -1500,6 +1504,16 @@
?~ channel
:_ state :_ ~
[duct %pass /flog %d %flog %crud %eyre-no-channel >id=channel-id< ~]
:: it's possible that this is a sign emitted directly alongside a fact
:: that triggered a clog & closed the subscription. in that case, just
:: drop the sign.
:: poke-acks are not paired with subscriptions, so we can process them
:: regardless.
::
?: ?& !?=(%poke-ack -.sign)
!(~(has by subscriptions.u.channel) request-id)
==
[~ state]
:: attempt to convert the sign to json.
:: if conversion succeeds, we *can* send it. if the client is actually
:: connected, we *will* send it immediately.
@ -1535,10 +1549,10 @@
:: update channel's unacked counts, find out if clogged
::
=^ clogged unacked.u.channel
:: poke-acks are one-offs, don't apply clog logic to them.
:: only apply clog logic to facts.
:: and of course don't count events we can't send as unacked.
::
?: ?| ?=(%poke-ack -.sign)
?: ?| !?=(%fact -.sign)
?=(~ json)
==
[| unacked.u.channel]
@ -1555,6 +1569,10 @@
=* kicking |(clogged ?=(~ json))
=? moves kicking
:_ moves
::NOTE this shouldn't crash because we
:: - never fail to serialize subscriptionless signs (%poke-ack),
:: - only clog on %facts, which have a subscription associated,
:: - and already checked whether we still have that subscription.
=+ (~(got by subscriptions.u.channel) request-id)
:^ duct %pass
(subscription-wire channel-id request-id ship app)
@ -1585,7 +1603,7 @@
==
=? next-id kicking +(next-id)
::
:- moves
:- (flop moves)
%_ state
session.channel-state
%+ ~(put by session.channel-state.state) channel-id
@ -2013,29 +2031,39 @@
(cat 3 '.' u.ext.request-line)
--
::
++ forwarded-for
++ forwarded-params
|= =header-list:http
^- (unit address)
=/ forwarded=(unit @t)
^- (unit (list (map @t @t)))
%+ biff
(get-header:http 'forwarded' header-list)
?~ forwarded ~
|^ =/ forwards=(unit (list (map @t @t)))
(unpack-header:http u.forwarded)
?. ?=([~ ^] forwards) ~
=* forward i.u.forwards
?~ for=(~(get by forward) 'for') ~
::NOTE per rfc7239, non-ip values are also valid. they're not useful
:: for the general case, so we ignore them here. if needed,
:: request handlers are free to inspect the headers themselves.
::
(rush u.for ip-address)
unpack-header:http
::
++ forwarded-for
|= forwards=(list (map @t @t))
^- (unit address)
?. ?=(^ forwards) ~
=* forward i.forwards
?~ for=(~(get by forward) 'for') ~
::NOTE per rfc7239, non-ip values are also valid. they're not useful
:: for the general case, so we ignore them here. if needed,
:: request handlers are free to inspect the headers themselves.
::
++ ip-address
;~ sfix
;~(pose (stag %ipv4 ip4) (stag %ipv6 (ifix [lac rac] ip6)))
;~(pose ;~(pfix col dim:ag) (easy ~))
==
--
%+ rush u.for
;~ sfix
;~(pose (stag %ipv4 ip4) (stag %ipv6 (ifix [sel ser] ip6)))
;~(pose ;~(pfix col dim:ag) (easy ~))
==
::
++ forwarded-secure
|= forwards=(list (map @t @t))
^- (unit ?)
?. ?=(^ forwards) ~
=* forward i.forwards
?~ proto=(~(get by forward) 'proto') ~
?+ u.proto ~
%http `|
%https `&
==
::
++ parse-request-line
|= url=@t
@ -2378,7 +2406,7 @@
=/ handle-gall-error
handle-gall-error:(per-server-event event-args)
=^ moves server-state.ax
(handle-gall-error leaf+"eyre bad mark {<mark>}" ~)
(handle-gall-error leaf+"eyre bad mark {(trip mark)}" ~)
[moves http-server-gate]
::
=/ =http-event:http

132
pkg/arvo/sys/zuse.hoon
View File

@ -367,7 +367,7 @@
++ pairs
%+ cook
~(gas by *(map @t @t))
%+ more (ifix [. .]:(star ace) mic)
%+ most (ifix [. .]:(star ace) mic)
;~(plug token ;~(pose ;~(pfix tis value) (easy '')))
::
++ value
@ -378,16 +378,16 @@
::NOTE this is ptok:de-purl:html, but can't access that here
%- plus
;~ pose
aln zap hax bus cen pad say tar lus
hep dot ket cab tec bar sig
aln zap hax buc cen pam soq tar lus
hep dot ket cab tic bar sig
==
::
++ quoted-string :: 7230 quoted string
%+ cook crip
%+ ifix [. .]:;~(less (jest '\\"') yel)
%+ ifix [. .]:;~(less (jest '\\"') doq)
%- star
;~ pose
;~(pfix bat ;~(pose (just '\09') ace prn))
;~(pfix bas ;~(pose (just '\09') ace prn))
;~(pose (just '\09') ;~(less (mask "\22\5c\7f") (shim 0x20 0xff)))
==
--
@ -1120,6 +1120,7 @@
{$boot lit/? p/*} :: weird %dill boot
{$crop p/@ud} :: trim kernel state
$>(%crud vane-task) :: error with trace
[%flee session=~] :: unwatch session
{$flog p/flog} :: wrapped error
{$flow p/@tas q/(list gill:gall)} :: terminal config
{$hail ~} :: terminal refresh
@ -1134,6 +1135,7 @@
{$talk p/tank} ::
{$text p/tape} ::
{$veer p/@ta q/path r/@t} :: install vane
[%view session=~] :: watch session blits
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
{$verb ~} :: verbose mode
@ -1157,6 +1159,7 @@
$% {$bel ~} :: make a noise
{$clr ~} :: clear the screen
{$hop p/@ud} :: set cursor position
[%klr p=stub] :: set styled line
{$lin p/(list @c)} :: set current line
{$mor ~} :: newline
{$sag p/path q/*} :: save to jamfile
@ -5362,28 +5365,30 @@
:: ::::
++ format ^?
|%
:: :: ++to-wain:format
++ to-wain :: atom to line list
~% %lore ..is ~
|= lub/@
=| tez/(list @t)
|- ^+ tez
=+ ^= wor
=+ [meg=0 i=0]
|- ^- {meg/@ i/@ end/@f}
=+ gam=(cut 3 [i 1] lub)
?: =(0 gam)
[meg i %.y]
?: =(10 gam)
[meg i %.n]
$(meg (cat 3 meg gam), i +(i))
?: end.wor
(flop ^+(tez [meg.wor tez]))
?: =(0 lub) (flop tez)
$(lub (rsh 3 +(i.wor) lub), tez [meg.wor tez])
:: 0 ending a line (invalid @t) is not preserved :: ++to-wain:format
++ to-wain :: cord to line list
~% %leer ..is ~
|= txt=cord
^- wain
=/ len=@ (met 3 txt)
=/ cut =+(cut -(a 3, c 1, d txt))
=/ sub sub
=| [i=@ out=wain]
|- ^+ out
=+ |- ^- j=@
?: ?| =(i len)
=(10 (cut(b i)))
==
i
$(i +(i))
=. out :_ out
(cut(b i, c (sub j i)))
?: =(j len)
(flop out)
$(i +(j))
:: :: ++of-wain:format
++ of-wain :: line list to atom
|= tez/(list @t)
++ of-wain :: line list to cord
|= tez=wain ^- cord
(rap 3 (join '\0a' tez))
:: :: ++of-wall:format
++ of-wall :: line list to tape
@ -5636,7 +5641,7 @@
[(rash a fel) b]
:: :: ++pa:dejs:format
++ pa :: string as path
(su ;~(pfix net (more net urs:ab)))
(su ;~(pfix fas (more fas urs:ab)))
:: :: ++pe:dejs:format
++ pe :: prefix
|* {pre/* wit/fist}
@ -6198,7 +6203,7 @@
:: :: ++abox:de-json:html
++ abox :: array
%+ stag %a
(ifix [lac (wish rac)] (more (wish com) apex))
(ifix [sel (wish ser)] (more (wish com) apex))
:: :: ++apex:de-json:html
++ apex :: any value
%+ knee *json |. ~+
@ -6230,7 +6235,7 @@
=* wow `(map @t @)`(malt lip)
(sear ~(get by wow) low)
=* tuf ;~(pfix (just 'u') (cook tuft qix:ab))
;~(pose yel net say bas loo tuf)
;~(pose doq fas soq bas loo tuf)
==
:: :: ++expo:de-json:html
++ expo :: exponent
@ -6244,7 +6249,7 @@
;~(plug dot digs)
:: :: ++jcha:de-json:html
++ jcha :: string character
;~(pose ;~(less yel bas prn) esca)
;~(pose ;~(less doq bas prn) esca)
:: :: ++mayb:de-json:html
++ mayb :: optional
|*(bus/rule ;~(pose bus (easy ~)))
@ -6261,7 +6266,7 @@
==
:: :: ++obje:de-json:html
++ obje :: object list
%+ ifix [(wish leb) (wish reb)]
%+ ifix [(wish kel) (wish ker)]
(more (wish com) pear)
:: :: ++obox:de-json:html
++ obox :: object
@ -6275,7 +6280,7 @@
(cook |=(a/@ [a ~]) bus)
:: :: ++stri:de-json:html
++ stri :: string
(cook crip (ifix [yel yel] (star jcha)))
(cook crip (ifix [doq doq] (star jcha)))
:: :: ++tops:de-json:html
++ tops :: strict value
;~(pose abox obox)
@ -6384,14 +6389,14 @@
;~(pfix (plus whit) name)
;~ pose
%+ ifix
:_ yel
;~(plug (ifix [. .]:(star whit) tis) yel)
(star ;~(less yel escp))
:_ doq
;~(plug (ifix [. .]:(star whit) tis) doq)
(star ;~(less doq escp))
::
%+ ifix
:_ say
;~(plug (ifix [. .]:(star whit) tis) say)
(star ;~(less say escp))
:_ soq
;~(plug (ifix [. .]:(star whit) tis) soq)
(star ;~(less soq escp))
::
(easy ~)
==
@ -6407,7 +6412,7 @@
:: :: ++chrd:de-xml:html
++ chrd :: character data
%+ cook |=(a/tape ^-(mars ;/(a)))
(plus ;~(less yel ;~(pose (just `@`10) escp)))
(plus ;~(less doq ;~(pose (just `@`10) escp)))
:: :: ++comt:de-xml:html
++ comt :: comments
=- (ifix [(jest '<!--') (jest '-->')] (star -))
@ -6424,10 +6429,10 @@
;~(less (jest '?>') prn)
:: :: ++escp:de-xml:html
++ escp ::
;~(pose ;~(less led ban pad prn) enty)
;~(pose ;~(less gal gar pam prn) enty)
:: :: ++enty:de-xml:html
++ enty :: entity
%+ ifix pad^mic
%+ ifix pam^mic
;~ pose
=+ def=^+(ent (my:nl [%gt '>'] [%lt '<'] [%amp '&'] [%quot '"'] ~))
%+ sear ~(get by (~(uni by def) ent))
@ -6443,7 +6448,7 @@
;~(plug ;~(plug name attr) (cold ~ (star whit)))
:: :: ++head:de-xml:html
++ head :: opening tag
(ifix [gal ban] ;~(plug name attr))
(ifix [gal gar] ;~(plug name attr))
:: :: ++many:de-xml:html
++ many :: contents
;~(pfix (star comt) (star ;~(sfix ;~(pose apex chrd cdat) (star comt))))
@ -6458,7 +6463,7 @@
;~(pose ;~(plug ;~(sfix chx col) chx) chx)
:: :: ++tail:de-xml:html
++ tail :: closing tag
(ifix [(jest '</') ban] name)
(ifix [(jest '</') gar] name)
:: :: ++whit:de-xml:html
++ whit :: whitespace
(mask ~[' ' `@`0x9 `@`0xa])
@ -6563,8 +6568,13 @@
?^ t.rax
[p.pok [ire q.pok]]:[pok=$(rax t.rax) ire=i.rax]
=/ raf/(like term)
=> |=(a/@ ((sand %tas) (crip (flop (trip a)))))
(;~(sfix (sear . sym) dot) [1^1 (flop (trip i.rax))])
%- ;~ sfix
%+ sear
|=(a/@ ((sand %ta) (crip (flop (trip a)))))
(cook |=(a/tape (rap 3 ^-((list @) a))) (star aln))
dot
==
[1^1 (flop (trip i.rax))]
?~ q.raf
[~ [i.rax ~]]
=+ `{ext/term {@ @} fyl/tape}`u.q.raf
@ -6573,7 +6583,7 @@
:: :: ++apat:de-purl:html
++ apat :: 2396 abs_path
%+ cook deft
;~(pfix net (more net smeg))
;~(pfix fas (more fas smeg))
:: :: ++aurf:de-purl:html
++ aurf :: 2396 with fragment
%+ cook |~(a/purf a)
@ -6594,13 +6604,13 @@
[q.a [[p.a r.a] b]]
::
;~ plug
;~(plug htts (punt ;~(sfix urt:ab vat)) thor)
;~(plug htts (punt ;~(sfix urt:ab pat)) thor)
;~(plug ;~(pose apat (easy *pork)) yque)
==
:: :: ++htts:de-purl:html
++ htts :: scheme
%+ sear ~(get by (malt `(list (pair term ?))`[http+| https+& ~]))
;~(sfix scem ;~(plug col net net))
;~(sfix scem ;~(plug col fas fas))
:: :: ++cock:de-purl:html
++ cock :: cookie
%+ most ;~(plug mic ace)
@ -6620,10 +6630,10 @@
(cook crip (star pquo))
:: :: ++pcar:de-purl:html
++ pcar :: 2396 path char
;~(pose pure pesc psub col vat)
;~(pose pure pesc psub col pat)
:: :: ++pcok:de-purl:html
++ pcok :: cookie char
;~(less bas mic com yel prn)
;~(less bas mic com doq prn)
:: :: ++pesc:de-purl:html
++ pesc :: 2396 escaped
;~(pfix cen mes)
@ -6632,24 +6642,24 @@
(cold ' ' (just '+'))
:: :: ++pque:de-purl:html
++ pque :: 3986 query char
;~(pose pcar net wut)
;~(pose pcar fas wut)
:: :: ++pquo:de-purl:html
++ pquo :: normal query char
;~(pose pure pesc pold net wut col com)
;~(pose pure pesc pold fas wut col com)
:: :: ++pure:de-purl:html
++ pure :: 2396 unreserved
;~(pose aln hep cab dot zap sig tar say lit rit)
;~(pose aln hep cab dot zap sig tar soq pal par)
:: :: ++psub:de-purl:html
++ psub :: 3986 sub-delims
;~ pose
zap bus pad say lit rit
zap buc pam soq pal par
tar lus com mic tis
==
:: :: ++ptok:de-purl:html
++ ptok :: 2616 token
;~ pose
aln zap hax bus cen pad say tar lus
hep dot ket cab tec bar sig
aln zap hax buc cen pam soq tar lus
hep dot ket cab tic bar sig
==
:: :: ++scem:de-purl:html
++ scem :: 2396 scheme
@ -6663,7 +6673,7 @@
(cook crip (plus pcok))
:: :: ++tosk:de-purl:html
++ tosk :: 6265 quoted value
;~(pose tock (ifix [yel yel] tock))
;~(pose tock (ifix [doq doq] tock))
:: :: ++toke:de-purl:html
++ toke :: 2616 token
(cook crip (plus ptok))
@ -6705,7 +6715,7 @@
:: proper query
::
%+ more
;~(pose pad mic)
;~(pose pam mic)
;~(plug fque ;~(pose ;~(pfix tis fquu) (easy '')))
::
:: funky query
@ -8209,7 +8219,7 @@
::
++ function
|* [tag=@tas fun=@t rul=rule]
;~(plug (cold tag (jest fun)) (ifix [lit rit] rul))
;~(plug (cold tag (jest fun)) (ifix [pal par] rul))
::
++ shipname
;~(pfix sig fed:ag)
@ -9174,6 +9184,10 @@
|- ^- seed:able:jael
=/ cub=acru:ames (pit:nu:crub:crypto 512 eny)
=/ who=ship `@`fig:ex:cub
:: disallow 64-bit or smaller addresses
::
?. ?=(%pawn (clan:title who))
$(eny +(eny))
?: (~(has in stars) (^sein:title who))
[who 1 sec:ex:cub ~]
$(eny +(eny))

39
pkg/arvo/ted/graph/create.hoon
View File

@ -1,4 +1,9 @@
/- spider, graph=graph-store, *metadata-store, *group, group-store
/- spider,
graph=graph-store,
*metadata-store,
*group,
group-store,
inv=invite-store
/+ strandio, resource, graph-view
=>
|%
@ -27,22 +32,25 @@
=+ !<([=action:graph-view ~] arg)
?> ?=(%create -.action)
;< =bowl:spider bind:m get-bowl:strandio
::
:: Add graph to graph-store
::
?. =(our.bowl entity.rid.action)
(strand-fail:strandio %bad-request ~)
=/ =update:graph
[%0 now.bowl %add-graph rid.action *graph:graph mark.action]
[%0 now.bowl %add-graph rid.action *graph:graph mark.action %.n]
;< ~ bind:m
(poke-our %graph-store graph-update+!>(update))
;< ~ bind:m
(poke-our %graph-push-hook %push-hook-action !>([%add rid.action]))
::
:: Add group, if graph is unmanaged
::
;< group=resource bind:m
(handle-group rid.action associated.action)
=/ group-path=path
(en-path:resource group)
::
:: Setup metadata
::
=/ =metadata
@ -53,9 +61,30 @@
creator our.bowl
module module.action
==
=/ act=metadata-action
=/ =metadata-action
[%add group-path graph+(en-path:resource rid.action) metadata]
;< ~ bind:m (poke-our %metadata-hook %metadata-action !>(act))
;< ~ bind:m
(poke-our %metadata-hook %metadata-action !>(metadata-action))
;< ~ bind:m
(poke-our %metadata-hook %metadata-hook-action !>([%add-owned group-path]))
(pure:m !>(~))
::
:: Send invites
::
?: ?=(%group -.associated.action)
(pure:m !>(~))
?- -.policy.associated.action
%open (pure:m !>(~))
%invite
=/ inv-action=action:inv
:^ %invites %graph (shaf %graph-uid eny.bowl)
^- multi-invite:inv
:* our.bowl
%graph-push-hook
rid.action
pending.policy.associated.action
description.action
==
;< ~ bind:m
(poke-our %invite-hook %invite-action !>(inv-action))
(pure:m !>(~))
==

9
pkg/arvo/ted/graph/delete.hoon
View File

@ -41,6 +41,15 @@
(poke-our %graph-store %graph-update !>([%0 now.bowl %remove-graph rid]))
;< ~ bind:m
(poke-our %graph-push-hook %push-hook-action !>([%remove rid]))
;< ~ bind:m
%+ poke-our %metadata-hook
metadata-hook-action+!>([%remove (en-path:resource rid)])
;< ~ bind:m
%+ poke-our %metadata-store
:- %metadata-action
!> :+ %remove
(en-path:resource rid)
[%graph (en-path:resource rid)]
(pure:m ~)
--
::

2
pkg/arvo/ted/graph/groupify.hoon
View File

@ -67,5 +67,5 @@
%+ poke-our %metadata-store
metadata-action+!>([%remove app-path graph+app-path])
;< ~ bind:m
(poke-our %group-store %group-update !>([%remove-group rid.action]))
(poke-our %group-store %group-update !>([%remove-group rid.action ~]))
(pure:m !>(~))

28
pkg/arvo/ted/invite/accepted-graph.hoon Normal file
View File

@ -0,0 +1,28 @@
/- spider, inv=invite-store, graph-view
/+ strandio
::
=* strand strand:spider
=* fail strand-fail:strand
=* poke-our poke-our:strandio
=* flog-text flog-text:strandio
::
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
=+ !<([=update:inv ~] arg)
?. ?=(%accepted -.update)
(pure:m !>(~))
;< =bowl:spider bind:m get-bowl:strandio
=* invite invite.update
?: =(our.bowl entity.resource.invite)
:: do not crash because that will kill the invitatory subscription
(pure:m !>(~))
;< ~ bind:m
%+ poke-our %spider
=- spider-start+!>([`tid.bowl ~ %graph-join -])
%+ slop
!> ^- action:graph-view
[%join resource.invite ship.invite]
!>(~)
(pure:m !>(~))

65
pkg/arvo/ted/ph/lib-hooks.hoon Normal file
View File

@ -0,0 +1,65 @@
/- spider
/+ *ph-io, *strandio
=>
|%
++ strand strand:spider
++ start-agents
|= =ship
=/ m (strand ,~)
;< ~ bind:m (dojo ship "|start %graph-store")
;< ~ bind:m (dojo ship "|start %graph-push-hook")
;< ~ bind:m (dojo ship "|start %graph-pull-hook")
;< ~ bind:m (dojo ship "|start %group-store")
;< ~ bind:m (dojo ship "|start %group-push-hook")
;< ~ bind:m (dojo ship "|start %group-pull-hook")
;< ~ bind:m (dojo ship "|start %metadata-store")
;< ~ bind:m (dojo ship "|start %metadata-hook")
;< ~ bind:m (sleep `@dr`300)
(pure:m ~)
::
++ make-link
|= [title=@t url=@t]
=/ m (strand ,~)
;< ~ bind:m (dojo ~bud ":graph-store|add-post [~bud %test] ~[[%text '{(trip title)}'] [%url '{(trip url)}']]")
(pure:m ~)
--
^- thread:spider
|= vase
=/ m (strand ,vase)
;< az=tid:spider
bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~dev)
;< ~ bind:m (real-ship az ~bud)
;< ~ bind:m (real-ship az ~dev)
;< ~ bind:m (start-agents ~bud)
;< ~ bind:m (start-agents ~dev)
;< ~ bind:m (send-hi ~bud ~dev)
;< ~ bind:m (dojo ~bud "-graph-create [%create [~bud %test] 'test' '' `%graph-validator-link [%policy [%open ~ ~]] 'link']")
;< ~ bind:m (sleep ~s5)
;< ~ bind:m (dojo ~dev "-graph-join [%join [~bud %test] ~bud]")
;< ~ bind:m (sleep ~s5)
;< ~ bind:m (send-hi ~bud ~dev)
;< ~ bind:m (poke-our %aqua noun+!>([%pause-events ~[~dev]]))
;< ~ bind:m (make-link 'one' 'one')
;< ~ bind:m (make-link 'two' 'one')
;< ~ bind:m (make-link 'thre' 'one')
;< ~ bind:m (make-link 'four' 'one')
;< ~ bind:m (make-link 'five' 'one')
;< ~ bind:m (make-link 'six' 'one')
;< ~ bind:m (make-link 'seven' 'one')
;< ~ bind:m (sleep ~s40)
:: five unacked events is sufficent to cause a clog, and by extension a
:: %kick
;< ~ bind:m (poke-our %aqua noun+!>([%unpause-events ~[~dev]]))
;< ~ bind:m (sleep ~s10)
;< ~ bind:m (make-link 'eight' 'one')
;< ~ bind:m (make-link 'nine' 'one')
;< ~ bind:m (sleep ~s10)
;< ~ bind:m (dojo ~dev ":graph-pull-hook +dbug %bowl")
;< ~ bind:m (dojo ~dev ":graph-store +dbug")
;< ~ bind:m (dojo ~bud ":graph-push-hook +dbug %bowl")
;< ~ bind:m (dojo ~bud ":graph-store +dbug")
;< ~ bind:m end-azimuth
(pure:m *vase)

Some files were not shown because too many files have changed in this diff Show More