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

Merge branch 'na-release/next-vere' into jt/minkleton

Browse Source 
* na-release/next-vere: (1169 commits)
  jets: fix broken jets so ~marzod can boot.
  jets: hook up preexisting +repn jet.
  jets: add empty hashes
  jets: review comments
  Revert "Revert "u3: clear cached mugs on cell edit""
  jets: +welp and +zing
  jets: fix memory leak in +run:in
  jet: +find
  jets: +all:by and +any:by
  jets: +urn:by
  jet: +rep:by
  jet: +rep:in
  jets: +apt:in
  jets: +run:in
  jets: final cleanup
  jets: reenable +uni:by
  jets: jet +apt:by
  jets: +key:by and +wyt:by
  jets: +run:by
  jet: final cleanup
  ...
This commit is contained in:
Joe Bryan 2020-05-20 14:05:17 -07:00
commit 6d3a5be259
581 changed files with 55770 additions and 11705 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
.github/ISSUE_TEMPLATE/kernel-or-runtime-bug-report.md vendored Normal file
View File

@ -0,0 +1,39 @@
---
name: Kernel or runtime bug report
about: Use this template to file a bug for low-level system components, e.g. Hoon,
Arvo, Zuse, the vanes, Vere, etc.
title: ''
labels: bug
assignees: ''
---
<!-- A good bug report, description of a crash, etc., should ideally be *reproducible*, with clear steps as to how another developer can replicate and examine your problem. That said, this isn't always possible; some bugs depend on having created a complicated or unusual state, or can otherwise simply be difficult to trigger again (say, you encountered it in the last continuity era).
Your issue should thus at a minimum be *informative*. The best advice here is probably "don't write bad issues," where "bad" is a matter of judgment and taste. Issues that the maintainers don't judge to be sufficiently useful or informative may be closed. -->
**Describe the bug**
A clear and concise description of what the bug is.
**To Reproduce**
Steps to reproduce the behaviour:
1. ...
2. ...
3. ...
**Expected behaviour**
A clear and concise description of what you expected to happen.
**Screenshots**
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)
**Additional context**
Add any other context about the problem here.
**Notify maintainers**
If you happen to know who the appropriate maintainers are, consider mentioning them with an @ here. You may want to use `git blame` to see who has last touched any relevant code.

39
.github/ISSUE_TEMPLATE/os1-bug-report.md vendored Normal file
View File

