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

Merge branch 'hm/btc-wallet-conflict-resolution' into ea/master-dist-deconflict

Browse Source
This commit is contained in:
Hunter Miller 2021-09-27 18:55:45 -05:00
commit 502f2e8a9c
1179 changed files with 104582 additions and 44213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -2,3 +2,8 @@ bin/* filter=lfs diff=lfs merge=lfs -text
bin/*/* filter=lfs diff=lfs merge=lfs -text
pkg/arvo/**/*.css binary
**/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

2
.gitignore vendored
View File

@ -78,3 +78,5 @@ pkg/interface/link-webext/web-ext-artifacts
# Logs
*.log
.vercel

11
.vercel/README.txt Normal file
View File

@ -0,0 +1,11 @@
> Why do I have a folder named ".vercel" in my project?
The ".vercel" folder is created when you link a directory to a Vercel project.
> What does the "project.json" file contain?
The "project.json" file contains:
- The ID of the Vercel project that you linked ("projectId")
- The ID of the user or team your Vercel project is owned by ("orgId")
> Should I commit the ".vercel" folder?
No, you should not share the ".vercel" folder with anyone.
Upon creation, it will be automatically added to your ".gitignore" file.

1
.vercel/project.json Normal file
View File

@ -0,0 +1 @@
{"orgId":"EDiU8DZExvM9N4unZGYQbG3d","projectId":"prj_fbAU5smemBgtr5t8lsk5ZoT9zNtI"}

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

3
bin/multi.pill Normal file
View File

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

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:12ba08bb71205669907a99e722e1339b3777c2c189f49764b8bbfbeabc38f3d6
size 16596163
oid sha256:c3a4d638b543c48558d25346f0912d60b2bc7ef2eb7463bf0c5d90f74f54989e
size 13246961

3
default.nix
View File

