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

Merge branch 'master' of github.com:urbit/urbit into merge-king

Browse Source
This commit is contained in:
Benjamin Summers 2019-12-16 14:49:20 -08:00
commit 36692278e1
51 changed files with 3261 additions and 185 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -20,3 +20,4 @@ s/*
**/*.swp
**/*.swo
**/*-min.js
pkg/interface/link-webext/web-ext-artifacts

4
bin/brass.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:1fc5ef636f7b868076f205eb57f0b39508ad037872abfa1871c712c1d00ac1ba
size 7143859
oid sha256:18d492d912068e7fefef48006105d39c1c8f56aa756b7aeae48387c2254c1b91
size 7153239

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:3d9a450a061b24c53a1a374e29d544247ee9782f0e5306bb18efc8abf95bfcb4
size 9518723
oid sha256:04735cc4764f9a3e6c4fb5b046a6b9590664fe9f644578c58f3bc6acc911b723
size 9606039

430
pkg/arvo/app/claz.hoon Normal file
View File

@ -0,0 +1,430 @@
:: claz: command line azimuth, for the power-user
::
/+ *claz, verb, default-agent
::
=, ethereum
=, azimuth
::
|%
+$ state-0
$: %0
in-progress=(unit command)
==
::
+$ rpc-result [id=@t res=@t]
+$ card card:agent:gall
::
++ node-url 'http://eth-mainnet.urbit.org:8545'
--
::
=| state-0
=* state -
%+ verb |
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load on-load:def
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. ?=(%noun mark) [~ this]
?^ in-progress
~& %still-running-please-try-again-later
[~ this]
=/ =command !<(command vase)
:_ this(in-progress `command)
(prepare-for-command:do command)
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=([%prepare *] wire)
(on-agent:def wire sign)
?- -.sign
%poke-ack
?~ p.sign
[~ this]
%- (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
:_ this(in-progress ~)
[(leave-spider:do wire our.bowl)]~
::
%watch-ack
?~ p.sign
[~ this]
=/ =tank leaf+"{(trip dap.bowl)} couldn't start listen to thread"
%- (slog tank u.p.sign)
[~ this(in-progress ~)]
::
%kick
[~ this(in-progress ~)]
::
%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(in-progress ~)]
::
%thread-done
=+ prep=!<(prep-result q.cage.sign)
?~ in-progress
~& [dap.bowl 'did preparations, but lost command']
[~ this]
:_ this(in-progress ~)
[(generate:do u.in-progress prep)]~
==
==
::
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
++ poke-spider
|= [=path our=@p =cage]
^- card
[%pass path %agent [our %spider] %poke cage]
::
++ watch-spider
|= [=path our=@p =sub=path]
^- card
[%pass path %agent [our %spider] %watch sub-path]
::
++ leave-spider
|= [=path our=@p]
^- card
[%pass path %agent [our %spider] %leave ~]
::
++ prepare-for-command
|= =command
^- (list card)
=/ new-tid=@ta
:((cury cat 3) dap.bowl '--' (scot %uv eny.bowl))
=/ args
[~ `new-tid %claz-prep-command !>([node-url command])]
:~ (watch-spider /prepare our.bowl /thread-result/[new-tid])
(poke-spider /prepare our.bowl %spider-start !>(args))
==
::
:: transaction generation logic
::
++ generate
|= [=command prep=prep-result]
^- card
?> ?=(%nonce -.prep)
?- -.command
%generate
%+ write-file-transactions
path.command
(batch-to-transactions nonce.prep [network as batch]:command)
==
::
++ batch-to-transactions
|= [nonce=@ud =network as=address =batch]
^- (list transaction:rpc)
?- -.batch
%single [(single nonce network as +.batch) ~]
%deed (deed nonce network as +.batch)
%invites (invites nonce network as +.batch)
%lock-prep (lock-prep nonce network as +.batch)
%lock (lock nonce network as +.batch)
::
%more
=| txs=(list transaction:rpc)
=* batches batches.batch
|-
?~ batches txs
=/ new-txs=(list transaction:rpc)
^$(batch i.batches)
%_ $
txs (weld txs new-txs)
nonce (add nonce (lent new-txs))
batches t.batches
==
==
::
++ tape-to-ux
|= t=tape
(scan t zero-ux)
::
++ zero-ux
;~(pfix (jest '0x') hex)
::
++ write-file-transactions
|= [=path tox=(list transaction:rpc)]
^- card
?> ?=([@ desk @ *] path)
=- [%pass [%write path] %arvo %c %info -]
:- `desk`i.t.path
=- &+[t.t.t.path -]~
=/ y .^(arch %cy path)
?~ fil.y
ins+eth-txs+!>(tox)
mut+eth-txs+!>(tox)
::
++ do
::TODO maybe reconsider encode-call interface, if we end up wanting @ux
:: as or more often than we want tapes
|= [=network nonce=@ud to=address dat=$@(@ux tape)]
^- transaction:rpc
:* nonce
8.000.000.000 ::TODO global config
600.000 ::TODO global config
to
0
`@`?@(dat dat (tape-to-ux dat))
::
?- network
%mainnet 0x1
%ropsten 0x3
%fakenet `@ux``@`1.337
[%other *] id.network
==
==
::
++ single
|= [nonce=@ud =network as=address =call]
^- transaction:rpc
=- (do network nonce contract data)
^- [data=tape contract=address]
:- (encode-claz-call call)
=/ contracts (get-contracts network)
?+ -.call ecliptic:contracts
%send-point delegated-sending:contracts
==
::
++ deed
|= [nonce=@ud =network as=address deeds-json=cord]
^- (list transaction:rpc)
=/ deeds=(list [=ship rights])
(parse-registration deeds-json)
::TODO split per spawn proxy
=| txs=(list transaction:rpc)
|^ :: $
?~ deeds (flop txs)
=* deed i.deeds
=. txs
?. ?=(%czar (clan:title ship.deed))
%- do-here
(spawn:dat ship.deed as)
~| %galaxy-held-by-ceremony
?> =(0x740d.6d74.1711.163d.3fca.cecf.1f11.b867.9a7c.7964 as)
~& [%assuming-galaxy-owned-by-ceremony ship.deed]
txs
=? txs ?=(^ net.deed)
%- do-here
(configure-keys:dat [ship u.net]:deed)
=? txs ?=(^ manage.deed)
%- do-here
(set-management-proxy:dat [ship u.manage]:deed)
=? txs ?=(^ voting.deed)
%- do-here
(set-voting-proxy:dat [ship u.voting]:deed)
=? txs ?=(^ spawn.deed)
%- do-here
(set-spawn-proxy:dat [ship u.spawn]:deed)
=. txs
%- do-here
(transfer-ship:dat [ship own]:deed)
$(deeds t.deeds)
::
::TODO maybe-do, take dat gat and unit argument
++ do-here
|= dat=tape
:_ txs
(do network (add nonce (lent txs)) ecliptic:(get-contracts network) dat)
--
::
++ invites
|= [nonce=@ud =network as=address as-who=ship file=path]
^- (list transaction:rpc)
=/ friends=(list [=ship @q =address])
(read-invites file)
=| txs=(list transaction:rpc)
|-
?~ friends (flop txs)
=* friend i.friends
=; tx=transaction:rpc
$(txs [tx txs], friends t.friends)
%- do
:* network
(add nonce (lent txs))
delegated-sending:(get-contracts network)
(send-point:dat as-who [ship address]:friend)
==
::
++ parse-registration
|= reg=cord
^- (list [=ship rights])
~| %registration-json-insane
=+ jon=(need (de-json:html reg))
~| %registration-json-invalid
?> ?=(%o -.jon)
=. p.jon (~(del by p.jon) 'idCode')
%+ turn ~(tap by p.jon)
|= [who=@t deed=json]
^- [ship rights]
:- (rash who dum:ag)
?> ?=(%a -.deed)
:: array has contents of:
:: [owner, transfer, spawn, mgmt, delegate, auth_key, crypt_key]
~| [%registration-incomplete deed (lent p.deed)]
?> =(7 (lent p.deed))
=< :* (. 0 %address) :: owner
(. 3 %unit-address) :: management
(. 4 %unit-address) :: voting
(. 1 %unit-address) :: transfer
(. 2 %unit-address) :: spawn
(both (. 6 %key) (. 5 %key)) :: crypt, auth
==
|* [i=@ud what=?(%address %unit-address %key)]
=+ j=(snag i p.deed)
~| [%registration-invalid-value what j]
?> ?=(%s -.j)
%+ rash p.j
=+ adr=;~(pfix (jest '0x') hex)
?- what
%address adr
%unit-address ;~(pose (stag ~ adr) (cold ~ (jest '')))
%key ;~(pose (stag ~ hex) (cold ~ (jest '')))
==
::
++ lock-prep
|= [nonce=@ud =network as=address what=(list ship)]
^- (list transaction:rpc)
~& %assuming-lockup-on-mainnet
=| txs=(list transaction:rpc)
|^
?~ what (flop txs)
=. txs
%- do-here
(spawn:dat i.what as)
=. txs
%- do-here
%+ transfer-ship:dat i.what
~& %assuming-lockup-done-by-ceremony
0x740d.6d74.1711.163d.3fca.cecf.1f11.b867.9a7c.7964
$(what t.what)
++ do-here
|= dat=tape
:_ txs
(do network (add nonce (lent txs)) ecliptic:mainnet-contracts dat)
--
::
::TODO support distinguishing/switching between usable lockup methods
:: automagically
++ lock
|= $: nonce=@ud
=network
as=address
how=?(%spawn %transfer)
what=(list ship)
to=address
=lockup
==
^- (list transaction:rpc)
:: verify lockup sanity
::
~| %invalid-lockup-ships
?> ?| ?=(%linear -.lockup)
=(`@`(lent what) :(add b1.lockup b2.lockup b3.lockup))
==
:: expand galaxies into stars
::
=. what
%- zing
%+ turn what
|= s=ship
^- (list ship)
?. =(%czar (clan:title s)) [s]~
(turn (gulf 1 255) |=(k=@ud (cat 3 s k)))
=/ lockup-contract=address
?- -.lockup
%linear 0x86cd.9cd0.992f.0423.1751.e376.1de4.5cec.ea5d.1801
%conditional 0x8c24.1098.c3d3.498f.e126.1421.633f.d579.86d7.4aea
==
%- flop
=| txs=(list transaction:rpc)
^+ txs
|^
:: registration
::
=. txs
%+ do-here lockup-contract
?- -.lockup
%linear (register-linear to (lent what) +.lockup)
%conditional (register-conditional to +.lockup)
==
:: context-dependent setup
::
=. txs
?- how
:: %spawn: set spawn proxy of parents
::
%spawn
~& %assuming-ceremony-controls-parents
=/ parents
=- ~(tap in -)
%+ roll what
|= [s=ship ss=(set ship)]
?> =(%king (clan:title s))
(~(put in ss) (^sein:title s))
|-
?~ parents txs
=. txs
%+ do-here ecliptic:mainnet-contracts
(set-spawn-proxy:dat i.parents lockup-contract)
$(parents t.parents)
::
:: %transfer: set transfer proxy of stars
::
%transfer
~& %assuming-ceremony-controls-stars
|-
?~ what txs
=. txs
%+ do-here ecliptic:mainnet-contracts
(set-transfer-proxy:dat i.what lockup-contract)
$(what t.what)
==
:: depositing
::
|-
?~ what txs
=. txs
%+ do-here lockup-contract
(deposit:dat to i.what)
$(what t.what)
++ do-here
|= [contract=address dat=tape]
:_ txs
(do network (add nonce (lent txs)) contract dat)
--
::
++ register-linear
|= [to=address stars=@ud windup-years=@ud unlock-years=@ud]
%- register-linear:dat
:* to
(mul windup-years yer:yo)
stars
(div (mul unlock-years yer:yo) stars)
1
==
::
++ register-conditional
|= [to=address [b1=@ud b2=@ud b3=@ud] unlock-years-per-batch=@ud]
%- register-conditional:dat
=- [`address`to b1 b2 b3 `@ud`- 1]
(div (mul unlock-years-per-batch yer:yo) :(add b1 b2 b3))
::
--

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

@ -22,8 +22,20 @@
:~ [%pass / %arvo %e %connect [~ /'~clock'] %clock]
[%pass /clock %agent [our.bowl %launch] %poke launcha]
==
++ on-save on-save:def
++ on-load on-load:def
:: bootstrapping to get %goad started OTA
::
++ on-save !>(%2)
++ on-load
|= old-state=vase
=/ old !<(?(~ %1 %2) old-state)
=^ cards this
?: ?=(%2 old)
`this
:_ this :_ ~
[%pass /behn %arvo %b %wait +(now.bowl)]
::
[cards this]
::
++ on-poke
|= [=mark =vase]
^- (quip card:agent:gall _this)
@ -63,6 +75,13 @@
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card:agent:gall _this)
?: ?=(%wake +<.sign-arvo)
?^ error.sign-arvo
:_ this :_ ~
[%pass /dill %arvo %d %flog %crud %clock-fail u.error.sign-arvo]
:_ this :_ ~
[%pass /gall %arvo %g %goad | `%hood]
::
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]

613
pkg/arvo/app/gaze.hoon Normal file
View File

