urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-19 00:13:12 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'release/next-userspace' into lf/app-sane

Browse Source
This commit is contained in:
Logan Allen 2020-11-19 11:39:48 -06:00
commit b11b343280
505 changed files with 21614 additions and 23373 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -1,4 +1,3 @@
bin/* filter=lfs diff=lfs merge=lfs -text
bin/*/* filter=lfs diff=lfs merge=lfs -text
pkg/arvo/**/*.js binary
pkg/arvo/**/*.css binary

11
.github/ISSUE_TEMPLATE/config.yml vendored Normal file
View File

@ -0,0 +1,11 @@
blank_issues_enabled: true
contact_links:
- name: Landscape design issue
url: https://github.com/urbit/landscape/issues/new?assignees=&labels=design+issue&template=report-a-design-issue.md&title=
about: Submit non-functionality, design-specific issues to the Landscape team here.
- name: Landscape feature request
url: https://github.com/urbit/landscape/issues/new?assignees=&labels=feature+request&template=feature_request.md&title=
about: Landscape is comprised of Tlon's user applications and client for Urbit. Submit Landscape feature requests here.
- name: urbit-dev mailing list
url: https://groups.google.com/a/urbit.org/g/dev
about: Developer questions and discussions also take place on the urbit-dev mailing list.

4
.github/ISSUE_TEMPLATE/os1-bug-report.md vendored
View File

@ -1,6 +1,6 @@
---
name: OS1 Bug report
about: 'Use this template to file a bug for any OS1 app: Chat, Publish, Links, Groups,
name: Landscape bug report
about: 'Use this template to file a bug for any Landscape app: Chat, Publish, Links, Groups,
Weather or Clock'
title: ''
labels: landscape

31
CONTRIBUTING.md
View File

@ -2,12 +2,14 @@
Thank you for your interest in contributing to Urbit.
See [urbit.org/docs/getting-started][start] for basic orientation and usage
See [urbit.org/using/install][start] for basic orientation and usage
instructions. You may also want to subscribe to [urbit-dev][list], the Urbit
development mailing list. For specific information on contributing to the Urbit
interface, see its [contribution guidelines][interface].
[start]: https://urbit.org/docs/getting-started/#arvo
For information on Arvo's maintainers, see [pkg/arvo][main].
[start]: https://urbit.org/using/install
[interface]: /pkg/interface/CONTRIBUTING.md
## Fake ships
@ -36,6 +38,17 @@ To resume a fake ship, just pass the name of the pier:
$ urbit my-fake-zod
```
Fake ships by default use the same pre-compiled kernelspace ('pills') as livenet
ships do: boot pills, which are not always current with `master`. If you wish to
develop using code off the master branch, run the following from the repo
directory:
```
git lfs install
git lfs pull
urbit -F zod -B "bin/solid.pill" -A "pkg/arvo"
```
## Git practice
### Contributing
@ -45,11 +58,10 @@ The canonical source tree is the `master` branch of
`master` when commencing new work; similarly, when we pull in your
contribution, we'll do so by merging it to `master`.
Since we use GitHub, it's helpful (though not required) to contribute via a
GitHub pull request. You can also post patches to the [mailing list][list],
email them to maintainers, or request a maintainer pull from your tree directly
-- but note that some maintainers will be more receptive to these methods than
others.
Since we use GitHub, we request you contribute via a GitHub pull request. Tag
the [maintainer][main] for the component. If you have a question for the
maintainer, you can direct message them from your Urbit ship using that
information.
When contributing changes, via whatever means, make sure you describe them
appropriately. You should attach a reasonably high-level summary of what the
@ -58,8 +70,8 @@ exist, e.g. a GitHub issue, a mailing list discussion, a UP, etc. [Here][jbpr]
is a good example of a pull request with a useful, concise description.
If your changes replace significant extant functionality, be sure to compare
them with the thing you're replacing. You may also want to cc maintainers,
reviewers, or other parties who might have a particular interest in what you're
them with the thing you're replacing. You may also want to cc reviewers,
or other parties who might have a particular interest in what you're
contributing.
[jbpr]: https://github.com/urbit/urbit/pull/1782
@ -283,3 +295,4 @@ Questions or other communications about contributing to Urbit can go to
[reba]: https://git-rebase.io/
[issu]: https://github.com/urbit/urbit/issues
[hoon]: https://urbit.org/docs/learn/hoon/style/
[main]: https://github.com/urbit/urbit/tree/master/pkg/arvo#maintainers

43
README.md
View File

@ -1,27 +1,38 @@
# Urbit
A personal server operating function.
[Urbit](https://urbit.org) is a personal server stack built from scratch. It
has an identity layer (Azimuth), virtual machine (Vere), and operating system
(Arvo).
> The Urbit address space, Azimuth, is now live on the Ethereum blockchain. You
> can find it at [`0x223c067f8cf28ae173ee5cafea60ca44c335fecb`][azim] or
> [`azimuth.eth`][aens]. Owners of Azimuth points (galaxies, stars, or planets)
> can view or manage them using [Bridge][brid], and can also use them to boot
> [Arvo][arvo], the Urbit OS.
A running Urbit "ship" is designed to operate with other ships peer-to-peer.
Urbit is a general-purpose, peer-to-peer computer and network.
This repository contains:
- The [Arvo OS][arvo]
- [herb][herb], a tool for Unix control of an Urbit ship
- Source code for [Landscape's web interface][land]
- Source code for the [vere][vere] virtual machine.
For more on the identity layer, see [Azimuth][azim]. To manage your Urbit
identity, use [Bridge][brid].
[azim]: https://etherscan.io/address/0x223c067f8cf28ae173ee5cafea60ca44c335fecb
[aens]: https://etherscan.io/address/azimuth.eth
[brid]: https://github.com/urbit/bridge
[arvo]: https://github.com/urbit/urbit/tree/master/pkg/arvo
[azim]: https://github.com/urbit/azimuth
[brid]: https://github.com/urbit/bridge
[herb]: https://github.com/urbit/urbit/tree/master/pkg/herb
[land]: https://github.com/urbit/urbit/tree/master/pkg/interface
[vere]: https://github.com/urbit/urbit/tree/master/pkg/urbit
## Install
To install and run Urbit, please follow the instructions at
[urbit.org/docs/getting-started/][start]. You'll be on the live network in a
[urbit.org/using/install][start]. You'll be on the live network in a
few minutes.
If you're interested in Urbit development, keep reading.
[start]: https://urbit.org/docs/getting-started/
[start]: https://urbit.org/using/install/
## Development
@ -38,7 +49,7 @@ The Makefile in the project's root directory contains useful phony targets for
building, installing, testing, and so on. You can use it to avoid dealing with
Nix explicitly.
To build Urbit, for example, use:
To build the Urbit virtual machine binary, for example, use:
```
make build
@ -68,12 +79,10 @@ Contributions of any form are more than welcome! Please take a look at our
[contributing guidelines][cont] for details on our git practices, coding
styles, how we manage issues, and so on.
You might also be interested in:
For instructions on contributing to Landscape, see [its][lcont] guidelines.
- joining the [urbit-dev][list] mailing list.
- [applying to Hoon School][mail], a course we run to teach the Hoon
programming language and Urbit application development.
You might also be interested in joining the [urbit-dev][list] mailing list.
[list]: https://groups.google.com/a/urbit.org/forum/#!forum/dev
[mail]: mailto:support@urbit.org
[cont]: https://github.com/urbit/urbit/blob/master/CONTRIBUTING.md
[lcont]: https://github.com/urbit/urbit/blob/master/pkg/interface/CONTRIBUTING.md

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:cfb556a9e6b473f6cf6c75b30a3b12cb986e57df1600dad4383b9d3380cffdb6
size 6263010
oid sha256:76de5b7d0a764af59018acdb78b5bbfb47f93bc166b0179d12501cdc84070f80
size 6316045

20
pkg/arvo/README.md
View File

@ -33,7 +33,7 @@ To boot a fake ship with a custom pill, use the `-B` flag:
urbit -F zod -A /path/to/arvo -B /path/to.pill -c fakezod
```
To run all tests in `/tests`, run `+test` in dojo. `+test /some/path` would only run all tests in `/tests/some/path`.
To run all tests in `/tests`, run `-test %/tests` in dojo. To run only the tests in `/tests/some/path`, use `-test %/tests/some/path`.
## Maintainers
@ -41,20 +41,20 @@ Most parts of Arvo have dedicated maintainers.
* `/sys/hoon`: @pilfer-pandex (~pilfer-pandex)
* `/sys/zuse`: @pilfer-pandex (~pilfer-pandex)
* `/sys/arvo`: @jtobin (~nidsut-tomdun)
* `/sys/vane/ames`: @belisarius222 (~rovnys-ricfer) & @joemfb (~master-morzod)
* `/sys/arvo`: @joemfb (~master-morzod)
* `/sys/vane/ames`: @belisarius222 (~rovnys-ricfer) & @philipcmonk (~wicdev-wisryt)
* `/sys/vane/behn`: @belisarius222 (~rovnys-ricfer)
* `/sys/vane/clay`: @philipcmonk (~wicdev-wisryt)
* `/sys/vane/dill`: @bernardodelaplaz (~rigdyn-sondur)
* `/sys/vane/clay`: @philipcmonk (~wicdev-wisryt) & @belisarius222 (~rovnys-ricfer)
* `/sys/vane/dill`: @joemfb (~master-morzod)
* `/sys/vane/eyre`: @eglaysher (~littel-ponnys)
* `/sys/vane/ford`: @belisarius222 (~rovnys-ricfer) & @eglaysher (~littel-ponnys)
* `/sys/vane/gall`: @jtobin (~nidsut-tomdun)
* `/sys/vane/jael`: @fang- (~palfun-foslup) & @joemfb (~master-morzod)
* `/sys/vane/gall`: @philipcmonk (~wicdev-wisryt)
* `/sys/vane/jael`: @fang- (~palfun-foslup) & @philipcmonk (~wicdev-wisryt)
* `/app/acme`: @joemfb (~master-morzod)
* `/app/dns`: @joemfb (~master-morzod)
* `/app/hall`: @fang- (~palfun-foslup)
* `/app/talk`: @fang- (~palfun-foslup)
* `/app/aqua`: @philipcmonk (~wicdev-wisryt)
* `/app/hood`: @belisarius222 (~rovnys-ricfer)
* `/lib/hood/drum`: @philipcmonk (~wicdev-wisryt)
* `/lib/hood/kiln`: @philipcmonk (~wicdev-wisryt)
* `/lib/test`: @eglaysher (~littel-ponnys)
## Contributing

8
pkg/arvo/app/acme.hoon
View File

@ -1,4 +1,4 @@
/- asn1, hall
/- asn1
/+ base64, der, primitive-rsa, *pkcs, *jose, default-agent, verb
=, eyre
=* rsa primitive-rsa
@ -1023,7 +1023,7 @@
::
=> .(liv (some fig), rod ~)
?> ?=(^ liv)
:: notify :hall
:: notify %dill
::
=> =/ msg=cord
%+ rap 3
@ -1229,7 +1229,7 @@
::
?: (bad-nonce rep)
(nonce:effect [act spur])
:: XX replace with :hall notification
:: XX replace with %dill notification
::
~| [%http-response-fail wire]
%. [spur rep]
@ -1398,7 +1398,7 @@
this
=. ..emit (queue-next-order 1 | dom)
=. ..emit cancel-current-order
:: notify :hall
:: notify %dill
::
=. ..emit
=/ msg=cord

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

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

@ -1,8 +1,8 @@
:: chat-hook:
:: chat-hook [landscape]:
:: 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,
@ -22,8 +22,14 @@
state-5
state-6
state-7
state-8
state-9
state-10
==
::
+$ state-10 [%10 state-base]
+$ state-9 [%9 state-base]
+$ state-8 [%8 state-base]
+$ state-7 [%7 state-base]
+$ state-6 [%6 state-base]
+$ state-5 [%5 state-base]
@ -46,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]
==
::
@ -54,7 +60,7 @@
$% [%chat-update update:store]
==
--
=| state-7
=| state-10
=* state -
::
%- agent:dbug
@ -71,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
==
@ -83,8 +89,20 @@
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|-
?: ?=(%7 -.old)
?: ?=(%10 -.old)
[cards this(state old)]
?: ?=(%9 -.old)
=. cards
:_ cards
[%pass /self-poke %agent [our.bol %chat-hook] %poke %noun !>(%run-upg9)]
$(-.old %10)
?: ?=(%8 -.old)
$(-.old %9)
?: ?=(%7 -.old)
=. cards
:_ cards
[%pass /self-poke %agent [our.bol %chat-hook] %poke %noun !>(%run-upg7)]
$(-.old %8)
?: ?=(%6 -.old)
=. cards
%+ weld cards
@ -114,7 +132,7 @@
i.syncs
?> ?=(^ pax)
?. =('~' i.pax)
$(syncs t.syncs)
$(syncs t.syncs)
=/ new-path=path
t.pax
=. synced.old
@ -160,6 +178,17 @@
^- (list (list card))
(turn ~(tap in keys) generate-cards)
==
::
++ scry-for
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bol)
app
(scot %da now.bol)
(snoc `^path`path %noun)
==
::
++ kick-old-subs
|= old-path=path
^- (list card)
@ -335,7 +364,8 @@
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun (poke-noun:cc !<(?(%fix-dm %fix-out-of-sync) vase))
%noun
(poke-noun:cc !<(?(%fix-dm %fix-out-of-sync %run-upg7 %run-upg9) vase))
::
%chat-hook-action
(poke-chat-hook-action:cc !<(action:hook vase))
@ -376,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
@ -398,15 +428,100 @@
++ grp ~(. grpl bol)
::
++ poke-noun
|= a=?(%fix-dm %fix-out-of-sync)
|= a=?(%fix-dm %fix-out-of-sync %run-upg7 %run-upg9)
^- (quip card _state)
|^
:_ state
?- a
%fix-dm (fix-dm %fix-dm)
%fix-out-of-sync (fix-out-of-sync %fix-out-of-sync)
%fix-dm [(fix-dm %fix-dm) state]
%fix-out-of-sync [(fix-out-of-sync %fix-out-of-sync) state]
%run-upg7 run-7-to-8
%run-upg9 run-9-to-10
==
::
++ scry-for
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bol)
app
(scot %da now.bol)
(snoc `^path`path %noun)
==
::
++ add-synced
|= [=ship =path]
^- card
=- [%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action -]
!>(`action:hook`[%add-synced ship path %.y])
::
++ add-owned
|= [=path history=?]
^- card
=- [%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action -]
!>(`action:hook`[%add-owned path history])
::
++ run-7-to-8
^- (quip card _state)
:_ state
=/ subscribers=(jug path ship)
%+ roll ~(val by sup.bol)
|= [[=ship =path] out=(jug path ship)]
:: /(mailbox|backlog)/~ship/resource.name
::
?. ?=([@ @ @ *] path) out
=/ pax=^path [i.t.path i.t.t.path ~]
(~(put ju out) pax ship)
=/ group ~(. grpl bol)
^- (list card)
%+ murn ~(tap in ~(key by synced.state))
|= =path
^- (unit card)
?> ?=([@ @ ~] path)
=/ group-paths (groups-of-chat path)
?~ group-paths ~
=/ members (members-from-path:group i.group-paths)
?: (is-managed-path:group i.group-paths) ~
=/ ships=(set ship) (~(get ju subscribers) path)
%- some
=+ [%invite path (~(dif in members) ships)]
[%pass /inv %agent [our.bol %chat-view] %poke %chat-view-action !>(-)]
::
++ run-9-to-10
^- (quip card _state)
:_
=/ list-paths=(list path)
%+ murn ~(tap in ~(key by synced.state))
|= =app=path
^- (unit path)
?~ (groups-of-chat app-path)
`app-path
~
|-
?~ list-paths
state
=. synced.state (~(del by synced.state) i.list-paths)
$(list-paths t.list-paths)
%+ weld
^- (list card)
%+ roll ~(tap in ~(key by wex.bol))
|= [[=wire =ship =term] out=(list card)]
?> ?=([@ *] wire)
?. ?&(=(ship our.bol) =(term %chat-hook))
out
:_ out
=- [%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action !>(-)]
[%remove t.wire]
=/ chat-keys=(set path) (scry-for (set path) %chat-store [%keys ~])
^- (list card)
%+ turn ~(tap in chat-keys)
|= =app=path
^- card
?> ?=([@ @ ~] app-path)
=/ =ship (slav %p i.app-path)
?: =(ship our.bol)
(add-owned app-path %.y)
(add-synced ship app-path)
::
++ fix-out-of-sync
|= b=%fix-out-of-sync
^- (list card)
@ -523,6 +638,7 @@
::
%add-synced
?> (team:title our.bol src.bol)
?< =(ship.act our.bol)
?: (~(has by synced) path.act) [~ state]
=. synced (~(put by synced) path.act ship.act)
?. ask-history.act
@ -603,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
@ -789,13 +908,7 @@
?: =(i.t.wir '~')
?> ?=(^ chat)
(migrate-listen t.chat)
:_ state
%. ~[(chat-view-poke %delete chat)]
%- slog
:* leaf+"chat-hook failed subscribe on {(spud chat)}"
leaf+"stack trace:"
u.saw
==
[~ state]
==
::
++ chat-poke
@ -809,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]
@ -826,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)
::

4
pkg/arvo/app/chat-store.hoon
View File

@ -1,4 +1,6 @@
:: chat-store: data store that holds linear sequences of chat messages
:: chat-store [landscape]:
::
:: data store that holds linear sequences of chat messages
::
/+ store=chat-store, default-agent, verb, dbug, group-store
~% %chat-store-top ..is ~

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

