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

fixes were made to the secp code and PR'd against master - updating

Browse Source 
in preparation to merge those fixes

Merge branch 'master' into urcrypt
This commit is contained in:
Paul Driver 2020-09-30 10:23:32 -07:00
commit f78562195b
410 changed files with 17884 additions and 13742 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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.

2
.github/ISSUE_TEMPLATE/kernel-or-runtime-bug-report.md vendored
View File

@ -30,7 +30,7 @@ If applicable, add screenshots to help explain your problem.
**System (please supply the following information, if relevant):**
- OS: [e.g. macOS, linux64, FreeBSD]
- Vere and Urbit OS versions
- Your ship's `%base` hash (use `.^(@uv %cz /=base=)` to check)
- Your ship's `%base` hash (use `+trouble` to check)
**Additional context**
Add any other context about the problem here.

8
.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
@ -27,13 +27,13 @@ If applicable, add screenshots to help explain your problem. If possible, please
**Desktop (please complete the following information):**
- OS: [e.g. MacOS 10.15.3]
- Browser [e.g. chrome, safari]
- Base hash of your urbit ship. Run ` .^(@uv %cz /=base=)` in Dojo to see this.
- Base hash of your urbit ship. Run `+trouble` in Dojo to see this.
**Smartphone (please complete the following information):**
- Device: [e.g. iPhone6]
- OS: [e.g. iOS8.1]
- Browser [e.g. stock browser, safari]
- Base hash of your urbit ship. Run ` .^(@uv %cz /=base=)` in Dojo to see this.
- Base hash of your urbit ship. Run `+trouble` in Dojo to see this.
**Additional context**
Add any other context about the problem here.

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

9
MAINTAINERS.md
View File

@ -175,14 +175,15 @@ the pill to have the new files/hash. For most things, it is sufficient to run
However, if you've made a change to Landscape's JS, then you will need to build
a "glob" and upload it to bootstrap.urbit.org. To do this, run `npm install;
npm run build:prod` in `pkg/interface`, and add the resulting
`pkg/arvo/app/landscape/index.js` to a fakezod at that path (or just create a
`pkg/arvo/app/landscape/index.[hash].js` to a fakezod at that path (or just create a
new fakezod with `urbit -F zod -B bin/solid.pill -A pkg/arvo`). Run
`:glob|make`, and this will output a file in `fakezod/.urb/put/glob-0vXXX.glob`.
Upload this file to bootstrap.urbit.org, and modify `+hash` at the top of
`pkg/arvo/app/glob.hoon` to match the hash in the filename. Do not commit the
produced `index.js` and make sure it doesn't end up in your pills (they should
be less than 10MB each).
`pkg/arvo/app/glob.hoon` to match the hash in the filename of the `.glob` file.
Amend `pkg/arvo/app/landscape/index.html` to import the hashed JS bundle, instead
of the unversioned index.js. Do not commit the produced `index.js` and
make sure it doesn't end up in your pills (they should be less than 10MB each).
### Tag the resulting commit

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:ecf3f8593815742e409008421f318b664124e672b1eecd131e4a1e49864a1c2a
size 6175676
oid sha256:6def8b55a977e3ced47d6042dba819450655421623efd4ed5db0852b0bce8723
size 6229538

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

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

@ -72,7 +72,7 @@
+$ glyph char
++ glyphs "!@#$%^&()-=_+[]\{}'\\:\",.<>?"
::
+$ nu-security ?(%channel %village %village-with-group)
+$ nu-security ?(%channel %village)
::
+$ command
$% [%target (set target)] :: set messaging target
@ -81,7 +81,7 @@
::
::
:: create chat
[%create nu-security path (unit glyph) (unit ?)]
[%create nu-security path (unit resource) (unit glyph) (unit ?)]
[%delete path] :: delete chat
[%invite [? path] (set ship)] :: allow
[%banish [? path] (set ship)] :: disallow
@ -293,8 +293,6 @@
::
++ target-to-path
|= target
%+ weld
?:(in-group ~ /~)
[(scot %p ship) path]
:: +path-to-target: deduces a target from a mailbox path
::
@ -464,6 +462,7 @@
security
;~ plug
path
(punt ;~(pfix ace group))
(punt ;~(pfix ace glyph))
(punt ;~(pfix ace (fuss 'y' 'n')))
==
@ -535,16 +534,15 @@
:: ;~(pfix ace ;~(plug i.opt $(opt t.opt)))
:: --
::
++ group ;~((glue net) 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
:: +mang: un/managed indicator prefix
::
++ mang
;~ pose
(cold %| (jest '~/'))
(cold %& (easy ~))
==
:: deprecated, as sig prefix is no longer used
::
++ mang (cold %& (easy ~))
:: +tarl: local target, as /path
::
++ tarl (stag our-self path)
@ -585,7 +583,7 @@
:: +security: security mode
::
++ security
(perk %channel %village-with-group %village ~)
(perk %channel %village ~)
::
:: +glyph: shorthand character
::
@ -741,15 +739,21 @@
:: +create: new local mailbox
::
++ create
|= [security=nu-security =path gyf=(unit char) allow-history=(unit ?)]
|= $: security=nu-security
=path
ugroup=(unit resource)
gyf=(unit char)
allow-history=(unit ?)
==
^- (quip card _state)
=/ with-group=? ?=(%village-with-group security)
=/ with-group=? ?=(^ ugroup)
=/ =target [with-group our-self path]
=/ real-path=^path (target-to-path target)
=/ group-path=^path ?~(ugroup ship+real-path (en-path:resource u.ugroup))
=/ =policy
?- security
%channel *open:policy
?(%village %village-with-group) *invite:policy
%channel *open:policy
%village *invite:policy
==
?^ (scry-for (unit mailbox:store) %chat-store [%mailbox real-path])
=- [[- ~] state]
@ -767,7 +771,7 @@
(rsh 3 1 (spat path))
''
real-path :: chat
real-path :: group
group-path :: group
policy
~
(fall allow-history %.y)

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

@ -1,4 +1,4 @@
:: 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
::
@ -18,17 +18,21 @@
state-1
state-2
state-3
state-4
state-5
state-6
state-7
state-8
==
::
+$ state-3
$: %3
state-base
==
+$ state-8 [%8 state-base]
+$ state-7 [%7 state-base]
+$ state-6 [%6 state-base]
+$ state-5 [%5 state-base]
+$ state-4 [%4 state-base]
+$ state-3 [%3 state-base]
+$ state-2 [%2 state-base]
::
+$ state-2
$: %2
state-base
==
+$ state-1
$: %1
loaded-cards=*
@ -52,7 +56,7 @@
$% [%chat-update update:store]
==
--
=| state-3
=| state-8
=* state -
::
%- agent:dbug
@ -81,8 +85,45 @@
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|-
?: ?=(%3 -.old)
?: ?=(%8 -.old)
[cards this(state old)]
?: ?=(%7 -.old)
=/ 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)
=. cards
%+ weld cards
^- (list card)
%+ murn ~(tap in ~(key by synced.old))
|= =path
^- (unit card)
?> ?=([@ @ ~] path)
=/ group-path (group-from-chat:cc path)
=/ members (members-from-path:group group-path)
?: (is-managed-path:group group-path) ~
=/ 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 !>(-)]
$(-.old %8)
?: ?=(%6 -.old)
=. cards
%+ weld cards
^- (list card)
[%pass /s %agent [our.bol %chat-hook] %poke %noun !>(%fix-out-of-sync)]~
$(-.old %7)
?: ?=(?(%3 %4 %5) -.old)
=. cards
%+ weld cards
^- (list card)
[%pass /pokeme %agent [our.bol %chat-hook] %poke %noun !>(%fix-dm)]~
$(-.old %6)
?: ?=(%2 -.old)
=. cards
%+ weld cards
@ -100,7 +141,7 @@
i.syncs
?> ?=(^ pax)
?. =('~' i.pax)
$(syncs t.syncs)
$(syncs t.syncs)
=/ new-path=path
t.pax
=. synced.old
@ -319,9 +360,9 @@
^- (quip card _this)
=^ cards state
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun [~ state]
%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))
::
%chat-hook-action
(poke-chat-hook-action:cc !<(action:hook vase))
@ -383,6 +424,81 @@
|_ bol=bowl:gall
++ grp ~(. grpl bol)
::
++ poke-noun
|= a=?(%fix-dm %fix-out-of-sync)
^- (quip card _state)
|^
:_ state
?- a
%fix-dm (fix-dm %fix-dm)
%fix-out-of-sync (fix-out-of-sync %fix-out-of-sync)
==
::
++ fix-out-of-sync
|= b=%fix-out-of-sync
^- (list card)
%- zing
%+ turn ~(tap by synced)
|= [=path host=ship]
^- (list card)
?: =(host our.bol) ~
?> ?=([@ @ ~] path)
=/ =ship (slav %p i.path)
:~ =- [%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action -]
!> ^- action:hook
[%remove path]
::
=- [%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action -]
!> ^- action:hook
[%add-synced ship path %.y]
==
::
++ fix-dm
|= b=%fix-dm
^- (list card)
%- zing
%+ turn
~(tap by synced)
|= [=path host=ship]
^- (list card)
?> ?=([@ @ *] path)
=/ =ship (slav %p i.path)
?: =(ship our.bol)
:: local dm, no need to do cleanup
~
?: ?=(^ (groups-of-chat path))
:: correctly initialized, no need to do cleanup
::
~
?. =((end 3 4 i.t.path) 'dm--')
~
:- =- [%pass /fixdm %agent [our.bol %chat-view] %poke %chat-view-action -]
!> ^- action:view
[%delete path]
=/ new-dm /(scot %p our.bol)/(crip (weld "dm--" (trip (scot %p ship))))
=/ mailbox=(unit mailbox:store) (chat-scry path)
?~ mailbox
~
:~ =- [%pass /fixdm %agent [our.bol %chat-view] %poke %chat-view-action -]
!> ^- action:view
:* %create
%- crip
(zing [(trip (scot %p our.bol)) " <-> " (trip (scot %p ship)) ~])
''
new-dm
ship+new-dm
[%invite (silt ~[ship])]
(silt ~[ship])
%.y
%.n
==
::
=- [%pass /fixdm %agent [our.bol %chat-store] %poke %chat-action -]
!> ^- action:store
[%messages new-dm envelopes.u.mailbox]
==
--
::
++ poke-json
|= jon=json
^- (quip card _state)

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 ~

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

@ -1,4 +1,6 @@
:: 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,
@ -61,7 +63,7 @@
:_ this
:~ :* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~chat' /app/landscape %.n])
!>([%serve-dir /'~chat' /app/landscape %.n %.y])
==
[%pass / %arvo %e %connect [~ /'chat-view'] %chat-view]
[%pass /updates %agent [our.bol %chat-store] %watch /updates]
@ -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)
@ -167,7 +169,7 @@
[%pass / %arvo %e %connect [~ /'chat-view'] %chat-view]
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~chat' /app/landscape %.n])
!>([%serve-dir /'~chat' /app/landscape %.n %.y])
==
==
::
@ -193,7 +195,6 @@
=/ pax t.t.t.t.site.url
=/ envelopes (envelope-scry [(scot %ud start) (scot %ud end) pax])
%- json-response:gen
%- json-to-octs
%- update:enjs:store
[%messages pax start end envelopes]
==
@ -212,8 +213,8 @@
?- -.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
@ -296,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

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,4 +1,5 @@
:: contact-hook:
:: contact-hook [landscape]
::
::
/- group-hook,
*contact-hook,
@ -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
@ -164,10 +165,7 @@
(fact-group-update:cc wire !<(update:group-store q.cage.sign))
[cards this]
::
%invite-update
=^ cards state
(fact-invite-update:cc wire !<(invite-update q.cage.sign))
[cards this]
%invite-update [~ this]
==
==
::
@ -304,8 +302,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)
@ -481,22 +479,6 @@
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
--
::
++ fact-invite-update
|= [wir=wire fact=invite-update]
^- (quip card _state)
?+ -.fact [~ state]
%accepted
=/ rid=resource
(de-path:resource path.invite.fact)
:_ state
~[(contact-view-poke %join rid)]
==
::
++ group-hook-poke
|= =action:group-hook
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(action)]
::
++ invite-poke
|= act=invite-action
^- card
@ -507,26 +489,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)
@ -538,16 +500,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)

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

@ -1,4 +1,6 @@
:: 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
::
/-
@ -48,7 +50,7 @@
(contact-poke:cc [%add /~/default our.bowl *contact])
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~groups' /app/landscape %.n])
!>([%serve-dir /'~groups' /app/landscape %.n %.y])
==
==
::
@ -63,7 +65,7 @@
[%pass / %arvo %e %connect [~ /'contact-view'] %contact-view]
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~groups' /app/landscape %.n])
!>([%serve-dir /'~groups' /app/landscape %.n %.y])
==
==
::
@ -268,7 +270,7 @@
%group-store
%group-push-hook
=/ =cage
:- %group-action
:- %group-update
!> ^- action:group-store
[%change-policy rid %invite %add-invites (sy ship ~)]
[%pass / %agent [entity.rid app] %poke cage]

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

@ -148,9 +148,7 @@
::
=; json=(unit json)
?~ json not-found:gen
%- json-response:gen
=, html
(as-octt:mimes (en-json u.json))
(json-response:gen u.json)
=, enjs:format
?+ site ~
:: /apps.json: {appname: running?}

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

