ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-09-11 10:46:43 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge tag 'urbit-os-v2.100' into naive/roller

Browse Source
This commit is contained in:
fang 2021-10-26 17:08:03 +02:00
commit 36cd69b6d0
No known key found for this signature in database
GPG Key ID: EB035760C1BBA972
491 changed files with 15834 additions and 13106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.eslintrc.js Normal file
View File

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

2
.gitattributes vendored
View File

@ -2,3 +2,5 @@ bin/* filter=lfs diff=lfs merge=lfs -text
bin/*/* filter=lfs diff=lfs merge=lfs -text
pkg/arvo/**/*.css binary
pkg/arvo/app/naive/logs.eth-logs filter=lfs diff=lfs merge=lfs -text
**/package-lock.json binary merge=theirs

2
.github/actions/glob/Dockerfile vendored
View File

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

2
.github/workflows/chromatic.yml vendored
View File

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

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

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

4
.github/workflows/glob.yml vendored
View File

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

14
.github/workflows/typescript-check.yml vendored
View File

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

1
.gitignore vendored
View File

@ -33,6 +33,7 @@ result-*
# NodeJS
node_modules
.eslintcache
# Haskell
.stack-work

1
.husky/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
_

0
pkg/interface/.husky/post-checkout → .husky/post-checkout
View File

0
pkg/interface/.husky/post-commit → .husky/post-commit
View File

0
pkg/interface/.husky/post-merge → .husky/post-merge
View File

8
.husky/pre-commit Executable file
View File

@ -0,0 +1,8 @@
#!/bin/sh
. "$(dirname "$0")/_/husky.sh"
command -v npx > /dev/null || {
exit 0
}
npx lint-staged

0
pkg/interface/.husky/pre-push → .husky/pre-push
View File

4
bin/brass.pill
View File

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

4
bin/ivory.pill
View File

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

4
bin/solid.pill
View File

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

8
lerna.json Normal file
View File

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

BIN
package-lock.json generated Normal file
View File

Binary file not shown.

21
package.json Normal file
View File

@ -0,0 +1,21 @@
{
"name": "root",
"private": true,
"devDependencies": {
"eslint": "^7.29.0",
"husky": "^6.0.0",
"lerna": "^4.0.0",
"lint-staged": "^11.0.0"
},
"scripts": {
"watch-libs": "lerna run watch --no-private --parallel",
"build-libs": "lerna run build --no-private",
"test": "lerna run test",
"prepare": "husky install .husky",
"bootstrap": "lerna bootstrap",
"build:prod": "lerna run build:prod"
},
"lint-staged": {
"*.{js,ts,tsx}": "eslint --cache --fix"
}
}

79
pkg/arvo/app/aqua.hoon
View File

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

487
pkg/arvo/app/btc-provider.hoon
View File

@ -11,21 +11,25 @@
::
/- *bitcoin, json-rpc, *btc-provider
/+ dbug, default-agent, bl=btc, groupl=group, resource
~% %btc-provider-top ..part ~
|%
+$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
state-2
==
::
+$ state-0 [%0 =host-info =whitelist]
::
+$ card card:agent:gall
::
+$ state-1 [%1 =host-info =whitelist timer=(unit @da)]
+$ state-2 [%2 =host-info =whitelist timer=(unit @da) interval=@dr]
--
%- agent:dbug
=| state-0
=| state-2
=* state -
^- agent:gall
=<
~% %btc-provider-agent ..send-status ~
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
@ -33,13 +37,13 @@
::
++ on-init
^- (quip card _this)
~& > '%btc-provider initialized successfully'
=| wl=^whitelist
:- ~
%_ this
host-info
['' connected=%.n %main block=0 clients=*(set ship)]
whitelist wl(public %.n, kids %.n)
host-info ['' connected=%.n %main block=0 clients=*(set ship)]
whitelist wl(public %.n, kids %.n)
timer ~
interval ~m1
==
::
++ on-save
@ -49,24 +53,144 @@
++ on-load
|= old-state=vase
^- (quip card _this)
~& > '%btc-provider recompiled successfully '
`this(state !<(versioned-state old-state))
=/ old !<(versioned-state old-state)
?- -.old
%2
[~ this(state old)]
::
%1
`this(state [%2 host-info.old whitelist.old timer.old ~m1])
::
%0
:_ this(state [%2 host-info.old whitelist.old ~ ~m1])
?: =('' api-url.host-info.old) ~
~[(start-ping-timer:hc ~s0)]
==
::
++ on-poke
~/ %on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> ?|((team:title our.bowl src.bowl) (is-client:hc src.bowl))
=^ cards state
?+ mark (on-poke:def mark vase)
%btc-provider-command
?> (team:title our.bowl src.bowl)
(handle-command:hc !<(command vase))
(handle-command !<(command vase))
::
%btc-provider-action
(handle-action:hc !<(action vase))
(handle-action !<(action vase))
::
%noun
?. =(q.vase %kick-timer) `state
:_ state(timer `now.bowl)
:* (start-ping-timer ~s0)
?~ timer ~
[[%pass /block-time %arvo %b %rest u.timer] ~]
==
==
[cards this]
::
++ handle-command
|= comm=command
^- (quip card _state)
?- -.comm
%set-credentials
:_ %_ state
host-info [api-url.comm %.n network.comm 0 *(set ship)]
timer `now.bowl
==
:* (start-ping-timer:hc ~s0)
?~ timer ~
[[%pass /block-time %arvo %b %rest u.timer] ~]
==
::
%add-whitelist
:- ~
?- -.wt.comm
%public
state(public.whitelist %.y)
::
%kids
state(kids.whitelist %.y)
::
%users
state(users.whitelist (~(uni in users.whitelist) users.wt.comm))
::
%groups
state(groups.whitelist (~(uni in groups.whitelist) groups.wt.comm))
==
::
%remove-whitelist
=. state
?- -.wt.comm
%public
state(public.whitelist %.n)
::
%kids
state(kids.whitelist %.n)
::
%users
state(users.whitelist (~(dif in users.whitelist) users.wt.comm))
::
%groups
state(groups.whitelist (~(dif in groups.whitelist) groups.wt.comm))
==
clean-client-list
::
%set-interval
`state(interval inte.comm)
==
::
:: +clean-client-list: remove clients who are no longer whitelisted
:: called after a whitelist change
::
++ clean-client-list
^- (quip card _state)
=/ to-kick=(set ship)
%- silt
%+ murn ~(tap in clients.host-info)
|= c=ship ^- (unit ship)
?:((is-whitelisted:hc c) ~ `c)
:_ state(clients.host-info (~(dif in clients.host-info) to-kick))
%+ turn ~(tap in to-kick)
|=(c=ship [%give %kick ~[/clients] `c])
::
:: if not connected, only %ping action is allowed
::
++ handle-action
|= act=action
^- (quip card _state)
:_ state
?. ?|(connected.host-info ?=(%ping -.act))
~[(send-update:hc [%| %not-connected 500] ~)]
:_ ~
%+ req-card act
^- action:rpc-types
?- -.act
%address-info [%get-address-info address.act]
%tx-info [%get-tx-vals txid.act]
%raw-tx [%get-raw-tx txid.act]
%broadcast-tx [%broadcast-tx rawtx.act]
%ping [%get-block-info ~]
%block-info [%get-block-info block.act]
==
::
++ req-card
|= [act=action ract=action:rpc-types]
=/ req=request:http
(gen-request:bl host-info ract)
[%pass (rpc-wire act) %arvo %i %request req *outbound-config:iris]
::
++ rpc-wire
|= act=action
^- wire
/[-.act]/(scot %p src.bowl)/(scot %ux (cut 3 [0 20] eny.bowl))
--
::
++ on-watch
~/ %on-watch
|= pax=path
^- (quip card _this)
:: checking provider permissions before trying to subscribe
@ -83,32 +207,124 @@
==
[%give %fact ~ %json !>(jon)]~
::
?> ?=([%clients *] pax)
?> ?| ?=([%clients ~] pax)
?& ?=([%clients @ ~] pax)
=(src.bowl (slav %p i.t.pax))
==
==
?. (is-whitelisted:hc src.bowl)
~& >>> "btc-provider: blocked client {<src.bowl>}"
[~[[%give %kick ~ ~]] this]
~|("btc-provider: blocked client {<src.bowl>}" !!)
~& > "btc-provider: accepted client {<src.bowl>}"
:- [do-ping:hc]~
this(clients.host-info (~(put in clients.host-info) src.bowl))
`this(clients.host-info (~(put in clients.host-info) src.bowl))
::
++ on-arvo
|= [=wire =sign-arvo]
~/ %on-arvo
|= [wir=wire =sign-arvo]
|^
^- (quip card _this)
:: check for connectivity every 30 seconds
::
?: ?=([%ping-timer *] wire)
:_ this
:~ do-ping:hc
(start-ping-timer:hc ~s30)
?: ?=([%ping-timer *] wir)
`this
?: ?=([%block-ping *] wir)
:_ this(timer `(add now.bowl interval))
:~ do-ping
(start-ping-timer:hc interval)
==
=^ cards state
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%http-response
(handle-rpc-response:hc wire client-response.sign-arvo)
==
?+ +<.sign-arvo (on-arvo:def wir sign-arvo)
%http-response
(handle-rpc-response wir client-response.sign-arvo)
==
[cards this]
::
++ do-ping
^- card
=/ act=action [%ping ~]
:* %pass /ping/[(scot %da now.bowl)] %agent
[our.bowl %btc-provider] %poke
%btc-provider-action !>(act)
==
::
:: Handles HTTP responses from RPC servers. Parses for errors,
:: then handles response. For actions that require collating multiple
:: RPC calls, uses req-card to call out to RPC again if more
:: information is required.
++ handle-rpc-response
|= [=wire response=client-response:iris]
^- (quip card _state)
?. ?=(%finished -.response) `state
=* status status-code.response-header.response
:: handle error types: connection errors, RPC errors (in order)
::
=^ conn-err state
(connection-error status)
?^ conn-err
:_ state(connected.host-info %.n)
:~ (send-status:hc [%disconnected ~] ~)
(send-update:hc [%| u.conn-err] ~)
==
::
%+ handle-rpc-result wire
%- parse-result:rpc:bl
(get-rpc-response:bl response)
::
++ handle-rpc-result
|= [=wire r=result:rpc-types]
^- (quip card _state)
=/ ship=(unit ship)
(slaw %p (snag 1 wire))
?+ -.wire ~|("Unexpected HTTP response" !!)
%address-info
?> ?=([%get-address-info *] r)
:_ state
~[(send-update:hc [%.y %address-info +.r] ship)]
::
%tx-info
?> ?=([%get-tx-vals *] r)
:_ state
~[(send-update:hc [%.y %tx-info +.r] ship)]
::
%raw-tx
?> ?=([%get-raw-tx *] r)
:_ state
~[(send-update:hc [%.y %raw-tx +.r] ship)]
::
%broadcast-tx
?> ?=([%broadcast-tx *] r)
:_ state
~[(send-update:hc [%.y %broadcast-tx +.r] ship)]
::
%ping
?> ?=([%get-block-info *] r)
:_ state(connected.host-info %.y, block.host-info block.r)
:_ ~
%- send-status:hc
:_ ~
?: =(block.host-info block.r)
[%connected network.host-info block.r fee.r]
[%new-block network.host-info block.r fee.r blockhash.r blockfilter.r]
::
%block-info
?> ?=([%get-block-info *] r)
:_ state
~[(send-update:hc [%.y %block-info network.host-info +.r] ship)]
==
::
++ connection-error
|= status=@ud
^- [(unit error) _state]
?+ status [`[%rpc-error ~] state]
%200 [~ state]
%400 [`[%bad-request status] state]
%401 [`[%no-auth status] state(connected.host-info %.n)]
%502 [`[%not-connected status] state(connected.host-info %.n)]
%504 [`[%not-connected status] state(connected.host-info %.n)]
==
--
::
++ on-peek
~/ %on-peek
|= pax=path
^- (unit (unit cage))
?+ pax (on-peek:def pax)
@ -116,7 +332,7 @@
``noun+!>((is-whitelisted:hc (ship (slav %p +>-.pax))))
::
[%x %is-client @t ~]
``noun+!>((is-client (ship (slav %p +>-.pax))))
``noun+!>((is-client:hc (ship (slav %p +>-.pax))))
==
::
++ on-leave on-leave:def
@ -124,187 +340,32 @@
++ on-fail on-fail:def
--
:: helper core
~% %btc-provider-helper ..card ~
|_ =bowl:gall
++ handle-command
|= comm=command
^- (quip card _state)
?- -.comm
%set-credentials
:- :~ do-ping
(start-ping-timer ~s30)
==
%= state
host-info
[api-url.comm connected=%.n network.comm block=0 clients=*(set ship)]
==
::
%add-whitelist
?- -.wt.comm
%public
`state(public.whitelist %.y)
::
%kids
`state(kids.whitelist %.y)
::
%users
`state(users.whitelist (~(uni in users.whitelist) users.wt.comm))
::
%groups
`state(groups.whitelist (~(uni in groups.whitelist) groups.wt.comm))
==
::
%remove-whitelist
=. state
?- -.wt.comm
%public
state(public.whitelist %.n)
::
%kids
state(kids.whitelist %.n)
::
%users
state(users.whitelist (~(dif in users.whitelist) users.wt.comm))
::
%groups
state(groups.whitelist (~(dif in groups.whitelist) groups.wt.comm))
==
clean-client-list
==
:: if not connected, only %ping action is allowed
::
++ handle-action
|= act=action
^- (quip card _state)
?. ?|(connected.host-info ?=(%ping -.act))
~& >>> "Not connected to RPC"
[~[(send-update [%| %not-connected 500])] state]
::
=/ ract=action:rpc-types
?- -.act :: ~|("Invalid action" !!)
%address-info
[%get-address-info address.act]
::
%tx-info
[%get-tx-vals txid.act]
::
%raw-tx
[%get-raw-tx txid.act]
::
%broadcast-tx
[%broadcast-tx rawtx.act]
::
%ping
[%get-block-info ~]
==
[~[(req-card act ract)] state]
::
++ req-card
|= [act=action ract=action:rpc-types]
=| out=outbound-config:iris
=/ req=request:http
(gen-request:bl host-info ract)
[%pass (rpc-wire act) %arvo %i %request req out]
:: wire structure: /action-tas/now
::
++ rpc-wire
|= act=action ^- wire
/[-.act]/[(scot %ux (cut 3 [0 20] eny.bowl))]
::
++ kick-client
|= client=ship
^- (quip card _state)
~& >>> "dropping client {<client>}"
:- ~[[%give %kick ~[/clients] `client]]
state(clients.host-info (~(dif in clients.host-info) (silt ~[client])))
::
:: Handles HTTP responses from RPC servers. Parses for errors, then handles response.
:: For actions that require collating multiple RPC calls, uses req-card to call out
:: to RPC again if more information is required.
::
++ handle-rpc-response
|= [=wire response=client-response:iris]
^- (quip card _state)
?. ?=(%finished -.response) `state
=* status status-code.response-header.response
:: handle error types: connection errors, RPC errors (in order)
::
=^ conn-err state
(connection-error status)
?^ conn-err
:_ state(connected.host-info %.n)
~[(send-status [%disconnected ~]) (send-update [%| u.conn-err])]
::
%+ handle-rpc-result wire
%- parse-result:rpc:bl
(get-rpc-response:bl response)
::
++ connection-error
|= status=@ud
^- [(unit error) _state]
?+ status [`[%rpc-error ~] state]
%200
[~ state]
%400
[`[%bad-request status] state]
%401
[`[%no-auth status] state(connected.host-info %.n)]
%502
[`[%not-connected status] state(connected.host-info %.n)]
%504
[`[%not-connected status] state(connected.host-info %.n)]
==
::
++ handle-rpc-result
|= [=wire r=result:rpc-types]
^- (quip card _state)
?+ -.wire ~|("Unexpected HTTP response" !!)
%address-info
?> ?=([%get-address-info *] r)
:_ state
~[(send-update [%.y %address-info +.r])]
::
%tx-info
?> ?=([%get-tx-vals *] r)
:_ state
~[(send-update [%.y %tx-info +.r])]
::
%raw-tx
?> ?=([%get-raw-tx *] r)
:_ state
~[(send-update [%.y %raw-tx +.r])]
::
%broadcast-tx
?> ?=([%broadcast-tx *] r)
:_ state
~[(send-update [%.y %broadcast-tx +.r])]
::
%ping
?> ?=([%get-block-info *] r)
:_ state(connected.host-info %.y, block.host-info block.r)
?: =(block.host-info block.r)
~[(send-status [%connected network.host-info block.r fee.r])]
~[(send-status [%new-block network.host-info block.r fee.r blockhash.r blockfilter.r])]
==
::
++ send-status
|= =status ^- card
|= [=status ship=(unit ship)]
^- card
%- ?: ?=(%new-block -.status)
~&(>> "%new-block: {<block.status>}" same)
same
[%give %fact ~[/clients] %btc-provider-status !>(status)]
=- [%give %fact ~[-] %btc-provider-status !>(status)]
?~ ship /clients
/clients/(scot %p u.ship)
::
++ send-update
|= =update
|= [=update ship=(unit ship)]
^- card
=+ c=[%give %fact ~[/clients] %btc-provider-update !>(update)]
?: ?=(%.y -.update)
:: ~& >> "prov. update: {<p.update>}"
c
~& >> "prov. err: {<p.update>}"
c
%- ?: ?=(%.y -.update)
same
~&(>> "prov. err: {<p.update>}" same)
=- [%give %fact ~[-] %btc-provider-update !>(update)]
?~ ship /clients
/clients/(scot %p u.ship)
::
++ is-whitelisted
|= user=ship ^- ?
~/ %is-whitelisted
|= user=ship
^- ?
|^
?| public.whitelist
=(our.bowl user)
@ -312,8 +373,10 @@
(~(has in users.whitelist) user)
in-group
==
::
++ is-kid
=(our.bowl (sein:title our.bowl now.bowl user))
::
++ in-group
=/ gs ~(tap in groups.whitelist)
|-
@ -321,35 +384,15 @@
?: (~(is-member groupl bowl) user i.gs)
%.y
$(gs t.gs)
:: .^((unit group:g) %gx ;:(weld /=group-store=/groups p /noun))
--
:: +clean-client-list: remove clients who are no longer whitelisted
:: called after a whitelist change
::
++ clean-client-list
^- (quip card _state)
=/ to-kick=(set ship)
%- silt
%+ murn ~(tap in clients.host-info)
|= c=ship ^- (unit ship)
?:((is-whitelisted c) ~ `c)
:_ state(clients.host-info (~(dif in clients.host-info) to-kick))
%+ turn ~(tap in to-kick)
|=(c=ship [%give %kick ~[/clients] `c])
::
++ is-client
|= user=ship ^- ?
|= user=ship
^- ?
(~(has in clients.host-info) user)
::
++ start-ping-timer
|= interval=@dr ^- card
[%pass /ping-timer %arvo %b %wait (add now.bowl interval)]
::
++ do-ping
|= interval=@dr
^- card
=/ act=action [%ping ~]
:* %pass /ping/[(scot %da now.bowl)] %agent
[our.bowl %btc-provider] %poke
%btc-provider-action !>(act)
==
[%pass /block-ping %arvo %b %wait (add now.bowl interval)]
--

1880
pkg/arvo/app/btc-wallet.hoon
View File

File diff suppressed because it is too large Load Diff

2
pkg/arvo/app/btc-wallet/index.html
View File

@ -26,6 +26,6 @@
<div id="portal-root"></div>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~btc/js/bundle/index.2fa306f66a2d4f9dd6c3.js"></script>
<script src="/~btc/js/bundle/index.050889bac51cbd935dd9.js"></script>
</body>
</html>

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

@ -918,7 +918,7 @@
^- (quip card _state)
:_ state
=- (turn - print:sh-out)
:~ ";view ~host/chat to print messages for a chat you've already jonied."
:~ ";view ~host/chat to print messages for a chat you've already joined."
";flee ~host/chat to stop printing messages for a chat."
"For more details:"
"https://urbit.org/using/operations/using-your-ship/#messaging"

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

@ -233,7 +233,7 @@
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(rolodex)
[%x %all ~] ``noun+!>(`rolodex:store`rolodex)
::
[%x %contact @ ~]
=/ =ship (slav %p i.t.t.path)
@ -245,14 +245,13 @@
::
[%x %allowed-ship @ ~]
=/ =ship (slav %p i.t.t.path)
``noun+!>((~(has in allowed-ships) ship))
``noun+!>(`?`(~(has in allowed-ships) ship))
::
[%x %is-public ~]
``noun+!>(is-public)
``noun+!>(`?`is-public)
::
[%x %allowed-groups ~]
``noun+!>(allowed-groups)
``noun+!>(`(set resource)`allowed-groups)
::
[%x %is-allowed @ @ @ @ ~]
=/ is-personal =(i.t.t.t.t.t.path 'true')

31
pkg/arvo/app/dm-hook.hoon
View File