@ -0,0 +1,613 @@
:: gaze: azimuth statistics
::
:: general flow:
:: - receive events
:: - process events whose timestamp is known
:: - request timestamps for unknown block numbers (if not already running)
:: - receive timestamps, process events
::
/- eth-watcher
/+ default-agent, verb
=, ethereum
=, azimuth
::
=> |%
+$ state-0
$: %0
:: qued: event logs waiting on block timestamp, oldest first
:: time: timstamps of block numbers
:: seen: events sorted by timestamp, newest first
:: days: stats by day, newest first
::
running=(unit @ta)
qued=loglist
time=(map @ud @da)
seen=(list [wen=@da wat=event])
days=(list [day=@da sat=stats])
==
::
+$ loglist loglist:eth-watcher
+$ event
$% [%azimuth who=ship dif=diff-point]
[%invite by=ship of=ship gift=ship to=address]
==
::
+$ stats
$: spawned=(list @p)
activated=(list @p)
transfer-p=(list @p)
transferred=(list @p)
configured=(list @p)
breached=(list @p)
request=(list @p)
sponsor=(list @p)
management-p=(list @p)
voting-p=(list @p)
spawn-p=(list @p)
invites-senders=(list @p)
==
::
+$ card card:agent:gall
::
++ node-url 'http://eth-mainnet.urbit.org:8545'
++ refresh-rate ~h1
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
[setup-cards:do this]
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> ?=(%noun mark)
=/ =noun !<(noun vase)
|- ^- [cards=(list card) =_this]
?+ noun ~|([dap.bowl %unknown-poke noun] !!)
%reconnect
:_ this
:~ leave-eth-watcher:do
watch-eth-watcher:do
==
::
%reload
:- cards:$(noun %reconnect)
this(qued ~, seen ~, days ~)
::
%rewatch
:_ this:$(noun %reset)
:~ leave-eth-watcher:do
clear-eth-watcher:do
setup-eth-watcher:do
await-eth-watcher:do
==
::
%export
[export:do this]
::
%debug
~& latest=(turn (scag 5 seen) head)
~& oldest=(turn (slag (sub (max 5 (lent seen)) 5) seen) head)
~& :- 'order is'
=- ?:(sane 'sane' 'insane')
%+ roll seen
|= [[this=@da *] last=@da sane=?]
:- this
?: =(*@da last) &
(lte this last)
~& time=~(wyt by time)
~& qued=(lent qued)
~& days=(lent days)
[~ this]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%kick
?. =(/watcher wire) [~ this]
[[watch-eth-watcher:do]~ this]
::
%fact
?+ wire (on-agent:def wire sign)
[%watcher ~]
?. ?=(%eth-watcher-diff p.cage.sign)
(on-agent:def wire sign)
=^ cards state
%- handle-eth-watcher-diff:do
!<(diff:eth-watcher q.cage.sign)
[cards this]
::
[%timestamps @ ~]
?+ p.cage.sign (on-agent:def wire sign)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
=/ =tank leaf+"{(trip dap.bowl)} thread failed; will retry"
%- (slog tank leaf+<term> tang)
=^ cards state
request-timestamps:do
[cards this]
::
%thread-done
=^ cards state
%- save-timestamps:do
!<((list [@ud @da]) q.cage.sign)
[cards this]
==
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ +<.sign-arvo ~|([dap.bowl %strange-arvo-sign +<.sign-arvo] !!)
%wake
?: =(/export wire)
[[wait-export:do export:do] this]
?: =(/watch wire)
[[watch-eth-watcher:do]~ this]
~& [dap.bowl %strange-wake wire]
[~ this]
==
::
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ setup-cards
^- (list card)
:~ wait-export
setup-eth-watcher
:: we punt on subscribing to the eth-watcher for a little while.
:: this way we get a %history diff containing all past events,
:: instead of so many individual %log diffs that we bail meme.
:: (to repro, replace this with `watch-eth-watcher`)
::
await-eth-watcher
==
::
++ wait
|= [=wire =@dr]
^- card
[%pass wire %arvo %b %wait (add now.bowl dr)]
::
++ wait-export (wait /export refresh-rate)
::
++ to-eth-watcher
|= [=wire =task:agent:gall]
^- card
[%pass wire %agent [our.bowl %eth-watcher] task]
::
++ setup-eth-watcher
%+ to-eth-watcher /setup
:+ %poke %eth-watcher-poke
!> ^- poke:eth-watcher
:+ %watch /[dap.bowl]
:* node-url
refresh-rate
public:mainnet-contracts
~[azimuth delegated-sending]:mainnet-contracts
~
==
::
:: see also comment in +setup-cards
++ await-eth-watcher (wait /watch ~m30)
::
++ watch-eth-watcher
%+ to-eth-watcher /watcher
[%watch /logs/[dap.bowl]]
::
++ leave-eth-watcher
%+ to-eth-watcher /watcher
[%leave ~]
::
++ clear-eth-watcher
%+ to-eth-watcher /clear
:+ %poke %eth-watcher-poke
!> ^- poke:eth-watcher
[%clear /logs/[dap.bowl]]
::
++ poke-spider
|= [=wire =cage]
^- card
[%pass wire %agent [our.bowl %spider] %poke cage]
::
++ watch-spider
|= [=wire =sub=path]
^- card
[%pass wire %agent [our.bowl %spider] %watch sub-path]
::
:: +handle-eth-watcher-diff: process new logs, clear state on rollback
::
:: processes logs for which we know the timestamp
:: adds timestamp-less logs to queue
::
++ handle-eth-watcher-diff
|= =diff:eth-watcher
^- (quip card _state)
=^ logs state
^- [loglist _state]
?- -.diff
%history ~& [%got-history (lent loglist.diff)]
[loglist.diff state(qued ~, seen ~)]
%log ~& %got-log
[[event-log.diff ~] state]
%disavow ~& %disavow-unimplemented
[~ state]
==
%- process-logs
%+ skip logs
|= =event-log:rpc
%- is-lockup-block
block-number:(need mined.event-log)
::
:: +is-lockup-block: whether the block contains lockup/ignorable transactions
::
:: this is the stupid dumb equivalent to actually identifying lockup
:: transactions procedurally, which is still in git history, but didn't
:: work quite right for unidentified reasons
::
++ is-lockup-block
|= num=@ud
^- ?
%+ roll
^- (list [@ud @ud])
:~ [7.050.978 7.051.038]
==
|= [[start=@ud end=@ud] in=_|]
?: in &
&((gte num start) (lte num end))
::
:: +request-timestamps: request block timestamps for the logs as necessary
::
:: will come back as a thread result
::
++ request-timestamps
^- (quip card _state)
?~ qued [~ state]
?^ running [~ state]
=/ tid=@ta
%+ scot %ta
:((cury cat 3) dap.bowl '_' (scot %uv eny.bowl))
:_ state(running `tid)
:~ (watch-spider /timestamps/[tid] /thread-result/[tid])
::
%+ poke-spider /timestamps/[tid]
:- %spider-start
=- !>([~ `tid %eth-get-timestamps -])
!> ^- [@t (list @ud)]
:- node-url
=- ~(tap in -)
%- ~(gas in *(set @ud))
^- (list @ud)
%+ turn qued
|= log=event-log:rpc
block-number:(need mined.log)
==
::
:: +save-timestamps: store timestamps into state
::
++ save-timestamps
|= timestamps=(list [@ud @da])
^- (quip card _state)
=. time (~(gas by time) timestamps)
=. running ~
(process-logs ~)
::
:: +process-logs: handle new incoming logs
::
++ process-logs
|= new=loglist :: oldest first
^- (quip card _state)
=. qued (weld qued new)
?~ qued [~ state]
=- %_ request-timestamps
qued (flop rest) :: oldest first
seen (weld logs seen) :: newest first
days (count-events (flop logs)) :: oldest first
==
%+ roll `loglist`qued
|= [log=event-log:rpc [rest=loglist logs=(list [wen=@da wat=event])]]
:: to ensure logs are processed in sane order,
:: stop processing as soon as we skipped one
::
?^ rest [[log rest] logs]
=/ tim=(unit @da)
%- ~(get by time)
block-number:(need mined.log)
?~ tim [[log rest] logs]
:- rest
=+ ven=(event-log-to-event log)
?~ ven logs
[[u.tim u.ven] logs]
::
:: +event-log-to-event: turn raw log into gaze noun
::
++ event-log-to-event
|= log=event-log:rpc
^- (unit event)
?: =(azimuth:mainnet-contracts address.log)
=+ (event-log-to-point-diff log)
?~ - ~
`azimuth+u
?: =(delegated-sending:mainnet-contracts address.log)
?. .= i.topics.log
0x4763.8e3c.ddee.2204.81e4.c3f9.183d.639c.
0efe.a7f0.5fcd.2df4.1888.5572.9f71.5419
~
=+ ^- [of=@ pool=@] ::TODO =/
~| t.topics.log
%+ decode-topics:abi:ethereum t.topics.log
~[%uint %uint]
=+ ^- [by=@ gift=@ to=@] ::TODO =/
~| data.log
%+ decode-topics:abi:ethereum
%+ rash data.log
=- ;~(pfix (jest '0x') -)
%+ stun [3 3]
(bass 16 (stun [64 64] hit))
~[%uint %uint %address]
`invite+[by of gift to]
~
::
:: +count-events: add events to the daily stats
::
++ count-events
|= logs=_seen :: oldest first
^+ days
=/ head=[day=@da sat=stats]
?^ days i.days
*[@da stats]
=+ tail=?~(days ~ t.days)
|-
:: when done, store updated head, but only if it's set
::
?~ logs
?: =(*[@da stats] head) tail
[head tail]
=* log i.logs
:: calculate day for current event, set head if unset
::
=/ day=@da
(sub wen.log (mod wen.log ~d1))
=? day.head =(*@da day.head) day
:: same day as head, so add to it
::
?: =(day day.head)
%_ $
sat.head (count-event wat.log sat.head)
logs t.logs
==
~| [%weird-new-day old=day.head new=day]
?> (gth day day.head)
:: newer day than head of days, so start new head
::
%_ $
tail [head tail]
head [day *stats]
==
::
:: +count-event: add event to the stats, if it's relevant
::
++ count-event
|= [eve=event sat=stats]
^- stats
?- -.eve
%invite sat(invites-senders [by.eve invites-senders.sat])
::
%azimuth
?+ -.dif.eve sat
%spawned sat(spawned [who.dif.eve spawned.sat])
%activated sat(activated [who.eve activated.sat])
%transfer-proxy ?: =(0x0 new.dif.eve) sat
sat(transfer-p [who.eve transfer-p.sat])
%owner sat(transferred [who.eve transferred.sat])
%keys sat(configured [who.eve configured.sat])
%continuity sat(breached [who.eve breached.sat])
%escape ?~ new.dif.eve sat
sat(request [who.eve request.sat])
%sponsor ?. has.new.dif.eve sat
sat(sponsor [who.eve sponsor.sat])
%management-proxy sat(management-p [who.eve management-p.sat])
%voting-proxy sat(voting-p [who.eve voting-p.sat])
%spawn-proxy sat(spawn-p [who.eve spawn-p.sat])
==
==
::
::
:: +export: periodically export data
::
++ export
^- (list card)
:~ (export-move %days (export-days days))
(export-move %months (export-months days))
(export-move %events export-raw)
==
::
:: +export-move: %info move to write exported .txt
::
++ export-move
|= [nom=@t dat=(list @t)]
^- card
=- [%pass /export/[nom] %arvo %c %info -]
%+ foal:space:userlib
/(scot %p our.bowl)/home/(scot %da now.bowl)/gaze-exports/[nom]/txt
[%txt !>(dat)]
::
:: +peek-x: accept gall scry
::
:: %/days/txt: per day, digest stats
:: %/months/txt: per month, digest stats
:: %/raw/txt: all observed events
::
++ peek-x ::TODO
|= pax=path
^- (unit (unit (pair mark *)))
?~ pax ~
?: =(%days i.pax)
:^ ~ ~ %txt
(export-days days)
?: =(%months i.pax)
:^ ~ ~ %txt
(export-months days)
?: =(%raw i.pax)
``txt+export-raw
~
::
:: +export-months: generate a csv of stats per month
::
++ export-months
|= =_days
%- export-days
^+ days
%+ roll (flop days)
|= [[day=@da sat=stats] mos=(list [mod=@da sat=stats])]
^+ mos
=/ mod=@da
%- year
=+ (yore day)
-(d.t 1)
?~ mos [mod sat]~
?: !=(mod mod.i.mos)
[[mod sat] mos]
:_ t.mos
:- mod
::TODO this is hideous. can we make a wet gate do this?
:* (weld spawned.sat spawned.sat.i.mos)
(weld activated.sat activated.sat.i.mos)
(weld transfer-p.sat transfer-p.sat.i.mos)
(weld transferred.sat transferred.sat.i.mos)
(weld configured.sat configured.sat.i.mos)
(weld breached.sat breached.sat.i.mos)
(weld request.sat request.sat.i.mos)
(weld sponsor.sat sponsor.sat.i.mos)
(weld management-p.sat management-p.sat.i.mos)
(weld voting-p.sat voting-p.sat.i.mos)
(weld spawn-p.sat spawn-p.sat.i.mos)
(weld invites-senders.sat invites-senders.sat.i.mos)
==
::
:: +export-days: generate a csv of stats per day
::
++ export-days
|= =_days
:- %- crip
;: weld
"date,"
"spawned,"
"activated,"
"transfer proxy,"
"transferred,"
"transferred (unique),"
"configured,"
"configured (unique),"
"escape request,"
"sponsor change,"
"invites,"
"invites (unique senders)"
==
|^ ^- (list @t)
%+ turn days
|= [day=@da stats]
%- crip
;: weld
(scow %da day) ","
(count spawned) ","
(count activated) ","
(count transfer-p) ","
(unique transferred) ","
(unique configured) ","
(count request) ","
(count sponsor) ","
(unique invites-senders)
==
::
++ count
|* l=(list)
(num (lent l))
::
++ unique
|* l=(list)
;: weld
(count l)
","
(num ~(wyt in (~(gas in *(set)) l)))
==
::
++ num (d-co:co 1)
--
::
:: +export-raw: generate a csv of individual transactions
::
++ export-raw
:- %- crip
;: weld
"date,"
"point,"
"event,"
"field 1,field2,field3"
==
|^ ^- (list @t)
%+ turn seen
:: (cork tail event-to-row crip)
|= [wen=@da =event]
(crip "{(scow %da wen)},{(event-to-row event)}")
::
++ event-to-row
|= =event
?- -.event
%azimuth (point-diff-to-row +.event)
%invite (invite-to-row +.event)
==
::
++ point-diff-to-row
|= [who=ship dif=diff-point]
^- tape
%+ weld "{(pon who)},"
?- -.dif
%full "full,"
%owner "owner,{(adr new.dif)}"
%activated "activated,"
%spawned "spawned,{(pon who.dif)}"
%keys "keys,{(num life.dif)}"
%continuity "breached,{(num new.dif)}"
%sponsor "sponsor,{(spo has.new.dif)},{(pon who.new.dif)}"
%escape "escape-req,{(req new.dif)}"
%management-proxy "management-p,{(adr new.dif)}"
%voting-proxy "voting-p,{(adr new.dif)}"
%spawn-proxy "spawn-p,{(adr new.dif)}"
%transfer-proxy "transfer-p,{(adr new.dif)}"
==
::
++ invite-to-row
|= [by=ship of=ship ship to=address]
"{(pon by)},invite,{(pon of)},{(adr to)}"
::
++ num (d-co:co 1)
++ pon (cury scow %p)
++ adr |=(a=@ ['0' 'x' ((x-co:co (mul 2 20)) a)])
++ spo |=(h=? ?:(h "escaped to" "detached from"))
++ req |=(r=(unit @p) ?~(r "canceled" (pon u.r)))
--
--