@ -1,10 +1,12 @@
:: chat-view: sets up chat JS client, paginates data, and combines commands
:: chat-view [landscape]:
::
:: sets up chat JS client, paginates data, and combines commands
:: into semantic actions for the UI
::
/- *permission-store,
*permission-hook,
*group,
*invite-store,
inv=invite-store,
*metadata-store,
group-hook,
*permission-group-hook,
@ -157,7 +159,7 @@
(on-arvo:def wire sign-arvo)
::
++ on-save !>(state)
++ on-load
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ old ((soft state-0) q.old-vase)
@ -211,15 +213,14 @@
?- -.act
%create
?> ?=(^ app-path.act)
?> ?| =(+:group-path.act app-path.act)
=(~(tap in members.act) ~)
?> ?| =(+:group-path.act app-path.act)
=(~(tap in members.act) ~)
==
?^ (chat-scry app-path.act)
~& %chat-already-exists
~
%- zing
:~ (create-chat app-path.act allow-history.act)
%- create-group
:~ %- create-group
:* group-path.act
app-path.act
policy.act
@ -229,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
@ -295,6 +297,7 @@
~[(chat-hook-poke %add-synced ship.act app-path.act ask-history.act)]
=/ rid=resource
(de-path:resource ship+app-path.act)
?: =(our.bol entity.rid) ~
=/ =cage
:- %group-update
!> ^- action:group-store
@ -404,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
@ -484,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

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

@ -1,4 +1,6 @@
:: clock: deprecated, should be removed
:: clock [landscape]:
::
:: deprecated, should be removed
::
/+ *server, default-agent, verb, dbug
=, format

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

@ -1,9 +1,10 @@
:: contact-hook:
:: contact-hook [landscape]
::
::
/- group-hook,
*contact-hook,
*contact-view,
*invite-store,
inv=invite-store,
*metadata-hook,
*metadata-store,
*group
@ -43,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]
==
@ -54,7 +55,7 @@
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|^
|- ^- (quip card _this)
|- ^- (quip card _this)
?: ?=(%3 -.old)
[cards this(state old)]
?: ?=(%2 -.old)
@ -80,7 +81,7 @@
%_ $
-.old %2
::
synced.old
synced.old
%- malt
%+ turn
~(tap by synced.old)
@ -126,7 +127,7 @@
%json
(poke-json:cc !<(json vase))
::
%contact-action
%contact-action
(poke-contact-action:cc !<(contact-action vase))
::
%contact-hook-action
@ -149,7 +150,7 @@
%kick [(kick:cc wire) this]
%watch-ack
=^ cards state
(watch-ack:cc wire p.sign)
(watch-ack:cc wire p.sign)
[cards this]
::
%fact
@ -307,8 +308,8 @@
[%pass /group %agent [our.bol %group-store] %watch /groups]~
::
[%contacts @ *]
=/ wir
?: =(%ship i.t.wir)
=/ wir
?: =(%ship i.t.wir)
wir
(migrate wir)
?> ?=([%contacts @ @ *] wir)
@ -472,25 +473,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)]
--
::
++ group-hook-poke
|= =action:group-hook
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(action)]
::
++ invite-poke
|= act=invite-action
|= act=action:inv
^- card
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(act)]
::
@ -499,26 +485,6 @@
^- card
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
::
++ contact-view-poke
|= act=contact-view-action
^- card
[%pass / %agent [our.bol %contact-view] %poke %contact-view-action !>(act)]
::
++ group-poke
|= act=action:group-store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ metadata-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-store] %poke %metadata-action !>(act)]
::
++ metadata-hook-poke
|= act=metadata-hook-action
^- card
[%pass / %agent [our.bol %metadata-hook] %poke %metadata-hook-action !>(act)]
::
++ contacts-scry
|= pax=path
^- (unit contacts)
@ -530,16 +496,6 @@
==
.^((unit contacts) %gx pax)
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax
;: weld
/(scot %p our.bol)/invite-store/(scot %da now.bol)
/invite/contacts/(scot %uv uid)/noun
==
.^((unit invite) %gx pax)
::
++ group-scry
|= pax=path
.^ (unit group)

6
pkg/arvo/app/contact-store.hoon
View File

@ -1,4 +1,6 @@
:: contact-store: data store that holds group-based contact data
:: contact-store [landscape]:
::
:: data store that holds group-based contact data
::
/+ *contact-json, default-agent, dbug
|%
@ -253,7 +255,7 @@
++ send-diff
|= [pax=path upd=contact-update]
^- (list card)
:~ :*
:~ :*
%give %fact
~[/all /updates [%contacts pax]]
%contact-update !>(upd)

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

@ -1,9 +1,11 @@
:: contact-view: sets up contact JS client and combines commands
:: contact-view [landscape]:
::
:: sets up contact JS client and combines commands
:: into semantic actions for the UI
::
/-
group-hook,
*invite-store,
inv=invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
@ -159,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)]
::
@ -274,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

6
pkg/arvo/app/dbug.hoon
View File

@ -380,17 +380,19 @@
'connected'^b+!-.state
'expiry'^?-(-.state %& (time date.p.state), %| ~)
'next-id'^(numb next-id)
'last-ack'^(time last-ack)
'unacked'^a+(turn (sort (turn ~(tap in events) head) dor) numb)
::
:- 'subscriptions'
:- %a
%+ turn ~(tap by subscriptions)
|= [=wire [=^ship app=term =^path *]]
|= [id=@ud [=^ship app=term =^path *]]
%- pairs
:~ 'wire'^(^path wire)
:~ 'id'^(numb id)
'ship'^(^ship ship)
'app'^s+app
'path'^(^path path)
'unacked'^(numb (~(gut by unacked) id 0))
==
==
==

2
pkg/arvo/app/debug/js/index.js
View File

File diff suppressed because one or more lines are too long

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,7 +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 pad) sym ;~(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
==
@ -228,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))
@ -263,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
@ -284,9 +284,10 @@
==
++ parse-value
;~ pose
(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

29
pkg/arvo/app/file-server.hoon
View File

@ -1,5 +1,9 @@
:: file-server [landscape]:
::
:: mounts HTTP endpoints for Landscape (and third-party) user applications
::
/- srv=file-server, glob
/+ *server, default-agent, verb, dbug
/+ *server, default-agent, verb, dbug, version
|%
+$ card card:agent:gall
+$ serving (map url-base=path [=content public=? single-page=?])
@ -218,8 +222,8 @@
::
[~ %html]
%. file
%* . html-response:gen
cache
%* . html-response:gen
cache
!=(/app/landscape/index/html (slag 3 scry-path))
==
==
@ -316,24 +320,11 @@
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path (on-peek:def path)
[%x %clay %base %hash ~] ``hash+!>(base-hash)
[%x %clay %base %hash ~]
=/ versions (base-hash:version [our now]:bowl)
``hash+!>(?~(versions 0v0 (end 0 25 i.versions)))
==
:: stolen from +trouble
:: TODO: move to a lib?
++ base-hash
^- @uv
=+ .^ ota=(unit [=ship =desk =aeon:clay])
%gx /(scot %p our.bowl)/hood/(scot %da now.bowl)/kiln/ota/noun
==
?~ ota
*@uv
=/ parent (scot %p ship.u.ota)
=+ .^(=cass:clay %cs /[parent]/[desk.u.ota]/1/late/foo)
%^ end 0 25
.^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass))
--
++ on-agent on-agent:def
++ on-fail on-fail:def
--

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

@ -1,7 +1,11 @@
:: glob [landscape]:
::
:: prompts content delivery and Gall state storage for Landscape JS blob
::
/- glob
/+ default-agent, verb, dbug
|%
++ hash 0v6.8fpt6.7mcjg.nb019.df3fo.haav6
++ hash 0v5.67obv.15auf.c2rc7.jpcu2.iain3
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0
@ -81,20 +85,33 @@
%glob-make
:_ this
=/ home=path /(scot %p our.bowl)/home/(scot %da now.bowl)
=+ .^(=tube:clay %cc (weld home /js/mime))
=+ .^(=js=tube:clay %cc (weld home /js/mime))
=+ .^(=map=tube:clay %cc (weld home /map/mime))
=+ .^(arch %cy (weld home /app/landscape/js/bundle))
=/ bundle=path
=/ bundle-hash=@t
%- need
^- (unit path)
^- (unit @t)
%- ~(rep by dir)
|= [[file=@t ~] out=(unit path)]
|= [[file=@t ~] out=(unit @t)]
?^ out out
?. =((end 3 5 file) 'index')
~
`/[file]/js
=+ .^(js=@t %cx :(weld home /app/landscape/js/bundle bundle))
=+ !<(=mime (tube !>(js)))
=/ =glob:glob (~(put by *glob:glob) bundle mime)
?. ?& =((end 3 6 file) 'index.')
!=('sj.' (end 3 3 (swp 3 file)))
==
out
``@t`(rsh 3 6 file)
=/ js-name
(cat 3 'index.' bundle-hash)
=/ map-name
(cat 3 js-name '.js')
=+ .^(js=@t %cx :(weld home /app/landscape/js/bundle /[js-name]/js))
=+ .^(map=@t %cx :(weld home /app/landscape/js/bundle /[map-name]/map))
=+ !<(=js=mime (js-tube !>(js)))
=+ !<(=map=mime (map-tube !>(map)))
=/ =glob:glob
%- ~(gas by *glob:glob)
:~ /[js-name]/js^js-mime
/[map-name]/map^map-mime
==
=/ =path /(cat 3 'glob-' (scot %uv (sham glob)))/glob
[%pass /make %agent [our.bowl %hood] %poke %drum-put !>([path (jam glob)])]~
::

50
pkg/arvo/app/graph-pull-hook.hoon Normal file
View File

@ -0,0 +1,50 @@
/- *resource
/+ store=graph-store, graph, default-agent, verb, dbug, pull-hook
~% %graph-pull-hook-top ..is ~
|%
+$ card card:agent:gall
++ config
^- config:pull-hook
:* %graph-store
update:store
%graph-update
%graph-push-hook
==
--
::
%- agent:dbug
^- agent:gall
%- (agent:pull-hook config)
^- (pull-hook:pull-hook config)
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
dep ~(. (default:pull-hook this config) bowl)
gra ~(. graph bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-pull-nack
|= [=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]]
::
++ on-pull-kick
|= =resource
^- (unit path)
=/ maybe-time (peek-update-log:gra resource)
?~ maybe-time `/
`/(scot %da u.maybe-time)
--

146
pkg/arvo/app/graph-push-hook.hoon Normal file
View File

@ -0,0 +1,146 @@
/+ store=graph-store
/+ metadata
/+ res=resource
/+ graph
/+ group
/+ default-agent
/+ dbug
/+ push-hook
~% %graph-push-hook-top ..is ~
|%
+$ card card:agent:gall
++ config
^- config:push-hook
:* %graph-store
/updates
update:store
%graph-update
%graph-pull-hook
==
::
+$ agent (push-hook:push-hook config)
::
++ is-allowed
|= [=resource:res =bowl:gall requires-admin=?]
^- ?
=/ grp ~(. group bowl)
=/ met ~(. metadata bowl)
=/ group-paths (groups-from-resource:met [%graph (en-path:res resource)])
?~ group-paths %.n
?: requires-admin
(is-admin:grp src.bowl i.group-paths)
?| (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
^- agent:gall
%- (agent:push-hook config)
^- agent
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
grp ~(. group bowl)
gra ~(. graph bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke on-poke:def
++ on-agent on-agent:def
++ 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
::
++ should-proxy-update
|= =vase
^- ?
=/ =update:store !<(update:store vase)
?- -.q.update
%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-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)
%unarchive-graph %.n
%add-tag %.n
%remove-tag %.n
%keys %.n
%tags %.n
%tag-queries %.n
%run-updates (is-allowed resource.q.update bowl %.y)
==
::
++ resource-for-update
|= =vase
^- (unit resource:res)
=/ =update:store !<(update:store vase)
?- -.q.update
%add-graph `resource.q.update
%remove-graph `resource.q.update
%add-nodes `resource.q.update
%remove-nodes `resource.q.update
%add-signatures `resource.uid.q.update
%remove-signatures `resource.uid.q.update
%archive-graph `resource.q.update
%unarchive-graph ~
%add-tag ~
%remove-tag ~
%keys ~
%tags ~
%tag-queries ~
%run-updates `resource.q.update
==
::
++ initial-watch
|= [=path =resource:res]
^- vase
?> (is-allowed resource bowl %.n)
!> ^- update:store
?~ path
:: new subscribe
::
(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]]
::
++ take-update
|= =vase
^- [(list card) agent]
=/ =update:store !<(update:store vase)
?+ -.q.update [~ this]
%remove-graph
:_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
::
%archive-graph
:_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
==
--

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

@ -1,17 +1,26 @@
:: graph-store [landscape]
::
::
/+ store=graph-store, sigs=signatures, res=resource, default-agent, dbug
~% %graph-store-top ..is ~
|%
+$ 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
@ -24,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
@ -57,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]
::
@ -65,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)
@ -83,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]]~
==
@ -185,7 +354,7 @@
=/ =hash:store `@ux`(sham validated-portion)
?~ hash.p node(signatures.post *signatures:store)
~| "signatures do not match the calculated hash"
?> (are-signatures-valid:sigs signatures.p hash now.bowl)
?> (are-signatures-valid:sigs our.bowl signatures.p hash now.bowl)
~| "hash of post does not match calculated hash"
?> =(hash u.hash.p)
node
@ -282,7 +451,7 @@
?~ index graph
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
:: last index in list
::
@ -293,7 +462,7 @@
~| "cannot add signatures to a node missing a hash"
?> ?=(^ hash.post.node)
~| "signatures did not match public keys!"
?> (are-signatures-valid:sigs signatures u.hash.post.node now.bowl)
?> (are-signatures-valid:sigs our.bowl signatures u.hash.post.node now.bowl)
node(signatures.post (~(uni in signatures) signatures.post.node))
~| "child graph does not exist to add signatures to!"
?> ?=(%graph -.children.node)
@ -327,7 +496,7 @@
?~ index graph
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
:: last index in list
::
@ -392,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
@ -447,16 +621,53 @@
|^
?> (team:title our.bowl src.bowl)
?+ path (on-peek:def path)
[%x %keys ~] ``noun+!>(~(key by graphs))
[%x %tags ~] ``noun+!>(~(key by tag-queries))
[%x %tag-queries ~] ``noun+!>(tag-queries)
[%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)]])
::
[%x %tags ~]
:- ~ :- ~ :- %graph-update
!>(`update:store`[%0 now.bowl [%tags ~(key by tag-queries)]])
::
[%x %tag-queries ~]
:- ~ :- ~ :- %graph-update
!>(`update:store`[%0 now.bowl [%tag-queries tag-queries]])
::
[%x %graph @ @ ~]
=/ =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+!>(u.result)
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0
now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
::
:: note: near-duplicate of /x/graph
::
[%x %archive @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ result=(unit marked-graph:store)
(~(get by archive) [ship term])
?~ result
~& no-archived-graph+[ship term]
[~ ~]
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0
now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
::
[%x %graph-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
@ -466,37 +677,31 @@
=/ graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ graph [~ ~]
``noun+!>(`graph:store`(subset:orm p.u.graph start end))
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0 now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(subset:orm p.u.graph start end))
|= [=atom =node:store]
^- [index:store node:store]
[~[atom] node]
::
[%x %node @ @ @ *]
=/ =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 [~ ~]
``noun+!>(u.node)
::
[%x %post @ @ @ *]
=/ =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)))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
``noun+!>(post.u.node)
::
[%x %node-children @ @ @ *]
=/ =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)))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
?- -.children.u.node
%empty [~ ~]
%graph ``noun+!>(p.children.u.node)
==
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0
now.bowl
:+ %add-nodes
[ship term]
(~(gas by *(map index:store node:store)) [index u.node] ~)
::
[%x %node-children-subset @ @ @ @ @ *]
=/ =ship (slav %p i.t.t.path)
@ -509,8 +714,29 @@
?~ node [~ ~]
?- -.children.u.node
%empty [~ ~]
%graph ``noun+!>(`graph:store`(subset:orm p.children.u.node start end))
%graph
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0
now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(subset:orm p.children.u.node end start))
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
==
::
[%x %update-log-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ start=(unit time) (slaw %da i.t.t.t.t.path)
=/ 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 [~ ~]
:: 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)
@ -525,7 +751,7 @@
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
=/ result=(unit [time update:store])
(peek:orm-log:store u.update-log)
(peek:orm-log:store u.update-log)
?~ result [~ ~]
``noun+!>([~ -.u.result])
==
@ -554,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]]~
==
::

6
pkg/arvo/app/group-hook.hoon
View File

@ -1,4 +1,6 @@
:: group-hook: allow syncing group data from foreign paths to local paths
:: group-hook [landscape]:
::
:: allow syncing group data from foreign paths to local paths
::
/- *group, hook=group-hook, *invite-store
/+ default-agent, verb, dbug, store=group-store, grpl=group, pull-hook, push-hook, resource
@ -58,7 +60,7 @@
:: ignore duplicate publish groups
?: =(4 (lent path))
~& "ignoring: {<path>}"
~
~
=/ pax=^path
?: =('~' i.path)
t.path

3
pkg/arvo/app/group-pull-hook.hoon
View File

@ -1,5 +1,6 @@
:: group-hook: allow syncing group data from foreign paths to local paths
:: group-hook [landscape]:
::
:: allow syncing group data from foreign paths to local paths
::
/- *group, hook=group-hook, *invite-store, *resource
/+ default-agent, verb, dbug, store=group-store, grpl=group, pull-hook

3
pkg/arvo/app/group-push-hook.hoon
View File