@ -13,16 +13,18 @@
::
+$ state-0 [%0 base-state-0]
+$ state-1 [%1 base-state-0]
+$ state-2 [%2 base-state-0]
+$ versioned-state
$% state-0
state-1
state-2
==
+$ card card:agent:gall
+$ nodes (map index:store node:store)
++ orm orm:store
--
::
=| state-1
=| state-2
=* state -
%- agent:dbug
^- agent:gall
@ -90,12 +92,23 @@
::
++ on-save !>(state)
++ on-load
|= =vase
|= =old=vase
^- (quip card _this)
=+ !<(old=versioned-state vase)
?: ?=(%1 -.old) `this(state old)
:_ this(state [%1 +.old])
(poke-self:pass noun+!>(%reinit))^~
=+ !<(old=versioned-state old-vase)
=| cards=(list card)
|-
?- -.old
%0
%_($ -.old %1)
%1
%_ $
-.old %2
cards (weld cards (poke-our:pass %goad noun+!>(%force))^~)
==
%2
:_ this(state old)
(weld cards (poke-self:pass noun+!>(%reinit))^~)
==
::
++ on-poke
|= [=mark =vase]
@ -189,7 +202,11 @@
?> =(1 ~(wyt by nodes))
=/ ship-screen (~(get ju screened) src.bowl)
=. ship-screen (~(uni in ship-screen) (normalize-incoming nodes))
`state(screened (~(put by screened) src.bowl ship-screen))
=. screened (~(put by screened) src.bowl ship-screen)
:_ state
=/ =action:hook
[%pendings ~(key by screened)]
(fact:io dm-hook-action+!>(action) ~[/updates])^~
::
++ dm-exists
|= =ship

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

@ -12,8 +12,8 @@
[%glob =glob:glob]
==
::
+$ state-3
$: %3
+$ state-4
$: %4
=configuration:srv
=serving
==
@ -22,7 +22,7 @@
%+ verb |
%- agent:dbug
::
=| state-3
=| state-4
=* state -
^- agent:gall
|_ =bowl:gall
@ -42,6 +42,7 @@
==
:~ (connect /)
(connect /'~landscape')
[%pass /serve-who %arvo %e %serve [~ /who] %home /gen/who/hoon ~]
==
::
++ connect
@ -56,6 +57,7 @@
^- (quip card _this)
|^
=+ !<(old-state=versioned-state old-vase)
=| cards=(list card)
=? old-state ?=(%0 -.old-state)
%= old-state
- %1
@ -79,16 +81,23 @@
^- [^content ? ?]
[content public %.y]
==
?> ?=(%3 -.old-state)
[~ this(state old-state)]
=? cards ?=(%3 -.old-state)
:_ cards
[%pass /serve-who %arvo %e %serve [~ /who] %home /gen/who/hoon ~]
=? old-state ?=(%3 -.old-state)
old-state(- %4)
?> ?=(%4 -.old-state)
[cards this(state old-state)]
::
+$ serving-0 (map url-base=path [=clay=path public=?])
+$ serving-1 (map url-base=path [=content public=?])
+$ serving-3 (map url-base=path [=content public=? single-page=?])
+$ versioned-state
$% state-0
[%1 state-1]
[%2 state-1]
state-3
state-4
==
::
+$ state-0
@ -100,6 +109,11 @@
$: =configuration:srv
serving=serving-1
==
+$ state-3
$: %3
=configuration:srv
serving=serving-3
==
--
::
++ on-poke
@ -205,30 +219,35 @@
?~ ext.req-line site.req-line
(snoc site.req-line u.ext.req-line)
=/ content=(unit [=content suffix=path public=?])
(get-content pax is-file)
(match-content-path pax is-file)
?~ content [not-found:gen %.n]
?- -.content.u.content
%clay
=/ scry-path=path
=/ scry-start=path
:* (scot %p our.bowl)
q.byk.bowl
(scot %da now.bowl)
(lowercase (weld path.content.u.content suffix.u.content))
path.content.u.content
==
=/ scry-path=path
(weld scry-start (lowercase suffix.u.content))
=? scry-path !.^(? %cu scry-path)
(weld scry-start /index/html)
?. .^(? %cu scry-path) [not-found:gen %.n]
?: ?=([~ %woff2] ext.req-line)
:_ public.u.content
[[200 [['content-type' '/font/woff2'] ~]] `.^(octs %cx scry-path)]
=/ file (as-octs:mimes:html .^(@ %cx scry-path))
:_ public.u.content
?+ ext.req-line not-found:gen
[~ %js] (js-response:gen file)
[~ %css] (css-response:gen file)
[~ %png] (png-response:gen file)
[~ %svg] (svg-response:gen file)
[~ %ico] (ico-response:gen file)
=/ ext (rear scry-path)
?+ ext not-found:gen
%js (js-response:gen file)
%css (css-response:gen file)
%png (png-response:gen file)
%svg (svg-response:gen file)
%ico (ico-response:gen file)
::
[~ %html]
%html
%. file
%* . html-response:gen
cache
@ -262,17 +281,8 @@
char
(add char ^~((sub 'a' 'A')))
::
++ get-content
|= [pax=path is-file=?]
^- (unit [content path ?])
=/ first-try (match-content-path pax (~(del by serving) /) is-file)
?^ first-try first-try
=/ root (~(get by serving) /)
?~ root ~
(match-content-path pax (~(gas by *^serving) [[/ u.root] ~]) is-file)
::
++ match-content-path
|= [pax=path =^serving is-file=?]
|= [pax=path is-file=?]
^- (unit [content path ?])
%+ roll
%+ sort ~(tap by serving)
@ -338,6 +348,13 @@
[%x %clay %base %hash ~]
=/ versions (base-hash:version [our now]:bowl)
``hash+!>(?~(versions 0v0 (end [0 25] i.versions)))
::
[%x %our ~]
``json+!>(s+(scot %p our.bowl))
::
[%x %url *]
=/ url t.t.path
``noun+!>((~(has by serving) url))
==
++ on-agent on-agent:def
++ on-fail on-fail:def

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

@ -5,8 +5,8 @@
/- glob, *resource
/+ default-agent, verb, dbug
|%
++ landscape-hash 0v2.i41hn.un6g3.jucd7.rhrah.n0qmv
++ btc-wallet-hash 0v2.3qak4.al612.8m1ig.kg03r.mfide
++ landscape-hash 0v3.sdoer.mnnfi.opjrg.npmcj.utr8l
++ btc-wallet-hash 0v758lj.uf0s5.0nh3m.gunn6.942gj
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ state-1 [%1 =globs:glob]
+$ all-states

60
pkg/arvo/app/graph-push-hook.hoon
View File

@ -26,18 +26,15 @@
state-one
==
::
+$ cached-transform
+$ post-transform
$- indexed-post:store
$-([index:store post:store atom ?] [index:store post:store])
::
+$ cached-permission
+$ post-to-permission
$-(indexed-post:store $-(vip-metadata:metadata permissions:store))
::
:: TODO: come back to this and potentially use send a %t
:: to be notified of validator changes
+$ cache
$: graph-to-mark=(map resource:res (unit mark))
perm-marks=(map [mark @tas] cached-permission)
transform-marks=(map mark cached-transform)
==
::
+$ inflated-state
@ -47,8 +44,6 @@
::
+$ cache-action
$% [%graph-to-mark (pair resource:res (unit mark))]
[%perm-marks (pair (pair mark @tas) cached-permission)]
[%transform-marks (pair mark cached-transform)]
==
--
::
@ -90,13 +85,9 @@
=/ a=cache-action !<(cache-action vase)
=* c +.state
=* graph-to-mark graph-to-mark.c
=* perm-marks perm-marks.c
=* transform-marks transform-marks.c
=. c
?- -.a
%graph-to-mark c(graph-to-mark (~(put by graph-to-mark) p.a q.a))
%perm-marks c(perm-marks (~(put by perm-marks) p.a q.a))
%transform-marks c(transform-marks (~(put by transform-marks) p.a q.a))
==
[~ this(+.state c)]
::
@ -131,10 +122,9 @@
=^ allowed cards (is-allowed-add:hc rid nodes.q.update)
?. allowed
[cards ~]
=/ mark-cached (~(has by graph-to-mark) rid)
=/ mark
?: mark-cached
(~(got by graph-to-mark) rid)
%+ fall
(~(get by graph-to-mark) rid)
(get-mark:gra rid)
?~ mark
[cards `vas]
@ -143,15 +133,9 @@
|%
++ $
^- (quip card (unit vase))
=/ transform-cached (~(has by transform-marks) u.mark)
=/ transform=cached-transform
?: transform-cached
(~(got by transform-marks) u.mark)
=/ =tube:clay
.^(tube:clay (scry:hc %cc %home /[u.mark]/transform-add-nodes))
!< cached-transform
%. !>(*indexed-post:store)
tube
=/ transform
%. *indexed-post:store
.^(post-transform (scry:hc %cf %home /[u.mark]/transform-add-nodes))
=/ [* result=(list [index:store node:store])]
%+ roll
(flatten-node-map ~(tap by nodes.q.update))
@ -164,17 +148,12 @@
update
%+ weld cards
%- zing
:~ ?: mark-cached ~
:~ ?: (~(has by graph-to-mark) rid)
~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%graph-to-mark rid mark]
::
?: transform-cached ~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%transform-marks u.mark transform]
==
::
++ flatten-node-map
@ -316,32 +295,23 @@
|= [=resource:res perm=@t vip=vip-metadata:metadata =indexed-post:store]
^- [permissions:store (list card)]
|^
=/ mark-cached (~(has by graph-to-mark.cache) resource)
=/ mark
?: mark-cached
(~(got by graph-to-mark.cache) resource)
%+ fall
(~(get by graph-to-mark.cache) resource)
(get-mark:gra resource)
?~ mark
[[%no %no %no] ~]
=/ key [u.mark (perm-mark-name perm)]
=/ perms-cached (~(has by perm-marks.cache) key)
=/ convert
?: perms-cached
(~(got by perm-marks.cache) key)
.^(cached-permission (scry %cf %home /[u.mark]/(perm-mark-name perm)))
.^(post-to-permission (scry %cf %home /[u.mark]/(perm-mark-name perm)))
:- ((convert indexed-post) vip)
%- zing
:~ ?: mark-cached ~
:~ ?: (~(has by graph-to-mark.cache) resource)
~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%graph-to-mark resource mark]
::
?: perms-cached ~
:_ ~
%+ poke-self:pass:io %graph-cache-hook
!> ^- cache-action
[%perm-marks [u.mark (perm-mark-name perm)] convert]
==
::
++ perm-mark-name

783
pkg/arvo/app/graph-store.hoon
View File

