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

Merge pull request #2946 from urbit/ipc-redux-kh

Browse Source 
[WIP] King Haskell New IPC
This commit is contained in:
Joe Bryan 2020-06-12 10:34:57 -07:00 committed by GitHub
commit dd58f00051
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
446 changed files with 30341 additions and 7477 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.

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

@ -3,7 +3,7 @@ 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
labels: landscape
assignees: ''
---

42
.travis.yml
View File

@ -2,45 +2,53 @@ jobs:
include:
- os: linux
language: nix
nix: 2.1.3
env: STACK_YAML=pkg/hs/stack.yaml
nix: 2.3.6
before_install:
- git lfs pull
- sh/travis-install-stack
install:
- nix-env -iA cachix -f https://cachix.org/api/v1/install
- stack --no-terminal --install-ghc build urbit-king --only-dependencies
script:
- cachix use urbit2
- ./sh/cachix
- make build
- make release
- sh/release-king-linux64-dynamic
- sh/ci-tests
- os: linux
language: generic
env: STACK_YAML=pkg/hs/stack.yaml
cache:
directories:
- $HOME/.ghc
- $HOME/.cabal
- $HOME/.stack
- $TRAVIS_BUILD_DIR/.stack-work
before_install:
- sh/travis-install-stack
install:
- stack --no-terminal --install-ghc build urbit-king --only-dependencies
script:
- stack test
- sh/release-king-linux64-dynamic
- os: osx
language: generic
sudo: required
env: STACK_YAML=pkg/hs/stack.yaml
cache:
directories:
- $HOME/.ghc
- $HOME/.cabal
- $HOME/.stack
- $TRAVIS_BUILD_DIR/.stack-work
before_install:
- sh/travis-install-stack
install:
- stack --no-terminal --install-ghc build urbit-king --only-dependencies
script:
- stack test
- sh/release-king-darwin-dynamic
cache:
directories:
- $HOME/.ghc
- $HOME/.cabal
- $HOME/.stack
- $TRAVIS_BUILD_DIR/.stack-work
deploy:
- skip_cleanup: true
provider: gcs

124
MAINTAINERS.md
View File