@ -502,8 +502,8 @@
^+ +>
:: XX needs filter
::
:: ?: ?=({$show $3} -.mad)
:: (dy-rash %tan (dy-show-source q.mad) ~) :: XX separate command
?: ?=({$show $3} -.mad)
(dy-rash %tan (dy-show-source q.mad) ~)
?: ?=($brev -.mad)
=. var (~(del by var) p.mad)
=< dy-amok
@ -589,10 +589,8 @@
?- p.p.mad
%0 ~
%1 [[%rose [~ " " ~] (skol p.q.cay) ~] maar]
:: XX actually print something meaningful here
::
%2 [[%rose [~ " " ~] *tank ~] maar]
%3 ~
%2 [[%rose [~ " " ~] (dy-show-type-noun p.q.cay) ~] maar]
::%3 handled above
%4 ~
%5 [[%rose [~ " " ~] (xskol p.q.cay) ~] maar]
==
@ -638,6 +636,70 @@
:- i=""
t=(turn `wain`?~(r.hit ~ (to-wain:format q.u.r.hit)) trip)
==
++ dy-show-type-noun
|= a/type ^- tank
=- >[-]<
|- ^- $? $% {$atom @tas (unit @)}
{$cell _$ _$}
{$face $@(term tune) _$}
{$fork (set _$)}
{$hold _$ hoon}
==
wain :: "<|core|>"
$?($noun $void)
==
?+ a a
{$face ^} a(q $(a q.a))
{$cell ^} a(p $(a p.a), q $(a q.a))
{$fork *} a(p (silt (turn ~(tap in p.a) |=(b/type ^$(a b)))))
{$hint *} !!
{$core ^} `wain`/core
{$hold *} a(p $(a p.a))
==
::
:: XX needs filter
::
++ dy-shown
=/ jank-bucwut :: FIXME just $? fishes when defined for some reason
|* [a=mold b=mold]
|=(c=_`*`*a ?:(& (a c) (b c)))
::
::$? hoon
;: jank-bucwut
hoon
$^ {dy-shown dy-shown}
$% {$ur cord}
{$sa mark}
{$as mark dy-shown}
{$do hoon dy-shown}
{$te term (list dy-shown)}
{$ge path (list dy-shown) (map term (unit dy-shown))}
{$dv path}
==
==
::
++ dy-show-source
|= a/dojo-source ^- tank
=- >[-]<
=+ `{@ bil/dojo-build}`a
|- ^- dy-shown
?- -.bil
$?($ur $dv $sa) bil
$ex ?. ?=({$cltr *} p.bil) p.bil
|- ^- hoon
?~ p.p.bil !!
?~ t.p.p.bil i.p.p.bil
[i.p.p.bil $(p.p.bil t.p.p.bil)]
$tu ?~ p.bil !!
|-
?~ t.p.bil ^$(bil q.i.p.bil)
[^$(bil q.i.p.bil) $(p.bil t.p.bil)]
$as bil(q $(bil q.q.bil))
$do bil(q $(bil q.q.bil))
$te bil(q (turn q.bil ..$))
$ge :+ %ge q.p.p.bil
[(turn p.q.p.bil ..$) (~(run by q.q.p.bil) (lift ..$))]
==
::
++ dy-edit :: handle edit
|= cal/sole-change
@ -875,6 +937,8 @@
?> ?=(~ cud)
?: =(nex num)
dy-over
?: =([%show %3] -.mad) :: just show source
dy-over
dy-make(cud `[nex (~(got by job) nex)])
--
::

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

@ -1,14 +1,19 @@
:: file-server [landscape]:
::
:: mounts HTTP endpoints for Landscape (and third-party) user applications
::
/- srv=file-server, glob
/+ *server, default-agent, verb, dbug
|%
+$ card card:agent:gall
+$ serving (map url-base=path [=content public=?])
+$ serving (map url-base=path [=content public=? single-page=?])
+$ content
$% [%clay =path]
[%glob =glob:glob]
==
+$ state-1
$: %1
::
+$ state-3
$: %3
=configuration:srv
=serving
==
@ -17,7 +22,7 @@
%+ verb |
%- agent:dbug
::
=| state-1
=| state-3
=* state -
^- agent:gall
|_ =bowl:gall
@ -33,7 +38,7 @@
%+ turn
^- (list path)
[/ /'~landscape' ~]
|=(pax=path [pax [clay+/app/landscape %.n]])
|=(pax=path [pax [clay+/app/landscape %.n %.y]])
==
:~ (connect /)
(connect /'~landscape')
@ -60,20 +65,41 @@
^- [content ?]
[[%clay clay-path] public]
==
?> ?=(%1 -.old-state)
=? old-state ?=(%1 -.old-state)
%= old-state
- %2
serving (~(del by serving.old-state) /'~landscape'/js/index)
==
=? old-state ?=(%2 -.old-state)
%= old-state
- %3
serving
%- ~(run by serving.old-state)
|= [=content public=?]
^- [^content ? ?]
[content public %.y]
==
?> ?=(%3 -.old-state)
[~ this(state old-state)]
::
+$ serving-0 (map url-base=path [=clay=path public=?])
+$ serving-1 (map url-base=path [=content public=?])
+$ versioned-state
$% state-1
state-0
$% state-0
[%1 state-1]
[%2 state-1]
state-3
==
::
+$ serving-0 (map url-base=path [=clay=path public=?])
+$ state-0
$: %0
=configuration:srv
=serving-0
==
+$ state-1
$: =configuration:srv
serving=serving-1
==
--
::
++ on-poke
@ -100,14 +126,17 @@
?: (~(has by serving) url-base)
~|("url already bound to {<(~(got by serving) url-base.act)>}" !!)
:- [%pass url-base %arvo %e %connect [~ url-base] %file-server]~
this(serving (~(put by serving) url-base clay+clay-base.act public.act))
%_ this
serving
(~(put by serving) url-base clay+clay-base.act public.act spa.act)
==
::
%serve-glob
=* url-base url-base.act
?: (~(has by serving) url-base)
~|("url already bound to {<(~(got by serving) url-base.act)>}" !!)
:- [%pass url-base %arvo %e %connect [~ url-base] %file-server]~
this(serving (~(put by serving) url-base glob+glob.act public.act))
this(serving (~(put by serving) url-base glob+glob.act public.act %.y))
::
%unserve-dir
:- [%pass url-base.act %arvo %e %disconnect [~ url-base.act]]~
@ -116,9 +145,9 @@
%toggle-permission
?. (~(has by serving) url-base.act)
~|("url is not bound" !!)
=/ [=content public=?] (~(got by serving) url-base.act)
=/ [=content public=? spa=?] (~(got by serving) url-base.act)
:- ~
this(serving (~(put by serving) url-base.act [content !public]))
this(serving (~(put by serving) url-base.act [content !public spa]))
::
%set-landscape-homepage-prefix
=. landscape-homepage-prefix.configuration prefix.act
@ -140,9 +169,14 @@
=* headers header-list.req
=/ req-line (parse-request-line url.req)
?. =(method.req %'GET') not-found:gen
=. site.req-line
%+ murn site.req-line
|= =cord
^- (unit ^cord)
?:(=(cord '') ~ `cord)
=/ is-file ?=(^ ext.req-line)
=? req-line ?=(~ ext.req-line)
[[[~ %html] ~['index']] args.req-line]
?> ?=(^ ext.req-line)
[[[~ %html] (snoc site.req-line 'index')] args.req-line]
?~ site.req-line
not-found:gen
=* url-prefix landscape-homepage-prefix.configuration
@ -157,19 +191,22 @@
%- js-response:gen
(as-octt:mimes:html "window.ship = '{+:(scow %p our.bowl)}';")
::
=/ [payload=simple-payload:http public=?] (get-file req-line)
=/ [payload=simple-payload:http public=?] (get-file req-line is-file)
?: public payload
(require-authorization-simple:app inbound-request payload)
::
++ get-file
|= req-line=request-line
|= [req-line=request-line is-file=?]
^- [simple-payload:http ?]
=/ pax=path (snoc site.req-line (need ext.req-line))
=/ content=(unit [=content suffix=path public=?]) (get-content pax)
=/ pax=path
?~ ext.req-line site.req-line
(snoc site.req-line u.ext.req-line)
=/ content=(unit [=content suffix=path public=?])
(get-content pax is-file)
?~ content [not-found:gen %.n]
?- -.content.u.content
%clay
=/ scry-path
=/ scry-path=path
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
@ -179,10 +216,16 @@
=/ file (as-octs:mimes:html .^(@ %cx scry-path))
:_ public.u.content
?+ ext.req-line not-found:gen
[~ %html] (html-response:gen file)
[~ %js] (js-response:gen file)
[~ %css] (css-response:gen file)
[~ %png] (png-response:gen file)
::
[~ %html]
%. file
%* . html-response:gen
cache
!=(/app/landscape/index/html (slag 3 scry-path))
==
==
::
%glob
@ -209,23 +252,28 @@
(add char ^~((sub 'a' 'A')))
::
++ get-content
|= pax=path
|= [pax=path is-file=?]
^- (unit [content path ?])
=/ first-try (match-content-path pax (~(del by serving) /))
=/ first-try (match-content-path pax (~(del by serving) /) is-file)
?^ first-try first-try
=/ root (~(get by serving) /)
?~ root ~
(match-content-path pax (~(gas by *^serving) [[/ u.root] ~]))
(match-content-path pax (~(gas by *^serving) [[/ u.root] ~]) is-file)
::
++ match-content-path
|= [pax=path =^serving]
|= [pax=path =^serving is-file=?]
^- (unit [content path ?])
%- ~(rep by serving)
|= [[url-base=path =content public=?] out=(unit [content path ?])]
|= $: [url-base=path =content public=? spa=?]
out=(unit [content path ?])
==
?^ out out
=/ suf (get-suffix url-base pax)
?~ suf ~
`[content u.suf public]
=- `[content - public]
?: ?&(spa !is-file)
/index/html
u.suf
::
++ get-suffix
|= [a=path b=path]
@ -269,7 +317,7 @@
==
::
++ on-leave on-leave:def
++ on-peek
++ on-peek
|= =path
^- (unit (unit cage))
|^
@ -287,10 +335,9 @@
*@uv
=/ parent (scot %p ship.u.ota)
=+ .^(=cass:clay %cs /[parent]/[desk.u.ota]/1/late/foo)
%^ end 3 3
%^ end 0 25
.^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass))
--
++ on-agent on-agent:def
++ on-fail on-fail:def
--

23
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 0v5.knd3c.vvtvt.h0gg0.8qcau.8iii4
++ hash 0v5.6e3d0.3hm4q.iib09.rb2jb.9h4k4
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ all-states
$% state-0
@ -41,7 +45,7 @@
--
=| state=state-0
=. hash.state hash
=/ serve-path=path /'~landscape'/js/index
=/ serve-path=path /'~landscape'/js/bundle
^- agent:gall
%+ verb |
%- agent:dbug
@ -58,7 +62,6 @@
++ on-load
|= old-state=vase
^- (quip card _this)
~& > %initting
=+ !<(old=all-states old-state)
?> ?=(%0 -.old)
?~ glob.old
@ -83,9 +86,19 @@
:_ this
=/ home=path /(scot %p our.bowl)/home/(scot %da now.bowl)
=+ .^(=tube:clay %cc (weld home /js/mime))
=+ .^(js=@t %cx (weld home /app/landscape/js/index/js))
=+ .^(arch %cy (weld home /app/landscape/js/bundle))
=/ bundle=path
%- need
^- (unit path)
%- ~(rep by dir)
|= [[file=@t ~] out=(unit path)]
?^ 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) /js mime)
=/ =glob:glob (~(put by *glob:glob) bundle mime)
=/ =path /(cat 3 'glob-' (scot %uv (sham glob)))/glob
[%pass /make %agent [our.bowl %hood] %poke %drum-put !>([path (jam glob)])]~
::

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

@ -0,0 +1,48 @@
/- *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)
::
++ 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
=- [%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:graph resource)
?~ maybe-time `/
`/(scot %da u.maybe-time)
--

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

@ -0,0 +1,128 @@
/+ 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)
==
--
::
%- 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 resource.q.update bowl %.y)
%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
::
=/ =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)] ~]~
==
--

618
pkg/arvo/app/graph-store.hoon Normal file
View File