@ -5,8 +5,8 @@
|%
+$ card card:agent:gall
+$ versioned-state
$% [%0 network:zero:store]
[%1 network:zero:store]
$% [%0 *]
[%1 *]
[%2 network:zero:store]
[%3 network:one:store]
[%4 network:store]
@ -16,21 +16,9 @@
+$ state-5 [%5 network:store]
++ orm orm:store
++ orm-log orm-log:store
+$ debug-input [%validate-graph =resource:store]
::
+$ cache
$: validators=(map mark $-(indexed-post:store indexed-post:store))
==
::
:: TODO: come back to this and potentially use ford runes or otherwise
:: send a %t to be notified of validator changes
+$ inflated-state
$: state-5
cache
==
--
::
=| inflated-state
=| state-5
=* state -
::
%- agent:dbug
@ -42,7 +30,7 @@
def ~(. (default-agent this %|) bowl)
::
++ on-init [~ this]
++ on-save !>(-.state)
++ on-save !>(state)
++ on-load
|= =old=vase
^- (quip card _this)
@ -50,34 +38,8 @@
=| cards=(list card)
|-
?- -.old
%0
=* zro zero-load:upgrade:store
%_ $
-.old %1
::
graphs.old
%- ~(run by graphs.old)
|= [=graph:zero:store q=(unit mark)]
^- [graph:zero:store (unit mark)]
:- (convert-unix-timestamped-graph:zro graph)
?^ q q
`%graph-validator-link
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:zero:store)
==
::
%1
=* zro zero-load:upgrade:store
%_ $
-.old %2
graphs.old (~(run by graphs.old) change-revision-graph:zro)
::
update-logs.old
%- ~(run by update-logs.old)
|=(a=* *update-log:zero:store)
==
%0 !!
%1 !!
::
%2
=* upg upgrade:store
@ -118,7 +80,7 @@
(gas:orm-log ~ [now.bowl logged-update] ~)
==
::
%5 [cards this(-.state old, +.state *cache)]
%5 [cards this(state old)]
==
::
++ on-watch
@ -138,7 +100,7 @@
++ give
|= =action:store
^- (list card)
[%give %fact ~ [%graph-update-2 !>([now.bowl action])]]~
[%give %fact ~ [%graph-update-2 !>(`update:store`[now.bowl action])]]~
--
::
++ on-poke
@ -148,10 +110,9 @@
|^
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%graph-update-2 (graph-update !<(update:store vase))
%noun (debug !<(debug-input vase))
%import (poke-import q.vase)
?+ mark (on-poke:def mark vase)
%graph-update-2 (graph-update !<(update:store vase))
%import (poke-import q.vase)
==
[cards this]
::
@ -204,7 +165,7 @@
==
%- zing
:~ (give [/keys ~] %keys (~(put in ~(key by graphs)) resource))
(give [/updates ~] %add-graph resource *graph:store mark overwrite)
(give [/updates ~] %add-graph resource ~ mark overwrite)
==
::
++ remove-graph
@ -219,10 +180,7 @@
==
::
++ add-nodes
|= $: =time
=resource:store
nodes=(map index:store node:store)
==
|= [=time =resource:store nodes=(map index:store node:store)]
^- (quip card _state)
|^
=/ [=graph:store mark=(unit mark:store)]
@ -274,7 +232,7 @@
?~ index
?=(^ node)
?~ t.index
?=(^ (get:orm graph i.index))
(has:orm graph i.index)
=. node (get:orm graph i.index)
?~ node %.n
?- -.children.u.node
@ -330,7 +288,8 @@
~| "cannot add deleted post"
?> ?=(%& -.post.node)
=* p p.post.node
?~ hash.p node(signatures.p.post *signatures:store)
?~ hash.p
node(signatures.p.post ~)
=/ =validated-portion:store
[parent-hash author.p time-sent.p contents.p]
=/ =hash:store `@ux`(sham validated-portion)
@ -343,24 +302,23 @@
::
=/ parent=node:store
~| "index does not exist to add a node to!"
(need (get:orm graph atom))
(got:orm graph atom)
%_ parent
children
^- internal-graph:store
:- %graph
%_ $
index t.index
index t.index
::
parent-hash
?- -.post.parent
%| `p.post.parent
%& hash.p.post.parent
==
?: ?=(%| -.post.parent)
`p.post.parent
hash.p.post.parent
::
graph
?: ?=(%graph -.children.parent)
p.children.parent
(gas:orm ~ ~)
?. ?=(%graph -.children.parent)
~
p.children.parent
==
==
--
@ -416,7 +374,7 @@
?~ t.index
=/ =node:store
~| "cannot remove index that does not exist {<index>}"
(need (get:orm graph atom))
(got:orm graph atom)
%_ node
post
~| "cannot remove post that has already been removed"
@ -434,7 +392,7 @@
::
=/ parent=node:store
~| "parent index does not exist to remove a node from!"
(need (get:orm graph atom))
(got:orm graph atom)
~| "child index does not exist to remove a node from!"
?> ?=(%graph -.children.parent)
%_ parent
@ -444,10 +402,9 @@
graph p.children.parent
::
parent-hash
?- -.post.parent
%| `p.post.parent
%& hash.p.post.parent
==
?: ?=(%| -.post.parent)
`p.post.parent
hash.p.post.parent
==
==
--
@ -478,7 +435,7 @@
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
(got:orm graph atom)
:: last index in list
::
%^ put:orm
@ -490,7 +447,10 @@
~| "cannot add signatures to a node missing a hash"
?> ?=(^ hash.p.post.node)
~| "signatures did not match public keys!"
?> (are-signatures-valid:sigs our.bowl signatures u.hash.p.post.node now.bowl)
?> %: are-signatures-valid:sigs
our.bowl signatures
u.hash.p.post.node now.bowl
==
node(signatures.p.post (~(uni in signatures) signatures.p.post.node))
~| "child graph does not exist to add signatures to!"
?> ?=(%graph -.children.node)
@ -525,7 +485,7 @@
=* atom i.index
=/ =node:store
~| "node does not exist to add signatures to!"
(need (get:orm graph atom))
(got:orm graph atom)
:: last index in list
::
%^ put:orm
@ -578,7 +538,7 @@
%_ state
archive (~(del by archive) resource)
graphs (~(put by graphs) resource (~(got by archive) resource))
update-logs (~(put by update-logs) resource (gas:orm-log ~ ~))
update-logs (~(put by update-logs) resource ~)
==
::
++ run-updates
@ -599,38 +559,26 @@
%- graph-update
^- update:store
?- -.q.update
%add-graph update(resource.q resource)
%add-nodes update(resource.q resource)
%remove-posts update(resource.q resource)
%add-signatures update(resource.uid.q resource)
%remove-signatures update(resource.uid.q resource)
%add-graph update(resource.q resource)
%add-nodes update(resource.q resource)
%remove-posts update(resource.q resource)
%add-signatures update(resource.uid.q resource)
%remove-signatures update(resource.uid.q resource)
==
$(cards (weld cards crds), updates t.updates)
::
++ give
|= [paths=(list path) update=action:store]
^- (list card)
[%give %fact paths [%graph-update-2 !>([now.bowl update])]]~
[%give %fact paths [%graph-update-2 !>(`update:store`[now.bowl update])]]~
--
::
++ debug
|= =debug-input
^- (quip card _state)
=/ [=graph:store mark=(unit mark:store)]
(~(got by graphs) resource.debug-input)
=^ is-valid state
(validate-graph graph mark)
?> is-valid
[~ state]
::
++ validate-graph
|= [=graph:store mark=(unit mark:store)]
^- [? _state]
?~ mark [%.y state]
=/ has-validator (~(has by validators) u.mark)
?~ mark
[%.y state]
=/ validate=$-(indexed-post:store indexed-post:store)
?: has-validator
(~(got by validators) u.mark)
.^ $-(indexed-post:store indexed-post:store)
%cf
(scot %p our.bowl)
@ -640,11 +588,11 @@
%graph-indexed-post
~
==
:_ state(validators (~(put by validators) u.mark validate))
:_ state
|- ^- ?
?~ graph %.y
%+ roll (tap:orm graph)
|= [[=atom =node:store] out=?]
%+ all:orm graph
|= [=atom =node:store]
^- ?
?& ?| ?=(%| -.post.node)
?=(^ (validate [atom p.post.node]))
@ -658,7 +606,7 @@
++ poke-import
|= arc=*
^- (quip card _state)
=^ cards -.state
=^ cards state
(import:store arc our.bowl)
[cards state]
--
@ -667,417 +615,284 @@
~/ %graph-store-peek
|= =path
^- (unit (unit cage))
|^
?> (team:title our.bowl src.bowl)
?+ path (on-peek:def path)
[%x %graph-mark @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result [~ ~]
``noun+!>(q.u.result)
?+ path (on-peek:def path)
[%x %export ~] ``noun+!>(state)
::
[%x %keys ~]
:- ~ :- ~ :- %graph-update-2
!>(`update:store`[now.bowl [%keys ~(key by graphs)]])
::
[%x %tags ~]
:- ~ :- ~ :- %graph-update-2
!>(`update:store`[now.bowl [%tags ~(key by tag-queries)]])
::
[%x %tag-queries ~]
:- ~ :- ~ :- %graph-update-2
!>(`update:store`[now.bowl [%tag-queries tag-queries]])
::
[%x %graph @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result [~ ~]
[%x %tag-queries *]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
?+ t.t.path (on-peek:def path)
~ [%tag-queries tag-queries]
[%tags ~] [%tags ~(key by tag-queries)]
==
::
:: note: near-duplicate of /x/graph
::
[%x %archive @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ result=(unit marked-graph:store)
(~(get by archive) [ship term])
?~ result
~& no-archived-graph+[ship term]
[~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
[%add-graph [ship term] `graph:store`p.u.result q.u.result %.y]
::
[%x %export ~]
``noun+!>(state)
::
[%x %graph-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ start=(unit atom) (rush i.t.t.t.t.path dem:ag)
=/ end=(unit atom) (rush i.t.t.t.t.t.path dem:ag)
=/ graph=(unit marked-graph:store)
=/ marked-graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ graph [~ ~]
?~ marked-graph [~ ~]
=* graph p.u.marked-graph
=* mark q.u.marked-graph
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(lot:orm p.u.graph start end))
|= [=atom =node:store]
^- [index:store node:store]
[~[atom] node]
!>(`update:store`[now.bowl [%add-graph [ship term] graph mark %.y]])
::
[%x %node-exists @ @ @ *]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ =index:store
(turn t.t.t.t.path (cury slav %ud))
=/ node=(unit node:store)
(get-node ship term index)
``noun+!>(?=(^ node))
[%x %update-log @ @ *]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ update-log
(~(get by update-logs) [ship term])
?~ update-log [~ ~]
:- ~ :- ~ :- %noun
!>
?+ t.t.t.t.path (on-peek:def path)
~ `update-log:store`u.update-log
::
[%latest ~]
^- (unit time)
%+ biff update-log
|= =update-log:store
(bind (pry:orm-log:store update-log) head)
::
[%subset @ @ ~]
^- update-log:store
=* start i.t.t.t.t.t.path
=* end i.t.t.t.t.t.t.path
%^ lot:orm-log
u.update-log
(slaw %da start)
(slaw %da end)
==
::
[%x %node @ @ @ *]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ =index:store
(turn t.t.t.t.path (cury slav %ud))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
:+ %add-nodes
[ship term]
(~(gas by *(map index:store node:store)) [index u.node] ~)
::
[%x %node-siblings ?(%older %younger) @ @ @ *]
=/ older ?=(%older i.t.t.path)
=/ =ship (slav %p i.t.t.t.path)
=/ =term i.t.t.t.t.path
=/ count (slav %ud i.t.t.t.t.t.path)
=/ =index:store
(turn t.t.t.t.t.t.path (cury slav %ud))
=/ parent=index:store
(scag (dec (lent index)) index)
=/ graph
(get-node-children ship term parent)
?~ graph [~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
:: TODO time complexity not desirable
:: replace with custom ordered map functions
%+ turn
=- ?.(older (slag (safe-sub (lent -) count) -) (scag count -))
%- tap:orm
%+ lot:orm u.graph
=/ idx
(snag (dec (lent index)) index)
?:(older [`idx ~] [~ `idx])
|= [=atom =node:store]
^- [index:store node:store]
[(snoc parent atom) node]
::
[%x %shallow-children @ @ *]
=/ newest ?=(%newest i.t.path)
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ =index:store
(turn t.t.t.t.path (cury slav %ud))
=/ children
(get-node-children ship term index)
?~ children [~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:+ now.bowl %add-nodes
:- [ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm u.children)
|= [=atom =node:store]
^- [index:store node:store]
:- (snoc index atom)
node(children [%empty ~])
::
[%x ?(%newest %oldest) @ @ @ *]
=/ newest ?=(%newest i.t.path)
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ count=@ud
(slav %ud i.t.t.t.t.path)
=/ =index:store
(turn t.t.t.t.t.path (cury slav %ud))
=/ children
(get-node-children ship term index)
?~ children [~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
:+ %add-nodes
[ship term]
%- ~(gas by *(map index:store node:store))
%+ turn
%+ scag count
%- ?:(newest same flop)
(tap:orm u.children)
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
::
[%x %node-children-subset @ @ @ @ @ *]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ start=(unit atom) (rush i.t.t.t.t.path dem:ag)
=/ end=(unit atom) (rush i.t.t.t.t.t.path dem:ag)
=/ =index:store
(turn t.t.t.t.t.t.path |=(=cord (slav %ud cord)))
=/ node=(unit node:store) (get-node ship term index)
?~ node [~ ~]
?- -.children.u.node
%empty [~ ~]
%graph
[%x %graph @ @ *]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ marked-graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ marked-graph [~ ~]
=* graph p.u.marked-graph
=* mark q.u.marked-graph
?+ t.t.t.t.path (on-peek:def path)
~
:- ~ :- ~ :- %graph-update-2
!>(`update:store`[now.bowl [%add-graph [ship term] graph mark %.y]])
::
[%mark ~]
``noun+!>(`(unit ^mark)`mark)
::
[%subset ?(%lone %kith) @ @ ~]
=/ start=(unit atom) (rush i.t.t.t.t.t.t.path dem:ag)
=/ end=(unit atom) (rush i.t.t.t.t.t.t.t.path dem:ag)
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
:+ %add-nodes
[ship term]
:^ now.bowl %add-nodes [ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm `graph:store`(lot:orm p.children.u.node end start))
%+ turn (tap:orm (lot:orm graph start end))
|= [=atom =node:store]
^- [index:store node:store]
[(snoc index atom) node]
==
::
[%x %deep-nodes-older-than @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ count=(unit atom) (rush i.t.t.t.t.path dem:ag)
=/ start=(unit atom) (rush i.t.t.t.t.t.path dem:ag)
?: ?=(~ count)
[~ ~]
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result
[~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:- now.bowl
:+ %add-nodes
[ship term]
=* a u.count
=/ b=(list (pair atom node:store))
(tab:orm p.u.result start u.count)
=| c=index:store
=| d=(map index:store node:store)
=| e=@ud
=- d
|- ^- [e=@ud d=(map index:store node:store)]
?: ?|(?=(~ b) =(e a))
[e d]
=* atom p.i.b
=* node q.i.b
=. c (snoc c atom)
?- -.children.node
%empty
$(b t.b, e +(e), d (~(put by d) c node), c (snip c))
:- atom^~
?: ?=(%kith i.t.t.t.t.t.path)
node
node(children [%empty ~])
::
%graph
=/ f $(b (tab:orm p.children.node ~ (sub a e)))
?: =(e.f a) f
%_ $
b t.b
e +(e.f)
d (~(put by d.f) c node(children [%empty ~]))
c (snip c)
==
==
::
[%x %firstborn @ @ @ *]
|^
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ =index:store
(turn t.t.t.t.path (cury slav %ud))
?> ?=(^ index)
=/ result=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ result
[~ ~]
%- (bond |.(`(unit (unit cage))`[~ ~]))
%+ biff
(collect-parents p.u.result index ship term)
(corl some collect-firstborn)
::
++ collect-parents
|= [=graph:store =index:store =ship =term]
^- (unit [node:store index:store (map index:store node:store) ^ship ^term])
=| =(map index:store node:store)
=| =node:store
=| ind=index:store
=/ len (lent index)
|-
?: (gte (lent ind) len)
`[node ind map ship term]
?> ?=(^ index)
=* atom i.index
?. (has:orm graph atom)
~
=: node (got:orm graph atom)
ind (snoc ind atom)
==
?: ?=(%empty -.children.node)
?. (gte (lent ind) len)
~
:- ~
:* node ind
(~(put by map) ind node)
ship term
==
%_ $
index t.index
graph p.children.node
map (~(put by map) ind node(children empty+~))
==
::
++ collect-firstborn
|= [=node:store =index:store map=(map index:store node:store) =ship =term]
^- (unit (unit cage))
?: ?=(%empty -.children.node)
[%node *]
|^
=* pax t.t.t.t.t.path
?+ pax (on-peek:def path)
[%exists ^]
=/ =index:store
(turn t.pax (cury slav %ud))
=/ node (get-node graph index)
``noun+!>(`?`?=(^ node))
::
[%index ?(%lone %kith) ^]
=/ =index:store
(turn t.t.pax (cury slav %ud))
=/ node (get-node graph index)
?~ node [~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
[now.bowl [%add-nodes [ship term] map]]
=/ item=[k=atom v=node:store]
(need (ram:orm p.children.node))
=. index (snoc index k.item)
$(map (~(put by map) index v.item(children empty+~)), node v.item)
--
::
[%x %update-log-subset @ @ @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ start=(unit time) (slaw %da i.t.t.t.t.path)
=/ end=(unit time) (slaw %da i.t.t.t.t.t.path)
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
:: orm-log is ordered backwards, so swap start and end
``noun+!>((lot:orm-log u.update-log end start))
::
[%x %update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ update-log=(unit update-log:store) (~(get by update-logs) [ship term])
?~ update-log [~ ~]
``noun+!>(u.update-log)
::
[%x %peek-update-log @ @ ~]
=/ =ship (slav %p i.t.t.path)
=/ =term i.t.t.t.path
=/ m-update-log=(unit update-log:store) (~(get by update-logs) [ship term])
:- ~ :- ~ :- %noun
!> ^- (unit time)
%+ biff m-update-log
|= =update-log:store
=/ result=(unit [=time =update:store])
(pry:orm-log:store update-log)
(bind result |=([=time update:store] time))
==
::
++ safe-sub
|= [a=@ b=@]
^- @
?: (gte b a)
0
(sub a b)
::
++ get-node-children
|= [=ship =term =index:store]
^- (unit graph:store)
?: ?=(~ index)
=/ graph
(~(get by graphs) [ship term])
?~ graph ~
`p.u.graph
=/ node
(get-node ship term index)
?~ node ~
?: ?=(%empty -.children.u.node)
~
`p.children.u.node
::
++ get-node
|= [=ship =term =index:store]
^- (unit node:store)
=/ parent-graph=(unit marked-graph:store)
(~(get by graphs) [ship term])
?~ parent-graph ~
=/ node=(unit node:store) ~
=/ =graph:store p.u.parent-graph
|-
?~ index
node
?~ t.index
(get:orm graph i.index)
=. node (get:orm graph i.index)
?~ node ~
?- -.children.u.node
%empty ~
%graph $(graph p.children.u.node, index t.index)
:^ now.bowl %add-nodes [ship term]
%- ~(gas by *(map index:store node:store))
:_ ~ :- index
?: ?=(%kith i.t.pax) u.node
u.node(children [%empty ~])
::
[%children ?(%lone %kith) @ @ *]
=/ start=(unit atom) (rush i.t.t.path dem:ag)
=/ end=(unit atom) (rush i.t.t.t.path dem:ag)
=/ =index:store
(turn t.t.t.t.pax (cury slav %ud))
=/ node (get-node graph index)
?: ?& ?=(~ node)
?=(^ index)
==
[~ ~]
=/ children=graph:store
?~ node
graph
?: ?=(%empty -.children.u.node)
~
p.children.u.node
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:^ now.bowl %add-nodes [ship term]
%- ~(gas by *(map index:store node:store))
%+ turn (tap:orm (lot:orm children end start))
|= [=atom =node:store]
^- [index:store node:store]
:- (snoc index atom)
?: ?=(%kith i.t.pax) node
node(children [%empty ~])
::
[%siblings ?(%older %newer %oldest %newest) ?(%lone %kith) @ *]
=/ count (slav %ud i.t.t.t.pax)
=/ =index:store
(turn t.t.t.t.pax (cury slav %ud))
=/ parent=index:store (snip index)
=/ node
(get-node graph ?:(?=(?(%oldest %newest) i.t.pax) index parent))
=/ children=graph:store
?~ node
graph
?: ?=(%empty -.children.u.node)
~
p.children.u.node
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:^ now.bowl %add-nodes [ship term]
%- ~(gas by *(map index:store node:store))
%+ turn
?- i.t.pax
%oldest (scag count (bap:orm children))
%older (tab:orm children `(rear index) count)
%newest (scag count (tap:orm children))
::
%newer
%+ slag (safe-sub (lent -) count)
(tap:orm (lot:orm children ~ `(rear index)))
==
|= [=atom =node:store]
^- [index:store node:store]
:- %- snoc
:_ atom
?:(?=(?(%newest %oldest) i.t.pax) index parent)
?: ?=(%kith i.t.t.pax) node
node(children [%empty ~])
::
[%firstborn ^]
|^
=/ =index:store
(turn t.pax (cury slav %ud))
%- (bond |.(`(unit (unit cage))`[~ ~]))
%+ biff
(collect-parents graph index)
(corl some collect-firstborn)
::
++ collect-parents
|= [=graph:store =index:store]
^- (unit [node:store index:store (map index:store node:store)])
=| =(map index:store node:store)
=| =node:store
=| ind=index:store
=/ len (lent index)
|-
?: (gte (lent ind) len)
`[node ind map]
?> ?=(^ index)
=* atom i.index
?. (has:orm graph atom)
~
=: node (got:orm graph atom)
ind (snoc ind atom)
==
?: ?=(%empty -.children.node)
?. (gte (lent ind) len)
~
`[node ind (~(put by map) ind node)]
%_ $
index t.index
graph p.children.node
map (~(put by map) ind node(children empty+~))
==
::
++ collect-firstborn
|= [=node:store =index:store =(map index:store node:store)]
^- (unit (unit cage))
?: ?=(%empty -.children.node)
:- ~ :- ~ :- %graph-update-2
!>(`update:store`[now.bowl [%add-nodes [ship term] map]])
=/ item=[k=atom v=node:store]
(need (ram:orm p.children.node))
=. index (snoc index k.item)
$(map (~(put by map) index v.item(children empty+~)), node v.item)
--
==
::
++ get-node
|= [=graph:store =index:store]
^- (unit node:store)
=| node=(unit node:store)
|-
?~ index node
?~ t.index (get:orm graph i.index)
=. node (get:orm graph i.index)
?~ node ~
?: ?=(%empty -.children.u.node)
~
$(graph p.children.u.node, index t.index)
::
++ safe-sub
|= [a=@ b=@]
^- @
?:((gte b a) 0 (sub a b))
--
::
[%depth-first @ @ ~]
=/ count=(unit atom) (rush i.t.t.t.t.path dem:ag)
=/ start=(unit atom) (rush i.t.t.t.t.t.path dem:ag)
?: ?=(~ count)
[~ ~]
:- ~ :- ~ :- %graph-update-2
!> ^- update:store
:^ now.bowl %add-nodes [ship term]
=* a u.count
=/ b=(list (pair atom node:store))
(tab:orm graph start u.count)
=| c=index:store
=| d=(map index:store node:store)
=| e=@ud
=- d
|- ^- [e=@ud d=(map index:store node:store)]
?: ?|(?=(~ b) =(e a))
[e d]
=* atom p.i.b
=* node q.i.b
=. c (snoc c atom)
?- -.children.node
%empty
$(b t.b, e +(e), d (~(put by d) c node), c (snip c))
::
%graph
=/ f $(b (tab:orm p.children.node ~ (sub a e)))
?: =(e.f a) f
%_ $
b t.b
e +(e.f)
d (~(put by d.f) c node(children [%empty ~]))
c (snip c)
==
==
==
--
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
::
:: old wire, do nothing
[%graph *] [~ this]
[%validator @ ~] [~ this]
::
[%try-rejoin @ *]
=/ rid=resource:store (de-path:res t.t.wire)
=/ nack-count (slav %ud i.t.wire)
?> ?=([%behn %wake *] sign-arvo)
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
=/ new=^wire [%try-rejoin (scot %ud +(nack-count)) t.t.wire]
:_ this
[%pass new %agent [entity.rid %graph-push-hook] %watch resource+t.t.wire]~
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=([%try-rejoin @ *] wire)
(on-agent:def wire sign)
?. ?=(%watch-ack -.sign)
[~ this]
=/ rid=resource:store (de-path:res t.t.wire)
?~ p.sign
=/ =cage [%pull-hook-action !>([%add entity.rid rid])]
:_ this
:~ [%pass / %agent [our.bowl %graph-pull-hook] %poke cage]
[%pass wire %agent [entity.rid %graph-push-hook] %leave ~]
==
=/ nack-count=@ud (slav %ud i.t.wire)
=/ wakeup=@da
(add now.bowl (mul ~s1 (bex (min 19 nack-count))))
:_ this
[%pass wire %arvo %b %wait wakeup]~
::
++ on-arvo on-arvo:def
++ on-agent on-agent:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--

21
pkg/arvo/app/group-view.hoon
View File

@ -127,8 +127,13 @@
++ hide
|= rid=resource
^- (quip card _state)
=/ =request:view (~(got by joining) rid)
?: ?=(final:view progress.request)
=. joining (~(del by joining) rid)
:_ state
(fact:io group-view-update+!>(`update:view`[%initial joining]) /all ~)^~
:- (fact:io group-view-update+!>([%hide rid]) /all ~)^~
state(joining (~(jab by joining) rid |=(request:view +<(hidden %.y))))
state(joining (~(put by joining) rid request(hidden %.y)))
::
++ has-joined
|= rid=resource
@ -160,7 +165,7 @@
++ tx-progress
|= =progress:view
=. joining
(~(jab by joining) rid |=(request:view +<(progress progress)))
(~(jab by joining) rid |=(req=request:view req(progress progress)))
=; =cage
(emit (fact:io cage /all tx+(en-path:resource rid) ~))
group-view-update+!>([%progress rid progress])
@ -217,10 +222,11 @@
?> ?=(%poke-ack -.sign)
?^ p.sign
(cleanup %no-perms)
=> %- emit
%+ poke-our:(jn-pass-io /pull-groups) %group-pull-hook
pull-hook-action+!>([%add ship rid])
(tx-progress %added)
=. jn-core
(tx-progress %added)
%- emit
%+ poke-our:(jn-pass-io /pull-groups) %group-pull-hook
pull-hook-action+!>([%add ship rid])
::
%pull-groups
?> ?=(%poke-ack -.sign)
@ -283,7 +289,7 @@
::
++ md-fact
|= [=mark =vase]
?. ?=(%metadata-update-1 mark) jn-core
?. ?=(%metadata-update-2 mark) jn-core
=+ !<(=update:metadata vase)
?. ?=(%initial-group -.update) jn-core
?. =(group.update rid) jn-core
@ -324,7 +330,6 @@
|= =progress:view
=. jn-core
(tx-progress progress)
=. joining (~(del by joining) rid)
=. jn-core
(emit (leave-our:(jn-pass-io /groups) %group-store))
(emit (leave-our:(jn-pass-io /md) %metadata-store))

61
pkg/arvo/app/hark-graph-hook.hoon
View File

@ -30,12 +30,12 @@
?> ?=(^ t.p)
.^(mold i.p (scot %p our) i.t.p (scot %da now) t.t.p)
::
++ scry-conversion
++ scry-notif-conversion
|= [[our=@p now=@da] desk=term =mark]
~+
^- $-(indexed-post:graph-store (unit notif-kind:hook))
%^ scry [our now]
tube:clay
/cc/[desk]/[mark]/notification-kind
$-(indexed-post:graph-store (unit notif-kind:hook))
/cf/[desk]/[mark]/notification-kind
--
::
=| state-1
@ -74,21 +74,9 @@
==
:_ this(state old)
=. cards (flop cards)
%+ welp
?: (~(has by wex.bowl) [/graph our.bowl %graph-store])
cards
[watch-graph:ha cards]
%+ turn
^- (list mark)
:~ %graph-validator-chat
%graph-validator-link
%graph-validator-publish
==
|= =mark
^- card
=/ =wire /validator/[mark]
=/ =rave:clay [%sing %c [%da now.bowl] /[mark]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]
?: (~(has by wex.bowl) [/graph our.bowl %graph-store])
cards
[watch-graph:ha cards]
::
++ on-watch
|= =path
@ -214,19 +202,18 @@
%- ~(gas by *(set [resource index:graph-store]))
(turn ~(tap in indices) (lead rid))
:_ state(watching (~(dif in watching) to-remove))
=/ =tube:clay
(get-conversion:ha rid)
=/ convert (get-conversion:ha rid)
%+ roll
~(tap in indices)
|= [=index:graph-store out=(list card)]
=| =indexed-post:graph-store
=. index.p.indexed-post index
=+ !<(u-notif-kind=(unit notif-kind:hook) (tube !>(indexed-post)))
?~ u-notif-kind out
=* notif-kind u.u-notif-kind
=/ notif-kind=(unit notif-kind:hook)
(convert indexed-post)
?~ notif-kind out
=/ =stats-index:store
[%graph rid (scag parent.index-len.notif-kind index)]
?. ?=(%each mode.notif-kind) out
[%graph rid (scag parent.index-len.u.notif-kind index)]
?. ?=(%each mode.u.notif-kind) out
:_ out
(poke-hark %read-each stats-index index)
::
@ -282,11 +269,8 @@
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
::
[%validator @ ~]
:_ this
=* validator i.t.wire
=/ =rave:clay [%next %c [%da now.bowl] /[validator]/notification-kind]
[%pass wire %arvo %c %warp our.bowl [%home `rave]]~
:: no longer necessary
[%validator @ ~] [~ this]
==
++ on-fail on-fail:def
--
@ -298,13 +282,13 @@
::
++ get-conversion
|= rid=resource
^- tube:clay
^- $-(indexed-post:graph-store (unit notif-kind:hook))
=+ %^ scry [our now]:bowl
,mark=(unit mark)
/gx/graph-store/graph-mark/(scot %p entity.rid)/[name.rid]/noun
/gx/graph-store/graph/(scot %p entity.rid)/[name.rid]/mark/noun
?~ mark
|=(v=vase !>(~))
(scry-conversion [our now]:bowl q.byk.bowl u.mark)
|=(=indexed-post:graph-store ~)
(scry-notif-conversion [our now]:bowl q.byk.bowl u.mark)
::
++ give
|= [paths=(list path) =update:hook]
@ -355,8 +339,6 @@
update-core(rid r, updates upds, mark m)
::
++ get-conversion
:: LA: this tube should be cached in %hark-graph-hook state
:: instead of just trying to keep it warm, as the scry overhead is large
~+ (^get-conversion rid)
::
++ abet
@ -410,9 +392,8 @@
?: ?=(%| -.post.node)
update-core
=* pos p.post.node
=+ !< notif-kind=(unit notif-kind:hook)
%- get-conversion
!>(`indexed-post:graph-store`[0 pos])
=/ notif-kind=(unit notif-kind:hook)
(get-conversion [0 pos])
?~ notif-kind
update-core
=/ desc=@t

2
pkg/arvo/app/hark-group-hook.hoon
View File

@ -113,7 +113,7 @@
(group-update !<(update:group-store q.cage.sign))
[cards this]
::
%metadata-update-1
%metadata-update-2
=^ cards state
(metadata-update !<(update:metadata q.cage.sign))
[cards this]

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

@ -422,7 +422,11 @@
%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
@ -566,10 +570,53 @@
(~(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
=/ indices (get-stats-indices rid)
=. poke-core
(give %remove-graph rid)
=. poke-core
@ -583,18 +630,6 @@
((dif-map-by-key ,@da) last-seen indices)
poke-core
::
++ get-stats-indices
%- ~(gas ^in *(set stats-index:store))
%+ skim
;: weld
~(tap ^in ~(key by unreads-count))
~(tap ^in ~(key by last-seen))
~(tap ^in ~(key by unreads-each))
==
|= =stats-index:store
?. ?=(%graph -.stats-index) %.n
=(graph.stats-index rid)
::
++ dif-map-by-key
|* value=mold
|= [=(map stats-index:store value) =(set stats-index:store)]

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

@ -2,7 +2,7 @@
/+ drum=hood-drum, helm=hood-helm, kiln=hood-kiln
|%
+$ state
$: %13
$: %15
drum=state:drum
helm=state:helm
kiln=state:kiln
@ -10,12 +10,14 @@
+$ 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:kiln]
[%8 drum=state:drum helm=state:helm kiln=state:kiln]
[%9 drum=state:drum helm=state:helm kiln=state:kiln]
[%10 drum=state:drum helm=state:helm kiln=state:kiln]
[%11 drum=state:drum helm=state:helm kiln=state:kiln]
[%12 drum=state:drum helm=state:helm kiln=state:kiln]
[%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]
==
+$ any-state-tuple
$: drum=any-state:drum

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

@ -24,6 +24,6 @@
<div id="portal-root"></div>
<script src="/~landscape/js/channel.js"></script>
<script src="/~landscape/js/session.js"></script>
<script src="/~landscape/js/bundle/index.969caa5f68ba7bcf5762.js"></script>
<script src="/~landscape/js/bundle/index.60c063d34a42a08ab440.js"></script>
</body>
</html>

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

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

6
pkg/arvo/app/metadata-pull-hook.hoon
View File

@ -38,7 +38,7 @@
update:metadata
%metadata-update
%metadata-push-hook
1 1
2 2
%.n
==
+$ state-zero
@ -180,7 +180,7 @@
%kick [watch-store^~ state]
::
%fact
?> ?=(%metadata-update-1 p.cage.sign)
?> ?=(%metadata-update-2 p.cage.sign)
=+ !<(=update:metadata q.cage.sign)
?. ?=(%initial-group -.update) `state
`state(previews (~(del by previews) group.update))
@ -325,7 +325,7 @@
%+ turn ~(tap by associations)
|= [=md-resource:metadata =association:metadata]
%+ poke-our:pass:io %metadata-store
:- %metadata-update-1
:- %metadata-update-2
!> ^- update:metadata
[%remove resource md-resource]
::

4
pkg/arvo/app/metadata-push-hook.hoon
View File

@ -14,7 +14,7 @@
update:store
%metadata-update
%metadata-pull-hook
1 1
2 2
==
::
+$ agent (push-hook:push-hook config)
@ -94,7 +94,7 @@
^- (quip card (unit vase))
=/ =update:store !<(update:store vas)
:- ~
?. ?=(?(%add %remove) -.update)
?. ?=(?(%add %remove %edit) -.update)
~
=/ role=(unit (unit role-tag))
(role-for-ship:grp group.update src.bowl)

293
pkg/arvo/app/metadata-store.hoon
View File

@ -24,7 +24,7 @@
:: /group/%path associations for group
::
/- store=metadata-store, pull-hook
/+ default-agent, verb, dbug, resource, *migrate
/+ default-agent, verb, dbug, resource, *migrate, lib=metadata-store
|%
+$ card card:agent:gall
+$ base-state-0
@ -107,6 +107,7 @@
+$ state-9 [%9 base-state-3]
+$ state-10 [%10 base-state-3]
+$ state-11 [%11 base-state-3]
+$ state-12 [%12 base-state-3]
+$ versioned-state
$% state-0
state-1
@ -120,10 +121,11 @@
state-9
state-10
state-11
state-12
==
::
+$ inflated-state
$: state-11
$: state-12
cached-indices
==
--
@ -151,18 +153,145 @@
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?> (team:title [our src]:bowl)
|^
=^ cards state
?+ mark (on-poke:def mark vase)
?(%metadata-action %metadata-update-1)
(poke-metadata-update:mc !<(update:store vase))
?(%metadata-action %metadata-update-2)
(poke-metadata-update !<(update:store vase))
::
%import
(poke-import:mc q.vase)
(poke-import q.vase)
::
%noun ~& +.state `state
==
[cards this]
::
++ poke-metadata-update
|= upd=update:store
^- (quip card _state)
|^
?+ -.upd ~|(%bad-poke !!)
%add (handle-add +.upd)
%remove (handle-remove +.upd)
%edit (handle-edit +.upd)
%initial-group (handle-initial-group +.upd)
==
::
++ handle-add
|= [group=resource =md-resource:store =metadatum:store]
^- (quip card _state)
:- %- send-diff:mc
[%add group md-resource metadatum]
%= state
associations
(~(put by associations) md-resource [group metadatum])
::
app-indices
%+ ~(put ju app-indices)
app-name.md-resource
[group resource.md-resource]
::
resource-indices
(~(put by resource-indices) md-resource group)
::
group-indices
(~(put ju group-indices) group md-resource)
==
::
++ handle-edit
|= [group=resource =md-resource:store =edit-field:store]
^- (quip card _state)
=/ [new-group=resource =metadatum:store]
~| %no-assoc-for-edit
(~(got by associations) md-resource)
~| %cant-reassign-groups
?> =(new-group group)
=. metadatum
?- -.edit-field
%title metadatum(title title.edit-field)
%description metadatum(description description.edit-field)
%color metadatum(color color.edit-field)
%picture metadatum(picture url.edit-field)
%hidden metadatum(hidden hidden.edit-field)
%preview metadatum(preview preview.edit-field)
%vip metadatum(vip vip.edit-field)
==
:- (send-diff:mc %add group md-resource metadatum)
%_ state
associations (~(put by associations) md-resource group metadatum)
==
::
++ handle-remove
|= [group=resource =md-resource:store]
^- (quip card _state)
:- (send-diff:mc [%remove group md-resource])
%= state
associations
(~(del by associations) md-resource)
::
app-indices
%+ ~(del ju app-indices)
app-name.md-resource
[group resource.md-resource]
::
resource-indices
(~(del by resource-indices) md-resource)
::
group-indices
(~(del ju group-indices) group md-resource)
==
::
++ handle-initial-group
|= [group=resource =associations:store]
=/ assocs=(list [=md-resource:store grp=resource =metadatum:store])
~(tap by associations)
:- (send-diff:mc %initial-group group associations)
|-
?~ assocs
state
=, assocs
?> =(group grp.i)
=^ cards state
(handle-add group [md-resource metadatum]:i)
$(assocs t)
--
::
++ poke-import
|= arc=*
^- (quip card _state)
|^
=^ cards state
(on-load:mc !>([%9 (remake-metadata ;;(tree-metadata +.arc))]))
:_ state
%+ weld cards
%+ turn ~(tap in ~(key by group-indices))
|= rid=resource
%- poke-our
?: =(entity.rid our.bowl)
:- %metadata-push-hook
push-hook-action+!>([%add rid])
:- %metadata-pull-hook
pull-hook-action+!>([%add [entity .]:rid])
::
++ poke-our
|= [app=term =cage]
^- card
[%pass / %agent [our.bowl app] %poke cage]
::
+$ tree-metadata
$: associations=(tree [md-resource:store [resource metadatum:store]])
~
==
::
++ remake-metadata
|= tm=tree-metadata
^- base-state-3
:* (remake-map associations.tm)
~
==
--
--
::
++ on-watch
|= =path
@ -172,7 +301,7 @@
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~]
(give %metadata-update-1 !>([%associations associations]))
(give %metadata-update-2 !>([%associations associations]))
::
[%updates ~]
~
@ -180,7 +309,7 @@
[%app-name @ ~]
=/ =app-name:store i.t.path
=/ app-indices (metadata-for-app:mc app-name)
(give %metadata-update-1 !>([%associations app-indices]))
(give %metadata-update-2 !>([%associations app-indices]))
==
[cards this]
::
@ -194,10 +323,18 @@
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y %group-indices ~] ``noun+!>(group-indices)
[%y %app-indices ~] ``noun+!>(app-indices)
[%y %resource-indices ~] ``noun+!>(resource-indices)
[%x %associations ~] ``noun+!>(associations)
[%y %group-indices ~]
``noun+!>(`(jug resource md-resource:store)`group-indices)
::
[%y %app-indices ~]
``noun+!>(`(jug app-name:store [group=resource =resource])`app-indices)
::
[%y %resource-indices ~]
``noun+!>(`(map md-resource:store resource)`resource-indices)
::
[%x %associations ~]
``noun+!>(`associations:store`associations)
::
[%x %app-name @ ~]
=/ =app-name:store i.t.t.path
``noun+!>(`associations:store`(metadata-for-app:mc app-name))
@ -210,6 +347,18 @@
=/ =md-resource:store
[i.t.t.path (de-path:resource t.t.t.path)]
``noun+!>(`(unit association:store)`(~(get by associations) md-resource))
::
[%x %metadata-json @ @ @ @ ~]
=/ =md-resource:store
[i.t.t.path (de-path:resource t.t.t.path)]
=/ assoc=(unit association:store) (~(get by associations) md-resource)
?~ assoc ~
=/ =json
%- pairs:enjs:format
:~ group+s+(enjs-path:resource group.u.assoc)
metadatum+(metadatum:enjs:lib metadatum.u.assoc)
==
``json+!>(json)
::
[%x %resource @ *]
=/ app=term i.t.t.path
@ -235,7 +384,7 @@
=| cards=(list card)
|^
=* loop $
?: ?=(%11 -.old)
?: ?=(%12 -.old)
:- cards
%_ state
associations associations.old
@ -243,6 +392,8 @@
group-indices (rebuild-group-indices associations.old)
app-indices (rebuild-app-indices associations.old)
==
?: ?=(%11 -.old)
$(-.old %12, associations.old (reset-group-hidden associations.old))
?: ?=(%10 -.old)
$(-.old %11, associations.old (hide-dm-assoc associations.old))
?: ?=(%9 -.old)
@ -285,6 +436,17 @@
:: pre-breach, can safely throw away
loop(old *state-8)
::
++ reset-group-hidden
|= assoc=associations:store
^- associations:store
%- ~(gas by *associations:store)
%+ turn ~(tap by assoc)
|= [m=md-resource:store [g=resource met=metadatum:store]]
^- [md-resource:store association:store]
=? hidden.met ?=(%groups app-name.m)
%.n
[m [g met]]
::
++ hide-dm-assoc
|= assoc=associations:store
^- associations:store
@ -395,109 +557,6 @@
ship+path.md-resource
[[path [%graph new-path]] m(module app)]
--
::
:: TODO: refactor into a |^ inside the agent core
++ poke-metadata-update
|= upd=update:store
^- (quip card _state)
?> (team:title [our src]:bowl)
?+ -.upd !!
%add (handle-add +.upd)
%remove (handle-remove +.upd)
%initial-group (handle-initial-group +.upd)
==
::
:: TODO: refactor into a |^ inside the agent core
++ poke-import
|= arc=*
^- (quip card _state)
|^
=^ cards state
(on-load !>([%9 (remake-metadata ;;(tree-metadata +.arc))]))
:_ state
%+ weld cards
%+ turn ~(tap in ~(key by group-indices))
|= rid=resource
%- poke-our
?: =(entity.rid our.bowl)
:- %metadata-push-hook
push-hook-action+!>([%add rid])
:- %metadata-pull-hook
pull-hook-action+!>([%add [entity .]:rid])
::
++ poke-our
|= [app=term =cage]
^- card
[%pass / %agent [our.bowl app] %poke cage]
::
+$ tree-metadata
$: associations=(tree [md-resource:store [resource metadatum:store]])
~
==
::
++ remake-metadata
|= tm=tree-metadata
^- base-state-3
:* (remake-map associations.tm)
~
==
--
::
++ handle-add
|= [group=resource =md-resource:store =metadatum:store]
^- (quip card _state)
:- %- send-diff
[%add group md-resource metadatum]
%= state
associations
(~(put by associations) md-resource [group metadatum])
::
app-indices
%+ ~(put ju app-indices)
app-name.md-resource
[group resource.md-resource]
::
resource-indices
(~(put by resource-indices) md-resource group)
::
group-indices
(~(put ju group-indices) group md-resource)
==
::
++ handle-remove
|= [group=resource =md-resource:store]
^- (quip card _state)
:- (send-diff [%remove group md-resource])
%= state
associations
(~(del by associations) md-resource)
::
app-indices
%+ ~(del ju app-indices)
app-name.md-resource
[group resource.md-resource]
::
resource-indices
(~(del by resource-indices) md-resource)
::
group-indices
(~(del ju group-indices) group md-resource)
==
::
++ handle-initial-group
|= [group=resource =associations:store]
=/ assocs=(list [=md-resource:store grp=resource =metadatum:store])
~(tap by associations)
:- (send-diff %initial-group group associations)
|-
?~ assocs
state
=, assocs
?> =(group grp.i)
=^ cards state
(handle-add group [md-resource metadatum]:i)
$(assocs t)
::
++ metadata-for-app
|= =app-name:store
^- associations:store
@ -533,6 +592,6 @@
++ update-subscribers
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %metadata-update-1 !>(update)]~
[%give %fact ~[pax] %metadata-update-2 !>(update)]~
--
--

433
pkg/arvo/app/notify.hoon Normal file
View File

@ -0,0 +1,433 @@
::
/- *notify, resource, hark-store, post
/+ default-agent, verb, dbug, group, agentio
::
|%
+$ card card:agent:gall
::
+$ provider-state (map term provider-entry)
+$ provider-entry
$: notify-endpoint=@t
binding-endpoint=@t
auth-token=@t
clients=(map ship binding=(unit @t))
=whitelist
==
::
+$ client-state
$: providers=(jug @p term)
==
::
+$ state-0
$: %0
=provider-state
=client-state
==
::
+$ versioned-state
$% state-0
==
::
--
::
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
::
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
do ~(. +> bowl)
io ~(. agentio bowl)
pass pass:io
::
++ on-init
:_ this
[(~(watch-our pass:io /hark) %hark-store /updates)]~
::
++ on-save !>(state)
++ on-load
|= =old=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
?- -.old
%0
:_ this(state old)
?. (~(has by wex.bowl) [/hark our.bowl %hark-store])
~
[(~(watch-our pass:io /hark) %hark-store /updates)]~
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
=^ cards state
?+ mark (on-poke:def mark vase)
%notify-provider-action (handle-provider-action !<(provider-action vase))
%notify-client-action (handle-client-action !<(client-action vase))
==
[cards this]
::
++ handle-provider-action
|= act=provider-action
^- (quip card _state)
?- -.act
%add
?> (team:title our.bowl src.bowl)
=/ new-entry=provider-entry
:* notify.act
binding.act
auth-token.act
~
whitelist.act
==
[~ state(provider-state (~(put by provider-state) service.act new-entry))]
::
%remove
?> (team:title our.bowl src.bowl)
=/ entry=(unit provider-entry) (~(get by provider-state) service.act)
?~ entry
~|("no such service: {<service.act>}" !!)
:_ state(provider-state (~(del by provider-state) service.act))
%+ turn ~(tap by clients.u.entry)
|= [who=@p *]
^- card
(leave-path:pass [who %notify] /notify/(scot %p who)/[service.act])
::
%client-join
=/ entry=(unit provider-entry) (~(get by provider-state) service.act)
?~ entry
~|("no such service: {<service.act>}" !!)
?. (is-whitelisted:do src.bowl u.entry)
~|("permission denied" !!)
=. clients.u.entry (~(put by clients.u.entry) src.bowl ~)
:_ state(provider-state (~(put by provider-state) service.act u.entry))
:~ %: register-binding:do
service.act
u.entry
binding-endpoint.u.entry
src.bowl
address.act
==
%+ watch:pass
[src.bowl %notify]
/notify/(scot %p src.bowl)/[service.act]
==
::
%client-leave
=/ entry=(unit provider-entry) (~(get by provider-state) service.act)
?~ entry
~|("no such service: {<service.act>}" !!)
?. (is-client:do src.bowl u.entry)
~|("permission denied" !!)
=/ client-info=(unit @t) (~(got by clients.u.entry) src.bowl)
=. clients.u.entry (~(del by clients.u.entry) src.bowl)
:_ state(provider-state (~(put by provider-state) service.act u.entry))
?~ client-info
:_ ~
%+ leave-path:pass
[src.bowl %notify]
/notify/(scot %p src.bowl)/[service.act]
:~ %: remove-binding:do
service.act
u.entry
src.bowl
binding-endpoint.u.entry
u.client-info
==
%+ leave-path:pass
[src.bowl %notify]
/notify/(scot %p src.bowl)/[service.act]
==
==
::
++ handle-client-action
|= act=client-action
^- (quip card _state)
?> (team:title our.bowl src.bowl)
?- -.act
%connect-provider
=. providers.client-state
(~(put ju providers.client-state) who.act service.act)
=/ pact=provider-action [%client-join service.act address.act]
:_ state
[(poke:pass [who.act %notify] %notify-provider-action !>(pact))]~
::
%remove-provider
=. providers.client-state
(~(del ju providers.client-state) who.act service.act)
=/ pact=provider-action [%client-leave service.act]
:_ state
[(poke:pass [who.act %notify] %notify-provider-action !>(pact))]~
==
--
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%notify @ @ ~]
=* service i.t.t.path
?. (~(has ju providers.client-state) src.bowl service)
~|("permission denied" !!)
`this
==
::
++ on-leave
|= =path
^- (quip card _this)
`this
::
++ on-peek on-peek:def
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ wire (on-agent:def wire sign)
::
:: subscription from client to their own hark-store
::
[%hark ~]
?+ -.sign (on-agent:def wire sign)
%fact
:_ this
?. ?=(%hark-update p.cage.sign)
~
=+ !<(hark-update=update:hark-store q.cage.sign)
=/ notes=(list notification) (filter-notifications:do hark-update)
?~ notes
~
:: only send the last one, since hark accumulates notifcations
=/ =update [%notification `notification`(snag 0 (flop notes))]
=/ card (fact-all:io %notify-update !>(update))
(drop card)
::
%kick
:_ this
[%pass /hark %agent [our.bowl %hark-store] %watch /updates]~
==
::
:: subscription from provider to client
::
[%agentio-watch %notify @ @ ~]
=/ who (slav %p i.t.t.wire)
=* service i.t.t.t.wire
?+ -.sign (on-agent:def wire sign)
%fact
?> ?=(%notify-update p.cage.sign)
=+ !<(=update q.cage.sign)
:_ this
?- -.update
%notification
=/ entry=(unit provider-entry) (~(get by provider-state) service)
?~ entry
~
[(send-notification:do u.entry who notification.update)]~
==
::
%kick
:_ this
[(watch:pass [who %notify] /notify/(scot %p who)/[service])]~
::
%watch-ack
?~ p.sign
`this
((slog u.p.sign) `this)
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
[%register-binding @ @ @ ~]
=/ who=@p (slav %p i.t.wire)
=* service i.t.t.wire
::
?> ?=(%iris -.sign-arvo)
?> ?=(%http-response +<.sign-arvo)
?> ?=(%finished -.client-response.sign-arvo)
?> ?=(^ full-file.client-response.sign-arvo)
=/ =mime-data:iris u.full-file.client-response.sign-arvo
?> =('application/json' type.mime-data)
=/ jon=json
(fall (rush (@t q.data.mime-data) apex:de-json:html) *json)
=/ [sid=@t message=@t]
%. jon
%- ot:dejs:format
:~ sid+so:dejs:format
message+so:dejs:format
==
::
=/ entry=(unit provider-entry) (~(get by provider-state) service)
:- ~
?~ entry
this
=. clients.u.entry (~(put by clients.u.entry) who `sid)
this(provider-state (~(put by provider-state) service u.entry))
::
[%remove-binding *]
`this
::
[%send-notification *]
`this
==
::
++ on-fail on-fail:def
--
|_ bowl=bowl:gall
::
++ filter-notifications
|= =update:hark-store
^- (list notification)
?+ -.update ~
%more
(zing (turn more.update filter-notifications))
::
%added
?- -.index.update
%graph
?: =(`%graph-validator-dm mark.index.update)
?. ?=(%graph -.contents.notification.update)
~
%+ turn list.contents.notification.update
|= =post:post
^- notification
[graph.index.update index.post]
?: =(`%graph-validator-chat mark.index.update)
=/ hid (group-is-hidden graph.index.update)
?~ hid ~
?. u.hid ~
?. ?=(%graph -.contents.notification.update)
~
%+ turn list.contents.notification.update
|= =post:post
^- notification
[graph.index.update index.post]
~
::
%group ~
==
==
::
++ group-is-hidden
|= =resource:resource
^- (unit ?)
=/ grp=(unit group:group) (~(scry-group group bowl) resource)
?~ grp ~
`hidden.u.grp
::
++ is-whitelisted
|= [who=@p entry=provider-entry]
^- ?
|^
?| public.whitelist.entry
=(our.bowl who)
is-kid
(~(has in users.whitelist.entry) who)
in-group
==
::
++ is-kid
?& kids.whitelist.entry
=(our.bowl (sein:title our.bowl now.bowl who))
==
::
++ in-group
=/ gs ~(tap in groups.whitelist.entry)
|-
?~ gs %.n
?: (~(is-member group bowl) who i.gs)
%.y
$(gs t.gs)
--
::
++ is-client
|= [who=@p entry=provider-entry]
^- ?
(~(has by clients.entry) who)
::
++ post-form
|= [=wire url=@t auth=@t params=(list [@t @t])]
^- card
=/ data
%+ roll
%+ sort params
|= [[p=@t @t] [q=@t @t]]
(aor p q)
|= [[p=@t q=@t] out=_url]
(rap 3 out p q ~)
=/ hmac-sig (hmac-sha1t:hmac:crypto auth data)
=/ b64-sig (en:base64:mimes:html (met 3 hmac-sig) (swp 3 hmac-sig))
=/ headers
:~ ['X-Twilio-Signature' b64-sig]
['Content-Type' 'application/x-www-form-urlencoded']
==
=/ form-data (build-form-data params)
=/ =request:http
[%'POST' url headers `[(met 3 form-data) form-data]]
[%pass wire %arvo %i %request request *outbound-config:iris]
::
++ build-form-data
|= data=(list [@t @t])
^- @t
%+ roll data
|= [[p=@t q=@t] out=@t]
?: =(out '')
(rap 3 p '=' q ~)
(rap 3 out '&' p '=' q ~)
::
++ send-notification
|= [entry=provider-entry who=@p =notification]
^- card
=/ params=(list [@t @t])
:~ identity+(rsh [3 1] (scot %p who))
ship+(rsh [3 1] (scot %p entity.resource.notification))
graph+name.resource.notification
:- %node
%+ roll index.notification
|= [in=@ out=@t]
(rap 3 out '/' (scot %ud in) ~)
==
%: post-form
/send-notification/(scot %uv (sham eny.bowl))
notify-endpoint.entry
auth-token.entry
params
==
::
++ register-binding
|= [service=term entry=provider-entry url=@t who=@p address=@t]
^- card
=/ params=(list [@t @t])
:~ identity+(rsh [3 1] (scot %p who))
bindingtype+'apn'
address+address
action+'add'
==
%: post-form
/register-binding/(scot %p who)/[service]/(scot %uv (sham eny.bowl))
binding-endpoint.entry
auth-token.entry
params
==
::
++ remove-binding
|= [service=term entry=provider-entry who=@p url=@t sid=@t]
^- card
=/ params=(list [@t @t])
:~ sid+sid
action+'remove'
==
%: post-form
/remove-binding/(scot %p who)/[service]/(scot %uv (sham eny.bowl))
binding-endpoint.entry
auth-token.entry
params
==
--

136
pkg/arvo/app/observe-hook.hoon
View File

@ -8,6 +8,12 @@
::
|%
+$ card card:agent:gall
+$ state-0
$: observers=(map serial observer:sur)
warm-cache=_|
static-conversions=(set [term term])
==
::
+$ versioned-state
$% [%0 observers=(map serial observer:sur)]
[%1 observers=(map serial observer:sur)]
@ -15,6 +21,7 @@
[%3 observers=(map serial observer:sur)]
[%4 observers=(map serial observer:sur)]
[%5 observers=(map serial observer:sur) warm-cache=_|]
[%6 state-0]
==
::
+$ serial @uv
@ -28,7 +35,7 @@
--
::
%- agent:dbug
=| [%5 observers=(map serial observer:sur) warm-cache=_|]
=| [%6 state-0]
=* state -
::
^- agent:gall
@ -44,6 +51,33 @@
(act [%watch %group-store /groups %group-on-remove-member])
(act [%watch %metadata-store /updates %md-on-add-group-feed])
(act [%warm-cache-all ~])
::
(warm-static %graph-validator-chat %graph-indexed-post)
(warm-static %graph-validator-publish %graph-indexed-post)
(warm-static %graph-validator-link %graph-indexed-post)
(warm-static %graph-validator-post %graph-indexed-post)
(warm-static %graph-validator-dm %graph-indexed-post)
::
(warm-static %graph-validator-chat %graph-permissions-add)
(warm-static %graph-validator-publish %graph-permissions-add)
(warm-static %graph-validator-link %graph-permissions-add)
(warm-static %graph-validator-post %graph-permissions-add)
::
(warm-static %graph-validator-chat %graph-permissions-remove)
(warm-static %graph-validator-publish %graph-permissions-remove)
(warm-static %graph-validator-link %graph-permissions-remove)
(warm-static %graph-validator-post %graph-permissions-remove)
::
(warm-static %graph-validator-chat %notification-kind)
(warm-static %graph-validator-publish %notification-kind)
(warm-static %graph-validator-link %notification-kind)
(warm-static %graph-validator-post %notification-kind)
(warm-static %graph-validator-dm %notification-kind)
::
(warm-static %graph-validator-chat %transform-add-nodes)
(warm-static %graph-validator-publish %transform-add-nodes)
(warm-static %graph-validator-link %transform-add-nodes)
(warm-static %graph-validator-post %transform-add-nodes)
==
::
++ act
@ -57,6 +91,19 @@
%observe-action
!>(action)
==
::
++ warm-static
|= [from=term to=term]
^- card
:* %pass
/poke
%agent
[our.bowl %observe-hook]
%poke
%observe-action
!> ^- action:sur
[%warm-static-conversion from to]
==
--
::
++ on-save !>(state)
@ -68,8 +115,41 @@
=| cards=(list card)
|-
?- -.old-state
%5
%6
[cards this(state old-state)]
::
%5
=. cards
%+ weld cards
:~ (warm-static %graph-validator-chat %graph-indexed-post)
(warm-static %graph-validator-publish %graph-indexed-post)
(warm-static %graph-validator-link %graph-indexed-post)
(warm-static %graph-validator-post %graph-indexed-post)
(warm-static %graph-validator-dm %graph-indexed-post)
::
(warm-static %graph-validator-chat %graph-permissions-add)
(warm-static %graph-validator-publish %graph-permissions-add)
(warm-static %graph-validator-link %graph-permissions-add)
(warm-static %graph-validator-post %graph-permissions-add)
::
(warm-static %graph-validator-chat %graph-permissions-remove)
(warm-static %graph-validator-publish %graph-permissions-remove)
(warm-static %graph-validator-link %graph-permissions-remove)
(warm-static %graph-validator-post %graph-permissions-remove)
::
(warm-static %graph-validator-chat %notification-kind)
(warm-static %graph-validator-publish %notification-kind)
(warm-static %graph-validator-link %notification-kind)
(warm-static %graph-validator-post %notification-kind)
(warm-static %graph-validator-dm %notification-kind)
::
(warm-static %graph-validator-chat %transform-add-nodes)
(warm-static %graph-validator-publish %transform-add-nodes)
(warm-static %graph-validator-link %transform-add-nodes)
(warm-static %graph-validator-post %transform-add-nodes)
==
$(old-state [%6 observers.old-state %.n ~])
::
%4
=. cards
:_ cards
@ -109,6 +189,19 @@
%observe-action
!>(action)
==
::
++ warm-static
|= [from=term to=term]
^- card
:* %pass
/poke
%agent
[our.bowl %observe-hook]
%poke
%observe-action
!> ^- action:sur
[%warm-static-conversion from to]
==
--
::
++ on-poke
@ -122,10 +215,12 @@
=* observer observer.action
=/ vals (silt ~(val by observers))
?- -.action
%watch (watch observer vals)
%ignore (ignore observer vals)
%warm-cache-all warm-cache-all
%cool-cache-all cool-cache-all
%watch (watch observer vals)
%ignore (ignore observer vals)
%warm-cache-all warm-cache-all
%cool-cache-all cool-cache-all
%warm-static-conversion (warm-static-conversion from.action to.action)
%cool-static-conversion (cool-static-conversion from.action to.action)
==
::
++ watch
@ -170,6 +265,23 @@
?. warm-cache
~|('cannot cool down cache that is already cool' !!)
[~ this(warm-cache %.n)]
::
++ warm-static-conversion
|= [from=term to=term]
^- (quip card _this)
?: (~(has in static-conversions) [from to])
~|('cannot warm up a static conversion that is already warm' !!)
:_ this(static-conversions (~(put in static-conversions) [from to]))
=/ =wire /static-convert/[from]/[to]
=/ =rave:clay [%sing %f [%da now.bowl] /[from]/[to]]
[%pass wire %arvo %c %warp our.bowl %home `rave]~
::
++ cool-static-conversion
|= [from=term to=term]
^- (quip card _this)
?. (~(has in static-conversions) [from to])
~|('cannot cool a static conversion that is already cool' !!)
[~ this(static-conversions (~(del in static-conversions) [from to]))]
--
::
++ on-agent
@ -326,6 +438,18 @@
~
=/ =rave:clay [%next %b q.p.u.riot mark]
[%pass wire %arvo %c %warp our.bowl %home `rave]~
::
[%static-convert @ @ ~]
=* from i.t.wire
=* to i.t.t.wire
?. (~(has in static-conversions) [from to])
~
?> ?=([%clay %writ *] sign-arvo)
=* riot p.sign-arvo
?~ riot
~
=/ =rave:clay [%next %f q.p.u.riot /[from]/[to]]
[%pass wire %arvo %c %warp our.bowl %home `rave]~
==
::
++ on-watch on-watch:def

10
pkg/arvo/app/settings-store.hoon
View File

@ -83,13 +83,13 @@
^- (unit (unit cage))
?+ pax (on-peek:def pax)
[%x %all ~]
``settings-data+!>(all+settings)
``settings-data+!>(`data`all+settings)
::
[%x %bucket @ ~]
=* buc i.t.t.pax
=/ bucket=(unit bucket) (~(get by settings) buc)
?~ bucket [~ ~]
``settings-data+!>(bucket+u.bucket)
``settings-data+!>(`data`bucket+u.bucket)
::
[%x %entry @ @ ~]
=* buc i.t.t.pax
@ -97,19 +97,19 @@
=/ =bucket (fall (~(get by settings) buc) ~)
=/ entry=(unit val) (~(get by bucket) key)
?~ entry [~ ~]
``settings-data+!>(entry+u.entry)
``settings-data+!>(`data`entry+u.entry)
::
[%x %has-bucket @ ~]
=* buc i.t.t.pax
=/ has-bucket=? (~(has by settings) buc)
``noun+!>(has-bucket)
``noun+!>(`?`has-bucket)
::
[%x %has-entry @ @ ~]
=* buc i.t.t.pax
=* key i.t.t.t.pax
=/ =bucket (fall (~(get by settings) buc) ~)
=/ has-entry=? (~(has by bucket) key)
``noun+!>(has-entry)
``noun+!>(`?`has-entry)
==
::
++ on-agent on-agent:def

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

@ -1,6 +1,7 @@
/- spider
/+ libstrand=strand, default-agent, verb, server
=, strand=strand:libstrand
~% %spider-top ..part ~
|%
+$ card card:agent:gall
+$ thread thread:spider
@ -60,6 +61,7 @@
::
:: Trie operations
::
~% %spider ..card ~
|%
++ get-yarn
|= [=trie =yarn]
@ -137,6 +139,7 @@
=| =state
=<
%+ verb |
~% %spider-agent ..bind-eyre ~
|_ =bowl:gall
+* this .
spider-core +>
@ -192,6 +195,7 @@
--
::
++ on-poke
~/ %on-poke
|= [=mark =vase]
^- (quip card _this)
?: ?=(%spider-kill mark)
@ -208,6 +212,7 @@
[cards this]
::
++ on-watch
~/ %on-watch
|= =path
^- (quip card _this)
=^ cards state
@ -220,6 +225,7 @@
::
++ on-leave on-leave:def
++ on-peek
~/ %on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
@ -234,6 +240,7 @@
==
::
++ on-agent
~/ %on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
=^ cards state
@ -243,6 +250,7 @@
[cards this]
::
++ on-arvo
~/ %on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
=^ cards state
@ -261,6 +269,7 @@
(on-load on-save)
--
::
~% %spider-helper ..get-yarn ~
|_ =bowl:gall
::
++ bind-eyre
@ -272,6 +281,7 @@
:((cury cat 3) file '--' (scot %uv (sham eny.bowl)))
::
++ handle-http-request
~/ %handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state)
?> authenticated.inbound-request
@ -284,6 +294,8 @@
=/ =tid (new-thread-id thread)
=. serving.state
(~(put by serving.state) tid [eyre-id output-mark])
:: TODO: speed this up somehow. we spend about 15ms in this arm alone
::
=+ .^
=tube:clay
%cc
@ -315,6 +327,7 @@
`state
::
++ handle-sign
~/ %handle-sign
|= [=tid =wire =sign-arvo]
=/ yarn (~(get by tid.state) tid)
?~ yarn
@ -331,6 +344,7 @@
(take-input u.yarn ~ %agent wire sign)
::
++ handle-start-thread
~/ %handle-start-thread
|= [parent-tid=(unit tid) use=(unit tid) file=term =vase]
^- (quip card ^state)
=/ parent-yarn=yarn
@ -353,12 +367,13 @@
=/ pax=path
~| no-file-for-thread+file
(need (get-fit:clay [our q.byk da+now]:bowl %ted file))
=/ =card
:+ %pass /build/[new-tid]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax]
[[card ~] state]
:_ state
:_ ~
:+ %pass /build/[new-tid]
[%arvo %c %warp our.bowl %home ~ %sing %a da+now.bowl pax]
::
++ handle-build
~/ %handle-build
|= [=tid =sign-arvo]
^- (quip card ^state)
=/ =yarn (~(got by tid.state) tid)
@ -377,6 +392,7 @@
(start-thread yarn p.maybe-thread)
::
++ start-thread
~/ %start-thread
|= [=yarn =thread]
^- (quip card ^state)
=/ =vase vase:(~(got by starting.state) yarn)
@ -411,6 +427,7 @@
(thread-fail u.yarn %cancelled ~)
::
++ take-input
~/ %take-input
|= [=yarn input=(unit input:strand)]
^- (quip card ^state)
=/ m (strand ,vase)

8
pkg/arvo/gen/aqua/dojo.hoon
View File

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

2
pkg/arvo/gen/aqua/file.hoon
View File

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

6
pkg/arvo/gen/aqua/init.hoon
View File

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

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

@ -12,7 +12,7 @@
arg=$@(~ [top=path ~])
~
==
:- %noun
:- %boot-pill
^- pill:pill
::
:: sys: root path to boot system, `/~me/[desk]/now/sys`

11
pkg/arvo/gen/group-view/join.hoon Normal file
View File

@ -0,0 +1,11 @@
:: group-view|join: Join a group
::
/- view=group-view
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[him=ship name=term ~] ~]
==
::
:- %group-view-action
^- action:view
[%join [him name] him]

30
pkg/arvo/gen/hood/crunch.hoon Normal file
View File

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

20
pkg/arvo/gen/hood/fuse-list.hoon Normal file
View File

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

49
pkg/arvo/gen/hood/fuse.hoon
View File

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

23
pkg/arvo/gen/hood/fuse/help.txt
View File

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

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

@ -15,7 +15,7 @@
arg=$@(~ [top=path ~])
dub=_|
==
:- %pill
:- %boot-pill
^- pill:pill
:: sys: root path to boot system, `/~me/[desk]/now/sys`
::

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

@ -115,6 +115,16 @@
^- 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 ~]

2
pkg/arvo/lib/aqua-azimuth.hoon
View File

@ -122,7 +122,7 @@
:_ ~
:* %event
her
//http-client/0v1n.2m9vh
/i/http-client/0v1n.2m9vh
%receive
num.u.ask
[%start [200 ~] `(as-octs:mimes:html resp) &]

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