@ -1,5 +1,6 @@
:: group-hook: allow syncing group data from foreign paths to local paths
:: group-hook [landscape]:
::
:: allow syncing group data from foreign paths to local paths
::
/- *group, hook=group-hook, *invite-store
/+ default-agent, verb, dbug, store=group-store, grpl=group, push-hook,

14
pkg/arvo/app/group-store.hoon
View File

@ -1,4 +1,6 @@
:: group-store: Store groups of ships
:: group-store [landscape]:
::
:: Store groups of ships
::
:: group-store stores groups of ships, so that resources in other apps can be
:: associated with a group. The current model of group-store rolls
@ -128,7 +130,7 @@
^- [resource group]
=/ members=(set ship)
(~(got by groups.old) pax)
=| =invite:policy
=| =invite:policy
?> ?=(^ pax)
=/ rid=resource
(resource-from-old-path t.pax)
@ -149,7 +151,7 @@
|= pax=path
=/ members
(~(got by groups.old) pax)
=| =invite:policy
=| =invite:policy
=/ rid=resource
(resource-from-old-path pax)
=/ =tags
@ -229,7 +231,7 @@
(~(has in members.group) ship)
==
%open
?! ?|
?! ?|
(~(has in banned.policy) ship)
(~(has in ban-ranks.policy) (clan:title ship))
==
@ -275,7 +277,7 @@
^- resource
?> ?=([@ @ *] path)
:- (slav %p i.path)
i.t.path
i.t.path
::
++ add-new
|= =permission:permission-store
@ -283,7 +285,7 @@
?: ?=(%black kind.permission)
[~ ~ [%open ~ who.permission] %.y]
[who.permission ~ [%invite ~] %.y]
::
::
++ update-existing
|= =permission:permission-store
|= =group

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
--

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