@ -0,0 +1,618 @@
:: 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-0 [%0 network:store]
++ orm orm:store
++ orm-log orm-log:store
--
::
=| state-0
=* state -
::
%- agent:dbug
^- agent:gall
~% %graph-store-agent ..card ~
|_ =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-watch
~/ %graph-store-watch
|= =path
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=/ cards=(list card)
?+ path (on-watch:def path)
[%updates ~] ~
[%keys ~] (give [%keys ~(key by graphs)])
[%tags ~] (give [%tags ~(key by tag-queries)])
==
[cards this]
::
++ give
|= =update-0:store
^- (list card)
[%give %fact ~ [%graph-update !>([%0 now.bowl update-0])]]~
--
::
++ on-poke
~/ %graph-store-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%graph-update (graph-update !<(update:store vase))
==
[cards this]
::
++ graph-update
|= =update:store
^- (quip card _state)
|^
?> ?=(%0 -.update)
?- -.q.update
%add-graph (add-graph +.q.update)
%remove-graph (remove-graph +.q.update)
%add-nodes (add-nodes p.update +.q.update)
%remove-nodes (remove-nodes p.update +.q.update)
%add-signatures (add-signatures p.update +.q.update)
%remove-signatures (remove-signatures p.update +.q.update)
%add-tag (add-tag +.q.update)
%remove-tag (remove-tag +.q.update)
%archive-graph (archive-graph +.q.update)
%unarchive-graph (unarchive-graph +.q.update)
%run-updates (run-updates +.q.update)
%keys ~|('cannot send %keys as poke' !!)
%tags ~|('cannot send %tags as poke' !!)
%tag-queries ~|('cannot send %tag-queries as poke' !!)
==
::
++ add-graph
|= [=resource:store =graph:store mark=(unit mark:store)]
^- (quip card _state)
?< (~(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 ~ ~))
validators
?~ mark validators
(~(put in validators) u.mark)
==
%- zing
:~ (give [/updates /keys ~] [%add-graph resource graph mark])
?~ mark ~
?: (~(has in validators) u.mark) ~
=/ wire (weld /graph (en-path:res resource))
=/ =rave:clay [%sing %b [%da now.bowl] /[u.mark]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
::
++ remove-graph
|= =resource:store
^- (quip card _state)
?< (~(has by archive) resource)
?> (~(has by graphs) resource)
:- (give [/updates /keys ~] [%remove-graph resource])
%_ state
graphs (~(del by graphs) resource)
update-logs (~(del by update-logs) resource)
==
::
++ add-nodes
|= $: =time
=resource:store
nodes=(map index:store node:store)
==
^- (quip card _state)
|^
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%add-nodes resource nodes]])
::
:- (give [/updates]~ [%add-nodes resource nodes])
%_ state
update-logs (~(put by update-logs) resource update-log)
graphs
%+ ~(put by graphs)
resource
:_ mark
(add-node-list resource graph mark (sort-nodes nodes))
==
::
++ sort-nodes
|= nodes=(map index:store node:store)
^- (list [index:store node:store])
%+ sort ~(tap by nodes)
|= [p=[=index:store *] q=[=index:store *]]
^- ?
(lth (lent index.p) (lent index.q))
::
++ add-node-list
|= $: =resource:store
=graph:store
mark=(unit mark:store)
node-list=(list [index:store node:store])
==
^- graph:store
?~ node-list graph
=* index -.i.node-list
=* node +.i.node-list
%_ $
node-list t.node-list
graph (add-node-at-index graph index node mark)
==
::
++ add-node-at-index
=| parent-hash=(unit hash:store)
|= $: =graph:store
=index:store
=node:store
mark=(unit mark:store)
==
^- graph:store
?< ?=(~ index)
~| "validation of node failed using mark {<mark>}"
?> (validate-graph (gas:orm ~ [i.index node]~) mark)
=* atom i.index
%^ put:orm
graph
atom
:: add child
::
?~ t.index
=* p post.node
=/ =validated-portion:store
[parent-hash author.p time-sent.p contents.p]
=/ =hash:store `@ux`(sham validated-portion)
?~ hash.p node(signatures.post *signatures:store)
~| "signatures do not match the calculated hash"
?> (are-signatures-valid:sigs our.bowl signatures.p hash now.bowl)
~| "hash of post does not match calculated hash"
?> =(hash u.hash.p)
node
:: recurse children
::
=/ parent=node:store
~| "index does not exist to add a node to!"
(need (get:orm graph atom))
%_ parent
children
^- internal-graph:store
:- %graph
%_ $
index t.index
parent-hash hash.post.parent
graph
?: ?=(%graph -.children.parent)
p.children.parent
(gas:orm ~ ~)
==
==
--
::
++ remove-nodes
|= [=time =resource:store indices=(set index:store)]
^- (quip card _state)
|^
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%remove-nodes resource indices]])
::
:- (give [/updates]~ [%remove-nodes resource indices])
%_ state
update-logs (~(put by update-logs) resource update-log)
graphs
%+ ~(put by graphs)
resource
[(remove-indices resource graph ~(tap in indices)) mark]
==
::
++ remove-indices
|= [=resource:store =graph:store indices=(list index:store)]
^- graph:store
?~ indices graph
%_ $
indices t.indices
graph (remove-index graph i.indices)
==
::
++ remove-index
|= [=graph:store =index:store]
^- graph:store
?~ index graph
=* atom i.index
:: last index in list
::
?~ t.index
+:`[* graph:store]`(del:orm graph atom)
=/ =node:store
~| "parent index does not exist to remove a node from!"
(need (get:orm graph atom))
~| "child index does not exist to remove a node from!"
?> ?=(%graph -.children.node)
%^ put:orm
graph
atom
node(p.children $(graph p.children.node, index t.index))
--
::
++ add-signatures
|= [=time =uid:store =signatures:store]
^- (quip card _state)
|^
=* resource resource.uid
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
(put:orm-log update-log time [%0 time [%add-signatures uid signatures]])
::
:- (give [/updates]~ [%add-signatures uid signatures])
%_ state
update-logs (~(put by update-logs) resource update-log)
graphs
%+ ~(put by graphs) resource
[(add-at-index graph index.uid signatures) mark]
==
::
++ add-at-index
|= [=graph:store =index:store =signatures:store]
^- graph:store
?~ index graph
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
:: last index in list
::
%^ put:orm
graph
atom
?~ t.index
~| "cannot add signatures to a node missing a hash"
?> ?=(^ hash.post.node)
~| "signatures did not match public keys!"
?> (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)
node(p.children $(graph p.children.node, index t.index))
--
::
++ remove-signatures
|= [=time =uid:store =signatures:store]
^- (quip card _state)
|^
=* resource resource.uid
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource)
=/ =update-log:store (~(got by update-logs) resource)
=. update-log
%^ put:orm-log update-log
time
[%0 time [%remove-signatures uid signatures]]
::
:- (give [/updates]~ [%remove-signatures uid signatures])
%_ state
update-logs (~(put by update-logs) resource update-log)
graphs
%+ ~(put by graphs) resource
[(remove-at-index graph index.uid signatures) mark]
==
::
++ remove-at-index
|= [=graph:store =index:store =signatures:store]
^- graph:store
?~ index graph
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
:: last index in list
::
%^ put:orm
graph
atom
?~ t.index
node(signatures.post (~(dif in signatures) signatures.post.node))
~| "child graph does not exist to add signatures to!"
?> ?=(%graph -.children.node)
node(p.children $(graph p.children.node, index t.index))
--
::
++ add-tag
|= [=term =resource:store]
^- (quip card _state)
?> (~(has by graphs) resource)
:- (give [/updates /tags ~] [%add-tag term resource])
%_ state
tag-queries (~(put ju tag-queries) term resource)
==
::
++ remove-tag
|= [=term =resource:store]
^- (quip card _state)
?> (~(has by graphs) resource)
:- (give [/updates /tags ~] [%remove-tag term resource])
%_ state
tag-queries (~(del ju tag-queries) term resource)
==
::
++ archive-graph
|= =resource:store
^- (quip card _state)
?< (~(has by archive) resource)
?> (~(has by graphs) resource)
:- (give [/updates /keys /tags ~] [%archive-graph resource])
%_ state
archive (~(put by archive) resource (~(got by graphs) resource))
graphs (~(del by graphs) resource)
update-logs (~(del by update-logs) resource)
tag-queries
%- ~(run by tag-queries)
|= =resources:store
(~(del in resources) resource)
==
::
++ unarchive-graph
|= =resource:store
^- (quip card _state)
?> (~(has by archive) resource)
?< (~(has by graphs) resource)
:- (give [/updates /keys ~] [%unarchive-graph resource])
%_ state
archive (~(del by archive) resource)
graphs (~(put by graphs) resource (~(got by archive) resource))
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
==
::
++ run-updates
|= [=resource:store =update-log:store]
^- (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]
==
%+ roll (tap:orm graph)
|= [[=atom =node:store] out=?]
?& out
=(%& -:(mule |.((vale:dais [atom post.node]))))
?- -.children.node
%empty %.y
%graph ^$(graph p.children.node)
==
==
::
++ give
|= [paths=(list path) update=update-0:store]
^- (list card)
[%give %fact paths [%graph-update !>([%0 now.bowl update])]]~
--
--
::
++ on-peek
~/ %graph-store-peek
|= =path
^- (unit (unit cage))
|^
?> (team:title our.bowl src.bowl)
?+ path (on-peek:def path)
[%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 [~ ~]
:- ~ :- ~ :- %graph-update
!> ^- update:store
:+ %0
now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result]
::
:: 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]
::
[%x %graph-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ start=(unit atom) (rush i.t.t.t.t.path dem:ag)
=/ end=(unit atom) (rush i.t.t.t.t.t.path dem:ag)
=/ graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ 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.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)))
=/ node=(unit node:store) (get-node ship term index)
?~ 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)
=/ =term i.t.t.t.path
=/ start=(unit atom) (rush i.t.t.t.t.path dem:ag)
=/ end=(unit atom) (rush i.t.t.t.t.t.path dem:ag)
=/ =index:store
(turn t.t.t.t.t.t.path |=(=cord (slav %ud cord)))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
?- -.children.u.node
%empty [~ ~]
%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 start end))
|= [=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 [~ ~]
``noun+!>((subset:orm-log u.update-log start end))
::
[%x %update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
``noun+!>(u.update-log)
::
[%x %peek-update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ 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)
?~ result [~ ~]
``noun+!>([~ -.u.result])
==
::
++ get-node
|= [=ship =term =index:store]
^- (unit node:store)
=/ parent-graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ parent-graph ~
=/ node=(unit node:store) ~
=/ =graph:store p.u.parent-graph
|-
?~ index
node
?~ t.index
(get:orm graph i.index)
=. node (get:orm graph i.index)
?~ node ~
?- -.children.u.node
%empty ~
%graph $(graph p.children.u.node, index t.index)
==
--
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ -.sign-arvo (on-arvo:def wire sign-arvo)
%c
:_ 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]]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
::
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--

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,

21
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
@ -227,8 +229,11 @@
++ peek-group-join
|= [rid=resource =ship]
=/ =group
(~(gut by groups) rid *group)
=/ ugroup
(~(get by groups) rid)
?~ ugroup
%.n
=* group u.ugroup
=* policy policy.group
?- -.policy
%invite
@ -236,7 +241,7 @@
(~(has in members.group) ship)
==
%open
?! ?|
?! ?|
(~(has in banned.policy) ship)
(~(has in ban-ranks.policy) (clan:title ship))
==
@ -282,7 +287,7 @@
^- resource
?> ?=([@ @ *] path)
:- (slav %p i.path)
i.t.path
i.t.path
::
++ add-new
|= =permission:permission-store
@ -290,7 +295,7 @@
?: ?=(%black kind.permission)
[~ ~ [%open ~ who.permission] %.y]
[who.permission ~ [%invite ~] %.y]
::
::
++ update-existing
|= =permission:permission-store
|= =group

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

@ -2,22 +2,17 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$: %8
drum=state:drum
helm=state:helm
kiln=state:kiln
==
+$ state-7
$: %7
$: %10
drum=state:drum
helm=state:helm
kiln=state:kiln
==
+$ any-state
$% state
state-7
[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]
==
+$ any-state-tuple
$: drum=any-state:drum

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

@ -1,4 +1,6 @@
:: 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.

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

@ -1,3 +1,4 @@
:: invite-store [landscape]
/+ *invite-json, default-agent, dbug
|%
+$ card card:agent:gall

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 693 B

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 255 B

After

Width:  |  Height:  |  Size: 582 B

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

@ -4,11 +4,11 @@
<title>OS1</title>
<meta charset="utf-8" />
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<meta name="apple-mobile-web-app-capable" content="yes" />
<meta name="apple-touch-fullscreen" content="yes" />
<meta name="apple-mobile-web-app-status-bar-style" content="default" />
<link rel="apple-touch-icon" href="/~landscape/img/touch_icon.png">
content="width=device-width, initial-scale=1, shrink-to-fit=no,maximum-scale=1"/>
<meta name="apple-mobile-web-app-capable" content="yes" />
<meta name="apple-touch-fullscreen" content="yes" />
<meta name="apple-mobile-web-app-status-bar-style" content="default" />
<link rel="apple-touch-icon" href="/~landscape/img/touch_icon.png">
<link rel="icon" type="image/png" href="/~landscape/img/Favicon.png">
<link rel="manifest"
href='data:application/manifest+json,{
@ -20,10 +20,10 @@
"theme_color": "%23000000"}' />
</head>
<body>
<div id="root"/>
<div id="root"></div>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~landscape/js/index.js"></script>
<script src="/~landscape/js/bundle/index.9f00eb9b1c58d2b1bd3c.js"></script>
<script src="https://sdk.amazonaws.com/js/aws-sdk-2.1.12.min.js"></script>
</body>
</html>

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

@ -113,7 +113,7 @@
++ json-response
|= [eyre-id=@ta jon=json]
^- (list card)
(give-simple-payload:app eyre-id (json-response:gen (json-to-octs jon)))
(give-simple-payload:app eyre-id (json-response:gen jon))
::
++ give-rpc-notification
|= res=out:notification:lsp-sur

13
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
@ -77,7 +81,7 @@
:~ [%pass / %arvo %e %disconnect [~ /]]
:* %pass /srv %agent [our.bowl %file-server]
%poke %file-server-action
!>([%serve-dir / /app/landscape %.n])
!>([%serve-dir / /app/landscape %.n %.y])
==
==
%+ turn ~(tap by wex.bowl)
@ -161,8 +165,11 @@
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %keys ~] ``noun+!>(~(key by tiles))
?. (team:title our.bowl src.bowl) ~
?+ path [~ ~]
[%x %tiles ~] ``noun+!>([tiles tile-ordering])
[%x %first-time ~] ``noun+!>(first-time)
[%x %keys ~] ``noun+!>(~(key by tiles))
==
::
++ on-arvo

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

@ -136,7 +136,7 @@
::
:_ this
%+ give-simple-payload:app eyre-id.u.job.state
(json-response:gen (json-to-octs jon))
(json-response:gen jon)
::
++ take-sole-effect
|= fec=sole-effect
@ -186,7 +186,7 @@
%+ give-simple-payload:app eyre-id.u.job.state
?- -.u.out
%json
(json-response:gen (json-to-octs json.u.out))
(json-response:gen json.u.out)
::
%mime
=/ headers

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

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

@ -1,59 +1,11 @@
:: 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
::
|%
+$ state-any $%(state-1 state-0)
+$ state-1 [%1 cards=(list card)]
+$ state-0
$: %0
by-group=(map path links)
@ -76,414 +28,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 !<(state-any old)
?: ?=(%1 -.s)
[~ this(state s)]
:: 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]
::
=/ =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])
==
==
::
++ 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])
== ==
==
::
++ 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)

231
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
@ -25,161 +27,200 @@
/+ *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]
+$ versioned-state
$% state-zero
state-one
state-two
$% state-0
state-1
state-2
state-3
state-4
state-5
==
--
::
=| state-two
=| state-5
=* 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)
?: ?=(%5 -.old)
[cards this(state old)]
?: ?=(%4 -.old)
%_ $
-.old %5
::
group-indices.old
%- ~(gas ju *(jug group-path md-resource))
~(tap in ~(key by associations.old))
::
app-indices.old
%- ~(gas ju *(jug app-name [group-path app-path]))
%+ turn ~(tap in ~(key by associations.old))
|= [g=group-path r=md-resource]
^- [app-name [group-path app-path]]
[app-name.r [g app-path.r]]
::
resource-indices.old
%- ~(gas ju *(jug md-resource group-path))
%+ turn ~(tap in ~(key by associations.old))
|= [g=group-path r=md-resource]
^- [md-resource group-path]
[r g]
==
?: ?=(%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
%+ turn
~(tap in ~(key by group-indices.old))
%+ murn ~(tap in ~(key by group-indices.old))
|= =group-path
^- card
=/ rid=resource
(de-path:resource group-path)
?: =(our.bowl entity.rid)
(poke-md-hook %add-owned group-path)
(poke-md-hook %add-synced entity.rid group-path)
^- (unit card)
=/ 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)
::
++ 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
@ -201,11 +242,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]
@ -217,8 +259,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)
@ -232,8 +278,6 @@
[%give %fact ~ cage]~
--
::
++ on-leave on-leave:def
::
++ on-peek
|= =path
^- (unit (unit cage))
@ -251,11 +295,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=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
@ -267,20 +317,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)
@ -289,7 +336,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)
@ -307,7 +356,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)

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

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