@ -1,5 +1,6 @@
/- bc=bitcoin
/+ bcu=bitcoin-utils
~% %bip-158-top ..part ~
|%
++ params
|%
@ -8,6 +9,7 @@
--
::
++ siphash
~/ %siphash
|= [k=byts m=byts]
^- byts
|^
@ -86,25 +88,28 @@
:: 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)]
==
:+ ?:((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]
=| bs=bits:bc
|-
?: =(n 0) [bs s]
=^ b s (read-bit s)
$(n (dec n), bs (write-bits bs [1 b]))
=/ 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])]
@ -112,6 +117,7 @@
:: +gol: Golomb-Rice encoding/decoding
::
++ gol
~% %gol ..params ~
|%
:: +en: encode x and append to end of s
:: - s: bits stream
@ -119,6 +125,7 @@
:: - p: golomb-rice p param
::
++ en
~/ %en
|= [s=bits:bc x=@ p=@]
^- bits:bc
=+ q=(rsh [0 p] x)
@ -128,6 +135,7 @@
(write-bits:str unary r)
::
++ de
~/ %de
|= [s=bits:bc p=@]
^- [delta=@ rest=bits:bc]
|^ ?> (gth wid.s 0)
@ -148,6 +156,7 @@
:: +hsh
::
++ hsh
~% %hsh ..params ~
|%
:: +to-range
:: - item: scriptpubkey to hash
@ -155,9 +164,10 @@
:: - k: key for siphash (end of blockhash, reversed)
::
++ to-range
~/ %to-range
|= [item=byts f=@ k=byts]
^- @
(rsh [0 64] (mul f (swp 3 dat:(siphash k item))))
(rsh [0 64] (mul f (rev 3 (siphash k item))))
:: +set-construct: return sorted hashes of scriptpubkeys
::
++ set-construct
@ -171,6 +181,7 @@
--
::
++ parse-filter
~/ %parse-filter
|= filter=hexb:bc
^- [n=@ux gcs-set=bits:bc]
=/ n n:(de:csiz:bcu filter)
@ -180,6 +191,7 @@
:: +to-key: blockhash (little endian) to key for siphash
::
++ to-key
~/ %to-key
|= blockhash=tape
^- byts
%+ take:byt:bcu 16
@ -191,6 +203,7 @@
:: - targets: scriptpubkeys to match
::
++ match
~/ %match
|= [filter=hexb:bc k=byts targets=(list byts)]
^- ?
=/ [p=@ m=@] [p:params m:params]
@ -211,19 +224,21 @@
$(last-val (add delta last-val))
:: +all-match: returns all target byts that match
:: - filter: full block filter, with leading N
:: - k: key for siphash (end of blockhash, reversed)
:: - targets: scriptpubkeys to match
::
++ all-match
|= [filter=hexb:bc k=byts targets=(list byts)]
^- (set hexb:bc)
%- ~(gas in *(set hexb:bc))
~/ %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 @ hexb:bc)
%- ~(gas by *(map @ hexb:bc))
=/ target-map=(map @ [address:bc hexb:bc])
%- ~(gas by *(map @ [address:bc hexb:bc]))
%+ turn targets
|=(t=hexb:bc [(to-range:hsh t (mul n m) k) t])
|= [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 @)
@ -244,4 +259,5 @@
=^ delta gcs-set
(de:gol gcs-set p)
$(last-val (add delta last-val))
::
--