@ -2,7 +2,7 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$: %9
$: %11
drum=state:drum
helm=state:helm
kiln=state:kiln
@ -12,6 +12,8 @@
[ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
[%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
@ -64,7 +66,7 @@
=^ d drum.state (on-load:drum-core -.old drum.tup)
=^ h helm.state (on-load:helm-core -.old helm.tup)
=^ k kiln.state (on-load:kiln-core -.old kiln.tup)
[:(weld d h k) this]
[:(welp d h k) this]
::
++ on-poke
|= [=mark =vase]

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

@ -1,121 +1,121 @@
:: invite-hook: receive invites from any source
:: invite-hook [landscape]: receive invites from any source
::
:: 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.
:: 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.
::
/+ *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
--

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

@ -1,183 +1,209 @@
/+ *invite-json, default-agent, dbug
:: invite-store [landscape]
/- 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)
==
::
--

4
pkg/arvo/app/invite-view.hoon
View File

@ -1,3 +1,7 @@
:: invite-view [landscape]:
::
:: deprecated
::
/+ default-agent
^- agent:gall
|_ =bowl:gall

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

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 4.7 KiB

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/groups.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 693 B

BIN
pkg/arvo/app/landscape/img/icon-home.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 582 B

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

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

@ -21,9 +21,9 @@
</head>
<body>
<div id="root"></div>
<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.5c70804296e13e8973c3.js"></script>
<script src="https://sdk.amazonaws.com/js/aws-sdk-2.1.12.min.js"></script>
<script src="/~landscape/js/bundle/index.cf90ee9625a2551fe672.js"></script>
</body>
</html>

23
pkg/arvo/app/landscape/js/channel.js
View File

@ -66,7 +66,7 @@ class Channel {
}
deleteOnUnload() {
window.addEventListener("unload", (event) => {
window.addEventListener("beforeunload", (event) => {
this.delete();
});
}
@ -103,14 +103,16 @@ class Channel {
path,
connectionErrFunc = () => {},
eventFunc = () => {},
quitFunc = () => {}) {
quitFunc = () => {},
subAckFunc = () => {}) {
let id = this.nextId();
this.outstandingSubscriptions.set(
id,
{
err: connectionErrFunc,
event: eventFunc,
quit: quitFunc
quit: quitFunc,
subAck: subAckFunc
}
);
@ -165,9 +167,11 @@ class Channel {
// The server side puts messages it sends us in a queue until we
// acknowledge that we received it.
//
let x = JSON.stringify(
[{action: "ack", "event-id": parseInt(this.lastEventId)}, j]
);
let payload = [{action: "ack", "event-id": parseInt(this.lastEventId)}];
if(j) {
payload.push(j)
}
let x = JSON.stringify(payload);
req.send(x);
this.lastEventId = this.lastAcknowledgedEventId;
@ -205,13 +209,16 @@ class Channel {
} else if (obj.response == "subscribe" ||
(obj.response == "poke" && !!subFuncs)) {
let funcs = subFuncs;
// on a response to a subscribe, we only notify the caller on err
//
if (obj.hasOwnProperty("err")) {
funcs["err"](obj.err);
this.outstandingSubscriptions.delete(obj.id);
} else if (obj.hasOwnProperty("ok")) {
funcs["subAck"](obj);
}
} else if (obj.response == "diff") {
// ack subscription
this.sendJSONToChannel();
let funcs = subFuncs;
funcs["event"](obj.json);
} else if (obj.response == "quit") {

2
pkg/arvo/app/language-server.hoon
View File

@ -247,7 +247,7 @@
(~(put by builds) uri q.r.u.p.gift)
=. ford-diagnostics
(~(del by ford-diagnostics) uri)
=+ .^(=open:clay %cs /(scot %p our.bow)/home/(scot %da now.bow)/open)
=+ .^(=open:clay %cs /(scot %p our.bow)/home/(scot %da now.bow)/open/foo)
=/ =type -:(open (uri-to-path:build uri))
=. preludes
(~(put by preludes) uri type)

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

@ -1,3 +1,7 @@
:: launch [landscape]:
::
:: registers Landscape (and third party) applications, tiles
::
/+ store=launch-store, default-agent, dbug
|%
+$ card card:agent:gall
@ -7,6 +11,8 @@
[%2 *]
[%3 *]
[%4 state-zero]
[%5 state-zero]
[%6 state-zero]
==
::
+$ state-zero
@ -16,7 +22,7 @@
==
--
::
=| [%4 state-zero]
=| [%6 state-zero]
=* state -
%- agent:dbug
^- agent:gall
@ -31,59 +37,81 @@
%_ new-state
tiles
%- ~(gas by *tiles:store)
%+ turn `(list term)`[%chat %publish %links %weather %clock %dojo ~]
%+ turn `(list term)`[%weather %clock %term ~]
|= =term
:- term
^- tile:store
?+ term [[%custom ~] %.y]
%chat [[%basic 'Chat' '/~landscape/img/Chat.png' '/~chat'] %.y]
%links [[%basic 'Links' '/~landscape/img/Links.png' '/~link'] %.y]
%dojo [[%basic 'Dojo' '/~landscape/img/Dojo.png' '/~dojo'] %.y]
%publish
[[%basic 'Publish' '/~landscape/img/Publish.png' '/~publish'] %.y]
?+ term [[%custom ~] %.y]
%term [[%basic 'Terminal' '/~landscape/img/term.png' '/~term'] %.y]
==
tile-ordering [%chat %publish %links %weather %clock %dojo ~]
tile-ordering [%weather %clock %term ~]
==
[~ this(state [%4 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)
:: 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 [~ /]]~
this(state old-state)
=. cards
%+ snoc cards
[%pass / %arvo %e %disconnect [~ /]]
=. tiles.old-state
(~(del by tiles.old-state) %chat)
=. tiles.old-state
(~(del by tiles.old-state) %publish)
=. tiles.old-state
(~(del by tiles.old-state) %links)
=. tile-ordering.old-state
(skip tile-ordering.old-state |=(=term ?=(?(%links %chat %publish) term)))
$(old-state [%5 +.old-state])
=/ new-state *state-zero
=. new-state
%_ new-state
tiles
%- ~(gas by *tiles:store)
%+ turn `(list term)`[%chat %publish %links %weather %clock %dojo ~]
%+ turn `(list term)`[%weather %clock %dojo ~]
|= =term
:- term
^- tile:store
?+ term [[%custom ~] %.y]
%chat [[%basic 'Chat' '/~landscape/img/Chat.png' '/~chat'] %.y]
%links [[%basic 'Links' '/~landscape/img/Links.png' '/~link'] %.y]
%dojo [[%basic 'Dojo' '/~landscape/img/Dojo.png' '/~dojo'] %.y]
%publish
[[%basic 'Publish' '/~landscape/img/Publish.png' '/~publish'] %.y]
==
tile-ordering [%chat %publish %links %weather %clock %dojo ~]
tile-ordering [%weather %clock %dojo ~]
==
:_ this(state [%4 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]

654
pkg/arvo/app/link-listen-hook.hoon
View File

@ -1,644 +1,52 @@
:: link-listen-hook: get your friends' bookmarks
:: link-listen-hook: no longer in use
::
:: keeps track of a listening=(set app-path). users can manually add to and
:: remove from this set.
::
:: for all ships in groups associated with those resources, we subscribe to
:: their link's local-pages and annotations at the resource path (through
:: link-proxy-hook), and forward all entries into our link-store as
:: submissions and comments.
::
:: if a subscription to a target fails, we assume it's because their
:: metadata+groups definition hasn't been updated to include us yet.
:: we retry with exponential backoff, maxing out at one hour timeouts.
:: to expede this process, we prod other potential listeners when we add
:: them to our metadata+groups definition.
::
::
/- listen-hook=link-listen-hook, *metadata-store, *group, *link
/+ mdl=metadata, default-agent, verb, dbug, group-store, grpl=group, resource, store=link-store
/+ default-agent, verb, dbug
::
~% %link-listen-hook-top ..is ~
|%
+$ versioned-state
$% [%0 state-0]
[%1 state-1]
[%2 state-2]
[%3 state-3]
$% [%0 *]
[%1 *]
[%2 *]
[%3 *]
[%4 ~]
==
+$ state-3 state-1
+$ state-2 state-1
+$ state-1
$: listening=(set app-path)
state-0
==
+$ state-0
$: retry-timers=(map target @dr)
:: reasoning: the resources we're subscribed to,
:: and the groups that cause that.
::
:: we don't strictly need to track this in state, but doing so heavily
:: simplifies logic and reduces the amount of big scries we do.
:: this also gives us the option to check & restore subscriptions,
:: should we ever need that.
::
reasoning=(jug [ship app-path] group-path)
==
::
+$ what-target ?(%local-pages %annotations)
+$ target
$: what=what-target
who=ship
where=path
==
++ wire-to-target
|= =wire
^- target
?> ?=([what-target @ ^] wire)
[i.wire (slav %p i.t.wire) t.t.wire]
++ target-to-wire
|= target
^- wire
[what (scot %p who) where]
::
+$ card card:agent:gall
--
::
=| [%3 state-3]
=| [%4 ~]
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
~[watch-metadata:do watch-groups:do]
::
++ on-save !>(state)
++ on-load
|= =vase
^- (quip card _this)
=/ old=versioned-state
!<(versioned-state vase)
=| cards=(list card)
|-
=* upgrade-loop $
?- -.old
%3 [cards this(state old)]
::
%2
:_ this(state [%3 +.old])
%+ welp cards
:~ [%pass /groups %agent [our.bowl %group-store] %leave ~]
watch-groups:do
==
::
%1
:: the upgrade from 0 left out local-only collections.
:: here, we pull those back in.
::
=. listening.old
(~(run in ~(key by reasoning.old)) tail)
=/ resources=(list [=group-path =app-path])
%~ tap in
%. %link
%~ get ju
.^ (jug app-name [group-path app-path])
%gy
(scot %p our.bowl)
%metadata-store
(scot %da now.bowl)
/app-indices
==
|-
?~ resources
upgrade-loop(old [%2 +.old])
=, i.resources
=/ members=(set ship)
(members-from-path:grp:do group-path)
:: if we're the only group member, this got incorrectly ignored
:: during 0's upgrade logic. watch it now.
::
?. &(=(1 ~(wyt in members)) (~(has in members) our.bowl))
$(resources t.resources)
=^ more-cards state
(handle-listen-action:do %watch app-path)
$(resources t.resources, cards (weld more-cards cards))
::
%0
=/ listening=(set app-path)
(~(run in ~(key by reasoning.old)) tail)
$(old [%1 listening +.old])
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards state
?+ wire ~|([dap.bowl %weird-agent-wire wire] !!)
[%metadata ~]
(take-metadata-sign:do sign)
::
[%groups ~]
(take-groups-sign:do sign)
::
[%links ?(%local-pages %annotations) @ ^]
(take-link-sign:do (wire-to-target t.wire) sign)
::
[%forward ^]
(take-forward-sign:do t.wire sign)
::
[%prod *]
?> ?=(%poke-ack -.sign)
?~ p.sign [~ state]
%- (slog leaf+"prod failed" u.p.sign)
[~ state]
==
[cards this]
::
++ on-poke
|= [=mark =vase]
?+ mark (on-poke:def mark vase)
%link-listen-poke
=/ =path !<(path vase)
:_ this
%+ weld
(take-retry:do %local-pages src.bowl path)
(take-retry:do %annotations src.bowl path)
::
%link-listen-action
?> (team:title [our src]:bowl)
=^ cards state
~| p.vase
(handle-listen-action:do !<(action:listen-hook vase))
[cards this]
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%g %done *]
?~ error.sign-arvo [~ this]
=/ =tank leaf+"{(trip dap.bowl)}'s message went wrong!"
%- (slog tank tang.u.error.sign-arvo)
[~ this]
::
[%b %wake *]
?> ?=([%retry @ @ ^] wire)
?^ error.sign-arvo
=/ =tank leaf+"wake on {(spud wire)} went wrong!"
%- (slog tank u.error.sign-arvo)
[~ this]
:_ this
(take-retry:do (wire-to-target t.wire))
==
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path ~
[%x %listening ~] ``noun+!>(listening)
[%x %listening ^] ``noun+!>((~(has in listening) t.t.path))
==
::
++ on-watch
|= =path
^- (quip card _this)
?. ?=([%listening ~] path) (on-watch:def path)
?> (team:title [our src]:bowl)
:_ this
[%give %fact ~ %link-listen-update !>([%listening listening])]~
::
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
::
|_ =bowl:gall
+* md ~(. mdl bowl)
++ grp ~(. grpl bowl)
+* this .
def ~(. (default-agent this %|) bowl)
::
:: user actions & updates
::
++ handle-listen-action
|= =action:listen-hook
^- (quip card _state)
::NOTE no-opping where appropriate happens further down the call stack.
:: we *could* no-op here, as %watch when we're already listening should
:: result in no-ops all the way down, but walking through everything
:: makes this a nice "resurrect if broken unexpectedly" option.
::
=* app-path path.action
=^ cards listening
^- (quip card _listening)
=/ had=? (~(has in listening) app-path)
?- -.action
%watch
:_ (~(put in listening) app-path)
?:(had ~ [(send-update action)]~)
::
%leave
:_ (~(del in listening) app-path)
?.(had ~ [(send-update action)]~)
==
=/ groups=(list group-path)
(groups-from-resource:md %link app-path)
|-
?~ groups [cards state]
=^ more-cards state
?- -.action
%watch (listen-to-group app-path i.groups)
%leave (leave-from-group app-path i.groups)
==
$(cards (weld cards more-cards), groups t.groups)
::
++ send-update
|= =update:listen-hook
++ on-init [~ this]
++ on-save !>(state)
++ on-load
|= =vase
^- (quip card _this)
:_ this
:- [%pass /groups %agent [our.bowl %group-store] %leave ~]
%+ turn ~(tap in ~(key by wex.bowl))
|= [=wire =ship =term]
^- card
[%give %fact ~[/listening] %link-listen-update !>(update)]
[%pass wire %agent [ship term] %leave ~]
::
:: metadata subscription
::
++ watch-metadata
^- card
[%pass /metadata %agent [our.bowl %metadata-store] %watch /app-name/link]
::
++ take-metadata-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /metadata] !!)
%kick [[watch-metadata]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to metadata store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?. ?=(%metadata-update mark)
~| [dap.bowl %unexpected-mark mark]
!!
%- handle-metadata-update
!<(metadata-update vase)
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%b *] [~ this]
==
::
++ handle-metadata-update
|= upd=metadata-update
^- (quip card _state)
?+ -.upd [~ state]
%add
?> =(%link app-name.resource.upd)
:: auto-listen to collections in unmanaged groups only
::
=/ rid=resource
(de-path:resource group-path.upd)
=/ =group
(need (scry-group:grp rid))
?. hidden.group
[~ state]
=, resource.upd
=^ update listening
^- (quip card _listening)
?: (~(has in listening) app-path)
[~ listening]
:- [(send-update %watch app-path)]~
(~(put in listening) app-path)
=^ cards state
(listen-to-group app-path group-path.upd)
[(weld update cards) state]
::
%remove
?> =(%link app-name.resource.upd)
=? listening
?=(~ (groups-from-resource:md %link app-path.resource.upd))
(~(del in listening) app-path.resource.upd)
(leave-from-group app-path.resource.upd group-path.upd)
==
::
:: groups subscriptions
::
++ watch-groups
^- card
[%pass /groups %agent [our.bowl %group-store] %watch /groups]
::
++ take-groups-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
%kick [[watch-groups]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to groups. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial [~ state] ::NOTE initial handled using metadata
%group-update (handle-group-update !<(update:group-store vase))
==
==
::
++ handle-group-update
|= upd=update:group-store
^- (quip card _state)
?. ?=(?(%add-members %initial-group %remove-members) -.upd)
[~ state]
=/ =path
(en-path:resource resource.upd)
=/ socs=(list app-path)
(app-paths-from-group:md %link path)
=/ whos=(list ship)
?- -.upd
%add-members ~(tap in ships.upd)
%remove-members ~(tap in ships.upd)
%initial-group ~(tap in members.group.upd)
==
=| cards=(list card)
|-
=* loop-socs $
?~ socs [cards state]
?. (~(has in listening) i.socs)
loop-socs(socs t.socs)
|-
=* loop-whos $
?~ whos loop-socs(socs t.socs)
=^ caz state
?. ?=(%remove-members -.upd)
(listen-to-peer i.socs path i.whos)
?: =(our.bowl i.whos)
(handle-listen-action %leave i.socs)
(leave-from-peer i.socs path i.whos)
loop-whos(whos t.whos, cards (weld cards caz))
::
:: link subscriptions
::
++ listen-to-group
|= [=app-path =group-path]
^- (quip card _state)
=/ peers=(list ship)
~| group-path
%~ tap in
(members-from-path:grp group-path)
=| cards=(list card)
|-
?~ peers [cards state]
=^ caz state
(listen-to-peer app-path group-path i.peers)
$(peers t.peers, cards (weld cards caz))
::
++ leave-from-group
|= [=app-path =group-path]
^- (quip card _state)
=/ peers=(list ship)
%~ tap in
(members-from-path:grp group-path)
=| cards=(list card)
|-
?~ peers [cards state]
=^ caz state
(leave-from-peer app-path group-path i.peers)
$(peers t.peers, cards (weld cards caz))
::
++ listen-to-peer
|= [=app-path =group-path who=ship]
^- (quip card _state)
?: =(our.bowl who)
[~ state]
:_ =- state(reasoning -)
(~(put ju reasoning) [who app-path] group-path)
:- (prod-other-listener who app-path)
?^ (~(get ju reasoning) [who app-path])
~
(start-link-subscriptions who app-path)
::
++ leave-from-peer
|= [=app-path =group-path who=ship]
^- (quip card _state)
?: =(our.bowl who)
[~ state]
=. reasoning (~(del ju reasoning) [who app-path] group-path)
::NOTE leaving is always safe, so we just do it unconditionally
(end-link-subscriptions who app-path)
::
++ start-link-subscriptions
|= [=ship =app-path]
^- (list card)
:~ (start-link-subscription %local-pages ship app-path)
(start-link-subscription %annotations ship app-path)
==
::
++ start-link-subscription
|= =target
^- card
:* %pass
[%links (target-to-wire target)]
%agent
[who.target %link-proxy-hook]
%watch
?- what.target
%local-pages [what where]:target
%annotations [what %$ where]:target
==
==
::
++ end-link-subscriptions
|= [who=ship where=path]
^- (quip card _state)
=. retry-timers (~(del by retry-timers) [%local-pages who where])
=. retry-timers (~(del by retry-timers) [%annotations who where])
:_ state
|^ ~[(end %local-pages) (end %annotations)]
::
++ end
|= what=what-target
:* %pass
[%links (target-to-wire what who where)]
%agent
[who %link-proxy-hook]
%leave
~
==
--
::
++ prod-other-listener
|= [who=ship where=path]
^- card
:* %pass
[%prod (scot %p who) where]
%agent
[who %link-listen-hook]
%poke
%link-listen-poke
!>(where)
==
::
++ take-link-sign
|= [=target =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links target] !!)
%kick [[(start-link-subscription target)]~ state]
::
%watch-ack
?~ p.sign
=. retry-timers (~(del by retry-timers) target)
[~ state]
:: our subscription request got rejected,
:: most likely because our group definition is out of sync with theirs.
:: set timer for retry.
::
(start-retry target)
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%link-initial
%- handle-link-initial
[who.target where.target !<(initial:store vase)]
::
%link-update
%- handle-link-update
[who.target where.target !<(update:store vase)]
==
==
::
++ start-retry
|= =target
^- (quip card _state)
=/ timer=@dr
%+ min ~h1
%+ mul 2
(~(gut by retry-timers) target ~s15)
=. retry-timers
(~(put by retry-timers) target timer)
:_ state
:_ ~
:* %pass
[%retry (target-to-wire target)]
[%arvo %b %wait (add now.bowl timer)]
==
::
++ take-retry
|= =target
^- (list card)
:: relevant: whether :who is still associated with resource :where
::
=; relevant=?
?. relevant ~
[(start-link-subscription target)]~
?. (~(has in listening) where.target)
|
?: %- ~(has by wex.bowl)
[[%links (target-to-wire target)] who.target %link-proxy-hook]
|
%+ lien (groups-from-resource:md %link where.target)
|= =group-path
^- ?
%. who.target
~(has in (members-from-path:grp group-path))
::
++ do-link-action
|= [=wire =action:store]
^- card
:* %pass
wire
%agent
[our.bowl %link-store]
%poke
%link-action
!>(action)
==
::
++ handle-link-initial
|= [who=ship where=path =initial:store]
^- (quip card _state)
?> =(src.bowl who)
?+ -.initial ~|([dap.bowl %unexpected-initial -.initial] !!)
%local-pages
=/ =pages (~(got by pages.initial) where)
(handle-link-update who where [%local-pages where pages])
::
%annotations
=/ urls=(list [=url =notes])
~(tap by (~(got by notes.initial) where))
=| cards=(list card)
|- ^- (quip card _state)
?~ urls [cards state]
=^ caz state
^- (quip card _state)
=, i.urls
(handle-link-update who where [%annotations where url notes])
$(urls t.urls, cards (weld cards caz))
==
::
++ handle-link-update
|= [who=ship where=path =update:store]
^- (quip card _state)
?> =(src.bowl who)
:_ state
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%local-pages
%+ turn pages.update
|= =page
%+ do-link-action
[%forward %local-page (scot %p who) where]
[%hear where who page]
::
%annotations
%+ turn notes.update
|= =note
^- card
%+ do-link-action
`wire`[%forward %annotation (scot %p who) where]
`action:store`[%read where url.update `comment`[who note]]
==
::
++ take-forward-sign
|= [=wire =sign:agent:gall]
^- (quip card _state)
~| [%unexpected-sign on=[%forward wire] -.sign]
?> ?=(%poke-ack -.sign)
?~ p.sign [~ state]
=/ =tank
:- %leaf
;: weld
(trip dap.bowl)
" failed to save submission from "
(spud wire)
==
%- (slog tank u.p.sign)
[~ state]
::
++ scry-for
|* [=mold =app-name =path]
.^ mold
%gx
(scot %p our.bowl)
app-name
(scot %da now.bowl)
(snoc `^path`path %noun)
==
++ on-agent on-agent:def
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--

347
pkg/arvo/app/link-proxy-hook.hoon
View File

@ -1,337 +1,46 @@
:: link-proxy-hook: make local pages available to foreign ships
:: link-proxy-hook: no longer in use
::
:: this is a "proxy" style hook, relaying foreign subscriptions into local
:: stores if permission conditions are met.
:: the patterns herein should one day be generalized into a proxy-hook lib.
::
:: this uses metadata-store to discover resources and their associated
:: groups. it sets the permission condition to be that a ship must be in a
:: group associated with the resource it's subscribing to.
:: we check this on-watch, but also subscribe to metadata & groups so that
:: we can kick subscriptions if needed (eg ship removed from group).
::
:: we deduplicate incoming subscriptions on the same path, ensuring we have
:: exactly one local subscription per unique incoming subscription path.
:: this comes at the cost of assuming that the store's initial response is
:: whatever's returned by the scry at that path, but perhaps that should
:: become part of the stores standard anyway.
::
:: when adding support for new paths, the only things you'll likely want
:: to touch are +permitted, +initial-response, & +kick-proxies.
::
/- *link, *metadata-store, *group
/+ metadata, default-agent, verb, dbug, group-store, grpl=group,
resource, store=link-store
/+ default-agent, verb, dbug
~% %link-proxy-hook-top ..is ~
|%
+$ state-0
$: %0
::TODO we use this to detect "first sub started" and "last sub left",
:: but can't we use [wex sup]:bowl for that?
active=(map path (set ship))
==
+$ state-1
$: %1
active=(map path (set ship))
==
::
+$ versioned-state
$% state-0
state-1
$% [%0 *]
[%1 *]
[%2 ~]
==
::
+$ card card:agent:gall
--
::
=| state-1
=| [%2 ~]
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %&) bowl)
::
++ on-init
^- (quip card _this)
:_ this
~[watch-groups:do watch-metadata:do]
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ old
!<(versioned-state old-vase)
?- -.old
%1 [~ this(state old)]
::
%0
:_ this(state [%1 +.old])
:~ [%pass /groups %agent [our.bowl %group-store] %leave ~]
watch-groups:do
==
==
::
++ on-watch
|= =path
^- (quip card _this)
:: the local ship should just use link-store directly
::TODO do we want to allow this anyway, to avoid client-side target checks?
::
?< (team:title [our src]:bowl)
?> (permitted:do src.bowl path)
=^ cards state
(start-proxy:do src.bowl path)
[cards this]
::
++ on-leave
|= =path
^- (quip card _this)
=^ cards state
(stop-proxy:do src.bowl path)
[cards this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%groups ~] wire)
=^ cards state
(take-groups-sign:do sign)
[cards this]
?: ?=([%proxy ^] wire)
=^ cards state
(handle-proxy-sign t.wire sign)
[cards this]
~| [dap.bowl %weird-wire wire]
!!
::
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
+* md ~(. metadata bowl)
grp ~(. grpl bowl)
+* this .
def ~(. (default-agent this %&) bowl)
::
:: permissions
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ paths
%+ turn ~(val by sup.bowl)
|=([=ship =path] path)
:_ this
:- [%pass /groups %agent [our.bowl %group-store] %leave ~]
?~ paths ~
[%give %kick paths ~]~
::
++ permitted
|= [who=ship =path]
^- ?
:: we only expose /local-pages and /annotations,
:: to ships in the groups associated with the resource.
:: (no url-specific annotations subscriptions, either.)
::
=/ target=(unit ^path)
?: ?=([%local-pages ^] path)
`t.path
?: ?=([%annotations ~ ^] path)
`t.t.path
~
?~ target |
%+ lien (groups-from-resource:md %link u.target)
|= =group-path
^- ?
(~(has in (members-from-path:grp group-path)) who)
::
++ kick-revoked-permissions
|= [=path who=(list ship)]
^- (list card)
%+ murn who
|= =ship
^- (unit card)
:: no need to remove to ourselves
::
?: =(our.bowl ship) ~
?: (permitted ship path) ~
`(kick-proxies ship path)
::
:: metadata subscription
::
++ watch-metadata
^- card
[%pass /metadata %agent [our.bowl %metadata-store] %watch /app-name/link]
::
++ take-metadata-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /metadata] !!)
%kick [[watch-metadata]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to metadata store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?. ?=(%metadata-update mark)
~| [dap.bowl %unexpected-mark mark]
!!
%- handle-metadata-update
!<(metadata-update vase)
==
::
++ handle-metadata-update
|= upd=metadata-update
^- (quip card _state)
:_ state
?. ?=(%remove -.upd) ~
?> =(%link app-name.resource.upd)
:: if a group is no longer associated with a resource,
:: we need to re-check permissions for everyone in that group.
::
%+ kick-revoked-permissions
app-path.resource.upd
%~ tap in
(members-from-path:grp group-path.upd)
::
:: groups subscription
::TODO largely copied from link-listen-hook. maybe make a store-listener lib?
::
++ watch-groups
^- card
[%pass /groups %agent [our.bowl %group-store] %watch /groups]
::
++ take-groups-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
%kick [[watch-groups]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to group store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial [~ state]
%group-update (handle-group-update !<(update:group-store vase))
==
==
::
++ handle-group-update
|= upd=update:group-store
^- (quip card _state)
:_ state
?. ?=(%remove-members -.upd) ~
:: if someone was removed from a group, find all link resources associated
:: with that group, then kick their subscriptions if they're no longer
::
%- zing
%+ turn (app-paths-from-group:md %link (en-path:resource resource.upd))
|= =app-path
^- (list card)
%+ kick-revoked-permissions
app-path
~(tap in ships.upd)
::
:: proxy subscriptions
::
++ kick-proxies
|= [who=ship =path]
^- card
=- [%give %kick - `who]
:~ [%local-pages path]
[%annotations %$ path]
==
::
++ handle-proxy-sign
|= [=wire =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack wire] !!)
%fact [[%give %fact ~[wire] cage.sign]~ state]
%kick [[(proxy-pass-link-store wire %watch wire)]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to link-store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
==
::
++ proxy-pass-link-store
|= [=path =task:agent:gall]
^- card
:* %pass
[%proxy path]
%agent
[our.bowl %link-store]
task
==
::
++ initial-response
|= =path
^- card
=; =initial:store
[%give %fact ~ %link-initial !>(initial)]
?+ path !!
[%local-pages ^]
[%local-pages (scry-for (map ^path pages) %link-store path)]
::
[%annotations %$ ^]
[%annotations (scry-for (per-path-url notes) %link-store path)]
==
::
++ start-proxy
|= [who=ship =path]
^- (quip card _state)
:_ state(active (~(put ju active) path who))
:_ ~
:: if we already have a local subscription open,
::
?. =(~ (~(get ju active) path))
:: gather the initial response ourselves, and send that.
::
(initial-response path)
:: else, open a local subscription,
:: sending outward its initial response when we hear it.
::
(proxy-pass-link-store path %watch path)
::
++ stop-proxy
|= [who=ship =path]
^- (quip card _state)
=. active (~(del ju active) path who)
:_ state
:: if there are still subscriptions remaining, do nothing.
::
?. =(~ (~(get ju active) path)) ~
:: else, close the local subscription.
::
[(proxy-pass-link-store path %leave ~)]~
::
:: helpers
::
++ scry-for
|* [=mold =app-name =path]
.^ mold
%gx
(scot %p our.bowl)
app-name
(scot %da now.bowl)
(snoc `^path`path %noun)
==
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

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

@ -1,59 +1,13 @@
:: link: social bookmarking
:: link [landscape]:
::
:: the paths under which links are submitted are generally expected to
:: correspond to existing group paths. for strictly-local collections of
:: links, arbitrary paths are probably fair game, but could trip up
:: primitive ui implementations.
::
:: urls in paths are expected to be encoded using +wood, for @ta sanity.
:: generally, use /lib/link's +build-discussion-path.
::
:: see link-listen-hook to see what's synced in, and similarly
:: see link-proxy-hook to see what's exposed.
::
:: scry and subscription paths:
::
:: (map path pages) %local-pages
:: /local-pages our saved pages
:: /local-pages/some-path our saved pages on path
::
:: (map path submissions) %submissions
:: /submissions all submissions we've seen
:: /submissions/some-path all submissions we've seen on path
::
:: (map path (map url notes)) %annotations
:: /annotations our comments
:: /annotations/wood-url our comments on url
:: /annotations/wood-url/some-path our comments on url on path
:: /annotations//some-path our comments on path
::
:: (map path (map url comments)) %discussions
:: /discussions all comments
:: /discussions/wood-url all comments on url
:: /discussions/wood-url/some-path all comments on url on path
:: /discussions//some-path all comments on path
::
:: subscription-only paths:
::
:: [path url] %observation
:: /seen updates whenever an item is seen
::
:: scry-only paths:
::
::
:: (map path (set url))
:: /unseen the ones we haven't seen yet
::
:: (set url)
:: /unseen/some-path the ones we haven't seen here yet
::
:: ?
:: /seen/wood-url/some-path have we seen this here
::
/- *link
/+ store=link-store, default-agent, verb, dbug
/- *link, gra=graph-store, *resource
/+ store=link-store, graph-store, default-agent, verb, dbug
::
|%
+$ spore-any $%(spore-1 state-0)
+$ state-any $%(state-1 state-0)
+$ spore-1 [%1 cards=*]
+$ state-1 [%1 cards=(list card)]
+$ state-0
$: %0
by-group=(map path links)
@ -76,414 +30,119 @@
+$ card card:agent:gall
--
::
=| state-0
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title [our src]:bowl) ::TODO /lib/store
=^ cards state
?+ mark (on-poke:def mark vase)
::TODO move json conversion into mark once mark performance improves
%json (do-action:do (action:dejs:store !<(json vase)))
%link-action (do-action:do !<(action:store vase))
==
[cards this]
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y ?(%local-pages %submissions) ~]
``noun+!>(~(key by by-group))
::
[%x %local-pages *]
``noun+!>((get-local-pages:do t.t.path))
::
[%x %submissions *]
``noun+!>((get-submissions:do t.t.path))
::
[%y ?(%annotations %discussions) *]
=/ [spath=^path surl=url]
(break-discussion-path:store t.t.path)
=- ``noun+!>(-)
::
?: =(~ surl)
:: no url, provide urls that have comments
::
^- (set url)
?~ spath
:: no path, find urls accross all paths
::
%- ~(rep by discussions)
|= [[* discussions=(map url discussion)] urls=(set url)]
%- ~(uni in urls)
~(key by discussions)
:: specified path, find urls for that specific path
::
%~ key by
(~(gut by discussions) spath *(map url *))
:: specified url and path, nothing to list here
::
?^ spath !!
:: no path, find paths with comments for this url
::
^- (set ^path)
%- ~(rep by discussions)
|= [[=^path urls=(map url discussion)] paths=(set ^path)]
?. (~(has by urls) surl) paths
(~(put in paths) path)
::
[%x %annotations *]
``noun+!>((get-annotations:do t.t.path))
::
[%x %discussions *]
``noun+!>((get-discussions:do t.t.path))
::
[%x %seen @ ^]
``noun+!>((is-seen:do t.t.path))
::
[%x %unseen ~]
``noun+!>(get-all-unseen:do)
::
[%x %unseen ^]
``noun+!>((get-unseen:do t.t.path))
==
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title [our src]:bowl) ::TODO /lib/store
:_ this
|^ ?+ path (on-watch:def path)
[%local-pages *]
%+ give %link-initial
^- initial:store
[%local-pages (get-local-pages:do t.path)]
::
[%submissions *]
%+ give %link-initial
^- initial:store
[%submissions (get-submissions:do t.path)]
::
[%annotations *]
%+ give %link-initial
^- initial:store
[%annotations (get-annotations:do t.path)]
::
[%discussions *]
%+ give %link-initial
^- initial:store
[%discussions (get-discussions:do t.path)]
::
[%seen ~]
~
==
::
++ give
|* [=mark =noun]
^- (list card)
[%give %fact ~ mark !>(noun)]~
::
++ give-single
|* [=mark =noun]
^- card
[%give %fact ~ mark !>(noun)]
--
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
:: writing
::
++ do-action
|= =action:store
^- (quip card _state)
?- -.action
%save (save-page +.action)
%note (note-note +.action)
%seen (seen-submission +.action)
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
::
%hear (hear-submission +.action)
%read (read-comment +.action)
==
:: +save-page: save a page ourselves
::
++ save-page
|= [=path title=@t =url]
^- (quip card _state)
?< |(=(~ path) =(~ title) =(~ url))
:: add page to group ours
=/ s !<(spore-any old)
?: ?=(%1 -.s)
[~ this(state s(cards ~))]
:: defer card emission to later event
::
=/ =links (~(gut by by-group) path *links)
=/ =page [title url now.bowl]
=. ours.links [page ours.links]
=. by-group (~(put by by-group) path links)
:: do generic submission logic
=; [cards=(list card) that=_this]
:_ that(state [%1 cards])
[%pass /load %arvo %b %wait now.bowl]~
::
=^ submission-cards state
(hear-submission path [our.bowl page])
:: mark page as seen (because we submitted it ourselves)
::
=^ seen-cards state
(seen-submission path `url)
:: send updates to subscribers
::
:_ state
:_ (weld submission-cards seen-cards)
:+ %give %fact
:+ :~ /local-pages
[%local-pages path]
==
%link-update
!>([%local-pages path [page]~])
:: +note-note: save a note for a url
::
++ note-note
|= [=path =url udon=@t]
^- (quip card _state)
?< |(=(~ path) =(~ url) =(~ udon))
:: add note to discussion ours
::
=/ urls (~(gut by discussions) path *(map ^url discussion))
=/ =discussion (~(gut by urls) url *discussion)
=/ =note [now.bowl udon]
=. ours.discussion [note ours.discussion]
=. urls (~(put by urls) url discussion)
=. discussions (~(put by discussions) path urls)
:: do generic comment logic
::
=^ cards state
(read-comment path url [our.bowl note])
:: send updates to subscribers
::
:_ state
:_ this(state *state-1)
=/ orm orm:graph-store
|^ ^- (list card)
%- zing
%+ turn ~(tap by by-group.s)
|= [=path =links]
^- (list card)
:_ cards
:+ %give %fact
:+ :~ /annotations
[%annotations %$ path]
[%annotations (build-discussion-path:store url)]
[%annotations (build-discussion-path:store path url)]
?. ?=([@ ~] path)
(on-bad-path path links)
=/ =resource [our.bowl i.path]
:_ [(archive-graph resource)]~
%+ add-graph resource
^- graph:gra
%+ gas:orm ~
=/ comments (~(gut by discussions.s) path *(map url discussion))
%+ turn submissions.links
|= sub=submission
^- [atom node:gra]
:- time.sub
=/ contents ~[text+title.sub url+url.sub]
=/ parent-hash `@ux`(sham ~ ship.sub time.sub contents)
:- ^- post:gra
:* author=ship.sub
index=~[time.sub]
time-sent=time.sub
contents
hash=`parent-hash
signatures=~
==
%link-update
!>([%annotations path url [note]~])
:: +seen-submission: mark url as seen/read
::
:: if no url specified, all under path are marked as read
::
++ seen-submission
|= [=path murl=(unit url)]
^- (quip card _state)
=/ =links (~(gut by by-group) path *links)
:: new: urls we want to, but haven't yet, marked as seen
^- internal-graph:gra
=/ dis (~(get by comments) url.sub)
?~ dis
[%empty ~]
:- %graph
^- graph:gra
%+ gas:orm ~
%+ turn comments.u.dis
|= [=ship =time udon=@t]
^- [atom node:gra]
:- time
:_ `internal-graph:gra`[%empty ~]
=/ contents ~[text+udon]
:* author=ship
index=~[time.sub time]
time-sent=time
contents
hash=``@ux`(sham `parent-hash ship time contents)
signatures=~
==
::
=/ new=(set url)
%. seen.links
%~ dif in
^- (set url)
?^ murl (sy ~[u.murl])
%- ~(gas in *(set url))
%+ turn submissions.links
|=(submission url)
?: =(~ new) [~ state]
=. seen.links (~(uni in seen.links) new)
:_ state(by-group (~(put by by-group) path links))
[%give %fact ~[/seen] %link-update !>([%observation path new])]~
:: +hear-submission: record page someone else saved
::
++ hear-submission
|= [=path =submission]
^- (quip card _state)
?< =(~ path)
:: add link to group submissions
++ on-bad-path
|= [=path =links]
^- (list card)
~& discarding-malformed-links+[path links]
~
::
=/ =links (~(gut by by-group) path *links)
=^ added submissions.links
?: ?=(^ (find ~[submission] submissions.links))
[| submissions.links]
:- &
(submissions:merge:store submissions.links ~[submission])
=. by-group (~(put by by-group) path links)
:: add submission to global sites
++ add-graph
|= [=resource =graph:gra]
^- card
%- poke-graph-store
[%0 now.bowl %add-graph resource graph `%graph-validator-link %.y]
::
=/ =site (site-from-url:store url.submission)
=. by-site (~(add ja by-site) site [path submission])
:: send updates to subscribers
++ archive-graph
|= =resource
^- card
%- poke-graph-store
[%0 now.bowl %archive-graph resource]
::
:_ state
?. added ~
:_ ~
:+ %give %fact
:+ :~ /submissions
[%submissions path]
==
%link-update
!>([%submissions path [submission]~])
:: +read-comment: record a comment someone else made
::
++ read-comment
|= [=path =url =comment]
^- (quip card _state)
:: add comment to url's discussion
::
=/ urls (~(gut by discussions) path *(map ^url discussion))
=/ =discussion (~(gut by urls) url *discussion)
=^ added comments.discussion
?: ?=(^ (find ~[comment] comments.discussion))
[| comments.discussion]
:- &
(comments:merge:store comments.discussion ~[comment])
=. urls (~(put by urls) url discussion)
=. discussions (~(put by discussions) path urls)
:: send updates to subscribers
::
:_ state
?. added ~
:_ ~
:+ %give %fact
:+ :~ /discussions
[%discussions '' path]
[%discussions (build-discussion-path:store url)]
[%discussions (build-discussion-path:store path url)]
==
%link-update
!>([%discussions path url [comment]~])
::
:: reading
::
++ get-local-pages
|= =path
^- (map ^path pages)
?~ path
:: all paths
::
%- ~(run by by-group)
|=(links ours)
:: specific path
::
%+ ~(put by *(map ^path pages)) path
ours:(~(gut by by-group) path *links)
::
++ get-submissions
|= =path
^- (map ^path submissions)
?~ path
:: all paths
::
%- ~(run by by-group)
|=(links submissions)
:: specific path
::
%+ ~(put by *(map ^path submissions)) path
submissions:(~(gut by by-group) path *links)
::
++ get-all-unseen
^- (jug path url)
%- ~(rut by by-group)
|= [=path *]
(get-unseen path)
::
++ get-unseen
|= =path
^- (set url)
=/ =links
(~(gut by by-group) path *links)
%- ~(gas in *(set url))
%+ murn submissions.links
|= submission
?: (~(has in seen.links) url) ~
(some url)
::
++ is-seen
|= =path
^- ?
=/ [=^path =url]
(break-discussion-path:store path)
%. url
%~ has in
seen:(~(gut by by-group) path *links)
::
::
++ get-annotations
|= =path
^- (per-path-url notes)
=/ args=[=^path =url]
(break-discussion-path:store path)
|^ ?~ path
:: all paths
::
(~(run by discussions) get-ours)
:: specific path
::
%+ ~(put by *(per-path-url notes)) path.args
%- get-ours
%+ ~(gut by discussions) path.args
*(map url discussion)
::
++ get-ours
|= m=(map url discussion)
^- (map url notes)
?: =(~ url.args)
:: all urls
::
%- ~(run by m)
|=(discussion ours)
:: specific url
::
%+ ~(put by *(map url notes)) url.args
ours:(~(gut by m) url.args *discussion)
++ poke-graph-store
|= =update:gra
^- card
:* %pass /migrate-link %agent [our.bowl %graph-store]
%poke %graph-update !>(update)
==
--
::
++ get-discussions
|= =path
^- (per-path-url comments)
=/ args=[=^path =url]
(break-discussion-path:store path)
|^ ?~ path
:: all paths
::
(~(run by discussions) get-comments)
:: specific path
::
%+ ~(put by *(per-path-url comments)) path.args
%- get-comments
%+ ~(gut by discussions) path.args
*(map url discussion)
::
++ get-comments
|= m=(map url discussion)
^- (map url comments)
?: =(~ url.args)
:: all urls
::
%- ~(run by m)
|=(discussion comments)
:: specific url
::
%+ ~(put by *(map url comments)) url.args
comments:(~(gut by m) url.args *discussion)
--
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%b %wake *]
[cards.state this]
==
++ on-fail on-fail:def
--

631
pkg/arvo/app/link-view.hoon
View File

@ -1,626 +1,39 @@
:: link-view: frontend endpoints
::
:: endpoints, mapping onto link-store's paths. p is for page as in pagination.
:: only the /0/submissions endpoint provides updates.
:: as with link-store, urls are expected to use +wood encoding.
::
:: /json/0/submissions initial + updates for all
:: /json/[p]/submissions/[collection] page for one collection
:: /json/[p]/discussions/[wood-url]/[collection] page for url in collection
:: /json/[n]/submission/[wood-url]/[collection] nth matching submission
:: /json/seen mark-as-read updates
::
/- *link, view=link-view
/- *invite-store, group-store
/- listen-hook=link-listen-hook
/- group-hook, permission-hook, permission-group-hook
/- metadata-hook, contact-view
/- pull-hook, *group
/+ store=link-store, metadata, *server, default-agent, verb, dbug, grpl=group
/+ group-store, resource
:: link-view: no longer in use
/+ default-agent, verb, dbug
~% %link-view-top ..is ~
::
::
|%
+$ versioned-state
$% state-0
state-1
==
+$ state-0
$: %0
~
==
::
+$ state-1
$: %1
~
$% [%0 ~]
[%1 ~]
[%2 ~]
==
::
+$ card card:agent:gall
--
::
=| state-1
=| [%2 ~]
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
:~ [%pass /submissions %agent [our.bowl %link-store] %watch /submissions]
[%pass /discussions %agent [our.bowl %link-store] %watch /discussions]
[%pass /seen %agent [our.bowl %link-store] %watch /seen]
::
=+ [%invite-action !>([%create /link])]
[%pass /invitatory/create %agent [our.bowl %invite-store] %poke -]
::
=+ /invitatory/link
[%pass - %agent [our.bowl %invite-store] %watch -]
:* %pass /srv %agent [our.bowl %file-server]
%poke %file-server-action
!>([%serve-dir /'~link' /app/landscape %.n %.y])
==
==
::
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
?- -.old
%1 [~ this]
%0
:_ this(state [%1 ~])
:- [%pass /connect %arvo %e %disconnect [~ /'~link']]
:~ :* %pass /srv %agent [our.bowl %file-server]
%poke %file-server-action
!>([%serve-dir /'~link' /app/landscape %.n %.y])
== ==
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
:_ this
?+ mark (on-poke:def mark vase)
%link-action
[(handle-action:do !<(action:store vase)) ~]
::
%link-view-action
(handle-view-action:do !<(action:view vase))
==
::
++ on-watch
|= =path
^- (quip card _this)
?: ?=([%json %seen ~] path)
[~ this]
?: ?=([%tile ~] path)
:_ this
~[give-tile-data:do]
?. ?=([%json @ @ *] path)
(on-watch:def path)
=/ p=@ud (slav %ud i.t.path)
?+ t.t.path (on-watch:def path)
[%submissions ~]
:_ this
(give-initial-submissions:do p ~)
::
[%submissions ^]
:_ this
(give-initial-submissions:do p t.t.t.path)
::
[%submission @ ^]
:_ this
(give-specific-submission:do p (break-discussion-path:store t.t.t.path))
::
[%discussions @ ^]
:_ this
(give-initial-discussions:do p (break-discussion-path:store t.t.t.path))
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%poke-ack
?. ?=([%join-group @ @ @ @ ~] wire)
(on-agent:def wire sign)
?^ p.sign
(on-agent:def wire sign)
=/ rid=resource
(de-path:resource t.t.wire)
=/ host=ship
(slav %p i.t.wire)
:_ this
(joined-group:do host rid)
::
%kick
:_ this
=/ app=term
?: ?=([%invites *] wire)
%invite-store
%link-store
[%pass wire %agent [our.bowl app] %watch wire]~
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark (on-agent:def wire sign)
%invite-update [(handle-invite-update:do !<(invite-update vase)) this]
%link-initial [~ this]
::
%link-update
:_ this
:- (send-update:do !<(update:store vase))
?: =(/discussions wire) ~
~[give-tile-data:do]
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%e %bound *] sign-arvo)
(on-arvo:def wire sign-arvo)
~? !accepted.sign-arvo
[dap.bowl "bind rejected!" binding.sign-arvo]
[~ this]
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
~% %link-view-logic ..card ~
|_ =bowl:gall
+* md ~(. metadata bowl)
grp ~(. grpl bowl)
+* this .
def ~(. (default-agent this %|) bowl)
::
++ page-size 25
++ get-paginated
|* [page=(unit @ud) list=(list)]
^- [total=@ud pages=@ud page=_list]
=/ l=@ud (lent list)
:+ l
%+ add (div l page-size)
(min 1 (mod l page-size))
?~ page list
%+ swag
[(mul u.page page-size) page-size]
list
++ on-init [~ this]
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
:_ this(state [%2 ~])
[%pass /connect %arvo %e %disconnect [~ /'~link']]~
::
++ page-to-json
=, enjs:format
|* $: page-number=@ud
[total-items=@ud total-pages=@ud page=(list)]
item-to-json=$-(* json)
==
^- json
%- pairs
:~ 'totalItems'^(numb total-items)
'totalPages'^(numb total-pages)
'pageNumber'^(numb page-number)
'page'^a+(turn page item-to-json)
==
++ do-poke
|= [app=term =mark =vase]
^- card
[%pass /create/[app]/[mark] %agent [our.bowl app] %poke mark vase]
::
++ joined-group
|= [host=ship rid=resource]
^- (list card)
=/ =path
(en-path:resource rid)
:~
:: sync the group
::
%^ do-poke %group-pull-hook
%pull-hook-action
!> ^- action:pull-hook
[%add host rid]
::
:: sync the metadata
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%add-synced host path]
::
:: sync the collection
::
%^ do-poke %link-listen-hook
%link-listen-action
!> ^- action:listen-hook
[%watch ~[name.rid]]
==
::
++ handle-invite-update
|= upd=invite-update
^- (list card)
?. ?=(%accepted -.upd) ~
?. =(/link path.upd) ~
=/ rid=resource
(de-path:resource path.invite.upd)
:~ :: add self
:* %pass
[%join-group (scot %p ship.invite.upd) path.invite.upd]
%agent [entity.rid %group-push-hook]
%poke %group-update
!> ^- action:group-store
[%add-members rid (sy our.bowl ~)]
== ==
::
++ handle-action
|= =action:store
^- card
[%pass /action %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ handle-view-action
|= act=action:view
^- (list card)
?- -.act
%create (handle-create +.act)
%delete (handle-delete +.act)
%invite (handle-invite +.act)
==
::
++ handle-create
|= [=path title=@t description=@t members=create-members:view real-group=?]
^- (list card)
=/ group-path=^path
?- -.members
%group path.members
::
%ships
[%ship (scot %p our.bowl) path]
==
=; group-setup=(list card)
%+ weld group-setup
:~ :: add collection to metadata-store
::
%^ do-poke %metadata-hook
%metadata-action
!> ^- metadata-action:md
:^ %add group-path
[%link path]
%* . *metadata:md
title title
description description
date-created now.bowl
creator our.bowl
==
::
:: expose the metadata
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%add-owned group-path]
::
:: watch the collection ourselves
::
%^ do-poke %link-listen-hook
%link-listen-action
!> ^- action:listen-hook
[%watch path]
==
?: ?=(%group -.members) ~
:: if the group is "real", make contact-view do the heavy lifting
=/ rid=resource
(de-path:resource group-path)
?: real-group
:- %^ do-poke %contact-view
%contact-view-action
!> ^- contact-view-action:contact-view
[%groupify rid title description]
%+ turn ~(tap in ships.members)
|= =ship
^- card
%^ do-poke %invite-hook
%invite-action
!> ^- invite-action
:^ %invite /link
(sham group-path eny.bowl)
:* our.bowl
%group-hook
group-path
ship
title
==
:: for "unmanaged" groups, do it ourselves
::
=/ =policy
[%invite ships.members]
:* :: create the new group
::
%^ do-poke %group-store
%group-action
!> ^- action:group-store
[%add-group rid policy %.y]
::
:: send invites
::
%+ turn ~(tap in ships.members)
|= =ship
^- card
%^ do-poke %invite-hook
%invite-action
!> ^- invite-action
:^ %invite /link
(sham group-path eny.bowl)
:* our.bowl
%group-hook
group-path
ship
title
==
==
::
++ handle-delete
|= =path
^- (list card)
=/ groups=(list ^path)
(groups-from-resource:md [%link path])
%- zing
%+ turn groups
|= =group=^path
=/ rid=resource
(de-path:resource group-path)
%+ snoc
^- (list card)
:: if it's a real group, we can't/shouldn't unsync it. this leaves us with
:: no way to stop propagation of collection deletion.
::
?. ?=([%'~' ^] group-path) ~
:: if it's an unmanaged group, we just stop syncing the group & metadata,
:: and clean up the group (after un-hooking it, to not push deletion).
::
:~ %^ do-poke %group-hook
%group-hook-action
!> ^- action:group-hook
[%remove rid]
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%remove group-path]
::
%^ do-poke %group-store
%group-action
!> ^- action:group-store
[%remove-group rid ~]
==
:: remove collection from metadata-store
::
%^ do-poke %metadata-store
%metadata-action
!> ^- metadata-action:md
[%remove group-path [%link path]]
::
++ handle-invite
|= [=path ships=(set ship)]
^- (list card)
%- zing
%+ turn (groups-from-resource:md %link path)
|= =group=^path
^- (list card)
=/ rid=resource
(de-path:resource group-path)
=/ =group
(need (scry-group:grp rid))
%- zing
:~
?. ?=(%invite -.policy.group)
~
:~ %^ do-poke %group-store
%group-action
!> ^- action:group-store
[%change-policy rid %invite %add-invites ships]
==
::
%+ turn ~(tap in ships)
|= =ship
^- card
%^ do-poke %invite-hook
%invite-action
!> ^- invite-action
:^ %invite /link
(sham group-path eny.bowl)
:* our.bowl
%group-pull-hook
group-path
ship
(rsh 3 1 (spat path))
==
==
:: +give-tile-data: total unread count as json object
::
::NOTE the full recalc of totals here probably isn't the end of the world.
:: but in case it is, well, here it is.
::
++ give-tile-data
^- card
=; =json
[%give %fact ~[/tile] %json !>(json)]
%+ frond:enjs:format 'unseen'
%- numb:enjs:format
%- %~ rep in
(scry-for (jug path url) /unseen)
|= [[=path unseen=(set url)] total=@ud]
%+ add total
~(wyt in unseen)
::
:: +give-initial-submissions: page of submissions on path
::
:: for the / path, give page for every path
::
:: result is in the shape of: {
:: "/some/path": {
:: totalItems: 1,
:: totalPages: 1,
:: pageNumber: 0,
:: page: [
:: { commentCount: 1, ...restOfTheSubmission }
:: ]
:: },
:: "/maybe/more": { etc }
:: }
::
++ give-initial-submissions
~/ %link-view-initial-submissions
|= [p=@ud =requested=path]
^- (list card)
:_ :: only keep the base case alive (for updates), kick all others
::
?: &(=(0 p) ?=(~ requested-path)) ~
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'initial-submissions'
%- pairs:enjs:format
%+ turn
%~ tap by
%+ scry-for (map path submissions)
[%submissions requested-path]
|= [=path =submissions]
^- [@t json]
:- (spat path)
=; =json
:: add unseen count
::
?> ?=(%o -.json)
:- %o
%+ ~(put by p.json) 'unseenCount'
%- numb:enjs:format
%~ wyt in
%+ scry-for (set url)
[%unseen path]
?: &(=(0 p) ?=(~ requested-path))
:: for a broad-scope initial result, only give total counts
::
=, enjs:format
%- pairs
=+ l=(lent submissions)
:~ 'totalItems'^(numb l)
'totalPages'^(numb (div l page-size))
==
%^ page-to-json p
%+ get-paginated `p
submissions
|= =submission
^- json
=/ =json (submission:enjs:store submission)
?> ?=([%o *] json)
:: add in seen status
::
=. p.json
%+ ~(put by p.json) 'seen'
:- %b
%+ scry-for ?
[%seen (build-discussion-path:store path url.submission)]
:: add in comment count
::
=; comment-count=@ud
:- %o
%+ ~(put by p.json) 'commentCount'
(numb:enjs:format comment-count)
%- lent
~| [path url.submission]
^- comments
=- (~(got by (~(got by -) path)) url.submission)
%+ scry-for (per-path-url comments)
:- %discussions
(build-discussion-path:store path url.submission)
::
++ give-specific-submission
|= [n=@ud =path =url]
:_ [%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'submission'
^- json
=; sub=(unit submission)
?~ sub ~
(submission:enjs:store u.sub)
=/ =submissions
=- (~(got by -) path)
%+ scry-for (map ^path submissions)
[%submissions path]
|-
?~ submissions ~
=* sub i.submissions
?. =(url.sub url)
$(submissions t.submissions)
?: =(0 n) `sub
$(n (dec n), submissions t.submissions)
::
++ give-initial-discussions
|= [p=@ud =path =url]
^- (list card)
:_ ?: =(0 p) ~
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'link-update'
%+ frond:enjs:format 'initial-discussions'
%^ page-to-json p
%+ get-paginated `p
=- (~(got by (~(got by -) path)) url)
%+ scry-for (per-path-url comments)
[%discussions (build-discussion-path:store path url)]
comment:enjs:store
::
++ send-update
|= =update:store
^- card
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%submissions
%+ give-json
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
:~ /json/0/submissions
(weld /json/0/submissions path.update)
==
::
%discussions
%+ give-json
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
:_ ~
%+ weld /json/0/discussions
(build-discussion-path:store [path url]:update)
::
%observation
%+ give-json
%+ frond:enjs:format 'link-update'
(update:enjs:store update)
~[/json/seen]
==
::
++ give-json
|= [=json paths=(list path)]
^- card
[%give %fact paths %json !>(json)]
::
++ scry-for
|* [=mold =path]
.^ mold
%gx
(scot %p our.bowl)
%link-store
(scot %da now.bowl)
(snoc `^path`path %noun)
==
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--

6
pkg/arvo/app/metadata-hook.hoon
View File

@ -1,4 +1,6 @@
:: metadata-hook: allow syncing foreign metadata
:: metadata-hook [landscape]:
::
:: allow syncing foreign metadata
::
:: watch paths:
:: /group/%group-path all updates related to this group
@ -37,7 +39,7 @@
[[%pass /updates %agent [our.bowl %metadata-store] %watch /updates]~ this]
::
++ on-save !>(state)
++ on-load
++ on-load
|= =vase
=/ old
!<(versioned-state vase)

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

@ -1,4 +1,6 @@
:: metadata-store: data store for application metadata and mappings
:: metadata-store [landscape]:
::
:: data store for application metadata and mappings
:: between groups and resources within applications
::
:: group-paths are expected to be an existing group path
@ -8,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
::
@ -25,162 +27,247 @@
/+ *metadata-json, default-agent, verb, dbug, resource
|%
+$ card card:agent:gall
::
::
+$ state-base
$: =associations
+$ base-state-0
$: associations=associations-0
group-indices=(jug group-path md-resource)
app-indices=(jug app-name [group-path app-path])
resource-indices=(jug md-resource group-path)
==
::
+$ state-zero
$: %0
state-base
+$ associations-0 (map [group-path md-resource] metadata-0)
::
+$ metadata-0
$: title=@t
description=@t
color=@ux
date-created=@da
creator=@p
==
::
+$ state-one
$: %1
state-base
==
::
+$ state-two
$: %2
state-base
+$ base-state-1
$: associations=associations
group-indices=(jug group-path md-resource)
app-indices=(jug app-name [group-path app-path])
resource-indices=(jug md-resource group-path)
==
::
+$ state-0 [%0 base-state-0]
+$ state-1 [%1 base-state-0]
+$ state-2 [%2 base-state-0]
+$ 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-zero
state-one
state-two
$% state-0
state-1
state-2
state-3
state-4
state-5
state-6
==
--
::
=| state-two
=| state-6
=* state -
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
metadata-core +>
mc ~(. metadata-core bowl)
def ~(. (default-agent this %|) bowl)
+* this .
mc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= =vase
^- (quip card _this)
=/ old
!<(versioned-state vase)
=/ old !<(versioned-state vase)
=| cards=(list card)
|-
|^
?: ?=(%2 -.old)
?: ?=(%6 -.old)
[cards this(state old)]
?: ?=(%5 -.old)
=/ =^associations
(migrate-app-to-graph-store %publish associations.old)
%_ $
-.old %6
associations.old associations
::
resource-indices.old
(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])
?: ?=(%2 -.old)
=/ new-state=state-3
%* . *state-3
associations
%- malt
%+ murn ~(tap by associations.old)
|= [[=group-path =md-resource] m=metadata-0]
^- (unit [[^group-path ^md-resource] metadata])
?: =(app-name.md-resource %link) ~
`[[group-path md-resource] (old-md-to-new m)]
==
$(old new-state)
?: ?=(%1 -.old)
%_ $
old [%2 +.old]
::
cards
%+ murn
~(tap in ~(key by group-indices.old))
%+ murn ~(tap in ~(key by group-indices.old))
|= =group-path
^- (unit card)
=/ rid=(unit resource)
(de-path-soft:resource group-path)
=/ rid (de-path-soft:resource group-path)
?~ rid ~
?: =(our.bowl entity.u.rid)
`(poke-md-hook %add-owned group-path)
`(poke-md-hook %add-synced entity.u.rid group-path)
==
=/ new-state=state-one
%* . *state-one
=/ new-state-1=state-1
%* . *state-1
associations (migrate-associations associations.old)
group-indices (migrate-group-indices group-indices.old)
app-indices (migrate-app-indices app-indices.old)
resource-indices (migrate-resource-indices resource-indices.old)
==
$(old new-state)
$(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
=/ =cage
:_ !>(act)
%metadata-hook-action
=/ =cage metadata-hook-action+!>(act)
[%pass / %agent [our.bowl %metadata-hook] %poke cage]
::
++ new-group-path
|= =group-path
ship+(new-app-path group-path)
::
++ new-app-path
|= =app-path
^- path
?> ?=(^ app-path)
?: =('~' i.app-path)
t.app-path
app-path
?:(=('~' i.app-path) t.app-path app-path)
::
++ old-md-to-new
|= m=metadata-0
^- metadata
%* . *metadata
title title.m
description description.m
color color.m
date-created date-created.m
creator creator.m
module *term
==
::
++ migrate-md-resource
|= md-resource
^- md-resource
?: =(%chat app-name)
[%chat (new-app-path app-path)]
?: =(%contacts app-name)
[%contacts ship+app-path]
?: =(%chat app-name) [%chat (new-app-path app-path)]
?: =(%contacts app-name) [%contacts ship+app-path]
[app-name app-path]
::
++ migrate-resource-indices
|= resource-indices=(jug md-resource group-path)
^- (jug md-resource group-path)
%- malt
%+ turn
~(tap by resource-indices)
%+ turn ~(tap by resource-indices)
|= [=md-resource paths=(set group-path)]
:_ (~(run in paths) new-group-path)
(migrate-md-resource md-resource)
:- (migrate-md-resource md-resource)
(~(run in paths) new-group-path)
::
++ migrate-app-indices
|= app-indices=(jug app-name [group-path app-path])
%- malt
%+ turn
~(tap by app-indices)
%+ turn ~(tap by app-indices)
|= [app=term indices=(set [=group-path =app-path])]
:- app
%- ~(run in indices)
|= [=group-path =app-path]
:- (new-group-path group-path)
?: =(%chat app)
(new-app-path app-path)
?: =(%contacts app)
ship+app-path
?: =(%chat app) (new-app-path app-path)
?: =(%contacts app) ship+app-path
app-path
::
++ migrate-group-indices
|= group-indices=(jug group-path md-resource)
%- malt
%+ turn
~(tap by group-indices)
%+ turn ~(tap by group-indices)
|= [=group-path resources=(set md-resource)]
:- (new-group-path group-path)
%- sy
%+ turn
~(tap in resources)
%+ turn ~(tap in resources)
migrate-md-resource
::
++ migrate-associations
|= =^associations
|= associations=associations-0
%- malt
%+ turn
~(tap by associations)
|= [[=group-path =md-resource] =metadata]
:_ metadata
:_ (migrate-md-resource md-resource)
(new-group-path group-path)
%+ turn ~(tap by associations)
|= [[g=group-path r=md-resource] m=metadata-0]
:_ m
[(new-group-path g) (migrate-md-resource r)]
--
::
++ on-poke
@ -202,11 +289,12 @@
:- ~
%+ roll ~(tap in res)
|= [r=md-resource out=_state]
=. resource-indices.out (~(del by resource-indices.out) r)
=. app-indices.out
=: resource-indices.out (~(del by resource-indices.out) r)
associations.out (~(del by associations.out) group r)
app-indices.out
%- ~(del ju app-indices.out)
[app-name.r group app-path.r]
=. associations.out (~(del by associations.out) group r)
==
out
==
[cards this]
@ -218,8 +306,12 @@
|^
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give %metadata-update !>([%associations associations]))
[%updates ~] ~
[%all ~]
(give %metadata-update !>([%associations associations]))
::
[%updates ~]
~
::
[%app-name @ ~]
=/ =app-name i.t.path
=/ app-indices (metadata-for-app:mc app-name)
@ -233,8 +325,6 @@
[%give %fact ~ cage]~
--
::
++ on-leave on-leave:def
::
++ on-peek
|= =path
^- (unit (unit cage))
@ -252,16 +342,17 @@
``noun+!>((metadata-for-group:mc group-path))
::
[%x %metadata @ @ @ ~]
=/ =group-path (stab (slav %t i.t.t.path))
=/ =md-resource [`@tas`i.t.t.t.path (stab (slav %t i.t.t.t.t.path))]
=/ =group-path (stab (slav %t i.t.t.path))
=/ =md-resource [`term`i.t.t.t.path (stab (slav %t i.t.t.t.t.path))]
``noun+!>((~(get by associations) [group-path md-resource]))
::
[%x %resource @ *]
=/ app=@tas i.t.t.path
=/ app-path=^path t.t.t.path
=/ app=term i.t.t.path
=/ app-path=^path t.t.t.path
``noun+!>((~(get by resource-indices) app app-path))
==
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
@ -273,20 +364,17 @@
^- (quip card _state)
?> (team:title our.bowl src.bowl)
?- -.act
%add
(handle-add group-path.act resource.act metadata.act)
::
%remove
(handle-remove group-path.act resource.act)
%add (handle-add group-path.act resource.act metadata.act)
%remove (handle-remove group-path.act resource.act)
==
::
++ handle-add
|= [=group-path =md-resource =metadata]
^- (quip card _state)
:- %+ send-diff app-name.md-resource
?. (~(has by resource-indices) md-resource)
[%add group-path md-resource metadata]
[%update-metadata group-path md-resource metadata]
?: (~(has by resource-indices) md-resource)
[%update-metadata group-path md-resource metadata]
[%add group-path md-resource metadata]
%= state
associations
(~(put by associations) [group-path md-resource] metadata)
@ -295,7 +383,9 @@
(~(put ju group-indices) group-path md-resource)
::
app-indices
(~(put ju app-indices) app-name.md-resource [group-path app-path.md-resource])
%+ ~(put ju app-indices)
app-name.md-resource
[group-path app-path.md-resource]
::
resource-indices
(~(put ju resource-indices) md-resource group-path)
@ -313,7 +403,9 @@
(~(del ju group-indices) group-path md-resource)
::
app-indices
(~(del ju app-indices) app-name.md-resource [group-path app-path.md-resource])
%+ ~(del ju app-indices)
app-name.md-resource
[group-path app-path.md-resource]
::
resource-indices
(~(del ju resource-indices) md-resource group-path)

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
--

33
pkg/arvo/app/permission-group-hook.hoon
View File

@ -1,45 +1,22 @@
:: permission-group-hook: groups into permissions
:: permission-group-hook [landscape]: deprecated
::
:: mirror the ships in specified groups to specified permission paths
/+ default-agent
::
/- *group-store, *permission-group-hook
/+ *permission-json, default-agent, verb, dbug
::
|%
+$ state
$% [%0 state-0]
==
::
+$ group-path path
::
+$ permission-path path
::
+$ state-0
$: relation=(map group-path (set permission-path))
==
::
+$ card card:agent:gall
--
::
=| state-0
=| [%1 ~]
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
[~ this]
::
++ on-poke on-poke:def
++ on-poke on-poke:def
++ on-agent on-agent:def
++ on-peek on-peek:def
++ on-watch on-watch:def

357
pkg/arvo/app/permission-hook.hoon
View File

@ -1,347 +1,26 @@
:: permission-hook: mirror remote permissions
:: permission-hook [landscape]: deprecated
::
:: allows mirroring permissions between local and foreign ships.
:: local permission path are exposed according to the permssion paths
:: configured for them as `access-control`.
/+ default-agent
::
/- *permission-hook
/+ *permission-json, default-agent, verb, dbug
::
~% %permission-hook-top ..is ~
|%
+$ state
$% [%0 state-0]
==
::
+$ owner-access [ship=ship access-control=path]
::
+$ state-0
$: synced=(map path owner-access)
access-control=(map path (set path))
boned=(map wire (list bone))
==
::
+$ card card:agent:gall
--
::
=| state-0
=| [%1 ~]
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%permission-hook-action
=^ cards state
(handle-permission-hook-action:do !<(permission-hook-action vase))
[cards this]
==
::
++ on-watch
|= =path
^- (quip card _this)
?. ?=([%permission ^] path) (on-watch:def path)
=^ cards state
(handle-watch-permission:do t.path)
[cards this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?- -.sign
%poke-ack (on-agent:def wire sign)
::
%fact
?. ?=(%permission-update p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(handle-permission-update:do wire !<(permission-update q.cage.sign))
[cards this]
::
%watch-ack
?~ p.sign [~ this]
?> ?=(^ wire)
:_ this(synced (~(del by synced) t.wire))
::NOTE we could've gotten rejected for permission reasons, so we don't
:: try to resubscribe automatically.
%. ~
%- slog
:* leaf+"permission-hook failed subscribe on {(spud t.wire)}"
leaf+"stack trace:"
u.p.sign
==
::
%kick
?> ?=([* ^] wire)
:: if we're not actively using it, we can safely ignore the %kick.
::
?. (~(has by synced) t.wire)
[~ this]
:: otherwise, resubscribe.
::
=/ =owner-access (~(got by synced) t.wire)
:_ this
[%pass wire %agent [ship.owner-access %permission-hook] %watch wire]~
==
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ handle-permission-hook-action
|= act=permission-hook-action
^- (quip card _state)
?- -.act
%add-owned
?> (team:title our.bowl src.bowl)
?: (~(has by synced) owned.act)
[~ state]
=. synced (~(put by synced) owned.act [our.bowl access.act])
=. access-control
(~(put ju access-control) access.act owned.act)
=/ perm-path [%permission owned.act]
:_ state
[%pass perm-path %agent [our.bowl %permission-store] %watch perm-path]~
::
%add-synced
?> (team:title our.bowl src.bowl)
?: (~(has by synced) path.act)
[~ state]
=. synced (~(put by synced) path.act [ship.act ~])
=/ perm-path [%permission path.act]
:_ state
[%pass perm-path %agent [ship.act %permission-hook] %watch perm-path]~
::
%remove
=/ owner-access=(unit owner-access)
(~(get by synced) path.act)
?~ owner-access
[~ state]
:: if we own it, and it's us asking,
::
?: ?& =(ship.u.owner-access our.bowl)
(team:title our.bowl src.bowl)
==
:: delete the permission path and its subscriptions from this hook.
::
:- :- [%give %kick [%permission path.act]~ ~]
(leave-permission path.act)
%_ state
synced (~(del by synced) path.act)
::
access-control
(~(del by access-control) access-control.u.owner-access)
==
:: else, if either source = ship or source = us,
::
?: |(=(ship.u.owner-access src.bowl) (team:title our.bowl src.bowl))
:: delete a foreign ship's path.
::
:- (leave-permission path.act)
%_ state
synced (~(del by synced) path.act)
boned (~(del by boned) [%permission path.act])
==
:: else, ignore action entirely.
::
[~ state]
==
+* this .
def ~(. (default-agent this %|) bowl)
::
++ handle-watch-permission
|= =path
^- (quip card _state)
=/ =owner-access (~(got by synced) path)
?> =(our.bowl ship.owner-access)
:: scry permissions to check if subscriber is allowed
::
?> (permitted src.bowl access-control.owner-access)
=/ pem (permission-scry path)
:_ state
[%give %fact ~ %permission-update !>([%create path pem])]~
::
++ handle-permission-update
|= [=wire diff=permission-update]
^- (quip card _state)
?: (team:title our.bowl src.bowl)
(handle-local diff)
(handle-foreign diff)
::
++ handle-local
|= diff=permission-update
^- (quip card _state)
?- -.diff
%initial [~ state]
%create [~ state]
%add (change-local-permission %add [path who]:diff)
%remove (change-local-permission %remove [path who]:diff)
::
%delete
?. (~(has by synced) path.diff)
[~ state]
=/ control=(unit path)
=+ (~(got by synced) path.diff)
?. =(our.bowl ship) ~
`access-control
:_ %_ state
synced (~(del by synced) path.diff)
access-control ?~ control access-control
(~(del ju access-control) u.control path.diff)
==
:_ ~
:* %pass
[%permission path.diff]
%agent
[our.bowl %permission-store]
[%leave ~]
==
==
::
++ change-local-permission
|= [kind=?(%add %remove) pax=path who=(set ship)]
^- (quip card _state)
:_ state
:- ?- kind
%add (update-subscribers [%permission pax] [%add pax who])
%remove (update-subscribers [%permission pax] [%remove pax who])
==
=/ access-paths=(unit (set path)) (~(get by access-control) pax)
:: check if this path changes the access permissions for other paths
?~ access-paths ~
(quit-subscriptions kind pax who u.access-paths)
::
++ handle-foreign
|= diff=permission-update
^- (quip card _state)
?- -.diff
%initial [~ state]
?(%create %add %remove)
(change-foreign-permission path.diff diff)
::
%delete
?> ?=([* ^] path.diff)
=/ owner-access=(unit owner-access)
(~(get by synced) path.diff)
?~ owner-access
[~ state]
?. =(ship.u.owner-access src.bowl)
[~ state]
:_ state(synced (~(del by synced) path.diff))
:~ (permission-poke diff)
::
:* %pass
[%permission path.diff]
%agent
[src.bowl %permission-hook]
[%leave ~]
==
==
==
::
++ change-foreign-permission
|= [=path diff=permission-update]
^- (quip card _state)
?> ?=([* ^] path)
=/ owner-access=(unit owner-access)
(~(get by synced) path)
:_ state
?~ owner-access ~
?. =(src.bowl ship.u.owner-access) ~
[(permission-poke diff)]~
::
++ quit-subscriptions
|= $: kind=?(%add %remove)
perm-path=path
who=(set ship)
access-paths=(set path)
==
^- (list card)
=/ perm (permission-scry perm-path)
:: if the change resolves to "allow",
::
?. ?| ?&(=(%black kind.perm) =(%add kind))
?&(=(%white kind.perm) =(%remove kind))
==
:: do nothing.
~
:: else, it resolves to "deny"/"ban".
:: kick subscriptions for all ships, at all affected paths.
::
%- zing
%+ turn ~(tap in who)
|= check-ship=ship
^- (list card)
%+ turn ~(tap in access-paths)
|= access-path=path
[%give %kick [%permission access-path]~ `check-ship]
::
++ permission-scry
|= pax=path
^- permission
=. pax
;: weld
/(scot %p our.bowl)/permission-store/(scot %da now.bowl)/permission
pax
/noun
==
(need .^((unit permission) %gx pax))
::
++ permitted
|= [who=ship =path]
.^ ?
%gx
(scot %p our.bowl)
%permission-store
(scot %da now.bowl)
%permitted
(scot %p src.bowl)
(snoc path %noun)
==
::
++ permission-poke
|= act=permission-action
^- card
:* %pass
/permission-action
%agent
[our.bowl %permission-store]
%poke
%permission-action
!>(act)
==
::
++ update-subscribers
|= [=path upd=permission-update]
^- card
[%give %fact ~[path] %permission-update !>(upd)]
::
++ leave-permission
|= =path
^- (list card)
=/ owner-access=(unit owner-access)
(~(get by synced) path)
?~ owner-access ~
:_ ~
=/ perm-path [%permission path]
?: =(ship.u.owner-access our.bowl)
[%pass perm-path %agent [our.bowl %permission-store] %leave ~]
[%pass perm-path %agent [ship.u.owner-access %permission-hook] %leave ~]
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
[~ this]
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

211
pkg/arvo/app/permission-store.hoon
View File

@ -1,201 +1,36 @@
:: permission-store: track black- and whitelists of ships
::
/- *permission-store
/+ default-agent, verb, dbug
:: permission-store [landscape]: deprecated
::
/+ default-agent
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
$% state-0
state-1
==
::
+$ state-zero
$: %0
permissions=permission-map
==
+$ state-0 [%0 *]
+$ state-1 [%1 ~]
--
=| state-zero
::
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
permission-core +>
pc ~(. permission-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?: ?=(%permission-action mark)
(poke-permission-action:pc !<(permission-action vase))
(on-poke:def mark vase)
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give %permission-update !>([%initial permissions]))
[%updates ~] ~
[%permission @ *]
=/ =vase !>([%create t.path (~(got by permissions) t.path)])
(give %permission-update vase)
==
[cards this]
::
++ give
|= =cage
^- (list card)
[%give %fact ~ cage]~
--
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %keys ~] ``noun+!>(~(key by permissions))
[%x %permission *]
?~ t.t.path ~
``noun+!>((~(get by permissions) t.t.path))
::
[%x %permitted @ *]
?~ t.t.t.path ~
=/ pem (~(get by permissions) t.t.t.path)
?~ pem ~
=/ who (slav %p i.t.t.path)
=/ has (~(has in who.u.pem) who)
``noun+!>(?-(kind.u.pem %black !has, %white has))
==
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
|_ bol=bowl:gall
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
[~ this]
::
++ poke-permission-action
|= action=permission-action
^- (quip card _state)
?> (team:title our.bol src.bol)
?- -.action
%initial [~ state]
%add (handle-add action)
%remove (handle-remove action)
%create (handle-create action)
%delete (handle-delete action)
%allow (handle-allow action)
%deny (handle-deny action)
==
::
++ handle-add
|= act=permission-action
^- (quip card _state)
?> ?=(%add -.act)
?~ path.act
[~ state]
:: TODO: calculate diff
:: =+ new=(~(dif in who.what.action) who.u.pem)
:: ?~(new ~ `what.action(who new))
?. (~(has by permissions) path.act)
[~ state]
:- (send-diff path.act act)
=/ perm (~(got by permissions) path.act)
=. who.perm (~(uni in who.perm) who.act)
state(permissions (~(put by permissions) path.act perm))
::
++ handle-remove
|= act=permission-action
^- (quip card _state)
?> ?=(%remove -.act)
?~ path.act
[~ state]
?. (~(has by permissions) path.act)
[~ state]
=/ perm (~(got by permissions) path.act)
=. who.perm (~(dif in who.perm) who.act)
:: TODO: calculate diff
:: =+ new=(~(int in who.what.action) who.u.pem)
:: ?~(new ~ `what.action(who new))
:- (send-diff path.act act)
state(permissions (~(put by permissions) path.act perm))
::
++ handle-create
|= act=permission-action
^- (quip card _state)
?> ?=(%create -.act)
?~ path.act
[~ state]
?: (~(has by permissions) path.act)
[~ state]
:: TODO: calculate diff
:- (send-diff path.act act)
state(permissions (~(put by permissions) path.act permission.act))
::
++ handle-delete
|= act=permission-action
^- (quip card _state)
?> ?=(%delete -.act)
?~ path.act
[~ state]
?. (~(has by permissions) path.act)
[~ state]
:- (send-diff path.act act)
state(permissions (~(del by permissions) path.act))
::
++ handle-allow
|= act=permission-action
^- (quip card _state)
?> ?=(%allow -.act)
?~ path.act
[~ state]
=/ perm (~(get by permissions) path.act)
?~ perm
[~ state]
?: =(kind.u.perm %white)
(handle-add [%add +.act])
(handle-remove [%remove +.act])
::
++ handle-deny
|= act=permission-action
^- (quip card _state)
?> ?=(%deny -.act)
?~ path.act
[~ state]
=/ perm (~(get by permissions) path.act)
?~ perm
[~ state]
?: =(kind.u.perm %black)
(handle-add [%add +.act])
(handle-remove [%remove +.act])
::
++ update-subscribers
|= [pax=path upd=permission-update]
^- (list card)
[%give %fact ~[pax] %permission-update !>(upd)]~
::
++ send-diff
|= [pax=path upd=permission-update]
^- (list card)
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%permission pax] upd)
==
++ on-poke on-poke:def
++ 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
--

4
pkg/arvo/app/pool-group-hook.hoon
View File

@ -1,4 +1,6 @@
:: pool-group-hook: maintain groups based on invite pool
:: pool-group-hook [landscape]:
::
:: maintain groups based on invite pool
::
:: looks at our invite tree, adds our siblings to group at +group-path
::

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

File diff suppressed because it is too large Load Diff

4
pkg/arvo/app/s3-store.hoon
View File

@ -1,3 +1,7 @@
:: s3-store [landscape]:
::
:: stores s3 keys for uploading and sharing images and objects
::
/- *s3
/+ s3-json, default-agent, verb, dbug
~% %s3-top ..is ~

42
pkg/arvo/app/shoe.hoon
View File

@ -6,7 +6,11 @@
/+ shoe, verb, dbug, default-agent
|%
+$ state-0 [%0 ~]
+$ command ~
+$ command
$? %demo
%row
%table
==
::
+$ card card:shoe
--
@ -41,22 +45,46 @@
++ command-parser
|= sole-id=@ta
^+ |~(nail *(like [? command]))
(cold [& ~] (jest 'demo'))
%+ stag &
(perk %demo %row %table ~)
::
++ tab-list
|= sole-id=@ta
^- (list [@t tank])
:~ ['demo' leaf+"run example command"]
['row' leaf+"print a row"]
['table' leaf+"display a table"]
==
::
++ on-command
|= [sole-id=@ta =command]
^- (quip card _this)
=- [[%shoe ~ %sole -]~ this]
=/ =tape "{(scow %p src.bowl)} ran the command"
?. =(src our):bowl
[%txt tape]
[%klr [[`%br ~ `%g] [(crip tape)]~]~]
=; [to=(list _sole-id) fec=shoe-effect:shoe]
[[%shoe to fec]~ this]
?- command
%demo
:- ~
:- %sole
=/ =tape "{(scow %p src.bowl)} ran the command"
?. =(src our):bowl
[%txt tape]
[%klr [[`%br ~ `%g] [(crip tape)]~]~]
::
%row
:- [sole-id]~
:+ %row
~[8 27 35 5]
~[p+src.bowl da+now.bowl t+'plenty room here!' t+'less here!']
::
%table
:- [sole-id]~
:^ %table
~[t+'ship' t+'date' t+'long text' t+'tldr']
~[8 27 35 5]
:~ ~[p+src.bowl da+now.bowl t+'plenty room here!' t+'less here!']
~[p+~marzod t+'yesterday' t+'sometimes:\0anewlines' t+'newlines']
==
==
::
++ can-connect
|= sole-id=@ta

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

@ -1,73 +1,4 @@
:: soto [tombstone]: former dojo relay for urbit's landscape interface
::
:: Soto: 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 %|)

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

@ -1,5 +1,5 @@
/- spider
/+ libstrand=strand, default-agent, verb
/+ libstrand=strand, default-agent, verb, server
=, strand=strand:libstrand
|%
+$ card card:agent:gall
@ -17,15 +17,25 @@
$: starting=(map yarn [=trying =vase])
running=trie
tid=(map tid yarn)
serving=(map tid [@ta =mark])
==
::
+$ clean-slate-any
$^ clean-slate-ket
$% clean-slate-sig
clean-slate-1
clean-slate
==
::
+$ clean-slate
$: %2
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [@ta =mark])
==
::
+$ clean-slate-1
$: %1
starting=(map yarn [=trying =vase])
running=(list yarn)
@ -133,7 +143,10 @@
sc ~(. spider-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-init
^- (quip card _this)
:_ this
~[bind-eyre:sc]
++ on-save clean-state:sc
++ on-load
|^
@ -141,7 +154,9 @@
=+ !<(any=clean-slate-any old-state)
=? any ?=(^ -.any) (old-to-1 any)
=? any ?=(~ -.any) (old-to-1 any)
?> ?=(%1 -.any)
=^ upgrade-cards any
(old-to-2 any)
?> ?=(%2 -.any)
::
=. tid.state tid.any
=/ yarns=(list yarn)
@ -149,17 +164,31 @@
~(tap in ~(key by starting.any))
|- ^- (quip card _this)
?~ yarns
`this
[~[bind-eyre:sc] this]
=^ cards-1 state
(handle-stop-thread:sc (yarn-to-tid i.yarns) |)
=^ cards-2 this
$(yarns t.yarns)
[(weld cards-1 cards-2) this]
[:(weld upgrade-cards cards-1 cards-2) this]
::
++ old-to-1
|= old=clean-slate-ket
^- clean-slate
^- clean-slate-1
1+old(starting (~(run by starting.old) |=([* v=vase] none+v)))
::
++ old-to-2
|= old=clean-slate-any
^- (quip card clean-slate)
?> ?=(?(%1 %2) -.old)
?: ?=(%2 -.old)
`old
:- ~[bind-eyre:sc]
:* %2
starting.old
running.old
tid.old
~
==
--
::
++ on-poke
@ -172,6 +201,9 @@
%spider-input (on-poke-input:sc !<(input vase))
%spider-start (handle-start-thread:sc !<(start-args vase))
%spider-stop (handle-stop-thread:sc !<([tid ?] vase))
::
%handle-http-request
(handle-http-request:sc !<([@ta =inbound-request:eyre] vase))
==
[cards this]
::
@ -182,6 +214,7 @@
?+ path (on-watch:def path)
[%thread @ *] (on-watch:sc t.path)
[%thread-result @ ~] (on-watch-result:sc i.t.path)
[%http-response *] `state
==
[cards this]
::
@ -216,6 +249,7 @@
?+ wire (on-arvo:def wire sign-arvo)
[%thread @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
[%bind ~] `state
==
[cards this]
:: On unexpected failure, kill all outstanding strands
@ -228,6 +262,41 @@
--
::
|_ =bowl:gall
::
++ bind-eyre
^- card
[%pass /bind %arvo %e %connect [~ /spider] %spider]
::
++ handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state)
?> authenticated.inbound-request
=/ url
(parse-request-line:server url.request.inbound-request)
?> ?=([%spider @t @t @t ~] site.url)
=* input-mark i.t.site.url
=* thread i.t.t.site.url
=* output-mark i.t.t.t.site.url
=/ =tid
(scot %uv (sham eny.bowl))
=. serving.state
(~(put by serving.state) tid [eyre-id output-mark])
=+ .^
=tube:clay
%cc
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/json/[input-mark]
==
?> ?=(^ body.request.inbound-request)
=/ body=json
(need (de-json:html q.u.body.request.inbound-request))
=/ input=vase
(slop (tube !>(body)) !>(~))
=/ =start-args
[~ `tid thread input]
=^ cards state
(handle-start-thread start-args)
[cards state]
::
++ on-poke-input
|= input
=/ yarn (~(got by tid.state) tid)
@ -394,6 +463,25 @@
:~ [%give %fact ~[/thread-result/[tid]] %thread-fail !>([term tang])]
[%give %kick ~[/thread-result/[tid]] ~]
==
++ thread-http-fail
|= [=tid =term =tang]
^- (quip card ^state)
=- (fall - `state)
%+ bind
(~(get by serving.state) tid)
|= [eyre-id=@ta output=mark]
:_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server eyre-id
^- simple-payload:http
:_ ~ :_ ~
?. ?=(http-error:spider term)
((slog tang) 500)
?- term
%bad-request 400
%forbidden 403
%nonexistent 404
%offline 504
==
::
++ thread-fail
|= [=yarn =term =tang]
@ -402,7 +490,24 @@
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ cards state (thread-clean yarn)
[(weld fail-cards cards) state]
=^ http-cards state (thread-http-fail tid term tang)
[:(weld fail-cards cards http-cards) state]
::
++ thread-http-response
|= [=tid =vase]
^- (quip card ^state)
=- (fall - `state)
%+ bind
(~(get by serving.state) tid)
|= [eyre-id=@ta output=mark]
=+ .^
=tube:clay
%cc
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[output]/json
==
:_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server eyre-id
(json-response:gen:server !<(json (tube vase)))
::
++ thread-done
|= [=yarn =vase]
@ -413,8 +518,10 @@
:~ [%give %fact ~[/thread-result/[tid]] %thread-done vase]
[%give %kick ~[/thread-result/[tid]] ~]
==
=^ http-cards state
(thread-http-response tid vase)
=^ cards state (thread-clean yarn)
[(weld done-cards cards) state]
[:(weld done-cards cards http-cards) state]
::
++ thread-clean
|= =yarn
@ -474,5 +581,5 @@
::
++ clean-state
!> ^- clean-slate
1+state(running (turn (tap-yarn running.state) head))
2+state(running (turn (tap-yarn running.state) head))
--

8
pkg/arvo/app/test/example.udon
View File

@ -1,8 +0,0 @@
:- ~[comments+&]
;>
# Static
You can put static files in here to serve them to the web. Actually, you can put static files anywhere in `/web` and see them in a browser.
Docs on static publishing with urbit are forthcoming — but feel free to drop markdown files in `/web` to try it out.

37
pkg/arvo/app/time.hoon Normal file
View File

@ -0,0 +1,37 @@
::
/+ default-agent, verb
::
|%
::
+$ card card:agent:gall
--
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init [~ this]
++ on-save !>(~)
++ on-load _on-init
++ on-poke
|= [=mark =vase]
?+ mark !!
%noun :_ this
[%pass /(scot %da now.bowl) %arvo %b %wait `@da`+(now.bowl)]~
==
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
|= [=wire sign=sign-arvo]
^- (quip card _this)
?+ wire !!
[@ ~]
?> ?=(%wake +<.sign)
~& [%took `@dr`(sub now.bowl (slav %da i.wire))]
[~ this]
==
++ on-fail on-fail:def
--

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

@ -1,3 +1,7 @@
:: weather [landscape]:
::
:: holds latlong, gets weather data from API, passes it on to subscribers
::
/+ *server, default-agent, verb, dbug
=, format
::

6
pkg/arvo/gen/cors-registry.hoon Normal file
View File

@ -0,0 +1,6 @@
:: eyre: give cors configuration
::
:- %say
|= [[now=@da eny=@uvJ =beak] ~ ~]
:- %noun
.^(cors-registry:eyre %ex /(scot %p p.beak)//(scot %da now)/cors)

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]]

14
pkg/arvo/gen/graph-store/export-graph.hoon Normal file
View File

@ -0,0 +1,14 @@
/+ graph-store
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=ship graph=term ~] ~]
==
:- %graph-update
=/ our (scot %p p.bec)
=/ wen (scot %da now)
=/ who (scot %p ship)
::
.^ update:graph-store
/gx/[our]/graph-store/[wen]/archive/[who]/[graph]/graph-update
==