@ -1,3 +1,4 @@
/* Examples
Shared urbit and urbit-worker binaries:
@ -113,6 +114,8 @@ let
solid = callPackage ./nix/pkgs/pill/solid.nix { };
marsSources = callPackage ./nix/pkgs/marsSources { };
urbit = callPackage ./nix/pkgs/urbit { inherit enableStatic; };
docker-image = callPackage ./nix/pkgs/docker-image { };

3
lerna.json
View File

@ -2,7 +2,8 @@
"packages": [
"pkg/npm/*",
"pkg/btc-wallet",
"pkg/interface"
"pkg/interface",
"pkg/grid"
],
"version": "independent"
}

37
nix/pkgs/arvo/default.nix
View File

@ -1,46 +1,21 @@
{ lib, stdenvNoCC, bc }:
{ lib, stdenvNoCC, marsSources }:
stdenvNoCC.mkDerivation {
name = "arvo";
src = lib.cleanSource ../../../pkg/arvo;
buildInputs = [ bc ];
src = marsSources;
outputs = [ "out" "ropsten" ];
phases = [ "mainnetPhase" "ropstenPhase" ];
mainnetPhase = ''
cp -r $src/ $out
chmod -R u+w $out
'';
ln -s ${marsSources.out}/arvo $out
'';
ropstenPhase = ''
cp -r $src tmp
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
'';
ln -s ${marsSources.ropsten}/arvo $ropsten
'';
preferLocalBuild = true;
}

46
nix/pkgs/marsSources/default.nix Normal file
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;
}

8852
package-lock.json generated
View File

File diff suppressed because it is too large Load Diff

5
package.json
View File

@ -5,7 +5,8 @@
"eslint": "^7.29.0",
"husky": "^6.0.0",
"lerna": "^4.0.0",
"lint-staged": "^11.0.0"
"lint-staged": "^11.1.2",
"prettier": "^2.3.2"
},
"scripts": {
"watch-libs": "lerna run watch --no-private --parallel",
@ -16,6 +17,6 @@
"build:prod": "lerna run build:prod"
},
"lint-staged": {
"*.{js,ts,tsx}": "eslint --cache --fix"
"*.{js,ts,tsx}": "eslint --cache --fix --quiet"
}
}

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

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

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

@ -132,6 +132,12 @@
=? site ?=([%'~debug' *] site) t.site
?~ ext
$(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
::
?. ?=([~ %json] ext)
@ -418,13 +424,16 @@
++ apps
|%
++ all
^- (list term)
%+ murn
(scry (list path) %ct %home /app)
|= =path
^- (unit term)
?. ?=([%app @ %hoon ~] path) ~
`i.t.path
^- (list dude:gall)
%- zing
^- (list (list dude:gall))
%+ turn
~(tap in (scry (set desk) %cd %$ /))
|= =desk
^- (list dude:gall)
=- (turn ~(tap in -) head)
;; (set [dude:gall ?]) ::TODO for some reason we need this?
(scry (set [dude:gall ?]) %ge desk /)
::
++ running
|= app=term

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

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

0
pkg/arvo/app/landscape/js/channel.js → pkg/arvo/app/debug/js/channel.js
View File

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

@ -12,7 +12,7 @@
=> |% :: external structures
+$ id @tasession :: session id
+$ house :: all state
$: %6
$: %7
egg=@u :: command count
hoc=(map id session) :: conversations
acl=(set ship) :: remote access whitelist
@ -66,7 +66,7 @@
$% [%ur p=@t] :: http GET request
[%ge p=dojo-model] :: generator
[%te p=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
[%sa p=mark] :: example mark value
[%as p=mark q=dojo-source] :: simple transmute
@ -79,7 +79,7 @@
== ::
+$ dojo-server :: numbered device
$: p=@ud :: assembly index
q=path :: gate path
q=[=desk =path] :: gate location
== ::
+$ dojo-config :: configuration
$: p=(list dojo-source) :: by order
@ -125,7 +125,14 @@
++ to-command
|= [gol=goal mod=dojo-model]
^- 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
|* [sym=rule src=rule]
@ -263,7 +270,14 @@
auri:de-purl:html
::
++ 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-hoon tall:hoon-parser
::
++ parse-rood
@ -334,11 +348,11 @@
:: +dy-sing: make a clay read request
::
++ dy-sing
|= [way=wire =care:clay =path]
|= [way=wire =care:clay =beak =path]
^+ +>+>
?> ?=(~ pux)
%- 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]
::
++ dy-request
@ -427,7 +441,13 @@
++ dy-init-server :: ++dojo-server
|= srv=dojo-server
=. 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
|= cig=dojo-config
@ -512,7 +532,7 @@
$?(%eny %now %our) !!
%lib .(lib ~)
%sur .(sur ~)
%dir .(dir [[our.hid %home ud+0] /])
%dir .(dir [[our.hid %base ud+0] /])
==
=+ cay=(~(got by rez) p.q.mad)
?- -.p.mad
@ -538,8 +558,8 @@
::
%dir =+ ^= pax ^- path
=+ pax=((dy-cast path !>(*path)) q.cay)
?: ?=(~ pax) ~[(scot %p our.hid) %home '0']
?: ?=([@ ~] pax) ~[i.pax %home '0']
?: ?=(~ pax) ~[(scot %p our.hid) %base '0']
?: ?=([@ ~] pax) ~[i.pax %base '0']
?: ?=([@ @ ~] pax) ~[i.pax i.t.pax '0']
pax
=. dir (need (de-beam pax))
@ -674,8 +694,8 @@
[%as mark dy-shown]
[%do hoon dy-shown]
[%te term (list dy-shown)]
[%ge path (list dy-shown) (map term (unit dy-shown))]
[%dv path]
[%ge [desk path] (list dy-shown) (map term (unit dy-shown))]
[%dv beak path]
==
==
::
@ -860,7 +880,8 @@
[%pass /wool %agent [our.hid %spider] %watch /thread-result/[tid]]
%- he-card
=/ =cage :: also sub
[%spider-start !>([~ `tid fil (dy-some src)])]
:: TODO: support threads on other desks
[%spider-start !>([~ `tid he-beak fil (dy-some src)])]
[%pass /wool %agent [our.hid %spider] %poke cage]
::
++ dy-make :: build step
@ -871,7 +892,7 @@
%ur (dy-request /hand `request:http`[%'GET' p.bil ~ ~])
%te (dy-wool-poke p.bil q.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)
%sa
=+ .^(=dais:clay cb+(en-beam he-beak /[p.bil]))
@ -879,6 +900,9 @@
::
%as
=/ 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]))
(dy-hand p.bil (tube q.cag))
::
@ -1015,13 +1039,13 @@
::
++ he-prow :: where we are
^- 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
?: &(=(our.hid p.dir) =([%ud 0] r.dir))
(weld "/" (trip q.dir))
;: weld
"/" ?:(=(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))
==
?:(=(~ s.dir) "" (spud s.dir))
@ -1039,6 +1063,7 @@
?+ way !!
[%hand *]
?~ riot
~> %slog.0^leaf/"dojo: %writ fail {<way>}"
(he-diff(poy ~) %tan >%generator-build-fail< >(snoc t.way %hoon)< ~)
(~(dy-hand dy u.poy(pux ~)) noun+!<(vase q.r.u.riot))
==
@ -1140,7 +1165,7 @@
:+ %clhp
[%rock %tas %cx]
%+ 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))]
%api !!
@ -1171,7 +1196,7 @@
%hoon
:* %do
%+ 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)
==
::
@ -1351,7 +1376,7 @@
++ complete-naked-poke
|= app=term
=/ 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)
%+ murn ~(tap by dir:.^(arch %cy pax))
|= [=term ~]
@ -1381,7 +1406,7 @@
(cat 3 '|' gen)
:((cury cat 3) ':' app '|' gen)
=/ 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
%+ murn
@ -1397,7 +1422,7 @@
|= gen=term
%+ complete (cat 3 '+' gen)
=/ 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 ~
%+ murn
~(tap by dir:.^(arch %cy pax))
@ -1493,12 +1518,52 @@
!>(state)
::
++ on-load
|= old=vase
?: ?=(%6 +<.old)
`..on-init(state !<(house old))
=/ old-5 !<([%5 egg=@u hoc=(map id session)] old)
=/ =house [%6 egg.old-5 hoc.old-5 *(set ship)]
`..on-init(state house)
|= ole=vase
|^ =+ old=!<(house-any ole)
=? old ?=(%5 -.old)
(house-5-to-6 old)
=? old ?=(%6 -.old)
(house-6-to-7 old)
?> ?=(%7 -.old)
`..on-init(state old)
::
+$ house-any $%(house house-6 house-5)
::
+$ house-6 :: all state
$: %6
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-to-7
|= old=house-6
[%7 egg.old (~(run by hoc.old) session-6-to-7) acl.old]
++ session-6-to-7
|= 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
|= [=mark =vase]
@ -1555,7 +1620,7 @@
=? hoc (~(has by hoc) id)
~& [%dojo-peer-replaced id]
(~(del by hoc) id)
=/ =session %*(. *session -.dir [our.hid %home ud+0])
=/ =session %*(. *session -.dir [our.hid %base ud+0])
=^ moves state
he-abet:~(he-prom he hid id ~ session)
[moves ..on-init]

6
pkg/arvo/app/eth-sender.hoon
View File

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

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

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

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

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

46
pkg/arvo/app/goad.hoon
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
--

745
pkg/arvo/app/hark-store.hoon
View File

@ -1,745 +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)
%read-graph (read-graph +.in)
%read-group (read-group +.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)
::
++ get-stats-indices
|= rid=resource
%- ~(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)
::
++ read-all-each
|= =stats-index:store
=/ refs=(list index:graph-store)
~(tap ^in (~(get ju unreads-each) stats-index))
|-
?~ refs poke-core
$(refs t.refs, poke-core (read-each stats-index i.refs))
::
++ read-graph
|= rid=resource
=/ indices=(list stats-index:store)
~(tap ^in (get-stats-indices rid))
|-
?~ indices poke-core
=* index i.indices
=? poke-core (~(has by unreads-count) index)
(read-count i.indices)
=? poke-core (~(has by unreads-each) index)
(read-all-each i.indices)
$(indices t.indices)
::
++ read-group
|= rid=resource
=/ graphs=(list resource)
(graphs-of-group:met rid)
|-
?~ graphs poke-core
=/ core=_poke-core (read-graph i.graphs)
$(graphs t.graphs, poke-core core)
::
++ remove-graph
|= rid=resource
|^
=/ indices (get-stats-indices rid)
=. 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
::
++ 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))
--

37
pkg/arvo/app/herm.hoon
View File

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

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

@ -2,22 +2,25 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$: %15
drum=state:drum
helm=state:helm
kiln=state:kiln
==
$~ [%20 *state:drum *state:helm *state:kiln]
$>(%20 any-state)
::
+$ any-state
$% state
[ver=?(%1 %2 %3 %4 %5 %6) lac=(map @tas fin-any-state)]
[%7 drum=state:drum helm=state:helm kiln=state-1:kiln]
[%8 drum=state:drum helm=state:helm kiln=state-1:kiln]
[%9 drum=state:drum helm=state:helm kiln=state-1:kiln]
[%10 drum=state:drum helm=state:helm kiln=state-1:kiln]
[%11 drum=state:drum helm=state:helm kiln=state-1:kiln]
[%12 drum=state:drum helm=state:helm kiln=state-1:kiln]
[%13 drum=state:drum helm=state:helm kiln=state-1:kiln]
[%14 drum=state:drum helm=state:helm kiln=state:kiln]
$% [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]
[%8 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%9 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%10 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%11 drum=state-2:drum helm=state:helm kiln=state-0:kiln]
[%12 drum=state-2:drum helm=state:helm kiln=state-0: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]
==
+$ any-state-tuple
$: drum=any-state:drum
@ -44,7 +47,8 @@
++ on-init
^- step:agent:gall
=^ 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-peek
@ -67,9 +71,9 @@
=-(?>(?=(%kiln -<) ->) (~(got by lac.old) %kiln))
==
==
=^ d drum.state (on-load:drum-core -.old drum.tup)
=^ h helm.state (on-load:helm-core -.old helm.tup)
=^ k kiln.state (on-load:kiln-core -.old kiln.tup)
=^ d drum.state (on-load:(drum bowl *state:drum) -.old drum.tup)
=^ h helm.state (on-load:(helm bowl *state:helm) -.old helm.tup)
=^ k kiln.state (on-load:(kiln bowl *state:kiln) -.old kiln.tup)
[:(welp d h k) this]
::
++ on-poke
@ -97,24 +101,23 @@
|= =path
^- step:agent:gall
?+ 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
|= [=wire =sign:agent:gall]
|= [=wire syn=sign:agent:gall]
^- step:agent:gall
?+ wire ~|([%hood-bad-wire wire] !!)
[%drum *] =^(c drum.state (take-agent:drum-core +<) [c this])
[%helm *] =^(c helm.state (take-agent:helm-core +<) [c this])
[%kiln *] =^(c kiln.state (take-agent:kiln-core +<) [c this])
[%drum *] =^(c drum.state (take-agent:drum-core t.wire syn) [c this])
[%helm *] =^(c helm.state (take-agent:helm-core t.wire syn) [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
|= [=wire syn=sign-arvo]
^- step:agent:gall
?+ 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])
[%kiln *] =^(c kiln.state (take-arvo:kiln-core t.wire syn) [c this])
==

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

@ -18,17 +18,26 @@
$: starting=(map yarn [=trying =vase])
running=trie
tid=(map tid yarn)
serving=(map tid [@ta =mark])
serving=(map tid [@ta =mark =desk])
==
::
+$ clean-slate-any
$^ clean-slate-ket
$% clean-slate-sig
clean-slate-1
clean-slate-2
clean-slate
==
::
+$ clean-slate
$: %3
starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
serving=(map tid [@ta =mark =desk])
==
::
+$ clean-slate-2
$: %2
starting=(map yarn [=trying =vase])
running=(list yarn)
@ -56,7 +65,7 @@
==
::
+$ start-args
[parent=(unit tid) use=(unit tid) file=term =vase]
[parent=(unit tid) use=(unit tid) =beak file=term =vase]
--
::
:: Trie operations
@ -145,6 +154,7 @@
spider-core +>
sc ~(. spider-core bowl)
def ~(. (default-agent this %|) bowl)
bec byk.bowl(r da+now.bowl)
::
++ on-init
^- (quip card _this)
@ -159,7 +169,8 @@
=? any ?=(~ -.any) (old-to-1 any)
=^ upgrade-cards any
(old-to-2 any)
?> ?=(%2 -.any)
=. any (old-to-3 any)
?> ?=(%3 -.any)
::
=. tid.state tid.any
=/ yarns=(list yarn)
@ -181,9 +192,9 @@
::
++ old-to-2
|= old=clean-slate-any
^- (quip card clean-slate)
?> ?=(?(%1 %2) -.old)
?: ?=(%2 -.old)
^- (quip card clean-slate-any)
?> ?=(?(%1 %2 %3) -.old)
?: ?=(?(%2 %3) -.old)
`old
:- ~[bind-eyre:sc]
:* %2
@ -192,6 +203,19 @@
tid.old
~
==
::
++ old-to-3
|= old=clean-slate-any
^- clean-slate
?> ?=(?(%2 %3) -.old)
?: ?=(%3 -.old)
old
:* %3
starting.old
running.old
tid.old
(~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl]))
==
--
::
++ on-poke
@ -271,7 +295,7 @@
::
~% %spider-helper ..get-yarn ~
|_ =bowl:gall
::
++ bec `beak`byk.bowl(r da+now.bowl)
++ bind-eyre
^- card
[%pass /bind %arvo %e %connect [~ /spider] %spider]
@ -284,33 +308,30 @@
~/ %handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state)
?> authenticated.inbound-request
::?> authenticated.inbound-request
=/ url
(parse-request-line:server url.request.inbound-request)
?> ?=([%spider @t @t @t ~] site.url)
=* input-mark i.t.site.url
=* thread i.t.t.site.url
=* output-mark i.t.t.t.site.url
?> ?=([%spider @t @t @t @t ~] site.url)
=* desk i.t.site.url
=* input-mark i.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)
=. 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
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/json/[input-mark]
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)/json/[input-mark]
==
?> ?=(^ body.request.inbound-request)
=/ body=json
(need (de-json:html q.u.body.request.inbound-request))
=/ input=vase
(slop !>(~) (tube !>(body)))
=/ =start-args
[~ `tid thread input]
=^ cards state
(handle-start-thread start-args)
[cards state]
=/ body=json (need (de-json:html q.u.body.request.inbound-request))
=/ input=vase (slop !>(~) (tube !>(body)))
=/ boc bec
=/ =start-args [~ `tid boc(q desk, r da+now.bowl) thread input]
(handle-start-thread start-args)
::
++ on-poke-input
|= input
@ -345,7 +366,7 @@
::
++ handle-start-thread
~/ %handle-start-thread
|= [parent-tid=(unit tid) use=(unit tid) file=term =vase]
|= [parent-tid=(unit tid) use=(unit tid) =beak file=term =vase]
^- (quip card ^state)
=/ parent-yarn=yarn
?~ parent-tid
@ -366,11 +387,11 @@
==
=/ pax=path
~| no-file-for-thread+file
(need (get-fit:clay [our q.byk da+now]:bowl %ted file))
(need (get-fit:clay beak %ted file))
:_ state
:_ ~
:+ %pass /build/[new-tid]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax]
[%arvo %c %warp p.beak q.beak ~ %sing %a r.beak pax]
::
++ handle-build
~/ %handle-build
@ -478,7 +499,7 @@
=/ moz (thread-say-fail tid term tang)
?. ?=([~ %build *] (~(get by starting.state) yarn))
moz
:_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %home ~])
:_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %base ~])
::
++ thread-say-fail
|= [=tid =term =tang]
@ -492,7 +513,7 @@
=- (fall - `state)
%+ bind
(~(get by serving.state) tid)
|= [eyre-id=@ta output=mark]
|= [eyre-id=@ta output=mark =desk]
:_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server eyre-id
^- simple-payload:http
@ -522,11 +543,11 @@
=- (fall - `state)
%+ bind
(~(get by serving.state) tid)
|= [eyre-id=@ta output=mark]
|= [eyre-id=@ta output=mark =desk]
=+ .^
=tube:clay
%cc
/(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[output]/json
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[output]/json
==
:_ state(serving (~(del by serving.state) tid))
%+ give-simple-payload:app:server eyre-id
@ -604,5 +625,5 @@
::
++ clean-state
!> ^- clean-slate
2+state(running (turn (tap-yarn running.state) head))
3+state(running (turn (tap-yarn running.state) head))
--

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

@ -0,0 +1,11 @@
:~ %acme
%azimuth-tracker
%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>}"]

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

@ -58,4 +58,4 @@
:~ (boot-ovum:pill compiler-source arvo-source)
(file-ovum2:pill bas)
==
[(file-ovum:pill bas) ~]
[(file-ovum:pill %base bas) ~]

10
pkg/arvo/gen/desk-jam.hoon Normal file
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)

7
pkg/arvo/gen/hood/bump.hoon Normal file
View File

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

14
pkg/arvo/gen/hood/install.hoon Normal file
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]

22
pkg/arvo/gen/hood/mount.hoon
View File

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

6
pkg/arvo/gen/hood/nuke.hoon Normal file
View File

@ -0,0 +1,6 @@
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[=term ~]
desk=_|
==
[%kiln-nuke term desk]

5
pkg/arvo/gen/hood/pause.hoon Normal file
View File

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

16
pkg/arvo/gen/hood/rein.hoon Normal file
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))

5
pkg/arvo/gen/hood/resume.hoon Normal file
View File

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

5
pkg/arvo/gen/hood/revive.hoon Normal file
View File

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

5
pkg/arvo/gen/hood/suspend.hoon Normal file
View File

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

5
pkg/arvo/gen/hood/uninstall.hoon Normal file
View File

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

15
pkg/arvo/gen/show-vat.hoon Normal file
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))))
==

45
pkg/arvo/gen/solid.hoon
View File

@ -12,16 +12,43 @@
!:
:- %say
|= $: [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=_|
==
:- %boot-pill
^- pill:pill
:: 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
?^ arg top.arg
/(scot %p p.bec)/[q.bec]/(scot %da now)/sys
?: ?=([^ *] arg)
`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)
=/ arvo-path (weld sys /arvo)
@ -65,9 +92,10 @@
=< q
%^ spin
^- (list ovum)
:~ (boot-ovum:pill compiler-src arvo-src)
(file-ovum2:pill (flop (tail (flop sys))))
==
:- (boot-ovum:pill compiler-src arvo-src)
%+ turn
(snoc (turn dez tail) bas)
file-ovum2:pill
.*(0 arvo-formula)
|= [ovo=ovum ken=*]
[~ (slum ken [now ovo])]
@ -99,5 +127,6 @@
::
:+ %pill %solid
:+ boot-ova ~
=/ bas (flop (tail (flop sys)))
[(file-ovum:pill bas) ~]
%+ turn
(snoc dez [%base bas])
file-ovum:pill

7
pkg/arvo/gen/spider/start.hoon
View File

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

76
pkg/arvo/gen/trouble.hoon
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))]
--

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

135
pkg/arvo/lib/agentio.hoon
View File

@ -1,135 +0,0 @@
=>
|%
++ card card:agent:gall
--
::
|_ =bowl:gall
++ scry
|= [desk=@tas =path]
%+ weld
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
path
::
++ pass
|_ =wire
++ poke
|= [=dock =cage]
[%pass wire %agent dock %poke cage]
::
++ poke-our
|= [app=term =cage]
^- card
(poke [our.bowl app] cage)
::
++ poke-self
|= =cage
^- card
(poke-our dap.bowl cage)
::
++ arvo
|= =note-arvo
^- card
[%pass wire %arvo note-arvo]
::
++ watch
|= [=dock =path]
[%pass (watch-wire path) %agent dock %watch path]
::
++ watch-our
|= [app=term =path]
(watch [our.bowl app] path)
::
++ watch-wire
|= =path
^+ wire
?. ?=(~ wire)
wire
agentio-watch+path
::
++ leave
|= =dock
[%pass wire %agent dock %leave ~]
::
++ leave-our
|= app=term
(leave our.bowl app)
::
++ leave-path
|= [=dock =path]
=. wire
(watch-wire path)
(leave dock)
::
++ wait
|= p=@da
(arvo %b %wait p)
::
++ rest
|= p=@da
(arvo %b %wait p)
::
++ warp
|= [wer=ship =riff:clay]
(arvo %c %warp wer riff)
::
++ warp-our
|= =riff:clay
(warp our.bowl riff)
::
:: right here, right now
++ warp-slim
|= [genre=?(%sing %next) =care:clay =path]
=/ =mood:clay
[care r.byk.bowl path]
=/ =rave:clay
?:(?=(%sing genre) [genre mood] [genre mood])
(warp-our q.byk.bowl `rave)
--
::
++ fact-curry
|* [=mark =mold]
|= [paths=(list path) fac=mold]
(fact mark^!>(fac) paths)
::
++ fact-kick
|= [=path =cage]
^- (list card)
:~ (fact cage ~[path])
(kick ~[path])
==
::
++ fact-init
|= =cage
^- card
[%give %fact ~ cage]
::
++ fact-init-kick
|= =cage
^- (list card)
:~ (fact cage ~)
(kick ~)
==
::
++ fact
|= [=cage paths=(list path)]
^- card
[%give %fact paths cage]
::
++ fact-all
|= =cage
^- (unit card)
=/ paths=(list path)
%+ turn ~(tap by sup.bowl)
|= [duct ship =path]
path
?~ paths ~
`[%give %fact paths cage]
::
++ kick
|= paths=(list path)
[%give %kick paths ~]
::
++ kick-only
|= [=ship paths=(list path)]
[%give %kick paths `ship]
--

1
pkg/arvo/lib/agentio.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/agentio.hoon

454
pkg/arvo/lib/azimuth.hoon
View File

@ -1,454 +0,0 @@
:: azimuth: constants and utilities
::
/+ ethereum
::
=> => [azimuth-types ethereum-types .]
|%
+$ complete-ship
$: state=point
history=(list diff-point) ::TODO maybe block/event nr? :: newest first
keys=(map life pass)
==
::
++ fleet (map @p complete-ship)
::
++ eth-type
|%
++ point
:~ [%bytes-n 32] :: encryptionKey
[%bytes-n 32] :: authenticationKey
%bool :: hasSponsor
%bool :: active
%bool :: escapeRequested
%uint :: sponsor
%uint :: escapeRequestedTo
%uint :: cryptoSuiteVersion
%uint :: keyRevisionNumber
%uint :: continuityNumber
==
++ deed
:~ %address :: owner
%address :: managementProxy
%address :: spawnProxy
%address :: votingProxy
%address :: transferProxy
==
--
::
++ eth-noun
|%
+$ point
$: encryption-key=octs
authentication-key=octs
has-sponsor=?
active=?
escape-requested=?
sponsor=@ud
escape-to=@ud
crypto-suite=@ud
key-revision=@ud
continuity-number=@ud
==
+$ deed
$: owner=address
management-proxy=address
spawn-proxy=address
voting-proxy=address
transfer-proxy=address
==
--
::
++ function
|%
++ azimuth
$% [%points who=@p]
[%rights who=@p]
[%get-spawned who=@p]
[%dns-domains ind=@ud]
==
--
::
:: # diffs
::
++ update
$% [%full ships=(map ship point) dns=dnses heard=events]
[%difs dis=(list (pair event-id diff-azimuth))]
==
::
:: # constants
::
:: contract addresses
++ contracts mainnet-contracts
++ mainnet-contracts
|%
:: azimuth: data contract
::
++ azimuth
0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb
::
++ ecliptic
0x6ac0.7b7c.4601.b5ce.11de.8dfe.6335.b871.c7c4.dd4d
::
++ linear-star-release
0x86cd.9cd0.992f.0423.1751.e376.1de4.5cec.ea5d.1801
::
++ conditional-star-release
0x8c24.1098.c3d3.498f.e126.1421.633f.d579.86d7.4aea
::
++ delegated-sending
0xf790.8ab1.f1e3.52f8.3c5e.bc75.051c.0565.aeae.a5fb
::
:: launch: block number of azimuth deploy
::
++ launch 6.784.800
::
:: public: block number of azimuth becoming independent
::
++ public 7.033.765
--
::
:: Testnet contract addresses
::
++ ropsten-contracts
|%
++ azimuth
0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579
::
++ ecliptic
0x8b9f.86a2.8921.d9c7.05b3.113a.755f.b979.e1bd.1bce
::
++ linear-star-release
0x1f8e.dd03.1ee4.1474.0aed.b39b.84fb.8f2f.66ca.422f
::
++ conditional-star-release
0x0
::
++ delegated-sending
0x3e8c.a510.354b.c2fd.bbd6.1502.52d9.3105.c9c2.7bbe
::
++ launch 4.601.630
++ public launch
--
::
:: Local contract addresses
::
:: These addresses are only reproducible if you use the deploy
:: script in bridge
::
++ local-contracts
|%
++ ecliptic
0x56db.68f2.9203.ff44.a803.faa2.404a.44ec.bb7a.7480
++ azimuth
0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381
++ delegated-sending
0xb71c.0b6c.ee1b.cae5.6dfe.95cd.9d3e.41dd.d7ea.fc43
++ linear-star-release
0x3c3.dc12.be65.8158.d1d7.f9e6.6e08.ec40.99c5.68e4
++ conditional-star-release
0x35eb.3b10.2d9c.1b69.ac14.69c1.b1fe.1799.850c.d3eb
++ launch 0
++ public 0
--
::
:: ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge
:: hashes of ship event signatures
++ azimuth-events
|%
::
:: OwnerChanged(uint32,address)
++ owner-changed
0x16d0.f539.d49c.6cad.822b.767a.9445.bfb1.
cf7e.a6f2.a6c2.b120.a7ea.4cc7.660d.8fda
::
:: Activated(uint32)
++ activated
0xe74c.0380.9d07.69e1.b1f7.06cc.8414.258c.
d1f3.b6fe.020c.d15d.0165.c210.ba50.3a0f
::
:: Spawned(uint32,uint32)
++ spawned
0xb2d3.a6e7.a339.f5c8.ff96.265e.2f03.a010.
a854.1070.f374.4a24.7090.9644.1508.1546
::
:: EscapeRequested(uint32,uint32)
++ escape-requested
0xb4d4.850b.8f21.8218.141c.5665.cba3.79e5.
3e9b.b015.b51e.8d93.4be7.0210.aead.874a
::
:: EscapeCanceled(uint32,uint32)
++ escape-canceled
0xd653.bb0e.0bb7.ce83.93e6.24d9.8fbf.17cd.
a590.2c83.28ed.0cd0.9988.f368.90d9.932a
::
:: EscapeAccepted(uint32,uint32)
++ escape-accepted
0x7e44.7c9b.1bda.4b17.4b07.96e1.00bf.7f34.
ebf3.6dbb.7fe6.6549.0b1b.fce6.246a.9da5
::
:: LostSponsor(uint32,uint32)
++ lost-sponsor
0xd770.4f9a.2519.3dbd.0b0c.b4a8.09fe.ffff.
a7f1.9d1a.ae88.17a7.1346.c194.4482.10d5
::
:: ChangedKeys(uint32,bytes32,bytes32,uint32,uint32)
++ changed-keys
0xaa10.e7a0.117d.4323.f1d9.9d63.0ec1.69be.
bb3a.988e.8957.70e3.5198.7e01.ff54.23d5
::
:: BrokeContinuity(uint32,uint32)
++ broke-continuity
0x2929.4799.f1c2.1a37.ef83.8e15.f79d.d91b.
cee2.df99.d63c.d1c1.8ac9.68b1.2951.4e6e
::
:: ChangedSpawnProxy(uint32,address)
++ changed-spawn-proxy
0x9027.36af.7b3c.efe1.0d9e.840a.ed0d.687e.
35c8.4095.122b.2505.1a20.ead8.866f.006d
::
:: ChangedTransferProxy(uint32,address)
++ changed-transfer-proxy
0xcfe3.69b7.197e.7f0c.f067.93ae.2472.a9b1.
3583.fecb.ed2f.78df.a14d.1f10.796b.847c
::
:: ChangedManagementProxy(uint32,address)
++ changed-management-proxy
0xab9c.9327.cffd.2acc.168f.afed.be06.139f.
5f55.cb84.c761.df05.e051.1c25.1e2e.e9bf
::
:: ChangedVotingProxy(uint32,address)
++ changed-voting-proxy
0xcbd6.269e.c714.57f2.c7b1.a227.74f2.46f6.
c5a2.eae3.795e.d730.0db5.1768.0c61.c805
::
:: ChangedDns(string,string,string)
++ changed-dns
0xfafd.04ad.e1da.ae2e.1fdb.0fc1.cc6a.899f.
d424.063e.d5c9.2120.e67e.0730.53b9.4898
--
--
::
:: logic
::
|%
++ pass-from-eth
|= [enc=octs aut=octs sut=@ud]
^- pass
%^ cat 3 'b'
?. &(=(1 sut) =(p.enc 32) =(p.aut 32))
(cat 8 0 0)
(cat 8 q.aut q.enc)
::
++ point-from-eth
|= [who=@p point:eth-noun deed:eth-noun]
^- point
::
:: ownership
::
:+ :* owner
management-proxy
voting-proxy
transfer-proxy
==
::
:: network state
::
?. active ~
:- ~
:* key-revision
::
(pass-from-eth encryption-key authentication-key crypto-suite)
::
continuity-number
::
[has-sponsor `@p`sponsor]
::
?. escape-requested ~
``@p`escape-to
==
::
:: spawn state
::
?. ?=(?(%czar %king) (clan:title who)) ~
:- ~
:* spawn-proxy
~ ::TODO call getSpawned to fill this
==
::
++ event-log-to-point-diff
=, azimuth-events
=, abi:ethereum
|= log=event-log:rpc:ethereum
^- (unit (pair ship diff-point))
~? ?=(~ mined.log) %processing-unmined-event
::
?: =(i.topics.log owner-changed)
=/ [who=@ wer=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %owner wer]
::
?: =(i.topics.log activated)
=/ who=@
(decode-topics t.topics.log ~[%uint])
`[who %activated who]
::
?: =(i.topics.log spawned)
=/ [pre=@ who=@]
(decode-topics t.topics.log ~[%uint %uint])
`[pre %spawned who]
::
?: =(i.topics.log escape-requested)
=/ [who=@ wer=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %escape `wer]
::
?: =(i.topics.log escape-canceled)
=/ who=@ (decode-topics t.topics.log ~[%uint])
`[who %escape ~]
::
?: =(i.topics.log escape-accepted)
=/ [who=@ wer=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %sponsor & wer]
::
?: =(i.topics.log lost-sponsor)
=/ [who=@ pos=@]
(decode-topics t.topics.log ~[%uint %uint])
`[who %sponsor | pos]
::
?: =(i.topics.log changed-keys)
=/ who=@ (decode-topics t.topics.log ~[%uint])
=/ [enc=octs aut=octs sut=@ud rev=@ud]
%+ decode-results data.log
~[[%bytes-n 32] [%bytes-n 32] %uint %uint]
`[who %keys rev (pass-from-eth enc aut sut)]
::
?: =(i.topics.log broke-continuity)
=/ who=@ (decode-topics t.topics.log ~[%uint])
=/ num=@ (decode-results data.log ~[%uint])
`[who %continuity num]
::
?: =(i.topics.log changed-management-proxy)
=/ [who=@ sox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %management-proxy sox]
::
?: =(i.topics.log changed-voting-proxy)
=/ [who=@ tox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %voting-proxy tox]
::
?: =(i.topics.log changed-spawn-proxy)
=/ [who=@ sox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %spawn-proxy sox]
::
?: =(i.topics.log changed-transfer-proxy)
=/ [who=@ tox=address]
(decode-topics t.topics.log ~[%uint %address])
`[who %transfer-proxy tox]
::
:: warn about unimplemented events, but ignore
:: the ones we know are harmless.
~? ?! .= i.topics.log
:: OwnershipTransferred(address,address)
0x8be0.079c.5316.5914.1344.cd1f.d0a4.f284.
1949.7f97.22a3.daaf.e3b4.186f.6b64.57e0
[%unimplemented-event i.topics.log]
~
::
++ apply-point-diff
|= [pot=point dif=diff-point]
^- point
?- -.dif
%full new.dif
::
%activated
%_ pot
net `[0 0 0 &^(^sein:title who.dif) ~]
kid ?. ?=(?(%czar %king) (clan:title who.dif)) ~
`[0x0 ~]
==
::
:: ownership
::
%owner pot(owner.own new.dif)
%transfer-proxy pot(transfer-proxy.own new.dif)
%management-proxy pot(management-proxy.own new.dif)
%voting-proxy pot(voting-proxy.own new.dif)
::
:: networking
::
?(%keys %continuity %sponsor %escape)
?> ?=(^ net.pot)
?- -.dif
%keys
pot(life.u.net life.dif, pass.u.net pass.dif)
::
%sponsor
%= pot
sponsor.u.net new.dif
escape.u.net ?:(has.new.dif ~ escape.u.net.pot)
==
::
%continuity pot(continuity-number.u.net new.dif)
%escape pot(escape.u.net new.dif)
==
::
:: spawning
::
?(%spawned %spawn-proxy)
?> ?=(^ kid.pot)
?- -.dif
%spawned
=- pot(spawned.u.kid -)
(~(put in spawned.u.kid.pot) who.dif)
::
%spawn-proxy pot(spawn-proxy.u.kid new.dif)
==
==
::
++ parse-id
|= id=@t
^- azimuth:function
|^
~| id
%+ rash id
;~ pose
(function %points 'points' shipname)
(function %get-spawned 'getSpawned' shipname)
(function %dns-domains 'dnsDomains' dem:ag)
==
::
++ function
|* [tag=@tas fun=@t rul=rule]
;~(plug (cold tag (jest fun)) (ifix [pal par] rul))
::
++ shipname
;~(pfix sig fed:ag)
--
::
++ function-to-call
|%
++ azimuth
|= cal=azimuth:function
^- [id=@t dat=call-data:rpc:ethereum]
?- -.cal
%points
:- (crip "points({(scow %p who.cal)})")
['points(uint32)' ~[uint+`@`who.cal]]
::
%rights
:- (crip "rights({(scow %p who.cal)})")
['rights(uint32)' ~[uint+`@`who.cal]]
::
%get-spawned
:- (crip "getSpawned({(scow %p who.cal)})")
['getSpawned(uint32)' ~[uint+`@`who.cal]]
::
%dns-domains
:- (crip "dnsDomains({(scow %ud ind.cal)})")
['dnsDomains(uint256)' ~[uint+ind.cal]]
==
--
--

1
pkg/arvo/lib/azimuth.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/azimuth.hoon

146
pkg/arvo/lib/azimuthio.hoon
View File

@ -1,146 +0,0 @@
/- rpc=json-rpc
/+ ethereum, azimuth, strandio
=, strand=strand:strandio
=, jael
|%
++ tract azimuth:contracts:azimuth
++ fetch-point
|= [url=@ta who=ship]
=/ m (strand ,point:azimuth)
^- form:m
=/ =request:rpc:ethereum
:+ %eth-call
=- [from=~ to=tract gas=~ price=~ value=~ data=-]
(encode-call:rpc:ethereum 'points(uint32)' [%uint `@`who]~)
[%label %latest]
;< jon=json bind:m (request-rpc url `'point' request)
=/ res=cord (so:dejs:format jon)
=/ =point:eth-noun:azimuth
(decode-results:abi:ethereum res point:eth-type:azimuth)
::
=/ =request:rpc:ethereum
:+ %eth-call
=- [from=~ to=tract gas=~ price=~ value=~ data=-]
(encode-call:rpc:ethereum 'rights(uint32)' [%uint `@`who]~)
[%label %latest]
;< jon=json bind:m (request-rpc url `'deed' request)
=/ res=cord (so:dejs:format jon)
=/ =deed:eth-noun:azimuth
(decode-results:abi:ethereum res deed:eth-type:azimuth)
::
(pure:m (point-from-eth:azimuth who point deed))
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (strand ,json)
^- form:m
%+ (retry json) `10
=/ m (strand ,(unit json))
^- form:m
|^
=/ =request:http
:* method=%'POST'
url=url
header-list=['Content-Type'^'application/json' ~]
^= body
%- some %- as-octt:mimes:html
%- en-json:html
(request-to-json:rpc:ethereum id req)
==
;< ~ bind:m (send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:strandio
?~ rep
(pure:m ~)
(parse-response u.rep)
::
++ parse-response
|= =client-response:iris
=/ m (strand ,(unit json))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=, dejs-soft:format
=/ array=(unit (list response:rpc))
((ar parse-one-response) u.jon)
?~ array
=/ res=(unit response:rpc) (parse-one-response u.jon)
?~ res
(strand-fail:strandio %request-rpc-parse-error >id< ~)
?: ?=(%error -.u.res)
(strand-fail:strandio %request-rpc-error >id< >+.res< ~)
?. ?=(%result -.u.res)
(strand-fail:strandio %request-rpc-fail >u.res< ~)
(pure:m `res.u.res)
(strand-fail:strandio %request-rpc-batch >%not-implemented< ~)
:: (pure:m `[%batch u.array])
::
++ parse-one-response
|= =json
^- (unit response:rpc)
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?^ res `[%result u.res]
~| parse-one-response=json
:+ ~ %error %- need
%. json
=, dejs-soft:format
(ot id+so error+(ot code+no message+so ~) ~)
--
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
=/ m (strand ,result)
=| try=@ud
|- ^- form:m
=* loop $
?: =(crash-after `try)
(strand-fail:strandio %retry-too-many ~)
;< ~ bind:m (backoff:strandio try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
loop(try +(try))
::
++ get-latest-block
|= url=@ta
=/ m (strand ,block)
^- form:m
;< =json bind:m (request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (strand ,block)
^- form:m
|^
;< =json bind:m
(request-rpc url `'block by number' %eth-get-block-by-number number |)
=/ =block (parse-block json)
?. =(number number.id.block)
(strand-fail:strandio %reorg-detected >number< >block< ~)
(pure:m block)
::
++ parse-block
|= =json
^- block
=< [[&1 &2] |2]
^- [@ @ @]
~| json
%. json
=, dejs:format
%- ot
:~ hash+parse-hex-result:rpc:ethereum
number+parse-hex-result:rpc:ethereum
'parentHash'^parse-hex-result:rpc:ethereum
==
--
--

1
pkg/arvo/lib/azimuthio.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/azimuthio.hoon

263
pkg/arvo/lib/bip/b158.hoon
View File

@ -1,263 +0,0 @@
/- bc=bitcoin
/+ bcu=bitcoin-utils
~% %bip-158-top ..part ~
|%
++ params
|%
++ p 19
++ m 784.931
--
::
++ siphash
~/ %siphash
|= [k=byts m=byts]
^- byts
|^
?> =(wid.k 16)
?> (lte (met 3 dat.k) wid.k)
?> (lte (met 3 dat.m) wid.m)
=. k (flim:sha k)
=. m (flim:sha m)
(flim:sha (fin (comp m (init dat.k))))
:: Initialise internal state
::
++ init
|= k=@
^- [@ @ @ @]
=/ k0=@ (end [6 1] k)
=/ k1=@ (cut 6 [1 1] k)
:^ (mix k0 0x736f.6d65.7073.6575)
(mix k1 0x646f.7261.6e64.6f6d)
(mix k0 0x6c79.6765.6e65.7261)
(mix k1 0x7465.6462.7974.6573)
::
:: Compression rounds
++ comp
|= [m=byts v=[v0=@ v1=@ v2=@ v3=@]]
^- [@ @ @ @]
=/ len=@ud (div wid.m 8)
=/ last=@ (lsh [3 7] (mod wid.m 256))
=| i=@ud
=| w=@
|-
=. w (cut 6 [i 1] dat.m)
?: =(i len)
=. v3.v (mix v3.v (mix last w))
=. v (rnd (rnd v))
=. v0.v (mix v0.v (mix last w))
v
%= $
v =. v3.v (mix v3.v w)
=. v (rnd (rnd v))
=. v0.v (mix v0.v w)
v
i (add i 1)
==
::
:: Finalisation rounds
++ fin
|= v=[v0=@ v1=@ v2=@ v3=@]
^- byts
=. v2.v (mix v2.v 0xff)
=. v (rnd (rnd (rnd (rnd v))))
:- 8
:(mix v0.v v1.v v2.v v3.v)
::
:: Sipround
++ rnd
|= [v0=@ v1=@ v2=@ v3=@]
^- [@ @ @ @]
=. v0 (~(sum fe 6) v0 v1)
=. v2 (~(sum fe 6) v2 v3)
=. v1 (~(rol fe 6) 0 13 v1)
=. v3 (~(rol fe 6) 0 16 v3)
=. v1 (mix v1 v0)
=. v3 (mix v3 v2)
=. v0 (~(rol fe 6) 0 32 v0)
=. v2 (~(sum fe 6) v2 v1)
=. v0 (~(sum fe 6) v0 v3)
=. v1 (~(rol fe 6) 0 17 v1)
=. v3 (~(rol fe 6) 0 21 v3)
=. v1 (mix v1 v2)
=. v3 (mix v3 v0)
=. v2 (~(rol fe 6) 0 32 v2)
[v0 v1 v2 v3]
--
:: +str: bit streams
:: read is from the front
:: write appends to the back
::
++ str
~% %str ..params ~
|%
++ read-bit
~/ %read-bit
|= s=bits:bc
^- [bit=@ub rest=bits:bc]
?> (gth wid.s 0)
:+ ?:((gth wid.s (met 0 dat.s)) 0b0 0b1)
(dec wid.s)
(end [0 (dec wid.s)] dat.s)
::
::
++ read-bits
~/ %read-bits
|= [n=@ s=bits:bc]
^- [bits:bc rest=bits:bc]
=/ r=@ (sub wid.s n)
:- n^(cut 0 [r n] dat.s)
r^(cut 0 [0 r] dat.s)
::
++ write-bits
~/ %write-bits
|= [s1=bits:bc s2=bits:bc]
^- bits:bc
[(add wid.s1 wid.s2) (can 0 ~[s2 s1])]
--
:: +gol: Golomb-Rice encoding/decoding
::
++ gol
~% %gol ..params ~
|%
:: +en: encode x and append to end of s
:: - s: bits stream
:: - x: number to add to the stream
:: - p: golomb-rice p param
::
++ en
~/ %en
|= [s=bits:bc x=@ p=@]
^- bits:bc
=+ q=(rsh [0 p] x)
=+ unary=[+(q) (lsh [0 1] (dec (bex q)))]
=+ r=[p (end [0 p] x)]
%+ write-bits:str s
(write-bits:str unary r)
::
++ de
~/ %de
|= [s=bits:bc p=@]
^- [delta=@ rest=bits:bc]
|^ ?> (gth wid.s 0)
=^ q s (get-q s)
=^ r s (read-bits:str p s)
[(add dat.r (lsh [0 p] q)) s]
::
++ get-q
|= s=bits:bc
=| q=@
=^ first-bit s (read-bit:str s)
|-
?: =(0 first-bit) [q s]
=^ b s (read-bit:str s)
$(first-bit b, q +(q))
--
--
:: +hsh
::
++ hsh
~% %hsh ..params ~
|%
:: +to-range
:: - item: scriptpubkey to hash
:: - f: N*M
:: - k: key for siphash (end of blockhash, reversed)
::
++ to-range
~/ %to-range
|= [item=byts f=@ k=byts]
^- @
(rsh [0 64] (mul f (rev 3 (siphash k item))))
:: +set-construct: return sorted hashes of scriptpubkeys
::
++ set-construct
|= [items=(list byts) k=byts f=@]
^- (list @)
%+ sort
%+ turn items
|= item=byts
(to-range item f k)
lth
--
::
++ parse-filter
~/ %parse-filter
|= filter=hexb:bc
^- [n=@ux gcs-set=bits:bc]
=/ n n:(de:csiz:bcu filter)
=/ lead=@ ?:(=(1 wid.n) 1 +(wid.n))
:- dat.n
[(mul 8 (sub wid.filter lead)) `@ub`dat:(drop:byt:bcu lead filter)]
:: +to-key: blockhash (little endian) to key for siphash
::
++ to-key
~/ %to-key
|= blockhash=tape
^- byts
%+ take:byt:bcu 16
%- flip:byt:bcu
(from-cord:hxb:bcu (crip blockhash))
:: +match: whether block filter matches *any* target scriptpubkeys
:: - filter: full block filter, with leading N
:: - k: key for siphash (end of blockhash, reversed)
:: - targets: scriptpubkeys to match
::
++ match
~/ %match
|= [filter=hexb:bc k=byts targets=(list byts)]
^- ?
=/ [p=@ m=@] [p:params m:params]
=/ [n=@ux gcs-set=bits:bc] (parse-filter filter)
=+ target-hs=(set-construct:hsh targets k (mul n m))
=+ last-val=0
|-
?~ target-hs %.n
?: =(last-val i.target-hs)
%.y
?: (gth last-val i.target-hs)
$(target-hs t.target-hs)
:: last-val is less than target: check next val in GCS, if any
::
?: (lth wid.gcs-set p) %.n
=^ delta gcs-set
(de:gol gcs-set p)
$(last-val (add delta last-val))
:: +all-match: returns all target byts that match
:: - filter: full block filter, with leading N
:: - targets: scriptpubkeys to match
::
++ all-match
~/ %all-match
|= [filter=hexb:bc blockhash=hexb:bc targets=(list [address:bc byts])]
^- (set [address:bc hexb:bc])
=/ k (to-key (trip (to-cord:hxb:bcu blockhash)))
%- ~(gas in *(set [address:bc hexb:bc]))
=/ [p=@ m=@] [p:params m:params]
=/ [n=@ux gcs-set=bits:bc] (parse-filter filter)
=/ target-map=(map @ [address:bc hexb:bc])
%- ~(gas by *(map @ [address:bc hexb:bc]))
%+ turn targets
|= [a=address:bc t=hexb:bc]
[(to-range:hsh t (mul n m) k) a t]
=+ target-hs=(sort ~(tap in ~(key by target-map)) lth)
=+ last-val=0
=| matches=(list @)
|-
?~ target-hs
(murn matches ~(get by target-map))
?: =(last-val i.target-hs)
%= $
target-hs t.target-hs
matches [last-val matches]
==
?: (gth last-val i.target-hs)
$(target-hs t.target-hs)
:: last-val is less than target: get next val in GCS, if any
::
?: (lth wid.gcs-set p)
(murn matches ~(get by target-map))
=^ delta gcs-set
(de:gol gcs-set p)
$(last-val (add delta last-val))
::
--

1
pkg/arvo/lib/bip/b158.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/bip/b158.hoon

144
pkg/arvo/lib/bip/b173.hoon
View File

@ -1,144 +0,0 @@
:: BIP173: Bech32 Addresses
:: https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki
::
:: Heavily copies:
:: https://github.com/bitcoinjs/bech32/blob/master/index.js
::
/- sur=bitcoin
/+ bcu=bitcoin-utils
=, sur
=, bcu
|%
++ prefixes
^- (map network tape)
(my [[%main "bc"] [%testnet "tb"] ~])
++ charset "qpzry9x8gf2tvdw0s3jn54khce6mua7l"
+$ raw-decoded [hrp=tape data=(list @) checksum=(list @)]
:: below is a port of: https://github.com/bitcoinjs/bech32/blob/master/index.js
::
++ polymod
|= values=(list @)
|^ ^- @
=/ gen=(list @ux)
~[0x3b6a.57b2 0x2650.8e6d 0x1ea1.19fa 0x3d42.33dd 0x2a14.62b3]
=/ chk=@ 1
|- ?~ values chk
=/ top (rsh [0 25] chk)
=. chk
(mix i.values (lsh [0 5] (dis chk 0x1ff.ffff)))
$(values t.values, chk (update-chk chk top gen))
::
++ update-chk
|= [chk=@ top=@ gen=(list @ux)]
=/ is (gulf 0 4)
|- ?~ is chk
?: =(1 (dis 1 (rsh [0 i.is] top)))
$(is t.is, chk (mix chk (snag i.is gen)))
$(is t.is)
--
::
++ expand-hrp
|= hrp=tape
^- (list @)
=/ front (turn hrp |=(p=@tD (rsh [0 5] p)))
=/ back (turn hrp |=(p=@tD (dis 31 p)))
(zing ~[front ~[0] back])
::
++ verify-checksum
|= [hrp=tape data-and-checksum=(list @)]
^- ?
%- |=(a=@ =(1 a))
%- polymod
(weld (expand-hrp hrp) data-and-checksum)
::
++ checksum
|= [hrp=tape data=(list @)]
^- (list @)
:: xor 1 with the polymod
::
=/ pmod=@
%+ mix 1
%- polymod
(zing ~[(expand-hrp hrp) data (reap 6 0)])
%+ turn (gulf 0 5)
|=(i=@ (dis 31 (rsh [0 (mul 5 (sub 5 i))] pmod)))
::
++ charset-to-value
|= c=@tD
^- (unit @)
(find ~[c] charset)
++ value-to-charset
|= value=@
^- (unit @tD)
?: (gth value 31) ~
`(snag value charset)
::
++ is-valid
|= [bech=tape last-1-pos=@] ^- ?
?& ?|(=((cass bech) bech) =((cuss bech) bech)) :: to upper or to lower is same as bech
(gte last-1-pos 1)
(lte (add last-1-pos 7) (lent bech))
(lte (lent bech) 90)
(levy bech |=(c=@tD (gte c 33)))
(levy bech |=(c=@tD (lte c 126)))
==
:: data should be 5bit words
::
++ encode-raw
|= [hrp=tape data=(list @)]
^- cord
=/ combined=(list @)
(weld data (checksum hrp data))
%- crip
(zing ~[hrp "1" (tape (murn combined value-to-charset))])
++ decode-raw
|= body=cord
^- (unit raw-decoded)
=/ bech (cass (trip body)) :: to lowercase
=/ pos (flop (fand "1" bech))
?~ pos ~
=/ last-1=@ i.pos
?. (is-valid bech last-1) :: check bech32 validity (not segwit validity or checksum)
~
=/ hrp (scag last-1 bech)
=/ encoded-data-and-checksum=(list @)
(slag +(last-1) bech)
=/ data-and-checksum=(list @)
%+ murn encoded-data-and-checksum
charset-to-value
?. =((lent encoded-data-and-checksum) (lent data-and-checksum)) :: ensure all were in CHARSET
~
?. (verify-checksum hrp data-and-checksum)
~
=/ checksum-pos (sub (lent data-and-checksum) 6)
`[hrp (scag checksum-pos data-and-checksum) (slag checksum-pos data-and-checksum)]
:: +from-address: BIP173 bech32 address encoding to hex
:: https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki
:: expects to drop a leading 5-bit 0 (the witness version)
::
++ from-address
|= body=cord
^- hexb
~| "Invalid bech32 address"
=/ d=(unit raw-decoded) (decode-raw body)
?> ?=(^ d)
=/ bs=bits (from-atoms:bit 5 data.u.d)
=/ byt-len=@ (div (sub wid.bs 5) 8)
?> =(5^0b0 (take:bit 5 bs))
?> ?| =(20 byt-len)
=(32 byt-len)
==
[byt-len `@ux`dat:(take:bit (mul 8 byt-len) (drop:bit 5 bs))]
:: pubkey is the 33 byte ECC compressed public key
::
++ encode-pubkey
|= [=network pubkey=byts]
^- (unit cord)
?. =(33 wid.pubkey)
~|('pubkey must be a 33 byte ECC compressed public key' !!)
=/ prefix (~(get by prefixes) network)
?~ prefix ~
:- ~
%+ encode-raw u.prefix
[0v0 (to-atoms:bit 5 [160 `@ub`dat:(hash-160 pubkey)])]
--

1
pkg/arvo/lib/bip/b173.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/bip/b173.hoon

182
pkg/arvo/lib/bip/b174.hoon
View File

@ -1,182 +0,0 @@
:: BIP174: PSBTs
:: https://github.com/bitcoin/bips/blob/master/bip-0174.mediawiki
::
/- sur=bitcoin
/+ bcu=bitcoin-utils
=, sur
=, bcu
|%
++ en
|%
++ globals
|= rawtx=hexb
^- map:psbt
:~ [[1 0x0] rawtx]
==
::
++ input
|= [only-witness=? i=in:psbt]
^- map:psbt
%+ weld
?: only-witness ~
~[[1^0x0 rawtx.i]]
:~ (witness-tx i)
(hdkey %input hdkey.i)
==
::
++ output
|= =out:psbt
^- map:psbt
?~ hk.out ~
:~ (hdkey %output u.hk.out)
==
::
++ witness-tx
|= i=in:psbt
^- keyval:psbt
:- [1 0x1]
%- cat:byt
:~ (flip:byt 8^value.utxo.i)
1^0x16
2^0x14
(hash-160 pubkey.hdkey.i)
==
::
++ hdkey
|= [=target:psbt h=^hdkey]
^- keyval:psbt
=/ typ=@ux
?- target
%input 0x6
%output 0x2
==
=/ coin-type=hexb
?- network.h
%main
1^0x0
%testnet
1^0x1
==
:- (cat:byt ~[1^typ pubkey.h])
%- cat:byt
:~ fprint.h
1^`@ux`bipt.h 3^0x80
coin-type 3^0x80
4^0x80
1^`@ux`chyg.h 3^0x0
(flip:byt 4^idx.h)
==
::
++ keyval-byts
|= kv=keyval:psbt
^- hexb
%- cat:byt
:~ 1^wid.key.kv
key.kv
1^wid.val.kv
val.kv
==
::
++ map-byts
|= m=map:psbt
^- (unit hexb)
?~ m ~
:- ~
%- cat:byt
(turn m keyval-byts)
--
++ base64
|= b=hexb
^- base64:psbt
%- en:base64:mimes:html
(flip:byt b)
:: +encode: make base64 cord of PSBT
:: - only-witness: don't include non-witness UTXO
::
++ encode
|= $: only-witness=?
rawtx=hexb
txid=hexb
inputs=(list in:psbt)
outputs=(list out:psbt)
==
^- base64:psbt
=/ sep=(unit hexb) `1^0x0
=/ final=(list (unit hexb))
%+ join sep
%+ turn
%- zing
:~ ~[(globals:en rawtx)]
(turn inputs (cury input:en only-witness))
(turn outputs output:en)
==
map-byts:en
%- base64:en
^- byts
%- cat:byt
%+ weld ~[[5 0x70.7362.74ff]]
(murn (snoc final sep) same)
::
++ parse
|= psbt-base64=cord
^- (list map:psbt)
=/ todo=hexb
(drop:byt 5 (to-byts psbt-base64))
=| acc=(list map:psbt)
=| m=map:psbt
|-
?: =(wid.todo 0)
(snoc acc m)
:: 0x0: map separator
::
?: =(1^0x0 (take:byt 1 todo))
$(acc (snoc acc m), m *map:psbt, todo (drop:byt 1 todo))
=^ kv todo (next-keyval todo)
$(m (snoc m kv))
:: +get-txid: extract txid from a valid PSBT
::
++ get-txid
|= psbt-base64=cord
^- hexb
=/ tx=hexb
%- raw-tx
%+ drop:byt 5
(to-byts psbt-base64)
%- flip:byt
(dsha256 tx)
:: +raw-tx: extract hex transaction
:: looks for key 0x0 in global map
:: crashes if tx not in hex
::
++ raw-tx
|= b=hexb
^- hexb
|-
?: =(wid.b 0) !!
?: =(1^0x0 (take:byt 1 b)) !!
=/ nk (next-keyval b)
?: =(0x0 dat.key.kv.nk)
val.kv.nk
$(b rest.nk)
:: +next-keyval: returns next key-val in a PSBT map
:: input first byte must be a map key length
::
++ next-keyval
|= b=hexb
^- [kv=keyval:psbt rest=hexb]
=/ klen dat:(take:byt 1 b)
=/ k (take:byt klen (drop:byt 1 b))
=/ vlen dat:(take:byt 1 (drop:byt (add 1 klen) b))
=/ v (take:byt vlen (drop:byt (add 2 klen) b))
?> ?&((gth wid.k 0) (gth wid.v 0))
:- [k v]
(drop:byt ;:(add 2 klen vlen) b)
::
++ to-byts
|= psbt-base64=cord
^- hexb
~| "Invalid PSBT"
=+ p=(de:base64:mimes:html psbt-base64)
?~ p !!
(flip:byt u.p)
--

1
pkg/arvo/lib/bip/b174.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/bip/b174.hoon

243
pkg/arvo/lib/bip32.hoon
View File

@ -1,243 +0,0 @@
:: bip32 implementation in hoon
::
:: to use, call one of the core initialization arms.
:: using the produced core, derive as needed and take out the data you want.
::
::NOTE tested to be correct against
:: https://en.bitcoin.it/wiki/BIP_0032_TestVectors
::
=, hmac:crypto
=, secp:crypto
=+ ecc=secp256k1
::
:: prv: private key
:: pub: public key
:: cad: chain code
:: dep: depth in chain
:: ind: index at depth
:: pif: parent fingerprint (4 bytes)
|_ [prv=@ pub=point.ecc cad=@ dep=@ud ind=@ud pif=@]
::
+$ keyc [key=@ cai=@] :: prv/pub key + chain code
::
:: elliptic curve operations and values
::
++ point priv-to-pub.ecc
::
++ ser-p compress-point.ecc
::
++ n n:t.ecc
::
:: core initialization
::
++ from-seed
|= byts
^+ +>
=+ der=(hmac-sha512l [12 'dees nioctiB'] [wid dat])
=+ pri=(cut 3 [32 32] der)
+>.$(prv pri, pub (point pri), cad (cut 3 [0 32] der))
::
++ from-private
|= keyc
+>(prv key, pub (point key), cad cai)
::
++ from-public
|= keyc
+>(pub (decompress-point.ecc key), cad cai)
::
++ from-public-point
|= [pon=point.ecc cai=@]
+>(pub pon, cad cai)
::
++ from-extended
|= t=tape
=+ x=(de-base58check 4 t)
=> |%
++ take
|= b=@ud
^- [v=@ x=@]
:- (end [3 b] x)
(rsh [3 b] x)
--
=^ k x (take 33)
=^ c x (take 32)
=^ i x (take 4)
=^ p x (take 4)
=^ d x (take 1)
?> =(0 x) :: sanity check
%. [d i p]
=< set-metadata
=+ v=(swag [1 3] t)
?: =("prv" v) (from-private k c)
?: =("pub" v) (from-public k c)
!!
::
++ set-metadata
|= [d=@ud i=@ud p=@]
+>(dep d, ind i, pif p)
::
:: derivation
::
++ derivation-path
;~ pfix
;~(pose (jest 'm/') (easy ~))
%+ most fas
;~ pose
%+ cook
|=(i=@ (add i (bex 31)))
;~(sfix dem soq)
::
dem
== ==
::
++ derive-path
|= t=tape
%- derive-sequence
(scan t derivation-path)
::
++ derive-sequence
|= j=(list @u)
?~ j +>
=. +> (derive i.j)
$(j t.j)
::
++ derive
?: =(0 prv)
derive-public
derive-private
::
++ derive-private
|= i=@u
^+ +>
:: we must have a private key to derive the next one
?: =(0 prv)
~| %know-no-private-key
!!
:: derive child at i
=/ [left=@ right=@]
=- [(cut 3 [32 32] -) (cut 3 [0 32] -)]
%+ hmac-sha512l [32 cad]
:- 37
?: (gte i (bex 31))
:: hardened child
(can 3 ~[4^i 32^prv 1^0])
:: normal child
(can 3 ~[4^i 33^(ser-p (point prv))])
=+ key=(mod (add left prv) n)
:: rare exception, invalid key, go to the next one
?: |(=(0 key) (gte left n)) $(i +(i))
%_ +>.$
prv key
pub (point key)
cad right
dep +(dep)
ind i
pif fingerprint
==
::
++ derive-public
|= i=@u
^+ +>
:: public keys can't be hardened
?: (gte i (bex 31))
~| %cant-derive-hardened-public-key
!!
:: derive child at i
=/ [left=@ right=@]
=- [(cut 3 [32 32] -) (cut 3 [0 32] -)]
%+ hmac-sha512l [32 cad]
37^(can 3 ~[4^i 33^(ser-p pub)])
:: rare exception, invalid key, go to the next one
?: (gte left n) $(i +(i)) ::TODO or child key is "point at infinity"
%_ +>.$
pub (add-points.ecc (point left) pub)
cad right
dep +(dep)
ind i
pif fingerprint
==
::
:: rendering
::
++ private-key ?.(=(0 prv) prv ~|(%know-no-private-key !!))
++ public-key (ser-p pub)
++ chain-code cad
++ private-chain [private-key cad]
++ public-chain [public-key cad]
::
++ identity (hash160 public-key)
++ fingerprint (cut 3 [16 4] identity)
::
++ address
|= network=?(%main %regtest %testnet)
^- @uc
:: removes checksum
::
%+ rsh [3 4]
%+ en-base58check
[4 (version-bytes network %pub %.n)]
[20 identity]
::
++ prv-extended
|= network=?(%main %regtest %testnet)
%+ en-b58c-bip32 (version-bytes network %prv %.y)
(build-extended private-key)
::
++ pub-extended
|= network=?(%main %regtest %testnet)
%+ en-b58c-bip32 (version-bytes network %pub %.y)
(build-extended public-key)
::
++ build-extended
|= key=@
%+ can 3
:~ 33^key
32^cad
4^ind
4^pif
1^dep
==
::
++ en-b58c-bip32
|= [v=@ k=@]
%- en-base58:mimes:html
(en-base58check [4 v] [74 k])
::
:: base58check
::
++ en-base58check
:: v: version bytes
:: d: data
|= [v=byts d=byts]
=+ p=[(add wid.v wid.d) (can 3 ~[d v])]
=- (can 3 ~[4^- p])
%+ rsh [3 28]
(sha-256l:sha 32 (sha-256l:sha p))
::
++ de-base58check
:: vw: amount of version bytes
|= [vw=@u t=tape]
=+ x=(de-base58:mimes:html t)
=+ hash=(sha-256l:sha 32 (sha-256:sha (rsh [3 4] x)))
?> =((end [3 4] x) (rsh [3 28] hash))
(cut 3 [vw (sub (met 3 x) (add 4 vw))] x)
::
++ hash160
|= d=@
(ripemd-160:ripemd:crypto 32 (sha-256:sha d))
::
++ version-bytes
|= [network=?(%main %regtest %testnet) type=?(%pub %prv) bip32=?]
^- @ux
|^
?- type
%pub ?:(bip32 xpub-key pay-to-pubkey)
%prv ?:(bip32 xprv-key private-key)
==
::
++ pay-to-pubkey ?:(=(network %main) 0x0 0x6f)
++ private-key ?:(=(network %main) 0x80 0xef)
++ xpub-key ?:(=(network %main) 0x488.b21e 0x435.87cf)
++ xprv-key ?:(=(network %main) 0x488.ade4 0x435.8394)
--
--

1
pkg/arvo/lib/bip32.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/bip32.hoon

46
pkg/arvo/lib/bip39.hoon
View File

@ -1,46 +0,0 @@
:: bip39 implementation in hoon
::
/+ bip39-english
::
|%
++ from-entropy
|= byts
^- tape
=. wid (mul wid 8)
~| [%unsupported-entropy-bit-length wid]
?> &((gte wid 128) (lte wid 256))
::
=+ cs=(div wid 32)
=/ check=@
%+ rsh [0 (sub 256 cs)]
(sha-256l:sha (div wid 8) dat)
=/ bits=byts
:- (add wid cs)
%+ can 0
:~ cs^check
wid^dat
==
::
=/ pieces
|- ^- (list @)
:- (end [0 11] dat.bits)
?: (lte wid.bits 11) ~
$(bits [(sub wid.bits 11) (rsh [0 11] dat.bits)])
::
=/ words=(list tape)
%+ turn pieces
|= ind=@ud
(snag ind `(list tape)`bip39-english)
::
%+ roll (flop words)
|= [nex=tape all=tape]
?~ all nex
:(weld all " " nex)
::
::NOTE always produces a 512-bit result
++ to-seed
|= [mnem=tape pass=tape]
^- @
%- hmac-sha512t:pbkdf:crypto
[(crip mnem) (crip (weld "mnemonic" pass)) 2.048 64]
--

1
pkg/arvo/lib/bip39.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/bip39.hoon

2052
pkg/arvo/lib/bip39/english.hoon
View File

File diff suppressed because it is too large Load Diff

1
pkg/arvo/lib/bip39/english.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/bip39/english.hoon

176
pkg/arvo/lib/bitcoin-utils.hoon
View File

@ -1,176 +0,0 @@
:: lib/bitcoin-utils.hoon
:: Utilities for working with BTC data types and transactions
::
/- *bitcoin
~% %bitcoin-utils-lib ..part ~
|%
::
:: TODO: move this bit/byt stuff to zuse
:: bit/byte utilities
::
::
:: +blop: munge bit and byt sequences (cat, flip, take, drop)
::
++ blop
~/ %blop
|_ =bloq
+$ biyts [wid=@ud dat=@]
++ cat
|= bs=(list biyts)
^- biyts
:- (roll (turn bs |=(b=biyts -.b)) add)
(can bloq (flop bs))
:: +flip: flip endianness while preserving lead/trail zeroes
::
++ flip
|= b=biyts
^- biyts
[wid.b (rev bloq b)]
:: +take: take n bloqs from front
:: pads front with extra zeroes if n is longer than input
::
++ take
|= [n=@ b=biyts]
^- biyts
?: (gth n wid.b)
[n dat.b]
[n (rsh [bloq (sub wid.b n)] dat.b)]
:: +drop: drop n bloqs from front
:: returns 0^0 if n >= width
::
++ drop
|= [n=@ b=biyts]
^- biyts
?: (gte n wid.b)
0^0x0
=+ n-take=(sub wid.b n)
[n-take (end [bloq n-take] dat.b)]
--
++ byt ~(. blop 3)
::
++ bit
~/ %bit
=/ bl ~(. blop 0)
|%
++ cat cat:bl:bit
++ flip flip:bl:bit
++ take take:bl:bit
++ drop drop:bl:bit
++ from-atoms
|= [bitwidth=@ digits=(list @)]
^- bits
%- cat:bit
%+ turn digits
|= a=@
?> (lte (met 0 a) bitwidth)
[bitwidth `@ub`a]
:: +to-atoms: convert bits to atoms of bitwidth
::
++ to-atoms
|= [bitwidth=@ bs=bits]
^- (list @)
=| res=(list @)
?> =(0 (mod wid.bs bitwidth))
|-
?: =(0 wid.bs) res
%= $
res (snoc res dat:(take:bit bitwidth bs))
bs (drop:bit bitwidth bs)
==
--
:: big endian sha256: input and output are both MSB first (big endian)
::
++ sha256
~/ %sha256
|= =byts
^- hexb
%- flip:byt
[32 (shay (flip:byt byts))]
::
++ dsha256
~/ %dsha256
|= =byts
(sha256 (sha256 byts))
::
++ hash-160
~/ %hash-160
|= val=byts
^- hexb
=, ripemd:crypto
:- 20
%- ripemd-160
(sha256 val)
::
:: hxb: hex parsing utilities
::
++ hxb
~% %hxb ..blop ~
|%
++ from-cord
~/ %from-cord
|= h=@t
^- hexb
?: =('' h) 1^0x0
:: Add leading 00
::
=+ (lsh [3 2] h)
:: Group by 4-size block
::
=+ (rsh [3 2] -)
:: Parse hex to atom
::
=/ a (need (de:base16:mimes:html -))
[-.a `@ux`+.a]
::
++ to-cord
~/ %to-cord
|= =hexb
^- cord
(en:base16:mimes:html hexb)
--
::
:: +csiz: CompactSize integers (a Bitcoin-specific datatype)
:: https://btcinformation.org/en/developer-reference#compactsize-unsigned-integers
:: - encode: big endian to little endian
:: - decode: little endian to big endian
::
++ csiz
~% %csiz ..blop ~
|%
++ en
~/ %en
|= a=@
^- hexb
=/ l=@ (met 3 a)
?: =(l 1) 1^a
?: =(l 2) (cat:byt ~[1^0xfd (flip:byt 2^a)])
?: (lte l 4) (cat:byt ~[1^0xfe (flip:byt 4^a)])
?: (lte l 8) (cat:byt ~[1^0xff (flip:byt 8^a)])
~|("Cannot encode CompactSize longer than 8 bytes" !!)
::
++ de
~/ %de
|= h=hexb
^- [n=hexb rest=hexb]
=/ s=@ux dat:(take:byt 1 h)
?: (lth s 0xfd) [1^s (drop:byt 1 h)]
~| "Invalid compact-size at start of {<h>}"
=/ len=bloq
?+ s !!
%0xfd 1
%0xfe 2
%0xff 3
==
:_ (drop:byt (add 1 len) h)
%- flip:byt
(take:byt (bex len) (drop:byt 1 h))
:: +dea: atom instead of hexb for parsed CompactSize
::
++ dea
|= h=hexb
^- [a=@ rest=hexb]
=> (de h)
[dat.n rest]
--
--

1
pkg/arvo/lib/bitcoin-utils.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/bitcoin-utils.hoon

61
pkg/arvo/lib/cram.hoon
View File

@ -1,61 +0,0 @@
|%
++ static :: freeze .mdh hoon subset
|= gen=hoon ^- [inf=(map term dime) elm=manx]
?+ -.gen
=/ gen ~(open ap gen)
?: =(gen ^gen) ~|([%cram-dynamic -.gen] !!)
$(gen gen)
::
%xray [~ (single (shut gen))]
^ [(malt (frontmatter p.gen)) (single (shut q.gen))]
==
::
++ single :: unwrap one-elem marl
|= xml=marl ^- manx
?: ?=([* ~] xml) i.xml
~|(%many-elems !!)
::
++ shut-mart :: xml attrs
|=([n=mane v=(list beer:hoot)] [n (turn v |=(a=beer:hoot ?^(a !! a)))])
::
++ shut :: as xml constant
|= gen=hoon ^- marl
?+ -.gen ~|([%bad-xml -.gen] !!)
%dbug $(gen q.gen)
::
%xray
[[n.g.p.gen (turn a.g.p.gen shut-mart)] $(gen [%mcts c.p.gen])]~
::
%mcts
?~ p.gen ~
=- (weld - $(p.gen t.p.gen))
?^ -.i.p.gen $(gen [%xray i.p.gen])
~| [%shut-tuna -.i.p.gen]
?+ -.i.p.gen !!
%manx ?>(?=(%xray -.p.i.p.gen) $(gen p.i.p.gen))
%marl ?>(?=(%mcts -.p.i.p.gen) $(gen p.i.p.gen))
==
==
::
::
++ frontmatter :: parse ~[[%foo 1] [%bar ~s2]]
|= gen=hoon ^- (list [term dime])
?: ?=([%bust %null] gen) ~
?: ?=(%dbug -.gen) $(gen q.gen)
?. ?=(%clsg -.gen) ~|([%bad-frontmatter -.gen] !!)
%+ turn p.gen
|= gen=hoon
?. ?=(^ -.gen)
=/ gen ~(open ap gen)
?: =(gen ^gen) ~|([%bad-frontmatter-elem -.gen] !!)
$(gen gen)
=/ hed (as-dime p.gen)
?. =(%tas p.hed) ~|([%bad-frontmatter-key-type p.hed] !!)
[q.hed (as-dime q.gen)]
::
++ as-dime :: %foo ~.foo 0vbar etc
|= gen=hoon ^- dime
?: ?=(%dbug -.gen) $(gen q.gen)
?. ?=([?(%rock %sand) @ @] gen) ~|([%bad-literal gen] !!)
+.gen
--

1
pkg/arvo/lib/cram.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/cram.hoon

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

@ -1,155 +0,0 @@
:: dbug: agent wrapper for generic debugging tools
::
:: usage: %-(agent:dbug your-agent)
::
|%
+$ poke
$% [%bowl ~]
[%state grab=cord]
[%incoming =about]
[%outgoing =about]
==
::
+$ about
$@ ~
$% [%ship =ship]
[%path =path]
[%wire =wire]
[%term =term]
==
::
++ agent
|= =agent:gall
^- agent:gall
!.
|_ =bowl:gall
+* this .
ag ~(. agent bowl)
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall agent:gall)
?. ?=(%dbug mark)
=^ cards agent (on-poke:ag mark vase)
[cards this]
=/ dbug
!<(poke vase)
=; =tang
((%*(. slog pri 1) tang) [~ this])
?- -.dbug
%bowl [(sell !>(bowl))]~
::
%state
=? grab.dbug =('' grab.dbug) '-'
=; product=^vase
[(sell product)]~
=/ state=^vase
:: if the underlying app has implemented a /dbug/state scry endpoint,
:: use that vase in place of +on-save's.
::
=/ result=(each ^vase tang)
(mule |.(q:(need (need (on-peek:ag /x/dbug/state)))))
?:(?=(%& -.result) p.result on-save:ag)
%+ slap
(slop state !>([bowl=bowl ..zuse]))
(ream grab.dbug)
::
%incoming
=; =tang
?^ tang tang
[%leaf "no matching subscriptions"]~
%+ murn
%+ sort ~(tap by sup.bowl)
|= [[* a=[=ship =path]] [* b=[=ship =path]]]
(aor [path ship]:a [path ship]:b)
|= [=duct [=ship =path]]
^- (unit tank)
=; relevant=?
?. relevant ~
`>[path=path from=ship duct=duct]<
?: ?=(~ about.dbug) &
?- -.about.dbug
%ship =(ship ship.about.dbug)
%path ?=(^ (find path.about.dbug path))
%wire %+ lien duct
|=(=wire ?=(^ (find wire.about.dbug wire)))
%term !!
==
::
%outgoing
=; =tang
?^ tang tang
[%leaf "no matching subscriptions"]~
%+ murn
%+ sort ~(tap by wex.bowl)
|= [[[a=wire *] *] [[b=wire *] *]]
(aor a b)
|= [[=wire =ship =term] [acked=? =path]]
^- (unit tank)
=; relevant=?
?. relevant ~
`>[wire=wire agnt=[ship term] path=path ackd=acked]<
?: ?=(~ about.dbug) &
?- -.about.dbug
%ship =(ship ship.about.dbug)
%path ?=(^ (find path.about.dbug path))
%wire ?=(^ (find wire.about.dbug wire))
%term =(term term.about.dbug)
==
==
::
++ on-peek
|= =path
^- (unit (unit cage))
?. ?=([@ %dbug *] path)
(on-peek:ag path)
?+ path [~ ~]
[%u %dbug ~] ``noun+!>(&)
[%x %dbug %state ~] ``noun+!>(on-save:ag)
[%x %dbug %subscriptions ~] ``noun+!>([wex sup]:bowl)
==
::
++ on-init
^- (quip card:agent:gall agent:gall)
=^ cards agent on-init:ag
[cards this]
::
++ on-save on-save:ag
::
++ on-load
|= old-state=vase
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-load:ag old-state)
[cards this]
::
++ on-watch
|= =path
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-watch:ag path)
[cards this]
::
++ on-leave
|= =path
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-leave:ag path)
[cards this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-agent:ag wire sign)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-arvo:ag wire sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
^- (quip card:agent:gall agent:gall)
=^ cards agent (on-fail:ag term tang)
[cards this]
--
--

1
pkg/arvo/lib/dbug.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/dbug.hoon

69
pkg/arvo/lib/default-agent.hoon
View File

@ -1,69 +0,0 @@
/+ skeleton
|* [agent=* help=*]
?: ?=(%& help)
~| %default-agent-helpfully-crashing
skeleton
|_ =bowl:gall
++ on-init
`agent
::
++ on-save
!>(~)
::
++ on-load
|= old-state=vase
`agent
::
++ on-poke
|= =cage
~| "unexpected poke to {<dap.bowl>} with mark {<p.cage>}"
!!
::
++ on-watch
|= =path
~| "unexpected subscription to {<dap.bowl>} on path {<path>}"
!!
::
++ on-leave
|= path
`agent
::
++ on-peek
|= =path
~| "unexpected scry into {<dap.bowl>} on path {<path>}"
!!
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card:agent:gall _agent)
?- -.sign
%poke-ack
?~ p.sign
`agent
%- (slog leaf+"poke failed from {<dap.bowl>} on wire {<wire>}" u.p.sign)
`agent
::
%watch-ack
?~ p.sign
`agent
=/ =tank leaf+"subscribe failed from {<dap.bowl>} on wire {<wire>}"
%- (slog tank u.p.sign)
`agent
::
%kick `agent
%fact
~| "unexpected subscription update to {<dap.bowl>} on wire {<wire>}"
~| "with mark {<p.cage.sign>}"
!!
==
::
++ on-arvo
|= [=wire =sign-arvo]
~| "unexpected system response {<-.sign-arvo>} to {<dap.bowl>} on wire {<wire>}"
!!
::
++ on-fail
|= [=term =tang]
%- (slog leaf+"error in {<dap.bowl>}" >term< tang)
`agent
--

1
pkg/arvo/lib/default-agent.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/default-agent.hoon

210
pkg/arvo/lib/der.hoon
View File

@ -1,210 +0,0 @@
/- asn1
:: |der: distinguished encoding rules for ASN.1
::
:: DER is a tag-length-value binary encoding for ASN.1, designed
:: so that there is only one (distinguished) valid encoding for an
:: instance of a type.
::
|%
:: +en:der: encode +spec:asn1 to +octs (kindof)
::
++ en
=< |= a=spec:asn1
^- [len=@ud dat=@ux]
=/ b ~(ren raw a)
[(lent b) (rep 3 b)]
|%
:: +raw:en:der: door for encoding +spec:asn1 to list of bytes
::
++ raw
|_ pec=spec:asn1
:: +ren:raw:en:der: render +spec:asn1 to tag-length-value bytes
::
++ ren
^- (list @D)
=/ a lem
[tag (weld (len a) a)]
:: +tag:raw:en:der: tag byte
::
++ tag
^- @D
?- pec
[%int *] 2
[%bit *] 3
[%oct *] 4
[%nul *] 5
[%obj *] 6
[%seq *] 48 :: constructed: (con 0x20 16)
[%set *] 49 :: constructed: (con 0x20 17)
[%con *] ;: con
0x80 :: context-specifc
?:(imp.bes.pec 0 0x20) :: implicit?
(dis 0x1f tag.bes.pec) :: 5 bits of custom tag
==
==
:: +lem:raw:en:der: element bytes
::
++ lem
^- (list @D)
?- pec
:: unsigned only, interpreted as positive-signed and
:: rendered in big-endian byte order. negative-signed would
:: be two's complement
::
[%int *] =/ a (flop (rip 3 int.pec))
?~ a [0 ~]
?:((lte i.a 127) a [0 a])
:: padded to byte-width, must be already byte-aligned
::
[%bit *] =/ a (rip 3 bit.pec)
=/ b ~| %der-invalid-bit
?. =(0 (mod len.pec 8))
~|(%der-invalid-bit-alignment !!)
(sub (div len.pec 8) (lent a))
[0 (weld a (reap b 0))]
:: padded to byte-width
::
[%oct *] =/ a (rip 3 oct.pec)
=/ b ~| %der-invalid-oct
(sub len.pec (lent a))
(weld a (reap b 0))
::
[%nul *] ~
[%obj *] (rip 3 obj.pec)
::
[%seq *] %- zing
|- ^- (list (list @))
?~ seq.pec ~
:- ren(pec i.seq.pec)
$(seq.pec t.seq.pec)
:: presumed to be already deduplicated and sorted
::
[%set *] %- zing
|- ^- (list (list @))
?~ set.pec ~
:- ren(pec i.set.pec)
$(set.pec t.set.pec)
:: already constructed
::
[%con *] con.pec
==
:: +len:raw:en:der: length bytes
::
++ len
|= a=(list @D)
^- (list @D)
=/ b (lent a)
?: (lte b 127)
[b ~] :: note: big-endian
[(con 0x80 (met 3 b)) (flop (rip 3 b))]
--
--
:: +de:der: decode atom to +spec:asn1
::
++ de
|= [len=@ud dat=@ux]
^- (unit spec:asn1)
:: XX refactor into +parse
=/ a (rip 3 dat)
=/ b ~| %der-invalid-len
(sub len (lent a))
(rust `(list @D)`(weld a (reap b 0)) parse)
:: +parse:der: DER parser combinator
::
++ parse
=< ^- $-(nail (like spec:asn1))
;~ pose
(stag %int (bass 256 (sear int ;~(pfix (tag 2) till))))
(stag %bit (sear bit (boss 256 ;~(pfix (tag 3) till))))
(stag %oct (boss 256 ;~(pfix (tag 4) till)))
(stag %nul (cold ~ ;~(plug (tag 5) (tag 0))))
(stag %obj (^boss 256 ;~(pfix (tag 6) till)))
(stag %seq (sear recur ;~(pfix (tag 48) till)))
(stag %set (sear recur ;~(pfix (tag 49) till)))
(stag %con ;~(plug (sear context next) till))
==
|%
:: +tag:parse:der: parse tag byte
::
++ tag
|=(a=@D (just a))
:: +int:parse:der: sear unsigned big-endian bytes
::
++ int
|= a=(list @D)
^- (unit (list @D))
?~ a ~
?: ?=([@ ~] a) `a
?. =(0 i.a) `a
?.((gth i.t.a 127) ~ `t.a)
:: +bit:parse:der: convert bytewidth to bitwidth
::
++ bit
|= [len=@ud dat=@ux]
^- (unit [len=@ud dat=@ux])
?. =(0 (end 3 dat)) ~
:+ ~
(mul 8 (dec len))
(rsh 3 dat)
:: +recur:parse:der: parse bytes for a list of +spec:asn1
::
++ recur
|=(a=(list @) (rust a (star parse)))
:: +context:parse:der: decode context-specific tag byte
::
++ context
|= a=@D
^- (unit bespoke:asn1)
?. =(1 (cut 0 [7 1] a)) ~
:+ ~
=(1 (cut 0 [5 1] a))
(dis 0x1f a)
:: +boss:parse:der: shadowed to count as well
::
:: Use for parsing +octs more broadly?
::
++ boss
|* [wuc=@ tyd=rule]
%+ cook
|= waq=(list @)
:- (lent waq)
(reel waq |=([p=@ q=@] (add p (mul wuc q))))
tyd
:: +till:parse:der: parser combinator for len-prefixed bytes
::
:: advance until
::
++ till
|= tub=nail
^- (like (list @D))
?~ q.tub
(fail tub)
:: fuz: first byte - length, or length of the length
::
=* fuz i.q.tub
:: nex: offset of value bytes from fuz
:: len: length of value bytes
::
=/ [nex=@ len=@]
:: faz: meaningful bits in fuz
::
=/ faz (end [0 7] fuz)
?: =(0 (cut 0 [7 1] fuz))
[0 faz]
[faz (rep 3 (flop (scag faz t.q.tub)))]
?: ?& !=(0 nex)
!=(nex (met 3 len))
==
(fail tub)
:: zuf: value bytes
::
=/ zuf (swag [nex len] t.q.tub)
?. =(len (lent zuf))
(fail tub)
:: zaf: product nail
::
=/ zaf [p.p.tub (add +(nex) q.p.tub)]
[zaf `[zuf zaf (slag (add nex len) t.q.tub)]]
--
--

1
pkg/arvo/lib/der.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/der.hoon

28
pkg/arvo/lib/desk-jam.hoon Normal file
View File

@ -0,0 +1,28 @@
=, clay
|%
++ jam-desk
|= [our=ship =desk now=@da]
~> %slog.0^leaf/"jamming desk {<desk>}"
%- jam
%- ?:(=(%base desk) remove-tmp-dir same)
%- ankh-to-map
=< ank
.^(dome:clay %cv /(scot %p our)/[desk]/(scot %da now))
::
++ remove-tmp-dir
|= fiz=(map path page)
^- (map path page)
%- ~(gas by *(map path page))
(skip ~(tap by fiz) |=([p=path *] ?=([%tmp *] p)))
::
++ ankh-to-map
=| res=(map path page)
=| pax=path
|= a=ankh
^- (map path page)
=? res ?=(^ fil.a) (~(put by res) pax [p q.q]:q.u.fil.a)
=/ dir=(list [seg=@ta =ankh]) ~(tap by dir.a)
|- ^+ res
?~ dir res
$(dir t.dir, res ^$(pax (snoc pax seg.i.dir), a ankh.i.dir))
--

866
pkg/arvo/lib/ethereum.hoon
View File

@ -1,866 +0,0 @@
:: ethereum: utilities
::
=, ethereum-types
|%
:: deriving and using ethereum keys
::
++ key
|%
++ address-from-pub
=, keccak:crypto
|= pub=@
%+ end [3 20]
%+ keccak-256 64
(rev 3 64 pub)
::
++ address-from-prv
(cork pub-from-prv address-from-pub)
::
++ pub-from-prv
=, secp256k1:secp:crypto
|= prv=@
%- serialize-point
(priv-to-pub prv)
::
++ sign-transaction
=, crypto
|= [tx=transaction:rpc pk=@]
^- @ux
:: hash the raw transaction data
=/ hash=@
=/ dat=@
%- encode-atoms:rlp
:: with v=chain-id, r=0, s=0
tx(chain-id [chain-id.tx 0 0 ~])
=+ wid=(met 3 dat)
%- keccak-256:keccak
[wid (rev 3 wid dat)]
:: sign transaction hash with private key
=+ (ecdsa-raw-sign:secp256k1:secp hash pk)
:: complete transaction is raw data, with r and s
:: taken from the signature, and v as per eip-155
%- encode-atoms:rlp
tx(chain-id [:(add (mul chain-id.tx 2) 35 v) r s ~])
--
::
:: rlp en/decoding
::NOTE https://github.com/ethereum/wiki/wiki/RLP
::
++ rlp
|%
::NOTE rlp encoding doesn't really care about leading zeroes,
:: but because we need to disinguish between no-bytes zero
:: and one-byte zero (and also empty list) we end up with
:: this awful type...
+$ item
$% [%l l=(list item)]
[%b b=byts]
==
:: +encode-atoms: encode list of atoms as a %l of %b items
::
++ encode-atoms
|= l=(list @)
^- @
%+ encode %l
%+ turn l
|=(a=@ b+[(met 3 a) a])
::
++ encode
|= in=item
|^ ^- @
?- -.in
%b
?: &(=(1 wid.b.in) (lte dat.b.in 0x7f))
dat.b.in
=- (can 3 ~[b.in [(met 3 -) -]])
(encode-length wid.b.in 0x80)
::
%l
=/ out=@
%+ roll l.in
|= [ni=item en=@]
(cat 3 (encode ni) en)
%^ cat 3 out
(encode-length (met 3 out) 0xc0)
==
::
++ encode-length
|= [len=@ off=@]
?: (lth len 56) (add len off)
=- (cat 3 len -)
:(add (met 3 len) off 55)
--
:: +decode-atoms: decode expecting a %l of %b items, producing atoms within
::
++ decode-atoms
|= dat=@
^- (list @)
=/ i=item (decode dat)
~| [%unexpected-data i]
?> ?=(%l -.i)
%+ turn l.i
|= i=item
~| [%unexpected-list i]
?> ?=(%b -.i)
dat.b.i
::
++ decode
|= dat=@
^- item
=/ bytes=(list @) (flop (rip 3 dat))
=? bytes ?=(~ bytes) ~[0]
|^ item:decode-head
::
++ decode-head
^- [done=@ud =item]
?~ bytes
~| %rlp-unexpected-end
!!
=* byt i.bytes
:: byte in 0x00-0x79 range encodes itself
::
?: (lte byt 0x79)
:- 1
[%b 1^byt]
:: byte in 0x80-0xb7 range encodes string length
::
?: (lte byt 0xb7)
=+ len=(sub byt 0x80)
:- +(len)
:- %b
len^(get-value 1 len)
:: byte in 0xb8-0xbf range encodes string length length
::
?: (lte byt 0xbf)
=+ led=(sub byt 0xb7)
=+ len=(get-value 1 led)
:- (add +(led) len)
:- %b
len^(get-value +(led) len)
:: byte in 0xc0-f7 range encodes list length
::
?: (lte byt 0xf7)
=+ len=(sub byt 0xc0)
:- +(len)
:- %l
%. len
decode-list(bytes (slag 1 `(list @)`bytes))
:: byte in 0xf8-ff range encodes list length length
::
?: (lte byt 0xff)
=+ led=(sub byt 0xf7)
=+ len=(get-value 1 led)
:- (add +(led) len)
:- %l
%. len
decode-list(bytes (slag +(led) `(list @)`bytes))
~| [%rip-not-bloq-3 `@ux`byt]
!!
::
++ decode-list
|= rem=@ud
^- (list item)
?: =(0 rem) ~
=+ ^- [don=@ud =item] ::TODO =/
decode-head
:- item
%= $
rem (sub rem don)
bytes (slag don bytes)
==
::
++ get-value
|= [at=@ud to=@ud]
^- @
(rep 3 (flop (swag [at to] bytes)))
--
--
::
:: abi en/decoding
::NOTE https://solidity.readthedocs.io/en/develop/abi-spec.html
::
++ abi
=> |%
:: solidity types. integer bitsizes ignored
++ etyp
$@ $? :: static
%address %bool
%int %uint
%real %ureal
:: dynamic
%bytes %string
==
$% :: static
[%bytes-n n=@ud]
:: dynamic
[%array-n t=etyp n=@ud]
[%array t=etyp]
==
::
:: solidity-style typed data. integer bitsizes ignored
++ data
$% [%address p=address]
[%string p=tape]
[%bool p=?]
[%int p=@sd]
[%uint p=@ud]
[%real p=@rs]
[%ureal p=@urs]
[%array-n p=(list data)]
[%array p=(list data)]
[%bytes-n p=octs] ::TODO just @, because context knows length?
[%bytes p=octs]
==
--
=, mimes:html
|%
:: encoding
::
++ encode-args
:: encode list of arguments.
::
|= das=(list data)
^- tape
(encode-data [%array-n das])
::
++ encode-data
:: encode typed data into ABI bytestring.
::
|= dat=data
^- tape
?+ -.dat
~| [%unsupported-type -.dat]
!!
::
%array-n
:: enc(X) = head(X[0]) ... head(X[k-1]) tail(X[0]) ... tail(X[k-1])
:: where head and tail are defined for X[i] being of a static type as
:: head(X[i]) = enc(X[i]) and tail(X[i]) = "" (the empty string), or as
:: head(X[i]) = enc(len( head(X[0])..head(X[k-1])
:: tail(X[0])..tail(X[i-1]) ))
:: and tail(X[i]) = enc(X[i]) otherwise.
::
:: so: if it's a static type, data goes in the head. if it's a dynamic
:: type, a reference goes into the head and data goes into the tail.
::
:: in the head, we first put a placeholder where references need to go.
=+ hol=(reap 64 'x')
=/ hes=(list tape)
%+ turn p.dat
|= d=data
?. (is-dynamic-type d) ^$(dat d)
hol
=/ tas=(list tape)
%+ turn p.dat
|= d=data
?. (is-dynamic-type d) ""
^$(dat d)
:: once we know the head and tail, we can fill in the references in head.
=- (weld nes `tape`(zing tas))
^- [@ud nes=tape]
=+ led=(lent (zing hes))
%+ roll hes
|= [t=tape i=@ud nes=tape]
:- +(i)
:: if no reference needed, just put the data.
?. =(t hol) (weld nes t)
:: calculate byte offset of data we need to reference.
=/ ofs=@ud
=- (div - 2) :: two hex digits per byte.
%+ add led :: count head, and
%- lent %- zing :: count all tail data
(scag i tas) :: preceding ours.
=+ ref=^$(dat [%uint ofs])
:: shouldn't hit this unless we're sending over 2gb of data?
~| [%weird-ref-lent (lent ref)]
?> =((lent ref) (lent hol))
(weld nes ref)
::
%array :: where X has k elements (k is assumed to be of type uint256):
:: enc(X) = enc(k) enc([X[1], ..., X[k]])
:: i.e. it is encoded as if it were an array of static size k, prefixed
:: with the number of elements.
%+ weld $(dat [%uint (lent p.dat)])
$(dat [%array-n p.dat])
::
%bytes-n
:: enc(X) is the sequence of bytes in X padded with zero-bytes to a
:: length of 32.
:: Note that for any X, len(enc(X)) is a multiple of 32.
~| [%bytes-n-too-long max=32 actual=p.p.dat]
?> (lte p.p.dat 32)
(pad-to-multiple (render-hex-bytes p.dat) 64 %right)
::
%bytes :: of length k (which is assumed to be of type uint256)
:: enc(X) = enc(k) pad_right(X), i.e. the number of bytes is encoded as a
:: uint256 followed by the actual value of X as a byte sequence, followed
:: by the minimum number of zero-bytes such that len(enc(X)) is a
:: multiple of 32.
%+ weld $(dat [%uint p.p.dat])
(pad-to-multiple (render-hex-bytes p.dat) 64 %right)
::
%string
:: enc(X) = enc(enc_utf8(X)), i.e. X is utf-8 encoded and this value is
:: interpreted as of bytes type and encoded further. Note that the length
:: used in this subsequent encoding is the number of bytes of the utf-8
:: encoded string, not its number of characters.
$(dat [%bytes (lent p.dat) (swp 3 (crip p.dat))])
::
%uint
:: enc(X) is the big-endian encoding of X, padded on the higher-order
:: (left) side with zero-bytes such that the length is a multiple of 32
:: bytes.
(pad-to-multiple (render-hex-bytes (as-octs p.dat)) 64 %left)
::
%bool
:: as in the uint8 case, where 1 is used for true and 0 for false
$(dat [%uint ?:(p.dat 1 0)])
::
%address
:: as in the uint160 case
$(dat [%uint `@ud`p.dat])
==
::
++ is-dynamic-type
|= a=data
?. ?=(%array-n -.a)
?=(?(%string %bytes %array) -.a)
&(!=((lent p.a) 0) (lien p.a is-dynamic-type))
::
:: decoding
::
++ decode-topics decode-arguments
::
++ decode-results
:: rex: string of hex bytes with leading 0x.
|* [rex=@t tys=(list etyp)]
=- (decode-arguments - tys)
%^ rut 9
(rsh [3 2] rex)
(curr rash hex)
::
++ decode-arguments
|* [wos=(list @) tys=(list etyp)]
=/ wos=(list @) wos :: get rid of tmi
=| win=@ud
=< (decode-from 0 tys)
|%
++ decode-from
|* [win=@ud tys=(list etyp)]
?~ tys !!
=- ?~ t.tys dat
[dat $(win nin, tys t.tys)]
(decode-one win ~[i.tys])
::
++ decode-one
::NOTE we take (list etyp) even though we only operate on
:: a single etyp as a workaround for urbit/arvo#673
|* [win=@ud tys=(list etyp)]
=- [nin dat]=- ::NOTE ^= regular form broken
?~ tys !!
=* typ i.tys
=+ wor=(snag win wos)
?+ typ
~| [%unsupported-type typ]
!!
::
?(%address %bool %uint) :: %int %real %ureal
:- +(win)
?- typ
%address `@ux`wor
%uint `@ud`wor
%bool =(1 wor)
==
::
%string
=+ $(tys ~[%bytes])
[nin (trip (swp 3 q.dat))]
::
%bytes
:- +(win)
:: find the word index of the actual data.
=/ lic=@ud (div wor 32)
:: learn the bytelength of the data.
=/ len=@ud (snag lic wos)
(decode-bytes-n +(lic) len)
::
[%bytes-n *]
:- (add win +((div (dec n.typ) 32)))
(decode-bytes-n win n.typ)
::
[%array *]
:- +(win)
:: find the word index of the actual data.
=. win (div wor 32)
:: read the elements from their location.
%- tail
%^ decode-array-n ~[t.typ] +(win)
(snag win wos)
::
[%array-n *]
(decode-array-n ~[t.typ] win n.typ)
==
::
++ decode-bytes-n
|= [fro=@ud bys=@ud]
^- octs
:: parse {bys} bytes from {fro}.
:- bys
%+ rsh
:- 3
=+ (mod bys 32)
?:(=(0 -) - (sub 32 -))
%+ rep 8
%- flop
=- (swag [fro -] wos)
+((div (dec bys) 32))
::
++ decode-array-n
::NOTE we take (list etyp) even though we only operate on
:: a single etyp as a workaround for urbit/arvo#673
::NOTE careful! produces lists without type info
=| res=(list)
|* [tys=(list etyp) fro=@ud len=@ud]
^- [@ud (list)]
?~ tys !!
?: =(len 0) [fro (flop `(list)`res)]
=+ (decode-one fro ~[i.tys]) :: [nin=@ud dat=*]
$(res ^+(res [dat res]), fro nin, len (dec len))
--
--
::
:: communicating with rpc nodes
::NOTE https://github.com/ethereum/wiki/wiki/JSON-RPC
::
++ rpc
:: types
::
=> =, abi
=, format
|%
:: raw call data
++ call-data
$: function=@t
arguments=(list data)
==
::
:: raw transaction data
+$ transaction
$: nonce=@ud
gas-price=@ud
gas=@ud
to=address
value=@ud
data=@ux
chain-id=@ux
==
::
:: ethereum json rpc api
::
:: supported requests.
++ request
$% [%eth-block-number ~]
[%eth-call cal=call deb=block]
$: %eth-new-filter
fro=(unit block)
tob=(unit block)
adr=(list address)
top=(list ?(@ux (list @ux)))
==
[%eth-get-block-by-number bon=@ud txs=?]
[%eth-get-filter-logs fid=@ud]
$: %eth-get-logs
fro=(unit block)
tob=(unit block)
adr=(list address)
top=(list ?(@ux (list @ux)))
==
$: %eth-get-logs-by-hash
has=@
adr=(list address)
top=(list ?(@ux (list @ux)))
==
[%eth-get-filter-changes fid=@ud]
[%eth-get-transaction-count adr=address =block]
[%eth-get-transaction-receipt txh=@ux]
[%eth-send-raw-transaction dat=@ux]
==
::
::TODO clean up & actually use
++ response
$% ::TODO
[%eth-new-filter fid=@ud]
[%eth-get-filter-logs los=(list event-log)]
[%eth-get-logs los=(list event-log)]
[%eth-get-logs-by-hash los=(list event-log)]
[%eth-got-filter-changes los=(list event-log)]
[%eth-transaction-hash haz=@ux]
==
::
++ event-log
$: :: null for pending logs
$= mined %- unit
$: log-index=@ud
transaction-index=@ud
transaction-hash=@ux
block-number=@ud
block-hash=@ux
removed=?
==
::
address=@ux
data=@t
:: event data
::
:: For standard events, the first topic is the event signature
:: hash. For anonymous events, the first topic is the first
:: indexed argument.
:: Note that this does not support the "anonymous event with
:: zero topics" case. This has dubious usability, and using
:: +lest instead of +list saves a lot of ?~ checks.
::
topics=(lest @ux)
==
::
:: data for eth_call.
++ call
$: from=(unit address)
to=address
gas=(unit @ud)
gas-price=(unit @ud)
value=(unit @ud)
data=tape
==
::
:: minimum data needed to construct a read call
++ proto-read-request
$: id=(unit @t)
to=address
call-data
==
::
:: block to operate on.
++ block
$% [%number n=@ud]
[%label l=?(%earliest %latest %pending)]
==
--
::
:: logic
::
|%
++ encode-call
|= call-data
^- tape
::TODO should this check to see if the data matches the function signature?
=- :(weld "0x" - (encode-args arguments))
%+ scag 8
%+ render-hex-bytes 32
%- keccak-256:keccak:crypto
(as-octs:mimes:html function)
::
:: building requests
::
++ json-request
=, eyre
|= [url=purl jon=json]
^- hiss
:^ url %post
%- ~(gas in *math)
~['Content-Type'^['application/json']~]
(some (as-octt (en-json:html jon)))
:: +light-json-request: like json-request, but for %l
::
:: TODO: Exorcising +purl from our system is a much longer term effort;
:: get the current output types for now.
::
++ light-json-request
|= [url=purl:eyre jon=json]
^- request:http
::
:* %'POST'
(crip (en-purl:html url))
~[['content-type' 'application/json']]
(some (as-octt (en-json:html jon)))
==
::
++ batch-read-request
|= req=(list proto-read-request)
^- json
a+(turn req read-request)
::
++ read-request
|= proto-read-request
^- json
%+ request-to-json id
:+ %eth-call
^- call
[~ to ~ ~ ~ `tape`(encode-call function arguments)]
[%label %latest]
::
++ request-to-json
=, enjs:format
|= [riq=(unit @t) req=request]
^- json
%- pairs
=; r=[met=@t pas=(list json)]
::TODO should use request-to-json:rpc:jstd,
:: and probably (fall riq -.req)
:* jsonrpc+s+'2.0'
method+s+met.r
params+a+pas.r
::TODO would just jamming the req noun for id be a bad idea?
?~ riq ~
[id+s+u.riq]~
==
?- -.req
%eth-block-number
['eth_blockNumber' ~]
::
%eth-call
:- 'eth_call'
:~ (eth-call-to-json cal.req)
(block-to-json deb.req)
==
::
%eth-new-filter
:- 'eth_newFilter'
:_ ~
:- %o %- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ ?~ fro.req ~
`['fromBlock' (block-to-json u.fro.req)]
::
?~ tob.req ~
`['toBlock' (block-to-json u.tob.req)]
::
::TODO fucking tmi
?: =(0 (lent adr.req)) ~
:+ ~ 'address'
?: =(1 (lent adr.req)) (tape (address-to-hex (snag 0 adr.req)))
:- %a
(turn adr.req (cork address-to-hex tape))
::
?~ top.req ~
:+ ~ 'topics'
(topics-to-json top.req)
==
::
%eth-get-block-by-number
:- 'eth_getBlockByNumber'
:~ (tape (num-to-hex bon.req))
b+txs.req
==
::
%eth-get-filter-logs
['eth_getFilterLogs' (tape (num-to-hex fid.req)) ~]
::
%eth-get-logs
:- 'eth_getLogs'
:_ ~
:- %o %- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ ?~ fro.req ~
`['fromBlock' (block-to-json u.fro.req)]
::
?~ tob.req ~
`['toBlock' (block-to-json u.tob.req)]
::
?: =(0 (lent adr.req)) ~
:+ ~ 'address'
?: =(1 (lent adr.req)) (tape (address-to-hex (snag 0 adr.req)))
:- %a
(turn adr.req (cork address-to-hex tape))
::
?~ top.req ~
:+ ~ 'topics'
(topics-to-json top.req)
==
::
%eth-get-logs-by-hash
:- 'eth_getLogs'
:_ ~ :- %o
%- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ `['blockHash' (tape (transaction-to-hex has.req))]
::
?: =(0 (lent adr.req)) ~
:+ ~ 'address'
?: =(1 (lent adr.req)) (tape (address-to-hex (snag 0 adr.req)))
:- %a
(turn adr.req (cork address-to-hex tape))
::
?~ top.req ~
:+ ~ 'topics'
(topics-to-json top.req)
==
::
%eth-get-filter-changes
['eth_getFilterChanges' (tape (num-to-hex fid.req)) ~]
::
%eth-get-transaction-count
:- 'eth_getTransactionCount'
:~ (tape (address-to-hex adr.req))
(block-to-json block.req)
==
::
%eth-get-transaction-receipt
['eth_getTransactionReceipt' (tape (transaction-to-hex txh.req)) ~]
::
%eth-send-raw-transaction
['eth_sendRawTransaction' (tape (num-to-hex dat.req)) ~]
==
::
++ eth-call-to-json
=, enjs:format
|= cal=call
^- json
:- %o %- ~(gas by *(map @t json))
=- (murn - same)
^- (list (unit (pair @t json)))
:~ ?~ from.cal ~
`['from' (tape (address-to-hex u.from.cal))]
::
`['to' (tape (address-to-hex to.cal))]
::
?~ gas.cal ~
`['gas' (tape (num-to-hex u.gas.cal))]
::
?~ gas-price.cal ~
`['gasPrice' (tape (num-to-hex u.gas-price.cal))]
::
?~ value.cal ~
`['value' (tape (num-to-hex u.value.cal))]
::
?~ data.cal ~
`['data' (tape data.cal)]
==
::
++ block-to-json
|= dob=block
^- json
?- -.dob
%number s+(crip '0' 'x' ((x-co:co 1) n.dob))
%label s+l.dob
==
::
++ topics-to-json
|= tos=(list ?(@ux (list @ux)))
^- json
:- %a
=/ ttj
;: cork
(cury render-hex-bytes 32)
prefix-hex
tape:enjs:format
==
%+ turn tos
|= t=?(@ (list @))
?@ t
?: =(0 t) ~
(ttj `@`t)
a+(turn t ttj)
::
:: parsing responses
::
::TODO ++ parse-response |= json ^- response
::
++ parse-hex-result
|= j=json
^- @
?> ?=(%s -.j)
(hex-to-num p.j)
::
++ parse-eth-new-filter-res parse-hex-result
::
++ parse-eth-block-number parse-hex-result
::
++ parse-transaction-hash parse-hex-result
::
++ parse-eth-get-transaction-count parse-hex-result
::
++ parse-event-logs
(ar:dejs:format parse-event-log)
::
++ parse-event-log
=, dejs:format
|= log=json
^- event-log
=- ((ot -) log)
:~ =- ['logIndex'^(cu - (mu so))]
|= li=(unit @t)
?~ li ~
=- `((ou -) log) ::TODO not sure if elegant or hacky.
:~ 'logIndex'^(un (cu hex-to-num so))
'transactionIndex'^(un (cu hex-to-num so))
'transactionHash'^(un (cu hex-to-num so))
'blockNumber'^(un (cu hex-to-num so))
'blockHash'^(un (cu hex-to-num so))
'removed'^(uf | bo)
==
::
address+(cu hex-to-num so)
data+so
::
=- topics+(cu - (ar so))
|= r=(list @t)
^- (lest @ux)
?> ?=([@t *] r)
:- (hex-to-num i.r)
(turn t.r hex-to-num)
==
--
::
:: utilities
::TODO give them better homes!
::
++ num-to-hex
|= n=@
^- tape
%- prefix-hex
?: =(0 n)
"0"
%- render-hex-bytes
(as-octs:mimes:html n)
::
++ address-to-hex
|= a=address
^- tape
%- prefix-hex
(render-hex-bytes 20 `@`a)
::
++ transaction-to-hex
|= h=@
^- tape
%- prefix-hex
(render-hex-bytes 32 h)
::
++ prefix-hex
|= a=tape
^- tape
['0' 'x' a]
::
++ render-hex-bytes
:: atom to string of hex bytes without 0x prefix and dots.
|= a=octs
^- tape
((x-co:co (mul 2 p.a)) q.a)
::
++ pad-to-multiple
|= [wat=tape mof=@ud wer=?(%left %right)]
^- tape
=+ len=(lent wat)
?: =(0 len) (reap mof '0')
=+ mad=(mod len mof)
?: =(0 mad) wat
=+ tad=(reap (sub mof mad) '0')
%- weld
?:(?=(%left wer) [tad wat] [wat tad])
::
++ hex-to-num
|= a=@t
(rash (rsh [3 2] a) hex)
--

1
pkg/arvo/lib/ethereum.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/ethereum.hoon

257
pkg/arvo/lib/ethio.hoon
View File

@ -1,257 +0,0 @@
:: ethio: Asynchronous Ethereum input/output functions.
::
/- rpc=json-rpc
/+ ethereum, strandio
=, ethereum-types
=, jael
::
=> |%
+$ topics (list ?(@ux (list @ux)))
--
|%
:: +request-rpc: send rpc request, with retry
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (strand:strandio ,json)
^- form:m
;< res=(list [id=@t =json]) bind:m
(request-batch-rpc-strict url [id req]~)
?: ?=([* ~] res)
(pure:m json.i.res)
%+ strand-fail:strandio
%unexpected-multiple-results
[>(lent res)< ~]
:: +request-batch-rpc-strict: send rpc requests, with retry
::
:: sends a batch request. produces results for all requests in the batch,
:: but only if all of them are successful.
::
++ request-batch-rpc-strict
|= [url=@ta reqs=(list [id=(unit @t) req=request:rpc:ethereum])]
|^ %+ (retry:strandio results)
`10
attempt-request
::
+$ results (list [id=@t =json])
::
++ attempt-request
=/ m (strand:strandio ,(unit results))
^- form:m
;< responses=(list response:rpc) bind:m
(request-batch-rpc-loose url reqs)
=- ?~ err
(pure:m `res)
(pure:m ~)
%+ roll responses
|= $: rpc=response:rpc
[res=results err=(list [id=@t code=@t message=@t])]
==
?: ?=(%error -.rpc)
[res [+.rpc err]]
?. ?=(%result -.rpc)
[res [['' 'ethio-rpc-fail' (crip <rpc>)] err]]
[[+.rpc res] err]
--
:: +request-batch-rpc-loose: send rpc requests, with retry
::
:: sends a batch request. produces results for all requests in the batch,
:: including the ones that are unsuccessful.
::
++ request-batch-rpc-loose
|= [url=@ta reqs=(list [id=(unit @t) req=request:rpc:ethereum])]
|^ %+ (retry:strandio results)
`10
attempt-request
::
+$ result response:rpc
+$ results (list response:rpc)
::
++ attempt-request
=/ m (strand:strandio ,(unit results))
^- form:m
=/ =request:http
:* method=%'POST'
url=url
header-list=['Content-Type'^'application/json' ~]
::
^= body
%- some %- as-octt:mimes:html
%- en-json:html
a+(turn reqs request-to-json:rpc:ethereum)
==
;< ~ bind:m
(send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:strandio
?~ rep
(pure:m ~)
(parse-responses u.rep)
::
++ parse-responses
|= =client-response:iris
=/ m (strand:strandio ,(unit results))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=/ array=(unit (list response:rpc))
((ar:dejs-soft:format parse-one-response) u.jon)
?~ array
(strand-fail:strandio %rpc-result-incomplete-batch >u.jon< ~)
(pure:m array)
::
++ parse-one-response
|= =json
^- (unit response:rpc)
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?^ res `[%result u.res]
~| parse-one-response=json
:+ ~ %error %- need
%. json
=, dejs-soft:format
(ot id+so error+(ot code+no message+so ~) ~)
--
::
:: +read-contract: calls a read function on a contract, produces result hex
::
++ read-contract
|= [url=@t req=proto-read-request:rpc:ethereum]
=/ m (strand:strandio ,@t)
;< res=(list [id=@t res=@t]) bind:m
(batch-read-contract-strict url [req]~)
?: ?=([* ~] res)
(pure:m res.i.res)
%+ strand-fail:strandio
%unexpected-multiple-results
[>(lent res)< ~]
:: +batch-read-contract-strict: calls read functions on contracts
::
:: sends a batch request. produces results for all requests in the batch,
:: but only if all of them are successful.
::
++ batch-read-contract-strict
|= [url=@t reqs=(list proto-read-request:rpc:ethereum)]
|^ =/ m (strand:strandio ,results)
^- form:m
;< res=(list [id=@t =json]) bind:m
%+ request-batch-rpc-strict url
(turn reqs proto-to-rpc)
=+ ^- [=results =failures]
(roll res response-to-result)
?~ failures (pure:m results)
(strand-fail:strandio %batch-read-failed-for >failures< ~)
::
+$ results (list [id=@t res=@t])
+$ failures (list [id=@t =json])
::
++ proto-to-rpc
|= proto-read-request:rpc:ethereum
^- [(unit @t) request:rpc:ethereum]
:- id
:+ %eth-call
^- call:rpc:ethereum
[~ to ~ ~ ~ `tape`(encode-call:rpc:ethereum function arguments)]
[%label %latest]
::
++ response-to-result
|= [[id=@t =json] =results =failures]
^+ [results failures]
?: ?=(%s -.json)
[[id^p.json results] failures]
[results [id^json failures]]
--
::
::
++ get-latest-block
|= url=@ta
=/ m (strand:strandio ,block)
^- form:m
;< =json bind:m
(request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (strand:strandio ,block)
^- form:m
|^
%+ (retry:strandio ,block) `10
=/ m (strand:strandio ,(unit block))
^- form:m
;< =json bind:m
%+ request-rpc url
:- `'block by number'
[%eth-get-block-by-number number |]
(pure:m (parse-block json))
::
++ parse-block
|= =json
^- (unit block)
=< ?~(. ~ `[[&1 &2] |2]:u)
^- (unit [@ @ @])
~| json
%. json
=, dejs-soft:format
%- ot
:~ hash+parse-hex
number+parse-hex
'parentHash'^parse-hex
==
::
++ parse-hex |=(=json `(unit @)`(some (parse-hex-result:rpc:ethereum json)))
--
::
++ get-logs-by-hash
|= [url=@ta =hash:block contracts=(list address) =topics]
=/ m (strand:strandio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by hash'
%eth-get-logs-by-hash
hash
contracts
topics
==
%- pure:m
(parse-event-logs:rpc:ethereum json)
::
++ get-logs-by-range
|= $: url=@ta
contracts=(list address)
=topics
=from=number:block
=to=number:block
==
=/ m (strand:strandio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by range'
%eth-get-logs
`number+from-number
`number+to-number
contracts
topics
==
%- pure:m
(parse-event-logs:rpc:ethereum json)
::
++ get-next-nonce
|= [url=@ta =address]
=/ m (strand:strandio ,@ud)
^- form:m
;< =json bind:m
%^ request-rpc url `'nonce'
[%eth-get-transaction-count address [%label %latest]]
%- pure:m
(parse-eth-get-transaction-count:rpc:ethereum json)
--

1
pkg/arvo/lib/ethio.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/ethio.hoon

562
pkg/arvo/lib/hark/store.hoon
View File

@ -1,562 +0,0 @@
/- sur=hark-store, post
/+ resource, graph-store, group-store
^?
=< [. sur]
=, sur
|%
++ upgrade
|%
++ to-three
=* two state-two
=* three state-three
|%
++ index
|= =index:two
^- (unit index:three)
`index
++ contents
|= =contents:two
^- (unit contents:three)
?. ?=(%group -.contents)
`contents
=- ?: =(~ -) ~
`[%group -]
%+ murn list.contents
|= =group-contents:two
^- (unit group-contents:three)
?: ?=(?(%add %remove) -.group-contents)
~
`group-contents
::
++ stats-index
|= =stats-index:two
^- (unit stats-index:three)
`stats-index
::
++ notifications
upg-notifications:upg
::
++ upg
%. [index stats-index contents]
%: upgrade
index:two
stats-index:two
contents:two
index:three
stats-index:three
contents:three
==
--
::
++ to-four
=* three state-three
=* four state-four
|%
++ index
|= =index:three
^- (unit index:four)
`index
++ contents
|= =contents:three
^- (unit contents:four)
?. ?=(%graph -.contents)
`contents
`[%graph (turn list.contents post-to-one:upgrade:graph-store)]
::
++ unreads-each
upg-unreads-each:upg
::
++ notifications
upg-notifications:upg
::
++ stats-index
|= =stats-index:three
^- (unit stats-index:four)
`stats-index
::
++ upg
%. [index stats-index contents]
%: upgrade
index:three
stats-index:three
contents:three
index:four
stats-index:four
contents:four
==
--
::
++ to-five
=* four state-four
=* five sur
|%
++ mark
|= module=@t
^- (unit @t)
?+ module ~
%chat `%graph-validator-chat
%publish `%graph-validator-publish
%link `%graph-validator-link
==
++ index
|= =index:four
^- (unit index:five)
?: ?=(%group -.index)
`index
=* i index
`[%graph graph.i (mark module.i) description.i index.i]
::
++ contents
|= =contents:four
^- (unit contents:five)
`contents
::
++ unreads-each
upg-unreads-each:upg
::
++ stats-index
|= =stats-index:four
^- (unit stats-index:five)
`stats-index
::
++ upg
%. [index stats-index contents]
%: upgrade
index:four
stats-index:four
contents:four
index:five
stats-index:five
contents:five
==
++ notifications
upg-notifications:upg
--
::
++ upgrade
|* $: :: input molds
in-index=mold
in-stats-index=mold
in-contents=mold
:: output molds
out-index=mold
out-stats-index=mold
out-contents=mold
==
=> . =>
|%
::
++ in
|%
::
+$ index in-index
+$ stats-index in-stats-index
+$ contents in-contents
+$ unreads-each (jug stats-index index)
+$ timebox (map index notification)
+$ notification
[date=@da read=? =contents]
++ orm
((ordered-map time timebox) gth)
+$ notifications
((mop time timebox) gth)
--
++ out
|%
::
::
+$ index out-index
+$ stats-index out-stats-index
+$ contents out-contents
+$ timebox (map out-index notification)
+$ unreads-each (jug stats-index index)
+$ notification
[date=@da read=? contents=out-contents]
+$ notifications
((mop time timebox) gth)
++ orm
((ordered-map time timebox) gth)
--
--
|= $: fun-index=$-(index:in (unit index:out))
fun-stats-index=$-(stats-index:in (unit stats-index:out))
fun-contents=$-(contents:in (unit contents:out))
==
|%
::
++ upg-unreads-each
|= =unreads-each:in
^- unreads-each:out
%- ~(gas by *unreads-each:out)
%+ murn ~(tap by unreads-each)
|= [=stats-index:in indices=(set index:in)]
^- (unit [stats-index:out (set index:out)])
=/ new-stats
(fun-stats-index stats-index)
?~ new-stats ~
=/ new-indices
(upg-indices indices)
?: =(0 ~(wyt ^in new-indices)) ~
`[u.new-stats new-indices]
::
++ upg-indices
|= indices=(set index:in)
^- (set index:out)
%- ~(gas ^in *(set index:out))
(murn ~(tap ^in indices) fun-index)
::
++ upg-notifications
|= =notifications:in
^- notifications:out
%+ gas:orm:out *notifications:out
^- (list [@da timebox:out])
%+ murn (tap:orm:in notifications)
|= [time=@da =timebox:in]
^- (unit [@da =timebox:out])
=/ new-timebox=timebox:out
(upg-timebox timebox)
?: =(0 ~(wyt by timebox))
~
`[time new-timebox]
::
++ upg-timebox
|= =timebox:in
^- timebox:out
%- ~(gas by *timebox:out)
%+ murn ~(tap by timebox)
|= [=index:in =notification:in]
^- (unit [index:out notification:out])
=/ new-index
(fun-index index)
?~ new-index ~
=/ new-notification
(upg-notification notification)
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ upg-notification
|= n=notification:in
^- (unit notification:out)
=/ new-contents
(fun-contents contents.n)
?~ new-contents ~
`[date.n read.n u.new-contents]
--
--
++ dejs
=, dejs:format
|%
++ index
%- of
:~ graph+graph-index
group+group-index
==
::
++ group-index
%- ot
:~ group+dejs-path:resource
description+so
==
::
++ graph-index
%- ot
:~ graph+dejs-path:resource
mark+(mu so)
description+so
index+(su ;~(pfix fas (more fas dem)))
==
::
++ stats-index
%- of
:~ graph+graph-stats-index
group+dejs-path:resource
==
++ graph-stats-index
%- ot
:~ graph+dejs-path:resource
index+graph-store-index
==
:: parse date as @ud
:: TODO: move to zuse
++ sd
|= jon=json
^- @da
?> ?=(%s -.jon)
`@da`(rash p.jon dem:ag)
::
++ notif-ref
^- $-(json [(unit @da) ^index])
%- ot
:~ time+(mu sd)
index+index
==
++ graph-store-index
(su ;~(pfix fas (more fas dem)))
::
++ add
|= jon=json
[*^index *notification]
::
++ read-graph-index
%- ot
:~ index+stats-index
target+graph-store-index
==
::
++ action
^- $-(json ^action)
%- of
:~ seen+ul
archive+notif-ref
read-note+index
add-note+add
set-dnd+bo
read-count+stats-index
read-graph+dejs-path:resource
read-group+dejs-path:resource
read-each+read-graph-index
read-all+ul
==
--
::
++ enjs
=, enjs:format
|%
++ update
|= upd=^update
^- json
|^
%+ frond -.upd
?+ -.upd a+~
%added (added +.upd)
%timebox (timebox +.upd)
%set-dnd b+dnd.upd
%count (numb count.upd)
%more (more +.upd)
%read-each (read-each +.upd)
%read-count (stats-index +.upd)
%unread-each (unread-each +.upd)
%unread-count (unread-count +.upd)
%remove-graph s+(enjs-path:resource +.upd)
%seen-index (seen-index +.upd)
%unreads (unreads +.upd)
%read-note (index +.upd)
%note-read (note-read +.upd)
::
%archive
(notif-ref +.upd)
==
::
++ note-read
|= [tim=@da idx=^index]
%- pairs
:~ time+s+(scot %ud tim)
index+(index idx)
==
::
++ stats-index
|= s=^stats-index
%+ frond -.s
|^
?- -.s
%graph (graph-stats-index +.s)
%group s+(enjs-path:resource +.s)
==
::
++ graph-stats-index
|= [graph=resource =index:graph-store]
%- pairs
:~ graph+s+(enjs-path:resource graph)
index+(index:enjs:graph-store index)
==
--
::
++ unreads
|= l=(list [^stats-index ^stats])
^- json
:- %a
^- (list json)
%+ turn l
|= [idx=^stats-index s=^stats]
%- pairs
:~ stats+(stats s)
index+(stats-index idx)
==
::
++ unread
|= =^unreads
%+ frond
-.unreads
?- -.unreads
%each a+(turn ~(tap by indices.unreads) index:enjs:graph-store)
::
%count
(numb num.unreads)
==
::
++ stats
|= s=^stats
^- json
%- pairs
:~ unreads+(unread unreads.s)
last+(time last-seen.s)
==
++ added
|= [idx=^index not=^notification]
^- json
%- pairs
:~ index+(index idx)
notification+(notification not)
==
::
++ notif-ref
|= [tim=(unit @da) idx=^index]
^- json
%- pairs
:~ [%time ?~(tim ~ s+(scot %ud u.tim))]
index+(index idx)
==
++ seen-index
|= [tim=@da idx=^stats-index]
^- json
%- pairs
:~ time+(time tim)
index+(stats-index idx)
==
::
++ more
|= upds=(list ^update)
^- json
a+(turn upds update)
::
++ index
|= =^index
%+ frond -.index
|^
?- -.index
%graph (graph-index +.index)
%group (group-index +.index)
==
::
++ graph-index
|= $: graph=resource
mark=(unit mark)
description=@t
idx=index:graph-store
==
^- json
%- pairs
:~ graph+s+(enjs-path:resource graph)
mark+s+(fall mark '')
description+s+description
index+(index:enjs:graph-store idx)
==
::
++ group-index
|= [group=resource description=@t]
^- json
%- pairs
:~ group+s+(enjs-path:resource group)
description+s+description
==
--
::
++ notification
|= ^notification
^- json
%- pairs
:~ time+(time date)
contents+(^contents contents)
==
::
++ contents
|= =^contents
^- json
%+ frond -.contents
|^
?- -.contents
%graph (graph-contents +.contents)
%group (group-contents +.contents)
==
::
++ graph-contents
|= =(list post:post)
^- json
:- %a
(turn list post:enjs:graph-store)
::
++ group-contents
|= =(list ^group-contents)
^- json
:- %a
%+ turn list
|= =^group-contents
(update:enjs:group-store group-contents)
--
::
++ indexed-notification
|= [=^index =^notification]
%- pairs
:~ index+(^index index)
notification+(^notification notification)
==
::
++ timebox
|= [tim=(unit @da) l=(list [^index ^notification])]
^- json
%- pairs
:~ time+`json`?~(tim ~ s+(scot %ud u.tim))
:- %notifications
^- json
:- %a
%+ turn l
|= [=^index =^notification]
^- json
(indexed-notification index notification)
==
::
++ read-each
|= [s=^stats-index target=index:graph-store]
%- pairs
:~ index+(stats-index s)
target+(index:enjs:graph-store target)
==
::
++ unread-each
|= [s=^stats-index target=index:graph-store tim=@da]
%- pairs
:~ index+(stats-index s)
target+(index:enjs:graph-store target)
last+(time tim)
==
::
++ unread-count
|= [s=^stats-index tim=@da]
%- pairs
:~ index+(stats-index s)
last+(time tim)
==
--
--
::
++ to-stats-index
|= =index
^- stats-index
?- -.index
%graph [%graph graph.index index.index]
%group [%group group.index]
==
++ stats-index-is-index
|= [=stats-index =index]
?- -.index
%graph
?. ?=(%graph -.stats-index) %.n
=([graph index]:index [graph index]:stats-index)
::
%group
?. ?=(%group -.stats-index) %.n
=(group:index group:stats-index)
==
--

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

@ -1,20 +1,36 @@
/- *sole
/+ sole
|%
+$ any-state $%(state)
+$ state [%2 pith-2]
+$ state state-4
+$ any-state
$~ *state
$% state-4
state-3
state-2
==
+$ state-4 [%4 pith-4]
+$ state-3 [%3 pith-3]
+$ state-2 [%2 pith-2]
::
++ pith-2 ::
+$ pith-4
$: eel=(set gill:gall) :: connect to
ray=(set well:gall) ::
fur=(map dude:gall (unit server)) :: servers
bin=(map bone source) :: terminals
== ::
::
++ pith-3 ::
$: eel=(set gill:gall) :: connect to
ray=(map dude:gall desk) ::
fur=(map dude:gall (unit *)) :: servers
bin=(map bone source) :: terminals
== ::
:: ::
++ server :: running server
$: syd=desk :: app identity
cas=case :: boot case
++ pith-2 ::
$: eel=(set gill:gall) :: connect to
ray=(set well:gall) ::
fur=(map dude:gall (unit *)) :: servers
bin=(map bone source) :: terminals
== ::
:: ::
++ kill :: kill ring
$: pos=@ud :: ring position
num=@ud :: number of entries
@ -54,70 +70,6 @@
:::: :: ::
:: :: ::
|%
++ deft-apes :: default servers
|= [our=ship lit=?]
%- ~(gas in *(set well:gall))
^- (list well:gall)
:: boot all default apps off the home desk
::
=- (turn - |=(a=term home+a))
^- (list term)
%+ welp
:~ %dojo
%spider
%eth-watcher
%azimuth-tracker
%ping
%goad
%lens
==
?: lit
~
:~ %acme
%clock
%dojo
%launch
%publish
%weather
%group-store
%group-pull-hook
%group-push-hook
%invite-store
%invite-hook
%chat-store
%chat-hook
%chat-view
%chat-cli
%herm
%contact-store
%contact-push-hook
%contact-pull-hook
%metadata-store
%s3-store
%file-server
%glob
%graph-store
%graph-pull-hook
%graph-push-hook
%hark-store
%hark-graph-hook
%hark-group-hook
%hark-chat-hook
%observe-hook
%metadata-push-hook
%metadata-pull-hook
%group-view
%settings-store
%dm-hook
%notify
==
::
++ deft-fish :: default connects
|= our=ship
%- ~(gas in *(set gill:gall))
^- (list gill:gall)
[[our %dojo] [our %chat-cli]~]
::
++ en-gill :: gill to wire
|= gyl=gill:gall
^- wire
@ -140,7 +92,7 @@
++ this .
+$ state ^state :: proxy
+$ any-state ^any-state :: proxy
++ on-init se-abet:this(eel (deft-fish our.hid))
++ on-init (poke-link our.hid %dojo)
++ diff-sole-effect-phat :: app event
|= [way=wire fec=sole-effect]
=< se-abet =< se-view
@ -151,21 +103,10 @@
++ peer ::
|= pax=path
~| [%drum-unauthorized our+our.hid src+src.hid] :: ourself
?> (team:title our.hid src.hid) :: or our own moon
?> (team:title our.hid src.hid) :: or our own moon
=< se-abet =< se-view
(se-text "[{<src.hid>}, driving {<our.hid>}]")
::
++ poke-set-boot-apps ::
|= lit=?
^- (quip card:agent:gall ^state)
:: We do not run se-abet:se-view here because that starts the apps,
:: and some apps are not ready to start (eg Talk crashes because the
:: terminal has width 0). It appears the first message to drum must
:: be the peer.
::
=. ray (deft-apes our.hid lit)
[~ sat]
::
++ poke-dill-belt :: terminal event
|= bet=dill-belt:dill
=< se-abet =< se-view
@ -175,16 +116,6 @@
|= bit=dill-blit:dill
se-abet:(se-blit-sys bit)
::
++ poke-start :: start app
|= wel=well:gall
=< se-abet =< se-view
(se-born & wel)
::
++ poke-fade :: fade app
|= wel=well:gall
=< se-abet =< se-view
(se-fade wel)
::
++ poke-link :: connect app
|= gyl=gill:gall
=< se-abet =< se-view
@ -211,60 +142,19 @@
%drum-exit =;(f (f !<(_+<.f vase)) poke-exit)
%drum-link =;(f (f !<(_+<.f vase)) poke-link)
%drum-put =;(f (f !<(_+<.f vase)) poke-put)
%drum-set-boot-apps =;(f (f !<(_+<.f vase)) poke-set-boot-apps)
%drum-start =;(f (f !<(_+<.f vase)) poke-start)
%drum-fade =;(f (f !<(_+<.f vase)) poke-fade)
%drum-unlink =;(f (f !<(_+<.f vase)) poke-unlink)
==
::
++ on-load
|= [hood-version=@ud old=any-state]
=< se-abet =< se-view
=? old ?=(%2 -.old) [%4 [eel bin]:old]
=? old ?=(%3 -.old) [%4 [eel bin]:old]
::
?> ?=(%4 -.old)
=. sat old
=. dev (~(gut by bin) ost *source)
=? ..on-load (lte hood-version %4)
~> %slog.0^leaf+"drum: starting os1 agents"
=> (se-born | %home %s3-store)
=> (se-born | %home %contact-view)
=> (se-born | %home %contact-hook)
=> (se-born | %home %contact-store)
=> (se-born | %home %metadata-hook)
=> (se-born | %home %metadata-store)
=> (se-born | %home %goad)
~> %slog.0^leaf+"drum: resubscribing to %dojo and %chat-cli"
=> (se-drop:(se-pull our.hid %dojo) | our.hid %dojo)
(se-drop:(se-pull our.hid %chat-cli) | our.hid %chat-cli)
=? ..on-load (lte hood-version %5)
(se-born | %home %file-server)
=? ..on-load (lte hood-version %7)
(se-born | %home %glob)
=? ..on-load (lte hood-version %8)
=> (se-born | %home %group-push-hook)
(se-born | %home %group-pull-hook)
=? ..on-load (lte hood-version %9)
(se-born | %home %graph-store)
=? ..on-load (lte hood-version %10)
=> (se-born | %home %graph-push-hook)
(se-born | %home %graph-pull-hook)
=? ..on-load (lte hood-version %11)
=> (se-born | %home %hark-graph-hook)
=> (se-born | %home %hark-group-hook)
=> (se-born | %home %hark-chat-hook)
=> (se-born | %home %hark-store)
=> (se-born | %home %observe-hook)
=> (se-born | %home %metadata-pull-hook)
=> (se-born | %home %metadata-push-hook)
(se-born | %home %herm)
=? ..on-load (lte hood-version %12)
=> (se-born | %home %contact-push-hook)
=> (se-born | %home %contact-pull-hook)
=> (se-born | %home %settings-store)
(se-born | %home %group-view)
=? ..on-load (lte hood-version %13)
(se-born | %home %dm-hook)
=? ..on-load (lte hood-version %15)
(se-born | %home %notify)
..on-load
this
::
++ reap-phat :: ack connect
|= [way=wire saw=(unit tang)]
@ -277,12 +167,6 @@
::
(se-drop & gyl)
::
++ take-arvo
|= [=wire =sign-arvo]
%+ take-onto wire
?> ?=(%onto +<.sign-arvo)
+>.sign-arvo
::
++ take-coup-phat :: ack poke
|= [way=wire saw=(unit tang)]
=< se-abet =< se-view
@ -293,29 +177,16 @@
:_ u.saw
>[%drum-coup-fail src.hid gyl]<
::
++ take-onto :: ack start
|= [way=wire saw=(each suss:gall tang)]
=< se-abet =< se-view
?> ?=([@ @ ~] way)
?> (~(has by fur) i.t.way)
=/ wel=well:gall [i.way i.t.way]
?- saw
[%| *] (se-dump p.saw)
[%& *] ?> =(q.wel p.p.saw)
:: =. +>.$ (se-text "live {<p.saw>}")
+>.$(fur (~(put by fur) q.wel `[p.wel %da r.p.saw]))
==
::
++ take-agent
|= [=wire =sign:agent:gall]
?+ wire ~|([%drum-bad-take-agent wire -.sign] !!)
[%drum %phat *]
?+ wire ~|([%drum-bad-take-agent wire -.sign] !!)
[%phat *]
?- -.sign
%poke-ack (take-coup-phat t.t.wire p.sign)
%watch-ack (reap-phat t.t.wire p.sign)
%kick (quit-phat t.t.wire)
%poke-ack (take-coup-phat t.wire p.sign)
%watch-ack (reap-phat t.wire p.sign)
%kick (quit-phat t.wire)
%fact
%+ diff-sole-effect-phat t.t.wire
%+ diff-sole-effect-phat t.wire
?> ?=(%sole-effect p.cage.sign)
!<(sole-effect q.cage.sign)
==
@ -332,7 +203,7 @@
:: :: ::
++ se-abet :: resolve
^- (quip card:agent:gall state)
=. . se-subze:se-adze:se-subit:se-adit
=. . se-subze:se-adze
:_ sat(bin (~(put by bin) ost dev))
^- (list card:agent:gall)
?~ biz (flop moz)
@ -340,72 +211,6 @@
=/ =dill-blit:dill ?~(t.biz i.biz [%mor (flop biz)])
[%give %fact ~[/drum] %dill-blit !>(dill-blit)]
::
++ se-adit :: update servers
^+ this
|^
=/ servers=(list well:gall)
(sort ~(tap in ray) sort-by-priorities)
|-
?~ servers
this
=/ wel=well:gall
i.servers
=/ =wire [%drum p.wel q.wel ~]
=/ hig=(unit (unit server))
(~(get by fur) q.wel)
?: &(?=(^ hig) |(?=(~ u.hig) =(p.wel syd.u.u.hig)))
$(servers t.servers)
=. fur
(~(put by fur) q.wel ~)
=. this
(se-text "activated app {(trip p.wel)}/{(trip q.wel)}")
=. this
%- se-emit
[%pass wire %arvo %g %conf q.wel]
$(servers t.servers)
::
++ priorities
^- (list (set @))
:~
:: set up stores with priority: depended on, but never depending
%- sy
:~ %chat-store
%contact-store
%group-store
%invite-store
%metadata-store
==
:: ensure chat-cli can sub to invites
:: and file server can receive pokes
(sy ~[%chat-hook %file-server])
==
++ sort-by-priorities
=/ priorities priorities
|= [[desk a=term] [desk b=term]]
^- ?
?~ priorities
(aor a b)
=* priority i.priorities
?: &((~(has in priority) a) (~(has in priority) b))
(aor a b)
?: (~(has in priority) a)
%.y
?: (~(has in priority) b)
%.n
$(priorities t.priorities)
--
::
++ se-subit :: downdate servers
=/ ruf=(list term) ~(tap in ~(key by fur))
|- ^+ this
?~ ruf
this
?: (~(has in ray) [%home i.ruf])
$(ruf t.ruf)
=/ wire [%drum %fade i.ruf ~]
=. this (se-emit %pass wire %arvo %g %fade i.ruf %slay)
$(ruf t.ruf, fur (~(del by fur) i.ruf))
::
++ se-adze :: update connections
^+ .
%+ roll
@ -490,26 +295,6 @@
(se-blit %bel ~)
ta-abet:(ta-belt:(se-tame u.gul) bet)
::
++ se-born :: new server
|= [print-on-repeat=? wel=well:gall]
^+ +>
?: (~(has in ray) wel)
?. print-on-repeat +>
(se-text "[already running {<p.wel>}/{<q.wel>}]")
%= +>
ray (~(put in ray) wel)
eel (~(put in eel) [our.hid q.wel])
==
::
++ se-fade :: delete server
|= wel=well:gall
^+ +>
?. (~(has in ray) wel)
(se-text "[fade not running {<p.wel>}/{<q.wel>}]")
%= +>
ray (~(del in ray) wel)
==
::
++ se-drop :: disconnect
|= [pej=? gyl=gill:gall]
^+ +>
@ -651,6 +436,7 @@
::
++ se-peer :: send a peer
|= gyl=gill:gall
~> %slog.0^leaf/"drum: link {<[p q]:gyl>}"
=/ =path /sole/(cat 3 'drum_' (scot %p our.hid))
%- se-emit(fug (~(put by fug) gyl ~))
[%pass (en-gill gyl) %agent gyl %watch path]
@ -750,7 +536,7 @@
%c ta-bel
%d ?^ buf.say.inp
ta-del
?: (~(has in (deft-fish our.hid)) gyl)
?: =([our.hid %dojo] gyl)
+>(..ta (se-blit qit+~)) :: quit pier
+>(..ta (se-klin gyl)) :: unlink app
%e +>(pos.inp (lent buf.say.inp))

13
pkg/arvo/lib/hood/helm.hoon
View File

@ -1,8 +1,13 @@
/+ pill
=* card card:agent:gall
|%
+$ any-state $%(state state-0)
+$ state
+$ state state-1
+$ any-state
$~ *state
$% state-1
state-0
==
+$ state-1
$: %1
mass-timer=[way=wire nex=@da tim=@dr]
==
@ -222,8 +227,8 @@
++ take-agent
|= [=wire =sign:agent:gall]
?+ wire ~|([%helm-bad-take-agent wire -.sign] !!)
[%helm %hi *] ?> ?=(%poke-ack -.sign)
(coup-hi t.t.wire p.sign)
[%hi *] ?> ?=(%poke-ack -.sign)
(coup-hi t.wire p.sign)
==
::
++ take-bound

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

File diff suppressed because it is too large Load Diff

214
pkg/arvo/lib/jose.hoon
View File

@ -1,214 +0,0 @@
/+ primitive-rsa, *pkcs
=* rsa primitive-rsa
|%
:: +en-base64url: url-safe base64 encoding, without padding
::
++ en-base64url
~(en base64:mimes:html | &)
:: +de-base64url: url-safe base64 decoding, without padding
::
++ de-base64url
~(de base64:mimes:html | &)
:: |octn: encode/decode unsigned atoms as big-endian octet stream
::
++ octn
|%
++ en |=(a=@u `octs`[(met 3 a) (swp 3 a)])
++ de |=(a=octs `@u`(rev 3 p.a q.a))
--
:: +eor: explicit sort order comparator
::
:: Lookup :a and :b in :lit, and pass their indices to :com.
::
++ eor
|= [com=$-([@ @] ?) lit=(list)]
|= [a=* b=*]
^- ?
(fall (bind (both (find ~[a] lit) (find ~[b] lit)) com) |)
:: +en-json-sort: json encoding with sorted object keys
::
:: XX move %zuse with sorting optional?
::
++ en-json-sort :: XX rename
|^ |=([sor=$-(^ ?) val=json] (apex val sor ""))
:: :: ++apex:en-json:html
++ apex
=, en-json:html
|= [val=json sor=$-(^ ?) rez=tape]
^- tape
?~ val (weld "null" rez)
?- -.val
%a
:- '['
=. rez [']' rez]
!.
?~ p.val rez
|-
?~ t.p.val ^$(val i.p.val)
^$(val i.p.val, rez [',' $(p.val t.p.val)])
::
%b (weld ?:(p.val "true" "false") rez)
%n (weld (trip p.val) rez)
%s
:- '"'
=. rez ['"' rez]
=+ viz=(trip p.val)
!.
|- ^- tape
?~ viz rez
=+ hed=(jesc i.viz)
?: ?=([@ ~] hed)
[i.hed $(viz t.viz)]
(weld hed $(viz t.viz))
::
%o
:- '{'
=. rez ['}' rez]
=/ viz
%+ sort ~(tap by p.val)
|=((pair) (sor (head p) (head q)))
?~ viz rez
!.
|- ^+ rez
?~ t.viz ^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
=. rez [',' $(viz t.viz)]
^$(val [%s p.i.viz], rez [':' ^$(val q.i.viz)])
==
--
:: %/lib/jose
::
:: |jwk: json representations of cryptographic keys (rfc7517)
::
:: Url-safe base64 encoding of key parameters in big-endian byte order.
:: RSA-only for now
::
++ jwk
|%
:: |en:jwk: encoding of json cryptographic keys
::
++ en
=> |%
:: +numb:en:jwk: base64-url encode big-endian number
::
++ numb (corl en-base64url en:octn)
--
|%
:: +pass:en:jwk: json encode public key
::
++ pass
|= k=key:rsa
^- json
[%o (my kty+s+'RSA' n+s+(numb n.pub.k) e+s+(numb e.pub.k) ~)]
:: +ring:en:jwk: json encode private key
::
++ ring
|= k=key:rsa
^- json
~| %rsa-need-ring
?> ?=(^ sek.k)
:- %o %- my :~
kty+s+'RSA'
n+s+(numb n.pub.k)
e+s+(numb e.pub.k)
d+s+(numb d.u.sek.k)
p+s+(numb p.u.sek.k)
q+s+(numb q.u.sek.k)
==
--
:: |de:jwk: decoding of json cryptographic keys
::
++ de
=, dejs-soft:format
=> |%
:: +numb:de:jwk: parse base64-url big-endian number
::
++ numb (cu (cork de-base64url (lift de:octn)) so)
--
|%
:: +pass:de:jwk: decode json public key
::
++ pass
%+ ci
=/ a (unit @ux)
|= [kty=@t n=a e=a]
^- (unit key:rsa)
=/ pub (both n e)
?~(pub ~ `[u.pub ~])
(ot kty+(su (jest 'RSA')) n+numb e+numb ~)
:: +ring:de:jwk: decode json private key
::
++ ring
%+ ci
=/ a (unit @ux)
|= [kty=@t n=a e=a d=a p=a q=a]
^- (unit key:rsa)
=/ pub (both n e)
=/ sek :(both d p q)
?:(|(?=(~ pub) ?=(~ sek)) ~ `[u.pub sek])
(ot kty+(su (jest 'RSA')) n+numb e+numb d+numb p+numb q+numb ~)
--
:: |thumb:jwk: "thumbprint" json-encoded key (rfc7638)
::
++ thumb
|%
:: +pass:thumb:jwk: thumbprint json-encoded public key
::
++ pass
|= k=key:rsa
(en-base64url 32 (shax (crip (en-json-sort aor (pass:en k)))))
:: +ring:thumb:jwk: thumbprint json-encoded private key
::
++ ring !!
--
--
:: |jws: json web signatures (rfc7515)
::
:: Note: flattened signature form only.
::
++ jws
|%
:: +sign:jws: sign json value
::
++ sign
|= [k=key:rsa pro=json lod=json]
|^ ^- json
=. pro header
=/ protect=cord (encode pro)
=/ payload=cord (encode lod)
:- %o %- my :~
protected+s+protect
payload+s+payload
signature+s+(sign protect payload)
==
:: +header:sign:jws: set signature algorithm in header
::
++ header
?> ?=([%o *] pro)
^- json
[%o (~(put by p.pro) %alg s+'RS256')]
:: +encode:sign:jws: encode json for signing
::
:: Alphabetically sort object keys, url-safe base64 encode
:: the serialized json.
::
++ encode
|= jon=json
%- en-base64url
%- as-octt:mimes:html
(en-json-sort aor jon)
:: +sign:sign:jws: compute signature
::
:: Url-safe base64 encode in big-endian byte order.
::
++ sign
|= [protect=cord payload=cord]
=/ msg=@t (rap 3 ~[protect '.' payload])
=/ sig=@ud (~(sign rs256 k) (met 3 msg) msg)
=/ len=@ud (met 3 n.pub.k)
(en-base64url len (rev 3 len sig))
--
:: +verify:jws: verify signature
::
++ verify !!
--
--

1
pkg/arvo/lib/jose.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/jose.hoon

112
pkg/arvo/lib/keygen.hoon
View File

@ -1,112 +0,0 @@
:: urbit-style key generation and derivation functions
::
/- keygen
::
/+ ethereum, bip32, bip39
::
=, keygen
::
|%
++ argon2u
|= [who=ship tic=byts]
^- @
~| [%who who (met 3 who)]
:: ?> (lte (met 3 who) 4)
%- (argon2-urbit:argon2:crypto 32)
:- tic
=- [(met 3 -) (swp 3 -)]
%- crip
(weld "urbitkeygen" (a-co:co who))
::
++ child-node-from-seed
|= [seed=@ typ=tape pass=(unit @t)]
^- node
=+ sed=(seed:ds 32^seed typ)
=+ nom=(from-entropy:bip39 32^sed)
:+ typ nom
%- wallet:ds
%+ to-seed:bip39 nom
(trip (fall pass ''))
::
++ derive-network-seed
|= [mngs=@ rev=@ud]
^- @ux
=+ (seed:ds 64^mngs (weld "network" (a-co:co rev)))
?: =(0 rev) -
:: hash again to prevent length extension attacks
(sha-256l:sha 32 -)
::
++ ownership-wallet-from-ticket
|= [who=ship ticket=byts pass=(unit @t)]
^- node
=+ master-seed=(argon2u who ticket)
(child-node-from-seed master-seed "ownership" pass)
::
++ full-wallet-from-ticket
:: who: username
:: ticket: password
:: rev: network key revision
:: pass: optional passphrase
::
|= [who=ship ticket=byts rev=@ud pass=(unit @t)]
^- vault
=+ master-seed=(argon2u who ticket)
=/ cn :: child node
|= typ=nodetype
(child-node-from-seed master-seed typ pass)
::
:- ^= ownership ^- node
(cn "ownership")
::
:- ^= voting ^- node
(cn "voting")
::
=/ management=node
(cn "management")
:- management=management
::
:- ^= transfer ^- node
(cn "transfer")
::
:- ^= spawn ^- node
(cn "spawn")
::
^= network ^- uode
=/ mad :: management seed
%+ to-seed:bip39
seed:management
(trip (fall pass ''))
=+ sed=(derive-network-seed mad rev)
[rev sed (urbit:ds sed)]
::
++ ds :: derive from raw seed
|%
++ wallet
|= seed=@
^- ^wallet
=+ => (from-seed:bip32 64^seed)
(derive-path "m/44'/60'/0'/0/0")
:+ [public-key private-key]
(address-from-prv:key:ethereum private-key)
chain-code
::
++ urbit
|= seed=@
^- edkeys
=+ =< [pub=pub:ex sec=sec:ex]
(pit:nu:crub:crypto 256 seed)
:- ^= auth
:- (rsh 3 (end [3 33] pub))
(rsh 3 (end [3 33] sec))
^= crypt
:- (rsh [3 33] pub)
(rsh [3 33] sec)
::
++ seed
|= [seed=byts salt=tape]
^- @ux
%- sha-256l:sha
:- (add wid.seed (lent salt))
(cat 3 (crip (flop salt)) dat.seed)
--
--

1
pkg/arvo/lib/keygen.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/keygen.hoon

61
pkg/arvo/lib/language-server/build.hoon
View File

@ -1,61 +0,0 @@
/- *language-server
::
|%
++ parse-error
|= =tape
^- (unit [=path =range])
=/ parse-pair
%+ cook
|=([row=@ud col=@ud] [(dec row) col])
(ifix [sel ser] ;~((glue ace) dem dem))
=/ parse-path
%+ cook
|=(p=path (slag 3 p))
(ifix [fas (jest '::')] (more fas urs:ab))
=/ parse-full
;~(plug parse-path ;~(sfix ;~((glue dot) parse-pair parse-pair) gar))
(rust tape parse-full)
::
++ get-errors-from-tang
|= [uri=@t =tang]
^- (list range)
=/ =path
(uri-to-path uri)
%+ murn tang
|= =tank
^- (unit range)
?. ?=([%leaf *] tank)
~
=/ error
(parse-error p.tank)
?~ error
~
?: =(path path.u.error)
`range.u.error
~
::
++ uri-to-path
|= uri=@t
^- path
=/ pier-root=(set cord)
%- sy
['app' 'gen' 'lib' 'mar' 'ren' 'sur' 'sys' 'test' ~]
=/ path=(list cord)
(parse-uri uri)
|-
?< ?=(~ path)
?: (~(has in pier-root) i.path)
`^path`path
$(path t.path)
::
++ parse-uri
|= uri=@t
=- (fall - /fail)
%+ rush uri
%+ more
;~(pose (plus fas) dot)
%+ cook
crip
(star ;~(pose col hep alf))
::
--

1
pkg/arvo/lib/language-server/build.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/language-server/build.hoon

386
pkg/arvo/lib/language-server/complete.hoon
View File

@ -1,386 +0,0 @@
/+ language-server-parser
:: Autocomplete for hoon.
::
=/ debug |
|%
+* option [item]
[term=cord detail=item]
::
:: Like +rose except also produces line number
::
++ lily
|* [los=tape sab=rule]
=+ vex=(sab [[1 1] los])
?~ q.vex
[%| p=p.vex(q (dec q.p.vex))]
?. =(~ q.q.u.q.vex)
[%| p=p.vex(q (dec q.p.vex))]
[%& p=p.u.q.vex]
::
:: Get all the identifiers accessible if this type is your subject.
::
++ get-identifiers
|= ty=type
%- flop
|- ^- (list (option type))
?- ty
%noun ~
%void ~
[%atom *] ~
[%cell *]
%+ weld
$(ty p.ty)
$(ty q.ty)
::
[%core *]
%- weld
:_ ?. ?=(%gold r.p.q.ty)
~
$(ty p.ty)
^- (list (option type))
%- zing
%+ turn ~(tap by q.r.q.ty)
|= [term =tome]
%+ turn
~(tap by q.tome)
|= [name=term =hoon]
^- (pair term type)
~| term=term
[name ~(play ~(et ut ty) ~[name] ~)]
::
[%face *]
?^ p.ty
~
[p.ty q.ty]~
::
[%fork *]
%= $
ty
=/ tines ~(tap in p.ty)
?~ tines
%void
|- ^- type
?~ t.tines
i.tines
(~(fuse ut $(tines t.tines)) i.tines)
==
::
[%hint *] $(ty q.ty)
[%hold *] $(ty ~(repo ut ty))
==
::
++ search-exact
|* [sid=term options=(list (option))]
=/ match
%+ skim options
|= [id=cord *]
=(sid id)
?~ match
~
[~ i.match]
::
:: Get all the identifiers that start with sid.
::
++ search-prefix
|* [sid=cord ids=(list (option))]
^+ ids
%+ skim ids
|= [id=cord *]
^- ?(%.y %.n)
=(sid (end [3 (met 3 sid)] id))
::
:: Get the longest prefix of a list of identifiers.
::
++ longest-match
|= matches=(list (option))
^- cord
?~ matches
''
=/ n 1
=/ last (met 3 term.i.matches)
|- ^- term
?: (gth n last)
term.i.matches
=/ prefix (end [3 n] term.i.matches)
?: |- ^- ?
?| ?=(~ t.matches)
?& =(prefix (end [3 n] term.i.t.matches))
$(t.matches t.t.matches)
== ==
$(n +(n))
(end [3 (dec n)] term.i.matches)
::
:: Run +find-type safely, printing the first line of the stack trace on
:: error.
::
++ find-type-mule
|= [sut=type gen=hoon]
^- (unit [term type])
=/ res (mule |.((find-type sut gen)))
?- -.res
%& p.res
%| ((slog (flop (scag 10 p.res))) ~)
==
::
:: Get the subject type of the wing where you've put the "magic-spoon".
::
++ find-type
|= [sut=type gen=hoon]
=* loop $
|^
^- (unit [term type])
?- gen
[%cnts [%magic-spoon ~] *] `['' sut]
[%cnts [%magic-spoon @ ~] *] `[i.t.p.gen sut]
[%cnts [%magic-spoon @ *] *]
%= $
sut (~(play ut sut) wing+t.t.p.gen)
t.p.gen t.p.gen(t ~)
==
::
[%cnts [%magic-fork @ ~] *]
`['' (~(play ut sut) wing+t.p.gen)]
::
[^ *] (both p.gen q.gen)
[%brcn *] (grow q.gen)
[%brpt *] (grow q.gen)
[%cnts *]
|- ^- (unit [term type])
=* inner-loop $
?~ q.gen
~
%+ replace
loop(gen q.i.q.gen)
|. inner-loop(q.gen t.q.gen)
::
[%dtkt *] (spec-and-hoon p.gen q.gen)
[%dtls *] loop(gen p.gen)
[%rock *] ~
[%sand *] ~
[%tune *] ~
[%dttr *] (both p.gen q.gen)
[%dtts *] (both p.gen q.gen)
[%dtwt *] loop(gen p.gen)
[%hand *] ~
[%ktbr *] loop(gen p.gen)
[%ktls *] (both p.gen q.gen)
[%ktpm *] loop(gen p.gen)
[%ktsg *] loop(gen p.gen)
[%ktwt *] loop(gen p.gen)
[%note *] loop(gen q.gen)
[%sgzp *] (both p.gen q.gen)
[%sggr *] loop(gen q.gen) :: should check for hoon in p.gen
[%tsgr *] (change p.gen q.gen)
[%tscm *]
%+ replace
loop(gen p.gen)
|.(loop(gen q.gen, sut (~(busk ut sut) p.gen)))
::
[%wtcl *] (bell p.gen q.gen r.gen)
[%fits *] (both p.gen wing+q.gen)
[%wthx *] loop(gen wing+q.gen)
[%dbug *] loop(gen q.gen)
[%zpcm *] (both p.gen q.gen)
[%lost *] loop(gen p.gen)
[%zpmc *] (both p.gen q.gen)
[%zpts *] loop(gen p.gen)
[%zppt *] (both q.gen r.gen)
[%zpgl *] (spec-and-hoon p.gen q.gen)
[%zpzp *] ~
*
=+ doz=~(open ap gen)
?: =(doz gen)
~_ (show [%c 'hoon'] [%q gen])
~> %mean.'play-open'
!!
loop(gen doz)
==
::
++ replace
|= [a=(unit [term type]) b=(trap (unit [term type]))]
^- (unit [term type])
?~(a $:b a)
::
++ both
|= [a=hoon b=hoon]
(replace loop(gen a) |.(loop(gen b)))
::
++ bell
|= [a=hoon b=hoon c=hoon]
%+ replace loop(gen a)
|. %+ replace loop(gen b, sut (~(gain ut sut) a))
|. loop(gen c, sut (~(lose ut sut) a))
::
++ spec-and-hoon
|= [a=spec b=hoon]
(replace (find-type-in-spec sut a) |.(loop(gen b)))
::
++ change
|= [a=hoon b=hoon]
(replace loop(gen a) |.(loop(gen b, sut (~(play ut sut) a))))
::
++ grow
|= m=(map term tome)
=/ tomes ~(tap by m)
|- ^- (unit [term type])
=* outer-loop $
?~ tomes
~
=/ arms ~(tap by q.q.i.tomes)
|- ^- (unit [term type])
=* inner-loop $
?~ arms
outer-loop(tomes t.tomes)
%+ replace
loop(gen q.i.arms, sut (~(play ut sut) gen))
|. inner-loop(arms t.arms)
--
::
:: Not implemented yet. I wonder whether we should modify types found
:: in spec mode such that if it's a mold that produces a type, it
:: should just display the type and not that it's technically a
:: function.
::
++ find-type-in-spec
|= [sut=type pec=spec]
^- (unit [term type])
~
::
++ get-id-sym
|= [pos=@ud =tape]
%^ get-id pos tape
^- $-(nail (like (unit @t)))
;~(sfix (punt sym) (star ;~(pose prn (just `@`10))))
::
++ get-id-cord
|= [pos=@ud =tape]
%^ get-id pos tape
^- $-(nail (like (unit @t)))
;~(sfix (punt (cook crip (star prn))) (star ;~(pose prn (just `@`10))))
::
++ get-id
|= [pos=@ud txt=tape seek=$-(nail (like (unit @t)))]
^- [forward=(unit @t) backward=(unit @t) id=(unit @t)]
=/ forward=(unit @t)
(scan (slag pos txt) seek)
=/ backward=(unit @t)
%- (lift |=(t=@t (swp 3 t)))
(scan (flop (scag pos txt)) seek)
=/ id=(unit @t)
?~ forward
?~ backward
~
`u.backward
?~ backward
`u.forward
`(cat 3 u.backward u.forward)
[forward backward id]
::
:: Insert magic marker in hoon source at the given position.
::
++ insert-magic
|= [pos=@ud txt=tape]
^- [back-pos=@ud fore-pos=@ud txt=tape]
:: Find beg-pos by searching backward to where the current term
:: begins
=+ (get-id-sym pos txt)
=/ back-pos
?~ backward
pos
(sub pos (met 3 u.backward))
=/ fore-pos
?~ forward
pos
(add pos (met 3 u.forward))
:+ back-pos fore-pos
:: Insert "magic-spoon" marker so +find-type can identify where to
:: stop.
::
;: weld
(scag back-pos txt)
?: &(?=(~ id) ?=([%'.' *] (slag pos txt)))
"magic-fork"
"magic-spoon"
?~ id
""
"."
(slag back-pos txt)
"\0a"
==
::
:: Produce the longest possible advance without choosing between
:: matches.
::
:: Takes a +hoon which has already has a magic-spoon marker. Useful if
:: you want to handle your own parsing.
::
++ advance-hoon
|= [sut=type gen=hoon]
%+ bind (find-type-mule sut gen)
|= [id=term typ=type]
=/ matches=(list (option type))
(search-prefix id (get-identifiers typ))
(longest-match matches)
::
:: Same as +advance-hoon, but takes a position and text directly.
::
++ advance-tape
|= [sut=type pos=@ud code=tape]
(advance-hoon sut (scan txt:(insert-magic pos code) vest))
::
:: Produce a list of matches.
::
:: Takes a +hoon which has already has a magic-spoon marker. Useful if
:: you want to handle your own parsing.
::
++ tab-list-hoon
|= [sut=type gen=hoon]
^- (unit (list (option type)))
%+ bind (find-type-mule sut gen)
|= [id=term typ=type]
(search-prefix id (get-identifiers typ))
::
:: Same as +advance-hoon, but takes a position and text directly.
::
++ tab-list-tape
|= [sut=type pos=@ud code=tape]
^- (each (unit (list (option type))) [row=@ col=@])
~? > debug %start-magick
=/ magicked txt:(insert-magic pos code)
~? > debug %start-parsing
=/ res (lily magicked (language-server-parser *path))
?: ?=(%| -.res)
~? > debug [%parsing-error p.res]
[%| p.res]
:- %&
~? > debug %parsed-good
((cury tab-list-hoon sut) hoon:`pile:clay`p.res)
::
:: Generators
++ tab-generators
|= [pfix=path app=(unit term) gens=(list term)]
^- (list (option tank))
%+ turn gens
|= gen=term
^- (option tank)
=/ pax=path
(weld pfix ~[gen %hoon])
=/ file
.^(@t %cx pax)
:_ (render-help file)
?~ app
(cat 3 '+' gen)
?: =(%hood u.app)
(cat 3 '|' gen)
:((cury cat 3) ':' u.app '|' gen)
:: Stolen from +help
++ render-help
|= a=@t
^- tank
:- %leaf
=/ c (to-wain:format a)
?~ c "~"
?. =(':: ' (end [3 4] i.c))
"<undocumented>"
(trip i.c)
--

1
pkg/arvo/lib/language-server/complete.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/language-server/complete.hoon

484
pkg/arvo/lib/language-server/easy-print.hoon
View File

@ -1,484 +0,0 @@
:: Fast type printing that's easy on the eyes or your money back
::
=> |%
+$ cape [p=(map @ud wine) q=wine]
+$ wine
$@ $? %noun
%path
%type
%void
%wall
%wool
%yarn
==
$% [%mato p=term]
[%gate p=hoon q=type r=wine]
[%core p=(list @ta) q=wine]
[%face p=term q=wine]
[%list p=term q=wine]
[%pear p=term q=@]
[%bcwt p=(list wine)]
[%plot p=(list wine)]
[%stop p=@ud]
[%tree p=term q=wine]
[%unit p=term q=wine]
==
--
|_ sut=type
++ dash
|= [mil=tape lim=char lam=tape]
^- tape
=/ esc (~(gas in *(set @tD)) lam)
:- lim
|- ^- tape
?~ mil [lim ~]
?: ?| =(lim i.mil)
=('\\' i.mil)
(~(has in esc) i.mil)
==
['\\' i.mil $(mil t.mil)]
?: (lte ' ' i.mil)
[i.mil $(mil t.mil)]
['\\' ~(x ne (rsh 2 i.mil)) ~(x ne (end 2 i.mil)) $(mil t.mil)]
::
++ deal |=(lum=* (dish dole lum))
++ dial
|= ham=cape
=+ gid=*(set @ud)
=| top-level=? :: don't need circumfix punctuation
=< `tank`-:$
|%
++ many
|= haz=(list wine)
^- [(list tank) (set @ud)]
?~ haz [~ gid]
=^ mor gid $(haz t.haz)
=^ dis gid ^$(q.ham i.haz)
[[dis mor] gid]
::
++ $
^- [tank (set @ud)]
?- q.ham
%noun :_(gid [%leaf '*' ~])
%path :_(gid [%leaf '/' ~])
%type :_(gid [%leaf '#' 't' ~])
%void :_(gid [%leaf '#' '!' ~])
%wool :_(gid [%leaf '*' '"' '"' ~])
%wall :_(gid [%leaf '*' '\'' '\'' ~])
%yarn :_(gid [%leaf '"' '"' ~])
[%mato *] :_(gid [%leaf '@' (trip p.q.ham)])
[%gate *]
=^ sam gid
?. ?=([%plot * * *] r.q.ham)
?: ?=(%plot -.r.q.ham)
%- (slog -:$(q.ham r.q.ham) ~)
`gid
`gid
[`u=- +]:$(q.ham i.p.r.q.ham, top-level |)
:_ gid
:+ %rose
:- ?> ?=(%core -.q.q.ham)
?: ?=(%dry q.p.q.q.q.ham)
" -> "
" ~> "
?: top-level
["" ""]
["(" ")"]
:+ ?~(sam leaf+"_" u.sam)
=/ res (mule |.((~(play ut q.q.ham) p.q.ham)))
?- -.res
%& duck(sut p.res)
%| leaf+"###"
==
~
::
[%core *]
=^ sam gid
?. ?=([%plot * * ~] q.q.ham)
`gid
[`u=- +]:$(q.ham i.p.q.q.ham)
:_ gid
?~ sam
:+ %rose
[[' ' ~] ['<' ~] ['>' ~]]
|- ^- (list tank)
?~ p.q.ham ~
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
:+ %rose
[" -> " "" ""]
:+ u.sam
:+ %rose
[[' ' ~] ['<' ~] ['>' ~]]
|- ^- (list tank)
?~ p.q.ham ~
[[%leaf (rip 3 i.p.q.ham)] $(p.q.ham t.p.q.ham)]
~
::
[%face *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] cox ~])
::
[%list *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
[%bcwt *]
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['?' '(' ~] [')' ~]] coz])
::
[%plot *]
=^ coz gid (many p.q.ham)
:_(gid [%rose [[' ' ~] ['[' ~] [']' ~]] coz])
::
[%pear *]
:_(gid [%leaf '$' ~(rend co [%$ p.q.ham q.q.ham])])
::
[%stop *]
=+ num=~(rend co [%$ %ud p.q.ham])
?: (~(has in gid) p.q.ham)
:_(gid [%leaf '#' num])
=^ cox gid
%= $
gid (~(put in gid) p.q.ham)
q.ham (~(got by p.ham) p.q.ham)
==
:_(gid [%palm [['.' ~] ~ ~ ~] [%leaf ['^' '#' num]] cox ~])
::
[%tree *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
[%unit *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
==
--
::
++ dish !:
|= [ham=cape lum=*] ^- tank
~| [%dish-h ?@(q.ham q.ham -.q.ham)]
~| [%lump lum]
~| [%ham ham]
%- need
=| gil=(set [@ud *])
|- ^- (unit tank)
?- q.ham
%noun
%= $
q.ham
?: ?=(@ lum)
[%mato %$]
:- %plot
|- ^- (list wine)
[%noun ?:(?=(@ +.lum) [[%mato %$] ~] $(lum +.lum))]
==
::
%path
:- ~
:+ %rose
[['/' ~] ['/' ~] ~]
|- ^- (list tank)
?~ lum ~
?@ lum !!
?> ?=(@ -.lum)
[[%leaf (rip 3 -.lum)] $(lum +.lum)]
::
%type
=+ tyr=|.((dial dole))
=+ vol=tyr(sut lum)
=+ cis=;;(tank .*(vol [%9 2 %0 1]))
:^ ~ %palm
[~ ~ ~ ~]
[[%leaf '#' 't' '/' ~] cis ~]
::
%wall
:- ~
:+ %rose
[[' ' ~] ['<' '|' ~] ['|' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[[%leaf (trip ;;(@ -.lum))] $(lum +.lum)]
::
%wool
:- ~
:+ %rose
[[' ' ~] ['<' '<' ~] ['>' '>' ~]]
|- ^- (list tank)
?~ lum ~
?@ lum !!
[(need ^$(q.ham %yarn, lum -.lum)) $(lum +.lum)]
::
%yarn
[~ %leaf (dash (tape lum) '"' "\{")]
::
%void
~
::
[%mato *]
?. ?=(@ lum)
~
:+ ~
%leaf
?+ (rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
~(rend co [%$ p.q.ham lum])
%$ ~(rend co [%$ %ud lum])
%t (dash (rip 3 lum) '\'' ~)
%tas ['%' ?.(=(0 lum) (rip 3 lum) ['$' ~])]
==
::
[%gate *]
!!
::
[%core *]
:: XX needs rethinking for core metal
:: ?. ?=(^ lum) ~
:: => .(lum `*`lum)
:: =- ?~(tok ~ [~ %rose [[' ' ~] ['<' ~] ['>' ~]] u.tok])
:: ^= tok
:: |- ^- (unit (list tank))
:: ?~ p.q.ham
:: =+ den=^$(q.ham q.q.ham)
:: ?~(den ~ [~ u.den ~])
:: =+ mur=$(p.q.ham t.p.q.ham, lum +.lum)
:: ?~(mur ~ [~ [[%leaf (rip 3 i.p.q.ham)] u.mur]])
[~ (dial ham)]
::
[%face *]
=+ wal=$(q.ham q.q.ham)
?~ wal
~
[~ %palm [['=' ~] ~ ~ ~] [%leaf (trip p.q.ham)] u.wal ~]
::
[%list *]
?: =(~ lum)
[~ %leaf '~' ~]
=- ?~ tok
~
[~ %rose [[' ' ~] ['~' '[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?: ?=(@ lum)
?.(=(~ lum) ~ [~ ~])
=+ [for=^$(q.ham q.q.ham, lum -.lum) aft=$(lum +.lum)]
?. &(?=(^ for) ?=(^ aft))
~
[~ u.for u.aft]
::
[%bcwt *]
|- ^- (unit tank)
?~ p.q.ham
~
=+ wal=^$(q.ham i.p.q.ham)
?~ wal
$(p.q.ham t.p.q.ham)
wal
::
[%plot *]
=- ?~ tok
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] u.tok]
^= tok
|- ^- (unit (list tank))
?~ p.q.ham
~
?: ?=([* ~] p.q.ham)
=+ wal=^$(q.ham i.p.q.ham)
?~(wal ~ [~ [u.wal ~]])
?@ lum
~
=+ gim=^$(q.ham i.p.q.ham, lum -.lum)
?~ gim
~
=+ myd=$(p.q.ham t.p.q.ham, lum +.lum)
?~ myd
~
[~ u.gim u.myd]
::
[%pear *]
?. =(lum q.q.ham)
~
=. p.q.ham
(rash p.q.ham ;~(sfix (cook crip (star low)) (star hig)))
=+ fox=$(q.ham [%mato p.q.ham])
?> ?=([~ %leaf ^] fox)
?: ?=(?(%n %tas) p.q.ham)
fox
[~ %leaf '%' p.u.fox]
::
[%stop *]
?: (~(has in gil) [p.q.ham lum]) ~
=+ kep=(~(get by p.ham) p.q.ham)
?~ kep
~|([%stop-loss p.q.ham] !!)
$(gil (~(put in gil) [p.q.ham lum]), q.ham u.kep)
::
[%tree *]
=- ?~ tok
~
[~ %rose [[' ' ~] ['{' ~] ['}' ~]] u.tok]
^= tok
=+ tuk=*(list tank)
|- ^- (unit (list tank))
?: =(~ lum)
[~ tuk]
?. ?=([n=* l=* r=*] lum)
~
=+ rol=$(lum r.lum)
?~ rol
~
=+ tim=^$(q.ham q.q.ham, lum n.lum)
?~ tim
~
$(lum l.lum, tuk [u.tim u.rol])
::
[%unit *]
?@ lum
?.(=(~ lum) ~ [~ %leaf '~' ~])
?. =(~ -.lum)
~
=+ wal=$(q.ham q.q.ham, lum +.lum)
?~ wal
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
==
::
++ doge
|= ham=cape
=- ?+ woz woz
[%list * [%mato %'ta']] %path
[%list * [%mato %'t']] %wall
[%list * [%mato %'tD']] %yarn
[%list * %yarn] %wool
==
^= woz
^- wine
?. ?=([%stop *] q.ham)
?: ?& ?= [%bcwt [%pear %n %0] [%plot [%pear %n %0] [%face *] ~] ~]
q.ham
=(1 (met 3 p.i.t.p.i.t.p.q.ham))
==
[%unit =<([p q] i.t.p.i.t.p.q.ham)]
q.ham
=+ may=(~(get by p.ham) p.q.ham)
?~ may
q.ham
=+ nul=[%pear %n 0]
?. ?& ?=([%bcwt *] u.may)
?=([* * ~] p.u.may)
|(=(nul i.p.u.may) =(nul i.t.p.u.may))
==
q.ham
=+ din=?:(=(nul i.p.u.may) i.t.p.u.may i.p.u.may)
?: ?& ?=([%plot [%face *] [%face * %stop *] ~] din)
=(p.q.ham p.q.i.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
==
:+ %list
(cat 3 p.i.p.din p.i.t.p.din)
q.i.p.din
?: ?& ?= $: %plot
[%face *]
[%face * %stop *]
[[%face * %stop *] ~]
==
din
=(p.q.ham p.q.i.t.p.din)
=(p.q.ham p.q.i.t.t.p.din)
=(1 (met 3 p.i.p.din))
=(1 (met 3 p.i.t.p.din))
=(1 (met 3 p.i.t.t.p.din))
==
:+ %tree
%^ cat
3
p.i.p.din
(cat 3 p.i.t.p.din p.i.t.t.p.din)
q.i.p.din
q.ham
::
++ dole
^- cape
=+ gil=*(set type)
=+ dex=[p=*(map type @) q=*(map @ wine)]
=< [q.p q]
|- ^- [p=[p=(map type @) q=(map @ wine)] q=wine]
=- [p.tez (doge q.p.tez q.tez)]
^= tez
^- [p=[p=(map type @) q=(map @ wine)] q=wine]
?: (~(meet ut sut) -:!>(*type))
[dex %type]
?- sut
%noun [dex sut]
%void [dex sut]
[%atom *] [dex ?~(q.sut [%mato p.sut] [%pear p.sut u.q.sut])]
[%cell *]
=+ hin=$(sut p.sut)
=+ yon=$(dex p.hin, sut q.sut)
:- p.yon
:- %plot
?:(?=([%plot *] q.yon) [q.hin p.q.yon] [q.hin q.yon ~])
::
[%core *]
?: ?=([[%$ * [[%$ @ *] ~ ~]] ~ ~] q.r.q.sut)
=/ dad $(sut p.sut)
:- p.dad
~! q.r.q.sut
[%gate q.n.q.q.n.q.r.q.sut sut(r.p.q %gold) q.dad]
=+ yad=$(sut p.sut)
:- p.yad
=+ ^= doy ^- [p=(list @ta) q=wine]
?: ?=([%core *] q.yad)
[p.q.yad q.q.yad]
[~ q.yad]
:- %core
:_ q.doy
:_ p.doy
%^ cat 3
%~ rent co
:+ %$ %ud
%- ~(rep by (~(run by q.r.q.sut) |=(tome ~(wyt by q.+<))))
|=([[@ a=@u] b=@u] (add a b))
%^ cat 3
?-(r.p.q.sut %gold '.', %iron '|', %lead '?', %zinc '&')
=+ gum=(mug q.r.q.sut)
%+ can 3
:~ [1 (add 'a' (mod gum 26))]
[1 (add 'a' (mod (div gum 26) 26))]
[1 (add 'a' (mod (div gum 676) 26))]
==
::
[%hint *]
$(sut q.sut)
::
[%face *]
=+ yad=$(sut q.sut)
?^(p.sut yad [p.yad [%face p.sut q.yad]])
::
[%fork *]
=+ yed=(sort ~(tap in p.sut) aor)
=- [p [%bcwt q]]
|- ^- [p=[p=(map type @) q=(map @ wine)] q=(list wine)]
?~ yed
[dex ~]
=+ mor=$(yed t.yed)
=+ dis=^$(dex p.mor, sut i.yed)
[p.dis q.dis q.mor]
::
[%hold *]
=+ hey=(~(get by p.dex) sut)
?^ hey
[dex [%stop u.hey]]
?: (~(has in gil) sut)
=+ dyr=+(~(wyt by p.dex))
[[(~(put by p.dex) sut dyr) q.dex] [%stop dyr]]
=+ rom=$(gil (~(put in gil) sut), sut ~(repo ut sut))
=+ rey=(~(get by p.p.rom) sut)
?~ rey
rom
[[p.p.rom (~(put by q.p.rom) u.rey q.rom)] [%stop u.rey]]
==
::
++ duck (dial dole)
--

1
pkg/arvo/lib/language-server/easy-print.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/language-server/easy-print.hoon

301
pkg/arvo/lib/language-server/json.hoon
View File

@ -1,301 +0,0 @@
/- lsp=language-server
|%
::
++ util
|%
++ get-json-string
|= [jon=(map @t json) key=@t]
^- (unit cord)
=/ cord-jon=(unit json)
(~(get by jon) key)
?~ cord-jon
~
?> ?=([%s *] u.cord-jon)
`p.u.cord-jon
--
::
::
++ dejs
=, dejs:format
|%
++ request
|= jon=json
?> ?=([%o *] jon)
=/ method=cord
%- method
(trip (need (get-json-string:util p.jon 'method')))
=/ id=cord
(need (get-json-string:util p.jon 'id'))
=/ params=json
(~(got by p.jon) 'params')
^- all:request:lsp
|^
?+ method [%unknown jon]
%text-document--hover (text-document--hover params id)
%text-document--completion (text-document--completion params id)
==
::
++ text-document--hover
|= [params=json id=cord]
^- text-document--hover:request:lsp
:+ %text-document--hover
id
%. params
%: ot
position+position
'textDocument'^text-document-id
~
==
::
++ text-document--completion
|= [params=json id=cord]
:+ %text-document--completion id
%. params
%: ot
position+position
'textDocument'^text-document-id
~
==
--
::
++ notification
|= jon=json
?> ?=([%o *] jon)
=/ method=cord
%- method
(trip (need (get-json-string:util p.jon 'method')))
=/ params=json
(~(got by p.jon) 'params')
^- all:notification:lsp
|^
?+ method [%unknown jon]
%text-document--did-change
(text-document--did-change params)
%text-document--did-open
(text-document--did-open params)
%text-document--did-save
(text-document--did-save params)
%text-document--did-close
(text-document--did-close params)
==
::
++ text-document--did-save
|= jon=json
^- text-document--did-save:notification:lsp
?> ?=([%o *] jon)
=/ doc-id
(~(got by p.jon) 'textDocument')
:- %text-document--did-save
(text-document-id doc-id)
::
++ text-document--did-close
|= jon=json
^- text-document--did-close:notification:lsp
?> ?=([%o *] jon)
=/ doc-id
(~(got by p.jon) 'textDocument')
:- %text-document--did-close
(text-document-id doc-id)
::
++ text-document--did-change
|= jon=json
^- text-document--did-change:notification:lsp
:- %text-document--did-change
%. jon
%: ot
'textDocument'^text-document-id
'contentChanges'^text-document-changes
~
==
::
++ text-document--did-open
|= jon=json
^- text-document--did-open:notification:lsp
?> ?=([%o *] jon)
:- %text-document--did-open
(text-document-item (~(got by p.jon) 'textDocument'))
--
:: Utilities
::
++ text-document-item
|= jon=json
^- text-document-item:lsp
%. jon
%: ot
uri+so
version+(mu ni)
text+so
~
==
::
++ text-document-id
%: ou
uri+(un so)
version+(uf ~ (pe ~ ni))
~
==
::
++ text-document-changes
%- ar
%: ou
range+(uf ~ (pe ~ range))
'rangeLength'^(uf ~ (pe ~ ni))
text+(un so)
~
==
::
++ method
|= =tape
^- cord
%- crip %- zing
%+ join "--"
^- (list ^tape)
%+ turn
^- (list (list ^tape))
%+ scan
tape
%+ more
fas
;~ plug
(star low)
(star ;~(plug (cook |=(a=@ (add a 32)) hig) (star low)))
==
|= words=(list ^tape)
^- ^tape
(zing (join "-" words))
::
++ range
%: ot
start+position
end+position
~
==
::
++ position
%: ot
line+ni
character+ni
~
==
--
::
++ enjs
=, enjs:format
|%
++ text-document--publish-diagnostics
|= pub=text-document--publish-diagnostics:notification:lsp
^- json
%: pairs
uri+s+uri.pub
diagnostics+a+(turn diagnostics.pub diagnostic)
~
==
++ notification
|= notification=all:notification:lsp
^- json
=/ params=json
?+ -.notification !!
%text-document--publish-diagnostics
(text-document--publish-diagnostics notification)
==
~! -.notification
=/ method=cord (crip (unparse-method -.notification))
%: pairs
method+s+method
params+params
~
==
::
++ response
|= res=all:response:lsp
^- json
|^
?- -.res
%text-document--hover (text-document--hover res)
%text-document--completion (text-document--completion res)
==
::
++ wrap-in-id
|= [id=cord res=json]
%: pairs
id+s+id
result+res
~
==
++ text-document--hover
|= hov=text-document--hover:response:lsp
%+ wrap-in-id id.hov
%+ frond 'contents'
?~ contents.hov
~
s+u.contents.hov
::
++ text-document--completion
|= com=text-document--completion:response:lsp
%+ wrap-in-id id.com
[%a (turn completion.com completion-item)]
--
++ unparse-method
|= =cord
^- ^tape
%+ rash cord
%+ cook |=(l=(list ^tape) (zing (join "/" l)))
%+ more (jest '--')
%+ cook
|= tapes=(list ^tape)
^- ^tape
?~ tapes ~
%- zing
:- i.tapes
%+ turn t.tapes
|= t=^tape
^- ^tape
?~ t ~
[`@tD`(sub i.t 32) t.t]
%+ more
;~(less (jest '--') hep)
(star alf)
::
++ completion-item
|= com=completion-item:lsp
^- json
%: pairs
label+s+label.com
detail+s+detail.com
kind+(numb kind.com)
'documentation'^s+doc.com
'insertText'^s+insert-text.com
'insertTextFormat'^(numb insert-text-format.com)
~
==
::
++ position
|= =position:lsp
^- json
%: pairs
line+(numb row.position)
character+(numb col.position)
~
==
::
++ range
|= =range:lsp
^- json
%: pairs
start+(position start.range)
end+(position end.range)
~
==
::
++ diagnostic
|= diag=diagnostic:lsp
^- json
%: pairs
range+(range range.diag)
severity+(numb severity.diag)
message+s+message.diag
~
==
::
--
--

1
pkg/arvo/lib/language-server/json.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/language-server/json.hoon

72
pkg/arvo/lib/language-server/parser.hoon
View File

@ -1,72 +0,0 @@
:: lifted directly from ford, should probably be in zuse
=, clay
=< pile-rule
|%
++ pile-rule
|= pax=path
%- full
%+ ifix
:_ gay
:: parse optional /? and ignore
::
;~(plug gay (punt ;~(plug fas wut gap dem gap)))
|^
;~ plug
%+ cook (bake zing (list (list taut)))
%+ rune hep
(most ;~(plug com gaw) taut-rule)
::
%+ cook (bake zing (list (list taut)))
%+ rune lus
(most ;~(plug com gaw) taut-rule)
::
%+ rune tis
;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
::
%+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
::
%+ rune buc
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix cen sym)
==
::
%+ rune tar
;~ (glue gap)
sym
;~(pfix cen sym)
stap
==
::
%+ stag %tssg
(most gap tall:(vang & pax))
==
::
++ pant
|* fel=^rule
;~(pose fel (easy ~))
::
++ mast
|* [bus=^rule fel=^rule]
;~(sfix (more bus fel) bus)
::
++ rune
|* [bus=^rule fel=^rule]
%- pant
%+ mast gap
;~(pfix fas bus gap fel)
--
::
++ taut-rule
%+ cook |=(taut +<)
;~ pose
(stag ~ ;~(pfix tar sym))
;~(plug (stag ~ sym) ;~(pfix tis sym))
(cook |=(a=term [`a a]) sym)
==
--

1
pkg/arvo/lib/language-server/parser.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/language-server/parser.hoon

532
pkg/arvo/lib/language-server/rune-snippet.hoon
View File

@ -1,532 +0,0 @@
/- lsp-sur=language-server
/+ auto=language-server-complete
=>
|%
++ snippet
|= [rune=tape text=tape]
^- json
=, enjs:format
%- pairs
:~ 'label'^(tape rune)
'insertTextFormat'^(numb 2)
'insertText'^(tape text)
==
::
++ runes
^- (list (option:auto tape))
:~ :- '|$'
"""
$\{1:sample}
$\{2:body}
"""
:- '|_'
"""
$\{1:sample}
++ $\{2:arm}
$\{3:body}
--
"""
:- '|:'
"""
$\{1:sample}
$\{2:body}
"""
:- '|%'
"""
++ $\{1:arm}
$\{2:body}
--
"""
:- '|.'
"""
$\{1:body}
"""
:- '|^'
"""
$\{1:body}
::
++ $\{2:arm}
$\{3:body}
--
"""
:- '|-'
"""
$\{1:body}
"""
:- '|~'
"""
$\{1:sample}
$\{2:body}
"""
:- '|*'
"""
$\{1:sample}
$\{2:body}
"""
:- '|='
"""
$\{1:sample}
$\{2:body}
"""
:- '|@'
"""
++ $\{1:arm}
$\{2:body}
--
"""
:- '|?'
"""
$\{1:sample}
"""
::
:- ':_'
"""
$\{1:tail}
$\{2:head}
"""
:- ':^'
"""
$\{1:car}
$\{2:cadr}
$\{3:caddr}
$\{4:cddr}
"""
:- ':-'
"""
$\{1:tail}
$\{2:head}
"""
:- ':+'
"""
$\{1:car}
$\{2:cadr}
$\{3:cddr}
"""
:- ':~'
"""
$\{1:item}
==
"""
:- ':*'
"""
$\{1:item}
==
"""
::
:- '%_'
"""
$\{1:target}
$\{2:wing} $\{3:new-value}
==
"""
:- '%.'
"""
$\{1:arg}
$\{2:gate}
"""
:- '%-'
"""
$\{1:gate}
$\{2:arg}
"""
:- '%:'
"""
$\{1:gate}
$\{2:args}
==
"""
:- '%*'
"""
$\{1:target-wing} $\{2:from}
$\{3:wing} $\{4:new-value}
==
"""
:- '%^'
"""
$\{1:gate}
$\{2:arg1}
$\{3:arg2}
$\{4:arg3}
"""
:- '%+'
"""
$\{1:gate}
$\{2:arg1}
$\{3:arg2}
"""
:- '%~'
"""
$\{1:arm}
$\{2:core}
$\{3:arg}
"""
:- '%='
"""
$\{1:target}
$\{2:wing} $\{3:new-value}
==
"""
::
:- '.^'
"""
$\{1:mold}
$\{2:path}
"""
:- '.+'
"""
$\{1:atom}
"""
:- '.*'
"""
$\{1:subject}
$\{2:formula}
"""
:- '.='
"""
$\{1:a}
$\{2:b}
"""
:- '.?'
"""
$\{1:noun}
"""
::
:- '^|'
"""
$\{1:iron-core}
"""
:- '^.'
"""
$\{1:a}
$\{2:b}
"""
:- '^+'
"""
$\{1:like}
$\{2:body}
"""
:- '^-'
"""
$\{1:type}
$\{2:body}
"""
:- '^&'
"""
$\{1:zinc-core}
"""
:- '^~'
"""
$\{1:constant}
"""
:- '^='
"""
$\{1:face}
$\{2:body}
"""
:- '^?'
"""
$\{1:lead-core}
"""
:- '^*'
"""
$\{1:type}
"""
:- '^:'
"""
$\{1:type}
"""
::
:- '~|'
"""
$\{1:trace}
$\{2:body}
"""
:- '~_'
"""
$\{1:tank}
$\{2:body}
"""
:- '~%'
"""
$\{1:name}
$\{2:parent}
~
$\{3:body}
"""
:- '~/'
"""
$\{1:name}
$\{2:body}
"""
:- '~<'
"""
$\{1:hint}
$\{2:body}
"""
:- '~>'
"""
$\{1:hint}
$\{2:body}
"""
:- '~$'
"""
$\{1:name}
$\{2:body}
"""
:- '~+'
"""
$\{1:body}
"""
:- '~&'
"""
$\{1:printf}
$\{2:body}
"""
:- '~='
"""
$\{1:a}
$\{2:b}
"""
:- '~?'
"""
$\{1:condition}
$\{2:printf}
$\{3:body}
"""
:- '~!'
"""
$\{1:type}
$\{2:body}
"""
::
:- ';='
"""
$\{1:manx}
==
"""
:- ';:'
"""
$\{1:gate}
$\{2:args}
==
"""
:- ';/'
"""
$\{1:tape}
"""
:- ';<'
"""
$\{1:type} bind:m $\{2:body1}
$\{3:body2}
"""
:- ';~'
"""
$\{1:gate}
$\{2:args}
==
"""
:- ';;'
"""
$\{1:type}
$\{2:body}
"""
::
:- '=|'
"""
$\{1:type}
$\{2:body}
"""
:- '=:'
"""
$\{1:wing} $\{2:value}
==
$\{3:body}
"""
:- '=/'
"""
$\{1:face}
$\{2:value}
$\{3:body}
"""
:- '=;'
"""
$\{1:face}
$\{2:body}
$\{3:value}
"""
:- '=.'
"""
$\{1:wing}
$\{2:value}
$\{3:body}
"""
:- '=?'
"""
$\{1:wing} $\{2:condition}
$\{3:value}
$\{4:body}
"""
:- '=<'
"""
$\{1:formula}
$\{2:subject}
"""
:- '=-'
"""
$\{1:body}
$\{2:value}
"""
:- '=>'
"""
$\{1:subject}
$\{2:formula}
"""
:- '=^'
"""
$\{1:face} $\{2:wing}
$\{3:computation}
$\{4:body}
"""
:- '=+'
"""
$\{1:value}
$\{2:body}
"""
:- '=~'
"""
$\{1:body}
"""
:- '=*'
"""
$\{1:alias} $\{2:value}
$\{3:body}
"""
:- '=,'
"""
$\{1:alias}
$\{3:body}
"""
::
:- '?|'
"""
$\{1:condition}
==
"""
:- '?-'
"""
$\{1:case}
$\{2:type} $\{3:value}
==
"""
:- '?:'
"""
$\{1:if}
$\{2:then}
$\{3:else}
"""
:- '?.'
"""
$\{1:if}
$\{2:else}
$\{3:then}
"""
:- '?^'
"""
$\{1:value}
$\{2:if-cell}
$\{3:if-atom}
"""
:- '?<'
"""
$\{1:assertion}
$\{2:body}
"""
:- '?>'
"""
$\{1:assertion}
$\{2:body}
"""
:- '?+'
"""
$\{1:case} $\{2:else}
$\{3:type} $\{4:value}
==
"""
:- '?&'
"""
$\{1:condition}
==
"""
:- '?@'
"""
$\{1:value}
$\{2:if-atom}
$\{3:if-cell}
"""
:- '?~'
"""
$\{1:value}
$\{2:if-null}
$\{3:if-nonnull}
"""
:- '?#'
"""
$\{1:skin}
$\{2:wing}
"""
:- '?='
"""
$\{1:type}
$\{2:wing}
"""
:- '?!'
"""
$\{1:loobean}
"""
::
:- '!,'
"""
*hoon
$\{1:ast}
"""
:- '!>'
"""
$\{1:value}
"""
:- '!;'
"""
$\{1:type}
$\{2:body}
"""
:- '!='
"""
$\{1:body}
"""
:- '!@'
"""
$\{1:wing}
$\{2:if-exists}
$\{3:if-not-exists}
"""
:- '!?'
"""
$\{1:version}
$\{2:body}
"""
:- '!!'
""
==
--
|= rune=tape
^- (list completion-item:lsp-sur)
=? rune =(' ' (snag 0 rune))
(slag 1 rune)
~& rune
%+ turn (search-prefix:auto (crip rune) runes)
|= [name=cord snippet=tape]
^- completion-item:lsp-sur
[name 1 '' '' (crip snippet) 2]

1
pkg/arvo/lib/language-server/rune-snippet.hoon Symbolic link
View File

@ -0,0 +1 @@
../../../base-dev/lib/language-server/rune-snippet.hoon

378
pkg/arvo/lib/pkcs.hoon
View File

@ -1,378 +0,0 @@
/- asn1
/+ primitive-rsa, der
=* rsa primitive-rsa
:::: %/lib/pkcs
|%
:: +rs256: RSA signatures over a sha-256 digest
::
++ rs256
|_ k=key:rsa
:: +emsa:rs256: message digest
::
:: Padded, DER encoded sha-256 hash (EMSA-PKCS1-v1_5).
::
++ emsa
|= m=byts
=/ emlen (met 3 n.pub.k)
=/ pec=spec:asn1
:~ %seq
[%seq [%obj sha-256:obj:asn1] [%nul ~] ~]
[%oct 32 (shay wid.m dat.m)]
==
:: note: this asn.1 digest is rendered raw here, as we require
:: big-endian bytes, and the product of +en:der is little-endian
::
=/ t=(list @D) ~(ren raw:en:der pec)
=/ tlen=@ud (lent t)
?: (lth emlen (add 11 tlen))
~|(%emsa-too-short !!)
=/ ps=(list @D)
(reap (sub emlen (add 3 tlen)) 0xff)
(rep 3 (flop (weld [0x0 0x1 ps] [0x0 t])))
:: +sign:rs256: sign message
::
:: An RSA signature is the primitive decryption of the message hash.
::
++ sign
|=(m=byts (de:rsa (emsa m) k))
:: +verify:rs256: verify signature
::
:: RSA signature verification confirms that the primitive encryption
:: of the signature matches the message hash.
::
++ verify
|= [s=@ m=byts]
=((emsa m) (en:rsa s k))
--
:: |pem: generic PEM implementation (rfc7468)
::
:: PEM is the base64 encoding of DER encoded data, with BEGIN and
:: END labels indicating some type.
::
++ pem
|%
:: +en:pem: PEM encode
::
++ en
|= [lab=@t len=@ud der=@ux]
^- wain
:: XX validate label?
:- (rap 3 ['-----BEGIN ' lab '-----' ~])
=/ a (en:base64:mimes:html len `@`der)
|- ^- wain
?~ a
[(rap 3 ['-----END ' lab '-----' ~]) ~]
[(end [3 64] a) $(a (rsh [3 64] a))]
:: +de:pem: PEM decode
::
++ de
|= [lab=@t mep=wain]
^- (unit [len=@ud der=@ux])
=/ a (sub (lent mep) 2)
?~ mep ~
:: XX validate label?
?. =((rap 3 ['-----BEGIN ' lab '-----' ~]) i.mep) ~
?. =((rap 3 ['-----END ' lab '-----' ~]) (snag a t.mep)) ~
^- (unit [@ @])
(de:base64:mimes:html (rap 3 (scag a t.mep)))
--
:: |pkcs1: RSA asymmetric cryptography (rfc3447)
::
++ pkcs1
|%
:: |spec:pkcs1: ASN.1 specs for RSA keys
::
++ spec
|%
:: |en:spec:pkcs1: ASN.1 encoding for RSA keys
::
++ en
|%
:: +pass:en:spec:pkcs1: encode public key to ASN.1
::
++ pass
|= k=key:rsa
^- spec:asn1
[%seq [%int n.pub.k] [%int e.pub.k] ~]
:: +ring:en:spec:pkcs1: encode private key to ASN.1
::
++ ring
|= k=key:rsa
^- spec:asn1
~| %rsa-need-ring
?> ?=(^ sek.k)
:~ %seq
[%int 0]
[%int n.pub.k]
[%int e.pub.k]
[%int d.u.sek.k]
[%int p.u.sek.k]
[%int q.u.sek.k]
[%int (mod d.u.sek.k (dec p.u.sek.k))]
[%int (mod d.u.sek.k (dec q.u.sek.k))]
[%int (~(inv fo p.u.sek.k) q.u.sek.k)]
==
--
:: |de:spec:pkcs1: ASN.1 decoding for RSA keys
::
++ de
|%
:: +pass:de:spec:pkcs1: decode ASN.1 public key
::
++ pass
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq [%int *] [%int *] ~] a)
~
=* n int.i.seq.a
=* e int.i.t.seq.a
`[[n e] ~]
:: +ring:de:spec:pkcs1: decode ASN.1 private key
::
++ ring
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq *] a) ~
?. ?= $: [%int %0]
[%int *]
[%int *]
[%int *]
[%int *]
[%int *]
*
==
seq.a
~
=* n int.i.t.seq.a
=* e int.i.t.t.seq.a
=* d int.i.t.t.t.seq.a
=* p int.i.t.t.t.t.seq.a
=* q int.i.t.t.t.t.t.seq.a
`[[n e] `[d p q]]
--
--
:: |der:pkcs1: DER encoding for RSA keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
::
++ der
|%
++ en
|%
++ pass |=(k=key:rsa (en:^der (pass:en:spec k)))
++ ring |=(k=key:rsa (en:^der (ring:en:spec k)))
--
++ de
|%
++ pass |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) pass:de:spec))
++ ring |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) ring:de:spec))
--
--
:: |pem:pkcs1: PEM encoding for RSA keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
::
++ pem
|%
++ en
|%
++ pass |=(k=key:rsa (en:^pem 'RSA PUBLIC KEY' (pass:en:der k)))
++ ring |=(k=key:rsa (en:^pem 'RSA PRIVATE KEY' (ring:en:der k)))
--
++ de
|%
++ pass |=(mep=wain (biff (de:^pem 'RSA PUBLIC KEY' mep) pass:de:der))
++ ring |=(mep=wain (biff (de:^pem 'RSA PRIVATE KEY' mep) ring:de:der))
--
--
--
:: |pkcs8: asymmetric cryptography (rfc5208, rfc5958)
::
:: RSA-only for now.
::
++ pkcs8
|%
:: |spec:pkcs8: ASN.1 specs for asymmetric keys
::
++ spec
|%
++ en
|%
:: +pass:spec:pkcs8: public key ASN.1
::
:: Technically not part of pkcs8, but standardized later in
:: the superseding RFC. Included here for symmetry.
::
++ pass
|= k=key:rsa
^- spec:asn1
:~ %seq
[%seq [[%obj rsa:obj:asn1] [%nul ~] ~]]
=/ a=[len=@ud dat=@ux]
(pass:en:der:pkcs1 k)
[%bit (mul 8 len.a) dat.a]
==
:: +ring:spec:pkcs8: private key ASN.1
::
++ ring
|= k=key:rsa
^- spec:asn1
:~ %seq
[%int 0]
[%seq [[%obj rsa:obj:asn1] [%nul ~] ~]]
[%oct (ring:en:der:pkcs1 k)]
==
--
:: |de:spec:pkcs8: ASN.1 decoding for asymmetric keys
::
++ de
|%
:: +pass:de:spec:pkcs8: decode public key ASN.1
::
++ pass
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq [%seq *] [%bit *] ~] a)
~
?. ?& ?=([[%obj *] [%nul ~] ~] seq.i.seq.a)
=(rsa:obj:asn1 obj.i.seq.i.seq.a)
==
~
(pass:de:der:pkcs1 (div len.i.t.seq.a 8) bit.i.t.seq.a)
:: +ring:de:spec:pkcs8: decode private key ASN.1
::
++ ring
|= a=spec:asn1
^- (unit key:rsa)
?. ?=([%seq [%int %0] [%seq *] [%oct *] ~] a)
~
?. ?& ?=([[%obj *] [%nul ~] ~] seq.i.t.seq.a)
=(rsa:obj:asn1 obj.i.seq.i.t.seq.a)
==
~
(ring:de:der:pkcs1 [len oct]:i.t.t.seq.a)
--
--
:: |der:pkcs8: DER encoding for asymmetric keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
:: RSA-only for now.
::
++ der
|%
++ en
|%
++ pass |=(k=key:rsa `[len=@ud dat=@ux]`(en:^der (pass:en:spec k)))
++ ring |=(k=key:rsa `[len=@ud dat=@ux]`(en:^der (ring:en:spec k)))
--
++ de
|%
++ pass |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) pass:de:spec))
++ ring |=([len=@ud dat=@ux] `(unit key:rsa)`(biff (de:^der len dat) ring:de:spec))
--
--
:: |pem:pkcs8: PEM encoding for asymmetric keys
::
:: En(coding) and de(coding) for public (pass) and private (ring) keys.
:: RSA-only for now.
::
++ pem
|%
++ en
|%
++ pass |=(k=key:rsa (en:^pem 'PUBLIC KEY' (pass:en:der k)))
++ ring |=(k=key:rsa (en:^pem 'PRIVATE KEY' (ring:en:der k)))
--
++ de
|%
++ pass |=(mep=wain (biff (de:^pem 'PUBLIC KEY' mep) pass:de:der))
++ ring |=(mep=wain (biff (de:^pem 'PRIVATE KEY' mep) ring:de:der))
--
--
--
:: |pkcs10: certificate signing requests (rfc2986)
::
:: Only implemented for RSA keys with subject-alternate names.
::
++ pkcs10
=> |%
:: +csr:pkcs10: certificate request
::
+$ csr [key=key:rsa hot=(list turf)]
--
|%
:: |spec:pkcs10: ASN.1 specs for certificate signing requests
::
++ spec
|%
:: +en:spec:pkcs10: ASN.1 encoding for certificate signing requests
::
++ en
|= csr
^- spec:asn1
|^ =/ dat=spec:asn1 (info key hot)
:~ %seq
dat
[%seq [[%obj rsa-sha-256:obj:asn1] [%nul ~] ~]]
:: big-endian signature bits
::
:: the signature bitwidth is definitionally the key length
::
:+ %bit
(met 0 n.pub.key)
(swp 3 (~(sign rs256 key) (en:^der dat)))
==
:: +info:en:spec:pkcs10: certificate request info
::
++ info
|= csr
^- spec:asn1
:~ %seq
[%int 0]
[%seq ~]
(pass:en:spec:pkcs8 key)
:: explicit, context-specific tag #0 (extensions)
::
:+ %con
`bespoke:asn1`[| 0]
%~ ren
raw:en:^der
:~ %seq
[%obj csr-ext:obj:asn1]
:~ %set
:~ %seq
:~ %seq
[%obj sub-alt:obj:asn1]
[%oct (en:^der (san hot))]
== == == == ==
:: +san:en:spec:pkcs10: subject-alternate-names
::
++ san
|= hot=(list turf)
^- spec:asn1
:- %seq
%+ turn hot
:: implicit, context-specific tag #2 (IA5String)
:: XX sanitize string?
|=(=turf [%con `bespoke:asn1`[& 2] (trip (en-turf:html turf))])
--
:: |de:spec:pkcs10: ASN.1 decoding for certificate signing requests
++ de !!
--
:: |der:pkcs10: DER encoding for certificate signing requests
::
++ der
|%
++ en |=(a=csr `[len=@ud der=@ux]`(en:^der (en:spec a)))
++ de !! ::|=(a=@ `(unit csr)`(biff (de:^der a) de:spec))
--
:: |pem:pkcs10: PEM encoding for certificate signing requests
::
++ pem
|%
++ en |=(a=csr (en:^pem 'CERTIFICATE REQUEST' (en:der a)))
++ de !! ::|=(mep=wain (biff (de:^pem 'CERTIFICATE REQUEST' mep) de:der))
--
--
--

1
pkg/arvo/lib/pkcs.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/pkcs.hoon

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