14
pkg/arvo/lib/bitcoin-json.hoon
View File

@ -110,6 +110,7 @@
%cancel-tx (hexb txid.upd)
%new-address (address address.upd)
%balance (balance balance.upd)
%scan-progress (scan-progress main.upd change.upd)
%error s+error.upd
%broadcast-success ~
==
@ -161,6 +162,19 @@
unconfirmed+(numb q.u.b)
==
::
++ scan-progress
|= [main=(unit idx:bitcoin) change=(unit idx:bitcoin)]
|^ ^- json
%- pairs
:~ main+(from-unit main)
change+(from-unit change)
==
++ from-unit
|= i=(unit idx:bitcoin)
?~ i ~
(numb u.i)
--
::
++ btc-state
|= bs=btc-state:btc-wallet
^- json

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

@ -1,8 +1,8 @@
:: lib/bitcoin-utils.hoon
:: Utilities for working with BTC data types and transactions
::
/- sur=bitcoin
=, sur
/- *bitcoin
~% %bitcoin-utils-lib ..part ~
|%
::
:: TODO: move this bit/byt stuff to zuse
@ -12,6 +12,7 @@
:: +blop: munge bit and byt sequences (cat, flip, take, drop)
::
++ blop
~/ %blop
|_ =bloq
+$ biyts [wid=@ud dat=@]
++ cat
@ -48,6 +49,7 @@
++ byt ~(. blop 3)
::
++ bit
~/ %bit
=/ bl ~(. blop 0)
|%
++ cat cat:bl:bit
@ -79,16 +81,19 @@
:: 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
@ -100,8 +105,10 @@
:: hxb: hex parsing utilities
::
++ hxb
~% %hxb ..blop ~
|%
++ from-cord
~/ %from-cord
|= h=@t
^- hexb
?: =('' h) 1^0x0
@ -113,10 +120,11 @@
=+ (rsh [3 2] -)
:: Parse hex to atom
::
:- (div (lent (trip h)) 2)
`@ux`(rash - hex)
=/ a (need (de:base16:mimes:html -))
[-.a `@ux`+.a]
::
++ to-cord
~/ %to-cord
|= =hexb
^- cord
(en:base16:mimes:html hexb)
@ -128,8 +136,10 @@
:: - decode: little endian to big endian
::
++ csiz
~% %csiz ..blop ~
|%
++ en
~/ %en
|= a=@
^- hexb
=/ l=@ (met 3 a)
@ -140,6 +150,7 @@
~|("Cannot encode CompactSize longer than 8 bytes" !!)
::
++ de
~/ %de
|= h=hexb
^- [n=hexb rest=hexb]
=/ s=@ux dat:(take:byt 1 h)
@ -162,5 +173,4 @@
=> (de h)
[dat.n rest]
--
::
--

40
pkg/arvo/lib/bitcoin.hoon
View File

@ -2,13 +2,13 @@
:: top-level Bitcoin constants
:: expose BIP libraries
::
/- sur=bitcoin
/+ bech32=bip-b173, pbt=bip-b174, bcu=bitcoin-utils
=, sur
=, bcu
/- *bitcoin
/+ bech32=bip-b173, pbt=bip-b174, bcu=bitcoin-utils, bip-b158
~% %bitcoin-lib ..part ~
|%
++ overhead-weight ^-(vbytes 11)
++ input-weight
~/ %input-weight
|= =bipt
^- vbytes
?- bipt
@ -40,8 +40,10 @@
:: adr: address manipulation
::
++ adr
~% %adr ..overhead-weight ~
|%
++ get-bipt
~/ %get-bipt
|= a=address
^- bipt
=/ spk=hexb (to-script-pubkey:adr a)
@ -52,35 +54,39 @@
~|("Invalid address" !!)
::
++ to-cord
~/ %to-cord
|= a=address ^- cord
?: ?=([%base58 *] a)
(scot %uc +.a)
%- crip
%+ slag 2
(scow %uc +.a)
+.a
::
++ from-pubkey
~/ %from-pubkey
|= [=bipt =network pubkey=hexb]
^- address
?- bipt
%44
:- %base58
=< ^-(@uc dat)
%- cat:byt
%- cat:byt:bcu
:- ?- network
%main 1^0x0
%testnet 1^0x6f
==
~[(hash-160 pubkey)]
~[(hash-160:bcu pubkey)]
::
%49
:- %base58
=< ^-(@uc dat)
%- cat:byt
%- cat:byt:bcu
:~ ?- network
%main 1^0x5
%testnet 1^0xc4
==
%- hash-160
(cat:byt ~[2^0x14 (hash-160 pubkey)])
%- hash-160:bcu
(cat:byt:bcu ~[2^0x14 (hash-160:bcu pubkey)])
==
::
%84
@ -89,6 +95,7 @@
==
::
++ from-cord
~/ %from-cord
|= addrc=@t
|^
=/ addrt=tape (trip addrc)
@ -117,12 +124,13 @@
--
::
++ to-script-pubkey
~/ %to-script-pubkey
|= =address
^- hexb
?- -.address
%bech32
=+ h=(from-address:bech32 +.address)
%- cat:byt
%- cat:byt:bcu
:~ 1^0x0
1^wid.h
h
@ -130,21 +138,21 @@
::
%base58
=/ h=hexb [21 `@ux`+.address]
=+ lead-byt=dat:(take:byt 1 h)
=+ lead-byt=dat:(take:byt:bcu 1 h)
=/ version-network=[bipt network]
?: =(0x0 lead-byt) [%44 %main]
?: =(0x6f lead-byt) [%44 %testnet]
?: =(0x5 lead-byt) [%49 %main]
?: =(0xc4 lead-byt) [%49 %testnet]
~|("Invalid base58 address: {<+.address>}" !!)
%- cat:byt
%- cat:byt:bcu
?: ?=(%44 -.version-network)
:~ 3^0x76.a914
(drop:byt 1 h)
(drop:byt:bcu 1 h)
2^0x88ac
==
:~ 2^0xa914
(drop:byt 1 h)
(drop:byt:bcu 1 h)
1^0x87
==
==
@ -155,6 +163,8 @@
:: - ignores signatures in inputs
::
++ txu
~% %bitcoin-lib-txu ..overhead-weight ~
=, bcu
|%
++ en
|%