9
pkg/arvo/gen/graph-store/import-graph.hoon Normal file
View File

@ -0,0 +1,9 @@
/+ graph-store
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[graph=term =path ~] ~]
==
:- %graph-update
=- ~& update=- -
.^(=update:graph-store %cx path)

2
pkg/arvo/gen/help.hoon
View File

@ -23,7 +23,7 @@
:- ?- b
~ "/" :: XX !! maybe?
{$hood ^} "|{(path-heps t.b)}"
^ "+{(path-heps b)}" :: XX deal with :hall|foo
^ "+{(path-heps b)}" :: XX deal with :graph-store|foo
==
=/ c (to-wain:format a)
?~ c "~"

30
pkg/arvo/gen/hood/code.hoon Normal file
View File

@ -0,0 +1,30 @@
:: Helm: query or reset login code for web
::
:::: /hoon/code/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=?(~ [%reset ~]) ~]
==
=* our p.bec
:- %helm-code
?~ arg
=/ code=tape
%+ slag 1
%+ scow %p
.^(@p %j /(scot %p our)/code/(scot %da now)/(scot %p our))
=/ step=tape
%+ scow %ud
.^(@ud %j /(scot %p our)/step/(scot %da now)/(scot %p our))
%- %- slog
:~ [%leaf code]
[%leaf (weld "current step=" step)]
[%leaf "use |code %reset to invalidate this and generate a new code"]
==
~
?> =(%reset -.arg)
%reset