66
pkg/arvo/app/goad.hoon Normal file
View File

@ -0,0 +1,66 @@
/+ default-agent, verb
%+ verb |
^- agent:gall
=>
|%
++ warp
|= =bowl:gall
[%pass /clay %arvo %c %warp our.bowl %home ~ %next %z da+now.bowl /sys]
::
++ wait
|= =bowl:gall
[%pass /behn %arvo %b %wait +(now.bowl)]
::
++ goad
|= force=?
:~ [%pass /gall %arvo %g %goad force ~]
==
--
::
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
++ on-init
:: subscribe to /sys and do initial goad
::
[[(warp bowl) (wait bowl) ~] this]
::
++ on-save on-save:def
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
?: ?=([%noun * %go] +<)
[(goad |) this]
?: ?=([%noun * %force] +<)
[(goad &) this]
(on-poke:def mark vase)
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-arvo
|= [=wire =sign-arvo]
?+ wire (on-arvo:def wire sign-arvo)
[%clay ~]
:: on writ, wait
::
?> ?=(%writ +<.sign-arvo)
:_ this
:~ (warp bowl)
(wait bowl)
==
::
[%behn ~]
:: on wake, goad
::
?> ?=(%wake +<.sign-arvo)
?^ error.sign-arvo
:_ this :_ ~
[%pass /dill %arvo %d %flog %crud %goad-fail u.error.sign-arvo]
%- (slog leaf+"goad: recompiling all apps" ~)
[(goad |) this]
==
::
++ on-fail on-fail:def
--

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

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

231
pkg/arvo/app/link-listen-hook.hoon Normal file
View File

@ -0,0 +1,231 @@
:: link-listen-hook: get your friends' bookmarks
::
:: on-init, subscribes to all groups on this ship.
:: for every ship in a group, we subscribe to their link's local-pages
:: at the group path (through link-proxy-hook),
:: and forwards all entries into our link as submissions.
::
/- *link, group-store
/+ default-agent, verb
::
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
[watch-groups:do]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%groups ~] wire)
=^ cards state
(take-groups-sign:do sign)
[cards this]
?: ?=([%links @ ^] wire)
=^ cards state
(take-links-sign:do (slav %p i.t.wire) t.t.wire sign)
[cards this]
?: ?=([%forward ^] wire)
=^ cards state
(take-forward-sign:do t.wire sign)
[cards this]
~| [dap.bowl %weird-wire wire]
!!
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=([%g %done *] sign-arvo)
(on-arvo:def wire sign-arvo)
?~ error.sign-arvo [~ this]
=/ =tank leaf+"{(trip dap.bowl)}'s message went wrong!"
%- (slog tank tang.u.error.sign-arvo)
[~ this]
::
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
::
|_ =bowl:gall
::
:: groups subscription
::
++ watch-groups
^- card
[%pass /groups %agent [our.bowl %group-store] %watch /all]
::
++ take-groups-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
%kick [[watch-groups]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to groups. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial (handle-group-initial !<(groups:group-store vase))
%group-update (handle-group-update !<(group-update:group-store vase))
==
==
::
++ handle-group-initial
|= =groups:group-store
^- (quip card _state)
=| cards=(list card)
=/ groups=(list [=path =group:group-store])
~(tap by groups)
|-
?~ groups [cards state]
=^ caz state
%- handle-group-update
[%add [group path]:i.groups]
$(cards (weld cards caz), groups t.groups)
::
++ handle-group-update
|= upd=group-update:group-store
^- (quip card _state)
:_ state
?+ -.upd ~
?(%path %add %remove)
=/ whos=(list ship) ~(tap in members.upd)
|- ^- (list card)
?~ whos ~
:: no need to subscribe to ourselves
::
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
%. [i.whos pax.upd]
?: ?=(%remove -.upd)
end-link-subscription
start-link-subscription
==
::
:: link subscriptions
::
++ start-link-subscription
|= [who=ship where=path]
^- card
:* %pass
[%links (scot %p who) where]
%agent
[who %link-proxy-hook]
%watch
[%local-pages where]
==
::
++ end-link-subscription
|= [who=ship where=path]
^- card
:* %pass
[%links (scot %p who) where]
%agent
[who %link-proxy-hook]
%leave
~
==
::
++ take-links-sign
|= [who=ship where=path =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links who where] !!)
%kick [[(start-link-subscription who where)]~ state]
::
%watch-ack
?~ p.sign [~ state]
:: our subscription request got rejected for whatever reason,
:: (most likely difference in group membership,)
:: so we don't try again.
::TODO but now the only way to retry is to remove from group and re-add...
:: this is a problem because our and their group may not update
:: simultaneously...
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%link-update (handle-link-update who where !<(update vase))
==
==
::
++ handle-link-update
|= [who=ship where=path =update]
^- (quip card _state)
?> ?=(%local-pages -.update)
?> =(src.bowl who)
:_ state
%+ turn pages.update
|= =page
^- card
:* %pass
[%forward (scot %p who) where]
%agent
[our.bowl %link-store]
%poke
%link-action
!>([%hear where src.bowl page])
==
::
++ take-forward-sign
|= [=wire =sign:agent:gall]
^- (quip card _state)
~| [%unexpected-sign on=[%forward wire] -.sign]
?> ?=(%poke-ack -.sign)
?~ p.sign [~ state]
=/ =tank
:- %leaf
;: weld
(trip dap.bowl)
" failed to save submission from "
(spud wire)
==
%- (slog tank u.p.sign)
[~ state]
--

231
pkg/arvo/app/link-proxy-hook.hoon Normal file
View File