42
pkg/arvo/lib/btc-provider.hoon
View File

@ -1,8 +1,6 @@
/- bp=btc-provider, json-rpc
/+ bc=bitcoin
^?
::=< [sur .]
::=, sur
/+ bc=bitcoin, bcu=bitcoin-utils
~% %btc-provider-lib ..part ~
|%
:: +from-epoch: time since Jan 1, 1970 in seconds.
::
@ -25,8 +23,8 @@
~[['Content-Type' 'application/json']]
=, html
%- some
%- as-octt:mimes
(en-json body)
%- as-octt:mimes
(en-json body)
==
::
++ gen-request
@ -36,6 +34,7 @@
api-url.host-info ract
::
++ rpc
~/ %rpc
=, dejs:format
|%
++ parse-result
@ -62,6 +61,7 @@
%get-block-info
[id.res (block-info res.res)]
==
::
++ address-info
%- ot
:~ [%address (cu from-cord:adr:bc so)]
@ -69,47 +69,53 @@
[%used bo]
[%block ni]
==
::
++ utxo
%- ot
%- ot
:~ ['tx_pos' ni]
['tx_hash' (cu from-cord:hxb:bc so)]
['tx_hash' (cu from-cord:hxb:bcu so)]
[%height ni]
[%value ni]
[%recvd (cu from-epoch ni)]
==
::
++ tx-vals
%- ot
:~ [%included bo]
[%txid (cu from-cord:hxb:bc so)]
[%txid (cu from-cord:hxb:bcu so)]
[%confs ni]
[%recvd (cu from-epoch ni)]
[%inputs (ar tx-val)]
[%outputs (ar tx-val)]
==
::
++ tx-val
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
:~ [%txid (cu from-cord:hxb:bcu so)]
[%pos ni]
[%address (cu from-cord:adr:bc so)]
[%value ni]
==
::
++ raw-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%rawtx (cu from-cord:hxb:bc so)]
:~ [%txid (cu from-cord:hxb:bcu so)]
[%rawtx (cu from-cord:hxb:bcu so)]
==
::
++ broadcast-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
:~ [%txid (cu from-cord:hxb:bcu so)]
[%broadcast bo]
[%included bo]
==
::
++ block-info
%- ot
:~ [%block ni]
[%fee (mu ni)]
[%blockhash (cu from-cord:hxb:bc so)]
[%blockfilter (cu from-cord:hxb:bc so)]
[%blockhash (cu from-cord:hxb:bcu so)]
[%blockfilter (cu from-cord:hxb:bcu so)]
==
--
--
@ -126,17 +132,17 @@
%get-tx-vals
%- get-request
%+ mk-url '/gettxvals/'
(to-cord:hxb:bc txid.ract)
(to-cord:hxb:bcu txid.ract)
::
%get-raw-tx
%- get-request
%+ mk-url '/getrawtx/'
(to-cord:hxb:bc txid.ract)
(to-cord:hxb:bcu txid.ract)
::
%broadcast-tx
%- get-request
%+ mk-url '/broadcasttx/'
(to-cord:hxb:bc rawtx.ract)
(to-cord:hxb:bcu rawtx.ract)
::
%get-block-count
%- get-request

29
pkg/arvo/lib/btc.hoon
View File

@ -1,7 +1,7 @@
:: lib/btc.hoon
::
/- *btc-wallet, json-rpc, bp=btc-provider
/+ bip32, bc=bitcoin
/+ bip32, bc=bitcoin, bcu=bitcoin-utils
=, secp:crypto
=+ ecc=secp256k1
|%
@ -424,6 +424,7 @@
%get-block-info
[id.res (block-info res.res)]
==
::
++ address-info
%- ot
:~ [%address (cu from-cord:adr:bc so)]
@ -434,7 +435,7 @@
++ utxo
%- ot
:~ ['tx_pos' ni]
['tx_hash' (cu from-cord:hxb:bc so)]
['tx_hash' (cu from-cord:hxb:bcu so)]
[%height ni]
[%value ni]
[%recvd (cu from-epoch ni)]
@ -442,7 +443,7 @@
++ tx-vals
%- ot
:~ [%included bo]
[%txid (cu from-cord:hxb:bc so)]
[%txid (cu from-cord:hxb:bcu so)]
[%confs ni]
[%recvd (cu from-epoch ni)]
[%inputs (ar tx-val)]
@ -450,19 +451,19 @@
==
++ tx-val
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
:~ [%txid (cu from-cord:hxb:bcu so)]
[%pos ni]
[%address (cu from-cord:adr:bc so)]
[%value ni]
==
++ raw-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%rawtx (cu from-cord:hxb:bc so)]
:~ [%txid (cu from-cord:hxb:bcu so)]
[%rawtx (cu from-cord:hxb:bcu so)]
==
++ broadcast-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
:~ [%txid (cu from-cord:hxb:bcu so)]
[%broadcast bo]
[%included bo]
==
@ -470,8 +471,8 @@
%- ot
:~ [%block ni]
[%fee (mu ni)]
[%blockhash (cu from-cord:hxb:bc so)]
[%blockfilter (cu from-cord:hxb:bc so)]
[%blockhash (cu from-cord:hxb:bcu so)]
[%blockfilter (cu from-cord:hxb:bcu so)]
==
--
--
@ -488,25 +489,27 @@
%get-tx-vals
%- get-request
%+ mk-url '/gettxvals/'
(to-cord:hxb:bc txid.ract)
(to-cord:hxb:bcu txid.ract)
::
%get-raw-tx
%- get-request
%+ mk-url '/getrawtx/'
(to-cord:hxb:bc txid.ract)
(to-cord:hxb:bcu txid.ract)
::
%broadcast-tx
%- get-request
%+ mk-url '/broadcasttx/'
(to-cord:hxb:bc rawtx.ract)
(to-cord:hxb:bcu rawtx.ract)
::
%get-block-count
%- get-request
(mk-url '/getblockcount' '')
::
%get-block-info
=/ param=@t
?~(block.ract '' (rsh [3 2] (scot %ui u.block.ract)))
%- get-request
(mk-url '/getblockinfo' '')
(mk-url '/getblockinfo/' param)
==
++ mk-url
|= [base=@t params=@t]

2
pkg/arvo/lib/contact.hoon
View File

@ -42,6 +42,7 @@
(snoc rids [our.bowl %''])
--
++ scry-sharing
^- (set resource)
.^ (set resource)
%gx
(scot %p our.bowl)
@ -58,6 +59,7 @@
(~(get by rolodex) ship)
::
++ scry-is-public
^- ?
.^ ?
%gx
(scot %p our.bowl)

356
pkg/arvo/lib/crunch.hoon Normal file
View File

@ -0,0 +1,356 @@
/- c=crunch, gs=graph-store, ms=metadata-store, p=post, r=resource
::
=<
|_ [our=ship now=@da]
++ walk-graph-associations
|= [=associations:ms content=? from=@da to=@da]
^- wain
:: graph resources in `our`; used to avoid scrying, e.g.,
:: a graph `our` has left and can no longer access
::
=/ accessible-graphs=(set resource:r) (scry-graph-resources)
%- ~(rep by associations)
|= [[=md-resource:ms =association:ms] out=wain]
^- wain
?. ?=(%graph app-name.md-resource)
out
?. ?=(%graph -.config.metadatum.association)
out
:: ensure graph, given by association, exists in `our`
::
?. (~(has in accessible-graphs) resource.md-resource)
out
:: scry the graph
::
=/ graph=(unit graph:gs) (scry-graph resource.md-resource)
?~ graph
out
:: prepare channel-info argument
::
=/ channel-info=channel-info:c
:* group.association
resource.md-resource
module.config.metadatum.association
==
:: walk the graph
::
?+ module.config.metadatum.association
:: non-chat (e.g. links & notes)
::
%+ weld out
%: walk-nested-graph-for-most-recent-entries
u.graph
content
channel-info
from
to
==
::
%chat
%+ weld out
%: walk-chat-graph
u.graph
content
channel-info
from
to
==
==
::
++ scry-graph
|= graph-resource=resource:r
^- (unit graph:gs)
=/ scry-response=update:gs
.^ update:gs
%gx
(scot %p our)
%graph-store
(scot %da now)
%graph
(scot %p entity.graph-resource)
name.graph-resource
/noun
==
?. ?=(%add-graph -.q.scry-response)
~
?~ graph.q.scry-response
~
[~ graph.q.scry-response]
::
++ scry-graph-resources
|= ~
^- (set resource:r)
=/ scry-response=update:gs
.^ update:gs
%gx
(scot %p our)
%graph-store
(scot %da now)
/keys/noun
==
?. ?=(%keys -.q.scry-response)
~
resources.q.scry-response
:: helper arm for callers to get graph associations
:: to pass to `walk-graph-associations`
::
++ scry-graph-associations
|= ~
^- associations:ms
.^ associations:ms
%gx
(scot %p our)
%metadata-store
(scot %da now)
/app-name/graph/noun
==
--
::
|%
::
:: parsing and formatting
::
++ resource-to-cord
|= =resource:r
^- @t
(rap 3 (scot %p entity.resource) '/' (scot %tas name.resource) ~)
::
++ paths-to-resources
|= paxs=(list path)
^- (set resource:r)
%- ~(gas in *(set resource:r))
(turn paxs path-to-resource)
::
++ path-to-resource
|= pax=path
^- resource:r
=/ entity=@p (slav %p -.pax)
=/ name=@tas -.+.pax
[entity name]
::
++ escape-characters-in-cord
|= =cord
^- @t
%- crip
%- mesc
:: specific to CSVs: make sure content does not
:: contain commas (only allowed as delimiters)
::
%- replace-tape-commas-with-semicolons
%- trip
cord
::
++ replace-tape-commas-with-semicolons
|= string=tape
^- tape
=/ comma-indices=(list @ud) (fand "," string)
|-
^- tape
?~ comma-indices
string
$(string (snap string i.comma-indices ';'), comma-indices t.comma-indices)
::
++ contents-to-cord
|= contents=(list content:p)
^- @t
?~ contents
''
%+ join-cords
' '
(turn contents content-to-cord)
::
++ content-to-cord
|= =content:p
^- @t
?- -.content
%text (escape-characters-in-cord text.content)
%mention (scot %p ship.content)
%url url.content
%code expression.content :: TODO: also print output?
%reference (reference-content-to-cord reference.content)
==
::
++ reference-content-to-cord
|= =reference:p
^- @t
?- -.reference
%group (resource-to-cord group.reference)
%graph (rap 3 (resource-to-cord group.reference) ': ' (resource-to-cord resource.uid.reference) ~)
==
::
++ format-post-to-comma-separated-cord
|= [=post:gs =channel-info:c]
^- @t
%+ join-cords
','
:~ (scot %da time-sent.post)
(scot %p author.post)
(resource-to-cord group.channel-info)
(resource-to-cord channel.channel-info)
(scot %tas channel-type.channel-info)
:: exclude content; optionally add later
::
==
::
++ join-cords
|= [delimiter=@t cords=(list @t)]
^- @t
%+ roll cords
|= [cord=@t out=@t]
^- @t
?: =('' out)
:: don't put delimiter before first element
::
cord
(rap 3 out delimiter cord ~)
::
:: walking graphs
::
++ walk-chat-graph
|= [=graph:gs content=? =channel-info:c from=@da to=@da]
^- wain
%- flop
%+ roll
:: filter by time
::
%+ only-nodes-older-than to
%+ only-nodes-newer-than from
~(val by graph)
|= [=node:gs out=wain]
^- wain
?- -.post.node
%|
:: do not output deleted posts
::
out
%&
?~ contents.p.post.node
:: do not output structural nodes
::
out
:_ out
=/ post-no-content=@t (format-post-to-comma-separated-cord p.post.node channel-info)
?- content
%| post-no-content
%&
%+ join-cords ','
~[post-no-content (contents-to-cord contents.p.post.node)]
==
==
::
++ walk-nested-graph-for-most-recent-entries
|= [=graph:gs content=? =channel-info:c from=@da to=@da]
^- wain
=| out=wain
=| most-recent-post-content=@t
=/ nodes
:: filter by time
::
%+ only-nodes-older-than to
%+ only-nodes-newer-than from
~(val by graph)
%- flop
|-
^- wain
?~ nodes
?: =('' most-recent-post-content)
:: don't return a cell: `['' ~]`
:: we want either an empty list `~`
:: or a list populated with actual entries
::
out
[most-recent-post-content out]
::
=? out ?=(%graph -.children.i.nodes)
%+ weld out
%: walk-nested-graph-for-most-recent-entries
p.children.i.nodes
content
channel-info
from
to
==
::
?- -.post.i.nodes
%|
:: do not keep deleted posts
::
$(nodes t.nodes)
%&
?~ contents.p.post.i.nodes
:: do not keep structural nodes
::
$(nodes t.nodes)
=/ post-no-content=@t (format-post-to-comma-separated-cord p.post.i.nodes channel-info)
%= $
nodes t.nodes
most-recent-post-content
?- content
%| post-no-content
%&
%+ join-cords ','
~[post-no-content (contents-to-cord contents.p.post.i.nodes)]
==
==
==
::
:: filters
::
++ filter-associations-by-group-resources
|= [=associations:ms group-resources=(set resource:r)]
^- associations:ms
%- ~(rep by associations)
|= [[=md-resource:ms =association:ms] out=associations:ms]
^- associations:ms
?. (~(has in group-resources) group.association)
out
(~(put by out) md-resource association)
:: wrappers for intuitive use of `filter-nodes-by-timestamp`:
:: pass `nodes` as given by the `graph-store` scry and no
:: need to worry about comparators
::
++ only-nodes-older-than
|= [time=@da nodes=(list node:gs)]
(filter-nodes-by-timestamp nodes lte time)
::
++ only-nodes-newer-than
|= [time=@da nodes=(list node:gs)]
%- flop
(filter-nodes-by-timestamp (flop nodes) gte time)
::
++ filter-nodes-by-timestamp
|= [nodes=(list node:gs) comparator=$-([@ @] ?) time=@da]
=| out=(list node:gs)
:: return `out` in same time-order as `nodes`
::
%- flop
|-
^- (list node:gs)
?~ nodes
out
?- -.post.i.nodes
%|
:: skip deleted posts
::
$(nodes t.nodes)
%&
?. (comparator time-sent.p.post.i.nodes time)
:: assume:
:: * time is monotonic
:: * first `%.n` we hit indicates nodes further on are `%.n`
:: (i.e. `nodes` must be ordered st. they start `%.y`,
:: e.g. if want all `nodes` older than given time,
:: `nodes` must start with oldest and comparator is `lth`)
::
out
$(nodes t.nodes, out [i.nodes out])
==
::
:: io
::
++ note-write-csv-to-clay
|= [pax=path file-content=wain]
?> =(%csv (snag (dec (lent pax)) pax))
[%c [%info %home %& [pax %ins %csv !>(file-content)]~]]
::
--

20
pkg/arvo/lib/graph-store.hoon
View File

@ -1,4 +1,4 @@
/- sur=graph-store, pos=post
/- sur=graph-store, pos=post, pull-hook
/+ res=resource, migrate
=< [sur .]
=< [pos .]
@ -28,8 +28,8 @@
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
::
++ orm ((ordered-map atom node) gth)
++ orm-log ((ordered-map time logged-update) gth)
++ orm ((on atom node) gth)
++ orm-log ((on time logged-update) gth)
::
++ enjs
=, enjs:format
@ -311,7 +311,7 @@
++ graph
|= a=json
^- ^graph
=/ or-mp ((ordered-map atom ^node) gth)
=/ or-mp ((on atom ^node) gth)
%+ gas:or-mp ~
%+ turn ~(tap by ((om node) a))
|* [b=cord c=*]
@ -559,7 +559,7 @@
=>
|%
++ in-orm
((ordered-map atom in-node) gth)
((on atom in-node) gth)
+$ in-node
[post=in-pst children=in-internal-graph]
+$ in-graph
@ -571,7 +571,7 @@
==
::
++ out-orm
((ordered-map atom out-node) gth)
((on atom out-node) gth)
+$ out-node
[post=out-pst children=out-internal-graph]
+$ out-graph
@ -823,7 +823,7 @@
++ remake-update-log
|= t=tree-update-log
^- update-log
=/ ulm ((ordered-map time logged-update) gth)
=/ ulm ((on time logged-update) gth)
%+ gas:ulm *update-log
%+ turn ~(tap by t)
|= [=time tlu=tree-logged-update]
@ -872,6 +872,10 @@
^- card:agent:gall
=/ res-path (en-path:res rid)
=/ wire [%try-rejoin (scot %ud nack-count) res-path]
[%pass wire %agent [entity.rid %graph-push-hook] %watch resource+res-path]
=/ =cage
:- %pull-hook-action
!> ^- action:pull-hook
[%add [entity .]:rid]
[%pass wire %agent [our %graph-pull-hook] %poke cage]
--
--

20
pkg/arvo/lib/graph.hoon
View File

@ -96,22 +96,12 @@
?> ?=(%add-graph -.q.update)
graph.q.update
::
++ gut-younger-node-siblings
|= [res=resource =index:store]
^- (map index:store node:store)
=+ %+ scry-for ,=update:store
%+ weld
/node-siblings/younger/(scot %p entity.res)/[name.res]/all
(turn index (cury scot %ud))
?> ?=(%add-nodes -.q.update)
nodes.q.update
::
++ got-node
|= [res=resource =index:store]
^- node:store
=+ %+ scry-for ,=update:store
%+ weld
/node/(scot %p entity.res)/[name.res]
/graph/(scot %p entity.res)/[name.res]/node/index/kith
(turn index (cury scot %ud))
?> ?=(%add-nodes -.q.update)
?> ?=(^ nodes.q.update)
@ -122,7 +112,7 @@
^- ?
%+ scry-for ,?
%+ weld
/node-exists/(scot %p entity.res)/[name.res]
/graph/(scot %p entity.res)/[name.res]/node/exists
(turn index (cury scot %ud))
::
++ get-update-log
@ -134,13 +124,13 @@
++ peek-update-log
|= res=resource
^- (unit time)
(scry-for (unit time) /peek-update-log/(scot %p entity.res)/[name.res])
(scry-for (unit time) /update-log/(scot %p entity.res)/[name.res]/latest)
::
++ get-update-log-subset
|= [res=resource start=@da]
^- update-log:store
%+ scry-for update-log:store
/update-log-subset/(scot %p entity.res)/[name.res]/(scot %da start)/'~'
/update-log/(scot %p entity.res)/[name.res]/subset/'~'/(scot %da start)
::
++ get-keys
^- resources
@ -183,5 +173,5 @@
::
++ get-mark
|= res=resource
(scry-for ,(unit mark) /graph-mark/(scot %p entity.res)/[name.res])
(scry-for ,(unit mark) /graph/(scot %p entity.res)/[name.res]/mark)
--

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

@ -314,6 +314,8 @@
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
==

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

