Merge branch 'naive/roller' into naive/preboot

This commit is contained in:
fang 2021-11-08 20:52:59 +01:00
commit 77732e186f
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
1884 changed files with 237474 additions and 53828 deletions

3
.eslintrc.js Normal file
View File

@ -0,0 +1,3 @@
module.exports = {
ignorePatterns: ["**/*"]
};

7
.gitattributes vendored
View File

@ -2,3 +2,10 @@ bin/* filter=lfs diff=lfs merge=lfs -text
bin/*/* filter=lfs diff=lfs merge=lfs -text bin/*/* filter=lfs diff=lfs merge=lfs -text
pkg/arvo/**/*.css binary pkg/arvo/**/*.css binary
pkg/arvo/app/naive/logs.eth-logs filter=lfs diff=lfs merge=lfs -text pkg/arvo/app/naive/logs.eth-logs filter=lfs diff=lfs merge=lfs -text
**/package-lock.json binary merge=theirs
pkg/arvo/tmp/garden.jam filter=lfs diff=lfs merge=lfs -text
pkg/arvo/tmp/landscape.jam filter=lfs diff=lfs merge=lfs -text
pkg/arvo/tmp/base.jam filter=lfs diff=lfs merge=lfs -text
pkg/arvo/tmp/bitcoin.jam filter=lfs diff=lfs merge=lfs -text
pkg/arvo/tmp/webterm.jam filter=lfs diff=lfs merge=lfs -text

View File

@ -1,4 +1,4 @@
FROM jaredtobin/janeway:v0.15.2 FROM tloncorp/janeway:v0.15.4
COPY entrypoint.sh /entrypoint.sh COPY entrypoint.sh /entrypoint.sh
EXPOSE 22/tcp EXPOSE 22/tcp
ENTRYPOINT ["/entrypoint.sh"] ENTRYPOINT ["/entrypoint.sh"]

View File

@ -74,15 +74,15 @@ jobs:
# for the docker build. We don't want in on Mac, where it isn't but # for the docker build. We don't want in on Mac, where it isn't but
# it breaks the nix install. The two `if` clauses should be mutually # it breaks the nix install. The two `if` clauses should be mutually
# exclusive # exclusive
- uses: cachix/install-nix-action@v12 - uses: cachix/install-nix-action@v13
with: with:
extra_nix_config: | extra_nix_config: |
system-features = nixos-test benchmark big-parallel kvm system-features = nixos-test benchmark big-parallel kvm
if: ${{ matrix.os == 'ubuntu-latest' }} if: ${{ matrix.os == 'ubuntu-latest' }}
- uses: cachix/install-nix-action@v12 - uses: cachix/install-nix-action@v13
if: ${{ matrix.os != 'ubuntu-latest' }} if: ${{ matrix.os != 'ubuntu-latest' }}
- uses: cachix/cachix-action@v8 - uses: cachix/cachix-action@v10
with: with:
name: ares name: ares
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
@ -107,8 +107,8 @@ jobs:
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
- uses: cachix/install-nix-action@v12 - uses: cachix/install-nix-action@v13
- uses: cachix/cachix-action@v8 - uses: cachix/cachix-action@v10
with: with:
name: ares name: ares
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
@ -116,3 +116,24 @@ jobs:
- run: nix-build -A hs.urbit-king.components.exes.urbit-king --arg enableStatic true - run: nix-build -A hs.urbit-king.components.exes.urbit-king --arg enableStatic true
- run: nix-build -A hs-checks - run: nix-build -A hs-checks
- run: nix-build shell.nix - run: nix-build shell.nix
mingw:
runs-on: windows-latest
defaults:
run:
shell: C:\msys64\msys2_shell.cmd -mingw64 -defterm -no-start -here -c ". <(cygpath '{0}')"
working-directory: ./pkg/urbit
steps:
- uses: actions/checkout@v2
with:
lfs: true
# echo suppresses pacman prompt
- run: echo|./configure
env:
CACHIX_CACHE: ares
CACHIX_AUTH_TOKEN: ${{ secrets.CACHIX_AUTH_TOKEN }}
- run: make build/urbit build/urbit-worker
- run: build/urbit -l -d -B ../../bin/solid.pill -F bus && curl -f --data '{"source":{"dojo":"+hood/exit"},"sink":{"app":"hood"}}' http://localhost:12321

View File

@ -18,7 +18,7 @@ jobs:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
with: with:
fetch-depth: 0 fetch-depth: 0
- run: cd 'pkg/interface' && npm i - run: npm i && npm run bootstrap
- name: Publish to Chromatic - name: Publish to Chromatic
uses: chromaui/action@v1 uses: chromaui/action@v1
with: with:

24
.github/workflows/frontend-test.yml vendored Normal file
View File

@ -0,0 +1,24 @@
name: frontend-test
on:
pull_request:
paths:
- 'pkg/interface/**'
- 'pkg/btc-wallet/**'
- 'pkg/npm/**'
jobs:
frontend-test:
runs-on: ubuntu-latest
name: "Test changed frontend packages"
steps:
- uses: actions/checkout@v2
with:
fetch-depth: 0
- run: git fetch --prune
- name: 'Setup root deps'
run: npm ci
- name: 'Setup dependencies'
run: npm run bootstrap
- name: 'Run tests'
run: npm run test -- --since origin/$GITHUB_BASE_REF --include-dependents

View File

@ -6,14 +6,14 @@ on:
jobs: jobs:
glob: glob:
runs-on: ubuntu-latest runs-on: ubuntu-latest
name: "Create and deploy a glob to ~lomlyx-lopsem-nidsut-tomdun" name: "Create and deploy a glob to ~hanruc-nalfus-nidsut-tomdun"
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
with: with:
lfs: true lfs: true
- uses: ./.github/actions/glob - uses: ./.github/actions/glob
with: with:
ship: 'lomlyx-lopsem-nidsut-tomdun' ship: 'hanruc-nalfus-nidsut-tomdun'
credentials: ${{ secrets.JANEWAY_SERVICE_KEY }} credentials: ${{ secrets.JANEWAY_SERVICE_KEY }}
ssh-sec-key: ${{ secrets.JANEWAY_SSH_SEC_KEY }} ssh-sec-key: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
ssh-pub-key: ${{ secrets.JANEWAY_SSH_PUB_KEY }} ssh-pub-key: ${{ secrets.JANEWAY_SSH_PUB_KEY }}

View File

@ -1,20 +0,0 @@
name: group-timer
on:
push:
branches:
- 'ops/group-timer'
jobs:
glob:
runs-on: ubuntu-latest
name: "Create and deploy a glob to ~difmex-passed"
steps:
- uses: actions/checkout@v2
with:
lfs: true
- uses: ./.github/actions/glob
with:
ship: 'difmex-passed'
credentials: ${{ secrets.JANEWAY_SERVICE_KEY }}
ssh-sec-key: ${{ secrets.JANEWAY_SSH_SEC_KEY }}
ssh-pub-key: ${{ secrets.JANEWAY_SSH_PUB_KEY }}

View File

@ -16,11 +16,11 @@ jobs:
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
- uses: cachix/install-nix-action@v12 - uses: cachix/install-nix-action@v13
with: with:
extra_nix_config: | extra_nix_config: |
system-features = nixos-test benchmark big-parallel kvm system-features = nixos-test benchmark big-parallel kvm
- uses: cachix/cachix-action@v8 - uses: cachix/cachix-action@v10
with: with:
name: ares name: ares
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}

View File

