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

Merge naive/aggregator into poprox/naive-tests

Browse Source
This commit is contained in:
drbeefsupreme 2021-08-16 15:14:58 -04:00
commit 8a5a7754f5
No known key found for this signature in database
GPG Key ID: B70D5683DE7F9EFC
570 changed files with 56357 additions and 11318 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

8
.github/actions/glob/entrypoint.sh vendored
View File

@ -10,10 +10,10 @@ chmod 600 service-account
chmod 600 id_ssh chmod 600 id_ssh
chmod 600 id_ssh.pub chmod 600 id_ssh.pub
janeway release glob --dev --no-pill \ janeway release glob-all --dev --no-pill \
--credentials service-account \ --credentials service-account \
--ssh-key id_ssh \ --ssh-key id_ssh \
--do-it-live \ --ci \
| bash | bash
SHORTHASH=$(git rev-parse --short HEAD) SHORTHASH=$(git rev-parse --short HEAD)
@ -21,12 +21,12 @@ SHORTHASH=$(git rev-parse --short HEAD)
janeway release prepare-ota arvo-glob-"$SHORTHASH" "$1" \ janeway release prepare-ota arvo-glob-"$SHORTHASH" "$1" \
--credentials service-account \ --credentials service-account \
--ssh-key id_ssh \ --ssh-key id_ssh \
--do-it-live \ --ci \
| bash | bash
janeway release perform-ota "$1" \ janeway release perform-ota "$1" \
--credentials service-account \ --credentials service-account \
--ssh-key id_ssh \ --ssh-key id_ssh \
--do-it-live \ --ci \
| bash | bash

27
.github/workflows/chromatic.yml vendored Normal file
View File

@ -0,0 +1,27 @@
name: Chromatic Deployment
on:
pull_request:
paths:
- 'pkg/interface/**'
push:
paths:
- 'pkg/interface/**'
branches:
- 'release/next-userspace'
jobs:
chromatic-deployment:
runs-on: ubuntu-latest
name: "Deploy Chromatic"
steps:
- uses: actions/checkout@v2
with:
fetch-depth: 0
- run: cd 'pkg/interface' && npm i
- name: Publish to Chromatic
uses: chromaui/action@v1
with:
token: ${{ secrets.GITHUB_TOKEN }}
projectToken: ${{ secrets.CHROMATIC_PROJECT_TOKEN }}
workingDir: pkg/interface

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

@ -2,7 +2,7 @@ name: glob
on: on:
push: push:
branches: branches:
- 'release/next-js' - 'release/next-userspace'
jobs: jobs:
glob: glob:
runs-on: ubuntu-latest runs-on: ubuntu-latest

4
.github/workflows/merge-master.yml vendored
View File

@ -6,13 +6,13 @@ on:
jobs: jobs:
merge-to-next-js: merge-to-next-js:
runs-on: ubuntu-latest runs-on: ubuntu-latest
name: "Merge master to release/next-js" name: "Merge master to release/next-userspace"
steps: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
- uses: devmasx/merge-branch@v1.3.1 - uses: devmasx/merge-branch@v1.3.1
with: with:
type: now type: now
target_branch: release/next-js target_branch: release/next-userspace
github_token: ${{ secrets.JANEWAY_BOT_TOKEN }} github_token: ${{ secrets.JANEWAY_BOT_TOKEN }}
merge-to-group-timer: merge-to-group-timer:

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

@ -0,0 +1,14 @@
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

2
.gitignore vendored
View File

@ -76,4 +76,4 @@ pkg/interface/link-webext/web-ext-artifacts
*.xz *.xz
# Logs # Logs
*.log *.log

6
MAINTAINERS.md
View File

@ -309,9 +309,9 @@ the new binary, and restarting the pier with it.
#### Continuous deployment #### Continuous deployment
A subset of release branches are deployed continuously to the network. Thus far A subset of release branches are deployed continuously to the network. Thus far
this only includes `release/next-js`, which deploys livenet-compatible this only includes `release/next-userspace`, which deploys livenet-compatible
JavaScript changes to select QA ships. Any push to master will automatically changes to select QA ships. Any push to master will automatically
merge master into `release/next-js` to keep the streams at parity. merge master into `release/next-userspace` to keep the streams at parity.
### Announce the update ### Announce the update

4
bin/ivory.pill
View File

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

4
bin/solid.pill
View File

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

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

@ -1394,8 +1394,6 @@
^+ this ^+ this
?: =(~ dom) ?: =(~ dom)
~|(%acme-empty-certificate-order !!) ~|(%acme-empty-certificate-order !!)
?: ?=(?(%earl %pawn) (clan:title our.bow))
this
=. ..emit (queue-next-order 1 | dom) =. ..emit (queue-next-order 1 | dom)
=. ..emit cancel-current-order =. ..emit cancel-current-order
:: notify %dill :: notify %dill

262
pkg/arvo/app/aggregator-rpc.hoon Normal file
View File

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

779
pkg/arvo/app/aggregator.hoon
View File

@ -16,79 +16,90 @@
:: when retrying, only do so if l2 txs remain in the "frozen" txs group. :: when retrying, only do so if l2 txs remain in the "frozen" txs group.
:: on %tx diff from naive, remove the matching tx from the frozen group. :: on %tx diff from naive, remove the matching tx from the frozen group.
:: ::
::TODO remaining general work:
:: - hook up subscription to azimuth for %tx diffs
:: - hook up thread updates/results
:: - hook up timer callbacks
:: - cache state, upate after every azimuth %fact
:: - properly support private key changes
::
::TODO questions: ::TODO questions:
:: - it's a bit weird how we just assume the raw and tx in raw-tx to match... :: - it's a bit weird how we just assume the raw and tx in raw-tx to match...
:: ::
/+ naive, default-agent, ethereum, dbug, verb /- *dice
/= ttttt /tests/lib/naive ::TODO use new lib /+ azimuth,
naive,
dice,
lib=naive-transactions,
default-agent,
ethereum,
dbug,
verb
:: ::
::TODO /sur file for public types
|% |%
+$ state-0 +$ state-0
$: %0 $: %0
:: pending: the next l2 txs to be sent :: pending: the next l2 txs to be sent
:: sending: the l2 txs currently sending/awaiting l2 confirmation :: sending: the l2 txs currently sending/awaiting l2 confirmation
::TODO should maybe key by [address nonce] instead. same for wires
:: finding: raw-tx-hash reverse lookup for sending map :: finding: raw-tx-hash reverse lookup for sending map
:: history: status of l2 txs by ethereum address
:: transfers: index that keeps track of transfer-proxy changes
:: next-nonce: next l1 nonce to use :: next-nonce: next l1 nonce to use
:: next-batch: when then next l2 batch will be sent
:: pre: predicted l2 state
:: own: ownership of azimuth points
:: derive-p: flag (derive predicted state)
:: derive-o: flag (derive ownership state)
:: ::
pending=(list pend-tx) pending=(list pend-tx)
sending=(map nonce:naive [next-gas-price=@ud txs=(list raw-tx:naive)]) ::
finding=(map keccak $?(%confirmed %failed l1-tx-pointer)) $= sending
next-nonce=@ud %+ map l1-tx-pointer
[next-gas-price=@ud txs=(list raw-tx:naive)]
::
finding=(map keccak ?(%confirmed %failed l1-tx-pointer))
history=(jug address:ethereum roller-tx)
transfers=(map ship address:ethereum)
next-nonce=(unit @ud)
next-batch=time
pre=^state:naive
own=owners
derive-p=?
derive-o=?
:: ::
:: pk: private key to send the roll :: pk: private key to send the roll
:: frequency: time to wait between sending batches (TODO fancier) :: frequency: time to wait between sending batches (TODO fancier)
:: endpoint: ethereum rpc endpoint to use :: endpoint: ethereum rpc endpoint to use
:: contract: ethereum contract address
:: chain-id: mainnet, ropsten, local (https://chainid.network/)
:: ::
pk=@ pk=@
frequency=@dr frequency=@dr
endpoint=@t endpoint=(unit @t)
contract=@ux
chain-id=@
== ==
:: ::
+$ keccak @ux +$ init [nas=^state:naive own=owners]
:: ::
+$ tx-status +$ config
$: status=?(%unknown %pending %sending %confirmed %failed) $% [%frequency frequency=@dr]
pointer=(unit l1-tx-pointer) [%setkey pk=@]
== [%endpoint endpoint=@t]
:: [%network net=?(%mainnet %ropsten %local)]
+$ l1-tx-pointer
$: =address:ethereum
nonce=@ud
==
::
::TODO cache sender address?
+$ pend-tx [force=? =raw-tx:naive]
::
+$ part-tx
$% [%raw raw=octs]
[%don =tx:naive]
[%ful raw=octs =tx:naive] ::TODO redundant?
== ==
:: ::
+$ action +$ action
$% [%submit force=? sig=@ tx=part-tx] $% :: we need to include the address in submit so pending txs show up
[%cancel sig=@ keccak=@] :: in the tx history, but because users can send the wrong
:: :: address, in +apply-tx:predicted state, we just replace
:: the provided address, with the one used when the message was signed;
::
:: we need to do it there to know the correct nonce that the signed
:: message should have included.
::
[%submit force=? =address:naive sig=@ tx=part-tx]
[%cancel sig=@ keccak=@ =l2-tx =ship]
[%commit ~] ::TODO maybe pk=(unit @) later [%commit ~] ::TODO maybe pk=(unit @) later
[%config frequency=@dr] [%config config]
[%setkey pk=@]
::TODO configure endpoint, contract address, chain..?
== ==
:: ::
+$ card card:agent:gall +$ card card:agent:gall
:: ::
::TODO config? :: TODO: add to config
++ contract 0xb581.01cd.3bbb.cc6f.a40b.cdb0.4bb7.1623.b5c7.d39b
++ chain-id '1'
:: ::
++ resend-time ~m5 ++ resend-time ~m5
:: ::
@ -110,9 +121,14 @@
:: ::
++ on-init ++ on-init
^- (quip card _this) ^- (quip card _this)
::TODO set default frequency and endpoint?
=. frequency ~h1 =. frequency ~h1
[~ this] =. contract naive:local-contracts:azimuth
=. chain-id chain-id:local-contracts:azimuth
=^ card next-batch set-timer
:_ this
:~ card
[%pass /azimuth-events %agent [our.bowl %azimuth] %watch /event]
==
:: ::
++ on-save !>(state) ++ on-save !>(state)
++ on-load ++ on-load
@ -125,28 +141,46 @@
^- (quip card _this) ^- (quip card _this)
=^ cards state =^ cards state
?+ mark (on-poke:def mark vase) ?+ mark (on-poke:def mark vase)
%aggregator-action %aggregator-action
=+ !<(poke=action vase) =+ !<(poke=action vase)
(on-action:do poke) (on-action:do poke)
== ==
[cards this] [cards this]
:: +on-peek: scry paths :: +on-peek: scry paths
::TODO reevaluate wrt recent flow changes
:: ::
:: /x/pending -> %noun (list pend-tx) :: /x/pending -> %noun (list pend-tx)
:: /x/pending/[~ship] -> %noun (list pend-tx) :: /x/pending/[~ship] -> %noun (list pend-tx)
:: /x/pending/[0xadd.ress] -> %noun (list pend-tx) :: /x/pending/[0xadd.ress] -> %noun (list pend-tx)
:: /x/tx/[0xke.ccak]/status -> %noun tx-status :: /x/tx/[0xke.ccak]/status -> %noun tx-status
:: /x/nonce/[~ship]/[0xadd.ress] -> %atom @ :: /x/history/[0xadd.ress] -> %noun (list roller-tx)
:: /x/nonce/[~ship]/[proxy] -> %noun (unit @)
:: /x/spawned/[~ship] -> %noun (list [ship address])
:: /x/next-batch -> %atom time
:: /x/point/[~ship] -> %noun point:naive
:: /x/points/[0xadd.ress] -> %noun (list [ship point:naive])
:: /x/config -> %noun config
:: /x/chain-id -> %atom @
:: ::
++ on-peek ++ on-peek
|= =path |= =path
^- (unit (unit cage)) ^- (unit (unit cage))
|^
?+ path ~ ?+ path ~
[%x %pending ~] ``noun+!>(pending) [%x %pending ~] ``noun+!>(pending)
[%x %pending @ ~] (pending-by i.t.t.path)
[%x %tx @ %status ~] (status i.t.t.path)
[%x %history @ ~] (history i.t.t.path)
[%x %nonce @ @ ~] (nonce i.t.t.path i.t.t.t.path)
[%x %spawned @ ~] (spawned i.t.t.path)
[%x %next-batch ~] ``atom+!>(next-batch)
[%x %point @ ~] (point i.t.t.path)
[%x %points @ ~] (points i.t.t.path)
[%x %config ~] config
[%x %chain-id ~] ``atom+!>(chain-id)
==
:: ::
[%x %pending @ ~] ++ pending-by
=* wat i.t.t.path |= wat=@t
?~ who=(slaw %p wat) ?~ who=(slaw %p wat)
:: by-address :: by-address
:: ::
@ -156,8 +190,7 @@
``noun+!>(pending) ``noun+!>(pending)
%+ skim pending %+ skim pending
|= pend-tx |= pend-tx
::TODO deduce address from sig.raw-tx ? =(u.wer (need (get-l1-address tx.raw-tx pre)))
!!
:: by-ship :: by-ship
:: ::
=; pending=(list pend-tx) =; pending=(list pend-tx)
@ -166,8 +199,9 @@
|= pend-tx |= pend-tx
=(u.who ship.from.tx.raw-tx) =(u.who ship.from.tx.raw-tx)
:: ::
[%x %tx @ %status ~] ++ status
?~ keccak=(slaw %ux i.t.t.path) |= wat=@t
?~ keccak=(slaw %ux wat)
[~ ~] [~ ~]
:+ ~ ~ :+ ~ ~
:- %noun :- %noun
@ -179,27 +213,107 @@
=; known=? =; known=?
[?:(known %pending %unknown) ~] [?:(known %pending %unknown) ~]
%+ lien pending %+ lien pending
|= [* raw-tx:naive] |= pend-tx
=(u.keccak (hash-tx raw)) =(u.keccak (hash-tx:lib raw.raw-tx))
:: ::
[%x %nonce @ @ ~] ++ history
?~ who=(slaw %p i.t.t.path) |= wat=@t
:+ ~ ~
:- %noun
!> ^- (list roller-tx)
?~ addr=(slaw %ux wat) ~
%~ tap in
(~(get ju ^history) u.addr)
::
++ nonce
|= [who=@t proxy=@t]
?~ who=(slaw %p who)
[~ ~] [~ ~]
=+ proxy=i.t.t.t.path
?. ?=(proxy:naive proxy) ?. ?=(proxy:naive proxy)
[~ ~] [~ ~]
=/ [* nas=^state:naive] pending-state:do :+ ~ ~
::TODO or should we ~ when !(~(has by points.nas) who) ? :- %noun
=/ =point:naive (~(gut by points.nas) u.who *point:naive) !> ^- (unit @)
=+ (proxy-from-point:naive proxy point) ?~ point=(get:orm:naive points.pre u.who)
``atom+!>(nonce) ~
== =< `nonce
(proxy-from-point:naive proxy u.point)
::
++ spawned
|= wat=@t
:+ ~ ~
:- %noun
!> ^- (list [=^ship =address:ethereum])
?~ star=(slaw %p wat) ~
=/ range
%+ lot:orm:naive points.pre
:: range exclusive [star next-star-first-planet-]
:: TODO: make range inclusive ([first-planet last-planet])?
::
[`u.star `(cat 3 +(u.star) 0x1)]
%+ turn (tap:orm:naive range)
|= [=ship =point:naive]
^- [=^ship =address:ethereum]
:- ship
address:(proxy-from-point:naive %own point)
::
++ point
|= wat=@t
?~ ship=(rush wat ;~(pfix sig fed:ag))
``noun+!>(*(unit point:naive))
``noun+!>((get:orm:naive points.pre u.ship))
::
++ points
|= wat=@t
:+ ~ ~
:- %noun
!> ^- (list ship)
?~ addr=(slaw %ux wat)
~
%~ tap in
(~(get ju own) u.addr)
::
++ config
:+ ~ ~
:- %noun
!> ^- roller-config
:* next-batch
frequency
resend-time
contract
chain-id
==
--
:: ::
++ on-arvo ++ on-arvo
|= [=wire =sign-arvo] |= [=wire =sign-arvo]
^- (quip card _this) ^- (quip card _this)
?+ +<.sign-arvo (on-arvo:def wire sign-arvo) ?+ wire (on-arvo:def wire sign-arvo)
%wake =^(cards state on-timer:do [cards this]) [%timer ~]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake =^(cards state on-timer:do [cards this])
==
::
[%predict ~]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake
=. state (predicted-state canonical-state):do
`this(derive-p &)
==
::
[%owners ~]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake
=. own.state canonical-owners:do
`this(derive-o &)
==
::
[%resend @ @ ~]
=/ [address=@ux nonce=@ud]
[(slav %ux i.t.wire) (rash i.t.t.wire dem)]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake [(send-roll:do address nonce) this]
==
== ==
:: ::
++ on-fail ++ on-fail
@ -209,7 +323,120 @@
:: ::
++ on-watch on-watch:def ++ on-watch on-watch:def
++ on-leave on-leave:def ++ on-leave on-leave:def
++ on-agent on-agent:def ++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ wire (on-agent:def wire sign)
[%send @ @ *] (send-batch i.t.wire i.t.t.wire sign)
[%azimuth-events ~] (azimuth-event sign)
[%nonce ~] (nonce sign)
==
::
++ send-batch
|= [address=@t nonce=@t =sign:agent:gall]
^- (quip card _this)
=/ [address=@ux nonce=@ud]
[(slav %ux address) (rash nonce dem)]
?- -.sign
%poke-ack
?~ p.sign
%- (slog leaf+"Send batch thread started successfully" ~)
[~ this]
%- (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
:_ this
[(leave:spider:do wire)]~
::
%watch-ack
?~ p.sign
[~ this]
=/ =tank leaf+"{(trip dap.bowl)} couldn't start listen to thread"
%- (slog tank u.p.sign)
[~ this]
::
%kick
[~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"{(trip dap.bowl)} failed" leaf+<term> tang)
=^ cards state
(on-batch-result:do address nonce %.n^'thread failed')
[cards this]
::
%thread-done
=+ !<(result=(each @ud @t) q.cage.sign)
=^ cards state
(on-batch-result:do address nonce result)
[cards this]
==
==
::
++ azimuth-event
|= =sign:agent:gall
^- (quip card _this)
?+ -.sign [~ this]
%watch-ack
?~ p.sign [~ this]
=/ =tank leaf+"{(trip dap.bowl)} couldn't start listen to %azimuth"
%- (slog tank u.p.sign)
[~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%naive-diffs
=+ !<(=diff:naive q.cage.sign)
=^ cards state
(on-naive-diff:do diff)
[cards this]
::
%naive-state
~& > %received-azimuth-state
:: cache naive and ownership state
::
=^ nas own.state !<(init q.cage.sign)
=. state (predicted-state:do nas)
`this
==
==
::
++ nonce
|= =sign:agent:gall
^- (quip card _this)
?- -.sign
%poke-ack
?~ p.sign
%- (slog leaf+"Nonce thread started successfully" ~)
[~ this]
%- (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
:_ this
[(leave:spider:do wire)]~
::
%watch-ack
?~ p.sign
[~ this]
=/ =tank leaf+"{(trip dap.bowl)} couldn't start listen to thread"
%- (slog tank u.p.sign)
[~ this]
::
%kick
[~ this]
::
%fact
?+ p.cage.sign (on-agent:def wire sign)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"{(trip dap.bowl)} failed" leaf+<term> tang)
[~ this]
::
%thread-done
=+ !<(nonce=@ud q.cage.sign)
[~ this(next-nonce `nonce)]
==
==
--
-- --
:: ::
|_ =bowl:gall |_ =bowl:gall
@ -231,176 +458,333 @@
|= [=wire thread=term arg=vase] |= [=wire thread=term arg=vase]
^- (list card) ^- (list card)
=/ tid=@ta (rap 3 thread '--' (scot %uv eny.bowl) ~) =/ tid=@ta (rap 3 thread '--' (scot %uv eny.bowl) ~)
:~ (poke wire %spider-start !>([~ `tid thread arg])) =/ args [~ `tid thread arg]
(watch wire %spider-start /thread-result/[tid]) :~ [%pass wire %agent [our.bowl %spider] %watch /thread-result/[tid]]
[%pass wire %agent [our.bowl %spider] %poke %spider-start !>(args)]
== ==
:: ::
++ poke
|= [=path =cage]
^- card
[%pass path %agent [our.bowl %spider] %poke cage]
::
++ watch
|= [=path =sub=path]
^- card
[%pass path %agent [our.bowl %spider] %watch sub-path]
::
++ leave ++ leave
|= =path |= =path
^- card ^- card
[%pass path %agent [our.bowl %spider] %leave ~] [%pass path %agent [our.bowl %spider] %leave ~]
-- --
:: ::
++ hash-tx keccak-256:keccak:crypto
::
++ hash-raw-tx
|= =raw-tx:naive
(hash-tx raw.raw-tx)
::
++ part-tx-to-full ++ part-tx-to-full
|= =part-tx |= =part-tx
^- [octs tx:naive] ^- [octs tx:naive]
?+ -.part-tx !! ?- -.part-tx
:: %raw [+.part-tx (decode-tx:naive +.part-tx)] %raw
:: %don [(encode-tx:naive +.part-tx) +.part-tx] ?~ batch=(parse-raw-tx:naive q.raw.part-tx)
~& %parse-failed
:: TODO: maybe return a unit if parsing fails?
::
!!
[raw tx]:-.u.batch
::
%don [(gen-tx-octs:lib +.part-tx) +.part-tx]
%ful +.part-tx %ful +.part-tx
== ==
:: +pending-state :: +canonical-state: current l2 state from /app/azimuth
:: ::
:: derives tentative state from pending txs and canonical state, ++ canonical-state
:: discarding invalid pending txs in the process. .^ ^state:naive
%gx
(scot %p our.bowl)
%azimuth
(scot %da now.bowl)
/nas/noun
==
:: +canonical-owners: current azimuth point ownership
:: ::
::TODO maybe want to cache locally, refresh on %fact from azimuth? ++ canonical-owners
.^ owners
%gx
(scot %p our.bowl)
%azimuth
(scot %da now.bowl)
/own/noun
==
:: +predicted-state
:: ::
++ pending-state :: derives predicted state from applying pending/sending txs to
^- (quip pend-tx ^state:naive) :: the canonical state, discarding invalid txs in the process.
:: load current, canonical state
::
=+ .^ nas=^state:naive
%gx
(scot %p our.bowl)
%azimuth
(scot %da now.bowl)
/nas/nas
==
:: apply our pending transactions
::TODO should also apply txs from sending map!
::
=| valid=_pending
|- ^+ [valid nas]
?~ pending [(flop valid) nas]
::
=^ gud=? nas (try-apply nas i.pending)
=? valid gud [i.pending valid]
$(pending t.pending)
:: +try-apply:
:: ::
++ try-apply ++ predicted-state
|= [nas=^state:naive force=? =raw-tx:naive] |= nas=^state:naive
^- [success=? _nas] ^+ state
?. (verify-sig-and-nonce:naive verifier:ttttt chain-id nas raw-tx) =. pre.state nas
[force nas] |^
=^ nes state apply-sending
=^ nep state apply-pending
state(sending nes, pending nep)
:: ::
=^ out points.nas (increment-nonce:naive nas from.tx.raw-tx) ++ apply-pending
(apply-txs pending %pending)
:: ::
?~ nex=(receive-tx:naive nas tx.raw-tx) ++ apply-sending
[force nas] =| valid=_sending
[& +.u.nex] =+ sending=~(tap by sending)
|- ^+ [valid state]
?~ sending [valid state]
::
=* key p.i.sending
=* val q.i.sending
=^ new-valid state
%+ apply-txs
(turn txs.val |=(=raw-tx:naive [| 0x0 raw-tx]))
%sending
=. valid
%+ ~(put by valid) key
val(txs (turn new-valid (cork tail tail)))
$(sending t.sending)
::
++ apply-txs
|= [txs=(list pend-tx) type=?(%pending %sending)]
=/ valid=_txs ~
:: =| local=(set keccak)
|- ^+ [valid state]
?~ txs [valid state]
::
=* tx i.txs
=* raw-tx raw-tx.i.txs
=* ship ship.from.tx.raw-tx.i.txs
=/ hash=@ux (hash-raw-tx:lib raw-tx)
:: TODO: add tests to validate if this is necessary
::
:: ?: (~(has in local) hash)
:: :: if tx was already seen here, skip
:: ::
:: $(txs t.txs)
=/ sign-address=(unit @ux)
(extract-address:lib raw-tx pre.state chain-id)
=^ gud=? state
(try-apply pre.state force.tx raw-tx)
:: TODO: only replace address if !=(address.tx sign-address)?
::
=? tx &(gud ?=(^ sign-address))
tx(address u.sign-address)
=? valid gud (snoc valid tx)
=? finding.state !gud
(~(put by finding.state) [hash %failed])
=? history.state !gud
=/ =roller-tx
[ship type hash (l2-tx +<.tx.raw-tx)]
%. [address.tx roller-tx(status %failed)]
~(put ju (~(del ju history.state) address.tx roller-tx))
:: $(txs t.txs, local (~(put in local) hash))
$(txs t.txs)
::
++ try-apply
|= [nas=^state:naive force=? =raw-tx:naive]
^- [? _state]
=/ [success=? predicted=_nas owners=_own]
(apply-raw-tx:dice force raw-tx nas own chain-id)
:- success
state(pre predicted, own owners)
--
::
++ get-l1-address
|= [=tx:naive nas=^state:naive]
^- (unit address:ethereum)
?~ point=(get:orm:naive points.nas ship.from.tx) ~
=< `address
(proxy-from-point:naive proxy.from.tx u.point)
:: ::
++ on-action ++ on-action
|= =action |= =action
^- (quip card _state) ^- (quip card _state)
?- -.action ?- -.action
%commit !! :: TODO send-roll %commit on-timer
%config [~ state(frequency frequency.action)] %config (on-config +.action)
%setkey [~ state(pk pk.action)] ::TODO what about existing sending entries? %cancel (cancel-tx +.action)
:: ::
%submit %submit
=^ success state %- take-tx
^- [? _state] :^ force.action
%^ take-tx address.action
force.action sig.action
sig.action (part-tx-to-full tx.action)
(part-tx-to-full tx.action)
:: TODO: consider failure case
?> success
[~ state]
::
%cancel
!! ::TODO
== ==
::
++ on-config
|= =config
^- (quip card _state)
?- -.config
%frequency [~ state(frequency frequency.config)]
%endpoint [~ state(endpoint `endpoint.config)]
::
%network
:- ~
=/ [contract=@ux chain-id=@]
=< [naive chain-id]
=, azimuth
?- net.config
%mainnet mainnet-contracts
%ropsten ropsten-contracts
%local local-contracts
==
state(contract contract, chain-id chain-id)
::
%setkey
?~ pk=(de:base16:mimes:html pk.config)
`state
[(get-nonce q.u.pk) state(pk q.u.pk)]
==
:: TODO: move address to state?
::
++ get-address
^- address:ethereum
(address-from-prv:key:ethereum pk)
:: +cancel-tx: cancel a pending transaction
::
++ cancel-tx
|= [sig=@ =keccak =l2-tx =ship]
^- (quip card _state)
?^ status=(~(get by finding) keccak)
~? lverb [dap.bowl %tx-not-pending status+u.status]
[~ state]
:: "cancel: 0x1234abcd"
::
=/ message=octs
%: cad:naive 3
8^'cancel: '
::
=; hash=@t
(met 3 hash)^hash
(crip "0x{((x-co:co 20) keccak)}")
::
~
==
?~ addr=(verify-sig:lib sig message)
~? lverb [dap.bowl %cancel-sig-fail]
[~ state]
:: TODO: mark as failed instead? add a %cancelled to tx-status?
::
=. history
%+ ~(del ju history) u.addr
[ship %pending keccak l2-tx]
=. pending
%+ skip pending
|= pend-tx
=(keccak (hash-raw-tx:lib raw-tx))
[~ state]
:: +take-tx: accept submitted l2 tx into the :pending list :: +take-tx: accept submitted l2 tx into the :pending list
::TODO rewrite
:: ::
++ take-tx ++ take-tx
|= [force=? =raw-tx:naive] |= pend-tx
^- [success=? _state] ^- (quip card _state)
=/ [nep=_pending nas=^state:naive] pending-state =/ hash=@ux (hash-raw-tx:lib raw-tx)
=| success=? :: TODO: what if this hash/tx is already in the history?
:: TODO: actually use try-apply when proper Tx signing in place :: e.g. if previously failed, but now it will go through
:: a) check in :finding that hash doesn't exist and if so, skip ?
:: b) extract the status from :finding, use it to delete
:: the entry in :history, and then insert it as %pending ?
:: ::
:: =^ success nas :: =/ not-sent=? !(~(has by finding) hash)
:: (try-apply nas force raw-tx) :: =? pending not-sent
::TODO want to notify about dropped pendings, or no? client prolly polls... =. pending (snoc pending [force address raw-tx])
=? pending success (snoc nep [force raw-tx]) :: =? history not-sent
::TODO cache nas? =. history
[success state] %+ ~(put ju history) address
[ship.from.tx.raw-tx %pending hash (l2-tx +<.tx.raw-tx)]
=? transfers =(%transfer-point (l2-tx +<.tx.raw-tx))
(~(put by transfers) ship.from.tx.raw-tx address)
:: ?. not-sent ~& "skip" [~ state]
:: toggle flush flag
::
:_ state(derive-p ?:(derive-p | derive-p))
?. derive-p ~
:: derive predicted state in 5m.
::
[(wait:b:sys /predict (add ~m5 now.bowl))]~
:: +set-timer: %wait until next whole :frequency :: +set-timer: %wait until next whole :frequency
:: ::
++ set-timer ++ set-timer
^- card ^- [=card =time]
%+ wait:b:sys /timer =+ time=(mul +((div now.bowl frequency)) frequency)
(mul +((div now.bowl frequency)) frequency) [(wait:b:sys /timer time) time]
:: +on-timer: every :frequency, freeze :pending txs roll and start sending it :: +on-timer: every :frequency, freeze :pending txs roll and start sending it
:: ::
++ on-timer ++ on-timer
^- (quip card _state) ^- (quip card _state)
=. state (predicted-state canonical-state)
=^ cards state =^ cards state
?~ pending [~ state] ?: =(~ pending) [~ state]
=/ nonce=@ud next-nonce ?~ next-nonce
=: :: FIXME: what's up with this? `pending ~` also fails ~&([dap.bowl %no-nonce] [~ state])
:: pending *(list pend-tx) =/ nonce=@ud u.next-nonce
next-nonce +(next-nonce) =: pending ~
derive-p &
next-nonce `+(u.next-nonce)
:: ::
sending sending
%+ ~(put by sending) nonce %+ ~(put by sending)
[0 (turn pending tail)] [get-address nonce]
[0 (turn pending (cork tail tail))]
::
finding
%- ~(gas by finding)
%+ turn pending
|= pend-tx
(hash-raw-tx:lib raw-tx)^[address nonce]
::
history
%+ roll pending
|= [pend-tx hist=_history]
=/ tx=roller-tx
:^ ship.from.tx.raw-tx
%pending
(hash-raw-tx:lib raw-tx)
(l2-tx +<.tx.raw-tx)
%+ ~(put ju (~(del ju hist) address tx))
address
tx(status %sending)
== ==
[(send-roll nonce) state] [(send-roll get-address nonce) state]
[[set-timer cards] state] =^ card next-batch set-timer
[[card cards] state]
:: +get-nonce: retrieves the latest nonce
::
++ get-nonce
|= pk=@
^- (list card)
?~ endpoint ~&([dap.bowl %no-endpoint] ~)
(start-thread:spider /nonce [%aggregator-nonce !>([u.endpoint pk])])
::
:: +send-roll: start thread to submit roll from :sending to l1 :: +send-roll: start thread to submit roll from :sending to l1
:: ::
++ send-roll ++ send-roll
|= nonce=@ud |= [=address:ethereum nonce=@ud]
^- (list card) ^- (list card)
:: if this nonce isn't in the sending queue anymore, it's done :: if this nonce isn't in the sending queue anymore, it's done
:: ::
?. (~(has by sending) nonce) ?. (~(has by sending) [address nonce])
~? lverb [dap.bowl %done-sending nonce] ~? lverb [dap.bowl %done-sending [address nonce]]
~ ~
:: start the thread, passing in the l2 txs to use :: start the thread, passing in the l2 txs to use
:: ::
?~ endpoint ~&([dap.bowl %no-endpoint] ~)
::TODO should go ahead and set resend timer in case thread hangs, or nah? ::TODO should go ahead and set resend timer in case thread hangs, or nah?
%+ start-thread:spider %+ start-thread:spider
/send/(scot %ud nonce) /send/(scot %ux address)/(scot %ud nonce)
:- %aggregator-send :- %aggregator-send
!> !> ^- rpc-send-roll
:* endpoint :* u.endpoint
contract contract
chain-id chain-id
0x1234.5678 pk
nonce nonce
(~(got by sending) nonce) (~(got by sending) [address nonce])
== ==
:: +on-thread-result: await resend after thread success or failure :: +on-batch-result: await resend after thread success or failure
:: ::
++ on-thread-result ++ on-batch-result
|= [nonce=@ud result=(each @ud term)] |= [=address:ethereum nonce=@ud result=(each @ud @t)]
^- (quip card _state) ^- (quip card _state)
:: update gas price for this tx in state :: update gas price for this tx in state
:: ::
=? sending ?=(%& -.result) =? sending ?=(%& -.result)
%+ ~(jab by sending) nonce %+ ~(jab by sending) [address nonce]
(cork tail (lead p.result)) (cork tail (lead p.result))
:: print error if there was one :: print error if there was one
:: ::
@ -408,15 +792,24 @@
:: resend the l1 tx in five minutes :: resend the l1 tx in five minutes
:: ::
:_ state :_ state
[(wait:b:sys /resend/(scot %ud nonce) (add resend-time now.bowl))]~ :_ ~
%+ wait:b:sys
/resend/(scot %ux address)/(scot %ud nonce)
(add resend-time now.bowl)
:: +on-naive-diff: process l2 tx confirmations :: +on-naive-diff: process l2 tx confirmations
:: ::
++ on-naive-diff ++ on-naive-diff
|= =diff:naive |= =diff:naive
^- (quip card _state) ^- (quip card _state)
?: ?=(%point -.diff)
:_ state(derive-o ?:(derive-o | derive-o))
?. derive-o ~
:: calculate ownership in 5m.
::
[(wait:b:sys /owners (add ~m5 now.bowl))]~
?. ?=(%tx -.diff) ?. ?=(%tx -.diff)
[~ state] [~ state]
=/ =keccak (hash-raw-tx raw-tx.diff) =/ =keccak (hash-raw-tx:lib raw-tx.diff)
?~ wer=(~(get by finding) keccak) ?~ wer=(~(get by finding) keccak)
[~ state] [~ state]
:: if we had already seen the tx, no-op :: if we had already seen the tx, no-op
@ -426,10 +819,11 @@
[dap.bowl %weird-double-confirm from.tx.raw-tx.diff] [dap.bowl %weird-double-confirm from.tx.raw-tx.diff]
[~ state] [~ state]
=* nonce nonce.u.wer =* nonce nonce.u.wer
=* ship ship.from.tx.raw-tx.diff
:: remove the tx from the sending map :: remove the tx from the sending map
:: ::
=. sending =. sending
?~ sen=(~(get by sending) nonce) ?~ sen=(~(get by sending) [get-address nonce])
~& [dap.bowl %weird-double-remove] ~& [dap.bowl %weird-double-remove]
sending sending
?~ nin=(find [raw-tx.diff]~ txs.u.sen) ?~ nin=(find [raw-tx.diff]~ txs.u.sen)
@ -437,9 +831,9 @@
sending sending
=. txs.u.sen (oust [u.nin 1] txs.u.sen) =. txs.u.sen (oust [u.nin 1] txs.u.sen)
?~ txs.u.sen ?~ txs.u.sen
~? lverb [dap.bowl %done-with-nonce nonce] ~? lverb [dap.bowl %done-with-nonce [get-address nonce]]
(~(del by sending) nonce) (~(del by sending) [get-address nonce])
(~(put by sending) nonce u.sen) (~(put by sending) [get-address nonce] u.sen)
:: update the finding map with the new status :: update the finding map with the new status
:: ::
=. finding =. finding
@ -449,6 +843,27 @@
:: unexpected tx failures here. would that be useful? probably not? :: unexpected tx failures here. would that be useful? probably not?
:: ~? !forced [dap.bowl %aggregated-tx-failed-anyway err.diff] :: ~? !forced [dap.bowl %aggregated-tx-failed-anyway err.diff]
%failed %failed
[~ state] ::
=. history
=/ l2-tx (l2-tx +<.tx.raw-tx.diff)
=/ tx=roller-tx [ship %sending keccak l2-tx]
?~ addr=(get-l1-address tx.raw-tx.diff pre)
history
=/ =address:ethereum
?. =(%transfer-point l2-tx)
u.addr
:: TODO: delete this ship from the transfer?
::
(~(got by transfers) ship)
%+ ~(put ju (~(del ju history) address tx))
address
%_ tx
status ?~(err.diff %confirmed %failed)
==
:_ state(derive-p ?:(derive-p | derive-p))
?. derive-p ~
:: derive predicted state in 5m.
::
[(wait:b:sys /predict (add ~m5 now.bowl))]~
:: ::
-- --

160
pkg/arvo/app/azimuth-rpc.hoon
View File

@ -11,14 +11,6 @@
version, version,
agentio agentio
|% |%
:: FIXME: import tx-status, pend-tx from aggregator
::
+$ tx-status
$: status=?(%unknown %pending %sent %confirmed %failed)
tx=(unit @ux)
==
::
+$ pend-tx [force=? =raw-tx:naive]
:: ::
+$ card card:agent:gall +$ card card:agent:gall
:: ::
@ -42,7 +34,7 @@
^- (quip card _this) ^- (quip card _this)
~& > 'init' ~& > 'init'
:_ this :_ this
[%pass /bind %arvo %e %connect [~ [%v1 %azimuth ~]] dap.bowl]~ [%pass /bind %arvo %e %connect [~ /v1/azimuth] dap.bowl]~
:: ::
++ on-save !>(state) ++ on-save !>(state)
++ on-load ++ on-load
@ -65,7 +57,7 @@
=+ !<([%disconnect bind=binding:eyre] vase) =+ !<([%disconnect bind=binding:eyre] vase)
~& >>> "disconnecting at {<bind>}" ~& >>> "disconnecting at {<bind>}"
:_ this :_ this
[[%pass /bind %arvo %e %disconnect bind]]~ [%pass /bind %arvo %e %disconnect bind]~
== ==
:: ::
++ handle-http-request ++ handle-http-request
@ -79,22 +71,19 @@
:: TODO: method not supported :: TODO: method not supported
:: ::
(give-simple-payload:app id not-found:gen) (give-simple-payload:app id not-found:gen)
?~ rpc-request=(validate-request:json-rpc body.req parse-method) ?~ rpc-request=(validate-request:json-rpc body.req)
:: TODO: malformed request :: TODO: malformed request
:: ::
(give-simple-payload:app id not-found:gen) (give-simple-payload:app id not-found:gen)
=/ [data=(unit cage) response=simple-payload:http] =/ [data=(list cage) response=simple-payload:http]
(process-rpc-request:do u.rpc-request) (process-rpc-request:do u.rpc-request)
%+ weld %+ weld
(give-simple-payload:app id response) (give-simple-payload:app id response)
|-
?~ data ~ ?~ data ~
:_ ~ :_ $(data t.data)
^- card ^- card
[%pass / %agent [our.bowl %aggregator] %poke u.data] [%pass / %agent [our.bowl %azimuth] %poke i.data]
:: TODO: validate that format is e.g. 'getPoint'
:: TODO: maybe use getPoint and translate to %get-point
::
++ parse-method |=(t=@t `term`t)
-- --
-- --
:: ::
@ -124,34 +113,43 @@
:: ::
|_ =bowl:gall |_ =bowl:gall
++ process-rpc-request ++ process-rpc-request
|= request:rpc |= req=batch-request:rpc
^- [(unit cage) simple-payload:http] ^- [(list cage) simple-payload:http]
=; [data=(unit cage) =response:rpc] |^
:- data ?- -.req
%o
=/ [data=(unit cage) =response:rpc]
(process p.req)
[(drop data) (render response)]
::
%a
=| data=(list cage)
=| resp=(list response:rpc)
|-
?~ p.req
[(flop data) (render %batch (flop resp))]
=/ [dat=(unit cage) res=response:rpc]
(process i.p.req)
=? data ?=(^ dat) [u.dat data]
$(p.req t.p.req, resp [res resp])
==
::
++ render
|= res=response:rpc
%- json-response:gen %- json-response:gen
(response-to-json:json-rpc response) (response-to-json:json-rpc res)
=, azimuth-rpc ::
?. ?=([%map *] params) ++ process
[~ ~(parse error id)] |= request:rpc
?+ method [~ ~(method error id)] =, azimuth-rpc
%get-point [~ (get-point id +.params point:scry)] ?. ?=([%map *] params)
%transfer-point (transfer-point id +.params) [~ ~(parse error:json-rpc id)]
%configure-keys (configure-keys id +.params) =/ method=@tas (enkebab method)
%spawn (spawn id +.params) ?+ method [~ ~(method error:json-rpc id)]
%escape (escape id +.params method) %get-point `(get-point id +.params point:scry)
%cancel-escape (cancel-escape id +.params method) %get-dns `(get-dns id +.params dns:scry)
%adopt (adopt id +.params method) ==
%detach (detach id +.params method) --
%reject (reject id +.params method)
%set-management-proxy (management-proxy id +.params method)
%set-spawn-proxy (spawn-proxy id +.params method)
%set-transfer-proxy (transfer-proxy id +.params method)
%pending [~ (all:pending id +.params all:pending:scry)]
%pending-by-ship [~ (ship:pending id +.params ship:pending:scry)]
%pending-by-address [~ (addr:pending id +.params addr:pending:scry)]
%status [~ (status id +.params tx-status:scry)]
:: %history [~ (history id +.params all:history:scry)]
==
:: ::
++ scry ++ scry
|% |%
@ -159,77 +157,15 @@
|= =ship |= =ship
.^ (unit point:naive) .^ (unit point:naive)
%gx %gx
(~(scry agentio bowl) %azimuth /nas/[(scot %p ship)]/noun) (~(scry agentio bowl) %azimuth /point/(scot %p ship)/noun)
== ==
:: ::
++ pending ++ dns
|% .^ (list @t)
++ all
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %aggregator /pending/noun)
==
::
++ ship
|= =^ship
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %aggregator /pending/[(scot %p ship)]/noun)
==
::
++ addr
|= =address:naive
.^ (list pend-tx)
%gx
%+ ~(scry agentio bowl) %aggregator
/pending/[(scot %ux address)]/noun
==
--
::
++ history
|%
++ all
:: FIXME: use proper type from aggregator/index
::
.^ (list tx:naive)
%gx
(~(scry agentio bowl) %aggregator /history/noun)
==
::
++ ship
|= =^ship
:: FIXME: use proper type from aggregator/index
::
.^ (list tx:naive)
%gx
(~(scry agentio bowl) %aggregator /history/[(scot %p ship)]/noun)
==
::
++ addr
|= =address:naive
:: FIXME: use proper type from aggregator/index
::
.^ (list tx:naive)
%gx
(~(scry agentio bowl) %aggregator /history/[(scot %ux address)]/noun)
==
--
::
++ tx-status
|= keccak=@ux
.^ ^tx-status
%gx
(~(scry agentio bowl) %aggregator /tx/[(scot %ux keccak)]/status/noun)
==
::
++ nonce
|= [=ship =address:naive]
:: FIXME: use proper type from aggregator/index
.^ @
%gx %gx
%+ ~(scry agentio bowl) %+ ~(scry agentio bowl)
%aggregator %azimuth
/nonce/[(scot %p ship)]/[(scot %ux address)]/atom /dns/noun
== ==
-- --
-- --

145
pkg/arvo/app/azimuth.hoon
View File

@ -1,5 +1,11 @@
/- eth-watcher /- eth-watcher, *dice
/+ ethereum, azimuth, naive, default-agent, verb, dbug /+ ethereum,
azimuth,
naive,
dice,
default-agent,
verb,
dbug
/* snap %eth-logs /app/azimuth/logs/eth-logs /* snap %eth-logs /app/azimuth/logs/eth-logs
:: ::
=/ last-snap :: maybe just use the last one? =/ last-snap :: maybe just use the last one?
@ -12,10 +18,11 @@
=, jael =, jael
|% |%
++ app-state ++ app-state
$: %2 $: %3
url=@ta url=@ta
whos=(set ship) whos=(set ship)
nas=^state:naive nas=^state:naive
own=owners
logs=(list =event-log:rpc:ethereum) logs=(list =event-log:rpc:ethereum)
== ==
+$ poke-data +$ poke-data
@ -27,9 +34,17 @@
[%watch url=@ta] [%watch url=@ta]
== ==
+$ tagged-diff [=id:block diff:naive] +$ tagged-diff [=id:block diff:naive]
::
+$ network ?(%mainnet %ropsten %local)
-- --
:: ::
|% |%
++ net
^- network
:: TODO: add poke action to allow switching?
:: eth snapshot could also be considered
::
%local
:: TODO: maybe flop the endianness here so metamask signs it in normal :: TODO: maybe flop the endianness here so metamask signs it in normal
:: order? :: order?
:: ::
@ -61,39 +76,42 @@
(hex-to-num:ethereum data) (hex-to-num:ethereum data)
:: ::
++ run-logs ++ run-logs
|= [nas=^state:naive logs=(list event-log:rpc:ethereum)] |= [state=app-state logs=(list event-log:rpc:ethereum)]
^- [(list tagged-diff) ^state:naive] ^- (quip tagged-diff _state)
=/ [contract=@ux * chain-id=@ *] (get-network net)
?~ logs ?~ logs
`nas `state
?~ mined.i.logs ?~ mined.i.logs
$(logs t.logs) $(logs t.logs)
=^ raw-effects nas =/ [raw-effects=effects:naive new-nas=_nas.state]
=/ =^input:naive =/ =^input:naive
?: =(azimuth:contracts:azimuth address.i.logs) ?: =(contract address.i.logs)
=/ data (data-to-hex data.i.logs) =/ data (data-to-hex data.i.logs)
=/ =event-log:naive =/ =event-log:naive
[address.i.logs data topics.i.logs] [address.i.logs data topics.i.logs]
[%log event-log] [%log event-log]
?~ input.u.mined.i.logs ?~ input.u.mined.i.logs
[%bat *@] [%bat *@]
=/ len (met 3 u.input.u.mined.i.logs) [%bat u.input.u.mined.i.logs]
=/ fun
(rsh [3 (sub len 4)] u.input.u.mined.i.logs)
?. =(0x2688.7f26 fun)
[%bat *@]
[%bat (end [3 (sub len 4)] u.input.u.mined.i.logs)]
=/ res =/ res
%- mule %- mule
|.((%*(. naive lac |) verifier chain-id:contracts:azimuth nas input)) |.((%*(. naive lac |) verifier chain-id nas.state input))
?- -.res ?- -.res
%& p.res %& p.res
%| ((slog 'naive-fail' p.res) `nas) %| ((slog 'naive-fail' p.res) `nas.state)
== ==
=. own.state
=, dice
?. =(contract address.i.logs)
=< own
(apply-effects raw-effects nas.state own.state chain-id)
(update-ownership raw-effects nas.state new-nas own.state)
=. nas.state new-nas
=/ effects-1 =/ effects-1
=/ =id:block [block-hash block-number]:u.mined.i.logs =/ =id:block [block-hash block-number]:u.mined.i.logs
(turn raw-effects |=(=diff:naive [id diff])) (turn raw-effects |=(=diff:naive [id diff]))
=^ effects-2 nas $(logs t.logs) =^ effects-2 state $(logs t.logs)
[(welp effects-1 effects-2) nas] [(welp effects-1 effects-2) state]
:: ::
++ to-udiffs ++ to-udiffs
|= effects=(list tagged-diff) |= effects=(list tagged-diff)
@ -125,16 +143,39 @@
:- [%give %fact ~[path] %azimuth-udiffs !>(~[i.udiffs])] :- [%give %fact ~[path] %azimuth-udiffs !>(~[i.udiffs])]
$(udiffs t.udiffs) $(udiffs t.udiffs)
:: ::
++ start ++ event-update
|= [state=app-state our=ship dap=term] |= effects=(list tagged-diff)
^- (list card:agent:gall)
%+ murn effects
|= tag=tagged-diff
^- (unit card:agent:gall)
?. |(?=(%tx +<.tag) ?=(%point +<.tag)) ~
%- some
^- card:agent:gall ^- card:agent:gall
[%give %fact ~[/event] %naive-diffs !>(+.tag)]
::
++ get-network
|= =network
^- [@ux @ux @ @]
=< [azimuth naive chain-id launch]
=, azimuth
?- network
%mainnet mainnet-contracts
%ropsten ropsten-contracts
%local local-contracts
==
::
++ start
|= [state=app-state =network our=ship dap=term]
^- card:agent:gall
=/ [azimuth=@ux naive=@ux * launch=@ud] (get-network network)
=/ args=vase !> =/ args=vase !>
:+ %watch /[dap] :+ %watch /[dap]
^- config:eth-watcher ^- config:eth-watcher
:* url.state =(%czar (clan:title our)) ~m5 ~h30 :* url.state =(%czar (clan:title our)) ~m5 ~h30
(max launch:contracts:azimuth last-snap) (max launch last-snap)
~[azimuth:contracts:azimuth] ~[azimuth]
~[naive:contracts:azimuth] ~[naive]
(topics whos.state) (topics whos.state)
== ==
[%pass /wa %agent [our %eth-watcher] %poke %eth-watcher-poke args] [%pass /wa %agent [our %eth-watcher] %poke %eth-watcher-poke args]
@ -172,14 +213,28 @@
- %2 - %2
nas *^state:naive nas *^state:naive
== ==
`this(state ?>(?=(%2 -.old-state) old-state)) =? old-state ?=(%2 -.old-state)
%= old-state
- %3
own *owners
==
`this(state ?>(?=(%3 -.old-state) old-state))
:: ::
++ app-states $%(app-state-0 app-state-1 app-state) ++ app-states $%(app-state-0 app-state-1 app-state-2 app-state)
++ app-state-2
$: %2
url=@ta
whos=(set ship)
nas=^state:naive
own=*
logs=(list =event-log:rpc:ethereum)
==
++ app-state-1 ++ app-state-1
$: %1 $: %1
url=@ta url=@ta
whos=(set ship) whos=(set ship)
nas=* nas=*
own=*
logs=(list =event-log:rpc:ethereum) logs=(list =event-log:rpc:ethereum)
== ==
++ app-state-0 ++ app-state-0
@ -187,6 +242,7 @@
url=@ta url=@ta
whos=(set ship) whos=(set ship)
nas=* nas=*
own=*
logs=(list =event-log-0) logs=(list =event-log-0)
== ==
:: ::
@ -212,7 +268,7 @@
?+ q.vase !! ?+ q.vase !!
%rerun %rerun
~& [%rerunning (lent logs.state)] ~& [%rerunning (lent logs.state)]
=^ effects nas.state (run-logs *^state:naive logs.state) =^ effects state (run-logs state logs.state)
`this `this
:: ::
%resub %resub
@ -235,39 +291,36 @@
%listen [[%pass /lo %arvo %j %listen (silt whos.poke) source.poke]~ this] %listen [[%pass /lo %arvo %j %listen (silt whos.poke) source.poke]~ this]
%watch %watch
=. url.state url.poke =. url.state url.poke
[[(start state [our dap]:bowl) ~] this] [[(start state net [our dap]:bowl) ~] this]
== ==
:: ::
++ on-watch ++ on-watch
|= =path |= =path
^- (quip card:agent:gall _this) ^- (quip card:agent:gall _this)
?< =(/sole/drum path) ?< =(/sole/drum path)
?> ?=(?(~ [@ ~]) path) ?: =(/event path)
:_ this
[%give %fact ~ %naive-state !>([nas.state own.state])]~
=/ who=(unit ship) =/ who=(unit ship)
?~ path ~ ?~ path ~
?: ?=([@ ~] path) ~
`(slav %p i.path) `(slav %p i.path)
=. whos.state =. whos.state
?~ who ?~ who
~ ~
(~(put in whos.state) u.who) (~(put in whos.state) u.who)
:_ this :_ ~ :_ this :_ ~
(start state [our dap]:bowl) (start state net [our dap]:bowl)
:: ::
++ on-leave on-leave:def ++ on-leave on-leave:def
++ on-peek ++ on-peek
|= =path |= =path
^- (unit (unit cage)) ^- (unit (unit cage))
?+ path (on-peek:def path) ?+ path (on-peek:def path)
[%x %logs ~] [%x %logs ~] ``noun+!>(logs.state)
``logs+!>(logs.state) [%x %nas ~] ``noun+!>(nas.state)
:: [%x %dns ~] ``noun+!>(dns.nas.state)
[%x %nas ~] [%x %own ~] ``noun+!>(own.state)
``nas+!>(nas.state)
::
[%x %nas @t ~]
?~ ship=(rush i.t.t.path ;~(pfix sig fed:ag))
``noun+!>(*(unit point:naive))
``noun+!>((~(get by points.nas.state) u.ship))
== ==
:: ::
++ on-agent ++ on-agent
@ -289,16 +342,12 @@
%logs (welp logs.state loglist.diff) %logs (welp logs.state loglist.diff)
== ==
=? nas.state ?=(%history -.diff) *^state:naive =? nas.state ?=(%history -.diff) *^state:naive
=^ effects nas.state =^ effects state (run-logs state loglist.diff)
%+ run-logs
?- -.diff
:: %history *^state:naive
%history nas.state
%logs nas.state
==
loglist.diff
:: ::
[(jael-update (to-udiffs effects)) this] :_ this
%+ weld
(event-update effects)
(jael-update (to-udiffs effects))
:: ::
++ on-arvo on-arvo:def ++ on-arvo on-arvo:def
++ on-fail on-fail:def ++ on-fail on-fail:def

355
pkg/arvo/app/btc-provider.hoon Normal file
View File

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

1161
pkg/arvo/app/btc-wallet.hoon Normal file
View File

File diff suppressed because it is too large Load Diff

4
pkg/arvo/app/btc-wallet/img/tile.svg Normal file
View File

@ -0,0 +1,4 @@
<svg width="128" height="128" viewBox="0 0 128 128" preserveAspectRatio="none" fill="none" xmlns="http://www.w3.org/2000/svg">
<rect width="128" height="128" rx="4" fill="#F98E40"/>
<path d="M75.9373 60.7714C76.4367 57.4333 73.8951 55.6389 70.4198 54.4418L71.5471 49.9199L68.7947 49.2339L67.6971 53.6366C66.9735 53.4563 66.2303 53.2862 65.4919 53.1177L66.5972 48.686L63.8463 48L62.7182 52.5203C62.1193 52.3839 61.5313 52.249 60.9606 52.1071L60.9637 52.093L57.1678 51.1452L56.4356 54.0851C56.4356 54.0851 58.4778 54.5531 58.4347 54.5821C59.5495 54.8604 59.751 55.5981 59.7172 56.1829L58.4331 61.3343C58.51 61.3539 58.6095 61.3821 58.7193 61.426C58.6276 61.4033 58.5296 61.3782 58.4284 61.3539L56.6285 68.5702C56.4921 68.9089 56.1463 69.4169 55.3671 69.224C55.3945 69.264 53.3664 68.7246 53.3664 68.7246L52 71.8754L55.5819 72.7683C56.2483 72.9352 56.9013 73.1101 57.5441 73.2747L56.4051 77.8483L59.1544 78.5343L60.2825 74.0093C61.0335 74.2131 61.7626 74.4013 62.476 74.5784L61.3518 79.0822L64.1043 79.7682L65.2434 75.2032C69.9369 76.0915 73.4663 75.7332 74.9519 71.4881C76.149 68.07 74.8923 66.0984 72.4228 64.8127C74.2212 64.398 75.5759 63.215 75.9373 60.7714V60.7714ZM69.6484 69.5901C68.7978 73.0082 63.0428 71.1604 61.177 70.6971L62.6884 64.6379C64.5543 65.1035 70.5374 66.0255 69.6484 69.5901ZM70.4998 60.722C69.7236 63.8312 64.9337 62.2515 63.3799 61.8642L64.7502 56.3687C66.304 56.756 71.308 57.4788 70.4998 60.722Z" fill="white" fill-opacity="0.7"/>
</svg>
Side by Side

After

Width:  |  Height:  |  Size: 1.4 KiB

31
pkg/arvo/app/btc-wallet/index.html Normal file
View File

@ -0,0 +1,31 @@
<!doctype html>
<html>
<head>
<title>Wallet</title>
<meta charset="utf-8" />
<meta name="viewport"
content="width=device-width, initial-scale=1, shrink-to-fit=no,maximum-scale=1"/>
<meta name="apple-mobile-web-app-capable" content="yes" />
<meta name="apple-touch-fullscreen" content="yes" />
<meta name="apple-mobile-web-app-status-bar-style" content="default" />
<!--
<link rel="apple-touch-icon" href="/~btc/img/touch_icon.png">
<link rel="icon" type="image/png" href="/~btc/img/Favicon.png">
-->
<link rel="manifest"
href='data:application/manifest+json,{
"name": "Wallet",
"short_name": "Wallet",
"description": "A%20bitcoin%20wallet%20for%20urbit",
"display": "standalone",
"background_color": "%23FFFFFF",
"theme_color": "%23000000"}' />
</head>
<body>
<div id="root"></div>
<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>
</body>
</html>

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

@ -169,7 +169,7 @@
:: ::
%fact %fact
?+ p.cage.sign ~|([dap.bowl %bad-sub-mark wire p.cage.sign] !!) ?+ p.cage.sign ~|([dap.bowl %bad-sub-mark wire p.cage.sign] !!)
%graph-update-1 %graph-update-2
%- on-graph-update:tc %- on-graph-update:tc
!<(update:graph q.cage.sign) !<(update:graph q.cage.sign)
== ==
@ -401,12 +401,16 @@
:: +read-post: add envelope to state and show it to user :: +read-post: add envelope to state and show it to user
:: ::
++ read-post ++ read-post
|= [=target =index:post =post:post] |= [=target =index:post =maybe-post:graph]
^- (quip card _session) ^- (quip card _session)
:- (show-post:sh-out target post) ?- -.maybe-post
%_ session %| [~ session]
history [[target index] history.session] %&
count +(count.session) :- (show-post:sh-out target p.maybe-post)
%_ session
history [[target index] history.session]
count +(count.session)
==
== ==
:: ::
++ notice-remove ++ notice-remove
@ -734,7 +738,8 @@
:: ::
?. (is-chat-graph target) ?. (is-chat-graph target)
[[(note:sh-out "no such chat")]~ put-ses] [[(note:sh-out "no such chat")]~ put-ses]
=. viewing (~(put in viewing) target) =. audience target
=. viewing (~(put in viewing) target)
=^ cards state =^ cards state
?: (~(has by bound) target) ?: (~(has by bound) target)
[~ state] [~ state]
@ -758,15 +763,15 @@
::TODO move creation into lib? ::TODO move creation into lib?
%^ act %out-message %^ act %out-message
%graph-push-hook %graph-push-hook
:- %graph-update-1 :- %graph-update-2
!> ^- update:graph !> ^- update:graph
:- now.bowl :- now.bowl
:+ %add-nodes audience :+ %add-nodes audience
%- ~(put by *(map index:post node:graph)) %- ~(put by *(map index:post node:graph))
:- ~[now.bowl] :- ~[now.bowl]
:_ *internal-graph:graph :_ *internal-graph:graph
^- post:post ^- maybe-post:graph
[our-self ~[now.bowl] now.bowl [msg]~ ~ ~] [%& `post:post`[our-self ~[now.bowl] now.bowl [msg]~ ~ ~]]
:: +eval: run hoon, send code and result as message :: +eval: run hoon, send code and result as message
:: ::
:: this double-virtualizes and clams to disable .^ for security reasons :: this double-virtualizes and clams to disable .^ for security reasons
@ -890,10 +895,12 @@
=/ =uid:post (snag index history) =/ =uid:post (snag index history)
=/ =node:graph (got-node:libgraph uid) =/ =node:graph (got-node:libgraph uid)
=. audience resource.uid =. audience resource.uid
?: ?=(%| -.post.node)
[~ state]
:_ put-ses :_ put-ses
^- (list card) ^- (list card)
:~ (print:sh-out ['?' ' ' number]) :~ (print:sh-out ['?' ' ' number])
(effect:sh-out ~(render-activate mr resource.uid post.node)) (effect:sh-out ~(render-activate mr resource.uid p.post.node))
prompt:sh-out prompt:sh-out
== ==
-- --

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

@ -154,7 +154,7 @@
++ poke-graph-store ++ poke-graph-store
|= =update:graph-store |= =update:graph-store
^- card ^- card
(poke-our %graph-store %graph-update-1 !>(update)) (poke-our %graph-store %graph-update-2 !>(update))
:: ::
++ nobody ++ nobody
^- @p ^- @p

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

@ -1,334 +1,28 @@
:: chat-store [landscape]: :: chat-store [landscape]: deprecated
:: ::
:: data store that holds linear sequences of chat messages /- store=chat-store
:: /+ default-agent
/- *group, store=chat-store
/+ default-agent, verb, dbug, group-store,
graph-store, resource, *migrate, grpl=group, mdl=metadata
~% %chat-store-top ..part ~
|% |%
+$ card card:agent:gall +$ card card:agent:gall
+$ versioned-state
$% state-0
state-1
state-2
state-3
state-4
==
::
+$ state-0 [%0 =inbox:store]
+$ state-1 [%1 =inbox:store]
+$ state-2 [%2 =inbox:store]
+$ state-3 [%3 =inbox:store]
+$ state-4 [%4 =inbox:store]
+$ admin-action
$% [%trim ~]
[%migrate-graph ~]
==
-- --
:: ::
=| state-4
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall ^- agent:gall
=< |_ =bowl:gall
~% %chat-store-agent-core ..peek-x-envelopes ~ +* this .
|_ =bowl:gall def ~(. (default-agent this %|) bowl)
+* this .
chat-core +>
cc ~(. chat-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old-vase=vase
^- (quip card _this)
|^
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|-
^- (quip card _this)
?- -.old
%4 [cards this(state old)]
::
%3
=. cards :_(cards (poke-admin %migrate-graph ~))
$(old [%4 inbox.old])
::
%2
=/ =inbox:store
(migrate-path-map:group-store inbox.old)
=/ kick-paths
%~ tap in
%+ roll
~(val by sup.bowl)
|= [[=ship sub=path] subs=(set path)]
^- (set path)
?. ?=([@ @ *] sub)
subs
?. &(=(%mailbox i.sub) =('~' i.t.sub))
subs
(~(put in subs) sub)
=? cards ?=(^ kick-paths)
:_ cards
[%give %kick kick-paths ~]
$(old [%3 inbox])
::
?(%0 %1) $(old (old-to-2 inbox.old))
::
==
++ poke-admin
|= =admin-action
^- card
[%pass / %agent [our dap]:bowl %poke noun+!>(admin-action)]
::
++ old-to-2
|= =inbox:store
^- state-2
:- %2
%- ~(run by inbox)
|= =mailbox:store
^- mailbox:store
[config.mailbox (flop envelopes.mailbox)]
--
::
++ on-poke
~/ %chat-store-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%noun (poke-noun:cc !<(admin-action vase))
%import (poke-import:cc q.vase)
==
[cards this]
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek
~/ %chat-store-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(inbox)
[%x %keys ~] ``noun+!>(~(key by inbox))
[%x %envelopes *] (peek-x-envelopes:cc t.t.path)
[%x %mailbox *]
?~ t.t.path
~
``noun+!>((~(get by inbox) t.t.path))
::
[%x %config *]
?~ t.t.path
~
=/ mailbox (~(get by inbox) t.t.path)
?~ mailbox
~
``noun+!>(config.u.mailbox)
::
[%x %export ~]
``noun+!>(state)
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
:: ::
~% %chat-store-library ..card ~ ++ on-init on-init:def
|_ bol=bowl:gall ++ on-save !>(~)
++ met ~(. mdl bol) ++ on-load
++ grp ~(. grpl bol) |= old-vase=vase
^- (quip card _this)
[~ this]
:: ::
++ peek-x-envelopes ++ on-poke on-poke:def
|= pax=path ++ on-watch on-watch:def
^- (unit (unit [%noun vase])) ++ on-leave on-leave:def
?+ pax ~ ++ on-peek on-peek:def
[@ @ *] ++ on-agent on-agent:def
=/ mail-path t.t.pax ++ on-arvo on-arvo:def
=/ mailbox (~(get by inbox) mail-path) ++ on-fail on-fail:def
?~ mailbox
[~ ~ %noun !>(~)]
=* envelopes envelopes.u.mailbox
=/ sign-test=[?(%neg %pos) @]
%- need
%+ rush i.pax
;~ pose
%+ cook
|= n=@
[%neg n]
;~(pfix hep dem:ag)
::
%+ cook
|= n=@
[%pos n]
dem:ag
==
=* length length.config.u.mailbox
=* start +.sign-test
?: =(-.sign-test %neg)
?: (gth start length)
[~ ~ %noun !>(envelopes)]
[~ ~ %noun !>((swag [(sub length start) start] envelopes))]
::
=/ end (slav %ud i.t.pax)
?. (lte start end)
~
=. end ?:((lth end length) end length)
[~ ~ %noun !>((swag [start (sub end start)] envelopes))]
==
::
++ poke-noun
|= nou=admin-action
^- (quip card _state)
?: ?=([%migrate-graph ~] nou)
:_ state
(migrate-inbox inbox)
~& %trimming-chat-store
:- ~
%_ state
inbox
%- ~(urn by inbox)
|= [=path mailbox:store]
^- mailbox:store
=/ [a=* out=(list envelope:store)]
%+ roll envelopes
|= $: =envelope:store
o=[[hav=(set serial:store) curr=@] out=(list envelope:store)]
==
?: (~(has in hav.o) uid.envelope)
[[hav.o curr.o] out.o]
:-
^- [(set serial:store) @]
[(~(put in hav.o) uid.envelope) +(curr.o)]
^- (list envelope:store)
[envelope(number curr.o) out.o]
=/ len (lent out)
~? !=(len (lent envelopes)) [path [%old (lent envelopes)] [%new len]]
[[len len] (flop out)]
==
::
++ poke-import
|= arc=*
^- (quip card _state)
=/ sty=state-4 [%4 (remake-map ;;((tree [path mailbox:store]) +.arc))]
:_ sty
(migrate-inbox inbox.sty)
::
++ update-subscribers
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %chat-update !>(update)]~
::
++ send-diff
|= [pax=path upd=update:store]
^- (list card)
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%mailbox pax] upd)
?. |(|(=(%read -.upd) =(%message -.upd)) =(%messages -.upd))
~
?. |(=(%create -.upd) =(%delete -.upd))
~
(update-subscribers /keys upd)
==
::
++ migrate-inbox
|= =inbox:store
^- (list card)
%- zing
(turn ~(tap by inbox) mailbox-to-updates)
::
++ add-graph
|= [rid=resource =mailbox:store]
%- poke-graph-store
:- now.bol
:+ %add-graph rid
:- (mailbox-to-graph mailbox)
[`%graph-validator-chat %.y]
::
++ archive-graph
|= rid=resource
%- poke-graph-store
[now.bol %archive-graph rid]
::
++ nobody
^- @p
(bex 128)
::
++ path-to-resource
|= =path
^- resource
?. ?=([@ @ ~] path)
nobody^(spat path)
=/ m-ship=(unit ship)
(slaw %p i.path)
?~ m-ship
nobody^(spat path)
[u.m-ship i.t.path]
::
++ mailbox-to-updates
|= [=path =mailbox:store]
^- (list card)
=/ app-rid=resource
(path-to-resource path)
=/ group-rid=resource
(fall (peek-group:met %graph app-rid) [nobody %bad-group])
=/ group=(unit group)
(scry-group:grp group-rid)
:- (add-graph app-rid mailbox)
?~ group (archive-graph app-rid)^~
?. &(=(~ members.u.group) hidden.u.group) ~
~& >>> "archiving {<app-rid>}"
:~ (archive-graph app-rid)
(remove-group group-rid)
==
::
++ remove-group
|= group=resource
^- card
=- [%pass / %agent [our.bol %group-store] %poke -]
group-update-0+!>([%remove-group group ~])
::
++ poke-graph-store
|= =update:graph-store
^- card
[%pass / %agent [our.bol %graph-store] %poke %graph-update-1 !>(update)]
::
++ letter-to-contents
|= =letter:store
^- (list content:graph-store)
:_ ~
?. ?=(%me -.letter)
letter
[%text narrative.letter]
::
++ envelope-to-node
|= =envelope:store
^- [atom:graph-store node:graph-store]
=/ contents=(list content:graph-store)
(letter-to-contents letter.envelope)
=/ =index:graph-store
[when.envelope ~]
=, envelope
:- when.envelope
:_ [%empty ~]
^- post:graph-store
:* author
index
when
contents
~ ~
==
::
++ mailbox-to-graph
|= =mailbox:store
^- graph:graph-store
%+ gas:orm:graph-store *graph:graph-store
(turn envelopes.mailbox envelope-to-node)
-- --

3
pkg/arvo/app/contact-push-hook.hoon
View File

@ -70,10 +70,11 @@
:: ::
++ transform-proxy-update ++ transform-proxy-update
|= vas=vase |= vas=vase
^- (unit vase) ^- (quip card (unit vase))
:: TODO: should check if user is allowed to %add, %remove, %edit :: TODO: should check if user is allowed to %add, %remove, %edit
:: contact :: contact
=/ =update:store !<(update:store vas) =/ =update:store !<(update:store vas)
:- ~
?- -.update ?- -.update
%initial ~ %initial ~
%add `vas %add `vas

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

@ -43,8 +43,8 @@
:: ::
++ transform-proxy-update ++ transform-proxy-update
|= vas=vase |= vas=vase
^- (unit vase) ^- (quip card (unit vase))
`vas ``vas
:: ::
++ resource-for-update ++ resource-for-update
|= =vase |= =vase

319
pkg/arvo/app/dm-hook.hoon Normal file
View File

@ -0,0 +1,319 @@
:: dm-hook [landscape]: receive and send DMs
::
/+ default-agent, dbug, store=graph-store, graphlib=graph, agentio, resource
/+ sig=signatures, hook=dm-hook
::
|%
::
+$ base-state-0
$: screening=?
screened=(jug ship [=index:store =node:store])
pending=(jar ship atom)
==
::
+$ state-0 [%0 base-state-0]
+$ state-1 [%1 base-state-0]
+$ versioned-state
$% state-0
state-1
==
+$ card card:agent:gall
+$ nodes (map index:store node:store)
++ orm orm:store
--
::
=| state-1
=* state -
%- agent:dbug
^- agent:gall
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
gra ~(. graphlib bowl)
io ~(. agentio bowl)
pass pass:io
::
++ on-init
:_ this
:_ ~
=/ dms=(list resource)
?. .^(? %gu (scry:io %graph-store ~))
~
%+ skim ~(tap in get-keys:gra)
|=([ship name=term] ?=(^ (rush name ;~(pfix (jest 'dm--') fed:ag))))
|^
%+ poke-our:pass %graph-store
%+ update:cg:gra now.bowl
:+ %add-graph [our.bowl %dm-inbox]
[graph `%graph-validator-dm %.n]
::
++ dm-parser
;~(pfix (jest 'dm--') fed:ag)
::
++ counterparty
|= rid=resource
=/ =ship (rash name.rid dm-parser)
?. =(our.bowl ship) ship
entity.rid
::
++ update-indices
|= [pfix=index:store =graph:store]
=* loop $
^- graph:store
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
=/ =index:store (snoc pfix atom)
:- atom
=. children.node
?: ?=(%empty -.children.node) children.node
[%graph loop(pfix index, graph p.children.node)]
?: ?=(%| -.post.node) node
node(index.p.post index)
::
++ graph
%+ roll dms
|= [rid=resource =graph:store]
^- graph:store
=/ =ship (counterparty rid)
=| =post:store
=: author.post our.bowl
index.post [ship ~]
time-sent.post now.bowl
==
=/ dm=graph:store
(update-indices ~[ship] (get-graph-mop:gra rid))
(put:orm:store graph `@`ship [%& post] %graph dm)
--
::
++ on-save !>(state)
++ on-load
|= =vase
^- (quip card _this)
=+ !<(old=versioned-state vase)
?: ?=(%1 -.old) `this(state old)
:_ this(state [%1 +.old])
(poke-self:pass noun+!>(%reinit))^~
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?+ mark (on-poke:def mark vase)
%noun
?+ q.vase !!
%reinit
?: (~(has in get-keys:gra) [our.bowl %dm-inbox])
`this
on-init
==
::
%dm-hook-action
=+ !<(=action:hook vase)
=^ cards state
?+ -.action !!
%accept (accept-screen ship.action)
%decline (decline-screen ship.action)
%screen (set-screen screen.action)
==
[cards this]
::
%graph-update-2
=+ !<(=update:store vase)
?+ -.q.update !!
%add-nodes
?> ?=([@ %dm-inbox] resource.q.update)
=^ cards state
?: =(our.bowl src.bowl)
(outgoing-add (hash-and-sign nodes.q.update))
?: &(screening !(dm-exists src.bowl))
(screen-add nodes.q.update)
(incoming-add nodes.q.update)
[cards this]
==
==
::
++ hash-and-sign
|= =nodes
%- ~(gas by *^nodes)
%+ turn ~(tap by nodes)
|= [=index:store =node:store]
^- [index:store node:store]
:- index
?> ?=(%& -.post.node)
=* p post.node
=/ =hash:store
`@ux`(sham [~ author time-sent contents]:p.p)
%_ node
hash.p.post `hash
::
signatures.p.post
%- ~(gas in *signatures:store)
[(sign:sig our.bowl now.bowl hash)]~
==
::
++ give
|= =action:hook
^- card
(fact:io dm-hook-action+!>(action) ~[/updates])
::
++ accept-screen
|= =ship
^- (quip card _state)
=/ unscreened=nodes
%- ~(gas by *nodes)
~(tap in (~(get ju screened) ship))
:_ state(screened (~(del by screened) ship))
%+ welp (add-missing-root ship)
:~ %+ poke-our:pass %graph-store
(update:cg:gra now.bowl %add-nodes [our.bowl %dm-inbox] unscreened)
::
(give %accept ship)
==
::
++ set-screen
|= screen=?
:_ state(screening screen)
(give %screen screen)^~
::
++ decline-screen
|= =ship
^- (quip card _state)
:_ state(screened (~(del by screened) ship))
(give %decline ship)^~
::
++ screen-add
|= =nodes
?> =(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))
::
++ dm-exists
|= =ship
=/ =index:store
[ship ~]
(check-node-existence:gra [our.bowl %dm-inbox] index)
::
++ add-node
|= [=index:store =node:store]
^- update:store
:^ now.bowl %add-nodes [our.bowl %dm-inbox]
(~(gas by *nodes) [index node] ~)
::
++ add-missing-root
|= =ship
^- (list card)
?: (dm-exists ship) ~
=/ =index:store
[ship ~]
=| =post:store
=: author.post our.bowl
index.post index
time-sent.post now.bowl
==
=/ =node:store
[%&^post %empty ~]
(poke-our:pass %graph-store (update:cg:gra (add-node index node)))^~
::
++ outgoing-add
|= =nodes
^- (quip card _state)
=/ nodes=(list [=index:store =node:store])
~(tap by nodes)
=| cards=(list card)
|- ^- (quip card _state)
?~ nodes [cards state]
?> ?=([@ @ ~] index.i.nodes)
=/ =ship i.index.i.nodes
=/ =dock [ship %dm-hook]
=/ =wire /dm/(scot %p ship)
=/ =cage
(update:cg:gra (add-node [index node]:i.nodes))
%= $
nodes t.nodes
pending (~(add ja pending) ship now.bowl)
::
cards
;: welp
cards
::
(add-missing-root ship)
::
:- (poke-our:pass %graph-store cage)
?: =(our.bowl ship) ~
(~(poke pass wire) dock cage)^~
==
==
::
++ normalize-incoming
|= =nodes
^- ^nodes
%- ~(gas by *^nodes)
%+ turn ~(tap by nodes)
|= [=index:store =node:store]
?> ?=([@ @ ~] index)
?> ?=(%empty -.children.node)
?> ?=(%& -.post.node)
=/ new-index=index:store
[src.bowl now.bowl ~]
=. index.p.post.node
new-index
[new-index node]
::
++ incoming-add
|= =nodes
^- (quip card _state)
:_ state
?> =(1 ~(wyt by nodes))
=* ship src.bowl
%+ snoc (add-missing-root ship)
%+ poke-our:pass %graph-store
%+ update:cg:gra now.bowl
[%add-nodes [our.bowl %dm-inbox] (normalize-incoming nodes)]
--
::
++ on-watch
|= =path
?. ?=([%updates ~] path)
(on-watch:def path)
:_ this
:~ (fact-init:io dm-hook-action+!>([%pendings ~(key by screened)]))
(fact-init:io dm-hook-action+!>([%screen screening]))
==
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?. ?=([%dm @ ~] wire)
(on-agent:def wire sign)
?> ?=(%poke-ack -.sign)
=/ =ship
(slav %p i.t.wire)
=^ acked=atom state
(remove-pending ship)
?~ p.sign
`this
:_ this
:_ ~
=+ indices=(~(gas in *(set index:store)) ~[ship acked] ~)
%+ poke-our:pass %graph-store
(update:cg:gra now.bowl %remove-posts [our.bowl %dm-inbox] indices)
::
++ remove-pending
|= =ship
^- [atom _state]
=/ pend-ship=(list atom)
(flop (~(get ja pending) ship))
?> ?=(^ pend-ship)
[i.pend-ship state(pending (~(put by pending) ship (flop t.pend-ship)))]
--
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

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

@ -875,7 +875,7 @@
%ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil) %ge (dy-run-generator (dy-cage p.p.p.bil) q.p.bil)
%sa %sa
=+ .^(=dais:clay cb+(en-beam he-beak /[p.bil])) =+ .^(=dais:clay cb+(en-beam he-beak /[p.bil]))
(dy-hand p.bil bunt:dais) (dy-hand p.bil *vale:dais)
:: ::
%as %as
=/ cag=cage (dy-cage p.q.bil) =/ cag=cage (dy-cage p.q.bil)
@ -1162,6 +1162,7 @@
%import !! %import !!
%export-all !! %export-all !!
%import-all !! %import-all !!
%cancel !!
%as %as
:* %as mar.source.com :* %as mar.source.com
$(num +(num), source.com next.source.com) $(num +(num), source.com next.source.com)

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

@ -188,8 +188,11 @@
?: ?=([%'~landscape' %js %session ~] site.req-line) ?: ?=([%'~landscape' %js %session ~] site.req-line)
%+ require-authorization-simple:app %+ require-authorization-simple:app
inbound-request inbound-request
%- js-response:gen %. %- as-octs:mimes:html
(as-octt:mimes:html "window.ship = '{+:(scow %p our.bowl)}';") (rap 3 'window.ship = "' (rsh 3 (scot %p our.bowl)) '";' ~)
%* . js-response:gen
cache %.n
==
:: ::
=/ [payload=simple-payload:http public=?] (get-file req-line is-file) =/ [payload=simple-payload:http public=?] (get-file req-line is-file)
?: public payload ?: public payload
@ -222,6 +225,8 @@
[~ %js] (js-response:gen file) [~ %js] (js-response:gen file)
[~ %css] (css-response:gen file) [~ %css] (css-response:gen file)
[~ %png] (png-response:gen file) [~ %png] (png-response:gen file)
[~ %svg] (svg-response:gen file)
[~ %ico] (ico-response:gen file)
:: ::
[~ %html] [~ %html]
%. file %. file
@ -238,11 +243,9 @@
[not-found:gen %.n] [not-found:gen %.n]
:_ public.u.content :_ public.u.content
=/ mime-type=@t (rsh 3 (crip <p.u.data>)) =/ mime-type=@t (rsh 3 (crip <p.u.data>))
:: Should maybe inspect to see how long cache should hold
::
=/ headers =/ headers
:~ content-type+mime-type :~ content-type+mime-type
max-1-da:gen max-1-wk:gen
'service-worker-allowed'^'/' 'service-worker-allowed'^'/'
== ==
[[200 headers] `q.u.data] [[200 headers] `q.u.data]
@ -271,7 +274,10 @@
++ match-content-path ++ match-content-path
|= [pax=path =^serving is-file=?] |= [pax=path =^serving is-file=?]
^- (unit [content path ?]) ^- (unit [content path ?])
%- ~(rep by serving) %+ roll
%+ sort ~(tap by serving)
|= [[a=path *] [b=path *]]
(gth (lent a) (lent b))
|= $: [url-base=path =content public=? spa=?] |= $: [url-base=path =content public=? spa=?]
out=(unit [content path ?]) out=(unit [content path ?])
== ==

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

@ -2,13 +2,16 @@
:: ::
:: prompts content delivery and Gall state storage for Landscape JS blob :: prompts content delivery and Gall state storage for Landscape JS blob
:: ::
/- glob /- glob, *resource
/+ default-agent, verb, dbug /+ default-agent, verb, dbug
|% |%
++ hash 0v3.g6u13.haedt.jt4hd.61ek5.6t30q ++ landscape-hash 0v2.i41hn.un6g3.jucd7.rhrah.n0qmv
++ btc-wallet-hash 0v2.3qak4.al612.8m1ig.kg03r.mfide
+$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))] +$ state-0 [%0 hash=@uv glob=(unit (each glob:glob tid=@ta))]
+$ state-1 [%1 =globs:glob]
+$ all-states +$ all-states
$% state-0 $% state-0
state-1
== ==
+$ card card:agent:gall +$ card card:agent:gall
-- --
@ -19,12 +22,12 @@
[%pass [%timer path] %arvo %b %wait (add now ~m30)] [%pass [%timer path] %arvo %b %wait (add now ~m30)]
:: ::
++ wait-start ++ wait-start
|= now=@da |= [now=@da =path]
^- card ^- card
[%pass /start %arvo %b %wait now] [%pass [%start path] %arvo %b %wait now]
:: ::
++ poke-file-server ++ poke-file-server
|= [our=@p =cage] |= [our=@p hash=@uv =cage]
^- card ^- card
[%pass /serving/(scot %uv hash) %agent [our %file-server] %poke cage] [%pass /serving/(scot %uv hash) %agent [our %file-server] %poke cage]
:: ::
@ -43,9 +46,12 @@
^- card ^- card
[%pass [%running path] %agent [our %spider] %leave ~] [%pass [%running path] %agent [our %spider] %leave ~]
-- --
=| state=state-0 =| state=state-1
=. hash.state hash =. globs.state
=/ serve-path=path /'~landscape'/js/bundle (~(put by globs.state) /'~landscape'/js/bundle landscape-hash ~)
=. globs.state
(~(put by globs.state) /'~btc'/js/bundle btc-wallet-hash ~)
::
^- agent:gall ^- agent:gall
%+ verb | %+ verb |
%- agent:dbug %- agent:dbug
@ -56,77 +62,121 @@
++ on-init ++ on-init
^- (quip card _this) ^- (quip card _this)
:: delay through timer to make sure %spider has started :: delay through timer to make sure %spider has started
[[(wait-start now.bowl) ~] this] :_ this
%+ turn ~(tap by ~(key by globs.state))
|=(=path (wait-start now.bowl path))
:: ::
++ on-save !>(state) ++ on-save !>(state)
++ on-load ++ on-load
|= old-state=vase |= old-state=vase
^- (quip card _this) ^- (quip card _this)
=+ !<(old=all-states old-state) =+ !<(old=all-states old-state)
?> ?=(%0 -.old) =| cards=(list card)
?~ glob.old =/ upgrading=? %.n
on-init |-
?: ?=(%& -.u.glob.old) ?- -.old
?: =(hash.old hash.state) %1
`this(state old) =/ [cards-1=(list card) =globs:glob]
on-init %- ~(rep by globs.old)
=/ cancel-cards |= $: [=serve=path =glob-details:glob]
=/ args [tid.p.u.glob.old &] cards=(list card)
:~ (leave-spider /(scot %uv hash.old) our.bowl) globs=_globs.state
(poke-spider /(scot %uv hash.old) our.bowl %spider-stop !>(args)) ==
^- [(list card) globs:glob]
=/ new-glob-details (~(get by globs) serve-path)
?~ new-glob-details
[cards globs]
?~ glob.glob-details
:_ globs
[(wait-start now.bowl serve-path) cards]
?: ?=(%& -.u.glob.glob-details)
?: =(hash.u.new-glob-details hash.glob-details)
[cards (~(put by globs) serve-path glob-details)]
:_ globs
[(wait-start now.bowl serve-path) cards]
?: upgrading
:_ globs
[(wait-start now.bowl serve-path) cards]
=/ args [tid.p.u.glob.glob-details &]
=/ spider-wire [(scot %uv hash.glob-details) serve-path]
:_ globs
:* (leave-spider spider-wire our.bowl)
(poke-spider spider-wire our.bowl %spider-stop !>(args))
(wait-start now.bowl serve-path)
cards
==
:- (weld cards cards-1)
this(globs.state globs)
::
%0
=/ globs
(~(put by globs.state) /'~landscape'/js/bundle [hash.old glob.old])
%= $
old [%1 globs]
::
cards
?~ glob.old ~
?: =(%& -.u.glob.old) ~
?> ?=(%| -.u.glob.old)
=/ args [tid.p.u.glob.old &]
:~ (leave-spider /(scot %uv hash.old) our.bowl)
(poke-spider /(scot %uv hash.old) our.bowl %spider-stop !>(args))
==
::
upgrading %.y
== ==
=^ init-cards this on-init ==
[(weld cancel-cards init-cards) this]
:: ::
++ on-poke ++ on-poke
|= [=mark =vase] |= [=mark =vase]
^- (quip card _this) ^- (quip card _this)
?+ mark (on-poke:def mark vase) ?+ mark (on-poke:def mark vase)
%glob-make %glob-make
=+ !<(dir=path vase)
:_ this :_ this
=/ home=path /(scot %p our.bowl)/home/(scot %da now.bowl) =/ home=path /(scot %p our.bowl)/home/(scot %da now.bowl)
=+ .^(paths=(list path) %ct (weld home dir))
=+ .^(=js=tube:clay %cc (weld home /js/mime)) =+ .^(=js=tube:clay %cc (weld home /js/mime))
=+ .^(=map=tube:clay %cc (weld home /map/mime)) =+ .^(=map=tube:clay %cc (weld home /map/mime))
=+ .^(arch %cy (weld home /app/landscape/js/bundle))
=/ bundle-hash=@t
%- need
^- (unit @t)
%- ~(rep by dir)
|= [[file=@t ~] out=(unit @t)]
?^ out out
?. ?& =((end [3 6] file) 'index.')
!=('sj.' (end [3 3] (swp 3 file)))
==
out
``@t`(rsh [3 6] file)
=/ js-name
(cat 3 'index.' bundle-hash)
=/ map-name
(cat 3 js-name '.js')
=+ .^(js=@t %cx :(weld home /app/landscape/js/bundle /[js-name]/js))
=+ .^(map=@t %cx :(weld home /app/landscape/js/bundle /[map-name]/map))
=+ .^(sw=@t %cx :(weld home /app/landscape/js/bundle /serviceworker/js))
=+ !<(=js=mime (js-tube !>(js)))
=+ !<(=sw=mime (js-tube !>(sw)))
=+ !<(=map=mime (map-tube !>(map)))
=/ =glob:glob =/ =glob:glob
%- ~(gas by *glob:glob) %- ~(gas by *glob:glob)
:~ /[js-name]/js^js-mime %+ turn paths
/[map-name]/map^map-mime |= pax=path
/serviceworker/js^sw-mime ^- [path mime]
=+ .^(file=@t %cx (weld home pax))
=/ mar (snag 0 (flop pax))
:- (slag (lent dir) pax)
?+ mar ~|(unsupported-glob-type+mar !!)
%js !<(mime (js-tube !>(file)))
%map !<(mime (map-tube !>(file)))
== ==
=/ =path /(cat 3 'glob-' (scot %uv (sham glob)))/glob =/ =path /(cat 3 'glob-' (scot %uv (sham glob)))/glob
~& globbed+`(set ^path)`~(key by glob)
[%pass /make %agent [our.bowl %hood] %poke %drum-put !>([path (jam glob)])]~ [%pass /make %agent [our.bowl %hood] %poke %drum-put !>([path (jam glob)])]~
:: ::
%noun %noun
?: =(%kick q.vase) ?: =(%kick -.q.vase)
(on-load !>(state(hash *@uv))) =+ !<([%kick =path] vase)
=/ glob-details (~(get by globs.state) path)
?~ glob-details
~& no-such-glob+path
`this
=/ new-state
state(globs (~(put by globs.state) path *@uv glob.u.glob-details))
(on-load !>(new-state))
(on-poke:def mark vase) (on-poke:def mark vase)
== ==
:: ::
++ on-watch on-watch:def ++ on-watch on-watch:def
++ on-leave on-leave:def ++ on-leave on-leave:def
++ on-peek on-peek:def ::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %btc-wallet ~] ``noun+!>(btc-wallet-hash)
==
::
++ on-agent ++ on-agent
|= [=wire =sign:agent:gall] |= [=wire =sign:agent:gall]
^- (quip card _this) ^- (quip card _this)
@ -134,83 +184,109 @@
(on-agent:def wire sign) (on-agent:def wire sign)
?: ?=([%make ~] wire) ?: ?=([%make ~] wire)
(on-agent:def wire sign) (on-agent:def wire sign)
?. ?=([%running @ ~] wire) ?. ?=([%running @ *] wire)
%- (slog leaf+"glob: strange on-agent! {<wire -.sign>}" ~) %- (slog leaf+"glob: strange on-agent! {<wire -.sign>}" ~)
(on-agent:def wire sign) (on-agent:def wire sign)
::
=/ produced-hash (slav %uv i.t.wire)
=* serve-path t.t.wire
=/ glob-details (~(get by globs.state) serve-path)
?~ glob-details
[~ this]
?. =(hash.u.glob-details produced-hash)
[~ this]
?- -.sign ?- -.sign
%poke-ack %poke-ack
?~ p.sign ?~ p.sign
[~ this] [~ this]
%- (slog leaf+"glob: couldn't start thread; will retry" u.p.sign) %- (slog leaf+"glob: couldn't start thread; will retry" u.p.sign)
:_ this(glob.state ~) :_ ~ :_ this(globs.state (~(put by globs.state) serve-path produced-hash ~))
(leave-spider t.wire our.bowl) [(leave-spider t.wire our.bowl)]~
:: ::
%watch-ack %watch-ack
?~ p.sign ?~ p.sign
[~ this] [~ this]
%- (slog leaf+"glob: couldn't listen to thread; will retry" u.p.sign) %- (slog leaf+"glob: couldn't listen to thread; will retry" u.p.sign)
[~ this(glob.state ~)] [~ this(globs.state (~(put by globs.state) serve-path produced-hash ~))]
:: ::
%kick %kick
=? glob.state ?=([~ %| *] glob.state) ?. ?=([~ %| *] glob.u.glob-details)
~ `this
`this [~ this(globs.state (~(put by globs.state) serve-path produced-hash ~))]
:: ::
%fact %fact
=/ produced-hash (slav %uv i.t.wire)
?. =(hash.state produced-hash)
[~ this]
?+ p.cage.sign (on-agent:def wire sign) ?+ p.cage.sign (on-agent:def wire sign)
%thread-fail %thread-fail
=+ !<([=term =tang] q.cage.sign) =+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"glob: thread failed; will retry" leaf+<term> tang) %- (slog leaf+"glob: thread failed; will retry" leaf+<term> tang)
[~ this(glob.state ~)] :- ~
this(globs.state (~(put by globs.state) serve-path produced-hash ~))
:: ::
%thread-done %thread-done
=+ !<(=glob:glob q.cage.sign) =+ !<(=glob:glob q.cage.sign)
?. =(hash.state (sham glob)) ?. =(hash.u.glob-details (sham glob))
%: mean %: mean
leaf+"glob: hash doesn't match!" leaf+"glob: hash doesn't match!"
>expected=hash.state< >expected=hash.u.glob-details<
>got=(sham glob)< >got=(sham glob)<
~ ~
== ==
:_ this(glob.state `[%& glob]) :_ ~ =. globs.state
%+ poke-file-server our.bowl (~(put by globs.state) serve-path produced-hash `[%& glob])
[%file-server-action !>([%serve-glob serve-path glob %&])] :_ this :_ ~
%: poke-file-server
our.bowl
produced-hash
%file-server-action
!>([%serve-glob serve-path glob %&])
==
== ==
== ==
:: ::
++ on-arvo ++ on-arvo
|= [=wire =sign-arvo] |= [=wire =sign-arvo]
^- (quip card _this) ^- (quip card _this)
?: ?=([%start ~] wire) ?: ?=([%start *] wire)
=/ new-tid=@ta (cat 3 'glob--' (scot %uv eny.bowl)) =* serve-path t.wire
=/ args [~ `new-tid %glob !>([~ hash.state])] =/ glob-details (~(get by globs.state) serve-path)
=/ action !>([%unserve-dir serve-path]) ?~ glob-details
:_ this(glob.state `[%| new-tid]) [~ this]
:~ (poke-file-server our.bowl %file-server-action action) =/ new-tid=@ta (cat 3 'glob--' (scot %uv (sham eny.bowl serve-path)))
(wait-timeout /[new-tid] now.bowl) =/ args [~ `new-tid %glob !>([~ hash.u.glob-details])]
(watch-spider /(scot %uv hash.state) our.bowl /thread-result/[new-tid]) =/ action=cage [%file-server-action !>([%unserve-dir serve-path])]
(poke-spider /(scot %uv hash.state) our.bowl %spider-start !>(args)) =/ spider-wire [(scot %uv hash.u.glob-details) serve-path]
=. globs.state
(~(put by globs.state) serve-path hash.u.glob-details `[%| new-tid])
:_ this
:~ (poke-file-server our.bowl hash.u.glob-details action)
(wait-timeout [new-tid serve-path] now.bowl)
(watch-spider spider-wire our.bowl /thread-result/[new-tid])
(poke-spider spider-wire our.bowl %spider-start !>(args))
== ==
?. ?=([%timer @ ~] wire) ::
?. ?=([%timer @ *] wire)
%- (slog leaf+"glob: strange on-arvo wire: {<wire [- +<]:sign-arvo>}" ~) %- (slog leaf+"glob: strange on-arvo wire: {<wire [- +<]:sign-arvo>}" ~)
`this `this
?. ?=(%wake +<.sign-arvo) ?. ?=(%wake +<.sign-arvo)
%- (slog leaf+"glob: strange on-arvo sign: {<wire [- +<]:sign-arvo>}" ~) %- (slog leaf+"glob: strange on-arvo sign: {<wire [- +<]:sign-arvo>}" ~)
`this `this
?: ?=([~ %& *] glob.state) =* serve-path t.wire
=/ glob-details (~(get by globs.state) serve-path)
?~ glob-details
`this `this
?. ?| ?=(~ glob.state) ?: ?=([~ %& *] glob.u.glob-details)
=(i.t.wire tid.p.u.glob.state) `this
?. ?| ?=(~ glob.u.glob-details)
=(i.t.wire tid.p.u.glob.u.glob-details)
== ==
`this `this
?^ error.sign-arvo ?^ error.sign-arvo
%- (slog leaf+"glob: timer handling failed; will retry" ~) %- (slog leaf+"glob: timer handling failed; will retry" ~)
[[(wait-timeout t.wire now.bowl)]~ this] [[(wait-timeout t.wire now.bowl)]~ this]
%- (slog leaf+"glob: timed out; retrying" ~) %- (slog leaf+"glob: timed out; retrying" ~)
(on-load !>(state(hash *@uv))) =/ new-details u.glob-details(hash *@uv)
=/ new-state state(globs (~(put by globs.state) serve-path new-details))
(on-load !>(new-state))
:: ::
++ on-fail on-fail:def ++ on-fail on-fail:def
-- --

4
pkg/arvo/app/graph-pull-hook.hoon
View File

@ -9,7 +9,7 @@
update:store update:store
%graph-update %graph-update
%graph-push-hook %graph-push-hook
1 1 2 2
%.n %.n
== ==
-- --
@ -41,7 +41,7 @@
%- (slog leaf+"nacked {<resource>}" tang) %- (slog leaf+"nacked {<resource>}" tang)
:_ this :_ this
?. (~(has in get-keys:gra) resource) ~ ?. (~(has in get-keys:gra) resource) ~
=- [%pass /pull-nack %agent [our.bowl %graph-store] %poke %graph-update-1 -]~ =- [%pass /pull-nack %agent [our.bowl %graph-store] %poke %graph-update-2 -]~
!> ^- update:store !> ^- update:store
[now.bowl [%archive-graph resource]] [now.bowl [%archive-graph resource]]
:: ::

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

@ -1,6 +1,6 @@
/- *group, metadata=metadata-store /- *group, metadata=metadata-store
/+ store=graph-store, mdl=metadata, res=resource, graph, group, default-agent, /+ store=graph-store, mdl=metadata, res=resource, graph, group, default-agent,
dbug, verb, push-hook dbug, verb, push-hook, agentio
:: ::
~% %graph-push-hook-top ..part ~ ~% %graph-push-hook-top ..part ~
|% |%
@ -12,16 +12,44 @@
update:store update:store
%graph-update %graph-update
%graph-pull-hook %graph-pull-hook
1 1 2 2
== ==
:: ::
+$ agent (push-hook:push-hook config) +$ agent (push-hook:push-hook config)
:: ::
+$ state-null ~ +$ state-null ~
+$ state-zero [%0 marks=(set mark)] +$ state-zero [%0 marks=(set mark)]
+$ state-one [%1 ~]
+$ versioned-state +$ versioned-state
$@ state-null $@ state-null
state-zero $% state-zero
state-one
==
::
+$ cached-transform
$-([index:store post:store atom ?] [index:store post:store])
::
+$ cached-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
$: state-one
cache
==
::
+$ cache-action
$% [%graph-to-mark (pair resource:res (unit mark))]
[%perm-marks (pair (pair mark @tas) cached-permission)]
[%transform-marks (pair mark cached-transform)]
==
-- --
:: ::
%- agent:dbug %- agent:dbug
@ -30,26 +58,48 @@
%- (agent:push-hook config) %- (agent:push-hook config)
^- agent ^- agent
=- =-
=| state-zero ~% %graph-push-hook-agent ..scry.hook-core ~
=| inflated-state
=* state - =* state -
|_ =bowl:gall |_ =bowl:gall
+* this . +* this .
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
grp ~(. group bowl) grp ~(. group bowl)
gra ~(. graph bowl) gra ~(. graph bowl)
hc ~(. hook-core bowl) met ~(. mdl bowl)
hc ~(. hook-core bowl +.state)
io ~(. agentio bowl)
:: ::
++ on-init on-init:def ++ on-init on-init:def
++ on-save !>(state) ++ on-save !>(-.state)
++ on-load ++ on-load
|= =vase |= =vase
=+ !<(old=versioned-state vase) =+ !<(old=versioned-state vase)
=? old ?=(~ old) =? old ?=(~ old)
[%0 ~] [%0 ~]
?> ?=(%0 -.old) =? old ?=(%0 -.old)
`this(state old) [%1 ~]
?> ?=(%1 -.old)
`this(-.state old, +.state *cache)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. =(mark %graph-cache-hook)
[~ this]
=/ 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)]
:: ::
++ on-poke on-poke:def
++ on-agent on-agent:def ++ on-agent on-agent:def
++ on-watch on-watch:def ++ on-watch on-watch:def
++ on-leave on-leave:def ++ on-leave on-leave:def
@ -58,47 +108,77 @@
|= [=wire =sign-arvo] |= [=wire =sign-arvo]
^- (quip card _this) ^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo) ?+ wire (on-arvo:def wire sign-arvo)
:: XX: no longer necessary
:: ::
[%perms @ @ ~] [%perms @ @ ~] [~ this]
?> ?=(?(%add %remove) i.t.t.wire) [%transform-add @ ~] [~ this]
=* mark i.t.wire
:_ this
(build-permissions:hc mark i.t.t.wire %next)^~
::
[%transform-add @ ~]
=* mark i.t.wire
:_ this
(build-transform-add:hc mark %next)^~
== ==
:: ::
++ on-fail on-fail:def ++ on-fail on-fail:def
++ transform-proxy-update ++ transform-proxy-update
~/ %transform-proxy-update
|= vas=vase |= vas=vase
^- (unit vase) ^- (quip card (unit vase))
=/ =update:store !<(update:store vas) =/ =update:store !<(update:store vas)
=* rid resource.q.update =* rid resource.q.update
=. p.update now.bowl =. p.update now.bowl
?- -.q.update ?- -.q.update
%add-nodes %add-nodes
?. (is-allowed-add:hc rid nodes.q.update) =| cards=(list card)
~ ?: ?=(^ (rush name.rid ;~(pfix (jest 'dm--') fed:ag)))
=/ mark (get-mark:gra rid) :: block new DM messages
?~ mark `vas [~ ~]
|^ =^ allowed cards (is-allowed-add:hc rid nodes.q.update)
=/ transform ?. allowed
!< $-([index:store post:store atom ?] [index:store post:store]) [cards ~]
%. !>(*indexed-post:store) =/ mark-cached (~(has by graph-to-mark) rid)
.^(tube:clay (scry:hc %cc %home /[u.mark]/transform-add-nodes)) =/ mark
=/ [* result=(list [index:store node:store])] ?: mark-cached
%+ roll (~(got by graph-to-mark) rid)
(flatten-node-map ~(tap by nodes.q.update)) (get-mark:gra rid)
(transform-list transform) ?~ mark
=. nodes.q.update [cards `vas]
%- ~(gas by *(map index:store node:store)) =< $
result ~% %transform-add-nodes ..transform-proxy-update ~
[~ !>(update)] |%
++ $
^- (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
=/ [* result=(list [index:store node:store])]
%+ roll
(flatten-node-map ~(tap by nodes.q.update))
(transform-list transform)
=. nodes.q.update
%- ~(gas by *(map index:store node:store))
result
:_ :- ~
!> ^- update:store
update
%+ weld cards
%- zing
:~ ?: mark-cached ~
:_ ~
%+ 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 ++ flatten-node-map
~/ %flatten-node-map
|= lis=(list [index:store node:store]) |= lis=(list [index:store node:store])
^- (list [index:store node:store]) ^- (list [index:store node:store])
|^ |^
@ -130,10 +210,13 @@
-- --
:: ::
++ transform-list ++ transform-list
~/ %transform-list
|= transform=$-([index:store post:store atom ?] [index:store post:store]) |= transform=$-([index:store post:store atom ?] [index:store post:store])
|= $: [=index:store =node:store] |= $: [=index:store =node:store]
[indices=(set index:store) lis=(list [index:store node:store])] [indices=(set index:store) lis=(list [index:store node:store])]
== ==
~| "cannot put a deleted post into %add-nodes {<post.node>}"
?> ?=(%& -.post.node)
=/ l (lent index) =/ l (lent index)
=/ parent-modified=? =/ parent-modified=?
%- ~(rep in indices) %- ~(rep in indices)
@ -144,36 +227,42 @@
%.n %.n
=((swag [0 k] index) i) =((swag [0 k] index) i)
=/ [ind=index:store =post:store] =/ [ind=index:store =post:store]
(transform index post.node now.bowl parent-modified) (transform index p.post.node now.bowl parent-modified)
:- (~(put in indices) index) :- (~(put in indices) index)
(snoc lis [ind node(post post)]) (snoc lis [ind node(p.post post)])
-- --
:: ::
%remove-nodes %remove-posts
?. (is-allowed-remove:hc resource.q.update indices.q.update) =| cards=(list card)
=^ allowed cards
(is-allowed-remove:hc rid indices.q.update)
:- cards
?. allowed
~ ~
`vas `vas
:: ::
%add-graph ~ %add-graph [~ ~]
%remove-graph ~ %remove-graph [~ ~]
%add-signatures ~ %add-signatures [~ ~]
%remove-signatures ~ %remove-signatures [~ ~]
%archive-graph ~ %archive-graph [~ ~]
%unarchive-graph ~ %unarchive-graph [~ ~]
%add-tag ~ %add-tag [~ ~]
%remove-tag ~ %remove-tag [~ ~]
%keys ~ %keys [~ ~]
%tags ~ %tags [~ ~]
%tag-queries ~ %tag-queries [~ ~]
%run-updates ~ %run-updates [~ ~]
== ==
:: ::
++ resource-for-update resource-for-update:gra ++ resource-for-update resource-for-update:gra
:: ::
++ initial-watch ++ initial-watch
~/ %initial-watch
|= [=path =resource:res] |= [=path =resource:res]
^- vase ^- vase
?> (is-allowed:hc resource) |^
?> (is-allowed resource)
!> ^- update:store !> ^- update:store
?~ path ?~ path
:: new subscribe :: new subscribe
@ -186,22 +275,19 @@
=/ =time (slav %da i.path) =/ =time (slav %da i.path)
=/ =update-log:store (get-update-log-subset:gra resource time) =/ =update-log:store (get-update-log-subset:gra resource time)
[now.bowl [%run-updates resource update-log]] [now.bowl [%run-updates resource update-log]]
::
++ is-allowed
|= =resource:res
=/ group-res=resource:res
(need (peek-group:met %graph resource))
(is-member:grp src.bowl group-res)
--
:: ::
++ take-update ++ take-update
|= =vase |= =vase
^- [(list card) agent] ^- [(list card) agent]
=/ =update:store !<(update:store vase) =/ =update:store !<(update:store vase)
?+ -.q.update [~ this] ?+ -.q.update [~ this]
%add-graph
?~ mark.q.update `this
=* mark u.mark.q.update
?: (~(has in marks) mark) `this
:_ this(marks (~(put in marks) mark))
:~ (build-permissions:hc mark %add %sing)
(build-permissions:hc mark %remove %sing)
(build-transform-add:hc mark %sing)
==
::
%remove-graph %remove-graph
:_ this :_ this
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~ [%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
@ -211,11 +297,14 @@
[%give %kick ~[resource+(en-path:res resource.q.update)] ~]~ [%give %kick ~[resource+(en-path:res resource.q.update)] ~]~
== ==
-- --
^| ^= hook-core ::
|_ =bowl:gall ~% %graph-push-hook-helper ..card.hook-core ~
^= hook-core
|_ [=bowl:gall =cache]
+* grp ~(. group bowl) +* grp ~(. group bowl)
met ~(. mdl bowl) met ~(. mdl bowl)
gra ~(. graph bowl) gra ~(. graph bowl)
io ~(. agentio bowl)
:: ::
++ scry ++ scry
|= [care=@t desk=@t =path] |= [care=@t desk=@t =path]
@ -223,28 +312,43 @@
/[care]/(scot %p our.bowl)/[desk]/(scot %da now.bowl) /[care]/(scot %p our.bowl)/[desk]/(scot %da now.bowl)
path path
:: ::
++ perm-mark-name
|= perm=@t
^- @t
(cat 3 'graph-permissions-' perm)
::
++ perm-mark ++ perm-mark
|= [=resource:res perm=@t vip=vip-metadata:metadata =indexed-post:store] |= [=resource:res perm=@t vip=vip-metadata:metadata =indexed-post:store]
^- permissions:store ^- [permissions:store (list card)]
=- (check vip) |^
!< check=$-(vip-metadata:metadata permissions:store) =/ mark-cached (~(has by graph-to-mark.cache) resource)
%. !>(indexed-post) =/ mark
=/ mark (get-mark:gra resource) ?: mark-cached
?~ mark |=(=vase !>([%no %no %no])) (~(got by graph-to-mark.cache) resource)
.^(tube:clay (scry %cc %home /[u.mark]/(perm-mark-name perm))) (get-mark:gra resource)
:: ?~ mark
++ add-mark [[%no %no %no] ~]
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store] =/ key [u.mark (perm-mark-name perm)]
(perm-mark resource %add vip indexed-post) =/ perms-cached (~(has by perm-marks.cache) key)
:: =/ convert
++ remove-mark ?: perms-cached
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store] (~(got by perm-marks.cache) key)
(perm-mark resource %remove vip indexed-post) .^(cached-permission (scry %cf %home /[u.mark]/(perm-mark-name perm)))
:- ((convert indexed-post) vip)
%- zing
:~ ?: mark-cached ~
:_ ~
%+ 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
|= perm=@t
^- @t
(cat 3 'graph-permissions-' perm)
--
:: ::
++ get-permission ++ get-permission
|= [=permissions:store is-admin=? writers=(set ship)] |= [=permissions:store is-admin=? writers=(set ship)]
@ -257,22 +361,23 @@
writer.permissions writer.permissions
reader.permissions reader.permissions
:: ::
++ is-allowed
|= =resource:res
=/ group-res=resource:res
(need (peek-group:met %graph resource))
(is-member:grp src.bowl group-res)
::
++ get-roles-writers-variation ++ get-roles-writers-variation
~/ %get-roles-writers-variation
|= =resource:res |= =resource:res
^- (unit [is-admin=? writers=(set ship) vip=vip-metadata:metadata]) ^- (unit [is-admin=? writers=(set ship) vip=vip-metadata:metadata])
=/ assoc=(unit association:metadata) =/ assoc=(unit association:metadata)
(peek-association:met %graph resource) (peek-association:met %graph resource)
?~ assoc ~ ?~ assoc ~
=/ group=(unit group:grp)
(scry-group:grp group.u.assoc)
?~ group ~
=/ role=(unit (unit role-tag)) =/ role=(unit (unit role-tag))
(role-for-ship:grp group.u.assoc src.bowl) (role-for-ship-with-group:grp u.group group.u.assoc src.bowl)
=/ writers=(set ship) =/ writers=(set ship)
(get-tagged-ships:grp group.u.assoc [%graph resource %writers]) %^ get-tagged-ships-with-group:grp
u.group
group.u.assoc
[%graph resource %writers]
?~ role ~ ?~ role ~
=/ is-admin=? =/ is-admin=?
?=(?([~ %admin] [~ %moderator]) u.role) ?=(?([~ %admin] [~ %moderator]) u.role)
@ -281,74 +386,111 @@
++ node-to-indexed-post ++ node-to-indexed-post
|= =node:store |= =node:store
^- indexed-post:store ^- indexed-post:store
=* index index.post.node ?> ?=(%& -.post.node)
[(snag (dec (lent index)) index) post.node] =* index index.p.post.node
[(snag (dec (lent index)) index) p.post.node]
:: ::
++ is-allowed-add ++ is-allowed-add
~/ %is-allowed-add
|= [=resource:res nodes=(map index:store node:store)] |= [=resource:res nodes=(map index:store node:store)]
^- ? ^- [? (list card)]
%- (bond |.(%.n)) |^
%- (bond |.([%.n ~]))
%+ biff (get-roles-writers-variation resource) %+ biff (get-roles-writers-variation resource)
|= [is-admin=? writers=(set ship) vip=vip-metadata:metadata] |= [is-admin=? writers=(set ship) vip=vip-metadata:metadata]
^- (unit [? (list card)])
%- some %- some
%+ levy ~(tap by nodes) =/ a ~(tap by nodes)
|= [=index:store =node:store] =| cards=(list card)
=/ parent-index=index:store |- ^- [? (list card)]
(scag (dec (lent index)) index) ?~ a [& cards]
?: (~(has by nodes) parent-index) %.y =/ c (check i.a is-admin writers vip)
?. =(author.post.node src.bowl) ?. -.c
%.n [| (weld cards +.c)]
=/ =permissions:store $(a t.a, cards (weld cards +.c))
%^ add-mark resource vip ::
(node-to-indexed-post node) ++ check
=/ =permission-level:store |= $: [=index:store =node:store]
(get-permission permissions is-admin writers) is-admin=?
?- permission-level writers=(set ship)
%yes %.y vip=vip-metadata:metadata
%no %.n ==
:: ^- [? (list card)]
%self =/ parent-index=index:store
=/ parent-node=node:store (scag (dec (lent index)) index)
(got-node:gra resource parent-index) ?: (~(has by nodes) parent-index)
=(author.post.parent-node src.bowl) [%.y ~]
== ?: ?=(%| -.post.node)
[%.n ~]
?. =(author.p.post.node src.bowl)
[%.n ~]
=/ added
%^ add-mark resource vip
(node-to-indexed-post node)
=* permissions -.added
=* cards +.added
=/ =permission-level:store
(get-permission permissions is-admin writers)
:_ cards
?- permission-level
%yes %.y
%no %.n
::
%self
=/ parent-node=node:store
(got-node:gra resource parent-index)
?: ?=(%| -.post.parent-node)
%.n
=(author.p.post.parent-node src.bowl)
==
::
++ add-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %add vip indexed-post)
--
:: ::
++ is-allowed-remove ++ is-allowed-remove
~/ %is-allowed-remove
|= [=resource:res indices=(set index:store)] |= [=resource:res indices=(set index:store)]
^- ? ^- [? (list card)]
%- (bond |.(%.n)) |^
%- (bond |.([%.n ~]))
%+ biff (get-roles-writers-variation resource) %+ biff (get-roles-writers-variation resource)
|= [is-admin=? writers=(set ship) vip=vip-metadata:metadata] |= [is-admin=? writers=(set ship) vip=vip-metadata:metadata]
%- some %- some
%+ levy ~(tap by indices) =/ a ~(tap by indices)
|= =index:store =| cards=(list card)
=/ =node:store |- ^- [? (list card)]
(got-node:gra resource index) ?~ a [& cards]
=/ =permissions:store =/ c (check i.a is-admin writers vip)
%^ remove-mark resource vip ?. -.c
(node-to-indexed-post node) [| (weld cards +.c)]
=/ =permission-level:store $(a t.a, cards (weld cards +.c))
(get-permission permissions is-admin writers) ::
?- permission-level ++ check
%yes %.y |= [=index:store is-admin=? writers=(set ship) vip=vip-metadata:metadata]
%no %.n ^- [? (list card)]
%self =(author.post.node src.bowl) =/ =node:store
== (got-node:gra resource index)
:: ?: ?=(%| -.post.node)
++ build-permissions [%.n ~]
|= [=mark kind=?(%add %remove) mode=?(%sing %next)] =/ removed
^- card %^ remove-mark resource vip
=/ =wire /perms/[mark]/[kind] (node-to-indexed-post node)
=/ =mood:clay [%c da+now.bowl /[mark]/(perm-mark-name kind)] =* permissions -.removed
=/ =rave:clay ?:(?=(%sing mode) [mode mood] [mode mood]) =* cards +.removed
[%pass wire %arvo %c %warp our.bowl %home `rave] =/ =permission-level:store
:: (get-permission permissions is-admin writers)
++ build-transform-add :_ cards
|= [=mark mode=?(%sing %next)] ?- permission-level
^- card %yes %.y
=/ =wire /transform-add/[mark] %no %.n
=/ =mood:clay [%c da+now.bowl /[mark]/transform-add-nodes] %self =(author.p.post.node src.bowl)
=/ =rave:clay ?:(?=(%sing mode) [mode mood] [mode mood]) ==
[%pass wire %arvo %c %warp our.bowl %home `rave] ::
++ remove-mark
|= [=resource:res vip=vip-metadata:metadata =indexed-post:store]
(perm-mark resource %remove vip indexed-post)
--
-- --

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

File diff suppressed because it is too large Load Diff

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

@ -47,8 +47,9 @@
:: ::
++ transform-proxy-update ++ transform-proxy-update
|= vas=vase |= vas=vase
^- (unit vase) ^- (quip card (unit vase))
=/ =update:store !<(update:store vas) =/ =update:store !<(update:store vas)
:- ~
?: ?=(%initial -.update) ?: ?=(%initial -.update)
~ ~
|^ |^

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

@ -136,13 +136,13 @@
^- (unit (unit cage)) ^- (unit (unit cage))
?+ path (on-peek:def path) ?+ path (on-peek:def path)
[%y %groups ~] [%y %groups ~]
``noun+!>(~(key by groups)) ``noun+!>(`(set resource)`~(key by groups))
:: ::
[%x %groups %ship @ @ ~] [%x %groups %ship @ @ ~]
=/ rid=(unit resource) =/ rid=(unit resource)
(de-path-soft:resource t.t.path) (de-path-soft:resource t.t.path)
?~ rid ~ ?~ rid ~
``noun+!>((peek-group u.rid)) ``noun+!>(`(unit group)`(peek-group u.rid))
:: ::
[%x %groups %ship @ @ %join @ ~] [%x %groups %ship @ @ %join @ ~]
=/ rid=(unit resource) =/ rid=(unit resource)
@ -150,7 +150,7 @@
=/ =ship =/ =ship
(slav %p i.t.t.t.t.t.t.path) (slav %p i.t.t.t.t.t.t.path)
?~ rid ~ ?~ rid ~
``noun+!>((peek-group-join u.rid ship)) ``noun+!>(`?`(peek-group-join u.rid ship))
:: ::
[%x %export ~] [%x %export ~]
``noun+!>(state) ``noun+!>(state)
@ -199,6 +199,7 @@
:: ::
++ peek-group-join ++ peek-group-join
|= [rid=resource =ship] |= [rid=resource =ship]
^- ?
=/ ugroup =/ ugroup
(~(get by groups) rid) (~(get by groups) rid)
?~ ugroup ?~ ugroup

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

@ -24,7 +24,6 @@
watch-on-self=_& watch-on-self=_&
== ==
:: ::
::
++ scry ++ scry
|* [[our=@p now=@da] =mold p=path] |* [[our=@p now=@da] =mold p=path]
?> ?=(^ p) ?> ?=(^ p)
@ -37,7 +36,6 @@
%^ scry [our now] %^ scry [our now]
tube:clay tube:clay
/cc/[desk]/[mark]/notification-kind /cc/[desk]/[mark]/notification-kind
::
-- --
:: ::
=| state-1 =| state-1
@ -126,15 +124,15 @@
:: ::
++ poke-noun ++ poke-noun
|= non=* |= non=*
?> ?=(%rewatch-dms non) [~ state]
=/ graphs=(list resource) :: ?> ?=(%rewatch-dms non)
~(tap in get-keys:gra) :: =/ graphs=(list resource)
:- ~ :: ~(tap in get-keys:gra)
%_ state :: %_ state
watching :: watching
%- ~(gas in watching) :: %- ~(gas in watching)
(murn graphs |=(rid=resource ?:((should-watch:ha rid) `[rid ~] ~))) :: (murn graphs |=(rid=resource ?:((should-watch:ha rid) `[rid ~] ~)))
== :: ==
:: ::
++ hark-graph-hook-action ++ hark-graph-hook-action
|= =action:hook |= =action:hook
@ -182,7 +180,7 @@
~[watch-graph:ha] ~[watch-graph:ha]
:: ::
%fact %fact
?. ?=(%graph-update-1 p.cage.sign) ?. ?=(%graph-update-2 p.cage.sign)
(on-agent:def wire sign) (on-agent:def wire sign)
=^ cards state =^ cards state
(graph-update !<(update:graph-store q.cage.sign)) (graph-update !<(update:graph-store q.cage.sign))
@ -197,18 +195,20 @@
:: ::
?(%remove-graph %archive-graph) ?(%remove-graph %archive-graph)
(remove-graph resource.q.update) (remove-graph resource.q.update)
:: ::
%remove-nodes %remove-posts
(remove-nodes resource.q.update indices.q.update) (remove-posts resource.q.update indices.q.update)
:: ::
%add-nodes %add-nodes
=* rid resource.q.update =* rid resource.q.update
(check-nodes ~(val by nodes.q.update) rid) =/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
(check-nodes ~(val by nodes.q.update) rid assoc)
== ==
:: this is awful, but notification kind should always switch :: this is awful, but notification kind should always switch
:: on the index, so hopefully doesn't matter :: on the index, so hopefully doesn't matter
:: TODO: rethink this :: TODO: rethink this
++ remove-nodes ++ remove-posts
|= [rid=resource indices=(set index:graph-store)] |= [rid=resource indices=(set index:graph-store)]
=/ to-remove =/ to-remove
%- ~(gas by *(set [resource index:graph-store])) %- ~(gas by *(set [resource index:graph-store]))
@ -256,32 +256,22 @@
=/ graph=graph:graph-store :: graph in subscription is bunted =/ graph=graph:graph-store :: graph in subscription is bunted
(get-graph-mop:gra rid) (get-graph-mop:gra rid)
=/ node=(unit node:graph-store) =/ node=(unit node:graph-store)
(bind (peek:orm:graph-store graph) |=([@ =node:graph-store] node)) (bind (pry:orm:graph-store graph) |=([@ =node:graph-store] node))
=/ assoc=(unit association:metadata)
(peek-association:met %graph rid)
=^ cards state =^ cards state
(check-nodes (drop node) rid) (check-nodes (drop node) rid assoc)
?. (should-watch:ha rid) ?. (should-watch:ha rid assoc)
[cards state] [cards state]
:_ state(watching (~(put in watching) [rid ~])) :_ state(watching (~(put in watching) [rid ~]))
(weld cards (give:ha ~[/updates] %listen [rid ~])) (weld cards (give:ha ~[/updates] %listen [rid ~]))
:: ::
::
++ check-nodes ++ check-nodes
|= $: nodes=(list node:graph-store) |= $: nodes=(list node:graph-store)
rid=resource rid=resource
assoc=(unit association:metadata)
== ==
=/ group=(unit resource) abet:check:(abed:handle-update:ha rid nodes)
(peek-group:met %graph rid)
?~ group
~& no-group+rid
`state
=/ metadatum=(unit metadatum:metadata)
(peek-metadatum:met %graph rid)
?~ metadatum `state
=/ module=term
?: ?=(%empty -.config.u.metadatum) %$
?: ?=(%group -.config.u.metadatum) %$
module.config.u.metadatum
abet:check:(abed:handle-update:ha rid nodes u.group module)
-- --
:: ::
++ on-peek on-peek:def ++ on-peek on-peek:def
@ -343,31 +333,31 @@
$(contents t.contents) $(contents t.contents)
:: ::
++ should-watch ++ should-watch
|= rid=resource |= [rid=resource assoc=(unit association:metadata)]
^- ? ^- ?
=/ group-rid=(unit resource) ?~ assoc
(peek-group:met %graph rid) %.y
?~ group-rid %.n &(watch-on-self =(our.bowl entity.rid))
?| !(is-managed:grp u.group-rid)
&(watch-on-self =(our.bowl entity.rid))
==
:: ::
++ handle-update ++ handle-update
|_ $: rid=resource :: input |_ $: rid=resource :: input
updates=(list node:graph-store) updates=(list node:graph-store)
group=resource mark=(unit mark)
module=term
hark-pokes=(list action:store) :: output hark-pokes=(list action:store) :: output
new-watches=(list index:graph-store) new-watches=(list index:graph-store)
== ==
++ update-core . ++ update-core .
:: ::
++ abed ++ abed
|= [r=resource upds=(list node:graph-store) grp=resource mod=term] |= [r=resource upds=(list node:graph-store)]
update-core(rid r, updates upds, group grp, module mod) =/ m=(unit ^mark)
(get-mark:gra r)
update-core(rid r, updates upds, mark m)
:: ::
++ get-conversion ++ get-conversion
(^get-conversion rid) :: 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 ++ abet
^- (quip card _state) ^- (quip card _state)
@ -417,30 +407,35 @@
|= =node:graph-store |= =node:graph-store
^+ update-core ^+ update-core
=. update-core (check-node-children node) =. update-core (check-node-children node)
?: ?=(%| -.post.node)
update-core
=* pos p.post.node
=+ !< notif-kind=(unit notif-kind:hook) =+ !< notif-kind=(unit notif-kind:hook)
(get-conversion !>([0 post.node])) %- get-conversion
!>(`indexed-post:graph-store`[0 pos])
?~ notif-kind ?~ notif-kind
update-core update-core
=/ desc=@t =/ desc=@t
?: (is-mention contents.post.node) ?: (is-mention contents.pos)
%mention %mention
name.u.notif-kind name.u.notif-kind
=* not-kind u.notif-kind =* not-kind u.notif-kind
=/ parent=index:post =/ parent=index:post
(scag parent.index-len.not-kind index.post.node) (scag parent.index-len.not-kind index.pos)
=/ notif-index=index:store =/ notif-index=index:store
[%graph group rid module desc parent] [%graph rid mark desc parent]
?: =(our.bowl author.post.node) ?: =(our.bowl author.pos)
(self-post node notif-index not-kind) (self-post node notif-index not-kind)
=. update-core =. update-core
(update-unread-count not-kind notif-index [time-sent index]:post.node) (update-unread-count not-kind notif-index [time-sent index]:pos)
=? update-core =? update-core
?| =(desc %mention) ?| =(desc %mention)
(~(has in watching) [rid parent]) (~(has in watching) [rid parent])
=(mark `%graph-validator-dm)
== ==
=/ =contents:store =/ =contents:store
[%graph (limo post.node ~)] [%graph (limo pos ~)]
(add-unread notif-index [time-sent.post.node %.n contents]) (add-unread notif-index [time-sent.pos %.n contents])
update-core update-core
:: ::
++ update-unread-count ++ update-unread-count
@ -459,19 +454,19 @@
=notif-kind:hook =notif-kind:hook
== ==
^+ update-core ^+ update-core
?> ?=(%& -.post.node)
=/ =stats-index:store =/ =stats-index:store
(to-stats-index:store index) (to-stats-index:store index)
=. update-core =. update-core
(hark %seen-index time-sent.post.node stats-index) (hark %seen-index time-sent.p.post.node stats-index)
=? update-core ?=(%count mode.notif-kind) =? update-core ?=(%count mode.notif-kind)
(hark %read-count stats-index) (hark %read-count stats-index)
=? update-core watch-on-self =? update-core watch-on-self
(new-watch index.post.node [watch-for index-len]:notif-kind) (new-watch index.p.post.node [watch-for index-len]:notif-kind)
update-core update-core
:: ::
++ add-unread ++ add-unread
|= [=index:store =notification:store] |= [=index:store =notification:store]
(hark %add-note index notification) (hark %add-note index notification)
::
-- --
-- --

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

@ -25,6 +25,7 @@
state-4 state-4
state-5 state-5
state-6 state-6
state-7
== ==
+$ unread-stats +$ unread-stats
[indices=(set index:graph-store) last=@da] [indices=(set index:graph-store) last=@da]
@ -32,6 +33,8 @@
+$ base-state +$ base-state
$: unreads-each=(jug stats-index:store index:graph-store) $: unreads-each=(jug stats-index:store index:graph-store)
unreads-count=(map stats-index:store @ud) unreads-count=(map stats-index:store @ud)
timeboxes=(map stats-index:store @da)
unread-notes=timebox:store
last-seen=(map stats-index:store @da) last-seen=(map stats-index:store @da)
=notifications:store =notifications:store
archive=notifications:store archive=notifications:store
@ -52,23 +55,16 @@
[%5 state-three:store] [%5 state-three:store]
:: ::
+$ state-6 +$ state-6
[%6 base-state] [%6 state-four:store]
::
+$ state-7
[%7 base-state]
:: ::
+$ inflated-state
$: state-6
cache
==
:: $cache: useful to have precalculated, but can be derived from state
:: albeit expensively
+$ cache
$: by-index=(jug stats-index:store [time=@da =index:store])
~
==
:: ::
++ orm ((ordered-map @da timebox:store) gth) ++ orm ((ordered-map @da timebox:store) gth)
-- --
:: ::
=| inflated-state =| state-7
=* state - =* state -
:: ::
=< =<
@ -87,26 +83,43 @@
:_ this :_ this
~[autoseen-timer] ~[autoseen-timer]
:: ::
++ on-save !>(-.state) ++ on-save !>(state)
++ on-load ++ on-load
|= =old=vase |= =old=vase
^- (quip card _this) ^- (quip card _this)
=/ old =/ old
!<(versioned-state old-vase) !<(versioned-state old-vase)
=| cards=(list card) =| cards=(list card)
|^ |^
^- (quip card _this)
?- -.old ?- -.old
%6 %7
:- (flop cards) :- (flop cards)
this(-.state old, +.state (inflate-cache:ha old)) this(state old)
::
%6
%_ $
-.old %7
:: ::
%5 +.old
%* . *base-state
notifications (notifications:to-five:upgrade:store notifications.old)
archive ~
unreads-each unreads-each.old
unreads-count unreads-count.old
last-seen last-seen.old
current-timebox current-timebox
dnd dnd.old
==
==
::
%5
%_ $ %_ $
-.old %6 -.old %6
notifications.old (convert-notifications-4 notifications.old) notifications.old (notifications:to-four:upgrade:store notifications.old)
archive.old (convert-notifications-4 archive.old) archive.old *notifications:state-four:store
== ==
:: ::
%4 %4
%_ $ %_ $
-.old %5 -.old %5
@ -115,14 +128,14 @@
%- ~(run by last-seen.old) %- ~(run by last-seen.old)
|=(old=@da (min old now.bowl)) |=(old=@da (min old now.bowl))
== ==
:: ::
%3 %3
%_ $ %_ $
-.old %4 -.old %4
notifications.old (convert-notifications-3 notifications.old) notifications.old (notifications:to-three:upgrade:store notifications.old)
archive.old (convert-notifications-3 archive.old) archive.old *notifications:state-three:store
== ==
:: ::
%2 %2
%_ $ %_ $
-.old %3 -.old %3
@ -131,7 +144,7 @@
:_ cards :_ cards
[%pass / %agent [our dap]:bowl %poke noun+!>(%fix-dangling)] [%pass / %agent [our dap]:bowl %poke noun+!>(%fix-dangling)]
== ==
:: ::
%1 %1
%_ $ %_ $
:: ::
@ -146,7 +159,7 @@
dnd dnd.old dnd dnd.old
== ==
== ==
:: ::
%0 %0
%_ $ %_ $
:: ::
@ -160,98 +173,6 @@
== ==
== ==
:: ::
++ convert-notifications-4
|= old=notifications:state-three:store
%+ gas:orm *notifications:store
^- (list [@da timebox:store])
%+ murn
(tap:orm:state-three:store old)
|= [time=@da =timebox:state-three:store]
^- (unit [@da timebox:store])
=/ new-timebox=timebox:store
(convert-timebox-4 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-4
|= =timebox:state-three:store
^- timebox:store
%- ~(gas by *timebox:store)
^- (list [index:store notification:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-three:store]
^- (unit [index:store notification:store])
=/ new-notification=(unit notification:store)
(convert-notification-4 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-4
|= =notification:state-three:store
^- (unit notification:store)
?: ?=(%group -.contents.notification)
`notification
=/ con=(list post:post)
(convert-graph-contents-4 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %graph con]
::
++ convert-graph-contents-4
|= con=(list post:post-zero:post)
^- (list post:post)
(turn con post-to-one:graph-store)
::
++ convert-notifications-3
|= old=notifications:state-two:store
%+ gas:orm:state-three:store *notifications:state-three:store
^- (list [@da timebox:state-three:store])
%+ murn
(tap:orm:state-two:store old)
|= [time=@da =timebox:state-two:store]
^- (unit [@da timebox:state-three:store])
=/ new-timebox=timebox:state-three:store
(convert-timebox-3 timebox)
?: =(0 ~(wyt by new-timebox))
~
`[time new-timebox]
::
++ convert-timebox-3
|= =timebox:state-two:store
^- timebox:state-three:store
%- ~(gas by *timebox:state-three:store)
^- (list [index:state-three:store notification:state-three:store])
%+ murn
~(tap by timebox)
|= [=index:store =notification:state-two:store]
^- (unit [index:store notification:state-three:store])
=/ new-notification=(unit notification:state-three:store)
(convert-notification-3 notification)
?~ new-notification ~
`[index u.new-notification]
::
++ convert-notification-3
|= =notification:state-two:store
^- (unit notification:state-three:store)
?: ?=(%graph -.contents.notification)
`notification
=/ con=(list group-contents:store)
(convert-group-contents-3 list.contents.notification)
?: =(~ con) ~
=, notification
`[date read %group con]
::
++ convert-group-contents-3
|= con=(list group-contents:state-two:store)
^- (list group-contents:store)
%+ murn con
|= =group-contents:state-two:store
^- (unit group-contents:store)
?. ?=(?(%add-members %remove-members) -.group-contents) ~
`group-contents
::
++ uni-by ++ uni-by
|= [a=(set index:graph-store) b=(set index:graph-store)] |= [a=(set index:graph-store) b=(set index:graph-store)]
=/ merged =/ merged
@ -291,12 +212,12 @@
|= =timebox:state-zero:store |= =timebox:state-zero:store
^- timebox:state-two:store ^- timebox:state-two:store
%- ~(gas by *timebox:state-two:store) %- ~(gas by *timebox:state-two:store)
^- (list [index:store notification:state-two:store]) ^- (list [index:state-two:store notification:state-two:store])
%+ murn %+ murn
~(tap by timebox) ~(tap by timebox)
|= [=index:state-zero:store =notification:state-zero:store] |= [=index:state-zero:store =notification:state-zero:store]
^- (unit [index:store notification:state-two:store]) ^- (unit [index:state-two:store notification:state-two:store])
=/ new-index=(unit index:store) =/ new-index=(unit index:state-two:store)
(convert-index-1 index) (convert-index-1 index)
=/ new-notification=(unit notification:state-two:store) =/ new-notification=(unit notification:state-two:store)
(convert-notification-1 notification) (convert-notification-1 notification)
@ -306,13 +227,13 @@
:: ::
++ convert-index-1 ++ convert-index-1
|= =index:state-zero:store |= =index:state-zero:store
^- (unit index:store) ^- (unit index:state-two:store)
?+ -.index `index ?+ -.index `index
%chat ~ %chat ~
:: ::
%graph %graph
=, index =, index
`[%graph group graph module description ~] `[%graph graph *resource module description ~]
== ==
:: ::
++ convert-notification-1 ++ convert-notification-1
@ -339,8 +260,14 @@
^- update:store ^- update:store
:- %more :- %more
^- (list update:store) ^- (list update:store)
:- give-unreads :~ give-unreads
[%set-dnd dnd]~ [%set-dnd dnd]
give-notifications
==
::
++ give-notifications
^- update:store
[%timebox ~ ~(tap by unread-notes)]
:: ::
++ give-since-unreads ++ give-since-unreads
^- (list [stats-index:store stats:store]) ^- (list [stats-index:store stats:store])
@ -348,7 +275,6 @@
~(tap by unreads-count) ~(tap by unreads-count)
|= [=stats-index:store count=@ud] |= [=stats-index:store count=@ud]
:* stats-index :* stats-index
(~(gut by by-index) stats-index ~)
[%count count] [%count count]
(~(gut by last-seen) stats-index *time) (~(gut by last-seen) stats-index *time)
== ==
@ -359,31 +285,16 @@
~(tap by unreads-each) ~(tap by unreads-each)
|= [=stats-index:store indices=(set index:graph-store)] |= [=stats-index:store indices=(set index:graph-store)]
:* stats-index :* stats-index
(~(gut by by-index) stats-index ~)
[%each indices] [%each indices]
(~(gut by last-seen) stats-index *time) (~(gut by last-seen) stats-index *time)
== ==
:: ::
++ give-group-unreads
^- (list [stats-index:store stats:store])
%+ murn ~(tap by by-index)
|= [=stats-index:store nots=(set [time index:store])]
?. ?=(%group -.stats-index)
~
:- ~
:* stats-index
nots
[%count 0]
*time
==
::
++ give-unreads ++ give-unreads
^- update:store ^- update:store
:- %unreads :- %unreads
;: weld ;: weld
give-each-unreads give-each-unreads
give-since-unreads give-since-unreads
give-group-unreads
== ==
-- --
:: ::
@ -409,8 +320,7 @@
?:(is-archive archive notifications) ?:(is-archive archive notifications)
|= [time=@da =timebox:store] |= [time=@da =timebox:store]
^- update:store ^- update:store
:^ %timebox time is-archive [%timebox `time ~(tap by timebox)]
~(tap by timebox)
== ==
:: ::
++ on-poke ++ on-poke
@ -471,9 +381,7 @@
^- (quip card _this) ^- (quip card _this)
?. ?=([%autoseen ~] wire) ?. ?=([%autoseen ~] wire)
(on-arvo:def wire sign-arvo) (on-arvo:def wire sign-arvo)
?> ?=([%behn %wake *] sign-arvo) `this
:_ this(current-timebox now.bowl)
~[autoseen-timer:ha]
:: ::
++ on-fail on-fail:def ++ on-fail on-fail:def
-- --
@ -512,7 +420,6 @@
%unread-each (unread-each +.in) %unread-each (unread-each +.in)
:: ::
%read-note (read-note +.in) %read-note (read-note +.in)
%unread-note (unread-note +.in)
:: ::
%seen-index (seen-index +.in) %seen-index (seen-index +.in)
%remove-graph (remove-graph +.in) %remove-graph (remove-graph +.in)
@ -525,13 +432,6 @@
:: +| %note :: +| %note
:: ::
:: notification tracking :: notification tracking
++ upd-cache
|= [read=? time=@da =index:store]
poke-core(+.state (^upd-cache read time index))
::
++ rebuild-cache
poke-core(+.state (inflate-cache -.state))
::
++ put-notifs ++ put-notifs
|= [time=@da =timebox:store] |= [time=@da =timebox:store]
poke-core(notifications (put:orm notifications time timebox)) poke-core(notifications (put:orm notifications time timebox))
@ -539,74 +439,60 @@
++ add-note ++ add-note
|= [=index:store =notification:store] |= [=index:store =notification:store]
^+ poke-core ^+ poke-core
=/ existing-notif
(~(get by unread-notes) index)
=/ new=notification:store
(merge-notification existing-notif notification)
=. unread-notes
(~(put by unread-notes) index new)
=/ timebox=@da
(~(gut by timeboxes) (to-stats-index:store index) current-timebox)
(give %added index new)
::
++ do-archive
|= [time=(unit @da) =index:store]
^+ poke-core
|^
?~(time archive-unread (archive-read u.time))
::
++ archive-unread
=. unread-notes
(~(del by unread-notes) index)
(give %archive ~ index)
::
++ archive-read
|= time=@da
=/ =timebox:store
(gut-orm notifications time)
=/ =notification:store
(~(got by timebox) index)
=/ new-timebox=timebox:store
(~(del by timebox) index)
=. poke-core
(put-notifs time new-timebox)
(give %archive `time index)
--
::
++ read-note
|= =index:store
=/ =notification:store
(~(got by unread-notes) index)
=. unread-notes
(~(del by unread-notes) index)
=/ =time
(~(gut by timeboxes) (to-stats-index:store index) current-timebox)
=/ =timebox:store =/ =timebox:store
(gut-orm notifications current-timebox) (gut-orm notifications time)
=/ existing-notif =/ existing-notif
(~(get by timebox) index) (~(get by timebox) index)
=/ new=notification:store =/ new=notification:store
(merge-notification existing-notif notification) (merge-notification existing-notif notification)
=/ new-read=? =. timebox
?~ existing-notif %.y
read.u.existing-notif
=/ new-timebox=timebox:store
(~(put by timebox) index new) (~(put by timebox) index new)
=. poke-core (put-notifs current-timebox new-timebox)
=? poke-core new-read
(upd-cache %.n current-timebox index)
(give %added current-timebox index new)
::
++ do-archive
|= [time=@da =index:store]
^+ poke-core
=/ =timebox:store
(gut-orm notifications time)
=/ =notification:store
(~(got by timebox) index)
=/ new-timebox=timebox:store
(~(del by timebox) index)
=? poke-core !read.notification
(upd-cache %.y time index)
=. poke-core
(put-notifs time new-timebox)
=. archive
%^ jub-orm archive time
|= archive-box=timebox:store
(~(put by archive-box) index notification(read %.y))
(give %archive time index)
::
:: if we detect cache inconsistencies, wipe and rebuild
++ change-read-status
|= [time=@da =index:store read=?]
^+ poke-core
=. poke-core (upd-cache read time index)
=/ tib=(unit timebox:store)
(get:orm notifications time)
?~ tib poke-core
=/ not=(unit notification:store)
(~(get by u.tib) index)
?~ not poke-core
=? poke-core
:: cache is inconsistent iff we didn't directly
:: call this through %read-note or %unread-note
&(=(read read.u.not) !?=(?(%read-note %unread-note) -.in))
~& >> "Inconsistent hark cache, rebuilding"
rebuild-cache
?< &(=(read read.u.not) ?=(?(%read-note %unread-note) -.in))
=. u.tib
(~(put by u.tib) index u.not(read read))
=. notifications =. notifications
(put:orm notifications time u.tib) (put:orm notifications time timebox)
poke-core (give %note-read time index)
:: ::
++ read-note
|= [time=@da =index:store]
%. [%read-note time index]
give:(change-read-status time index %.y)
::
++ unread-note
|= [time=@da =index:store]
%. [%unread-note time index]
give:(change-read-status time index %.n)
:: ::
:: +| %each :: +| %each
:: ::
@ -624,18 +510,18 @@
|= [=stats-index:store ref=index:graph-store] |= [=stats-index:store ref=index:graph-store]
%- read-indices %- read-indices
%+ skim %+ skim
~(tap ^in (~(get ju by-index) stats-index)) ~(tap ^in ~(key by unread-notes))
|= [time=@da =index:store] |= =index:store
=/ =timebox:store ?. (stats-index-is-index:store stats-index index) %.n
(gut-orm notifications time)
=/ not=notification:store =/ not=notification:store
(~(got by timebox) index) (~(got by unread-notes) index)
?. ?=(%graph -.index) %.n ?. ?=(%graph -.index) %.n
?. ?=(%graph -.contents.not) %.n ?. ?=(%graph -.contents.not) %.n
(lien list.contents.not |=(p=post:post =(index.p ref))) (lien list.contents.not |=(p=post:post =(index.p ref)))
:: ::
++ read-each ++ read-each
|= [=stats-index:store ref=index:graph-store] |= [=stats-index:store ref=index:graph-store]
=. timeboxes (~(put by timeboxes) stats-index now.bowl)
=. poke-core (read-index-each stats-index ref) =. poke-core (read-index-each stats-index ref)
%+ jub-unreads-each:(give %read-each stats-index ref) %+ jub-unreads-each:(give %read-each stats-index ref)
stats-index stats-index
@ -659,12 +545,13 @@
++ read-count ++ read-count
|= =stats-index:store |= =stats-index:store
=. unreads-count (~(put by unreads-count) stats-index 0) =. unreads-count (~(put by unreads-count) stats-index 0)
=/ times=(list [@da index:store]) =/ times=(list index:store)
~(tap ^in (~(get ju by-index) stats-index)) (unread-for-stats-index stats-index)
=? timeboxes !(~(has by timeboxes) stats-index) (~(put by timeboxes) stats-index now.bowl)
(give:(read-indices times) %read-count stats-index) (give:(read-indices times) %read-count stats-index)
:: ::
++ read-indices ++ read-indices
|= times=(list [time=@da =index:store]) |= times=(list =index:store)
|- |-
?~ times poke-core ?~ times poke-core
=/ core =/ core
@ -694,8 +581,6 @@
unreads-each indices unreads-each indices
=. last-seen =. last-seen
((dif-map-by-key ,@da) last-seen indices) ((dif-map-by-key ,@da) last-seen indices)
=. by-index
((dif-map-by-key ,(set [@da =index:store])) by-index indices)
poke-core poke-core
:: ::
++ get-stats-indices ++ get-stats-indices
@ -705,7 +590,6 @@
~(tap ^in ~(key by unreads-count)) ~(tap ^in ~(key by unreads-count))
~(tap ^in ~(key by last-seen)) ~(tap ^in ~(key by last-seen))
~(tap ^in ~(key by unreads-each)) ~(tap ^in ~(key by unreads-each))
~(tap ^in ~(key by by-index))
== ==
|= =stats-index:store |= =stats-index:store
?. ?=(%graph -.stats-index) %.n ?. ?=(%graph -.stats-index) %.n
@ -728,30 +612,35 @@
~(tap ^in set) ~(tap ^in set)
|- |-
?~ indices poke-core ?~ indices poke-core
=/ times=(list [time=@da =index:store]) =/ times=(list =index:store)
~(tap ^in (~(get ju by-index) i.indices)) (unread-for-stats-index i.indices)
=. poke-core =. poke-core
(read-indices times) (read-indices times)
$(indices t.indices) $(indices t.indices)
-- --
:: ::
++ seen ++ seen
=> (emit cancel-autoseen) =. poke-core
=> (emit autoseen-timer) (read-indices ~(tap ^in ~(key by unread-notes)))
poke-core(current-timebox now.bowl) poke-core(current-timebox now.bowl, timeboxes ~)
:: ::
++ read-all ++ read-all
=: unreads-count (~(run by unreads-count) _0) =: unreads-count (~(run by unreads-count) _0)
unreads-each (~(run by unreads-each) _~) unreads-each (~(run by unreads-each) _~)
notifications (~(run by notifications) _~) notifications (~(run by notifications) _~)
== ==
(give:seen:rebuild-cache %read-all ~) (give:seen %read-all ~)
:: ::
++ set-dnd ++ set-dnd
|= d=? |= d=?
(give:poke-core(dnd d) %set-dnd d) (give:poke-core(dnd d) %set-dnd d)
-- --
:: ::
++ unread-for-stats-index
|= =stats-index:store
%+ skim ~(tap in ~(key by unread-notes))
(cury stats-index-is-index:store stats-index)
::
++ merge-notification ++ merge-notification
|= [existing=(unit notification:store) new=notification:store] |= [existing=(unit notification:store) new=notification:store]
^- notification:store ^- notification:store
@ -760,11 +649,11 @@
:: ::
%graph %graph
?> ?=(%graph -.contents.new) ?> ?=(%graph -.contents.new)
u.existing(read %.n, list.contents (weld list.contents.u.existing list.contents.new)) u.existing(list.contents (weld list.contents.u.existing list.contents.new))
:: ::
%group %group
?> ?=(%group -.contents.new) ?> ?=(%group -.contents.new)
u.existing(read %.n, list.contents (weld list.contents.u.existing list.contents.new)) u.existing(list.contents (weld list.contents.u.existing list.contents.new))
== ==
:: ::
:: +key-orm: +key:by for ordered maps :: +key-orm: +key:by for ordered maps
@ -818,38 +707,4 @@
^- (list [@da timebox:store]) ^- (list [@da timebox:store])
%+ skim (tap:orm notifications) %+ skim (tap:orm notifications)
|=([@da =timebox:store] !=(~(wyt by timebox) 0)) |=([@da =timebox:store] !=(~(wyt by timebox) 0))
::
++ upd-cache
|= [read=? time=@da =index:store]
^+ +.state
%_ +.state
::
by-index
%. [(to-stats-index:store index) time index]
?: read
~(del ju by-index)
~(put ju by-index)
==
::
++ inflate-cache
|= state-6
^+ +.state
=. +.state
*cache
=/ nots=(list [p=@da =timebox:store])
(tap:orm notifications)
|- =* outer $
?~ nots +.state
=/ unreads ~(tap by timebox.i.nots)
|- =* inner $
?~ unreads
outer(nots t.nots)
=* notification q.i.unreads
=* index p.i.unreads
?: read.notification
inner(unreads t.unreads)
=. +.state
(upd-cache %.n p.i.nots index)
inner(unreads t.unreads)
-- --

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

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

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

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

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

@ -13,16 +13,23 @@
[%4 state-zero] [%4 state-zero]
[%5 state-zero] [%5 state-zero]
[%6 state-zero] [%6 state-zero]
[%7 state-7]
== ==
:: ::
+$ state-zero +$ state-zero
$: tiles=tiles-0:store
=tile-ordering:store
first-time=?
==
::
+$ state-7
$: =tiles:store $: =tiles:store
=tile-ordering:store =tile-ordering:store
first-time=? first-time=?
== ==
-- --
:: ::
=| [%6 state-zero] =| [%7 state-7]
=* state - =* state -
%- agent:dbug %- agent:dbug
^- agent:gall ^- agent:gall
@ -32,7 +39,7 @@
:: ::
++ on-init ++ on-init
^- (quip card _this) ^- (quip card _this)
=/ new-state *state-zero =/ new-state *state-7
=. new-state =. new-state
%_ new-state %_ new-state
tiles tiles
@ -41,12 +48,12 @@
|= =term |= =term
:- term :- term
^- tile:store ^- tile:store
?+ term [[%custom ~] %.y] ?+ term [[%custom ~ ~] %.y]
%term [[%basic 'Terminal' '/~landscape/img/term.png' '/~term'] %.y] %term [[%basic 'Terminal' '/~landscape/img/term.png' '/~term'] %.y]
== ==
tile-ordering [%weather %clock %term ~] tile-ordering [%weather %clock %term ~]
== ==
[~ this(state [%6 new-state])] [~ this(state [%7 new-state])]
:: ::
++ on-save !>(state) ++ on-save !>(state)
++ on-load ++ on-load
@ -55,8 +62,22 @@
=/ old-state !<(versioned-state old) =/ old-state !<(versioned-state old)
=| cards=(list card) =| cards=(list card)
|- ^- (quip card _this) |- ^- (quip card _this)
?: ?=(%6 -.old-state) ?: ?=(%7 -.old-state)
[cards this(state old-state)] [cards this(state old-state)]
::
?: ?=(%6 -.old-state)
=/ new-tiles=tiles:store
%- ~(gas by *tiles:store)
%+ turn ~(tap by tiles.old-state)
|= [=term =tile-0:store]
:- term
:_ is-shown.tile-0
?- -.type.tile-0
%basic type.tile-0
%custom [%custom ~ ~]
==
$(old-state [%7 new-tiles tile-ordering.old-state first-time.old-state])
::
?: ?=(%5 -.old-state) ?: ?=(%5 -.old-state)
:: replace %dojo with %term :: replace %dojo with %term
:: ::
@ -86,11 +107,11 @@
=. new-state =. new-state
%_ new-state %_ new-state
tiles tiles
%- ~(gas by *tiles:store) %- ~(gas by *tiles-0:store)
%+ turn `(list term)`[%weather %clock %dojo ~] %+ turn `(list term)`[%weather %clock %dojo ~]
|= =term |= =term
:- term :- term
^- tile:store ^- tile-0:store
?+ term [[%custom ~] %.y] ?+ term [[%custom ~] %.y]
%dojo [[%basic 'Dojo' '/~landscape/img/Dojo.png' '/~dojo'] %.y] %dojo [[%basic 'Dojo' '/~landscape/img/Dojo.png' '/~dojo'] %.y]
== ==
@ -191,9 +212,14 @@
^- (unit (unit cage)) ^- (unit (unit cage))
?. (team:title our.bowl src.bowl) ~ ?. (team:title our.bowl src.bowl) ~
?+ path [~ ~] ?+ path [~ ~]
[%x %tiles ~] ``noun+!>([tiles tile-ordering]) [%x %tiles ~] ``noun+!>([tiles tile-ordering])
[%x %first-time ~] ``noun+!>(first-time) [%x %first-time ~] ``noun+!>(first-time)
[%x %keys ~] ``noun+!>(~(key by tiles)) [%x %keys ~] ``noun+!>(~(key by tiles))
::
[%x %runtime-lag ~]
:^ ~ ~ %json
!> ^- json
b+.^(? //(scot %p our.bowl)//(scot %da now.bowl)/zen/lag)
== ==
:: ::
++ on-arvo ++ on-arvo

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

@ -1,5 +1,5 @@
/- lens, *sole /- lens, *sole
/+ *server, default-agent /+ *server, default-agent, dbug
/= lens-mark /mar/lens/command :: TODO: ask clay to build a $tube /= lens-mark /mar/lens/command :: TODO: ask clay to build a $tube
=, format =, format
|% |%
@ -35,6 +35,8 @@
-- --
:: ::
=| =state =| =state
%- agent:dbug
^- agent:gall
|_ =bowl:gall |_ =bowl:gall
+* this . +* this .
def ~(. (default-agent this %|) bowl) def ~(. (default-agent this %|) bowl)
@ -56,8 +58,6 @@
?. ?=(%handle-http-request mark) ?. ?=(%handle-http-request mark)
(on-poke:def mark vase) (on-poke:def mark vase)
=+ !<([eyre-id=@ta =inbound-request:eyre] vase) =+ !<([eyre-id=@ta =inbound-request:eyre] vase)
?> ?=(~ job.state)
::
=/ request-line (parse-request-line url.request.inbound-request) =/ request-line (parse-request-line url.request.inbound-request)
=/ site (flop site.request-line) =/ site (flop site.request-line)
:: ::
@ -76,6 +76,13 @@
=/ com=command:lens =/ com=command:lens
(json:grab:lens-mark jon) (json:grab:lens-mark jon)
:: ::
?: ?=(%cancel -.source.com)
~& %lens-cancel
:_ this(job.state ~)
(give-simple-payload:app eyre-id (json-response:gen [%s 'cancelled']))
::
?> ?=(~ job.state)
::
?+ -.source.com ?+ -.source.com
:_ this(job.state (some [eyre-id com])) :_ this(job.state (some [eyre-id com]))
[%pass /sole %agent [our.bowl %dojo] %watch /sole/[eyre-id]]~ [%pass /sole %agent [our.bowl %dojo] %watch /sole/[eyre-id]]~

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

@ -2,7 +2,7 @@
:: ::
/- *group, *invite-store, store=metadata-store /- *group, *invite-store, store=metadata-store
/+ default-agent, verb, dbug, grpl=group, push-hook, /+ default-agent, verb, dbug, grpl=group, push-hook,
resource, mdl=metadata, gral=graph resource, mdl=metadata, gral=graph, agentio
~% %group-hook-top ..part ~ ~% %group-hook-top ..part ~
|% |%
+$ card card:agent:gall +$ card card:agent:gall
@ -18,9 +18,19 @@
== ==
:: ::
+$ agent (push-hook:push-hook config) +$ agent (push-hook:push-hook config)
::
+$ state-null ~
+$ state-zero [%0 ~]
::
+$ versioned-state
$% state-null
state-zero
==
-- --
:: ::
:: ::
=| state-zero
=* state -
%- agent:dbug %- agent:dbug
%+ verb | %+ verb |
^- agent:gall ^- agent:gall
@ -32,23 +42,45 @@
grp ~(. grpl bowl) grp ~(. grpl bowl)
met ~(. mdl bowl) met ~(. mdl bowl)
gra ~(. gral bowl) gra ~(. gral bowl)
io ~(. agentio bowl)
pass pass:io
:: ::
++ on-init on-init:def ++ on-init on-init:def
++ on-save !>(~) ++ on-save !>(~)
++ on-load on-load:def ++ on-load on-load:def
::
++ on-poke ++ on-poke
|= [=mark =vase] |= [=mark =vase]
?. ?=(%metadata-hook-update mark) |^ ^- (quip card _this)
(on-poke:def mark vase) ?+ mark (on-poke:def mark vase)
=+ !<(=hook-update:store vase) %metadata-hook-update metadata-hook-update
?. ?=(%req-preview -.hook-update) %noun noun
(on-poke:def mark vase) ==
?> =(entity.group.hook-update our.bowl) ::
=/ =group-preview:store ++ metadata-hook-update
(get-preview:met group.hook-update) =+ !<(=hook-update:store vase)
:_ this ?. ?=(%req-preview -.hook-update)
=- [%pass / %agent [src.bowl %metadata-pull-hook] %poke -]~ (on-poke:def mark vase)
metadata-hook-update+!>(`hook-update:store`[%preview group-preview]) ?> =(entity.group.hook-update our.bowl)
=/ =group-preview:store
(get-preview:met group.hook-update)
:_ this
=- [%pass / %agent [src.bowl %metadata-pull-hook] %poke -]~
metadata-hook-update+!>(`hook-update:store`[%preview group-preview])
::
++ noun
?+ q.vase ~|("unknown noun poke" !!)
::
%clean-dm
=+ .^(sharing=(set resource) (scry:io %gx dap.bowl /sharing/noun))
:_ this
%+ murn ~(tap in sharing)
|= rid=resource
^- (unit card)
?@ (rush name.rid ;~(pfix (jest 'dm--') fed:ag)) ~
`(poke-self:pass push-hook-action+!>([%remove rid]))
==
--
:: ::
++ on-agent on-agent:def ++ on-agent on-agent:def
++ on-watch on-watch:def ++ on-watch on-watch:def
@ -59,8 +91,9 @@
:: ::
++ transform-proxy-update ++ transform-proxy-update
|= vas=vase |= vas=vase
^- (unit vase) ^- (quip card (unit vase))
=/ =update:store !<(update:store vas) =/ =update:store !<(update:store vas)
:- ~
?. ?=(?(%add %remove) -.update) ?. ?=(?(%add %remove) -.update)
~ ~
=/ role=(unit (unit role-tag)) =/ role=(unit (unit role-tag))

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

@ -106,6 +106,7 @@
+$ state-8 [%8 base-state-3] +$ state-8 [%8 base-state-3]
+$ state-9 [%9 base-state-3] +$ state-9 [%9 base-state-3]
+$ state-10 [%10 base-state-3] +$ state-10 [%10 base-state-3]
+$ state-11 [%11 base-state-3]
+$ versioned-state +$ versioned-state
$% state-0 $% state-0
state-1 state-1
@ -118,10 +119,11 @@
state-8 state-8
state-9 state-9
state-10 state-10
state-11
== ==
:: ::
+$ inflated-state +$ inflated-state
$: state-10 $: state-11
cached-indices cached-indices
== ==
-- --
@ -198,22 +200,21 @@
[%x %associations ~] ``noun+!>(associations) [%x %associations ~] ``noun+!>(associations)
[%x %app-name @ ~] [%x %app-name @ ~]
=/ =app-name:store i.t.t.path =/ =app-name:store i.t.t.path
``noun+!>((metadata-for-app:mc app-name)) ``noun+!>(`associations:store`(metadata-for-app:mc app-name))
:: ::
[%x %group *] [%x %group *]
=/ group=resource (de-path:resource t.t.path) =/ group=resource (de-path:resource t.t.path)
``noun+!>((metadata-for-group:mc group)) ``noun+!>(`associations:store`(metadata-for-group:mc group))
:: ::
[%x %metadata @ @ @ @ ~] [%x %metadata @ @ @ @ ~]
=/ =md-resource:store =/ =md-resource:store
[i.t.t.path (de-path:resource t.t.t.path)] [i.t.t.path (de-path:resource t.t.t.path)]
``noun+!>((~(get by associations) md-resource)) ``noun+!>(`(unit association:store)`(~(get by associations) md-resource))
:: ::
[%x %resource @ *] [%x %resource @ *]
=/ app=term i.t.t.path =/ app=term i.t.t.path
=/ rid=resource (de-path:resource t.t.t.path) =/ rid=resource (de-path:resource t.t.t.path)
``noun+!>((~(get by resource-indices) [app rid])) ``noun+!>(`(unit resource)`(~(get by resource-indices) [app rid]))
:: ::
[%x %export ~] [%x %export ~]
``noun+!>(-.state) ``noun+!>(-.state)
@ -234,7 +235,7 @@
=| cards=(list card) =| cards=(list card)
|^ |^
=* loop $ =* loop $
?: ?=(%10 -.old) ?: ?=(%11 -.old)
:- cards :- cards
%_ state %_ state
associations associations.old associations associations.old
@ -242,6 +243,8 @@
group-indices (rebuild-group-indices associations.old) group-indices (rebuild-group-indices associations.old)
app-indices (rebuild-app-indices associations.old) app-indices (rebuild-app-indices associations.old)
== ==
?: ?=(%10 -.old)
$(-.old %11, associations.old (hide-dm-assoc associations.old))
?: ?=(%9 -.old) ?: ?=(%9 -.old)
=/ groups =/ groups
(fall (~(get by (rebuild-app-indices associations.old)) %groups) ~) (fall (~(get by (rebuild-app-indices associations.old)) %groups) ~)
@ -282,6 +285,20 @@
:: pre-breach, can safely throw away :: pre-breach, can safely throw away
loop(old *state-8) loop(old *state-8)
:: ::
++ hide-dm-assoc
|= 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
?& ?=(^ (rush name.resource.m ;~(pfix (jest 'dm--') fed:ag)))
?=(%graph app-name.m)
==
%.y
[m [g met]]
::
++ associations-2-to-3 ++ associations-2-to-3
|= assoc=associations-2 |= assoc=associations-2
^- associations:store ^- associations:store
@ -483,7 +500,7 @@
:: ::
++ metadata-for-app ++ metadata-for-app
|= =app-name:store |= =app-name:store
^+ associations ^- associations:store
%+ roll ~(tap in (~(gut by app-indices) app-name ~)) %+ roll ~(tap in (~(gut by app-indices) app-name ~))
|= [[group=resource rid=resource] out=associations:store] |= [[group=resource rid=resource] out=associations:store]
=/ =md-resource:store =/ =md-resource:store
@ -494,6 +511,7 @@
:: ::
++ metadata-for-group ++ metadata-for-group
|= group=resource |= group=resource
^- associations:store
=/ resources=(set md-resource:store) =/ resources=(set md-resource:store)
(~(get ju group-indices) group) (~(get ju group-indices) group)
%+ roll %+ roll

13
pkg/arvo/gen/btc-provider/action.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Sends a raw RPC action to the BTC Provider
::
:: Commands:
::
::
::
/- *btc-provider
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[act=action ~] ~]
==
[%btc-provider-action act]

13
pkg/arvo/gen/btc-provider/command.hoon Normal file
View File

@ -0,0 +1,13 @@
:: Sends a command to the BTC Provider
::
:: Commands:
::
::
::
/- *btc-provider
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[comm=command ~] ~]
==
[%btc-provider-command comm]

5
pkg/arvo/gen/btc-wallet-check.hoon Normal file
View File

@ -0,0 +1,5 @@
:- %say
|= [[now=time * bec=beak] ~ ~]
:- %noun
:- %btc-wallet-hash
.^(@uv %gx (en-beam bec(q %glob) /btc-wallet/noun))

9
pkg/arvo/gen/btc-wallet/action.hoon Normal file
View File

@ -0,0 +1,9 @@
:: Sends an action to btc-wallet
::
/- *btc-wallet
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[act=action ~] ~]
==
[%btc-wallet-action act]

9
pkg/arvo/gen/btc-wallet/command.hoon Normal file
View File

@ -0,0 +1,9 @@
:: Sends a command to btc-wallet
::
/- *btc-wallet
::
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[comm=command ~] ~]
==
[%btc-wallet-command comm]

21
pkg/arvo/gen/dm-hook/dm.hoon Normal file
View File

@ -0,0 +1,21 @@
:: dm-hook|dm: DM somebody
::
/- *graph-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[him=ship contents=(list content) ~] ~]
==
=* our p.beak
=/ =post *post
=: author.post our
index.post ~[him now]
time-sent.post now
contents.post contents
==
::
:- %graph-update-2
^- update
:- now
:+ %add-nodes [our %dm-inbox]
%- ~(gas by *(map index node))
~[[~[him now] [%&^post [%empty ~]]]]

4
pkg/arvo/gen/glob/make.hoon
View File

@ -1,3 +1,3 @@
:- %say :- %say
|= * |= [^ [=path ~] ~]
[%glob-make ~] [%glob-make path]

2
pkg/arvo/gen/graph-store/add-graph.hoon
View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=resource mark=(unit mark) overwrite=? ~] ~] [[=resource mark=(unit mark) overwrite=? ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%add-graph resource (gas:orm ~ ~) mark overwrite]] [now [%add-graph resource (gas:orm ~ ~) mark overwrite]]

4
pkg/arvo/gen/graph-store/add-post.hoon
View File

@ -12,9 +12,9 @@
contents.post contents contents.post contents
== ==
:: ::
:- %graph-update-1 :- %graph-update-2
^- update ^- update
:- now :- now
:+ %add-nodes [our name] :+ %add-nodes [our name]
%- ~(gas by *(map index node)) %- ~(gas by *(map index node))
~[[[now]~ [post [%empty ~]]]] ~[[[now]~ [[%& post] [%empty ~]]]]

2
pkg/arvo/gen/graph-store/add-signatures.hoon
View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[[=resource =index] =signatures ~] ~] [[[=resource =index] =signatures ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%add-signatures [resource index] signatures]] [now [%add-signatures [resource index] signatures]]

6
pkg/arvo/gen/graph-store/add-tag.hoon
View File

@ -3,8 +3,8 @@
/- *graph-store /- *graph-store
:- %say :- %say
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~] [[=term =uid ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%add-tag term resource]] [now [%add-tag term uid]]

2
pkg/arvo/gen/graph-store/archive-graph.hoon
View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~] [[=resource ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%archive-graph resource]] [now [%archive-graph resource]]

2
pkg/arvo/gen/graph-store/export-graph.hoon
View File

@ -4,7 +4,7 @@
|= $: [now=@da eny=@uvJ bec=beak] |= $: [now=@da eny=@uvJ bec=beak]
[[=ship graph=term ~] ~] [[=ship graph=term ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
=/ our (scot %p p.bec) =/ our (scot %p p.bec)
=/ wen (scot %da now) =/ wen (scot %da now)
=/ who (scot %p ship) =/ who (scot %p ship)

2
pkg/arvo/gen/graph-store/import-graph.hoon
View File

@ -4,6 +4,6 @@
|= $: [now=@da eny=@uvJ bec=beak] |= $: [now=@da eny=@uvJ bec=beak]
[[graph=term =path ~] ~] [[graph=term =path ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
=- ~& update=- - =- ~& update=- -
.^(=update:graph-store %cx path) .^(=update:graph-store %cx path)

2
pkg/arvo/gen/graph-store/remove-graph.hoon
View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~] [[=resource ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%remove-graph resource]] [now [%remove-graph resource]]

6
pkg/arvo/gen/graph-store/remove-nodes.hoon → pkg/arvo/gen/graph-store/remove-posts.hoon
View File

@ -1,10 +1,10 @@
:: graph-store|remove-nodes: remove nodes from a graph at indices :: graph-store|remove-posts: remove nodes from a graph at indices
:: ::
/- *graph-store /- *graph-store
:- %say :- %say
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=resource indices=(set index) ~] ~] [[=resource indices=(set index) ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%remove-nodes resource indices]] [now [%remove-posts resource indices]]

2
pkg/arvo/gen/graph-store/remove-signatures.hoon
View File

@ -6,6 +6,6 @@
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[[=resource =index] =signatures ~] ~] [[[=resource =index] =signatures ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%remove-signatures [resource index] signatures]] [now [%remove-signatures [resource index] signatures]]

6
pkg/arvo/gen/graph-store/remove-tag.hoon
View File

@ -3,8 +3,8 @@
/- *graph-store /- *graph-store
:- %say :- %say
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=term =resource ~] ~] [[=term =uid ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%remove-tag term resource]] [now [%remove-tag term uid]]

2
pkg/arvo/gen/graph-store/unarchive-graph.hoon
View File

@ -5,6 +5,6 @@
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=resource ~] ~] [[=resource ~] ~]
== ==
:- %graph-update-1 :- %graph-update-2
^- update ^- update
[now [%unarchive-graph resource]] [now [%unarchive-graph resource]]

35
pkg/arvo/gen/hood/code.hoon
View File

@ -3,15 +3,14 @@
:::: /hoon/code/hood/gen :::: /hoon/code/hood/gen
:: ::
/? 310 /? 310
:: /- *sole
:::: /+ *generators
:: :- %ask
:- %say
|= $: [now=@da eny=@uvJ bec=beak] |= $: [now=@da eny=@uvJ bec=beak]
[arg=?(~ [%reset ~]) ~] [arg=?(~ [%reset ~]) ~]
== ==
=* our p.bec =* our p.bec
:- %helm-code ^- (sole-result [%helm-code ?(~ %reset)])
?~ arg ?~ arg
=/ code=tape =/ code=tape
%+ slag 1 %+ slag 1
@ -20,11 +19,23 @@
=/ step=tape =/ step=tape
%+ scow %ud %+ scow %ud
.^(@ud %j /(scot %p our)/step/(scot %da now)/(scot %p our)) .^(@ud %j /(scot %p our)/step/(scot %da now)/(scot %p our))
%- %- slog ::
:~ [%leaf code] %+ print 'use |code %reset to invalidate this and generate a new code'
[%leaf (weld "current step=" step)] %+ print leaf+(weld "current step=" step)
[%leaf "use |code %reset to invalidate this and generate a new code"] %+ print leaf+code
== (produce [%helm-code ~])
~ ::
?> =(%reset -.arg) ?> =(%reset -.arg)
%reset %+ print 'continue?'
%+ print 'warning: resetting your code closes all web sessions'
%+ prompt
[%& %project "y/n: "]
%+ parse
;~ pose
(cold %.y (mask "yY"))
(cold %.n (mask "nN"))
==
|= reset=?
?. reset
no-product
(produce [%helm-code %reset])

15
pkg/arvo/gen/hood/fuse.hoon Normal file
View File

@ -0,0 +1,15 @@
:: Kiln: Fuse local desk from (optionally-)foreign sources
::
:::: /hoon/fuse/hood/gen
::
/* help-text %txt /gen/hood/fuse/help/txt
=, clay
::
::::
::
:- %say
|= [[now=@da eny=@uvJ bec=beak] [arg=[?(~ [des=desk bas=beak con=(list [beak germ]) ~])]] ~]
:- %kiln-fuse
?~ arg
((slog (turn `wain`help-text |=(=@t leaf+(trip t)))) ~)
[des bas con]:arg

8
pkg/arvo/gen/hood/fuse/help.txt Normal file
View File

@ -0,0 +1,8 @@
Usage:
|fuse %destination-desk base-beak ~[[source-beak %some-germ] [another-beak %another-germ]]
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.

7
pkg/arvo/gen/kick.hoon Normal file
View File

@ -0,0 +1,7 @@
:: Kick subs
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
~
~
==
[%kick %kick]

15
pkg/arvo/gen/tally.hoon
View File

@ -1,5 +1,5 @@
/- gr=group, md=metadata-store, ga=graph-store /- gr=group, md=metadata-store, ga=graph-store
/+ re=resource /+ re=resource, graph=graph-store
!: !:
:- %say :- %say
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
@ -67,7 +67,7 @@
=/ real=(set resource:re) =/ real=(set resource:re)
=/ upd=update:ga =/ upd=update:ga
%+ scry update:ga %+ scry update:ga
[%x %graph-store /keys/graph-update-1] [%x %graph-store /keys/graph-update-2]
?> ?=(%keys -.q.upd) ?> ?=(%keys -.q.upd)
resources.q.upd resources.q.upd
:: count activity per channel :: count activity per channel
@ -86,14 +86,17 @@
%+ scry update:ga %+ scry update:ga
[%x %graph-store /graph/(scot %p entity.r)/[name.r]/noun] [%x %graph-store /graph/(scot %p entity.r)/[name.r]/noun]
?> ?=(%add-graph -.q.upd) ?> ?=(%add-graph -.q.upd)
=/ mo ((ordered-map atom node:ga) gth) =* mo orm:graph
=/ week=(list [@da node:ga]) =/ week=(list [@da node:ga])
(tap:mo (subset:mo graph.q.upd ~ `(sub now ~d7))) (tap:mo (lot:mo graph.q.upd ~ `(sub now ~d7)))
:- (lent week) :- (lent week)
%~ wyt in %~ wyt in
%+ roll week %+ roll week
|= [[* [author=ship *] *] a=(set ship)] |= [[* mp=maybe-post:ga *] a=(set ship)]
(~(put in a) author) ?- -.mp
%| a
%& (~(put in a) author.p.mp)
==
:: render results :: render results
:: ::
:- (tac 'the date is ' (scot %da now)) :- (tac 'the date is ' (scot %da now))

12
pkg/arvo/gen/trouble.hoon
View File

@ -9,6 +9,7 @@
:: children :: children
:: glob-hash: hash of the glob, which is the js for landscape :: glob-hash: hash of the glob, which is the js for landscape
:: ::
/- glob
/+ version /+ version
:- %say :- %say
|= [[now=time * bec=beak] ~ ~] |= [[now=time * bec=beak] ~ ~]
@ -65,8 +66,11 @@
.^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass)) .^(@uv %cz /[parent]/[desk.u.ota]/(scot %ud ud.cass))
:: ::
++ glob-state ++ glob-state
^- [@uv @tas] ^- (list [path @uv @tas])
=< [hash ?~(glob %waiting ?:(-.u.glob %done %trying))] =+ !< [@ud =globs:glob]
!< [@ud hash=@uv glob=(unit [? *])] .^(vase %gx (weld (pathify ~.glob ~) /dbug/state/noun))
.^(vase %gx (weld (pathify ~.glob ~) /dbug/state/noun)) %+ turn ~(tap by globs)
|= [srv=path hash=@uv glob=(unit [? *])]
^- [path @uv @tas]
[srv hash ?~(glob %waiting ?:(-.u.glob %done %trying))]
-- --

533
pkg/arvo/lib/azimuth-rpc.hoon
View File

@ -1,7 +1,7 @@
:: azimuth-rpc: command parsing and utilities :: azimuth-rpc: command parsing and utilities
:: ::
/- rpc=json-rpc /- rpc=json-rpc, *dice
/+ naive /+ naive, json-rpc, lib=naive-transactions
:: ::
=> :: Utilities => :: Utilities
:: ::
@ -19,32 +19,54 @@
%set-spawn-proxy %set-spawn-proxy
%set-transfer-proxy %set-transfer-proxy
== ==
:: FIXME: import tx-status, pend-tx from aggregator
:: ::
+$ tx-status ++ parse-ship
$: status=?(%unknown %pending %sent %confirmed %failed) |= jon=json
tx=(unit @ux) ^- (unit @p)
== ?: ?=([%n *] jon)
:: (rush p.jon dem)
+$ pend-tx [force=? =raw-tx:naive] ?. ?=([%s *] jon) ~
(rush p.jon ;~(pfix sig fed:ag))
:: TODO: from /lib/group-store (move to zuse?)
++ enkebab
|= str=cord
^- @tas
~| str
=- (fall - str)
%+ rush str
=/ name
%+ cook
|= part=tape
^- tape
?~ part part
:- (add i.part 32)
t.part
;~(plug hig (star low))
%+ cook
|=(a=(list tape) (crip (zing (join "-" a))))
;~(plug (star low) (star name))
:: ::
++ from-json ++ from-json
=, dejs-soft:format
|% |%
++ keys
|= params=(map @t json)
^- (unit [encrypt=@ auth=@ crypto-suite=@ breach=?])
?~ data=(~(get by params) 'data') ~
%. u.data
=, dejs-soft:format
%- ot
:~ ['encrypt' so]
['auth' so]
['crypto-suite' so]
['breach' bo]
==
::
++ data ++ data
|% |%
++ keys
|= params=(map @t json)
^- (unit [encrypt=@ auth=@ crypto-suite=@ breach=?])
?~ data=(~(get by params) 'data') ~
=; ans=(unit [cryp=(unit @ux) auth=(unit @ux) suit=@ brec=?])
?~ ans ~
?: |(?=(~ cryp.u.ans) ?=(~ auth.u.ans)) ~
(some [u.cryp.u.ans u.auth.u.ans suit.u.ans brec.u.ans])
%. u.data
%- ot
:~ ['encrypt' (cu to-hex so)]
['auth' (cu to-hex so)]
['cryptoSuite' no]
['breach' bo]
==
::
++ address-transfer ++ address-transfer
|= params=(map @t json) |= params=(map @t json)
^- (unit [@ux ?]) ^- (unit [@ux ?])
@ -54,7 +76,6 @@
?~ add.u.ans ~ ?~ add.u.ans ~
(some [u.add.u.ans r.u.ans]) (some [u.add.u.ans r.u.ans])
%. u.data %. u.data
=, dejs-soft:format
%- ot %- ot
~[['address' (cu to-hex so)] ['reset' bo]] ~[['address' (cu to-hex so)] ['reset' bo]]
:: ::
@ -67,9 +88,8 @@
?~ add.u.ans ~ ?~ add.u.ans ~
(some [ship.u.ans u.add.u.ans]) (some [ship.u.ans u.add.u.ans])
%. u.data %. u.data
=, dejs-soft:format
%- ot %- ot
:~ ['ship' (su ;~(pfix sig fed:ag))] :~ ['ship' parse-ship]
['address' (cu to-hex so)] ['address' (cu to-hex so)]
== ==
:: ::
@ -79,7 +99,6 @@
?~ data=(~(get by params) 'data') ~ ?~ data=(~(get by params) 'data') ~
=; ans=(unit (unit @ux)) =; ans=(unit (unit @ux))
?~(ans ~ u.ans) ?~(ans ~ u.ans)
=, dejs-soft:format
%. u.data %. u.data
(ot ['address' (cu to-hex so)]~) (ot ['address' (cu to-hex so)]~)
:: ::
@ -87,90 +106,106 @@
|= params=(map @t json) |= params=(map @t json)
^- (unit @p) ^- (unit @p)
?~ data=(~(get by params) 'data') ~ ?~ data=(~(get by params) 'data') ~
=, dejs-soft:format
%. u.data %. u.data
(ot ['ship' (su ;~(pfix sig fed:ag))]~) (ot ['ship' parse-ship]~)
::
++ cancel
|= params=(map @t json)
^- (unit [l2-tx @p])
?~ data=(~(get by params) 'data') ~
%. u.data
%- ot
:~ ['type' (cu l2-tx so)]
['ship' parse-ship]
==
-- --
:: ::
++ ship ++ ship
|= params=(map @t json) |= params=(map @t json)
^- (unit @p) ^- (unit @p)
?~ data=(~(get by params) 'ship') ~ ?~ data=(~(get by params) 'ship') ~
=, dejs-soft:format (parse-ship u.data)
%. u.data
(su ;~(pfix sig fed:ag))
:: ::
++ address ++ address
|= params=(map @t json) |= params=(map @t json)
^- (unit @ux) ^- (unit @ux)
?~ data=(~(get by params) 'address') ~ ?~ data=(~(get by params) 'address') ~
=; ans=(unit (unit @ux)) ?~ ans=((cu to-hex so) u.data) ~
?~(ans ~ u.ans) u.ans
=, dejs-soft:format
((cu to-hex so) u.data)
:: ::
++ sig ++ sig
|= params=(map @t json) |= params=(map @t json)
^- (unit @) ^- (unit @)
?~ sig=(~(get by params) 'sig') ~ ?~ sig=(~(get by params) 'sig') ~
(so:dejs-soft:format u.sig) ?~ ans=((cu to-hex so) u.sig) ~
u.ans
:: ::
++ from ++ from
|= params=(map @t json) |= params=(map @t json)
^- (unit [@p proxy:naive]) ^- (unit [@p proxy:naive])
?~ from=(~(get by params) 'from') ~ ?~ from=(~(get by params) 'from') ~
=, dejs-soft:format
%. u.from %. u.from
%- ot %- ot
:~ ['ship' (su ;~(pfix sig fed:ag))] :~ ['ship' parse-ship]
['proxy' (cu proxy:naive so)] ['proxy' (cu proxy:naive so)]
== ==
:: ::
++ keccak ++ hash
|= params=(map @t json) |= params=(map @t json)
^- (unit @ux) ^- (unit @ux)
?~ keccak=(~(get by params) 'keccak') ~ ?~ hash=(~(get by params) 'hash') ~
=; ans=(unit (unit @ux)) ?~ ans=((cu to-hex so) u.hash) ~
?~(ans ~ u.ans) u.ans
=, dejs-soft:format
((cu to-hex so) u.keccak)
:: ::
++ raw ++ raw
|= params=(map @t json) |= params=(map @t json)
^- (unit octs) ^- (unit octs)
?~ raw=(~(get by params) 'raw') ~ ?~ raw=(~(get by params) 'raw') ~
=; ans=(unit (unit @ux)) ?~ ans=((cu to-hex so) u.raw) ~
?~ ans ~ ?~ u.ans ~
?~ u.ans ~ (some (as-octs:mimes:html u.u.ans))
(some (as-octs:mimes:html u.u.ans)) ::
=, dejs-soft:format ++ tx
((cu to-hex so) u.raw) |= params=(map @t json)
^- (unit l2-tx)
?~ data=(~(get by params) 'tx') ~
?~ tx=(so u.data) ~
=/ method=@tas (enkebab u.tx)
?. ?=(l2-tx method) ~
`method
::
++ nonce
|= params=(map @t json)
^- (unit @ud)
?~ nonce=(~(get by params) 'nonce') ~
(ni u.nonce)
-- --
:: ::
++ to-json ++ to-json
=, enjs:format
|% |%
++ pending ++ pending
|= pending=(list pend-tx) |= pending=(list pend-tx)
^- json ^- json
=, enjs:format
:- %a :- %a
%+ turn pending %+ turn pending
|= pend-tx |= pend-tx
^- json ^- json
=, enjs:format
%- pairs %- pairs
:~ ['force' b+force] :~ ['force' b+force]
(en-address address)
:: ::
:- 'raw-tx' :- 'rawTx'
%- pairs %- pairs
:~ ['sig' (numb sig.raw-tx)] :~ ['tx' (tx:to-json tx.raw-tx)]
['tx' (tx:to-json tx.raw-tx)] ['sig' (hex (as-octs:mimes:html sig.raw-tx))]
== == == ==
:: ::
++ en-address |=(a=@ux address+(hex 20 a))
::
++ tx ++ tx
|= =tx:naive |= =tx:naive
^- json ^- json
=, enjs:format
|^ |^
%- pairs %- pairs
:~ ['tx' (parse-tx +.tx)] :~ ['tx' (parse-tx +.tx)]
@ -203,7 +238,6 @@
== == == ==
:: ::
++ en-ship |=(s=@p ship+(ship s)) ++ en-ship |=(s=@p ship+(ship s))
++ en-address |=(a=@ux address+s+(crip "0x{((x-co:co 20) a)}"))
++ en-spawn |=([s=@p a=@ux] ~[(en-ship s) (en-address a)]) ++ en-spawn |=([s=@p a=@ux] ~[(en-ship s) (en-address a)])
++ en-transfer |=([a=@ux r=?] ~[(en-address a) reset+b+r]) ++ en-transfer |=([a=@ux r=?] ~[(en-address a) reset+b+r])
++ en-keys ++ en-keys
@ -211,7 +245,7 @@
^- (list [@t json]) ^- (list [@t json])
:~ ['encrypt' (numb encrypt)] :~ ['encrypt' (numb encrypt)]
['auth' (numb auth)] ['auth' (numb auth)]
['crypto-suite' (numb crypto-suite)] ['cryptoSuite' (numb crypto-suite)]
['breach' b+breach] ['breach' b+breach]
== ==
-- --
@ -221,10 +255,22 @@
^- json ^- json
a+(turn txs |=(=tx:naive (tx:to-json tx))) a+(turn txs |=(=tx:naive (tx:to-json tx)))
:: ::
++ roller-txs
|= txs=(list roller-tx)
^- json
:- %a
%+ turn txs
|= roller-tx
^- json
%- pairs
:~ ['status' s+status]
['hash' (hex (as-octs:mimes:html hash))]
['type' s+type]
==
::
++ point ++ point
|= =point:naive |= =point:naive
^- json ^- json
=, enjs:format
%- pairs %- pairs
:~ ['dominion' s+dominion.point] :~ ['dominion' s+dominion.point]
:: ::
@ -244,15 +290,15 @@
=* net net.point =* net net.point
:* ['rift' (numb rift.net)] :* ['rift' (numb rift.net)]
:: ::
=, mimes:html
:- 'keys' :- 'keys'
%- pairs %- pairs
:~ ['life' (numb life.keys.net)] :~ ['life' (numb life.keys.net)]
['suite' (numb suite.keys.net)] ['suite' (numb suite.keys.net)]
['auth' (numb auth.keys.net)] ['auth' (hex (as-octs auth.keys.net))]
['crypt' (numb crypt.keys.net)] ['crypt' (hex (as-octs crypt.keys.net))]
== ==
:: ::
['rift' (numb rift.net)]
:- 'sponsor' :- 'sponsor'
%- pairs %- pairs
~[['has' b+has.sponsor.net] ['who' (ship who.sponsor.net)]] ~[['has' b+has.sponsor.net] ['who' (ship who.sponsor.net)]]
@ -261,220 +307,211 @@
['escape' (ship u.escape.net)]~ ['escape' (ship u.escape.net)]~
== == == ==
:: ::
++ points
|= points=(list [@p point:naive])
^- json
:- %a
%+ turn points
|= [ship=@p =point:naive]
%- pairs
:~ ['ship' (^ship ship)]
['point' (^point point)]
==
::
++ ships
|= ships=(list @p)
^- json
a+(turn ships ship)
::
++ ownership ++ ownership
|= [=address:naive =nonce:naive] |= [=address:naive =nonce:naive]
^- json ^- json
=, enjs:format
%- pairs %- pairs
:~ ['address' s+(crip "0x{((x-co:co 20) address)}")] :~ (en-address address)
['nonce' (numb nonce)] ['nonce' (numb nonce)]
== ==
:: ::
++ tx-status ++ spawned
|= =^tx-status |= children=(list [@p @ux])
^- json ^- json
=, enjs:format :- %a
%+ turn children
|= [child=@p address=@ux]
%- pairs %- pairs
:~ ['status' s+status.tx-status] :~ ['ship' (ship child)]
:: (en-address address)
:- 'tx'
?~ tx.tx-status ~
s+(crip "0x{((x-co:co 20) u.tx.tx-status)}")
== ==
::
++ tx-status |=(=^tx-status ^-(json s+status.tx-status))
::
++ config
|= roller-config
^- json
%- pairs
:~ ['nextBatch' (time next-batch)]
['frequency' (numb (div frequency ~s1))]
['refreshTime' (numb (div refresh-time ~s1))]
['contract' (hex 20 contract)]
['chainId' (numb chain-id)]
==
::
++ hex
|= [p=@ q=@]
^- json
s+(crip ['0' 'x' ((x-co:co (mul 2 p)) q)])
-- --
:: ::
++ to-hex ++ to-hex
|= =cord |= =cord
^- (unit @ux) ^- (unit @ux)
=/ parsed=(unit (pair @ud @ux)) (de:base16:mimes:html cord) ?. =((end [3 2] cord) '0x') ~
?~ parsed (rush (rsh [3 2] cord) hex)
::~|(%non-hex-cord !!) ::
++ build-l2-tx
|= [=l2-tx from=[@p proxy:naive] params=(map @t json)]
^- (unit tx:naive)
?: =(l2-tx %transfer-point)
?~ data=(address-transfer:data:from-json params)
~
`[from %transfer-point u.data]
?: =(l2-tx %spawn)
?~ data=(address-ship:data:from-json params)
~
`[from %spawn u.data]
?: =(l2-tx %configure-keys)
?~ data=(keys:data:from-json params)
~
`[from %configure-keys u.data]
?: ?=(spawn-action l2-tx)
?~ data=(ship:data:from-json params)
~
?- l2-tx
%escape `[from %escape u.data]
%cancel-escape `[from %cancel-escape u.data]
%adopt `[from %adopt u.data]
%reject `[from %reject u.data]
%detach `[from %detach u.data]
==
?. ?=(proxy-action l2-tx)
~ ~
(some q.u.parsed) ?~ data=(address:data:from-json params)
:: ~
++ rpc-res ?- l2-tx
|% %set-management-proxy `[from %set-management-proxy u.data]
++ sponsor %set-spawn-proxy `[from %set-spawn-proxy u.data]
|= [id=@t params=(map @t json) action=spawn-action] %set-transfer-proxy `[from %set-transfer-proxy u.data]
^- [(unit cage) response:rpc] ==
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [@p proxy:naive]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit @p) (ship:data:from-json params)
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
:- %aggregator-action
!>
=; =skim-tx:naive
[%submit | u.sig %ful u.raw u.from skim-tx]
?- action
%escape [%escape u.data]
%cancel-escape [%cancel-escape u.data]
%adopt [%adopt u.data]
%reject [%reject u.data]
%detach [%detach u.data]
==
::
++ proxy
|= [id=@t params=(map @t json) action=proxy-action]
^- [(unit cage) response:rpc]
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [@p proxy:naive]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit @ux) (address:data:from-json params)
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
:- %aggregator-action
!>
=; =skim-tx:naive
[%submit | u.sig %ful u.raw u.from skim-tx]
?- action
%set-management-proxy [%set-management-proxy u.data]
%set-spawn-proxy [%set-spawn-proxy u.data]
%set-transfer-proxy [%set-transfer-proxy u.data]
==
--
::
++ error
|_ id=@t
:: https://www.jsonrpc.org/specification#error_object
::
++ parse [%error id '-32700' 'Failed to parsed']
++ request [%error id '-32600' 'Invalid Request']
++ method [%error id '-32601' 'Method not found']
++ params [%error id '-32602' 'Invalid params']
++ internal [%error id '-32603' 'Internal error']
++ not-found [%error id '-32000' 'Resource not found']
--
::
++ validate
|%
++ params
|= params=(map @t json)
^- ?
=((lent ~(tap by params)) 4)
--
-- --
|% |%
++ get-point ++ get-point
|= [id=@t params=(map @t json) scry=$-(ship (unit point:naive))] |= [id=@t params=(map @t json) scry=$-(ship (unit point:naive))]
^- response:rpc ^- response:rpc
?. =((lent ~(tap by params)) 1) ?. =(~(wyt by params) 1)
~(params error id) ~(params error:json-rpc id)
?~ ship=(~(get by params) 'ship') ?~ ship=(~(get by params) 'ship')
~(params error id) ~(params error:json-rpc id)
?~ ship=(rush (so:dejs:format u.ship) ;~(pfix sig fed:ag)) ?~ ship=(parse-ship u.ship)
~(params error id) ~(params error:json-rpc id)
?~ point=(scry u.ship) ?~ point=(scry u.ship)
~(params error id) ~(not-found error:json-rpc id)
[%result id (point:to-json u.point)] [%result id (point:to-json u.point)]
:: ::
++ transfer-point ++ get-ships
|= [id=@t params=(map @t json) scry=$-(@ux (list @p))]
^- response:rpc
?. =(~(wyt by params) 1)
~(params error:json-rpc id)
?~ address=(address:from-json params)
~(parse error:json-rpc id)
[%result id (ships:to-json (scry u.address))]
::
++ get-dns
|= [id=@t params=(map @t json) dns=(list @t)]
^- response:rpc
?. =((lent ~(tap by params)) 0)
~(params error:json-rpc id)
[%result id a+(turn dns (cork same (lead %s)))]
::
++ cancel-tx
|= [id=@t params=(map @t json)] |= [id=@t params=(map @t json)]
^- [(unit cage) response:rpc] ^- [(unit cage) response:rpc]
?. (params:validate params) ?. =(~(wyt by params) 3)
[~ ~(params error id)] [~ ~(params error:json-rpc id)]
=/ sig=(unit @) (sig:from-json params) =/ sig=(unit @) (sig:from-json params)
=/ from=(unit [ship @t]) (from:from-json params) =/ keccak=(unit @ux) (hash:from-json params)
=/ raw=(unit octs) (raw:from-json params) =/ data=(unit [l2-tx ship]) (cancel:data:from-json params)
=/ data=(unit [@ux ?]) (address-transfer:data:from-json params) ?. &(?=(^ sig) ?=(^ keccak) ?=(^ data))
?: |(?=(~ sig) ?=(~ from) ?=(~ raw) ?=(~ data)) [~ ~(parse error:json-rpc id)]
[~ ~(parse error id)]
:_ [%result id s+'ok'] :_ [%result id s+'ok']
%- some %- some
noun+!>([u.sig u.from u.data]) aggregator-action+!>([%cancel u.sig u.keccak u.data])
:: ::
++ configure-keys ++ get-spawned
|= [id=@t params=(map @t json)] |= [id=@t params=(map @t json) scry=$-(ship (list [ship @ux]))]
^- response:rpc
?. =((lent ~(tap by params)) 1)
~(params error:json-rpc id)
?~ ship=(ship:from-json params)
~(params error:json-rpc id)
[%result id (spawned:to-json (scry u.ship))]
::
++ process-rpc
|= [id=@t params=(map @t json) action=l2-tx]
^- [(unit cage) response:rpc] ^- [(unit cage) response:rpc]
?. (params:validate params) ?. =((lent ~(tap by params)) 4)
[~ ~(params error id)] [~ ~(params error:json-rpc id)]
=/ sig=(unit @) (sig:from-json params) =+ ^- $: sig=(unit @)
=/ from=(unit [ship @t]) (from:from-json params) from=(unit [ship proxy:naive])
=/ raw=(unit octs) (raw:from-json params) addr=(unit @ux)
=/ data=(unit [encrypt=@ auth=@ crypto-suite=@ breach=?]) ==
(keys:data:from-json params) =, from-json
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data)) [(sig params) (from params) (address params)]
[~ ~(parse error id)] ?: |(?=(~ sig) ?=(~ from) ?=(~ addr))
:_ [%result id s+'ok'] [~ ~(parse error:json-rpc id)]
=/ tx=(unit tx:naive) (build-l2-tx action u.from params)
?~ tx [~ ~(parse error:json-rpc id)]
=+ (gen-tx-octs:lib u.tx)
:_ [%result id (hex:to-json 32 (hash-tx:lib p q))]
%- some %- some
noun+!>([u.sig u.from u.data]) aggregator-action+!>([%submit | u.addr u.sig %don u.tx])
:: ::
++ spawn ++ nonce
|= [id=@t params=(map @t json)]
^- [(unit cage) response:rpc]
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [@p proxy:naive]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit [@p @ux]) (address-ship:data:from-json params)
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
aggregator-action+!>([%submit | u.sig %ful u.raw u.from %spawn u.data])
::
++ escape sponsor:rpc-res
++ cancel-escape sponsor:rpc-res
++ adopt sponsor:rpc-res
++ detach sponsor:rpc-res
++ reject sponsor:rpc-res
++ management-proxy proxy:rpc-res
++ spawn-proxy proxy:rpc-res
++ transfer-proxy proxy:rpc-res
:: - readNonce(from=[ship proxy]) -> @ :: automatically increment for pending wraps
::
++ read-nonce
|= [id=@t params=(map @t json) scry=$-([ship proxy:naive] (unit @))] |= [id=@t params=(map @t json) scry=$-([ship proxy:naive] (unit @))]
^- response:rpc ^- response:rpc
?. =((lent ~(tap by params)) 3) ?. =((lent ~(tap by params)) 1)
~(params error id) ~(params error:json-rpc id)
?~ from=(from:from-json params) ?~ from=(from:from-json params)
~(parse error id) ~(parse error:json-rpc id)
?~ nonce=(scry u.from) ?~ nonce=(scry u.from)
~(params error id) ~(not-found error:json-rpc id)
[%result id (numb:enjs:format u.nonce)] [%result id (numb:enjs:format u.nonce)]
:: ::
++ pending ++ pending
:: FIXME: send raw-tx (i.e. tx with signature) instead?
::
|% |%
:: - readPendingRoll() -> (list pend-tx)
:: ::
++ all ++ all
|= [id=@t params=(map @t json) pending=(list pend-tx)] |= [id=@t params=(map @t json) pending=(list pend-tx)]
^- response:rpc ^- response:rpc
?. =((lent ~(tap by params)) 0) ?. =((lent ~(tap by params)) 0)
~(params error id) ~(params error:json-rpc id)
[%result id (pending:to-json pending)] [%result id (pending:to-json pending)]
:: - readPendingByShip(ship) -> (list pend-tx)
:: ::
++ ship ++ ship
|= [id=@t params=(map @t json) scry=$-(@p (list pend-tx))] |= [id=@t params=(map @t json) scry=$-(@p (list pend-tx))]
^- response:rpc ^- response:rpc
?. =((lent ~(tap by params)) 1) ?. =((lent ~(tap by params)) 1)
~(params error id) ~(params error:json-rpc id)
?~ ship=(ship:from-json params) ?~ ship=(ship:from-json params)
~(parse error id) ~(parse error:json-rpc id)
[%result id (pending:to-json (scry u.ship))] [%result id (pending:to-json (scry u.ship))]
:: - readPendingByAddress(address) -> (list pend-tx)
:: ::
++ addr ++ addr
|= [id=@t params=(map @t json) scry=$-(@ux (list pend-tx))] |= [id=@t params=(map @t json) scry=$-(@ux (list pend-tx))]
^- response:rpc ^- response:rpc
?. =((lent ~(tap by params)) 1) ?. =((lent ~(tap by params)) 1)
~(params error id) ~(params error:json-rpc id)
?~ address=(address:from-json params) ?~ address=(address:from-json params)
~(parse error id) ~(parse error:json-rpc id)
[%result id (pending:to-json (scry u.address))] [%result id (pending:to-json (scry u.address))]
-- --
:: ::
@ -482,22 +519,50 @@
|= [id=@t params=(map @t json) scry=$-(@ tx-status)] |= [id=@t params=(map @t json) scry=$-(@ tx-status)]
^- response:rpc ^- response:rpc
?. =((lent ~(tap by params)) 1) ?. =((lent ~(tap by params)) 1)
~(params error id) ~(params error:json-rpc id)
?~ keccak=(keccak:from-json params) ?~ hash=(hash:from-json params)
~(parse error id) ~(parse error:json-rpc id)
[%result id (tx-status:to-json (scry u.keccak))] [%result id (tx-status:to-json (scry u.hash))]
:: ::
:: ++ history ++ next-batch
:: |= $: id=@t |= [id=@t params=(map @t json) when=time]
:: params=(map @t json) ^- response:rpc
:: :: FIXME: use proper type from aggregator/index ?. =((lent ~(tap by params)) 0)
:: :: ~(params error:json-rpc id)
:: scry=$-([@p proxy:naive] (list tx:naive)) [%result id (time:enjs:format when)]
:: == ::
:: ^- response:rpc ++ history
:: ?. =((lent ~(tap by params)) 1) |= [id=@t params=(map @t json) scry=$-(address:naive (list roller-tx))]
:: ~(params error id) ^- response:rpc
:: ?~ from=(from:from-json params) ?. =((lent ~(tap by params)) 1)
:: ~(parse error id) ~(params error:json-rpc id)
:: [%result id (txs:to-json (scry u.from))] ?~ address=(address:from-json params)
~(parse error:json-rpc id)
[%result id (roller-txs:to-json (scry u.address))]
::
++ get-config
|= [id=@t params=(map @t json) =roller-config]
^- response:rpc
?. =((lent ~(tap by params)) 0)
~(params error:json-rpc id)
[%result id (config:to-json roller-config)]
::
++ hash-transaction
|= [id=@t params=(map @t json) chain-id=@]
^- response:rpc
?. =((lent ~(tap by params)) 4)
~(params error:json-rpc id)
=+ ^- $: l2-tx=(unit l2-tx)
nonce=(unit @ud)
from=(unit [@p proxy:naive])
==
=, from-json
[(tx params) (nonce params) (from params)]
?: |(?=(~ nonce) ?=(~ from) ?=(~ l2-tx))
~(parse error:json-rpc id)
=/ tx=(unit tx:naive) (build-l2-tx u.l2-tx u.from params)
?~ tx ~(parse error:json-rpc id)
:+ %result id
=- (hex:to-json 32 (hash-tx:lib p q))
(unsigned-tx:lib chain-id u.nonce (gen-tx-octs:lib u.tx))
-- --

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

@ -132,7 +132,7 @@
0x3e8c.a510.354b.c2fd.bbd6.1502.52d9.3105.c9c2.7bbe 0x3e8c.a510.354b.c2fd.bbd6.1502.52d9.3105.c9c2.7bbe
:: ::
++ naive ++ naive
0xb581.01cd.3bbb.cc6f.a40b.cdb0.4bb7.1623.b5c7.d39b 0xe7cf.4b83.06d3.11ba.ca15.585f.e3f0.7cd0.441c.21d1
:: ::
++ launch 4.601.630 ++ launch 4.601.630
++ public launch ++ public launch

247
pkg/arvo/lib/bip/b158.hoon Normal file
View File

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

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

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

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

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

234
pkg/arvo/lib/bitcoin-json.hoon Normal file
View File

@ -0,0 +1,234 @@
/- btc-wallet, btc-provider, bitcoin
/+ bl=bitcoin
|%
++ dejs
=, dejs:format
|%
++ command
|= jon=json
^- command:btc-wallet
%. jon
%- of
:~ set-provider+(mu ship)
check-provider+ship
check-payee+ship
set-current-wallet+so
add-wallet+add-wallet
delete-wallet+so
init-payment-external+init-payment-external
init-payment+init-payment
broadcast-tx+so
gen-new-address+|=(json ~)
==
::
++ ship (su ;~(pfix sig fed:ag))
::
++ add-wallet
%- ot
:~ xpub+so
fprint+(at [ni ni ~])
scan-to+(mu (at [ni ni ~]))
max-gap+(mu ni)
confs+(mu ni)
==
::
++ init-payment-external
%- ot
:~ address+address
value+ni
feyb+ni
note+(mu so)
==
::
++ init-payment
%- ot
:~ payee+ship
value+ni
feyb+ni
note+(mu so)
==
::
++ address
|= jon=json
?> ?=([%s @t] jon)
^- address:bitcoin
(from-cord:adr:bl +.jon)
--
::
++ enjs
=, enjs:format
|%
++ status
|= sta=status:btc-provider
^- json
%+ frond -.sta
?- -.sta
%connected (connected sta)
%new-block (new-block sta)
%disconnected ~
==
::
++ connected
|= sta=status:btc-provider
?> ?=(%connected -.sta)
%- pairs
:~ network+s+network.sta
block+(numb block.sta)
fee+?~(fee.sta ~ (numb u.fee.sta))
==
::
++ new-block
|= sta=status:btc-provider
?> ?=(%new-block -.sta)
%- pairs
:~ network+s+network.sta
block+(numb block.sta)
fee+?~(fee.sta ~ (numb u.fee.sta))
blockhash+(hexb blockhash.sta)
blockfilter+(hexb blockfilter.sta)
==
::
++ hexb
|= h=hexb:bitcoin
^- json
%- pairs
:~ wid+(numb:enjs wid.h)
dat+s+(scot %ux dat.h)
==
::
++ update
|= upd=update:btc-wallet
^- json
%+ frond -.upd
?- -.upd
%initial (initial upd)
%change-provider (change-provider upd)
%change-wallet (change-wallet upd)
%psbt (psbt upd)
%btc-state (btc-state btc-state.upd)
%new-tx (hest hest.upd)
%cancel-tx (hexb txid.upd)
%new-address (address address.upd)
%balance (balance balance.upd)
%error s+error.upd
%broadcast-success ~
==
::
++ initial
|= upd=update:btc-wallet
?> ?=(%initial -.upd)
^- json
%- pairs
:~ provider+(provider provider.upd)
wallet+?~(wallet.upd ~ [%s u.wallet.upd])
balance+(balance balance.upd)
history+(history history.upd)
btc-state+(btc-state btc-state.upd)
address+?~(address.upd ~ (address u.address.upd))
==
::
++ change-provider
|= upd=update:btc-wallet
?> ?=(%change-provider -.upd)
^- json
(provider provider.upd)
::
++ change-wallet
|= upd=update:btc-wallet
?> ?=(%change-wallet -.upd)
^- json
%- pairs
:~ wallet+?~(wallet.upd ~ [%s u.wallet.upd])
balance+(balance balance.upd)
history+(history history.upd)
==
::
++ psbt
|= upd=update:btc-wallet
?> ?=(%psbt -.upd)
^- json
%- pairs
:~ pb+s+pb.upd
fee+(numb fee.upd)
==
::
++ balance
|= b=(unit [p=@ q=@])
^- json
?~ b ~
%- pairs
:~ confirmed+(numb p.u.b)
unconfirmed+(numb q.u.b)
==
::
++ btc-state
|= bs=btc-state:btc-wallet
^- json
%- pairs
:~ block+(numb block.bs)
fee+?~(fee.bs ~ (numb u.fee.bs))
date+(sect t.bs)
==
::
++ provider
|= p=(unit provider:btc-wallet)
^- json
?~ p ~
%- pairs
:~ host+(ship host.u.p)
connected+b+connected.u.p
==
::
++ history
|= hy=history:btc-wallet
^- json
:- %o
^- (map @t json)
%- ~(rep by hy)
|= [[=txid:btc-wallet h=hest:btc-wallet] out=(map @t json)]
^- (map @t json)
(~(put by out) (scot %ux dat.txid) (hest h))
::
++ hest
|= h=hest:btc-wallet
^- json
%- pairs
:~ xpub+s+xpub.h
txid+(hexb txid.h)
confs+(numb confs.h)
recvd+?~(recvd.h ~ (sect u.recvd.h))
inputs+(vals inputs.h)
outputs+(vals outputs.h)
note+?~(note.h ~ [%s u.note.h])
==
::
++ vals
|= vl=(list [=val:tx:bitcoin s=(unit @p)])
^- json
:- %a
%+ turn vl
|= [v=val:tx:bitcoin s=(unit @p)]
%- pairs
:~ val+(val v)
ship+?~(s ~ (ship u.s))
==
::
++ val
|= v=val:tx:bitcoin
^- json
%- pairs
:~ txid+(hexb txid.v)
pos+(numb pos.v)
address+(address address.v)
value+(numb value.v)
==
::
++ address
|= a=address:bitcoin
^- json
?- -.a
%base58 [%s (rsh [3 2] (scot %uc +.a))]
%bech32 [%s +.a]
==
--
--

166
pkg/arvo/lib/bitcoin-utils.hoon Normal file
View File

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

286
pkg/arvo/lib/bitcoin.hoon Normal file
View File

@ -0,0 +1,286 @@
:: bitcoin.hoon
:: top-level Bitcoin constants
:: expose BIP libraries
::
/- sur=bitcoin
/+ bech32=bip-b173, pbt=bip-b174, bcu=bitcoin-utils
=, sur
=, bcu
|%
++ overhead-weight ^-(vbytes 11)
++ input-weight
|= =bipt
^- vbytes
?- bipt
%44 148
%49 91
%84 68
==
++ output-weight
|= =bipt
^- vbytes
?- bipt
%44 34
%49 32
%84 31
==
::
++ xpub-type
|= =xpub
^- [=bipt =network]
=/ prefix=tape (scag 4 (trip xpub))
?: =("tpub" prefix) [%44 %testnet]
?: =("upub" prefix) [%49 %testnet]
?: =("vpub" prefix) [%84 %testnet]
?: =("xpub" prefix) [%44 %main]
?: =("ypub" prefix) [%49 %main]
?: =("zpub" prefix) [%84 %main]
~|("invalid xpub: {<xpub>}" !!)
::
:: adr: address manipulation
::
++ adr
|%
++ get-bipt
|= a=address
^- bipt
=/ spk=hexb (to-script-pubkey:adr a)
?: =(25 wid.spk) %44
?: =(23 wid.spk) %49
?: =(22 wid.spk) %84
?: =(34 wid.spk) %84
~|("Invalid address" !!)
::
++ to-cord
|= a=address ^- cord
?: ?=([%base58 *] a)
(scot %uc +.a)
+.a
::
++ from-pubkey
|= [=bipt =network pubkey=hexb]
^- address
?- bipt
%44
:- %base58
=< ^-(@uc dat)
%- cat:byt
:- ?- network
%main 1^0x0
%testnet 1^0x6f
==
~[(hash-160 pubkey)]
::
%49
:- %base58
=< ^-(@uc dat)
%- cat:byt
:~ ?- network
%main 1^0x5
%testnet 1^0xc4
==
%- hash-160
(cat:byt ~[2^0x14 (hash-160 pubkey)])
==
::
%84
:- %bech32
(need (encode-pubkey:bech32 network pubkey))
==
::
++ from-cord
|= addrc=@t
|^
=/ addrt=tape (trip addrc)
^- address
?: (is-base58 addrt)
[%base58 `@uc`(scan addrt fim:ag)]
?: (is-bech32 addrt)
[%bech32 addrc]
~|("Invalid address: {<addrc>}" !!)
::
++ is-base58
|= at=tape
^- ?
?| =("m" (scag 1 at))
=("1" (scag 1 at))
=("3" (scag 1 at))
=("2" (scag 1 at))
==
::
++ is-bech32
|= at=tape
^- ?
?| =("bc1" (scag 3 at))
=("tb1" (scag 3 at))
==
--
::
++ to-script-pubkey
|= =address
^- hexb
?- -.address
%bech32
=+ h=(from-address:bech32 +.address)
%- cat:byt
:~ 1^0x0
1^wid.h
h
==
::
%base58
=/ h=hexb [21 `@ux`+.address]
=+ lead-byt=dat:(take:byt 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
?: ?=(%44 -.version-network)
:~ 3^0x76.a914
(drop:byt 1 h)
2^0x88ac
==
:~ 2^0xa914
(drop:byt 1 h)
1^0x87
==
==
--
::
:: +txu: transaction utility core
:: - primarily used for calculating txids
:: - ignores signatures in inputs
::
++ txu
|%
++ en
|%
++ input
|= i=input:tx
^- hexb
%- cat:byt
:~ (flip:byt txid.i)
(flip:byt 4^pos.i)
?~ script-sig.i 1^0x0
%- cat:byt
~[(en:csiz wid.u.script-sig.i) u.script-sig.i]
(flip:byt sequence.i)
==
::
++ output
|= o=output:tx
^- hexb
%- cat:byt
:~ (flip:byt 8^value.o)
1^wid.script-pubkey.o
script-pubkey.o
==
--
::
++ de
|%
++ nversion
|= b=hexb
^- [nversion=@ud rest=hexb]
:- dat:(flip:byt (take:byt 4 b))
(drop:byt 4 b)
::
++ segwit
|= b=hexb
^- [segwit=(unit @ud) rest=hexb]
?. =(1^0x0 (take:byt 1 b))
[~ b]
:- [~ dat:(take:byt 2 b)]
(drop:byt 2 b)
::
++ script-sig
|= b=hexb
^- [sig=hexb rest=hexb]
=^ siglen=hexb b (de:csiz b)
:- (take:byt dat.siglen b)
(drop:byt dat.siglen b)
::
++ sequence
|= b=hexb
^- [seq=hexb rest=hexb]
[(flip:byt (take:byt 4 b)) (drop:byt 4 b)]
::
++ inputs
|= b=hexb
^- [is=(list input:tx) rest=hexb]
|^
=| acc=(list input:tx)
=^ count b (dea:csiz b)
|-
?: =(0 count) [acc b]
=^ i b (input b)
$(acc (snoc acc i), count (dec count))
::
++ input
|= b=hexb
^- [i=input:tx rest=hexb]
=/ txid (flip:byt (take:byt 32 b))
=/ pos dat:(flip:byt (take:byt 4 (drop:byt 32 b)))
=^ sig=hexb b (script-sig (drop:byt 36 b))
=^ seq=hexb b (sequence b)
:_ b
[txid pos seq ?:((gth wid.sig 0) `sig ~) ~ 0]
--
::
++ outputs
|= b=hexb
^- [os=(list output:tx) rest=hexb]
=| acc=(list output:tx)
=^ count b (dea:csiz b)
|-
?: =(0 count) [acc b]
=/ value (flip:byt (take:byt 8 b))
=^ scriptlen b (dea:csiz (drop:byt 8 b))
%= $
acc %+ snoc acc
:- (take:byt scriptlen b)
dat.value
b (drop:byt scriptlen b)
count (dec count)
==
--
:: +basic-encode: encodes data in a format suitable for hashing
::
++ basic-encode
|= =data:tx
^- hexb
%- cat:byt
%- zing
:~ ~[(flip:byt 4^nversion.data)]
~[(en:csiz (lent is.data))]
(turn is.data input:en)
~[(en:csiz (lent os.data))]
(turn os.data output:en)
~[(flip:byt 4^locktime.data)]
==
++ get-id
|= =data:tx
^- hexb
%- flip:byt
%- dsha256
(basic-encode data)
::
++ decode
|= b=hexb
^- data:tx
=^ nversion b
(nversion:de b)
=^ segwit b
(segwit:de b)
=^ inputs b
(inputs:de b)
=^ outputs b
(outputs:de b)
=/ locktime=@ud
dat:(take:byt 4 (flip:byt b))
[inputs outputs locktime nversion segwit]
--
--

209
pkg/arvo/lib/btc-provider.hoon Normal file
View File

@ -0,0 +1,209 @@
/- bp=btc-provider, json-rpc
/+ bc=bitcoin
^?
::=< [sur .]
::=, sur
|%
:: +from-epoch: time since Jan 1, 1970 in seconds.
::
++ from-epoch
|= secs=@ud
^- (unit @da)
?: =(0 secs) ~
[~ (add ~1970.1.1 `@dr`(mul secs ~s1))]
::
++ get-request
|= url=@t
^- request:http
[%'GET' url ~ ~]
::
++ post-request
|= [url=@t body=json]
^- request:http
:* %'POST'
url
~[['Content-Type' 'application/json']]
=, html
%- some
%- as-octt:mimes
(en-json body)
==
::
++ gen-request
|= [=host-info:bp ract=action:rpc-types:bp]
^- request:http
%+ rpc-action-to-http
api-url.host-info ract
::
++ rpc
=, dejs:format
|%
++ parse-result
|= res=response:json-rpc
|^ ^- result:rpc-types:bp
~| -.res
?> ?=(%result -.res)
?+ id.res ~|([%unsupported-result id.res] !!)
%get-address-info
[id.res (address-info res.res)]
::
%get-tx-vals
[id.res (tx-vals res.res)]
::
%get-raw-tx
[id.res (raw-tx res.res)]
::
%broadcast-tx
[%broadcast-tx (broadcast-tx res.res)]
::
%get-block-count
[id.res (ni res.res)]
::
%get-block-info
[id.res (block-info res.res)]
==
++ address-info
%- ot
:~ [%address (cu from-cord:adr:bc so)]
[%utxos (as utxo)]
[%used bo]
[%block ni]
==
++ utxo
%- ot
:~ ['tx_pos' ni]
['tx_hash' (cu from-cord:hxb:bc so)]
[%height ni]
[%value ni]
[%recvd (cu from-epoch ni)]
==
++ tx-vals
%- ot
:~ [%included bo]
[%txid (cu from-cord:hxb:bc 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)]
[%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)]
==
++ broadcast-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc 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)]
==
--
--
::
++ rpc-action-to-http
|= [endpoint=@t ract=action:rpc-types:bp]
|^ ^- request:http
?- -.ract
%get-address-info
%- get-request
%+ mk-url '/addresses/info/'
(to-cord:adr:bc address.ract)
::
%get-tx-vals
%- get-request
%+ mk-url '/gettxvals/'
(to-cord:hxb:bc txid.ract)
::
%get-raw-tx
%- get-request
%+ mk-url '/getrawtx/'
(to-cord:hxb:bc txid.ract)
::
%broadcast-tx
%- get-request
%+ mk-url '/broadcasttx/'
(to-cord:hxb:bc rawtx.ract)
::
%get-block-count
%- get-request
(mk-url '/getblockcount' '')
::
%get-block-info
%- get-request
(mk-url '/getblockinfo' '')
==
++ mk-url
|= [base=@t params=@t]
%^ cat 3
(cat 3 endpoint base) params
--
:: RPC/HTTP Utilities
::
++ httr-to-rpc-response
|= hit=httr:eyre
^- response:json-rpc
~| hit
=/ jon=json (need (de-json:html q:(need r.hit)))
?. =(%2 (div p.hit 100))
(parse-rpc-error jon)
=, dejs-soft:format
^- response:json-rpc
=; dere
=+ res=((ar dere) jon)
?~ res (need (dere jon))
[%batch u.res]
|= jon=json
^- (unit response:json-rpc)
=/ res=[id=(unit @t) res=(unit json) err=(unit json)]
%. jon
=, dejs:format
=- (ou -)
:~ ['id' (uf ~ (mu so))]
['result' (uf ~ (mu same))]
['error' (uf ~ (mu same))]
==
?: ?=([^ * ~] res)
`[%result [u.id.res ?~(res.res ~ u.res.res)]]
~| jon
`(parse-rpc-error jon)
::
++ get-rpc-response
|= response=client-response:iris
^- response:json-rpc
?> ?=(%finished -.response)
%- httr-to-rpc-response
%+ to-httr:iris
response-header.response
full-file.response
::
++ parse-rpc-error
|= =json
^- response:json-rpc
:- %error
?~ json ['' '' '']
%. json
=, dejs:format
=- (ou -)
:~ =- ['id' (uf '' (cu - (mu so)))]
|*(a=(unit) ?~(a '' u.a))
:- 'error'
=- (uf ['' ''] -)
=- (cu |*(a=(unit) ?~(a ['' ''] u.a)) (mu (ou -)))
:~ ['code' (uf '' no)]
['message' (uf '' so)]
== ==
--

571
pkg/arvo/lib/btc.hoon Normal file
View File

@ -0,0 +1,571 @@
:: lib/btc.hoon
::
/- *btc-wallet, json-rpc, bp=btc-provider
/+ bip32, bc=bitcoin
=, secp:crypto
=+ ecc=secp256k1
|%
::
:: Formerly lib/btc-wallet.hoon
::
::
++ defaults
|%
++ max-gap 20
++ confs 6
--
:: +fam: planet parent if s is a moon
::
++ fam
|= [our=ship now=@da s=ship]
^- ship
?. =(%earl (clan:title s)) s
(sein:title our now s)
::
++ num-confs
|= [last-block=@ud =utxo:bc]
?: =(0 height.utxo) 0
(add 1 (sub last-block height.utxo))
::
++ from-xpub
|= $: =xpub:bc
=fprint:bc
scan-to=(unit scon)
max-gap=(unit @ud)
confs=(unit @ud)
==
^- walt
=/ [=bipt =network] (xpub-type:bc xpub)
:* xpub
network
fprint
+6:(from-extended:bip32 (trip xpub))
bipt
*wach
[0 0]
%.n
(fall scan-to *scon)
(fall max-gap max-gap:defaults)
(fall confs confs:defaults)
==
:: +address-coords: find wallet info for the address, if any
::
++ address-coords
|= [a=address ws=(list walt)]
^- (unit [w=walt =chyg =idx])
|^
|- ?~ ws ~
=/ res=(unit [=chyg =idx])
(lookup i.ws)
?^ res `[i.ws chyg.u.res idx.u.res]
$(ws t.ws)
::
++ lookup
|= w=walt
^- (unit [=chyg =idx])
=/ ad=(unit addi) (~(get by wach.w) a)
?~(ad ~ `[chyg.u.ad idx.u.ad])
--
::
++ new-txbu
|= $: w=walt
payee=(unit ship)
=vbytes:bc
is=(list insel)
txos=(list txo)
==
^- txbu
:* xpub.w
payee
vbytes
%+ turn is
|= i=insel
[utxo.i ~ (~(hdkey wad w chyg.i) idx.i)]
txos
~
==
:: txb: transaction builder helpers
::
++ txb
|_ t=txbu
++ value
^- [in=sats out=sats]
:- %+ roll
%+ turn txis.t
|=(=txi value.utxo.txi)
add
(roll (turn txos.t |=(=txo value.txo)) add)
::
++ fee
^- sats:bc
=/ [in=sats out=sats] value
(sub in out)
::
++ vbytes
^- vbytes:bc
%+ add overhead-weight:bc
%+ add
%+ roll
(turn txis.t |=(t=txi (input-weight:bc bipt.hdkey.t)))
add
%+ roll
(turn txos.t |=(t=txo (output-weight:bc (get-bipt:adr:bc address.t))))
add
++ tx-data
|^
^- data:tx:bc
:* (turn txis.t txi-data)
(turn txos.t txo-data)
0 1 `1
==
::
++ txi-data
|= =txi
:* txid.utxo.txi pos.utxo.txi
4^0xffff.ffff ~ ~ value.utxo.txi
==
++ txo-data
|= =txo
:- (to-script-pubkey:adr:bc address.txo)
value.txo
--
::
++ get-txid
^- txid
(get-id:txu:bc tx-data)
::
++ get-rawtx
(basic-encode:txu:bc tx-data)
:: +add-output: append output (usually change) to txos
::
++ add-output
|= =txo
^- txbu
:: todo update vbytes
t(txos (snoc [txos.t] txo))
:: +to-psbt: returns a based 64 PSBT if
:: - all inputs have an associated rawtx
::
++ to-psbt
^- (unit base64:psbt:bc)
=/ ins=(list in:psbt:bc)
%+ murn txis.t
|= =txi
?~ rawtx.txi ~
`[utxo.txi u.rawtx.txi hdkey.txi]
?: (lth (lent ins) (lent txis.t))
~
=/ outs=(list out:psbt:bc)
%+ turn txos.t
|=(=txo [address.txo hk.txo])
`(encode:pbt:bc %.y get-rawtx get-txid ins outs)
--
:: wad: door for processing walts (wallets)
:: parameterized on a walt and it's chyg account
::
++ wad
|_ [w=walt =chyg]
++ pubkey
|= =idx:bc
^- hexb:bc
=/ pk=@ux
%- compress-point:ecc
pub:(derive-public:(~(derive-public bip32 wamp.w) chyg) idx)
[(met 3 pk) pk]
::
++ hdkey
|= =idx:bc
^- hdkey:bc
[fprint.w (~(pubkey wad w chyg) idx) network.w bipt.w chyg idx]
::
++ mk-address
|= =idx:bc
^- address:bc
(from-pubkey:adr:bc bipt.w network.w (pubkey idx))
:: +nixt-address: used to get change addresses
:: - gets the current next available address
:: - doesn't bump nixt-address if it's unused
:: - if used, fall back to gen-address and make a new one
::
++ nixt-address
^- (trel address:bc idx:bc walt)
=/ addr (mk-address nixt-idx)
~| "lib/btc-wallet-store: get-next-address: nixt shouldn't be blank"
=/ =addi (~(got by wach.w) addr)
?. used.addi
[addr nixt-idx w]
gen-address
::
:: +gen-address:
:: - generates the next available address
:: - watches it (using update address)
::
++ gen-address
^- (trel address:bc idx:bc walt)
=/ addr (mk-address nixt-idx)
:* addr
nixt-idx
%+ update-address addr
[%.n chyg nixt-idx *(set utxo:bc)]
==
:: +update-address
:: - insert a new address
:: - if it's used, move "nixt" to the next free address
:: - watch address
::
++ update-address
|= [a=address:bc =addi]
^- walt
?> =(chyg chyg.addi)
?> =(a (mk-address idx.addi))
=? w ?&(used.addi (is-nixt addi))
bump-nixt
w(wach (~(put by wach.w) a addi))
::
++ is-nixt
|= =addi ^- ?
?: ?=(%0 chyg.addi)
=(idx.addi p.nixt.w)
=(idx.addi q.nixt.w)
++ nixt-idx
?:(?=(%0 chyg) p.nixt.w q.nixt.w)
:: +bump-nixt: return wallet with bumped nixt
:: - find next unused address
:: - watches that address
:: - crashes if max-index is passed
::
++ bump-nixt
|^ ^- walt
=/ new-idx=idx:bc +(nixt-idx)
|- ?> (lte new-idx max-index)
=+ addr=(mk-address new-idx)
=/ =addi
%+ ~(gut by wach.w) addr
[%.n chyg new-idx *(set utxo:bc)]
?. used.addi
%= w
nixt (set-nixt new-idx)
wach (~(put by wach.w) addr addi)
==
$(new-idx +(new-idx))
::
++ set-nixt
|= =idx:bc ^- nixt
?:(?=(%0 chyg) [idx q.nixt.w] [p.nixt.w idx])
--
--
:: sut: select utxos
::
++ sut
|_ [w=walt eny=@uvJ last-block=@ud payee=(unit ship) =feyb txos=(list txo)]
++ dust-sats 3
++ dust-threshold
|= output-bipt=bipt:bc
^- vbytes
(mul dust-sats (input-weight:bc output-bipt))
::
++ target-value
^- sats
%+ roll (turn txos |=(=txo value.txo))
|=([a=sats b=sats] (add a b))
::
++ base-weight
^- vbytes
%+ add overhead-weight:bc
%+ roll
%+ turn txos
|=(=txo (output-weight:bc (get-bipt:adr:bc address.txo)))
add
::
++ total-vbytes
|= selected=(list insel)
^- vbytes
%+ add base-weight
(mul (input-weight:bc bipt.w) (lent selected))
:: value of an input after fee
:: 0 if net is <= 0
::
++ net-value
|= val=sats
^- sats
=/ cost (mul (input-weight:bc bipt.w) feyb)
?: (lte val cost) 0
(sub val cost)
::
:: +spendable: whether utxo has enough confs to spend
::
++ spendable
|= =utxo:bc ^- ?
(gte (num-confs last-block utxo) confs.w)
:: +with-change:
:: - choose UTXOs, if there are enough
:: - return txbu and amount of change (if any)
::
++ with-change
^- [tb=(unit txbu) chng=(unit sats)]
=/ tb=(unit txbu) select-utxos
?~ tb [~ ~]
=+ excess=~(fee txb u.tb) :: (inputs - outputs)
=/ new-fee=sats :: cost of this tx + one more output
(mul feyb (add (output-weight:bc bipt.w) vbytes.u.tb))
?. (gth excess new-fee)
[tb ~]
?. (gth (sub excess new-fee) (dust-threshold bipt.w))
[tb ~]
:- tb
`(sub excess new-fee)
:: Uses naive random selection. Should switch to branch-and-bound later.
::
++ select-utxos
|^ ^- (unit txbu)
?. %+ levy txos
|= =txo
%+ gth value.txo
(dust-threshold (get-bipt:adr:bc address.txo))
~|("One or more suggested outputs is dust." !!)
=/ is=(unit (list insel))
%- single-random-draw
%- zing
(turn ~(val by wach.w) to-insels)
?~ is ~
`(new-txbu w payee (total-vbytes u.is) u.is txos)
::
++ to-insels
|= =addi
^- (list insel)
%+ turn ~(tap in utxos.addi)
|=(=utxo:bc [utxo chyg.addi idx.addi])
--
:: single-random-draw
:: randomly choose utxos until target is hit
:: only use an insel if its net-value > 0
::
++ single-random-draw
|= is=(list insel)
^- (unit (list insel))
=/ rng ~(. og eny)
=/ target (add target-value (mul feyb base-weight)) :: add base fees to target
=| [select=(list insel) total=sats:bc]
|-
?: =(~ is) ~
=^ n rng (rads:rng (lent is))
=/ i=insel (snag n is)
?. (spendable utxo.i)
$(is (oust [n 1] is))
=/ net-val (net-value value.utxo.i)
=? select (gth net-val 0)
[i select]
=/ new-total (add total net-val)
?: (gte new-total target) `select
%= $
is (oust [n 1] is)
total new-total
==
::
--
::
::
:: Formerly lib/btc-provider
::
::
++ from-epoch
|= secs=@ud
^- (unit @da)
?: =(0 secs) ~
[~ (add ~1970.1.1 `@dr`(mul secs ~s1))]
::
++ get-request
|= url=@t
^- request:http
[%'GET' url ~ ~]
::
++ post-request
|= [url=@t body=json]
^- request:http
:* %'POST'
url
~[['Content-Type' 'application/json']]
=, html
%- some
%- as-octt:mimes
(en-json body)
==
::
++ gen-request
|= [=host-info:bp ract=action:rpc-types:bp]
^- request:http
%+ rpc-action-to-http
api-url.host-info ract
::
++ rpc
=, dejs:format
|%
++ parse-result
|= res=response:json-rpc
|^ ^- result:rpc-types:bp
~| -.res
?> ?=(%result -.res)
?+ id.res ~|([%unsupported-result id.res] !!)
%get-address-info
[id.res (address-info res.res)]
::
%get-tx-vals
[id.res (tx-vals res.res)]
::
%get-raw-tx
[id.res (raw-tx res.res)]
::
%broadcast-tx
[%broadcast-tx (broadcast-tx res.res)]
::
%get-block-count
[id.res (ni res.res)]
::
%get-block-info
[id.res (block-info res.res)]
==
++ address-info
%- ot
:~ [%address (cu from-cord:adr:bc so)]
[%utxos (as utxo)]
[%used bo]
[%block ni]
==
++ utxo
%- ot
:~ ['tx_pos' ni]
['tx_hash' (cu from-cord:hxb:bc so)]
[%height ni]
[%value ni]
[%recvd (cu from-epoch ni)]
==
++ tx-vals
%- ot
:~ [%included bo]
[%txid (cu from-cord:hxb:bc 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)]
[%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)]
==
++ broadcast-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc 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)]
==
--
--
::
++ rpc-action-to-http
|= [endpoint=@t ract=action:rpc-types:bp]
|^ ^- request:http
?- -.ract
%get-address-info
%- get-request
%+ mk-url '/addresses/info/'
(to-cord:adr:bc address.ract)
::
%get-tx-vals
%- get-request
%+ mk-url '/gettxvals/'
(to-cord:hxb:bc txid.ract)
::
%get-raw-tx
%- get-request
%+ mk-url '/getrawtx/'
(to-cord:hxb:bc txid.ract)
::
%broadcast-tx
%- get-request
%+ mk-url '/broadcasttx/'
(to-cord:hxb:bc rawtx.ract)
::
%get-block-count
%- get-request
(mk-url '/getblockcount' '')
::
%get-block-info
%- get-request
(mk-url '/getblockinfo' '')
==
++ mk-url
|= [base=@t params=@t]
%^ cat 3
(cat 3 endpoint base) params
--
:: RPC/HTTP Utilities
::
++ httr-to-rpc-response
|= hit=httr:eyre
^- response:json-rpc
~| hit
=/ jon=json (need (de-json:html q:(need r.hit)))
?. =(%2 (div p.hit 100))
(parse-rpc-error jon)
=, dejs-soft:format
^- response:json-rpc
=; dere
=+ res=((ar dere) jon)
?~ res (need (dere jon))
[%batch u.res]
|= jon=json
^- (unit response:json-rpc)
=/ res=[id=(unit @t) res=(unit json) err=(unit json)]
%. jon
=, dejs:format
=- (ou -)
:~ ['id' (uf ~ (mu so))]
['result' (uf ~ (mu same))]
['error' (uf ~ (mu same))]
==
?: ?=([^ * ~] res)
`[%result [u.id.res ?~(res.res ~ u.res.res)]]
~| jon
`(parse-rpc-error jon)
::
++ get-rpc-response
|= response=client-response:iris
^- response:json-rpc
?> ?=(%finished -.response)
%- httr-to-rpc-response
%+ to-httr:iris
response-header.response
full-file.response
::
++ parse-rpc-error
|= =json
^- response:json-rpc
:- %error
?~ json ['' '' '']
%. json
=, dejs:format
=- (ou -)
:~ =- ['id' (uf '' (cu - (mu so)))]
|*(a=(unit) ?~(a '' u.a))
:- 'error'
=- (uf ['' ''] -)
=- (cu |*(a=(unit) ?~(a ['' ''] u.a)) (mu (ou -)))
:~ ['code' (uf '' no)]
['message' (uf '' so)]
== ==
--

73
pkg/arvo/lib/dice.hoon Normal file
View File

@ -0,0 +1,73 @@
:: dice: helper functions for L2 Rollers
::
/- *dice
/+ naive, *naive-transactions
::
|%
++ apply-effects
|= [=effects:naive nas=^state:naive own=owners chain-t=@]
^+ [nas=nas own=own]
%+ roll effects
|= [=diff:naive nas=_nas own=_own]
^+ [nas own]
?. ?=([%tx *] diff) [nas own]
=< [nas own]
(apply-raw-tx | raw-tx.diff nas own chain-t)
::
++ apply-raw-tx
|= [force=? =raw-tx:naive nas=^state:naive own=owners chain-t=@]
^- [? nas=_nas own=_own]
=+ cache-nas=nas
=/ chain-t=@t (ud-to-ascii:naive chain-t)
?. (verify-sig-and-nonce:naive verifier chain-t nas raw-tx)
~& [%verify-sig-and-nonce %failed tx.raw-tx]
[force nas own]
=^ * points.nas
(increment-nonce:naive nas from.tx.raw-tx)
?~ nex=(receive-tx:naive nas tx.raw-tx)
~& [%receive-tx %failed]
[force ?:(force nas cache-nas) own]
=* new-nas +.u.nex
=* effects -.u.nex
:+ &
new-nas
(update-ownership effects cache-nas new-nas own)
::
++ update-ownership
|= $: =effects:naive
cache-nas=^state:naive
nas=^state:naive
=owners
==
^+ owners
%+ roll effects
|= [=diff:naive owners=_owners]
=, orm:naive
?. ?=([%point *] diff) owners
=/ old=(unit point:naive)
(get points.cache-nas ship.diff)
=/ new=point:naive
(need (get points.nas ship.diff))
=* event +>.diff
=; [to=@ux from=@ux]
=? owners !=(from 0x0)
(~(del ju owners) from ship.diff)
?: =(to 0x0) owners
(~(put ju owners) to ship.diff)
?+ -.event [0x0 0x0]
%owner
[+.event ?~(old 0x0 address.owner.own.u.old)]
::
%spawn-proxy
[+.event ?~(old 0x0 address.spawn-proxy.own.u.old)]
::
%management-proxy
[+.event ?~(old 0x0 address.management-proxy.own.u.old)]
::
%voting-proxy
[+.event ?~(old 0x0 address.voting-proxy.own.u.old)]
::
%transfer-proxy
[+.event ?~(old 0x0 address.transfer-proxy.own.u.old)]
==
--

36
pkg/arvo/lib/dm-hook.hoon Normal file
View File

@ -0,0 +1,36 @@
/- *dm-hook
|%
::
++ dejs
=, dejs:format
|%
++ action
|^
%- of
:~ accept+ship
decline+ship
pendings+ships
screen+bo
==
::
++ ship (su ;~(pfix sig fed:ag))
::
++ ships (as ship)
--
--
::
++ enjs
=, enjs:format
|%
::
++ action
|= act=^action
%+ frond -.act
?- -.act
?(%accept %decline) (ship +.act)
%pendings a+(turn ~(tap in ships.act) ship)
%screen [%b +.act]
==
--
--

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

@ -483,6 +483,7 @@
[%eth-get-filter-changes fid=@ud] [%eth-get-filter-changes fid=@ud]
[%eth-get-transaction-by-hash txh=@ux] [%eth-get-transaction-by-hash txh=@ux]
[%eth-get-transaction-count adr=address =block] [%eth-get-transaction-count adr=address =block]
[%eth-get-balance adr=address]
[%eth-get-transaction-receipt txh=@ux] [%eth-get-transaction-receipt txh=@ux]
[%eth-send-raw-transaction dat=@ux] [%eth-send-raw-transaction dat=@ux]
== ==
@ -717,6 +718,9 @@
:~ (tape (address-to-hex adr.req)) :~ (tape (address-to-hex adr.req))
(block-to-json block.req) (block-to-json block.req)
== ==
::
%eth-get-balance
['eth_getBalance' (tape (address-to-hex adr.req)) ~]
:: ::
%eth-get-transaction-by-hash %eth-get-transaction-by-hash
['eth_getTransactionByHash' (tape (transaction-to-hex txh.req)) ~] ['eth_getTransactionByHash' (tape (transaction-to-hex txh.req)) ~]
@ -796,6 +800,8 @@
:: ::
++ parse-eth-get-transaction-count parse-hex-result ++ parse-eth-get-transaction-count parse-hex-result
:: ::
++ parse-eth-get-balance parse-hex-result
::
++ parse-event-logs ++ parse-event-logs
(ar:dejs:format parse-event-log) (ar:dejs:format parse-event-log)
:: ::

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

@ -108,16 +108,25 @@
++ parse-one-response ++ parse-one-response
|= =json |= =json
^- (unit response:rpc) ^- (unit response:rpc)
=/ res=(unit [@t ^json]) ?. &(?=([%o *] json) (~(has by p.json) 'error'))
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?~ res ~
`[%result u.res]
~| parse-one-response=json
=/ error=(unit [id=@t ^json code=@ta mssg=@t])
%. json %. json
=, dejs-soft:format =, dejs-soft:format
(ot id+so result+some ~) :: A 'result' member is present in the error
?^ res `[%result u.res] :: response when using ganache, even though
~| parse-one-response=json :: that goes against the JSON-RPC spec
:+ ~ %error %- need ::
%. json (ot id+so result+some error+(ot code+no message+so ~) ~)
=, dejs-soft:format ?~ error ~
(ot id+so error+(ot code+no message+so ~) ~) =* err u.error
`[%error id.err code.err mssg.err]
-- --
:: ::
:: +read-contract: calls a read function on a contract, produces result hex :: +read-contract: calls a read function on a contract, produces result hex
@ -267,4 +276,14 @@
[%eth-get-transaction-count address [%label %latest]] [%eth-get-transaction-count address [%label %latest]]
%- pure:m %- pure:m
(parse-eth-get-transaction-count:rpc:ethereum json) (parse-eth-get-transaction-count:rpc:ethereum json)
::
++ get-balance
|= [url=@ta =address]
=/ m (strand:strandio ,@ud)
^- form:m
;< =json bind:m
%^ request-rpc url `'balance'
[%eth-get-balance address]
%- pure:m
(parse-eth-get-balance:rpc:ethereum json)
-- --

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

@ -1,105 +1,10 @@
/- sur=graph-store, pos=post /- sur=graph-store, pos=post
/+ res=resource /+ res=resource, migrate
=< [sur .] =< [sur .]
=< [pos .] =< [pos .]
=, sur =, sur
=, pos =, pos
|% |%
::
++ update-log-to-one
|= =update-log:zero
^- ^update-log
%+ gas:orm-log *^update-log
%+ turn (tap:orm-log:zero update-log)
|= [=time =logged-update:zero]
:- time
:- p.logged-update
(logged-update-to-one q.logged-update)
::
++ logged-update-to-one
|= upd=logged-update-0:zero
?+ -.upd upd
%add-graph upd(graph (graph-to-one graph.upd))
%add-nodes upd(nodes (~(run by nodes.upd) node-to-one))
==
::
++ node-to-one
|= =node:zero
(node:(upgrade ,post:zero ,post) node post-to-one)
::
++ graph-to-one
|= =graph:zero
(graph:(upgrade ,post:zero ,post) graph post-to-one)
::
++ marked-graph-to-one
|= [=graph:zero m=(unit mark)]
[(graph-to-one graph) m]
::
++ post-to-one
|= p=post:zero
^- post
p(contents (contents-to-one contents.p))
::
++ contents-to-one
|= cs=(list content:zero)
^- (list content)
%+ murn cs
|= =content:zero
^- (unit ^content)
?: ?=(%reference -.content) ~
`content
::
++ upgrade
|* [in-pst=mold out-pst=mold]
=>
|%
++ in-orm
((ordered-map atom in-node) gth)
+$ in-node
[post=in-pst children=in-internal-graph]
+$ in-graph
((mop atom in-node) gth)
+$ in-internal-graph
$~ [%empty ~]
$% [%graph p=in-graph]
[%empty ~]
==
::
++ out-orm
((ordered-map atom out-node) gth)
+$ out-node
[post=out-pst children=out-internal-graph]
+$ out-graph
((mop atom out-node) gth)
+$ out-internal-graph
$~ [%empty ~]
$% [%graph p=out-graph]
[%empty ~]
==
--
|%
::
++ graph
|= $: gra=in-graph
fn=$-(in-pst out-pst)
==
^- out-graph
%+ gas:out-orm *out-graph
^- (list [atom out-node])
%+ turn (tap:in-orm gra)
|= [a=atom n=in-node]
^- [atom out-node]
[a (node n fn)]
::
++ node
|= [nod=in-node fn=$-(in-pst out-pst)]
^- out-node
:- (fn post.nod)
^- out-internal-graph
?: ?=(%empty -.children.nod)
[%empty ~]
[%graph (graph p.children.nod fn)]
--
:: NOTE: move these functions to zuse :: NOTE: move these functions to zuse
++ nu :: parse number as hex ++ nu :: parse number as hex
|= jon=json |= jon=json
@ -145,18 +50,17 @@
== ==
:: ::
++ index ++ index
|= i=^index |= ind=^index
^- json ^- json
?: =(~ i) s+'/' :- %s
=/ j=^tape "" ?: =(~ ind)
|- '/'
?~ i [%s (crip j)] %+ roll ind
=/ k=json (numb i.i) |= [cur=@ acc=@t]
?> ?=(%n -.k) ^- @t
%_ $ =/ num (numb cur)
i t.i ?> ?=(%n -.num)
j (weld j (weld "/" (trip +.k))) (rap 3 acc '/' p.num ~)
==
:: ::
++ uid ++ uid
|= u=^uid |= u=^uid
@ -212,6 +116,14 @@
s+(enjs-path:res grp) s+(enjs-path:res grp)
-- --
:: ::
++ maybe-post
|= mp=^maybe-post
^- json
?- -.mp
%| s+(scot %ux p.mp)
%& (post p.mp)
==
::
++ post ++ post
|= p=^post |= p=^post
^- json ^- json
@ -252,8 +164,8 @@
[%nodes (nodes nodes.upd)] [%nodes (nodes nodes.upd)]
== ==
:: ::
%remove-nodes %remove-posts
:- %remove-nodes :- %remove-posts
%- pairs %- pairs
:~ [%resource (enjs:res resource.upd)] :~ [%resource (enjs:res resource.upd)]
[%indices (indices indices.upd)] [%indices (indices indices.upd)]
@ -277,14 +189,14 @@
:- %add-tag :- %add-tag
%- pairs %- pairs
:~ [%term s+term.upd] :~ [%term s+term.upd]
[%resource (enjs:res resource.upd)] [%uid (uid uid.upd)]
== ==
:: ::
%remove-tag %remove-tag
:- %remove-tag :- %remove-tag
%- pairs %- pairs
:~ [%term s+term.upd] :~ [%term s+term.upd]
[%resource (enjs:res resource.upd)] [%uid (uid uid.upd)]
== ==
:: ::
%archive-graph %archive-graph
@ -306,9 +218,9 @@
:- %tag-queries :- %tag-queries
%- pairs %- pairs
%+ turn ~(tap by tag-queries.upd) %+ turn ~(tap by tag-queries.upd)
|= [=term =resources] |= [=term uids=(set ^uid)]
^- [cord json] ^- [cord json]
[term [%a (turn ~(tap in resources) enjs:res)]] [term [%a (turn ~(tap in uids) uid)]]
== ==
:: ::
++ graph ++ graph
@ -328,7 +240,7 @@
|= n=^node |= n=^node
^- json ^- json
%- pairs %- pairs
:~ [%post (post post.n)] :~ [%post (maybe-post post.n)]
:- %children :- %children
?- -.children.n ?- -.children.n
%empty ~ %empty ~
@ -336,7 +248,6 @@
== ==
== ==
:: ::
::
++ nodes ++ nodes
|= m=(map ^index ^node) |= m=(map ^index ^node)
^- json ^- json
@ -370,7 +281,7 @@
++ decode ++ decode
%- of %- of
:~ [%add-nodes add-nodes] :~ [%add-nodes add-nodes]
[%remove-nodes remove-nodes] [%remove-posts remove-posts]
[%add-signatures add-signatures] [%add-signatures add-signatures]
[%remove-signatures remove-signatures] [%remove-signatures remove-signatures]
:: ::
@ -422,7 +333,7 @@
:: ::
++ node ++ node
%- ot %- ot
:~ [%post post] :~ [%post maybe-post]
[%children internal-graph] [%children internal-graph]
== ==
:: ::
@ -433,6 +344,15 @@
[%empty ~] [%empty ~]
[%graph (graph jon)] [%graph (graph jon)]
:: ::
++ maybe-post
|= jon=json
^- ^maybe-post
?~ jon !!
?+ -.jon !!
%s [%| (nu jon)]
%o [%& (post jon)]
==
::
++ post ++ post
%- ot %- ot
:~ [%author (su ;~(pfix sig fed:ag))] :~ [%author (su ;~(pfix sig fed:ag))]
@ -489,9 +409,8 @@
:~ expression+so :~ expression+so
output+tang output+tang
== ==
:: ::
++ remove-nodes ++ remove-posts
%- ot %- ot
:~ [%resource dejs:res] :~ [%resource dejs:res]
[%indices (as index)] [%indices (as index)]
@ -527,13 +446,13 @@
++ add-tag ++ add-tag
%- ot %- ot
:~ [%term so] :~ [%term so]
[%resource dejs:res] [%uid uid]
== ==
:: ::
++ remove-tag ++ remove-tag
%- ot %- ot
:~ [%term so] :~ [%term so]
[%resource dejs:res] [%uid uid]
== ==
:: ::
++ keys ++ keys
@ -568,4 +487,391 @@
*signatures *signatures
== ==
-- --
::
++ upgrade
|%
::
:: +two
::
++ marked-graph-to-two
|= [=graph:one m=(unit mark)]
[(graph-to-two graph) m]
::
++ graph-to-two
|= =graph:one
(graph:(upgrade ,post:one ,maybe-post) graph post-to-two)
::
++ post-to-two
|= p=post:one
^- maybe-post
[%& p]
::
::
:: +one
::
++ update-log-to-one
|= =update-log:zero
^- update-log:one
%+ gas:orm-log:one *update-log:one
%+ turn (tap:orm-log:zero update-log)
|= [=time =logged-update:zero]
^- [^time logged-update:one]
:- time
:- p.logged-update
(logged-update-to-one q.logged-update)
::
++ logged-update-to-one
|= upd=logged-update-0:zero
^- logged-action:one
?+ -.upd upd
%add-graph upd(graph (graph-to-one graph.upd))
%add-nodes upd(nodes (~(run by nodes.upd) node-to-one))
==
::
++ node-to-one
|= =node:zero
(node:(upgrade ,post:zero ,post) node post-to-one)
::
++ graph-to-one
|= =graph:zero
(graph:(upgrade ,post:zero ,post) graph post-to-one)
::
++ marked-graph-to-one
|= [=graph:zero m=(unit mark)]
[(graph-to-one graph) m]
::
++ post-to-one
|= p=post:zero
^- post
p(contents (contents-to-one contents.p))
::
++ contents-to-one
|= cs=(list content:zero)
^- (list content)
%+ murn cs
|= =content:zero
^- (unit ^content)
?: ?=(%reference -.content) ~
`content
::
++ upgrade
|* [in-pst=mold out-pst=mold]
=>
|%
++ in-orm
((ordered-map atom in-node) gth)
+$ in-node
[post=in-pst children=in-internal-graph]
+$ in-graph
((mop atom in-node) gth)
+$ in-internal-graph
$~ [%empty ~]
$% [%graph p=in-graph]
[%empty ~]
==
::
++ out-orm
((ordered-map atom out-node) gth)
+$ out-node
[post=out-pst children=out-internal-graph]
+$ out-graph
((mop atom out-node) gth)
+$ out-internal-graph
$~ [%empty ~]
$% [%graph p=out-graph]
[%empty ~]
==
--
|%
::
++ graph
|= $: gra=in-graph
fn=$-(in-pst out-pst)
==
^- out-graph
%+ gas:out-orm *out-graph
^- (list [atom out-node])
%+ turn (tap:in-orm gra)
|= [a=atom n=in-node]
^- [atom out-node]
[a (node n fn)]
::
++ node
|= [nod=in-node fn=$-(in-pst out-pst)]
^- out-node
:- (fn post.nod)
^- out-internal-graph
?: ?=(%empty -.children.nod)
[%empty ~]
[%graph (graph p.children.nod fn)]
--
::
++ zero-load
:: =* infinitely recurses
=, store=zero
=, orm=orm:zero
=, orm-log=orm-log:zero
|%
++ change-revision-graph
|= [=graph:store q=(unit mark)]
^- [graph:store (unit mark)]
|^
:_ q
?+ q graph
[~ %graph-validator-link] convert-links
[~ %graph-validator-publish] convert-publish
==
::
++ convert-links
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:: top-level
::
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^atom =node:store]
^- [^^atom node:store]
:: existing comments get turned into containers for revisions
::
:^ atom
post.node(contents ~, hash ~)
%graph
%+ gas:orm *graph:store
:_ ~ :- %0
:_ [%empty ~]
post.node(index (snoc index.post.node atom), hash ~)
::
++ convert-publish
%+ gas:orm *graph:store
%+ turn (tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:: top-level
::
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^atom =node:store]
^- [^^atom node:store]
:: existing container for publish note revisions
::
?+ atom !!
%1 [atom node]
%2
:+ atom post.node
?: ?=(%empty -.children.node)
[%empty ~]
:- %graph
%+ gas:orm *graph:store
%+ turn (tap:orm p.children.node)
|= [=^^atom =node:store]
^- [^^^atom node:store]
:+ atom post.node(contents ~, hash ~)
:- %graph
%+ gas:orm *graph:store
:_ ~ :- %1
:_ [%empty ~]
post.node(index (snoc index.post.node atom), hash ~)
==
--
::
++ maybe-unix-to-da
|= =atom
^- @
:: (bex 127) is roughly 226AD
?. (lte atom (bex 127))
atom
(add ~1970.1.1 (div (mul ~s1 atom) 1.000))
::
++ convert-unix-timestamped-node
|= =node:store
^- node:store
=. index.post.node
(convert-unix-timestamped-index index.post.node)
?. ?=(%graph -.children.node)
node
:+ post.node
%graph
(convert-unix-timestamped-graph p.children.node)
::
++ convert-unix-timestamped-index
|= =index:store
(turn index maybe-unix-to-da)
::
++ convert-unix-timestamped-graph
|= =graph:store
%+ gas:orm *graph:store
%+ turn
(tap:orm graph)
|= [=atom =node:store]
^- [^atom node:store]
:- (maybe-unix-to-da atom)
(convert-unix-timestamped-node node)
--
--
++ import
|= [arc=* our=ship]
^- (quip card:agent:gall [%5 network])
|^
=/ sty [%5 (remake-network ;;(tree-network +.arc))]
:_ sty
%+ turn ~(tap by graphs.sty)
|= [rid=resource =marked-graph]
^- card:agent:gall
?: =(our entity.rid)
=/ =cage [%push-hook-action !>([%add rid])]
[%pass / %agent [our %graph-push-hook] %poke cage]
(try-rejoin rid 0)
::
+$ tree-network
$: graphs=tree-graphs
tag-queries=(tree [term (tree uid)])
update-logs=tree-update-logs
archive=tree-graphs
~
==
+$ tree-graphs (tree [resource tree-marked-graph])
+$ tree-marked-graph [p=tree-graph q=(unit ^mark)]
+$ tree-graph (tree [atom tree-node])
+$ tree-node [post=tree-maybe-post children=tree-internal-graph]
+$ tree-internal-graph
$~ [%empty ~]
$% [%graph p=tree-graph]
[%empty ~]
==
+$ tree-update-logs (tree [resource tree-update-log])
+$ tree-update-log (tree [time tree-logged-update])
+$ tree-logged-update
$: p=time
$= q
$% [%add-graph =resource =tree-graph mark=(unit ^mark) ow=?]
[%add-nodes =resource nodes=(tree [index tree-node])]
[%remove-posts =resource indices=(tree index)]
[%add-signatures =uid signatures=tree-signatures]
[%remove-signatures =uid signatures=tree-signatures]
==
==
+$ tree-signatures (tree signature)
+$ tree-maybe-post (each tree-post hash)
+$ tree-post
$: author=ship
=index
time-sent=time
contents=(list content)
hash=(unit hash)
signatures=tree-signatures
==
::
++ remake-network
|= t=tree-network
^- network
:* (remake-graphs graphs.t)
(remake-jug:migrate tag-queries.t)
(remake-update-logs update-logs.t)
(remake-graphs archive.t)
~
==
::
++ remake-graphs
|= t=tree-graphs
^- graphs
%- remake-map:migrate
(~(run by t) remake-marked-graph)
::
++ remake-marked-graph
|= t=tree-marked-graph
^- marked-graph
[(remake-graph p.t) q.t]
::
++ remake-graph
|= t=tree-graph
^- graph
%+ gas:orm *graph
%+ turn ~(tap by t)
|= [a=atom tn=tree-node]
^- [atom node]
[a (remake-node tn)]
::
++ remake-internal-graph
|= t=tree-internal-graph
^- internal-graph
?: ?=(%empty -.t)
[%empty ~]
[%graph (remake-graph p.t)]
::
++ remake-node
|= t=tree-node
^- node
:- (remake-post post.t)
(remake-internal-graph children.t)
::
++ remake-update-logs
|= t=tree-update-logs
^- update-logs
%- remake-map:migrate
(~(run by t) remake-update-log)
::
++ remake-update-log
|= t=tree-update-log
^- update-log
=/ ulm ((ordered-map time logged-update) gth)
%+ gas:ulm *update-log
%+ turn ~(tap by t)
|= [=time tlu=tree-logged-update]
^- [^time logged-update]
[time (remake-logged-update tlu)]
::
++ remake-logged-update
|= t=tree-logged-update
^- logged-update
:- p.t
?- -.q.t
%add-graph
:* %add-graph
resource.q.t
(remake-graph tree-graph.q.t)
mark.q.t
ow.q.t
==
::
%add-nodes
:- %add-nodes
:- resource.q.t
%- remake-map:migrate
(~(run by nodes.q.t) remake-node)
::
%remove-posts
[%remove-posts resource.q.t (remake-set:migrate indices.q.t)]
::
%add-signatures
[%add-signatures uid.q.t (remake-set:migrate signatures.q.t)]
::
%remove-signatures
[%remove-signatures uid.q.t (remake-set:migrate signatures.q.t)]
==
::
++ remake-post
|= t=tree-maybe-post
^- maybe-post
?- -.t
%| t
%& t(signatures.p (remake-set:migrate signatures.p.t))
==
::
++ try-rejoin
|= [rid=resource nack-count=@]
^- 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]
--
-- --

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

@ -1,6 +1,14 @@
/- *resource /- *resource
/+ store=graph-store /+ store=graph-store
|_ =bowl:gall |_ =bowl:gall
++ cg
|%
++ update
|= =update:store
^- cage
[%graph-update-2 !>(update)]
--
::
++ scry-for ++ scry-for
|* [=mold =path] |* [=mold =path]
.^ mold .^ mold
@ -19,7 +27,7 @@
%add-graph ~[resource.q.update] %add-graph ~[resource.q.update]
%remove-graph ~[resource.q.update] %remove-graph ~[resource.q.update]
%add-nodes ~[resource.q.update] %add-nodes ~[resource.q.update]
%remove-nodes ~[resource.q.update] %remove-posts ~[resource.q.update]
%add-signatures ~[resource.uid.q.update] %add-signatures ~[resource.uid.q.update]
%remove-signatures ~[resource.uid.q.update] %remove-signatures ~[resource.uid.q.update]
%archive-graph ~[resource.q.update] %archive-graph ~[resource.q.update]
@ -76,6 +84,7 @@
++ get-graph ++ get-graph
|= res=resource |= res=resource
^- update:store ^- update:store
=- -(p *time)
%+ scry-for update:store %+ scry-for update:store
/graph/(scot %p entity.res)/[name.res] /graph/(scot %p entity.res)/[name.res]
:: ::

21
pkg/arvo/lib/group.hoon
View File

@ -34,10 +34,12 @@
:: ::
++ scry-group ++ scry-group
|= rid=resource |= rid=resource
^- (unit group)
%+ scry-for ,(unit group) %+ scry-for ,(unit group)
`path`groups+(en-path:resource rid) `path`groups+(en-path:resource rid)
:: ::
++ scry-groups ++ scry-groups
^- (set resource)
.^ ,(set resource) .^ ,(set resource)
%gy %gy
(scot %p our.bowl) (scot %p our.bowl)
@ -48,6 +50,7 @@
:: ::
++ members ++ members
|= rid=resource |= rid=resource
^- (set ship)
=; =group =; =group
members.group members.group
(fall (scry-group rid) *group) (fall (scry-group rid) *group)
@ -75,7 +78,12 @@
=/ grp=(unit group) =/ grp=(unit group)
(scry-group rid) (scry-group rid)
?~ grp ~ ?~ grp ~
=* group u.grp (role-for-ship-with-group u.grp rid ship)
::
++ role-for-ship-with-group
|= [grp=group rid=resource =ship]
^- (unit (unit role-tag))
=* group grp
=* policy policy.group =* policy policy.group
=* tags tags.group =* tags tags.group
=/ admins=(set ^ship) =/ admins=(set ^ship)
@ -96,6 +104,7 @@
:: ::
++ can-join ++ can-join
|= [rid=resource =ship] |= [rid=resource =ship]
^- ?
%+ scry-for ,? %+ scry-for ,?
^- path ^- path
:- %groups :- %groups
@ -106,11 +115,17 @@
^- (set ship) ^- (set ship)
=/ grp=(unit group) =/ grp=(unit group)
(scry-group rid) (scry-group rid)
?~ grp ~ ?~ grp ~
(~(get ju tags.u.grp) tag) (get-tagged-ships-with-group u.grp rid tag)
::
++ get-tagged-ships-with-group
|= [grp=group rid=resource =tag]
^- (set ship)
(~(get ju tags.grp) tag)
:: ::
++ is-managed ++ is-managed
|= rid=resource |= rid=resource
^- ?
=/ group=(unit group) =/ group=(unit group)
(scry-group rid) (scry-group rid)
?~ group %.n ?~ group %.n

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

@ -4,6 +4,247 @@
=< [. sur] =< [. sur]
=, sur =, sur
|% |%
++ upgrade
|%
++ to-three
=* two state-two
=* three state-three
|%
++ index
|= =index:two
^- (unit index:three)
`index
++ contents
|= =contents:two
^- (unit contents:three)
?. ?=(%group -.contents)
`contents
=- ?: =(~ -) ~
`[%group -]
%+ murn list.contents
|= =group-contents:two
^- (unit group-contents:three)
?: ?=(?(%add %remove) -.group-contents)
~
`group-contents
::
++ stats-index
|= =stats-index:two
^- (unit stats-index:three)
`stats-index
::
++ notifications
upg-notifications:upg
::
++ upg
%. [index stats-index contents]
%: upgrade
index:two
stats-index:two
contents:two
index:three
stats-index:three
contents:three
==
--
::
++ to-four
=* three state-three
=* four state-four
|%
++ index
|= =index:three
^- (unit index:four)
`index
++ contents
|= =contents:three
^- (unit contents:four)
?. ?=(%graph -.contents)
`contents
`[%graph (turn list.contents post-to-one:upgrade:graph-store)]
::
++ unreads-each
upg-unreads-each:upg
::
++ notifications
upg-notifications:upg
::
++ stats-index
|= =stats-index:three
^- (unit stats-index:four)
`stats-index
::
++ upg
%. [index stats-index contents]
%: upgrade
index:three
stats-index:three
contents:three
index:four
stats-index:four
contents:four
==
--
::
++ to-five
=* four state-four
=* five sur
|%
++ mark
|= module=@t
^- (unit @t)
?+ module ~
%chat `%graph-validator-chat
%publish `%graph-validator-publish
%link `%graph-validator-link
==
++ index
|= =index:four
^- (unit index:five)
?: ?=(%group -.index)
`index
=* i index
`[%graph graph.i (mark module.i) description.i index.i]
::
++ contents
|= =contents:four
^- (unit contents:five)
`contents
::
++ unreads-each
upg-unreads-each:upg
::
++ stats-index
|= =stats-index:four
^- (unit stats-index:five)
`stats-index
::
++ upg
%. [index stats-index contents]
%: upgrade
index:four
stats-index:four
contents:four
index:five
stats-index:five
contents:five
==
++ notifications
upg-notifications:upg
--
::
++ upgrade
|* $: :: input molds
in-index=mold
in-stats-index=mold
in-contents=mold
:: output molds
out-index=mold
out-stats-index=mold
out-contents=mold
==
=> . =>
|%
::
++ in
|%
::
+$ index in-index
+$ stats-index in-stats-index
+$ contents in-contents
+$ unreads-each (jug stats-index index)
+$ timebox (map index notification)
+$ notification
[date=@da read=? =contents]
++ orm
((ordered-map time timebox) gth)
+$ notifications
((mop time timebox) gth)
--
++ out
|%
::
::
+$ index out-index
+$ stats-index out-stats-index
+$ contents out-contents
+$ timebox (map out-index notification)
+$ unreads-each (jug stats-index index)
+$ notification
[date=@da read=? contents=out-contents]
+$ notifications
((mop time timebox) gth)
++ orm
((ordered-map time timebox) gth)
--
--
|= $: fun-index=$-(index:in (unit index:out))
fun-stats-index=$-(stats-index:in (unit stats-index:out))
fun-contents=$-(contents:in (unit contents:out))
==
|%
::
++ upg-unreads-each
|= =unreads-each:in
^- unreads-each:out
%- ~(gas by *unreads-each:out)
%+ murn ~(tap by unreads-each)
|= [=stats-index:in indices=(set index:in)]
^- (unit [stats-index:out (set index:out)])
=/ new-stats
(fun-stats-index stats-index)
?~ new-stats ~
=/ new-indices
(upg-indices indices)
?: =(0 ~(wyt ^in new-indices)) ~
`[u.new-stats new-indices]
::
++ upg-indices
|= indices=(set index:in)
^- (set index:out)
%- ~(gas ^in *(set index:out))
(murn ~(tap ^in indices) fun-index)
::
++ upg-notifications
|= =notifications:in
^- notifications:out
%+ gas:orm:out *notifications:out
^- (list [@da timebox:out])
%+ murn (tap:orm:in notifications)
|= [time=@da =timebox:in]
^- (unit [@da =timebox:out])
=/ new-timebox=timebox:out
(upg-timebox timebox)
?: =(0 ~(wyt by timebox))
~
`[time new-timebox]
::
++ upg-timebox
|= =timebox:in
^- timebox:out
%- ~(gas by *timebox:out)
%+ murn ~(tap by timebox)
|= [=index:in =notification:in]
^- (unit [index:out notification:out])
=/ new-index
(fun-index index)
?~ new-index ~
=/ new-notification
(upg-notification notification)
?~ new-notification ~
`[u.new-index u.new-notification]
::
++ upg-notification
|= n=notification:in
^- (unit notification:out)
=/ new-contents
(fun-contents contents.n)
?~ new-contents ~
`[date.n read.n u.new-contents]
--
--
++ dejs ++ dejs
=, dejs:format =, dejs:format
|% |%
@ -21,9 +262,8 @@
:: ::
++ graph-index ++ graph-index
%- ot %- ot
:~ group+dejs-path:resource :~ graph+dejs-path:resource
graph+dejs-path:resource mark+(mu so)
module+so
description+so description+so
index+(su ;~(pfix fas (more fas dem))) index+(su ;~(pfix fas (more fas dem)))
== ==
@ -47,9 +287,9 @@
`@da`(rash p.jon dem:ag) `@da`(rash p.jon dem:ag)
:: ::
++ notif-ref ++ notif-ref
^- $-(json [@da ^index]) ^- $-(json [(unit @da) ^index])
%- ot %- ot
:~ time+sd :~ time+(mu sd)
index+index index+index
== ==
++ graph-store-index ++ graph-store-index
@ -70,8 +310,7 @@
%- of %- of
:~ seen+ul :~ seen+ul
archive+notif-ref archive+notif-ref
unread-note+notif-ref read-note+index
read-note+notif-ref
add-note+add add-note+add
set-dnd+bo set-dnd+bo
read-count+stats-index read-count+stats-index
@ -100,12 +339,21 @@
%unread-count (unread-count +.upd) %unread-count (unread-count +.upd)
%remove-graph s+(enjs-path:resource +.upd) %remove-graph s+(enjs-path:resource +.upd)
%seen-index (seen-index +.upd) %seen-index (seen-index +.upd)
%unreads (unreads +.upd) %unreads (unreads +.upd)
%read-note (index +.upd)
%note-read (note-read +.upd)
:: ::
?(%archive %read-note %unread-note) %archive
(notif-ref +.upd) (notif-ref +.upd)
== ==
:: ::
++ note-read
|= [tim=@da idx=^index]
%- pairs
:~ time+s+(scot %ud tim)
index+(index idx)
==
::
++ stats-index ++ stats-index
|= s=^stats-index |= s=^stats-index
%+ frond -.s %+ frond -.s
@ -151,23 +399,21 @@
^- json ^- json
%- pairs %- pairs
:~ unreads+(unread unreads.s) :~ unreads+(unread unreads.s)
notifications+a+(turn ~(tap in notifications.s) notif-ref)
last+(time last-seen.s) last+(time last-seen.s)
== ==
++ added ++ added
|= [tim=@da idx=^index not=^notification] |= [idx=^index not=^notification]
^- json ^- json
%- pairs %- pairs
:~ time+s+(scot %ud tim) :~ index+(index idx)
index+(index idx)
notification+(notification not) notification+(notification not)
== ==
:: ::
++ notif-ref ++ notif-ref
|= [tim=@da idx=^index] |= [tim=(unit @da) idx=^index]
^- json ^- json
%- pairs %- pairs
:~ time+s+(scot %ud tim) :~ [%time ?~(tim ~ s+(scot %ud u.tim))]
index+(index idx) index+(index idx)
== ==
++ seen-index ++ seen-index
@ -193,17 +439,15 @@
== ==
:: ::
++ graph-index ++ graph-index
|= $: group=resource |= $: graph=resource
graph=resource mark=(unit mark)
module=@t
description=@t description=@t
idx=index:graph-store idx=index:graph-store
== ==
^- json ^- json
%- pairs %- pairs
:~ group+s+(enjs-path:resource group) :~ graph+s+(enjs-path:resource graph)
graph+s+(enjs-path:resource graph) mark+s+(fall mark '')
module+s+module
description+s+description description+s+description
index+(index:enjs:graph-store idx) index+(index:enjs:graph-store idx)
== ==
@ -222,7 +466,6 @@
^- json ^- json
%- pairs %- pairs
:~ time+(time date) :~ time+(time date)
read+b+read
contents+(^contents contents) contents+(^contents contents)
== ==
:: ::
@ -259,11 +502,10 @@
== ==
:: ::
++ timebox ++ timebox
|= [tim=@da arch=? l=(list [^index ^notification])] |= [tim=(unit @da) l=(list [^index ^notification])]
^- json ^- json
%- pairs %- pairs
:~ time+s+(scot %ud tim) :~ time+`json`?~(tim ~ s+(scot %ud u.tim))
archive+b+arch
:- %notifications :- %notifications
^- json ^- json
:- %a :- %a

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

@ -108,6 +108,7 @@
%metadata-pull-hook %metadata-pull-hook
%group-view %group-view
%settings-store %settings-store
%dm-hook
== ==
:: ::
++ deft-fish :: default connects ++ deft-fish :: default connects
@ -258,6 +259,8 @@
=> (se-born | %home %contact-pull-hook) => (se-born | %home %contact-pull-hook)
=> (se-born | %home %settings-store) => (se-born | %home %settings-store)
(se-born | %home %group-view) (se-born | %home %group-view)
=? ..on-load (lte hood-version %13)
(se-born | %home %dm-hook)
..on-load ..on-load
:: ::
++ reap-phat :: ack connect ++ reap-phat :: ack connect

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

@ -55,6 +55,12 @@
cas=case :: cas=case ::
gim=?(%auto germ) :: gim=?(%auto germ) ::
== ==
+$ kiln-fuse
$@ ~
$: syd=desk
bas=beak
con=(list [beak germ])
==
-- --
|= [bowl:gall state] |= [bowl:gall state]
?> =(src our) ?> =(src our)
@ -381,6 +387,11 @@
?~ +< abet ?~ +< abet
abet:abet:(merge:(work syd) ali sud cas gim) abet:abet:(merge:(work syd) ali sud cas gim)
:: ::
++ poke-fuse
|= k=kiln-fuse
?~ k abet
abet:(emit [%pass /kiln/fuse/[syd.k] %arvo %c [%fuse syd.k bas.k con.k]])
::
++ poke-cancel ++ poke-cancel
|= a=@tas |= a=@tas
abet:(emit %pass /cancel %arvo %c [%drop a]) abet:(emit %pass /cancel %arvo %c [%drop a])
@ -430,6 +441,7 @@
%kiln-info =;(f (f !<(_+<.f vase)) poke-info) %kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label) %kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge) %kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
%kiln-fuse =;(f (f !<(_+<.f vase)) poke-fuse)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount) %kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-ota =;(f (f !<(_+<.f vase)) poke:update) %kiln-ota =;(f (f !<(_+<.f vase)) poke:update)
%kiln-ota-info =;(f (f !<(_+<.f vase)) poke-ota-info) %kiln-ota-info =;(f (f !<(_+<.f vase)) poke-ota-info)
@ -489,6 +501,8 @@
++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler ++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler
++ take-mere :: ++ take-mere ::
|= [way=wire are=(each (set path) (pair term tang))] |= [way=wire are=(each (set path) (pair term tang))]
?. ?=([@ ~] way)
abet
abet:abet:(mere:(take way) are) abet:abet:(mere:(take way) are)
:: ::
++ take-coup-fancy :: ++ take-coup-fancy ::

59
pkg/arvo/lib/json/rpc.hoon
View File

@ -17,7 +17,7 @@
|= request |= request
^- json ^- json
%- pairs:enjs:format %- pairs:enjs:format
:~ jsonrpc+s+'0.2' :~ jsonrpc+s+'2.0'
id+s+id id+s+id
method+s+method method+s+method
:: ::
@ -25,7 +25,9 @@
^- json ^- json
?- -.params ?- -.params
%list [%a +.params] %list [%a +.params]
%map [%o +.params] :: FIXME: support either %map or %object (also in /sur/json/rpc)
::
%map [%o +.params]
%object [%o (~(gas by *(map @t json)) +.params)] %object [%o (~(gas by *(map @t json)) +.params)]
== == == ==
:: ::
@ -35,14 +37,16 @@
:: TODO: consider all cases :: TODO: consider all cases
:: ::
?+ -.response ~|([%unsupported-rpc-response response] !!) ?+ -.response ~|([%unsupported-rpc-response response] !!)
%batch a+(turn bas.response response-to-json)
::
%result %result
:- %o :- %o
%- molt %- molt
^- (list [@t json]) ^- (list [@t json])
:: FIXME: return 'id' as string, number or NULL :: FIXME: return 'id' as string, number or NULL
:: ::
:~ ['jsonrpc' s+'2.0'] :~ ['jsonrpc' s+'2.0']
['id' s+id.response] ['id' s+id.response]
['result' res.response] ['result' res.response]
== ==
:: ::
@ -50,39 +54,48 @@
:- %o :- %o
%- molt %- molt
^- (list [@t json]) ^- (list [@t json])
:~ ['jsonrpc' s+'2.0'] :~ ['jsonrpc' s+'2.0']
['id' ?~(id.response ~ s+id.response)] ['id' ?~(id.response ~ s+id.response)]
['code' n+code.response] ['code' n+code.response]
['message' s+message.response] ['message' s+message.response]
== ==
== ==
:: ::
++ validate-request ++ validate-request
|= [body=(unit octs) parse-method=$-(@t term)] |= body=(unit octs)
^- (unit request) ^- (unit batch-request)
?~ body ~ ?~ body ~
?~ jon=(de-json:html q.u.body) ~ ?~ jon=(de-json:html q.u.body) ~
:: ignores non-object responses =, dejs-soft:format
:: =; reparser
:: ?. ?=([%o *] json) ~|([%format-not-valid json] !!) ?: ?=([%a *] u.jon)
?. ?=([%o *] u.jon) ~ (bind ((ar reparser) u.jon) (lead %a))
%- some (bind (reparser u.jon) (lead %o))
%. u.jon
=, dejs:format
:: TODO: If parsing fails, return a proper error (not 500)
::
%- ot %- ot
:~ :: FIXME: parse 'id' as string, number or NULL :~ :: FIXME: parse 'id' as string, number or NULL
:: ::
['id' so] ['id' so]
['jsonrpc' (su (jest '2.0'))] ['jsonrpc' (su (jest '2.0'))]
['method' (cu parse-method so)] ['method' so]
:: ::
:- 'params' :- 'params'
|= =json |= =json
^- request-params ^- (unit request-params)
?+ -.json !! ?+ -.json ~
%a [%list ((ar same) json)] %a `[%list ((ar:dejs:format same) json)]
%o [%map ((om same) json)] %o `[%map ((om:dejs:format same) json)]
== == == ==
::
++ error
|_ id=@t
:: https://www.jsonrpc.org/specification#error_object
::
++ parse [%error id '-32700' 'Failed to parsed']
++ request [%error id '-32600' 'Invalid Request']
++ method [%error id '-32601' 'Method not found']
++ params [%error id '-32602' 'Invalid params']
++ internal [%error id '-32603' 'Internal error']
++ not-found [%error id '-32000' 'Resource not found']
++ todo [%error id '-32001' 'Method not implemented']
--
-- --

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

@ -21,7 +21,10 @@
(most ;~(plug com gaw) taut-rule) (most ;~(plug com gaw) taut-rule)
:: ::
%+ rune tis %+ rune tis
;~(plug sym ;~(pfix gap fas (more fas urs:ab))) ;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
:: ::
%+ rune cen %+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym))) ;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
@ -37,7 +40,7 @@
;~ (glue gap) ;~ (glue gap)
sym sym
;~(pfix cen sym) ;~(pfix cen sym)
;~(pfix fas (more fas urs:ab)) stap
== ==
:: ::
%+ stag %tssg %+ stag %tssg

11
pkg/arvo/lib/launch-store.hoon
View File

@ -71,7 +71,12 @@
[%'linkedUrl' s+linked-url.type] [%'linkedUrl' s+linked-url.type]
== ==
:: ::
%custom (frond %custom ~) %custom
%+ frond %custom
%- pairs
:~ [%'linkedUrl' ?~(linked-url.type ~ s+u.linked-url.type)]
[%'image' ?~(image.type ~ s+u.image.type)]
==
== ==
:: ::
++ terms ++ terms
@ -105,10 +110,10 @@
[%'isShown' bo] [%'isShown' bo]
== ==
:: ::
++ tile-type ++ tile-type
%- of %- of
:~ [%basic basic] :~ [%basic basic]
[%custom ul] [%custom (ot [%'linkedUrl' (mu so)] [%'image' (mu so)] ~)]
== ==
:: ::
++ basic ++ basic

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

@ -23,13 +23,13 @@
%+ turn ~(tap by associations) %+ turn ~(tap by associations)
|= [=md-resource [group=resource =^metadatum]] |= [=md-resource [group=resource =^metadatum]]
^- [cord json] ^- [cord json]
:- :- %: rap 3
%- crip (spat (en-path:resource group))
;: weld '/'
(trip (spat (en-path:resource group))) app-name.md-resource
(weld "/" (trip app-name.md-resource)) (spat (en-path:resource resource.md-resource))
(trip (spat (en-path:resource resource.md-resource))) ~
== ==
%- pairs %- pairs
:~ [%group s+(enjs-path:resource group)] :~ [%group s+(enjs-path:resource group)]
[%app-name s+app-name.md-resource] [%app-name s+app-name.md-resource]

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

@ -53,6 +53,7 @@
:: ::
++ app-metadata-for-group ++ app-metadata-for-group
|= [group=resource =app-name:store] |= [group=resource =app-name:store]
^- associations:store
=/ =associations:store =/ =associations:store
(metadata-for-group group) (metadata-for-group group)
%- ~(gas by *associations:store) %- ~(gas by *associations:store)
@ -62,6 +63,7 @@
:: ::
++ metadata-for-group ++ metadata-for-group
|= group=resource |= group=resource
^- associations:store
.^ associations:store .^ associations:store
%gx (scot %p our.bowl) %metadata-store (scot %da now.bowl) %gx (scot %p our.bowl) %metadata-store (scot %da now.bowl)
%group (snoc (en-path:resource group) %noun) %group (snoc (en-path:resource group) %noun)
@ -69,6 +71,7 @@
:: ::
++ md-resources-from-group ++ md-resources-from-group
|= group=resource |= group=resource
^- (set md-resource:store)
=- (~(get ju -) group) =- (~(get ju -) group)
.^ (jug resource md-resource:store) .^ (jug resource md-resource:store)
%gy %gy
@ -80,6 +83,7 @@
:: ::
++ peek-association ++ peek-association
|= [app-name=term rid=resource] |= [app-name=term rid=resource]
^- (unit association:store)
.^ (unit association:store) .^ (unit association:store)
%gx (scot %p our.bowl) %metadata-store (scot %da now.bowl) %gx (scot %p our.bowl) %metadata-store (scot %da now.bowl)
%metadata app-name (snoc (en-path:resource rid) %noun) %metadata app-name (snoc (en-path:resource rid) %noun)
@ -87,6 +91,7 @@
:: ::
++ peek-metadatum ++ peek-metadatum
|= =md-resource:store |= =md-resource:store
^- (unit metadatum:store)
%+ bind (peek-association md-resource) %+ bind (peek-association md-resource)
|=(association:store metadatum) |=(association:store metadatum)
:: ::

69
pkg/arvo/lib/naive-transactions.hoon
View File

@ -19,24 +19,54 @@
=, secp256k1:secp:crypto =, secp256k1:secp:crypto
%- address-from-pub:key:ethereum %- address-from-pub:key:ethereum
%- serialize-point %- serialize-point
(ecdsa-raw-recover (keccak-256:keccak:crypto dat) v r s) (ecdsa-raw-recover (hash-tx dat) v r s)
?- -.result ?- -.result
%| ~ %| ~
%& `p.result %& `p.result
== ==
:: Verify signature and produce signer address
::
++ verify-sig
|= [sig=@ txdata=octs]
^- (unit address)
|^
:: Reversed of the usual r-s-v order because Ethereum integers are
:: big-endian
::
=^ v sig (take 3)
=^ s sig (take 3 32)
=^ r sig (take 3 32)
:: In Ethereum, v is generally 27 + recid, and verifier expects a
:: recid. Old versions of geth used 0 + recid, so most software
:: now supports either format. See:
::
:: https://github.com/ethereum/go-ethereum/issues/2053
::
=? v (gte v 27) (sub v 27)
(verifier txdata v r s)
::
++ take
|= =bite
[(end bite sig) (rsh bite sig)]
--
::
++ unsigned-tx
|= [chain-id=@ud =nonce tx=octs]
^- octs
=/ prepared-data (prepare-for-sig chain-id nonce tx)
=/ len (rsh [3 2] (scot %ui p.prepared-data))
%: cad:naive 3
26^'\19Ethereum Signed Message:\0a'
(met 3 len)^len
prepared-data
~
==
:: ::
++ sign-tx ++ sign-tx
|= [pk=@ =nonce tx=octs] ^- octs |= [pk=@ =nonce tx=octs] ^- octs
=/ prepared-data (prepare-for-sig 1.337 nonce tx)
=/ sign-data =/ sign-data
=/ len (rsh [3 2] (scot %ui p.prepared-data)) %- hash-tx
%- keccak-256:keccak:crypto (unsigned-tx 1.337 nonce tx)
%: cad:naive 3
26^'\19Ethereum Signed Message:\0a'
(met 3 len)^len
prepared-data
~
==
=+ (ecdsa-raw-sign:secp256k1:secp:crypto sign-data pk) =+ (ecdsa-raw-sign:secp256k1:secp:crypto sign-data pk)
(cad:naive 3 1^v 32^s 32^r tx ~) (cad:naive 3 1^v 32^s 32^r tx ~)
:: ::
@ -53,6 +83,18 @@
~ ~
== ==
:: ::
++ extract-address
|= [=raw-tx:naive nas=^state:naive chain-id=@]
^- (unit @ux)
?~ point=(get:orm:naive points.nas ship.from.tx.raw-tx)
~
=/ =nonce:naive
=< nonce
(proxy-from-point:naive proxy.from.tx.raw-tx u.point)
=/ message=octs
(unsigned-tx chain-id nonce raw.raw-tx)
(verify-sig sig.raw-tx message)
::
++ gen-tx ++ gen-tx
|= [=nonce tx=tx:naive pk=@] ^- octs |= [=nonce tx=tx:naive pk=@] ^- octs
:: takes in a nonce, tx:naive, and private key and returned a signed transactions as octs :: takes in a nonce, tx:naive, and private key and returned a signed transactions as octs
@ -161,4 +203,11 @@
:: ::
-- --
:: ::
++ hash-tx keccak-256:keccak:crypto
::
++ hash-raw-tx
|= =raw-tx:naive
^- @ux
(hash-tx raw.raw-tx)
::
-- --

21
pkg/arvo/lib/naive.hoon
View File

@ -139,6 +139,7 @@
+$ nonce @ud +$ nonce @ud
+$ dominion ?(%l1 %l2 %spawn) +$ dominion ?(%l1 %l2 %spawn)
+$ keys [=life suite=@ud auth=@ crypt=@] +$ keys [=life suite=@ud auth=@ crypt=@]
++ orm ((on ship point) por)
++ point ++ point
$: :: domain $: :: domain
:: ::
@ -187,7 +188,7 @@
=operators =operators
dns=(list @t) dns=(list @t)
== ==
+$ points (map ship point) +$ points (tree [ship point])
+$ operators (jug address address) +$ operators (jug address address)
+$ effects (list diff) +$ effects (list diff)
+$ proxy ?(%own %spawn %manage %vote %transfer) +$ proxy ?(%own %spawn %manage %vote %transfer)
@ -455,7 +456,7 @@
++ get-point ++ get-point
|= [=state =ship] |= [=state =ship]
^- (unit point) ^- (unit point)
=/ existing (~(get by points.state) ship) =/ existing (get:orm points.state ship)
?^ existing ?^ existing
`u.existing `u.existing
=| =point =| =point
@ -517,7 +518,7 @@
=/ the-point (get-point state ship) =/ the-point (get-point state ship)
?> ?=(^ the-point) ?> ?=(^ the-point)
=* point u.the-point =* point u.the-point
=- [effects state(points (~(put by points.state) ship new-point))] =- [effects state(points (put:orm points.state ship new-point))]
^- [=effects new-point=^point] ^- [=effects new-point=^point]
:: ::
?: =(log-name changed-spawn-proxy:log-names) ?: =(log-name changed-spawn-proxy:log-names)
@ -690,7 +691,7 @@
== ==
:: ::
:- [%nonce ship proxy nonce]~ :- [%nonce ship proxy nonce]~
(~(put by points.state) ship u.point) (put:orm points.state ship u.point)
:: ::
:: Receive an individual L2 transaction :: Receive an individual L2 transaction
:: ::
@ -726,7 +727,7 @@
=/ res=(unit [=effects new-point=^point]) (fun u.point rest) =/ res=(unit [=effects new-point=^point]) (fun u.point rest)
?~ res ?~ res
~ ~
`[effects.u.res state(points (~(put by points.state) ship new-point.u.res))] `[effects.u.res state(points (put:orm points.state ship new-point.u.res))]
:: ::
++ w-point-esc ++ w-point-esc
|* [fun=$-([ship point *] (unit [effects point])) =ship rest=*] |* [fun=$-([ship point *] (unit [effects point])) =ship rest=*]
@ -736,7 +737,7 @@
=/ res=(unit [=effects new-point=^point]) (fun u.point rest) =/ res=(unit [=effects new-point=^point]) (fun u.point rest)
?~ res ?~ res
~ ~
`[effects.u.res state(points (~(put by points.state) ship new-point.u.res))] `[effects.u.res state(points (put:orm points.state ship new-point.u.res))]
:: ::
++ w-point-spawn ++ w-point-spawn
|* [fun=$-([ship point *] (unit [effects point])) =ship rest=*] |* [fun=$-([ship point *] (unit [effects point])) =ship rest=*]
@ -747,7 +748,7 @@
=/ res=(unit [=effects new-point=^point]) (fun u.point rest) =/ res=(unit [=effects new-point=^point]) (fun u.point rest)
?~ res ?~ res
~ ~
`[effects.u.res state(points (~(put by points.state) ship new-point.u.res))] `[effects.u.res state(points (put:orm points.state ship new-point.u.res))]
:: ::
++ process-transfer-point ++ process-transfer-point
|= [=point to=address reset=?] |= [=point to=address reset=?]
@ -778,7 +779,7 @@
?: =(0 life.keys.net.point) ?: =(0 life.keys.net.point)
`rift.net.point `rift.net.point
:- [%point ship %rift +(rift.net.point)]~ :- [%point ship %rift +(rift.net.point)]~
+(rift.net.point) +(rift.net.point)
=/ effects-4 =/ effects-4
:~ [%point ship %spawn-proxy *address] :~ [%point ship %spawn-proxy *address]
[%point ship %management-proxy *address] [%point ship %management-proxy *address]
@ -811,7 +812,7 @@
:: ::
:: TODO: verify this means the ship exists on neither L1 nor L2 :: TODO: verify this means the ship exists on neither L1 nor L2
:: ::
?: (~(has by points.state) ship) (debug %spawn-exists ~) ?^ (get:orm points.state ship) (debug %spawn-exists ~)
:: Assert one-level-down :: Assert one-level-down
:: ::
?. =(+((ship-rank parent)) (ship-rank ship)) (debug %bad-rank ~) ?. =(+((ship-rank parent)) (ship-rank ship)) (debug %bad-rank ~)
@ -843,7 +844,7 @@
address.owner.own address.owner.own.u.parent-point address.owner.own address.owner.own.u.parent-point
address.transfer-proxy.own to address.transfer-proxy.own to
== ==
`[effects state(points (~(put by points.state) ship new-point))] `[effects state(points (put:orm points.state ship new-point))]
:: ::
++ process-configure-keys ++ process-configure-keys
|= [=point crypt=@ auth=@ suite=@ breach=?] |= [=point crypt=@ auth=@ suite=@ breach=?]

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

@ -90,7 +90,12 @@
$: tracking=(map resource track) $: tracking=(map resource track)
inner-state=vase inner-state=vase
== ==
::
+$ base-state-3
$: prev-version=@ud
prev-min-version=@ud
base-state-2
==
:: ::
+$ state-0 [%0 base-state-0] +$ state-0 [%0 base-state-0]
:: ::
@ -100,12 +105,23 @@
:: ::
+$ state-3 [%3 base-state-2] +$ state-3 [%3 base-state-2]
:: ::
+$ state-4 [%4 base-state-3]
::
+$ versioned-state +$ versioned-state
$% state-0 $% state-0
state-1 state-1
state-2 state-2
state-3 state-3
state-4
== ==
:: +diplomatic: only renegotiate if versions changed
::
:: If %.n please leave note as to why renegotiation necessary
::
::
++ diplomatic
^- ?
%.y
:: ::
++ default ++ default
|* [pull-hook=* =config] |* [pull-hook=* =config]
@ -198,7 +214,7 @@
++ agent ++ agent
|* =config |* =config
|= =(pull-hook config) |= =(pull-hook config)
=| state-3 =| state-4
=* state - =* state -
^- agent:gall ^- agent:gall
=< =<
@ -224,13 +240,21 @@
=| cards=(list card:agent:gall) =| cards=(list card:agent:gall)
|^ |^
?- -.old ?- -.old
%3 %4
=^ og-cards pull-hook =^ og-cards pull-hook
(on-load:og inner-state.old) (on-load:og inner-state.old)
=. state old =. state old
=/ kick=(list card)
?: ?& =(min-version.config prev-min-version.old)
=(version.config prev-version.old)
diplomatic
==
~
(poke-self:pass kick+!>(%kick))^~
:_ this :_ this
:(weld cards og-cards (poke-self:pass kick+!>(%kick))^~) :(weld cards og-cards kick)
:: ::
%3 $(old [%4 0 0 +.old])
%2 $(old (state-to-3 old)) %2 $(old (state-to-3 old))
%1 $(old [%2 +.old ~]) %1 $(old [%2 +.old ~])
%0 !! :: pre-breach %0 !! :: pre-breach
@ -255,8 +279,10 @@
:: ::
++ on-save ++ on-save
^- vase ^- vase
=. inner-state =: inner-state on-save:og
on-save:og prev-min-version min-version.config
prev-version version.config
==
!>(state) !>(state)
:: ::
++ on-poke ++ on-poke
@ -422,6 +448,7 @@
?~ tan tr-core ?~ tan tr-core
?. versioned ?. versioned
(tr-ap-og:tr-cleanup |.((on-pull-nack:og rid u.tan))) (tr-ap-og:tr-cleanup |.((on-pull-nack:og rid u.tan)))
%- (slog leaf+"versioned nack for {<rid>} in {<dap.bowl>}" u.tan)
=/ pax =/ pax
(kick-mule:virt rid |.((on-pull-kick:og rid))) (kick-mule:virt rid |.((on-pull-kick:og rid)))
?~ pax tr-failed-kick ?~ pax tr-failed-kick
@ -446,18 +473,18 @@
:: subscription :: subscription
tr-core tr-core
(tr-suspend-pub-ver min-version.config) (tr-suspend-pub-ver min-version.config)
=/ =vase =/ =^cage
(convert-to:ver cage) (convert-to:ver cage)
=/ =wire =/ =wire
(make-wire /store) (make-wire /store)
=+ resources=(~(gas in *(set resource)) (resource-for-update:og vase)) =+ resources=(~(gas in *(set resource)) (resource-for-update:og q.cage))
?> ?| no-validate.config ?> ?| no-validate.config
?& (check-src resources) ?& (check-src resources)
(~(has in resources) rid) (~(has in resources) rid)
== == == ==
=/ =mark =/ =mark
(append-version:ver version.config) (append-version:ver version.config)
(tr-emit (~(poke-our pass wire) store-name.config mark vase)) (tr-emit (~(poke-our pass wire) store-name.config cage))
-- --
:: ::
++ tr-kick ++ tr-kick
@ -472,6 +499,7 @@
:: ::
++ tr-add ++ tr-add
|= [s=^ship r=resource] |= [s=^ship r=resource]
?< =(s our.bowl)
=: ship s =: ship s
rid r rid r
status [%active ~] status [%active ~]

128
pkg/arvo/lib/push-hook.hoon
View File

@ -26,6 +26,7 @@
:: ::
/- *push-hook /- *push-hook
/+ default-agent, resource, verb, versioning, agentio /+ default-agent, resource, verb, versioning, agentio
~% %push-hook-top ..part ~
|% |%
+$ card card:agent:gall +$ card card:agent:gall
:: ::
@ -57,15 +58,32 @@
inner-state=vase inner-state=vase
== ==
:: ::
+$ base-state-1
$: prev-version=@ud
prev-min-version=@ud
base-state-0
==
::
+$ state-0 [%0 base-state-0] +$ state-0 [%0 base-state-0]
:: ::
+$ state-1 [%1 base-state-0] +$ state-1 [%1 base-state-0]
+$ state-2 [%2 base-state-1]
:: ::
+$ versioned-state +$ versioned-state
$% state-0 $% state-0
state-1 state-1
state-2
== ==
:: +diplomatic: only renegotiate if versions changed
::
:: If %.n please leave note as to why renegotiation necessary
::
++ diplomatic
^- ?
%.y
::
++ push-hook ++ push-hook
~/ %push-hook
|* =config |* =config
$_ ^| $_ ^|
|_ bowl:gall |_ bowl:gall
@ -95,7 +113,7 @@
:: ::
++ transform-proxy-update ++ transform-proxy-update
|~ vase |~ vase
*(unit vase) *[(list card) (unit vase)]
:: +initial-watch: produce initial state for a subscription :: +initial-watch: produce initial state for a subscription
:: ::
:: .resource is the resource being subscribed to. :: .resource is the resource being subscribed to.
@ -153,10 +171,11 @@
++ agent ++ agent
|* =config |* =config
|= =(push-hook config) |= =(push-hook config)
=| state-1 =| state-2
=* state - =* state -
^- agent:gall ^- agent:gall
=< =<
~% %push-agent-lib ..poke-hook-action ~
|_ =bowl:gall |_ =bowl:gall
+* this . +* this .
og ~(. push-hook bowl) og ~(. push-hook bowl)
@ -179,16 +198,21 @@
=| cards=(list card:agent:gall) =| cards=(list card:agent:gall)
|^ |^
?- -.old ?- -.old
%1 %2
=^ og-cards push-hook =^ og-cards push-hook
(on-load:og inner-state.old) (on-load:og inner-state.old)
=/ old-subs =/ old-subs
find-old-subs (find-old-subs [prev-version prev-min-version]:old)
=/ version-cards =/ version-cards
:- (fact:io version+!>(version.config) /version ~) :- (fact:io version+!>(version.config) /version ~)
?~ old-subs ~ ?~ old-subs ~
(kick:io old-subs)^~ (kick:io old-subs)^~
[:(weld cards og-cards version-cards) this(state old)] [:(weld cards og-cards version-cards) this(state old)]
::
%1
%_ $
old [%2 0 0 +.old]
==
:: ::
:: ::
%0 %0
@ -205,6 +229,13 @@
== ==
:: ::
++ find-old-subs ++ find-old-subs
|= [prev-min-version=@ud prev-version=@ud]
?: ?& =(min-version.config prev-min-version)
=(prev-version version.config)
diplomatic
==
:: bail on kick if we didn't change versions
~
%~ tap in %~ tap in
%+ roll %+ roll
~(val by sup.bowl) ~(val by sup.bowl)
@ -230,13 +261,20 @@
-- --
:: ::
++ on-save ++ on-save
=. inner-state =: prev-version version.config
on-save:og prev-min-version min-version.config
inner-state on-save:og
==
!>(state) !>(state)
:: ::
++ on-poke ++ on-poke
~/ %on-poke
|= [=mark =vase] |= [=mark =vase]
^- (quip card:agent:gall agent:gall) ^- (quip card:agent:gall agent:gall)
?: =(mark %kick)
?> (team:title [our src]:bowl)
:_ this
(kick:io (turn ~(val by sup.bowl) tail))^~
?: =(mark %push-hook-action) ?: =(mark %push-hook-action)
?> (team:title our.bowl src.bowl) ?> (team:title our.bowl src.bowl)
=^ cards state =^ cards state
@ -251,6 +289,7 @@
[cards this] [cards this]
:: ::
++ on-watch ++ on-watch
~/ %on-watch
|= =path |= =path
^- (quip card:agent:gall agent:gall) ^- (quip card:agent:gall agent:gall)
?: ?=([%version ~] path) ?: ?=([%version ~] path)
@ -265,31 +304,32 @@
unversioned unversioned
=/ =resource =/ =resource
(de-path:resource t.t.path) (de-path:resource t.t.path)
=/ requested=@ud
(slav %ud i.t.t.t.t.t.path)
=/ =mark =/ =mark
(append-version:ver (slav %ud i.t.t.t.t.t.path)) (append-version:ver (min requested version.config))
?. (supported:ver mark) ?. (supported:ver mark)
:_ this :_ this
(fact-init-kick:io version+!>(min-version.config)) (fact-init-kick:io version+!>(min-version.config))
=/ =vase
(convert-to:ver mark (initial-watch:og t.t.t.t.t.t.path resource))
:_ this :_ this
[%give %fact ~ mark vase]~ =- [%give %fact ~ -]~
(convert-to:ver mark (initial-watch:og t.t.t.t.t.t.path resource))
:: ::
++ unversioned ++ unversioned
?> ?=([%ship @ @ *] t.path) ?> ?=([%ship @ @ *] t.path)
?. =(min-version.config 0)
~& >>> "unversioned req from: {<src.bowl>}, nooping"
`this
=/ =resource =/ =resource
(de-path:resource t.path) (de-path:resource t.path)
=/ =vase =/ =vase
%+ convert-to:ver update-mark.config
(initial-watch:og t.t.t.t.path resource) (initial-watch:og t.t.t.t.path resource)
:_ this :_ this
[%give %fact ~ update-mark.config vase]~ ?. =(min-version.config 0)
~& >>> "unversioned req from: {<src.bowl>}, nooping"
~
[%give %fact ~ (convert-to:ver update-mark.config vase)]~
-- --
:: ::
++ on-agent ++ on-agent
~/ %on-agent
|= [=wire =sign:agent:gall] |= [=wire =sign:agent:gall]
^- (quip card:agent:gall agent:gall) ^- (quip card:agent:gall agent:gall)
?. ?=([%helper %push-hook @ *] wire) ?. ?=([%helper %push-hook @ *] wire)
@ -343,6 +383,7 @@
[%x %min-version ~] ``version+!>(version.config) [%x %min-version ~] ``version+!>(version.config)
== ==
-- --
~% %push-helper-lib ..card ~
|_ =bowl:gall |_ =bowl:gall
+* og ~(. push-hook bowl) +* og ~(. push-hook bowl)
ver ~(. versioning [bowl [update-mark version min-version]:config]) ver ~(. versioning [bowl [update-mark version min-version]:config])
@ -350,6 +391,7 @@
pass pass:io pass pass:io
:: ::
++ poke-hook-action ++ poke-hook-action
~/ %poke-hook-action
|= =action |= =action
^- (quip card:agent:gall _state) ^- (quip card:agent:gall _state)
|^ |^
@ -418,6 +460,7 @@
[%pass wire %agent [our.bowl store-name.config] %watch store-path.config] [%pass wire %agent [our.bowl store-name.config] %watch store-path.config]
:: ::
++ push-updates ++ push-updates
~/ %push-updates
|= =cage |= =cage
^- (list card:agent:gall) ^- (list card:agent:gall)
%+ roll (resource-for-update q.cage) %+ roll (resource-for-update q.cage)
@ -439,11 +482,8 @@
%+ turn ~(tap by paths) %+ turn ~(tap by paths)
|= [fact-ver=@ud paths=(set path)] |= [fact-ver=@ud paths=(set path)]
=/ =mark =/ =mark
(append-version:ver fact-ver) (append-version:ver (min version.config fact-ver))
=/ =^cage (fact:io (convert-from:ver mark q.cage) ~(tap in paths))
:- mark
(convert-from:ver mark q.cage)
(fact:io cage ~(tap in paths))
:: TODO: deprecate :: TODO: deprecate
++ unversioned ++ unversioned
?. =(min-version.config 0) ~ ?. =(min-version.config 0) ~
@ -453,52 +493,47 @@
%- ~(gas in *(set path)) %- ~(gas in *(set path))
(turn (incoming-subscriptions prefix) tail) (turn (incoming-subscriptions prefix) tail)
?: =(0 ~(wyt in unversioned)) ~ ?: =(0 ~(wyt in unversioned)) ~
=/ =^cage (fact:io (convert-from:ver update-mark.config q.cage) ~(tap in unversioned))^~
:- update-mark.config
(convert-from:ver update-mark.config q.cage)
(fact:io cage ~(tap in unversioned))^~
-- --
:: ::
++ forward-update ++ forward-update
~/ %forward-update
|= =cage |= =cage
^- (list card:agent:gall) ^- (list card:agent:gall)
=- lis =- lis
=/ vas =/ vas=vase
(convert-to:ver cage) q:(convert-to:ver cage)
%+ roll (resource-for-update q.cage) %+ roll (resource-for-update q.cage)
|= [rid=resource [lis=(list card:agent:gall) tf-vas=(unit vase)]] |= [rid=resource [lis=(list card:agent:gall) tf-vas=(unit vase)]]
^- [(list card:agent:gall) (unit vase)] ^- [(list card:agent:gall) (unit vase)]
=/ =path =/ =path
resource+(en-path:resource rid) resource+(en-path:resource rid)
=/ =wire (make-wire path)
=* ship entity.rid =* ship entity.rid
=. tf-vas =/ out=(pair (list card:agent:gall) (unit vase))
?. =(our.bowl ship) ?. =(our.bowl ship)
:: do not transform before forwarding :: do not transform before forwarding
:: ::
`vas ``vas
:: use cached transform :: use cached transform
:: ::
?^ tf-vas tf-vas ?^ tf-vas `tf-vas
:: transform before poking store :: transform before poking store
:: ::
(transform-proxy-update:og vas) (transform-proxy-update:og vas)
~| "forwarding failed during transform. mark: {<p.cage>} resource: {<rid>}" ~| "forwarding failed during transform. mark: {<p.cage>} rid: {<rid>}"
?> ?=(^ tf-vas) ?> ?=(^ q.out)
=/ =dock :_ q.out
:- ship :_ (weld lis p.out)
?. =(our.bowl ship) =/ =wire (make-wire path)
:: forward to host =- [%pass wire %agent - %poke [current-version:ver u.q.out]]
:: :- ship
dap.bowl ?. =(our.bowl ship)
:: poke our store :: forward to host
:: ::
store-name.config dap.bowl
=/ cag=^cage :: poke our store
:- current-version:ver ::
u.tf-vas store-name.config
:_ tf-vas
[[%pass wire %agent dock %poke cag] lis]
:: ::
++ ver-from-path ++ ver-from-path
|= =path |= =path
@ -508,6 +543,7 @@
(slav %ud i.extra) (slav %ud i.extra)
:: ::
++ resource-for-update ++ resource-for-update
~/ %resource-for-update
|= =vase |= =vase
^- (list resource) ^- (list resource)
%~ tap in %~ tap in

77
pkg/arvo/lib/server.hoon
View File

@ -39,10 +39,10 @@
~! +:*handler ~! +:*handler
(handler inbound-request) (handler inbound-request)
:: ::
=/ redirect=cord =- [[307 ['location' -]~] ~]
%- crip %^ cat 3
"/~/login?redirect={(trip url.request.inbound-request)}" '/~/login?redirect='
[[307 ['location' redirect]~] ~] url.request.inbound-request
:: ::
:: +require-authorization-simple: :: +require-authorization-simple:
:: redirect to the login page when unauthenticated :: redirect to the login page when unauthenticated
@ -56,10 +56,10 @@
~! this ~! this
simple-payload simple-payload
:: ::
=/ redirect=cord =- [[307 ['location' -]~] ~]
%- crip %^ cat 3
"/~/login?redirect={(trip url.request.inbound-request)}" '/~/login?redirect='
[[307 ['location' redirect]~] ~] url.request.inbound-request
:: ::
++ give-simple-payload ++ give-simple-payload
|= [eyre-id=@ta =simple-payload:http] |= [eyre-id=@ta =simple-payload:http]
@ -86,36 +86,59 @@
:_ `octs :_ `octs
[200 [['content-type' 'text/html'] ?:(cache [max-1-wk ~] ~)]] [200 [['content-type' 'text/html'] ?:(cache [max-1-wk ~] ~)]]
:: ::
++ js-response
|= =octs
^- simple-payload:http
[[200 [['content-type' 'text/javascript'] max-1-da ~]] `octs]
::
++ json-response
|= =json
^- simple-payload:http
[[200 ['content-type' 'application/json']~] `(json-to-octs json)]
::
++ css-response ++ css-response
=| cache=?
|= =octs |= =octs
^- simple-payload:http ^- simple-payload:http
[[200 [['content-type' 'text/css'] max-1-da ~]] `octs] :_ `octs
[200 [['content-type' 'text/css'] ?:(cache [max-1-wk ~] ~)]]
:: ::
++ manx-response ++ js-response
|= man=manx =| cache=?
|= =octs
^- simple-payload:http ^- simple-payload:http
[[200 ['content-type' 'text/html']~] `(manx-to-octs man)] :_ `octs
[200 [['content-type' 'text/javascript'] ?:(cache [max-1-wk ~] ~)]]
:: ::
++ png-response ++ png-response
=| cache=?
|= =octs |= =octs
^- simple-payload:http ^- simple-payload:http
[[200 [['content-type' 'image/png'] max-1-wk ~]] `octs] :_ `octs
[200 [['content-type' 'image/png'] ?:(cache [max-1-wk ~] ~)]]
::
++ svg-response
=| cache=?
|= =octs
^- simple-payload:http
:_ `octs
[200 [['content-type' 'image/svg+xml'] ?:(cache [max-1-wk ~] ~)]]
::
++ ico-response
|= =octs
^- simple-payload:http
[[200 [['content-type' 'image/x-icon'] max-1-wk ~]] `octs]
:: ::
++ woff2-response ++ woff2-response
=| cache=?
|= =octs |= =octs
^- simple-payload:http ^- simple-payload:http
[[200 [['content-type' 'font/woff2'] max-1-wk ~]] `octs] [[200 [['content-type' 'font/woff2'] max-1-wk ~]] `octs]
:: ::
++ json-response
=| cache=_|
|= =json
^- simple-payload:http
:_ `(json-to-octs json)
[200 [['content-type' 'application/json'] ?:(cache [max-1-da ~] ~)]]
::
++ manx-response
=| cache=_|
|= man=manx
^- simple-payload:http
:_ `(manx-to-octs man)
[200 [['content-type' 'text/html'] ?:(cache [max-1-da ~] ~)]]
::
++ not-found ++ not-found
^- simple-payload:http ^- simple-payload:http
[[404 ~] ~] [[404 ~] ~]
@ -123,10 +146,10 @@
++ login-redirect ++ login-redirect
|= =request:http |= =request:http
^- simple-payload:http ^- simple-payload:http
=/ redirect=cord =- [[307 ['location' -]~] ~]
%- crip %^ cat 3
"/~/login?redirect={(trip url.request)}" '/~/login?redirect='
[[307 ['location' redirect]~] ~] url.request
:: ::
++ redirect ++ redirect
|= redirect=cord |= redirect=cord

145
pkg/arvo/lib/std.hoon
View File

@ -12,6 +12,7 @@
+$ step _`@u`1 +$ step _`@u`1
+$ bite $@(bloq [=bloq =step]) +$ bite $@(bloq [=bloq =step])
+$ octs [p=@ud q=@] +$ octs [p=@ud q=@]
+$ mold $~(* $-(* *))
++ unit |$ [item] $@(~ [~ u=item]) ++ unit |$ [item] $@(~ [~ u=item])
++ list |$ [item] $@(~ [i=item t=(list item)]) ++ list |$ [item] $@(~ [i=item t=(list item)])
++ lest |$ [item] [i=item t=(list item)] ++ lest |$ [item] [i=item t=(list item)]
@ -455,6 +456,22 @@
?. ?=(@ b) & ?. ?=(@ b) &
(lth a b) (lth a b)
:: ::
++ por :: parent order
~/ %por
|= [a=@p b=@p]
^- ?
?: =(a b) &
=| i=@
|-
?: =(i 2)
:: second two bytes
(lte a b)
:: first two bytes
=+ [c=(end 3 a) d=(end 3 b)]
?: =(c d)
$(a (rsh 3 a), b (rsh 3 b), i +(i))
(lth c d)
::
:: Maps :: Maps
:: ::
++ by ++ by
@ -534,6 +551,134 @@
== ==
-- --
:: ::
++ on :: ordered map
~/ %on
|* [key=mold val=mold]
=> |%
+$ item [key=key val=val]
--
::
~% %comp +>+ ~
|= compare=$-([key key] ?)
~% %core + ~
|%
::
++ apt
~/ %apt
|= a=(tree item)
=| [l=(unit key) r=(unit key)]
|- ^- ?
?~ a %.y
?& ?~(l %.y (compare key.n.a u.l))
?~(r %.y (compare u.r key.n.a))
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
==
::
++ gas
~/ %gas
|= [a=(tree item) b=(list item)]
^- (tree item)
?~ b a
$(b t.b, a (put a i.b))
::
++ get
~/ %get
|= [a=(tree item) b=key]
^- (unit val)
?~ a ~
?: =(b key.n.a)
`val.n.a
?: (compare b key.n.a)
$(a l.a)
$(a r.a)
::
++ has
~/ %has
|= [a=(tree item) b=key]
^- ?
!=(~ (get a b))
::
++ lot
~/ %lot
|= $: tre=(tree item)
start=(unit key)
end=(unit key)
==
^- (tree item)
|^
?: ?&(?=(~ start) ?=(~ end))
tre
?~ start
(del-span tre %end end)
?~ end
(del-span tre %start start)
?> (compare u.start u.end)
=. tre (del-span tre %start start)
(del-span tre %end end)
::
++ del-span
|= [a=(tree item) b=?(%start %end) c=(unit key)]
^- (tree item)
?~ a a
?~ c a
?- b
%start
?: =(key.n.a u.c)
(nip a(l ~))
?: (compare key.n.a u.c)
$(a (nip a(l ~)))
a(l $(a l.a))
::
%end
?: =(u.c key.n.a)
(nip a(r ~))
?: (compare key.n.a u.c)
a(r $(a r.a))
$(a (nip a(r ~)))
==
--
::
++ nip
~/ %nip
|= a=(tree item)
^- (tree item)
?> ?=(^ a)
|- ^- (tree item)
?~ l.a r.a
?~ r.a l.a
?: (mor key.n.l.a key.n.r.a)
l.a(r $(l.a r.l.a))
r.a(l $(r.a l.r.a))
::
++ put
~/ %put
|= [a=(tree item) =key =val]
^- (tree item)
?~ a [n=[key val] l=~ r=~]
?: =(key.n.a key) a(val.n val)
?: (compare key key.n.a)
=/ l $(a l.a)
?> ?=(^ l)
?: (mor key.n.a key.n.l)
a(l l)
l(r a(l r.l))
=/ r $(a r.a)
?> ?=(^ r)
?: (mor key.n.a key.n.r)
a(r r)
r(l a(r l.r))
::
++ tap
~/ %tap
|= a=(tree item)
^- (list item)
=| b=(list item)
|- ^+ b
?~ a b
$(a l.a, b [n.a $(a r.a)])
--
::
:: Sets :: Sets
:: ::
++ in ++ in

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

@ -490,7 +490,7 @@
=/ m (strand ,vase) =/ m (strand ,vase)
^- form:m ^- form:m
;< =riot:clay bind:m ;< =riot:clay bind:m
(warp ship desk ~ %sing %b case /[mak]) (warp ship desk ~ %sing %e case /[mak])
?~ riot ?~ riot
(strand-fail %build-nave >arg< ~) (strand-fail %build-nave >arg< ~)
?> =(%nave p.r.u.riot) ?> =(%nave p.r.u.riot)

342
pkg/arvo/lib/vere.hoon
View File

@ -44,23 +44,10 @@
:: |give:dawn: produce requests for pre-boot validation :: |give:dawn: produce requests for pre-boot validation
:: ::
++ give ++ give
=, rpc:ethereum
=, abi:ethereum
=/ tract azimuth:contracts:azimuth
|% |%
:: +bloq:give:dawn: Eth RPC for latest block number
::
++ bloq
^- octs
%- as-octt:mimes:html
%- en-json:html
%+ request-to-json
`~.0
[%eth-block-number ~]
:: +czar:give:dawn: Eth RPC for galaxy table :: +czar:give:dawn: Eth RPC for galaxy table
:: ::
++ czar ++ czar
|= boq=@ud
^- octs ^- octs
%- as-octt:mimes:html %- as-octt:mimes:html
%- en-json:html %- en-json:html
@ -68,40 +55,43 @@
%+ turn (gulf 0 255) %+ turn (gulf 0 255)
|= gal=@ |= gal=@
%+ request-to-json %+ request-to-json
`(cat 3 'gal-' (scot %ud gal)) (cat 3 'gal-' (scot %ud gal))
:+ %eth-call :- 'getPoint'
=- [from=~ to=tract gas=~ price=~ value=~ data=-] (~(put by *(map @t json)) 'ship' s+(scot %p gal))
(encode-call 'points(uint32)' [%uint gal]~)
[%number boq]
:: +point:give:dawn: Eth RPC for ship's contract state :: +point:give:dawn: Eth RPC for ship's contract state
:: ::
++ point ++ point
|= [boq=@ud who=ship] |= who=ship
^- octs ^- octs
%- as-octt:mimes:html %- as-octt:mimes:html
%- en-json:html %- en-json:html
%+ request-to-json %+ request-to-json
`~.0 ~.
:+ %eth-call :- 'getPoint'
=- [from=~ to=tract gas=~ price=~ value=~ data=-] (~(put by *(map @t json)) 'ship' s+(scot %p who))
(encode-call 'points(uint32)' [%uint `@`who]~)
[%number boq]
:: +turf:give:dawn: Eth RPC for network domains :: +turf:give:dawn: Eth RPC for network domains
:: ::
++ turf ++ turf
|= boq=@ud
^- octs ^- octs
%- as-octt:mimes:html %- as-octt:mimes:html
%- en-json:html %- en-json:html
:- %a
%+ turn (gulf 0 2)
|= idx=@
%+ request-to-json %+ request-to-json
`(cat 3 'turf-' (scot %ud idx)) 'turf'
:+ %eth-call ['getDns' ~]
=- [from=~ to=tract gas=~ price=~ value=~ data=-] :: +request-to-json:give:dawn: internally used for request generation
(encode-call 'dnsDomains(uint256)' [%uint idx]~) ::
[%number boq] ::NOTE we could import this from /lib/json/rpc, but adding that as a
:: dependency seems a bit unclean
::
++ request-to-json
|= [id=@t method=@t params=(map @t json)]
^- json
%- pairs:enjs:format
:~ jsonrpc+s+'2.0'
id+s+id
method+s+method
params+o+params
==
-- --
:: |take:dawn: parse responses for pre-boot validation :: |take:dawn: parse responses for pre-boot validation
:: ::
@ -111,23 +101,6 @@
=, azimuth =, azimuth
=, dejs-soft:format =, dejs-soft:format
|% |%
:: +bloq:take:dawn: parse block number
::
++ bloq
|= rep=octs
^- (unit @ud)
=/ jon=(unit json) (de-json:html q.rep)
?~ jon
~&([%bloq-take-dawn %invalid-json] ~)
=/ res=(unit cord) ((ot result+so ~) u.jon)
?~ res
~&([%bloq-take-dawn %invalid-response rep] ~)
=/ out
%- mule |.
(hex-to-num:ethereum u.res)
?: ?=(%& -.out)
(some p.out)
~&([%bloq-take-dawn %invalid-block-number] ~)
:: +czar:take:dawn: parse galaxy table :: +czar:take:dawn: parse galaxy table
:: ::
++ czar ++ czar
@ -136,58 +109,94 @@
=/ jon=(unit json) (de-json:html q.rep) =/ jon=(unit json) (de-json:html q.rep)
?~ jon ?~ jon
~&([%czar-take-dawn %invalid-json] ~) ~&([%czar-take-dawn %invalid-json] ~)
=/ res=(unit (list [@t @t])) =/ res=(unit (list [@t @ud @ud @]))
((ar (ot id+so result+so ~)) u.jon) %. u.jon
=, dejs-soft:format
=- (ar (ot id+so result+(ot network+- ~) ~))
%- ot
:~ :- 'rift' ni
:- 'keys' (ot 'life'^ni ~)
:- 'keys' %+ cu pass-from-eth:azimuth
%- ot
:~ 'crypt'^(cu (lead 32) ni)
'auth'^(cu (lead 32) ni)
'suite'^ni
==
==
?~ res ?~ res
~&([%czar-take-dawn %invalid-response rep] ~) ~&([%czar-take-dawn %invalid-json] ~)
=/ dat=(unit (list [who=@p point:azimuth-types]))
=- ?:(?=(%| -.out) ~ (some p.out))
^= out %- mule |.
%+ turn u.res
|= [id=@t result=@t]
^- [who=ship point:azimuth-types]
=/ who `@p`(slav %ud (rsh [3 4] id))
:- who
%+ point-from-eth
who
:_ *deed:eth-noun
%+ decode-results
result
point:eth-type
?~ dat
~&([%bloq-take-dawn %invalid-galaxy-table] ~)
:- ~ :- ~
%+ roll u.dat %+ roll u.res
|= $: [who=ship =point:azimuth-types] |= $: [id=@t deet=[=rift =life =pass]]
kyz=(map ship [=rift =life =pass]) kyz=(map ship [=rift =life =pass])
== ==
^+ kyz ^+ kyz
?~ net.point ?: =(0 life.deet)
kyz kyz
(~(put by kyz) who [continuity-number life pass]:u.net.point) %+ ~(put by kyz)
(slav %ud (rsh [3 4] id))
deet
:: +point:take:dawn: parse ship's contract state :: +point:take:dawn: parse ship's contract state
:: ::
++ point ++ point
|= [who=ship rep=octs] |= [who=ship rep=octs]
^- (unit point:azimuth) ^- (unit point:azimuth)
~! *point:azimuth
=/ jon=(unit json) (de-json:html q.rep) =/ jon=(unit json) (de-json:html q.rep)
?~ jon ?~ jon
~&([%point-take-dawn %invalid-json] ~) ~&([%point-take-dawn %invalid-json] ~)
=/ res=(unit cord) ((ot result+so ~) u.jon) =- ?~ res
?~ res ~&([%point-take-dawn %incomplete-json] ~)
~&([%point-take-dawn %invalid-response rep] ~) =, u.res
~? =(u.res '0x') %- some
:- 'bad result from node; is azimuth address correct?' :+ own
azimuth:contracts ?: =(0 life) ~
=/ out `[life pass rift sponsor ~] ::NOTE escape unknown ::TODO could be!
%- mule |. ?. (gth who 0xffff) ~
%+ point-from-eth `[spawn ~] ::NOTE spawned unknown
who ^- $= res
:_ *deed:eth-noun ::TODO call rights to fill %- unit
(decode-results u.res point:eth-type) $: [spawn=@ own=[@ @ @ @]]
?: ?=(%& -.out) [=rift =life =pass sponsor=[? ship]]
(some p.out) ==
~&([%point-take-dawn %invalid-point] ~) %. u.jon
=, dejs-soft:format
=- (ot result+- ~)
%- ot
:~ :- 'ownership'
%- ot
|^ :~ 'spawnProxy'^address
'owner'^address
'managementProxy'^address
'votingProxy'^address
'transferProxy'^address
==
::
++ address
(ot 'address'^(cu hex-to-num:ethereum so) ~)
--
::
:- 'network'
%- ot
::TODO dedupe with +czar
:~ 'rift'^ni
'keys'^(ot 'life'^ni ~)
::
:- 'keys'
%+ cu pass-from-eth:azimuth
%- ot
:~ 'crypt'^(cu (lead 32) ni)
'auth'^(cu (lead 32) ni)
'suite'^ni
==
::
::TODO inconsistent @p string
'sponsor'^(ot 'has'^bo 'who'^(su fed:ag) ~)
::
::TODO escape
::TODO what if escape or sponsor not present? possible?
==
==
:: +turf:take:dawn: parse network domains :: +turf:take:dawn: parse network domains
:: ::
++ turf ++ turf
@ -196,94 +205,95 @@
=/ jon=(unit json) (de-json:html q.rep) =/ jon=(unit json) (de-json:html q.rep)
?~ jon ?~ jon
~&([%turf-take-dawn %invalid-json] ~) ~&([%turf-take-dawn %invalid-json] ~)
=/ res=(unit (list [@t @t])) =/ res=(unit (list @t))
((ar (ot id+so result+so ~)) u.jon) ((ot result+(ar so) ~) u.jon)
?~ res ?~ res
~&([%turf-take-dawn %invalid-response rep] ~) ~&([%turf-take-dawn %invalid-response rep] ~)
=/ dat=(unit (list (pair @ud ^turf))) :: remove duplicates, parse into turfs
=- ?:(?=(%| -.out) ~ (some p.out))
^= out %- mule |.
%+ turn u.res
|= [id=@t result=@t]
^- (pair @ud ^turf)
:- (slav %ud (rsh [3 5] id))
=/ dom=tape
(decode-results result [%string]~)
=/ hot=host:eyre
(scan dom thos:de-purl:html)
?>(?=(%& -.hot) p.hot)
?~ dat
~&([%turf-take-dawn %invalid-domains] ~)
:- ~
=* dom u.dat
:: sort by id, ascending, removing duplicates
:: ::
=| tuf=(map ^turf @ud) =- `doz
|- ^- (list ^turf) %+ roll u.res
?~ dom |= [dom=@t doh=(set @t) doz=(list ^turf)]
%+ turn ?: (~(has in doh) dom) [doh doz]
%+ sort ~(tap by tuf) :- (~(put in doh) dom)
|=([a=(pair ^turf @ud) b=(pair ^turf @ud)] (lth q.a q.b)) =/ hot=host:eyre
head (rash dom thos:de-purl:html)
=? tuf !(~(has by tuf) q.i.dom) ?. ?=(%& -.hot) doz
(~(put by tuf) q.i.dom p.i.dom) (snoc doz p.hot)
$(dom t.dom)
-- --
:: +veri:dawn: validate keys, life, discontinuity, &c :: +veri:dawn: validate keys, life, discontinuity, &c
:: ::
++ veri ++ veri
|= [=seed:jael =point:azimuth =live] |= [=ship =feed:jael =point:azimuth =live]
^- (unit error=term) ^- (each seed:jael (lest error=term))
=/ rac (clan:title who.seed) |^ ?@ -.feed
=/ cub (nol:nu:crub:crypto key.seed) ?^ err=(test feed) |+[u.err ~]
?- rac &+feed
%pawn ?> ?=([%1 ~] -.feed)
:: a comet address is the fingerprint of the keypair =| errs=(list term)
:: |-
?. =(who.seed `@`fig:ex:cub) ?~ kyz.feed
`%key-mismatch |+?~(errs [%no-key ~] errs)
:: a comet can never be breached =/ =seed:jael [who [lyf key ~]:i.kyz]:feed
:: ?~ err=(test seed)
?^ live &+seed
`%already-booted =. errs (snoc errs u.err)
:: a comet can never be re-keyed $(kyz.feed t.kyz.feed)
::
?. ?=(%1 lyf.seed)
`%invalid-life
~
:: ::
%earl ++ test
~ |= =seed:jael
:: ^- (unit error=term)
* ?. =(ship who.seed) `%not-our-key
:: on-chain ships must be launched =/ rac (clan:title who.seed)
=/ cub (nol:nu:crub:crypto key.seed)
?- rac
%pawn
:: a comet address is the fingerprint of the keypair
::
?. =(who.seed `@`fig:ex:cub)
`%key-mismatch
:: a comet can never be breached
::
?^ live
`%already-booted
:: a comet can never be re-keyed
::
?. ?=(%1 lyf.seed)
`%invalid-life
~
:: ::
?~ net.point %earl
`%not-keyed ~
=* net u.net.point
:: boot keys must match the contract
:: ::
?. =(pub:ex:cub pass.net) *
~& [%key-mismatch pub:ex:cub pass.net] :: on-chain ships must be launched
`%key-mismatch ::
:: life must match the contract ?~ net.point
:: `%not-keyed
?. =(lyf.seed life.net) =* net u.net.point
`%life-mismatch :: boot keys must match the contract
:: the boot life must be greater than and discontinuous with ::
:: the last seen life (per the sponsor) ?. =(pub:ex:cub pass.net)
:: `%key-mismatch
?: ?& ?=(^ live) :: life must match the contract
?| ?=(%| breach.u.live) ::
(lte life.net life.u.live) ?. =(lyf.seed life.net)
== == `%life-mismatch
`%already-booted :: the boot life must be greater than and discontinuous with
:: produce the sponsor for vere :: the last seen life (per the sponsor)
:: ::
~? !has.sponsor.net ?: ?& ?=(^ live)
[%no-sponsorship-guarantees-from who.sponsor.net] ?| ?=(%| breach.u.live)
~ (lte life.net life.u.live)
== == ==
`%already-booted
:: produce the sponsor for vere
::
~? !has.sponsor.net
[%no-sponsorship-guarantees-from who.sponsor.net]
~
==
--
:: +sponsor:dawn: retreive sponsor from point :: +sponsor:dawn: retreive sponsor from point
:: ::
++ sponsor ++ sponsor

22
pkg/arvo/lib/versioning.hoon
View File

@ -29,11 +29,12 @@
&((gte ver min) (lte ver version)) &((gte ver min) (lte ver version))
:: ::
++ convert-to ++ convert-to
|= =cage |= [=mark =vase]
^- vase ^- cage
?: =(p.cage current-version) :- current-version
q.cage ?: =(mark current-version)
((tube-to p.cage) q.cage) vase
((tube-to mark) vase)
:: ::
++ tube-to ++ tube-to
|= =mark |= =mark
@ -44,10 +45,11 @@
.^(tube:clay %cc (scry:io %home /[current-version]/[mark])) .^(tube:clay %cc (scry:io %home /[current-version]/[mark]))
:: ::
++ convert-from ++ convert-from
|= =cage |= [=mark =vase]
^- vase ^- cage
?: =(p.cage current-version) :- mark
q.cage ?: =(mark current-version)
((tube-from p.cage) q.cage) vase
((tube-from mark) vase)
-- --

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