@ -0,0 +1,231 @@
:: link-proxy-hook: make local pages available to foreign ships
::
:: this is a "proxy" style hook, relaying foreign subscriptions into local
:: stores if permission conditions are met.
:: the patterns herein should one day be generalized into a proxy-hook lib.
::
:: this adopts a very primitive view of groups-store as containing only
:: groups of interesting (rather than uninteresting) ships. it sets the
:: permission condition to be that ship must be in group matching the path
:: it's subscribing to.
:: we check this on-watch, but also subscribe to groups so that we can kick
:: subscriptions if needed (eg ship removed from group).
::
:: we deduplicate incoming subscriptions on the same path, ensuring we have
:: exactly one local subscription per unique incoming subscription path.
:: this comes at the cost of assuming that the store's initial response is
:: whatever's returned by the scry at that path, but perhaps that should
:: become part of the stores standard anyway.
::
/- *link, group-store
/+ default-agent, verb
|%
+$ state-0
$: %0
::TODO we use this to detect "first sub started" and "last sub left",
:: but can't we use [wex sup]:bowl for that?
active=(map path (set ship))
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %&) bowl)
::
++ on-init
^- (quip card _this)
:_ this
[watch-groups:do]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-watch
|= =path
^- (quip card _this)
:: the local ship should just use link-store directly
::TODO do we want to allow this anyway, to avoid client-side target checks?
::
?< (team:title [our src]:bowl)
?> (permitted:do src.bowl path)
=^ cards state
(start-proxy:do src.bowl path)
[cards this]
::
++ on-leave
|= =path
^- (quip card _this)
=^ cards state
(stop-proxy:do src.bowl path)
[cards this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?: ?=([%groups ~] wire)
=^ cards state
(take-groups-sign:do sign)
[cards this]
?: ?=([%proxy ^] wire)
=^ cards state
(handle-proxy-sign t.wire sign)
[cards this]
~| [dap.bowl %weird-wire wire]
!!
::
++ on-poke on-poke:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ permitted
|= [who=ship =path]
^- ?
:: we only expose /local-pages, and only to ships in the relevant group
::
?. ?=([%local-pages ^] path) |
=; group
?& ?=(^ group)
(~(has in u.group) who)
==
.^ (unit group:group-store)
%gx
(scot %p our.bowl)
%group-store
(scot %da now.bowl)
(snoc t.path %noun)
==
::
:: groups subscription
::TODO largely copied from link-listen-hook. maybe make a store-listener lib?
::
++ watch-groups
^- card
[%pass /groups %agent [our.bowl %group-store] %watch /all]
::
++ take-groups-sign
|= =sign:agent:gall
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
%kick [[watch-groups]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to group store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
::
%fact
=* mark p.cage.sign
=* vase q.cage.sign
~& [dap.bowl %fact mark]
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
%group-initial [~ state]
%group-update (handle-group-update !<(group-update:group-store vase))
==
==
::
++ handle-group-update
|= upd=group-update:group-store
^- (quip card _state)
:_ state
?. ?=(%remove -.upd) ~
=/ whos=(list ship) ~(tap in members.upd)
|- ^- (list card)
?~ whos ~
:: no need to remove to ourselves
::
?: =(our.bowl i.whos)
$(whos t.whos)
:_ $(whos t.whos)
::NOTE this depends kind of unfortunately on the fact that we only accept
:: subscriptions to /local-pages/* paths. it'd be more correct if we
:: "just" looked at all paths in the map, and found the matching ones.
(kick-proxy i.whos [%local-pages pax.upd])
::
:: proxy subscriptions
::
++ kick-proxy
|= [who=ship =path]
^- card
[%give %kick `path `who]
::
++ handle-proxy-sign
|= [=path =sign:agent:gall]
^- (quip card _state)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack path] !!)
%fact [[%give %fact `path cage.sign]~ state]
%kick [[(proxy-pass-link-store path %watch path)]~ state]
::
%watch-ack
?~ p.sign [~ state]
=/ =tank
:- %leaf
"{(trip dap.bowl)} failed subscribe to link-store. very wrong!"
%- (slog tank u.p.sign)
[~ state]
==
::
++ proxy-pass-link-store
|= [=path =task:agent:gall]
^- card
:* %pass
[%proxy path]
%agent
[our.bowl %link-store]
task
==
::
++ initial-response
|= =path
^- card
=/ initial=update
[%local-pages path .^(pages %gx path)]
[%give %fact ~ %link-update !>(initial)]
::
++ start-proxy
|= [who=ship =path]
^- (quip card _state)
:_ state(active (~(put ju active) path who))
:_ ~
:: if we already have a local subscription open,
::
?. =(~ (~(get ju active) path))
:: gather the initial response ourselves, and send that.
::
(initial-response path)
:: else, open a local subscription,
:: sending outward its initial response when we hear it.
::
(proxy-pass-link-store path %watch path)
::
++ stop-proxy
|= [who=ship =path]
^- (quip card _state)
=. active (~(del ju active) path who)
:_ state
:: if there are still subscriptions remaining, do nothing.
::
?. =(~ (~(get ju active) path)) ~
:: else, close the local subscription.
::
[(proxy-pass-link-store path %leave ~)]~
--

230
pkg/arvo/app/link-server-hook.hoon Normal file
View File

@ -0,0 +1,230 @@
:: link-server: accessing link-store via eyre
::
:: only accepts requests authenticated as the host ship.
::
:: GET requests:
:: /~link/local-pages/[some-path].json?p=0
:: our submissions on path, with optional pagination
::
:: POST requests:
:: /~link/add/[some-path]
:: send {title url} json, will save link at path
::
/+ *link, *server, default-agent, verb
::
|%
+$ state-0
$: %0
~
::NOTE this means we could get away with just producing cards everywhere,
:: never producing new state outside of the agent interface core.
:: we opt to keep ^-(quip card _state) in place for most logic arms
:: because it doesn't cost much, results in unsurprising code, and
:: makes adding any state in the future easier.
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
:_ this
[start-serving:do]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-watch
|= =path
^- (quip card _this)
?: ?=([%http-response *] path)
[~ this]
(on-watch:def path)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?. ?=(%handle-http-request mark)
(on-poke:def mark vase)
:_ this
=+ !<([eyre-id=@ta =inbound-request:eyre] vase)
(handle-http-request:do eyre-id inbound-request)
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?. ?=(%bound +<.sign-arvo)
(on-arvo:def wire sign-arvo)
[~ this]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=(%poke-ack -.sign)
(on-agent:def wire sign)
?~ p.sign [~ this]
=/ =tank
leaf+"{(trip dap.bowl)} failed writing to %link-store"
%- (slog tank u.p.sign)
[~ this]
::
++ on-peek on-peek:def
++ on-leave on-leave:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
++ start-serving
^- card
[%pass / %arvo %e %connect [~ /'~link'] dap.bowl]
::
++ do-action
|= =action
^- card
[%pass / %agent [our.bowl %link-store] %poke %link-action !>(action)]
::
++ do-add
|= [=path title=@t =url]
^- card
(do-action %add path title url)
::
++ handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (list card)
::NOTE we don't use +require-authorization because it's too restrictive
:: on the flow we want here.
::
?. ?& authenticated.inbound-request
=(src.bowl our.bowl)
==
::TODO `*octs -> ~ everywhere once no-data bug is fixed
(give-simple-payload:app eyre-id [[403 ~] `*octs])
:: request-line: parsed url + params
::
=/ =request-line
%- parse-request-line
url.request.inbound-request
=* req-head header-list.request.inbound-request
=- ::TODO =; [cards=(list card) =simple-payload:http]
%+ weld cards
(give-simple-payload:app eyre-id simple-payload)
^- [cards=(list card) =simple-payload:http]
?+ method.request.inbound-request [~ not-found:gen]
%'OPTIONS'
[~ (include-cors-headers req-head [[200 ~] `*octs])]
::
%'GET'
[~ (handle-get req-head request-line)]
::
%'POST'
(handle-post req-head request-line body.request.inbound-request)
==
::
++ handle-post
|= [request-headers=header-list:http =request-line body=(unit octs)]
^- [(list card) simple-payload:http]
=- ::TODO =; [success=? cards=(list card)]
:- cards
%+ include-cors-headers
request-headers
::TODO it would be more correct to wait for the %poke-ack instead of
:: sending this response right away... but link-store pokes can't
:: actually fail right now, so it's fine.
[[?:(success 200 400) ~] `*octs]
^- [success=? cards=(list card)]
?~ body [| ~]
?+ request-line [| ~]
[[~ [%'~link' %add ^]] ~]
^- [? (list card)]
=/ jon=(unit json) (de-json:html q.u.body)
?~ jon [| ~]
=/ page=(unit [title=@t =url])
%. u.jon
(ot title+so url+so ~):dejs-soft:format
?~ page [| ~]
[& [(do-add t.t.site.request-line [title url]:u.page) ~]]
==
::
++ handle-get
|= [request-headers=header-list:http =request-line]
%+ include-cors-headers
request-headers
^- simple-payload:http
:: args: map of params
:: p: pagination index
::
=/ args
%- ~(gas by *(map @t @t))
args.request-line
=/ p=(unit @ud)
%+ biff (~(get by args) 'p')
(curr rush dim:ag)
?+ request-line not-found:gen
::TODO expose submissions, other data
:: local links by recency as json
::
[[[~ %json] [%'~link' %local-pages ^]] *]
%- json-response:gen
%- json-to-octs ::TODO include in +json-response:gen
^- json
:- %a
%+ turn
`pages`(get-pages t.t.site.request-line p)
`$-(page json)`page:en-json
==
::
++ include-cors-headers
|= [request-headers=header-list:http =simple-payload:http]
^+ simple-payload
=* out-heads headers.response-header.simple-payload
=; =header-list:http
|-
?~ header-list simple-payload
=* new-head i.header-list
=. out-heads
(set-header:http key.new-head value.new-head out-heads)
$(header-list t.header-list)
=/ origin=@t
=/ headers=(map @t @t)
(~(gas by *(map @t @t)) request-headers)
(~(gut by headers) 'origin' '*')
:~ 'Access-Control-Allow-Origin'^origin
'Access-Control-Allow-Credentials'^'true'
'Access-Control-Request-Method'^'OPTIONS, GET, POST'
'Access-Control-Allow-Methods'^'OPTIONS, GET, POST'
'Access-Control-Allow-Headers'^'content-type'
==
::
++ page-size 25
++ get-pages
|= [=path p=(unit @ud)]
^- pages
=; =pages
?~ p pages
%+ scag page-size
%+ slag (mul u.p page-size)
pages
.^ pages
%gx
(scot %p our.bowl)
%link-store
(scot %da now.bowl)
%local-pages
(snoc path %noun)
==
--

172
pkg/arvo/app/link-store.hoon Normal file
View File

@ -0,0 +1,172 @@
:: link: social bookmarking
::
:: the paths under which links are submitted are generally expected to
:: correspond to existing group paths. for strictly-local collections of
:: links, arbitrary paths are probably fair game, but could trip up
:: primitive ui implementations.
::
:: scry and subscription paths:
::
:: /local-pages/[some-group] all pages we saved by recency
:: /submissions/[some-group] all submissions by recency
::
/+ *link, default-agent, verb
::
|%
+$ state-0
$: %0
by-group=(map path links)
by-site=(map site (list [path submission]))
==
::
+$ links
$: ::NOTE all lists by recency
=submissions
ours=pages
==
::
+$ card card:agent:gall
--
::
=| state-0
=* state -
::
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ 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 src]:bowl) ::TODO /lib/store
=^ cards state
?+ mark (on-poke:def mark vase)
::TODO move json conversion into mark once mark performance improves
%json (do-action:do (action:de-json !<(json vase)))
%link-action (do-action:do !<(action vase))
==
[cards this]
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%y ?(%local-pages %submissions) ~]
``noun+!>(~(key by by-group))
::
[%x %local-pages ^]
``noun+!>((get-local-pages:do t.t.path))
::
[%x %submissions ^]
``noun+!>((get-submissions:do t.t.path))
==
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title [our src]:bowl) ::TODO /lib/store
:_ this
|^ ?+ path (on-watch:def path)
[%local-pages ^]
%+ give %link-update
[%local-pages t.path (get-local-pages:do t.path)]
::
[%submissions ^]
%+ give %link-update
[%submissions t.path (get-submissions:do t.path)]
==
::
++ give
|* [=mark =noun]
^- (list card)
[%give %fact ~ mark !>(noun)]~
--
::
++ on-leave on-leave:def
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
::
:: writing
::
++ do-action
|= =action
^- (quip card _state)
?- -.action
%add (add-page +.action)
%hear (hear-submission +.action)
==
:: +add-page: save a page ourselves
::
++ add-page
|= [=path title=@t =url]
^- (quip card _state)
?< =(~ path)
:: add page to group ours
::
=/ =links (~(gut by by-group) path *links)
=/ =page [title url now.bowl]
=. ours.links [page ours.links]
=. by-group (~(put by by-group) path links)
:: do generic submission logic
::
=^ cards state
(hear-submission path [our.bowl page])
:: send updates to subscribers
::
:_ state
:_ cards
:+ %give %fact
:+ `[%local-pages path]
%link-update
!>([%local-pages path [page]~])
:: +hear-submission: record page someone else saved
::
++ hear-submission
|= [=path =submission]
^- (quip card _state)
?< =(~ path)
:: add link to group submissions
::
=/ =links (~(gut by by-group) path *links)
=. submissions.links [submission submissions.links]
=. by-group (~(put by by-group) path links)
:: add submission to global sites
::
=/ =site (site-from-url url.submission)
=. by-site (~(add ja by-site) site [path submission])
:: send updates to subscribers
::
:_ state
:_ ~
:+ %give %fact
:+ `[%submissions path]
%link-update
!>([%submissions path [submission]~])
::
:: reading
::
++ get-local-pages
|= =path
^- pages
ours:(~(gut by by-group) path *links)
::
++ get-submissions
|= =path
^- submissions
submissions:(~(gut by by-group) path *links)
--

10
pkg/arvo/gen/group-store/add.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|add: add members to a group
::
/- *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path members=(list ship) ~] ~]
==
:- %group-action
^- group-action
[%add (sy members) path]

10
pkg/arvo/gen/group-store/create.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|create: initialize a group
::
/- *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path ~] ~]
==
:- %group-action
^- group-action
[%bundle path]

10
pkg/arvo/gen/group-store/remove.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|remove: remove members from a group
::
/- *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path members=(list ship) ~] ~]
==
:- %group-action
^- group-action
[%remove (sy members) path]

10
pkg/arvo/gen/hood/ames-sift.hoon Normal file
View File

@ -0,0 +1,10 @@
:: Helm: Set Ames Verbosity by Ship
::
/? 310
::
::::
::
:- %say
|= [^ ships=(list ship) ~]
:- %helm-ames-sift
ships

2
pkg/arvo/gen/hood/reboot.hoon
View File

@ -10,4 +10,4 @@
|= $: {now/@da eny/@uvJ bec/beak}
{arg/~ ~}
==
[%helm-reload ~[%z %a %b %c %d %f %g %j %l]]
[%helm-reload ~[%z %a %b %c %d %e %f %g %i %j]]

10
pkg/arvo/gen/link-store/add.hoon Normal file
View File

@ -0,0 +1,10 @@
:: link-store|add: save a link to a path
::
/- *link
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path title=@t =url ~] ~]
==
:- %link-action
^- action
[%add path title url]

280
pkg/arvo/lib/claz.hoon Normal file
View File

@ -0,0 +1,280 @@
:: claz: call data generation
::
/- *claz
::
=, ethereum
::
|%
++ read-invites ::TODO lib
|= file=path
^- (list [=ship ticket=@q =address])
=+ txt=.^((list cord) %cx file)
%+ murn txt
|= line=cord
^- (unit [ship @q address])
?: =('' line) ~
%- some
~| line
%+ rash line
;~ (glue com)
;~(pfix sig fed:ag)
;~(pfix sig feq:ag)
;~(pfix (jest '0x') hex)
==
::
++ get-contracts
|= =network
?+ network ~&(%careful-fallback-contracts mainnet-contracts:azimuth)
%mainnet mainnet-contracts:azimuth
%ropsten ropsten-contracts:azimuth
==
::
++ encode-claz-call
|= =call
?- -.call
%create-galaxy (create-galaxy:dat +.call)
%spawn (spawn:dat +.call)
%configure-keys (configure-keys:dat +.call)
%set-management-proxy (set-management-proxy:dat +.call)
%set-voting-proxy (set-voting-proxy:dat +.call)
%set-spawn-proxy (set-spawn-proxy:dat +.call)
%transfer-ship (transfer-ship:dat +.call)
%set-transfer-proxy (set-transfer-proxy:dat +.call)
%adopt (adopt:dat +.call)
%start-document-poll (start-document-poll:dat +.call)
%cast-document-vote (cast-document-vote:dat +.call)
::
%send-point (send-point:dat +.call)
==
::
+$ call-data call-data:rpc
++ dat
|%
++ enc
|* cal=$-(* call-data)
(cork cal encode-call:rpc)
::
++ create-galaxy (enc create-galaxy:cal)
++ spawn (enc spawn:cal)
++ configure-keys (enc configure-keys:cal)
++ set-spawn-proxy (enc set-spawn-proxy:cal)
++ transfer-ship (enc transfer-ship:cal)
++ set-management-proxy (enc set-management-proxy:cal)
++ set-voting-proxy (enc set-voting-proxy:cal)
++ set-transfer-proxy (enc set-transfer-proxy:cal)
++ set-dns-domains (enc set-dns-domains:cal)
++ upgrade-to (enc upgrade-to:cal)
++ transfer-ownership (enc transfer-ownership:cal)
++ adopt (enc adopt:cal)
++ start-document-poll (enc start-document-poll:cal)
++ cast-document-vote (enc cast-document-vote:cal)
::
++ register-linear (enc register-linear:cal)
++ register-conditional (enc register-conditional:cal)
++ deposit (enc deposit:cal)
::
++ send-point (enc send-point:cal)
--
::
::TODO lib
++ cal
|%
++ create-galaxy
|= [gal=ship to=address]
^- call-data
?> =(%czar (clan:title gal))
:- 'createGalaxy(uint8,address)'
:~ [%uint `@`gal]
[%address to]
==
::
++ spawn
|= [who=ship to=address]
^- call-data
?> ?=(?(%king %duke) (clan:title who))
:- 'spawn(uint32,address)'
:~ [%uint `@`who]
[%address to]
==
::
++ configure-keys
|= [who=ship crypt=@ auth=@]
^- call-data
::TODO maybe disable asserts?
?> (lte (met 3 crypt) 32)
?> (lte (met 3 auth) 32)
:- 'configureKeys(uint32,bytes32,bytes32,uint32,bool)'
:~ [%uint `@`who]
[%bytes-n 32^crypt]
[%bytes-n 32^auth]
[%uint 1]
[%bool |]
==
::
++ set-management-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setManagementProxy(uint32,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ set-voting-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setVotingProxy(uint8,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ set-spawn-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setSpawnProxy(uint16,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ transfer-ship
|= [who=ship to=address]
^- call-data
:- 'transferPoint(uint32,address,bool)'
:~ [%uint `@`who]
[%address to]
[%bool |]
==
::
++ set-transfer-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setTransferProxy(uint32,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ start-document-poll
|= [gal=ship hash=@]
^- call-data
?> =(%czar (clan:title gal))
:- 'startDocumentPoll(uint8,bytes32)'
:~ [%uint `@`gal]
[%bytes-n 32^hash]
==
::
++ cast-document-vote
|= [gal=ship hash=@ support=?]
^- call-data
?> =(%czar (clan:title gal))
:- 'castDocumentVote(uint8,bytes32,bool)'
:~ [%uint `@`gal]
[%bytes-n 32^hash]
[%bool support]
==
::
::
++ set-dns-domains
|= [pri=tape sec=tape ter=tape]
^- call-data
:- 'setDnsDomains(string,string,string)'
:~ [%string pri]
[%string sec]
[%string ter]
==
::
++ upgrade-to
|= to=address
^- call-data
:- 'upgradeTo(address)'
:~ [%address to]
==
::
::
++ transfer-ownership :: of contract
|= to=address
^- call-data
:- 'transferOwnership(address)'
:~ [%address to]
==
::
++ adopt
|= who=ship
^- call-data
:- 'adopt(uint32)'
:~ [%uint `@`who]
==
::
::
++ register-linear
|= $: to=address
windup=@ud
stars=@ud
rate=@ud
rate-unit=@ud
==
^- call-data
:- 'register(address,uint256,uint16,uint16,uint256)'
:~ [%address to]
[%uint windup]
[%uint stars]
[%uint rate]
[%uint rate-unit]
==
::
++ register-conditional
|= $: to=address
b1=@ud
b2=@ud
b3=@ud
rate=@ud
rate-unit=@ud
==
^- call-data
:- 'register(address,uint16[],uint16,uint256)'
:~ [%address to]
[%array ~[uint+b1 uint+b2 uint+b3]]
[%uint rate]
[%uint rate-unit]
==
::
++ deposit
|= [to=address star=ship]
^- call-data
:- 'deposit(address,uint16)'
:~ [%address to]
[%uint `@`star]
==
::
++ send-point
|= [as=ship point=ship to=address]
^- call-data
:- 'sendPoint(uint32,uint32,address)'
:~ [%uint `@`as]
[%uint `@`point]
[%address to]
==
::
:: read calls
::
++ rights
|= =ship
^- call-data
:- 'rights(uint32)'
:~ [%uint `@`ship]
==
::
++ get-pool
|= =ship
^- call-data
:- 'getPool(uint32)'
:~ [%uint `@`ship]
==
::
++ pools
|= [pool=@ud star=ship]
^- call-data
:- 'pools(uint32,uint16)'
:~ [%uint pool]
[%uint `@`star]
==
--
--

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

@ -18,11 +18,12 @@
(request-batch-rpc-strict url [id req]~)
?: ?=([* ~] res)
(pure:m json.i.res)
~| [%ethio %unexpected-results (lent res)]
!!
%+ strand-fail:strandio
%unexpected-multiple-results
[>(lent res)< ~]
:: +request-batch-rpc-strict: send rpc request, with retry
::
:: sends a batch requests. produces results for all requests in the batch,
:: sends a batch request. produces results for all requests in the batch,
:: but only if all of them are successful.
::
++ request-batch-rpc-strict
@ -100,16 +101,52 @@
:: +read-contract: calls a read function on a contract, produces result hex
::
++ read-contract
|= [url=@t proto-read-request:rpc:ethereum]
|= [url=@t req=proto-read-request:rpc:ethereum]
=/ m (strand:strandio ,@t)
;< =json bind:m
%^ request-rpc url id
;< res=(list [id=@t res=@t]) bind:m
(batch-read-contract-strict url [req]~)
?: ?=([* ~] res)
(pure:m res.i.res)
%+ strand-fail:strandio
%unexpected-multiple-results
[>(lent res)< ~]
:: +batch-read-contract-strict: calls read functions on contracts
::
:: sends a batch request. produces results for all requests in the batch,
:: but only if all of them are successful.
::
++ batch-read-contract-strict
|= [url=@t reqs=(list proto-read-request:rpc:ethereum)]
|^ =/ m (strand:strandio ,results)
^- form:m
;< res=(list [id=@t =json]) bind:m
%+ request-batch-rpc-strict url
(turn reqs proto-to-rpc)
=+ ^- [=results =failures]
(roll res response-to-result)
?~ failures (pure:m results)
(strand-fail:strandio %batch-read-failed-for >failures< ~)
::
+$ results (list [id=@t res=@t])
+$ failures (list [id=@t =json])
::
++ proto-to-rpc
|= proto-read-request:rpc:ethereum
^- [(unit @t) request:rpc:ethereum]
:- id
:+ %eth-call
^- call:rpc:ethereum
[~ to ~ ~ ~ `tape`(encode-call:rpc:ethereum function arguments)]
[%label %latest]
?. ?=(%s -.json) (strand-fail:strandio %request-rpc-fail >json< ~)
(pure:m p.json)
::
++ response-to-result
|= [[id=@t =json] =results =failures]
^+ [results failures]
?: ?=(%s -.json)
[[id^p.json results] failures]
[results [id^json failures]]
--
::
::
++ get-latest-block
|= url=@ta
@ -185,4 +222,14 @@
==
%- pure:m
(parse-event-logs:rpc:ethereum json)
::
++ get-next-nonce
|= [url=@ta =address]
=/ m (strand:strandio ,@ud)
^- form:m
;< =json bind:m
%^ request-rpc url `'nonce'
[%eth-get-transaction-count address [%label %latest]]
%- pure:m
(parse-eth-get-transaction-count:rpc:ethereum json)
--

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

@ -85,6 +85,7 @@
%eth-watcher
%azimuth-tracker
%ping
%goad
==
?: lit
~
@ -212,6 +213,11 @@
%drum-set-boot-apps =;(f (f !<(_+<.f vase)) poke-set-boot-apps)
==
::
++ on-load
|= %1
=< se-abet =< se-view
(se-born %home %goad)
::
++ reap-phat :: ack connect
|= {way/wire saw/(unit tang)}
=< se-abet =< se-view

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

@ -177,6 +177,10 @@
|= ~ =< abet
(flog %verb ~)
::
++ poke-ames-sift
|= ships=(list ship) =< abet
(emit %pass /helm %arvo %a %sift ships)
::
++ poke-ames-verb
|= veb=(list verb:ames) =< abet
(emit %pass /helm %arvo %a %spew veb)
@ -199,6 +203,7 @@
%helm-reload-desk =;(f (f !<(_+<.f vase)) poke-reload-desk)
%helm-reset =;(f (f !<(_+<.f vase)) poke-reset)
%helm-send-hi =;(f (f !<(_+<.f vase)) poke-send-hi)
%helm-ames-sift =;(f (f !<(_+<.f vase)) poke-ames-sift)
%helm-ames-verb =;(f (f !<(_+<.f vase)) poke-ames-verb)
%helm-verb =;(f (f !<(_+<.f vase)) poke-verb)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)

49
pkg/arvo/lib/link.hoon Normal file
View File

@ -0,0 +1,49 @@
:: link: social bookmarking
::
/- *link
::
|%
++ site-from-url
|= =url
^- site
=/ murl=(unit purl:eyre)
(de-purl:html url)
?~ murl 'http://example.com'
%^ cat 3
:: render protocol
::
=* sec p.p.u.murl
?:(sec 'https://' 'http://')
:: render host
::
=* host r.p.u.murl
?- -.host
%& (roll (join '.' p.host) (cury cat 3))
%| (rsh 3 1 (scot %if p.host))
==
::
++ en-json
=, enjs:format
|%
++ page
|= =^page
^- json
%- pairs
:~ 'title'^s+title.page
'url'^s+url.page
'timestamp'^(time time.page)
==
--
::
++ de-json
=, dejs:format
|%
++ action
|= =json
^- ^action
?> ?=([%o [%add *] ~ ~] json)
:- %add ::TODO +of doesn't please type system?
%. q.n.p.json
(ot 'path'^pa 'title'^so 'url'^so ~)
--
--

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

@ -1,11 +1,14 @@
=, eyre
|%
::
+$ request-line
$: [ext=(unit @ta) site=(list @t)]
args=(list [key=@t value=@t])
==
:: +parse-request-line: take a cord and parse out a url
::
++ parse-request-line
|= url=@t
^- [[ext=(unit @ta) site=(list @t)] args=(list [key=@t value=@t])]
^- request-line
(fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~])
::
++ manx-to-octs

15
pkg/arvo/mar/link/update.hoon Normal file
View File

@ -0,0 +1,15 @@
:: link: subscription updates
::
::TODO this should include json conversion once mark performance improves
/- *link
|_ =update
++ grow
|%
++ noun update
--
::
++ grab
|%
++ noun ^update
--
--

76
pkg/arvo/sur/claz.hoon Normal file
View File

@ -0,0 +1,76 @@
:: claz: command & call structures
::
::TODO contract structures might go into stdlib
::
=, ethereum-types
::
|%
++ command
$% [%generate =path =network as=address =batch]
==
::
++ network
$? %mainnet
%ropsten
%fakenet
[%other id=@]
==
::
++ batch
$~ [%deed '{}']
$% :: %single: execute a single ecliptic function call
::
[%single =call]
:: %deed: deed ships based on json, assumes spawnable
::
[%deed deeds-json=cord]
:: %invites: sendPoint for every ship in ship,ticket,owner file
::
:: to generate such a file, try |claz-invites ~star 1 10 %/out/txt
::
[%invites as-who=ship file=path]
:: %lock-prep: prepare for lockup by transfering ships to the ceremony address
::
[%lock-prep what=(list ship)]
:: %lock: put ships into lockup for the target address
::
[%lock how=?(%spawn %transfer) what=(list ship) to=address =lockup]
:: %more: multiple batches sequentially
::
[%more batches=(list batch)]
==
::
++ lockup
$% [%linear windup-years=@ud unlock-years=@ud]
[%conditional [b1=@ud b2=@ud b3=@ud] unlock-years-per-batch=@ud]
==
::
++ rights
$: own=address
manage=(unit address)
voting=(unit address)
transfer=(unit address)
spawn=(unit address)
net=(unit [crypt=@ux auth=@ux])
==
::
++ call
$% [%create-galaxy gal=ship to=address]
[%spawn who=ship to=address]
[%configure-keys who=ship crypt=@ auth=@]
[%set-management-proxy who=ship proxy=address]
[%set-voting-proxy who=ship proxy=address]
[%set-spawn-proxy who=ship proxy=address]
[%transfer-ship who=ship to=address]
[%set-transfer-proxy who=ship proxy=address]
[%adopt who=ship]
[%start-document-poll gal=ship hash=@]
[%cast-document-vote gal=ship hash=@ vote=?]
::
[%send-point as=ship point=ship to=address]
==
::
++ prep-result
$% [%nonce nonce=@ud]
==
--

44
pkg/arvo/sur/link.hoon Normal file
View File

@ -0,0 +1,44 @@
:: link: social bookmarking
::
:: link operates on the core structure of "pages", which are URLs saved at a
:: specific time with a specific title.
:: submissions, then, are pages received from a specific ship.
::
|%
:: primitives
::
+$ url @t
+$ site @t :: domain, host, etc.
:: +page: a saved URL with timestamp and custom title
::
+$ page
$: title=@t
=url
=time
==
:: +submission: a page saved by a ship
::
+$ submission
$: =ship
page
==
:: lists, reverse chronological / newest first
::
+$ pages (list page)
+$ submissions (list submission)
::
:: +action: local actions
::
+$ action
$% [%add =path title=@t =url]
[%hear =path from=ship =page] ::TODO just =submission?
==
:: +update: local updates
::
::NOTE we include paths explicitly to support the "subscribed to all" case
::
+$ update
$% [%local-pages =path =pages]
[%submissions =path =submissions]
==
--

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

@ -1335,7 +1335,7 @@
?> ?=(^ c)
?: (mor n.a n.c)
a(r c)
c(r a(r l.c))
c(l a(r l.c))
::
++ rep :: replace by product
|* b/_=>(~ |=({* *} +<+))

245
pkg/arvo/sys/vane/ames.hoon
View File

@ -65,20 +65,24 @@
:* snd=`?`%.n :: sending packets
rcv=`?`%.n :: receiving packets
odd=`?`%.n :: unusual events
msg=`?`%.n :: messages
msg=`?`%.n :: message-level events
ges=`?`%.n :: congestion control
for=`?`%.n :: packet forwards
for=`?`%.n :: packet forwarding
rot=`?`%.n :: routing attempts
==
=>
|%
:: +trace: print if .verb is set
:: +trace: print if .verb is set and we're tracking .ship
::
++ trace
|= [verb=? print=(trap tape)]
|= [verb=? =ship ships=(set ship) print=(trap tape)]
^+ same
?. verb
same
(slog leaf/"ames: {(print)}" ~)
?. => [ship=ship ships=ships in=in]
~+ |(=(~ ships) (~(has in ships) ship))
same
(slog leaf/"ames: {(scow %p ship)}: {(print)}" ~)
--
=>
|%
@ -362,7 +366,7 @@
::
$: =our=life
crypto-core=acru:ames
veb=_veb-all-off
=bug
==
:: her data, specific to this dyad
::
@ -438,12 +442,27 @@
::
:: $ames-state: state for entire vane
::
:: peers: states of connections to other ships
:: unix-duct: handle to give moves to unix
:: life: our $life; how many times we've rekeyed
:: crypto-core: interface for encryption and signing
:: bug: debug printing configuration
::
+$ ames-state
$: peers=(map ship ship-state)
=unix=duct
=life
crypto-core=acru:ames
veb=_veb-all-off
=bug
==
:: $bug: debug printing configuration
::
:: veb: verbosity toggles
:: ships: identity filter; if ~, print for all
::
+$ bug
$: veb=_veb-all-off
ships=(set ship)
==
:: $ship-state: all we know about a peer
::
@ -768,7 +787,7 @@
$% [%hear =message-num =fragment-num]
[%done =message-num lag=@dr]
[%halt ~]
[%wake ~]
[%wake current=message-num]
==
:: $packet-pump-gift: effect from |packet-pump
::
@ -804,7 +823,15 @@
==
:: previous state versions, for +stay/+load migrations
::
+| %plasmodics
+| %plasmonics
::
+$ ames-state-2
$: peers=(map ship ship-state)
=unix=duct
=life
crypto-core=acru:ames
veb=_veb-all-off
==
::
+$ ames-state-1
$: peers=(map ship ship-state-1)
@ -938,29 +965,38 @@
:: lifecycle arms; mostly pass-throughs to the contained adult ames
::
++ scry scry:adult-core
++ stay [%2 %larva queued-events ames-state.adult-gate]
++ stay [%3 %larva queued-events ames-state.adult-gate]
++ load
|= $= old
$% $: %2
$% $: %3
$% [%larva events=_queued-events state=_ames-state.adult-gate]
[%adult state=_ames-state.adult-gate]
== ==
::
$: %2
$% [%larva events=_queued-events state=ames-state-2]
[%adult state=ames-state-2]
== ==
::
$% [%larva events=_queued-events state=ames-state-1]
[%adult state=ames-state-1]
== ==
?- old
[%2 %adult *]
(load:adult-core %2 state.old)
[%3 %adult *] (load:adult-core %3 state.old)
[%2 %adult *] (load:adult-core %2 state.old)
[%adult *] (load:adult-core %1 state.old)
::
[%3 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %3 state.old)
larval-gate
::
[%2 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %2 state.old)
larval-gate
::
[%adult *]
(load:adult-core %1 state.old)
::
[%larva *]
~> %slog.0^leaf/"ames: larva: load"
@ -975,7 +1011,7 @@
=| =ames-state
|= [our=ship now=@da eny=@ scry-gate=sley]
=* ames-gate .
=* veb veb.ames-state
=* veb veb.bug.ames-state
|%
:: +call: handle request $task
::
@ -1001,6 +1037,7 @@
%hole (on-hole:event-core [lane blob]:task)
%init (on-init:event-core ship=p.task)
%jilt (on-jilt:event-core ship.task)
%sift (on-sift:event-core ships.task)
%spew (on-spew:event-core veb.task)
%vega on-vega:event-core
%wegh on-wegh:event-core
@ -1032,43 +1069,61 @@
[moves ames-gate]
:: +stay: extract state before reload
::
++ stay [%2 %adult ames-state]
++ stay [%3 %adult ames-state]
:: +load: load in old state after reload
::
++ load
|= $= old-state
$% [%1 ames-state-1]
[%2 ^ames-state]
[%2 ames-state-2]
[%3 ^ames-state]
==
^+ ames-gate
?- -.old-state
%2
ames-gate(ames-state +.old-state)
|^ ^+ ames-gate
::
=? old-state ?=(%1 -.old-state) %2^(state-1-to-2 +.old-state)
=? old-state ?=(%2 -.old-state) %3^(state-2-to-3 +.old-state)
::
?> ?=(%3 -.old-state)
ames-gate(ames-state +.old-state)
::
%1
=> .(old-state +.old-state)
=. +.ames-state
:* unix-duct.old-state
life.old-state
crypto-core.old-state
veb-all-off
++ state-1-to-2
|= =ames-state-1
^- ames-state-2
::
=| =ames-state-2
=. +.ames-state-2
:* unix-duct.ames-state-1
life.ames-state-1
crypto-core.ames-state-1
veb=veb-all-off
==
=. peers.ames-state
=. peers.ames-state-2
%- ~(gas by *(map ship ship-state))
%+ turn ~(tap by peers.old-state)
|= [peer=ship old-ship-state=ship-state-1]
%+ turn ~(tap by peers.ames-state-1)
|= [peer=ship =ship-state-1]
^- [ship ship-state]
?: ?=(%alien -.old-ship-state)
[peer old-ship-state]
?: ?=(%alien -.ship-state-1)
[peer ship-state-1]
:+ peer %known
%= +.old-ship-state
%= +.ship-state-1
qos
?+ -.qos.old-ship-state qos.old-ship-state
?+ -.qos.ship-state-1 qos.ship-state-1
%unborn [%unborn now]
==
==
ames-gate
==
ames-state-2
::
++ state-2-to-3
|= =ames-state-2
^- ^ames-state
::
:* peers.ames-state-2
unix-duct.ames-state-2
life.ames-state-2
crypto-core.ames-state-2
bug=[veb=veb.ames-state-2 ships=~]
==
--
:: +scry: dereference namespace
::
++ scry
@ -1083,12 +1138,16 @@
++ per-event
=| moves=(list move)
|= [[our=ship now=@da eny=@ scry-gate=sley] =duct =ames-state]
=* veb veb.ames-state
=* veb veb.bug.ames-state
|%
++ event-core .
++ abet [(flop moves) ames-state]
++ emit |=(=move event-core(moves [move moves]))
++ channel-state [life crypto-core veb]:ames-state
++ channel-state [life crypto-core bug]:ames-state
++ trace
|= [verb=? =ship print=(trap tape)]
^+ same
(^trace verb ship ships.bug.ames-state print)
:: +on-take-done: handle notice from vane that it processed a message
::
++ on-take-done
@ -1121,17 +1180,24 @@
=/ nack-trace-bone=^bone (mix 0b10 bone)
::
abet:(run-message-pump:peer-core nack-trace-bone %memo message-blob)
:: +on-spew: handle request to set verbosity toggles
:: +on-sift: handle request to filter debug output by ship
::
++ on-sift
|= ships=(list ship)
^+ event-core
=. ships.bug.ames-state (sy ships)
event-core
:: +on-spew: handle request to set verbosity toggles on debug output
::
++ on-spew
|= verbs=(list verb)
^+ event-core
:: start from all %.n's, then flip requested toggles
::
=. veb.ames-state
=. veb.bug.ames-state
%+ roll verbs
|= [=verb acc=_veb-all-off]
^+ veb.ames-state
^+ veb.bug.ames-state
?- verb
%snd acc(snd %.y)
%rcv acc(rcv %.y)
@ -1187,7 +1253,6 @@
++ on-hole
|= [=lane =blob]
^+ event-core
::
(on-hear-packet lane (decode-packet blob) ok=%.n)
:: +on-hear-packet: handle mildly processed packet receipt
::
@ -1215,7 +1280,8 @@
++ on-hear-forward
|= [=lane =packet ok=?]
^+ event-core
%- (trace for.veb |.("forward: {<sndr.packet>} -> {<rcvr.packet>}"))
%- %^ trace for.veb sndr.packet
|.("forward: {<sndr.packet>} -> {<rcvr.packet>}")
:: set .origin.packet if it doesn't already have one, re-encode, and send
::
=? origin.packet ?=(~ origin.packet) `lane
@ -1356,7 +1422,7 @@
=/ =channel [[our ship] now channel-state -.peer-state]
::
=^ =bone ossuary.peer-state (bind-duct ossuary.peer-state duct)
%- %+ trace msg.veb
%- %^ trace msg.veb ship
|. ^- tape
=/ sndr [our our-life.channel]
=/ rcvr [ship her-life.channel]
@ -1712,7 +1778,8 @@
++ send-blob
|= [for=? =ship =blob]
::
%- (trace rot.veb |.("send-blob: to {<ship>}"))
=/ final-ship ship
%- (trace rot.veb final-ship |.("send-blob: to {<ship>}"))
|-
|^ ^+ event-core
::
@ -1733,10 +1800,10 @@
(try-next-sponsor sponsor.peer-state)
::
?~ route=route.peer-state
%- (trace rot.veb |.("no route to: {<ship>}"))
%- (trace rot.veb final-ship |.("no route to: {<ship>}"))
(try-next-sponsor sponsor.peer-state)
::
%- (trace rot.veb |.("trying route: {<ship>}"))
%- (trace rot.veb final-ship |.("trying route: {<ship>}"))
=. event-core
(emit unix-duct.ames-state %give %send lane.u.route blob)
::
@ -1802,10 +1869,10 @@
::
++ make-peer-core
|= [=peer-state =channel]
=* veb veb.bug.channel
|%
++ peer-core .
++ emit |=(move peer-core(event-core (^emit +<)))
::
++ abet
^+ event-core
::
@ -1813,7 +1880,10 @@
(~(put by peers.ames-state) her.channel %known peer-state)
::
event-core
::
++ trace
|= [verb=? print=(trap tape)]
^+ same
(^trace verb her.channel print)
++ on-heed peer-core(heeds.peer-state (~(put in heeds.peer-state) duct))
++ on-jilt peer-core(heeds.peer-state (~(del in heeds.peer-state) duct))
:: +update-qos: update and maybe print connection status
@ -1890,6 +1960,9 @@
(run-message-sink bone %hear lane shut-packet ok)
:: ignore .ok for |message-pump; just try again on error
::
:: Note this implies that vanes should never crash on %done,
:: since we have no way to continue using the flow if they do.
::
(run-message-pump bone %hear [message-num +.meat]:shut-packet)
:: +on-memo: handle request to send message
::
@ -2210,13 +2283,17 @@
::
++ make-message-pump
|= [state=message-pump-state =channel]
=* veb veb.channel
=* veb veb.bug.channel
=| gifts=(list message-pump-gift)
::
|%
++ message-pump .
++ give |=(gift=message-pump-gift message-pump(gifts [gift gifts]))
++ packet-pump (make-packet-pump packet-pump-state.state channel)
++ trace
|= [verb=? print=(trap tape)]
^+ same
(^trace verb her.channel ships.bug.channel print)
:: +work: handle a $message-pump-task
::
++ work
@ -2226,6 +2303,7 @@
=~ (dispatch-task task)
feed-packets
(run-packet-pump %halt ~)
assert
[(flop gifts) state]
==
:: +dispatch-task: perform task-specific processing
@ -2236,7 +2314,7 @@
::
?- -.task
%memo (on-memo message-blob.task)
%wake (run-packet-pump task)
%wake (run-packet-pump %wake current.state)
%hear
?- -.ack-meat.task
%& (on-hear [message-num fragment-num=p.ack-meat]:task)
@ -2395,16 +2473,30 @@
=. message-pump (give i.packet-pump-gifts)
::
$(packet-pump-gifts t.packet-pump-gifts)
:: +assert: sanity checks to isolate error cases
::
++ assert
^+ message-pump
=/ top-live
(peek:packet-queue:*make-packet-pump live.packet-pump-state.state)
?. |(?=(~ top-live) (gte current.state message-num.key.u.top-live))
~| [%strange-current current=current.state key.u.top-live]
!!
message-pump
--
:: +make-packet-pump: construct |packet-pump core
::
++ make-packet-pump
|= [state=packet-pump-state =channel]
=* veb veb.channel
=* veb veb.bug.channel
=| gifts=(list packet-pump-gift)
|%
++ packet-pump .
++ give |=(packet-pump-gift packet-pump(gifts [+< gifts]))
++ trace
|= [verb=? print=(trap tape)]
^+ same
(^trace verb her.channel ships.bug.channel print)
:: +packet-queue: type for all sent fragments, ordered by sequence number
::
++ packet-queue
@ -2412,7 +2504,7 @@
lte-packets
:: +gauge: inflate a |pump-gauge to track congestion control
::
++ gauge (make-pump-gauge now.channel metrics.state veb.channel)
++ gauge (make-pump-gauge now.channel metrics.state [her bug]:channel)
:: +work: handle $packet-pump-task request
::
++ work
@ -2424,12 +2516,13 @@
?- -.task
%hear (on-hear [message-num fragment-num]:task)
%done (on-done message-num.task)
%wake on-wake
%wake (on-wake current.task)
%halt set-wake
==
:: +on-wake: handle packet timeout
::
++ on-wake
|= current=message-num
^+ packet-pump
:: assert temporal coherence
::
@ -2443,13 +2536,14 @@
::
=- =* res -
=. live.state live.res
=. packet-pump (give %send static-fragment.res)
%- %+ trace snd.veb
=/ nums [message-num fragment-num]:static-fragment.res
|.("dead {<nums^show:gauge>}")
=? packet-pump ?=(^ static-fragment)
%- %+ trace snd.veb
=/ nums [message-num fragment-num]:u.static-fragment.res
|.("dead {<nums^show:gauge>}")
(give %send u.static-fragment.res)
packet-pump
::
=| acc=static-fragment
=| acc=(unit static-fragment)
^+ [static-fragment=acc live=live.state]
::
%^ (traverse:packet-queue _acc) live.state acc
@ -2458,12 +2552,18 @@
val=live-packet-val
==
^- [new-val=(unit live-packet-val) stop=? _acc]
:: if already acked later message, don't resend
::
?: (lth message-num.key current)
%- %- slog :_ ~
leaf+"ames: strange wake queue, expected {<current>}, got {<key>}"
[~ stop=%.n ~]
:: packet has expired; update it in-place, stop, and produce it
::
=. last-sent.val now.channel
=. retries.val +(retries.val)
::
[`val stop=%.y (to-static-fragment key val)]
[`val stop=%.y `(to-static-fragment key val)]
:: +feed: try to send a list of packets, returning unsent and effects
::
++ feed
@ -2584,7 +2684,7 @@
==
^- [new-val=(unit live-packet-val) stop=? _acc]
::
=/ gauge (make-pump-gauge now.channel metrics.acc veb.channel)
=/ gauge (make-pump-gauge now.channel metrics.acc [her bug]:channel)
:: is this the acked packet?
::
?: =(key [message-num fragment-num])
@ -2631,7 +2731,7 @@
==
^- [new-val=(unit live-packet-val) stop=? pump-metrics]
::
=/ gauge (make-pump-gauge now.channel metrics veb.channel)
=/ gauge (make-pump-gauge now.channel metrics [her bug]:channel)
:: if we get an out-of-order ack for a message, skip until it
::
?: (lth message-num.key message-num)
@ -2679,9 +2779,14 @@
:: +make-pump-gauge: construct |pump-gauge congestion control core
::
++ make-pump-gauge
|= [now=@da pump-metrics veb=_veb-all-off]
|= [now=@da pump-metrics =ship =bug]
=* veb veb.bug
=* metrics +<+<
|%
++ trace
|= [verb=? print=(trap tape)]
^+ same
(^trace verb ship ships.bug print)
:: +next-expiry: when should a newly sent fresh packet time out?
::
:: Use rtt + 4*sigma, where sigma is the mean deviation of rtt.
@ -2808,11 +2913,17 @@
::
++ make-message-sink
|= [state=message-sink-state =channel]
=* veb veb.channel
=* veb veb.bug.channel
=| gifts=(list message-sink-gift)
|%
++ message-sink .
++ give |=(message-sink-gift message-sink(gifts [+< gifts]))
++ trace
|= [verb=? print=(trap tape)]
^+ same
(^trace verb her.channel ships.bug.channel print)
:: +work: handle a $message-sink-task
::
++ work
|= task=message-sink-task
^+ [gifts state]

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

@ -391,6 +391,18 @@
padding-top: 22px;
margin-bottom: 66px;
}
h2 {
line-height: 38px;
font-size: 32px;
-webkit-margin-before: 0;
-webkit-margin-after: 0;
-webkit-margin-start: 0;
-webkit-margin-end: 0;
font-weight: 500;
flex: 1;
padding-top: 22px;
margin-bottom: 66px;
}
#main {
vertical-align: middle;
display: table-cell;
@ -431,6 +443,7 @@
;div#inner
;h1#topborder:"Welcome"
;h1#ship-name:"{(scow %p our)}"
;h2:"Get passcode by entering +code at the dojo or from Bridge"
;form(action "/~/login", method "post", enctype "application/x-www-form-urlencoded")
;input(type "password", name "password", placeholder "passcode", autofocus "true");
;input(type "hidden", name "redirect", value redirect-str);

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

@ -229,7 +229,6 @@
=< mo-boot
=/ =note-arvo [%f %kill ~]
(mo-pass wire note-arvo)
::
::
:: +mo-goad: rebuild agent(s)
::
@ -1233,13 +1232,19 @@
[agent-wire dock]
%+ ~(jab by outgoing.subscribers.current-agent) [agent-wire dock]
|= [acked=? =path]
~| [%already-acked agent-name wire dock path]
?< acked
=. .
?. acked
.
%- =/ =tape
"{<agent-name>}: received 2nd watch-ack on {<wire dock path>}"
(slog leaf+tape ~)
.
[& path]
::
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(on-agent:ap-agent-core agent-wire sign)
:: if failed %fact handling, kill subscription
::
=? ap-core ?=(%fact -.sign)
(ap-update-subscription =(~ maybe-tang) p.dock q.dock agent-wire)
@ -1569,9 +1574,6 @@
::
++ all-state $%(state-0 state-1 ^state)
::
:: Note that if you change sign-arvo, you must ensure that spider
:: gets reloaded.
::
++ state-1-to-2
|= =state-1
^- ^state

26
pkg/arvo/sys/zuse.hoon
View File

@ -393,6 +393,7 @@
:: %born: process restart notification
:: %crud: crash report
:: %init: vane boot
:: %sift: limit verbosity to .ships
:: %spew: set verbosity toggles
:: %vega: kernel reload notification
:: %wegh: request for memory usage report
@ -407,6 +408,7 @@
$>(%born vane-task)
$>(%crud vane-task)
$>(%init vane-task)
[%sift ships=(list ship)]
[%spew veb=(list verb)]
$>(%vega vane-task)
$>(%wegh vane-task)
@ -7632,6 +7634,9 @@
++ azimuth
0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb
::
++ ecliptic
0x6ac0.7b7c.4601.b5ce.11de.8dfe.6335.b871.c7c4.dd4d
::
++ linear-star-release
0x86cd.9cd0.992f.0423.1751.e376.1de4.5cec.ea5d.1801
::
@ -7657,10 +7662,20 @@
++ azimuth
0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579
::
++ ecliptic
0x8b9f.86a2.8921.d9c7.05b3.113a.755f.b979.e1bd.1bce
::
++ linear-star-release
0x1f8e.dd03.1ee4.1474.0aed.b39b.84fb.8f2f.66ca.422f
::
++ conditional-star-release
0x0
::
++ delegated-sending
0x1000.0000.0000.0000.0000.0000.0000.0000.0000.0000
0x3e8c.a510.354b.c2fd.bbd6.1502.52d9.3105.c9c2.7bbe
::
++ launch 4.601.630
++ public launch
--
::
:: ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge
@ -8363,7 +8378,7 @@
top=(list ?(@ux (list @ux)))
==
[%eth-get-filter-changes fid=@ud]
[%eth-get-transaction-count adr=address]
[%eth-get-transaction-count adr=address =block]
[%eth-get-transaction-receipt txh=@ux]
[%eth-send-raw-transaction dat=@ux]
==
@ -8584,7 +8599,10 @@
['eth_getFilterChanges' (tape (num-to-hex fid.req)) ~]
::
%eth-get-transaction-count
['eth_getTransactionCount' (tape (address-to-hex adr.req)) ~]
:- 'eth_getTransactionCount'
:~ (tape (address-to-hex adr.req))
(block-to-json block.req)
==
::
%eth-get-transaction-receipt
['eth_getTransactionReceipt' (tape (transaction-to-hex txh.req)) ~]
@ -8659,6 +8677,8 @@
::
++ parse-transaction-hash parse-hex-result
::
++ parse-eth-get-transaction-count parse-hex-result
::
++ parse-event-logs
(ar:dejs:format parse-event-log)
::

119
pkg/arvo/ted/claz/prep-command.hoon Normal file
View File

@ -0,0 +1,119 @@
:: claz/pre-command: sanity-check command and gather prerequisites
::
/- *claz
/+ *claz, ethio, strandio
=, ethereum-types
=, able:jael
::
|= args=vase
=+ ^- [url=@t =command]
!<([@t command] args)
=/ m (strand:strandio ,vase)
^- form:m
?. ?=(%generate -.command) !! ::TODO
|^ ;< err=(unit tang) bind:m
:: sanity-check command
::
?+ -.batch.command (pure:(strand:strandio (unit tang)) ~)
%invites (check-invites +.batch.command)
==
?^ err (strand-fail:strandio %claz-pre-command u.err)
:: gather prerequisites
::
~& [%gonna-get-nonce url as.command]
;< nonce=@ud bind:m
(get-next-nonce:ethio url as.command)
~& [%got-nonce nonce]
(pure:m !>([%nonce nonce]))
::
++ check-invites
|= [as=ship file=path]
=/ m (strand:strandio ,(unit tang))
^- form:m
=/ friends=(list ship)
%+ turn
(read-invites file)
head
;< err=(unit tang) bind:m
(are-available friends)
?^ err (pure:m err)
(has-invites-for as friends)
::
++ are-available
|= ships=(list ship)
=/ m (strand:strandio ,(unit tang))
^- form:m
;< responses=(list [@t @t]) bind:m
%+ batch-read-contract-strict:ethio url
%+ turn ships
|= =ship
^- proto-read-request:rpc
:+ `(scot %p ship)
::TODO argument?
azimuth:contracts:azimuth
(rights:cal ship)
=/ taken=(list ship)
%+ murn responses
|= [id=@t res=@t]
^- (unit ship)
=/ rights=[owner=address *]
%+ decode-results:rpc res
::NOTE using +reap nest-fails
[%address %address %address %address %address ~]
?: =(0x0 owner.rights) ~
`(slav %p id)
%- pure:m
?: =(~ taken) ~
:- ~
:~ leaf+"some ships already taken:"
>taken<
==
::
++ has-invites-for
|= [as=ship ships=(list ship)]
=/ m (strand:strandio ,(unit tang))
^- form:m
=/ counts=(map ship @ud)
%+ roll ships
|= [s=ship counts=(map ship @ud)]
=+ p=(^sein:title s)
%+ ~(put by counts) p
+((~(gut by counts) p 0))
;< pool=@ud bind:m
=/ n (strand:strandio ,@ud)
;< res=@t bind:n
%+ read-contract:ethio url
:+ `'pool'
::TODO pass in as argument
delegated-sending:contracts:azimuth
(get-pool:cal as)
%- pure:n
(decode-results:rpc res [%uint]~)
;< responses=(list [id=@t res=@t]) bind:m
%+ batch-read-contract-strict:ethio url
%+ turn ~(tap by counts)
|= [=ship @ud]
^- proto-read-request:rpc
:+ `(scot %p ship)
::TODO pass in as argument
delegated-sending:contracts:azimuth
(pools:cal pool ship)
=/ missing=(list [star=ship have=@ud needed=@ud])
%+ murn responses
|= [id=@t res=@t]
^- (unit [ship @ud @ud])
=/ =ship
(slav %p id)
=/ pool-size=@ud
(decode-results:rpc res [%uint]~)
=/ need=@ud
(~(got by counts) ship)
?: (gte pool-size need) ~
`[ship pool-size need]
?: =(~ missing)
(pure:m ~)
%+ strand-fail:strandio %lacking-invites
:~ leaf+"not enough invites from stars:"
>missing<
==
--

44
pkg/arvo/ted/eth/get-timestamps.hoon Normal file
View File

@ -0,0 +1,44 @@
:: eth/get-timestamps: query ethereum block timestamps
::
:: produces list of @da result
::
/+ ethio, strandio
=, ethereum-types
=, able:jael
::
|= args=vase
=+ !<([url=@t blocks=(list @ud)] args)
=/ m (strand:strandio ,vase)
=| out=(list [block=@ud timestamp=@da])
|^ ^- form:m
=* loop $
?: =(~ blocks) (pure:m !>(out)) ::TODO TMI
;< res=(list [@t json]) bind:m
(request-blocks (scag 100 blocks))
%_ loop
out (weld out (parse-results res))
blocks (slag 100 blocks)
==
::
++ request-blocks
|= blocks=(list @ud)
%+ request-batch-rpc-strict:ethio url
%+ turn blocks
|= block=@ud
^- [(unit @t) request:rpc:ethereum]
:- `(scot %ud block)
[%eth-get-block-by-number block |]
::
++ parse-results
|= res=(list [@t json])
^+ out
%+ turn res
|= [id=@t =json]
^- [@ud @da]
:- (slav %ud id)
%- from-unix:chrono:userlib
%- parse-hex-result:rpc:ethereum
~| json
?> ?=(%o -.json)
(~(got by p.json) 'timestamp')
--

92
pkg/interface/link-webext/background.js Normal file
View File

@ -0,0 +1,92 @@
const attemptPost = (endpoint, path, data) => {
console.log('sending', data, JSON.stringify(data));
return new Promise((resolve, reject) => {
fetch(`http://${endpoint}/~link${path}`, {
method: 'POST',
credentials: 'include',
body: JSON.stringify(data)
})
.then(response => {
console.log('resp', response.status);
resolve(response.status === 200);
})
.catch(error => {
console.error('post failed', error);
resolve(false);
});
});
}
const attemptGet = (endpoint, path, data) => {
return new Promise((resolve, reject) => {
fetch(`http://${endpoint}/~link{path}`, {
method: 'GET',
credentials: 'include',
body: JSON.stringify(data)
})
.then(response => {
console.log('get response');
console.log('response', response);
resolve(true);
})
.catch(error => {
console.log('fetch error', error);
resolve(false);
});
});
}
const saveUrl = (endpoint, title, url) => {
return attemptPost(endpoint, '/add/private', {title, url});
}
const openOptions = () => {
browser.tabs.create({
url: browser.runtime.getURL('options/index.html')
});
}
const openLogin = (endpoint) => {
browser.tabs.create({
url: `http://${endpoint}/~/login`
});
}
const doSave = async () => {
console.log('gonna do save!');
// if no endpoint, refer to options page
const endpoint = await getEndpoint();
console.log('endpoint', endpoint);
if (endpoint === null) {
return openOptions();
}
const tab = (await browser.tabs.query({currentWindow: true, active: true}))[0];
//TODO figure out if we're viewing urbit page, turn into arvo:// url?
const success = await saveUrl(endpoint, tab.title, tab.url);
console.log('success', success);
if (!success) {
console.log('failed, opening login');
openLogin(endpoint);
} else {
console.log('success!');
}
}
// perform save action when extension button is clicked
//TODO want to do a pop-up instead of on-click action here latern
//
browser.browserAction.onClicked.addListener(doSave);
// open settings page on-install, user will need to set endpoint
//
browser.runtime.onInstalled.addListener(async ({ reason, temporary }) => {
// if (temporary) return; // skip during development
switch (reason) {
case "install":
browser.runtime.openOptionsPage();
break;
}
});

11
pkg/interface/link-webext/browserAction/index.html Executable file
View File

@ -0,0 +1,11 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<link href="style.css" rel="stylesheet" />
</head>
<body>
<h1 id="myHeading">My browser action</h1>
<script src="script.js"></script>
</body>
</html>

1
pkg/interface/link-webext/browserAction/script.js Executable file
View File

@ -0,0 +1 @@
console.log('script.js firing');

3
pkg/interface/link-webext/browserAction/style.css Executable file
View File

@ -0,0 +1,3 @@
h1 {
font-style: italic;
}

BIN
pkg/interface/link-webext/icons/icon.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 979 B

39
pkg/interface/link-webext/manifest.json Executable file
View File

@ -0,0 +1,39 @@
{
"manifest_version": 2,
"name": "link",
"description": "Urbit Link",
"version": "0.0.0",
"icons": {
"64": "icons/icon.png"
},
"browser_action": {
"default_icon": {
"64": "icons/icon.png"
},
"todo__default_popup": "browserAction/index.html",
"default_title": "link"
},
"background": {
"scripts": [
"background.js",
"storage.js"
]
},
"options_ui": {
"page": "options/index.html"
},
"web_accessible_resources": [
"src/options/options.html"
],
"permissions": [
"storage", // storing config
"activeTab" // viewing current page url & title
],
"applications": {
"gecko": {
"id": "link-webext@tlon.io"
}
}
}

22
pkg/interface/link-webext/options/index.html Executable file
View File

@ -0,0 +1,22 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="UTF-8">
<link href="style.css" rel="stylesheet" />
</head>
<body>
<form>
<label>
Ship HTTP endpoint:
<input id="endpoint" type="text" placeholder="your-ship.arvo.network" />
</label>
<button type="submit">Save</button>
</form>
<script src="../storage.js"></script>
<script src="script.js"></script>
</body>
</html>

21
pkg/interface/link-webext/options/script.js Executable file
View File

@ -0,0 +1,21 @@
function storeOptions(e) {
e.preventDefault();
// clean up endpoint address and store it
let endpoint = document.querySelector("#endpoint").value
.replace(/^.*:\/\//, '') // strip protocol
.replace(/\/+$/, ''); // strip trailing slashes
setEndpoint(endpoint);
}
async function restoreOptions() {
const endpoint = await getEndpoint();
console.log('prefilling with', endpoint);
document.querySelector("#endpoint").value = endpoint;
}
document.addEventListener("DOMContentLoaded", restoreOptions);
document.querySelector("form").addEventListener("submit", storeOptions);

3
pkg/interface/link-webext/options/style.css Executable file
View File

@ -0,0 +1,3 @@
h1 {
font-style: italic;
}

20
pkg/interface/link-webext/storage.js Normal file
View File

@ -0,0 +1,20 @@
// use synced storage if supported, fall back to local
const storage = browser.storage.sync || browser.storage.local;
const setEndpoint = (endpoint) => {
return storage.set({endpoint});
}
const getEndpoint = () => {
return new Promise((resolve, reject) => {
storage.get("endpoint").then((res) => {
if (res && res.endpoint) {
resolve(res.endpoint);
} else {
resolve(null);
}
}, (err) => {
resolve(null);
});
});
}

43
pkg/urbit/Makefile
View File

@ -5,6 +5,7 @@ noun = $(wildcard noun/*.c)
vere = $(wildcard vere/*.c)
daemon = $(wildcard daemon/*.c)
worker = $(wildcard worker/*.c)
tests = $(wildcard tests/*.c)
common = $(jets) $(noun) $(vere)
headers = $(shell find include -type f)
@ -15,9 +16,9 @@ worker_objs = $(shell echo $(worker) | sed 's/\.c/.o/g')
all_objs = $(common_objs) $(daemon_objs) $(worker_objs)
all_srcs = $(common) $(daemon) $(worker)
all_exes = ./build/ames_tests ./build/mug_tests ./build/jam_tests \
./build/noun_tests ./build/hashtable_tests \
./build/urbit ./build/urbit-worker
test_exes = $(shell echo $(tests) | sed 's/tests\//.\/build\//g' | sed 's/\.c//g')
all_exes = $(test_exes) ./build/urbit ./build/urbit-worker
# -Werror promotes all warnings that are enabled into errors (this is on)
# -Wall issues all types of errors. This is off (for now)
@ -31,13 +32,8 @@ CFLAGS := $(CFLAGS)
all: $(all_exes)
test: build/ames_tests build/hashtable_tests build/jam_tests build/mug_tests build/newt_tests build/noun_tests
./build/ames_tests
./build/hashtable_tests
./build/jam_tests
./build/mug_tests
./build/newt_tests
./build/noun_tests
test: $(test_exes)
for x in $^; do echo "\n$$x" && ./$$x; done
clean:
rm -f ./tags $(all_objs) $(all_exes)
@ -47,32 +43,7 @@ mrproper: clean
################################################################################
build/ames_tests: $(common_objs) tests/ames_tests.o
@echo CC -o $@
@mkdir -p ./build
@$(CC) $^ $(LDFLAGS) -o $@
build/hashtable_tests: $(common_objs) tests/hashtable_tests.o
@echo CC -o $@
@mkdir -p ./build
@$(CC) $^ $(LDFLAGS) -o $@
build/jam_tests: $(common_objs) tests/jam_tests.o
@echo CC -o $@
@mkdir -p ./build
@$(CC) $^ $(LDFLAGS) -o $@
build/mug_tests: $(common_objs) tests/mug_tests.o
@echo CC -o $@
@mkdir -p ./build
@$(CC) $^ $(LDFLAGS) -o $@
build/newt_tests: $(common_objs) tests/newt_tests.o
@echo CC -o $@
@mkdir -p ./build
@$(CC) $^ $(LDFLAGS) -o $@
build/noun_tests: $(common_objs) tests/noun_tests.o
build/%_tests: $(common_objs) tests/%_tests.o
@echo CC -o $@
@mkdir -p ./build
@$(CC) $^ $(LDFLAGS) -o $@

2
pkg/urbit/tests/ames_tests.c
View File

@ -39,6 +39,6 @@ main(int argc, char* argv[])
_test_ames();
fprintf(stderr, "ames okeedokee");
fprintf(stderr, "ames okeedokee\n");
return 0;
}

54
pkg/urbit/vere/ames.c
View File

@ -408,31 +408,26 @@ static void
_ames_io_start(u3_pier* pir_u)
{
u3_ames* sam_u = pir_u->sam_u;
c3_s por_s = pir_u->por_s;
u3_noun who = u3i_chubs(2, pir_u->who_d);
u3_noun rac = u3do("clan:title", u3k(who));
c3_s por_s = pir_u->por_s;
u3_noun who = u3i_chubs(2, pir_u->who_d);
u3_noun rac = u3do("clan:title", u3k(who));
c3_i ret_i;
if ( c3__czar == rac ) {
u3_noun imp = u3dc("scot", 'p', u3k(who));
c3_c* imp_c = u3r_string(imp);
c3_y num_y = (c3_y)pir_u->who_d[0];
c3_y num_y = (c3_y)pir_u->who_d[0];
c3_s zar_s = _ames_czar_port(num_y);
por_s = _ames_czar_port(num_y);
if ( c3y == u3_Host.ops_u.net ) {
u3l_log("ames: czar: %s on %d\n", imp_c, por_s);
if ( 0 == por_s ) {
por_s = zar_s;
}
else {
u3l_log("ames: czar: %s on %d (localhost only)\n", imp_c, por_s);
else if ( por_s != zar_s ) {
u3l_log("ames: czar: overriding port %d with -p %d\n", zar_s, por_s);
u3l_log("ames: czar: WARNING: %d required for discoverability\n", zar_s);
}
u3z(imp);
free(imp_c);
}
int ret;
if ( 0 != (ret = uv_udp_init(u3L, &sam_u->wax_u)) ) {
u3l_log("ames: init: %s\n", uv_strerror(ret));
if ( 0 != (ret_i = uv_udp_init(u3L, &sam_u->wax_u)) ) {
u3l_log("ames: init: %s\n", uv_strerror(ret_i));
c3_assert(0);
}
@ -448,14 +443,17 @@ _ames_io_start(u3_pier* pir_u)
htonl(INADDR_LOOPBACK);
add_u.sin_port = htons(por_s);
int ret;
if ( (ret = uv_udp_bind(&sam_u->wax_u,
(const struct sockaddr*) & add_u, 0)) != 0 ) {
u3l_log("ames: bind: %s\n",
uv_strerror(ret));
if (UV_EADDRINUSE == ret){
if ( (ret_i = uv_udp_bind(&sam_u->wax_u,
(const struct sockaddr*)&add_u, 0)) != 0 )
{
u3l_log("ames: bind: %s\n", uv_strerror(ret_i));
if ( (c3__czar == rac) &&
(UV_EADDRINUSE == ret_i) )
{
u3l_log(" ...perhaps you've got two copies of vere running?\n");
}
u3_pier_exit(pir_u);
}
@ -465,7 +463,13 @@ _ames_io_start(u3_pier* pir_u)
sam_u->por_s = ntohs(add_u.sin_port);
}
// u3l_log("ames: on localhost, UDP %d.\n", sam_u->por_s);
if ( c3y == u3_Host.ops_u.net ) {
u3l_log("ames: live on %d\n", por_s);
}
else {
u3l_log("ames: live on %d (localhost only)\n", por_s);
}
uv_udp_recv_start(&sam_u->wax_u, _ames_alloc, _ames_recv_cb);
sam_u->liv = c3y;

2
pkg/urbit/vere/dawn.c
View File

@ -489,7 +489,7 @@ _dawn_come(u3_noun stars)
eny = u3i_words(16, eny_w);
u3l_log("boot: mining a comet. May take up to an hour.\r\n");
u3l_log("If you want to boot faster, get an Azimuth point.\r\n");
u3l_log("If you want to boot faster, get an Urbit identity.\r\n");
seed = u3dc("come:dawn", u3k(stars), u3k(eny));
u3z(eny);

50
pkg/urbit/vere/http.c
View File

@ -325,9 +325,9 @@ _http_req_done(void* ptr_v)
{
u3_hreq* req_u = (u3_hreq*)ptr_v;
// client canceled request
if ( (u3_rsat_plan == req_u->sat_e ) ||
(0 != req_u->gen_u && c3n == ((u3_hgen*)req_u->gen_u)->dun )) {
// client canceled request before response
//
if ( u3_rsat_plan == req_u->sat_e ) {
_http_req_kill(req_u);
}
@ -420,7 +420,6 @@ static void
_http_hgen_send(u3_hgen* gen_u)
{
c3_assert( c3y == gen_u->red );
c3_assert( 0 == gen_u->nud_u );
u3_hreq* req_u = gen_u->req_u;
h2o_req_t* rec_u = req_u->rec_u;
@ -428,29 +427,33 @@ _http_hgen_send(u3_hgen* gen_u)
c3_w len_w;
h2o_iovec_t* vec_u = _cttp_bods_to_vec(gen_u->bod_u, &len_w);
// not ready again until _proceed
//
gen_u->red = c3n;
// stash [bod_u] to free later
//
_cttp_bods_free(gen_u->nud_u);
gen_u->nud_u = gen_u->bod_u;
gen_u->bod_u = 0;
if ( c3n == gen_u->dun ) {
h2o_send(rec_u, vec_u, len_w, H2O_SEND_STATE_IN_PROGRESS);
// Restart the timer
uv_timer_start(req_u->tim_u, _http_req_timer_cb, 45 * 1000, 0);
}
else {
h2o_send(rec_u, vec_u, len_w, H2O_SEND_STATE_FINAL);
// close connection if shutdown pending
//
u3_h2o_serv* h2o_u = req_u->hon_u->htp_u->h2o_u;
if ( 0 != h2o_u->ctx_u.shutdown_requested ) {
rec_u->http1_is_persistent = 0;
}
h2o_send(rec_u, vec_u, len_w, H2O_SEND_STATE_FINAL);
}
// not ready again until _proceed
gen_u->red = c3n;
// stash bod_u to be free'd later
gen_u->nud_u = gen_u->bod_u;
gen_u->bod_u = 0;
free(vec_u);
c3_free(vec_u);
}
/* _http_hgen_stop(): h2o is closing an in-progress response.
@ -458,7 +461,13 @@ _http_hgen_send(u3_hgen* gen_u)
static void
_http_hgen_stop(h2o_generator_t* neg_u, h2o_req_t* rec_u)
{
// kill request in %light
u3_hgen* gen_u = (u3_hgen*)neg_u;
// response not complete, enqueue cancel
//
if ( c3n == gen_u->dun ) {
_http_req_kill(gen_u->req_u);
}
}
/* _http_hgen_proceed(): h2o is ready for more response data.
@ -474,11 +483,6 @@ _http_hgen_proceed(h2o_generator_t* neg_u, h2o_req_t* rec_u)
gen_u->red = c3y;
_http_heds_free(gen_u->hed_u);
gen_u->hed_u = 0;
_cttp_bods_free(gen_u->nud_u);
gen_u->nud_u = 0;
if ( 0 != gen_u->bod_u || c3y == gen_u->dun ) {
_http_hgen_send(gen_u);
}
@ -514,6 +518,7 @@ _http_start_respond(u3_hreq* req_u,
"hosed";
u3_hhed* hed_u = _http_heds_from_noun(u3k(headers));
u3_hhed* deh_u = hed_u;
c3_i has_len_i = 0;
@ -521,7 +526,6 @@ _http_start_respond(u3_hreq* req_u,
if ( 0 == strncmp(hed_u->nam_c, "content-length", 14) ) {
has_len_i = 1;
}
else {
h2o_add_header_by_str(&rec_u->pool, &rec_u->res.headers,
hed_u->nam_c, hed_u->nam_w, 0, 0,
@ -539,7 +543,7 @@ _http_start_respond(u3_hreq* req_u,
gen_u->bod_u = ( u3_nul == data ) ?
0 : _cttp_bod_from_octs(u3k(u3t(data)));
gen_u->nud_u = 0;
gen_u->hed_u = hed_u;
gen_u->hed_u = deh_u;
gen_u->req_u = req_u;
// if we don't explicitly set this field, h2o will send with

2
pkg/urbit/vere/newt.c
View File

@ -181,6 +181,8 @@ _newt_poke_mess(u3_moat* mot_u)
u3_noun mat = u3i_bytes((c3_w)len_d, buf_y);
mot_u->pok_f(mot_u->vod_p, mat);
}
c3_free(buf_y);
}
/* u3_newt_decode(): decode a (partial) length-prefixed byte buffer

1
pkg/urbit/vere/pier.c
View File

@ -1770,6 +1770,7 @@ _pier_create(c3_w wag_w, c3_c* pax_c)
pir_u->sat_e = u3_psat_init;
pir_u->sam_u = c3_calloc(sizeof(u3_ames));
pir_u->por_s = u3_Host.ops_u.por_s;
pir_u->teh_u = c3_calloc(sizeof(u3_behn));
pir_u->unx_u = c3_calloc(sizeof(u3_unix));
pir_u->sav_u = c3_calloc(sizeof(u3_save));