@ -1,3 +1,7 @@
:: publish [landscape]
::
:: stores notebooks in clay, subscribes and allow subscriptions to notebooks
::
/- *publish
/- *group
/- group-hook
@ -54,6 +58,7 @@
[%3 state-three]
[%4 state-three]
[%5 state-three]
[%6 state-three]
==
::
+$ metadata-delta
@ -69,7 +74,7 @@
==
--
::
=| [%5 state-three]
=| [%6 state-three]
=* state -
%- agent:dbug
%+ verb |
@ -86,7 +91,6 @@
:_ this
:~ [%pass /view-bind %arvo %e %connect [~ /'publish-view'] %publish]
[%pass /read/paths %arvo %c %warp our.bol q.byk.bol `rav]
[%pass /permissions %agent [our.bol %permission-store] %watch /updates]
(invite-poke:main [%create /publish])
:* %pass /invites %agent [our.bol %invite-store] %watch
/invitatory/publish
@ -96,7 +100,7 @@
==
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~publish' /app/landscape %.n])
!>([%serve-dir /'~publish' /app/landscape %.n %.y])
==
[%pass /groups %agent [our.bol %group-store] %watch /groups]
==
@ -126,7 +130,7 @@
[%pass /view-bind %arvo %e %connect [~ /'publish-view'] %publish]
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~publish' /app/landscape %.n])
!>([%serve-dir /'~publish' /app/landscape %.n %.y])
==
==
=+ ^- [kick-cards=(list card) old-subs=(jug @tas @p)] kick-subs
@ -197,7 +201,7 @@
[%pass /view-bind %arvo %e %connect [~ /'publish-view'] %publish]
:* %pass /srving %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~publish' /app/landscape %.n])
!>([%serve-dir /'~publish' /app/landscape %.n %.y])
== ==
==
::
@ -218,6 +222,26 @@
==
::
%5
%= $
-.p.old-state %6
cards
%+ weld cards
%+ roll ~(tap by books.p.old-state)
|= [[[who=@p book=@tas] nb=notebook] out=(list card)]
^- (list card)
?. =(who our.bol)
out
=/ rid (de-path:resource writers.nb)
=/ grp=(unit group) (scry-group:grup:main rid)
?~ grp out
?: hidden.u.grp
out
=/ =tag [%publish (cat 3 'writers-' book)]
:_ out
(group-proxy-poke entity.rid %add-tag rid tag members.u.grp)
==
::
%6
[cards this(state p.old-state)]
==
++ convert-notebook-3-4
@ -995,6 +1019,22 @@
[~ state]
:_ state
%- zing
:- ^- (list card)
%+ roll ~(tap by books)
|= [[[who=@p book=@tas] nb=notebook] out=(list card)]
^- (list card)
?. =(who our.bol)
out
?. =(writers.nb path)
out
=/ rid (de-path:resource writers.nb)
=/ grp=(unit group) (scry-group:grup rid)
?~ grp out
?: hidden.u.grp
out
=/ =tag [%publish (cat 3 'writers-' book)]
:_ out
(group-proxy-poke entity.rid %add-tag rid tag members.u.grp)
%+ turn ~(tap in ships)
|= who=@p
?. (allowed who %read u.book)
@ -1226,12 +1266,19 @@
^- [(list card) write=path read=path]
?> ?=(^ group-path.group)
=/ scry-path
;:(welp /(scot %p our.bol)/group-store/(scot %da now.bol) [%groups group-path.group] /noun)
=/ grp .^((unit ^group) %gx scry-path)
;: welp
/(scot %p our.bol)/group-store/(scot %da now.bol)
[%groups group-path.group]
/noun
==
=/ rid=resource (de-path:resource group-path.group)
=/ grp=(unit ^group) (scry-group:grup rid)
?: use-preexisting.group
?~ grp !!
?. (is-managed group-path.group) !!
`[group-path.group group-path.group]
=/ =tag [%publish (cat 3 'writers-' book)]
:_ [group-path.group group-path.group]
[(group-proxy-poke entity.rid %add-tag rid tag members.u.grp)]~
::
=/ =policy
*open:policy
@ -1684,10 +1731,9 @@
?> ?=(^ subscribers.u.book)
=/ cards=(list card)
~[(delete-dir pax)]
=/ rid=resource
(de-path:resource writers.u.book)
=? cards (is-managed:grup rid)
=? cards !(is-managed:grup rid)
[(group-poke %remove-group rid ~) cards]
[cards state]
:: %del-note:
@ -1789,8 +1835,14 @@
::
%subscribe
?> (team:title our.bol src.bol)
?: =(our.bol who.act)
[~ state]
=/ join-wire=wire
/join-group/[(scot %p who.act)]/[book.act]
=/ meta=(unit (set path))
(metadata-resource-scry %publish /(scot %p who.act)/[book.act])
?^ meta
(subscribe-notebook who.act book.act)
=/ rid=resource
[who.act book.act]
=/ =cage
@ -1811,12 +1863,16 @@
(de-path:resource writers.book)
=/ =group
(need (scry-group:grup rid))
:_ state(books (~(del by books) who.act book.act))
:~ `card`[%pass wir %agent [who.act %publish] %leave ~]
`card`[%give %fact [/primary]~ %publish-primary-delta !>(del)]
(group-proxy-poke who.act %remove-members rid (sy our.bol ~))
(group-poke %remove-group rid ~)
==
=/ cards=(list card)
:~ [%pass wir %agent [who.act %publish] %leave ~]
[%give %fact [/primary]~ %publish-primary-delta !>(del)]
==
=? cards hidden.group
%+ weld cards
:~ (group-proxy-poke who.act %remove-members rid (sy our.bol ~))
(group-poke %remove-group rid ~)
==
[cards state(books (~(del by books) who.act book.act))]
:: %read
::
%read
@ -1952,6 +2008,19 @@
/noun
==
::
++ metadata-resource-scry
|= [app=@tas app-path=path]
^- (unit (set path))
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~) ~
.^ (unit (set path))
%gx
;: weld
/(scot %p our.bol)/metadata-store/(scot %da now.bol)/resource/[app]
app-path
/noun
==
==
::
++ emit-metadata
|= del=metadata-delta
^- (list card)
@ -2044,9 +2113,11 @@
(emit-updates-and-state host.del book.del data.del del sty)
=/ rid=resource
(de-path:resource writers.data.del)
=? cards !=(our.bol entity.rid)
:_ cards
(group-pull-hook-poke [%add host.del rid])
:_ state
:* (group-pull-hook-poke [%add host.del rid])
(metadata-hook-poke [%add-synced host.del writers.data.del])
:* (metadata-hook-poke [%add-synced host.del writers.data.del])
cards
==
::
@ -2280,7 +2351,6 @@
:: all notebooks, short form
[[[~ %json] [%'publish-view' %notebooks ~]] ~]
%- json-response:gen
%- json-to-octs
(notebooks-map:enjs our.bol books)
::
:: notes pagination
@ -2299,7 +2369,6 @@
?~ length
not-found:gen
%- json-response:gen
%- json-to-octs
:- %o
(notes-page:enjs notes.u.book u.start u.length)
::
@ -2323,7 +2392,6 @@
?~ length
not-found:gen
%- json-response:gen
%- json-to-octs
(comments-page:enjs comments.u.note u.start u.length)
::
:: single notebook with initial 50 notes in short form, as json
@ -2342,7 +2410,7 @@
(~(put by p.notebook-json) %subscribers (get-subscribers-json book-name))
=. p.notebook-json
(~(put by p.notebook-json) %writers (get-writers-json u.host book-name))
(json-response:gen (json-to-octs (pairs notebook+notebook-json ~)))
(json-response:gen (pairs notebook+notebook-json ~))
::
:: single note, with initial 50 comments, as json
[[[~ %json] [%'publish-view' @ @ @ ~]] ~]
@ -2357,7 +2425,7 @@
?~ note not-found:gen
=/ jon=json
o+(note-presentation:enjs u.book note-name u.note)
(json-response:gen (json-to-octs jon))
(json-response:gen jon)
==
::
--

17
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 ~
@ -89,7 +93,18 @@
--
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-peek
~/ %s3-peek
|= =path
^- (unit (unit cage))
?. (team:title our.bowl src.bowl) ~
?+ path [~ ~]
[%x %credentials ~]
[~ ~ %s3-update !>(`update`[%credentials credentials])]
::
[%x %configuration ~]
[~ ~ %s3-update !>(`update`[%configuration configuration])]
==
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def

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

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

@ -1,5 +1,6 @@
::
:: Soto: A Dojo relay for Urbit's Landscape interface
:: soto [landscape]: A Dojo relay for Urbit's Landscape interface
::
:: Relays sole-effects to subscribers and forwards sole-action pokes
::
/- sole
@ -29,7 +30,7 @@
:_ ~
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~dojo' /app/landscape %.n])
!>([%serve-dir /'~dojo' /app/landscape %.n %.y])
==
++ on-save !>(state)
::
@ -43,7 +44,7 @@
:~ [%pass /bind/soto %arvo %e %disconnect [~ /'~dojo']]
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~dojo' /app/landscape %.n])
!>([%serve-dir /'~dojo' /app/landscape %.n %.y])
==
==
::

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

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

10
pkg/arvo/gen/graph-store/add-graph.hoon Normal file
View File

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

20
pkg/arvo/gen/graph-store/add-post.hoon Normal file
View File

@ -0,0 +1,20 @@
:: graph-store|add-post: add post to a graph
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[[our=ship name=term] contents=(list content) ~] ~]
==
=/ =post *post
=: author.post our
index.post [now]~
time-sent.post now
contents.post contents
==
::
:- %graph-update
^- update
:+ %0 now
:+ %add-nodes [our name]
%- ~(gas by *(map index node))
~[[[now]~ [post [%empty ~]]]]

10
pkg/arvo/gen/graph-store/add-signatures.hoon Normal file
View File

@ -0,0 +1,10 @@
:: graph-store|add-signatures: add signatures to a node at a particular uid
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[[=resource =index] =signatures ~] ~]
==
:- %graph-update
^- update
[%0 now [%add-signatures [resource index] signatures]]

10
pkg/arvo/gen/graph-store/add-tag.hoon Normal file
View File

@ -0,0 +1,10 @@
:: graph-store|add-tag: tag a particular graph
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~]
==
:- %graph-update
^- update
[%0 now [%add-tag term resource]]

10
pkg/arvo/gen/graph-store/archive-graph.hoon Normal file
View File

@ -0,0 +1,10 @@
:: graph-store|archive-graph: archive graph
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
^- update
[%0 now [%archive-graph resource]]

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)

10
pkg/arvo/gen/graph-store/remove-graph.hoon Normal file
View File

@ -0,0 +1,10 @@
:: graph-store|remove-graph: remove graph
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
^- update
[%0 now [%remove-graph resource]]

10
pkg/arvo/gen/graph-store/remove-nodes.hoon Normal file
View File

@ -0,0 +1,10 @@
:: graph-store|remove-nodes: remove nodes from a graph at indices
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=resource indices=(set index) ~] ~]
==
:- %graph-update
^- update
[%0 now [%remove-nodes resource indices]]

11
pkg/arvo/gen/graph-store/remove-signatures.hoon Normal file
View File

@ -0,0 +1,11 @@
:: graph-store|remove-signatures: remove signatures from a node at a
:: particular uid
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[[=resource =index] =signatures ~] ~]
==
:- %graph-update
^- update
[%0 now [%remove-signatures [resource index] signatures]]

10
pkg/arvo/gen/graph-store/remove-tag.hoon Normal file
View File

@ -0,0 +1,10 @@
:: graph-store|remove-tag: remove a tag from a particular graph
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~]
==
:- %graph-update
^- update
[%0 now [%remove-tag term resource]]

10
pkg/arvo/gen/graph-store/unarchive-graph.hoon Normal file
View File

@ -0,0 +1,10 @@
:: graph-store|unarchive-graph: unarchive graph
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~]
==
:- %graph-update
^- update
[%0 now [%unarchive-graph resource]]

2
pkg/arvo/gen/hood/moon-cycle-keys.hoon
View File

@ -36,7 +36,7 @@
public-key
=/ cub (pit:nu:crub:crypto 512 (shaz (jam mon life eny)))
=/ =seed:able:jael
[mon 1 sec:ex:cub ~]
[mon life sec:ex:cub ~]
%- %- slog
:~ leaf+"moon: {(scow %p mon)}"
leaf+(scow %uw (jam seed))

8
pkg/arvo/gen/hood/ota.hoon
View File