@ -17,8 +17,8 @@ jobs:
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
- uses: cachix/install-nix-action@v12 - uses: cachix/install-nix-action@v13
- uses: cachix/cachix-action@v8 - uses: cachix/cachix-action@v10
with: with:
name: ${{ secrets.CACHIX_NAME }} name: ${{ secrets.CACHIX_NAME }}
authToken: ${{ secrets.CACHIX_AUTH_TOKEN }} authToken: ${{ secrets.CACHIX_AUTH_TOKEN }}
@ -35,7 +35,8 @@ jobs:
- name: Run upload to bootstrap.urbit.org - name: Run upload to bootstrap.urbit.org
run: | run: |
version="$(cat ./pkg/urbit/version)" version="$(cat ./pkg/urbit/version)"
system="$(nix eval --raw '(builtins.currentSystem)')" system="$(nix-instantiate --eval --expr 'builtins.currentSystem')"
system=${system:1:${#system}-2}
target="gs://bootstrap.urbit.org/ci/urbit-v${version}-${system}-${GITHUB_SHA:0:9}.tgz" target="gs://bootstrap.urbit.org/ci/urbit-v${version}-${system}-${GITHUB_SHA:0:9}.tgz"
gsutil cp -n ./result "$target" gsutil cp -n ./result "$target"

View File

@ -1,14 +0,0 @@
name: typescript-check
on:
pull_request:
paths:
- 'pkg/interface/**'
jobs:
typescript-check:
runs-on: ubuntu-latest
name: "Check pkg/interface types"
steps:
- uses: actions/checkout@v2
- run: cd 'pkg/interface' && npm i && npm run tsc

7
.gitignore vendored
View File

@ -33,6 +33,7 @@ result-*
# NodeJS # NodeJS
node_modules node_modules
.eslintcache
# Haskell # Haskell
.stack-work .stack-work
@ -54,7 +55,11 @@ release/
dist/ dist/
out/ out/
work/ work/
pkg/*/*.a
*.o *.o
*.so
*.dll
*.dylib
# Landscape Dev # Landscape Dev
urbitrc urbitrc
@ -77,3 +82,5 @@ pkg/interface/link-webext/web-ext-artifacts
# Logs # Logs
*.log *.log
.vercel

16
.vercelignore Normal file
View File

@ -0,0 +1,16 @@
bin
doc
extras
nix
pkg/arvo
pkg/base-dev
pkg/docker-image
pkg/ent
pkg/garden
pkg/garden-dev
pkg/ge-additions
pkg/herb
pkg/hs
pkg/libaes_siv
pkg/urbit
sh

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1 version https://git-lfs.github.com/spec/v1
oid sha256:61e583dd7db795dac4a7c31bfd3ee8b240e679bb882e35d4e7d1acb5f9f2f3d6 oid sha256:9a56f675d2a6c5dafa92a9e2d55040d994f3d3d27a1ed827bd87d1158b1e69d0
size 8270131 size 3749183

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1 version https://git-lfs.github.com/spec/v1
oid sha256:063cb7928607fd3e3882e46a369047e3304e1635ee7761e2daa1fe611eb74ca7 oid sha256:e6e3c7c0274352d2cfba2a9f2b3382cdeab0e0fb97455b42293a214561d177ee
size 7130416 size 1101949

3
bin/multi-brass.pill Normal file
View File

@ -0,0 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:049801d388b4cb7203854b4668826688c21089f90430bd547d276e7b59386e8d
size 5588170

3
bin/multi.pill Normal file
View File

@ -0,0 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:c27cdb47bccda98ba68556181cae6cd845c6daf8d7426d82adf67c1e8f532be9
size 7454265

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1 version https://git-lfs.github.com/spec/v1
oid sha256:6d654c8c49f9836102b1db7dec7e625d5e8100ab7db4baa31b4184751c73c009 oid sha256:1f75add9e2b4522ee18a3ef64beb52a3f3b49345e8ac31e4954449c4f4d3b2ef
size 15337032 size 21338783

View File

@ -1,3 +1,4 @@
/* Examples /* Examples
Shared urbit and urbit-worker binaries: Shared urbit and urbit-worker binaries:
@ -85,19 +86,11 @@ let
# Local vendored packages defined in ./pkg. # Local vendored packages defined in ./pkg.
# For non-vendored nixpkgs specific package overrides, see ./nix/overlays. # For non-vendored nixpkgs specific package overrides, see ./nix/overlays.
pkgsLocal = { pkgsLocal = {
argon2u = callPackage ./nix/pkgs/argon2u { };
ca-bundle = callPackage ./nix/pkgs/ca-bundle { }; ca-bundle = callPackage ./nix/pkgs/ca-bundle { };
ed25519 = callPackage ./nix/pkgs/ed25519 { };
ent = callPackage ./nix/pkgs/ent { }; ent = callPackage ./nix/pkgs/ent { };
ge-additions = callPackage ./nix/pkgs/ge-additions { }; libaes_siv = callPackage ./nix/pkgs/libaes_siv { inherit (pkgsNative) cmake; };
libaes_siv = callPackage ./nix/pkgs/libaes_siv { };
libscrypt = callPackage ./nix/pkgs/libscrypt { };
murmur3 = callPackage ./nix/pkgs/murmur3 { }; murmur3 = callPackage ./nix/pkgs/murmur3 { };
@ -113,8 +106,12 @@ let
solid = callPackage ./nix/pkgs/pill/solid.nix { }; solid = callPackage ./nix/pkgs/pill/solid.nix { };
marsSources = callPackage ./nix/pkgs/marsSources { };
urbit = callPackage ./nix/pkgs/urbit { inherit enableStatic; }; urbit = callPackage ./nix/pkgs/urbit { inherit enableStatic; };
urcrypt = callPackage ./nix/pkgs/urcrypt { inherit enableStatic; };
docker-image = callPackage ./nix/pkgs/docker-image { }; docker-image = callPackage ./nix/pkgs/docker-image { };
hs = callPackage ./nix/pkgs/hs { hs = callPackage ./nix/pkgs/hs {

9
lerna.json Normal file
View File

@ -0,0 +1,9 @@
{
"packages": [
"pkg/npm/*",
"pkg/btc-wallet",
"pkg/interface",
"pkg/grid"
],
"version": "independent"
}

View File

@ -11,6 +11,11 @@ in {
outputs = [ "out" "dev" "lib" ]; outputs = [ "out" "dev" "lib" ];
}); });
secp256k1 = prev.secp256k1.overrideAttrs (_attrs: {
version = final.sources.secp256k1.rev;
src = final.sources.secp256k1;
});
libsigsegv = prev.libsigsegv.overrideAttrs (attrs: { libsigsegv = prev.libsigsegv.overrideAttrs (attrs: {
patches = optionalList attrs.patches ++ [ patches = optionalList attrs.patches ++ [
../pkgs/libsigsegv/disable-stackvma_fault-linux-arm.patch ../pkgs/libsigsegv/disable-stackvma_fault-linux-arm.patch

View File

@ -1,30 +0,0 @@
{ stdenv, sources, enableParallelBuilding ? true }:
stdenv.mkDerivation {
pname = "argon2u";
version = sources.argon2u.rev;
src = sources.argon2u;
postPatch = ''
substituteInPlace Makefile --replace 'ar rcs' '$(AR) rcs'
'';
buildPhase = ''
make libargon2.a
'';
installPhase = ''
mkdir -p $out/{lib,include}
cp libargon2.a $out/lib/
cp include/argon2.h $out/include/
cp ./src/blake2/*.h $out/include/
'';
makeFlags = [
"AR=${stdenv.cc.targetPrefix}ar" # Fix cross-compilation
];
NO_THREADS = true;
inherit enableParallelBuilding;
}

View File

@ -1,46 +1,21 @@
{ lib, stdenvNoCC, bc }: { lib, stdenvNoCC, marsSources }:
stdenvNoCC.mkDerivation { stdenvNoCC.mkDerivation {
name = "arvo"; name = "arvo";
src = lib.cleanSource ../../../pkg/arvo;
buildInputs = [ bc ]; src = marsSources;
outputs = [ "out" "ropsten" ]; outputs = [ "out" "ropsten" ];
phases = [ "mainnetPhase" "ropstenPhase" ]; phases = [ "mainnetPhase" "ropstenPhase" ];
mainnetPhase = '' mainnetPhase = ''
cp -r $src/ $out ln -s ${marsSources.out}/arvo $out
chmod -R u+w $out '';
'';
ropstenPhase = '' ropstenPhase = ''
cp -r $src tmp ln -s ${marsSources.ropsten}/arvo $ropsten
chmod -R u+w tmp '';
ZUSE=tmp/sys/zuse.hoon
AMES=tmp/sys/vane/ames.hoon
ACME=tmp/app/acme.hoon
# Replace the mainnet azimuth contract with the ropsten contract
sed --in-place \
's/\(\+\+ contracts \)mainnet\-contracts/\1ropsten-contracts/' \
$ZUSE
# Increment the %ames protocol version
sed -r --in-place \
's_^(=/ protocol\-version=\?\(.*\) %)([0-7])_echo "\1$(echo "(\2+1) % 8" | bc)"_e' \
$AMES
# Use the staging API in :acme
sed --in-place \
's_https://acme-v02.api.letsencrypt.org/directory_https://acme-staging-v02.api.letsencrypt.org/directory_' \
$ACME
cp -r tmp $ropsten
chmod -R u+w $ropsten
'';
preferLocalBuild = true; preferLocalBuild = true;
} }

View File

@ -1,21 +0,0 @@
{ stdenv, sources }:
stdenv.mkDerivation {
pname = "ed25519";
version = sources.ed25519.rev;
src = sources.ed25519;
buildPhase = ''
CFLAGS="-O3 -Wall -I$src/src"
for f in $(find src -type f -name '*.c'); do
$CC $CFLAGS -c $f -o "''${f//\//_}.o"
done
'';
installPhase = ''
mkdir -p $out/{lib,include}
$AR rcs $out/lib/libed25519.a *.o
cp $src/src/*.h $out/include/
'';
}

View File

@ -1,13 +0,0 @@
{ lib, stdenv, ed25519, enableParallelBuilding ? true }:
stdenv.mkDerivation {
name = "ge-additions";
src = lib.cleanSource ../../../pkg/ge-additions;
buildInputs = [ ed25519 ];
installFlags = [ "PREFIX=$(out)" ];
inherit enableParallelBuilding;
}

View File

@ -0,0 +1,34 @@
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -5,6 +5,8 @@ if("${CMAKE_BUILD_TYPE}" STREQUAL "")
set(CMAKE_BUILD_TYPE Release)
endif("${CMAKE_BUILD_TYPE}" STREQUAL "")
+option(BUILD_SHARED_LIBS "Build shared libraries" ON)
+
include(GNUInstallDirs)
# Warning: don't use the UB sanitizer in production builds. It can introduce timing side-channels
@@ -31,10 +33,12 @@ endif(NOT DISABLE_DOCS)
configure_file(config.h.in config.h)
include_directories(${CMAKE_CURRENT_BINARY_DIR})
+if(BUILD_SHARED_LIBS)
add_library(aes_siv SHARED aes_siv.c)
target_include_directories(aes_siv PUBLIC ${OPENSSL_INCLUDE_DIR})
target_link_libraries(aes_siv ${OPENSSL_CRYPTO_LIBRARY})
set_target_properties(aes_siv PROPERTIES VERSION "1.0.1" SOVERSION 1)
+endif()
add_library(aes_siv_static STATIC aes_siv.c)
target_include_directories(aes_siv_static PUBLIC ${OPENSSL_INCLUDE_DIR})
@@ -63,7 +67,9 @@ endif(ENABLE_SANITIZER)
add_executable(bench EXCLUDE_FROM_ALL bench.c)
target_link_libraries(bench aes_siv_static)
+if(BUILD_SHARED_LIBS)
install(TARGETS aes_siv LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR})
+endif()
install(TARGETS aes_siv_static ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR})
install(FILES aes_siv.h DESTINATION ${CMAKE_INSTALL_INCLUDEDIR})

View File

@ -1,12 +1,17 @@
{ lib, stdenv, openssl, enableParallelBuilding ? true }: { stdenv, sources, cmake, openssl, enableParallelBuilding ? true }:
stdenv.mkDerivation { stdenv.mkDerivation {
name = "libaes_siv"; name = "libaes_siv";
src = lib.cleanSource ../../../pkg/libaes_siv; version = sources.libaes_siv.rev;
src = sources.libaes_siv;
patches = [ ./cmakefiles_static.patch ];
nativeBuildInputs = [ cmake ];
buildInputs = [ openssl ]; buildInputs = [ openssl ];
installFlags = [ "PREFIX=$(out)" ]; cmakeFlags = [
"-DBUILD_SHARED_LIBS=OFF"
];
inherit enableParallelBuilding; inherit enableParallelBuilding;
} }

View File

@ -1,35 +0,0 @@
{ stdenv, sources }:
stdenv.mkDerivation {
pname = "libscrypt";
version = sources.libscrypt.rev;
src = sources.libscrypt;
buildPhase = ''
sources=" \
crypto_scrypt-check \
crypto_scrypt-hash \
crypto_scrypt-hexconvert \
crypto_scrypt-nosse \
crypto-mcf \
crypto-scrypt-saltgen \
slowequals \
sha256 \
b64 \
"
CFLAGS="-I$src -Wall -ffast-math -O3 -D_FORTIFY_SOURCE=2 -fstack-protector"
for s in $sources; do
$CC $CFLAGS -c $src/$s.c -o $s.o
done
$AR rcs libscrypt.a *.o
'';
installPhase = ''
mkdir -p $out/{lib,include}
cp libscrypt.a $out/lib
cp $src/*.h $out/include/
'';
}

View File

@ -0,0 +1,46 @@
{ lib, stdenvNoCC, bc }:
stdenvNoCC.mkDerivation {
name = "sources";
src = lib.cleanSource ../../../pkg;
buildInputs = [ bc ];
outputs = [ "out" "ropsten" ];
phases = [ "mainnetPhase" "ropstenPhase" ];
mainnetPhase = ''
cp -r $src $out
chmod -R u+w $out
'';
ropstenPhase = ''
cp -r $src tmp
chmod -R u+w tmp
ZUSE=tmp/arvo/sys/zuse.hoon
AMES=tmp/arvo/sys/vane/ames.hoon
ACME=tmp/arvo/app/acme.hoon
# Replace the mainnet azimuth contract with the ropsten contract
sed --in-place \
's/\(\+\+ contracts \)mainnet\-contracts/\1ropsten-contracts/' \
$ZUSE
# Increment the %ames protocol version
sed -r --in-place \
's_^(=/ protocol\-version=\?\(.*\) %)([0-7])_echo "\1$(echo "(\2+1) % 8" | bc)"_e' \
$AMES
# Use the staging API in :acme
sed --in-place \
's_https://acme-v02.api.letsencrypt.org/directory_https://acme-staging-v02.api.letsencrypt.org/directory_' \
$ACME
cp -r tmp $ropsten
chmod -R u+w $ropsten
'';
preferLocalBuild = true;
}

View File

@ -1,8 +1,12 @@
{ lib, stdenv, coreutils, pkgconfig, argon2u, cacert, ca-bundle, curlMinimal { lib, stdenv, coreutils, pkgconfig # build/env
, ed25519, ent, ge-additions, gmp, h2o, herb, ivory, libaes_siv, libscrypt , cacert, ca-bundle, ivory # codegen
, libsigsegv, libuv, lmdb, murmur3, openssl, secp256k1, softfloat3, zlib , curlMinimal, ent, gmp, h2o, libsigsegv, libuv, lmdb # libs
, enableStatic ? stdenv.hostPlatform.isStatic, enableDebug ? false , murmur3, openssl, softfloat3, urcrypt, zlib #
, doCheck ? true, enableParallelBuilding ? true, dontStrip ? true }: , enableStatic ? stdenv.hostPlatform.isStatic # opts
, enableDebug ? false
, doCheck ? true
, enableParallelBuilding ? true
, dontStrip ? true }:
let let
@ -19,30 +23,23 @@ in stdenv.mkDerivation {
nativeBuildInputs = [ pkgconfig ]; nativeBuildInputs = [ pkgconfig ];
buildInputs = [ buildInputs = [
argon2u
cacert cacert
ca-bundle ca-bundle
curlMinimal curlMinimal
ed25519
ent ent
ge-additions
gmp gmp
h2o h2o
ivory.header ivory.header
libaes_siv
libscrypt
libsigsegv libsigsegv
libuv libuv
lmdb lmdb
murmur3 murmur3
openssl openssl
secp256k1
softfloat3 softfloat3
urcrypt
zlib zlib
]; ];
checkInputs = [ herb ];
# Ensure any `/usr/bin/env bash` shebang is patched. # Ensure any `/usr/bin/env bash` shebang is patched.
postPatch = '' postPatch = ''
patchShebangs ./configure patchShebangs ./configure
@ -56,9 +53,14 @@ in stdenv.mkDerivation {
cp ./build/urbit-worker $out/bin/urbit-worker cp ./build/urbit-worker $out/bin/urbit-worker
''; '';
dontDisableStatic = enableStatic;
configureFlags = if enableStatic
then [ "--disable-shared" "--enable-static" ]
else [];
CFLAGS = [ (if enableDebug then "-O0" else "-O3") "-g" ] CFLAGS = [ (if enableDebug then "-O0" else "-O3") "-g" ]
++ lib.optionals (!enableDebug) [ "-Werror" ] ++ lib.optionals (!enableDebug) [ "-Werror" ];
++ lib.optionals enableStatic [ "-static" ];
MEMORY_DEBUG = enableDebug; MEMORY_DEBUG = enableDebug;
CPU_DEBUG = enableDebug; CPU_DEBUG = enableDebug;

View File

@ -0,0 +1,21 @@
{ stdenv, autoreconfHook, pkgconfig
, libaes_siv, openssl, secp256k1
, enableStatic ? stdenv.hostPlatform.isStatic }:
stdenv.mkDerivation rec {
name = "urcrypt";
src = ../../../pkg/urcrypt;
# XX why are these required for darwin?
dontDisableStatic = enableStatic;
configureFlags = if enableStatic
then [ "--disable-shared" "--enable-static" ]
else [];
nativeBuildInputs =
[ autoreconfHook pkgconfig ];
propagatedBuildInputs =
[ openssl secp256k1 libaes_siv ];
}

65
nix/sources-pmnsh.json Normal file
View File

@ -0,0 +1,65 @@
{
"curl": {
"branch": "master",
"description": "A command line tool and library for transferring data with URL syntax",
"homepage": "http://curl.se/",
"pmnsh": {
"include": "include",
"lib": "lib/.libs",
"prepare": "autoreconf -vfi && ./configure --disable-shared --disable-ldap --disable-rtsp --without-brotli --without-libidn2 --without-libpsl --without-nghttp2 --with-openssl",
"make": "-C lib libcurl.la"
},
"owner": "curl",
"repo": "curl",
"rev": "curl-7_77_0",
"type": "tarball",
"url": "https://github.com/curl/curl/archive/curl-7_77_0.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"lmdb": {
"branch": "mdb.master",
"description": "LMDB library",
"homepage": "http://www.lmdb.tech/",
"pmnsh": {
"strip": 2,
"make": "liblmdb.a"
},
"owner": "LMDB",
"repo": "lmdb",
"rev": "48a7fed59a8aae623deff415dda27097198ca0c1",
"type": "tarball",
"url": "https://github.com/LMDB/lmdb/archive/48a7fed59a8aae623deff415dda27097198ca0c1.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"uv": {
"branch": "v1.x",
"description": "Cross-platform asynchronous I/O",
"homepage": "http://libuv.org/",
"pmnsh": {
"include": "include",
"lib": ".libs",
"prepare": "./autogen.sh && ./configure --disable-shared",
"make": "libuv.la",
"compat": {
"m1brew": false
}
},
"owner": "libuv",
"repo": "libuv",
"rev": "v1.40.0",
"type": "tarball",
"url": "https://github.com/libuv/libuv/archive/v1.40.0.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"ent": {
"pmnsh": {
"prepare": "./configure"
}
},
"urcrypt": {
"pmnsh": {
"prepare": "./autogen.sh && ./configure --disable-shared PKG_CONFIG_PATH=../secp256k1 CFLAGS=\"-I../secp256k1/include -I../libaes_siv\" LDFLAGS=-L../libaes_siv",
"make": "install"
}
}
}

View File

@ -1,38 +1,24 @@
{ {
"argon2u": {
"branch": "master",
"description": "With argon2u. Based off https://github.com/P-H-C/phc-winner-argon2",
"homepage": "",
"owner": "urbit",
"repo": "argon2",
"rev": "4da94a611ee62bad87ab2b131ffda3bcc0723d9c",
"sha256": "0bqq1hg367l4jkb6cqhxlblpvdbwz3l586qsfakwzfd9wdvnm3yc",
"type": "tarball",
"url": "https://github.com/urbit/argon2/archive/4da94a611ee62bad87ab2b131ffda3bcc0723d9c.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"ed25519": {
"branch": "master",
"description": "Submodule included by Urbit",
"homepage": null,
"owner": "urbit",
"repo": "ed25519",
"rev": "76385f2ebbbc9580a9c236952d68d11d73a6135c",
"sha256": "0s1spif4s9lgcwcny3fl2fvpbw6acqn3s8r6qxnrmkd9icgyw4cp",
"type": "tarball",
"url": "https://github.com/urbit/ed25519/archive/76385f2ebbbc9580a9c236952d68d11d73a6135c.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"h2o": { "h2o": {
"branch": "master", "branch": "master",
"description": "H2O - the optimized HTTP/1, HTTP/2, HTTP/3 server", "description": "H2O - the optimized HTTP/1, HTTP/2, HTTP/3 server",
"homepage": "https://h2o.examp1e.net", "homepage": "https://h2o.examp1e.net",
"pmnsh": {
"include": "include",
"prepare": "cmake .",
"make": "libh2o",
"compat": {
"mingw": {
"prepare": "cmake -G\"MSYS Makefiles\" -DCMAKE_INSTALL_PREFIX=. ."
}
}
},
"owner": "h2o", "owner": "h2o",
"repo": "h2o", "repo": "h2o",
"rev": "v2.2.4", "rev": "v2.2.6",
"sha256": "0176x0bzjry19zs074a9i5vhncc842xikmx43wj61jky318nq4w4", "sha256": "0qni676wqvxx0sl0pw9j0ph7zf2krrzqc1zwj73mgpdnsr8rsib7",
"type": "tarball", "type": "tarball",
"url": "https://github.com/h2o/h2o/archive/v2.2.4.tar.gz", "url": "https://github.com/h2o/h2o/archive/v2.2.6.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz" "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}, },
"hackage.nix": { "hackage.nix": {
@ -59,22 +45,37 @@
"url": "https://github.com/input-output-hk/haskell.nix/archive/bbb34dcdf7b90d478002f91713531f418ddf1b53.tar.gz", "url": "https://github.com/input-output-hk/haskell.nix/archive/bbb34dcdf7b90d478002f91713531f418ddf1b53.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz" "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}, },
"libscrypt": { "libaes_siv": {
"branch": "master", "branch": "master",
"description": null, "description": null,
"homepage": null, "homepage": null,
"owner": "urbit", "pmnsh": {
"repo": "libscrypt", "compat": {
"rev": "029693ff1cbe4f69d3a2da87d0f4f034f92cc0c2", "m1brew": {
"sha256": "17pcxypzjmmrvacw45cacvibm6mlr9ip30hy30l1appsnywx679n", "prepare": "cmake .",
"make": "install CFLAGS=$(pkg-config --cflags openssl)"
},
"mingw": {
"prepare": "cmake -G\"MSYS Makefiles\" -DDISABLE_DOCS:BOOL=ON .",
"make": "aes_siv_static"
}
}
},
"owner":"dfoxfranke",
"repo": "libaes_siv",
"rev": "9681279cfaa6e6399bb7ca3afbbc27fc2e19df4b",
"sha256": "1g4wy0m5wpqx7z6nillppkh5zki9fkx9rdw149qcxh7mc5vlszzi",
"type": "tarball", "type": "tarball",
"url": "https://github.com/urbit/libscrypt/archive/029693ff1cbe4f69d3a2da87d0f4f034f92cc0c2.tar.gz", "url": "https://github.com/dfoxfranke/libaes_siv/archive/9681279cfaa6e6399bb7ca3afbbc27fc2e19df4b.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz" "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}, },
"murmur3": { "murmur3": {
"branch": "master", "branch": "master",
"description": null, "description": null,
"homepage": null, "homepage": null,
"pmnsh": {
"make": "static"
},
"owner": "urbit", "owner": "urbit",
"repo": "murmur3", "repo": "murmur3",
"rev": "71a75d57ca4e7ca0f7fc2fd84abd93595b0624ca", "rev": "71a75d57ca4e7ca0f7fc2fd84abd93595b0624ca",
@ -111,6 +112,19 @@
"branch": "master", "branch": "master",
"description": null, "description": null,
"homepage": null, "homepage": null,
"pmnsh": {
"include": "source/include",
"compat": {
"m1brew": {
"lib": "build/template-FAST_INT64",
"make": "-C build/template-FAST_INT64 libsoftfloat3.a"
},
"mingw": {
"lib": "build/Win64-MinGW-w64",
"make": "-C build/Win64-MinGW-w64 libsoftfloat3.a"
}
}
},
"owner": "urbit", "owner": "urbit",
"repo": "berkeley-softfloat-3", "repo": "berkeley-softfloat-3",
"rev": "ec4c7e31b32e07aad80e52f65ff46ac6d6aad986", "rev": "ec4c7e31b32e07aad80e52f65ff46ac6d6aad986",
@ -119,6 +133,24 @@
"url": "https://github.com/urbit/berkeley-softfloat-3/archive/ec4c7e31b32e07aad80e52f65ff46ac6d6aad986.tar.gz", "url": "https://github.com/urbit/berkeley-softfloat-3/archive/ec4c7e31b32e07aad80e52f65ff46ac6d6aad986.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz" "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
}, },
"secp256k1": {
"branch": "master",
"description": "Optimized C library for ECDSA signatures and secret/public key operations on curve secp256k1.",
"homepage": null,
"pmnsh": {
"include": "include",
"lib": ".libs",
"prepare": "./autogen.sh && ./configure --disable-shared --enable-module-recovery CFLAGS=-DSECP256K1_API=",
"make": "libsecp256k1.la"
},
"owner": "bitcoin-core",
"repo": "secp256k1",
"rev": "26de4dfeb1f1436dae1fcf17f57bdaa43540f940",
"sha256": "03i3nv8d3ci7q9y98q11rrp3rvwdqc0hc0ss0pr6xckybvizsmbb",
"type": "tarball",
"url": "https://github.com/bitcoin-core/secp256k1/archive/26de4dfeb1f1436dae1fcf17f57bdaa43540f940.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"stackage.nix": { "stackage.nix": {
"branch": "master", "branch": "master",
"description": "Automatically generated Nix expressions of Stackage snapshots", "description": "Automatically generated Nix expressions of Stackage snapshots",

15713
package-lock.json generated Normal file

File diff suppressed because it is too large Load Diff

18
package.json Normal file
View File

@ -0,0 +1,18 @@
{
"name": "root",
"private": true,
"devDependencies": {
"eslint": "^7.29.0",
"husky": "^6.0.0",
"lerna": "^4.0.0",
"lint-staged": "^11.1.2",
"prettier": "^2.3.2"
},
"scripts": {
"watch-libs": "lerna run watch --no-private --parallel",
"build-libs": "lerna run build --no-private",
"test": "lerna run test",
"bootstrap": "lerna bootstrap",
"build:prod": "lerna run build:prod"
}
}

View File

@ -1,838 +0,0 @@
:: aggregator: Azimuth L2 roll aggregator
::
:: general flow is as described below, to ensure transactions actually go
:: through once we start sending it out, in the dumbest reasonable way.
::
:: periodic timer fires:
:: if there are no pending l2 txs, do nothing.
:: else kick off tx submission flow:
:: "freeze" pending txs, store alongside nonce, then increment nonce,
:: kick off thread for sending the corresponding l1 tx:
:: if nonce doesn't match on-chain expected nonce, bail.
:: if we can't afford the tx fee, bail.
:: construct, sign, submit the l1 tx.
:: if thread bailed, retry in five minutes.
:: if thread succeeded, retry in five minutes with higher gas price.
:: when retrying, only do so if l2 txs remain in the "frozen" txs group.
:: on %tx diff from naive, remove the matching tx from the frozen group.
::
::TODO questions:
:: - it's a bit weird how we just assume the raw and tx in raw-tx to match...
::
/- *aggregator
/+ azimuth,
naive,
lib=naive-transactions,
default-agent,
ethereum,
dbug,
verb
::
|%
+$ state-0
$: %0
:: pending: the next l2 txs to be sent
:: sending: the l2 txs currently sending/awaiting l2 confirmation
:: finding: raw-tx-hash reverse lookup for sending map
:: history: status of l2 txs by ethereum address
:: next-nonce: next l1 nonce to use
:: next-batch: when then next l2 batch will be sent
:: pre: predicted l2 state
:: flush: flag for deriving predicted state
::
pending=(list pend-tx)
::
$= sending
%+ map l1-tx-pointer
[next-gas-price=@ud txs=(list raw-tx:naive)]
::
finding=(map keccak ?(%confirmed %failed l1-tx-pointer))
history=(jug address:ethereum roller-tx)
next-nonce=(unit @ud)
next-batch=time
pre=^state:naive
flush=?
::
:: pk: private key to send the roll
:: frequency: time to wait between sending batches (TODO fancier)
:: endpoint: ethereum rpc endpoint to use
:: contract: ethereum contract address
:: chain-id: mainnet, ropsten, local (https://chainid.network/)
::
pk=@
frequency=@dr
endpoint=(unit @t)
contract=@ux
chain-id=@
==
::
+$ config
$% [%frequency frequency=@dr]
[%setkey pk=@]
[%endpoint endpoint=@t]
[%network net=?(%mainnet %ropsten %local)]
==
::
+$ action
$% [%submit force=? sig=@ tx=part-tx]
[%cancel sig=@ keccak=@ =l2-tx]
[%commit ~] ::TODO maybe pk=(unit @) later
[%config config]
==
::
+$ card card:agent:gall
::
:: TODO: add to config
::
++ resend-time ~m5
::
++ lverb &
--
::
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
::
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
=. frequency ~h1
=. contract naive:local-contracts:azimuth
=. chain-id chain-id:local-contracts:azimuth
=^ card next-batch set-timer
:_ this
:~ card
[%pass /azimuth-txs %agent [our.bowl %azimuth] %watch /txs]
==
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
=^ cards state
?+ mark (on-poke:def mark vase)
%aggregator-action
=+ !<(poke=action vase)
(on-action:do poke)
==
[cards this]
:: +on-peek: scry paths
::
:: /x/pending -> %noun (list pend-tx)
:: /x/pending/[~ship] -> %noun (list pend-tx)
:: /x/pending/[0xadd.ress] -> %noun (list pend-tx)
:: /x/tx/[0xke.ccak]/status -> %noun tx-status
:: /x/nonce/[~ship]/[proxy] -> %noun (unit @)
:: /x/spawned/[~ship] -> %noun (list [ship address])
:: /x/next-batch -> %atom time
:: /x/point/[~ship] -> %noun point:naive
:: /x/points/[0xadd.ress] -> %noun (list [ship point:naive])
:: /x/config -> %noun config
::
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path ~
[%x %pending ~] ``noun+!>(pending)
[%x %pending @ ~] (pending-by i.t.t.path)
[%x %tx @ %status ~] (status i.t.t.path)
[%x %history @ ~] (history i.t.t.path)
[%x %nonce @ @ ~] (nonce i.t.t.path i.t.t.t.path)
[%x %spawned @ ~] (spawned i.t.t.path)
[%x %next-batch ~] ``noun+!>(next-batch)
[%x %point @ ~] (point i.t.t.path)
[%x %points @ ~] (points i.t.t.path)
[%x %config ~] config
==
::
++ pending-by
|= wat=@t
?~ who=(slaw %p wat)
:: by-address
::
?~ wer=(slaw %ux wat)
[~ ~]
=; pending=(list pend-tx)
``noun+!>(pending)
%+ skim pending
|= pend-tx
=(u.wer (get-l1-address tx.raw-tx pre))
:: by-ship
::
=; pending=(list pend-tx)
``noun+!>(pending)
%+ skim pending
|= pend-tx
=(u.who ship.from.tx.raw-tx)
::
++ status
|= wat=@t
?~ keccak=(slaw %ux wat)
[~ ~]
:+ ~ ~
:- %noun
!> ^- tx-status
?^ status=(~(get by finding) u.keccak)
?@ u.status [u.status ~]
[%sending status]
::TODO potentially slow!
=; known=?
[?:(known %pending %unknown) ~]
%+ lien pending
|= pend-tx
=(u.keccak (hash-tx raw.raw-tx))
::
++ history
|= wat=@t
:+ ~ ~
:- %noun
!> ^- (list roller-tx)
?~ addr=(slaw %ux wat) ~
%~ tap in
(~(get ju ^history) u.addr)
::
++ nonce
|= [who=@t proxy=@t]
?~ who=(slaw %p who)
[~ ~]
?. ?=(proxy:naive proxy)
[~ ~]
:+ ~ ~
:- %noun
!> ^- (unit @)
?~ point=(get:orm:naive points.pre u.who)
~
=< `nonce
(proxy-from-point:naive proxy u.point)
::
++ spawned
|= wat=@t
:+ ~ ~
:- %noun
!> ^- (list [=^ship =address:ethereum])
?~ star=(slaw %p wat) ~
=/ range
%+ lot:orm:naive points.pre
:: range exclusive [star next-star-first-planet-]
:: TODO: make range inclusive ([first-planet last-planet])?
::
[`u.star `(cat 3 +(u.star) 0x1)]
%+ turn (tap:orm:naive range)
|= [=ship =point:naive]
^- [=^ship =address:ethereum]
:- ship
address:(proxy-from-point:naive %own point)
::
++ point
|= wat=@t
?~ ship=(rush wat ;~(pfix sig fed:ag))
``noun+!>(*(unit point:naive))
``noun+!>((get:orm:naive points.pre u.ship))
::
++ points
|= wat=@t
:+ ~ ~
:- %noun
!> ^- (list [ship point:naive])
?~ addr=(slaw %ux wat)
~
%~ tap in
(~(get ju owners.pre) u.addr)
::
++ config
:+ ~ ~
:- %noun
!> ^- roller-config
:* next-batch
frequency
resend-time
contract
chain-id
==
--
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
[%timer ~]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake =^(cards state on-timer:do [cards this])
==
::
[%predict ~]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake
=. state (predicted-state canonical-state):do
`this(flush &)
==
::
[%resend @ @ ~]
=/ [address=@ux nonce=@ud]
[(slav %ux i.t.wire) (rash i.t.t.wire dem)]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake [(send-roll:do address nonce) this]
==
==
::
++ on-fail
|= [=term =tang]
::TODO if crashed during timer, set new timer? how to detect?
(on-fail:def term tang)
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ wire (on-agent:def wire sign)
[%send @ @ *] (send-batch i.t.wire i.t.t.wire sign)
[%azimuth-txs ~] (azimuth-update sign)
[%nonce ~] (nonce sign)
==
::
++ send-batch
|= [address=@t nonce=@t =sign:agent:gall]
^- (quip card _this)
=/ [address=@ux nonce=@ud]
[(slav %ux address) (rash nonce dem)]
?- -.sign
%poke-ack
?~ p.sign
%- (slog leaf+"Send batch thread started successfully" ~)
[~ this]
%- (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
:_ this
[(leave:spider:do wire)]~
::
%watch-ack
?~ p.sign
[~ this]
=/ =tank leaf+"{(trip dap.bowl)} couldn't start listen to thread"
%- (slog tank u.p.sign)
[~ this]
::
%kick
[~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"{(trip dap.bowl)} failed" leaf+<term> tang)
=^ cards state
(on-batch-result:do address nonce %.n^'thread failed')
[cards this]
::
%thread-done
=+ !<(result=(each @ud @t) q.cage.sign)
=^ cards state
(on-batch-result:do address nonce result)
[cards this]
==
==
::
++ azimuth-update
|= =sign:agent:gall
^- (quip card _this)
?+ -.sign [~ this]
%watch-ack
?~ p.sign [~ this]
=/ =tank leaf+"{(trip dap.bowl)} couldn't start listen to %azimuth"
%- (slog tank u.p.sign)
[~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%naive-diffs
=+ !<(=diff:naive q.cage.sign)
=^ cards state
(on-naive-diff:do diff)
[cards this]
::
%naive-state
~& > %received-naive-state
:- ~
:: cache naive state, received upon innitializing subscription
:: this assumes that /app/azimuth has already processed eth data
::
=. state (predicted-state:do !<(^state:naive q.cage.sign))
this
==
==
::
++ nonce
|= =sign:agent:gall
^- (quip card _this)
?- -.sign
%poke-ack
?~ p.sign
%- (slog leaf+"Nonce thread started successfully" ~)
[~ this]
%- (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
:_ this
[(leave:spider:do wire)]~
::
%watch-ack
?~ p.sign
[~ this]
=/ =tank leaf+"{(trip dap.bowl)} couldn't start listen to thread"
%- (slog tank u.p.sign)
[~ this]
::
%kick
[~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"{(trip dap.bowl)} failed" leaf+<term> tang)
[~ this]
::
%thread-done
=+ !<(nonce=@ud q.cage.sign)
[~ this(next-nonce `nonce)]
==
==
--
--
::
|_ =bowl:gall
::TODO /lib/sys.hoon?
++ sys
|%
++ b
|%
++ wait
|= [=wire =time]
^- card
[%pass wire %arvo %b %wait time]
--
--
::TODO /lib/spider.hoon?
++ spider
|%
++ start-thread
|= [=wire thread=term arg=vase]
^- (list card)
=/ tid=@ta (rap 3 thread '--' (scot %uv eny.bowl) ~)
=/ args [~ `tid thread arg]
:~ [%pass wire %agent [our.bowl %spider] %watch /thread-result/[tid]]
[%pass wire %agent [our.bowl %spider] %poke %spider-start !>(args)]
==
::
++ leave
|= =path
^- card
[%pass path %agent [our.bowl %spider] %leave ~]
--
::
++ hash-tx keccak-256:keccak:crypto
::
++ hash-raw-tx
|= =raw-tx:naive
^- @ux
(hash-tx raw.raw-tx)
::
++ part-tx-to-full
|= =part-tx
^- [octs tx:naive]
?- -.part-tx
%raw
?~ batch=(parse-raw-tx:naive q.raw.part-tx)
~& %parse-failed
:: TODO: maybe return a unit if parsing fails?
::
!!
[raw tx]:-.u.batch
::
%don [(gen-tx-octs:lib +.part-tx) +.part-tx]
%ful +.part-tx
==
:: +canonical-state: load current l2 state from /app/azimuth
::
++ canonical-state
.^ ^state:naive
%gx
(scot %p our.bowl)
%azimuth
(scot %da now.bowl)
/nas/noun
==
:: +predicted-state
::
:: derives predicted state from pending/sending txs and
:: canonical state, discarding invalid txs in the process.
::
++ predicted-state
|= nas=^state:naive
^+ state
=. pre.state nas
|^
=^ nes state apply-sending
=^ nep state (update-txs pending %pending)
%_ state
sending nes
pending nep
==
::
++ apply-sending
=| valid=_sending
=+ sending=~(tap by sending)
|- ^+ [valid state]
?~ sending [valid state]
::
=* key p.i.sending
=* val q.i.sending
=^ new-valid state
%+ update-txs
(turn txs.val |=(=raw-tx:naive [| 0x0 raw-tx]))
%sending
=. valid
%+ ~(put by valid) key
val(txs (turn new-valid (cork tail tail)))
$(sending t.sending)
::
++ update-txs
|= [txs=(list pend-tx) type=?(%pending %sending)]
=/ valid=_txs ~
=| local=(set keccak)
|- ^+ [valid state]
?~ txs [valid state]
::
=* tx i.txs
=/ hash=@ux (hash-raw-tx raw-tx.tx)
?: (~(has in local) hash)
:: if tx was already seen here, skip
::
$(txs t.txs)
=^ gud=? pre.state
(try-apply pre.state [force raw-tx]:tx)
=? valid gud (snoc valid tx)
=? finding.state !gud
(~(put by finding.state) [hash %failed])
=? history.state !gud
=/ =roller-tx
[[type ~] hash (l2-tx +<.tx.raw-tx.tx)]
%. [address.tx roller-tx(status [%failed ~])]
~(put ju (~(del ju history.state) address.tx roller-tx))
$(txs t.txs, local (~(put in local) hash))
::
++ try-apply
|= [nas=^state:naive force=? =raw-tx:naive]
^- [success=? _nas]
=/ chain-t=@t (ud-to-ascii:naive chain-id)
?. (verify-sig-and-nonce:naive verifier:lib chain-t nas raw-tx)
~& [%verify-sig-and-nonce %failed]
[force nas]
=^ * points.nas
(increment-nonce:naive nas from.tx.raw-tx)
?~ nex=(receive-tx:naive nas tx.raw-tx)
[force nas]
[& +.u.nex]
--
::
++ get-l1-address
|= [=tx:naive nas=^state:naive]
^- address:ethereum
?~ point=(get:orm:naive points.nas ship.from.tx)
!!
=< address
(proxy-from-point:naive proxy.from.tx u.point)
::
++ on-action
|= =action
^- (quip card _state)
?- -.action
%commit on-timer
%config (on-config +.action)
%cancel (cancel-tx +.action)
%submit (take-tx force.action sig.action (part-tx-to-full tx.action))
==
::
++ on-config
|= =config
^- (quip card _state)
?- -.config
%frequency [~ state(frequency frequency.config)]
%endpoint [~ state(endpoint `endpoint.config)]
::
%network
:- ~
=/ [contract=@ux chain-id=@]
=< [naive chain-id]
=, azimuth
?- net.config
%mainnet mainnet-contracts
%ropsten ropsten-contracts
%local local-contracts
==
state(contract contract, chain-id chain-id)
::
%setkey
?~ pk=(de:base16:mimes:html pk.config)
`state
[(get-nonce q.u.pk) state(pk q.u.pk)]
==
:: TODO: move address to state?
::
++ get-address
^- address:ethereum
(address-from-prv:key:ethereum pk)
:: +cancel-tx: cancel a pending transaction
::
++ cancel-tx
|= [sig=@ =keccak =l2-tx]
^- (quip card _state)
?^ status=(~(get by finding) keccak)
~? lverb [dap.bowl %tx-not-pending status+u.status]
[~ state]
:: "cancel: 0x1234abcd"
::
=/ message=octs
%: cad:naive 3
8^'cancel: '
::
=; hash=@t
(met 3 hash)^hash
(crip "0x{((x-co:co 20) keccak)}")
::
~
==
?~ addr=(verify-sig sig message)
~? lverb [dap.bowl %cancel-sig-fail]
[~ state]
=. history
%+ ~(del ju history) u.addr
[[%pending ~] keccak l2-tx]
=. pending
%+ skip pending
|= pend-tx
=(keccak (hash-raw-tx raw-tx))
[~ state]
:: TODO: move to /lib/naive-transactions
::
++ verify-sig
|= [sig=@ txdata=octs]
^- (unit address:naive)
|^
:: Reversed of the usual r-s-v order because Ethereum integers are
:: big-endian
::
=^ v sig (take 3)
=^ s sig (take 3 32)
=^ r sig (take 3 32)
:: In Ethereum, v is generally 27 + recid, and verifier expects a
:: recid. Old versions of geth used 0 + recid, so most software
:: now supports either format. See:
::
:: https://github.com/ethereum/go-ethereum/issues/2053
::
=? v (gte v 27) (sub v 27)
(verifier:lib txdata v r s)
::
++ take
|= =bite
[(end bite sig) (rsh bite sig)]
--
:: +take-tx: accept submitted l2 tx into the :pending list
::
++ take-tx
|= [force=? =raw-tx:naive]
^- (quip card _state)
=/ =address:ethereum
(get-l1-address tx.raw-tx pre)
=/ hash=@ux (hash-raw-tx raw-tx)
:: TODO: what if this hash/tx is already in the history?
:: check in finding that hash doesn't exist ?
::
:: =/ not-sent=? !(~(has by finding) hash)
:: =? pending not-sent
=. pending
(snoc pending [force address raw-tx])
:: =? history not-sent
=. history
%+ ~(put ju history) address
[[%pending ~] hash (l2-tx +<.tx.raw-tx)]
:: ?. not-sent ~& "skip" [~ state]
:: toggle flush flag
::
:_ state(flush ?:(flush | &))
?. flush ~
:: derive predicted state in 5m.
::
[(wait:b:sys /predict (add ~m5 now.bowl))]~
:: +set-timer: %wait until next whole :frequency
::
++ set-timer
^- [=card =time]
=+ time=(mul +((div now.bowl frequency)) frequency)
[(wait:b:sys /timer time) time]
:: +on-timer: every :frequency, freeze :pending txs roll and start sending it
::
++ on-timer
^- (quip card _state)
=. state (predicted-state canonical-state)
=^ cards state
?: =(~ pending) [~ state]
?~ next-nonce
~&([dap.bowl %no-nonce] [~ state])
=/ nonce=@ud u.next-nonce
=: pending ~
flush &
next-nonce `+(u.next-nonce)
::
sending
%+ ~(put by sending)
[get-address nonce]
[0 (turn pending (cork tail tail))]
::
finding
%- ~(gas by finding)
%+ turn pending
|= pend-tx
(hash-raw-tx raw-tx)^[address nonce]
::
history
%+ roll pending
|= [pend-tx hist=_history]
=/ tx=roller-tx
:+ [%pending ~]
(hash-raw-tx raw-tx)
(l2-tx +<.tx.raw-tx)
%+ ~(put ju (~(del ju hist) address tx))
address
tx(status [%sending ~])
==
[(send-roll get-address nonce) state]
=^ card next-batch set-timer
[[card cards] state]
:: +get-nonce: retrieves the latest nonce
::
++ get-nonce
|= pk=@
^- (list card)
?~ endpoint ~&([dap.bowl %no-endpoint] ~)
(start-thread:spider /nonce [%aggregator-nonce !>([u.endpoint pk])])
::
:: +send-roll: start thread to submit roll from :sending to l1
::
++ send-roll
|= [=address:ethereum nonce=@ud]
^- (list card)
:: if this nonce isn't in the sending queue anymore, it's done
::
?. (~(has by sending) [address nonce])
~? lverb [dap.bowl %done-sending [address nonce]]
~
:: start the thread, passing in the l2 txs to use
::
?~ endpoint ~&([dap.bowl %no-endpoint] ~)
::TODO should go ahead and set resend timer in case thread hangs, or nah?
%+ start-thread:spider
/send/(scot %ux address)/(scot %ud nonce)
:- %aggregator-send
!> ^- rpc-send-roll
:* u.endpoint
contract
chain-id
pk
nonce
(~(got by sending) [address nonce])
==
:: +on-batch-result: await resend after thread success or failure
::
++ on-batch-result
|= [=address:ethereum nonce=@ud result=(each @ud @t)]
^- (quip card _state)
:: update gas price for this tx in state
::
=? sending ?=(%& -.result)
%+ ~(jab by sending) [address nonce]
(cork tail (lead p.result))
:: print error if there was one
::
~? ?=(%| -.result) [dap.bowl %send-error p.result]
:: resend the l1 tx in five minutes
::
:_ state
:_ ~
%+ wait:b:sys
/resend/(scot %ux address)/(scot %ud nonce)
(add resend-time now.bowl)
:: +on-naive-diff: process l2 tx confirmations
::
++ on-naive-diff
|= =diff:naive
^- (quip card _state)
?. ?=(%tx -.diff)
[~ state]
=/ =keccak (hash-raw-tx raw-tx.diff)
?~ wer=(~(get by finding) keccak)
[~ state]
:: if we had already seen the tx, no-op
::
?@ u.wer
~? &(?=(%confirmed u.wer) ?=(~ err.diff))
[dap.bowl %weird-double-confirm from.tx.raw-tx.diff]
[~ state]
=* nonce nonce.u.wer
:: remove the tx from the sending map
::
=. sending
?~ sen=(~(get by sending) [get-address nonce])
~& [dap.bowl %weird-double-remove]
sending
?~ nin=(find [raw-tx.diff]~ txs.u.sen)
~& [dap.bowl %weird-unknown]
sending
=. txs.u.sen (oust [u.nin 1] txs.u.sen)
?~ txs.u.sen
~? lverb [dap.bowl %done-with-nonce [get-address nonce]]
(~(del by sending) [get-address nonce])
(~(put by sending) [get-address nonce] u.sen)
:: update the finding map with the new status
::
=. finding
%+ ~(put by finding) keccak
?~ err.diff %confirmed
:: if we kept the forced flag around for longer, we could notify of
:: unexpected tx failures here. would that be useful? probably not?
:: ~? !forced [dap.bowl %aggregated-tx-failed-anyway err.diff]
%failed
::
=. history
=/ tx=roller-tx
:+ [%sending ~]
keccak
(l2-tx +<.tx.raw-tx.diff)
=/ =address:ethereum
(get-l1-address tx.raw-tx.diff pre)
%+ ~(put ju (~(del ju history) address tx))
address
%_ tx
status ?~(err.diff [%confirmed ~] [%failed ~])
==
:_ state(flush ?:(flush | &))
?. flush ~
:: derive predicted state in 5m.
::
[(wait:b:sys /predict (add ~m5 now.bowl))]~
::
--

View File

@ -30,7 +30,7 @@
== ==
+$ state-0 +$ state-0
$: %0 $: %0
pil=pill pil=$>(%pill pill)
assembled=* assembled=*
tym=@da tym=@da
fleet-snaps=(map term fleet) fleet-snaps=(map term fleet)
@ -38,11 +38,7 @@
== ==
:: XX temporarily shadowed, fix and remove :: XX temporarily shadowed, fix and remove
:: ::
+$ pill +$ pill pill:pill-lib
$: boot-ova=*
kernel-ova=(list unix-event)
userspace-ova=(list unix-event)
==
:: ::
+$ fleet [ships=(map ship pier) azi=az-state] +$ fleet [ships=(map ship pier) azi=az-state]
+$ pier +$ pier
@ -86,7 +82,7 @@
=^ cards state =^ cards state
?+ mark ~|([%aqua-bad-mark mark] !!) ?+ mark ~|([%aqua-bad-mark mark] !!)
%aqua-events (poke-aqua-events:ac !<((list aqua-event) vase)) %aqua-events (poke-aqua-events:ac !<((list aqua-event) vase))
%pill (poke-pill:ac !<(pill vase)) %pill (poke-pill:ac !<(pill vase))
%noun (poke-noun:ac !<(* vase)) %noun (poke-noun:ac !<(* vase))
%azimuth-action (poke-azimuth-action:ac !<(azimuth-action vase)) %azimuth-action (poke-azimuth-action:ac !<(azimuth-action vase))
== ==
@ -183,7 +179,7 @@
?. processing-events ?. processing-events
..abet-pe ..abet-pe
=^ ue next-events ~(get to next-events) =^ ue next-events ~(get to next-events)
=/ poke-arm (mox +47.snap) =/ poke-arm (mox +23.snap)
?> ?=(%0 -.poke-arm) ?> ?=(%0 -.poke-arm)
=/ poke p.poke-arm =/ poke p.poke-arm
=. tym (max +(tym) now.hid) =. tym (max +(tym) now.hid)
@ -202,20 +198,21 @@
:: ::
++ peek ++ peek
|= p=* |= p=*
=/ res (mox +46.snap) =/ res (mox +22.snap)
?> ?=(%0 -.res) ?> ?=(%0 -.res)
=/ peek p.res =/ peek p.res
=/ pax (path p) =/ pax (path p)
?> ?=([@ @ @ @ *] pax) ?> ?=([@ @ @ @ *] pax)
=. i.t.t.t.pax (scot %da tym) =. i.t.t.t.pax (scot %da tym)
=/ pek (slum peek [tym pax]) =/ pek (slum peek [[~ ~] & pax])
pek =+ ;;(res=(unit (cask)) pek)
:: (bind res tail)
::
:: Wish :: Wish
:: ::
++ wish ++ wish
|= txt=@t |= txt=@t
=/ res (mox +22.snap) =/ res (mox +10.snap)
?> ?=(%0 -.res) ?> ?=(%0 -.res)
=/ wish p.res =/ wish p.res
~& [who=who %wished (slum wish txt)] ~& [who=who %wished (slum wish txt)]
@ -373,6 +370,7 @@
++ poke-pill ++ poke-pill
|= p=pill |= p=pill
^- (quip card:agent:gall _state) ^- (quip card:agent:gall _state)
?< ?=(%ivory -.p)
=. this apex-aqua =< abet-aqua =. this apex-aqua =< abet-aqua
=. pil p =. pil p
~& lent=(met 3 (jam boot-ova.pil)) ~& lent=(met 3 (jam boot-ova.pil))
@ -411,10 +409,11 @@
:: ::
?+ val ~|(%bad-noun-arg !!) ?+ val ~|(%bad-noun-arg !!)
[%swap-vanes vs=*] [%swap-vanes vs=*]
?> ?=([[%7 * %1 installed=*] ~] boot-ova.pil) ?> ?=(^ boot-ova.pil)
=. installed.boot-ova.pil ?> ?=([%7 * %1 installed=*] i.boot-ova.pil)
=. installed.i.boot-ova.pil
%+ roll (,(list term) vs.val) %+ roll (,(list term) vs.val)
|= [v=term =_installed.boot-ova.pil] |= [v=term =_installed.i.boot-ova.pil]
%^ slum installed now.hid %^ slum installed now.hid
=/ vane =/ vane
?+ v ~|([%unknown-vane v] !!) ?+ v ~|([%unknown-vane v] !!)
@ -507,28 +506,42 @@
?- -.ae ?- -.ae
:: ::
%init-ship %init-ship
:: XX Note that the keys that get passed in are unused. The keys field
:: should be deleted now that aqua is capable of managing azimuth state
:: internally. Its been left this way for now until all the ph tests
:: can be rewritten
=/ keys=dawn-event:jael (dawn who.ae)
=. this abet-pe:(publish-effect:(pe who.ae) [/ %sleep ~]) =. this abet-pe:(publish-effect:(pe who.ae) [/ %sleep ~])
=/ initted =/ initted
=< plow =< plow
%- push-events:apex:(pe who.ae) %- push-events:apex:(pe who.ae)
^- (list unix-event) ^- (list unix-event)
:~ [/ %wack 0] :: eny %- zing
[/ %whom who.ae] :: eny :~
[//newt/0v1n.2m9vh %born ~] :~ [/ %wack 0] :: eny
[//behn/0v1n.2m9vh %born ~] :: [/ %verb `|] :: possible verb
:^ //term/1 %boot & :^ / %wyrd [~.nonce /aqua] :: dummy runtime version + nonce
?~ keys.ae ^- (list (pair term @))
[%fake who.ae] :~ zuse+zuse
[%dawn keys] lull+lull
-.userspace-ova.pil arvo+arvo
[//http-client/0v1n.2m9vh %born ~] hoon+hoon-version
[//http-server/0v1n.2m9vh %born ~] nock+4
[//http-server/0v1n.2m9vh %live 8.080 `8.445] ==
[/ %whom who.ae] :: who
==
::
kernel-ova.pil :: load compiler
::
:_ ~
:^ /d/term/1 %boot &
?: fake.ae
[%fake who.ae]
[%dawn (dawn who.ae)]
::
userspace-ova.pil :: load os
::
:~ [/b/behn/0v1n.2m9vh %born ~]
[/i/http-client/0v1n.2m9vh %born ~]
[/e/http-server/0v1n.2m9vh %born ~]
[/e/http-server/0v1n.2m9vh %live 8.080 `8.445]
[/a/newt/0v1n.2m9vh %born ~]
==
== ==
=. this abet-pe:initted =. this abet-pe:initted
(pe who.ae) (pe who.ae)

View File

@ -1,14 +1,13 @@
:: Azimuth JSON-RPC API :: Azimuth JSON-RPC API
:: ::
/- rpc=json-rpc, *aggregator /- rpc=json-rpc
/+ naive, /+ naive,
azimuth-rpc, azimuth-roll-rpc,
json-rpc, json-rpc,
*server, *server,
default-agent, default-agent,
verb, verb,
dbug, dbug,
version,
agentio agentio
|% |%
:: ::
@ -71,7 +70,7 @@
:: TODO: method not supported :: TODO: method not supported
:: ::
(give-simple-payload:app id not-found:gen) (give-simple-payload:app id not-found:gen)
?~ rpc-request=(validate-request:json-rpc body.req parse-method) ?~ rpc-request=(validate-request:json-rpc body.req)
:: TODO: malformed request :: TODO: malformed request
:: ::
(give-simple-payload:app id not-found:gen) (give-simple-payload:app id not-found:gen)
@ -83,11 +82,7 @@
?~ data ~ ?~ data ~
:_ $(data t.data) :_ $(data t.data)
^- card ^- card
[%pass / %agent [our.bowl %aggregator] %poke i.data] [%pass / %agent [our.bowl %azimuth] %poke i.data]
:: TODO: validate that format is e.g. 'getPoint'
:: TODO: maybe use getPoint and translate to %get-point
::
++ parse-method |=(t=@t `term`t)
-- --
-- --
:: ::
@ -145,35 +140,15 @@
:: ::
++ process ++ process
|= request:rpc |= request:rpc
=, azimuth-rpc =, azimuth-roll-rpc
?. ?=([%map *] params) ?. ?=([%map *] params)
[~ ~(parse error:json-rpc id)] [~ ~(parse error:json-rpc id)]
=/ method=@tas (enkebab method) =/ method=@tas (enkebab method)
?+ method [~ ~(method error:json-rpc id)] ?+ method [~ ~(method error:json-rpc id)]
%get-point `(get-point id +.params point:scry) %get-point `(get-point id +.params point:scry)
%get-points `(get-points id +.params points:scry) %get-dns `(get-dns id +.params dns:scry)
%get-dns `(get-dns id +.params dns:scry) %get-naive-state `(get-naive id +.params naive-state:scry)
%transfer-point (transfer-point id +.params) %get-refresh `(get-refresh id +.params refresh:scry)
%cancel-transaction (cancel-tx id +.params)
%get-spawned `(get-spawned id +.params spawned:scry)
%configure-keys (configure-keys id +.params)
%spawn (spawn id +.params)
%escape (escape id +.params method)
%cancel-escape (cancel-escape id +.params method)
%adopt (adopt id +.params method)
%detach (detach id +.params method)
%reject (reject id +.params method)
%set-management-proxy (management-proxy id +.params method)
%set-spawn-proxy (spawn-proxy id +.params method)
%set-transfer-proxy (transfer-proxy id +.params method)
%get-all-pending `(all:pending id +.params all:pending:scry)
%get-pending-by-ship `(ship:pending id +.params ship:pending:scry)
%get-pending-by-address `(addr:pending id +.params addr:pending:scry)
%get-transaction-status `(status id +.params tx-status:scry)
%when-next-batch `(next-batch id +.params next-batch:scry)
%get-nonce `(nonce id +.params nonce:scry)
%get-history `(history id +.params addr:history:scry)
%get-roller-config `(get-config id +.params config:scry)
== ==
-- --
:: ::
@ -183,93 +158,25 @@
|= =ship |= =ship
.^ (unit point:naive) .^ (unit point:naive)
%gx %gx
(~(scry agentio bowl) %aggregator /point/(scot %p ship)/noun) (~(scry agentio bowl) %azimuth /point/(scot %p ship)/noun)
==
::
++ points
|= =address:naive
.^ (list [ship point:naive])
%gx
(~(scry agentio bowl) %azimuth /points/(scot %ux address)/noun)
==
::
++ spawned
|= =ship
.^ (list [@p @ux])
%gx
(~(scry agentio bowl) %aggregator /spawned/(scot %p ship)/noun)
==
::
++ pending
|%
++ all
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %aggregator /pending/noun)
==
::
++ ship
|= =^ship
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %aggregator /pending/(scot %p ship)/noun)
==
::
++ addr
|= =address:naive
.^ (list pend-tx)
%gx
%+ ~(scry agentio bowl) %aggregator
/pending/[(scot %ux address)]/noun
==
--
::
++ history
|%
++ addr
|= =address:naive
.^ (list roller-tx)
%gx
(~(scry agentio bowl) %aggregator /history/(scot %ux address)/noun)
==
--
::
++ tx-status
|= keccak=@ux
.^ ^tx-status
%gx
(~(scry agentio bowl) %aggregator /tx/(scot %ux keccak)/status/noun)
==
::
++ next-batch
.^ time
%gx
(~(scry agentio bowl) %aggregator /next-batch/noun)
==
::
++ nonce
|= [=ship =proxy:naive]
.^ (unit @)
%gx
%+ ~(scry agentio bowl)
%aggregator
/nonce/(scot %p ship)/[proxy]/noun
== ==
:: ::
++ dns ++ dns
.^ (list @t) .^ (list @t)
%gx %gx
%+ ~(scry agentio bowl) (~(scry agentio bowl) %azimuth /dns/noun)
%azimuth
/dns/noun
== ==
:: ::
++ config ++ naive-state
.^ roller-config .^ ^state:naive
%gx %gx
%+ ~(scry agentio bowl) (~(scry agentio bowl) %azimuth /nas/noun)
%aggregator ==
/config/noun ::
++ refresh
.^ @dr
%gx
(~(scry agentio bowl) %azimuth /refresh/noun)
== ==
-- --
-- --

View File

@ -1,5 +1,11 @@
/- eth-watcher /- eth-watcher, *dice
/+ ethereum, azimuth, naive, default-agent, verb, dbug /+ ethereum,
azimuth,
naive,
dice,
default-agent,
verb,
dbug
/* snap %eth-logs /app/azimuth/logs/eth-logs /* snap %eth-logs /app/azimuth/logs/eth-logs
:: ::
=/ last-snap :: maybe just use the last one? =/ last-snap :: maybe just use the last one?
@ -11,35 +17,183 @@
:: ::
=, jael =, jael
|% |%
++ app-state +$ versioned-state
$: %3 $% app-state
==
::::
+$ app-state
$: %0
url=@ta url=@ta
net=network
whos=(set ship) whos=(set ship)
nas=^state:naive nas=^state:naive
own=owners own=owners
logs=(list =event-log:rpc:ethereum) logs=(list =event-log:rpc:ethereum)
== ==
::
+$ poke-data +$ poke-data
$% :: %listen $% :: %listen
:: ::
[%listen whos=(list ship) =source:jael] [%listen whos=(list ship) =source:jael]
:: %watch: configure node url :: %watch: configure node url and network
:: ::
[%watch url=@ta] [%watch url=@ta net=network]
== ==
+$ tagged-diff [=id:block diff:naive]
:: ::
+$ network ?(%mainnet %ropsten %local) +$ tagged-diff [=id:block diff:naive]
+$ owners (jug address:naive [ship point:naive]) +$ network ?(%mainnet %ropsten %local)
+$ card card:agent:gall
:: TODO: add to state?
::
++ refresh ~m5
-- --
:: ::
|% =| state=app-state
++ net %- agent:dbug
^- network %+ verb |
:: TODO: add poke action to allow switching? ^- agent:gall
:: eth snapshot could also be considered =<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
:: ::
%local ++ on-init
^- (quip card _this)
=. net.state %local
:_ this
:_ ~
:* %pass
/eth-watcher
%agent
[our.bowl %eth-watcher]
%watch
/logs/[dap.bowl]
==
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
`this(state !<(versioned-state old))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?: =(%noun mark)
?+ q.vase !!
%rerun
~& [%rerunning (lent logs.state)]
=. points.nas.state ~
=. own.state ~
=^ * state (run-logs:do logs.state)
`this
::
%resub
:_ this :_ ~
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]
::
%resnap
=. logs.state snap
$(mark %noun, vase !>(%rerun))
==
?: =(%eth-logs mark)
=+ !<(logs=(list event-log:rpc:ethereum) vase)
=. logs.state logs
$(mark %noun, vase !>(%rerun))
::
?. ?=(%azimuth-poke mark)
(on-poke:def mark vase)
=+ !<(poke=poke-data vase)
?- -.poke
%listen
[[%pass /lo %arvo %j %listen (silt whos.poke) source.poke]~ this]
::
%watch
:: TODO: only wipe out state when switching networks?
:: ?: =(net.state net.poke)
:: [~ this]
=: nas.state *^state:naive
net.state net.poke
url.state url.poke
own.state ~
logs.state ~
==
[start:do this]
==
::
++ on-watch
|= =path
^- (quip card _this)
?< =(/sole/drum path)
?: =(/event path)
:_ this
[%give %fact ~ %naive-state !>([nas.state own.state])]~
=/ who=(unit ship)
?~ path ~
?: ?=([@ ~] path) ~
`(slav %p i.path)
=. whos.state
?~ who
~
(~(put in whos.state) u.who)
^- (quip card _this)
[start:do this]
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path (on-peek:def path)
[%x %logs ~] ``noun+!>(logs.state)
[%x %nas ~] ``noun+!>(nas.state)
[%x %dns ~] ``noun+!>(dns.nas.state)
[%x %own ~] ``noun+!>(own.state)
[%x %refresh ~] ``atom+!>(refresh)
[%x %point @ ~] ``noun+(point i.t.t.path)
==
::
++ point
|= wat=@t
^- vase
!> ^- (unit point:naive)
?~ ship=(rush wat ;~(pfix sig fed:ag))
~
(get:orm:naive points.nas.state u.ship)
--
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=([%eth-watcher ~] wire)
(on-agent:def wire sign)
?. ?=(%fact -.sign)
(on-agent:def wire sign)
?. ?=(%eth-watcher-diff p.cage.sign)
(on-agent:def wire sign)
=+ !<(diff=diff:eth-watcher q.cage.sign)
?: ?=(%disavow -.diff)
[(jael-update:do [*ship id.diff %disavow ~]~) this]
::
=. logs.state
?- -.diff
:: %history loglist.diff
%history (welp logs.state loglist.diff)
%logs (welp logs.state loglist.diff)
==
=? nas.state ?=(%history -.diff) *^state:naive
=^ effects state (run-logs:do loglist.diff)
::
:_ this
%+ weld
(event-update:do effects)
(jael-update:do (to-udiffs:do effects))
::
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
|_ =bowl:gall
:: TODO: maybe flop the endianness here so metamask signs it in normal :: TODO: maybe flop the endianness here so metamask signs it in normal
:: order? :: order?
:: ::
@ -70,45 +224,18 @@
?: =(data '0x') *@ux ?: =(data '0x') *@ux
(hex-to-num:ethereum data) (hex-to-num:ethereum data)
:: ::
++ update-ownership
|= [=diff:naive own=owners old=(unit point:naive) new=point:naive]
^+ own
?. ?=([%point *] diff) own
=* event +>.diff
=; [to=@ux from=@ux]
=? own !=(from 0x0)
?> ?=(^ old)
(~(del ju own) from [ship.diff u.old])
?: =(to 0x0) own
(~(put ju own) to [ship.diff new])
?+ -.event [0x0 0x0]
%owner
[+.event ?~(old 0x0 address.owner.own.u.old)]
::
%spawn-proxy
[+.event ?~(old 0x0 address.transfer-proxy.own.u.old)]
::
%management-proxy
[+.event ?~(old 0x0 address.management-proxy.own.u.old)]
::
%voting-proxy
[+.event ?~(old 0x0 address.voting-proxy.own.u.old)]
::
%transfer-proxy
[+.event ?~(old 0x0 address.spawn-proxy.own.u.old)]
==
::
++ run-logs ++ run-logs
|= [state=app-state logs=(list event-log:rpc:ethereum)] |= [logs=(list event-log:rpc:ethereum)]
^- [(list tagged-diff) _state] ^- (quip tagged-diff _state)
=/ [contract=@ux * chain-id=@ *] (get-network net) =+ net=(get-network net.state)
?~ logs ?~ logs
`state `state
?~ mined.i.logs ?~ mined.i.logs
$(logs t.logs) $(logs t.logs)
=/ [raw-effects=effects:naive new-nas=_nas.state] =/ [raw-effects=effects:naive new-nas=_nas.state]
=/ =^input:naive =/ =^input:naive
?: =(contract address.i.logs) :- block-number.u.mined.i.logs
?: =(azimuth.net address.i.logs)
=/ data (data-to-hex data.i.logs) =/ data (data-to-hex data.i.logs)
=/ =event-log:naive =/ =event-log:naive
[address.i.logs data topics.i.logs] [address.i.logs data topics.i.logs]
@ -118,20 +245,26 @@
[%bat u.input.u.mined.i.logs] [%bat u.input.u.mined.i.logs]
=/ res =/ res
%- mule %- mule
|.((%*(. naive lac |) verifier chain-id nas.state input)) |.((%*(. naive lac |) verifier chain-id.net nas.state input))
?- -.res ?- -.res
%& p.res %& p.res
%| ((slog 'naive-fail' p.res) `nas.state) %| ((slog 'naive-fail' p.res) `nas.state)
== ==
=. own.state =. own.state
%+ roll raw-effects =< own
|= [=diff:naive own=_own.state] ?. =(azimuth.net address.i.logs)
^+ own %: apply-effects:dice
=, orm:naive raw-effects
?. ?=([%point *] diff) own nas.state
=/ old=(unit point:naive) (get points.nas.state ship.diff) own.state
=/ new=point:naive (need (get points.new-nas ship.diff)) chain-id.net
(update-ownership diff own old new) ==
%: update-ownership:dice
raw-effects
nas.state
new-nas
own.state
==
=. nas.state new-nas =. nas.state new-nas
=/ effects-1 =/ effects-1
=/ =id:block [block-hash block-number]:u.mined.i.logs =/ =id:block [block-hash block-number]:u.mined.i.logs
@ -157,10 +290,10 @@
:: ::
++ jael-update ++ jael-update
|= =udiffs:point |= =udiffs:point
^- (list card:agent:gall) ^- (list card)
?: & ~ :: XX ?: & ~ :: XX
:- [%give %fact ~[/] %azimuth-udiffs !>(udiffs)] :- [%give %fact ~[/] %azimuth-udiffs !>(udiffs)]
|- ^- (list card:agent:gall) |- ^- (list card)
?~ udiffs ?~ udiffs
~ ~
=/ =path /(scot %p ship.i.udiffs) =/ =path /(scot %p ship.i.udiffs)
@ -169,20 +302,20 @@
:- [%give %fact ~[path] %azimuth-udiffs !>(~[i.udiffs])] :- [%give %fact ~[path] %azimuth-udiffs !>(~[i.udiffs])]
$(udiffs t.udiffs) $(udiffs t.udiffs)
:: ::
++ tx-update ++ event-update
|= effects=(list tagged-diff) |= effects=(list tagged-diff)
^- (list card:agent:gall) ^- (list card)
%+ murn effects %+ murn effects
|= tag=tagged-diff |= tag=tagged-diff
^- (unit card:agent:gall) ^- (unit card)
?. ?=(%tx +<.tag) ~ ?. |(?=(%tx +<.tag) ?=(%point +<.tag)) ~
%- some %- some
^- card:agent:gall ^- card
[%give %fact ~[/txs] %naive-diffs !>(+.tag)] [%give %fact ~[/event] %naive-diffs !>(+.tag)]
:: ::
++ get-network ++ get-network
|= =network |= =network
^- [@ux @ux @ @] ^- [azimuth=@ux naive=@ux chain-id=@ launch=@]
=< [azimuth naive chain-id launch] =< [azimuth naive chain-id launch]
=, azimuth =, azimuth
?- network ?- network
@ -192,204 +325,16 @@
== ==
:: ::
++ start ++ start
|= [state=app-state =network our=ship dap=term] ^- (list card)
^- card:agent:gall =+ net=(get-network net.state)
=/ [azimuth=@ux naive=@ux * launch=@ud] (get-network network)
=/ args=vase !> =/ args=vase !>
:+ %watch /[dap] :+ %watch /[dap.bowl]
^- config:eth-watcher ^- config:eth-watcher
:* url.state =(%czar (clan:title our)) ~m5 ~h30 :* url.state =(%czar (clan:title our.bowl)) refresh ~h30
(max launch last-snap) (max launch.net last-snap)
~[azimuth] ~[azimuth.net]
~[naive] ~[naive.net]
(topics whos.state) (topics whos.state)
== ==
[%pass /wa %agent [our %eth-watcher] %poke %eth-watcher-poke args] [%pass /wa %agent [our.bowl %eth-watcher] %poke %eth-watcher-poke args]~
--
::
=| state=app-state
%- agent:dbug
%+ verb |
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card:agent:gall agent:gall)
:_ this :_ ~
^- card:agent:gall
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]
::
++ on-save !>(state)
++ on-load
|= old=vase
|^
=+ !<(old-state=app-states old)
=? old-state ?=(%0 -.old-state)
%= old-state
- %1
logs
%+ turn logs.old-state
|= =event-log-0
event-log-0(mined ?~(mined.event-log-0 ~ `mined.event-log-0))
==
=? old-state ?=(%1 -.old-state)
%= old-state
- %2
nas *^state:naive
==
=? old-state ?=(%2 -.old-state)
%= old-state
- %3
own *owners
==
`this(state ?>(?=(%3 -.old-state) old-state))
::
++ app-states $%(app-state-0 app-state-1 app-state-2 app-state)
++ app-state-2
$: %2
url=@ta
whos=(set ship)
nas=^state:naive
own=*
logs=(list =event-log:rpc:ethereum)
==
++ app-state-1
$: %1
url=@ta
whos=(set ship)
nas=*
own=*
logs=(list =event-log:rpc:ethereum)
==
++ app-state-0
$: %0
url=@ta
whos=(set ship)
nas=*
own=*
logs=(list =event-log-0)
==
::
+$ event-log-0
$: $= mined %- unit
$: log-index=@ud
transaction-index=@ud
transaction-hash=@ux
block-number=@ud
block-hash=@ux
removed=?
==
::
address=@ux
data=@t
topics=(lest @ux)
==
--
::
++ on-poke
|= [=mark =vase]
?: =(%noun mark)
?+ q.vase !!
%rerun
~& [%rerunning (lent logs.state)]
=^ effects state (run-logs state logs.state)
`this
::
%resub
:_ this :_ ~
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]
::
%resnap
=. logs.state snap
$(mark %noun, vase !>(%rerun))
==
?: =(%eth-logs mark)
=+ !<(logs=(list event-log:rpc:ethereum) vase)
=. logs.state logs
$(mark %noun, vase !>(%rerun))
::
?. ?=(%azimuth-poke mark)
(on-poke:def mark vase)
=+ !<(poke=poke-data vase)
?- -.poke
%listen [[%pass /lo %arvo %j %listen (silt whos.poke) source.poke]~ this]
%watch
=. url.state url.poke
[[(start state net [our dap]:bowl) ~] this]
==
::
++ on-watch
|= =path
^- (quip card:agent:gall _this)
?< =(/sole/drum path)
?: =(/txs path)
:_ this
[%give %fact ~ %naive-state !>(nas.state)]~
=/ who=(unit ship)
?~ path ~
?: ?=([@ ~] path) ~
`(slav %p i.path)
=. whos.state
?~ who
~
(~(put in whos.state) u.who)
:_ this :_ ~
(start state net [our dap]:bowl)
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %logs ~] ``noun+!>(logs.state)
[%x %nas ~] ``noun+!>(nas.state)
[%x %dns ~] ``noun+!>(dns.nas.state)
[%x %points @ ~]
=* wat i.t.t.path
:+ ~ ~
:- %noun
!> ^- (list [ship point:naive])
?~ addr=(slaw %ux wat)
~
%~ tap in
(~(get ju own.state) u.addr)
==
::
++ on-agent
|= [=wire =sign:agent:gall]
?. ?=([%eth-watcher ~] wire)
(on-agent:def wire sign)
?. ?=(%fact -.sign)
(on-agent:def wire sign)
?. ?=(%eth-watcher-diff p.cage.sign)
(on-agent:def wire sign)
=+ !<(diff=diff:eth-watcher q.cage.sign)
?: ?=(%disavow -.diff)
[(jael-update [*ship id.diff %disavow ~]~) this]
::
=. logs.state
?- -.diff
:: %history loglist.diff
%history (welp logs.state loglist.diff)
%logs (welp logs.state loglist.diff)
==
=? nas.state ?=(%history -.diff) *^state:naive
=^ effects state
=; nas=^state:naive
(run-logs state(nas nas) loglist.diff)
?- -.diff
:: %history *^state:naive
%history nas.state
%logs nas.state
==
::
:_ this
%+ weld
(tx-update effects)
(jael-update (to-udiffs effects))
::
++ on-arvo on-arvo:def
++ on-fail on-fail:def
-- --

View File

@ -1,355 +0,0 @@
:: btc-provider.hoon
:: Proxy that serves a BTC full node and ElectRS address indexer
::
:: Subscriptions: none
:: To Subscribers: /clients
:: current connection state
:: results/errors of RPC calls
::
:: Scrys
:: x/is-whitelisted/SHIP: bool, whether ship is whitelisted
::
/- *bitcoin, json-rpc, *btc-provider
/+ dbug, default-agent, bl=btc, groupl=group, resource
|%
+$ versioned-state
$% state-0
==
::
+$ state-0 [%0 =host-info =whitelist]
::
+$ card card:agent:gall
::
--
%- agent:dbug
=| state-0
=* state -
^- agent:gall
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
hc ~(. +> bowl)
::
++ on-init
^- (quip card _this)
~& > '%btc-provider initialized successfully'
=| wl=^whitelist
:- ~
%_ this
host-info
['' connected=%.n %main block=0 clients=*(set ship)]
whitelist wl(public %.n, kids %.n)
==
::
++ on-save
^- vase
!>(state)
::
++ on-load
|= old-state=vase
^- (quip card _this)
~& > '%btc-provider recompiled successfully '
`this(state !<(versioned-state old-state))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> ?|((team:title our.bowl src.bowl) (is-client:hc src.bowl))
=^ cards state
?+ mark (on-poke:def mark vase)
%btc-provider-command
?> (team:title our.bowl src.bowl)
(handle-command:hc !<(command vase))
%btc-provider-action
(handle-action:hc !<(action vase))
==
[cards this]
::
++ on-watch
|= pax=path
^- (quip card _this)
:: checking provider permissions before trying to subscribe
:: terrible hack until we have cross-ship scries
::
?: ?=([%permitted @ ~] pax)
:_ this
=/ jon=json
%+ frond:enjs:format
%'providerStatus'
%- pairs:enjs:format
:~ provider+s+(scot %p our.bowl)
permitted+b+(is-whitelisted:hc src.bowl)
==
[%give %fact ~ %json !>(jon)]~
::
?> ?=([%clients *] pax)
?. (is-whitelisted:hc src.bowl)
~& >>> "btc-provider: blocked client {<src.bowl>}"
[~[[%give %kick ~ ~]] this]
~& > "btc-provider: accepted client {<src.bowl>}"
:- [do-ping:hc]~
this(clients.host-info (~(put in clients.host-info) src.bowl))
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
:: check for connectivity every 30 seconds
::
?: ?=([%ping-timer *] wire)
:_ this
:~ do-ping:hc
(start-ping-timer:hc ~s30)
==
=^ cards state
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%http-response
(handle-rpc-response:hc wire client-response.sign-arvo)
==
[cards this]
::
++ on-peek
|= pax=path
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %is-whitelisted @t ~]
``noun+!>((is-whitelisted:hc (ship (slav %p +>-.pax))))
::
[%x %is-client @t ~]
``noun+!>((is-client (ship (slav %p +>-.pax))))
==
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-fail on-fail:def
--
:: helper core
|_ =bowl:gall
++ handle-command
|= comm=command
^- (quip card _state)
?- -.comm
%set-credentials
:- :~ do-ping
(start-ping-timer ~s30)
==
%= state
host-info
[api-url.comm connected=%.n network.comm block=0 clients=*(set ship)]
==
::
%add-whitelist
?- -.wt.comm
%public
`state(public.whitelist %.y)
::
%kids
`state(kids.whitelist %.y)
::
%users
`state(users.whitelist (~(uni in users.whitelist) users.wt.comm))
::
%groups
`state(groups.whitelist (~(uni in groups.whitelist) groups.wt.comm))
==
::
%remove-whitelist
=. state
?- -.wt.comm
%public
state(public.whitelist %.n)
::
%kids
state(kids.whitelist %.n)
::
%users
state(users.whitelist (~(dif in users.whitelist) users.wt.comm))
::
%groups
state(groups.whitelist (~(dif in groups.whitelist) groups.wt.comm))
==
clean-client-list
==
:: if not connected, only %ping action is allowed
::
++ handle-action
|= act=action
^- (quip card _state)
?. ?|(connected.host-info ?=(%ping -.act))
~& >>> "Not connected to RPC"
[~[(send-update [%| %not-connected 500])] state]
::
=/ ract=action:rpc-types
?- -.act :: ~|("Invalid action" !!)
%address-info
[%get-address-info address.act]
::
%tx-info
[%get-tx-vals txid.act]
::
%raw-tx
[%get-raw-tx txid.act]
::
%broadcast-tx
[%broadcast-tx rawtx.act]
::
%ping
[%get-block-info ~]
==
[~[(req-card act ract)] state]
::
++ req-card
|= [act=action ract=action:rpc-types]
=| out=outbound-config:iris
=/ req=request:http
(gen-request:bl host-info ract)
[%pass (rpc-wire act) %arvo %i %request req out]
:: wire structure: /action-tas/now
::
++ rpc-wire
|= act=action ^- wire
/[-.act]/[(scot %ux (cut 3 [0 20] eny.bowl))]
::
++ kick-client
|= client=ship
^- (quip card _state)
~& >>> "dropping client {<client>}"
:- ~[[%give %kick ~[/clients] `client]]
state(clients.host-info (~(dif in clients.host-info) (silt ~[client])))
::
:: Handles HTTP responses from RPC servers. Parses for errors, then handles response.
:: For actions that require collating multiple RPC calls, uses req-card to call out
:: to RPC again if more information is required.
::
++ handle-rpc-response
|= [=wire response=client-response:iris]
^- (quip card _state)
?. ?=(%finished -.response) `state
=* status status-code.response-header.response
:: handle error types: connection errors, RPC errors (in order)
::
=^ conn-err state
(connection-error status)
?^ conn-err
:_ state(connected.host-info %.n)
~[(send-status [%disconnected ~]) (send-update [%| u.conn-err])]
::
%+ handle-rpc-result wire
%- parse-result:rpc:bl
(get-rpc-response:bl response)
::
++ connection-error
|= status=@ud
^- [(unit error) _state]
?+ status [`[%rpc-error ~] state]
%200
[~ state]
%400
[`[%bad-request status] state]
%401
[`[%no-auth status] state(connected.host-info %.n)]
%502
[`[%not-connected status] state(connected.host-info %.n)]
%504
[`[%not-connected status] state(connected.host-info %.n)]
==
::
++ handle-rpc-result
|= [=wire r=result:rpc-types]
^- (quip card _state)
?+ -.wire ~|("Unexpected HTTP response" !!)
%address-info
?> ?=([%get-address-info *] r)
:_ state
~[(send-update [%.y %address-info +.r])]
::
%tx-info
?> ?=([%get-tx-vals *] r)
:_ state
~[(send-update [%.y %tx-info +.r])]
::
%raw-tx
?> ?=([%get-raw-tx *] r)
:_ state
~[(send-update [%.y %raw-tx +.r])]
::
%broadcast-tx
?> ?=([%broadcast-tx *] r)
:_ state
~[(send-update [%.y %broadcast-tx +.r])]
::
%ping
?> ?=([%get-block-info *] r)
:_ state(connected.host-info %.y, block.host-info block.r)
?: =(block.host-info block.r)
~[(send-status [%connected network.host-info block.r fee.r])]
~[(send-status [%new-block network.host-info block.r fee.r blockhash.r blockfilter.r])]
==
::
++ send-status
|= =status ^- card
%- ?: ?=(%new-block -.status)
~&(>> "%new-block: {<block.status>}" same)
same
[%give %fact ~[/clients] %btc-provider-status !>(status)]
::
++ send-update
|= =update
^- card
=+ c=[%give %fact ~[/clients] %btc-provider-update !>(update)]
?: ?=(%.y -.update)
:: ~& >> "prov. update: {<p.update>}"
c
~& >> "prov. err: {<p.update>}"
c
::
++ is-whitelisted
|= user=ship ^- ?
|^
?| public.whitelist
=(our.bowl user)
?&(kids.whitelist is-kid)
(~(has in users.whitelist) user)
in-group
==
++ is-kid
=(our.bowl (sein:title our.bowl now.bowl user))
++ in-group
=/ gs ~(tap in groups.whitelist)
|-
?~ gs %.n
?: (~(is-member groupl bowl) user i.gs)
%.y
$(gs t.gs)
:: .^((unit group:g) %gx ;:(weld /=group-store=/groups p /noun))
--
:: +clean-client-list: remove clients who are no longer whitelisted
:: called after a whitelist change
::
++ clean-client-list
^- (quip card _state)
=/ to-kick=(set ship)
%- silt
%+ murn ~(tap in clients.host-info)
|= c=ship ^- (unit ship)
?:((is-whitelisted c) ~ `c)
:_ state(clients.host-info (~(dif in clients.host-info) to-kick))
%+ turn ~(tap in to-kick)
|=(c=ship [%give %kick ~[/clients] `c])
::
++ is-client
|= user=ship ^- ?
(~(has in clients.host-info) user)
::
++ start-ping-timer
|= interval=@dr ^- card
[%pass /ping-timer %arvo %b %wait (add now.bowl interval)]
::
++ do-ping
^- card
=/ act=action [%ping ~]
:* %pass /ping/[(scot %da now.bowl)] %agent
[our.bowl %btc-provider] %poke
%btc-provider-action !>(act)
==
--

File diff suppressed because it is too large Load Diff

View File

@ -22,6 +22,7 @@
+* this . +* this .
do ~(. +> bowl) do ~(. +> bowl)
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
bec byk.bowl(r da+now.bowl)
:: ::
++ on-init on-init:def ++ on-init on-init:def
++ on-save !>(state) ++ on-save !>(state)
@ -86,6 +87,7 @@
-- --
:: ::
|_ =bowl:gall |_ =bowl:gall
++ bec byk.bowl(r da+now.bowl)
:: ::
++ poke-spider ++ poke-spider
|= [=path our=@p =cage] |= [=path our=@p =cage]
@ -108,7 +110,7 @@
=/ new-tid=@ta =/ new-tid=@ta
:((cury cat 3) dap.bowl '--' (scot %uv eny.bowl)) :((cury cat 3) dap.bowl '--' (scot %uv eny.bowl))
=/ args =/ args
[~ `new-tid %claz-prep-command !>([node-url command])] [~ `new-tid bec %claz-prep-command !>([node-url command])]
:~ (watch-spider /prepare our.bowl /thread-result/[new-tid]) :~ (watch-spider /prepare our.bowl /thread-result/[new-tid])
(poke-spider /prepare our.bowl %spider-start !>(args)) (poke-spider /prepare our.bowl %spider-start !>(args))
== ==

View File

@ -132,6 +132,12 @@
=? site ?=([%'~debug' *] site) t.site =? site ?=([%'~debug' *] site) t.site
?~ ext ?~ ext
$(ext `%html, site [%index ~]) ::NOTE hack $(ext `%html, site [%index ~]) ::NOTE hack
:: serve dynamic session.js
::
?: =([/js/session `%js] [site ext])
%- js-response:gen
%- as-octt:mimes:html
"window.ship = '{(slag 1 (scow %p our.bowl))}';"
:: if not json, serve static file :: if not json, serve static file
:: ::
?. ?=([~ %json] ext) ?. ?=([~ %json] ext)
@ -418,13 +424,16 @@
++ apps ++ apps
|% |%
++ all ++ all
^- (list term) ^- (list dude:gall)
%+ murn %- zing
(scry (list path) %ct %home /app) ^- (list (list dude:gall))
|= =path %+ turn
^- (unit term) ~(tap in (scry (set desk) %cd %$ /))
?. ?=([%app @ %hoon ~] path) ~ |= =desk
`i.t.path ^- (list dude:gall)
=- (turn ~(tap in -) head)
;; (set [dude:gall ?]) ::TODO for some reason we need this?
(scry (set [dude:gall ?]) %ge desk /)
:: ::
++ running ++ running
|= app=term |= app=term

View File

@ -12,8 +12,8 @@
<body class="w-100 h-100"> <body class="w-100 h-100">
<div id="root" class="w-100 h-100"> <div id="root" class="w-100 h-100">
</div> </div>
<script src="/~landscape/js/channel.js"></script> <script src="/~debug/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script> <script src="/~debug/js/session.js"></script>
<script src="/~debug/js/index.js"></script> <script src="/~debug/js/index.js"></script>
</body> </body>

View File

@ -12,7 +12,7 @@
=> |% :: external structures => |% :: external structures
+$ id @tasession :: session id +$ id @tasession :: session id
+$ house :: all state +$ house :: all state
$: %6 $: %8
egg=@u :: command count egg=@u :: command count
hoc=(map id session) :: conversations hoc=(map id session) :: conversations
acl=(set ship) :: remote access whitelist acl=(set ship) :: remote access whitelist
@ -65,8 +65,8 @@
$~ [%ex *hoon] $~ [%ex *hoon]
$% [%ur p=@t] :: http GET request $% [%ur p=@t] :: http GET request
[%ge p=dojo-model] :: generator [%ge p=dojo-model] :: generator
[%te p=term q=(list dojo-source)] :: thread [%te p=[=desk =term] q=(list dojo-source)] :: thread
[%dv p=path] :: core from source [%dv p=beak q=path] :: core from source
[%ex p=hoon] :: hoon expression [%ex p=hoon] :: hoon expression
[%sa p=mark] :: example mark value [%sa p=mark] :: example mark value
[%as p=mark q=dojo-source] :: simple transmute [%as p=mark q=dojo-source] :: simple transmute
@ -79,7 +79,7 @@
== :: == ::
+$ dojo-server :: numbered device +$ dojo-server :: numbered device
$: p=@ud :: assembly index $: p=@ud :: assembly index
q=path :: gate path q=[=desk =path] :: gate location
== :: == ::
+$ dojo-config :: configuration +$ dojo-config :: configuration
$: p=(list dojo-source) :: by order $: p=(list dojo-source) :: by order
@ -125,7 +125,14 @@
++ to-command ++ to-command
|= [gol=goal mod=dojo-model] |= [gol=goal mod=dojo-model]
^- dojo-command ^- dojo-command
[[%poke gol] [0 [%ge mod(q.p [q.gol q.p.mod])]]] =/ =desk
::TODO maybe should recognize if the user specified a desk explicitly.
:: currently eats the :app|desk#gen case.
=+ gop=(en-beam dir(q q.gol, s /))
?. .^(? %gu gop)
q.dir
.^(desk %gd gop)
[[%poke gol] [0 [%ge mod(q.p [desk q.gol path.q.p.mod])]]]
:: ::
++ parse-variable ++ parse-variable
|* [sym=rule src=rule] |* [sym=rule src=rule]
@ -217,7 +224,7 @@
;~ pose ;~ pose
;~(plug (cold %ur lus) parse-url) ;~(plug (cold %ur lus) parse-url)
;~(plug (cold %ge lus) parse-model) ;~(plug (cold %ge lus) parse-model)
;~(plug (cold %te hep) sym (star ;~(pfix ace parse-source))) ;~(plug (cold %te hep) parse-thread (star ;~(pfix ace parse-source)))
;~(plug (cold %as pam) sym ;~(pfix ace parse-source)) ;~(plug (cold %as pam) sym ;~(pfix ace parse-source))
;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source)) ;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source))
parse-value parse-value
@ -263,7 +270,20 @@
auri:de-purl:html auri:de-purl:html
:: ::
++ parse-model ;~(plug parse-server parse-config) ++ parse-model ;~(plug parse-server parse-config)
++ parse-server (stag 0 (most fas sym)) ::
++ parse-server
%+ stag 0
;~ plug
;~(pose ;~(sfix sym zap) (easy q.dir))
(most fas sym)
==
::
++ parse-thread
;~ plug
;~(pose ;~(sfix sym zap) (easy q.dir))
sym
==
::
++ parse-hoon tall:hoon-parser ++ parse-hoon tall:hoon-parser
:: ::
++ parse-rood ++ parse-rood
@ -334,11 +354,11 @@
:: +dy-sing: make a clay read request :: +dy-sing: make a clay read request
:: ::
++ dy-sing ++ dy-sing
|= [way=wire =care:clay =path] |= [way=wire =care:clay =beak =path]
^+ +>+> ^+ +>+>
?> ?=(~ pux) ?> ?=(~ pux)
%- he-card(poy `+>+<(pux `way)) %- he-card(poy `+>+<(pux `way))
=/ [=ship =desk =case:clay] he-beak =/ [=ship =desk =case:clay] beak
[%pass way %arvo %c %warp ship desk ~ %sing care case path] [%pass way %arvo %c %warp ship desk ~ %sing care case path]
:: ::
++ dy-request ++ dy-request
@ -427,7 +447,13 @@
++ dy-init-server :: ++dojo-server ++ dy-init-server :: ++dojo-server
|= srv=dojo-server |= srv=dojo-server
=. p.srv num =. p.srv num
[srv +>.$(num +(num), job (~(put by job) num [%dv [%gen q.srv]]))] =/ bek=beak he-beak
:- srv
%_ +>.$
num +(num)
job %+ ~(put by job) num
[%dv bek(q desk.q.srv) [%gen path.q.srv]]
==
:: ::
++ dy-init-config :: prepare config ++ dy-init-config :: prepare config
|= cig=dojo-config |= cig=dojo-config
@ -512,7 +538,7 @@
$?(%eny %now %our) !! $?(%eny %now %our) !!
%lib .(lib ~) %lib .(lib ~)
%sur .(sur ~) %sur .(sur ~)
%dir .(dir [[our.hid %home ud+0] /]) %dir .(dir [[our.hid %base ud+0] /])
== ==
=+ cay=(~(got by rez) p.q.mad) =+ cay=(~(got by rez) p.q.mad)
?- -.p.mad ?- -.p.mad
@ -538,8 +564,8 @@
:: ::
%dir =+ ^= pax ^- path %dir =+ ^= pax ^- path
=+ pax=((dy-cast path !>(*path)) q.cay) =+ pax=((dy-cast path !>(*path)) q.cay)
?: ?=(~ pax) ~[(scot %p our.hid) %home '0'] ?: ?=(~ pax) ~[(scot %p our.hid) %base '0']
?: ?=([@ ~] pax) ~[i.pax %home '0'] ?: ?=([@ ~] pax) ~[i.pax %base '0']
?: ?=([@ @ ~] pax) ~[i.pax i.t.pax '0'] ?: ?=([@ @ ~] pax) ~[i.pax i.t.pax '0']
pax pax
=. dir (need (de-beam pax)) =. dir (need (de-beam pax))
@ -673,9 +699,9 @@
[%sa mark] [%sa mark]
[%as mark dy-shown] [%as mark dy-shown]
[%do hoon dy-shown] [%do hoon dy-shown]
[%te term (list dy-shown)] [%te [desk term] (list dy-shown)]
[%ge path (list dy-shown) (map term (unit dy-shown))] [%ge [desk path] (list dy-shown) (map term (unit dy-shown))]
[%dv path] [%dv beak path]
== ==
== ==
:: ::
@ -850,7 +876,7 @@
(dy-hand %noun q.cag) (dy-hand %noun q.cag)
:: ::
++ dy-wool-poke ++ dy-wool-poke
|= [fil=term src=(list dojo-source)] |= [[=desk =term] src=(list dojo-source)]
^+ +>+> ^+ +>+>
?> ?=(~ pux) ?> ?=(~ pux)
=/ tid (scot %ta (cat 3 'dojo_' (scot %uv (sham eny.hid)))) =/ tid (scot %ta (cat 3 'dojo_' (scot %uv (sham eny.hid))))
@ -860,7 +886,9 @@
[%pass /wool %agent [our.hid %spider] %watch /thread-result/[tid]] [%pass /wool %agent [our.hid %spider] %watch /thread-result/[tid]]
%- he-card %- he-card
=/ =cage :: also sub =/ =cage :: also sub
[%spider-start !>([~ `tid fil (dy-some src)])] ::TODO would be nice if spider supported starting from paths,
:: for semantics/abilities/code closer to generators.
[%spider-start !>([~ `tid he-beak(q.dir desk) term (dy-some src)])]
[%pass /wool %agent [our.hid %spider] %poke cage] [%pass /wool %agent [our.hid %spider] %poke cage]
:: ::
++ dy-make :: build step ++ dy-make :: build step
@ -871,7 +899,7 @@
%ur (dy-request /hand `request:http`[%'GET' p.bil ~ ~]) %ur (dy-request /hand `request:http`[%'GET' p.bil ~ ~])
%te (dy-wool-poke p.bil q.bil) %te (dy-wool-poke p.bil q.bil)
%ex (dy-mere p.bil) %ex (dy-mere p.bil)
%dv (dy-sing hand+p.bil %a (snoc p.bil %hoon)) %dv (dy-sing hand+q.bil %a p.bil (snoc q.bil %hoon))
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil) %ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%sa %sa
=+ .^(=dais:clay cb+(en-beam he-beak /[p.bil])) =+ .^(=dais:clay cb+(en-beam he-beak /[p.bil]))
@ -879,6 +907,9 @@
:: ::
%as %as
=/ cag=cage (dy-cage p.q.bil) =/ cag=cage (dy-cage p.q.bil)
=/ has-mark .?((get-fit:clay he-beak %mar p.bil))
?. has-mark :: yolo
(dy-hand p.bil q.cag)
=+ .^(=tube:clay cc+(en-beam he-beak /[p.cag]/[p.bil])) =+ .^(=tube:clay cc+(en-beam he-beak /[p.cag]/[p.bil]))
(dy-hand p.bil (tube q.cag)) (dy-hand p.bil (tube q.cag))
:: ::
@ -1015,13 +1046,13 @@
:: ::
++ he-prow :: where we are ++ he-prow :: where we are
^- tape ^- tape
?: &(=(our.hid p.dir) =(%home q.dir) =([%ud 0] r.dir) =(~ s.dir)) ~ ?: &(=(our.hid p.dir) =(%base q.dir) =([%ud 0] r.dir) =(~ s.dir)) ~
%+ weld %+ weld
?: &(=(our.hid p.dir) =([%ud 0] r.dir)) ?: &(=(our.hid p.dir) =([%ud 0] r.dir))
(weld "/" (trip q.dir)) (weld "/" (trip q.dir))
;: weld ;: weld
"/" ?:(=(our.hid p.dir) "=" (scow %p p.dir)) "/" ?:(=(our.hid p.dir) "=" (scow %p p.dir))
"/" ?:(=(%home q.dir) "=" (trip q.dir)) "/" ?:(=(%base q.dir) "=" (trip q.dir))
"/" ?:(=([%ud 0] r.dir) "=" (scow r.dir)) "/" ?:(=([%ud 0] r.dir) "=" (scow r.dir))
== ==
?:(=(~ s.dir) "" (spud s.dir)) ?:(=(~ s.dir) "" (spud s.dir))
@ -1039,6 +1070,7 @@
?+ way !! ?+ way !!
[%hand *] [%hand *]
?~ riot ?~ riot
~> %slog.0^leaf/"dojo: %writ fail {<way>}"
(he-diff(poy ~) %tan >%generator-build-fail< >(snoc t.way %hoon)< ~) (he-diff(poy ~) %tan >%generator-build-fail< >(snoc t.way %hoon)< ~)
(~(dy-hand dy u.poy(pux ~)) noun+!<(vase q.r.u.riot)) (~(dy-hand dy u.poy(pux ~)) noun+!<(vase q.r.u.riot))
== ==
@ -1140,7 +1172,7 @@
:+ %clhp :+ %clhp
[%rock %tas %cx] [%rock %tas %cx]
%+ rash pax.source.com %+ rash pax.source.com
rood:(vang | /(scot %p our.hid)/home/(scot %da now.hid)) rood:(vang | /(scot %p our.hid)/base/(scot %da now.hid))
:: ::
%url [%ur (crip (en-purl:html url.source.com))] %url [%ur (crip (en-purl:html url.source.com))]
%api !! %api !!
@ -1171,7 +1203,7 @@
%hoon %hoon
:* %do :* %do
%+ rash code.source.com %+ rash code.source.com
tall:(vang | /(scot %p our.hid)/home/(scot %da now.hid)) tall:(vang | /(scot %p our.hid)/base/(scot %da now.hid))
$(num +(num), source.com next.source.com) $(num +(num), source.com next.source.com)
== ==
:: ::
@ -1351,7 +1383,7 @@
++ complete-naked-poke ++ complete-naked-poke
|= app=term |= app=term
=/ pax=path =/ pax=path
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/app /(scot %p our.hid)/[q:he-beam]/(scot %da now.hid)/app
%+ complete (cat 3 ':' app) %+ complete (cat 3 ':' app)
%+ murn ~(tap by dir:.^(arch %cy pax)) %+ murn ~(tap by dir:.^(arch %cy pax))
|= [=term ~] |= [=term ~]
@ -1381,7 +1413,7 @@
(cat 3 '|' gen) (cat 3 '|' gen)
:((cury cat 3) ':' app '|' gen) :((cury cat 3) ':' app '|' gen)
=/ pfix=path =/ pfix=path
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/gen/[app] /(scot %p our.hid)/[q:he-beam]/(scot %da now.hid)/gen/[app]
:: ::
%^ tab-generators:auto pfix `app %^ tab-generators:auto pfix `app
%+ murn %+ murn
@ -1397,7 +1429,7 @@
|= gen=term |= gen=term
%+ complete (cat 3 '+' gen) %+ complete (cat 3 '+' gen)
=/ pax=path =/ pax=path
/(scot %p our.hid)/[q.byk.hid]/(scot %da now.hid)/gen /(scot %p our.hid)/[q:he-beam]/(scot %da now.hid)/gen
%^ tab-generators:auto pax ~ %^ tab-generators:auto pax ~
%+ murn %+ murn
~(tap by dir:.^(arch %cy pax)) ~(tap by dir:.^(arch %cy pax))
@ -1493,12 +1525,53 @@
!>(state) !>(state)
:: ::
++ on-load ++ on-load
|= old=vase |= ole=vase
?: ?=(%6 +<.old) |^ =+ old=!<(house-any ole)
`..on-init(state !<(house old)) =? old ?=(%5 -.old)
=/ old-5 !<([%5 egg=@u hoc=(map id session)] old) (house-5-to-6 old)
=/ =house [%6 egg.old-5 hoc.old-5 *(set ship)] =? old ?=(?(%6 %7) -.old)
`..on-init(state house) (house-6-7-to-8 +.old)
?> ?=(%8 -.old)
`..on-init(state old)
::
+$ house-any $%(house house-7 house-6 house-5)
::
+$ house-7 [%7 house-6-7]
+$ house-6 [%6 house-6-7]
+$ house-6-7
$: egg=@u :: command count
hoc=(map id session-6) :: conversations
acl=(set ship) :: remote access whitelist
== ::
+$ session-6 :: per conversation
$: say=sole-share :: command-line state
dir=beam :: active path
poy=(unit *) :: working
$: :: sur: structure imports
::
sur=(list cable:clay)
:: lib: library imports
::
lib=(list cable:clay)
==
var=(map term cage) :: variable state
old=(set term) :: used TLVs
buf=tape :: multiline buffer
== ::
++ house-6-7-to-8
|= old=house-6-7
[%8 egg.old (~(run by hoc.old) session-6-to-8) acl.old]
++ session-6-to-8
|= old=session-6
~? ?=(^ poy.old) [dap.hid %cancelling-for-load]
old(poy ~, -.dir [our.hid %base ud+0])
::
+$ house-5
[%5 egg=@u hoc=(map id session)]
++ house-5-to-6
|= old=house-5
[%6 egg.old hoc.old *(set ship)]
--
:: ::
++ on-poke ++ on-poke
|= [=mark =vase] |= [=mark =vase]
@ -1555,7 +1628,7 @@
=? hoc (~(has by hoc) id) =? hoc (~(has by hoc) id)
~& [%dojo-peer-replaced id] ~& [%dojo-peer-replaced id]
(~(del by hoc) id) (~(del by hoc) id)
=/ =session %*(. *session -.dir [our.hid %home ud+0]) =/ =session %*(. *session -.dir [our.hid %base ud+0])
=^ moves state =^ moves state
he-abet:~(he-prom he hid id ~ session) he-abet:~(he-prom he hid id ~ session)
[moves ..on-init] [moves ..on-init]

View File

@ -49,6 +49,7 @@
+* this . +* this .
do ~(. +> bowl) do ~(. +> bowl)
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
bec byk.bowl(r da+now.bowl)
:: ::
++ on-init on-init:def ++ on-init on-init:def
++ on-save !>(state) ++ on-save !>(state)
@ -117,6 +118,7 @@
-- --
:: ::
|_ =bowl:gall |_ =bowl:gall
++ bec byk.bowl(r da+now.bowl)
++ poke-spider ++ poke-spider
|= [=path our=@p =cage] |= [=path our=@p =cage]
^- card ^- card
@ -137,9 +139,7 @@
^- (list card) ^- (list card)
=/ tid=@ta =/ tid=@ta
:((cury cat 3) dap.bowl '--' node-id '--' (scot %uv eny.bowl)) :((cury cat 3) dap.bowl '--' node-id '--' (scot %uv eny.bowl))
=/ args =/ args [~ `tid bec %eth-send-txs !>([node step txs])]
:^ ~ `tid %eth-send-txs
!>([node step txs])
:~ (watch-spider /send/[tid] our.bowl /thread-result/[tid]) :~ (watch-spider /send/[tid] our.bowl /thread-result/[tid])
(poke-spider /send/[tid] our.bowl %spider-start !>(args)) (poke-spider /send/[tid] our.bowl %spider-start !>(args))
== ==
@ -151,7 +151,7 @@
.^ (list cord) .^ (list cord)
%cx %cx
(scot %p our.bowl) (scot %p our.bowl)
%home %base
(scot %da now.bowl) (scot %da now.bowl)
path path
== ==

View File

@ -64,6 +64,7 @@
|_ =bowl:gall |_ =bowl:gall
+* this . +* this .
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
bec byk.bowl(r da+now.bowl)
:: ::
++ on-init ++ on-init
^- (quip card _this) ^- (quip card _this)
@ -535,8 +536,9 @@
(cat 3 'eth-watcher--' (scot %uv eny.bowl)) (cat 3 'eth-watcher--' (scot %uv eny.bowl))
:_ dog(running `[now.bowl new-tid]) :_ dog(running `[now.bowl new-tid])
=/ args =/ args
:^ ~ `new-tid %eth-watcher :* ~ `new-tid bec %eth-watcher
!>([~ `watchpup`[- number pending-logs blocks]:dog]) !>([~ `watchpup`[- number pending-logs blocks]:dog])
==
:~ (watch-spider path our.bowl /thread-result/[new-tid]) :~ (watch-spider path our.bowl /thread-result/[new-tid])
(poke-spider path our.bowl %spider-start !>(args)) (poke-spider path our.bowl %spider-start !>(args))
== ==

View File

@ -62,6 +62,7 @@
+* this . +* this .
do ~(. +> bowl) do ~(. +> bowl)
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
bec byk.bowl(r da+now.bowl)
:: ::
++ on-init ++ on-init
^- (quip card _this) ^- (quip card _this)
@ -174,6 +175,7 @@
-- --
:: ::
|_ =bowl:gall |_ =bowl:gall
++ bec byk.bowl(r da+now.bowl)
++ setup-cards ++ setup-cards
^- (list card) ^- (list card)
:~ wait-export :~ wait-export
@ -297,7 +299,7 @@
:: ::
%+ poke-spider /timestamps/[tid] %+ poke-spider /timestamps/[tid]
:- %spider-start :- %spider-start
=- !>([~ `tid %eth-get-timestamps -]) =- !>([~ `tid bec %eth-get-timestamps -])
!> ^- [@t (list @ud)] !> ^- [@t (list @ud)]
:- node-url :- node-url
=- ~(tap in -) =- ~(tap in -)

View File

@ -1,46 +0,0 @@
/+ default-agent, verb
%+ verb |
^- agent:gall
=>
|%
++ goad
|= force=?
:~ [%pass /gall %arvo %g %goad force ~]
==
+$ state
$@ ~
[%0 ~]
--
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-poke
|= [=mark =vase]
?: ?=([%noun * %go] +<)
[(goad |) this]
?: ?=([%noun * %force] +<)
[(goad &) this]
(on-poke:def mark vase)
::
++ on-arvo
|= [wir=wire sin=sign-arvo]
?+ wir (on-arvo:def wir sin)
[%clay ~] `this
[%behn ~] `this :: backcompat
==
::
++ on-agent on-agent:def
++ on-fail on-fail:def
++ on-init on-init:def
++ on-leave on-leave:def
++ on-load
|= =vase
=+ !<(old=state vase)
?^ old `this
[(goad &) this]
::
++ on-peek on-peek:def
++ on-save !>([%0 ~])
++ on-watch on-watch:def
--

View File

@ -1,472 +0,0 @@
:: hark-graph-hook: notifications for graph-store [landscape]
::
/- post, group-store, metadata=metadata-store, hook=hark-graph-hook, store=hark-store
/+ resource, mdl=metadata, default-agent, dbug, graph-store, graph, grouplib=group, store=hark-store
::
::
~% %hark-graph-hook-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
==
::
+$ state-0
[%0 base-state-0]
::
+$ state-1
[%1 base-state-0]
::
+$ base-state-0
$: watching=(set [resource index:post])
mentions=_&
watch-on-self=_&
==
::
++ scry
|* [[our=@p now=@da] =mold p=path]
?> ?=(^ p)
?> ?=(^ t.p)
.^(mold i.p (scot %p our) i.t.p (scot %da now) t.t.p)
::
++ scry-conversion
|= [[our=@p now=@da] desk=term =mark]
~+
%^ scry [our now]
tube:clay
/cc/[desk]/[mark]/notification-kind
--
::
=| state-1
=* state -
::
=<
%- agent:dbug
^- agent:gall
~% %hark-graph-hook-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
++ on-init
:_ this
~[watch-graph:ha]
::
++ on-save !>(state)
++ on-load
|= =vase
^- (quip card _this)
=+ !<(old=versioned-state vase)
=| cards=(list card)
|-
?: ?=(%0 -.old)
%_ $
-.old %1
::
cards
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%rewatch-dms)]
==
:_ this(state old)
=. cards (flop cards)
%+ welp
?: (~(has by wex.bowl) [/graph our.bowl %graph-store])
cards
[watch-graph:ha cards]
%+ turn
^- (list mark)
:~ %graph-validator-chat
%graph-validator-link
%graph-validator-publish
==
|= =mark
^- card
=/ =wire /validator/[mark]
=/ =rave:clay [%sing %c [%da now.bowl] /[mark]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
::
++ on-watch
|= =path
^- (quip card _this)
=^ cards state
?+ path (on-watch:def path)
::
[%updates ~]
:_ state
%+ give:ha ~
:* %initial
watching
mentions
watch-on-self
==
==
[cards this]
::
++ on-poke
~/ %hark-graph-hook-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-graph-hook-action
(hark-graph-hook-action !<(action:hook vase))
%noun
(poke-noun !<(* vase))
==
[cards this]
::
++ poke-noun
|= non=*
[~ state]
:: ?> ?=(%rewatch-dms non)
:: =/ graphs=(list resource)
:: ~(tap in get-keys:gra)
:: %_ state
:: watching
:: %- ~(gas in watching)
:: (murn graphs |=(rid=resource ?:((should-watch:ha rid) `[rid ~] ~)))
:: ==
::
++ hark-graph-hook-action
|= =action:hook
^- (quip card _state)
|^
:- (give:ha ~[/updates] action)
?- -.action
%listen (listen +.action)
%ignore (ignore +.action)
%set-mentions (set-mentions +.action)
%set-watch-on-self (set-watch-on-self +.action)
==
++ listen
|= [graph=resource =index:post]
^+ state
state(watching (~(put in watching) [graph index]))
::
++ ignore
|= [graph=resource =index:post]
^+ state
state(watching (~(del in watching) [graph index]))
::
++ set-mentions
|= ment=?
^+ state
state(mentions ment)
::
++ set-watch-on-self
|= self=?
^+ state
state(watch-on-self self)
--
--
::
++ on-agent
~/ %hark-graph-hook-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ -.sign (on-agent:def wire sign)
%kick
:_ this
?. ?=([%graph ~] wire)
~
~[watch-graph:ha]
::
%fact
?. ?=(%graph-update-2 p.cage.sign)
(on-agent:def wire sign)
=^ cards state
(graph-update !<(update:graph-store q.cage.sign))
[cards this]
==
::
++ graph-update
|= =update:graph-store
^- (quip card _state)
?+ -.q.update `state
%add-graph (add-graph resource.q.update)
::
?(%remove-graph %archive-graph)
(remove-graph resource.q.update)
::
%remove-posts
(remove-posts resource.q.update indices.q.update)
::
%add-nodes
=* rid resource.q.update
=/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
(check-nodes ~(val by nodes.q.update) rid assoc)
==
:: this is awful, but notification kind should always switch
:: on the index, so hopefully doesn't matter
:: TODO: rethink this
++ remove-posts
|= [rid=resource indices=(set index:graph-store)]
=/ to-remove
%- ~(gas by *(set [resource index:graph-store]))
(turn ~(tap in indices) (lead rid))
:_ state(watching (~(dif in watching) to-remove))
=/ =tube:clay
(get-conversion:ha rid)
%+ roll
~(tap in indices)
|= [=index:graph-store out=(list card)]
=| =indexed-post:graph-store
=. index.p.indexed-post index
=+ !<(u-notif-kind=(unit notif-kind:hook) (tube !>(indexed-post)))
?~ u-notif-kind out
=* notif-kind u.u-notif-kind
=/ =stats-index:store
[%graph rid (scag parent.index-len.notif-kind index)]
?. ?=(%each mode.notif-kind) out
:_ out
(poke-hark %read-each stats-index index)
::
++ poke-hark
|= =action:store
^- card
[%pass / %agent [our.bowl %hark-store] %poke hark-action+!>(action)]
::
++ remove-graph
|= rid=resource
=/ unwatched
%- ~(gas in *(set [resource index:graph-store]))
%+ skim ~(tap in watching)
|= [r=resource idx=index:graph-store]
=(r rid)
:_ state(watching (~(dif in watching) unwatched))
^- (list card)
:- (poke-hark:ha %remove-graph rid)
%- zing
%+ turn ~(tap in unwatched)
|= [r=resource =index:graph-store]
(give:ha ~[/updates] %ignore r index)
::
++ add-graph
|= rid=resource
^- (quip card _state)
=/ graph=graph:graph-store :: graph in subscription is bunted
(get-graph-mop:gra rid)
=/ node=(unit node:graph-store)
(bind (pry:orm:graph-store graph) |=([@ =node:graph-store] node))
=/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
=^ cards state
(check-nodes (drop node) rid assoc)
?. (should-watch:ha rid assoc)
[cards state]
:_ state(watching (~(put in watching) [rid ~]))
(weld cards (give:ha ~[/updates] %listen [rid ~]))
::
++ check-nodes
|= $: nodes=(list node:graph-store)
rid=resource
assoc=(unit association:metadata)
==
abet:check:(abed:handle-update:ha rid nodes)
--
::
++ on-peek on-peek:def
::
++ on-leave on-leave:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
::
[%validator @ ~]
:_ this
=* validator i.t.wire
=/ =rave:clay [%next %c [%da now.bowl] /[validator]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
==
++ on-fail on-fail:def
--
::
|_ =bowl:gall
+* met ~(. mdl bowl)
grp ~(. grouplib bowl)
gra ~(. graph bowl)
::
++ get-conversion
|= rid=resource
^- tube:clay
=+ %^ scry [our now]:bowl
,mark=(unit mark)
/gx/graph-store/graph-mark/(scot %p entity.rid)/[name.rid]/noun
?~ mark
|=(v=vase !>(~))
(scry-conversion [our now]:bowl q.byk.bowl u.mark)
::
++ give
|= [paths=(list path) =update:hook]
^- (list card)
[%give %fact paths hark-graph-hook-update+!>(update)]~
::
++ watch-graph
^- card
[%pass /graph %agent [our.bowl %graph-store] %watch /updates]
::
++ poke-hark
|= =action:store
^- card
=- [%pass / %agent [our.bowl %hark-store] %poke -]
hark-action+!>(action)
::
++ is-mention
|= contents=(list content:post)
^- ?
?. mentions %.n
?~ contents %.n
?. ?=(%mention -.i.contents)
$(contents t.contents)
?: =(our.bowl ship.i.contents)
%.y
$(contents t.contents)
::
++ should-watch
|= [rid=resource assoc=(unit association:metadata)]
^- ?
?~ assoc
%.y
&(watch-on-self =(our.bowl entity.rid))
::
++ handle-update
|_ $: rid=resource :: input
updates=(list node:graph-store)
mark=(unit mark)
hark-pokes=(list action:store) :: output
new-watches=(list index:graph-store)
==
++ update-core .
::
++ abed
|= [r=resource upds=(list node:graph-store)]
=/ m=(unit ^mark)
(get-mark:gra r)
update-core(rid r, updates upds, mark m)
::
++ get-conversion
:: LA: this tube should be cached in %hark-graph-hook state
:: instead of just trying to keep it warm, as the scry overhead is large
~+ (^get-conversion rid)
::
++ abet
^- (quip card _state)
:_ state(watching (~(uni in watching) (silt (turn new-watches (lead rid)))))
^- (list card)
%+ welp (turn (flop hark-pokes) poke-hark)
%- zing
%+ turn (flop new-watches)
|=(=index:graph-store (give ~[/updates] [%listen rid index]))
::
++ hark
|= =action:store
^+ update-core
update-core(hark-pokes [action hark-pokes])
::
++ new-watch
|= [=index:graph-store =watch-for:hook =index-len:hook]
=? new-watches =(%siblings watch-for)
[(scag parent.index-len index) new-watches]
=? new-watches =(%children watch-for)
[(scag self.index-len index) new-watches]
update-core
::
++ check
|- ^+ update-core
?~ updates
update-core
=/ core=_update-core
(check-node i.updates)
=. updates.core t.updates
$(update-core core)
::
++ check-node-children
|= =node:graph-store
^+ update-core
?: ?=(%empty -.children.node)
update-core
=/ children=(list [=atom =node:graph-store])
(tap:orm:graph-store p.children.node)
|- ^+ update-core
?~ children
update-core
=. update-core (check-node node.i.children)
$(children t.children)
::
++ check-node
|= =node:graph-store
^+ update-core
=. update-core (check-node-children node)
?: ?=(%| -.post.node)
update-core
=* pos p.post.node
=+ !< notif-kind=(unit notif-kind:hook)
%- get-conversion
!>(`indexed-post:graph-store`[0 pos])
?~ notif-kind
update-core
=/ desc=@t
?: (is-mention contents.pos)
%mention
name.u.notif-kind
=* not-kind u.notif-kind
=/ parent=index:post
(scag parent.index-len.not-kind index.pos)
=/ notif-index=index:store
[%graph rid mark desc parent]
?: =(our.bowl author.pos)
(self-post node notif-index not-kind)
=. update-core
(update-unread-count not-kind notif-index [time-sent index]:pos)
=? update-core
?| =(desc %mention)
(~(has in watching) [rid parent])
=(mark `%graph-validator-dm)
==
=/ =contents:store
[%graph (limo pos ~)]
(add-unread notif-index [time-sent.pos %.n contents])
update-core
::
++ update-unread-count
|= [=notif-kind:hook =index:store time=@da ref=index:graph-store]
=/ =stats-index:store
(to-stats-index:store index)
?- mode.notif-kind
%count (hark %unread-count stats-index time)
%each (hark %unread-each stats-index ref time)
%none update-core
==
::
++ self-post
|= $: =node:graph-store
=index:store
=notif-kind:hook
==
^+ update-core
?> ?=(%& -.post.node)
=/ =stats-index:store
(to-stats-index:store index)
=. update-core
(hark %seen-index time-sent.p.post.node stats-index)
=? update-core ?=(%count mode.notif-kind)
(hark %read-count stats-index)
=? update-core watch-on-self
(new-watch index.p.post.node [watch-for index-len]:notif-kind)
update-core
::
++ add-unread
|= [=index:store =notification:store]
(hark %add-note index notification)
--
--

View File

@ -1,710 +0,0 @@
:: hark-store: notifications and unread counts [landscape]
::
:: hark-store can store unread counts differently, depending on the
:: resource.
:: - last seen. This way, hark-store simply stores an index into
:: graph-store, which represents the last "seen" item, useful for
:: high-volume applications which are intrinsically time-ordered. i.e.
:: chats, comments
:: - each. Hark-store will store an index for each item that is unread.
:: Usefull for non-linear, low-volume applications, i.e. blogs,
:: collections
::
/- post, group-store, metadata-store, store=hark-store
/+ resource, metadata, default-agent, dbug, graph-store, graphl=graph, verb, store=hark-store
::
::
~% %hark-store-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state:state-zero:store
state:state-one:store
state-2
state-3
state-4
state-5
state-6
state-7
==
+$ unread-stats
[indices=(set index:graph-store) last=@da]
::
+$ base-state
$: unreads-each=(jug stats-index:store index:graph-store)
unreads-count=(map stats-index:store @ud)
timeboxes=(map stats-index:store @da)
unread-notes=timebox:store
last-seen=(map stats-index:store @da)
=notifications:store
archive=notifications:store
current-timebox=@da
dnd=_|
==
::
+$ state-2
[%2 state-two:store]
::
+$ state-3
[%3 state-two:store]
::
+$ state-4
[%4 state-three:store]
::
+$ state-5
[%5 state-three:store]
::
+$ state-6
[%6 state-four:store]
::
+$ state-7
[%7 base-state]
::
::
++ orm ((ordered-map @da timebox:store) gth)
--
::
=| state-7
=* state -
::
=<
%+ verb |
%- agent:dbug
^- agent:gall
~% %hark-store-agent ..card ~
|_ =bowl:gall
+* this .
ha ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
met ~(. metadata bowl)
gra ~(. graphl bowl)
::
++ on-init
:_ this
~[autoseen-timer]
::
++ on-save !>(state)
++ on-load
|= =old=vase
^- (quip card _this)
=/ old
!<(versioned-state old-vase)
=| cards=(list card)
|^
^- (quip card _this)
?- -.old
%7
:- (flop cards)
this(state old)
::
%6
%_ $
-.old %7
::
+.old
%* . *base-state
notifications (notifications:to-five:upgrade:store notifications.old)
archive ~
unreads-each unreads-each.old
unreads-count unreads-count.old
last-seen last-seen.old
current-timebox current-timebox
dnd dnd.old
==
==
::
%5
%_ $
-.old %6
notifications.old (notifications:to-four:upgrade:store notifications.old)
archive.old *notifications:state-four:store
==
::
%4
%_ $
-.old %5
::
last-seen.old
%- ~(run by last-seen.old)
|=(old=@da (min old now.bowl))
==
::
%3
%_ $
-.old %4
notifications.old (notifications:to-three:upgrade:store notifications.old)
archive.old *notifications:state-three:store
==
::
%2
%_ $
-.old %3
::
cards
:_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%fix-dangling)]
==
::
%1
%_ $
::
old
%* . *state-2
unreads-each ((convert-unread ,(set index:graph-store)) uni-by unreads-each.old)
unreads-count ((convert-unread ,@ud) add unreads-count.old)
last-seen ((convert-unread ,@da) max last-seen.old)
notifications notifications.old
archive archive.old
current-timebox current-timebox.old
dnd dnd.old
==
==
::
%0
%_ $
::
old
%* . *state:state-one:store
notifications (convert-notifications-1 notifications.old)
archive (convert-notifications-1 archive.old)
current-timebox current-timebox.old
dnd dnd.old
==
==
==
::
++ uni-by
|= [a=(set index:graph-store) b=(set index:graph-store)]
=/ merged
(~(uni in a) b)
%- ~(gas in *(set index:graph-store))
%+ skip ~(tap in merged)
|=(=index:graph-store &(=((lent index) 3) !=(-:(flop index) 1)))
::
++ convert-unread
|* value=mold
|= [combine=$-([value value] value) unreads=(map index:store value)]
^- (map stats-index:store value)
%+ roll
~(tap in unreads)
|= [[=index:store val=value] out=(map stats-index:store value)]
=/ old=value
(~(gut by unreads) index (combine))
=/ =stats-index:store
(to-stats-index:store index)
(~(put by out) stats-index (combine old val))
::
++ convert-notifications-1
|= old=notifications:state-zero:store
%+ gas:orm:state-two:store *notifications:state-two:store
^- (list [@da timebox:state-two:store])
%+ murn
(tap:orm:state-zero:store old)
|= [time=@da =timebox:state-zero:store]
^- (unit [@da timebox:state-two:store])
=/ new-timebox=timebox:state-two:store
(convert-timebox-1 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-1
|= =timebox:state-zero:store
^- timebox:state-two:store
%- ~(gas by *timebox:state-two:store)
^- (list [index:state-two:store notification:state-two:store])
%+ murn
~(tap by timebox)
|= [=index:state-zero:store =notification:state-zero:store]
^- (unit [index:state-two:store notification:state-two:store])
=/ new-index=(unit index:state-two:store)
(convert-index-1 index)
=/ new-notification=(unit notification:state-two:store)
(convert-notification-1 notification)
?~ new-index ~
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ convert-index-1
|= =index:state-zero:store
^- (unit index:state-two:store)
?+ -.index `index
%chat ~
::
%graph
=, index
`[%graph graph *resource module description ~]
==
::
++ convert-notification-1
|= =notification:state-zero:store
^- (unit notification:state-two:store)
?: ?=(%chat -.contents.notification)
~
`notification
--
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title [src our]:bowl)
|^
?+ path (on-watch:def path)
::
[%updates ~]
:_ this
[%give %fact ~ hark-update+!>(initial-updates)]~
==
::
++ initial-updates
^- update:store
:- %more
^- (list update:store)
:~ give-unreads
[%set-dnd dnd]
give-notifications
==
::
++ give-notifications
^- update:store
[%timebox ~ ~(tap by unread-notes)]
::
++ give-since-unreads
^- (list [stats-index:store stats:store])
%+ turn
~(tap by unreads-count)
|= [=stats-index:store count=@ud]
:* stats-index
[%count count]
(~(gut by last-seen) stats-index *time)
==
::
++ give-each-unreads
^- (list [stats-index:store stats:store])
%+ turn
~(tap by unreads-each)
|= [=stats-index:store indices=(set index:graph-store)]
:* stats-index
[%each indices]
(~(gut by last-seen) stats-index *time)
==
::
++ give-unreads
^- update:store
:- %unreads
;: weld
give-each-unreads
give-since-unreads
==
--
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
::
[%x %recent ?(%archive %inbox) @ @ ~]
=/ is-archive
=(%archive i.t.t.path)
=/ offset=@ud
(slav %ud i.t.t.t.path)
=/ length=@ud
(slav %ud i.t.t.t.t.path)
:^ ~ ~ %hark-update
!> ^- update:store
:- %more
%+ turn
%+ scag length
%+ slag offset
%- tap-nonempty:ha
?:(is-archive archive notifications)
|= [time=@da =timebox:store]
^- update:store
[%timebox `time ~(tap by timebox)]
==
::
++ on-poke
~/ %hark-store-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%hark-action (hark-action !<(action:store vase))
%noun (poke-noun !<(* vase))
==
[cards this]
::
++ poke-noun
|= val=*
?+ val ~|(%bad-noun-poke !!)
%fix-dangling fix-dangling
%print ~&(+.state [~ state])
==
::
++ fix-dangling
=/ graphs get-keys:gra
:_ state
%+ roll
~(tap by unreads-each)
|= $: [=stats-index:store indices=(set index:graph-store)]
out=(list card)
==
?. ?=(%graph -.stats-index) out
?. (~(has in graphs) graph.stats-index)
:_(out (poke-us %remove-graph graph.stats-index))
%+ welp out
%+ turn
%+ skip
~(tap in indices)
|= =index:graph-store
(check-node-existence:gra graph.stats-index index)
|=(=index:graph-store (poke-us %read-each stats-index index))
::
++ poke-us
|= =action:store
^- card
[%pass / %agent [our dap]:bowl %poke hark-action+!>(action)]
::
++ hark-action
|= =action:store
^- (quip card _state)
abet:translate:(abed:poke-engine:ha action)
--
::
++ on-agent on-agent:def
::
++ on-leave on-leave:def
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%autoseen ~] wire)
(on-arvo:def wire sign-arvo)
`this
::
++ on-fail on-fail:def
--
|_ =bowl:gall
+* met ~(. metadata bowl)
++ poke-engine
|_ [in=action:store out=(list update:store) cards=(list card)]
++ poke-core .
::
++ abed
|= =action:store poke-core(in action)
::
++ abet
^- (quip card _state)
:_ state
%+ snoc (flop cards)
[%give %fact ~[/updates] %hark-update !>([%more (flop out)])]
::
++ give
|= =update:store poke-core(out [update out])
::
++ emit
|= =card poke-core(cards [card cards])
::
++ translate
^+ poke-core
?- -.in
::
%add-note (add-note +.in)
%archive (do-archive +.in)
::
%unread-count (unread-count +.in)
%read-count (read-count +.in)
::
%read-each (read-each +.in)
%unread-each (unread-each +.in)
::
%read-note (read-note +.in)
::
%seen-index (seen-index +.in)
%remove-graph (remove-graph +.in)
%set-dnd (set-dnd +.in)
%seen seen
%read-all read-all
::
==
::
:: +| %note
::
:: notification tracking
++ put-notifs
|= [time=@da =timebox:store]
poke-core(notifications (put:orm notifications time timebox))
::
++ add-note
|= [=index:store =notification:store]
^+ poke-core
=/ existing-notif
(~(get by unread-notes) index)
=/ new=notification:store
(merge-notification existing-notif notification)
=. unread-notes
(~(put by unread-notes) index new)
=/ timebox=@da
(~(gut by timeboxes) (to-stats-index:store index) current-timebox)
(give %added index new)
::
++ do-archive
|= [time=(unit @da) =index:store]
^+ poke-core
|^
?~(time archive-unread (archive-read u.time))
::
++ archive-unread
=. unread-notes
(~(del by unread-notes) index)
(give %archive ~ index)
::
++ archive-read
|= time=@da
=/ =timebox:store
(gut-orm notifications time)
=/ =notification:store
(~(got by timebox) index)
=/ new-timebox=timebox:store
(~(del by timebox) index)
=. poke-core
(put-notifs time new-timebox)
(give %archive `time index)
--
::
++ read-note
|= =index:store
=/ =notification:store
(~(got by unread-notes) index)
=. unread-notes
(~(del by unread-notes) index)
=/ =time
(~(gut by timeboxes) (to-stats-index:store index) current-timebox)
=/ =timebox:store
(gut-orm notifications time)
=/ existing-notif
(~(get by timebox) index)
=/ new=notification:store
(merge-notification existing-notif notification)
=. timebox
(~(put by timebox) index new)
=. notifications
(put:orm notifications time timebox)
(give %note-read time index)
::
::
:: +| %each
::
:: each unread tracking
::
++ unread-each
|= [=stats-index:store unread=index:graph-store time=@da]
=. poke-core (seen-index time stats-index)
%+ jub-unreads-each:(give %unread-each stats-index unread time)
stats-index
|= indices=(set index:graph-store)
(~(put ^in indices) unread)
::
++ read-index-each
|= [=stats-index:store ref=index:graph-store]
%- read-indices
%+ skim
~(tap ^in ~(key by unread-notes))
|= =index:store
?. (stats-index-is-index:store stats-index index) %.n
=/ not=notification:store
(~(got by unread-notes) index)
?. ?=(%graph -.index) %.n
?. ?=(%graph -.contents.not) %.n
(lien list.contents.not |=(p=post:post =(index.p ref)))
::
++ read-each
|= [=stats-index:store ref=index:graph-store]
=. timeboxes (~(put by timeboxes) stats-index now.bowl)
=. poke-core (read-index-each stats-index ref)
%+ jub-unreads-each:(give %read-each stats-index ref)
stats-index
|= indices=(set index:graph-store)
(~(del ^in indices) ref)
::
++ jub-unreads-each
|= $: =stats-index:store
f=$-((set index:graph-store) (set index:graph-store))
==
poke-core(unreads-each (jub stats-index f))
::
++ unread-count
|= [=stats-index:store time=@da]
=/ new-count
+((~(gut by unreads-count) stats-index 0))
=. unreads-count
(~(put by unreads-count) stats-index new-count)
(seen-index:(give %unread-count stats-index time) time stats-index)
::
++ read-count
|= =stats-index:store
=. unreads-count (~(put by unreads-count) stats-index 0)
=/ times=(list index:store)
(unread-for-stats-index stats-index)
=? timeboxes !(~(has by timeboxes) stats-index) (~(put by timeboxes) stats-index now.bowl)
(give:(read-indices times) %read-count stats-index)
::
++ read-indices
|= times=(list =index:store)
|-
?~ times poke-core
=/ core
(read-note i.times)
$(poke-core core, times t.times)
::
++ seen-index
|= [time=@da =stats-index:store]
=/ new-time=@da
(max time (~(gut by last-seen) stats-index 0))
=. last-seen
(~(put by last-seen) stats-index new-time)
(give %seen-index new-time stats-index)
::
++ remove-graph
|= rid=resource
|^
=/ indices get-stats-indices
=. poke-core
(give %remove-graph rid)
=. poke-core
(remove-notifications indices)
=. unreads-count
((dif-map-by-key ,@ud) unreads-count indices)
=. unreads-each
%+ (dif-map-by-key ,(set index:graph-store))
unreads-each indices
=. last-seen
((dif-map-by-key ,@da) last-seen indices)
poke-core
::
++ get-stats-indices
%- ~(gas ^in *(set stats-index:store))
%+ skim
;: weld
~(tap ^in ~(key by unreads-count))
~(tap ^in ~(key by last-seen))
~(tap ^in ~(key by unreads-each))
==
|= =stats-index:store
?. ?=(%graph -.stats-index) %.n
=(graph.stats-index rid)
::
++ dif-map-by-key
|* value=mold
|= [=(map stats-index:store value) =(set stats-index:store)]
=/ to-remove ~(tap ^in set)
|-
?~ to-remove map
=. map
(~(del by map) i.to-remove)
$(to-remove t.to-remove)
::
++ remove-notifications
|= =(set stats-index:store)
^+ poke-core
=/ indices
~(tap ^in set)
|-
?~ indices poke-core
=/ times=(list =index:store)
(unread-for-stats-index i.indices)
=. poke-core
(read-indices times)
$(indices t.indices)
--
::
++ seen
=. poke-core
(read-indices ~(tap ^in ~(key by unread-notes)))
poke-core(current-timebox now.bowl, timeboxes ~)
::
++ read-all
=: unreads-count (~(run by unreads-count) _0)
unreads-each (~(run by unreads-each) _~)
notifications (~(run by notifications) _~)
==
(give:seen %read-all ~)
::
++ set-dnd
|= d=?
(give:poke-core(dnd d) %set-dnd d)
--
::
++ unread-for-stats-index
|= =stats-index:store
%+ skim ~(tap in ~(key by unread-notes))
(cury stats-index-is-index:store stats-index)
::
++ merge-notification
|= [existing=(unit notification:store) new=notification:store]
^- notification:store
?~ existing new
?- -.contents.u.existing
::
%graph
?> ?=(%graph -.contents.new)
u.existing(list.contents (weld list.contents.u.existing list.contents.new))
::
%group
?> ?=(%group -.contents.new)
u.existing(list.contents (weld list.contents.u.existing list.contents.new))
==
::
:: +key-orm: +key:by for ordered maps
++ key-orm
|= =notifications:store
^- (list @da)
(turn (tap:orm notifications) |=([@da *] +<-))
:: +jub-orm: combo +jab/+gut for ordered maps
:: TODO: move to zuse.hoon
++ jub-orm
|= [=notifications:store time=@da fun=$-(timebox:store timebox:store)]
^- notifications:store
=/ =timebox:store
(fun (gut-orm notifications time))
(put:orm notifications time timebox)
++ jub
|= [=stats-index:store f=$-((set index:graph-store) (set index:graph-store))]
^- (jug stats-index:store index:graph-store)
=/ val=(set index:graph-store)
(~(gut by unreads-each) stats-index ~)
(~(put by unreads-each) stats-index (f val))
:: +gut-orm: +gut:by for ordered maps
:: TODO: move to zuse.hoon
++ gut-orm
|= [=notifications:store time=@da]
^- timebox:store
(fall (get:orm notifications time) ~)
::
++ autoseen-interval ~h3
++ cancel-autoseen
^- card
[%pass /autoseen %arvo %b %rest (add current-timebox autoseen-interval)]
::
++ autoseen-timer
^- card
[%pass /autoseen %arvo %b %wait (add now.bowl autoseen-interval)]
::
++ scry
|* [=mold p=path]
?> ?=(^ p)
?> ?=(^ t.p)
.^(mold i.p (scot %p our.bowl) i.t.p (scot %da now.bowl) t.t.p)
::
++ give
|= [paths=(list path) update=update:store]
^- (list card)
[%give %fact paths [%hark-update !>(update)]]~
::
++ tap-nonempty
|= =notifications:store
^- (list [@da timebox:store])
%+ skim (tap:orm notifications)
|=([@da =timebox:store] !=(~(wyt by timebox) 0))
--

View File

@ -1,6 +1,8 @@
:: herm: stand-in for term.c with http interface :: herm: stand-in for term.c with http interface
:: ::
/+ default-agent, dbug, verb /+ default-agent, dbug, verb
/$ blit-to-json %blit %json
/$ json-to-blit %json %blit
=, jael =, jael
|% |%
+$ state-0 [%0 ~] +$ state-0 [%0 ~]
@ -11,33 +13,15 @@
%+ verb | %+ verb |
%- agent:dbug %- agent:dbug
^- agent:gall ^- agent:gall
=> |%
++ request-tube
|= [bowl:gall from=mark to=mark next=?]
^- card:agent:gall
:* %pass /tube/[from]/[to]
%arvo %c %warp
our q.byk ~
::
?: next
[%next %c da+now /[from]/[to]]
[%sing %c da+now /[from]/[to]]
==
--
|_ =bowl:gall |_ =bowl:gall
+* this . +* this .
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
:: ::
++ on-init ++ on-init
^- (quip card:agent:gall _this) ^- (quip card:agent:gall _this)
:_ this :: set up dill session subscription
:: set up dill session subscription,
:: and ensure the tubes we use are in cache
:: ::
:~ [%pass [%view %$ ~] %arvo %d %view ~] [[%pass [%view %$ ~] %arvo %d %view ~]~ this]
(request-tube bowl %blit %json |)
(request-tube bowl %json %belt |)
==
:: ::
++ on-save !>([%0 ~]) ++ on-save !>([%0 ~])
++ on-load ++ on-load
@ -61,7 +45,9 @@
++ on-arvo ++ on-arvo
|= [=wire =sign-arvo] |= [=wire =sign-arvo]
^- (quip card:agent:gall _this) ^- (quip card:agent:gall _this)
?+ wire !! ?+ wire (on-arvo:def wire sign-arvo)
[%tube *] [~ this] :: we no longer care about these
::
:: pass on dill blits for the session :: pass on dill blits for the session
:: ::
[%view %$ ~] [%view %$ ~]
@ -72,17 +58,6 @@
%+ turn p.sign-arvo %+ turn p.sign-arvo
|= =blit:dill |= =blit:dill
[%give %fact [%session %$ ~]~ %blit !>(blit)] [%give %fact [%session %$ ~]~ %blit !>(blit)]
::
:: ensure the tubes we need remain in cache
::
[%tube @ @ ~]
=* from i.t.wire
=* to i.t.t.wire
?. ?=([%clay %writ *] sign-arvo)
~| [%unexpected-sign [- +<]:sign-arvo]
!!
:_ this
[(request-tube bowl from to &)]~
== ==
:: ::
++ on-poke ++ on-poke

View File

@ -2,20 +2,27 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln /+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|% |%
+$ state +$ state
$: %13 $~ [%22 *state:drum *state:helm *state:kiln]
drum=state:drum $>(%22 any-state)
helm=state:helm ::
kiln=state:kiln
==
+$ any-state +$ any-state
$% state $% [ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
[ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)] [%7 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%7 drum=state:drum helm=state:helm kiln=state:kiln] [%8 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%8 drum=state:drum helm=state:helm kiln=state:kiln] [%9 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%9 drum=state:drum helm=state:helm kiln=state:kiln] [%10 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%10 drum=state:drum helm=state:helm kiln=state:kiln] [%11 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%11 drum=state:drum helm=state:helm kiln=state:kiln] [%12 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%12 drum=state:drum helm=state:helm kiln=state:kiln] [%13 drum=state-2:drum helm=state:helm kiln=state-1:kiln]
[%14 drum=state-2:drum helm=state:helm kiln=state-1:kiln]
[%15 drum=state-2:drum helm=state:helm kiln=state-2:kiln]
[%16 drum=state-4:drum helm=state:helm kiln=state-3:kiln]
[%17 drum=state-4:drum helm=state:helm kiln=state-4:kiln]
[%18 drum=state-4:drum helm=state:helm kiln=state-5:kiln]
[%19 drum=state-4:drum helm=state:helm kiln=state-6:kiln]
[%20 drum=state-4:drum helm=state:helm kiln=state-7:kiln]
[%21 drum=state-4:drum helm=state:helm kiln=state-8:kiln]
[%22 drum=state-4:drum helm=state:helm kiln=state-9:kiln]
== ==
+$ any-state-tuple +$ any-state-tuple
$: drum=any-state:drum $: drum=any-state:drum
@ -42,7 +49,8 @@
++ on-init ++ on-init
^- step:agent:gall ^- step:agent:gall
=^ d drum.state on-init:drum-core =^ d drum.state on-init:drum-core
[d this] =^ k kiln.state on-init:kiln-core
[:(welp d k) this]
:: ::
++ on-leave on-leave:def ++ on-leave on-leave:def
++ on-peek ++ on-peek
@ -65,9 +73,9 @@
=-(?>(?=(%kiln -<) ->) (~(got by lac.old) %kiln)) =-(?>(?=(%kiln -<) ->) (~(got by lac.old) %kiln))
== ==
== ==
=^ d drum.state (on-load:drum-core -.old drum.tup) =^ d drum.state (on-load:(drum bowl *state:drum) -.old drum.tup)
=^ h helm.state (on-load:helm-core -.old helm.tup) =^ h helm.state (on-load:(helm bowl *state:helm) -.old helm.tup)
=^ k kiln.state (on-load:kiln-core -.old kiln.tup) =^ k kiln.state (on-load:(kiln bowl *state:kiln) -.old kiln.tup)
[:(welp d h k) this] [:(welp d h k) this]
:: ::
++ on-poke ++ on-poke
@ -95,24 +103,23 @@
|= =path |= =path
^- step:agent:gall ^- step:agent:gall
?+ path (on-watch:def +<) ?+ path (on-watch:def +<)
[%drum *] =^(c drum.state (peer:drum-core +<) [c this]) [%drum *] =^(c drum.state (peer:drum-core t.path) [c this])
[%kiln *] =^(c kiln.state (peer:kiln-core t.path) [c this])
== ==
:: ::
++ on-agent ++ on-agent
|= [=wire =sign:agent:gall] |= [=wire syn=sign:agent:gall]
^- step:agent:gall ^- step:agent:gall
?+ wire ~|([%hood-bad-wire wire] !!) ?+ wire ~|([%hood-bad-wire wire] !!)
[%drum *] =^(c drum.state (take-agent:drum-core +<) [c this]) [%drum *] =^(c drum.state (take-agent:drum-core t.wire syn) [c this])
[%helm *] =^(c helm.state (take-agent:helm-core +<) [c this]) [%helm *] =^(c helm.state (take-agent:helm-core t.wire syn) [c this])
[%kiln *] =^(c kiln.state (take-agent:kiln-core +<) [c this]) [%kiln *] =^(c kiln.state (take-agent:kiln-core t.wire syn) [c this])
== ==
:: TODO: symmetry between adding and stripping wire prefixes
:: ::
++ on-arvo ++ on-arvo
|= [=wire syn=sign-arvo] |= [=wire syn=sign-arvo]
^- step:agent:gall ^- step:agent:gall
?+ wire ~|([%hood-bad-wire wire] !!) ?+ wire ~|([%hood-bad-wire wire] !!)
[%drum *] =^(c drum.state (take-arvo:drum-core t.wire syn) [c this])
[%helm *] =^(c helm.state (take-arvo:helm-core t.wire syn) [c this]) [%helm *] =^(c helm.state (take-arvo:helm-core t.wire syn) [c this])
[%kiln *] =^(c kiln.state (take-arvo:kiln-core t.wire syn) [c this]) [%kiln *] =^(c kiln.state (take-arvo:kiln-core t.wire syn) [c this])
== ==

View File

@ -25,8 +25,6 @@
^- (list @tas) ^- (list @tas)
:~ %group-store :~ %group-store
%metadata-store %metadata-store
%contact-store
%contact-hook
%invite-store %invite-store
%graph-store %graph-store
== ==

View File

@ -0,0 +1,594 @@
:: roller-cli: CLI for L2 Azimuth Rollers
::
:: TODO: commands
::
:: client | roller
:: _________|___________
:: - CLI command
:: [%track 0x1234.abcd]
:: - init subscriptions to the roller
:: watch --> /point/[0x1234.abcd] - point updates
:: watch --> /tx/[0x1234.abcd] - tx status updates
::
:: ----------------------
:: Submit Txs
:: poke --tx--> +take-tx
::
:: ---------------------
:: Receive Tx status updates
:: watch /tx/[0x1234.abcd]
::
:: <--(list roller-tx:dice)-- - init
:: <--[address roller-tx:dice]-- - update
:: <--%kick-sub-- ?: ?=(?(%confirmed %failed) tx-status)
:: ---------------------
:: Receive Point updates (i.e. nonces)
:: watch /point/[0x1234.abcd]
::
:: <-(list point:naive)- - init
:: <-[address point:naive]- - update
::
/- *dice
/+ *dice,
naive,
lib=naive-transactions,
*fake-roller,
shoe,
verb,
dbug,
default-agent,
ethereum
|%
+$ app-state
$: %0
:: TODO: keep track of sessions
::
:: sessions=(map sole-id session)
points=(jug address:ethereum [ship point:naive])
history=(jug address:ethereum roller-tx)
unsigned-txs=(jug address:ethereum [keccak tx:naive])
:: TODO: track pub/prv keys
::
:: keys=(list (pair address:ethereum address:ethereum)
==
::
+$ card card:shoe
::
+$ command
$% :: List all possible L2 tx types
::
[%l2-tx ~] :: ?
:: Loads a new address (login?)
:: — should require signing?
:: - it subscribes to the Roller, for updates to it
:: - innitially receives a list of points (if any) it controls
::
:: [%track pubkey=address:ethereum prvkey=address:ethereum]
[%track address:ethereum]
:: Table of all submitted txs, by address
::
[%history address:ethereum]
:: Table of all unsigned txs, by address
::
[%show-unsigned ~]
:: Signs and Submit an unsigned txs (signed)
::
[%submit address:ethereum tx:naive]
:: Cancels a submitted (but pending) txs
::
[%cancel ~]
:: Ships owned by an address
::
[%ships address:ethereum]
:: Point data for a given ship
::
[%point address:ethereum ship]
:: Example flow
::
[%example-flow ~]
==
--
=| app-state
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
%- (agent:shoe command)
^- (shoe:shoe command)
:: => |%
:: ++ get-address-points
:: |= [roller=@p =address:ethereum]
:: :* %pass
:: /roller-points
:: %agent
:: [roller %azimuth]
:: %watch
:: /address/[address]
:: ==
:: --
|_ =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(state !<(app-state old))]
:: |^
:: =+ !<(old-state=app-states old)
:: |-
:: ?- -.old-state
:: %0 $(old-state [%1 ~ ~ ~])
:: %1 $(old-state [%2 ~ ~ ~])
:: %2 [~ this(state old-state)]
:: ==
:: ++ app-states $%([%0 ~] [%1 *] app-state)
:: --
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
~&
=/ addr=@ux
0x6def.fb0c.afdb.11d1.75f1.23f6.891a.a64f.01c2.4f7d
:: %+ turn
~(tap in (~(get ju points) addr))
:: head
[~ this]
++ on-watch on-watch:def
++ on-leave on-leave:def
:: +on-peek: scry paths
::
:: /x/ships/[0x1234.abcd] -> %noun (list ship)
::
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path ~
[%x %ships @ ~] (ships i.t.t.path)
==
::
++ ships
|= wat=@t
:+ ~ ~
:- %noun
!> ^- (list ship)
?~ addr=(slaw %ux wat) ~
%+ turn
~(tap in (~(get ju points) u.addr))
head
--
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ wire (on-agent:def wire sign)
[%points @ ~] (get-points i.t.wire sign)
[%txs @ ~] (get-txs i.t.wire sign)
==
::
++ get-points
|= [wat=@t =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%fact
?+ p.cage.sign (on-agent:def wire sign)
%points
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
=+ !<(points=(list [ship point:naive]) q.cage.sign)
=. points.state
%- ~(gas ju points.state)
(turn points (cork same (lead u.addr)))
[~ this]
::
%point
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
=+ !<(new-point=[=ship =point:naive] q.cage.sign)
:: TODO: handle multiple sole sessions?
::
:: =/ sez=(list [=sole-id =session])
:: ~(tap by sessions)
=/ console=tape
"Point update ({(scow %p ship.new-point)})"
=. points.state
:: FIXME: doesn't properly update point
:: handle proper insert/deletion of points
:: to account for ownership changes/nonce updates
::
=; [is-owner=? old=(unit [=ship =point:naive])]
?~ old points.state
=. points.state
(~(del ju points.state) u.addr u.old)
?. is-owner points.state
(~(put ju points.state) [u.addr new-point])
=/ points=(list [=ship =point:naive])
~(tap in (~(get ju points.state) u.addr))
|- ^- [? (unit [ship point:naive])]
|^
?~ points [| ~]
?. =(ship.i.points ship.new-point)
$(points t.points)
:- is-owner
`[ship.new-point point.i.points]
::
++ is-owner
=* own own.point.new-point
?| =(u.addr address.owner.own)
=(u.addr address.spawn-proxy.own)
=(u.addr address.management-proxy.own)
=(u.addr address.voting-proxy.own)
=(u.addr address.transfer-proxy.own)
==
--
:: %- ~(run in points)
:: |= old=[=ship =point:naive]
:: ?. =(ship.old ship.new)
:: old
:: point.new
:: (~(put ju points.state) [u.addr point])
~& :- %ships
(turn ~(tap in (~(get ju points.state) u.addr)) head)
:_ this
:_ ~
:- %shoe
:- ~
:- %sole
?. =(src our):bowl
[%txt console]
[%klr [[`%br ~ `%g] [(crip console)]~]~]
==
==
::
++ get-txs
|= [wat=@t =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%fact
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
?+ p.cage.sign (on-agent:def wire sign)
%txs
=+ !<(txs=(list roller-tx) q.cage.sign)
=. history.state
%- ~(gas ju history.state)
(turn txs (cork same (lead u.addr)))
[~ this]
::
%tx
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
=+ !<(=roller-tx q.cage.sign)
=/ hash=tape
=+ hash=(scow %ux hash.roller-tx)
=+ len=(lent hash)
;: weld
(swag [0 6] hash)
"..."
(swag [(sub len 4) len] hash)
==
=/ console=tape
"Tx hash: {hash} -> {(trip status.roller-tx)}"
=. history.state (update-tx u.addr roller-tx)
:: ~& console
:_ this
:_ ~
:- %shoe
:- ~
:- %sole
?. =(src our):bowl
[%txt console]
[%klr [[`%br ~ `%g] [(crip console)]~]~]
==
==
::
++ update-tx
|= [=address:ethereum =roller-tx]
%. [address roller-tx]
?+ status.roller-tx ~(put ju history.state)
%pending
~(put ju history.state)
::
%sending
%~ put ju
%- ~(del ju history.state)
[address roller-tx(status %pending)]
::
%confirmed
%~ put ju
%- ~(del ju history.state)
[address roller-tx(status %sending)]
::
%failed
:: TODO: make it not ugly
::
%~ put ju
%- %~ del ju
%- ~(del ju history.state)
[address roller-tx(status %sending)]
[address roller-tx(status %pending)]
==
--
::
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ command-parser
|= sole-id=@ta
^+ |~(nail *(like [? command]))
:: wait for 'enter' to run the command
::
|^
%+ stag |
:: (perk %demo %row %table %track %submit %history ~)
;~ pose
;~(plug (tag %track) ;~(pfix (jest ' 0x') hex))
;~(plug (tag %example-flow) (easy ~))
;~(plug (tag %history) ;~(pfix (jest ' 0x') hex))
;~((glue ace) (tag %submit) submit)
;~((glue ace) (tag %ships) address)
;~((glue ace) (tag %point) address ;~(pfix sig fed:ag))
==
::
++ tag |*(a=@tas (cold a (jest a))) :: TODO (from /app/chat-cli) into stdlib
++ address ;~(pfix (jest '0x') hex)
++ sponsorship
%- perk
:~ %escape
%cancel-escape
%adopt
%reject
%detach
==
::
++ ownership
%- perk
:~ %set-management-proxy
%set-spawn-proxy
%set-transfer-proxy
==
::
++ proxies
(perk %own %spawn %manage %vote %transfer ~)
++ submit
%+ cook ,[address:naive tx:naive]
;~ (glue ace)
address
:: from=[ship proxy:naive]
::
%+ cook ,[ship proxy:naive]
%+ ifix [sel ser]
;~((glue ace) ;~(pfix sig fed:ag) proxies)
:: skim-tx:naive
::
%+ cook ,skim-tx:naive
;~ pose
:: [%transfer-point =address reset=?]
::
;~ (glue ace)
(perk %transfer-point ~)
address
;~(pose (cold & (just 'y')) (cold | (just 'n')))
==
:: [%spawn ship address:naive]
::
;~ (glue ace)
(perk %spawn ~)
;~(pfix sig fed:ag)
address
==
:: [%configure-keys encrypt=@ auth=@ crypto-suite=@ breach=?]
::
;~ (glue ace)
(perk %configure-keys ~)
address
address
dem
;~(pose (cold & (just 'y')) (cold | (just 'n')))
==
:: [?([%escape %cancel-escape %adopt %reject %detach]) ship]
::
;~((glue ace) sponsorship ;~(pfix sig fed:ag))
:: $: ?([%set-management-proxy %set-spawn-proxy %set-transfer-proxy])
:: address
:: ==
::
;~((glue ace) ownership address)
==
==
--
::
++ tab-list
|= sole-id=@ta
^- (list [@t tank])
:~ ['txs' leaf+"list available L2 transaction"]
['submit' leaf+"sends| a L2 transaction to the Roller"]
['cancel' leaf+"cancels a (pending) L2 transaction"]
['history' leaf+"shows all current submitted transactions"]
['track' leaf+"loads an ethereum address and tracks points and L2 txs"]
==
::
++ on-command
|= [sole-id=@ta =command]
^- (quip card _this)
|^
?+ -.command !!
%track (track +.command)
%submit (submit +.command)
%history (history +.command)
%ships (ships +.command)
%point (point +.command)
%example-flow example-flow
==
::
++ example-flow
^- (quip card _this)
=/ address=@t '0x6deffb0cafdb11d175f123f6891aa64f01c24f7d '
=/ spawn=@t '0xf48062ae8bafd6ef19cd6cb89db93a0d0ca6ce26'
=/ track=@t 'track 0x6deffb0cafdb11d175f123f6891aa64f01c24f7d'
=/ ships=@t 'ships 0x6deffb0cafdb11d175f123f6891aa64f01c24f7d'
=/ tx1=@t
%- crip
:~ 'submit '
address
'[~wanzod own] '
'set-spawn-proxy '
address
==
=/ tx2=@t
%- crip
:~ 'submit '
address
'[~wanzod own] '
'spawn '
'~modlep-fosreg '
spawn
==
=/ failed-tx=@t
%- crip
:~ 'submit '
'0x6deffb0cafdb11d175f123f6891aa64f01c24f7d '
'[~wanzod own] '
'spawn '
'~marzod '
'0xf'
==
=/ example-a=@t '- lists ships controlled by the given address :: '
=/ example-b=@t '- receives updates signed by the given address :: '
=/ example-c=@t '- this tx will fail :: '
:_ this
:_ ~
^- card
:- %shoe
^- [(list _sole-id) shoe-effect:shoe]
:- [sole-id]~
^- shoe-effect:shoe
:- %sole
?. =(src our):bowl
[%txt "1234"]
:- %mor
:~ [%klr ~[[[~ ~ `%g] [example-a]~] [``~ [ships]~]]]
[%klr ~[[[~ ~ `%b] [example-b]~] [``~ [track]~]]]
[%klr ~[[[~ ~ `%r] [example-c]~] [``~ [failed-tx]~]]]
==
::
++ submit
|= [=address:ethereum =tx:naive]
^- (quip card _this)
=/ owner=(unit [=nonce:naive =point:naive])
=/ points=(list [=ship =point:naive])
~(tap in (~(get ju points) address))
|- ^- (unit [nonce:naive point:naive])
?~ points ~
?. =(ship.from.tx ship.i.points)
$(points t.points)
`(get-owner point.i.points proxy.from.tx)
:: =< `[nonce point.i.points]
:: (proxy-from-point:naive proxy.from.tx point.i.points)
?~ owner ~& "empty points" [~ this]
=/ =keccak
%- hash-tx:lib
(unsigned-tx:lib 1.337 nonce.u.owner (gen-tx-octs:lib tx))
=/ sig=octs (fake-sig tx address nonce.u.owner)
=. points
%+ ~(put ju points) address
[ship.from.tx point.u.owner]
:_ this
:_ ~
:* %pass
/pokepath
%agent
[our.bowl %roller]
%poke
roller-action+!>([%submit | address q.sig %don tx])
==
::
++ track
|= =address:ethereum
^- (quip card _this)
=/ [to=(list _sole-id) fec=shoe-effect:shoe]
:- [sole-id]~
:- %sole
=/ =tape "Listening to updates for {(scow %ux address)}"
?. =(src our):bowl
[%txt tape]
[%klr [[`%br ~ `%g] [(crip tape)]~]~]
:: :_ this(keys (snoc keys address))
:_ this
:~ [%shoe to fec]
:^ %pass /points/[(scot %ux address)] %agent
[[our.bowl %roller] %watch /points/[(scot %ux address)]]
::
:^ %pass /txs/[(scot %ux address)] %agent
[[our.bowl %roller] %watch /txs/[(scot %ux address)]]
==
::
++ history
|= =address:ethereum
^- (quip card _this)
:_ this
=; [to=(list _sole-id) fec=shoe-effect:shoe]
[%shoe to fec]~
:- [sole-id]~
:^ %table
:: ~[t+'address' t+'signing ship' t+'type' t+'status' t+'hash']
~[t+'signing ship' t+'type' t+'status' t+'hash' t+'time']
~[14 20 9 13 26]
%+ turn
%+ sort ~(tap in (~(get ju history.state) address))
|=([a=roller-tx b=roller-tx] (lth time.a time.b))
|= roller-tx
|^ ~[p+ship t+type t+status pack-hash t+(scot %da time)]
::
++ pack-address
=+ addr=(scow %ux address)
=+ len=(lent addr)
:- %t
%- crip
;: weld
(swag [0 6] addr)
"..."
(swag [(sub len 4) len] addr)
==
::
++ pack-hash
=+ hash=(scow %ux hash)
=+ len=(lent hash)
:- %t
%- crip
;: weld
(swag [0 6] hash)
"..."
(swag [(sub len 4) len] hash)
==
--
::
++ ships
|= =address:ethereum
^- (quip card _this)
~& ships+(turn ~(tap in (~(get ju points) address)) head)
[~ this]
::
++ point
|= [=address:ethereum =ship]
^- (quip card _this)
=/ points=(set [@p point:naive])
(~(get ju points.state) address)
~& %+ skim ~(tap in points)
|=([s=@p =point:naive] =(s ship))
[~ this]
--
::
++ can-connect
|= sole-id=@ta
^- ?
?| =(~zod src.bowl)
(team:title [our src]:bowl)
==
::
++ on-connect on-connect:des
++ on-disconnect on-disconnect:des
--

View File

@ -0,0 +1,355 @@
:: Roller JSON-RPC API
::
/- rpc=json-rpc, *dice
/+ naive,
azimuth-roll-rpc,
json-rpc,
*server,
default-agent,
verb,
dbug,
agentio
|%
::
+$ card card:agent:gall
::
+$ state-0 [%0 ~]
--
::
%+ verb |
%- agent:dbug
::
=| state-0
=* state -
::
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
~& > 'init'
:_ this
[%pass /bind %arvo %e %connect [~ /v1/roller] dap.bowl]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([id=@ta req=inbound-request:eyre] vase)
:_ this
(handle-http-request id req)
::
%azimuth-action
=+ !<([%disconnect bind=binding:eyre] vase)
~& >>> "disconnecting at {<bind>}"
:_ this
[%pass /bind %arvo %e %disconnect bind]~
==
::
++ handle-http-request
|= [id=@ta =inbound-request:eyre]
^- (list card)
|^
=* req request.inbound-request
=* headers header-list.req
=/ req-line (parse-request-line url.req)
?. =(method.req %'POST')
:: TODO: method not supported
::
(give-simple-payload:app id not-found:gen)
?~ rpc-request=(validate-request:json-rpc body.req)
:: TODO: malformed request
::
(give-simple-payload:app id not-found:gen)
=/ [data=(list cage) response=simple-payload:http]
(process-rpc-request:do u.rpc-request)
%+ weld
(give-simple-payload:app id response)
|-
?~ data ~
:_ $(data t.data)
^- card
[%pass / %agent [our.bowl %roller] %poke i.data]
--
--
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?+ path (on-watch:def path)
[%http-response *] [~ this]
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%eyre %bound *]
~? !accepted.sign-arvo
[dap.bowl 'bind rejected!' binding.sign-arvo]
[~ this]
==
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ process-rpc-request
|= req=batch-request:rpc
^- [(list cage) simple-payload:http]
|^
?- -.req
%o
=/ [data=(unit cage) =response:rpc]
(process p.req)
[(drop data) (render response)]
::
%a
=| data=(list cage)
=| resp=(list response:rpc)
|-
?~ p.req
[(flop data) (render %batch (flop resp))]
=/ [dat=(unit cage) res=response:rpc]
(process i.p.req)
=? data ?=(^ dat) [u.dat data]
$(p.req t.p.req, resp [res resp])
==
::
++ render
|= res=response:rpc
%- json-response:gen
(response-to-json:json-rpc res)
::
++ process
|= request:rpc
?. ready:scry
:: TODO: move to lib
::
`[%error id '-32003' 'Roller is not ready']
=, azimuth-roll-rpc
?. ?=([%map *] params)
[~ ~(parse error:json-rpc id)]
=/ method=@tas (enkebab method)
?: ?=(l2-tx method)
(process-rpc id +.params method over-quota:scry)
?+ method [~ ~(method error:json-rpc id)]
%get-point `(get-point id +.params point:scry)
%get-ships `(get-ships id +.params ships:scry)
%cancel-transaction (cancel-tx id +.params)
%get-spawned `(get-spawned id +.params spawned:scry)
%get-unspawned `(get-spawned id +.params unspawned:scry)
%get-owned-points `(get-ships id +.params owned:scry)
%get-transferring-for `(get-ships id +.params transfers:scry)
%get-manager-for `(get-ships id +.params manager:scry)
%get-voting-for `(get-ships id +.params voting:scry)
%get-spawning-for `(get-ships id +.params spawning:scry)
%get-all-pending `(all:pending id +.params all:pending:scry)
%get-pending-by-ship `(ship:pending id +.params ship:pending:scry)
%get-pending-by-address `(addr:pending id +.params addr:pending:scry)
%get-pending-tx `(hash:pending id +.params hash:pending:scry)
%get-transaction-status `(status id +.params tx-status:scry)
%when-next-batch `(next-batch id +.params next-batch:scry)
%get-nonce `(nonce id +.params nonce:scry)
%get-history `(history id +.params addr:history:scry)
%get-roller-config `(get-config id +.params config:scry)
%prepare-for-signing `(hash-transaction id +.params chain:scry | &)
%get-unsigned-tx `(hash-transaction id +.params chain:scry & |)
%get-predicted-state `(get-naive id +.params predicted:scry)
%hash-raw-transaction `(hash-raw-transaction id +.params)
:: TODO: deprecated, remove
::
%hash-transaction `(hash-transaction id +.params chain:scry & |)
==
--
::
++ scry
|%
++ point
|= =ship
.^ (unit point:naive)
%gx
(~(scry agentio bowl) %roller /point/(scot %p ship)/noun)
==
::
++ ships
|= =address:naive
.^ (list ship)
%gx
(~(scry agentio bowl) %roller /ships/(scot %ux address)/noun)
==
::
++ spawned
|= =ship
.^ (list @p)
%gx
(~(scry agentio bowl) %roller /spawned/(scot %p ship)/noun)
==
::
++ unspawned
|= =ship
.^ (list @p)
%gx
(~(scry agentio bowl) %roller /unspawned/(scot %p ship)/noun)
==
::
++ owned
|= =address:naive
.^ (list ship)
%gx
(~(scry agentio bowl) %roller /owned/(scot %ux address)/noun)
==
::
++ transfers
|= =address:naive
.^ (list ship)
%gx
(~(scry agentio bowl) %roller /transfers/(scot %ux address)/noun)
==
::
++ manager
|= =address:naive
.^ (list ship)
%gx
(~(scry agentio bowl) %roller /manager/(scot %ux address)/noun)
==
::
++ voting
|= =address:naive
.^ (list ship)
%gx
(~(scry agentio bowl) %roller /voting/(scot %ux address)/noun)
==
::
++ spawning
|= =address:naive
.^ (list ship)
%gx
(~(scry agentio bowl) %roller /spawning/(scot %ux address)/noun)
==
::
++ pending
|%
++ all
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %roller /pending/noun)
==
::
++ ship
|= =^ship
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %roller /pending/(scot %p ship)/noun)
==
::
++ addr
|= =address:naive
.^ (list pend-tx)
%gx
%+ ~(scry agentio bowl) %roller
/pending/[(scot %ux address)]/noun
==
::
++ hash
|= keccak=@ux
.^ (unit pend-tx)
%gx
%+ ~(scry agentio bowl) %roller
/pending-tx/[(scot %ux keccak)]/noun
==
--
::
++ history
|%
++ addr
|= =address:naive
.^ (list hist-tx)
%gx
(~(scry agentio bowl) %roller /history/(scot %ux address)/noun)
==
--
::
++ tx-status
|= keccak=@ux
.^ ^tx-status
%gx
(~(scry agentio bowl) %roller /tx/(scot %ux keccak)/status/noun)
==
::
++ next-batch
.^ time
%gx
(~(scry agentio bowl) %roller /next-batch/noun)
==
::
++ nonce
|= [=ship =proxy:naive]
.^ (unit @)
%gx
%+ ~(scry agentio bowl)
%roller
/nonce/(scot %p ship)/[proxy]/noun
==
::
++ config
^- [azimuth-config roller-config]
:- refresh
.^ roller-config
%gx
%+ ~(scry agentio bowl)
%roller
/config/noun
==
::
++ chain
.^ @
%gx
%+ ~(scry agentio bowl)
%roller
/chain-id/noun
==
::
++ predicted
.^ ^state:naive
%gx
(~(scry agentio bowl) %roller /predicted/noun)
==
::
++ refresh
.^ @dr
%gx
(~(scry agentio bowl) %azimuth /refresh/noun)
==
::
++ over-quota
|= =ship
.^ ?
%gx
(~(scry agentio bowl) %roller /over-quota/(scot %p ship)/atom)
==
::
++ ready
.^ ?
%gx
(~(scry agentio bowl) %roller /ready/atom)
==
--
--

1280
pkg/arvo/app/roller.hoon Normal file

File diff suppressed because it is too large Load Diff

View File

@ -1,186 +0,0 @@
/- *settings
/+ verb, dbug, default-agent, agentio
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
==
+$ state-0 [%0 settings=settings-0]
+$ state-1 [%1 =settings]
--
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ bol=bowl:gall
+* this .
do ~(. +> bol)
def ~(. (default-agent this %|) bol)
io ~(. agentio bol)
::
++ on-init
^- (quip card _this)
=^ cards state
(put-entry:do %tutorial %seen b+|)
[cards this]
::
++ on-save !>(state)
::
++ on-load
|= =old=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
|-
?- -.old
%0 $(old [%1 +.old])
%1 [~ this(state old)]
==
::
++ on-poke
|= [mar=mark vas=vase]
^- (quip card _this)
?> (team:title our.bol src.bol)
?. ?=(%settings-event mar)
(on-poke:def mar vas)
=/ evt=event !<(event vas)
=^ cards state
?- -.evt
%put-bucket (put-bucket:do key.evt bucket.evt)
%del-bucket (del-bucket:do key.evt)
%put-entry (put-entry:do buc.evt key.evt val.evt)
%del-entry (del-entry:do buc.evt key.evt)
==
[cards this]
::
++ on-watch
|= pax=path
^- (quip card _this)
?> (team:title our.bol src.bol)
?+ pax (on-watch:def pax)
[%all ~]
[~ this]
::
[%bucket @ ~]
=* bucket-key i.t.pax
?> (~(has by settings) bucket-key)
[~ this]
::
[%entry @ @ ~]
=* bucket-key i.t.pax
=* entry-key i.t.t.pax
=/ bucket (~(got by settings) bucket-key)
?> (~(has by bucket) entry-key)
[~ this]
==
::
++ on-peek
|= pax=path
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %all ~]
``settings-data+!>(all+settings)
::
[%x %bucket @ ~]
=* buc i.t.t.pax
=/ bucket=(unit bucket) (~(get by settings) buc)
?~ bucket [~ ~]
``settings-data+!>(bucket+u.bucket)
::
[%x %entry @ @ ~]
=* buc i.t.t.pax
=* key i.t.t.t.pax
=/ =bucket (fall (~(get by settings) buc) ~)
=/ entry=(unit val) (~(get by bucket) key)
?~ entry [~ ~]
``settings-data+!>(entry+u.entry)
::
[%x %has-bucket @ ~]
=* buc i.t.t.pax
=/ has-bucket=? (~(has by settings) buc)
``noun+!>(has-bucket)
::
[%x %has-entry @ @ ~]
=* buc i.t.t.pax
=* key i.t.t.t.pax
=/ =bucket (fall (~(get by settings) buc) ~)
=/ has-entry=? (~(has by bucket) key)
``noun+!>(has-entry)
==
::
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
::
:: +put-bucket: put a bucket in the top level settings map, overwriting if it
:: already exists
::
++ put-bucket
|= [=key =bucket]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[key]
==
:- [(give-event pas %put-bucket key bucket)]~
state(settings (~(put by settings) key bucket))
::
:: +del-bucket: delete a bucket from the top level settings map
::
++ del-bucket
|= =key
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[key]
==
:- [(give-event pas %del-bucket key)]~
state(settings (~(del by settings) key))
::
:: +put-entry: put an entry in a bucket, overwriting if it already exists
:: if bucket does not yet exist, create it
::
++ put-entry
|= [buc=key =key =val]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[buc]
/entry/[buc]/[key]
==
=/ =bucket (fall (~(get by settings) buc) ~)
=. bucket (~(put by bucket) key val)
:- [(give-event pas %put-entry buc key val)]~
state(settings (~(put by settings) buc bucket))
::
:: +del-entry: delete an entry from a bucket, fail quietly if bucket does not
:: exist
::
++ del-entry
|= [buc=key =key]
^- (quip card _state)
=/ pas=(list path)
:~ /all
/bucket/[buc]
/entry/[buc]/[key]
==
=/ bucket=(unit bucket) (~(get by settings) buc)
?~ bucket
[~ state]
=. u.bucket (~(del by u.bucket) key)
:- [(give-event pas %del-entry buc key)]~
state(settings (~(put by settings) buc u.bucket))
::
++ give-event
|= [pas=(list path) evt=event]
^- card
[%give %fact pas %settings-event !>(evt)]
--

View File

@ -1,6 +1,7 @@
/- spider /- spider
/+ libstrand=strand, default-agent, verb, server /+ libstrand=strand, default-agent, verb, server, dbug
=, strand=strand:libstrand =, strand=strand:libstrand
~% %spider-top ..part ~
|% |%
+$ card card:agent:gall +$ card card:agent:gall
+$ thread thread:spider +$ thread thread:spider
@ -17,17 +18,35 @@
$: starting=(map yarn [=trying =vase]) $: starting=(map yarn [=trying =vase])
running=trie running=trie
tid=(map tid yarn) tid=(map tid yarn)
serving=(map tid [@ta =mark]) serving=(map tid [(unit @ta) =mark =desk])
== ==
:: ::
+$ clean-slate-any +$ clean-slate-any
$^ clean-slate-ket $^ clean-slate-ket
$% clean-slate-sig $% clean-slate-sig
clean-slate-1 clean-slate-1
clean-slate-2
clean-slate-3
clean-slate clean-slate
== ==
:: ::
+$ clean-slate +$ clean-slate
$: %4
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
==
::
+$ clean-slate-3
$: %3
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [@ta =mark =desk])
==
::
+$ clean-slate-2
$: %2 $: %2
starting=(map yarn [=trying =vase]) starting=(map yarn [=trying =vase])
running=(list yarn) running=(list yarn)
@ -55,11 +74,12 @@
== ==
:: ::
+$ start-args +$ start-args
[parent=(unit tid) use=(unit tid) file=term =vase] [parent=(unit tid) use=(unit tid) =beak file=term =vase]
-- --
:: ::
:: Trie operations :: Trie operations
:: ::
~% %spider ..card ~
|% |%
++ get-yarn ++ get-yarn
|= [=trie =yarn] |= [=trie =yarn]
@ -133,17 +153,20 @@
(welp next-1 next-2) (welp next-1 next-2)
-- --
:: ::
%- agent:dbug
^- agent:gall ^- agent:gall
=| =state =| =state
=< =<
%+ verb | %+ verb |
~% %spider-agent ..bind-eyre ~
|_ =bowl:gall |_ =bowl:gall
+* this . +* this .
spider-core +> spider-core +>
sc ~(. spider-core bowl) sc ~(. spider-core bowl)
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
bec byk.bowl(r da+now.bowl)
:: ::
++ on-init ++ on-init
^- (quip card _this) ^- (quip card _this)
:_ this :_ this
~[bind-eyre:sc] ~[bind-eyre:sc]
@ -154,9 +177,11 @@
=+ !<(any=clean-slate-any old-state) =+ !<(any=clean-slate-any old-state)
=? any ?=(^ -.any) (old-to-1 any) =? any ?=(^ -.any) (old-to-1 any)
=? any ?=(~ -.any) (old-to-1 any) =? any ?=(~ -.any) (old-to-1 any)
=^ upgrade-cards any =^ upgrade-cards any
(old-to-2 any) (old-to-2 any)
?> ?=(%2 -.any) =. any (old-to-3 any)
=. any (old-to-4 any)
?> ?=(%4 -.any)
:: ::
=. tid.state tid.any =. tid.state tid.any
=/ yarns=(list yarn) =/ yarns=(list yarn)
@ -178,9 +203,9 @@
:: ::
++ old-to-2 ++ old-to-2
|= old=clean-slate-any |= old=clean-slate-any
^- (quip card clean-slate) ^- (quip card clean-slate-any)
?> ?=(?(%1 %2) -.old) ?> ?=(?(%1 %2 %3 %4) -.old)
?: ?=(%2 -.old) ?: ?=(?(%2 %3 %4) -.old)
`old `old
:- ~[bind-eyre:sc] :- ~[bind-eyre:sc]
:* %2 :* %2
@ -189,9 +214,35 @@
tid.old tid.old
~ ~
== ==
::
++ old-to-3
|= old=clean-slate-any
^- clean-slate-any
?> ?=(?(%2 %3 %4) -.old)
?: ?=(?(%3 %4) -.old)
old
:* %3
starting.old
running.old
tid.old
(~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl]))
==
++ old-to-4
|= old=clean-slate-any
^- clean-slate
?> ?=(?(%3 %4) -.old)
?: ?=(%4 -.old)
old
:* %4
starting.old
running.old
tid.old
(~(run by serving.old) |=([id=@ta =mark =desk] [`id mark q.byk.bowl]))
==
-- --
:: ::
++ on-poke ++ on-poke
~/ %on-poke
|= [=mark =vase] |= [=mark =vase]
^- (quip card _this) ^- (quip card _this)
?: ?=(%spider-kill mark) ?: ?=(%spider-kill mark)
@ -202,12 +253,13 @@
%spider-start (handle-start-thread:sc !<(start-args vase)) %spider-start (handle-start-thread:sc !<(start-args vase))
%spider-stop (handle-stop-thread:sc !<([tid ?] vase)) %spider-stop (handle-stop-thread:sc !<([tid ?] vase))
:: ::
%handle-http-request %handle-http-request
(handle-http-request:sc !<([@ta =inbound-request:eyre] vase)) (handle-http-request:sc !<([@ta =inbound-request:eyre] vase))
== ==
[cards this] [cards this]
:: ::
++ on-watch ++ on-watch
~/ %on-watch
|= =path |= =path
^- (quip card _this) ^- (quip card _this)
=^ cards state =^ cards state
@ -220,6 +272,7 @@
:: ::
++ on-leave on-leave:def ++ on-leave on-leave:def
++ on-peek ++ on-peek
~/ %on-peek
|= =path |= =path
^- (unit (unit cage)) ^- (unit (unit cage))
?+ path (on-peek:def path) ?+ path (on-peek:def path)
@ -234,6 +287,7 @@
== ==
:: ::
++ on-agent ++ on-agent
~/ %on-agent
|= [=wire =sign:agent:gall] |= [=wire =sign:agent:gall]
^- (quip card _this) ^- (quip card _this)
=^ cards state =^ cards state
@ -243,6 +297,7 @@
[cards this] [cards this]
:: ::
++ on-arvo ++ on-arvo
~/ %on-arvo
|= [=wire =sign-arvo] |= [=wire =sign-arvo]
^- (quip card _this) ^- (quip card _this)
=^ cards state =^ cards state
@ -261,8 +316,9 @@
(on-load on-save) (on-load on-save)
-- --
:: ::
~% %spider-helper ..get-yarn ~
|_ =bowl:gall |_ =bowl:gall
:: ++ bec `beak`byk.bowl(r da+now.bowl)
++ bind-eyre ++ bind-eyre
^- card ^- card
[%pass /bind %arvo %e %connect [~ /spider] %spider] [%pass /bind %arvo %e %connect [~ /spider] %spider]
@ -272,33 +328,29 @@
:((cury cat 3) file '--' (scot %uv (sham eny.bowl))) :((cury cat 3) file '--' (scot %uv (sham eny.bowl)))
:: ::
++ handle-http-request ++ handle-http-request
~/ %handle-http-request
|= [eyre-id=@ta =inbound-request:eyre] |= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state) ^- (quip card _state)
?> authenticated.inbound-request ::?> authenticated.inbound-request
=/ url =/ url
(parse-request-line:server url.request.inbound-request) (parse-request-line:server url.request.inbound-request)
?> ?=([%spider @t @t @t ~] site.url) ?> ?=([%spider @t @t @t @t ~] site.url)
=* input-mark i.t.site.url =* desk i.t.site.url
=* thread i.t.t.site.url =* input-mark i.t.t.site.url
=* output-mark i.t.t.t.site.url =* thread i.t.t.t.site.url
=* output-mark i.t.t.t.t.site.url
=/ =tid (new-thread-id thread) =/ =tid (new-thread-id thread)
=. serving.state =. serving.state
(~(put by serving.state) tid [eyre-id output-mark]) (~(put by serving.state) tid [`eyre-id output-mark desk])
=+ .^ :: TODO: speed this up somehow. we spend about 15ms in this arm alone
=tube:clay ::
%cc =/ tube (convert-tube %json input-mark desk bowl)
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/json/[input-mark]
==
?> ?=(^ body.request.inbound-request) ?> ?=(^ body.request.inbound-request)
=/ body=json =/ body=json (need (de-json:html q.u.body.request.inbound-request))
(need (de-json:html q.u.body.request.inbound-request)) =/ input=vase (slop !>(~) (tube !>(body)))
=/ input=vase =/ boc bec
(slop !>(~) (tube !>(body))) =/ =start-args [~ `tid boc(q desk, r da+now.bowl) thread input]
=/ =start-args (handle-start-thread start-args)
[~ `tid thread input]
=^ cards state
(handle-start-thread start-args)
[cards state]
:: ::
++ on-poke-input ++ on-poke-input
|= input |= input
@ -315,6 +367,7 @@
`state `state
:: ::
++ handle-sign ++ handle-sign
~/ %handle-sign
|= [=tid =wire =sign-arvo] |= [=tid =wire =sign-arvo]
=/ yarn (~(get by tid.state) tid) =/ yarn (~(get by tid.state) tid)
?~ yarn ?~ yarn
@ -331,7 +384,8 @@
(take-input u.yarn ~ %agent wire sign) (take-input u.yarn ~ %agent wire sign)
:: ::
++ handle-start-thread ++ handle-start-thread
|= [parent-tid=(unit tid) use=(unit tid) file=term =vase] ~/ %handle-start-thread
|= [parent-tid=(unit tid) use=(unit tid) =beak file=term =vase]
^- (quip card ^state) ^- (quip card ^state)
=/ parent-yarn=yarn =/ parent-yarn=yarn
?~ parent-tid ?~ parent-tid
@ -347,18 +401,22 @@
~| [%already-starting yarn] ~| [%already-starting yarn]
!! !!
:: ::
=? serving.state !(~(has by serving.state) new-tid)
(~(put by serving.state) new-tid [~ %noun q.beak])
::
=: starting.state (~(put by starting.state) yarn [%build vase]) =: starting.state (~(put by starting.state) yarn [%build vase])
tid.state (~(put by tid.state) new-tid yarn) tid.state (~(put by tid.state) new-tid yarn)
== ==
=/ pax=path =/ pax=path
~| no-file-for-thread+file ~| no-file-for-thread+file
(need (get-fit:clay [our q.byk da+now]:bowl %ted file)) (need (get-fit:clay beak %ted file))
=/ =card :_ state
:+ %pass /build/[new-tid] :_ ~
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax] :+ %pass /build/[new-tid]
[[card ~] state] [%arvo %c %warp p.beak q.beak ~ %sing %a r.beak pax]
:: ::
++ handle-build ++ handle-build
~/ %handle-build
|= [=tid =sign-arvo] |= [=tid =sign-arvo]
^- (quip card ^state) ^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid) =/ =yarn (~(got by tid.state) tid)
@ -377,6 +435,7 @@
(start-thread yarn p.maybe-thread) (start-thread yarn p.maybe-thread)
:: ::
++ start-thread ++ start-thread
~/ %start-thread
|= [=yarn =thread] |= [=yarn =thread]
^- (quip card ^state) ^- (quip card ^state)
=/ =vase vase:(~(got by starting.state) yarn) =/ =vase vase:(~(got by starting.state) yarn)
@ -411,11 +470,12 @@
(thread-fail u.yarn %cancelled ~) (thread-fail u.yarn %cancelled ~)
:: ::
++ take-input ++ take-input
~/ %take-input
|= [=yarn input=(unit input:strand)] |= [=yarn input=(unit input:strand)]
^- (quip card ^state) ^- (quip card ^state)
=/ m (strand ,vase) =/ m (strand ,vase)
?. (has-yarn running.state yarn) ?. (has-yarn running.state yarn)
%- (slog leaf+"spider got input for non-existent {<yarn>} 2" ~) %- (slog leaf+"spider got input for non-existent {<yarn>}" ~)
`state `state
=/ =eval-form:eval:m =/ =eval-form:eval:m
thread-form:(need (get-yarn running.state yarn)) thread-form:(need (get-yarn running.state yarn))
@ -461,7 +521,7 @@
=/ moz (thread-say-fail tid term tang) =/ moz (thread-say-fail tid term tang)
?. ?=([~ %build *] (~(get by starting.state) yarn)) ?. ?=([~ %build *] (~(get by starting.state) yarn))
moz moz
:_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %home ~]) :_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %base ~])
:: ::
++ thread-say-fail ++ thread-say-fail
|= [=tid =term =tang] |= [=tid =term =tang]
@ -473,11 +533,13 @@
|= [=tid =term =tang] |= [=tid =term =tang]
^- (quip card ^state) ^- (quip card ^state)
=- (fall - `state) =- (fall - `state)
%+ bind %+ bind
(~(get by serving.state) tid) (~(get by serving.state) tid)
|= [eyre-id=@ta output=mark] |= [eyre-id=(unit @ta) output=mark =desk]
:_ state(serving (~(del by serving.state) tid)) :_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server eyre-id ?~ eyre-id
~
%+ give-simple-payload:app:server u.eyre-id
^- simple-payload:http ^- simple-payload:http
:_ ~ :_ ~ :_ ~ :_ ~
?. ?=(http-error:spider term) ?. ?=(http-error:spider term)
@ -503,16 +565,14 @@
|= [=tid =vase] |= [=tid =vase]
^- (quip card ^state) ^- (quip card ^state)
=- (fall - `state) =- (fall - `state)
%+ bind %+ bind
(~(get by serving.state) tid) (~(get by serving.state) tid)
|= [eyre-id=@ta output=mark] |= [eyre-id=(unit @ta) output=mark =desk]
=+ .^ ?~ eyre-id
=tube:clay `state
%cc =/ tube (convert-tube output %json desk bowl)
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[output]/json
==
:_ state(serving (~(del by serving.state) tid)) :_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server eyre-id %+ give-simple-payload:app:server u.eyre-id
(json-response:gen:server !<(json (tube vase))) (json-response:gen:server !<(json (tube vase)))
:: ::
++ thread-done ++ thread-done
@ -543,6 +603,7 @@
=/ =tid (yarn-to-tid yarn) =/ =tid (yarn-to-tid yarn)
=: running.state (del-yarn running.state yarn) =: running.state (del-yarn running.state yarn)
tid.state (~(del by tid.state) tid) tid.state (~(del by tid.state) tid)
serving.state (~(del by serving.state) (yarn-to-tid yarn))
== ==
:_ state :_ state
%+ murn ~(tap by wex.bowl) %+ murn ~(tap by wex.bowl)
@ -559,14 +620,14 @@
|= [=yarn =bowl:gall] |= [=yarn =bowl:gall]
^- bowl:spider ^- bowl:spider
:* our.bowl :* our.bowl
src.bowl src.bowl
(yarn-to-tid yarn) (yarn-to-tid yarn)
(yarn-to-parent yarn) (yarn-to-parent yarn)
wex.bowl wex.bowl
sup.bowl sup.bowl
eny.bowl eny.bowl
now.bowl now.bowl
byk.bowl (yarn-to-byk yarn bowl)
== ==
:: ::
++ yarn-to-tid ++ yarn-to-tid
@ -585,7 +646,25 @@
~ ~
`i.t.nary `i.t.nary
:: ::
++ yarn-to-byk
|= [=yarn =bowl:gall]
=/ [* * =desk]
~| "no desk associated with {<tid>}"
%- ~(got by serving.state) (yarn-to-tid yarn)
=/ boc bec
boc(q desk)
::
++ clean-state ++ clean-state
!> ^- clean-slate !> ^- clean-slate
2+state(running (turn (tap-yarn running.state) head)) 4+state(running (turn (tap-yarn running.state) head))
::
++ convert-tube
|= [from=mark to=mark =desk =bowl:gall]
.^
tube:clay
%cc
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to]
==
-- --

11
pkg/arvo/desk.bill Normal file
View File

@ -0,0 +1,11 @@
:~ %acme
%azimuth
%dbug
%dojo
%eth-watcher
%hood
%herm
%lens
%ping
%spider
==

11
pkg/arvo/gen/agents.hoon Normal file
View File

@ -0,0 +1,11 @@
/- hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
:- %tang
%+ turn (get-apps-have:hood p.bec desk now)
|= [=dude:gall live=?]
^- tank
=/ liv ?:(live "running " "archived")
[%leaf "status: {liv} {<dude>}"]

View File

@ -5,10 +5,10 @@
:- %aqua-events :- %aqua-events
%+ turn %+ turn
^- (list unix-event) ^- (list unix-event)
:~ [//term/1 %belt %ctl `@c`%e] :~ [/d/term/1 %belt %ctl `@c`%e]
[//term/1 %belt %ctl `@c`%u] [/d/term/1 %belt %ctl `@c`%u]
[//term/1 %belt %txt ((list @c) command)] [/d/term/1 %belt %txt ((list @c) command)]
[//term/1 %belt %ret ~] [/d/term/1 %belt %ret ~]
== ==
|= ue=unix-event |= ue=unix-event
[%event her ue] [%event her ue]

View File

@ -7,5 +7,5 @@
:+ %event her :+ %event her
?> ?=([@ @ @ *] pax) ?> ?=([@ @ @ *] pax)
=/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] =/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))]
:- //sync/0v1n.2m9vh :- /c/sync/0v1n.2m9vh
[%into `desk`i.t.pax | `mode:clay`[t.t.t.pax `file]~] [%into `desk`i.t.pax | `mode:clay`[t.t.t.pax `file]~]

View File

@ -1,6 +1,8 @@
:: Start an aqua ship
::
/- aquarium /- aquarium
=, aquarium =, aquarium
:- %say :- %say
|= [* [her=ship ~] ~] |= [* [her=ship fake=? ~] ~]
:- %aqua-events :- %aqua-events
[%init-ship her `*dawn-event:jael]~ [%init-ship her fake]~

View File

@ -1,4 +1,4 @@
:: Change node url for azimuth :: Change node url and network for azimuth
:- %say :- %say
|= [* [url=@ta ~] ~] |= [* [url=@ta net=?(%mainnet %ropsten %local) ~] ~]
[%azimuth-poke %watch url] [%azimuth-poke %watch url net]

View File

@ -9,17 +9,43 @@
!: !:
:- %say :- %say
|= $: [now=@da eny=@uvJ bec=beak] |= $: [now=@da eny=@uvJ bec=beak]
arg=$@(~ [top=path ~]) ::
:: arg: desks to build pill from
::
:: list of desks. defaults to [%base]~.
:: the first desk in this list will become the pill's base desk.
:: optionally, the first desk may be replaced with a fully
:: qualified path to the new boot system (typically in sys).
:: the rest of the desks will be installed through kiln.
::
$= arg
$@ ~
$: base=$@(desk [@ta @ta @ta path])
rest=(list desk)
==
::
~ ~
== ==
:- %noun :- %boot-pill
^- pill:pill ^- pill:pill
::
:: sys: root path to boot system, `/~me/[desk]/now/sys` :: sys: root path to boot system, `/~me/[desk]/now/sys`
:: bas: root path to boot system' desk
:: dez: secondary desks and their root paths
:: ::
=/ sys=path =/ sys=path
?^ arg top.arg ?: ?=([^ *] arg)
/(scot %p p.bec)/[q.bec]/(scot %da now)/sys `path`base.arg
=/ =desk
?~ arg %base
?>(?=(@ base.arg) base.arg)
/(scot %p p.bec)/[desk]/(scot %da now)/sys
=/ bas=path
(scag 3 sys)
=/ dez=(list [desk path])
?~ arg ~
%+ turn rest.arg
|= =desk
[desk /(scot %p p.bec)/[desk]/(scot %da now)]
:: ::
:: compiler-source: hoon source file producing compiler, `sys/hoon` :: compiler-source: hoon source file producing compiler, `sys/hoon`
:: ::
@ -52,10 +78,11 @@
== ==
:: a pill is a 3-tuple of event-lists: [boot kernel userspace] :: a pill is a 3-tuple of event-lists: [boot kernel userspace]
:: ::
=/ bas=path (flop (tail (flop sys)))
:+ %pill %brass :+ %pill %brass
:+ boot-ova :+ boot-ova
:~ (boot-ovum:pill compiler-source arvo-source) :~ (boot-ovum:pill compiler-source arvo-source)
(file-ovum2:pill bas) (file-ovum2:pill bas)
== ==
[(file-ovum:pill bas) ~] %+ turn
(snoc dez [%base bas])
file-ovum:pill

View File

@ -0,0 +1,10 @@
:: +desk-jam: jam ankh from desk
::
/+ jammer=desk-jam
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[=desk ~]
~
==
:- %jam
(jam-desk:jammer p.bec desk now)

View File

@ -0,0 +1,7 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
~
force=_|
except=(set desk)
==
[%kiln-bump except force]

View File

@ -0,0 +1,30 @@
/- ms=metadata-store
/+ crunch
:- %say
|= [[now=@da * bec=beak] [csv-path=path from=@da ~] [to=@da groups=(list path) content=(unit ?) ~]]
=/ our=@p p.bec
:: check given path has `csv` mark
::
?> =(%csv (snag (dec (lent csv-path)) csv-path))
:: get all graph associations ship is a part of
::
=/ associations=associations:ms
(~(scry-graph-associations crunch [our now]))
:: filter by input groups, if any (default: all from scry)
::
=/ filtered-associations=associations:ms
?~ groups
associations
%+ filter-associations-by-group-resources.crunch
associations
(paths-to-resources.crunch groups)
:: walk graphs to extract content
::
=/ file-content=wain
%: ~(walk-graph-associations crunch [our now])
filtered-associations
?~ content %.n u.content
from
?: =(*@da to) now to
==
[%helm-pass (note-write-csv-to-clay.crunch csv-path file-content)]

View File

@ -0,0 +1,20 @@
:: Kiln: Fuse local desk from (optionally-)foreign sources
::
:::: /hoon/fuse/hood/gen
::
/+ *hood-kiln
/* help-text %txt /gen/hood/fuse/help/txt
=, clay
::
::::
::
=>
|%
+$ fuse-list-arg $@(~ [des=desk ~])
--
:- %say
|= [* [arg=fuse-list-arg] ~]
:- %kiln-fuse-list
?~ arg
~
`des.arg

View File

@ -2,14 +2,59 @@
:: ::
:::: /hoon/fuse/hood/gen :::: /hoon/fuse/hood/gen
:: ::
/+ *hood-kiln
/* help-text %txt /gen/hood/fuse/help/txt /* help-text %txt /gen/hood/fuse/help/txt
=, clay =, clay
:: ::
:::: ::::
:: ::
=>
|%
+$ fuse-arg
$: des=desk
:: specified as [germ path] instead of [path germ] so
:: users can write mate//=home= instead of [/=home= %mate]
::
res=[?([%cancel ~] [bas=path con=(list [germ path])])]
==
::
++ parse-fuse-source
|= bec=beak
^- fuse-source
:: This is a slight overload of the label, but
:: it provides a nicer interface for the user so
:: we'll go with it.
::
?: ?=([%tas *] r.bec)
?: =(p.r.bec %track)
[p.bec q.bec %trak]
bec
bec
::
++ de-beak
|= pax=path
^- beak
=/ bem=beam (need (de-beam pax))
?> =(s.bem /)
-.bem
::
++ path-to-fuse-source
|= pax=path
^- fuse-source
(parse-fuse-source (de-beak pax))
--
:- %say :- %say
|= [[now=@da eny=@uvJ bec=beak] [arg=[?(~ [des=desk bas=beak con=(list [beak germ]) ~])]] ~] |= [* [arg=[?(~ fuse-arg)]] [overwrite=$~(| flag) ~]]
:- %kiln-fuse :- %kiln-fuse
?~ arg ?~ arg
((slog (turn `wain`help-text |=(=@t leaf+(trip t)))) ~) ((slog (turn `wain`help-text |=(=@t leaf+(trip t)))) ~)
[des bas con]:arg :- des.arg
?: ?=([%cancel ~] res.arg)
~
:+ overwrite
(path-to-fuse-source bas.res.arg)
%+ turn
con.res.arg
|= [g=germ pax=path]
^- [fuse-source germ]
[(path-to-fuse-source pax) g]

View File

@ -1,8 +1,21 @@
Usage: Usage:
|fuse %destination-desk base-beak ~[[source-beak %some-germ] [another-beak %another-germ]] |fuse %dest /=kids= mate//~nel/home= meet//~zod/kids/track
|fuse %old-desk /=kids= only-that//~nus/test=, =overwrite &
|fuse %desk-to-cancel-fuse-into %cancel
A fuse replaces the contents of %destination-desk with the merge of the A %fuse request in clay replaces the contents of %destination-desk
specified beaks according to their merge strategies. This has no dependence with the merge of the specified beaks according to their merge
on the previous state of %destination-desk so any commits/work there will strategies. This has no dependence on the previous state of %dest
be overwritten. so any commits/work there will be overwritten.
|fuse extends this concept with the idea of a tracked source. When
specifying beaks to include in your fuse, specify %track instead of
a case. This will tell |fuse to retrieve the latest version of the
source beak AND to rerun the %fuse request whenever that tracked
source changes. A fuse can have many tracked sources, or none. The
base may be tracked as well.
The overwrite flag allows you to overwrite a currently ongoing fuse.
Without this flag, attempting a fuse into a desk that you already
|fuse'd into will error.

View File

@ -0,0 +1,14 @@
:: |install: install the .rem desk from .her into local .lac desk
::
:: > |install ~zod %landscape
:: installs ~zod's %landscape desk into our %landscape desk.
::
:: > |install ~zod %landscape, =local %portrait
:: installs ~zod's %landscape desk into our %portrait desk.
::
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[her=@p rem=desk ~] local=@tas]
==
=/ loc=desk ?:(=(%$ local) rem local)
[%kiln-install loc her rem]

View File

@ -7,11 +7,21 @@
:::: ::::
:: ::
:- %say :- %say
=> |%
+$ bath
$@ desk
(lest knot)
--
|= $: [now=@da eny=@uvJ bec=beak] |= $: [now=@da eny=@uvJ bec=beak]
[[pax=path pot=$@(~ [v=@tas ~])] ~] [=bath pot=$@(~ [v=@tas ~])]
~
== ==
?~ pot =/ bem=beam
=+ bem=(need (de-beam pax)) ?@ bath [bec(q bath) /]
$(pot ~[?^(s.bem (rear s.bem) q.bem)]) (need (de-beam `path`bath))
:- %kiln-mount ::
[pax v.pot] =/ =desk
?^ pot v.pot
?^(s.bem (rear s.bem) q.bem)
::
[%kiln-mount (en-beam bem) desk]

View File

@ -0,0 +1,34 @@
:: |nuke: wipe agent state & subscriptions after confirmation
::
/+ *generators
:- %ask
|= $: [now=@da eny=@uvJ bec=beak]
[=term ~]
[desk=_| hard=_|]
==
?: hard (produce %kiln-nuke term desk)
=/ m1
'nuking agents will permanently delete all their state and subscriptions.'
=/ m2
'if other agents depend on the one(s) you nuke, \
/their behavior could be negatively impacted. \
/if you do not understand the risks, you may \
/want to contact the agent\'s developers.'
=/ m3
%+ rap 3
:~ 'are you sure you want to continue and nuke '
::
?. desk (cat 3 '%' term)
(cat 3 'all agents in ' term)
::
'?'
==
::NOTE yes, printing order is weird
%+ print m3
%+ print m2
%+ print m1
%+ prompt [%& %prompt "nuke? (y/N) "]
|= in=tape
?. |(=("y" in) =("Y" in) =("yes" in))
no-product
(produce %kiln-nuke term desk)

View File

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

View File

@ -0,0 +1,5 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
[%kiln-pause desk]

View File

@ -0,0 +1,16 @@
/- hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
$: =desk
arg=(list [? dude:gall])
==
liv=_&
==
:- %kiln-rein
:- desk
%+ roll arg
=| =rein:hood
|: [*[on=? =dude:gall] rein(liv liv)]
?: on
rein(add (~(put in add.rein) dude))
rein(sub (~(put in sub.rein) dude))

View File

@ -0,0 +1,5 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
[%kiln-resume desk]

View File

@ -0,0 +1,5 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
[%kiln-revive desk]

View File

@ -0,0 +1,5 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
[%kiln-suspend desk]

View File

@ -0,0 +1,5 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
[%kiln-uninstall desk]

View File

@ -2,6 +2,7 @@
:- %say :- %say
|= $: [now=@da eny=@uvJ bec=beak] |= $: [now=@da eny=@uvJ bec=beak]
~ ~
~ nice=?
== ==
[%kick %kick] [%kick nice]

View File

@ -0,0 +1,5 @@
:: Submits a new L2 batch with all pending transactions
::
:- %say
|= *
[%roller-action %commit ~]

View File

@ -0,0 +1,7 @@
:: Updates a configuration option for /app/roller
::
/- *dice
::
:- %say
|= [* [=config ~] ~]
[%roller-action %config config]

View File

@ -0,0 +1,4 @@
::
:- %say
|= [* [url=@t net=?(%mainnet %ropsten %local) ~] ~]
[%roller-action %config %endpoint url net]

View File

@ -0,0 +1,4 @@
::
:- %say
|= [* [freq=@dr ~] ~]
[%roller-action %config %frequency freq]

View File

@ -0,0 +1,5 @@
:: Configures /app/roller to listen to a local Ethereum node
::
:- %say
|= *
[%roller-action %config %endpoint 'http://0.0.0.0:8545' %local]

View File

@ -0,0 +1,4 @@
::
:- %say
|= [* [net=?(%mainnet %ropsten %local) ~] ~]
[%roller-action %config %network net]

View File

@ -0,0 +1,5 @@
:: Modifies the number of txs a ship is allowed to send, per unit of time (slice)
::
:- %say
|= [* [quota=@ud ~] ~]
[%roller-action %config %quota quota]

View File

@ -0,0 +1,10 @@
:: Configures /app/roller to listen to a Ropsten Infura node
::
:- %say
|= *
:* %roller-action
%config
%endpoint
'https://ropsten.infura.io/v3/2599df54929b47099bda360958d75aaf'
%ropsten
==

View File

@ -0,0 +1,5 @@
:: Loads a private key into the roller and retrieves its L1 nonce
::
:- %say
|= [* [pk=@t ~] ~]
[%roller-action %config %setkey pk]

View File

@ -0,0 +1,5 @@
:: Modifies the unit of time (e.g. ~d1) for each ship's quota
::
:- %say
|= [* [slice=@dr ~] ~]
[%roller-action %config %slice slice]

View File

@ -0,0 +1,15 @@
/- *bill
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[=desk ~]
~
==
:- %tang
%- flop ^- tang
=/ pax=path /(scot %p p.bec)/[desk]/(scot %da now)
=+ .^([lal=@tas num=@ud] cx+(weld pax /sys/kelvin))
:~ 'sys.kelvin:'
leaf/"[%{<lal>} %{<num>}]"
'desk.bill:'
(sell !>(.^(bill cx+(weld pax /desk/bill))))
==

View File

@ -12,16 +12,43 @@
!: !:
:- %say :- %say
|= $: [now=@da eny=@uvJ bec=beak] |= $: [now=@da eny=@uvJ bec=beak]
arg=$@(~ [top=path ~]) ::
:: arg: desks to build pill from
::
:: list of desks. defaults to [%base]~.
:: the first desk in this list will become the pill's base desk.
:: optionally, the first desk may be replaced with a fully
:: qualified path to the new boot system (typically in sys).
:: the rest of the desks will be installed through kiln.
::
$= arg
$@ ~
$: base=$@(desk [@ta @ta @ta path])
rest=(list desk)
==
::
dub=_| dub=_|
== ==
:- %pill :- %boot-pill
^- pill:pill ^- pill:pill
:: sys: root path to boot system, `/~me/[desk]/now/sys` :: sys: root path to boot system, `/~me/[desk]/now/sys`
:: bas: root path to boot system' desk
:: dez: secondary desks and their root paths
:: ::
=/ sys=path =/ sys=path
?^ arg top.arg ?: ?=([^ *] arg)
/(scot %p p.bec)/[q.bec]/(scot %da now)/sys `path`base.arg
=/ =desk
?~ arg %base
?>(?=(@ base.arg) base.arg)
/(scot %p p.bec)/[desk]/(scot %da now)/sys
=/ bas=path
(scag 3 sys)
=/ dez=(list [desk path])
?~ arg ~
%+ turn rest.arg
|= =desk
[desk /(scot %p p.bec)/[desk]/(scot %da now)]
:: ::
=/ compiler-path (weld sys /hoon) =/ compiler-path (weld sys /hoon)
=/ arvo-path (weld sys /arvo) =/ arvo-path (weld sys /arvo)
@ -65,9 +92,10 @@
=< q =< q
%^ spin %^ spin
^- (list ovum) ^- (list ovum)
:~ (boot-ovum:pill compiler-src arvo-src) :- (boot-ovum:pill compiler-src arvo-src)
(file-ovum2:pill (flop (tail (flop sys)))) %+ turn
== (snoc (turn dez tail) bas)
file-ovum2:pill
.*(0 arvo-formula) .*(0 arvo-formula)
|= [ovo=ovum ken=*] |= [ovo=ovum ken=*]
[~ (slum ken [now ovo])] [~ (slum ken [now ovo])]
@ -99,5 +127,6 @@
:: ::
:+ %pill %solid :+ %pill %solid
:+ boot-ova ~ :+ boot-ova ~
=/ bas (flop (tail (flop sys))) %+ turn
[(file-ovum:pill bas) ~] (snoc dez [%base bas])
file-ovum:pill

View File

@ -1,4 +1,7 @@
:: Start a thread :: Start a thread
:- %say :- %say
|= [* [name=term vase=$@(~ [vase ~])] ~] |= $: [now=@da eny=@uvJ bec=beak]
[%spider-start ~ ~ name ?~(vase *^vase -.vase)] [name=term vase=$@(~ [vase ~])]
~
==
[%spider-start ~ ~ bec name ?~(vase *^vase -.vase)]

View File

@ -1,76 +0,0 @@
:: Print useful diagnostic information
::
:: base-hash: loosely, the most recent successfully applied update.
:: Technically, the mergebase of %home with OTA source
:: sour-hash: most recently downloaded update (not necessarily applied)
:: home-hash: hash of %home desk, which may differ if you have changed
:: it, for example with notebooks or 3rd party apps
:: kids-hash: hash of the %kids desk, which is what you serve to your
:: children
:: glob-hash: hash of the glob, which is the js for landscape
::
/- glob
/+ version
:- %say
|= [[now=time * bec=beak] ~ ~]
=* our p.bec
=/ sponsor (sein:title our now our)
:- %noun
=<
:~
[%base-hash (base-hash:version our now)]
[%sour-hash sour-hash]
[%home-hash .^(@uv %cz (pathify ~.home ~))]
[%kids-hash .^(@uv %cz (pathify ~.kids ~))]
[%glob-hash glob-state]
::
(info %our our)
(info %sponsor sponsor)
(info %dopzod ~dopzod)
::
["Compare lifes and rifts to values here:"]
["https://etherscan.io/address/azimuth.eth#readContract"]
[" life - getKeyRevisionNumber"]
[" rift - getContinuityNumber"]
==
|%
++ pathify
|= [a=@ta b=(unit ship)]
^- path
=/ o=@ta (scot %p our)
=/ n=@ta (scot %da now)
?~ b ~[o a n]
~[o a n (scot %p u.b)]
::
++ info
|= [=term =ship]
:: unitized life and rift
=/ lyfe .^((unit @ud) %j (pathify ~.lyfe `ship))
=/ ryft .^((unit @ud) %j (pathify ~.ryft `ship))
:* term
ship=ship
point=(crip (slag 2 (scow %ui ship)))
:: report as units
life=lyfe
rift=ryft
==
::
++ sour-hash
=+ .^ ota=(unit [=ship =desk =aeon:clay])
%gx /(scot %p our)/hood/(scot %da now)/kiln/ota/noun
==
?~ ota
*@uv
=/ parent (scot %p ship.u.ota)
=+ .^(=cass:clay %cs /[parent]/[desk.u.ota]/1/late/foo)
.^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass))
::
++ glob-state
^- (list [path @uv @tas])
=+ !< [@ud =globs:glob]
.^(vase %gx (weld (pathify ~.glob ~) /dbug/state/noun))
%+ turn ~(tap by globs)
|= [srv=path hash=@uv glob=(unit [? *])]
^- [path @uv @tas]
[srv hash ?~(glob %waiting ?:(-.u.glob %done %trying))]
--

1
pkg/arvo/gen/trouble.hoon Symbolic link
View File

@ -0,0 +1 @@
vats.hoon

6
pkg/arvo/gen/vats.hoon Normal file
View File

@ -0,0 +1,6 @@
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=~ ~]
==
[%tang (report-vats p.bec now)]

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