@ -1,5 +1,117 @@
# 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
@ -119,6 +231,9 @@ this:
```
urbit-vx.y.z
Note that this Vere release will by default boot fresh ships using an Urbit OS
va.b.c pill.
Release binaries:
(linux64)
@ -138,9 +253,11 @@ Contributions:
The same schpeel re: release candidates applies here.
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 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
@ -170,4 +287,3 @@ Post an announcement to urbit-dev. The tag annotation, basically, is fine here
-- 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:4259ef9a7112459948d2cb032266b1c2aa66b5cb34c83d1f5ee9ef1f1b7aebc3
size 10687559
oid sha256:f18a8670a53dc7fe0a3660c639a46e7c9d900ebd235d41e78ceb5af6807ff1ad
size 11350224

4
bin/ivory.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:50c17bcd19004751c4c13c62ea37a8e70d42377c36bce50318992653943ae50e
size 1234008
oid sha256:ac18ec9cb1035466d9aef16371738ea80f2b1d13206afb44a8ba37e0a1db812b
size 1265214

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:f39f6f1c7de1bca5710731ca11664771280a54b72c61192a1416c9ea23b25e16
size 13036410
oid sha256:ab1e700ae005ffc73f14deaf1ae4263d378032499c9d63ec77a28187f08a4989
size 13709878

7
nix/cachix/tests.nix Normal file
View File

@ -0,0 +1,7 @@
let
ops = import ../ops/default.nix {};
in
{
results = ops.test;
fakebus = ops.bus;
}

2
nix/deps-env.nix
View File

@ -10,7 +10,7 @@ let
libs =
with pkgs;
[ openssl zlib curl gmp scrypt libsigsegv ncurses openssl zlib lmdb ];
[ openssl curl gmp scrypt libsigsegv openssl zlib lmdb ];
osx =
with pkgs;

3
nix/ops/boot-ship.nix
View File

@ -10,9 +10,10 @@ let
tlon = import ../pkgs { inherit pkgs; };
arvo = tlon.arvo;
urbit = tlon.urbit;
herb = tlon.herb;
in
import ./fakeship {
inherit pkgs tlon deps arvo pill ship debug;
inherit pkgs arvo pill ship urbit herb;
}

8
nix/ops/default.nix
View File

@ -31,16 +31,16 @@ let
ship = "zod";
};
in
rec {
bus = import ./fakeship {
inherit pkgs herb urbit arvo;
pill = bootsolid;
ship = "bus";
};
in
rec {
test = import ./test {
inherit pkgs herb urbit;
ship = bus;

2
nix/ops/fakeship/builder.sh
View File

@ -13,7 +13,7 @@ check () {
[ 3 -eq "$(herb $out -d 3)" ]
}
if check
if check && sleep 10 && check
then
echo "Boot success." >&2
herb $out -p hood -d '+hood/exit' || true

5
nix/ops/test/builder.sh
View File

@ -38,8 +38,9 @@ herb ./ship -p test -d ':- %renders /'
herb ./ship -d '~& %finish-test-renders ~'
# Run the test generator
herb ./ship -d '+test, =seed `@uvI`(shaz %reproducible)' |
tee test-generator-output
herb ./ship -d '+test, =seed `@uvI`(shaz %reproducible)' > test-generator-output
cat test-generator-output || true
herb ./ship -p hood -d '+hood/mass'

8
nix/pkgs/default.nix
View File

@ -14,9 +14,13 @@ let
inherit (deps) ed25519;
};
libaes_siv = import ./libaes_siv {
inherit pkgs;
};
mkUrbit = { debug }:
import ./urbit {
inherit pkgs ent debug ge-additions;
inherit pkgs ent debug ge-additions libaes_siv;
inherit (deps) argon2 murmur3 uv ed25519 sni scrypt softfloat3;
inherit (deps) secp256k1 h2o ivory-header ca-header;
};
@ -26,4 +30,4 @@ let
in
{ inherit ent ge-additions arvo arvo-ropsten herb urbit urbit-debug; }
{ inherit ent ge-additions libaes_siv arvo arvo-ropsten herb urbit urbit-debug; }

7
nix/pkgs/libaes_siv/builder.sh Normal file
View File

@ -0,0 +1,7 @@
source $stdenv/setup
cp -r $src ./src
chmod -R u+w ./src
cd ./src
PREFIX=$out make install

12
nix/pkgs/libaes_siv/cross.nix Normal file
View File

@ -0,0 +1,12 @@
{ env_name, env, deps }:
env.make_derivation rec {
name = "libaes_siv";
builder = ./release.sh;
src = ../../../pkg/libaes_siv;
cross_inputs = [ env.openssl ];
CC = "${env.host}-gcc";
AR = "${env.host}-ar";
}

9
nix/pkgs/libaes_siv/default.nix Normal file
View File

@ -0,0 +1,9 @@
{ pkgs }:
pkgs.stdenv.mkDerivation rec {
name = "libaes_siv";
builder = ./builder.sh;
src = ../../../pkg/libaes_siv;
nativeBuildInputs = [ pkgs.openssl ];
}

13
nix/pkgs/libaes_siv/release.sh Normal file
View File

@ -0,0 +1,13 @@
source $setup
cp -r $src ./src
chmod -R u+w ./src
cd ./src
for dep in $cross_inputs; do
export CFLAGS="${CFLAGS-} -I$dep/include"
export LDFLAGS="${LDFLAGS-} -L$dep/lib"
done
PREFIX=$out make install

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

@ -1,7 +1,7 @@
{
pkgs,
debug,
argon2, ed25519, ent, ge-additions, h2o, murmur3, scrypt, secp256k1, sni, softfloat3, uv, ivory-header, ca-header
argon2, ed25519, ent, ge-additions, libaes_siv, h2o, murmur3, scrypt, secp256k1, sni, softfloat3, uv, ivory-header, ca-header
}:
let
@ -18,10 +18,10 @@ let
deps =
with pkgs;
[ curl gmp libsigsegv ncurses openssl zlib lmdb ];
[ curl gmp libsigsegv openssl zlib lmdb ];
vendor =
[ argon2 softfloat3 ed25519 ent ge-additions h2o scrypt uv murmur3 secp256k1 sni ivory-header ca-header ];
[ argon2 softfloat3 ed25519 ent ge-additions libaes_siv h2o scrypt uv murmur3 secp256k1 sni ivory-header ca-header ];
urbit = pkgs.stdenv.mkDerivation {
inherit name meta;

8
nix/pkgs/urbit/release.nix
View File

@ -4,18 +4,19 @@
ent,
name ? "urbit",
debug ? false,
ge-additions
ge-additions,
libaes_siv
}:
let
crossdeps =
with env;
[ curl libgmp libsigsegv ncurses openssl zlib lmdb ];
[ curl libgmp libsigsegv openssl zlib lmdb ];
vendor =
with deps;
[ argon2 softfloat3 ed25519 ge-additions h2o scrypt uv murmur3 secp256k1 sni ivory-header ca-header ];
[ argon2 softfloat3 ed25519 ge-additions libaes_siv h2o scrypt uv murmur3 secp256k1 sni ivory-header ca-header ];
in
@ -26,7 +27,6 @@ env.make_derivation {
MEMORY_DEBUG = debug;
CPU_DEBUG = debug;
EVENT_TIME_DEBUG = false;
NCURSES = env.ncurses;
name = "${name}-${env_name}";
exename = name;

1
nix/pkgs/urbit/release.sh
View File

@ -17,6 +17,5 @@ bash ./configure
make build/urbit build/urbit-worker -j8
mkdir -p $out/bin
cp -r $NCURSES/share/terminfo $out/bin/$exename-terminfo
cp ./build/urbit $out/bin/$exename
cp ./build/urbit-worker $out/bin/$exename-worker

2
nix/pkgs/urbit/shell.nix
View File

@ -10,7 +10,7 @@ import ./default.nix {
inherit pkgs;
debug = false;
inherit (tlon)
ent ge-additions;
ent ge-additions libaes_siv;
inherit (deps)
argon2 ed25519 h2o murmur3 scrypt secp256k1 sni softfloat3 uv ivory-header ca-header;
}

7
nix/release.nix
View File

@ -19,20 +19,25 @@ let
ge-additions = env:
import ./pkgs/ge-additions/cross.nix env;
libaes_siv = env:
import ./pkgs/libaes_siv/cross.nix env;
urbit = { env, debug }:
import ./pkgs/urbit/release.nix env {
inherit debug;
name = if debug then "urbit-debug" else "urbit";
ent = ent env;
ge-additions = ge-additions env;
libaes_siv = libaes_siv env;
};
builds-for-platform = plat:
plat.deps // {
inherit (plat.env) curl libgmp libsigsegv ncurses openssl zlib lmdb;
inherit (plat.env) curl libgmp libsigsegv openssl zlib lmdb;
inherit (plat.env) cmake_toolchain;
ent = ent plat;
ge-additions = ge-additions plat;
libaes_siv = libaes_siv plat;
urbit = urbit { env = plat; debug = false; };
urbit-debug = urbit { env = plat; debug = true; };
};

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)

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

@ -9,22 +9,22 @@
:: we concat the ship onto the head of the path,
:: and trust it to take care of the rest.
::
/- *chat-store, *chat-view, *chat-hook,
/- view=chat-view, hook=chat-hook,
*permission-store, *group-store, *invite-store,
sole-sur=sole
/+ sole-lib=sole, chat-eval, default-agent, verb, dbug,
auto=language-server-complete
*rw-security, sole
/+ shoe, default-agent, verb, dbug, store=chat-store
::
|%
+$ card card:agent:gall
+$ card card:shoe
::
+$ versioned-state
$% state-1
$% state-2
state-1
state-0
==
::
+$ state-1
$: %1
+$ state-2
$: %2
grams=(list mail) :: all messages
known=(set [target serial]) :: known message lookup
count=@ud :: (lent grams)
@ -34,12 +34,25 @@
settings=(set term) :: frontend flags
width=@ud :: display width
timez=(pair ? @ud) :: timezone adjustment
cli=state=sole-share:sole-sur :: console state
==
::
+$ state-1
$: %1
grams=(list mail) :: all messages
known=(set [target serial:store]) :: known message lookup
count=@ud :: (lent grams)
bound=(map target glyph) :: bound circle glyphs
binds=(jug glyph target) :: circle glyph lookup
audience=(set target) :: active targets
settings=(set term) :: frontend flags
width=@ud :: display width
timez=(pair ? @ud) :: timezone adjustment
cli=state=sole-share:sole :: console state
eny=@uvJ :: entropy
==
::
+$ state-0
$: grams=(list [[=ship =path] envelope]) :: all messages
$: grams=(list [[=ship =path] envelope:store]) :: all messages
known=(set [[=ship =path] serial]) :: known message lookup
count=@ud :: (lent grams)
bound=(map [=ship =path] glyph) :: bound circle glyphs
@ -48,11 +61,11 @@
settings=(set term) :: frontend flags
width=@ud :: display width
timez=(pair ? @ud) :: timezone adjustment
cli=state=sole-share:sole-sur :: console state
cli=state=sole-share:sole :: console state
eny=@uvJ :: entropy
==
::
+$ mail [source=target envelope]
+$ mail [source=target envelope:store]
+$ target [in-group=? =ship =path]
::
+$ glyph char
@ -62,7 +75,7 @@
::
+$ command
$% [%target (set target)] :: set messaging target
[%say letter] :: send message
[%say letter:store] :: send message
[%eval cord hoon] :: send #-message
::
::
@ -91,18 +104,20 @@
== ::
::
--
=| state-1
=| state-2
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:shoe command)
^- (shoe:shoe command)
=<
|_ =bowl:gall
+* this .
talk-core +>
tc ~(. talk-core(eny eny.bowl) bowl)
tc ~(. talk-core bowl)
def ~(. (default-agent this %|) bowl)
des ~(. (default:shoe this command) bowl)
::
++ on-init
^- (quip card _this)
@ -124,18 +139,9 @@
=^ cards state
?+ mark (on-poke:def mark vase)
%noun (poke-noun:tc !<(* vase))
%sole-action (poke-sole-action:tc !<(sole-action:sole-sur vase))
==
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
=^ cards state (peer:tc path)
[cards this]
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
@ -153,14 +159,39 @@
::
%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 !<(update:store q.cage.sign))
%invite-update (handle-invite-update:tc !<(invite-update q.cage.sign))
==
==
[cards this]
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ command-parser
|= sole-id=@ta
parser:sh:tc
::
++ tab-list
|= sole-id=@ta
tab-list:sh:tc
::
++ on-command
|= [sole-id=@ta =command]
=^ cards state
(work:sh:tc command)
[cards this]
::
++ on-connect
|= sole-id=@ta
^- (quip card _this)
[[prompt:sh-out:tc ~] this]
::
++ can-connect can-connect:des
++ on-disconnect on-disconnect:des
--
::
|_ =bowl:gall
@ -183,13 +214,9 @@
?: (~(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)))
::
?(~ ^)
^- state-2
=? u.old ?=(?(~ ^) -.u.old)
^- state-1
:- %1
%= u.old
grams ~ ::NOTE this only impacts historic message lookup in chat-cli
@ -221,21 +248,30 @@
|= t=[ship path]
`target`[| t]
==
==
::
=? u.old ?=(%1 -.u.old)
^- state-2
=, u.old
:* %2
grams known count
bound binds audience
settings width timez
==
::
?> ?=(%2 -.u.old)
u.old
:: +catch-up: process all chat-store state
::
++ catch-up
^- (quip card _state)
?. .^(? %gu /(scot %p our.bowl)/chat-store/(scot %da now.bowl))
[~ state]
=/ =inbox
(scry-for inbox %chat-store /all)
=/ =inbox:store
(scry-for inbox:store %chat-store /all)
|- ^- (quip card _state)
?~ inbox [~ state]
=* path p.n.inbox
=* mailbox q.n.inbox
=/ =target (path-to-target path)
=^ cards-n state (read-envelopes target envelopes.mailbox)
=^ 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]
@ -249,7 +285,8 @@
^- card
[%pass /invites %agent [our.bowl %invite-store] %watch /invitatory/chat]
::
++ our-self (name:title our.bowl)
::TODO better moon support. (name:title our.bowl)
++ our-self our.bowl
:: +target-to-path: prepend ship to the path
::
++ target-to-path
@ -284,28 +321,6 @@
?: ?=(%catch-up a)
catch-up
[~ 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)
(sole:sh-in act)
:: +peer: accept only cli subscriptions from ourselves
::
++ peer
|= =path
^- (quip card _state)
?. (team:title our-self src.bowl)
~| [%peer-talk-stranger src.bowl]
!!
?. ?=([%sole *] path)
~| [%peer-talk-strange path]
!!
:: display a fresh prompt
:- [prompt:sh-out ~]
:: start with fresh sole state
state(state.cli *sole-share:sole-sur)
:: +handle-invite-update: get new invites
::
++ handle-invite-update
@ -317,17 +332,17 @@
:: +diff-chat-update: get new mailboxes & messages
::
++ diff-chat-update
|= [=wire upd=chat-update]
|= [=wire upd=update:store]
^- (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)]
|= [=target envs=(list envelope:store)]
^- (quip card _state)
?~ envs [~ state]
=^ cards-i state (read-envelope target i.envs)
@ -413,7 +428,7 @@
:: +read-envelope: add envelope to state and show it to user
::
++ read-envelope
|= [=target =envelope]
|= [=target =envelope:store]
^- (quip card _state)
?: (~(has in known) [target uid.envelope])
::NOTE we no-op only because edits aren't possible
@ -425,132 +440,16 @@
count +(count)
==
::
:: +sh-in: handle user input
:: +sh: shoe handling
::
++ sh-in
::NOTE interestingly, adding =, sh-out breaks compliation
++ sh
|%
:: +sole: apply sole action
::
++ sole
|= act=sole-action:sole-sur
^- (quip card _state)
?- -.dat.act
%det (edit +.dat.act)
%clr [~ state]
%ret obey
%tab (tab +.dat.act)
==
:: +tab-list: static list of autocomplete entries
++ tab-list
^- (list (option:auto tank))
:~
[%join leaf+";join ~ship/chat-name (glyph)"]
[%leave leaf+";leave ~ship/chat-name"]
::
[%create leaf+";create [type] /chat-name (glyph)"]
[%delete leaf+";delete /chat-name"]
[%invite leaf+";invite /chat-name ~ships"]
[%banish leaf+";banish /chat-name ~ships"]
::
[%bind leaf+";bind [glyph] ~ship/chat-name"]
[%unbind leaf+";unbind [glyph]"]
[%what leaf+";what (~ship/chat-name) (glyph)"]
::
[%settings leaf+";settings"]
[%set leaf+";set key (value)"]
[%unset leaf+";unset key"]
::
[%chats leaf+";chats"]
[%help leaf+";help"]
==
++ tab
|= pos=@ud
^- (quip card _state)
?: ?| =(~ buf.state.cli)
!=(';' -.buf.state.cli)
==
:_ state
[(effect:sh-out [%bel ~]) ~]
::
=+ (get-id:auto pos (tufa buf.state.cli))
=/ needle=term
(fall id '')
?: &(!=(pos 1) =(0 (met 3 needle)))
[~ state] :: autocomplete empty command iff user at start of command
=/ options=(list (option:auto tank))
(search-prefix:auto needle tab-list)
=/ advance=term
(longest-match:auto options)
=/ to-send=tape
(trip (rsh 3 (met 3 needle) advance))
=/ send-pos
(add pos (met 3 (fall forward '')))
=| moves=(list card)
=? moves ?=(^ options)
[(tab:sh-out options) moves]
=| fxs=(list sole-effect:sole-sur)
|- ^- (quip card _state)
?~ to-send
[(flop moves) state]
=^ char state.cli
(~(transmit sole-lib state.cli) [%ins send-pos `@c`i.to-send])
%_ $
moves [(effect:sh-out %det char) moves]
send-pos +(send-pos)
to-send t.to-send
==
:: +edit: apply sole edit
::
:: called when typing into the cli prompt.
:: applies the change and does sanitizing.
::
++ edit
|= cal=sole-change:sole-sur
^- (quip card _state)
=^ inv state.cli (~(transceive sole-lib state.cli) cal)
=+ fix=(sanity inv buf.state.cli)
?~ lit.fix
[~ state]
:: just capital correction
?~ err.fix
(slug fix)
:: allow interior edits and deletes
?. &(?=($del -.inv) =(+(p.inv) (lent buf.state.cli)))
[~ state]
(slug fix)
:: +sanity: check input sanity
::
:: parses cli prompt using +read.
:: if invalid, produces error correction description, for use with +slug.
::
++ sanity
|= [inv=sole-edit:sole-sur buf=(list @c)]
^- [lit=(list sole-edit:sole-sur) err=(unit @u)]
=+ res=(rose (tufa buf) read)
?: ?=(%& -.res) [~ ~]
[[inv]~ `p.res]
:: +slug: apply error correction to prompt input
::
++ slug
|= [lit=(list sole-edit:sole-sur) err=(unit @u)]
^- (quip card _state)
?~ lit [~ state]
=^ lic state.cli
%- ~(transmit sole-lib state.cli)
^- sole-edit:sole-sur
?~(t.lit i.lit [%mor lit])
:_ state
:_ ~
%+ effect:sh-out %mor
:- [%det lic]
?~(err ~ [%err u.err]~)
:: +read: command parser
::
:: parses the command line buffer.
:: produces commands which can be executed by +work.
::
++ read
++ parser
|^
%+ knee *command |. ~+
=- ;~(pose ;~(pfix mic -) message)
@ -733,7 +632,7 @@
::
++ text
%+ cook crip
(plus ;~(less (jest '•') next))
(plus next)
:: +expr: parse expression into [cord hoon]
::
++ expr
@ -742,33 +641,29 @@
%+ stag (crip q.tub)
wide:(vang & [&1:% &2:% (scot %da now.bowl) |3:%])
--
:: +obey: apply result
:: +tab-list: command descriptions
::
:: called upon hitting return in the prompt.
:: if input is invalid, +slug is called.
:: otherwise, the appropriate work is done and
:: the command (if any) gets echoed to the user.
::
++ obey
^- (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 ~) ~] state]
=^ cal state.cli (~(transmit sole-lib state.cli) [%set ~])
=^ cards state (work u.jub)
:_ state
%+ weld
^- (list card)
:: echo commands into scrollback
?. =(`0 (find ";" buf)) ~
[(note:sh-out (tufa `(list @)`buf)) ~]
:_ cards
%+ effect:sh-out %mor
:~ [%nex ~]
[%det cal]
++ tab-list
^- (list [@t tank])
:~
[%join leaf+";join ~ship/chat-name (glyph)"]
[%leave leaf+";leave ~ship/chat-name"]
::
[%create leaf+";create [type] /chat-name (glyph)"]
[%delete leaf+";delete /chat-name"]
[%invite leaf+";invite /chat-name ~ships"]
[%banish leaf+";banish /chat-name ~ships"]
::
[%bind leaf+";bind [glyph] ~ship/chat-name"]
[%unbind leaf+";unbind [glyph]"]
[%what leaf+";what (~ship/chat-name) (glyph)"]
::
[%settings leaf+";settings"]
[%set leaf+";set key (value)"]
[%unset leaf+";unset key"]
::
[%chats leaf+";chats"]
[%help leaf+";help"]
==
:: +work: run user command
::
@ -853,7 +748,7 @@
%channel %channel
?(%village %village-with-group) %village
==
?^ (scry-for (unit mailbox) %chat-store [%mailbox real-path])
?^ (scry-for (unit mailbox:store) %chat-store [%mailbox real-path])
=- [[- ~] state]
%- print:sh-out
"{(spud path)} already exists!"
@ -864,7 +759,7 @@
=- [[- moz] state]
%^ act %do-create %chat-view
:- %chat-view-action
!> ^- chat-view-action
!> ^- action:view
:* %create
(rsh 3 1 (spat path))
''
@ -882,7 +777,7 @@
=- [[- ~] state]
%^ act %do-delete %chat-view
:- %chat-view-action
!> ^- chat-view-action
!> ^- action:view
[%delete (target-to-path | our-self path)]
:: +change-permission: modify permissions on a local chat
::
@ -941,7 +836,7 @@
:: gives ugly %chat-hook-reap
%^ act %do-join %chat-view
:- %chat-view-action
!> ^- chat-view-action
!> ^- action:view
[%join ship.target (target-to-path target) (fall ask-history %.y)]
:: +leave: unsync & destroy mailbox
::
@ -954,22 +849,22 @@
"can't ;leave local chats, maybe use ;delete instead"
%^ act %do-leave %chat-hook
:- %chat-hook-action
!> ^- chat-hook-action
!> ^- action:hook
[%remove (target-to-path target)]
:: +say: send messages
::
++ say
|= =letter
|= =letter:store
^- (quip card _state)
~! bowl
=/ =serial (shaf %msg-uid eny.bowl)
:_ state(eny (shax eny.bowl))
:_ state
^- (list card)
%+ turn ~(tap in audience)
|= =target
%^ act %out-message %chat-hook
:- %chat-action
!> ^- chat-action
!> ^- action:store
:+ %message (target-to-path target)
[serial *@ our-self now.bowl letter]
:: +eval: run hoon, send code and result as message
@ -978,7 +873,7 @@
::
++ eval
|= [txt=cord exe=hoon]
(say %code txt (eval:chat-eval bowl exe))
(say %code txt (eval:store bowl exe))
:: +lookup-glyph: print glyph info for all, glyph or target
::
++ lookup-glyph
@ -1041,7 +936,7 @@
::
++ set-width
|= w=@ud
[~ state(width w)]
[~ state(width (max 40 w))]
:: +set-timezone: configure timestamp printing adjustment
::
++ set-timezone
@ -1121,23 +1016,16 @@
--
--
::
:: +sh-out: output to the cli
:: +sh-out: ouput to session
::
++ sh-out
|%
:: +effect: console effect card
:: +effect: console effect card for all listeners
::
++ effect
|= fec=sole-effect:sole-sur
|= effect=sole-effect:sole
^- card
::TODO don't hard-code session id 'drum' here
[%give %fact ~[/sole/drum] %sole-effect !>(fec)]
:: +tab: print tab-complete list
::
++ tab
|= options=(list [cord tank])
^- card
(effect %tab options)
[%shoe ~ %sole effect]
:: +print: puts some text into the cli as-is
::
++ print
@ -1190,7 +1078,7 @@
:: and the %notify flag is set, emit a bell.
::
++ show-envelope
|= [=target =envelope]
|= [=target =envelope:store]
^- (list card)
%+ weld
^- (list card)
@ -1310,13 +1198,14 @@
:: +mr: render messages
::
++ mr
=, sole
|_ $: source=target
envelope
envelope:store
==
:: +activate: produce sole-effect for printing message details
::
++ render-activate
^- sole-effect:sole-sur
^- sole-effect
~[%mor [%tan meta] body]
:: +meta: render message metadata (serial, timestamp, author, target)
::
@ -1329,7 +1218,7 @@
:: +body: long-form render of message contents
::
++ body
|- ^- sole-effect:sole-sur
|- ^- sole-effect
?- -.letter
?(%text %me)
=/ pre=tape ?:(?=(%me -.letter) "@ " "")
@ -1341,7 +1230,7 @@
%code
=/ texp=tape ['>' ' ' (trip expression.letter)]
:- %mor
|- ^- (list sole-effect:sole-sur)
|- ^- (list sole-effect)
?: =("" texp) [tan+output.letter ~]
=/ newl (find "\0a" texp)
?~ newl [txt+texp $(texp "")]
@ -1454,8 +1343,13 @@
~(glyph tr source)
=/ lis=(list tape)
%+ simple-wrap
~| [%weird-text `@`+.letter]
`tape``(list @)`(tuba (trip +.letter))
=/ result=(each tape tang)
%- mule |.
`(list @)`(tuba (trip +.letter))
?- -.result
%& p.result
%| "[[msg rendering error]]"
==
(sub wyd (min (div wyd 2) (lent pef)))
=+ lef=(lent pef)
=+ ?:((gth (lent lis) 0) (snag 0 lis) "")
@ -1487,6 +1381,8 @@
^- (list tape)
?~ txt ~
=/ [end=@ud nex=?]
=+ ret=(find "\0a" (scag +(wid) `tape`txt))
?^ ret [u.ret &]
?: (lte (lent txt) wid) [(lent txt) &]
=+ ace=(find " " (flop (scag +(wid) `tape`txt)))
?~ ace [wid |]

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

@ -2,9 +2,12 @@
:: 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, *metadata-store,
*permission-hook, *group-store, *permission-group-hook ::TMP for upgrade
/+ *chat-json, *chat-eval, default-agent, verb, dbug
/- *permission-store, *invite-store, *metadata-store,
*permission-hook, *group-store, *permission-group-hook, ::TMP for upgrade
hook=chat-hook,
view=chat-view
/+ default-agent, verb, dbug, store=chat-store
~% %chat-hook-top ..is ~
|%
+$ card card:agent:gall
::
@ -20,29 +23,30 @@
==
+$ state-0 [%0 state-base]
+$ state-base
$: =synced
$: =synced:hook
invite-created=_|
allow-history=(map path ?)
==
::
+$ poke
$% [%chat-action chat-action]
$% [%chat-action action:store]
[%permission-action permission-action]
[%invite-action invite-action]
[%chat-view-action chat-view-action]
[%chat-view-action action:view]
==
::
+$ fact
$% [%chat-update chat-update]
$% [%chat-update update:store]
==
--
=| state-1
=* state -
::
%+ verb |
%- agent:dbug
%+ verb |
^- agent:gall
=<
~% %chat-hook-agent-core ..poke-json ~
|_ bol=bowl:gall
+* this .
chat-core +>
@ -106,8 +110,8 @@
++ recreate-chat
|= [host=ship chat=path new-chat=path]
^- (list card)
=/ old-mailbox=mailbox
(need (scry:cc (unit mailbox) %chat-store [%mailbox chat]))
=/ old-mailbox=mailbox:store
(need (scry:cc (unit mailbox:store) %chat-store [%mailbox chat]))
=* enves envelopes.old-mailbox
:~ (chat-poke:cc [%delete new-chat])
(chat-poke:cc [%delete chat])
@ -115,7 +119,7 @@
(chat-poke:cc [%messages new-chat enves])
(chat-poke:cc [%read new-chat])
%^ make-poke %chat-hook %chat-hook-action
!> ^- chat-hook-action
!> ^- action:hook
?: =(our.bol host) [%add-owned new-chat %.y]
[%add-synced host new-chat %.y]
==
@ -222,23 +226,25 @@
--
::
++ 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-action (poke-chat-action:cc !<(action:store 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))
(poke-chat-hook-action:cc !<(action:hook vase))
==
[cards this]
::
++ on-watch
~/ %chat-hook-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
@ -248,6 +254,7 @@
==
::
++ on-agent
~/ %chat-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
@ -265,7 +272,7 @@
?+ p.cage.sign (on-agent:def wire sign)
%chat-update
=^ cards state
(fact-chat-update:cc wire !<(chat-update q.cage.sign))
(fact-chat-update:cc wire !<(update:store q.cage.sign))
[cards this]
::
%invite-update
@ -287,15 +294,16 @@
--
::
::
~% %chat-hook-library ..card ~
|_ bol=bowl:gall
::
++ poke-json
|= jon=json
^- (quip card _state)
(poke-chat-action (json-to-action jon))
(poke-chat-action (action:dejs:store jon))
::
++ poke-chat-action
|= act=chat-action
|= act=action:store
^- (quip card _state)
?> ?=(%message -.act)
:: local
@ -306,7 +314,7 @@
=* letter letter.envelope.act
=? letter &(?=(%code -.letter) ?=(~ output.letter))
=/ =hoon (ream expression.letter)
letter(output (eval bol hoon))
letter(output (eval:store bol hoon))
=/ ship (~(got by synced) path.act)
=/ appl ?:(=(ship our.bol) %chat-store %chat-hook)
[%pass / %agent [ship appl] %poke %chat-action !>(act)]~
@ -322,7 +330,7 @@
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]~
::
++ poke-chat-hook-action
|= act=chat-hook-action
|= act=action:hook
^- (quip card _state)
?- -.act
%add-owned
@ -346,7 +354,7 @@
=/ chat-path [%mailbox path.act]
:_ state
[%pass chat-path %agent [ship.act %chat-hook] %watch chat-path]~
=/ mailbox=(unit mailbox) (chat-scry path.act)
=/ mailbox=(unit mailbox:store) (chat-scry path.act)
=/ chat-history=path
:- %backlog
%+ weld path.act
@ -357,17 +365,23 @@
==
::
%remove
=/ ship (~(get by synced) path.act)
?~ ship [~ state]
=/ 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 src.bol) ?!((team:title our.bol src.bol)))
[~ state]
=. synced (~(del by synced) path.act)
:_ state
%- zing
:~ (pull-wire [%backlog (weld path.act /0)])
(pull-wire [%mailbox path.act])
[%give %kick ~[[%mailbox path.act]] ~]~
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]~
:* [%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)
==
==
::
@ -393,56 +407,31 @@
^- (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)
:: check if read is permitted
?> (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
:~ [%give %fact ~ %chat-update !>([%create pas])]~
?. ?&(?=(^ backlog-start) (~(has by allow-history) pas)) ~
(paginate-messages pas (need (chat-scry pas)) u.backlog-start)
?. ?&(?=(^ 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)
:_ state
?+ -.fact ~
::
%accepted
=/ ask-history ?~((chat-scry path.invite.fact) %.y %.n)
=* shp ship.invite.fact
@ -497,72 +486,72 @@
--
::
++ fact-chat-update
|= [wir=wire fact=chat-update]
|= [wir=wire =update:store]
^- (quip card _state)
?: (team:title our.bol src.bol)
(handle-local fact)
(handle-foreign fact)
(handle-local update)
(handle-foreign update)
::
++ handle-local
|= fact=chat-update
|= =update:store
^- (quip card _state)
?+ -.fact [~ state]
?+ -.update [~ state]
%delete
?. (~(has by synced) path.fact) [~ state]
=. synced (~(del by synced) path.fact)
?. (~(has by synced) path.update) [~ state]
=. synced (~(del by synced) path.update)
:_ state
:~ [%pass [%mailbox path.fact] %agent [our.bol %chat-store] %leave ~]
:~ [%pass [%mailbox path.update] %agent [our.bol %chat-store] %leave ~]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%message
:_ state
[%give %fact [%mailbox path.fact]~ %chat-update !>(fact)]~
[%give %fact [%mailbox path.update]~ %chat-update !>(update)]~
::
%messages
:_ state
[%give %fact [%mailbox path.fact]~ %chat-update !>(fact)]~
[%give %fact [%mailbox path.update]~ %chat-update !>(update)]~
==
::
++ handle-foreign
|= fact=chat-update
|= =update:store
^- (quip card _state)
?+ -.fact [~ state]
?+ -.update [~ state]
%create
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%create path.fact])]~
[(chat-poke [%create path.update])]~
::
%delete
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp [~ state]
?. =(u.shp src.bol) [~ state]
=. synced (~(del by synced) path.fact)
=. synced (~(del by synced) path.update)
:_ state
:- (chat-poke [%delete path.fact])
:~ [%pass [%mailbox path.fact] %agent [src.bol %chat-hook] %leave ~]
:- (chat-poke [%delete path.update])
:~ [%pass [%mailbox path.update] %agent [src.bol %chat-hook] %leave ~]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%message
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%message path.fact envelope.fact])]~
[(chat-poke [%message path.update envelope.update])]~
::
%messages
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%messages path.fact envelopes.fact])]~
[(chat-poke [%messages path.update envelopes.update])]~
==
::
++ kick
@ -577,7 +566,8 @@
~& store-kick+wir
?. (~(has by synced) t.wir) [~ state]
~& %chat-store-resubscribe
=/ mailbox=(unit mailbox) (chat-scry t.wir)
=/ mailbox=(unit mailbox:store)
(chat-scry t.wir)
:_ state
[%pass wir %agent [our.bol %chat-store] %watch [%mailbox t.wir]]~
::
@ -586,7 +576,7 @@
?. (~(has by synced) t.wir) [~ state]
~& %chat-hook-resubscribe
=/ =ship (~(got by synced) t.wir)
=/ mailbox=(unit mailbox) (chat-scry t.wir)
=/ mailbox=(unit mailbox:store) (chat-scry t.wir)
=/ chat-history
%+ welp backlog+t.wir
?~(mailbox /0 /(scot %ud (lent envelopes.u.mailbox)))
@ -594,15 +584,15 @@
[%pass chat-history %agent [ship %chat-hook] %watch chat-history]~
::
[%backlog @ @ *]
=/ pax `path`(oust [(dec (lent t.wir)) 1] `(list @ta)`t.wir)
?. (~(has by synced) pax) [~ state]
=/ 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)
=. pax ?~((chat-scry pax) wir [%mailbox pax])
=/ =path ?~((chat-scry chat) wir [%mailbox chat])
:_ state
[%pass pax %agent [ship %chat-hook] %watch pax]~
[%pass path %agent [ship %chat-hook] %watch path]~
==
::
++ watch-ack
@ -614,22 +604,23 @@
(poke-chat-hook-action %remove t.wir)
::
[%backlog @ @ @ *]
=/ pax `path`(oust [(dec (lent t.wir)) 1] `(list @ta)`t.wir)
%. (poke-chat-hook-action %remove pax)
=/ 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 pax)}"
:* leaf+"chat-hook failed subscribe on {(spud chat)}"
leaf+"stack trace:"
u.saw
==
==
::
++ chat-poke
|= act=chat-action
|= act=action:store
^- card
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
::
++ chat-view-poke
|= act=chat-view-action
|= act=action:view
^- card
[%pass / %agent [our.bol %chat-view] %poke %chat-view-action !>(act)]
::
@ -638,11 +629,6 @@
^- 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])]
::
++ sec-to-perm
|= [pax=path =kind]
^- permission-action
@ -650,8 +636,8 @@
::
++ chat-scry
|= pax=path
^- (unit mailbox)
%^ scry (unit mailbox)
^- (unit mailbox:store)
%^ scry (unit mailbox:store)
%chat-store
[%mailbox pax]
::
@ -732,13 +718,23 @@
(snoc `^path`path %noun)
==
::
++ pull-wire
|= pax=path
++ pull-backlog-subscriptions
|= [target=ship chat=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 ~]~
%+ 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
|= [=ship =wire]
^- card
?: =(ship our.bol)
[%pass wire %agent [our.bol %chat-store] %leave ~]
[%pass wire %agent [ship %chat-hook] %leave ~]
--

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

@ -1,30 +1,34 @@
:: chat-store: data store that holds linear sequences of chat messages
::
/+ *chat-json, *chat-eval, default-agent, verb, dbug
/+ store=chat-store, 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-one [%1 =inbox]
+$ state-zero [%0 =inbox:store]
+$ state-one [%1 =inbox:store]
+$ state-two [%2 =inbox:store]
::
+$ diff
$% [%chat-initial inbox]
[%chat-configs chat-configs]
[%chat-update chat-update]
$% [%chat-initial inbox:store]
[%chat-configs configs:store]
[%chat-update update:store]
==
--
::
=| state-one
=| state-two
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
~% %chat-store-agent-core ..peek-x-envelopes ~
|_ =bowl:gall
+* this .
chat-core +>
@ -36,23 +40,29 @@
++ on-load
|= old-vase=vase
=/ old !<(versioned-state old-vase)
?: ?=(%1 -.old)
?: ?=(%2 -.old)
[~ this(state old)]
:_ this(state [%1 inbox.old])
[%pass /lo-chst %agent [our.bowl %chat-hook] %poke %noun !>(%store-load)]~
=/ reversed-inbox=inbox:store
%- ~(run by inbox.old)
|= =mailbox:store
^- mailbox:store
[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)
=^ cards state
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(chat-action vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
==
[cards this]
::
++ on-watch
~/ %chat-store-watch
|= =path
^- (quip card _this)
|^
@ -61,7 +71,7 @@
?+ path (on-watch:def path)
[%keys ~] (give %chat-update !>([%keys ~(key by inbox)]))
[%all ~] (give %chat-initial !>(inbox))
[%configs ~] (give %chat-configs !>((inbox-to-configs inbox)))
[%configs ~] (give %chat-configs !>((inbox-to-configs:store inbox)))
[%updates ~] ~
[%mailbox @ *]
?> (~(has by inbox) t.path)
@ -77,11 +87,12 @@
::
++ on-leave on-leave:def
++ on-peek
~/ %chat-store-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(inbox)
[%x %configs ~] ``noun+!>((inbox-to-configs inbox))
[%x %configs ~] ``noun+!>((inbox-to-configs:store inbox))
[%x %keys ~] ``noun+!>(~(key by inbox))
[%x %envelopes *] (peek-x-envelopes:cc t.t.path)
[%x %mailbox *]
@ -104,6 +115,7 @@
--
::
::
~% %chat-store-library ..card ~
|_ bol=bowl:gall
::
++ peek-x-envelopes
@ -147,10 +159,10 @@
++ poke-json
|= jon=json
^- (quip card _state)
(poke-chat-action (json-to-action jon))
(poke-chat-action (action:dejs:store jon))
::
++ poke-chat-action
|= action=chat-action
|= =action:store
^- (quip card _state)
?- -.action
%create (handle-create action)
@ -166,62 +178,61 @@
==
::
++ handle-create
|= act=chat-action
|= =action:store
^- (quip card _state)
?> ?=(%create -.act)
?: (~(has by inbox) path.act) [~ state]
:- (send-diff path.act act)
state(inbox (~(put by inbox) path.act *mailbox))
?> ?=(%create -.action)
?: (~(has by inbox) path.action) [~ state]
:- (send-diff path.action action)
state(inbox (~(put by inbox) path.action *mailbox:store))
::
++ handle-delete
|= act=chat-action
|= =action:store
^- (quip card _state)
?> ?=(%delete -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
?> ?=(%delete -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
?~ mailbox [~ state]
:- (send-diff path.act act)
state(inbox (~(del by inbox) path.act))
:- (send-diff path.action action)
state(inbox (~(del by inbox) path.action))
::
++ handle-message
|= act=chat-action
|= =action:store
^- (quip card _state)
?> ?=(%message -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
?> ?=(%message -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
?~ mailbox
[~ state]
=. letter.envelope.act (evaluate-letter [author letter]:envelope.act)
=^ envelope u.mailbox (append-envelope u.mailbox envelope.act)
:- (send-diff path.act act(envelope envelope))
state(inbox (~(put by inbox) path.act u.mailbox))
=. letter.envelope.action (evaluate-letter [author letter]:envelope.action)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.action)
:- (send-diff path.action action(envelope envelope))
state(inbox (~(put by inbox) path.action u.mailbox))
::
++ handle-messages
|= act=chat-action
|= act=action:store
^- (quip card _state)
?> ?=(%messages -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.act)
?~ mailbox
[~ state]
=/ evaluated-envelopes=(list envelope) ~
=. envelopes.act (flop envelopes.act)
=| evaluated-envelopes=(list envelope:store)
|- ^- (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)
=^ envelope u.mailbox (append-envelope u.mailbox i.envelopes.act)
=. evaluated-envelopes (snoc evaluated-envelopes envelope)
=^ envelope u.mailbox (prepend-envelope u.mailbox i.envelopes.act)
=. evaluated-envelopes [envelope evaluated-envelopes]
$(envelopes.act t.envelopes.act)
::
++ handle-read
|= act=chat-action
|= act=action:store
^- (quip card _state)
?> ?=(%read -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
=/ mailbox=(unit mailbox:store) (~(get by inbox) path.act)
?~ mailbox
[~ state]
=. read.config.u.mailbox length.config.u.mailbox
@ -229,33 +240,33 @@
state(inbox (~(put by inbox) path.act u.mailbox))
::
++ evaluate-letter
|= [author=ship =letter]
^- ^letter
|= [author=ship =letter:store]
^- letter:store
=? letter
?& ?=(%code -.letter)
?=(~ output.letter)
(team:title our.bol author)
==
=/ =hoon (ream expression.letter)
letter(output (eval bol hoon))
letter(output (eval:store bol hoon))
letter
::
++ append-envelope
|= [=mailbox =envelope]
++ prepend-envelope
|= [=mailbox:store =envelope:store]
^+ [envelope mailbox]
=. number.envelope +(length.config.mailbox)
=: length.config.mailbox +(length.config.mailbox)
envelopes.mailbox (snoc envelopes.mailbox envelope)
envelopes.mailbox [envelope envelopes.mailbox]
==
[envelope mailbox]
::
++ update-subscribers
|= [pax=path update=chat-update]
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %chat-update !>(update)]~
::
++ send-diff
|= [pax=path upd=chat-update]
|= [pax=path upd=update:store]
^- (list card)
%- zing
:~ (update-subscribers /all upd)

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

@ -8,8 +8,12 @@
*metadata-store,
*permission-group-hook,
*chat-hook,
*metadata-hook
/+ *server, *chat-json, default-agent, verb, dbug
*metadata-hook,
*rw-security,
hook=chat-hook
/+ *server, default-agent, verb, dbug,
store=chat-store,
view=chat-view
/= index
/^ octs
/; as-octs:mimes:html
@ -42,14 +46,15 @@
/^ (map knot @)
/: /===/app/chat/img /_ /png/
::
~% %chat-view-top ..is ~
|%
+$ card card:agent:gall
::
+$ poke
$% [%launch-action [@tas path @t]]
[%chat-action chat-action]
[%chat-action action:store]
[%group-action group-action]
[%chat-hook-action chat-hook-action]
[%chat-hook-action action:hook]
[%permission-hook-action permission-hook-action]
[%permission-group-hook-action permission-group-hook-action]
==
@ -58,6 +63,7 @@
%- agent:dbug
^- agent:gall
=<
~% %chat-view-agent-core ..poke-handle-http-request ~
|_ bol=bowl:gall
+* this .
chat-core +>
@ -73,6 +79,7 @@
[%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)
@ -86,14 +93,15 @@
::
%json
:_ this
(poke-chat-view-action:cc (json-to-view-action !<(json vase)))
(poke-chat-view-action:cc (action:dejs:view !<(json vase)))
::
%chat-view-action
:_ this
(poke-chat-view-action:cc !<(chat-view-action vase))
(poke-chat-view-action:cc !<(action:view vase))
==
::
++ on-watch
~/ %chat-view-watch
|= =path
^- (quip card _this)
?> (team:title our.bol src.bol)
@ -104,7 +112,7 @@
:: 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))]~
[%give %fact ~ %json !>((inbox:enjs:store truncated-inbox-scry))]~
?: =(/configs path)
[[%give %fact ~ %json !>(*json)]~ this]
(on-watch:def path)
@ -112,23 +120,17 @@
++ message-limit 20
::
++ truncated-inbox-scry
^- inbox
=/ =inbox .^(inbox %gx /=chat-store/(scot %da now.bol)/all/noun)
^- inbox:store
=/ =inbox:store
.^(inbox:store %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 message-limit)
envelopes
(slag (sub length message-limit) envelopes)
|= =mailbox:store
^- mailbox:store
[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,11 +142,12 @@
?+ p.cage.sign (on-agent:def wire sign)
%chat-update
:_ this
(diff-chat-update:cc !<(chat-update q.cage.sign))
(diff-chat-update:cc !<(update:store q.cage.sign))
==
==
::
++ on-arvo
~/ %chat-view-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=(%bound +<.sign-arvo)
@ -159,6 +162,7 @@
--
::
::
~% %chat-view-library ..card ~
|_ bol=bowl:gall
::
++ poke-handle-http-request
@ -184,7 +188,7 @@
=/ envelopes (envelope-scry [(scot %ud start) (scot %ud end) pax])
%- json-response:gen
%- json-to-octs
%- update-to-json
%- update:enjs:store
[%messages pax start end envelopes]
::
[%'~chat' *] (html-response:gen index)
@ -194,10 +198,10 @@
|= jon=json
^- (list card)
?> (team:title our.bol src.bol)
(poke-chat-view-action (json-to-view-action jon))
(poke-chat-view-action (action:dejs:view jon))
::
++ poke-chat-view-action
|= act=chat-view-action
|= act=action:view
^- (list card)
|^
?> (team:title our.bol src.bol)
@ -261,8 +265,8 @@
?> ?=([%'~' ^] app-path.act)
:: retrieve old data
::
=/ data=(unit mailbox)
(scry-for (unit mailbox) %chat-store [%mailbox app-path.act])
=/ data=(unit mailbox:store)
(scry-for (unit mailbox:store) %chat-store [%mailbox app-path.act])
?~ data
~& [%cannot-groupify-nonexistent app-path.act]
~
@ -336,7 +340,10 @@
++ create-group
|= [=path app-path=path sec=rw-security ships=(set ship) title=@t desc=@t]
^- (list card)
?^ (group-scry path) ~
?^ (group-scry path)
:~ (create-security path %village)
(permission-hook-poke [%add-owned path path])
==
:: do not create a managed group if this is a sig path or a blacklist
::
?: =(sec %channel)
@ -422,9 +429,9 @@
::
++ chat-scry
|= pax=path
^- (unit mailbox)
^- (unit mailbox:store)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
.^((unit mailbox) %gx pax)
.^((unit mailbox:store) %gx pax)
::
++ maybe-group-from-chat
|= app-path=path
@ -479,10 +486,10 @@
--
::
++ diff-chat-update
|= upd=chat-update
|= upd=update:store
^- (list card)
=/ updates-json (update-to-json upd)
=/ configs-json (configs-to-json configs-scry)
=/ updates-json (update:enjs:store upd)
=/ configs-json (configs:enjs:store configs-scry)
:~ [%give %fact ~[/primary] %json !>(updates-json)]
[%give %fact ~[/configs] %json !>(configs-json)]
==
@ -490,7 +497,7 @@
:: +utilities
::
++ chat-poke
|= act=chat-action
|= act=action:store
^- card
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
::
@ -505,7 +512,7 @@
[%pass / %agent [our.bol %permission-store] %poke %permission-action !>(act)]
::
++ chat-hook-poke
|= act=chat-hook-action
|= act=action:hook
^- card
[%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action !>(act)]
::
@ -525,12 +532,12 @@
::
++ envelope-scry
|= pax=path
^- (list envelope)
(scry-for (list envelope) %chat-store [%envelopes pax])
^- (list envelope:store)
(scry-for (list envelope:store) %chat-store [%envelopes pax])
::
++ configs-scry
^- chat-configs
(scry-for chat-configs %chat-store /configs)
^- configs:store
(scry-for configs:store %chat-store /configs)
::
++ group-scry
|= pax=path

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 865 B

0
pkg/arvo/app/chat/img/Home.png → pkg/arvo/app/chat/img/Spinner.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 679 B

After

Width:  |  Height:  |  Size: 679 B

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

@ -26,5 +26,6 @@
<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>

3
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

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

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

File diff suppressed because one or more lines are too long

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

@ -7,6 +7,7 @@
*metadata-hook,
*metadata-store
/+ *contact-json, default-agent, dbug
~% %contact-hook-top ..is ~
|%
+$ card card:agent:gall
::
@ -18,7 +19,7 @@
+$ state-zero [%0 state-base]
+$ state-one [%1 state-base]
+$ state-base
$: synced=(map path ship)
$: =synced
invite-created=_|
==
--
@ -76,6 +77,7 @@
^- (quip card _this)
?+ path (on-watch:def path)
[%contacts *] [(watch-contacts:cc t.path) this]
[%synced *] [(watch-synced:cc t.path) this]
==
::
++ on-agent
@ -123,30 +125,29 @@
++ 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)
=/ 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)]~
--
::
++ 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
@ -159,7 +160,9 @@
[~ state]
=. synced (~(put by synced) path.act our.bol)
:_ state
[%pass contact-path %agent [our.bol %contact-store] %watch contact-path]~
:~ [%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)
@ -167,7 +170,9 @@
=. 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]~
:~ [%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)
@ -178,13 +183,20 @@
%- 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
:- (pull-wire [%contacts path.act])
state(synced (~(del by synced) path.act))
=/ 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
@ -196,10 +208,13 @@
=/ =group (need (group-scry pax))
?> (~(has in group) src.bol)
=/ contacts (need (contacts-scry pax))
:~ :*
%give %fact ~ %contact-update
!>([%contacts pax contacts])
== ==
[%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)]
@ -307,13 +322,15 @@
==
::
%add
=/ owner (~(got by synced) path.fact)
?> |(=(owner src.bol) =(src.bol ship.fact))
=/ 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 (~(got by synced) path.fact)
?> |(=(owner src.bol) =(src.bol ship.fact))
=/ 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])
@ -352,7 +369,8 @@
|= =path
^- (quip card _state)
?. (~(has by synced) path)
[~ state]
:_ state
[(contact-poke [%delete path])]~
:_ state(synced (~(del by synced) path))
:~ [%pass [%contacts path] %agent [our.bol %contact-store] %leave ~]
[(contact-poke [%delete path])]

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

@ -5,18 +5,33 @@
+$ 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=rolodex-0
==
+$ diff
$% [%contact-update contact-update]
+$ state-one
$: %1
=rolodex
==
--
::
=| state-zero
=| state-one
=* state -
%- agent:dbug
^- agent:gall
@ -30,8 +45,26 @@
++ 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)
?: ?=(%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]
@ -142,7 +175,7 @@
|= [=path =ship]
^- (quip card _state)
=/ contacts (~(got by rolodex) path)
?> (~(has by contacts) ship)
?. (~(has by contacts) ship) [~ state]
=. contacts (~(del by contacts) ship)
:- (send-diff path [%remove path ship])
state(rolodex (~(put by rolodex) path contacts))

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

@ -147,9 +147,9 @@
::
%delete
%+ weld
:~ (group-poke [%unbundle path.act])
:~ (contact-hook-poke [%remove path.act])
(group-poke [%unbundle path.act])
(contact-poke [%delete path.act])
(contact-hook-poke [%remove path.act])
==
(delete-metadata path.act)
::
@ -181,21 +181,19 @@
::
:: avatar images
::
:: [%'~groups' %avatar @ *]
:: =/ pax=path `path`t.t.site.url
:: ?~ pax not-found:gen
:: =/ pas `path`(flop pax)
:: ?~ pas not-found:gen
:: =/ pav `path`(flop t.pas)
:: ~& pav+pav
:: ~& name+name
:: =/ contact (contact-scry `path`(weld pav [name]~))
:: ?~ contact not-found:gen
:: ?~ avatar.u.contact not-found:gen
:: =* avatar u.avatar.u.contact
:: =/ decoded (de:base64 q.octs.avatar)
:: ?~ decoded not-found:gen
:: [[200 ['content-type' content-type.avatar]~] `u.decoded]
[%'~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)
==

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

File diff suppressed because one or more lines are too long

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 4.7 KiB

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 1.5 KiB

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

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.7 KiB

After

Width:  |  Height:  |  Size: 1.7 KiB

0
pkg/arvo/app/contacts/img/Home.png → pkg/arvo/app/contacts/img/Spinner.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 679 B

After

Width:  |  Height:  |  Size: 679 B

1
pkg/arvo/app/contacts/index.html
View File

@ -13,5 +13,6 @@
<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>

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

898
pkg/arvo/app/dbug.hoon Normal file
View File

@ -0,0 +1,898 @@
:: dbug: debug dashboard server
::
/- spider
/+ server, default-agent, verb, dbug
::
|%
+$ state-0 [%0 passcode=(unit @t)]
+$ 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 [~ /'~debug'] dap.bowl]~
::
++ on-save !>(state)
::
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-watch
|= =path
^- (quip card _this)
?. ?=([%http-response *] path)
(on-watch:def path)
[~ this]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?: ?=(%noun mark)
?> (team:title [our src]:bowl)
=/ code !<((unit @t) vase)
=/ msg=tape
?~ code
"Removing passcode access for debug interface."
"""
Enabling passcode access for debug interface. Anyone with this code can
view your applications' state, the people you've talked to, etc. Only
share with people you trust. To disable, run :dbug ~
"""
%- (slog leaf+msg ~)
[~ this(passcode code)]
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
:_ this
%+ give-simple-payload:app:server eyre-id
%+ authorize-http-request:do inbound-request
handle-http-request: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-agent on-agent:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
:: serving
::
++ authorize-http-request
=, server
:: if no passcode configured, only allow host ship to view
::
?~ passcode require-authorization:app
|= $: =inbound-request:eyre
handler=$-(inbound-request:eyre simple-payload:http)
==
?: authenticated.inbound-request
(handler inbound-request)
:: else, allow randos access,
:: on the condition they provide a correct ?passcode= url parameter
::
=; pass=(unit @t)
?: =(passcode pass)
(handler inbound-request)
(require-authorization:app inbound-request handler)
=/ from-url=(unit @t)
=- (~(get by -) 'passcode')
%- ~(gas by *(map @t @t))
args:(parse-request-line url.request.inbound-request)
?^ from-url from-url
:: try the referer field instead
::
=/ ref-url=(unit @t)
(get-header:http 'referer' header-list.request.inbound-request)
?~ ref-url ~
?~ (find "passcode={(trip u.passcode)}" (trip u.ref-url)) ~
passcode
::
++ handle-http-request
=, server
|= =inbound-request:eyre
^- simple-payload:http
=/ =request-line
%- parse-request-line
url.request.inbound-request
=* req-head header-list.request.inbound-request
::TODO handle POST
?. ?=(%'GET' method.request.inbound-request)
not-found:gen
(handle-get-request req-head request-line)
::
++ handle-get-request
=, server
|= [headers=header-list:http request-line]
^- simple-payload:http
=? site ?=([%'~debug' *] site) t.site
?~ ext
$(ext `%html, site [%index ~]) ::NOTE hack
:: if not json, serve static file
::
?. ?=([~ %json] ext)
=/ file=(unit octs)
(get-file-at /app/debug site u.ext)
?~ file not-found:gen
?+ u.ext 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 data matching the json and convert it
::
=; json=(unit json)
?~ json not-found:gen
%- json-response:gen
=, html
(as-octt:mimes (en-json u.json))
=, enjs:format
?+ site ~
:: /apps.json: {appname: running?}
::
[%apps ~]
%- some
%- pairs
%+ turn all:apps
|= app=term
[app b+(running:apps app)]
::
:: /app/[appname]...
::
[%app @ *]
=* app i.t.site
::TODO ?. (dbugable:apps app) ~
=/ rest=^path t.t.site
?+ rest ~
:: /app/[appname].json: {state: }
::
~
%- some
%- pairs
:~ :- 'simpleState'
%- tank
=; head=(unit ^tank)
(fall head leaf+"unversioned")
:: try to print the state version
::
=/ version=(unit vase)
(slew 2 (state:apps app))
?~ version ~
?. ?=(%atom -.p.u.version) ~
`(sell u.version)
::
:- 'subscriptions'
%- pairs
=+ (subscriptions:apps app)
|^ ~['in'^(incoming in) 'out'^(outgoing out)]
::
++ incoming
|= =bitt:gall
^- json
:- %a
%+ turn ~(tap by bitt)
|= [d=duct [s=^ship p=^path]]
%- pairs
:~ 'duct'^a+(turn d path)
'ship'^(ship s)
'path'^(path p)
==
::
++ outgoing
|= =boat:gall
^- json
:- %a
%+ turn ~(tap by boat)
|= [[w=wire s=^ship t=term] [a=? p=^path]]
%- pairs
:~ 'wire'^(path w)
'ship'^(ship s)
'app'^s+t
'acked'^b+a
'path'^(path p)
==
--
==
::
:: /app/[appname]/state.json
:: /app/[appname]/state/[query].json
::
[%state ?(~ [@ ~])]
%- some
=- (pairs 'state'^(tank -) ~)
%+ state-at:apps app
?~ t.rest ~
(slaw %t i.t.rest)
==
::
:: /spider.json
::
[%spider %threads ~]
%- some
:: turn flat stack descriptors into object (tree) representing stacks
::
|^ (tree-to-json build-thread-tree)
::
+$ tree
$~ ~
(map tid:spider tree)
::
++ build-thread-tree
%+ roll tree:threads
|= [stack=(list tid:spider) =tree]
?~ stack tree
%+ ~(put by tree) i.stack
%_ $
stack t.stack
tree (~(gut by tree) i.stack ~)
==
::
++ tree-to-json
|= =tree
o+(~(run by tree) tree-to-json)
--
::
:: /azimuth/status
::
:: /ames/peer.json
::
[%ames %peer ~]
=/ [known=(list [^ship *]) alien=(list [^ship *])]
%+ skid ~(tap by peers:v-ames)
|= [^ship kind=?(%alien %known)]
?=(%known kind)
%- some
%- pairs
::NOTE would do (cork head ship) but can't get that to compile...
:~ 'known'^a+(turn (turn known head) ship)
'alien'^a+(turn (turn alien head) ship)
==
::
:: /ames/peer/[shipname].json
::
[%ames %peer @ ~]
=/ who=^ship
(rash i.t.t.site fed:ag)
%- some
=, v-ames
(peer-to-json (peer who))
::
:: /behn/timers.json
::
[%behn %timers ~]
%- some
:- %a
%+ turn timers:v-behn
|= [date=@da =duct]
%- pairs
:~ 'date'^(time date)
'duct'^a+(turn duct path)
==
::
:: /clay/commits.json
::
[%clay %commits ~]
(some commits-json:v-clay)
::
:: /eyre/bindings.json
::
[%eyre %bindings ~]
%- some
:- %a
%+ turn bindings:v-eyre
=, eyre
|= [binding =duct =action]
%- pairs
:~ 'location'^s+(cat 3 (fall site '*') (spat path))
'action'^(render-action:v-eyre action)
==
::
:: /eyre/connections.json
::
[%eyre %connections ~]
%- some
:- %a
%+ turn ~(tap by connections:v-eyre)
|= [=duct outstanding-connection:eyre]
%- pairs
:~ 'duct'^a+(turn duct path)
'action'^(render-action:v-eyre action)
::
:- 'request'
%- pairs
=, inbound-request
:~ 'authenticated'^b+authenticated
'secure'^b+secure
'source'^s+(scot %if +.address)
:: ?- -.address
:: %ipv4 %if
:: %ipv6 %is
:: ==
==
::
:- 'response'
%- pairs
:~ 'sent'^(numb bytes-sent)
::
:- 'header'
?~ response-header ~
=, u.response-header
%- pairs
:~ 'status-code'^(numb status-code)
::
:- 'headers'
:- %a
%+ turn headers
|=([k=@t v=@t] s+:((cury cat 3) k ': ' v))
==
==
==
::
:: /eyre/authentication.json
::
[%eyre %authentication ~]
%- some
:- %a
%+ turn
%+ sort ~(tap by sessions:auth-state:v-eyre)
|= [[@uv a=@da] [@uv b=@da]]
(gth a b)
|= [cookie=@uv session:eyre]
%- pairs
:~ 'cookie'^s+(end 3 4 (rsh 3 2 (scot %x (shax cookie))))
'expiry'^(time expiry-time)
==
::
:: /eyre/channels.json
::
[%eyre %channels ~]
%- some
:- %a
=+ channel-state:v-eyre
%+ turn ~(tap by session)
|= [key=@t channel:eyre]
%- pairs
:~ 'session'^s+key
'connected'^b+!-.state
'expiry'^?-(-.state %& (time date.p.state), %| ~)
'next-id'^(numb next-id)
'unacked'^a+(turn (sort (turn ~(tap in events) head) dor) numb)
::
:- 'subscriptions'
:- %a
%+ turn ~(tap by subscriptions)
|= [=wire [=^ship app=term =^path *]]
%- pairs
:~ 'wire'^(^path wire)
'ship'^(^ship ship)
'app'^s+app
'path'^(^path path)
==
==
==
::
++ get-file-at
|= [base=path file=path ext=@ta]
^- (unit octs)
?. ?=(?(%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)
::
:: applications
::
++ apps
|%
++ all
^- (list term)
%+ murn
(scry (list path) %ct %home /app)
|= =path
^- (unit term)
?. ?=([%app @ %hoon ~] path) ~
`i.t.path
::
++ running
|= app=term
(scry ? %gu app ~)
::
++ dbugable
|= app=term
^- ?
!! ::TODO how to check if it supports the /dbug scries?
::
++ state
|= app=term
^- vase
(scry-dbug vase app /state)
::
++ state-at
|= [app=term what=(unit @t)]
^- tank
=/ state=vase (state app)
?~ what (sell state)
=/ result=(each vase tang)
%- mule |.
%+ slap
(slop state !>([bowl=bowl ..zuse]))
(ream u.what)
?- -.result
%& (sell p.result)
%| (head p.result)
==
::
++ subscriptions
=, gall
|= app=term
^- [out=boat in=bitt]
(scry-dbug ,[boat bitt] app /subscriptions)
::
++ scry-dbug
|* [=mold app=term =path]
(scry mold %gx app (snoc `^path`[%dbug path] %noun))
::
::TODO but why? we can't tell if it's on or not
++ poke-verb-toggle
|= app=term
^- card
(poke /verb/[app] app %verb !>(%loud))
--
::
:: threads
::
++ threads
|%
::NOTE every (list tid:spider) represents a stack,
:: with a unique tid at the end
++ tree
(scry (list (list tid:spider)) %gx %spider /tree/noun)
::
++ poke-kill
|= =tid:spider
^- card
(poke /spider/kill/[tid] %spider %spider-stop !>([tid |]))
--
::
:: ames
::
++ v-ames
|%
++ peers
(scry (map ship ?(%alien %known)) %a %peers ~)
::
++ peer
|= who=ship
(scry ship-state:ames %a %peer /(scot %p who))
::
++ peer-to-json
=, ames
=, enjs:format
|= =ship-state
|^ ^- json
%+ frond -.ship-state
?- -.ship-state
%alien (alien +.ship-state)
%known (known +.ship-state)
==
::
++ alien
|= alien-agenda
%- pairs
:~ 'messages'^(numb (lent messages))
'packets'^(numb ~(wyt in packets))
'heeds'^(set-array heeds from-duct)
==
::
:: json for known peer is structured to closely match the peer-state type.
:: where an index is specified, the array is generally sorted by those.
::
:: { life: 123,
:: route: { direct: true, lane: 'something' },
:: qos: { kind: 'status', last-contact: 123456 }, // ms timestamp
:: flows: { forward: [snd, rcv, ...], backward: [snd, rcv, ...] }
:: -> snd:
:: { bone: 123, // index
:: duct: ['/paths', ...]
:: current: 123,
:: next: 123,
:: unsent-messages: [123, ...], // size in bytes
:: queued-message-acks: [{
:: message-num: 123, // index
:: ack: 'ok'
:: }, ...],
:: packet-pump-state: {
:: next-wake: 123456, // ms timestamp
:: live: [{
:: message-num: 123, // index
:: fragment-num: 123, // index
:: num-fragments: 123,
:: last-sent: 123456, // ms timestamp
:: retries: 123,
:: skips: 123
:: }, ...],
:: metrics: {
:: rto: 123, // seconds
:: rtt: 123, // seconds
:: rttvar: 123,
:: ssthresh: 123,
:: num-live: 123,
:: cwnd: 123,
:: counter: 123
:: }
:: }
:: }
:: -> rcv:
:: { bone: 123, // index
:: duct: ['/paths', ...] // index
:: last-acked: 123,
:: last-heard: 123,
:: pending-vane-ack: [123, ...],
:: live-messages: [{
:: message-num: 123, // index
:: num-received: 122,
:: num-fragments: 123,
:: fragments: [123, ...]
:: }, ...],
:: nax: [123, ...]
:: }
:: nax: [{
:: bone: 123, // index
:: duct: ['/paths', ...],
:: message-num: 123
:: }, ...],
:: heeds: [['/paths', ...] ...]
:: }
::
++ known
|= peer-state
%- pairs
:~ 'life'^(numb life)
::
:- 'route'
%+ maybe route
|= [direct=? =lane]
%- pairs
:~ 'direct'^b+direct
::
:- 'lane'
?- -.lane
%& (ship p.lane)
::
%|
?~ l=((soft ,[=@tas =@if =@ud]) (cue p.lane))
s+(scot %x p.lane)
=, u.l
(tape "%{(trip tas)}, {(scow %if if)}, {(scow %ud ud)}")
==
==
::
:- 'qos'
%- pairs
:~ 'kind'^s+-.qos
'last-contact'^(time last-contact.qos)
==
::
:- 'flows'
|^ =/ mix=(list flow)
=- (sort - dor)
%+ welp
(turn ~(tap by snd) (tack %snd))
(turn ~(tap by rcv) (tack %rcv))
=/ [forward=(list flow) backward=(list flow)]
%+ skid mix
|= [=bone *]
=(0 (mod bone 2))
%- pairs
:~ ['forward' a+(turn forward build)]
['backward' a+(turn backward build)]
==
::
+$ flow
$: =bone
::
$= state
$% [%snd message-pump-state]
[%rcv message-sink-state]
==
==
::
++ tack
|* =term
|* [=bone =noun]
[bone [term noun]]
::
++ build
|= flow
^- json
%+ frond -.state
?- -.state
%snd (snd-with-bone ossuary bone +.state)
%rcv (rcv-with-bone ossuary bone +.state)
==
--
::
:- 'nax'
:- %a
%+ turn (sort ~(tap in nax) dor) :: sort by bone
|= [=bone =message-num]
%- pairs
:* 'message-num'^(numb message-num)
(bone-to-pairs bone ossuary)
==
::
'heeds'^(set-array heeds from-duct)
==
::
++ snd-with-bone
|= [=ossuary =bone message-pump-state]
^- json
%- pairs
:* 'current'^(numb current)
'next'^(numb next)
::
:- 'unsent-messages' :: as byte sizes
(set-array unsent-messages (cork (cury met 3) numb))
::
'unsent-fragments'^(numb (lent unsent-fragments)) :: as lent
::
:- 'queued-message-acks'
:- %a
%+ turn (sort ~(tap by queued-message-acks) dor) :: sort by msg nr
|= [=message-num =ack]
%- pairs
:~ 'message-num'^(numb message-num)
'ack'^s+-.ack
==
::
:- 'packet-pump-state'
%- pairs
=, packet-pump-state
:~ 'next-wake'^(maybe next-wake time)
::
:- 'live'
:- %a
%+ turn (sort ~(tap in live) dor) :: sort by msg nr & frg nr
|= [live-packet-key live-packet-val]
%- pairs
:~ 'message-num'^(numb message-num)
'fragment-num'^(numb fragment-num)
'num-fragments'^(numb num-fragments)
'last-sent'^(time last-sent)
'retries'^(numb retries)
'skips'^(numb skips)
==
::
:- 'metrics'
%- pairs
=, metrics
:~ 'rto'^(numb (div rto ~s1)) ::TODO milliseconds?
'rtt'^(numb (div rtt ~s1))
'rttvar'^(numb (div rttvar ~s1))
'ssthresh'^(numb ssthresh)
'num-live'^(numb num-live)
'cwnd'^(numb cwnd)
'counter'^(numb counter)
==
==
::
(bone-to-pairs bone ossuary)
==
::
++ rcv-with-bone
|= [=ossuary =bone message-sink-state]
^- json
%- pairs
:* 'last-acked'^(numb last-acked)
'last-heard'^(numb last-heard)
::
:- 'pending-vane-ack'
=- a+(turn - numb)
(sort (turn ~(tap in pending-vane-ack) head) dor) :: sort by msg #
::
:- 'live-messages'
:- %a
%+ turn (sort ~(tap by live-messages) dor) :: sort by msg #
|= [=message-num partial-rcv-message]
%- pairs
:~ 'message-num'^(numb message-num)
'num-received'^(numb num-received)
'num-fragments'^(numb num-fragments)
'fragments'^(set-array ~(key by fragments) numb)
==
::
'nax'^a+(turn (sort ~(tap in nax) dor) numb)
::
(bone-to-pairs bone ossuary)
==
::
++ bone-to-pairs
|= [=bone ossuary]
^- (list [@t json])
:~ 'bone'^(numb bone)
'duct'^(from-duct (~(gut by by-bone) bone ~))
==
::
++ maybe
|* [unit=(unit) enjs=$-(* json)]
^- json
?~ unit ~
(enjs u.unit)
::
++ set-array
|* [set=(set) enjs=$-(* json)]
^- json
a+(turn ~(tap in set) enjs)
::
++ from-duct
|= =duct
a+(turn duct path)
--
--
::
:: behn
::
++ v-behn
|%
++ timers
(scry ,(list [date=@da =duct]) %b %timers ~)
--
::
:: clay
::
::TODO depends on new clay changes (%s care)
++ v-clay
=, clay
|%
++ start-path /(scot %p our.bowl)/home/(scot %da now.bowl)
::
+$ commit
[=tako parents=(list tako) children=(list tako) wen=@da content-hash=@uvI]
::
++ commits-json
^- json
=+ .^(desks=(set desk) %cd start-path)
=/ heads=(list [tako desk])
%+ turn ~(tap in desks)
|= =desk
=+ .^(=dome %cv /(scot %p our.bowl)/[desk]/(scot %da now.bowl))
=/ =tako (~(got by hit.dome) let.dome)
[tako desk]
=/ yakis=(set yaki)
%- silt
^- (list yaki)
%- zing
%+ turn heads
|= [=tako =desk]
(trace-tako tako)
=/ commits=(list commit) (yakis-to-commits ~(tap in yakis))
=, enjs:format
%: pairs
head+(pairs (turn heads |=([=tako =desk] (scot %uv tako)^s+desk)))
commits+(commits-to-json commits)
~
==
::
++ yakis-to-commits
|= yakis=(list yaki)
^- (list commit)
%+ turn yakis
|= =yaki
:* r.yaki p.yaki
=/ candidates
%+ turn
(skim yakis |=(can=^yaki (lien p.can |=(=tako =(r.yaki tako)))))
|= can=^yaki
r.can
~(tap in (silt candidates))
t.yaki
.^(@uvI %cs (weld start-path /hash/(scot %uv r.yaki)))
==
::
++ trace-tako
|= =tako
~+
^- (list yaki)
=+ .^(=yaki %cs (weld start-path /yaki/(scot %uv tako)))
:- yaki
(zing (turn p.yaki trace-tako))
::
++ commits-to-json
|= commits=(list commit)
^- json
:- %a
%+ turn
%+ sort commits
|= [a=commit b=commit]
(gte wen.a wen.b)
|= =commit
(commit-to-json commit)
::
++ commit-to-json
|= =commit
^- json
=, enjs:format
%: pairs
'commitHash'^(tako-to-json tako.commit)
parents+a+(turn parents.commit tako-to-json)
children+a+(turn children.commit tako-to-json)
'contentHash'^(tako-to-json content-hash.commit)
~
==
::
++ tako-to-json
|= =tako
^- json
s+(scot %uv tako)
--
::
:: eyre
::
++ v-eyre
=, eyre
|%
++ bindings
(scry ,(list [=binding =duct =action]) %e %bindings ~)
::
++ connections
(scry ,(map duct outstanding-connection) %e %connections ~)
::
++ auth-state
(scry authentication-state %e %authentication-state ~)
::
++ channel-state
(scry ^channel-state %e %channel-state ~)
::
++ render-action
|= =action
^- json
:- %s
?+ -.action -.action
%gen :((cury cat 3) '+' (spat [desk path]:generator.action))
%app (cat 3 ':' app.action)
==
--
::
:: helpers
::
++ poke
|= [=wire app=term =mark =vase]
^- card
[%pass wire %agent [our.bowl app] %poke mark vase]
::
++ scry
|* [=mold care=term =desk =path]
.^(mold care (scot %p our.bowl) desk (scot %da now.bowl) path)
--

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

File diff suppressed because one or more lines are too long

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

@ -0,0 +1,20 @@
<!doctype html>
<html>
<head>
<title>Debug Dashboard</title>
<meta charset="utf-8" />
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no" />
<link rel="stylesheet" href="/~debug/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="/~debug/js/index.js"></script>
</body>
</html>

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

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

@ -12,9 +12,10 @@
=> |% :: external structures
++ id @tasession :: session id
++ house :: all state
$: $5
$: $6
egg/@u :: command count
hoc/(map id session) :: conversations
acl/(set ship) :: remote access whitelist
== ::
++ session :: per conversation
$: say/sole-share :: command-line state
@ -1349,9 +1350,12 @@
!>(state)
::
++ on-load
|= =old-state=vase
=/ old-state !<(house old-state-vase)
`..on-init(state old-state)
|= old=vase
?: ?=(%6 +<.old)
`..on-init(state !<(house old))
=/ old-5 !<([%5 egg=@u hoc=(map id session)] old)
=/ =house [%6 egg.old-5 hoc.old-5 *(set ship)]
`..on-init(state house)
::
++ on-poke
|= [=mark =vase]
@ -1359,6 +1363,7 @@
=^ moves state
^- (quip card:agent:gall house)
?+ mark ~|([%dojo-poke-bad-mark mark] !!)
::
%sole-action
=/ act !<(sole-action vase)
he-abet:(~(he-type he hid id.act ~ (~(got by hoc) id.act)) act)
@ -1367,8 +1372,17 @@
=+ !<([=id =command:lens] vase)
he-abet:(~(he-lens he hid id ~ (~(got by hoc) id)) command)
::
%json
~& jon=!<(json vase)
%allow-remote-login
=/ who !<(@p vase)
`state(acl (~(put in acl) who))
::
%revoke-remote-login
=/ who !<(@p vase)
:_ state(acl (~(del in acl) who))
[%give %kick ~ `who]~
::
%list-remote-logins
~& acl
`state
::
%wipe
@ -1390,8 +1404,9 @@
++ on-watch
|= =path
^- (quip card:agent:gall _..on-init)
~? !=(our.hid src.hid) [%dojo-peer-stranger src.hid]
?> (team:title our.hid src.hid)
?> ?| (team:title our.hid src.hid)
(~(has in acl) src.hid)
==
?> ?=([%sole @ ~] path)
=/ id i.t.path
=? hoc (~(has by hoc) id)

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

@ -8,14 +8,14 @@
=> |%
+$ 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
@ -98,7 +98,7 @@
::
=? old-state ?=(%2 -.old-state)
%- (slog leaf+"upgrading eth-watcher from %2" ~)
^- app-state
^- app-state-3
%= old-state
- %3
dogs
@ -109,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
@ -175,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)
@ -197,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
@ -385,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)
@ -411,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
~

53
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
::
@ -37,18 +38,12 @@
^- (quip card _this)
=/ old !<(state-zero vase)
:_ this(state old)
%+ murn
~(tap by synced.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])
~
=/ =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
@ -172,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
@ -184,7 +178,6 @@
?- -.diff
%keys [~ state]
%bundle [~ state]
::
%path
:_ state
?~ pax.diff ~
@ -218,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
@ -261,5 +257,4 @@
?: =(u.shp our.bol)
[%pass wir %agent [our.bol %group-store] %leave ~]~
[%pass wir %agent [u.shp %group-hook] %leave ~]~
::
--

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

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

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

@ -151,7 +151,7 @@
?+ site.request-line
not-found:gen
::
~
[~ ~]
=/ hym=manx
%+ index
[%b first-time]

35
pkg/arvo/app/launch/js/channel.js
View File

@ -1,5 +1,17 @@
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 =
@ -40,8 +52,10 @@ class Channel {
// disconnect function may be called exactly once.
//
this.outstandingSubscriptions = new Map();
}
this.deleteOnUnload();
setOnChannelError(onError = (err) => {}) {
this.onChannelError = onError;
}
deleteOnUnload() {
@ -164,8 +178,11 @@ class Channel {
this.lastEventId = e.lastEventId;
let obj = JSON.parse(e.data);
if (obj.response == "poke") {
let funcs = this.outstandingPokes.get(obj.id);
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")) {
@ -175,19 +192,20 @@ class Channel {
}
this.outstandingPokes.delete(obj.id);
} else if (obj.response == "subscribe") {
} 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
//
let funcs = this.outstandingSubscriptions.get(obj.id);
if (obj.hasOwnProperty("err")) {
funcs["err"](obj.err);
this.outstandingSubscriptions.delete(obj.id);
}
} else if (obj.response == "diff") {
let funcs = this.outstandingSubscriptions.get(obj.id);
let funcs = subFuncs;
funcs["event"](obj.json);
} else if (obj.response == "quit") {
let funcs = this.outstandingSubscriptions.get(obj.id);
let funcs = subFuncs;
funcs["quit"](obj);
this.outstandingSubscriptions.delete(obj.id);
} else {
@ -196,8 +214,9 @@ class Channel {
}
this.eventSource.onerror = e => {
console.error("eventSource error:", e);
this.delete();
this.init();
this.onChannelError(e);
}
}

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

File diff suppressed because one or more lines are too long

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

@ -1,8 +1,7 @@
:: link-listen-hook: get your friends' bookmarks
::
:: keeps track of a listening=(set app-path). automatically adds to that
:: whenever new %link resources get added in the metadata-store. users
:: can manually remove from and add back to this set.
:: keeps track of a listening=(set app-path). users can manually add to and
:: remove from this set.
::
:: for all ships in groups associated with those resources, we subscribe to
:: their link's local-pages and annotations at the resource path (through
@ -18,6 +17,7 @@
/- link-listen-hook, *metadata-store, *link, group-store
/+ mdl=metadata, default-agent, verb, dbug
::
~% %link-listen-hook-top ..is ~
|%
+$ versioned-state
$% [%0 state-0]
@ -289,21 +289,11 @@
|= upd=metadata-update
^- (quip card _state)
?+ -.upd [~ state]
%associations
=/ socs=(list [=group-path resource])
~(tap in ~(key by associations.upd))
=| cards=(list card)
|- ::TODO try for +roll maybe?
?~ socs [cards state]
=^ more-cards state
=, i.socs
?. =(%link app-name) [~ state]
%- handle-metadata-update
[%add group-path [%link app-path] *metadata]
$(socs t.socs, cards (weld cards more-cards))
::
%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)
@ -372,9 +362,11 @@
=* loop-whos $
?~ whos loop-socs(socs t.socs)
=^ caz state
?: ?=(%remove -.upd)
(leave-from-peer i.socs pax.upd i.whos)
(listen-to-peer i.socs pax.upd i.whos)
?. ?=(%remove -.upd)
(listen-to-peer i.socs pax.upd i.whos)
?: =(our.bowl i.whos)
(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

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

@ -21,6 +21,7 @@
::
/- group-store, *metadata-store
/+ *link, metadata, default-agent, verb, dbug
~% %link-proxy-hook-top ..is ~
|%
+$ state-0
$: %0
@ -113,8 +114,6 @@
`t.t.path
~
?~ target |
~? !.^(? %gu (scot %p our.bowl) %metadata-store (scot %da now.bowl) ~)
%woah-md-s-not-booted ::TODO fallback if needed
%+ lien (groups-from-resource:md %link u.target)
|= =group-path
^- ?

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

@ -1,20 +1,22 @@
:: link-view: frontend endpoints
::
:: endpoints, mapping onto link-store's paths. p is for page as in pagination.
:: updates only work for page 0.
:: only the /0/submissions endpoint provides updates.
:: as with link-store, urls are expected to use +wood encoding.
::
:: /json/[p]/submissions pages for all groups
:: /json/[p]/submissions/[some-group] page for one group
:: /json/[p]/discussions/[wood-url]/[some-group] page for url in group
:: /json/[n]/submission/[wood-url]/[some-group] nth matching submission
:: /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
@ -153,20 +155,22 @@
++ on-fail on-fail:def
--
::
~% %link-view-logic ..card ~
|_ =bowl:gall
+* md ~(. metadata bowl)
::
++ page-size 25
++ get-paginated
|* [p=(unit @ud) l=(list)]
^- [total=@ud pages=@ud page=_l]
:+ (lent l)
%+ add (div (lent l) page-size)
(min 1 (mod (lent l) page-size))
?~ p l
%+ scag page-size
%+ slag (mul u.p page-size)
l
|* [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
@ -311,6 +315,13 @@
%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
@ -480,9 +491,12 @@
:: }
::
++ give-initial-submissions
|= [p=@ud =path]
~/ %link-view-initial-submissions
|= [p=@ud =requested=path]
^- (list card)
:_ ?: =(0 p) ~
:_ :: only keep the base case alive (for updates), kick all others
::
?: &(=(0 p) ?=(~ requested-path)) ~
[%give %kick ~ ~]~
=; =json
[%give %fact ~ %json !>(json)]
@ -490,9 +504,9 @@
%- pairs:enjs:format
%+ turn
%~ tap by
%+ scry-for (map ^path submissions)
[%submissions path]
|= [=^path =submissions]
%+ scry-for (map path submissions)
[%submissions requested-path]
|= [=path =submissions]
^- [@t json]
:- (spat path)
=; =json
@ -505,6 +519,15 @@
%~ 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

0
pkg/arvo/app/link/img/Home.png → pkg/arvo/app/link/img/Spinner.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 679 B

After

Width:  |  Height:  |  Size: 679 B

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

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

@ -5,6 +5,7 @@
::
/- *metadata-store, *metadata-hook
/+ default-agent, dbug
~% %metadata-hook-top ..is ~
|%
+$ card card:agent:gall
+$ versioned-state

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

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because one or more lines are too long

0
pkg/arvo/app/publish/img/Home.png → pkg/arvo/app/publish/img/Spinner.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 679 B

After

Width:  |  Height:  |  Size: 679 B

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

70
pkg/arvo/app/shoe.hoon Normal file
View File

@ -0,0 +1,70 @@
:: shoe: example usage of /lib/shoe
::
:: the app supports one command: "demo".
:: running this command renders some text on all sole clients.
::
/+ shoe, verb, dbug, default-agent
|%
+$ state-0 [%0 ~]
+$ command ~
::
+$ card card:shoe
--
=| state-0
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
%- (agent:shoe command)
^- (shoe:shoe command)
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
des ~(. (default:shoe this command) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this]
::
++ on-poke on-poke:def
++ on-watch on-watch:def
++ 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
::
++ command-parser
|= sole-id=@ta
^+ |~(nail *(like command))
(cold ~ (jest 'demo'))
::
++ tab-list
|= sole-id=@ta
^- (list [@t tank])
:~ ['demo' leaf+"run example command"]
==
::
++ on-command
|= [sole-id=@ta =command]
^- (quip card _this)
=- [[%shoe ~ %sole -]~ this]
=/ =tape "{(scow %p src.bowl)} ran the command"
?. =(src our):bowl
[%txt tape]
[%klr [[`%br ~ `%g] [(crip tape)]~]~]
::
++ can-connect
|= sole-id=@ta
^- ?
?| =(~zod src.bowl)
(team:title [our src]:bowl)
==
::
++ on-connect on-connect:des
++ on-disconnect on-disconnect:des
--

0
pkg/arvo/app/soto/img/Home.png → pkg/arvo/app/soto/img/Spinner.png
View File

Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 679 B

After

Width:  |  Height:  |  Size: 679 B

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

1
pkg/arvo/gen/aqua/pill.hoon
View File

@ -1,3 +1,4 @@
:: Produce a pill for aqua
/+ pill
::
:- %say

1
pkg/arvo/gen/aqua/scry.hoon
View File

@ -1,3 +1,4 @@
:: Scry into an aqua ship
/- aquarium
/+ ph-util
=, aquarium

1
pkg/arvo/gen/azimuth-sources.hoon
View File

@ -1,3 +1,4 @@
:: List azimuth sources
:- %say
|= [[now=@da *] *]
:- %noun

1
pkg/arvo/gen/azimuth-tracker/kick.hoon
View File

@ -1,3 +1,4 @@
:: Kick azimuth-tracker
:- %say
|= *
[%azimuth-tracker-poke %listen ~ %| %azimuth-tracker]

1
pkg/arvo/gen/azimuth-tracker/listen.hoon
View File

@ -1,3 +1,4 @@
:: Add a source for azimuth-tracker
=> |%
+$ src
$% [%ship =ship ~]

1
pkg/arvo/gen/azimuth-tracker/watch.hoon
View File

@ -1,3 +1,4 @@
:: Change node url for azimuth-tracker
:- %say
|= [* [url=@ta ~] ~]
[%azimuth-tracker-poke %watch url]

1
pkg/arvo/gen/brass.hoon
View File

@ -1,3 +1,4 @@
:: Produce a brass pill
::
:::: /hoon/brass/gen
::

1
pkg/arvo/gen/dbug.hoon
View File

@ -10,6 +10,7 @@
:: all in subs matching the parameters
:: direction: %incoming or %outgoing
:: specifics:
:: ~ all subscriptions
:: [%ship ~ship] subscriptions to/from this ship
:: [%path /path] subscriptions on path containing /path
:: [%wire /wire] subscriptions on wire containing /wire

1
pkg/arvo/gen/deco.hoon
View File

@ -1,3 +1,4 @@
:: Hoon style sample
::
:: this is a sample file designed to set conventions for
:: high-quality conventional hoon.

9
pkg/arvo/gen/dojo/acl.hoon Normal file
View File

@ -0,0 +1,9 @@
:: acl: list the ships that are allowed to link to dojo
::
/? 310
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[~ ~]
==
[%list-remote-logins ~]

9
pkg/arvo/gen/dojo/allow-remote-login.hoon Normal file
View File

@ -0,0 +1,9 @@
:: allow-remote-login: allow a ship to link to dojo
::
/? 310
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=ship ~] ~]
==
[%allow-remote-login ship]