5
pkg/arvo/gen/hood/cors-approve.hoon Normal file
View File

@ -0,0 +1,5 @@
:: eyre: allow cors requests from origin
::
:- %say
|= [^ [=origin:eyre ~] ~]
[%helm-cors-approve origin]

5
pkg/arvo/gen/hood/cors-reject.hoon Normal file
View File

@ -0,0 +1,5 @@
:: eyre: disallow cors requests from origin
::
:- %say
|= [^ [=origin:eyre ~] ~]
[%helm-cors-reject origin]

13
pkg/arvo/gen/hood/meld.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Helm: unify memory
::
:::: /hoon/meld/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=~ ~]
==
[%helm-meld ~]

6
pkg/arvo/gen/hood/merge.hoon
View File

@ -3,6 +3,7 @@
:::: /hoon/merge/hood/gen
::
/? 310
/* help-text %txt /gen/hood/merge/help/txt
=, clay
::
|%
@ -14,12 +15,13 @@
::
:- %say
|= $: {now/@da eny/@uvJ bek/beak}
{arg/{?(sorc {syd/$@(desk beaky) sorc})} cas/case gem/?(germ $auto)}
{arg/{?(~ sorc {syd/$@(desk beaky) sorc})} cas/case gem/?(germ $auto)}
==
=* our p.bek
|^ :- %kiln-merge
^- {syd/desk her/ship sud/desk cas/case gem/?(germ $auto)}
^- $@(~ {syd/desk her/ship sud/desk cas/case gem/?(germ $auto)})
?- arg
~ ((slog (turn help-text |=(=@t leaf+(trip t)))) ~)
{@ @ ~}
=+(arg [sud ?.(=(our her) her (sein:title p.bek now her)) sud (opt-case da+now) gem])
::

110
pkg/arvo/gen/hood/merge/help.txt Normal file
View File

@ -0,0 +1,110 @@
Usage:
|merge %destination-desk ~source-ship %source-desk
|merge %destination-desk ~source-ship %source-desk, =gem %strategy
|merge %destination-desk ~source-ship %source-desk, =cas ud+5
We support various merge strategies. A "commit" is a snapshot of
the files with a list of parents plus a date. Most commits have
one parent; a "merge" commit is a commit with two parents. The
%home desk starts with an initial commit with no parents; commits
with several parents ("octopus merges") are possible but we don't
generate them right now.
Unless otherwise specified, all of the following create a new commit
with the source and destination commits as parents.
Several strategies need a "merge-base". They find it by identifying
the most recent common ancestor of the two desks. If none, fail
with %merge-no-merge-base; if there are two or more, pick one.
%init: the only way to create a desk. Not a true merge, since it
simply assigns the source commit to the destination.
%fine: if source or destination are in the ancestry of each other,
use the newer one; else abort. If the destination is ahead of the
source, succeed but do nothing. If the source is ahead of the
destination, assign the next revision number to the source commit.
Some call this "fast-forward".
%meet: combine changes, failing if both sides changed the same file.
Specifically, take diff(merge-base,source) and
diff(merge-base,destination) and combine them as long as those diffs
touch different files.
%mate: combine changes, failing if both sides changed the same part
of a file. Identical to %meet, except that some marks, like %hoon,
allow intelligent merge of changes to different parts of a file.
%meld: combine changes; if both sides changed the same part of a
file, use the version of the file in the merge-base.
%only-this: create a merge commit with exactly the contents of the
destination desk.
%only-that: create a merge commit with exactly the contents of the
source commit.
%take-this: create a merge commit with exactly the contents of the
destination desk except take any files from the source commit which
are not in the destination desk.
%take-that: create a merge commit with exactly the contents of the
source commit except preserve any files from the destination desk
which are not in the source commit.
%meet-this: merge as in %meet, except if both sides changed the same
file, use the version in the destination desk.
%meet-that: merge as in %meet, except if both sides changed the same
file, use the version in the source commit.
# Examples and notes:
The most common merge strategy is %mate, which is a normal 3-way
merge which aborts on conflict.
%take-that is useful to "force" an OTA. After running %take-that,
you're guaranteed to have exactly the files in the source commit plus
any files you separately added.
We speak of merging into a destination *desk* from a source *commit*
because while you can only merge on top of a desk, you can merge from
historical commits. For example,
|merge %old our %home, =cas ud+5, =gem %init
will create a new desk called %old with the 5th commit in %home.
You can revert the contents of a desk to what they were yesterday
with
|merge %home our %home, =cas da+(sub now ~d1), =gem %only-that
Note this is a normal %only-that merge, which means you're creating a
*new* commit with the old *contents*.
%meld is rarely used on its own, however if you specify %auto or
omit the merge strategy, %kiln will run a %meld merge into a scratch
desk and then annotate the conflicts there.
If you resolve merge conflicts manually, for example by mounting the
desks, copying the files in unix and then running |commit, you
should usually run an %only-this merge. This will not change the
newly-fixed contents of your desk, but it will record that the merge
happened so that those conflicts don't reappear in later merges.
If you get a %merge-no-merge-base error, this means you're trying to
merge two desks which have no common ancestors. You need to give
them a common ancestor by choosing a merge strategy which doesn't
need a merge-base, like %only-this, %only-that, %take-this, or
%take-that.
%take-this could be useful to install 3rd party software, but you
couldn't get subsequent updates this way, since the files would
already exist in the destination desk. Something like "take only
the files which aren't in my OTA source or any other 3rd party app"
would be basically correct. This would require a parameter listing
the desks to not conflict with.
%meet-this and %meet-that imply the existence of %mate-this and
%mate-that, but those don't exist yet.

13
pkg/arvo/gen/hood/trim.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Helm: trim kernel state
::
:::: /hoon/trim/hood/gen
::
/? 310
::
::::
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=?(~ [pri=@ud ~]) ~]
==
[%helm-trim ?~(arg 1 pri.arg)]

20
pkg/arvo/gen/metadata-store/remove.hoon Normal file
View File

@ -0,0 +1,20 @@
:: :metadata-store|remove: remove resource from group
:: Usage:
:: :metadata-store|remove
:: <group-name> <app-name> <channel-path>
:: %urbit-community %chat /~darrux-landes/general-503
::
:: You can acquire the channel-path with
:: :metadata-store +dbug [%state '(~(got by group-indices) <group-path>)'
:: and looking for the entry with an app-path that is similar to the
:: title of the channel
::
/- *metadata-store
/+ resource
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[group=term app=term =path ~] ~]
==
:- %metadata-action
^- metadata-action
[%remove (en-path:resource [p.beak group]) app path]

15
pkg/arvo/gen/trouble.hoon
View File

@ -1,5 +1,15 @@
:: Print useful diagnostic information
::
:: base-hash: loosely, the most recent successfully applied update.
:: Technically, the mergebase of %home with OTA source
:: sour-hash: most recently downloaded update (not necessarily applied)
:: home-hash: hash of %home desk, which may differ if you have changed
:: it, for example with notebooks or 3rd party apps
:: kids-hash: hash of the %kids desk, which is what you serve to your
:: children
:: glob-hash: hash of the glob, which is the js for landscape
::
/+ version
:- %say
|= [[now=time * bec=beak] ~ ~]
=* our p.bec
@ -7,7 +17,8 @@
:- %noun
=<
:~
[%base-hash base-hash]
[%base-hash (base-hash:version our now)]
[%sour-hash sour-hash]
[%home-hash .^(@uv %cz (pathify ~.home ~))]
[%kids-hash .^(@uv %cz (pathify ~.kids ~))]
[%glob-hash glob-state]
@ -43,7 +54,7 @@
rift=ryft
==
::
++ base-hash
++ sour-hash
=+ .^ ota=(unit [=ship =desk =aeon:clay])
%gx /(scot %p our)/hood/(scot %da now)/kiln/ota/noun
==

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
== ==

12
pkg/arvo/lib/dbug.hoon
View File

@ -41,9 +41,17 @@
::
%state
=? grab.dbug =('' grab.dbug) '-'
=- [(sell -)]~
=; product=^vase
[(sell product)]~
=/ state=^vase
:: if the underlying app has implemented a /dbug/state scry endpoint,
:: use that vase in place of +on-save's.
::
=/ result=(each ^vase tang)
(mule |.(q:(need (need (on-peek:ag /x/dbug/state)))))
?:(?=(%& -.result) p.result on-save:ag)
%+ slap
(slop on-save:ag !>([bowl=bowl ..zuse]))
(slop state !>([bowl=bowl ..zuse]))
(ream grab.dbug)
::
%incoming

176
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)]
==
--
--
::
@ -247,20 +252,24 @@
|%
++ decode
%- of
:~ [%add-graph add-graph]
[%remove-graph remove-graph]
[%add-nodes add-nodes]
:~ [%add-nodes add-nodes]
[%remove-nodes remove-nodes]
[%add-signatures add-signatures]
[%remove-signatures remove-signatures]
::
[%add-graph add-graph]
[%remove-graph remove-graph]
::
[%add-tag add-tag]
[%remove-tag remove-tag]
::
[%archive-graph archive-graph]
[%unarchive-graph unarchive-graph]
[%run-updates run-updates]
::
[%keys keys]
[%tags tags]
[%tag-queries tag-queries]
[%run-updates run-updates]
==
::
++ add-graph
@ -268,6 +277,7 @@
:~ [%resource dejs:res]
[%graph graph]
[%mark (mu so)]
[%overwrite bo]
==
::
++ graph
@ -291,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
@ -313,7 +328,8 @@
::
++ content
%- of
:~ [%text so]
:~ [%mention (su ;~(pfix sig fed:ag))]
[%text so]
[%url so]
[%reference uid]
[%code eval]
@ -362,7 +378,7 @@
[%index index]
==
::
++ index (su ;~(pfix net (more net dem)))
++ index (su ;~(pfix fas (more fas dem)))
::
++ add-tag
%- ot

62
pkg/arvo/lib/graph-view.hoon Normal file
View File

@ -0,0 +1,62 @@
/- sur=graph-view
/+ resource, group-store
^?
=< [sur .]
=, sur
|%
++ dejs
=, dejs:format
|%
++ action
|^
^- $-(json ^action)
%- of
:~ create+create
delete+delete
join+join
leave+leave
groupify+groupify
::invite+invite
==
::
++ create
%- ou
:~ resource+(un dejs:resource)
title+(un so)
description+(un so)
mark+(uf ~ (mu so))
associated+(un associated)
module+(un so)
==
::
++ leave
%- ot
:~ resource+dejs:resource
==
::
++ delete
%- ot
:~ resource+dejs:resource
==
::
++ join
%- ot
:~ resource+dejs:resource
ship+(su ;~(pfix sig fed:ag))
==
::
++ groupify
%- ou
:~ resource+(un dejs:resource)
to+(uf ~ (mu dejs:resource))
==
++ invite !!
::
++ associated
%- of
:~ group+dejs:resource
policy+policy:dejs:group-store
==
--
--
--

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

@ -13,12 +13,44 @@
::
++ get-graph
|= res=resource
^- marked-graph:store
%+ scry-for marked-graph:store
^- update:store
%+ scry-for update:store
/graph/(scot %p entity.res)/[name.res]
::
++ peek-log
++ 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
%+ scry-for update-log:store
/update-log/(scot %p entity.rid)/[name.rid]
::
++ peek-update-log
|= res=resource
^- (unit time)
(scry-for (unit time) /peek-update-log/(scot %p entity.res)/[name.res])
::
++ get-update-log-subset
|= [res=resource start=@da]
^- 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
--

8
pkg/arvo/lib/group.hoon
View File

@ -48,6 +48,13 @@
^- ?
=- (~(has in -) ship)
(members-from-path group-path)
::
++ is-admin
|= [=ship =group-path]
^- ?
=/ tags tags:(fall (scry-group-path group-path) *group)
=/ admins=(set ^ship) (~(gut by tags) %admin ~)
(~(has in admins) ship)
:: +role-for-ship: get role for user
::
:: Returns ~ if no such group exists or user is not
@ -77,6 +84,7 @@
?: (~(has in members.group) ship)
[~ ~]
~
::
++ can-join-from-path
|= [=path =ship]
%+ scry-for

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)
==
--
--

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