@ -0,0 +1,39 @@
---
name: OS1 Bug report
about: 'Use this template to file a bug for any OS1 app: Chat, Publish, Links, Groups,
Weather or Clock'
title: ''
labels: OS1
assignees: ''
---
**Describe the bug**
A clear and concise description of what the bug is.
**To Reproduce**
Steps to reproduce the behavior:
1. Go to '...'
2. Click on '....'
3. Scroll down to '....'
4. See error
**Expected behavior**
A clear and concise description of what you expected to happen.
**Screenshots**
If applicable, add screenshots to help explain your problem. If possible, please also screenshot your browser's dev console. Here are [Chrome's docs](https://developers.google.com/web/tools/chrome-devtools/open) for using this feature.
**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.
**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.
**Additional context**
Add any other context about the problem here.

57
.gitignore vendored
View File

@ -1,23 +1,46 @@
/out
/result
/result-*
/work
# nix symlink artifacts
#
result
result-*
# common dev piers
#
/zod
/bus
/fakezod*
tags
TAGS
/nec
/fakezod
# package manager caches
#
.stack-work
node_modules
# build and release artifacts
#
cross/
release/
.stack-work
dist
/out
/work
# landscape dev
#
urbitrc
*-min.js
pkg/interface/link-webext/web-ext-artifacts
# catchall editor and OS stuff
#
.tags
.etags
tags
TAGS
GPATH
GRTAGS
GTAGS
.DS_Store
*.swp
*.swo
\#*\#
s/*
**/.DS_Store
**/dist
**/node_modules
**/urbitrc
**/*.swp
**/*.swo
**/*-min.js
.stack-work
pkg/interface/link-webext/web-ext-artifacts

5
CONTRIBUTING.md
View File

@ -158,9 +158,8 @@ commit that updates the source.
## Releases
We typically create releases by cherry picking appropriate commits from
`master` and tagging the result, so any given commit in `master` may not
actually be present in the latest release.
We typically create releases by tagging appropriate commits on `master`, so any
given commit in `master` may not actually be present in the latest release.
We perform updates by pushing releases over-the-air to `~zod` approximately
once per week, so any contribution that can be deployed OTA will usually find

247
MAINTAINERS.md
View File

@ -1,13 +1,125 @@
# Maintainers' Guide
## Branch organization
The essence of this branching scheme is that you create "release branches" of
independently releasable units of work. These can then be released by their
maintainers when ready.
### Master branch
Master is what's released on the network. Deployment instructions are in the
next section, but tagged releases should always come from this branch.
### Feature branches
Anyone can create feature branches. For those with commit access to
urbit/urbit, you're welcome to create them in this repo; otherwise, fork the
repo and create them there.
Usually, new development should start from master, but if your work depends on
work in another feature branch or release branch, start from there.
If, after starting your work, you need changes that are in master, merge it into
your branch. If you need changes that are in a release branch or feature
branch, merge it into your branch, but understand that your work now depends on
that release branch, which means it won't be released until that one is
released.
### Release branches
Release branches are code that is ready to release. All release branch names
should start with `release/`.
All code must be reviewed before being pushed to a release branch. Thus,
feature branches should be PR'd against a release branch, not master.
Create new release branches as needed. You don't need a new one for every PR,
since many changes are relatively small and can be merged together with little
risk. However, once you merge two branches, they're now coupled and will only
be released together -- unless one of the underlying commits is separately put
on a release branch.
Here's a worked example. The rule is to make however many branches are useful,
and no more. This example is not prescriptive, the developers making the
changes may add, remove, or rename branches in this flow at will.
Suppose you (plural, the dev community at large) complete some work in a
userspace app, and you put it in `release/next-userspace`. Separately, you make
a small JS change. If you PR it to `release/next-userspace`, then it will only
be released at the same time as the app changes. Maybe this is fine, or maybe
you want this change to go out quickly, and the change in
`release/next-userspace` is relatively risky, so you don't want to push it out
on Friday afternoon. In this case, put the change in another release branch,
say `release/next-js`. Now either can be released independently.
Suppose you do further work that you want to PR to `release/next-userspace`, but
it depends on your fixes in `release/next-js`. Simply merge `release/next-js`
into either your feature branch or `release/next-userspace` and PR your finished
work to `release/next-userspace`. Now there is a one-way coupling:
`release/next-userspace` contains `release/next-js`, so releasing it will
implicitly release `release/next-js`. However, you can still release
`release/next-js` independently.
This scheme extends to other branches, like `release/next-kernel` or
`release/os1.1` or `release/ford-fusion`. Some branches may be long-lived and
represent simply the "next" release of something, while others will have a
definite lifetime that corresponds to development of a particular feature or
numbered release.
Since they are "done", release branches should be considered "public", in the
sense that others may depend on them at will. Thus, never rebase a release
branch.
When cutting a new release, you can filter branches with `git branch --list
'release/*'` or by typing "release/" in the branch filter on Github. This will
give you the list of branches which have passed review and may be merged to
master and released. When choosing which branches to release, make sure you
understand the risks of releasing them immediately. If merging these produces
nontrivial conflicts, consider asking the developers on those branches to merge
between themselves. In many cases a developer can do this directly, but if it's
sufficiently nontrivial, this may be a reviewed PR of one release branch into
another.
### Non-OTAable release branches
In some cases, work is completed which cannot be OTA'd as written. For example,
the code may lack state adapters, or it may not properly handle outstanding
subscriptions. It could also be code which is planned to be released only upon
a breach (network-wide or rolling).
In this case, the code may be PR'd to a `na-release/` branch. All rules are the
same as for release branches, except that the code does not need to apply
cleanly to an existing ship. If you later write state adapter or otherwise make
it OTAable, then you may PR it to a release branch.
### Other cases
Outside contributors can generally target their PRs against master unless
specifically instructed. Maintainers should retarget those branches as
appropriate.
If a commit is not something that goes into a release (eg changes to README or
CI), it may be committed straight to master.
If a hotfix is urgent, it may be PR'd straight to master. This should only be
done if you reasonably expect that it will be released soon and before anything
else is released.
If a series of commits that you want to release is on a release branch, but you
really don't want to release the whole branch, you must cherry-pick them onto
another release branch. Cherry-picking isn't ideal because those commits will
be duplicated in the history, but it won't have any serious side effects.
## Hotfixes
Here lies an informal guide for making hotfix releases and deploying them to
the network.
Take [this recent PR][1], as an example. This constituted a great hotfix.
It's a single commit, targeting a problem that existed on the network at the
time. Here's it should be released and deployed OTA.
Take [this PR][1], as an example. This constituted a great hotfix. It's a
single commit, targeting a problem that existed on the network at the time.
Here's it should be released and deployed OTA.
[1]: https://github.com/urbit/urbit/pull/2025
@ -16,14 +128,9 @@ time. Here's it should be released and deployed OTA.
Unless it's very trivial, it should probably have a single "credible looking"
review from somebody else on it.
You can just merge the PR in GitHub. As I, `~nidsut-tomdun`, am a l33t
h4x0r, I use a custom merge commit format, gotten by:
```
git merge --no-ff --signoff --log BRANCH
```
with the commit message:
You should avoid merging the PR in GitHub directly. Instead, use the
`sh/merge-with-custom-msg` script -- it will produce a merge commit with
message along the lines of:
```
Merge branch FOO (#PR_NUM)
@ -32,66 +139,58 @@ Merge branch FOO (#PR_NUM)
bar: ...
baz: ...
Signed-off-by: Jared Tobin <jared@tlon.io>
Signed-off-by: SIGNER <signer@example.com>
```
All this extra wankery is hardly required, but IMO it's nice to have the
commit log information in the merge commit, which GitHub's "Merge PR" button
doesn't do (at least by default).
We do this as it's nice to have the commit log information in the merge commit,
which GitHub's "Merge PR" button doesn't do (at least by default).
`sh/merge-with-custom-msg` performs some useful last-minute urbit-specific
checks, as well.
The script at `sh/merge-with-custom-message` can be used to make this simple(r)
to do. I use `git mu` as an alias for it, locally.
### Apply the changes to this era's release branch
This corresponds to the 'vx.y' part of the most recent 'urbit vx.y.z' release.
At the time of writing, we're on v0.10 (and I'll use this branch as a running
example):
If the branch doesn't yet exist, just create it via:
You might want to alias `sh/merge-with-custom-msg` locally, to make it easier
to use. My .git/config contains the following, for example:
```
git checkout -b v0.10 master
[alias]
mu = !sh/merge-with-custom-msg
```
If you can get away with merging master to v0.10 without pulling in any
superfluous commits, feel free to do that. Otherwise, you'll want to cherry
pick the commits like so:
so that I can type e.g. `git mu origin/foo 1337`.
```
git cherry-pick -x TARGET_COMMITS
```
### Prepare a release commit
Use the `-x` flag to `git-cherry-pick`, because this will indicate in the
commit message where the things originally came from.
You should create Landscape or alternative pill builds, if or as appropriate
(i.e., if anything in Landscape changed -- don't trust any compiled JS/CSS
that's included in the commit), and commit these in a release commit.
Create Landscape or alternative pill builds, if or as appropriate (i.e., if
anything in Landscape changed -- don't trust the compiled JS/CSS that's
included in the commit).
You may also want to create a brass pill, in particular, as it's convenient for
You should always create a solid pill, in particular, as it's convenient for
tooling to be able to boot directly from a given release.
If you're making a Vere release, just play it safe and update all the pills.
### Tag the resulting commit
What you should do here depends on the type of release being made.
First, for Arvo releases:
First, for Urbit OS releases:
If it's a very trivial hotfix that you know isn't going to break
anything, tag it as `arvo.yyyy.mm.dd`. Use an annotated tag, i.e.
anything, tag it as `urbit-os-vx.y.z`. Here 'x' refers to the product version
(e.g. OS1, OS2..), 'y' to the continuity era in that version, and 'z' to an
OTA patch counter. So for a hotfix version, you'll just want to increment 'z'.
Use an annotated tag, i.e.
```
git tag -a arvo.yyyy.mm.dd
git tag -a urbit-os-vx.y.z
```
The tag format should look something like this:
```
arvo.yyyy.mm.dd
urbit-os-vx.y.z
This release contains Arvo changes that will be pushed to the live
network as an over-the-air update.
This release will be pushed to the network as an over-the-air update.
Release notes:
@ -106,8 +205,7 @@ You can get the "contributions" section by the shortlog between the
last release and this release:
```
git log --pretty=short --no-merges \
LAST_RELEASE..v0.10 | git shortlog
git log --pretty=short LAST_RELEASE.. | git shortlog
```
I originally tried to curate this list somewhat, but now just paste it
@ -121,23 +219,28 @@ If the commit descriptions are too poor to easily do this, then again, yell at
your fellow contributors to make them better in the future.
If it's *not* a trivial hotfix, you should probably make any number of release
candidate tags (e.g. `arvo.yyyy.mm.dd.rc-1`, `arvo.yyyy.mm.dd.rc-2`, ..), test
candidate tags (e.g. `urbit-os-vx.y.z.rc1`, `urbit-os-vx.y.z.rc2`, ..), test
them, and after you confirm one of them is good, tag the release as
`arvo.yyyy.mm.dd`.
`urbit-os-vx.y.z`.
For Vere releases:
Tag the release as `vx.y.z`. The tag format should look something
like this:
Tag the release as `urbit-vx.y.z`. The tag format should look something like
this:
```
urbit vx.y.z
urbit-vx.y.z
This release contains Vere changes, so users should update their
binaries.
Note that this Vere release will by default boot fresh ships using an Urbit OS
va.b.c pill.
This is not a breaching release, so users should not create new
piers.
Release binaries:
(linux64)
https://bootstrap.urbit.org/urbit-vx.y.z-linux64.tgz
(macOS)
https://bootstrap.urbit.org/urbit-vx.y.z-darwin.tgz
Release notes:
@ -150,29 +253,37 @@ Contributions:
The same schpeel re: release candidates applies here.
You should probably avoid putting both Arvo and Vere changes into Vere
releases.
Note that the release notes indicate which version of Urbit OS the Vere release
will use by default when booting fresh ships. Do not include implicit Urbit OS
changes in Vere releases; this used to be done, historically, but shouldn't be
any longer. If there are Urbit OS and Vere changes to be released, make two
separate releases.
### Deploy the update
For Arvo updates, this means copying the files into ~zod's %base desk. For
consistency, I download the release tarball and then rsync the files in:
(**Note**: the following steps are automated by some other Tlon-internal
tooling. Just ask `~nidsut-tomdun` for details.)
For Urbit OS updates, this means copying the files into ~zod's %base desk. The
changes will be synced to /~zod/kids and then propagated through other galaxies
and stars to the rest of the network.
For consistency, I create a release tarball and then rsync the files in.
```
$ wget https://github.com/urbit/urbit/archive/arvo.yyyy.mm.dd.tar.gz
$ tar xzf arvo.yyyy.mm.dd.tar.gz
$ wget https://github.com/urbit/urbit/archive/urbit-os-vx.y.z.tar.gz
$ tar xzf urbit-os-vx.y.z.tar.gz
$ herb zod -p hood -d "+hood/mount /=base="
$ rsync -zr --delete urbit-arvo.yyyy.mm.dd/pkg/arvo/ zod/base
$ rsync -zr --delete urbit-urbit-os-vx.y.z/pkg/arvo/ zod/base
$ herb zod -p hood -d "+hood/commit %base"
```
For Vere updates, this means shutting down each desired ship, installing the
new binary, and restarting the pier with it.
For Vere updates, this means simply shutting down each desired ship, installing
the new binary, and restarting the pier with it.
### Announce the update
Post an announcement to urbit-dev. The tag annotation, basically, is fine here
-- I usually add the %base hash (for Arvo releases) and the release binary URLs
(for Vere releaes). Check the urbit-dev archives for examples of these
-- I usually add the %base hash (for Urbit OS releases) and the release binary
URLs (for Vere releases). Check the urbit-dev archives for examples of these
announcements.

4
bin/brass.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:362ba607d646cc053ef27c9cab1d7e6cf07856d0949cb5a48e17ef536e857613
size 7227783
oid sha256:5f283336929733f6492f7fe230c949749cea43c8a1fb18959742b2ff88e9d239
size 10418083

4
bin/ivory.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:61a38233c95cd8e0c0790e33c134c1aab607659a16abce22e85f56b6c77b19c5
size 1232440
oid sha256:8d2579ed2b72828ced40789c0eae516a832c66f8f9dcd06af4ba5ec4cb4e2ac6
size 1236461

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:df7e73129cc484fba44301eec4230b9ec3dc533163db36b885074ff8b018b6c8
size 9650082
oid sha256:20219ec89d58a89285733db183b89e5f19e5bb7764bed43218c0c83902dd1e56
size 12878034

15
nix/pkgs/urbit/builder.sh
View File

@ -1,15 +0,0 @@
source $stdenv/setup
cp -r $src ./src
chmod -R u+w ./src
cd src
bash ./configure
make clean
make all -j8
make test
mkdir -p $out/bin
cp ./build/urbit $out/bin/$exename
cp ./build/urbit-worker $out/bin/$exename-worker

14
nix/pkgs/urbit/default.nix
View File

@ -27,9 +27,21 @@ let
inherit name meta;
exename = name;
src = ../../../pkg/urbit;
builder = ./builder.sh;
nativeBuildInputs = deps ++ vendor;
configurePhase = ''
bash ./configure
'';
installPhase = ''
make all -j8
make test
mkdir -p $out/bin
cp ./build/urbit $out/bin/$exename
cp ./build/urbit-worker $out/bin/$exename-worker
'';
# See https://github.com/NixOS/nixpkgs/issues/18995
hardeningDisable = if debug then [ "all" ] else [];

5
pkg/arvo/app/azimuth-tracker.hoon
View File

@ -87,8 +87,9 @@
|= [state=app-state our=ship dap=term]
^- card:agent:gall
=/ args=vase !>
:* %watch /[dap]
url.state =(%czar (clan:title our)) ~m5
:+ %watch /[dap]
^- config:eth-watcher
:* url.state =(%czar (clan:title our)) ~m5 ~m30
launch:contracts:azimuth
~[azimuth:contracts:azimuth]
(topics whos.state)

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

@ -17,8 +17,15 @@
::
|%
+$ card card:agent:gall
+$ state
$: grams=(list mail) :: all messages
::
+$ versioned-state
$% state-1
state-0
==
::
+$ state-1
$: %1
grams=(list mail) :: all messages
known=(set [target serial]) :: known message lookup
count=@ud :: (lent grams)
bound=(map target glyph) :: bound circle glyphs
@ -31,11 +38,27 @@
eny=@uvJ :: entropy
==
::
+$ state-0
$: grams=(list [[=ship =path] envelope]) :: all messages
known=(set [[=ship =path] serial]) :: known message lookup
count=@ud :: (lent grams)
bound=(map [=ship =path] glyph) :: bound circle glyphs
binds=(jug glyph [=ship =path]) :: circle glyph lookup
audience=(set [=ship =path]) :: active targets
settings=(set term) :: frontend flags
width=@ud :: display width
timez=(pair ? @ud) :: timezone adjustment
cli=state=sole-share:sole-sur :: console state
eny=@uvJ :: entropy
==
::
+$ mail [source=target envelope]
+$ target [=ship =path]
+$ target [in-group=? =ship =path]
::
+$ glyph char
++ glyphs "!@#$%^&()-=_+[]\{};'\\:\",.<>?"
++ glyphs "!@#$%^&()-=_+[]\{}'\\:\",.<>?"
::
+$ nu-security ?(%channel %village %village-with-group)
::
+$ command
$% [%target (set target)] :: set messaging target
@ -44,10 +67,10 @@
::
::
:: create chat
[%create rw-security path (unit glyph) (unit ?)]
[%create nu-security path (unit glyph) (unit ?)]
[%delete path] :: delete chat
[%invite ?(%r %w %rw) path (set ship)] :: allow
[%banish ?(%r %w %rw) path (set ship)] :: disallow
[%invite [? path] (set ship)] :: allow
[%banish [? path] (set ship)] :: disallow
::
[%join target (unit glyph) (unit ?)] :: join target
[%leave target] :: nuke target
@ -68,8 +91,8 @@
== ::
::
--
=| state
=* all-state -
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
@ -83,26 +106,22 @@
::
++ on-init
^- (quip card _this)
:- [connect:tc]~
%_ this
audience [[our-self:tc /] ~ ~]
settings (sy %showtime %notify ~)
width 80
==
=^ cards state (prep:tc ~)
[cards this]
::
++ on-save !>(all-state)
++ on-save !>(state)
::
++ on-load
|= old-state=vase
^- (quip card _this)
=/ old !<(state old-state)
=^ cards all-state (prep:tc `old)
=/ old !<(versioned-state old-state)
=^ cards state (prep:tc `old)
[cards this]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
=^ cards all-state
=^ cards state
?+ mark (on-poke:def mark vase)
%noun (poke-noun:tc !<(* vase))
%sole-action (poke-sole-action:tc !<(sole-action:sole-sur vase))
@ -112,7 +131,7 @@
++ on-watch
|= =path
^- (quip card _this)
=^ cards all-state (peer:tc path)
=^ cards state (peer:tc path)
[cards this]
::
++ on-leave on-leave:def
@ -120,14 +139,22 @@
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards all-state
=^ cards state
?- -.sign
%poke-ack [- all-state]:(on-agent:def wire sign)
%watch-ack [- all-state]:(on-agent:def wire sign)
%kick [?:(?=([%chat-store ~] wire) ~[connect:tc] ~) all-state]
%poke-ack [- state]:(on-agent:def wire sign)
%watch-ack [- state]:(on-agent:def wire sign)
::
%kick
:_ state
?+ wire ~
[%chat-store ~] ~[connect:tc]
[%invites ~] ~[connect-invites:tc]
==
::
%fact
?+ p.cage.sign ~|([%chat-cli-bad-sub-mark wire p.cage.sign] !!)
%chat-update (diff-chat-update:tc wire !<(chat-update q.cage.sign))
%chat-update (diff-chat-update:tc wire !<(chat-update q.cage.sign))
%invite-update (handle-invite-update:tc !<(invite-update q.cage.sign))
==
==
[cards this]
@ -140,58 +167,104 @@
:: +prep: setup & state adapter
::
++ prep
|= old=(unit state)
^- (quip card state)
?^ old
:_ u.old
?: (~(has by wex.bowl) [/chat-store our-self %chat-store])
~
~[connect]
=^ cards all-state
%_ catch-up
audience [[our-self /] ~ ~]
settings (sy %showtime %notify ~)
width 80
|= old=(unit versioned-state)
^- (quip card _state)
?~ old
=^ cards state
%_ catch-up
audience [[| our-self /] ~ ~]
settings (sy %showtime %notify ~)
width 80
==
[[connect connect-invites cards] state]
:- %+ weld
?: (~(has by wex.bowl) [/invites our-self %invite-store]) ~
~[connect-invites]
?: (~(has by wex.bowl) [/chat-store our-self %chat-store]) ~
~[connect]
::
^- state-1
?- -.u.old
%1
=? width.u.old =(0 width.u.old) 80
u.old(bound (~(gas by *(map target glyph)) ~(tap by bound.u.old)))
::
?(~ ^)
:- %1
%= u.old
grams ~ ::NOTE this only impacts historic message lookup in chat-cli
::
known
^- (set [target serial])
%- ~(run in known.u.old)
|= [t=[ship path] s=serial]
[`target`[| t] s]
::
bound
^- (map target glyph)
%- ~(gas by *(map target glyph))
%+ turn ~(tap by bound.u.old)
|= [t=[ship path] g=glyph]
[`target`[| t] g]
::
binds
^- (jug glyph target)
%- ~(run by binds.u.old)
|= s=(set [ship path])
%- ~(run in s)
|= t=[ship path]
`target`[| t]
::
audience
^- (set target)
%- ~(run in audience.u.old)
|= t=[ship path]
`target`[| t]
==
[[connect cards] all-state]
==
:: +catch-up: process all chat-store state
::
++ catch-up
^- (quip card state)
^- (quip card _state)
=/ =inbox
.^ inbox
%gx
(scot %p our.bowl)
%chat-store
(scot %da now.bowl)
/all/noun
==
|- ^- (quip card state)
?~ inbox [~ all-state]
(scry-for inbox %chat-store /all)
|- ^- (quip card _state)
?~ inbox [~ state]
=* path p.n.inbox
=* mailbox q.n.inbox
=/ =target (path-to-target path)
=^ cards-n all-state (read-envelopes target envelopes.mailbox)
=^ cards-l all-state $(inbox l.inbox)
=^ cards-r all-state $(inbox r.inbox)
[:(weld cards-n cards-l cards-r) all-state]
=^ cards-n state (read-envelopes target (flop envelopes.mailbox))
=^ cards-l state $(inbox l.inbox)
=^ cards-r state $(inbox r.inbox)
[:(weld cards-n cards-l cards-r) state]
:: +connect: connect to the chat-store
::
++ connect
^- card
[%pass /chat-store %agent [our-self %chat-store] %watch /updates]
::
++ connect-invites
^- card
[%pass /invites %agent [our.bowl %invite-store] %watch /invitatory/chat]
::
++ our-self (name:title our.bowl)
:: +target-to-path: prepend ship to the path
::
++ target-to-path
|= target
%+ weld
?:(in-group ~ /~)
[(scot %p ship) path]
:: +path-to-target: deduces a target from a mailbox path
::
++ path-to-target
|= =path
^- target
=^ in-group path
?. ?=([%'~' *] path)
[& path]
[| t.path]
:- in-group
?. ?=([@ @ *] path)
::TODO can we safely assert the above?
~& [%path-without-host path]
@ -203,24 +276,24 @@
::
++ poke-noun
|= a=*
^- (quip card state)
^- (quip card _state)
?: ?=(%connect a)
[[connect ~] all-state]
[[connect ~] state]
?: ?=(%catch-up a)
catch-up
[~ all-state]
[~ state]
:: +poke-sole-action: handle cli input
::
++ poke-sole-action
::TODO use id.act to support multiple separate sessions
|= [act=sole-action:sole-sur]
^- (quip card state)
^- (quip card _state)
(sole:sh-in act)
:: +peer: accept only cli subscriptions from ourselves
::
++ peer
|= =path
^- (quip card state)
^- (quip card _state)
?. (team:title our-self src.bowl)
~| [%peer-talk-stranger src.bowl]
!!
@ -230,40 +303,48 @@
:: display a fresh prompt
:- [prompt:sh-out ~]
:: start with fresh sole state
all-state(state.cli *sole-share:sole-sur)
state(state.cli *sole-share:sole-sur)
:: +handle-invite-update: get new invites
::
++ handle-invite-update
|= upd=invite-update
^- (quip card _state)
?+ -.upd [~ state]
%invite [[(show-invite:sh-out invite.upd) ~] state]
==
:: +diff-chat-update: get new mailboxes & messages
::
++ diff-chat-update
|= [=wire upd=chat-update]
^- (quip card state)
?+ -.upd [~ all-state]
%create (notice-create +.upd)
%delete [[(show-delete:sh-out (path-to-target path.upd)) ~] all-state]
^- (quip card _state)
?+ -.upd [~ state]
%create (notice-create (path-to-target path.upd))
%delete [[(show-delete:sh-out (path-to-target path.upd)) ~] state]
%message (read-envelope (path-to-target path.upd) envelope.upd)
%messages (read-envelopes (path-to-target path.upd) envelopes.upd)
%messages (read-envelopes (path-to-target path.upd) (flop envelopes.upd))
==
::
++ read-envelopes
|= [=target envs=(list envelope)]
^- (quip card state)
?~ envs [~ all-state]
=^ cards-i all-state (read-envelope target i.envs)
=^ cards-t all-state $(envs t.envs)
[(weld cards-i cards-t) all-state]
^- (quip card _state)
?~ envs [~ state]
=^ cards-i state (read-envelope target i.envs)
=^ cards-t state $(envs t.envs)
[(weld cards-i cards-t) state]
::
++ notice-create
|= =target
^- (quip card state)
=^ cards all-state
^- (quip card _state)
=^ cards state
?: (~(has by bound) target)
[~ all-state]
[~ state]
(bind-default-glyph target)
[[(show-create:sh-out target) cards] all-state]
[[(show-create:sh-out target) cards] state]
:: +bind-default-glyph: bind to default, or random available
::
++ bind-default-glyph
|= =target
^- (quip card state)
^- (quip card _state)
=; =glyph (bind-glyph glyph target)
|^ =/ g=glyph (choose glyphs)
?. (~(has by binds) g) g
@ -281,7 +362,7 @@
::
++ bind-glyph
|= [=glyph =target]
^- (quip card state)
^- (quip card _state)
::TODO should send these to settings store eventually
:: if the target was already bound to another glyph, un-bind that
::
@ -289,16 +370,16 @@
(~(del ju binds) (~(got by bound) target) target)
=. bound (~(put by bound) target glyph)
=. binds (~(put ju binds) glyph target)
[(show-glyph:sh-out glyph `target) all-state]
[(show-glyph:sh-out glyph `target) state]
:: +unbind-glyph: remove all binding for glyph
::
++ unbind-glyph
|= [=glyph targ=(unit target)]
^- (quip card state)
^- (quip card _state)
?^ targ
=. binds (~(del ju binds) glyph u.targ)
=. bound (~(del by bound) u.targ)
[(show-glyph:sh-out glyph ~) all-state]
[(show-glyph:sh-out glyph ~) state]
=/ ole=(set target)
(~(get ju binds) glyph)
=. binds (~(del by binds) glyph)
@ -308,7 +389,7 @@
=. bound $(ole l.ole)
=. bound $(ole r.ole)
(~(del by bound) n.ole)
[(show-glyph:sh-out glyph ~) all-state]
[(show-glyph:sh-out glyph ~) state]
:: +decode-glyph: find the target that matches a glyph, if any
::
++ decode-glyph
@ -331,12 +412,12 @@
::
++ read-envelope
|= [=target =envelope]
^- (quip card state)
^- (quip card _state)
?: (~(has in known) [target uid.envelope])
::NOTE we no-op only because edits aren't possible
[~ all-state]
[~ state]
:- (show-envelope:sh-out target envelope)
%_ all-state
%_ state
known (~(put in known) [target uid.envelope])
grams [[target envelope] grams]
count +(count)
@ -351,10 +432,10 @@
::
++ sole
|= act=sole-action:sole-sur
^- (quip card state)
^- (quip card _state)
?- -.dat.act
%det (edit +.dat.act)
%clr [~ all-state]
%clr [~ state]
%ret obey
%tab (tab +.dat.act)
==
@ -367,8 +448,8 @@
::
[%create leaf+";create [type] /chat-name (glyph)"]
[%delete leaf+";delete /chat-name"]
[%invite leaf+";invite [rw | r | w] /chat-name ~ships"]
[%banish leaf+";banish [rw | r | w] /chat-name ~ships"]
[%invite leaf+";invite /chat-name ~ships"]
[%banish leaf+";banish /chat-name ~ships"]
::
[%bind leaf+";bind [glyph] ~ship/chat-name"]
[%unbind leaf+";unbind [glyph]"]
@ -383,18 +464,18 @@
==
++ tab
|= pos=@ud
^- (quip card state)
^- (quip card _state)
?: ?| =(~ buf.state.cli)
!=(';' -.buf.state.cli)
==
:_ all-state
:_ state
[(effect:sh-out [%bel ~]) ~]
::
=+ (get-id:auto pos (tufa buf.state.cli))
=/ needle=term
(fall id '')
?: &(!=(pos 1) =(0 (met 3 needle)))
[~ all-state] :: autocomplete empty command iff user at start of command
[~ state] :: autocomplete empty command iff user at start of command
=/ options=(list (option:auto tank))
(search-prefix:auto needle tab-list)
=/ advance=term
@ -407,9 +488,9 @@
=? moves ?=(^ options)
[(tab:sh-out options) moves]
=| fxs=(list sole-effect:sole-sur)
|- ^- (quip card state)
|- ^- (quip card _state)
?~ to-send
[(flop moves) all-state]
[(flop moves) state]
=^ char state.cli
(~(transmit sole-lib state.cli) [%ins send-pos `@c`i.to-send])
%_ $
@ -424,17 +505,17 @@
::
++ edit
|= cal=sole-change:sole-sur
^- (quip card state)
^- (quip card _state)
=^ inv state.cli (~(transceive sole-lib state.cli) cal)
=+ fix=(sanity inv buf.state.cli)
?~ lit.fix
[~ all-state]
[~ state]
:: just capital correction
?~ err.fix
(slug fix)
:: allow interior edits and deletes
?. &(?=($del -.inv) =(+(p.inv) (lent buf.state.cli)))
[~ all-state]
[~ state]
(slug fix)
:: +sanity: check input sanity
::
@ -451,13 +532,13 @@
::
++ slug
|= [lit=(list sole-edit:sole-sur) err=(unit @u)]
^- (quip card state)
?~ lit [~ all-state]
^- (quip card _state)
?~ lit [~ state]
=^ lic state.cli
%- ~(transmit sole-lib state.cli)
^- sole-edit:sole-sur
?~(t.lit i.lit [%mor lit])
:_ all-state
:_ state
:_ ~
%+ effect:sh-out %mor
:- [%det lic]
@ -484,8 +565,8 @@
==
==
;~((glue ace) (tag %delete) path)
;~((glue ace) (tag %invite) rw path ships)
;~((glue ace) (tag %banish) rw path ships)
;~((glue ace) (tag %invite) tarx ships)
;~((glue ace) (tag %banish) tarx ships)
::
;~ (glue ace)
(tag %join)
@ -505,6 +586,7 @@
;~((glue ace) (tag %set) flag)
;~((glue ace) (tag %unset) flag)
;~(plug (cold %width (jest 'set width ')) dem:ag)
::
;~ plug
(cold %timezone (jest 'set timezone '))
;~ pose
@ -551,10 +633,20 @@
::
++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib
++ ship ;~(pfix sig fed:ag)
++ path ;~(pfix net (most net urs:ab))
++ path ;~(pfix net ;~(plug urs:ab (easy ~))) ::NOTE short only, tmp
:: +mang: un/managed indicator prefix
::
++ mang
;~ pose
(cold %| (jest '~/'))
(cold %& (easy ~))
==
:: +tarl: local target, as /path
::
++ tarl (stag our-self path)
:: +tarx: local target, maybe managed
::
++ tarx ;~(plug mang path)
:: +tarp: sponsor target, as ^/path
::
++ tarp
@ -564,9 +656,15 @@
::
++ targ
;~ pose
tarl
tarp
;~(plug ship path)
;~ plug
mang
::
;~ pose
tarl
tarp
;~(plug ship path)
==
==
(sear decode-glyph glyph)
==
:: +tars: set of comma-separated targs
@ -583,11 +681,7 @@
:: +security: security mode
::
++ security
(perk %channel %village %journal %mailbox ~)
:: +rw: read, write, or read-write
::
++ rw
(perk %rw %r %w ~)
(perk %channel %village-with-group %village ~)
::
:: +glyph: shorthand character
::
@ -654,16 +748,16 @@
:: the command (if any) gets echoed to the user.
::
++ obey
^- (quip card state)
^- (quip card _state)
=+ buf=buf.state.cli
=+ fix=(sanity [%nop ~] buf)
?^ lit.fix
(slug fix)
=+ jub=(rust (tufa buf) read)
?~ jub [[(effect:sh-out %bel ~) ~] all-state]
?~ jub [[(effect:sh-out %bel ~) ~] state]
=^ cal state.cli (~(transmit sole-lib state.cli) [%set ~])
=^ cards all-state (work u.jub)
:_ all-state
=^ cards state (work u.jub)
:_ state
%+ weld
^- (list card)
:: echo commands into scrollback
@ -678,7 +772,7 @@
::
++ work
|= job=command
^- (quip card state)
^- (quip card _state)
|^ ?- -.job
%target (set-target +.job)
%say (say +.job)
@ -735,153 +829,145 @@
:^ %invite /chat
(shax (jam [our-self where] who))
^- invite
=; desc=cord
[our-self %chat-hook where who desc]
%- crip
%+ weld
"You have been invited to chat at "
~(full tr [our-self where])
[our-self %chat-hook where who '']
==
:: +set-target: set audience, update prompt
::
++ set-target
|= tars=(set target)
^- (quip card state)
^- (quip card _state)
=. audience tars
[[prompt:sh-out ~] all-state]
[[prompt:sh-out ~] state]
:: +create: new local mailbox
::
++ create
|= [security=rw-security =path gyf=(unit char) allow-history=(unit ?)]
^- (quip card state)
::TODO check if already exists
=/ =target [our-self path]
|= [security=nu-security =path gyf=(unit char) allow-history=(unit ?)]
^- (quip card _state)
=/ with-group=? ?=(%village-with-group security)
=/ =target [with-group our-self path]
=/ real-path=^path (target-to-path target)
=/ =rw-security
?- security
%channel %channel
?(%village %village-with-group) %village
==
?^ (scry-for (unit mailbox) %chat-store [%mailbox real-path])
=- [[- ~] state]
%- print:sh-out
"{(spud path)} already exists!"
=. audience [target ~ ~]
=^ moz all-state
?. ?=(^ gyf) [~ all-state]
=^ moz state
?. ?=(^ gyf) [~ state]
(bind-glyph u.gyf target)
=- [[- moz] all-state]
=- [[- moz] state]
%^ act %do-create %chat-view
:- %chat-view-action
!>
!> ^- chat-view-action
:* %create
path
security
:: ensure we can read from/write to our own chats
::
:: read
?- security
?(%channel %journal) ~
?(%village %mailbox) [our-self ~ ~]
==
:: write
?- security
?(%channel %mailbox) ~
?(%village %journal) [our-self ~ ~]
==
(rsh 3 1 (spat path))
''
real-path :: chat
real-path :: group
rw-security
~
(fall allow-history %.y)
==
:: +delete: delete local chats
::
++ delete
|= =path
^- (quip card state)
=- [[- ~] all-state]
^- (quip card _state)
=- [[- ~] state]
%^ act %do-delete %chat-view
:- %chat-view-action
!>
[%delete (target-to-path our-self path)]
!> ^- chat-view-action
[%delete (target-to-path | our-self path)]
:: +change-permission: modify permissions on a local chat
::
++ change-permission
|= [allow=? rw=?(%r %w %rw) =path ships=(set ship)]
^- (quip card state)
:_ all-state
=; cards=(list card)
?. allow cards
%+ weld cards
%+ turn ~(tap in ships)
(cury invite-card path)
%+ murn
^- (list term)
?- rw
%r [%read ~]
%w [%write ~]
%rw [%read %write ~]
==
|= =term
^- (unit card)
=. path
=- (snoc `^path`- term)
[%chat (target-to-path our-self path)]
|= [allow=? [group=? =path] ships=(set ship)]
^- (quip card _state)
:_ state
=/ real-path=^path
(target-to-path group our-self path)
=; permit=(unit card)
%+ weld (drop permit)
?. allow ~
^- (list card)
%+ murn ~(tap in ships)
|= =ship
^- (unit card)
:: if they weren't permitted before, some hook will send an invite.
:: but if they already were, we want to send an invite ourselves.
::
?. %^ scry-for ?
%permission-store
[%permitted (scot %p ship) real-path]
~
`(invite-card real-path ship)
:: whitelist: empty if no matching permission, else true if whitelist
::
=/ whitelist=(unit ?)
=; perm=(unit permission)
?~(perm ~ `?=(%white kind.u.perm))
::TODO +permission-of-target?
.^ (unit permission)
%gx
(scot %p our-self)
%permission-store
(scot %da now.bowl)
%permission
(snoc path %noun)
==
%^ scry-for (unit permission)
%permission-store
[%permission real-path]
?~ whitelist
~& [%weird-no-permission path]
~& [%weird-no-permission real-path]
~
%- some
%^ act %do-permission %group-store
:- %group-action
!>
!> ^- group-action
?: =(u.whitelist allow)
[%add ships path]
[%remove ships path]
[%add ships real-path]
[%remove ships real-path]
:: +join: sync with remote mailbox
::
++ join
|= [=target gyf=(unit char) ask-history=(unit ?)]
^- (quip card state)
=^ moz all-state
?. ?=(^ gyf) [~ all-state]
^- (quip card _state)
=^ moz state
?. ?=(^ gyf) [~ state]
(bind-glyph u.gyf target)
=. audience [target ~ ~]
=; =card
[[card prompt:sh-out moz] all-state]
[[card prompt:sh-out moz] state]
::TODO ideally we'd check permission first. attempting this and failing
:: gives ugly %chat-hook-reap
%^ act %do-join %chat-view
:- %chat-view-action
!>
[%join ship.target path.target (fall ask-history %.y)]
!> ^- chat-view-action
[%join ship.target (target-to-path target) (fall ask-history %.y)]
:: +leave: unsync & destroy mailbox
::
::TODO allow us to "mute" local chats using this
++ leave
|= =target
=- [[- ~] all-state]
=- [[- ~] state]
?: =(our-self ship.target)
%- print:sh-out
"can't ;leave local chats, maybe use ;delete instead"
%^ act %do-leave %chat-hook
:- %chat-hook-action
!>
!> ^- chat-hook-action
[%remove (target-to-path target)]
:: +say: send messages
::
++ say
|= =letter
^- (quip card state)
^- (quip card _state)
~! bowl
=/ =serial (shaf %msg-uid eny.bowl)
:_ all-state(eny (shax eny.bowl))
:_ state(eny (shax eny.bowl))
^- (list card)
%+ turn ~(tap in audience)
|= =target
%^ act %out-message %chat-hook
:- %chat-action
!>
!> ^- chat-action
:+ %message (target-to-path target)
[serial *@ our-self now.bowl letter]
:: +eval: run hoon, send code and result as message
@ -895,8 +981,8 @@
::
++ lookup-glyph
|= qur=(unit $@(glyph target))
^- (quip card state)
=- [[- ~] all-state]
^- (quip card _state)
=- [[- ~] state]
?^ qur
?^ u.qur
=+ gyf=(~(get by bound) u.qur)
@ -920,8 +1006,8 @@
:: +show-settings: print enabled flags, timezone and width settings
::
++ show-settings
^- (quip card state)
:_ all-state
^- (quip card _state)
:_ state
:~ %- print:sh-out
%- zing
^- (list tape)
@ -941,24 +1027,24 @@
::
++ set-setting
|= =term
^- (quip card state)
[~ all-state(settings (~(put in settings) term))]
^- (quip card _state)
[~ state(settings (~(put in settings) term))]
:: +unset-setting: disable settings flag
::
++ unset-setting
|= =term
^- (quip card state)
[~ all-state(settings (~(del in settings) term))]
^- (quip card _state)
[~ state(settings (~(del in settings) term))]
:: +set-width: configure cli printing width
::
++ set-width
|= w=@ud
[~ all-state(width w)]
[~ state(width w)]
:: +set-timezone: configure timestamp printing adjustment
::
++ set-timezone
|= tz=[? @ud]
[~ all-state(timez tz)]
[~ state(timez tz)]
:: +select: expand message from number reference
::
++ select
@ -967,7 +1053,7 @@
:: (with leading zeros used for precision)
::
|= num=$@(rel=@ud [zeros=@u abs=@ud])
^- (quip card state)
^- (quip card _state)
|^ ?@ num
=+ tum=(scow %s (new:si | +(num)))
?: (gte rel.num count)
@ -985,7 +1071,7 @@
::
++ just-print
|= txt=tape
[[(print:sh-out txt) ~] all-state]
[[(print:sh-out txt) ~] state]
:: +index: get message index from absolute reference
::
++ index
@ -999,10 +1085,10 @@
::
++ activate
|= [number=tape index=@ud]
^- (quip card state)
^- (quip card _state)
=+ gam=(snag index grams)
=. audience [source.gam ~ ~]
:_ all-state
:_ state
^- (list card)
:~ (print:sh-out ['?' ' ' number])
(effect:sh-out ~(render-activate mr gam))
@ -1012,17 +1098,14 @@
:: +chats: display list of local mailboxes
::
++ chats
^- (quip card state)
:_ all-state
^- (quip card _state)
:_ state
:_ ~
%- print-more:sh-out
=/ all
::TODO refactor
::TODO remote scries fail... but moon support?
.^ (set path)
%gx
/(scot %p our-self)/chat-store/(scot %da now.bowl)/keys/noun
==
%^ scry-for (set path)
%chat-store
/keys
%+ turn ~(tap in all)
%+ cork path-to-target
|= target
@ -1030,8 +1113,8 @@
:: +help: print (link to) usage instructions
::
++ help
^- (quip card state)
=- [[- ~] all-state]
^- (quip card _state)
=- [[- ~] state]
(print:sh-out "see https://urbit.org/using/operations/using-your-ship/#messaging")
--
--
@ -1148,6 +1231,14 @@
%+ weld "set: {[glyph ~]} "
?~ target "unbound"
~(phat tr u.target)
:: +show-invite: print incoming invite notification
::
++ show-invite
|= invite
^- card
%- note
%+ weld "invited to: "
~(phat tr (path-to-target path))
--
::
:: +tr: render targets
@ -1181,17 +1272,21 @@
::
++ full
^- tape
(weld (scow %p ship.one) (spud path.one))
;: weld
?:(in-group.one "" "~/")
(scow %p ship.one)
(spud path.one)
==
:: +phat: render target with local shorthand
::
:: renders as ~ship/path.
:: for local mailboxes, renders just /path.
:: for sponsor's mailboxes, renders ^/path.
::
::NOTE but, given current implementation, all will be local
::
++ phat
^- tape
%+ weld
?:(in-group.one "" "~/")
%+ weld
?: =(our-self ship.one) ~
?: =((sein:title our.bowl now.bowl our-self) ship.one) "^"
@ -1396,4 +1491,16 @@
[(sub wid u.ace) &]
:- (tufa (scag end `(list @)`txt))
$(txt (slag ?:(nex +(end) end) `tape`txt))
::
::NOTE anything that uses this breaks moons support, because moons don't sync
:: full app state rn
++ scry-for
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bowl)
app
(scot %da now.bowl)
(snoc `^path`path %noun)
==
--

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

@ -2,18 +2,26 @@
:: mirror chat data from foreign to local based on read permissions
:: allow sending chat messages to foreign paths based on write perms
::
/- *permission-store, *chat-hook, *invite-store
/+ *chat-json, default-agent, verb, dbug
/- *permission-store, *chat-hook, *invite-store, *metadata-store,
*permission-hook, *group-store, *permission-group-hook ::TMP for upgrade
/+ *chat-json, *chat-eval, default-agent, verb, dbug
~% %chat-hook-top ..is ~
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
$% state-0
state-1
==
::
+$ state-zero
$: %0
synced=(map path ship)
+$ state-1
$: %1
loaded-cards=(list card)
state-base
==
+$ state-0 [%0 state-base]
+$ state-base
$: =synced
invite-created=_|
allow-history=(map path ?)
==
@ -29,13 +37,14 @@
$% [%chat-update chat-update]
==
--
=| state-zero
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
~% %chat-hook-agent-core ..poke-json ~
|_ bol=bowl:gall
+* this .
chat-core +>
@ -51,29 +60,199 @@
==
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
|= old-vase=vase
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
:_ this(state old)
%+ murn ~(tap by wex.bol)
|= [[=wire =ship =term] *]
^- (unit card)
?. &(?=([%mailbox *] wire) =(our.bol ship) =(%chat-store term))
~
`[%pass wire %agent [our.bol %chat-store] %leave ~]
:: path structure ugprade logic
::
=/ keys=(set path) (scry:cc (set path) %chat-store /keys)
=/ upgraded-state
%* . *state-1
synced synced
invite-created invite-created
allow-history allow-history
loaded-cards
%- zing
^- (list (list card))
%+ turn ~(tap in keys) generate-cards
==
[loaded-cards.upgraded-state this(state upgraded-state)]
::
++ generate-cards
|= old-chat=path
^- (list card)
=/ host=ship (slav %p (snag 0 old-chat))
=/ new-chat [%'~' old-chat]
=/ newp=permission (unify-permissions old-chat)
=/ old-group=path [%chat old-chat]
%- zing
:~ :~ (delete-group host (snoc old-group %read))
(delete-group host (snoc old-group %write))
==
::
(create-group new-chat who.newp)
(hookup-group new-chat kind.newp)
[(record-group new-chat new-chat)]~
(recreate-chat host old-chat new-chat)
==
::
++ recreate-chat
|= [host=ship chat=path new-chat=path]
^- (list card)
=/ old-mailbox=mailbox
(need (scry:cc (unit mailbox) %chat-store [%mailbox chat]))
=* enves envelopes.old-mailbox
:~ (chat-poke:cc [%delete new-chat])
(chat-poke:cc [%delete chat])
(chat-poke:cc [%create new-chat])
(chat-poke:cc [%messages new-chat enves])
(chat-poke:cc [%read new-chat])
%^ make-poke %chat-hook %chat-hook-action
!> ^- chat-hook-action
?: =(our.bol host) [%add-owned new-chat %.y]
[%add-synced host new-chat %.y]
==
::
++ unify-permissions
|= chat=path
^- permission
=/ read=(unit permission) (get-permission chat %read)
=/ write=(unit permission) (get-permission chat %write)
?. &(?=(^ read) ?=(^ write))
~& [%missing-permission chat read=?=(~ read) write=?=(~ write)]
[%white [(slav %p (snag 0 chat)) ~ ~]]
?+ [kind.u.read kind.u.write] !!
:: village: exclusive to writers
::
[%white %white] [%white who.u.write]
::
:: channel: merge blacklists
::
[%black %black] [%black (~(uni in who.u.read) who.u.write)]
::
:: journal: exclusive to writers
::
[%black %white] [%white who.u.write]
::
:: mailbox: exclusive to readers
::
[%white %black] [%white who.u.read]
==
::
++ get-permission
|= [chat=path what=?(%read %write)]
%^ scry:cc (unit permission)
%permission-store
[%permission %chat (snoc chat what)]
::
++ make-poke
|= [app=term =mark =vase]
^- card
[%pass /on-load/[app]/[mark] %agent [our.bol app] %poke mark vase]
::
++ delete-group
|= [host=ship group=path]
^- card
:: if we host the group, delete it directly
::
?: =(our.bol host)
%^ make-poke %group-store
%group-action
!> ^- group-action
[%unbundle group]
:: else, just delete the sync in the hook
::
%^ make-poke %permission-hook
%permission-hook-action
!> ^- permission-hook-action
[%remove group]
::
++ create-group
|= [group=path who=(set ship)]
^- (list card)
:~ %^ make-poke %group-store
%group-action
!> ^- group-action
[%bundle group]
::
%^ make-poke %group-store
%group-action
!> ^- group-action
[%add who group]
==
::
++ hookup-group
|= [group=path =kind]
^- (list card)
:* %^ make-poke %permission-group-hook
%permission-group-hook-action
!> ^- permission-group-hook-action
[%associate group [group^kind ~ ~]]
::
=/ =ship (slav %p (snag 1 group))
?. =(our.bol ship) ~
:_ ~
%^ make-poke %permission-hook
%permission-hook-action
!> ^- permission-hook-action
[%add-owned group group]
==
::
++ record-group
|= [group=path chat=path]
^- card
=/ =metadata
~| [%weird-chat-path chat]
%* . *metadata
title (snag 2 chat)
date-created now.bol
creator (slav %p (snag 1 chat))
==
%^ make-poke %metadata-store
%metadata-action
!> ^- metadata-action
[%add group [%chat chat] metadata]
--
::
++ on-poke
~/ %chat-hook-poke
|= [=mark =vase]
^- (quip card _this)
=^ cards state
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(chat-action vase))
%chat-hook-action (poke-chat-hook-action:cc !<(chat-hook-action vase))
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(chat-action vase))
%noun
?: =(%store-load q.vase)
[loaded-cards.state state(loaded-cards ~)]
[~ state]
::
%chat-hook-action
(poke-chat-hook-action:cc !<(chat-hook-action vase))
==
[cards this]
::
++ on-watch
~/ %chat-hook-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%backlog *] [(watch-backlog:cc t.path) this]
[%mailbox *] [(watch-mailbox:cc t.path) this]
[%synced *] [(watch-synced:cc t.path) this]
==
::
++ on-agent
~/ %chat-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
@ -113,6 +292,7 @@
--
::
::
~% %chat-hook-library ..card ~
|_ bol=bowl:gall
::
++ poke-json
@ -129,18 +309,19 @@
?: (team:title our.bol src.bol)
?. (~(has by synced) path.act)
~
=* letter letter.envelope.act
=? letter &(?=(%code -.letter) ?=(~ output.letter))
=/ =hoon (ream expression.letter)
letter(output (eval bol hoon))
=/ ship (~(got by synced) path.act)
=/ appl ?:(=(ship our.bol) %chat-store %chat-hook)
[%pass / %agent [ship appl] %poke %chat-action !>(act)]~
:: foreign
=/ ship (~(get by synced) path.act)
?~ ship
~
?. =(u.ship our.bol)
~
:: scry permissions to check if write is permitted
?. (permitted-scry [(scot %p src.bol) %chat (weld path.act /write)])
~
?~ ship ~
?. =(u.ship our.bol) ~
:: check if write is permitted
?. (is-permitted src.bol path.act) ~
=: author.envelope.act src.bol
when.envelope.act now.bol
==
@ -153,158 +334,154 @@
%add-owned
?> (team:title our.bol src.bol)
=/ chat-path [%mailbox path.act]
?: (~(has by synced) path.act)
[~ state]
=/ chat-wire [%store path.act]
?: (~(has by synced) path.act) [~ state]
=: synced (~(put by synced) path.act our.bol)
allow-history (~(put by allow-history) path.act allow-history.act)
==
:_ state
%+ weld
[%pass chat-path %agent [our.bol %chat-store] %watch chat-path]~
(create-permission [%chat path.act] security.act)
:~ [%pass chat-wire %agent [our.bol %chat-store] %watch chat-path]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%add-synced
?> (team:title our.bol src.bol)
?: (~(has by synced) [(scot %p ship.act) path.act])
[~ state]
=. synced (~(put by synced) [(scot %p ship.act) path.act] ship.act)
?: (~(has by synced) path.act) [~ state]
=. synced (~(put by synced) path.act ship.act)
?. ask-history.act
=/ chat-path [%mailbox (scot %p ship.act) path.act]
=/ chat-path [%mailbox path.act]
:_ state
[%pass chat-path %agent [ship.act %chat-hook] %watch chat-path]~
:: TODO: only ask for backlog from previous point
=/ chat-history [%backlog (scot %p ship.act) (weld path.act /0)]
=/ mailbox=(unit mailbox) (chat-scry path.act)
=/ chat-history=path
:- %backlog
%+ weld path.act
?~(mailbox /0 /(scot %ud (lent envelopes.u.mailbox)))
:_ state
[%pass chat-history %agent [ship.act %chat-hook] %watch chat-history]~
:~ [%pass chat-history %agent [ship.act %chat-hook] %watch chat-history]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%remove
=/ ship (~(get by synced) path.act)
=/ ship=(unit ship)
=/ ship (~(get by synced) path.act)
?^ ship ship
=? path.act ?=([%'~' *] path.act) t.path.act
?~ path.act ~
(slaw %p i.path.act)
?~ ship
~& [dap.bol %unknown-host-cannot-leave path.act]
[~ state]
?: &(=(u.ship our.bol) (team:title our.bol src.bol))
:: delete one of our.bol own paths
:_ state(synced (~(del by synced) path.act))
%- zing
:~ (pull-wire [%backlog (weld path.act /0)])
(pull-wire [%mailbox path.act])
(delete-permission [%chat path.act])
[%give %kick [%mailbox path.act]~ ~]~
==
?. |(=(u.ship src.bol) (team:title our.bol src.bol))
:: if neither ship = source or source = us, do nothing
?: &(!=(u.ship src.bol) ?!((team:title our.bol src.bol)))
[~ state]
:: delete a foreign ship's path
:- (pull-wire [%mailbox path.act])
state(synced (~(del by synced) path.act))
=. synced (~(del by synced) path.act)
:_ state
:* [%give %kick ~[[%mailbox path.act]] ~]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
(pull-wire u.ship [%mailbox path.act])
(pull-backlog-subscriptions u.ship path.act)
==
==
::
++ watch-synced
|= pax=path
^- (list card)
?> (team:title our.bol src.bol)
[%give %fact ~ %chat-hook-update !>([%initial synced])]~
::
++ watch-mailbox
|= pax=path
^- (list card)
?> ?=(^ pax)
?> (~(has by synced) pax)
:: scry permissions to check if read is permitted
?> (permitted-scry [(scot %p src.bol) %chat (weld pax /read)])
:: check if read is permitted
?> (is-permitted src.bol pax)
=/ box (chat-scry pax)
?~ box !!
[%give %fact ~ %chat-update !>([%create (slav %p i.pax) pax])]~
[%give %fact ~ %chat-update !>([%create pax])]~
::
++ watch-backlog
|= pax=path
^- (list card)
?> ?=(^ pax)
=/ last (dec (lent pax))
=/ backlog-start=(unit @ud)
%+ rush
(snag last `(list @ta)`pax)
dem:ag
=/ backlog-latest=(unit @ud) (rush (snag last `(list @ta)`pax) dem:ag)
=/ pas `path`(oust [last 1] `(list @ta)`pax)
?> ?=([* ^] pas)
?> (~(has by synced) pas)
:: scry permissions to check if read is permitted
?> (permitted-scry [(scot %p src.bol) %chat (weld pas /read)])
=/ box (chat-scry pas)
?~ box !!
:- [%give %fact ~ %chat-update !>([%create (slav %p i.pas) pas])]
?> (is-permitted src.bol pas)
=/ envs envelopes:(need (chat-scry pas))
=/ length (lent envs)
=/ latest
?~ backlog-latest length
?: (gth u.backlog-latest length) length
(sub length u.backlog-latest)
=. envs (scag latest envs)
=/ =vase !>([%messages pas 0 latest envs])
%- zing
:~
?: ?&(?=(^ backlog-start) (~(got by allow-history) pas))
(paginate-messages pas u.box u.backlog-start)
~
[%give %kick [%backlog pax]~ `src.bol]~
:~ [%give %fact ~ %chat-update !>([%create pas])]~
?. ?&(?=(^ backlog-latest) (~(has by allow-history) pas)) ~
[%give %fact ~ %chat-update vase]~
[%give %kick [%backlog pax]~ `src.bol]~
==
::
++ paginate-messages
|= [=path =mailbox start=@ud]
^- (list card)
=/ cards=(list card) ~
=/ end (lent envelopes.mailbox)
?: |((gte start end) =(end 0))
cards
=. envelopes.mailbox (slag start `(list envelope)`envelopes.mailbox)
|- ^- (list card)
?~ envelopes.mailbox
cards
?: (lte end 5.000)
=. cards
%+ snoc cards
%- messages-fact
[path start (lent envelopes.mailbox) envelopes.mailbox]
$(envelopes.mailbox ~)
=. cards
%+ snoc cards
%- messages-fact
:^ path start
(add start 5.000)
(scag 5.000 `(list envelope)`envelopes.mailbox)
=: start (add start 5.000)
end (sub end 5.000)
==
$(envelopes.mailbox (slag 5.000 `(list envelope)`envelopes.mailbox))
::
++ fact-invite-update
|= [wir=wire fact=invite-update]
^- (quip card _state)
?+ -.fact
[~ state]
::
:_ state
?+ -.fact ~
%accepted
=/ ask-history
?~ (chat-scry [(scot %p ship.invite.fact) path.invite.fact])
%.y
%.n
:_ state
[(chat-view-poke [%join ship.invite.fact path.invite.fact ask-history])]~
==
=/ ask-history ?~((chat-scry path.invite.fact) %.y %.n)
=* shp ship.invite.fact
=* app-path path.invite.fact
~[(chat-view-poke [%join shp app-path ask-history])]
==
::
++ fact-permission-update
|= [wir=wire fact=permission-update]
^- (quip card _state)
|^
:_ state
?- -.fact
%create ~
%delete ~
?+ -.fact ~
%add (handle-permissions [%add path.fact who.fact])
%remove (handle-permissions [%remove path.fact who.fact])
==
::
++ handle-permissions
|= [kind=?(%add %remove) pax=path who=(set ship)]
^- (list card)
?> ?=([* *] pax)
?. =(%chat i.pax) ~
:: check path to see if this is a %read permission
?. =(%read (snag (dec (lent pax)) `(list @t)`pax))
~
%- zing
%+ turn ~(tap in who)
|= =ship
?: (permitted-scry [(scot %p ship) pax])
~
:: if ship is not permitted, kick their subscription
=/ mail-path
(oust [(dec (lent t.pax)) (lent t.pax)] `(list @t)`t.pax)
[%give %kick [%mailbox mail-path]~ `ship]~
::
++ handle-permissions
|= [kind=?(%add %remove) pax=path who=(set ship)]
^- (list card)
%- zing
%+ turn
(chats-of-group pax)
|= chat=path
^- (list card)
=/ owner (~(get by synced) chat)
?~ owner ~
?. =(u.owner our.bol) ~
%- zing
%+ turn ~(tap in who)
|= =ship
?: (is-permitted ship chat)
?: ?|(=(kind %remove) =(ship our.bol) (is-managed pax)) ~
:: if ship has just been added to the permitted group,
:: send them an invite
~[(send-invite chat ship)]
:: if ship is not permitted, kick their subscription
[%give %kick [%mailbox chat]~ `ship]~
::
++ send-invite
|= [=path =ship]
^- card
=/ =invite [our.bol %chat-hook path ship '']
=/ act=invite-action [%invite /chat (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
--
::
++ fact-chat-update
|= [wir=wire fact=chat-update]
@ -316,16 +493,14 @@
++ handle-local
|= fact=chat-update
^- (quip card _state)
?- -.fact
%keys [~ state]
%read [~ state]
%config [~ state]
%create [~ state]
?+ -.fact [~ state]
%delete
?. (~(has by synced) path.fact)
[~ state]
:_ state(synced (~(del by synced) path.fact))
[%pass [%mailbox path.fact] %agent [our.bol %chat-store] %leave ~]~
?. (~(has by synced) path.fact) [~ state]
=. synced (~(del by synced) path.fact)
:_ state
:~ [%pass [%mailbox path.fact] %agent [our.bol %chat-store] %leave ~]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%message
:_ state
@ -339,28 +514,26 @@
++ handle-foreign
|= fact=chat-update
^- (quip card _state)
?- -.fact
%keys [~ state]
%read [~ state]
%config [~ state]
?+ -.fact [~ state]
%create
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%create ship.fact t.path.fact])]~
[(chat-poke [%create path.fact])]~
::
%delete
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?~ shp
[~ state]
?. =(u.shp src.bol)
[~ state]
:_ state(synced (~(del by synced) path.fact))
?~ shp [~ state]
?. =(u.shp src.bol) [~ state]
=. synced (~(del by synced) path.fact)
:_ state
:- (chat-poke [%delete path.fact])
[%pass [%mailbox path.fact] %agent [src.bol %chat-hook] %leave ~]~
:~ [%pass [%mailbox path.fact] %agent [src.bol %chat-hook] %leave ~]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%message
:_ state
@ -386,43 +559,56 @@
:_ state
[%pass /permissions %agent [our.bol %permission-store] %watch /updates]~
::
?: ?=([%mailbox @ *] wir)
?+ wir !!
[%store @ *]
~& store-kick+wir
?. (~(has by synced) t.wir) [~ state]
~& %chat-store-resubscribe
=/ mailbox=(unit mailbox) (chat-scry t.wir)
:_ state
[%pass wir %agent [our.bol %chat-store] %watch [%mailbox t.wir]]~
::
[%mailbox @ *]
~& mailbox-kick+wir
?. (~(has by synced) t.wir)
:: no-op
[~ state]
?. (~(has by synced) t.wir) [~ state]
~& %chat-hook-resubscribe
=/ =ship (~(got by synced) t.wir)
=/ mailbox=(unit mailbox) (chat-scry t.wir)
=/ chat-history
%+ welp backlog+t.wir
?~ mailbox
/0
/(scot %ud (lent envelopes.u.mailbox))
?~(mailbox /0 /(scot %ud (lent envelopes.u.mailbox)))
:_ state
[%pass chat-history %agent [ship %chat-hook] %watch chat-history]~
::
?: ?=([%backlog @ *] wir)
=/ pax `path`(oust [(dec (lent t.wir)) 1] `(list @ta)`t.wir)
?. (~(has by synced) pax) [~ state]
=/ mailbox=(unit mailbox) (chat-scry pax)
=. pax ?~(mailbox wir [%mailbox pax])
[%backlog @ @ *]
=/ chat=path (oust [(dec (lent t.wir)) 1] `(list @ta)`t.wir)
?. (~(has by synced) chat) [~ state]
=/ =ship
?: =('~' i.t.wir)
(slav %p i.t.t.wir)
(slav %p i.t.wir)
=/ =path ?~((chat-scry chat) wir [%mailbox chat])
:_ state
[%pass pax %agent [(slav %p i.t.wir) %chat-hook] %watch pax]~
!!
[%pass path %agent [ship %chat-hook] %watch path]~
==
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?~ saw
[~ state]
?> ?=(^ wir)
:_ state(synced (~(del by synced) t.wir))
%. ~
%- slog
:* leaf+"chat-hook failed subscribe on {(spud t.wir)}"
leaf+"stack trace:"
u.saw
?~ saw [~ state]
?+ wir [~ state]
[%store @ *]
(poke-chat-hook-action %remove t.wir)
::
[%backlog @ @ @ *]
=/ chat=path (oust [(dec (lent t.wir)) 1] `(list @ta)`t.wir)
:_ state
%. ~[(chat-view-poke %delete chat)]
%- slog
:* leaf+"chat-hook failed subscribe on {(spud chat)}"
leaf+"stack trace:"
u.saw
==
==
::
++ chat-poke
@ -435,57 +621,11 @@
^- card
[%pass / %agent [our.bol %chat-view] %poke %chat-view-action !>(act)]
::
++ permission-poke
|= act=permission-action
^- card
[%pass / %agent [our.bol %permission-store] %poke %permission-action !>(act)]
::
++ invite-poke
|= act=invite-action
^- card
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(act)]
::
++ messages-fact
|= [=path start=@ud end=@ud envelopes=(list envelope)]
^- card
[%give %fact ~ %chat-update !>([%messages path start end envelopes])]
::
++ create-permission
|= [pax=path sec=rw-security]
^- (list card)
=/ read-perm (weld pax /read)
=/ write-perm (weld pax /write)
?- sec
%channel
:~ (permission-poke (sec-to-perm read-perm %black))
(permission-poke (sec-to-perm write-perm %black))
==
::
%village
:~ (permission-poke (sec-to-perm read-perm %white))
(permission-poke (sec-to-perm write-perm %white))
==
::
%journal
:~ (permission-poke (sec-to-perm read-perm %black))
(permission-poke (sec-to-perm write-perm %white))
==
::
%mailbox
:~ (permission-poke (sec-to-perm read-perm %white))
(permission-poke (sec-to-perm write-perm %black))
==
==
::
++ delete-permission
|= pax=path
^- (list card)
=/ read-perm (weld pax /read)
=/ write-perm (weld pax /write)
:~ (permission-poke [%delete read-perm])
(permission-poke [%delete write-perm])
==
::
++ sec-to-perm
|= [pax=path =kind]
^- permission-action
@ -494,27 +634,104 @@
++ chat-scry
|= pax=path
^- (unit mailbox)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
.^((unit mailbox) %gx pax)
%^ scry (unit mailbox)
%chat-store
[%mailbox pax]
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax /=invite-store/(scot %da now.bol)/invite/chat/(scot %uv uid)/noun
.^((unit invite) %gx pax)
%^ scry (unit invite)
%invite-store
/invite/chat/(scot %uv uid)
::
++ permitted-scry
|= pax=path
++ chats-of-group
|= =group-path
^- (list path)
:: if metadata-store isn't running yet, we're still in the upgrade ota phase.
:: we can't get chats from the metadata-store, but can make assumptions
:: about group path shape, and the chat that would match it.
::TODO remove me at some point.
::
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~) ~
%+ murn
^- (list resource)
=; resources
%~ tap in
%+ ~(gut by resources)
group-path
*(set resource)
.^ (jug path resource)
%gy
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
/group-indices
==
|= resource
^- (unit path)
?. =(%chat app-name) ~
`app-path
::
++ groups-of-chat
|= chat=path
^- (list group-path)
:: if metadata-store isn't running yet, we're still in the upgrade ota phase.
:: we can't get groups from the metadata-store, but can make assumptions
:: about chat path shape, and the chat that would match it.
::TODO remove me at some point.
::
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~) ~
=; resources
%~ tap in
%+ ~(gut by resources)
[%chat chat]
*(set group-path)
.^ (jug resource group-path)
%gy
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
/resource-indices
==
::
::NOTE this assumes permission paths match group paths
++ is-permitted
|= [who=ship chat=path]
^- ?
.^(? %gx ;:(weld /=permission-store/(scot %da now.bol)/permitted pax /noun))
%+ lien (groups-of-chat chat)
|= =group-path
%^ scry ?
%permission-store
[%permitted (scot %p who) group-path]
::
++ scry
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bol)
app
(scot %da now.bol)
(snoc `^path`path %noun)
==
::
++ pull-backlog-subscriptions
|= [target=ship chat=path]
^- (list card)
%+ murn ~(tap by wex.bol)
|= [[=wire =ship =term] [acked=? =path]]
^- (unit card)
?. ?& =(ship target)
?=([%backlog *] wire)
=(`1 (find chat wire))
==
~
`(pull-wire target wire)
::
++ pull-wire
|= pax=path
^- (list card)
?> ?=(^ pax)
=/ shp (~(get by synced) t.pax)
?~ shp ~
?: =(u.shp our.bol)
[%pass pax %agent [our.bol %chat-store] %leave ~]~
[%pass pax %agent [u.shp %chat-hook] %leave ~]~
|= [=ship =wire]
^- card
?: =(ship our.bol)
[%pass wire %agent [our.bol %chat-store] %leave ~]
[%pass wire %agent [ship %chat-hook] %leave ~]
--

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

@ -1,16 +1,18 @@
:: chat-store: data store that holds linear sequences of chat messages
::
/+ *chat-json, *chat-eval, default-agent, verb, dbug
~% %chat-store-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
state-one
state-two
==
::
+$ state-zero
$: %0
=inbox
==
+$ state-zero [%0 =inbox]
+$ state-one [%1 =inbox]
+$ state-two [%2 =inbox]
::
+$ diff
$% [%chat-initial inbox]
@ -19,13 +21,14 @@
==
--
::
=| state-zero
=| state-two
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
~% %chat-store-agent-core ..peek-x-envelopes ~
|_ =bowl:gall
+* this .
chat-core +>
@ -35,10 +38,19 @@
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
|= old-vase=vase
=/ old !<(versioned-state old-vase)
?: ?=(%2 -.old)
[~ this(state old)]
=/ reversed-inbox=^inbox
%- ~(run by inbox.old)
|= =mailbox
^- ^mailbox
[config.mailbox (flop envelopes.mailbox)]
[~ this(state [%2 reversed-inbox])]
::
++ on-poke
~/ %chat-store-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
@ -50,10 +62,11 @@
[cards this]
::
++ on-watch
~/ %chat-store-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
?> (team:title our.bowl src.bowl)
=/ cards=(list card)
?+ path (on-watch:def path)
[%keys ~] (give %chat-update !>([%keys ~(key by inbox)]))
@ -62,8 +75,7 @@
[%updates ~] ~
[%mailbox @ *]
?> (~(has by inbox) t.path)
=/ =ship (slav %p i.t.path)
(give %chat-update !>([%create ship t.t.path]))
(give %chat-update !>([%create t.path]))
==
[cards this]
::
@ -75,6 +87,7 @@
::
++ on-leave on-leave:def
++ on-peek
~/ %chat-store-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
@ -102,6 +115,7 @@
--
::
::
~% %chat-store-library ..card ~
|_ bol=bowl:gall
::
++ peek-x-envelopes
@ -153,28 +167,30 @@
?- -.action
%create (handle-create action)
%delete (handle-delete action)
%message (handle-message action)
%messages (handle-messages action)
%read (handle-read action)
%messages (handle-messages action)
%message
?. =(our.bol author.envelope.action)
(handle-message action)
=^ message-moves state (handle-message action)
=^ read-moves state (handle-read [%read path.action])
[(weld message-moves read-moves) state]
==
::
++ handle-create
|= act=chat-action
^- (quip card _state)
?> ?=(%create -.act)
=/ pax [(scot %p ship.act) path.act]
?: (~(has by inbox) pax)
[~ state]
:- (send-diff pax act)
state(inbox (~(put by inbox) pax *mailbox))
?: (~(has by inbox) path.act) [~ state]
:- (send-diff path.act act)
state(inbox (~(put by inbox) path.act *mailbox))
::
++ handle-delete
|= act=chat-action
^- (quip card _state)
?> ?=(%delete -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
?~ mailbox
[~ state]
?~ mailbox [~ state]
:- (send-diff path.act act)
state(inbox (~(del by inbox) path.act))
::
@ -186,8 +202,8 @@
?~ mailbox
[~ state]
=. letter.envelope.act (evaluate-letter [author letter]:envelope.act)
=. u.mailbox (append-envelope u.mailbox envelope.act)
:- (send-diff path.act act)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.act)
:- (send-diff path.act act(envelope envelope))
state(inbox (~(put by inbox) path.act u.mailbox))
::
++ handle-messages
@ -197,20 +213,16 @@
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
?~ mailbox
[~ state]
=. envelopes.act (flop envelopes.act)
=/ evaluated-envelopes=(list envelope) ~
|- ^- (quip card _state)
?~ envelopes.act
:_ state(inbox (~(put by inbox) path.act u.mailbox))
%+ send-diff path.act
:* %messages
path.act
(sub length.config.u.mailbox (lent evaluated-envelopes))
length.config.u.mailbox
evaluated-envelopes
==
[%messages path.act 0 (lent evaluated-envelopes) evaluated-envelopes]
=. letter.i.envelopes.act (evaluate-letter [author letter]:i.envelopes.act)
=. evaluated-envelopes (snoc evaluated-envelopes i.envelopes.act)
=. u.mailbox (append-envelope u.mailbox i.envelopes.act)
=^ envelope u.mailbox (prepend-envelope u.mailbox i.envelopes.act)
=. evaluated-envelopes [envelope evaluated-envelopes]
$(envelopes.act t.envelopes.act)
::
++ handle-read
@ -236,14 +248,14 @@
letter(output (eval bol hoon))
letter
::
++ append-envelope
++ prepend-envelope
|= [=mailbox =envelope]
^- ^mailbox
^+ [envelope mailbox]
=. number.envelope +(length.config.mailbox)
=: length.config.mailbox +(length.config.mailbox)
envelopes.mailbox (snoc envelopes.mailbox envelope)
envelopes.mailbox [envelope envelopes.mailbox]
==
mailbox
[envelope mailbox]
::
++ update-subscribers
|= [pax=path update=chat-update]

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

@ -4,8 +4,11 @@
/- *permission-store,
*permission-hook,
*group-store,
*invite-store,
*metadata-store,
*permission-group-hook,
*chat-hook
*chat-hook,
*metadata-hook
/+ *server, *chat-json, default-agent, verb, dbug
/= index
/^ octs
@ -39,6 +42,7 @@
/^ (map knot @)
/: /===/app/chat/img /_ /png/
::
~% %chat-view-top ..is ~
|%
+$ card card:agent:gall
::
@ -51,10 +55,11 @@
[%permission-group-hook-action permission-group-hook-action]
==
--
%- agent:dbug
%+ verb |
%- agent:dbug
^- agent:gall
=<
~% %chat-view-agent-core ..poke-handle-http-request ~
|_ bol=bowl:gall
+* this .
chat-core +>
@ -63,13 +68,14 @@
::
++ on-init
^- (quip card _this)
=/ launcha [%launch-action !>([%chat-view /configs '/~chat/js/tile.js'])]
=/ launcha [%launch-action !>([%add %chat-view /configs '/~chat/js/tile.js'])]
:_ this
:~ [%pass /updates %agent [our.bol %chat-store] %watch /updates]
[%pass / %arvo %e %connect [~ /'~chat'] %chat-view]
[%pass /chat-view %agent [our.bol %launch] %poke launcha]
==
++ on-poke
~/ %chat-view-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bol src.bol)
@ -91,6 +97,7 @@
==
::
++ on-watch
~/ %chat-view-watch
|= =path
^- (quip card _this)
?> (team:title our.bol src.bol)
@ -98,7 +105,7 @@
?: ?=([%http-response *] path)
[~ this]
?: =(/primary path)
:: create inbox with 100 messages max per mailbox and send that along
:: create inbox with 20 messages max per mailbox and send that along
:: then quit the subscription
:_ this
[%give %fact ~ %json !>((inbox-to-json truncated-inbox-scry))]~
@ -106,24 +113,19 @@
[[%give %fact ~ %json !>(*json)]~ this]
(on-watch:def path)
::
++ message-limit 20
::
++ truncated-inbox-scry
^- inbox
=/ =inbox .^(inbox %gx /=chat-store/(scot %da now.bol)/all/noun)
%- ~(run by inbox)
|= =mailbox
^- ^mailbox
[config.mailbox (truncate-envelopes envelopes.mailbox)]
::
++ truncate-envelopes
|= envelopes=(list envelope)
^- (list envelope)
=/ length (lent envelopes)
?: (lth length 100)
envelopes
(swag [(sub length 100) 100] envelopes)
[config.mailbox (scag message-limit envelopes.mailbox)]
--
::
++ on-agent
~/ %chat-view-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
@ -140,6 +142,7 @@
==
::
++ on-arvo
~/ %chat-view-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=(%bound +<.sign-arvo)
@ -154,6 +157,7 @@
--
::
::
~% %chat-view-library ..card ~
|_ bol=bowl:gall
::
++ poke-handle-http-request
@ -188,53 +192,290 @@
++ poke-json
|= jon=json
^- (list card)
?. =(src.bol our.bol)
~
?> (team:title our.bol src.bol)
(poke-chat-view-action (json-to-view-action jon))
::
++ poke-chat-view-action
|= act=chat-view-action
^- (list card)
?. =(src.bol our.bol)
~
|^
?> (team:title our.bol src.bol)
?- -.act
%create
=/ pax [(scot %p our.bol) path.act]
=/ group-read=path [%chat (weld pax /read)]
=/ group-write=path [%chat (weld pax /write)]
?> ?=(^ app-path.act)
?> |(=(group-path.act app-path.act) =(~(tap in members.act) ~))
?^ (chat-scry app-path.act)
~& %chat-already-exists
~
%- zing
:~ :~ (group-poke [%bundle group-read])
(group-poke [%bundle group-write])
(group-poke [%add read.act group-read])
(group-poke [%add write.act group-write])
(chat-poke [%create our.bol path.act])
(chat-hook-poke [%add-owned pax security.act allow-history.act])
==
(create-security [%chat pax] security.act)
:~ (permission-hook-poke [%add-owned group-read group-read])
(permission-hook-poke [%add-owned group-write group-read])
:~ (create-chat app-path.act allow-history.act)
%- create-group
:* group-path.act
app-path.act
security.act
members.act
title.act
description.act
==
(create-metadata title.act description.act group-path.act app-path.act)
==
::
%delete
=/ group-read [%chat (weld path.act /read)]
=/ group-write [%chat (weld path.act /write)]
:~ (chat-hook-poke [%remove path.act])
(permission-hook-poke [%remove group-read])
(permission-hook-poke [%remove group-write])
(group-poke [%unbundle group-read])
(group-poke [%unbundle group-write])
(chat-poke [%delete path.act])
?> ?=(^ app-path.act)
:: always just delete the chat from chat-store
::
:+ (chat-hook-poke [%remove app-path.act])
(chat-poke [%delete app-path.act])
:: if we still have metadata for the chat, remove it, and the associated
:: group if it's unmanaged
::
:: we aren't guaranteed to have metadata: the chat might have been
:: deleted by the host, which pushes metadata deletion down to us.
::
=/ group-path=(unit path)
(maybe-group-from-chat app-path.act)
?~ group-path ~
=* group u.group-path
%- zing
:~ ?. (is-creator group %chat app-path.act) ~
[(metadata-poke [%remove group [%chat app-path.act]])]~
::
?: (is-managed group) ~
:~ (group-poke [%unbundle group])
(metadata-hook-poke [%remove group])
(metadata-store-poke [%remove group [%chat app-path.act]])
==
==
::
%join
=/ group-read [%chat (scot %p ship.act) (weld path.act /read)]
=/ group-write [%chat (scot %p ship.act) (weld path.act /write)]
:~ (chat-hook-poke [%add-synced ship.act path.act ask-history.act])
(permission-hook-poke [%add-synced ship.act group-write])
(permission-hook-poke [%add-synced ship.act group-read])
=/ group-path
?. (is-managed app-path.act) app-path.act
(group-from-chat app-path.act)
:~ (chat-hook-poke [%add-synced ship.act app-path.act ask-history.act])
(permission-hook-poke [%add-synced ship.act group-path])
(metadata-hook-poke [%add-synced ship.act group-path])
==
::
%groupify
?> ?=([%'~' ^] app-path.act)
:: retrieve old data
::
=/ data=(unit mailbox)
(scry-for (unit mailbox) %chat-store [%mailbox app-path.act])
?~ data
~& [%cannot-groupify-nonexistent app-path.act]
~
=/ permission=(unit permission)
(scry-for (unit permission) %permission-store [%permission app-path.act])
?: |(?=(~ permission) ?=(%black kind.u.permission))
~& [%cannot-groupify-blacklist app-path.act]
~
=/ =metadata
=- (fall - *metadata)
%^ scry-for (unit metadata)
%metadata-store
=/ encoded-path=@ta
(scot %t (spat app-path.act))
/metadata/[encoded-path]/chat/[encoded-path]
:: figure out new data
::
=/ chat-path=^path (slag 1 `path`app-path.act)
:: group-path: the group to associate with the chat
:: members: members of group, if it's new
:: new-members: new members of group, if it already exists
::
=/ [group-path=path members=(set ship) new-members=(set ship)]
?~ existing.act
[chat-path who.u.permission ~]
:+ group-path.u.existing.act
~
?. inclusive.u.existing.act ~
%- ~(dif in who.u.permission)
~| [%groupifying-with-nonexistent-group group-path.u.existing.act]
%- need
(group-scry group-path.u.existing.act)
:: make changes
::
;: weld
:: delete the old chat
::
(poke-chat-view-action %delete app-path.act)
::
:: create the new chat. if needed, creates the new group.
::
%- poke-chat-view-action
:* %create
title.metadata
description.metadata
chat-path
group-path
%village
members
&
==
::
:: if needed, add members to the existing group
::
?~ new-members ~
[(group-poke [%add new-members group-path])]~
::
:: import messages into the new chat
::
[(chat-poke %messages chat-path envelopes.u.data)]~
==
==
::
++ create-chat
|= [=path history=?]
^- (list card)
:~ (chat-poke [%create path])
(chat-hook-poke [%add-owned path history])
==
::
++ create-group
|= [=path app-path=path sec=rw-security ships=(set ship) title=@t desc=@t]
^- (list card)
?^ (group-scry path) ~
:: do not create a managed group if this is a sig path or a blacklist
::
?: =(sec %channel)
:~ (group-poke [%bundle path])
(create-security path sec)
(permission-hook-poke [%add-owned path path])
==
?: (is-managed path)
~[(contact-view-poke [%create path ships title desc])]
%+ welp
:~ (group-poke [%bundle path])
(group-poke [%add ships path])
(create-security path sec)
(permission-hook-poke [%add-owned path path])
==
%- zing
%+ turn ~(tap in ships)
|= =ship
?: =(ship our.bol) ~
[(send-invite app-path ship)]~
::
++ create-security
|= [pax=path sec=rw-security]
^- card
?+ sec !!
%channel
(perm-group-hook-poke [%associate pax [[pax %black] ~ ~]])
::
%village
(perm-group-hook-poke [%associate pax [[pax %white] ~ ~]])
==
::
++ create-metadata
|= [title=@t description=@t group-path=path app-path=path]
^- (list card)
=/ =metadata
%* . *metadata
title title
description description
date-created now.bol
creator
%+ slav %p
?: (is-managed app-path) (snag 0 app-path)
(snag 1 app-path)
==
:~ (metadata-poke [%add group-path [%chat app-path] metadata])
(metadata-hook-poke [%add-owned group-path])
==
::
++ contact-view-poke
|= act=[%create =path ships=(set ship) title=@t description=@t]
^- card
[%pass / %agent [our.bol %contact-view] %poke %contact-view-action !>(act)]
::
++ metadata-poke
|= act=metadata-action
^- card
[%pass / %agent [our.bol %metadata-hook] %poke %metadata-action !>(act)]
::
++ metadata-store-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)
==
::
++ send-invite
|= [=path =ship]
^- card
=/ =invite
:* our.bol %chat-hook
path ship ''
==
=/ act=invite-action [%invite /chat (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
::
++ chat-scry
|= pax=path
^- (unit mailbox)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
.^((unit mailbox) %gx pax)
::
++ maybe-group-from-chat
|= app-path=path
^- (unit path)
?. .^(? %gu (scot %p our.bol) %metadata-store (scot %da now.bol) ~)
?: ?=([@ ^] app-path)
~& [%assuming-ported-legacy-chat app-path]
`[%'~' app-path]
~& [%weird-chat app-path]
!!
=/ resource-indices
.^ (jug resource group-path)
%gy
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
/resource-indices
==
=/ groups=(set path)
%+ fall
(~(get by resource-indices) [%chat app-path])
*(set path)
?~ groups ~
`n.groups
::
++ group-from-chat
(cork maybe-group-from-chat need)
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
::
++ is-creator
|= [group-path=path app-name=@ta app-path=path]
^- ?
=/ meta=(unit metadata)
.^ (unit metadata)
%gx
(scot %p our.bol)
%metadata-store
(scot %da now.bol)
%metadata
(scot %t (spat group-path))
app-name
(scot %t (spat app-path))
/noun
==
?~ meta !!
=(our.bol creator.u.meta)
--
::
++ diff-chat-update
|= upd=chat-update
@ -257,6 +498,11 @@
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ permission-poke
|= act=permission-action
^- card
[%pass / %agent [our.bol %permission-store] %poke %permission-action !>(act)]
::
++ chat-hook-poke
|= act=chat-hook-action
^- card
@ -279,37 +525,24 @@
++ envelope-scry
|= pax=path
^- (list envelope)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/envelopes pax /noun)
.^((list envelope) %gx pax)
(scry-for (list envelope) %chat-store [%envelopes pax])
::
++ configs-scry
^- chat-configs
.^(chat-configs %gx /=chat-store/(scot %da now.bol)/configs/noun)
(scry-for chat-configs %chat-store /configs)
::
++ create-security
|= [pax=path sec=rw-security]
^- (list card)
=/ read (weld pax /read)
=/ write (weld pax /write)
?- sec
%channel
:~ (perm-group-hook-poke [%associate read [[read %black] ~ ~]])
(perm-group-hook-poke [%associate write [[write %black] ~ ~]])
==
::
%village
:~ (perm-group-hook-poke [%associate read [[read %white] ~ ~]])
(perm-group-hook-poke [%associate write [[write %white] ~ ~]])
==
::
%journal
:~ (perm-group-hook-poke [%associate read [[read %black] ~ ~]])
(perm-group-hook-poke [%associate write [[write %white] ~ ~]])
==
::
%mailbox
:~ (perm-group-hook-poke [%associate read [[read %white] ~ ~]])
(perm-group-hook-poke [%associate write [[write %black] ~ ~]])
==
++ group-scry
|= pax=path
^- (unit group)
(scry-for (unit group) %group-store pax)
::
++ scry-for
|* [=mold app=term =path]
.^ mold
%gx
(scot %p our.bol)
app
(scot %da now.bol)
(snoc `^path`path %noun)
==
--

4
pkg/arvo/app/chat/css/index.css
View File

File diff suppressed because one or more lines are too long

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 866 B

After

Width:  |  Height:  |  Size: 1.3 KiB

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 861 B

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/chat/img/CodeEval.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 611 B

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

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 255 B

BIN
pkg/arvo/app/chat/img/ImageUpload.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 865 B

BIN
pkg/arvo/app/chat/img/Spinner.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.7 KiB

After

Width:  |  Height:  |  Size: 4.7 KiB

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 854 B

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
pkg/arvo/app/chat/img/search.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

5
pkg/arvo/app/chat/index.html
View File

@ -22,9 +22,10 @@
</head>
<body>
<div id="root" />
<script src="/~/channel/channel.js"></script>
<div id="root"/>
<script src="/~channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~chat/js/index.js"></script>
<script src="https://sdk.amazonaws.com/js/aws-sdk-2.1.12.min.js"></script>
</body>
</html>

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

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/chat/js/tile.js
View File

File diff suppressed because one or more lines are too long

9
pkg/arvo/app/claz.hoon
View File

@ -417,14 +417,17 @@
:* to
(mul windup-years yer:yo)
stars
(div (mul unlock-years yer:yo) stars)
1
(div (mul unlock-years yer:yo) stars)
==
::
++ register-conditional
|= [to=address [b1=@ud b2=@ud b3=@ud] unlock-years-per-batch=@ud]
%- register-conditional:dat
=- [`address`to b1 b2 b3 `@ud`- 1]
(div (mul unlock-years-per-batch yer:yo) :(add b1 b2 b3))
:* to
b1 b2 b3
1
(div (mul unlock-years-per-batch yer:yo) :(add b1 b2 b3))
==
::
--

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

@ -1,4 +1,4 @@
/+ *server, default-agent, verb
/+ *server, default-agent, verb, dbug
/= tile-js
/^ octs
/; as-octs:mimes:html
@ -8,7 +8,18 @@
==
=, format
::
|%
::
+$ card card:agent:gall
+$ versioned-state
$% state-zero
==
+$ state-zero [%0 data=json]
--
%+ verb |
%- agent:dbug
=| state-zero
=* state -
^- agent:gall
|_ =bowl:gall
+* this .
@ -17,20 +28,28 @@
++ on-init
^- (quip card:agent:gall _this)
=/ launcha
[%launch-action !>([%clock /tile '/~clock/js/tile.js'])]
[%launch-action !>([%add %clock /clocktile '/~clock/js/tile.js'])]
:_ this
:~ [%pass / %arvo %e %connect [~ /'~clock'] %clock]
[%pass /clock %agent [our.bowl %launch] %poke launcha]
==
:: bootstrapping to get %goad started OTA
::
++ on-save !>(%2)
++ on-save !>(%3)
++ on-load
|= old-state=vase
=/ old !<(?(~ %1 %2) old-state)
^- (quip card _this)
=/ old !<(?(~ %1 %2 %3) old-state)
=^ cards this
?: ?=(%2 old)
?: ?=(%3 old)
`this
?: ?=(%2 old)
:: ensure launch is set up to listen to us correctly
::
=/ launcha
[%launch-action !>([%add %clock /clocktile '/~clock/js/tile.js'])]
:_ this
[%pass /clock %agent [our.bowl %launch] %poke launcha]~
:_ this :_ ~
[%pass /behn %arvo %b %wait +(now.bowl)]
::
@ -39,6 +58,9 @@
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall _this)
|^
?: ?=(%json mark)
(poke-json !<(json vase))
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
@ -59,15 +81,23 @@
?: =(name 'tile')
(js-response:gen tile-js)
not-found:gen
::
++ poke-json
|= jon=json
^- (quip card:agent:gall _this)
=. data.state jon
:_ this
[%give %fact ~[/clocktile] %json !>(jon)]~
--
::
++ on-watch
|= =path
^- (quip card:agent:gall _this)
?: ?=([%http-response *] path)
`this
?. =(/tile path)
?. =(/clocktile path)
(on-watch:def path)
[[%give %fact ~ %json !>(*json)]~ this]
[[%give %fact ~ %json !>(data.state)]~ this]
::
++ on-leave on-leave:def
++ on-peek on-peek:def

2
pkg/arvo/app/clock/js/tile.js
View File

File diff suppressed because one or more lines are too long

483
pkg/arvo/app/contact-hook.hoon Normal file
View File

@ -0,0 +1,483 @@
:: contact-hook:
::
/- *group-store,
*group-hook,
*contact-hook,
*invite-store,
*metadata-hook,
*metadata-store
/+ *contact-json, default-agent, dbug
~% %contact-hook-top ..is ~
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
state-one
==
::
+$ state-zero [%0 state-base]
+$ state-one [%1 state-base]
+$ state-base
$: =synced
invite-created=_|
==
--
=| state-one
=* state -
%- agent:dbug
^- agent:gall
=<
|_ bol=bowl:gall
+* this .
contact-core +>
cc ~(. contact-core bol)
def ~(. (default-agent this %|) bol)
::
++ on-init
^- (quip card _this)
:_ this(invite-created %.y)
:~ (invite-poke:cc [%create /contacts])
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]
[%pass /group %agent [our.bol %group-store] %watch /updates]
==
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
[~ this(state old)]
=/ upgraded-state
%* . *state-one
synced synced
invite-created invite-created
==
:_ this(state upgraded-state)
[%pass /group %agent [our.bol %group-store] %watch /updates]~
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
=^ cards state
?+ mark (on-poke:def mark vase)
%json
(poke-json:cc !<(json vase))
::
%contact-action
(poke-contact-action:cc !<(contact-action vase))
::
%contact-hook-action
(poke-hook-action:cc !<(contact-hook-action vase))
==
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%contacts *] [(watch-contacts:cc t.path) this]
[%synced *] [(watch-synced:cc t.path) this]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick [(kick:cc wire) this]
%watch-ack
=^ cards state
(watch-ack:cc wire p.sign)
[cards this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%contact-update
=^ cards state
(fact-contact-update:cc wire !<(contact-update q.cage.sign))
[cards this]
::
%group-update
=^ cards state
(fact-group-update:cc wire !<(group-update q.cage.sign))
[cards this]
::
%invite-update
=^ cards state
(fact-invite-update:cc wire !<(invite-update q.cage.sign))
[cards this]
==
==
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
::
++ poke-json
|= jon=json
^- (quip card _state)
(poke-contact-action (json-to-action jon))
::
++ poke-contact-action
|= act=contact-action
^- (quip card _state)
:_ state
?+ -.act !!
%edit (handle-contact-action path.act ship.act act)
%add (handle-contact-action path.act ship.act act)
%remove (handle-contact-action path.act ship.act act)
==
::
++ handle-contact-action
|= [=path =ship act=contact-action]
^- (list card)
:: local
?: (team:title our.bol src.bol)
?. (~(has by synced) path) ~
=/ shp ?:(=(path /~/default) our.bol (~(got by synced) path))
=/ appl ?:(=(shp our.bol) %contact-store %contact-hook)
[%pass / %agent [shp appl] %poke %contact-action !>(act)]~
:: foreign
=/ shp (~(got by synced) path)
?. |(=(shp our.bol) =(src.bol ship)) ~
:: scry group to check if ship is a member
=/ =group (need (group-scry path))
?. (~(has in group) shp) ~
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]~
::
++ poke-hook-action
|= act=contact-hook-action
^- (quip card _state)
?- -.act
%add-owned
?> (team:title our.bol src.bol)
=/ contact-path [%contacts path.act]
?: (~(has by synced) path.act)
[~ state]
=. synced (~(put by synced) path.act our.bol)
:_ state
:~ [%pass contact-path %agent [our.bol %contact-store] %watch contact-path]
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]
==
::
%add-synced
?> (team:title our.bol src.bol)
?: (~(has by synced) path.act) [~ state]
=. synced (~(put by synced) path.act ship.act)
=/ contact-path [%contacts path.act]
:_ state
:~ [%pass contact-path %agent [ship.act %contact-hook] %watch contact-path]
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]
==
::
%remove
=/ ship (~(get by synced) path.act)
?~ ship [~ state]
?: &(=(u.ship our.bol) (team:title our.bol src.bol))
:: delete one of our.bol own paths
:_ state(synced (~(del by synced) path.act))
%- zing
:~ (pull-wire [%contacts path.act])
[%give %kick ~[[%contacts path.act]] ~]~
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]~
==
?. |(=(u.ship src.bol) (team:title our.bol src.bol))
:: if neither ship = source or source = us, do nothing
[~ state]
:: delete a foreign ship's path
=/ cards
(handle-contact-action path.act our.bol [%remove path.act our.bol])
:_ state(synced (~(del by synced) path.act))
%- zing
:~ (pull-wire [%contacts path.act])
[%give %fact [/synced]~ %contact-hook-update !>([%initial synced])]~
cards
==
==
::
++ watch-contacts
|= pax=path
^- (list card)
?> ?=(^ pax)
?> (~(has by synced) pax)
:: scry groups to check if ship is a member
=/ =group (need (group-scry pax))
?> (~(has in group) src.bol)
=/ contacts (need (contacts-scry pax))
[%give %fact ~ %contact-update !>([%contacts pax contacts])]~
::
++ watch-synced
|= pax=path
^- (list card)
?> (team:title our.bol src.bol)
[%give %fact ~ %contact-hook-update !>([%initial synced])]~
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?~ saw
[~ state]
?> ?=(^ wir)
[~ state(synced (~(del by synced) t.wir))]
::
++ kick
|= wir=wire
^- (list card)
?+ wir !!
[%inv ~]
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]~
::
[%group ~]
[%pass /group %agent [our.bol %group-store] %watch /updates]~
::
[%contacts @ *]
?. (~(has by synced) t.wir) ~
=/ =ship (~(got by synced) t.wir)
?: =(ship our.bol)
[%pass wir %agent [our.bol %contact-store] %watch wir]~
[%pass wir %agent [ship %contact-hook] %watch wir]~
==
::
++ fact-contact-update
|= [wir=wire fact=contact-update]
^- (quip card _state)
|^
?: (team:title our.bol src.bol)
(local fact)
:_ state
(foreign fact)
::
++ give-fact
|= [=path update=contact-update]
^- (list card)
[%give %fact ~[[%contacts path]] %contact-update !>(update)]~
::
++ local
|= fact=contact-update
^- (quip card _state)
?+ -.fact [~ state]
%add
:_ state
(give-fact path.fact [%add path.fact ship.fact contact.fact])
::
%edit
:_ state
(give-fact path.fact [%edit path.fact ship.fact edit-field.fact])
::
%remove
:_ state
~[(group-poke [%remove [ship.fact ~ ~] path.fact])]
::
%delete
=. synced (~(del by synced) path.fact)
:_ state
:~ (group-poke [%unbundle path.fact])
(metadata-hook-poke [%remove path.fact])
(metadata-poke [%remove path.fact [%contacts path.fact]])
==
==
::
++ foreign
|= fact=contact-update
^- (list card)
?+ -.fact ~
%contacts
=/ owner (~(got by synced) path.fact)
?> =(owner src.bol)
=/ have-contacts=(unit contacts)
(contacts-scry path.fact)
?~ have-contacts
:: if we don't have any contacts yet,
:: create the entry, and %add every contact
::
:- (contact-poke [%create path.fact])
%+ turn ~(tap by contacts.fact)
|= [=ship =contact]
(contact-poke [%add path.fact ship contact])
:: if we already have some, decide between %add, %remove and recreate
:: on a per-contact basis
::
%- zing
%+ turn
%~ tap in
%- ~(uni in ~(key by contacts.fact))
~(key by u.have-contacts)
|= =ship
^- (list card)
=/ have=(unit contact) (~(get by u.have-contacts) ship)
=/ want=(unit contact) (~(get by contacts.fact) ship)
?~ have
[(contact-poke %add path.fact ship (need want))]~
?~ want
[(contact-poke %remove path.fact ship)]~
?: =(u.want u.have) ~
::TODO probably want an %all edit-field that resolves to more granular
:: updates within the contact-store?
:~ (contact-poke %remove path.fact ship)
(contact-poke %add path.fact ship u.want)
==
::
%add
=/ owner (~(get by synced) path.fact)
?~ owner ~
?> |(=(u.owner src.bol) =(src.bol ship.fact))
~[(contact-poke [%add path.fact ship.fact contact.fact])]
::
%remove
=/ owner (~(get by synced) path.fact)
?~ owner ~
?> |(=(u.owner src.bol) =(src.bol ship.fact))
%+ welp
:~ (group-poke [%remove [ship.fact ~ ~] path.fact])
(contact-poke [%remove path.fact ship.fact])
==
?. =(ship.fact our.bol) ~
~[(group-poke [%unbundle path.fact])]
::
%edit
=/ owner (~(got by synced) path.fact)
?> |(=(owner src.bol) =(src.bol ship.fact))
~[(contact-poke [%edit path.fact ship.fact edit-field.fact])]
==
--
::
++ fact-group-update
|= [wir=wire fact=group-update]
^- (quip card _state)
|^
?+ -.fact [~ state]
%add (add +.fact)
%remove (remove +.fact)
%unbundle (unbundle +.fact)
==
++ add
|= [ships=(set ship) =path]
^- (quip card _state)
=/ owner (~(get by synced) path)
?~ owner [~ state]
?. =(u.owner our.bol) [~ state]
:_ state
%+ turn ~(tap in (~(del in ships) our.bol))
|= =ship
(send-invite-poke path ship)
::
++ unbundle
|= =path
^- (quip card _state)
?. (~(has by synced) path)
:_ state
[(contact-poke [%delete path])]~
:_ state(synced (~(del by synced) path))
:~ [%pass [%contacts path] %agent [our.bol %contact-store] %leave ~]
[(contact-poke [%delete path])]
==
::
++ remove
|= [members=group =path]
^- (quip card _state)
:: if pax is synced, remove member from contacts and kick their sub
=/ owner=(unit ship) (~(get by synced) path)
?~ owner
:_ state
%+ turn ~(tap in members)
|= =ship
(contact-poke [%remove path ship])
:_ state
%- zing
%+ turn ~(tap in members)
|= =ship
:~ [%give %kick ~[[%contacts path]] `ship]
?: =(ship our.bol)
(contact-poke [%delete path])
(contact-poke [%remove path ship])
==
::
++ send-invite-poke
|= [=path =ship]
^- card
=/ =invite
:* our.bol %contact-hook
path ship ''
==
=/ act=invite-action [%invite /contacts (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
--
::
++ fact-invite-update
|= [wir=wire fact=invite-update]
^- (quip card _state)
?+ -.fact [~ state]
%accepted
=/ changes
(poke-hook-action [%add-synced ship.invite.fact path.invite.fact])
:-
%+ welp
:~ (group-hook-poke [%add ship.invite.fact path.invite.fact])
(metadata-hook-poke [%add-synced ship.invite.fact path.invite.fact])
==
-.changes
+.changes
==
::
++ group-hook-poke
|= act=group-hook-action
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
::
++ invite-poke
|= act=invite-action
^- card
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(act)]
::
++ contact-poke
|= act=contact-action
^- card
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
::
++ group-poke
|= act=group-action
^- 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)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contacts pax /noun)
.^((unit contacts) %gx pax)
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax
/=invite-store/(scot %da now.bol)/invite/contacts/(scot %uv uid)/noun
.^((unit invite) %gx pax)
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
::
++ pull-wire
|= pax=path
^- (list card)
?> ?=(^ pax)
=/ shp (~(get by synced) t.pax)
?~ shp ~
?: =(u.shp our.bol)
[%pass pax %agent [our.bol %contact-store] %leave ~]~
[%pass pax %agent [u.shp %contact-hook] %leave ~]~
--

214
pkg/arvo/app/contact-store.hoon Normal file
View File

@ -0,0 +1,214 @@
:: contact-store: data store that holds group-based contact data
::
/+ *contact-json, default-agent, dbug
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
state-one
==
::
+$ rolodex-0 (map path contacts-0)
+$ contacts-0 (map ship contact-0)
+$ avatar-0 [content-type=@t octs=[p=@ud q=@t]]
+$ contact-0
$: nickname=@t
email=@t
phone=@t
website=@t
notes=@t
color=@ux
avatar=(unit avatar-0)
==
::
+$ state-zero
$: %0
rolodex=rolodex-0
==
+$ state-one
$: %1
=rolodex
==
--
::
=| state-one
=* state -
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
contact-core +>
cc ~(. contact-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old-vase=vase
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
[~ this(state old)]
=/ new-rolodex=^rolodex
%- ~(run by rolodex.old)
|= cons=contacts-0
^- contacts
%- ~(run by cons)
|= con=contact-0
^- contact
:* nickname.con
email.con
phone.con
website.con
notes.con
color.con
~
==
[~ this(state [%1 new-rolodex])]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
::%json (poke-json:cc !<(json vase))
%contact-action (poke-contact-action:cc !<(contact-action 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 %contact-update !>([%rolodex rolodex]))
[%updates ~] ~
[%contacts @ *]
%+ give %contact-update
!>([%contacts t.path (~(got by rolodex) t.path)])
==
[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 %all ~] ``noun+!>(rolodex)
[%x %contacts *]
?~ t.t.path
~
``noun+!>((~(get by rolodex) t.t.path))
::
[%x %contact *]
:: /:path/:ship
=/ pax `^path`(flop t.t.path)
?~ pax ~
=/ =ship (slav %p i.pax)
?~ t.pax ~
=> .(pax `(list @ta)`(flop t.pax))
=/ contacts=(unit contacts) (~(get by rolodex) pax)
?~ contacts
~
``noun+!>((~(get by u.contacts) ship))
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
::
|_ bol=bowl:gall
::
::++ poke-json
:: |= =json
:: ^- (quip move _this)
:: ?> (team:title our.bol src.bol)
:: (poke-contact-action (json-to-action json))
::
++ poke-contact-action
|= action=contact-action
^- (quip card _state)
?> (team:title our.bol src.bol)
?- -.action
%create (handle-create +.action)
%delete (handle-delete +.action)
%add (handle-add +.action)
%remove (handle-remove +.action)
%edit (handle-edit +.action)
==
::
++ handle-create
|= =path
^- (quip card _state)
?< (~(has by rolodex) path)
:- (send-diff path [%create path])
state(rolodex (~(put by rolodex) path *contacts))
::
++ handle-delete
|= =path
^- (quip card _state)
?. (~(has by rolodex) path) [~ state]
:- (send-diff path [%delete path])
state(rolodex (~(del by rolodex) path))
::
++ handle-add
|= [=path =ship =contact]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
?< (~(has by contacts) ship)
=. contacts (~(put by contacts) ship contact)
:- (send-diff path [%add path ship contact])
state(rolodex (~(put by rolodex) path contacts))
::
++ handle-remove
|= [=path =ship]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
?. (~(has by contacts) ship) [~ state]
=. contacts (~(del by contacts) ship)
:- (send-diff path [%remove path ship])
state(rolodex (~(put by rolodex) path contacts))
::
++ handle-edit
|= [=path =ship =edit-field]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
=/ contact (~(got by contacts) ship)
=. contact (edit-contact contact edit-field)
=. contacts (~(put by contacts) ship contact)
:- (send-diff path [%edit path ship edit-field])
state(rolodex (~(put by rolodex) path contacts))
::
++ edit-contact
|= [con=contact edit=edit-field]
^- contact
?- -.edit
%nickname con(nickname nickname.edit)
%email con(email email.edit)
%phone con(phone phone.edit)
%website con(website website.edit)
%notes con(notes notes.edit)
%color con(color color.edit)
%avatar con(avatar avatar.edit)
==
::
++ send-diff
|= [pax=path upd=contact-update]
^- (list card)
:~ :*
%give %fact
~[/all /updates [%contacts pax]]
%contact-update !>(upd)
== ==
--

282
pkg/arvo/app/contact-view.hoon Normal file
View File

@ -0,0 +1,282 @@
:: contact-view: sets up contact JS client and combines commands
:: into semantic actions for the UI
::
/- *group-store,
*group-hook,
*invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
*permission-group-hook,
*permission-hook
/+ *server, *contact-json, default-agent, dbug
/= index
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/index
/| /html/
/~ ~
==
/= tile-js
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/js/tile
/| /js/
/~ ~
==
/= script
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/js/index
/| /js/
/~ ~
==
/= style
/^ octs
/; as-octs:mimes:html
/: /===/app/contacts/css/index
/| /css/
/~ ~
==
/= contact-png
/^ (map knot @)
/: /===/app/contacts/img /_ /png/
::
|%
+$ card card:agent:gall
--
=* state -
::
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
contact-core +>
cc ~(. contact-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
:~ [%pass /updates %agent [our.bowl %contact-store] %watch /updates]
[%pass / %arvo %e %connect [~ /'~groups'] %contact-view]
(contact-poke:cc [%create /~/default])
(group-poke:cc [%bundle /~/default])
(contact-poke:cc [%add /~/default our.bowl *contact])
(group-poke:cc [%add [our.bowl ~ ~] /~/default])
==
::
++ on-save on-save:def
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?+ mark (on-poke:def mark vase)
%json [(poke-json:cc !<(json vase)) this]
%contact-view-action
[(poke-contact-view-action:cc !<(contact-view-action vase)) this]
::
%handle-http-request
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
:_ this
%+ give-simple-payload:app eyre-id
%+ require-authorization:app inbound-request
poke-handle-http-request:cc
==
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?: ?=([%http-response *] path) [~ this]
?. =(/primary path) (on-watch:def path)
[[%give %fact ~ %json !>((rolodex-to-json all-scry:cc))]~ this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick
[[%pass / %agent [our.bol %contact-store] %watch /updates]~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%contact-update
=/ update=json (update-to-json !<(contact-update q.cage.sign))
[[%give %fact ~[/primary] %json !>(update)]~ this]
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
++ poke-json
|= jon=json
^- (list card)
?> (team:title our.bol src.bol)
(poke-contact-view-action (json-to-view-action jon))
::
++ poke-contact-view-action
|= act=contact-view-action
^- (list card)
?- -.act
%create
?> ?=([@ *] path.act)
%+ weld
:~ (group-poke [%bundle path.act])
(contact-poke [%create path.act])
(contact-hook-poke [%add-owned path.act])
(group-hook-poke [%add our.bol path.act])
(group-poke [%add (~(put in ships.act) our.bol) path.act])
(perm-group-hook-poke [%associate path.act [[path.act %white] ~ ~]])
(permission-hook-poke [%add-owned path.act path.act])
==
(create-metadata path.act title.act description.act)
::
%delete
%+ weld
:~ (contact-hook-poke [%remove path.act])
(group-poke [%unbundle path.act])
(contact-poke [%delete path.act])
==
(delete-metadata path.act)
::
%remove
:~ (group-poke [%remove [ship.act ~ ~] path.act])
(contact-poke [%remove path.act ship.act])
==
::
%share
:: determine whether to send to our contact-hook or foreign
:: send contact-action to contact-hook with %add action
[(share-poke recipient.act [%add path.act ship.act contact.act])]~
==
++ poke-handle-http-request
|= =inbound-request:eyre
^- simple-payload:http
=+ url=(parse-request-line url.request.inbound-request)
=/ name=@t
=+ back-path=(flop site.url)
?~ back-path
''
i.back-path
?+ site.url not-found:gen
[%'~groups' %css %index ~] (css-response:gen style)
[%'~groups' %js %index ~] (js-response:gen script)
[%'~groups' %js %tile ~] (js-response:gen tile-js)
[%'~groups' %img *]
(png-response:gen (as-octs:mimes:html (~(got by contact-png) `@ta`name)))
::
:: avatar images
::
[%'~groups' %avatar @ *]
=/ =path (flop t.t.site.url)
?~ path not-found:gen
=/ contact (contact-scry `^path`(snoc (flop t.path) name))
?~ contact not-found:gen
?~ avatar.u.contact not-found:gen
?- -.u.avatar.u.contact
%url [[307 ['location' url.u.avatar.u.contact]~] ~]
%octt
=/ max-3-days ['cache-control' 'max-age=259200']
=/ content-type ['content-type' content-type.u.avatar.u.contact]
[[200 [content-type max-3-days ~]] `octs.u.avatar.u.contact]
==
::
[%'~groups' *] (html-response:gen index)
==
::
:: +utilities
::
++ contact-poke
|= act=contact-action
^- card
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
::
++ contact-hook-poke
|= act=contact-hook-action
^- card
[%pass / %agent [our.bol %contact-hook] %poke %contact-hook-action !>(act)]
::
++ share-poke
|= [=ship act=contact-action]
^- card
[%pass / %agent [ship %contact-hook] %poke %contact-action !>(act)]
::
++ group-poke
|= act=group-action
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ group-hook-poke
|= act=group-hook-action
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-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)]
::
++ perm-group-hook-poke
|= act=permission-group-hook-action
^- card
:* %pass / %agent [our.bol %permission-group-hook]
%poke %permission-group-hook-action !>(act)
==
::
++ permission-hook-poke
|= act=permission-hook-action
^- card
:* %pass / %agent [our.bol %permission-hook]
%poke %permission-hook-action !>(act)
==
::
++ create-metadata
|= [=path title=@t description=@t]
^- (list card)
=/ =metadata
%* . *metadata
title title
description description
date-created now.bol
creator our.bol
==
:~ (metadata-poke [%add path [%contacts path] metadata])
(metadata-hook-poke [%add-owned path])
==
::
++ delete-metadata
|= =path
^- (list card)
:~ (metadata-poke [%remove path [%contacts path]])
(metadata-hook-poke [%remove path])
==
::
++ all-scry
^- rolodex
.^(rolodex %gx /=contact-store/(scot %da now.bol)/all/noun)
::
++ contact-scry
|= pax=path
^- (unit contact)
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contact pax /noun)
.^((unit contact) %gx pax)
--

1
pkg/arvo/app/contacts/css/index.css Normal file
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/contacts/img/Chat.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 880 B

BIN
pkg/arvo/app/contacts/img/ImageUpload.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 865 B

BIN
pkg/arvo/app/contacts/img/Link.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.5 KiB

BIN
pkg/arvo/app/contacts/img/Publish.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.7 KiB

BIN
pkg/arvo/app/contacts/img/Spinner.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/contacts/img/Tile.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.0 KiB

BIN
pkg/arvo/app/contacts/img/search.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

18
pkg/arvo/app/contacts/index.html Normal file
View File

@ -0,0 +1,18 @@
<!doctype html>
<html>
<head>
<title>Groups</title>
<meta charset="utf-8" />
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<link rel="stylesheet" href="/~groups/css/index.css" />
<link rel="icon" type="image/png" href="/~launch/img/Favicon.png">
</head>
<body>
<div id="root" />
<script src="/~channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~groups/js/index.js"></script>
<script src="https://sdk.amazonaws.com/js/aws-sdk-2.1.12.min.js"></script>
</body>
</html>

1
pkg/arvo/app/contacts/js/index.js Normal file
View File

File diff suppressed because one or more lines are too long

1
pkg/arvo/app/contacts/js/tile.js Normal file
View File

File diff suppressed because one or more lines are too long

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

@ -1115,7 +1115,7 @@
=/ fore-pos-diff (sub fore-pos pos)
=+ vex=((full parse-command-line:he-parser) [1 1] txt)
?. ?=([* ~ [* @ %ex *] *] vex)
res
(he-tab-not-hoon pos :(weld buf (tufa buf.say) "\0a"))
=/ typ p:(slop q:he-hoon-head !>(..dawn))
=/ tl (tab-list-hoon:auto typ p.q.q.p.u.q.vex)
=/ advance (advance-hoon:auto typ p.q.q.p.u.q.vex)
@ -1168,6 +1168,140 @@
*tank
~(duck easy-print type)
::
:: Full tab complete for all Dojo sinks and sources is a madmans job.
:: Instead, we try to parse limited but common forms we know we can
:: autocomplete correctly
++ he-tab-not-hoon
|= [pos=@ud txt=tape]
^+ +>
=* res +>
|^
=/ naked-poke=(unit term)
%+ rust txt
(full (ifix [col (just `@`10)] ;~(pose sym (easy %$))))
?^ naked-poke
(complete-naked-poke u.naked-poke)
=/ variable=(unit term)
%+ rust txt
(full (ifix [tis (just `@`10)] ;~(pose sym (easy %$))))
?^ variable
(complete-variable u.variable)
=/ gen-poke-to-app=(unit [term term])
%+ rust txt
;~ sfix
;~ (glue bar)
;~(pose ;~(pfix col sym) (easy %$))
;~(pose sym (easy %$))
==
(just `@`10)
==
?^ gen-poke-to-app
(complete-gen-poke-to-app u.gen-poke-to-app)
=/ naked-gen=(unit term)
%+ rust txt
(full (ifix [lus (just `@`10)] ;~(pose sym (easy %$))))
?~ naked-gen
res
(complete-naked-gen u.naked-gen)
::
++ complete-naked-poke
|= app=term
=/ pax=path
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/app
%+ complete (cat 3 ':' app)
%+ murn ~(tap by dir:.^(arch %cy pax))
|= [=term ~]
^- (unit [^term tank])
?. =(app (end 3 (met 3 app) term))
~
?~ =<(fil .^(arch %cy (weld pax ~[term %hoon])))
~
`[(cat 3 ':' term) *tank]
::
++ complete-variable
|= variable=term
%+ complete variable
%+ murn ~(tap by var)
|= [name=term =cage]
^- (unit [term tank])
?. =(variable (end 3 (met 3 variable) name))
~
`[name (sell q.cage)]
::
++ complete-gen-poke-to-app
|= [app=term gen=term]
=. app
?:(?=(%$ app) %hood app)
%+ complete
?: =(%hood app)
(cat 3 '|' gen)
:((cury cat 3) ':' app '|' gen)
=/ pfix=path
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/gen/[app]
::
%^ tab-generators:auto pfix `app
%+ murn
~(tap by dir:.^(arch %cy pfix))
|= [=term ~]
?. =(gen (end 3 (met 3 gen) term))
~
?~ =<(fil .^(arch %cy (weld pfix ~[term %hoon])))
~
(some term)
::
++ complete-naked-gen
|= gen=term
%+ complete (cat 3 '+' gen)
=/ pax=path
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/gen
%^ tab-generators:auto pax ~
%+ murn
~(tap by dir:.^(arch %cy pax))
|= [=term ~]
?. =(gen (end 3 (met 3 gen) term))
~
?~ =<(fil .^(arch %cy (weld pax ~[term %hoon])))
~
(some term)
::
++ complete
|= [completing=term options=(list [term tank])]
?~ options
res
=/ advance
(longest-match:auto options)
=. pos
(dec (lent txt)) :: lock cursor at end
=/ back-pos
(sub pos (met 3 completing))
=/ to-send
(trip (rsh 3 (sub pos back-pos) advance))
=| fxs=(list sole-effect)
::
:: Cursor is guaranteed to be at end so we don't worry about the
:: backwards case
::
=. res
|- ^+ res
?~ to-send
(he-diff %mor (flop fxs))
=^ lic say (~(transmit sole say) %ins pos `@c`i.to-send)
$(to-send t.to-send, fxs [`sole-effect`det+lic fxs], pos +(pos))
:: If no options, ring the bell
::
?: =(~ options)
(he-diff %bel ~)
:: If only one option, don't print unless the option is already
:: typed in.
::
?: &(?=([* ~] options) !=((met 3 advance) (met 3 completing)))
res
:: Else, print results
::
%+ he-diff %tab
options
--
::
++ he-type :: apply input
|= act/sole-action
^+ +>

90
pkg/arvo/app/eth-watcher.hoon
View File

@ -1,21 +1,21 @@
:: eth-watcher: ethereum event log collector
::
/- *eth-watcher, spider
/+ default-agent, verb
/+ default-agent, verb, dbug
=, ethereum-types
=, able:jael
::
=> |%
+$ card card:agent:gall
+$ app-state
$: %3
$: %4
dogs=(map path watchdog)
==
::
+$ context [=path dog=watchdog]
+$ watchdog
$: config
running=(unit =tid:spider)
running=(unit [since=@da =tid:spider])
=number:block
=pending-logs
=history
@ -57,6 +57,7 @@
::
:: Main
::
%- agent:dbug
^- agent:gall
=| state=app-state
%+ verb |
@ -97,7 +98,7 @@
::
=? old-state ?=(%2 -.old-state)
%- (slog leaf+"upgrading eth-watcher from %2" ~)
^- app-state
^- app-state-3
%= old-state
- %3
dogs
@ -108,10 +109,52 @@
==
==
::
[cards-1 this(state ?>(?=(%3 -.old-state) old-state))]
=? old-state ?=(%3 -.old-state)
%- (slog leaf+"upgrading eth-watcher from %3" ~)
^- app-state
%= old-state
- %4
dogs
%- ~(run by dogs.old-state)
|= dog=watchdog-3
%= dog
-
=, -.dog
[url eager refresh-rate (mul refresh-rate 6) from contracts topics]
::
running
?~ running.dog ~
`[now.bowl u.running.dog]
==
==
::
[cards-1 this(state ?>(?=(%4 -.old-state) old-state))]
::
+$ app-states
$%(app-state-0 app-state-1 app-state-2 app-state)
$%(app-state-0 app-state-1 app-state-2 app-state-3 app-state)
::
+$ app-state-3
$: %3
dogs=(map path watchdog-3)
==
::
+$ watchdog-3
$: config-3
running=(unit =tid:spider)
=number:block
=pending-logs
=history
blocks=(list block)
==
::
+$ config-3
$: url=@ta
eager=?
refresh-rate=@dr
from=number:block
contracts=(list address:ethereum)
=topics
==
::
+$ app-state-2
$: %2
@ -174,11 +217,11 @@
?- -.poke
%watch
:: fully restart the watchdog if it doesn't exist yet,
:: or if the new config changes more than just the url or refresh rate.
:: or if result-altering parts of the config changed.
=/ restart=?
?| !(~(has by dogs.state) path.poke)
?! .= ->+:(~(got by dogs.state) path.poke)
+>.config.poke
?! .= ->+>+:(~(got by dogs.state) path.poke)
+>+>.config.poke
==
::
=/ already (~(has by dogs.state) path.poke)
@ -196,7 +239,7 @@
?=(^ running.u.dog)
==
~
=/ =cage [%spider-stop !>([u.running.u.dog &])]
=/ =cage [%spider-stop !>([tid.u.running.u.dog &])]
:_ ~
`card`[%pass [%starting path.poke] %agent [our.bowl %spider] %poke cage]
=/ new-dog
@ -384,25 +427,34 @@
::
%- (slog leaf+"eth-watcher failed; will retry" ~)
[[(wait path now.bowl refresh-rate.dog)]~ this]
:: start a new thread that checks for updates
:: maybe kill a timed-out update thread, maybe start a new one
::
=^ cards-1=(list card) dog
:: if still running, kill it and restart
=^ stop-cards=(list card) dog
:: if still running beyond timeout time, kill it
::
?~ running.dog
?. ?& ?=(^ running.dog)
::
%+ gth now.bowl
(add since.u.running.dog timeout-time.dog)
==
`dog
::
%- (slog leaf+"eth-watcher still running; will restart" ~)
=/ =cage [%spider-stop !>([u.running.dog |])]
%- (slog leaf+"eth-watcher {(spud path)} timed out; will restart" ~)
=/ =cage [%spider-stop !>([tid.u.running.dog |])]
:_ dog(running ~)
:~ (leave-spider path our.bowl)
[%pass [%starting path] %agent [our.bowl %spider] %poke cage]
==
::
=^ cards-2=(list card) dog
=^ start-cards=(list card) dog
:: if not (or no longer) running, start a new thread
::
?^ running.dog
`dog
::
=/ new-tid=@ta
(cat 3 'eth-watcher--' (scot %uv eny.bowl))
:_ dog(running `new-tid)
:_ dog(running `[now.bowl new-tid])
=/ args
:^ ~ `new-tid %eth-watcher
!>(`watchpup`[- number pending-logs blocks]:dog)
@ -410,7 +462,7 @@
(poke-spider path our.bowl %spider-start !>(args))
==
::
:- [(wait path now.bowl refresh-rate.dog) (weld cards-1 cards-2)]
:- [(wait path now.bowl refresh-rate.dog) (weld stop-cards start-cards)]
this(dogs.state (~(put by dogs.state) path dog))
==
::

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

@ -51,6 +51,7 @@
::
++ node-url 'http://eth-mainnet.urbit.org:8545'
++ refresh-rate ~h1
++ timeout-time ~h2
--
::
=| state-0
@ -207,6 +208,7 @@
:* node-url
|
refresh-rate
timeout-time
public:mainnet-contracts
~[azimuth delegated-sending]:mainnet-contracts
~

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

@ -59,7 +59,7 @@
:_ this :_ ~
[%pass /dill %arvo %d %flog %crud %goad-fail u.error.sign-arvo]
%- (slog leaf+"goad: recompiling all apps" ~)
[(goad |) this]
[(goad &) this]
==
::
++ on-fail on-fail:def

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

@ -2,6 +2,7 @@
::
/- *group-store, *group-hook
/+ default-agent, verb, dbug
~% %group-hook-top ..is ~
|%
+$ card card:agent:gall
::
@ -33,8 +34,18 @@
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
|= =vase
^- (quip card _this)
=/ old !<(state-zero vase)
:_ this(state old)
%+ murn ~(tap by synced.old)
|= [=path =ship]
^- (unit card)
=/ =wire [(scot %p ship) %group path]
=/ =term ?:(=(our.bowl ship) %group-store %group-hook)
?: (~(has by wex.bowl) [wire ship term]) ~
`[%pass wire %agent [ship term] %watch [%group path]]
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
@ -74,20 +85,26 @@
?~ p.sign
[~ this]
%- (slog u.p.sign)
?> ?=([@ @ *] wire)
=/ =ship (slav %p i.wire)
=. synced.state (~(del by synced.state) t.t.wire)
?> ?=([@ %group ^] wire)
=/ =ship (slav %p i.wire)
=* group t.t.wire
:: only remove from synced if this watch-nack came from the ship we
:: thought we were actively syncing from
::
=? synced.state
=(ship (~(gut by synced.state) group ship))
(~(del by synced.state) group)
[~ this]
::
%kick
?> ?=([@ @ *] wire)
?> ?=([@ %group ^] wire)
=/ =ship (slav %p i.wire)
?. (~(has by synced.state) wire)
=* group t.t.wire
?. (~(has by synced.state) group)
[~ this]
=/ group-path [%group wire]
=/ group-wire [i.wire group-path]
=* group-path t.wire
:_ this
[%pass group-wire %agent [ship %group-hook] %watch group-path]~
[%pass wire %agent [ship %group-hook] %watch group-path]~
::
%fact
?. ?=(%group-update p.cage.sign)
@ -150,10 +167,9 @@
%remove [(update-subscribers [%group pax.diff] diff) state]
::
%unbundle
:_ state(synced (~(del by synced.state) pax.diff))
%+ snoc
(update-subscribers [%group pax.diff] diff)
[%give %kick [%group pax.diff]~ ~]
=/ ship (~(get by synced.state) pax.diff)
?~ ship [~ state]
(poke-group-hook-action [%remove pax.diff])
==
::
++ handle-foreign
@ -162,17 +178,29 @@
?- -.diff
%keys [~ state]
%bundle [~ state]
::
%path
:_ state
?~ pax.diff ~
=/ ship (~(get by synced.state) pax.diff)
?~ ship ~
?. =(src.bol u.ship) ~
:~ (group-poke pax.diff [%unbundle pax.diff])
(group-poke pax.diff [%bundle pax.diff])
(group-poke pax.diff [%add members.diff pax.diff])
==
=/ have-group=(unit group)
(group-scry pax.diff)
?~ have-group
:: if we don't have the group yet, create it
::
:~ (group-poke pax.diff [%bundle pax.diff])
(group-poke pax.diff [%add members.diff pax.diff])
==
:: if we already have the group, calculate and apply the diff
::
=/ added=group (~(dif in members.diff) u.have-group)
=/ removed=group (~(dif in u.have-group) members.diff)
%+ weld
?~ added ~
[(group-poke pax.diff [%add added pax.diff])]~
?~ removed ~
[(group-poke pax.diff [%remove removed pax.diff])]~
::
%add
:_ state
@ -183,23 +211,26 @@
[(group-poke pax.diff diff)]~
::
%remove
:_ state
?~ pax.diff ~
?~ pax.diff [~ state]
=/ ship (~(get by synced.state) pax.diff)
?~ ship ~
?. =(src.bol u.ship) ~
[(group-poke pax.diff diff)]~
?~ ship [~ state]
?. =(src.bol u.ship) [~ state]
?. (~(has in members.diff) our.bol)
:_ state
[(group-poke pax.diff diff)]~
=/ changes (poke-group-hook-action [%remove pax.diff])
:_ +.changes
%+ welp -.changes
:~ (group-poke pax.diff diff)
(group-poke pax.diff [%unbundle pax.diff])
==
::
%unbundle
?~ pax.diff
[~ state]
?~ pax.diff [~ state]
=/ ship (~(get by synced.state) pax.diff)
?~ ship
[~ state]
?. =(src.bol u.ship)
[~ state]
:_ state(synced (~(del by synced.state) pax.diff))
[(group-poke pax.diff diff)]~
?~ ship [~ state]
?. =(src.bol u.ship) [~ state]
(poke-group-hook-action [%remove pax.diff])
==
::
++ group-poke
@ -226,5 +257,4 @@
?: =(u.shp our.bol)
[%pass wir %agent [our.bol %group-store] %leave ~]~
[%pass wir %agent [u.shp %group-hook] %leave ~]~
::
--

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

@ -57,6 +57,7 @@
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give %group-initial !>(groups))
[%updates ~] ~
[%keys ~] (give %group-update !>([%keys ~(key by groups)]))
[%group *]
(give %group-update !>([%path (~(got by groups) t.path) t.path]))
@ -158,6 +159,7 @@
^- (list card)
%- zing
:~ (update-subscribers /all act)
(update-subscribers /updates act)
(update-subscribers [%group pax] act)
?. |(=(%bundle -.act) =(%unbundle -.act))
~

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

@ -43,9 +43,9 @@
!:
=> |% ::
++ hood-old :: unified old-state
{?($1 $2) lac/(map @tas hood-part-old)} ::
{?($1 $2 $3 $4) lac/(map @tas hood-part-old)} ::
++ hood-1 :: unified state
{$2 lac/(map @tas hood-part)} ::
{$4 lac/(map @tas hood-part)} ::
++ hood-good :: extract specific
=+ hed=$:hood-head
|@ ++ $
@ -140,16 +140,19 @@
`..on-init
::
++ on-save
!>([%2 lac])
!>([%4 lac])
::
++ on-load
|= =old-state=vase
=/ old-state !<(hood-old old-state-vase)
=^ cards lac
=. lac lac.old-state
?. ?=(%1 -.old-state)
`lac
((wrap on-load):from-drum:(help hid) %1)
?- -.old-state
%1 ((wrap on-load):from-drum:(help hid) %1)
%2 ((wrap on-load):from-drum:(help hid) %2)
%3 ((wrap on-load):from-drum:(help hid) %3)
%4 `lac
==
[cards ..on-init]
::
++ on-poke

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

@ -4,7 +4,7 @@
:: can be poked by the host team to send an invite out to someone.
:: can be poked by foreign ships to send an invite to us.
::
/+ *invite-json, default-agent, verb
/+ *invite-json, default-agent, verb, dbug
::
|%
+$ state-0 [%0 ~]
@ -16,6 +16,7 @@
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
@ -49,12 +50,10 @@
%invite-action
=/ act=invite-action !<(invite-action vase)
?. ?=(%invite -.act) ~
:: if the sender is us,
::
?: (team:title our.bowl src.bowl)
:: outgoing. we must be inviting another ship. send them the invite.
::
?> !(team:title our.bowl recipient.invite.act)
?< (team:title our.bowl recipient.invite.act)
[(invite-hook-poke:do recipient.invite.act act)]~
:: else incoming. ensure invitatory exists and invite is not a duplicate.
::

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

@ -1,4 +1,4 @@
/+ *invite-json, default-agent
/+ *invite-json, default-agent, dbug
|%
+$ card card:agent:gall
::
@ -14,6 +14,7 @@
::
=| state-zero
=* state -
%- agent:dbug
^- agent:gall
=<
|_ bol=bowl:gall

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

@ -6,7 +6,7 @@
::
::TODO could maybe use /lib/proxy-hook, be renamed invite-proxy-hook
::
/+ *invite-json, default-agent
/+ *invite-json, default-agent, dbug
::
|%
+$ card card:agent:gall
@ -19,6 +19,8 @@
^- card
[%pass /store %agent [our %invite-store] %watch /updates]
--
::
%- agent:dbug
^- agent:gall
|_ =bowl:gall
+* this .

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

@ -1,8 +1,8 @@
/- launch
/+ *server, default-agent
/+ *server, default-agent, dbug
::
/= index
/^ $-(marl manx)
/^ $-([json marl] manx)
/: /===/app/launch/index /!noun/
/= script
/^ octs
@ -11,6 +11,13 @@
/| /js/
/~ ~
==
/= channel-js
/^ octs
/; as-octs:mimes:html
/: /===/app/launch/js/channel
/| /js/
/~ ~
==
/= style
/^ octs
/; as-octs:mimes:html
@ -24,53 +31,108 @@
::
|%
+$ versioned-state
$% state-zero
$% [%0 state-zero]
[%1 state-two]
[%2 state-two]
[%3 state-two]
==
+$ state-zero
$: %0
tiles=(set tile:launch)
$: tiles=(set tile:launch)
data=tile-data:launch
path-to-tile=(map path @tas)
==
+$ state-two
$: tiles=(set tile:launch)
data=tile-data:launch
path-to-tile=(map path @tas)
first-time=?
==
::
+$ card card:agent:gall
++ launch-who
|= =desk
[%pass /who %arvo %e %serve [~ /who] desk /gen/who/hoon ~]
--
::
=| state-zero
=| [%3 state-two]
=* state -
%- agent:dbug
^- agent:gall
|_ bol=bowl:gall
+* this .
def ~(. (default-agent this %|) bol)
++ on-init
^- (quip card _this)
:_ this
[%pass / %arvo %e %connect [~ /] %launch]~
:_ this(state *[%3 state-two])
:~ (launch-who q.byk.bol)
[%pass / %arvo %e %connect [~ /] %launch]
==
::
++ on-save !>(state)
::
++ on-load
|= old=vase
`this(state !<(state-zero old))
^- (quip card _this)
=/ old-state !<(versioned-state old)
=| cards=(list card)
|-
?- -.old-state
%0
$(old-state [%1 tiles data path-to-tile %.n]:old-state)
::
%1
=/ new-state=state-two
=, old-state
:* (~(del in tiles) [%contact-view /primary])
(~(del by data) %contact-view)
(~(del by path-to-tile) /primary)
first-time
==
$(old-state [%2 new-state])
::
%2
$(old-state [%3 +.old-state], cards [(launch-who q.byk.bol) cards])
::
%3
[(flop cards) this(state old-state)]
==
::
++ on-poke
|= [mar=mark vas=vase]
^- (quip card _this)
?+ mar (on-poke:def mar vas)
%json
?> (team:title our.bol src.bol)
=/ jon !<(json vas)
:- ~
?. =(jon [%s 'disable welcome message'])
this
this(first-time %.n)
::
%launch-action
=/ act !<(action:launch vas)
=/ beforedata (~(get by data) name.act)
=/ newdata
?~ beforedata
(~(put by data) name.act [*json url.act])
(~(put by data) name.act [jon.u.beforedata url.act])
=/ new-tile `tile:launch`[`@tas`name.act `path`subscribe.act]
:- [%pass subscribe.act %agent [our.bol name.act] %watch subscribe.act]~
%= this
tiles (~(put in tiles) new-tile)
data newdata
path-to-tile (~(put by path-to-tile) subscribe.act name.act)
?- -.act
%add
=/ beforedata (~(get by data) name.act)
=/ newdata
?~ beforedata
(~(put by data) name.act [*json url.act])
(~(put by data) name.act [jon.u.beforedata url.act])
=/ new-tile `tile:launch`[`@tas`name.act `path`subscribe.act]
:- [%pass subscribe.act %agent [our.bol name.act] %watch subscribe.act]~
%= this
tiles (~(put in tiles) new-tile)
data newdata
path-to-tile (~(put by path-to-tile) subscribe.act name.act)
==
::
%remove
:- [%pass subscribe.act %agent [our.bol name.act] %leave ~]~
%= this
tiles (~(del in tiles) [name.act subscribe.act])
data (~(del by data) name.act)
path-to-tile (~(del by path-to-tile) subscribe.act)
==
==
::
%handle-http-request
@ -89,9 +151,10 @@
?+ site.request-line
not-found:gen
::
~
[~ ~]
=/ hym=manx
%- index
%+ index
[%b first-time]
^- marl
%+ turn ~(tap by data)
|= [key=@tas [jon=json url=@t]]
@ -119,6 +182,9 @@
"window.urb = new Channel();"
==
(js-response:gen session-js)
::
[%'~channel' %channel ~]
(js-response:gen channel-js)
==
==
::

3
pkg/arvo/app/launch/css/index.css
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/launch/img/Chevron.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 453 B

5
pkg/arvo/app/launch/index.hoon
View File

@ -1,4 +1,4 @@
|= scripts=marl
|= [startup=json scripts=marl]
;html
;head
;title: Home
@ -11,9 +11,10 @@
==
;body
;div#root;
;script@"/~/channel/channel.js";
;script@"/~channel/channel.js";
;script@"/~modulo/session.js";
;* scripts
;script@"/~launch/js/index.js";
;script: window.startupMessage = {(en-json:html startup)}
==
==

231
pkg/arvo/app/launch/js/channel.js Normal file
View File

@ -0,0 +1,231 @@
class Channel {
constructor() {
this.init();
this.deleteOnUnload();
// a way to handle channel errors
//
//
this.onChannelError = (err) => {
console.error('event source error: ', err);
};
}
init() {
// unique identifier: current time and random number
//
this.uid =
new Date().getTime().toString() +
"-" +
Math.random().toString(16).slice(-6);
this.requestId = 1;
// the currently connected EventSource
//
this.eventSource = null;
// the id of the last EventSource event we received
//
this.lastEventId = 0;
// this last event id acknowledgment sent to the server
//
this.lastAcknowledgedEventId = 0;
// a registry of requestId to successFunc/failureFunc
//
// These functions are registered during a +poke and are executed
// in the onServerEvent()/onServerError() callbacks. Only one of
// the functions will be called, and the outstanding poke will be
// removed after calling the success or failure function.
//
this.outstandingPokes = new Map();
// a registry of requestId to subscription functions.
//
// These functions are registered during a +subscribe and are
// executed in the onServerEvent()/onServerError() callbacks. The
// event function will be called whenever a new piece of data on this
// subscription is available, which may be 0, 1, or many times. The
// disconnect function may be called exactly once.
//
this.outstandingSubscriptions = new Map();
}
setOnChannelError(onError = (err) => {}) {
this.onChannelError = onError;
}
deleteOnUnload() {
window.addEventListener("unload", (event) => {
this.delete();
});
}
// sends a poke to an app on an urbit ship
//
poke(ship, app, mark, json, successFunc, failureFunc) {
let id = this.nextId();
this.outstandingPokes.set(
id,
{
success: successFunc,
fail: failureFunc
}
);
this.sendJSONToChannel({
id,
action: "poke",
ship,
app,
mark,
json
});
}
// subscribes to a path on an specific app and ship.
//
// Returns a subscription id, which is the same as the same internal id
// passed to your Urbit.
subscribe(
ship,
app,
path,
connectionErrFunc = () => {},
eventFunc = () => {},
quitFunc = () => {}) {
let id = this.nextId();
this.outstandingSubscriptions.set(
id,
{
err: connectionErrFunc,
event: eventFunc,
quit: quitFunc
}
);
this.sendJSONToChannel({
id,
action: "subscribe",
ship,
app,
path
});
return id;
}
// quit the channel
//
delete() {
let id = this.nextId();
navigator.sendBeacon(this.channelURL(), JSON.stringify([{
id,
action: "delete"
}]));
}
// unsubscribe to a specific subscription
//
unsubscribe(subscription) {
let id = this.nextId();
this.sendJSONToChannel({
id,
action: "unsubscribe",
subscription
});
}
// sends a JSON command command to the server.
//
sendJSONToChannel(j) {
let req = new XMLHttpRequest();
req.open("PUT", this.channelURL());
req.setRequestHeader("Content-Type", "application/json");
if (this.lastEventId == this.lastAcknowledgedEventId) {
let x = JSON.stringify([j]);
req.send(x);
} else {
// we add an acknowledgment to clear the server side queue
//
// The server side puts messages it sends us in a queue until we
// acknowledge that we received it.
//
let x = JSON.stringify(
[{action: "ack", "event-id": parseInt(this.lastEventId)}, j]
);
req.send(x);
this.lastEventId = this.lastAcknowledgedEventId;
}
this.connectIfDisconnected();
}
// connects to the EventSource if we are not currently connected
//
connectIfDisconnected() {
if (this.eventSource) {
return;
}
this.eventSource = new EventSource(this.channelURL(), {withCredentials:true});
this.eventSource.onmessage = e => {
this.lastEventId = e.lastEventId;
let obj = JSON.parse(e.data);
let pokeFuncs = this.outstandingPokes.get(obj.id);
let subFuncs = this.outstandingSubscriptions.get(obj.id);
if (obj.response == "poke" && !!pokeFuncs) {
let funcs = pokeFuncs;
if (obj.hasOwnProperty("ok")) {
funcs["success"]();
} else if (obj.hasOwnProperty("err")) {
funcs["fail"](obj.err);
} else {
console.error("Invalid poke response: ", obj);
}
this.outstandingPokes.delete(obj.id);
} else if (obj.response == "subscribe" ||
(obj.response == "poke" && !!subFuncs)) {
let funcs = subFuncs;
// on a response to a subscribe, we only notify the caller on err
//
if (obj.hasOwnProperty("err")) {
funcs["err"](obj.err);
this.outstandingSubscriptions.delete(obj.id);
}
} else if (obj.response == "diff") {
let funcs = subFuncs;
funcs["event"](obj.json);
} else if (obj.response == "quit") {
let funcs = subFuncs;
funcs["quit"](obj);
this.outstandingSubscriptions.delete(obj.id);
} else {
console.log("Unrecognized response: ", e);
}
}
this.eventSource.onerror = e => {
this.delete();
this.init();
this.onChannelError(e);
}
}
channelURL() {
return "/~/channel/" + this.uid;
}
nextId() {
return this.requestId++;
}
};

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

File diff suppressed because one or more lines are too long

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

@ -1,30 +1,70 @@
:: link-listen-hook: get your friends' bookmarks
::
:: on-init, subscribes to all groups on this ship.
:: for every ship in a group, we subscribe to their link's local-pages
:: at the group path (through link-proxy-hook),
:: and forwards all entries into our link as submissions.
:: keeps track of a listening=(set app-path). users can manually add to and
:: remove from this set.
::
/- *link, group-store
/+ default-agent, verb
:: 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.
::
/- link-listen-hook, *metadata-store, *link, group-store
/+ mdl=metadata, default-agent, verb, dbug
::
~% %link-listen-hook-top ..is ~
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
+$ versioned-state
$% [%0 state-0]
[%1 state-1]
[%2 state-2]
==
+$ 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
--
::
=| state-0
=| [%2 state-2]
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -36,53 +76,244 @@
++ on-init
^- (quip card _this)
:_ this
[watch-groups:do]~
~[watch-metadata:do watch-groups:do]
::
++ on-save !>(state)
++ on-load
|= old=vase
|= =vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
=/ old=versioned-state
!<(versioned-state vase)
|-
?- -.old
%2 [~ this(state old)]
::
%1
:: the upgrade from 0 left out local-only collections.
:: here, we pull those back in.
::
=. state [%2 +.old]
=. listening.state
(~(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
==
=| cards=(list card)
|-
?~ resources [cards this]
=, i.resources
=/ =group:group-store
=- (fall - *group:group-store)
(scry-for:do (unit group:group-store) %group-store group-path)
:: if we're the only group member, this got incorrectly ignored
:: during 0's upgrade logic. watch it now.
::
?. &(=(1 ~(wyt in group)) (~(has in group) 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)
?: ?=([%groups ~] wire)
=^ cards state
=^ cards state
?+ wire ~|([dap.bowl %weird-agent-wire wire] !!)
[%metadata ~]
(take-metadata-sign:do sign)
::
[%groups ~]
(take-groups-sign:do sign)
[cards this]
?: ?=([%links @ ^] wire)
=^ cards state
(take-links-sign:do (slav %p i.t.wire) t.t.wire sign)
[cards this]
?: ?=([%forward ^] wire)
=^ cards state
::
[%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:link-listen-hook vase))
[cards this]
~| [dap.bowl %weird-wire wire]
!!
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%g %done *] sign-arvo)
(on-arvo:def wire sign-arvo)
?~ error.sign-arvo [~ this]
=/ =tank leaf+"{(trip dap.bowl)}'s message went wrong!"
%- (slog tank tang.u.error.sign-arvo)
[~ 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-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
::
|_ =bowl:gall
+* md ~(. mdl bowl)
::
:: groups subscription
:: user actions & updates
::
++ handle-listen-action
|= =action:link-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:link-listen-hook
^- card
[%give %fact ~[/listening] %link-listen-update !>(update)]
::
:: 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)
?+ -.upd [~ state]
%add
?> =(%link app-name.resource.upd)
:: auto-listen to collections in unmanaged groups only
::
?. ?=([%'~' ^] group-path.upd) [~ 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
@ -106,111 +337,268 @@
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial (handle-group-initial !<(groups:group-store vase))
%group-initial [~ state] ::NOTE initial handled using metadata
%group-update (handle-group-update !<(group-update:group-store vase))
==
==
::
++ handle-group-initial
|= =groups:group-store
^- (quip card _state)
=| cards=(list card)
=/ groups=(list [=path =group:group-store])
~(tap by groups)
|-
?~ groups [cards state]
=^ caz state
%- handle-group-update
[%add [group path]:i.groups]
$(cards (weld cards caz), groups t.groups)
::
++ handle-group-update
|= upd=group-update:group-store
^- (quip card _state)
:_ state
?+ -.upd ~
?(%path %add %remove)
=/ whos=(list ship) ~(tap in members.upd)
|- ^- (list card)
?~ whos ~
:: no need to subscribe to ourselves
::
?. ?=(?(%path %add %remove) -.upd)
[~ state]
=/ socs=(list app-path)
(app-paths-from-group:md %link pax.upd)
=/ whos=(list ship)
~(tap in members.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 -.upd)
(listen-to-peer i.socs pax.upd i.whos)
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
%. [i.whos pax.upd]
?: ?=(%remove -.upd)
end-link-subscription
start-link-subscription
==
(handle-listen-action %leave i.socs)
(leave-from-peer i.socs pax.upd 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
=- (fall - *group:group-store)
%^ scry-for (unit group:group-store)
%group-store
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
=- (fall - *group:group-store)
%^ scry-for (unit group:group-store)
%group-store
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
|= [who=ship where=path]
|= =target
^- card
:* %pass
[%links (scot %p who) where]
[%links (target-to-wire target)]
%agent
[who %link-proxy-hook]
[who.target %link-proxy-hook]
%watch
[%local-pages where]
?- what.target
%local-pages [what where]:target
%annotations [what %$ where]:target
==
==
::
++ end-link-subscription
++ 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
[%links (scot %p who) where]
[%prod (scot %p who) where]
%agent
[who %link-proxy-hook]
%leave
~
[who %link-listen-hook]
%poke
%link-listen-poke
!>(where)
==
::
++ take-links-sign
|= [who=ship where=path =sign:agent:gall]
++ take-link-sign
|= [=target =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links who where] !!)
%kick [[(start-link-subscription who where)]~ state]
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links target] !!)
%kick [[(start-link-subscription target)]~ state]
::
%watch-ack
?~ p.sign [~ state]
:: our subscription request got rejected for whatever reason,
:: (most likely difference in group membership,)
:: so we don't try again.
::TODO but now the only way to retry is to remove from group and re-add...
:: this is a problem because our and their group may not update
:: simultaneously...
[~ state]
?~ 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-update (handle-link-update who where !<(update vase))
%link-initial
%- handle-link-initial
[who.target where.target !<(initial vase)]
::
%link-update
%- handle-link-update
[who.target where.target !<(update 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
^- ?
=- (~(has in (fall - *group:group-store)) who.target)
%^ scry-for (unit group:group-store)
%group-store
group-path
::
++ do-link-action
|= [=wire =action]
^- card
:* %pass
wire
%agent
[our.bowl %link-store]
%poke
%link-action
!>(action)
==
::
++ handle-link-initial
|= [who=ship where=path =initial]
^- (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]
^- (quip card _state)
?> ?=(%local-pages -.update)
?> =(src.bowl who)
:_ state
%+ turn pages.update
|= =page
^- card
:* %pass
[%forward (scot %p who) where]
%agent
[our.bowl %link-store]
%poke
%link-action
!>([%hear where src.bowl page])
?+ -.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
[%forward %annotation (scot %p who) where]
[%read where url.update who note]
==
::
++ take-forward-sign
@ -228,4 +616,14 @@
==
%- (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)
==
--

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

@ -4,12 +4,11 @@
:: stores if permission conditions are met.
:: the patterns herein should one day be generalized into a proxy-hook lib.
::
:: this adopts a very primitive view of groups-store as containing only
:: groups of interesting (rather than uninteresting) ships. it sets the
:: permission condition to be that ship must be in group matching the path
:: it's subscribing to.
:: we check this on-watch, but also subscribe to groups so that we can kick
:: subscriptions if needed (eg ship removed from group).
:: 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.
@ -17,8 +16,12 @@
:: whatever's returned by the scry at that path, but perhaps that should
:: become part of the stores standard anyway.
::
/- *link, group-store
/+ default-agent, verb
:: when adding support for new paths, the only things you'll likely want
:: to touch are +permitted, +initial-response, & +kick-proxies.
::
/- group-store, *metadata-store
/+ *link, metadata, default-agent, verb, dbug
~% %link-proxy-hook-top ..is ~
|%
+$ state-0
$: %0
@ -33,6 +36,7 @@
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -44,7 +48,7 @@
++ on-init
^- (quip card _this)
:_ this
[watch-groups:do]~
~[watch-groups:do watch-metadata:do]
::
++ on-save !>(state)
++ on-load
@ -92,24 +96,92 @@
--
::
|_ =bowl:gall
+* md ~(. metadata bowl)
::
:: permissions
::
++ permitted
|= [who=ship =path]
^- ?
:: we only expose /local-pages, and only to ships in the relevant group
:: we only expose /local-pages and /annotations,
:: to ships in the groups associated with the resource.
:: (no url-specific annotations subscriptions, either.)
::
?. ?=([%local-pages ^] path) |
=; group
?& ?=(^ group)
(~(has in u.group) who)
==
.^ (unit group:group-store)
%gx
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
(snoc t.path %noun)
=/ 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 (fall - *group:group-store)) who)
%^ scry-for (unit group:group-store)
%group-store
group-path
::
++ 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
=- (fall - *group:group-store)
%^ scry-for (unit group:group-store)
%group-store
group-path.upd
::
:: groups subscription
::TODO largely copied from link-listen-hook. maybe make a store-listener lib?
::
@ -135,7 +207,6 @@
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial [~ state]
%group-update (handle-group-update !<(group-update:group-store vase))
@ -147,33 +218,34 @@
^- (quip card _state)
:_ state
?. ?=(%remove -.upd) ~
=/ whos=(list ship) ~(tap in members.upd)
|- ^- (list card)
?~ whos ~
:: no need to remove to ourselves
:: if someone was removed from a group, find all link resources associated
:: with that group, then kick their subscriptions if they're no longer
::
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
::NOTE this depends kind of unfortunately on the fact that we only accept
:: subscriptions to /local-pages/* paths. it'd be more correct if we
:: "just" looked at all paths in the map, and found the matching ones.
(kick-proxy i.whos [%local-pages pax.upd])
%- zing
%+ turn (app-paths-from-group:md %link pax.upd)
|= =app-path
^- (list card)
%+ kick-revoked-permissions
app-path
~(tap in members.upd)
::
:: proxy subscriptions
::
++ kick-proxy
++ kick-proxies
|= [who=ship =path]
^- card
[%give %kick ~[path] `who]
=- [%give %kick - `who]
:~ [%local-pages path]
[%annotations %$ path]
==
::
++ handle-proxy-sign
|= [=path =sign:agent:gall]
|= [=wire =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack path] !!)
%fact [[%give %fact ~[path] cage.sign]~ state]
%kick [[(proxy-pass-link-store path %watch path)]~ state]
%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]
@ -197,9 +269,15 @@
++ initial-response
|= =path
^- card
=/ initial=update
[%local-pages path .^(pages %gx path)]
[%give %fact ~ %link-update !>(initial)]
=; =initial
[%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]
@ -228,4 +306,16 @@
:: 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)
==
--

228
pkg/arvo/app/link-server-hook.hoon
View File

@ -1,228 +0,0 @@
:: link-server: accessing link-store via eyre
::
:: only accepts requests authenticated as the host ship.
::
:: GET requests:
:: /~link/local-pages/[some-path].json?p=0
:: our submissions on path, with optional pagination
::
:: POST requests:
:: /~link/add/[some-path]
:: send {title url} json, will save link at path
::
/+ *link, *server, default-agent, verb
::
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
[start-serving:do]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-watch
|= =path
^- (quip card _this)
?: ?=([%http-response *] path)
[~ this]
(on-watch:def path)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
:_ this
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
(handle-http-request:do eyre-id inbound-request)
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=(%poke-ack -.sign)
(on-agent:def wire sign)
?~ p.sign [~ this]
=/ =tank
leaf+"{(trip dap.bowl)} failed writing to %link-store"
%- (slog tank u.p.sign)
[~ this]
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
++ start-serving
^- card
[%pass / %arvo %e %connect [~ /'~link'] dap.bowl]
::
++ do-action
|= =action
^- card
[%pass / %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ do-add
|= [=path title=@t =url]
^- card
(do-action %add path title url)
::
++ handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (list card)
::NOTE we don't use +require-authorization because it's too restrictive
:: on the flow we want here.
::
?. ?& authenticated.inbound-request
=(src.bowl our.bowl)
==
::TODO `*octs -> ~ everywhere once no-data bug is fixed
(give-simple-payload:app eyre-id [[403 ~] `*octs])
:: request-line: parsed url + params
::
=/ =request-line
%- parse-request-line
url.request.inbound-request
=* req-head header-list.request.inbound-request
=; [cards=(list card) =simple-payload:http]
%+ weld cards
(give-simple-payload:app eyre-id simple-payload)
?+ method.request.inbound-request [~ not-found:gen]
%'OPTIONS'
[~ (include-cors-headers req-head [[200 ~] `*octs])]
::
%'GET'
[~ (handle-get req-head request-line)]
::
%'POST'
(handle-post req-head request-line body.request.inbound-request)
==
::
++ handle-post
|= [request-headers=header-list:http =request-line body=(unit octs)]
^- [(list card) simple-payload:http]
=; [success=? cards=(list card)]
:- cards
%+ include-cors-headers
request-headers
::TODO it would be more correct to wait for the %poke-ack instead of
:: sending this response right away... but link-store pokes can't
:: actually fail right now, so it's fine.
[[?:(success 200 400) ~] `*octs]
?~ body [| ~]
?+ request-line [| ~]
[[~ [%'~link' %add ^]] ~]
^- [? (list card)]
=/ jon=(unit json) (de-json:html q.u.body)
?~ jon [| ~]
=/ page=(unit [title=@t =url])
%. u.jon
(ot title+so url+so ~):dejs-soft:format
?~ page [| ~]
[& [(do-add t.t.site.request-line [title url]:u.page) ~]]
==
::
++ handle-get
|= [request-headers=header-list:http =request-line]
%+ include-cors-headers
request-headers
^- simple-payload:http
:: args: map of params
:: p: pagination index
::
=/ args
%- ~(gas by *(map @t @t))
args.request-line
=/ p=(unit @ud)
%+ biff (~(get by args) 'p')
(curr rush dim:ag)
?+ request-line not-found:gen
::TODO expose submissions, other data
:: local links by recency as json
::
[[[~ %json] [%'~link' %local-pages ^]] *]
%- json-response:gen
%- json-to-octs ::TODO include in +json-response:gen
^- json
:- %a
%+ turn
`pages`(get-pages t.t.site.request-line p)
`$-(page json)`page:en-json
==
::
++ include-cors-headers
|= [request-headers=header-list:http =simple-payload:http]
^+ simple-payload
=* out-heads headers.response-header.simple-payload
=; =header-list:http
|-
?~ header-list simple-payload
=* new-head i.header-list
=. out-heads
(set-header:http key.new-head value.new-head out-heads)
$(header-list t.header-list)
=/ origin=@t
=/ headers=(map @t @t)
(~(gas by *(map @t @t)) request-headers)
(~(gut by headers) 'origin' '*')
:~ 'Access-Control-Allow-Origin'^origin
'Access-Control-Allow-Credentials'^'true'
'Access-Control-Request-Method'^'OPTIONS, GET, POST'
'Access-Control-Allow-Methods'^'OPTIONS, GET, POST'
'Access-Control-Allow-Headers'^'content-type'
==
::
++ page-size 25
++ get-pages
|= [=path p=(unit @ud)]
^- pages
=; =pages
?~ p pages
%+ scag page-size
%+ slag (mul u.p page-size)
pages
.^ pages
%gx
(scot %p our.bowl)
%link-store
(scot %da now.bowl)
%local-pages
(snoc path %noun)
==
--

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

@ -5,24 +5,71 @@
:: 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:
::
:: /local-pages/[some-group] all pages we saved by recency
:: /submissions/[some-group] all submissions by recency
:: (map path pages) %local-pages
:: /local-pages our saved pages
:: /local-pages/some-path our saved pages on path
::
/+ *link, default-agent, verb
:: (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, default-agent, verb, dbug
::
|%
+$ state-0
$: %0
by-group=(map path links)
by-site=(map site (list [path submission]))
discussions=(per-path-url discussion)
==
::
+$ links
$: ::NOTE all lists by recency
=submissions
ours=pages
seen=(set url)
==
::
+$ discussion
$: =comments
ours=notes
==
::
+$ card card:agent:gall
@ -31,6 +78,7 @@
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
@ -64,12 +112,58 @@
?+ path (on-peek:def path)
[%y ?(%local-pages %submissions) ~]
``noun+!>(~(key by by-group))
::
[%x %local-pages ^]
::
[%x %local-pages *]
``noun+!>((get-local-pages:do t.t.path))
::
[%x %submissions ^]
::
[%x %submissions *]
``noun+!>((get-submissions:do t.t.path))
::
[%y ?(%annotations %discussions) *]
=/ [spath=^path surl=url]
(break-discussion-path 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
@ -78,19 +172,39 @@
?> (team:title [our src]:bowl) ::TODO /lib/store
:_ this
|^ ?+ path (on-watch:def path)
[%local-pages ^]
%+ give %link-update
[%local-pages t.path (get-local-pages:do t.path)]
[%local-pages *]
%+ give %link-initial
^- initial
[%local-pages (get-local-pages:do t.path)]
::
[%submissions ^]
%+ give %link-update
[%submissions t.path (get-submissions:do t.path)]
[%submissions *]
%+ give %link-initial
^- initial
[%submissions (get-submissions:do t.path)]
::
[%annotations *]
%+ give %link-initial
^- initial
[%annotations (get-annotations:do t.path)]
::
[%discussions *]
%+ give %link-initial
^- initial
[%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
@ -107,15 +221,19 @@
|= =action
^- (quip card _state)
?- -.action
%add (add-page +.action)
%save (save-page +.action)
%note (note-note +.action)
%seen (seen-submission +.action)
::
%hear (hear-submission +.action)
%read (read-comment +.action)
==
:: +add-page: save a page ourselves
:: +save-page: save a page ourselves
::
++ add-page
++ save-page
|= [=path title=@t =url]
^- (quip card _state)
?< =(~ path)
?< |(=(~ path) =(~ title) =(~ url))
:: add page to group ours
::
=/ =links (~(gut by by-group) path *links)
@ -124,16 +242,75 @@
=. by-group (~(put by by-group) path links)
:: do generic submission logic
::
=^ cards state
=^ 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
:_ cards
:_ (weld submission-cards seen-cards)
:+ %give %fact
:+ [%local-pages path]~
:+ :~ /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
^- (list card)
:_ cards
:+ %give %fact
:+ :~ /annotations
[%annotations %$ path]
[%annotations (build-discussion-path url)]
[%annotations (build-discussion-path path url)]
==
%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
::
=/ 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
@ -143,7 +320,11 @@
:: add link to group submissions
::
=/ =links (~(gut by by-group) path *links)
=. submissions.links [submission submissions.links]
=^ added submissions.links
?: ?=(^ (find ~[submission] submissions.links))
[| submissions.links]
:- &
(submissions:merge submissions.links ~[submission])
=. by-group (~(put by by-group) path links)
:: add submission to global sites
::
@ -152,21 +333,156 @@
:: send updates to subscribers
::
:_ state
?. added ~
:_ ~
:+ %give %fact
:+ [%submissions path]~
:+ :~ /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 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 url)]
[%discussions (build-discussion-path path url)]
==
%link-update
!>([%discussions path url [comment]~])
::
:: reading
::
++ get-local-pages
|= =path
^- pages
^- (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
^- submissions
^- (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 path)
%. url
%~ has in
seen:(~(gut by by-group) path *links)
::
::
++ get-annotations
|= =path
^- (per-path-url notes)
=/ args=[=^path =url]
(break-discussion-path 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)
--
::
++ get-discussions
|= =path
^- (per-path-url comments)
=/ args=[=^path =url]
(break-discussion-path 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)
--
--

634
pkg/arvo/app/link-view.hoon Normal file
View File

@ -0,0 +1,634 @@
:: 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,
*invite-store, group-store,
link-listen-hook,
group-hook, permission-hook, permission-group-hook,
metadata-hook, contact-view
/+ *link, metadata, *server, default-agent, verb, dbug
~% %link-view-top ..is ~
::
|%
+$ state-0
$: %0
~
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
:~ [%pass /connect %arvo %e %connect [~ /'~link'] dap.bowl]
[%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]
::
=+ [%add dap.bowl /tile '/~link/js/tile.js']
[%pass /launch %agent [our.bowl %launch] %poke %launch-action !>(-)]
::
=+ [%invite-action !>([%create /link])]
[%pass /invitatory/create %agent [our.bowl %invite-store] %poke -]
::
=+ /invitatory/link
[%pass - %agent [our.bowl %invite-store] %watch -]
==
::
++ 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.bowl src.bowl)
:_ this
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
%+ give-simple-payload:app eyre-id
%+ require-authorization:app inbound-request
handle-http-request:do
::
%link-action
[(handle-action:do !<(action vase)) ~]
::
%link-view-action
(handle-view-action:do !<(view-action vase))
==
::
++ on-watch
|= =path
^- (quip card _this)
?: ?| ?=([%http-response *] path)
?=([%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 t.t.t.path))
::
[%discussions @ ^]
:_ this
(give-initial-discussions:do p (break-discussion-path t.t.t.path))
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%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 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)
::
++ 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
::
++ 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)
==
::
++ handle-http-request
|= =inbound-request:eyre
^- simple-payload:http
?. =(src.bowl our.bowl)
[[403 ~] ~]
:: request-line: parsed url + params
::
=/ =request-line
%- parse-request-line
url.request.inbound-request
=* req-head header-list.request.inbound-request
?+ method.request.inbound-request not-found:gen
%'GET'
(handle-get req-head request-line)
==
::
++ handle-get
|= [request-headers=header-list:http =request-line]
^- simple-payload:http
:: try to load file from clay
::
?~ ext.request-line
:: for extension-less requests, always just serve the index.html.
:: that way the js can load and figure out how to deal with that route.
::
$(request-line [[`%html ~[%'~link' 'index']] args.request-line])
=/ file=(unit octs)
?. ?=([%'~link' *] site.request-line) ~
(get-file-at /app/link [t.site u.ext]:request-line)
?~ file not-found:gen
?+ u.ext.request-line not-found:gen
%html (html-response:gen u.file)
%js (js-response:gen u.file)
%css (css-response:gen u.file)
%png (png-response:gen u.file)
==
::
++ get-file-at
|= [base=path file=path ext=@ta]
^- (unit octs)
:: only expose html, css and js files for now
::
?. ?=(?(%html %css %js %png) ext)
~
=/ =path
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
(snoc (weld base file) ext)
==
?. .^(? %cu path)
~
%- some
%- as-octs:mimes:html
.^(@ %cx path)
::
++ do-poke
|= [app=term =mark =vase]
^- card
[%pass /create/[app]/[mark] %agent [our.bowl app] %poke mark vase]
::
++ handle-invite-update
|= upd=invite-update
^- (list card)
?. ?=(%accepted -.upd) ~
?. =(/link path.upd) ~
:~ :: sync the group
::
%^ do-poke %group-hook
%group-hook-action
!> ^- group-hook-action:group-hook
[%add ship path]:invite.upd
::
:: sync the metadata
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%add-synced ship path]:invite.upd
==
::
++ handle-action
|= =action
^- card
[%pass /action %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ handle-view-action
|= act=view-action
^- (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 real-group=?]
^- (list card)
=/ group-path=^path
?- -.members
%group path.members
::
%ships
%+ weld
?:(real-group ~ [~.~]~)
[(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:link-listen-hook
[%watch path]
==
?: ?=(%group -.members) ~
:: if the group is "real", make contact-view do the heavy lifting
::
?: real-group
:_ ~
%^ do-poke %contact-view
%contact-view-action
!> ^- contact-view-action:contact-view
[%create group-path ships.members title description]
:: for "unmanaged" groups, do it ourselves
::
:* :: create the new group
::
%^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%bundle group-path]
::
:: fill the new group
::
%^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%add (~(put in ships.members) our.bowl) group-path]
::
:: make group available
::
%^ do-poke %group-hook
%group-hook-action
!> ^- group-hook-action:group-hook
[%add our.bowl group-path]
::
:: mirror group into a permission
::
%^ do-poke %permission-group-hook
%permission-group-hook-action
!> ^- permission-group-hook-action:permission-group-hook
[%associate group-path [group-path^%white ~ ~]]
::
:: expose the permission
::
%^ do-poke %permission-hook
%permission-hook-action
!> ^- permission-hook-action:permission-hook
[%add-owned group-path group-path]
::
:: 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
%+ 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
!> ^- group-hook-action:group-hook
[%remove group-path]
::
%^ do-poke %metadata-hook
%metadata-hook-action
!> ^- metadata-hook-action:metadata-hook
[%remove group-path]
::
%^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%unbundle group-path]
==
:: 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)
:- %^ do-poke %group-store
%group-action
!> ^- group-action:group-store
[%add ships group-path]
:: for managed groups, rely purely on group logic for invites
::
?. ?=([%'~' ^] group-path)
~
:: for unmanaged groups, send invites manually
::
%+ turn ~(tap in ships)
|= =ship
^- card
%^ do-poke %invite-hook
%invite-action
!> ^- invite-action
:^ %invite /link
(sham group-path eny.bowl)
:* our.bowl
%group-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 '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:en-json submission)
?> ?=([%o *] json)
:: add in seen status
::
=. p.json
%+ ~(put by p.json) 'seen'
:- %b
%+ scry-for ?
[%seen (build-discussion-path 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 path url.submission)
::
++ give-specific-submission
|= [n=@ud =path =url]
:_ [%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
%+ frond:enjs:format 'submission'
^- json
=; sub=(unit submission)
?~ sub ~
(submission:en-json 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 '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 path url)]
comment:en-json
::
++ send-update
|= =update
^- card
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
%submissions
%+ give-json
(update:en-json update)
:~ /json/0/submissions
(weld /json/0/submissions path.update)
==
::
%discussions
%+ give-json
(update:en-json update)
:_ ~
%+ weld /json/0/discussions
(build-discussion-path [path url]:update)
::
%observation
%+ give-json
(update:en-json 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)
==
--

1
pkg/arvo/app/link/css/index.css Normal file
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/link/img/Spinner.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/link/img/SwitcherClosed.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
pkg/arvo/app/link/img/SwitcherOpen.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/link/img/Tile.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 3.3 KiB

BIN
pkg/arvo/app/link/img/popout.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/link/img/search.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

20
pkg/arvo/app/link/index.html Normal file
View File

@ -0,0 +1,20 @@
<!doctype html>
<html>
<head>
<title>Links</title>
<meta charset="utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no" />
<link rel="stylesheet" href="/~link/css/index.css" />
<link rel="icon" type="image/png" href="/~launch/img/Favicon.png">
</head>
<body class="w-100 h-100">
<div id="root" class="w-100 h-100">
</div>
<script src="/~channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~link/js/index.js"></script>
</body>
</html>

1
pkg/arvo/app/link/js/index.js Normal file
View File

File diff suppressed because one or more lines are too long

1
pkg/arvo/app/link/js/tile.js Normal file
View File

File diff suppressed because one or more lines are too long

248
pkg/arvo/app/metadata-hook.hoon Normal file
View File

@ -0,0 +1,248 @@
:: metadata-hook: allow syncing foreign metadata
::
:: watch paths:
:: /group/%group-path all updates related to this group
::
/- *metadata-store, *metadata-hook
/+ default-agent, dbug
~% %metadata-hook-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
==
::
+$ state-zero
$: %0
synced=(map group-path ship)
==
--
=| state-zero
=* state -
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
[[%pass /updates %agent [our.bowl %metadata-store] %watch /updates]~ this]
::
++ on-save !>(state)
++ on-load |=(=vase `this(state !<(state-zero vase)))
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%metadata-hook-action
=^ cards state
(poke-hook-action:hc !<(metadata-hook-action vase))
[cards this]
::
%metadata-action
[(poke-action:hc !<(metadata-action vase)) this]
==
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%group *] [(watch-group:hc t.path) this]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick =^(cards state (kick:hc wire) [cards this])
%watch-ack =^(cards state (watch-ack:hc wire p.sign) [cards this])
%fact
?+ p.cage.sign (on-agent:def wire sign)
%metadata-update
=^ cards state
(fact-metadata-update:hc wire !<(metadata-update q.cage.sign))
[cards this]
==
==
--
::
|_ =bowl:gall
++ poke-hook-action
|= act=metadata-hook-action
^- (quip card _state)
|^
?- -.act
%add-owned
?> (team:title our.bowl src.bowl)
:- ~
?: (~(has by synced) path.act) state
state(synced (~(put by synced) path.act our.bowl))
::
%add-synced
?> (team:title our.bowl src.bowl)
=/ =path [%group path.act]
?: (~(has by synced) path.act) [~ state]
:_ state(synced (~(put by synced) path.act ship.act))
[%pass path %agent [ship.act %metadata-hook] %watch path]~
::
%remove
=/ ship (~(get by synced) path.act)
?~ ship [~ state]
?: &(!=(u.ship src.bowl) ?!((team:title our.bowl src.bowl)))
[~ state]
:_ state(synced (~(del by synced) path.act))
%- zing
:~ (unsubscribe [%group path.act] u.ship)
[%give %kick ~[[%group path.act]] ~]~
==
==
::
++ unsubscribe
|= [=path =ship]
^- (list card)
?: =(ship our.bowl)
[%pass path %agent [our.bowl %metadata-store] %leave ~]~
[%pass path %agent [ship %metadata-hook] %leave ~]~
--
::
++ poke-action
|= act=metadata-action
^- (list card)
|^
?: (team:title our.bowl src.bowl)
?- -.act
%add (send group-path.act)
%remove (send group-path.act)
==
?> (is-permitted src.bowl group-path.act)
?- -.act
%add (metadata-poke our.bowl %metadata-store)
%remove (metadata-poke our.bowl %metadata-store)
==
::
++ send
|= =group-path
^- (list card)
=/ =ship
%+ slav %p
?: (is-managed group-path) (snag 0 group-path)
(snag 1 group-path)
=/ app ?:(=(ship our.bowl) %metadata-store %metadata-hook)
(metadata-poke ship app)
::
++ metadata-poke
|= [=ship app=@tas]
^- (list card)
[%pass / %agent [ship app] %poke %metadata-action !>(act)]~
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
--
::
++ watch-group
|= =path
^- (list card)
|^
?> =(our.bowl (~(got by synced) path))
?> (is-permitted src.bowl path)
%+ turn ~(tap by (metadata-scry path))
|= [[=group-path =resource] =metadata]
^- card
[%give %fact ~ %metadata-update !>([%add group-path resource metadata])]
::
++ metadata-scry
|= pax=^path
^- associations
=. pax ;:(weld /=metadata-store/(scot %da now.bowl)/group pax /noun)
.^(associations %gx pax)
--
::
++ fact-metadata-update
|= [wir=wire fact=metadata-update]
^- (quip card _state)
|^
[?:((team:title our.bowl src.bowl) handle-local handle-foreign) state]
::
++ handle-local
?+ -.fact ~
%add
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
::
%update-metadata
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
::
%remove
?. (~(has by synced) group-path.fact) ~
(give group-path.fact fact)
==
::
++ handle-foreign
?+ -.fact ~
%add
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke fact)
::
%update-metadata
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke [%add +.fact])
::
%remove
?. =(src.bowl (~(got by synced) group-path.fact)) ~
(poke fact)
==
::
++ give
|= [=path upd=metadata-update]
^- (list card)
[%give %fact ~[[%group path]] %metadata-update !>(upd)]~
::
++ poke
|= act=metadata-action
^- (list card)
[%pass / %agent [our.bowl %metadata-store] %poke %metadata-action !>(act)]~
--
::
++ kick
|= wir=wire
^- (quip card _state)
:_ state
?+ wir !!
[%updates ~]
[%pass /updates %agent [our.bowl %metadata-store] %watch /updates]~
::
[%group @ *]
?. (~(has by synced) t.wir) ~
=/ =ship (~(got by synced) t.wir)
?: =(ship our.bowl)
[%pass wir %agent [our.bowl %metadata-store] %watch wir]~
[%pass wir %agent [ship %metadata-hook] %watch wir]~
==
::
++ watch-ack
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?> ?=(^ wir)
[~ ?~(saw state state(synced (~(del by synced) t.wir)))]
::
++ is-permitted
|= [=ship pax=path]
^- ?
=. pax
;: weld
/=permission-store/(scot %da now.bowl)/permitted
[(scot %p ship) pax]
/noun
==
.^(? %gx pax)
--

205
pkg/arvo/app/metadata-store.hoon Normal file
View File

@ -0,0 +1,205 @@
:: metadata-store: data store for application metadata and mappings
:: between groups and resources within applications
::
:: group-paths are expected to be an existing group path
:: resources are expected to correspond to existing app paths
::
:: note: when scrying for metadata, to make the arguments safe in paths,
:: encode group-path and app-path using (scot %t (spat group-path))
::
:: +watch paths:
:: /all assocations + updates
:: /updates just updates
:: /app-name/%app-name specific app's associations + updates
::
:: +peek paths:
:: /associations all associations
:: /group-indices all group indices
:: /app-indices all app indices
:: /resource-indices all resource indices
:: /metadata/%group-path/%app-name/%app-path specific metadatum
:: /app-name/%app-name associations for app
:: /group/%group-path associations for group
::
/+ *metadata-json, default-agent, verb, dbug
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
==
::
+$ state-zero
$: %0
=associations
group-indices=(jug group-path resource)
app-indices=(jug app-name [group-path app-path])
resource-indices=(jug resource group-path)
==
--
::
=| state-zero
=* state -
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
metadata-core +>
mc ~(. metadata-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
?: ?=(%metadata-action mark)
(poke-metadata-action:mc !<(metadata-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 %metadata-update !>([%associations associations]))
[%updates ~] ~
[%app-name @ ~]
=/ =app-name i.t.path
=/ app-indices (metadata-for-app:mc app-name)
(give %metadata-update !>([%associations app-indices]))
==
[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)
[%y %group-indices ~] ``noun+!>(group-indices)
[%y %app-indices ~] ``noun+!>(app-indices)
[%y %resource-indices ~] ``noun+!>(resource-indices)
[%x %associations ~] ``noun+!>(associations)
[%x %app-name @ ~]
=/ =app-name i.t.t.path
``noun+!>((metadata-for-app:mc app-name))
::
[%x %group *]
=/ =group-path t.t.path
``noun+!>((metadata-for-group:mc group-path))
::
[%x %metadata @ @ @ ~]
=/ =group-path (stab (slav %t i.t.t.path))
=/ =resource [`@tas`i.t.t.t.path (stab (slav %t i.t.t.t.t.path))]
``noun+!>((~(get by associations) [group-path resource]))
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ poke-metadata-action
|= act=metadata-action
^- (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)
==
::
++ handle-add
|= [=group-path =resource =metadata]
^- (quip card _state)
:- %+ send-diff app-name.resource
?. (~(has by resource-indices) resource)
[%add group-path resource metadata]
[%update-metadata group-path resource metadata]
%= state
associations
(~(put by associations) [group-path resource] metadata)
::
group-indices
(~(put ju group-indices) group-path resource)
::
app-indices
(~(put ju app-indices) app-name.resource [group-path app-path.resource])
::
resource-indices
(~(put ju resource-indices) resource group-path)
==
::
++ handle-remove
|= [=group-path =resource]
^- (quip card _state)
:- (send-diff app-name.resource [%remove group-path resource])
%= state
associations
(~(del by associations) [group-path resource])
::
group-indices
(~(del ju group-indices) group-path resource)
::
app-indices
(~(del ju app-indices) app-name.resource [group-path app-path.resource])
::
resource-indices
(~(del ju resource-indices) resource group-path)
==
::
++ metadata-for-app
|= =app-name
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(gut by app-indices) app-name ~))
|= [=group-path =app-path]
:- [group-path [app-name app-path]]
(~(got by associations) [group-path [app-name app-path]])
::
++ metadata-for-group
|= =group-path
^- ^associations
%- ~(gas by *^associations)
%+ turn ~(tap in (~(gut by group-indices) group-path ~))
|= =resource
:- [group-path resource]
(~(got by associations) [group-path resource])
::
++ send-diff
|= [=app-name upd=metadata-update]
^- (list card)
|^
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%app-name app-name ~] upd)
==
::
++ update-subscribers
|= [pax=path upd=metadata-update]
^- (list card)
[%give %fact ~[pax] %metadata-update !>(upd)]~
--
--

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

@ -3,7 +3,7 @@
:: mirror the ships in specified groups to specified permission paths
::
/- *group-store, *permission-group-hook
/+ *permission-json, default-agent, verb
/+ *permission-json, default-agent, verb, dbug
::
|%
+$ state
@ -25,6 +25,7 @@
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall

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

@ -7,6 +7,7 @@
/- *permission-hook
/+ *permission-json, default-agent, verb, dbug
::
~% %permission-hook-top ..is ~
|%
+$ state
$% [%0 state-0]
@ -195,7 +196,15 @@
%delete
?. (~(has by synced) path.diff)
[~ state]
:_ state(synced (~(del by synced) path.diff))
=/ 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]

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

File diff suppressed because it is too large Load Diff

3
pkg/arvo/app/publish/css/index.css
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/publish/img/Spinner.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/publish/img/SwitcherClosed.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
pkg/arvo/app/publish/img/SwitcherOpen.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

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

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 245 B

BIN
pkg/arvo/app/publish/img/popout.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

BIN
pkg/arvo/app/publish/img/search.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 951 B

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.1 KiB

After

Width:  |  Height:  |  Size: 3.7 KiB

4
pkg/arvo/app/publish/index.hoon
View File

@ -10,13 +10,13 @@
=content "width=device-width, initial-scale=1, shrink-to-fit=no";
;link(rel "stylesheet", href "/~publish/index.css");
;link(rel "icon", type "image/png", href "/~launch/img/Favicon.png");
;script@"/~/channel/channel.js";
;script@"/~channel/channel.js";
;script@"/~modulo/session.js";
;script: window.injectedState = {(en-json:html inject)}
==
::
;body
;div#root;
;div#root.w-100.h-100;
;script@"/~publish/index.js";
==
==

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

File diff suppressed because one or more lines are too long

2
pkg/arvo/app/publish/js/tile.js
View File

File diff suppressed because one or more lines are too long

96
pkg/arvo/app/s3-store.hoon Normal file
View File

@ -0,0 +1,96 @@
/- *s3
/+ s3-json, default-agent, verb, dbug
~% %s3-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-zero
==
::
+$ state-zero [%0 =credentials =configuration]
--
::
=| state-zero
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
~% %s3-agent-core ..card ~
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old-vase=vase
[~ this(state !<(state-zero old-vase))]
::
++ on-poke
~/ %s3-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%s3-action (poke-action !<(action vase))
==
[cards this]
::
++ poke-action
|= act=action
^- (quip card _state)
:- [%give %fact [/all]~ %s3-update !>(act)]~
?- -.act
%set-endpoint
state(endpoint.credentials endpoint.act)
::
%set-access-key-id
state(access-key-id.credentials access-key-id.act)
::
%set-secret-access-key
state(secret-access-key.credentials secret-access-key.act)
::
%set-current-bucket
%_ state
current-bucket.configuration bucket.act
buckets.configuration (~(put in buckets.configuration) bucket.act)
==
::
%add-bucket
state(buckets.configuration (~(put in buckets.configuration) bucket.act))
::
%remove-bucket
state(buckets.configuration (~(del in buckets.configuration) bucket.act))
==
--
::
++ on-watch
~/ %s3-watch
|= =path
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~]
:~ (give %s3-update !>([%credentials credentials]))
(give %s3-update !>([%configuration configuration]))
==
==
[cards this]
::
++ give
|= =cage
^- card
[%give %fact ~ cage]
--
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

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

@ -54,7 +54,7 @@
:_ this
:~ [%pass /bind/soto %arvo %e %connect [~ /'~dojo'] %soto]
:* %pass /launch/soto %agent [our.bol %launch] %poke
%launch-action !>([%soto /sototile '/~dojo/js/tile.js'])
%launch-action !>([%add %soto /sototile '/~dojo/js/tile.js'])
==
==
++ on-save !>(state)

2
pkg/arvo/app/soto/css/index.css
View File

File diff suppressed because one or more lines are too long

BIN
pkg/arvo/app/soto/img/Spinner.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 679 B

BIN
pkg/arvo/app/soto/img/Tile.png
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 6.4 KiB

After

Width:  |  Height:  |  Size: 2.2 KiB

BIN
pkg/arvo/app/soto/img/popout.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.5 KiB

6
pkg/arvo/app/soto/index.html
View File

@ -6,9 +6,11 @@
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<link rel="stylesheet" href="/~dojo/css/index.css" />
<link rel="icon" type="image/png" href="/~launch/img/Favicon.png">
</head>
<body class="bg-black">
<div id="root" />
<body class="w-100 h-100">
<div id="root" class="w-100 h-100">
</div>
<script src="/~/channel/channel.js"></script>
<script src="/~modulo/session.js"></script>
<script src="/~dojo/js/index.js"></script>

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

File diff suppressed because one or more lines are too long

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