10
pkg/arvo/gen/dojo/revoke-remote-login.hoon Normal file
View File

@ -0,0 +1,10 @@
:: revoke-remote-login: revoke a ship's right to link to dojo,
:: kicking the ship if it is currently linked
::
/? 310
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=ship ~] ~]
==
[%revoke-remote-login ship]

1
pkg/arvo/gen/glass.hoon
View File

@ -1,3 +1,4 @@
:: Produce a glass pill
::
:::: /hoon/glass/gen
::

5
pkg/arvo/gen/hood/ames-wake.hoon Normal file
View File

@ -0,0 +1,5 @@
:: Set timers for any ames flows that lack them
::
:- %say
|= [^ ~ ~]
[%helm-ames-wake ~]

1
pkg/arvo/gen/hood/cancel-autocommit.hoon
View File

@ -1,3 +1,4 @@
:: Cancel autocommit
::
:::: /hoon/cancel-autocommit/hood/gen
::

1
pkg/arvo/gen/hood/cancel-automass.hoon
View File

@ -1,3 +1,4 @@
:: Cancel automass
::
:::: /hoon/cancel-automass/hood/gen
::

14
pkg/arvo/gen/hood/gall-sear.hoon Normal file
View File

@ -0,0 +1,14 @@
:: Clear ship from pending queues
::
:::: /hoon/gall-sear/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[=ship ~]
~
==
[%kiln-gall-sear ship]

1
pkg/arvo/gen/hood/static.hoon
View File

@ -1,3 +1,4 @@
:: Serve static files
/? 309
::
/= pre-process

1
pkg/arvo/gen/ivory.hoon
View File

@ -1,3 +1,4 @@
:: Produce an ivory pill
::
:::: /hoon/ivory/gen
::

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