@ -8,7 +8,11 @@
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=?(~ [her=@p sud=@tas ~]) ~]
[arg=?(~ [%disable ~] [her=@p sud=@tas ~]) ~]
==
?~ arg
:- %kiln-ota-info ~
:- %kiln-ota
?~(arg ~ `[her sud]:arg)
?: ?=([%disable ~] arg)
~
`[her sud]:arg

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

@ -5,5 +5,5 @@
[%tang >timers< ~]
.^ (list [date=@da =duct])
%bx
(en-beam:format [p.bec %$ r.bec] /debug/timers)
(en-beam:format [p.bec %$ r.bec] /timers/debug)
==

57
pkg/arvo/lib/chat-store.hoon
View File

@ -61,8 +61,9 @@
^- json
%+ frond %chat-update
%- pairs
:~
?: ?=(%initial -.upd)
:_ ~
?- -.upd
%initial
:- %initial
%- pairs
%+ turn ~(tap by inbox.upd)
@ -73,27 +74,37 @@
:~ [%envelopes [%a (turn envelopes.mailbox envelope)]]
[%config (config config.mailbox)]
==
?: ?=(%message -.upd)
:- %message
%- pairs
:~ [%path (path path.upd)]
[%envelope (envelope envelope.upd)]
==
?: ?=(%messages -.upd)
:- %messages
%- pairs
:~ [%path (path path.upd)]
[%start (numb start.upd)]
[%end (numb end.upd)]
[%envelopes [%a (turn envelopes.upd envelope)]]
==
?: ?=(%read -.upd)
[%read (pairs [%path (path path.upd)]~)]
?: ?=(%create -.upd)
[%create (pairs [%path (path path.upd)]~)]
?: ?=(%delete -.upd)
[%delete (pairs [%path (path path.upd)]~)]
[*@t *json]
::
%message
:- %message
%- pairs
:~ [%path (path path.upd)]
[%envelope (envelope envelope.upd)]
==
::
%messages
:- %messages
%- pairs
:~ [%path (path path.upd)]
[%start (numb start.upd)]
[%end (numb end.upd)]
[%envelopes [%a (turn envelopes.upd envelope)]]
==
::
%read
[%read (pairs [%path (path path.upd)]~)]
::
%create
[%create (pairs [%path (path path.upd)]~)]
::
%delete
[%delete (pairs [%path (path path.upd)]~)]
::
%keys
:- %keys
:- %a
%+ turn ~(tap by keys.upd)
|= pax=^path (path pax)
==
--
++ dejs

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

415
pkg/arvo/lib/graph-store.hoon Normal file
View File

@ -0,0 +1,415 @@
/- sur=graph-store, pos=post
/+ res=resource
=< [sur .]
=< [pos .]
=, sur
=, pos
|%
:: NOTE: move these functions to zuse
++ nu :: parse number as hex
|= jon/json
?> ?=({$s *} jon)
(rash p.jon hex)
::
++ re :: recursive reparsers
|* {gar/* sef/_|.(fist:dejs-soft:format)}
|= jon/json
^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ dank :: tank
^- $-(json (unit tank))
=, ^? dejs-soft:format
%+ re *tank |. ~+
%- of :~
leaf+sa
palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~)
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
::
++ orm ((ordered-map atom node) gth)
++ orm-log ((ordered-map time logged-update) gth)
::
++ enjs
=, enjs:format
|%
++ update
|= upd=^update
^- json
?> ?=(%0 -.upd)
|^ (frond %graph-update (pairs ~[(encode q.upd)]))
::
++ encode
|= upd=update-0
^- [cord json]
?- -.upd
%add-graph
:- %add-graph
%- pairs
:~ [%resource (enjs:res resource.upd)]
[%graph (graph graph.upd)]
[%mark ?~(mark.upd ~ s+u.mark.upd)]
==
::
%remove-graph
[%remove-graph (enjs:res resource.upd)]
::
%add-nodes
:- %add-nodes
%- pairs
:~ [%resource (enjs:res resource.upd)]
[%nodes (nodes nodes.upd)]
==
::
%remove-nodes
:- %remove-nodes
%- pairs
:~ [%resource (enjs:res resource.upd)]
[%indices (indices indices.upd)]
==
::
%add-signatures
:- %add-signatures
%- pairs
:~ [%uid (uid uid.upd)]
[%signatures (signatures signatures.upd)]
==
::
%remove-signatures
:- %remove-signatures
%- pairs
:~ [%uid (uid uid.upd)]
[%signatures (signatures signatures.upd)]
==
::
%add-tag
:- %add-tag
%- pairs
:~ [%term s+term.upd]
[%resource (enjs:res resource.upd)]
==
::
%remove-tag
:- %remove-tag
%- pairs
:~ [%term s+term.upd]
[%resource (enjs:res resource.upd)]
==
::
%archive-graph
[%archive-graph (enjs:res resource.upd)]
::
%unarchive-graph
[%unarchive-graph (enjs:res resource.upd)]
::
%keys
[%keys [%a (turn ~(tap in resources.upd) enjs:res)]]
::
%tags
[%tags [%a (turn ~(tap in tags.upd) |=(=term s+term))]]
::
%run-updates
[%run-updates ~]
::
%tag-queries
:- %tag-queries
%- pairs
%+ turn ~(tap by tag-queries.upd)
|= [=term =resources]
^- [cord json]
[term [%a (turn ~(tap in resources) enjs:res)]]
==
::
++ graph
|= g=^graph
^- json
:- %a
%+ turn (tap:orm g)
|= [a=atom n=^node]
^- json
:- %a
:~ (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
%- pairs
:~ [%post (post post.n)]
:- %children
?- -.children.n
%empty ~
%graph (graph +.children.n)
==
==
::
++ 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
:- %a
%+ turn ~(tap by m)
|= [n=^index o=^node]
^- json
:- %a
:~ (index n)
(node o)
==
::
++ indices
|= i=(set ^index)
^- 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)]
==
--
--
::
++ dejs
=, dejs:format
|%
++ update
|= jon=json
^- ^update
:- %0
:- *time
^- update-0
=< (decode jon)
|%
++ decode
%- of
:~ [%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]
==
::
++ add-graph
%- ot
:~ [%resource dejs:res]
[%graph graph]
[%mark (mu so)]
==
::
++ graph
|= a=json
^- ^graph
=/ or-mp ((ordered-map atom ^node) gth)
%+ gas:or-mp ~
%+ turn ~(tap by ((om node) a))
|* [b=cord c=*]
^- [atom ^node]
=> .(+< [b c]=+<)
[(rash b dem) c]
::
++ remove-graph (ot [%resource dejs:res]~)
++ archive-graph (ot [%resource dejs:res]~)
++ unarchive-graph (ot [%resource dejs:res]~)
::
++ add-nodes
%- ot
:~ [%resource dejs:res]
[%nodes nodes]
==
::
++ nodes (op ;~(pfix net (more net dem)) node)
::
++ node
%- ot
:~ [%post post]
:: TODO: support adding nodes with children by supporting the
:: graph key
[%children (of [%empty ul]~)]
==
::
++ post
%- ot
:~ [%author (su ;~(pfix sig fed:ag))]
[%index index]
[%time-sent di]
[%contents (ar content)]
[%hash (mu nu)]
[%signatures (as signature)]
==
::
++ content
%- of
:~ [%text so]
[%url so]
[%reference uid]
[%code eval]
==
::
++ eval
|= a=^json
^- [cord (list tank)]
=, ^? dejs-soft:format
=+ exp=((ot expression+so ~) a)
%- need
?~ exp [~ '' ~]
:+ ~ u.exp
:: NOTE: when sending, if output is an empty list,
:: graph-store will evaluate
(fall ((ot output+(ar dank) ~) a) ~)
::
++ remove-nodes
%- ot
:~ [%resource dejs:res]
[%indices (as index)]
==
::
++ add-signatures
%- ot
:~ [%uid uid]
[%signatures (as signature)]
==
::
++ remove-signatures
%- ot
:~ [%uid uid]
[%signatures (as signature)]
==
::
++ signature
%- ot
:~ [%hash nu]
[%ship (su ;~(pfix sig fed:ag))]
[%life ni]
==
::
++ uid
%- ot
:~ [%resource dejs:res]
[%index index]
==
::
++ index (su ;~(pfix net (more net dem)))
::
++ add-tag
%- ot
:~ [%term so]
[%resource dejs:res]
==
::
++ remove-tag
%- ot
:~ [%term so]
[%resource dejs:res]
==
::
++ keys
|= =json
*resources
::
++ tags
|= =json
*(set term)
::
++ tag-queries
|= =json
*^tag-queries
::
++ run-updates
|= a=json
^- [resource update-log]
[*resource *update-log]
--
--
::
++ create
|_ [our=ship now=time]
++ post
|= [=index contents=(list content)]
^- ^post
:* our
index
now
contents
~
*signatures
==
--
--

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

36
pkg/arvo/lib/graph.hoon Normal file
View File

@ -0,0 +1,36 @@
/- *resource
/+ store=graph-store
|_ =bowl:gall
++ scry-for
|* [=mold =path]
.^ mold
%gx
(scot %p our.bowl)
%graph-store
(scot %da now.bowl)
(snoc `^path`path %noun)
==
::
++ get-graph
|= res=resource
^- update:store
%+ scry-for update:store
/graph/(scot %p entity.res)/[name.res]
::
++ 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)/'~'
--

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

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

@ -104,6 +104,9 @@
%s3-store
%file-server
%glob
%graph-store
%graph-pull-hook
%graph-push-hook
==
::
++ deft-fish :: default connects
@ -206,7 +209,7 @@
==
::
++ on-load
|= [hood-version=?(%1 %2 %3 %4 %5 %6 %7 %8) old=any-state]
|= [hood-version=?(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10) old=any-state]
=< se-abet =< se-view
=. sat old
=. dev (~(gut by bin) ost *source)
@ -233,6 +236,11 @@
=? ..on-load (lte hood-version %8)
=> (se-born | %home %group-push-hook)
(se-born | %home %group-pull-hook)
=? ..on-load (lte hood-version %9)
(se-born | %home %graph-store)
=? ..on-load (lte hood-version %10)
=> (se-born | %home %graph-push-hook)
(se-born | %home %graph-pull-hook)
..on-load
::
++ reap-phat :: ack connect

20
pkg/arvo/lib/hood/kiln.hoon
View File

@ -208,7 +208,7 @@
::
++ get-germ
|= =desk
=+ .^(=cass:clay %cw /(scot %p our)/home/(scot %da now))
=+ .^(=cass:clay %cw /(scot %p our)/[desk]/(scot %da now))
?- ud.cass
%0 %init
%1 %that
@ -341,13 +341,22 @@
abet:(spam (render "already syncing" [sud her syd]:hos) ~)
abet:abet:start-sync:(auto hos)
::
++ ota-info
?~ ota
"OTAs disabled"
"OTAs enabled from {<desk.u.ota>} on {<ship.u.ota>}"
::
++ poke-ota-info
|= *
=< abet %- spam
:~ [%leaf ota-info]
[%leaf "use |ota %disable or |ota ~sponsor %kids to reset it"]
==
::
++ poke-syncs :: print sync config
|= ~
=< abet %- spam
:- :- %leaf
?~ ota
"OTAs disabled"
"OTAs from {<desk.u.ota>} on {<ship.u.ota>}"
:- [%leaf ota-info]
?: =(0 ~(wyt by syn))
[%leaf "no other syncs configured"]~
%+ turn ~(tap in ~(key by syn))
@ -416,6 +425,7 @@
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-ota =;(f (f !<(_+<.f vase)) poke:update)
%kiln-ota-info =;(f (f !<(_+<.f vase)) poke-ota-info)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)

4
pkg/arvo/lib/metadata-json.hoon
View File

@ -58,6 +58,7 @@
[%color nu]
[%date-created (se %da)]
[%creator (su ;~(pfix sig fed:ag))]
[%module so]
==
++ md-resource
%- ot
@ -76,12 +77,13 @@
[%color s+(scot %ux color.met)]
[%date-created s+(scot %da date-created.met)]
[%creator s+(scot %p creator.met)]
[%module s+module.met]
==
::
++ update-to-json
|= upd=metadata-update
=, enjs:format
^- json
=, enjs:format
%+ frond %metadata-update
%- pairs
:~ ?- -.upd

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

@ -1,3 +1,23 @@
:: lib/pull-hook: helper for creating a push hook
::
:: lib/pull-hook is a helper for automatically pulling data from a
:: corresponding push-hook to a store.
::
:: ## Interfacing notes:
::
:: The inner door may interact with the library by producing cards.
:: Do not pass any cards on a wire beginning with /helper as these
:: wires are reserved by this library. Any watches/pokes/peeks not
:: listed below will be routed to the inner door.
::
:: ## Subscription paths
::
:: /tracking: The set of resources we are pulling
::
:: ## Pokes
::
:: %pull-hook-action: Add/remove a resource from pulling.
::
/- *pull-hook
/+ default-agent, resource
::
@ -5,12 +25,24 @@
|%
+$ card card:agent:gall
::
:: $config: configuration for the pull hook
::
:: .store-name: name of the store to send subscription updates to.
:: .update-mark: mark that updates will be tagged with
:: .push-hook-name: name of the corresponding push-hook
::
+$ config
$: store-name=term
update=mold
update-mark=term
push-hook-name=term
==
::
:: $state-0: state for the pull hook
::
:: .tracking: a map of resources we are pulling, and the ships that
:: we are pulling them from.
:: .inner-state: state given to internal door
::
+$ state-0
$: %0
@ -37,7 +69,29 @@
|* config
$_ ^|
|_ bowl:gall
:: +on-pull-nack: handle failed pull subscription
::
:: This arm is called when a pull subscription fails. lib/pull-hook
:: will automatically delete the resource from .tracking by the
:: time this arm is called.
::
++ on-pull-nack
|~ [resource tang]
*[(list card) _^|(..on-init)]
:: +on-pull-kick: produce any additional resubscribe path
::
:: If non-null, the produced path is appended to the original
:: subscription path. This should be used to encode extra
:: information onto the path in order to reduce the payload of a
:: kick and resubscribe.
::
:: If null, a resubscribe is not attempted
::
++ on-pull-kick
|~ resource
*(unit path)
::
:: from agent:gall
++ on-init
*[(list card) _^|(..on-init)]
::
@ -75,26 +129,6 @@
++ on-fail
|~ [term tang]
*[(list card) _^|(..on-init)]
:: +on-pull-nack: handle failed pull subscription
::
:: This arm is called when a pull subscription fails.
::
++ on-pull-nack
|~ [resource tang]
*[(list card) _^|(..on-init)]
:: +on-pull-kick: produce any additional resubscribe path
::
:: If non-null, the produced path is appended to the original
:: subscription path. This should be used to encode extra
:: information onto the path in order to reduce the payload of a
:: kick and resubscribe.
::
:: If null, a resubscribe is not attempted
::
++ on-pull-kick
|~ resource
*(unit path)
:: ::
--
++ agent
|* =config
@ -209,7 +243,10 @@
=^ cards pull-hook
(on-fail:og term tang)
[cards this]
++ on-peek on-peek:def
++ on-peek
|= =path
^- (unit (unit cage))
(on-peek:og path)
--
|_ =bowl:gall
+* og ~(. pull-hook bowl)
@ -225,7 +262,9 @@
++ add
|= [=ship =resource]
~| resource
?< (~(has by tracking) resource)
?< |(=(our.bowl ship) =(our.bowl entity.resource))
?: (~(has by tracking) resource)
[~ state]
=. tracking
(~(put by tracking) resource ship)
:_ state

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

@ -1,8 +1,42 @@
:: lib/push-hook: helper for creating a push hook
::
:: lib/push-hook is a helper for automatically pushing data from a
:: local store to the corresponding pull-hook on remote ships. It also
:: proxies remote pokes to the store.
::
:: ## Interfacing notes:
::
:: The inner door may interact with the library by producing cards.
:: Do not pass any cards on a wire beginning with /helper as these
:: wires are reserved by this library. Any watches/pokes/peeks not
:: listed below will be routed to the inner door.
::
:: ## Subscription paths
::
:: /resource/[resource]: Receive initial state and updates to
:: .resource. .resource should be encoded with en-path:resource from
:: /lib/resource. Facts on this path will be of mark
:: update-mark.config
::
:: ## Pokes
::
:: %push-hook-action: Add/remove a resource from pushing.
:: [update-mark.config]: A poke to proxy to the local store or a
:: foreign push-hook
::
/- *push-hook
/+ default-agent, resource
/+ default-agent, resource, verb
|%
+$ card card:agent:gall
::
:: $config: configuration for the push hook
::
:: .store-name: name of the store to proxy pokes and
:: subscriptions to
:: .store-path: subscription path to receive updates on
:: .update-mark: mark that updates will be tagged with
:: .pull-hook-name: name of the corresponding pull-hook
::
+$ config
$: store-name=term
store-path=path
@ -10,6 +44,12 @@
update-mark=term
pull-hook-name=term
==
::
:: $state-0: state for the push hook
::
:: .sharing: resources that the push hook is proxying
:: .inner-state: state given to internal door
::
+$ state-0
$: %0
sharing=(set resource)
@ -21,6 +61,48 @@
$_ ^|
|_ bowl:gall
::
:: +resource-for-update: get affected resource from an update
::
:: Given a vase of the update, the mark of which is
:: update-mark.config, produce the affected resource, if any.
::
++ resource-for-update
|~ vase
*(unit resource)
::
:: +take-update: handle update from store
::
:: Given an update from the store, do other things after proxying
:: the update
::
++ take-update
|~ vase
*[(list card) _^|(..on-init)]
:: +should-proxy-update: should forward update to store
::
:: If %.y is produced, then the update is forwarded to the local
:: store. If %.n is produced then the update is not forwarded and
:: the poke fails.
::
++ should-proxy-update
|~ vase
*?
:: +initial-watch: produce initial state for a subscription
::
:: .resource is the resource being subscribed to.
:: .path is any additional information in the subscription wire.
:: This would typically be used to encode state that the subscriber
:: already has. For example, a chat client might encode
:: the number of messages that it already has, or the date it last
:: received an update.
::
:: If +initial-watch crashes, the subscription fails.
::
++ initial-watch
|~ [path resource]
*vase
:: from agent:gall
::
++ on-init
*[(list card) _^|(..on-init)]
::
@ -58,36 +140,6 @@
++ on-fail
|~ [term tang]
*[(list card) _^|(..on-init)]
:: +resource-for-update: get affected resource from an update
++ resource-for-update
|~ vase
*(unit resource)
::
:: +on-update: handle update from store
::
:: Do extra stuff on store update
++ take-update
|~ vase
*[(list card) _^|(..on-init)]
:: +should-proxy-update: should forward update to store
::
:: If %.y is produced, then the update is forwarded to the local
:: store. If %.n is produced then the update is not forwarded and
:: the poke fails.
::
++ should-proxy-update
|~ vase
*?
:: +initial-watch: produce initial state for a subscription
::
:: .resource is the resource being subscribed to.
:: .path is any additional information in the subscription wire
::
++ initial-watch
|~ [path resource]
*vase
::
--
++ agent
|* =config
@ -131,6 +183,9 @@
[cards this]
::
?: =(mark update-mark.config)
?: (team:title [our src]:bowl)
:_ this
(forward-update:hc vase)
=^ cards state
(poke-update:hc vase)
[cards this]
@ -150,7 +205,7 @@
=/ =resource
(de-path:resource t.path)
=/ =vase
(initial-watch:og t.t.t.path resource)
(initial-watch:og t.t.t.t.path resource)
:_ this
[%give %fact ~ update-mark.config vase]~
::
@ -282,5 +337,19 @@
=/ =path
resource+(en-path:resource u.rid)
[%give %fact ~[path] update-mark.config vase]~
::
++ forward-update
|= =vase
^- (list card:agent:gall)
=/ rid=(unit resource)
(resource-for-update:og vase)
?~ rid ~
=/ =path
resource+(en-path:resource u.rid)
=/ =wire
(make-wire resource+(en-path:resource u.rid))
=/ dap=term
?:(=(our.bowl entity.u.rid) store-name.config dap.bowl)
[%pass wire %agent [entity.u.rid dap] %poke update-mark.config vase]~
--
--

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

@ -80,9 +80,11 @@
++ max-1-wk ['cache-control' 'max-age=604800']
::
++ html-response
=| cache=?
|= =octs
^- simple-payload:http
[[200 [['content-type' 'text/html'] max-1-wk ~]] `octs]
:_ `octs
[200 [['content-type' 'text/html'] ?:(cache [max-1-wk ~] ~)]]
::
++ js-response
|= =octs
@ -90,9 +92,9 @@
[[200 [['content-type' 'text/javascript'] max-1-da ~]] `octs]
::
++ json-response
|= =octs
|= =json
^- simple-payload:http
[[200 ['content-type' 'application/json']~] `octs]
[[200 ['content-type' 'application/json']~] `(json-to-octs json)]
::
++ css-response
|= =octs

189
pkg/arvo/lib/shoe.hoon
View File

@ -26,8 +26,15 @@
:: $shoe-effect: easier sole-effects
::
+$ shoe-effect
$% [%sole effect=sole-effect]
::TODO complex screen-draw effects
$% :: %sole: raw sole-effect
::
[%sole effect=sole-effect]
:: %table: sortable, filterable data, with suggested column char widths
::
[%table head=(list dime) wide=(list @ud) rows=(list (list dime))]
:: %row: line sections with suggested char widths
::
[%row wide=(list @ud) cols=(list dime)]
==
:: +shoe: gall agent core with extra arms
::
@ -159,6 +166,17 @@
~(tap in ~(key by soles))
|= sole-id=@ta
/sole/[sole-id]
::
%table
=; fez=(list sole-effect)
$(effect.card [%sole %mor fez])
=, +.effect.card
:- (row:draw & wide head)
%+ turn rows
(cury (cury row:draw |) wide)
::
%row
$(effect.card [%sole (row:draw | +.effect.card)])
==
--
::
@ -225,7 +243,7 @@
%+ rose (tufa buf.cli-state)
(command-parser:og sole-id)
?: ?=(%& -.res)
?. &(?=(^ p.res) run.u.p.res)
?. &(?=(^ p.res) run.u.p.res)
[[~ cli-state] shoe]
(run-command cmd.u.p.res)
:_ shoe
@ -325,7 +343,11 @@
=^ cards shoe (on-leave:og path)
[(deal cards) this]
::
++ on-peek on-peek:og
++ on-peek
|= =path
^- (unit (unit cage))
?. =(/x/dbug/state path) ~
``noun+(slop on-save:og !>(shoe=state))
::
++ on-agent
|= [=wire =sign:agent:gall]
@ -345,4 +367,163 @@
=^ cards shoe (on-fail:og term tang)
[(deal cards) this]
--
::
++ draw
|%
++ row
|= [bold=? wide=(list @ud) cols=(list dime)]
^- sole-effect
:- %mor
^- (list sole-effect)
=/ cows=(list [wid=@ud col=dime])
%- head
%^ spin cols wide
|= [col=dime wiz=(list @ud)]
~| [%too-few-wide col]
?> ?=(^ wiz)
[[i.wiz col] t.wiz]
=/ cobs=(list [wid=@ud (list tape)])
(turn cows col-as-lines)
=+ [lin=0 any=|]
=| fez=(list sole-effect)
|- ^+ fez
=; out=tape
:: done when we're past the end of all columns
::
?: (levy out (cury test ' '))
(flop fez)
=; fec=sole-effect
$(lin +(lin), fez [fec fez])
?. bold txt+out
klr+[[`%br ~ ~]^[(crip out)]~]~
%+ roll cobs
|= [[wid=@ud lines=(list tape)] out=tape]
%+ weld out
%+ weld ?~(out "" " ")
=+ l=(swag [lin 1] lines)
?^(l i.l (reap wid ' '))
::
++ col-as-lines
|= [wid=@ud col=dime]
^- [@ud (list tape)]
:- wid
%+ turn
(break wid (col-as-text col) (break-sets -.col))
(cury (cury pad wid) (alignment -.col))
::
++ col-as-text
|= col=dime
^- tape
?+ p.col (scow col)
%t (trip q.col)
%tas ['%' (scow col)]
==
::
++ alignment
|= wut=@ta
^- ?(%left %right)
?: ?=(?(%t %ta %tas %da) wut)
%left
%right
::
++ break-sets
|= wut=@ta
:: for: may break directly before these characters
:: aft: may break directly after these characters
:: new: always break on these characters, consuming them
::
^- [for=(set @t) aft=(set @t) new=(set @t)]
?+ wut [(sy " ") (sy ".:-/") (sy "\0a")]
?(%p %q) [(sy "-") (sy "-") ~]
%ux [(sy ".") ~ ~]
==
::
++ break
|= [wid=@ud cot=tape brs=_*break-sets]
^- (list tape)
~| [wid cot]
?: =("" cot) ~
=; [lin=tape rem=tape]
[lin $(cot rem)]
:: take snip of max width+1, search for breakpoint on that.
:: we grab one char extra, to look-ahead for for.brs.
:: later on, we always transfer _at least_ the extra char.
::
=^ lin=tape cot
[(scag +(wid) cot) (slag +(wid) cot)]
=+ len=(lent lin)
:: find the first newline character
::
=/ new=(unit @ud)
=+ new=~(tap in new.brs)
=| las=(unit @ud)
|-
?~ new las
$(new t.new, las (hunt lth las (find [i.new]~ lin)))
:: if we found a newline, break on it
::
?^ new
:- (scag u.new lin)
(weld (slag +(u.new) lin) cot)
:: if it fits, we're done
::
?: (lte len wid)
[lin cot]
=+ nil=(flop lin)
:: search for latest aft match
::
=/ aft=(unit @ud)
:: exclude the look-ahead character from search
::
=. len (dec len)
=. nil (slag 1 nil)
=- ?~(- ~ `+(u.-))
^- (unit @ud)
=+ aft=~(tap in aft.brs)
=| las=(unit @ud)
|-
?~ aft (bind las (cury sub (dec len)))
$(aft t.aft, las (hunt lth las (find [i.aft]~ nil)))
:: search for latest for match
::
=/ for=(unit @ud)
=+ for=~(tap in for.brs)
=| las=(unit @ud)
|-
?~ for (bind las (cury sub (dec len)))
=- $(for t.for, las (hunt lth las -))
=+ (find [i.for]~ nil)
:: don't break before the first character
::
?:(=(`(dec len) -) ~ -)
:: if any result, break as late as possible
::
=+ brk=(hunt gth aft for)
?~ brk
:: lin can't break, produce it in its entirety
:: (after moving the look-ahead character back)
::
:- (scag wid lin)
(weld (slag wid lin) cot)
:- (scag u.brk lin)
=. cot (weld (slag u.brk lin) cot)
:: eat any leading whitespace the next line might have, "clean break"
::
|- ^+ cot
?~ cot ~
?. ?=(?(%' ' %'\09') i.cot)
cot
$(cot t.cot)
::
++ pad
|= [wid=@ud lyn=?(%left %right) lin=tape]
^+ lin
=+ l=(lent lin)
?: (gte l wid) lin
=+ p=(reap (sub wid l) ' ')
?- lyn
%left (weld lin p)
%right (weld p lin)
==
--
--

52
pkg/arvo/lib/signatures.hoon Normal file
View File

@ -0,0 +1,52 @@
/- post
^?
=< [post .]
=, post
|%
++ jael-scry
|* [=mold our=ship desk=term now=time =path]
.^ mold
%j
(scot %p our)
desk
(scot %da now)
path
==
++ sign
|= [our=ship now=time =hash]
^- signature
=+ (jael-scry ,=life our %life now /(scot %p our))
=+ (jael-scry ,=ring our %vein now /(scot %ud life))
:+ `@ux`(sign:as:(nol:nu:crub:crypto ring) hash)
our
life
::
++ is-signature-valid
|= [our=ship =signature =hash now=time]
^- ?
=+ (jael-scry ,lyf=(unit @) our %lyfe now /(scot %p q.signature))
:: we do not have a public key from ship at this life
::
?~ lyf %.y
=+ %: jael-scry
,deed=[a=life b=pass c=(unit @ux)]
our %deed now /(scot %p q.signature)/(scot %ud p.signature)
==
?. =(a.deed r.signature) %.y
:: verify signature from ship at life
::
=/ them
(com:nu:crub:crypto b.deed)
=(`hash (sure:as.them p.signature))
::
++ are-signatures-valid
|= [our=ship =signatures =hash now=time]
^- ?
=/ signature-list ~(tap in signatures)
|-
?~ signature-list
%.y
?: (is-signature-valid our i.signature-list hash now)
$(signature-list t.signature-list)
%.n
--

35
pkg/arvo/lib/strandio.hoon
View File

@ -241,6 +241,16 @@
;< our=@p bind:m get-our
(watch wire [our term] path)
::
++ scry
|* [=mold =path]
=/ m (strand ,mold)
^- form:m
?> ?=(^ path)
?> ?=(^ t.path)
;< =bowl:spider bind:m get-bowl
%- pure:m
.^(mold i.path (scot %p our.bowl) i.t.path (scot %da now.bowl) t.t.path)
::
++ leave
|= [=wire =dock]
=/ m (strand ,~)
@ -285,6 +295,20 @@
[%pass /wait/(scot %da until) %arvo %b %wait until]
(send-raw-card card)
::
++ map-err
|* computation-result=mold
=/ m (strand ,computation-result)
|= [f=$-([term tang] [term tang]) computation=form:m]
^- form:m
|= tin=strand-input:strand
=* loop $
=/ c-res (computation tin)
?: ?=(%cont -.next.c-res)
c-res(self.next ..loop(computation self.next.c-res))
?. ?=(%fail -.next.c-res)
c-res
c-res(err.next (f err.next.c-res))
::
++ set-timeout
|* computation-result=mold
=/ m (strand ,computation-result)
@ -478,6 +502,17 @@
`[%skip ~]
`[%done +>.sign-arvo.u.in.tin]
==
:: +check-online: require that peer respond before timeout
::
++ check-online
|= [who=ship lag=@dr]
=/ m (strand ,~)
^- form:m
%+ (map-err ,~) |=(* [%offline *tang])
%+ (set-timeout ,~) lag
;< ~ bind:m
(poke [who %hood] %helm-hi !>(~))
(pure:m ~)
::
:: Queue on skip, try next on fail %ignore
::

19
pkg/arvo/mar/graph/update.hoon Normal file
View File

@ -0,0 +1,19 @@
/+ *graph-store
=* as-octs as-octs:mimes:html
::
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
++ json (update:enjs upd)
++ mime [/application/x-urb-graph-update (as-octs (jam upd))]
--
::
++ grab
|%
++ noun update
++ json update:dejs
++ mime |=([* =octs] ;;(update (cue q.octs)))
--
--

17
pkg/arvo/mar/graph/validator/chat.hoon Normal file
View File

@ -0,0 +1,17 @@
/- *post
|_ i=indexed-post
++ grow
|%
++ noun i
--
++ grab
|%
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?> ?=([@ ~] index.p.ip)
ip
--
::
++ grad %noun
--

27
pkg/arvo/mar/graph/validator/link.hoon Normal file
View File

@ -0,0 +1,27 @@
/- *post
|_ i=indexed-post
++ grow
|%
++ noun i
--
++ grab
|%
++ noun
|= p=*
=/ ip ;;(indexed-post p)
?+ index.p.ip ~|(index+index.p.ip !!)
:: top-level link post; title and url
::
[@ ~]
?> ?=([[%text @] [%url @] ~] contents.p.ip)
ip
::
:: comment on link post; comment text
::
[@ @ ~]
?> ?=([[%text @] ~] contents.p.ip)
ip
==
--
++ grad %noun
--

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

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

2
pkg/arvo/sur/file-server.hoon
View File

@ -1,7 +1,7 @@
/- glob
|%
+$ action
$% [%serve-dir url-base=path clay-base=path public=?]
$% [%serve-dir url-base=path clay-base=path public=? spa=?]
[%serve-glob url-base=path =glob:glob public=?]
[%unserve-dir url-base=path]
[%toggle-permission url-base=path]

61
pkg/arvo/sur/graph-store.hoon Normal file
View File

@ -0,0 +1,61 @@
/- *post
|%
+$ graph ((mop atom node) gth)
+$ marked-graph [p=graph q=(unit mark)]
::
+$ node [=post children=internal-graph]
+$ graphs (map resource marked-graph)
::
+$ tag-queries (jug term resource)
::
+$ update-log ((mop time logged-update) gth)
+$ update-logs (map resource update-log)
::
+$ internal-graph
$~ [%empty ~]
$% [%graph p=graph]
[%empty ~]
==
::
+$ network
$: =graphs
=tag-queries
=update-logs
archive=graphs
validators=(set mark)
==
::
+$ update
$% [%0 p=time q=update-0]
==
::
+$ logged-update
$% [%0 p=time q=logged-update-0]
==
::
+$ logged-update-0
$% [%add-nodes =resource nodes=(map index node)]
[%remove-nodes =resource indices=(set index)]
[%add-signatures =uid =signatures]
[%remove-signatures =uid =signatures]
==
::
+$ update-0
$% logged-update-0
[%add-graph =resource =graph mark=(unit mark)]
[%remove-graph =resource]
::
[%add-tag =term =resource]
[%remove-tag =term =resource]
::
[%archive-graph =resource]
[%unarchive-graph =resource]
[%run-updates =resource =update-log]
::
:: NOTE: cannot be sent as pokes
::
[%keys =resources]
[%tags tags=(set term)]
[%tag-queries =tag-queries]
==
--

46
pkg/arvo/sur/graph-view.hoon Normal file
View File

@ -0,0 +1,46 @@
/- *group, store=graph-store
/+ resource
^?
|%
:: $associated: A group to associate, or a policy if it is unmanaged
::
+$ associated
$% [%group rid=resource]
[%policy =policy]
==
::
:: $error: An error from a graph-view poke
::
:: %offline: Ship is offline
:: %bad-perms: Not permitted
:: %unknown: Anything not described above
::
+$ error
?(%offline %bad-perms %unknown)
:: $action: A semantic action on graphs
::
:: %create: Create a graph and associated metadata
:: %delete: Delete a graph
:: %join: Join a graph
:: %invite: Invite users to a graph
:: %groupify: Make graph into managed group
::
+$ action
$%
$: %create
rid=resource
title=@t
description=@t
mark=(unit mark)
=associated
module=@t
==
[%delete rid=resource]
[%leave rid=resource]
[%join rid=resource =ship]
::[%invite rid=resource ships=(set ship)]
[%groupify rid=resource to=(unit resource)]
[%forward rid=resource =update:store]
==
--

14
pkg/arvo/sur/metadata-store.hoon
View File

@ -1,16 +1,18 @@
|%
+$ group-path path
+$ app-name @tas
+$ app-name term
+$ app-path path
+$ md-resource [=app-name =app-path]
+$ associations (map [group-path md-resource] metadata)
::
+$ color @ux
+$ metadata
$: title=@t
description=@t
color=@ux
date-created=@da
creator=@p
$: title=cord
description=cord
=color
date-created=time
creator=ship
module=term
==
::
+$ metadata-action

37
pkg/arvo/sur/post.hoon Normal file
View File

@ -0,0 +1,37 @@
/- *resource
|%
+$ index (list atom)
+$ uid [=resource =index]
::
:: +sham (half sha-256) hash of +validated-portion
+$ hash @ux
::
+$ signature [p=@ux q=ship r=life]
+$ signatures (set signature)
+$ post
$: author=ship
=index
time-sent=time
contents=(list content)
hash=(unit hash)
=signatures
==
::
+$ indexed-post [a=atom p=post]
::
+$ validated-portion
$: parent-hash=(unit hash)
author=ship
time-sent=time
contents=(list content)
==
::
+$ content
$% [%text text=cord]
[%url url=cord]
[%code expression=cord output=(list tank)]
[%reference =uid]
:: TODO: maybe use a cask?
::[%cage =cage]
==
--

1
pkg/arvo/sur/pull-hook.hoon
View File

@ -8,5 +8,4 @@
+$ update
$% [%tracking tracking=(map resource ship)]
==
::
--

6
pkg/arvo/sur/spider.hoon
View File

@ -5,4 +5,10 @@
+$ input [=tid =cage]
+$ tid tid:strand
+$ bowl bowl:strand
+$ http-error
$? %bad-request :: 400
%forbidden :: 403
%nonexistent :: 404
%offline :: 504
==
--

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

@ -7762,11 +7762,13 @@
++ teal
|= mod/spec
^- spec
?: ?=(%& -.tik) mod
[%over [%& 3]~ mod]
::
++ tele
|= syn/skin
^- skin
?: ?=(%& -.tik) syn
[%over [%& 3]~ syn]
::
++ gray

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

@ -1121,17 +1121,32 @@
?> =(rcvr-life.shut-packet our-life.channel)
:: non-galaxy: update route with heard lane or forwarded lane
::
=? route.peer-state
?: =(%czar (clan:title her.channel))
%.n
=/ is-old-direct=? ?=([~ %& *] route.peer-state)
=/ is-new-direct=? ?=(~ origin.packet)
:: old direct takes precedence over new indirect
::
|(is-new-direct !is-old-direct)
=? route.peer-state !=(%czar (clan:title her.channel))
:: if new packet is direct, use that. otherwise, if the new new
:: and old lanes are indirect, use the new one. if the new lane
:: is indirect but the old lane is direct, then if the lanes are
:: identical, don't mark it indirect; if they're not identical,
:: use the new lane and mark it indirect.
::
?~ origin.packet
:: if you mark lane as indirect because you got an indirect
:: packet even though you already had a direct identical lane,
:: then delayed forwarded packets will come later and reset to
:: indirect, so you're unlikely to get a stable direct route
:: (unless the forwarder goes offline for a while).
::
:: conversely, if you don't accept indirect routes with different
:: lanes, then if your lane is stale and they're trying to talk
:: to you, your acks will go to the stale lane, and you'll never
:: time it out unless you reach out to them. this manifests as
:: needing to |hi or dotpost to get a response when the other
:: ship has changed lanes.
::
?: ?=(~ origin.packet)
`[direct=%.y lane]
?: ?=([~ %& *] route.peer-state)
?: =(lane.u.route.peer-state u.origin.packet)
route.peer-state
`[direct=%.n u.origin.packet]
`[direct=%.n u.origin.packet]
:: perform peer-specific handling of packet
::

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

@ -109,6 +109,10 @@
mut/(list (trel path lobe cage)) :: mutations
== ::
::
:: Over-the-wire backfill request
::
+$ fill [=desk =lobe]
::
:: Ford cache
::
+$ ford-cache
@ -214,18 +218,29 @@
:: requests, and a possible nako if we've received data from the other ship and
:: are in the process of validating it.
::
++ rind :: request manager
$: nix/@ud :: request index
bom/(map @ud {p/duct q/rave}) :: outstanding
fod/(map duct @ud) :: current requests
haw/(map mood (unit cage)) :: simple cache
== ::
+$ rind :: request manager
$: nix=@ud :: request index
bom=(map @ud update-state) :: outstanding
fod=(map duct @ud) :: current requests
haw=(map mood (unit cage)) :: simple cache
== ::
::
:: Active downloads
::
+$ update-state
$: =duct
=rave
have=(map lobe blob)
need=(list lobe)
nako=(qeu (unit nako))
busy=_|
==
::
:: Result of a subscription
::
++ sub-result
$% [%blab =mood data=(each cage lobe)]
[%bleb ins=@ud range=(unit (pair aeon aeon))]
[%bleb ver=@ud ins=@ud range=(unit (pair aeon aeon))]
[%balk cage=(unit (each cage lobe)) =mood]
[%blas moods=(set mood)]
[%blub ~]
@ -246,7 +261,7 @@
:: Generally used when we store a request in our state somewhere.
::
++ cach (unit (unit (each cage lobe))) :: cached result
+$ wove [for=(unit ship) =rove] :: stored source + req
+$ wove [for=(unit [=ship ver=@ud]) =rove] :: stored source + req
++ rove :: stored request
$% [%sing =mood] :: single request
[%next =mood aeon=(unit aeon) =cach] :: next version of one
@ -1134,13 +1149,13 @@
:: Give next step in a subscription.
::
++ bleb
|= {hen/duct ins/@ud hip/(unit (pair aeon aeon))}
|= [hen=duct ver=@ud ins=@ud hip=(unit (pair aeon aeon))]
^+ +>
%^ blab hen [%w [%ud ins] ~]
:- %&
?~ hip
[%null [%atom %n ~] ~]
[%nako !>((make-nako:ze u.hip))]
[%nako !>((make-nako:ze ver u.hip))]
::
:: Tell subscriber that subscription is done.
::
@ -1183,7 +1198,7 @@
=/ =desk p.riff
=/ =wire /warp-index/(scot %p ship)/(scot %tas desk)/(scot %ud index)
=/ =path [%question desk (scot %ud index) ~]
(emit duct %pass wire %a %plea ship %c path riff)
(emit duct %pass wire %a %plea ship %c path [[%1 ~] riff])
::
:: Create a request that cannot be filled immediately.
::
@ -1210,7 +1225,7 @@
(send-over-ames hen her inx syd `rave)
%= +>+.$
nix.u.ref +(nix.u.ref)
bom.u.ref (~(put by bom.u.ref) inx [hen rave])
bom.u.ref (~(put by bom.u.ref) inx [hen rave ~ ~ ~ |])
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
@ -2003,6 +2018,7 @@
:: bob's.
::
?: ?=(%init germ)
?> ?=(~ bob-yaki)
&+`[conflicts=~ new=|+ali-yaki lat=~]
::
=/ bob-yaki (need bob-yaki)
@ -2589,7 +2605,7 @@
:: and then waiting if the subscription range extends into the future.
::
++ start-request
|= [for=(unit ship) rav=rave]
|= [for=(unit [ship @ud]) rav=rave]
^+ ..start-request
=^ [new-sub=(unit rove) sub-results=(list sub-result)] fod.dom
(try-fill-sub for (rave-to-rove rav))
@ -2612,9 +2628,9 @@
?> ?=(^ ref)
=+ ruv=(~(get by bom.u.ref) inx)
?~ ruv +>.$
=/ rav=rave q.u.ruv
=/ rav=rave rave.u.ruv
?: ?=(%many -.rav)
(take-foreign-update inx rut)
abet:(apex:(foreign-update inx) rut)
?~ rut
:: nothing here, so cache that
::
@ -2689,36 +2705,138 @@
!>(;;(@uvI q.page))
--
::
:: A full foreign update. Validate and apply to our local cache of
:: their state.
:: Respond to backfill request
::
++ take-foreign-update
|= [inx=@ud rut=(unit rand)]
^+ ..take-foreign-update
:: Maybe should verify the requester is allowed to access this blob?
::
++ give-backfill
|= =lobe
^+ ..give-backfill
(emit hen %give %boon (~(got by lat.ran) lobe))
::
:: Ingest foreign update, requesting missing blobs if necessary
::
++ foreign-update
|= inx=@ud
?> ?=(^ ref)
=/ ruv (~(get by bom.u.ref) inx)
?~ ruv
~& [%clay-foreign-update-lost her syd inx]
..take-foreign-update
=. hen p.u.ruv
=/ =rave q.u.ruv
?> ?=(%many -.rave)
|^
?~ rut
done
=. lim ?.(?=(%da -.to.moat.rave) lim p.to.moat.rave)
?> ?=(%nako p.r.u.rut)
=/ nako ;;(nako q.r.u.rut)
=. ..take-foreign-update
=< ?>(?=(^ ref) .)
(apply-foreign-update nako)
done
=/ [sat=update-state lost=?]
=/ ruv (~(get by bom.u.ref) inx)
?~ ruv
~& [%clay-foreign-update-lost her syd inx]
[*update-state &]
[u.ruv |]
=/ done=? |
=. hen duct.sat
|%
++ abet
^+ ..foreign-update
?: lost
..foreign-update
?: done
=: bom.u.ref (~(del by bom.u.ref) inx)
fod.u.ref (~(del by fod.u.ref) hen)
==
=<(?>(?=(^ ref) .) wake)
=. bom.u.ref (~(put by bom.u.ref) inx sat)
..foreign-update
::
++ done
=: bom.u.ref (~(del by bom.u.ref) inx)
bom.u.ref (~(del by bom.u.ref) hen)
==
=<(?>(?=(^ ref) .) wake)
++ apex
|= rut=(unit rand)
^+ ..abet
?: lost ..abet
?~ rut
=. nako.sat (~(put to nako.sat) ~)
work
?> ?=(%nako p.r.u.rut)
=/ nako ;;(nako q.r.u.rut)
=/ missing (missing-blobs nako)
=. need.sat `(list lobe)`(welp need.sat ~(tap in missing))
=. nako.sat (~(put to nako.sat) ~ nako)
work
::
++ missing-blobs
|= =nako
^- (set lobe)
=/ yakis ~(tap in lar.nako)
|- ^- (set lobe)
=* yaki-loop $
?~ yakis
~
=/ lobes=(list [=path =lobe]) ~(tap by q.i.yakis)
|- ^- (set lobe)
=* blob-loop $
?~ lobes
yaki-loop(yakis t.yakis)
?: (~(has by lat.ran) lobe.i.lobes)
blob-loop(lobes t.lobes)
(~(put in blob-loop(lobes t.lobes)) lobe.i.lobes)
::
:: Receive backfill response
::
++ take-backfill
|= =blob
^+ ..abet
?: lost ..abet
=? need.sat
?& ?=(%delta -.blob)
!(~(has by lat.ran) q.q.blob)
!(~(has by have.sat) q.q.blob)
==
[q.q.blob need.sat]
:: We can't put a blob in lat.ran if its parent isn't already
:: there. Unions are in reverse order so we don't overwrite
:: existing blobs.
::
=. ..abet
?: &(?=(%delta -.blob) !(~(has by lat.ran) q.q.blob))
..abet(have.sat (~(uni by (malt [p.blob `^blob`blob] ~)) have.sat))
..abet(lat.ran (~(uni by (malt [p.blob blob] ~)) lat.ran))
work(busy.sat |)
::
:: Fetch next blob
::
++ work
^+ ..abet
?: busy.sat
..abet
|- ^+ ..abet
?: =(~ need.sat)
:: NB: if you change to release nakos as we get enough blobs
:: for them instead of all at the end, you *must* store the
:: `lim` that should be applied after the nako is complete and
:: not use the one in the rave, since that will apply to the
:: end of subscription.
::
=. lat.ran (~(uni by have.sat) lat.ran)
|- ^+ ..abet
?: =(~ nako.sat)
..abet
=^ next=(unit nako) nako.sat ~(get to nako.sat)
?~ next
..abet(done &)
=. ..abet (apply-foreign-update u.next)
=. ..foreign-update =<(?>(?=(^ ref) .) wake)
$
?> ?=(^ need.sat)
:: This is what removes an item from `need`. This happens every
:: time we take a backfill response, but it could happen more than
:: once if we somehow got this data in the meantime (maybe from
:: another desk updating concurrently, or a previous update on this
:: same desk).
::
?: ?| (~(has by lat.ran) i.need.sat)
(~(has by have.sat) i.need.sat)
==
$(need.sat t.need.sat)
:: Otherwise, fetch the next blob
::
=/ =fill [syd i.need.sat]
=/ =wire /back-index/(scot %p her)/[syd]/(scot %ud inx)
=/ =path [%backfill syd (scot %ud inx) ~]
=. ..foreign-update
=< ?>(?=(^ ref) .)
(emit hen %pass wire %a %plea her %c path fill)
..abet(busy.sat &)
::
:: When we get a %w foreign update, store this in our state.
::
@ -2728,7 +2846,7 @@
::
++ apply-foreign-update
|= =nako
^+ ..take-foreign-update
^+ ..abet
:: hit: updated commit-hashes by @ud case
:: nut: new commit-hash/commit pairs
:: hut: updated commits by hash
@ -2765,12 +2883,19 @@
$(aeon +(aeon))
:: produce updated state
::
=/ =rave rave:(~(got by bom.u.ref) inx)
?> ?=(%many -.rave)
=: let.dom (max let.nako let.dom)
hit.dom hit
hut.ran hut
lat.ran lat
:: Is this correct? Seeems like it should only go to `to` if
:: we've gotten all the way to the end. Leaving this
:: behavior unchanged for now, but I believe it's wrong.
::
lim ?.(?=(%da -.to.moat.rave) lim p.to.moat.rave)
==
..take-foreign-update
..abet
--
::
:: fire function if request is in future
@ -2862,8 +2987,9 @@
:: Try to fill a subscription
::
++ try-fill-sub
|= [for=(unit ship) rov=rove]
|= [far=(unit [=ship ver=@ud]) rov=rove]
^- [[new-sub=(unit rove) (list sub-result)] ford-cache]
=/ for=(unit ship) ?~(far ~ `ship.u.far)
?- -.rov
%sing
=/ cache-value=(unit (unit cage))
@ -3075,6 +3201,7 @@
::
[`rov ~]
=/ to-aeon (case-to-aeon to.moat.rov)
=/ ver ?~(far %1 ver.u.far)
?~ to-aeon
:: we're in the middle of the range, so produce what we can,
:: but don't end the subscription
@ -3092,7 +3219,7 @@
~
:: else changes, so produce them
::
[%bleb let.dom ?:(track.rov ~ `[u.from-aeon let.dom])]~
[%bleb ver let.dom ?:(track.rov ~ `[u.from-aeon let.dom])]~
:: we're past the end of the range, so end subscription
::
:- ~
@ -3103,7 +3230,7 @@
=/ bleb=(list sub-result)
?: =(lobes.rov new-lobes)
~
[%bleb +(u.from-aeon) ?:(track.rov ~ `[u.from-aeon u.to-aeon])]~
[%bleb ver +(u.from-aeon) ?:(track.rov ~ `[u.from-aeon u.to-aeon])]~
:: end subscription
::
=/ blub=(list sub-result)
@ -3111,17 +3238,6 @@
(weld bleb blub)
==
::
++ drop-me
^+ .
~| %clay-drop-me-not-implemented
!!
:: ?~ mer
:: .
:: %- emit(mer ~) ^- move :*
:: hen.u.mer %give %mere %| %user-interrupt
:: >sor.u.mer< >our< >cas.u.mer< >gem.u.mer< ~
:: ==
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
:: This core has no additional state, and the distinction exists purely for
@ -3209,7 +3325,7 @@
:: Creates a nako of all the changes between a and b.
::
++ make-nako
|= {a/aeon b/aeon}
|= [ver=@ud a=aeon b=aeon]
^- nako
:+ ?> (lte b let.dom)
|-
@ -3219,7 +3335,7 @@
b
?: =(0 b)
[~ ~]
(data-twixt-takos (~(get by hit.dom) a) (aeon-to-tako b))
(data-twixt-takos =(0 ver) (~(get by hit.dom) a) (aeon-to-tako b))
::
:: Traverse parentage and find all ancestor hashes
::
@ -3245,16 +3361,21 @@
:: ones we found before `a`. Then convert the takos to yakis and also get
:: all the data in all the yakis.
::
:: What happens if you run an %init merge on a desk that already
:: had a commit?
::
++ data-twixt-takos
|= {a/(unit tako) b/tako}
^- {(set yaki) (set plop)}
|= [plops=? a=(unit tako) b=tako]
^- [(set yaki) (set plop)]
=+ old=?~(a ~ (reachable-takos u.a))
=/ yal/(set tako)
=/ yal=(set tako)
%- silt
%+ skip
~(tap in (reachable-takos b))
|=(tak/tako (~(has in old) tak))
|=(tak=tako (~(has in old) tak))
:- (silt (turn ~(tap in yal) tako-to-yaki))
?. plops
~
(silt (turn ~(tap in (new-lobes (new-lobes ~ old) yal)) lobe-to-blob))
::
:: Get all the lobes that are referenced in `a` except those that are
@ -3728,7 +3849,7 @@
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=| :: instrument state
$: ver=%3 :: vane version
$: ver=%4 :: vane version
ruf=raft :: revision tree
== ::
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
@ -3939,7 +4060,14 @@
=^ for req
?: ?=(%warp -.req)
[~ req]
:- ?:(=(our who.req) ~ `who.req)
:: ?: =(our who.req)
:: [~ [%warp wer.req rif.req]]
=^ ver rif.req
?@ -.rif.req
[%0 rif.req]
[-<.rif.req +.rif.req]
?> ?=(@ -.rif.req)
:- ?:(=(our who.req) ~ `[who.req ver])
[%warp wer.req rif.req]
::
?> ?=(%warp -.req)
@ -3957,8 +4085,14 @@
=* pax path.plea.req
=* res payload.plea.req
::
?> ?=({%question *} pax)
=+ ryf=;;(riff res)
?: ?=([%backfill *] pax)
=+ ;;(=fill res)
=^ mos ruf
=/ den ((de our now ski hen ruf) our desk.fill)
abet:(give-backfill:den +.fill)
[[[hen %give %done ~] mos] ..^$]
?> ?=([%question *] pax)
=+ ryf=;;(riff-any res)
:_ ..^$
:~ [hen %give %done ~]
=/ =wire
@ -3971,11 +4105,58 @@
!:
|^
|= old=any-state
~! [old=old new=*state-3]
~! [old=old new=*state-4]
=? old ?=(%2 -.old) (load-2-to-3 old)
?> ?=(%3 -.old)
=? old ?=(%3 -.old) (load-3-to-4 old)
?> ?=(%4 -.old)
..^^$(ruf +.old)
::
++ load-3-to-4
|= =state-3
^- state-4
|^
=- state-3(- %4, hoy hoy.-, rom (room-3-to-4 rom.state-3))
^- hoy=(map ship rung)
%- ~(run by hoy.state-3)
|= =rung-3
^- rung
%- ~(run by rus.rung-3)
|= =rede-3
^- rede
=- rede-3(ref ref.-, qyx (cult-3-to-4 qyx.rede-3))
^- ref=(unit rind)
?~ ref.rede-3
~
=- `u.ref.rede-3(bom bom.-)
^- bom=(map @ud update-state)
%- ~(run by bom.u.ref.rede-3)
|= [=duct =rave]
^- update-state
[duct rave ~ ~ ~ |]
::
++ room-3-to-4
|= =room-3
^- room
=- room-3(dos dos.-)
^- dos=(map desk dojo)
%- ~(run by dos.room-3)
|= =dojo-3
^- dojo
dojo-3(qyx (cult-3-to-4 qyx.dojo-3))
::
++ cult-3-to-4
|= =cult-3
^- cult
%- malt
%+ turn ~(tap by cult-3)
|= [=wove-3 ducts=(set duct)]
^- [wove (set duct)]
:_ ducts :_ rove.wove-3
?~ for.wove-3
~
`[u.for.wove-3 %0]
--
::
++ load-2-to-3
|= =state-2
^- state-3
@ -4005,11 +4186,11 @@
:- %ford-fusion
[leaf+"queued merge canceled due to upgrade to ford fusion" ~]
`[duct %slip %b %drip !>([%mere %| err])]
^- rom=room
^- rom=room-3
:- hun.rom.state-2
%- ~(urn by dos.rom.state-2)
|= [=desk =dojo-2]
^- dojo
^- dojo-3
=- dojo-2(dom -)
^- dome
=/ fer=(unit reef-cache)
@ -4019,23 +4200,22 @@
(~(got by hut.ran.state-2) (~(got by hit.dom.dojo-2) let.dom.dojo-2))
`(build-reef desk q.yaki)
[ank let hit lab mim fod=*ford-cache fer=fer]:[dom.dojo-2 .]
^- hoy=(map ship rung)
^- hoy=(map ship rung-3)
%- ~(run by hoy.state-2)
|= =rung-2
^- rung
^- rung-3
%- ~(run by rus.rung-2)
|= =rede-2
^- rede
^- rede-3
=- rede-2(ref ref.-, dom dom.-)
:- ^- dom=dome
[ank let hit lab mim fod=*ford-cache fer=~]:[dom.rede-2 .]
^- ref=(unit rind)
^- ref=(unit rind-3)
?~ ref.rede-2
~
:: TODO: somehow call +wake later to notify subscribers
:- ~
^- rind
=/ rin=rind [nix bom fod haw]:u.ref.rede-2
^- rind-3
=/ rin=rind-3 [nix bom fod haw]:u.ref.rede-2
=. rin
=/ pur=(list [inx=@ud =rand *]) ~(tap by pur.u.ref.rede-2)
|- ^+ rin
@ -4138,8 +4318,46 @@
--
--
::
+$ any-state $%(state-3 state-2)
+$ state-3 [%3 raft]
+$ any-state $%(state-4 state-3 state-2)
+$ state-4 [%4 raft]
+$ state-3
$: %3
rom=room-3
hoy=(map ship rung-3)
ran=rang
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
pun=(list move)
==
+$ rung-3 rus=(map desk rede-3)
+$ rede-3
$: lim/@da
ref/(unit rind-3)
qyx/cult-3
dom/dome
per/regs
pew/regs
==
+$ rind-3
$: nix/@ud
bom/(map @ud {p/duct q/rave})
fod/(map duct @ud)
haw/(map mood (unit cage))
==
+$ room-3
$: hun/duct
dos/(map desk dojo-3)
==
++ dojo-3
$: qyx/cult-3
dom/dome
per/regs
pew/regs
==
+$ cult-3 (jug wove-3 duct)
+$ wove-3 [for=(unit ship) =rove]
+$ state-2
$: %2
rom=room-2 :: domestic
@ -4156,7 +4374,7 @@
dos/(map desk dojo-2) :: native desk
== ::
+$ dojo-2
$: qyx/cult :: subscribers
$: qyx/cult-3 :: subscribers
dom/dome-2 :: desk state
per/regs :: read perms per path
pew/regs :: write perms per path
@ -4172,7 +4390,7 @@
+$ rede-2
$: lim/@da :: complete to
ref/(unit rind-2) :: outgoing requests
qyx/cult :: subscribers
qyx/cult-3 :: subscribers
dom/dome-2 :: revision state
per/regs :: read perms per path
pew/regs :: write perms per path
@ -4303,6 +4521,35 @@
[mos ..^$]
==
::
?: ?=([%back-index @ @ @ ~] tea)
?+ +<.q.hin ~| %clay-backfill-index-strange !!
%done
?~ error.q.hin
[~ ..^$]
:: TODO better error handling
::
~& %clay-take-backfill-index-error^our^tea^tag.u.error.q.hin
%- (slog tang.u.error.q.hin)
[~ ..^$]
::
%lost
~| %clay-take-backfill-lost^our
:: TODO better error handling
!!
::
%boon
=+ ;; =blob payload.q.hin
::
=/ her=ship (slav %p i.t.tea)
=/ =desk (slav %tas i.t.t.tea)
=/ index=@ud (slav %ud i.t.t.t.tea)
::
=^ mos ruf
=/ den ((de our now ski hen ruf) her desk)
abet:abet:(take-backfill:(foreign-update:den index) blob)
[mos ..^$]
==
::
?: ?=([%sinks ~] tea)
?> ?=(%public-keys +<.q.hin)
?. ?=(%breach -.public-keys-result.q.hin)
@ -4396,7 +4643,9 @@
:+ desk %|
:~ ankh+&+ank.dom.dojo
mime+&+mim.dom.dojo
ford+&+fod.dom.dojo
ford-vases+&+vases.fod.dom.dojo
ford-marks+&+marks.fod.dom.dojo
ford-casts+&+casts.fod.dom.dojo
==
:~ domestic+|+domestic
foreign+&+hoy.ruf

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

@ -861,7 +861,7 @@
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
{$warp wer/ship rif/riff} :: internal file req
{$werp who/ship wer/ship rif/riff} :: external file req
{$werp who/ship wer/ship rif/riff-any} :: external file req
$>(%plea vane-task) :: ames request
== ::
-- ::able
@ -967,7 +967,10 @@
who/(pair (set ship) (map @ta crew)) ::
== ::
++ regs (map path rule) :: rules for paths
++ riff {p/desk q/(unit rave)} :: request+desist
+$ riff [p=desk q=(unit rave)] :: request+desist
+$ riff-any
$^ [[%1 ~] riff]
riff
++ rite :: new permissions
$% {$r red/(unit rule)} :: for read
{$w wit/(unit rule)} :: for write

30
pkg/arvo/ted/diff.hoon Normal file
View File

@ -0,0 +1,30 @@
/- spider
/+ strandio
=, strand=strand:spider
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
|^
=+ !<([=a=path =b=path ~] arg)
=/ a-mark=mark -:(flop a-path)
=/ b-mark=mark -:(flop b-path)
?. =(a-mark b-mark)
(strand-fail:strandio %files-not-same-type ~)
=/ a-beam (need (de-beam:format a-path))
;< =a=cage bind:m (get-file a-path)
;< =b=cage bind:m (get-file b-path)
;< =dais:clay bind:m (build-mark:strandio -.a-beam a-mark)
(pure:m (~(diff dais q.a-cage) q.b-cage))
::
++ get-file
|= =path
=/ m (strand ,cage)
^- form:m
=/ beam (need (de-beam:format path))
;< =riot:clay bind:m
(warp:strandio p.beam q.beam ~ %sing %x r.beam (flop s.beam))
?~ riot
(strand-fail:strandio %file-not-found >path< ~)
(pure:m r.u.riot)
--

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