@ -109,6 +109,7 @@
%group-view
%settings-store
%dm-hook
%notify
==
::
++ deft-fish :: default connects
@ -261,6 +262,8 @@
(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
::
++ reap-phat :: ack connect

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

@ -3,11 +3,29 @@
=, space:userlib
=, format
|%
+$ state [%1 pith-1]
+$ state state-2
+$ state-2 [%2 pith-2]
+$ state-1 [%1 pith-1]
+$ state-0 [%0 pith-0]
+$ any-state
$% state
[%0 pith-0]
$% state-2
state-1
state-0
==
+$ pith-2 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
ota=(unit [=ship =desk =aeon]) ::
commit-timer=[way=wire nex=@da tim=@dr mon=term] ::
:: map desk to the currently ongoing fuse request
:: and the latest version numbers for beaks to
fus=(map desk per-fuse)
:: used for fuses - every time we get a fuse we
:: bump this. used when calculating hashes to
:: ensure they're unique even when the same
:: request is made multiple times.
hxs=(map desk @ud)
== ::
+$ pith-1 ::
$: rem=(map desk per-desk) ::
syn=(map kiln-sync let=@ud) ::
@ -31,6 +49,15 @@
sud=@tas :: from desk
cas=case :: at case
==
+$ per-fuse :: per fuse state
:: map [ship desk] to latest version number we
:: have for them. used for things we're %trak-ing
:: our invariant here is to store the latest version
:: number we've heard of.
$: mox=(map [ship desk] let=@ud)
:: relevant parts of originating request
kf=kiln-fuse-data
==
+$ kiln-commit term ::
+$ kiln-mount ::
$: pax=path ::
@ -55,12 +82,26 @@
cas=case ::
gim=?(%auto germ) ::
==
+$ fuse-source [who=ship des=desk ver=$@(%trak case)]
:: actual poke
+$ kiln-fuse
$@ ~
$: syd=desk
bas=beak
con=(list [beak germ])
$@ ~ :: signifies clearing the fuse
$: overwrite=flag :: force overwrite previous fuse
bas=fuse-source
con=(list [fuse-source germ])
==
==
:: state tracked by kiln
+$ kiln-fuse-data
$: syd=desk
bas=fuse-source
con=(list [fuse-source germ])
==
:: Request to list current fuses. ~ means "list all"
::
+$ kiln-fuse-list (unit desk)
--
|= [bowl:gall state]
?> =(src our)
@ -85,6 +126,15 @@
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
::
++ on-load
=>
|%
++ state-1-to-2
|= s=state-1
^- state-2
=/ p=pith-1 +.s
:- %2
[rem.p syn.p ota.p commit-timer.p *(map desk per-fuse) *(map desk @ud)]
--
|= [hood-version=@ud old=any-state]
=< abet
=? . ?=(%0 -.old)
@ -97,8 +147,8 @@
?: &(=(%base syd.i.syncs) !=(our her.i.syncs) =(%kids sud.i.syncs))
`[syd her sud]:i.syncs
$(syncs t.syncs)
::
=. +<+.$.abet
%- state-1-to-2
=- old(- %1, |3 [ota=~ commit-timer.old], syn -)
?~ recognized-ota
syn
@ -108,7 +158,8 @@
(poke-internal:update `[her sud]:u.recognized-ota)
+(old +<+.$.abet)
::
?> ?=(%1 -.old)
=? old ?=(%1 -.old) (state-1-to-2 old)
?> ?=(%2 -.old)
=. +<+.$.abet old
..abet
::
@ -387,10 +438,76 @@
?~ +< abet
abet:abet:(merge:(work syd) ali sud cas gim)
::
++ poke-fuse-list
=>
|%
++ format-fuse
|= [into=desk pf=per-fuse]
^- tank
=/ sources=tape
%+ reel
con.kf.pf
|= [[fs=fuse-source g=germ] acc=tape]
^- tape
;: weld
" ["
(format-fuse-source fs)
" "
<g>
"]"
acc
==
:- %leaf
;: weld
"|fuse {<into>} "
(format-fuse-source bas.kf.pf)
sources
==
:: +format-fuse-source: fuse source -> beak -> path
::
++ format-fuse-source
|= fs=fuse-source
^- tape
=/ bec=beak [who.fs des.fs ?:(?=([%trak] ver.fs) [%tas %track] ver.fs)]
<(en-beam [bec /])>
--
|= k=kiln-fuse-list
^+ abet
%. abet
?~ k
?~ fus
(slog [leaf+"no ongoing fuses" ~])
%- slog
%+ roll
~(tap by `(map desk per-fuse)`fus)
|= [[syd=desk pf=per-fuse] acc=tang]
^- tang
[(format-fuse syd pf) acc]
=/ pfu=(unit per-fuse) (~(get by fus) u.k)
?~ pfu
(slog [leaf+"no ongoing fuse for {<u.k>}" ~])
(slog [(format-fuse u.k u.pfu) ~])
::
++ poke-fuse
|= k=kiln-fuse
?~ k abet
abet:(emit [%pass /kiln/fuse/[syd.k] %arvo %c [%fuse syd.k bas.k con.k]])
=/ payload +.k
?~ payload
:: cancelling an ongoing fuse
%- (slog [leaf+"cancelling fuse into {<syd.k>}" ~])
=/ f (fuzz syd.k now)
?~ f
abet
abet:abet:delete:u.f
?: &(!overwrite.payload (~(has by fus) syd.k))
((slog [leaf+"existing fuse into {<syd.k>} - need =overwrite &" ~]) abet)
=. fus (~(put by fus) syd.k [~ [syd.k bas.payload con.payload]])
=/ old-cnt=@ud (~(gut by hxs) syd.k 0)
=. hxs (~(put by hxs) syd.k +(old-cnt))
=/ f (fuzz syd.k now)
?~ f
abet
abet:abet:fuse:u.f
::
++ poke-cancel
|= a=@tas
@ -442,6 +559,7 @@
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-fuse =;(f (f !<(_+<.f vase)) poke-fuse)
%kiln-fuse-list =;(f (f !<(_+<.f vase)) poke-fuse-list)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-ota =;(f (f !<(_+<.f vase)) poke:update)
%kiln-ota-info =;(f (f !<(_+<.f vase)) poke-ota-info)
@ -489,6 +607,21 @@
[%autocommit *] %+ take-wake-autocommit t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%ota *] abet:(take:update t.wire sign-arvo)
[%fuse-request @tas *]
=/ f (fuzz i.t.wire now)
?~ f
abet
abet:abet:(take:u.f t.t.wire sign-arvo)
[%fuse @tas *] ?> ?=(%mere +<.sign-arvo)
=/ syd=desk i.t.wire
?. ?=([%| *] +>.sign-arvo)
?~ p.p.sign-arvo
abet
=/ msg=tape "fuse merge conflict for {<syd>}"
%- (slog [leaf+msg >p.p.sign-arvo< ~])
abet
%- (slog leaf+"failed fuse for {<syd>}" p.p.sign-arvo)
abet
*
?+ +<.sign-arvo
((slog leaf+"kiln: strange card {<+<.sign-arvo wire>}" ~) abet)
@ -567,6 +700,122 @@
++ spam
|= mes=(list tank)
((slog mes) ..spam)
:: state machine for fuses
::
++ fuzz
|= [syd=desk now=@da]
=/ pfu=(unit per-fuse) (~(get by fus) syd)
?~ pfu
~
=* kf kf.u.pfu
=* mox mox.u.pfu
=/ should-delete=flag |
%- some
|%
:: finalize
::
++ abet
?: should-delete
..fuzz(fus (~(del by fus) syd))
..fuzz(fus (~(put by fus) syd [mox kf]))
::
++ delete
^+ ..delete
=. should-delete &
..delete
:: queue moves
::
++ blab
|= new=(list card:agent:gall)
^+ +>
+>.$(moz (welp new moz))
:: +make-requests: send requests for each %trak source.
::
++ make-requests
^+ ..abet
=/ movs=(list card:agent:gall)
%+ murn
[[bas.kf *germ] con.kf]
|= [fs=fuse-source germ]
^- (unit card:agent:gall)
?^ ver.fs
:: static source, don't need to track
~
=/ bec=beak (realize-fuse-source fs &)
?> =(who.fs p.bec)
?> =(des.fs q.bec)
=/ hax=@ud (mug [kf (~(got by hxs) syd)])
=/ wir=wire
/kiln/fuse-request/[syd]/(scot %p p.bec)/[q.bec]/(scot %ud hax)
=/ rav=rave [%sing %w r.bec /]
=/ rif=riff [q.bec `rav]
`[%pass wir %arvo %c [%warp who.fs rif]]
:: No need to keep state if all the sources are static
?~ movs
delete
(blab movs)
::
++ send-fuse
^+ ..abet
=/ bas=beak (realize-fuse-source bas.kf |)
=/ con=(list [beak germ])
%+ turn
con.kf
|= [fs=fuse-source g=germ]
[(realize-fuse-source fs |) g]
%- blab
[%pass /kiln/fuse/[syd] %arvo %c [%fuse syd bas con]]~
::
++ fuse
^+ ..abet
send-fuse:make-requests
::
++ take
|= [wir=wire =sign-arvo]
^+ ..fuse
?> =((lent wir) 3)
=/ who=ship (slav %p (snag 0 wir))
=/ src=desk (snag 1 wir)
=/ hax=@ud (slav %ud (snag 2 wir))
?. =(hax (mug [kf (~(got by hxs) syd)]))
:: If the hash in the wire doesn't match the current request
:: this is a response for a previous fuse that we can ignore.
..take
?> ?=([?(%clay %behn) %writ *] sign-arvo)
=/ gif +.sign-arvo
?~ p.gif
%- (slog leaf+"|fuse request failed for {<src>} on <who> - cancelling")
delete
=/ cas=cass:clay !<(cass:clay +.r.u.p.gif)
=. mox (~(put by mox) [who src] ud.cas)
fuse
::
:: utility functions below
::
:: +realize-fuse-source: convert a fuse-source to a
:: fully realized beak.
::
++ realize-fuse-source
|= [fs=fuse-source incr=flag]
^- beak
:+ who.fs
des.fs
?@ ver.fs
(realize-case [who.fs des.fs incr])
`case`ver.fs
::
++ realize-case
|= [who=ship des=desk incr=flag]
^- case
=/ let=(unit @ud) (~(get by mox) [who des])
^- case
?~ let
da+now
:- %ud
?: incr
+(u.let)
u.let
--
::
++ auto
|= kiln-sync

40
pkg/arvo/lib/metadata-store.hoon
View File

@ -37,6 +37,17 @@
[%metadata (^metadatum metadatum)]
==
::
++ edit-field
|= edt=^edit-field
^- json
%+ frond -.edt
^- json
?- -.edt
%color [%s `@t`(scot %ux color.edt)]
?(%title %description %picture %vip) [%s `@t`+.edt]
?(%preview %hidden) [%b `?`+.edt]
==
::
++ metadatum
|= met=^metadatum
^- json
@ -85,6 +96,16 @@
[%resource s+(enjs-path:resource resource.resource.upd)]
[%metadata (metadatum metadatum.upd)]
==
::
%edit
:- %edit
%- pairs
:~ [%group s+(enjs-path:resource group.upd)]
[%app-name s+app-name.resource.upd]
[%resource s+(enjs-path:resource resource.resource.upd)]
[%edit (edit-field edit-field.upd)]
==
::
%updated-metadata
:- %add
%- pairs
@ -136,6 +157,25 @@
:~ [%add add]
[%remove remove]
[%initial-group initial-group]
[%edit edit]
==
::
++ edit
%- ot
:~ [%group dejs-path:resource]
[%resource md-resource]
[%edit edit-field]
==
::
++ edit-field
%- of
:~ [%title so]
[%description so]
[%color nu]
[%picture so]
[%preview bo]
[%hidden bo]
[%vip vip]
==
::
++ initial-group

11
pkg/arvo/lib/metadata.hoon
View File

@ -30,7 +30,7 @@
|= =vase
^- (list resource)
=/ =update:store !<(update:store vase)
?. ?=(?(%add %remove %initial-group) -.update) ~
?. ?=(?(%add %remove %initial-group %edit) -.update) ~
~[group.update]
::
++ app-paths-from-group
@ -100,4 +100,13 @@
^- (unit resource)
%+ bind (peek-association md-resource)
|=(association:store group)
::
++ graphs-of-group
|= group=resource
=/ =associations:store
(metadata-for-group group)
%+ murn ~(tap in ~(key by associations))
|= [=app-name:store rid=resource]
?.(=(%graph app-name) ~ `rid)
--

85
pkg/arvo/lib/ph/io.hoon
View File

@ -23,17 +23,14 @@
::
++ start-simple
(start-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre ~)
++ end-simple
(end-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre ~)
::
++ start-azimuth
=/ m (strand ,tid:spider)
=/ m (strand ,~)
^- form:m
;< ~ bind:m (start-test %aqua-ames %aqua-behn %aqua-dill ~)
(start-thread %aqua-eyre-azimuth)
;<(~ bind:m start-simple init)
::
++ end-azimuth
(end-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre-azimuth ~)
++ end
(end-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre ~)
::
++ start-test
|= vane-threads=(list term)
@ -91,77 +88,32 @@
^- form:m
(pure:m ~)
::
:: XX +spawn-aqua and +breach-aqua mean do these actions using aqua's internal
:: azimuth management system, eventually these should just replace +spawn
:: +breach
::
++ init-azimuth
++ init
=/ m (strand ,~)
^- form:m
(send-azimuth-action %init-azimuth ~)
::
++ spawn-aqua
++ spawn
|= =ship
~& > "spawning {<ship>}"
=/ m (strand ,~)
^- form:m
(send-azimuth-action %spawn ship)
::
++ breach-aqua
++ breach
|= =ship
~& > "breaching {<ship>}"
=/ m (strand ,~)
^- form:m
(send-azimuth-action %breach ship)
::
++ spawn
|= [=tid:spider =ship]
~& > "spawning {<ship>}"
=/ m (strand ,~)
=/ =vase !>(`input:spider`[tid %azimuth-command !>([%spawn ship])])
(poke-our %spider %spider-input vase)
::
++ breach
|= [=tid:spider who=ship]
=/ m (strand ,~)
~& > "breaching {<who>}"
=/ =vase
!>([tid %azimuth-command !>([%breach who])])
(poke-our %spider %spider-input vase)
::
:: who: breachee
:: her: wait until hears about breach
::
++ breach-and-hear
|= [=tid:spider who=ship her=ship]
=/ m (strand ,~)
~& > "breaching {<who>} for {<her>}"
;< =bowl:spider bind:m get-bowl
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.bowl)/(scot %p who)/noun
=/ old-rut ;;((unit @) (scry-aqua:util noun our.bowl now.bowl aqua-pax))
=/ new-rut
?~ old-rut
1
+(+.old-rut)
=/ =vase
!>([tid %azimuth-command !>([%breach who])])
;< ~ bind:m (poke-our %spider %spider-input vase)
|- ^- form:m
=* loop $
;< [him=ship =unix-effect] bind:m take-unix-effect
;< =bowl:spider bind:m get-bowl
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.bowl)/(scot %p who)/noun
=/ rut (scry-aqua:util noun our.bowl now.bowl aqua-pax)
?: =([~ new-rut] rut)
(pure:m ~)
loop
::
++ breach-and-hear-aqua
|= [who=ship her=ship]
~& > "breaching {<who>} for {<her>}"
=/ m (strand ,~)
;< =bowl:spider bind:m get-bowl
=/ aqua-pax
@ -186,27 +138,11 @@
loop
::
++ init-ship
|= =ship
|= [=ship fake=?]
=/ m (strand ,~)
^- form:m
~& > "starting {<ship>}"
;< ~ bind:m (send-events (init:util ship `*dawn-event:jael))
(check-ship-booted ship)
::
++ real-ship
|= [=tid:spider =ship]
~& > "booting real {<ship>}"
=/ m (strand ,~)
=/ =vase !>([tid %azimuth-command !>([%create-ship ship])])
;< ~ bind:m (poke-our %spider %spider-input vase)
(check-ship-booted ship)
::
++ raw-ship
|= [=ship keys=(unit dawn-event:jael)]
=/ m (strand ,~)
^- form:m
~& > "starting {<ship>}"
;< ~ bind:m (send-events (init:util ship keys))
;< ~ bind:m (send-events (init:util ship fake))
(check-ship-booted ship)
::
++ check-ship-booted
@ -258,6 +194,7 @@
::
++ send-hi-not-responding
|= [from=@p to=@p]
~& > 'sending hi not responding'
=/ m (strand ,~)
;< ~ bind:m (dojo from "|hi {(scow %p to)}")
(wait-for-output from "{(scow %p to)} not responding still trying")

16
pkg/arvo/lib/ph/util.hoon
View File

@ -16,9 +16,9 @@
:: Start a ship (low-level; prefer +raw-ship)
::
++ init
|= [who=ship keys=(unit dawn-event:jael)]
|= [who=ship fake=?]
^- (list aqua-event)
[%init-ship who keys]~
[%init-ship who fake]~
::
:: Send dojo command
::
@ -28,10 +28,10 @@
%+ send-events-to who
^- (list unix-event)
:~
[//term/1 %belt %ctl `@c`%e]
[//term/1 %belt %ctl `@c`%u]
[//term/1 %belt %txt ((list @c) what)]
[//term/1 %belt %ret ~]
[/d/term/1 %belt %ctl `@c`%e]
[/d/term/1 %belt %ctl `@c`%u]
[/d/term/1 %belt %txt ((list @c) what)]
[/d/term/1 %belt %ret ~]
==
::
:: Control character
@ -40,7 +40,7 @@
|= [who=ship what=term]
^- (list ph-event)
%+ send-events-to who
:~ [//term/1 %belt %ctl (,@c what)]
:~ [/d/term/1 %belt %ctl (,@c what)]
==
::
:: Inject a file into a ship
@ -54,7 +54,7 @@
[path ~ /text/plain (as-octs:mimes:html txt)]
%+ send-events-to who
:~
[//sync/0v1n.2m9vh %into des | input]
[/c/sync/0v1n.2m9vh %into des | input]
==
::
:: Checks whether the given event is a dojo output blit containing the

15
pkg/arvo/lib/pill.hoon
View File

@ -5,12 +5,13 @@
::
+$ pill
$% [%ivory p=(list)]
$: %pill
nam=term
boot-ova=(list)
kernel-ova=(list unix-event)
userspace-ova=(list unix-event)
== ==
$: %pill
nam=term
boot-ova=(list)
kernel-ova=(list unix-event)
userspace-ova=(list unix-event)
==
==
::
+$ unix-event
%+ pair wire
@ -18,6 +19,8 @@
[%what p=(list (pair path (cask)))]
[%whom p=ship]
[%boot ? $%($>(%fake task:jael) $>(%dawn task:jael))]
[%wyrd p=vere]
[%verb p=(unit ?)]
unix-task
==
:: +boot-ovum: boostrap kernel filesystem load

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

@ -514,7 +514,11 @@
^+ tr-core
?- -.action
%add (tr-add +.action)
%remove tr-remove:(tr-abed resource.action)
::
%remove
?. (~(has by tracking) resource.action)
tr-core
tr-remove:(tr-abed resource.action)
==
::
++ tr-cleanup

15
pkg/arvo/mar/csv.hoon Normal file
View File

@ -0,0 +1,15 @@
=, format
=, mimes:html
|_ csv=wain
::
++ grab :: convert from
|%
++ mime |=((pair mite octs) (to-wain q.q))
++ noun wain :: clam from %noun
--
++ grow
|%
++ mime [/text/csv (as-octs (of-wain csv))]
--
++ grad %mime
--

2
pkg/arvo/mar/graph/cache/hook.hoon vendored
View File

@ -2,8 +2,6 @@
|%
+$ cache-action
$% [%graph-to-mark (pair resource:res (unit mark))]
[%perm-marks (pair (pair mark @tas) tube:clay)]
[%transform-marks (pair mark tube:clay)]
==
--
::

15
pkg/arvo/mar/metadata/update-1.hoon
View File

@ -1,15 +1,22 @@
/+ store=metadata-store
|_ =update:store
|_ =update:one:store
++ grad %noun
++ grow
|%
++ noun update
++ json (update:enjs:store update)
++ metadata-update-2
^- update:store
update
--
::
++ grab
|%
++ noun update:store
++ json action:dejs:store
++ noun update:one:store
:: This is ok, we don't send %edit over the wire yet.
++ metadata-update-2
|= upd=update:store
^- update:one:store
?< ?=(%edit -.upd)
upd
--
--

15
pkg/arvo/mar/metadata/update-2.hoon Normal file
View File

@ -0,0 +1,15 @@
/+ store=metadata-store
|_ =update:store
++ grad %noun
++ grow
|%
++ noun update
++ json (update:enjs:store update)
--
::
++ grab
|%
++ noun update:store
++ json action:dejs:store
--
--

34
pkg/arvo/mar/notify/client-action.hoon Normal file
View File

@ -0,0 +1,34 @@
/- *notify
|_ act=client-action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun client-action
++ json
|= jon=^json
=, dejs:format
^- client-action
|^
%. jon
%- of
:~ connect-provider+connect-provider
remove-provider+remove-provider
==
++ connect-provider
%- ot
:~ who+(su fed:ag)
service+so
address+so
==
++ remove-provider
%- ot
:~ who+(su fed:ag)
service+so
==
--
--
--

12
pkg/arvo/mar/notify/provider-action.hoon Normal file
View File

@ -0,0 +1,12 @@
/- *notify
|_ act=provider-action
++ grad %noun
++ grow
|%
++ noun act
--
++ grab
|%
++ noun provider-action
--
--

12
pkg/arvo/mar/notify/update.hoon Normal file
View File

@ -0,0 +1,12 @@
/- *notify
|_ upd=update
++ grad %noun
++ grow
|%
++ noun upd
--
++ grab
|%
++ noun update
--
--

12
pkg/arvo/mar/transform-add-nodes.hoon Normal file
View File

@ -0,0 +1,12 @@
/- *post
|_ i=indexed-post
++ grad %noun
++ grow
|%
++ noun i
--
++ grab
|%
++ noun indexed-post
--
--

2
pkg/arvo/sur/aquarium.hoon
View File

@ -28,7 +28,7 @@
+$ pill pill:pill-lib
::
+$ aqua-event
$% [%init-ship who=ship keys=(unit dawn-event:jael)]
$% [%init-ship who=ship fake=?]
[%pause-events who=ship]
[%snap-ships lab=term hers=(list ship)]
[%restore-snap lab=term]

5
pkg/arvo/sur/btc-provider.hoon
View File

@ -24,6 +24,7 @@
$% [%set-credentials api-url=@t =network]
[%add-whitelist wt=whitelist-target]
[%remove-whitelist wt=whitelist-target]
[%set-interval inte=@dr]
==
+$ action
$% [%address-info =address]
@ -31,6 +32,7 @@
[%raw-tx txid=hexb]
[%broadcast-tx rawtx=hexb]
[%ping ~]
[%block-info block=(unit @ud)]
==
::
+$ result
@ -38,6 +40,7 @@
[%tx-info =info:tx]
[%raw-tx txid=hexb rawtx=hexb]
[%broadcast-tx txid=hexb broadcast=? included=?]
[%block-info =network block=@ud fee=(unit sats) blockhash=hexb blockfilter=hexb]
==
+$ error
$% [%not-connected status=@ud]
@ -60,7 +63,7 @@
[%get-raw-tx txid=hexb]
[%broadcast-tx rawtx=hexb]
[%get-block-count ~]
[%get-block-info ~]
[%get-block-info block=(unit @ud)]
==
::
+$ result

4
pkg/arvo/sur/btc-wallet.hoon
View File

@ -162,6 +162,10 @@
[%new-address =address]
[%balance balance=(unit [confirmed=sats unconfirmed=sats])]
[%error =error]
:: current index being scanned in each wallet part
:: ~ if scan of that part is done
::
[%scan-progress main=(unit idx) change=(unit idx)]
==
::
--

9
pkg/arvo/sur/crunch.hoon Normal file
View File

@ -0,0 +1,9 @@
/- resource
::
|%
+$ channel-info
$: group=resource:resource
channel=resource:resource
channel-type=term
==
--

4
pkg/arvo/sur/graph-store.hoon
View File

@ -73,8 +73,8 @@
::
++ one
|%
++ orm ((ordered-map atom node) gth)
++ orm-log ((ordered-map time logged-update) gth)
++ orm ((on atom node) gth)
++ orm-log ((on time logged-update) gth)
::
+$ graph ((mop atom node) gth)
+$ marked-graph [p=graph q=(unit mark)]

4
pkg/arvo/sur/hark-store.hoon
View File

@ -44,6 +44,9 @@
[%read-note =index]
::
[%seen-index time=@da =stats-index]
::
[%read-graph =resource]
[%read-group =resource]
[%remove-graph =resource]
::
[%read-all ~]
@ -281,6 +284,7 @@
[%unread-note time=@da index]
::
[%seen-index time=@da =stats-index]
::
[%remove-graph =resource]
::
[%read-all ~]

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

@ -44,6 +44,16 @@
[%empty ~]
==
::
+$ edit-field
$% [%title title=cord]
[%description description=cord]
[%color color=@ux]
[%picture =url]
[%preview preview=?]
[%hidden hidden=?]
[%vip vip=vip-metadata]
==
::
+$ metadatum
$: title=cord
description=cord
@ -60,6 +70,7 @@
+$ action
$% [%add group=resource resource=md-resource =metadatum]
[%remove group=resource resource=md-resource]
[%edit group=resource resource=md-resource =edit-field]
[%initial-group group=resource =associations]
==
::
@ -79,6 +90,18 @@
==
==
:: historical
++ one
|%
::
+$ action
$~ [%remove *resource *md-resource]
$< %edit ^action
::
+$ update
$~ [%remove *resource *md-resource]
$< %edit ^update
::
--
++ zero
|%
::

30
pkg/arvo/sur/notify.hoon Normal file
View File

@ -0,0 +1,30 @@
/- resource, graph-store
|%
+$ provider-action
$% [%add service=term notify=@t binding=@t auth-token=@t =whitelist]
[%remove service=term]
[%client-join service=term address=@t]
[%client-leave service=term]
==
::
+$ client-action
$% [%connect-provider who=@p service=term address=@t]
[%remove-provider who=@p service=term]
==
::
+$ notification
$: =resource:resource
=index:graph-store
==
::
+$ whitelist
$: public=?
kids=?
users=(set ship)
groups=(set resource:resource)
==
::
+$ update
$% [%notification =notification]
==
--

2
pkg/arvo/sur/observe-hook.hoon
View File

@ -10,5 +10,7 @@
::
[%warm-cache-all ~]
[%cool-cache-all ~]
[%warm-static-conversion from=term to=term]
[%cool-static-conversion from=term to=term]
==
--

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

@ -252,11 +252,13 @@
:: %what: update from files
:: %whey: produce $mass :: XX remove, scry
:: %verb: toggle laconicity
:: %whiz: prime vane caches
::
$% [%trim p=@ud]
[%what p=(list (pair path (cask)))]
[%whey ~]
[%verb p=(unit ?)]
[%whiz ~]
==
+$ wasp
:: %crud: reroute $ovum with $goof
@ -291,14 +293,23 @@
|=(b=beam =*(s scot `path`[(s %p p.b) q.b (s r.b) s.b]))
::
++ de-beam
~/ %de-beam
|= p=path
^- (unit beam)
?. ?=([@ @ @ *] p) ~
?~ who=(slaw %p i.p) ~
?~ des=?~(i.t.p (some %$) (slaw %tas i.t.p)) ~ :: XX +sym ;~(pose low (easy %$))
?~ ved=(slay i.t.t.p) ~
?. ?=([%$ case] u.ved) ~
`(unit beam)`[~ [`ship`u.who `desk`u.des `case`p.u.ved] t.t.t.p]
?~ ved=(de-case i.t.t.p) ~
`[[`ship`u.who `desk`u.des u.ved] t.t.t.p]
::
++ de-case
~/ %de-case
|= =knot
^- (unit case)
?^ num=(slaw %ud knot) `[%ud u.num]
?^ wen=(slaw %da knot) `[%da u.wen]
?~ lab=(slaw %tas knot) ~
`[%tas u.lab]
::
++ en-omen
|= [vis=view bem=beam]
@ -308,6 +319,7 @@
~(rent co [%many $/tas/way.vis $/tas/car.vis ~])
::
++ de-omen
~/ %de-omen
|= pax=path
^- (unit [vis=view bem=beam])
?~ pax ~
@ -1000,8 +1012,11 @@
++ settle
|= van=vase
^- (pair vase worm)
=/ [rig=vase wor=worm] (~(slym wa *worm) van *vane-sample)
[van +:(~(slap wa wor) rig [%limb %scry])]
=| sac=worm
=^ rig=vase sac (~(slym wa sac) van *vane-sample)
=^ gat=vase sac (~(slap wa sac) rig [%limb %scry])
=^ pro=vase sac (~(slap wa sac) gat [%limb %$])
[van +:(~(mint wa sac) p.pro [%$ 7])]
::
:: XX pass identity to preserve behavior?
::
@ -1470,6 +1485,9 @@
%verb ..pith(lac.fad ?~(p.waif !lac.fad u.p.waif))
%what ~(kel what p.waif)
%whey ..pith(out [[//arvo mass/whey] out])
::
%whiz
..pith(van.mod (~(run by van.mod) |=(vane (settle:va:part vase))))
==
::
++ peek

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

@ -259,6 +259,8 @@
++ head |*(^ ,:+<-) :: get head
++ same |*(* +<) :: identity
::
++ succ |=(@ +(+<)) :: successor
::
++ tail |*(^ ,:+<+) :: get tail
++ test |=(^ =(+<- +<+)) :: equality
::
@ -8764,6 +8766,7 @@
%peek peek
%repo repo
%rest rest
%sink sink
%tack tack
%toss toss
%wrap wrap
@ -10838,7 +10841,7 @@
|- ^- type
?~ lov sut
$(lov t.lov, sut (face i.lov sut))
:: ::
::
++ sint :: reduce by reference
|= $: :: hod: expand holds
::
@ -10911,6 +10914,39 @@
%- ~(gas in *(set type))
(turn leg |=([p=type q=hoon] (play(sut p) q)))
::
++ sink
~/ %sink
|^ ^- cord
?- sut
%void 'void'
%noun 'noun'
[%atom *] (rap 3 'atom ' p.sut ' ' ?~(q.sut '~' u.q.sut) ~)
[%cell *] (rap 3 'cell ' (mup p.sut) ' ' (mup q.sut) ~)
[%face *] (rap 3 'face ' ?@(p.sut p.sut (mup p.sut)) ' ' (mup q.sut) ~)
[%fork *] (rap 3 'fork ' (mup p.sut) ~)
[%hint *] (rap 3 'hint ' (mup p.sut) ' ' (mup q.sut) ~)
[%hold *] (rap 3 'hold ' (mup p.sut) ' ' (mup q.sut) ~)
::
[%core *]
%+ rap 3
:~ 'core '
(mup p.sut)
' '
?~(p.p.q.sut '~' u.p.p.q.sut)
' '
q.p.q.sut
' '
r.p.q.sut
' '
(mup q.q.sut)
' '
(mup p.r.q.sut)
==
==
::
++ mup |=(* (scot %p (mug +<)))
--
::
++ take
|= [vit=vein duz=$-(type type)]
^- (pair axis type)

18
pkg/arvo/sys/lull.hoon
View File

@ -1069,14 +1069,23 @@
:::: :: (1d2)
::
+$ blew [p=@ud q=@ud] :: columns rows
+$ belt :: old belt
+$ belt :: client input
$? bolt :: simple input
$% [%mod mod=?(%ctl %met %hyp) key=bolt] :: w/ modifier
[%txt p=(list @c)] :: utf32 text
::TODO consider moving %hey, %rez, %yow here ::
::TMP forward backwards-compatibility ::
:: ::
[%ctl p=@c] ::
[%met p=@c] ::
== == ::
+$ bolt :: simple input
$@ @c :: simple keystroke
$% [%aro p=?(%d %l %r %u)] :: arrow key
[%bac ~] :: true backspace
[%ctl p=@c] :: control-key
[%del ~] :: true delete
[%met p=@c] :: meta-key
[%hit r=@ud c=@ud] :: mouse click
[%ret ~] :: return
[%txt p=(list @c)] :: utf32 text
== ::
+$ blit :: old blit
$% [%bel ~] :: make a noise
@ -2107,6 +2116,7 @@
[%g task:gall]
[%i task:iris]
[%j task:jael]
[%$ %whiz ~]
[@tas %meta vase]
==
:: full vane names are required in vanes

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

@ -2096,7 +2096,7 @@
|= [k=beak v=(unit dome:clay)]
^- tank
=/ received=tape ?~(v "missing" "received")
leaf+"{<k>} {received}"
leaf+"{<(en-beam k ~)>} {received}"
:_ discarded
leaf+"fusing into {<syd>} from {<bas>} {<con>} - overwriting prior fuse"
=. fiz (make-melt bas con)
@ -2113,8 +2113,11 @@
:: responses we get for the merge will cause take-fuse to crash
::
=. fiz *melt
((slog [leaf+"clay: fuse failed, missing {<bec>}"]~) ..take-fuse)
?> (~(has by sto.fiz) bec)
=/ msg=tape <(en-beam bec ~)>
((slog [leaf+"clay: fuse failed, missing {msg}"]~) ..take-fuse)
?. (~(has by sto.fiz) bec)
=/ msg=tape <(en-beam bec ~)>
((slog [leaf+"clay: got strange fuse response {<msg>}"]~) ..take-fuse)
=. fiz
:+ bas.fiz con.fiz
(~(put by sto.fiz) bec `!<(dome:clay q.r.u.riot))
@ -2135,7 +2138,6 @@
|-
^+ ..take-fuse
?~ merges
=/ t=tang [leaf+"{<syd>} fused from {<bas.fiz>} {<con.fiz>}" ~]
=. ..take-fuse (done-fuse clean-state %& ~)
(park | [%| continuation-yaki(p (flop parents))] rag)
=/ [bec=beak g=germ] i.merges
@ -2143,7 +2145,8 @@
=/ result (merge-helper p.bec q.bec g ali-dom `continuation-yaki)
?- -.result
%|
(done-fuse clean-state %| %fuse-merge-failed p.result)
=/ failing-merge=tape "{<bec>} {<g>}"
(done-fuse clean-state %| %fuse-merge-failed leaf+failing-merge p.result)
::
%&
=/ merge-result=(unit merge-result) +.result
@ -3660,7 +3663,7 @@
=/ lower=@ud 1
|-
:: a should be excluded, so wait until we're past it
?: =(lower +(a))
?: (gte lower +(a))
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) lower))
$(acc (~(uni in acc) res), lower +(lower))
@ -3668,7 +3671,7 @@
=| acc=(set tako)
=/ upper=@ud b
|-
?: =(upper a)
?: (lte upper a)
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) upper))
$(acc (~(uni in acc) res), upper (dec upper))

32
pkg/arvo/sys/vane/dill.hoon
View File

@ -106,7 +106,6 @@
%flow +>
%harm +>
%hail (send %hey ~)
%belt (send `dill-belt`p.kyz)
%text (from %out (tuba p.kyz))
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
@ -116,6 +115,18 @@
%pack (dump kyz)
%crop (dump trim+p.kyz)
%verb (pass /verb %$ kyz)
::
%belt
%- send
::TMP forwards compatibility with next-dill
::
?@ p.kyz [%txt p.kyz ~]
?: ?=(%hit -.p.kyz) [%txt ~]
?. ?=(%mod -.p.kyz) p.kyz
=/ =@c
?@ key.p.kyz key.p.kyz
?:(?=(?(%bac %del %ret) -.key.p.kyz) `@`-.key.p.kyz ~-)
?:(?=(%met mod.p.kyz) [%met c] [%ctl c])
==
::
++ crud
@ -264,13 +275,18 @@
::
[%gall %unto *]
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
%poke-ack ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%kick peer
%watch-ack ?~ p.p.+>.sih
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
%fact (from ;;(dill-blit q:`vase`+>+>.sih))
?- -.+>.sih
%poke-ack ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%kick peer
%watch-ack
?~ p.p.+>.sih
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
::
%fact
?. ?=(%dill-blit p.cage.p.+>.sih)
+>.$
(from ;;(dill-blit q.q.cage.p.+>.sih))
==
::
[%clay %note *]

102
pkg/arvo/sys/vane/eyre.hoon
View File

@ -30,6 +30,9 @@
$% [%rest p=@da]
[%wait p=@da]
== ==
$: %c
$>(%warp task:clay)
==
:: %d: to dill
::
$: %d
@ -53,6 +56,12 @@
$: %gall
gift:gall
:: $>(%unto gift:gall)
::
==
$: %clay
gift:clay
:: $>(%writ gift:clay)
::
== ==
--
:: more structures
@ -545,6 +554,7 @@
:: +per-server-event: per-event server core
::
++ per-server-event
~% %eyre-per-server-event ..part ~
:: gate that produces the +per-server-event core from event information
::
|= [[eny=@ =duct now=@da rof=roof] state=server-state]
@ -772,7 +782,7 @@
:* duct %pass /run-app-request/[eyre-id]
%g %deal [our our] app
%poke %handle-http-request
!>([eyre-id inbound-request])
!>(`[@ta inbound-request:eyre]`[eyre-id inbound-request])
==
==
:: +cancel-request: handles a request being externally aborted
@ -1196,15 +1206,21 @@
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
%^ return-static-data-on-duct 404 'text/html'
(error-page 404 %.y url.request ~)
:: if there's already a duct listening to this channel, we must 400
::
?: ?=([%| *] state.u.maybe-channel)
%^ return-static-data-on-duct 400 'text/html'
(error-page 400 %.y url.request "channel already bound")
:: when opening an event-stream, we must cancel our timeout timer
:: if there's no duct already bound. Else, kill the old request
:: and replace it
::
=. moves
[(cancel-timeout-move channel-id p.state.u.maybe-channel) moves]
=^ cancel-moves state
?. ?=([%| *] state.u.maybe-channel)
:_ state
(cancel-timeout-move channel-id p.state.u.maybe-channel)^~
=/ cancel-heartbeat
?~ heartbeat.u.maybe-channel ~
:_ ~
%+ cancel-heartbeat-move channel-id
[date duct]:u.heartbeat.u.maybe-channel
=- [(weld cancel-heartbeat -<) ->]
(handle-response(duct p.state.u.maybe-channel) [%cancel ~])
:: the request may include a 'Last-Event-Id' header
::
=/ maybe-last-event-id=(unit @ud)
@ -1231,9 +1247,9 @@
::NOTE these will only fail if the mark and/or json types changed,
:: since conversion failure also gets caught during first receive.
:: we can't do anything about this, so consider it unsupported.
?~ sign=(channel-event-to-sign channel-event) $
?~ json=(sign-to-json request-id u.sign) $
$(events [(event-json-to-wall id u.json) events])
?~ sign=(channel-event-to-sign channel-event) $
?~ jive=(sign-to-json request-id u.sign) $
$(events [(event-json-to-wall id +.u.jive) events])
:: send the start event to the client
::
=^ http-moves state
@ -1273,7 +1289,7 @@
|= =channel
channel(events ~, state [%| duct], heartbeat (some [heartbeat-time duct]))
::
[[heartbeat (weld http-moves moves)] state]
[[heartbeat :(weld http-moves cancel-moves moves)] state]
:: +acknowledge-events: removes events before :last-event-id on :channel-id
::
++ acknowledge-events
@ -1499,8 +1515,12 @@
:: if conversion succeeds, we *can* send it. if the client is actually
:: connected, we *will* send it immediately.
::
=/ json=(unit json)
=/ jive=(unit (quip move json))
(sign-to-json request-id sign)
=/ json=(unit json)
?~(jive ~ `+.u.jive)
=? moves ?=(^ jive)
(weld moves -.u.jive)
=* sending &(?=([%| *] state.u.channel) ?=(^ json))
::
=/ next-id next-id.u.channel
@ -1578,7 +1598,7 @@
^= data
%- wall-to-octs
%+ event-json-to-wall next-id
(need (sign-to-json request-id %kick ~))
+:(need (sign-to-json request-id %kick ~))
::
complete=%.n
==
@ -1619,32 +1639,33 @@
:: +sign-to-json: render sign from request-id as json channel event
::
++ sign-to-json
~% %sign-to-json ..part ~
|= [request-id=@ud =sign:agent:gall]
^- (unit json)
^- (unit (quip move json))
:: for facts, we try to convert the result to json
::
=/ jsyn=(unit sign:agent:gall)
?. ?=(%fact -.sign) `sign
?: ?=(%json p.cage.sign) `sign
=/ [from=(unit mark) jsyn=(unit sign:agent:gall)]
?. ?=(%fact -.sign) [~ `sign]
?: ?=(%json p.cage.sign) [~ `sign]
:: find and use tube from fact mark to json
::
=* have=mark p.cage.sign
=* desc=tape "from {(trip have)} to json"
=/ tube=(unit tube:clay)
=/ tuc=(unit (unit cage))
(rof ~ %cc [our %home da+now] /[have]/json)
?. ?=([~ ~ *] tuc) ~
`!<(tube:clay q.u.u.tuc)
?~ tube
((slog leaf+"eyre: no tube {desc}" ~) ~)
::
=/ res (mule |.((u.tube q.cage.sign)))
?: ?=(%& -.res)
`[%fact %json p.res]
((slog leaf+"eyre: failed tube {desc}" ~) ~)
::
=/ convert=(unit vase)
=/ cag=(unit (unit cage))
(rof ~ %cf [our %home da+now] /[have]/json)
?. ?=([~ ~ *] cag) ~
`q.u.u.cag
?~ convert
((slog leaf+"eyre: no convert {desc}" ~) [~ ~])
~| "conversion failed {desc}"
[`have `[%fact %json (slym u.convert q.q.cage.sign)]]
?~ jsyn ~
%- some
:- ?~ from ~
:_ ~
:^ duct %pass /conversion-cache/[u.from]
[%c %warp our %home `[%sing %f da+now /[u.from]/json]]
=* sign u.jsyn
=, enjs:format
%- pairs
@ -1665,7 +1686,7 @@
:- 'json'
~| [%unexpected-fact-mark p.cage.sign]
?> =(%json p.cage.sign)
;;(json q.q.cage.sign)
!<(json q.cage.sign)
==
::
%kick
@ -1696,7 +1717,7 @@
=/ res
%- handle-response
:* %continue
data=(some (as-octs:mimes:html '\0a'))
data=(some (as-octs:mimes:html ':\0a'))
complete=%.n
==
=/ http-moves -.res
@ -2320,14 +2341,15 @@
::
|^ ^- [(list move) _http-server-gate]
::
?+ i.wire
~|([%bad-take-wire wire] !!)
?+ i.wire
~|([%bad-take-wire wire] !!)
::
%run-app-request run-app-request
%watch-response watch-response
%sessions sessions
%channel channel
%acme acme-ack
%run-app-request run-app-request
%watch-response watch-response
%sessions sessions
%channel channel
%acme acme-ack
%conversion-cache `http-server-gate
==
::
++ run-app-request

11
pkg/arvo/sys/vane/gall.hoon
View File

@ -159,7 +159,10 @@
~< %slog.[0 leaf+"gall: molted"]
:: +molt should never notify its client about agent changes
::
=- [(skip -< |=(move ?=([* %give %onto *] +<))) ->]
=- :_ ->
%+ welp
(skip -< |=(move ?=([* %give %onto *] +<)))
[^duct %pass /whiz/gall %$ %whiz ~]~
=/ adult adult-core
=. state.adult
[%7 system-duct outstanding contacts yokes=~ blocked]:spore
@ -757,12 +760,10 @@
mo-core
=^ [=duct =routes blocker=(each deal sign:agent)] blocked
~(get to blocked)
?: ?=(%| -.blocker) $
=/ =move
=/ =sock [attributing.routes our]
=/ card
?: ?=(%& -.blocker)
[%slip %g %deal sock dap p.blocker]
[%pass /clear-huck %b %huck `sign-arvo`[%gall %unto p.blocker]]
=/ card [%slip %g %deal sock dap p.blocker]
[duct card]
$(moves [move moves])
:: +mo-filter-queue: remove all blocked tasks from ship.

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