Merge branch 'master' into philip/mall-real

This commit is contained in:
Philip Monk 2019-11-09 16:47:41 -08:00
commit bcd7c5e82d
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
48 changed files with 2050 additions and 1099 deletions

View File

@ -81,9 +81,12 @@ aqua, ph" -- but note that this may be a warning that too many changes are
being packed into a single commit. The 'component' and 'short description'
combined should be no more than 50 characters.
A lengthier description is encouraged, where useful, but is not required.
A lengthier description is encouraged, where useful, but is not always strictly
required. You should use the longer description to give any useful background
on or motivation for the commit, provide a summary of what it does, link to
relevant issues, proposals, or other commits, and so on.
Here's an example of our commit format, applied to a hypothetical commit:
Here is an example of our commit format, taken from a commit in the history:
> zuse: remove superfluous 'scup' and 'culm' types.
>
@ -95,6 +98,23 @@ Here's an example of our commit format, applied to a hypothetical commit:
> This commit deletes 'scup' and 'culm' and refactors what little code
> made use of them.
Note that the short description is prefixed by `zuse:`, which is what the
commit touches. Otherwise it just includes a summary of the change.
Here's another example:
> build: give arvo a high priority
>
> 0bdced981e4 introduced the 'arvo-ropsten' derivation. Attempting to
> install both 'arvo' and 'arvo-ropsten' via nix-env will result in a
> priority error; this assigns a higher priority to 'arvo' to resolve the
> conflict.
>
> Fixes #1912.
Note that it cites a previous relevant commit, `0bdced981e4`, in its summary,
and also points at the issue that it resolves.
If you're in doubt about how to format your commit descriptions, take a look at
the recent history and try to mimic the style that you can see others broadly
follow there.
@ -128,9 +148,13 @@ via:
sh/update-solid-pill
```
and include it along with your contribution. You can either include it in the
same commit as your change, or, if you prefer, in a standalone commit (you will
see plenty of "pills: update solid" commits if you look through the history).
and include it along with your contribution.
Historically, we've sometimes included these updated pills in separate,
standalone commits (you will see plenty of "pills: update solid" and similar
commits if you look through the history), but this practice is considered to be
deprecated -- you should usually just include the updated pill in the same
commit that updates the source.
## Releases

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:4624d075efc11ac9ec8cdbcf7683253845a2c2f1b433f965b207d5f379e43db7
size 9190993
oid sha256:0bd369e7b1df2cb3c806706d3d20774b9441e957cb5f29cd059d931b87baaecc
size 9231363

View File

@ -1,24 +1,31 @@
/- eth-watcher
/+ tapp, stdio
=, able:jael
=> |%
+$ pending-udiffs (map number:block udiffs:point)
+$ app-state
$: %2
$: %3
url=@ta
=number:block
=pending-udiffs
blocks=(list block)
whos=(set ship)
==
+$ peek-data ~
+$ in-poke-data
$: %azimuth-tracker-poke
$% [%listen whos=(list ship) =source:jael]
$% :: %listen
::
[%listen whos=(list ship) =source:jael]
:: %watch: configure node url
::
[%watch url=@ta]
==
==
+$ out-poke-data ~
+$ in-peer-data ~
+$ out-poke-data
$: %eth-watcher-poke
poke:eth-watcher
==
+$ in-peer-data
$: %eth-watcher-diff
diff:eth-watcher
==
+$ out-peer-data
[%azimuth-udiff =ship =udiff:point]
++ tapp
@ -56,171 +63,6 @@
~
[(turn ~(tap in ships) ,@) ~]
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (async:stdio ,json)
^- form:m
%+ (retry json) `10
=/ m (async:stdio ,(unit json))
^- form:m
|^
=/ =request:http
:* method=%'POST'
url=url
header-list=['Content-Type'^'application/json' ~]
^= body
%- some %- as-octt:mimes:html
%- en-json:html
(request-to-json:rpc:ethereum id req)
==
;< ~ bind:m (send-request:stdio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:stdio
?~ rep
(pure:m ~)
(parse-response u.rep)
::
++ parse-response
|= =client-response:iris
=/ m (async:stdio ,(unit json))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=, dejs-soft:format
=/ array=(unit (list response:rpc:jstd))
((ar parse-one-response) u.jon)
?~ array
=/ res=(unit response:rpc:jstd) (parse-one-response u.jon)
?~ res
(async-fail:stdio %request-rpc-parse-error >id< ~)
?: ?=(%error -.u.res)
(async-fail:stdio %request-rpc-error >id< >+.res< ~)
?. ?=(%result -.u.res)
(async-fail:stdio %request-rpc-fail >u.res< ~)
(pure:m `res.u.res)
(async-fail:stdio %request-rpc-batch >%not-implemented< ~)
:: (pure:m `[%batch u.array])
::
++ parse-one-response
|= =json
^- (unit response:rpc:jstd)
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?^ res `[%result u.res]
~| parse-one-response=json
:+ ~ %error %- need
%. json
=, dejs-soft:format
(ot id+so error+(ot code+no message+so ~) ~)
--
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(async:stdio (unit result))]
=/ m (async:stdio ,result)
=| try=@ud
|^
|- ^- form:m
=* loop $
?: =(crash-after `try)
(async-fail:stdio %retry-too-many ~)
;< ~ bind:m (backoff try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
loop(try +(try))
::
++ backoff
|= [try=@ud limit=@dr]
=/ m (async:stdio ,~)
^- form:m
;< eny=@uvJ bind:m get-entropy:stdio
;< now=@da bind:m get-time:stdio
%- wait:stdio
%+ add now
%+ min limit
?: =(0 try) ~s0
%+ add
(mul ~s1 (bex (dec try)))
(mul ~s0..0001 (~(rad og eny) 1.000))
--
::
++ get-latest-block
|= url=@ta
=/ m (async:stdio ,block)
^- form:m
;< =json bind:m (request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (async:stdio ,block)
^- form:m
|^
;< =json bind:m
(request-rpc url `'block by number' %eth-get-block-by-number number |)
=/ =block (parse-block json)
?. =(number number.id.block)
(async-fail:stdio %reorg-detected >number< >block< ~)
(pure:m block)
::
++ parse-block
|= =json
^- block
=< [[&1 &2] |2]
^- [@ @ @]
~| json
%. json
=, dejs:format
%- ot
:~ hash+parse-hex-result:rpc:ethereum
number+parse-hex-result:rpc:ethereum
'parentHash'^parse-hex-result:rpc:ethereum
==
--
::
++ get-logs-by-hash
|= [url=@ta whos=(set ship) =hash:block]
=/ m (async:stdio udiffs:point)
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by hash'
%eth-get-logs-by-hash
hash
~[azimuth:contracts:azimuth]
(topics whos)
==
=/ event-logs=(list event-log:rpc:ethereum)
(parse-event-logs:rpc:ethereum json)
=/ =udiffs:point (event-logs-to-udiffs event-logs)
(pure:m udiffs)
::
++ get-logs-by-range
|= [url=@ta whos=(set ship) =from=number:block =to=number:block]
=/ m (async:stdio udiffs:point)
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by range'
%eth-get-logs
`number+from-number
`number+to-number
~[azimuth:contracts:azimuth]
(topics whos)
==
=/ event-logs=(list event-log:rpc:ethereum)
(parse-event-logs:rpc:ethereum json)
=/ =udiffs:point (event-logs-to-udiffs event-logs)
(pure:m udiffs)
::
++ event-logs-to-udiffs
|= event-logs=(list =event-log:rpc:ethereum)
^- =udiffs:point
@ -285,142 +127,105 @@
:: Start watching a node
::
++ start
|= state=app-state
|= [state=app-state our=ship dap=term]
=/ m (async:stdio ,app-state)
^- form:m
=: number.state 0
pending-udiffs.state *pending-udiffs
blocks.state *(list block)
;< ~ bind:m
%+ poke-app:stdio
[our %eth-watcher]
:+ %eth-watcher-poke %watch
:- /[dap]
:* url.state
launch:contracts:azimuth
~[azimuth:contracts:azimuth]
(topics whos.state)
==
(get-updates state)
(pure:m state)
::
:: Get updates since last checked
:: +history: Tell subscribers about many changes
::
++ get-updates
|= state=app-state
=/ m (async:stdio ,app-state)
^- form:m
;< =latest=block bind:m (get-latest-block url.state)
;< state=app-state bind:m (zoom state number.id.latest-block)
++ history
|= =loglist:eth-watcher
=/ m (async:stdio ,~)
|- ^- form:m
=* walk-loop $
?: (gth number.state number.id.latest-block)
;< now=@da bind:m get-time:stdio
;< ~ bind:m (wait-effect:stdio (add now ~m5))
(pure:m state)
;< =block bind:m (get-block-by-number url.state number.state)
;< [=new=pending-udiffs new-blocks=(lest ^block)] bind:m
%- take-block
[url.state whos.state pending-udiffs.state block blocks.state]
=: pending-udiffs.state new-pending-udiffs
blocks.state new-blocks
number.state +(number.id.i.new-blocks)
==
walk-loop
%- jael-update
(event-logs-to-udiffs loglist)
::
:: Process a block, detecting and handling reorgs
:: +log: Tell subscribers about a new change
::
++ take-block
|= [url=@ta whos=(set ship) =a=pending-udiffs =block blocks=(list block)]
=/ m (async:stdio ,[pending-udiffs (lest ^block)])
^- form:m
?: &(?=(^ blocks) !=(parent-hash.block hash.id.i.blocks))
(rewind url a-pending-udiffs block blocks)
;< =b=pending-udiffs bind:m
(release-old-events a-pending-udiffs number.id.block)
;< =new=udiffs:point bind:m (get-logs-by-hash url whos hash.id.block)
=. b-pending-udiffs (~(put by b-pending-udiffs) number.id.block new-udiffs)
(pure:m b-pending-udiffs block blocks)
++ log
|= =event-log:rpc:ethereum
=/ m (async:stdio ,~)
(history [event-log ~])
::
:: Release events if they're more than 30 blocks ago
::
++ release-old-events
|= [=pending-udiffs =number:block]
=/ m (async:stdio ,^pending-udiffs)
^- form:m
=/ rel-number (sub number 30)
=/ =udiffs:point (~(get ja pending-udiffs) rel-number)
;< ~ bind:m (jael-update udiffs)
(pure:m (~(del by pending-udiffs) rel-number))
::
:: Reorg detected, so rewind until we're back in sync
::
++ rewind
|= [url=@ta =pending-udiffs =block blocks=(list block)]
=/ m (async:stdio ,[^pending-udiffs (lest ^block)])
|- ^- form:m
=* loop $
?~ blocks
(pure:m pending-udiffs block blocks)
?: =(parent-hash.block hash.id.i.blocks)
(pure:m pending-udiffs block blocks)
;< =next=^block bind:m (get-block-by-number url number.id.i.blocks)
?: =(~ pending-udiffs)
;< ~ bind:m (disavow block)
loop(block next-block, blocks t.blocks)
=. pending-udiffs (~(del by pending-udiffs) number.id.block)
loop(block next-block, blocks t.blocks)
::
:: Tell subscribers there was a deep reorg
:: +disavow: Tell subscribers there was a deep reorg
::
++ disavow
|= =block
|= =id:block
=/ m (async:stdio ,~)
^- form:m
(jael-update [*ship id.block %disavow ~]~)
::
:: Zoom forward to near a given block number.
::
:: Zooming doesn't go forward one block at a time. As a
:: consequence, it cannot detect and handle reorgs. Only use it
:: at a safe distance -- 500 blocks ago is probably sufficient.
::
++ zoom
|= [state=app-state =latest=number:block]
=/ m (async:stdio ,app-state)
^- form:m
=/ zoom-margin=number:block 100
?: (lth latest-number (add number.state zoom-margin))
(pure:m state)
=/ to-number=number:block (sub latest-number zoom-margin)
;< =udiffs:point bind:m
(get-logs-by-range url.state whos.state number.state to-number)
;< ~ bind:m (jael-update udiffs)
=. number.state +(to-number)
=. blocks.state ~
(pure:m state)
(jael-update [*ship id %disavow ~]~)
--
::
:: Main
::
=* default-tapp default-tapp:tapp
%- create-tapp-poke-peer-take:tapp
%- create-tapp-all:tapp
^- tapp-core-all:tapp
|_ [=bowl:gall state=app-state]
++ handle-poke
|= =in-poke-data
++ handle-init
=/ m tapp-async
^- form:m
?- +<.in-poke-data
%listen (listen state +>.in-poke-data)
%watch (pure:m state(url url.in-poke-data))
:: set up subscription once, listen forever
::
;< ~ bind:m
%+ peer-app:stdio
[our.bowl %eth-watcher]
/logs/[dap.bowl]
(pure:m state)
::
++ handle-peek handle-peek:default-tapp
++ handle-take handle-take:default-tapp
::
++ handle-poke
|= in=in-poke-data
=/ m tapp-async
^- form:m
?- +<.in
%listen (listen state +>.in)
%watch (start state(url url.in) [our dap]:bowl)
==
::
++ handle-take
|= =sign:tapp
++ handle-diff
|= [=dock =path in=in-peer-data]
=/ m tapp-async
^- form:m
?+ -.sign ~|([%strange-sign -.sign] !!)
%wake (get-updates state)
==
;< ~ bind:m
?- +<.in
%history (history +>.in)
%log (log +>.in)
%disavow (disavow +>.in)
==
(pure:m state)
::
:: +handle-peer: handle incoming subscriptions (generally from jael)
::
:: /~some-ship: listen to events for this ship
:: /: listen to events for all ships azimuth-tracker is observing
::
:: note that incoming subscriptions affect application state.
::
++ handle-peer
|= =path
=/ m tapp-async
^- form:m
=/ who=(unit ship) ?~(path ~ `(slav %p i.path))
?. ?=(?(~ [@ ~]) path) !!
=/ who=(unit ship)
?~ path ~
`(slav %p i.path)
=. whos.state
?~ who
~
(~(put in whos.state) u.who)
(start state)
(start state [our dap]:bowl)
--

View File

@ -2,7 +2,7 @@
:: mirror chat data from foreign to local based on read permissions
:: allow sending chat messages to foreign paths based on write perms
::
/- *permission-store, *chat-hook
/- *permission-store, *chat-hook, *invite-store
/+ *chat-json
|%
+$ move [bone card]
@ -15,33 +15,60 @@
[%peer wire dock path]
==
::
+$ state
$% [%0 state-zero]
+$ state-both
$% state-zero
state-one
==
::
+$ state-zero
$: synced=(map path ship)
$: %0
synced=(map path ship)
boned=(map wire (list bone))
==
::
+$ state-one
$: %1
synced=(map path ship)
boned=(map wire (list bone))
invite-created=_|
==
::
+$ poke
$% [%chat-action chat-action]
[%permission-action permission-action]
[%invite-action invite-action]
[%chat-view-action chat-view-action]
==
::
--
::
|_ [bol=bowl:gall state]
|_ [bol=bowl:gall state-one]
::
++ this .
::
++ prep
|= old=(unit state)
|= old=(unit state-both)
^- (quip move _this)
?~ old
:_ this
[ost.bol %peer /permissions [our.bol %permission-store] /updates]~
[~ this(+<+ u.old)]
:_ this(invite-created %.y)
:~ (invite-poke [%create /chat])
[ost.bol %peer /invites [our.bol %invite-store] /invitatory/chat]
[ost.bol %peer /permissions [our.bol %permission-store] /updates]
==
?- -.u.old
%1 [~ this(+<+ u.old)]
::
%0
=/ sta *state-one
=: boned.sta boned.u.old
synced.sta synced.u.old
invite-created %.y
==
:_ this(+<+ sta)
:~ (invite-poke [%create /chat])
[ost.bol %peer /invites [our.bol %invite-store] /invitatory/chat]
==
==
::
++ poke-json
|= jon=json
@ -139,6 +166,17 @@
:_ this
[ost.bol %diff %chat-update [%create (slav %p i.pax) pax]]~
::
++ diff-invite-update
|= [wir=wire diff=invite-update]
^- (quip move _this)
?+ -.diff
[~ this]
::
%accepted
:_ this
[(chat-view-poke [%join ship.invite.diff path.invite.diff])]~
==
::
++ diff-permission-update
|= [wir=wire diff=permission-update]
^- (quip move _this)
@ -271,11 +309,21 @@
^- move
[ost.bol %poke / [our.bol %chat-store] [%chat-action act]]
::
++ chat-view-poke
|= act=chat-view-action
^- move
[ost.bol %poke / [our.bol %chat-view] [%chat-view-action act]]
::
++ permission-poke
|= act=permission-action
^- move
[ost.bol %poke / [our.bol %permission-store] [%permission-action act]]
::
++ invite-poke
|= act=invite-action
^- move
[ost.bol %poke / [our.bol %invite-store] [%invite-action act]]
::
++ create-permission
|= [pax=path sec=chat-security]
^- (list move)
@ -323,6 +371,12 @@
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
.^((unit mailbox) %gx pax)
::
++ invite-scry
|= uid=serial
^- (unit invite)
=/ pax /=invite-store/(scot %da now.bol)/invite/chat/(scot %uv uid)/noun
.^((unit invite) %gx pax)
::
++ permitted-scry
|= pax=path
^- ?

File diff suppressed because one or more lines are too long

View File

@ -1057,11 +1057,6 @@
:: ~& [%his-clock ler.cal]
:: ~& [%our-clock ven.say]
=^ dat say (~(transceive sole say) cal)
:: speedrun mode
:: =; res
:: ?. ?=(%del -.dat)
:: res
:: (he-tab:res +(p.dat))
?. ?& ?=($del -.dat)
=(+(p.dat) (lent buf.say))
==

View File

@ -1,571 +1,323 @@
:: watcher: ethereum event log collector
:: eth-watcher: ethereum event log collector
::
/+ *eth-watcher
/- *eth-watcher
/+ tapp, stdio, ethio
=, ethereum-types
=, able:jael
::
=, ethereum
=, rpc
=> |%
++ refresh-rate ~m5
--
::
|%
++ state
$: eyes=(map name eye)
==
=> |%
+$ app-state
$: %0
dogs=(map path watchdog)
==
::
+$ context [=path dog=watchdog]
+$ watchdog
$: config
=number:block
=pending-logs
=history
blocks=(list block)
==
::
:: history: newest block first, oldest event first
+$ history (list loglist)
+$ pending-logs (map number:block loglist)
::
+$ peek-data
[%atom =next-block=number:block]
+$ in-poke-data
$: %eth-watcher-poke
poke
==
+$ out-poke-data ~
+$ in-peer-data ~
+$ out-peer-data
$: %eth-watcher-diff
diff
==
++ tapp
%: ^tapp
app-state
peek-data
in-poke-data
out-poke-data
in-peer-data
out-peer-data
==
++ tapp-async tapp-async:tapp
++ stdio (^stdio out-poke-data out-peer-data)
++ ethio (^ethio out-poke-data out-peer-data)
--
::
++ eye
$: config
latest-block=@ud
filter-id=@ud
poll-timer=(unit @da)
snapshot
sap=history
==
:: Async helpers
::
++ history
$: interval=_100
max-count=_10
count=@ud
latest-block=@ud
snaps=(qeu snapshot)
==
=> |%
++ send-logs
|= [=path =loglist]
=/ m (async:stdio ,~)
|- ^- form:m
=* loop $
?~ loglist
(pure:m ~)
;< ~ bind:m (send-update path %log i.loglist)
loop(loglist t.loglist)
::
++ send-update
|= [=path =diff]
=/ m (async:stdio ,~)
^- form:m
=. path [%logs path]
(give-result:stdio path %eth-watcher-diff diff)
--
::
++ move (pair bone card)
++ card
$% [%hiss wire (unit user:eyre) mark %hiss hiss:eyre]
[%wait wire @da]
[%rest @da]
[%info wire desk nori:clay]
[%diff %eth-watcher-update update]
[%quit ~]
==
--
:: Main loop
::
|_ [bowl:gall state]
=> |%
::
:: Update watchdog configuration, then look for updates
::
++ configure
|= [context =config]
=/ m (async:stdio ,watchdog)
^- form:m
%+ get-updates path
%_ dog
- config
number from.config
==
::
:: Get updates since last checked
::
++ get-updates
|= context
=/ m (async:stdio ,watchdog)
^- form:m
;< =latest=block bind:m (get-latest-block:ethio url.dog)
;< dog=watchdog bind:m (zoom [path dog] number.id.latest-block)
|- ^- form:m
=* loop $
?: (gth number.dog number.id.latest-block)
(pure:m dog)
;< =block bind:m (get-block-by-number:ethio url.dog number.dog)
;< dog=watchdog bind:m
(take-block [path dog] block)
loop(dog dog)
::
:: Process a block, detecting and handling reorgs
::
++ take-block
|= [context =block]
=/ m (async:stdio ,watchdog)
^- form:m
:: if this next block isn't direct descendant of our logs, reorg happened
?: &(?=(^ blocks.dog) !=(parent-hash.block hash.id.i.blocks.dog))
(rewind [path dog] block)
;< [=new=pending-logs =released=loglist] bind:m
(release-old-events path pending-logs.dog number.id.block)
;< =new=loglist bind:m :: oldest first
(get-logs-by-hash:ethio url.dog hash.id.block contracts.dog topics.dog)
=. new-pending-logs
(~(put by new-pending-logs) number.id.block new-loglist)
%- pure:m
%_ dog
number +(number.id.block)
pending-logs new-pending-logs
history [released-loglist history.dog]
blocks [block blocks.dog]
==
::
:: Release events if they're more than 30 blocks ago
::
++ release-old-events
|= [=path =pending-logs =number:block]
=/ m (async:stdio ,[^pending-logs loglist])
^- form:m
?: (lth number 30) (pure:m pending-logs ~)
=/ rel-number (sub number 30)
=/ =loglist (~(get ja pending-logs) rel-number)
;< ~ bind:m (send-logs path loglist)
(pure:m (~(del by pending-logs) rel-number) loglist)
::
:: Reorg detected, so rewind until we're back in sync
::
++ rewind
:: block: wants to be head of blocks.dog, but might not match
|= [context =block]
=/ m (async:stdio ,watchdog)
=* blocks blocks.dog
|- ^- form:m
=* loop $
:: if we have no further history to rewind, we're done
?~ blocks
(pure:m dog(blocks [block blocks]))
:: if target block is directly after "latest", we're done
?: =(parent-hash.block hash.id.i.blocks)
(pure:m dog(blocks [block blocks]))
:: next-block: the new target block
;< =next=^block bind:m
(get-block-by-number:ethio url.dog number.id.i.blocks)
:: remove from either pending-logs or history
?: =(~ pending-logs.dog)
:: if no more pending logs, start deleting from history instead
::NOTE this assumes there's one history entry per item in blocks.
:: while +zoom breaks that assumption by clearing blocks, we won't
:: run out of history before running out of blocks, allowing us to
:: skip the =(number.id.block number.id.i.i.history) check.
?~ history.dog
loop(block next-block, blocks t.blocks)
;< ~ bind:m
:: don't bother sending a disavow if there were no logs there
?~ i.history.dog (pure:(async:stdio ,~) ~)
(disavow path block)
loop(block next-block, blocks t.blocks, history.dog t.history.dog)
=. pending-logs.dog
(~(del by pending-logs.dog) number.id.block)
loop(block next-block, blocks t.blocks)
::
:: Tell subscribers there was a deep reorg
::
++ disavow
|= [=path =block]
=/ m (async:stdio ,~)
^- form:m
(send-update path %disavow id.block)
::
:: Zoom forward to near a given block number.
::
:: Zooming doesn't go forward one block at a time. As a
:: consequence, it cannot detect and handle reorgs. Only use it
:: at a safe distance -- 500 blocks ago is probably sufficient.
::
++ zoom
|= [context =latest=number:block]
=/ m (async:stdio ,watchdog)
^- form:m
=/ zoom-margin=number:block 100
?: (lth latest-number (add number.dog zoom-margin))
(pure:m dog)
=/ to-number=number:block (sub latest-number zoom-margin)
;< =loglist bind:m :: oldest first
%: get-logs-by-range:ethio
url.dog
contracts.dog
topics.dog
number.dog
to-number
==
;< ~ bind:m (send-logs path loglist)
=. number.dog +(to-number)
=. blocks.dog ~
=. history.dog [loglist history.dog]
(pure:m dog)
--
::
++ prep
|= old=(unit state)
?~ old
[~ ..prep]
[~ ..prep(+<+ u.old)]
:: Main
::
++ poke-noun
|= [what=?(%save %load) =name]
^- (quip move _+>)
=+ eye=(~(gut by eyes) name *eye)
?- what
%save
=/ pax=path
/(scot %p our)/home/(scot %da now)/watcher/[name]/jam
:_ +>.$
:_ ~
^- move
:* ost
%info
/jamfile
(foal:space:userlib pax [%jam !>((jam eye))])
==
::
%load
=. eyes
%+ ~(put by eyes) name
=- (^eye (cue .^(@ %cx -)))
/(scot %p our)/home/(scot %da now)/watcher/[name]/jam
done:new-filter:(open:watcher name)
==
=* default-tapp default-tapp:tapp
%- create-tapp-all:tapp
^- tapp-core-all:tapp
|_ [=bowl:gall state=app-state]
++ handle-init
=/ m tapp-async
^- form:m
:: start update timer loop
;< now=@da bind:m get-time:stdio
;< ~ bind:m (wait-effect:stdio (add now refresh-rate))
(pure:m state)
::
++ poke-eth-watcher-action
|= act=action
^- (quip move _+>)
?- -.act
++ handle-diff handle-diff:default-tapp
::
++ handle-poke
|= in=in-poke-data
=/ m tapp-async
^- form:m
?- +<.in
%watch
done:(init:watcher +.act)
:: fully restart the watchdog if it doesn't exist yet,
:: or if the new config changes more than just the url.
=/ restart=?
?| !(~(has by dogs.state) path.in)
?! .= ->:(~(got by dogs.state) path.in)
+.config.in
==
~? &((~(has by dogs.state) path.in) restart)
[dap.bowl 'overwriting existing watchdog on' path.in]
;< dog=watchdog bind:m
=/ dog=watchdog
?: restart *watchdog
(~(got by dogs.state) path.in)
(configure [path.in dog] config.in)
=. dogs.state (~(put by dogs.state) path.in dog)
(pure:m state)
::
%clear
wipe:(open:watcher +.act)
=. dogs.state (~(del by dogs.state) path.in)
(pure:m state)
==
::
++ peek-x
|= pax=path
^- (unit (unit [%noun *]))
?. ?=([@ *] pax) ~
=+ eye=(~(get by eyes) i.pax)
?~ eye [~ ~]
:: /name: all logs
::
?~ t.pax ``[%noun logs.u.eye]
:: /name/num: most recent num logs
::
=+ num=(slaw %ud i.t.pax)
?^ num ``[%noun (scag u.num logs.u.eye)]
:: /name/debug: debug information
::
?. ?=(%debug i.t.pax) ~
=- ``[%noun -]
=, u.eye
:* node=(en-purl:html node)
last=last-heard-block
lent=(lent logs)
time=poll-timer
++ handle-take
|= =sign:tapp
=/ m tapp-async
^- form:m
?+ -.sign ~|([%strange-sign -.sign] !!)
%wake
;< ~ bind:m
;< now=@da bind:(async:tapp ,~) get-time:stdio
=/ next=@da (add now refresh-rate)
::NOTE we use +send-raw-card here to ensure we always set a new timer,
:: regardless of what happens further on in the flow.
(send-raw-card:stdio %wait /effect/(scot %da next) next)
::TODO ideally we'd process these in parallel. this seems possible,
:: but requires non-trivial work, as it deviates from tapp's flow.
:: (when making that change, take note of rpc request id's.)
=/ dogs=(list [=path dog=watchdog]) ~(tap by dogs.state)
|- ^- form:m
=* loop $
?~ dogs
(pure:m state)
=, i.dogs
;< dog=watchdog bind:m (get-updates path dog)
=. dogs.state (~(put by dogs.state) path dog)
loop(dogs t.dogs)
==
::
++ peer
|= pax=path
^- (quip move _+>)
?> ?=([@ ~] pax)
done:(put-snapshot-diff:(open:watcher i.pax) ost)
:: +handle-peer: subscribe & get initial subscription data
::
++ wake
|= [wir=wire error=(unit tang)]
^- (quip move _+>)
?^ error
%- (slog u.error)
[~ ..wake]
?> ?=([@ %poll ~] wir)
done:poll-filter:(open:watcher i.wir)
:: /logs/some-path:
::
++ sigh-tang
|= [wir=wire res=tang]
^- (quip move _+>)
~& ['something went wrong!' wir]
~_ res
[~ +>.$]
++ handle-peer
|= =path
=/ m tapp-async
^- form:m
?. ?=([%logs ^] path)
~| [%invalid-subscription-path path]
!!
;< ~ bind:m
%+ send-effect-on-bone:stdio ost.bowl
:+ %diff %eth-watcher-diff
:- %history
^- loglist
%- zing
%- flop
=< history
(~(gut by dogs.state) t.path *watchdog)
(pure:m state)
::
++ sigh-json-rpc-response
|= [wir=wire res=response:rpc:jstd]
^- (quip move _+>)
?> ?=([@ *] wir)
=< done
%- sigh-json-rpc-response:(open:watcher i.wir)
[t.wir res]
:: +handle-peek: get diagnostics data
::
++ watcher
|_ $: =name
=eye
rewind-block=(unit @ud)
new-logs=loglist
moves=(list move)
==
::
:: +open: initialize core
::
++ open
|= nom=^name
^+ +>
+>.$(name nom, eye (~(got by eyes) nom))
::
:: +init: set up eye and initialize core
::
++ init
|= [nom=^name =config]
^+ +>
=. name nom
=. eye
%*(. *^eye - config, last-heard-block from-block.config)
get-latest-block
::
:: +| outward
::
:: +wipe: delete eye
::
++ wipe
=> cancel-wait-poll
=> cancel-subscribers
:- (flop moves)
..watcher(eyes (~(del by eyes) name))
::
:: +done: store changes, update subscribers
::
++ done
^- [(list move) _..watcher]
=? . ?=(^ rewind-block)
:: if we're rewinding to a block, then we throw away any moves
:: and changes we were going to make.
::
=: moves *(list move)
new-logs *loglist
==
(restore-block u.rewind-block)
:: if we have any updates, send them
::
=? . !=(~ new-logs)
(fan-diff %logs new-logs)
:: produce moves, store updated state
::
:- (flop moves)
..watcher(eyes (~(put by eyes) name eye))
::
:: +put-move: store side-effect
::
++ put-move
|= =card
%_(+> moves [[ost card] moves])
::
++ put-moves
|= moz=(list move)
%_(+> moves (weld (flop moz) moves))
::
:: +put-rpc-request: store rpc request to ethereum node
::
++ put-rpc-request
|= [wir=wire id=(unit @t) req=request]
^+ +>
%- put-move
^- card
:* %hiss
[name wir]
~
%json-rpc-response
%hiss
%+ json-request node.eye
(request-to-json id req)
==
::
:: +put-log: store change made by event
::
++ put-log
|= log=event-log
%_ +>
new-logs (store-new-logs ~[log] new-logs)
logs.eye (store-new-logs ~[log] logs.eye)
heard.eye (~(put in heard.eye) (log-to-id log))
==
::
:: +| subscriptions
::
++ put-diff
|= [for=bone dif=update]
%_(+> moves [[for %diff %eth-watcher-update dif] moves])
::
++ put-snapshot-diff
|= for=bone
(put-diff for %snap last-heard-block.eye heard.eye logs.eye)
::
++ get-subscribers
^- (list bone)
%+ murn ~(tap by sup)
|= [b=bone s=ship p=path]
^- (unit bone)
?> ?=([@ *] p)
?:(=(name i.p) `b ~)
::
++ fan-diff
|= dif=update
%- put-moves
%+ turn get-subscribers
|= b=bone
^- move
[b %diff %eth-watcher-update dif]
::
++ cancel-subscribers
%- put-moves
%+ turn get-subscribers
|=(b=bone [b %quit ~])
::
:: +| catch-up-operations
::
:: +get-latest-block
::
:: Get latest block from eth node and compare to our own latest block.
:: Get intervening blocks in chunks until we're caught up, then set
:: up a filter going forward.
::
++ get-latest-block
=> cancel-wait-poll
(put-rpc-request /catch-up/block-number `'block number' %eth-block-number ~)
::
:: +catch-up: get next chunk
::
++ catch-up
|= from-block=@ud
^+ +>
?: (gte from-block latest-block.eye)
new-filter
=/ next-block (min latest-block.eye (add from-block 5.760)) :: ~d1
~? debug=|
[%catching-up from=from-block to=latest-block.eye]
%- put-rpc-request
:+ /catch-up/step/(scot %ud from-block)/(scot %ud next-block)
`'catch up'
:* %eth-get-logs
`number+from-block
`number+next-block
contracts.eye
topics.eye
==
::
:: +| filter-operations
::
:: +new-filter: request a new polling filter
::
:: Listens from the last-heard block onward.
::
++ new-filter
%- put-rpc-request
:+ /filter/new `'new filter'
^- request:rpc
:* %eth-new-filter
`number+last-heard-block.eye
?~(to-block.eye ~ `number+u.to-block.eye)
contracts.eye
topics.eye
==
::
:: +read-filter: get all events the filter captures
::
++ read-filter
%- put-rpc-request
:+ /filter/logs `'filter logs'
[%eth-get-filter-logs filter-id.eye]
::
:: +poll-filter: get all new events since last poll (or filter creation)
::
++ poll-filter
?: =(0 filter-id.eye)
~& %no-filter-bad-poll
.
%- put-rpc-request
:+ /filter/changes `'poll filter'
[%eth-get-filter-changes filter-id.eye]
::
:: +wait-poll: remind us to poll in four minutes
::
:: Four minutes because Ethereum RPC filters time out after five.
:: We don't check for an existing timer or clear an old one here,
:: sane flows shouldn't see this being called superfluously.
::
++ wait-poll
=+ wen=(add now ~m4)
%- put-move(poll-timer.eye `wen)
[%wait name^/poll wen]
::
:: +cancel-wait-poll: remove poll reminder
::
++ cancel-wait-poll
?~ poll-timer.eye ..cancel-wait-poll
%- put-move(poll-timer.eye ~)
[%rest u.poll-timer.eye]
::
:: +| filter-results
::
:: +sigh-json-rpc-response: process rpc response
::
++ sigh-json-rpc-response
|= [wir=wire res=response:rpc:jstd]
^+ +>
~! -.res
?: ?=(%fail -.res)
?: =(405 p.hit.res)
~& 'HTTP 405 error (expected if using infura)'
+>.$
?. =(5 (div p.hit.res 100))
~& [%http-error hit.res]
+>.$
?+ wir
~& [%retrying-node ~] ::((soft tang) q.res)]
wait-poll
[%catch-up %step @ta @ta ~]
~& %retrying-catch-up
(catch-up (slav %ud `@ta`i.t.t.wir))
==
?+ wir ~|([%weird-sigh-wire wir] !!)
[%filter %new *]
(take-new-filter res)
::
[%filter *]
(take-filter-results res)
::
[%catch-up %block-number ~]
(take-block-number res)
::
[%catch-up %step @ta @ta ~]
=/ from-block (slav %ud `@ta`i.t.t.wir)
=/ next-block (slav %ud `@ta`i.t.t.t.wir)
(take-catch-up-step res from-block next-block)
==
::
:: +take-new-filter: store filter-id and read it
::
++ take-new-filter
|= rep=response:rpc:jstd
^+ +>
~| rep
?< ?=(%batch -.rep)
?< ?=(%fail -.rep)
?: ?=(%error -.rep)
~& [%filter-error--retrying message.rep]
new-filter
=- read-filter(filter-id.eye -)
(parse-eth-new-filter-res res.rep)
::
:: +take-filter-results: parse results into event-logs and process them
::
++ take-filter-results
|= rep=response:rpc:jstd
^+ +>
?< ?=(%batch -.rep)
?< ?=(%fail -.rep)
?: ?=(%error -.rep)
?. ?| =('filter not found' message.rep) :: geth
=('Filter not found' message.rep) :: parity
==
~& [%unhandled-filter-error +.rep]
+>
~& [%filter-timed-out--recreating block=last-heard-block.eye +.rep]
:: arguably should rewind 40 blocks on the off chance the chain reorganized
:: when we blinked. this will also restart the filter.
::
:: (restore-block ?:((lth last-heard-block 40) 0 (sub.add last-heard-block 40)))
::
:: counter-argument: it's a royal pain to restore from a snapshot
:: every time you can't ping the node for 5 minutes. this is likely
:: to destabilize the network. better to manually restore if we
:: notice an anomaly.
::
:: third way: don't trust anything that doesn't have 40 confirmations
::
new-filter
:: kick polling timer, only if it hasn't already been.
=? +> |(?=(~ poll-timer.eye) (gth now u.poll-timer.eye))
wait-poll
(take-events rep)
::
:: +take-block-number: take block number and start catching up
::
++ take-block-number
|= rep=response:rpc:jstd
^+ +>
?< ?=(%batch -.rep)
?< ?=(%fail -.rep)
?: ?=(%error -.rep)
~& [%take-block-number-error--retrying message.rep]
get-latest-block
=. latest-block.eye (parse-eth-block-number res.rep)
(catch-up last-heard-block.eye)
::
:: +take-catch-up-step: process chunk
::
++ take-catch-up-step
|= [rep=response:rpc:jstd from-block=@ud next-block=@ud]
^+ +>
?< ?=(%batch -.rep)
?< ?=(%fail -.rep)
?: ?=(%error -.rep)
~& [%catch-up-step-error--retrying message.rep]
(catch-up from-block)
=. +>.$ (take-events rep)
(catch-up next-block)
::
:: +take-events: process events
::
++ take-events
|= rep=response:rpc:jstd
^+ +>
?< ?=(%batch -.rep)
?< ?=(%fail -.rep)
?< ?=(%error -.rep)
?. ?=(%a -.res.rep)
~& [%events-not-array rep]
!!
=* changes p.res.rep
~? &(debug=| (gth (lent changes) 0))
:* %processing-changes
changes=(lent changes)
block=last-heard-block.eye
id=filter-id.eye
==
|- ^+ +>.^$
?~ changes +>.^$
=. +>.^$
(take-event-log (parse-event-log i.changes))
$(changes t.changes)
::
:: +take-event-log: obtain changes from event-log
::
++ take-event-log
|= log=event-log
^+ +>
?~ mined.log
~& %ignoring-unmined-event
+>
=* place u.mined.log
?: (~(has in heard.eye) block-number.place log-index.place)
?. removed.u.mined.log
~? debug=|
[%ignoring-duplicate-event tx=transaction-hash.u.mined.log]
+>
:: block was reorganized away, so rewind to this block and
:: start syncing again.
::
~& :* 'removed event! Perhaps chain has reorganized?'
tx-hash=transaction-hash.u.mined.log
block-number=block-number.u.mined.log
block-hash=block-hash.u.mined.log
==
%= +>
rewind-block
:- ~
?~ rewind-block
block-number.place
(min block-number.place u.rewind-block)
==
=. last-heard-block.eye
(max block-number.place last-heard-block.eye)
?: ?& (gte block-number.place from-block.eye)
?| ?=(~ to-block.eye)
(lte block-number.place u.to-block.eye)
==
==
(put-log log)
~& :* %event-block-out-of-range
got=block-number.place
from=from-block.eye
to=to-block.eye
==
+>.$
::
:: +restore-block: rewind to block or earlier
::
++ restore-block
|= block=@ud
^+ +>
=/ old-qeu snaps.sap.eye
:: clear history
::
=: snaps.sap.eye ~
count.sap.eye 0
latest-block.sap.eye 0
==
:: find a snapshot we can use, remove ones that are too new
::
=^ snap=snapshot +>.$
?: |(=(~ old-qeu) (lth block last-heard-block:(need ~(top to old-qeu))))
[%*(. *snapshot last-heard-block from-block.eye) +>.$]
|- ^- [snapshot _+>.^$]
=^ snap=snapshot old-qeu
~(get to old-qeu)
=: count.sap.eye +(count.sap.eye)
latest-block.sap.eye last-heard-block.snap
snaps.sap.eye (~(put to snaps.sap.eye) snap)
==
?: |(=(~ old-qeu) (lth block last-heard-block:(need ~(top to old-qeu))))
[snap +>.^$]
$
~& [%restoring-block block last-heard-block.snap]
(restore-snap snap)
::
:: +restore-snap: revert state to snapshot
::
++ restore-snap
|= snap=snapshot
^+ +>
:: notify subscribers
::TODO be more nuanced about what changed, maybe
::
=. +>.$ (fan-diff snap+snap)
:: restore state and kick new fetch cycle
::
%= get-latest-block
last-heard-block.eye last-heard-block.snap
heard.eye heard.snap
logs.eye logs.snap
==
--
:: /block/some-path: get next block number to check for /some-path
::
++ handle-peek
|= =path
^- (unit (unit peek-data))
?. ?=([%x %block ^] path) ~
?. (~(has by dogs.state) t.t.path) ~
:+ ~ ~
:- %atom
number:(~(got by dogs.state) t.t.path)
--

View File

@ -1,7 +1,6 @@
:: gaze: azimuth statistics
::
/+ *eth-watcher
::
/- eth-watcher
=, ethereum
=, azimuth
::
@ -18,6 +17,7 @@
days=(list [day=@da sat=stats])
==
::
++ loglist loglist:eth-watcher
++ event
$% [%azimuth who=ship dif=diff-point]
::TODO [%invites *]
@ -40,7 +40,7 @@
::
++ move (pair bone card)
++ card
$% [%poke wire [ship %eth-watcher] %eth-watcher-action action]
$% [%poke wire [ship %eth-watcher] %eth-watcher-poke poke:eth-watcher]
[%peer wire [ship %eth-watcher] path]
[%hiss wire (unit user:eyre) mark %hiss hiss:eyre]
[%wait wire @da]
@ -49,7 +49,7 @@
--
::
|_ [bowl:gall state]
++ node-url (need (de-purl:html 'http://eth-mainnet.urbit.org:8545'))
++ node-url 'http://eth-mainnet.urbit.org:8545'
++ export-frequency ~h1
::
++ prep
@ -76,13 +76,12 @@
:* %poke
/look
[our %eth-watcher]
%eth-watcher-action
%eth-watcher-poke
::
^- action
:+ %watch dap
^- poke:eth-watcher
:+ %watch /[dap]
:* node-url
public:contracts
~
~[azimuth:contracts]
~
==
@ -116,17 +115,20 @@
[~ +>.$]
==
::
:: +diff-eth-watcher-update: process new logs, clear state on rollback
:: +diff-eth-watcher-diff: process new logs, clear state on rollback
::
++ diff-eth-watcher-update
|= [=wire =^update]
++ diff-eth-watcher-diff
|= [=wire =diff:eth-watcher]
^- (quip move _+>)
=^ logs +>.$
?- -.update
%snap ~& [%got-snap (lent logs.snapshot.update)]
[logs.snapshot.update +>.$(qued ~, seen ~)]
%logs ~& [%got-logs (lent loglist.update)]
[loglist.update +>.$]
^- [loglist _+>.$]
?- -.diff
%history ~& [%got-history (lent loglist.diff)]
[loglist.diff +>.$(qued ~, seen ~)]
%log ~& %got-log
[[event-log.diff ~] +>.$]
%disavow ~& %disavow-unimplemented
[~ +>.$]
==
?~ logs [~ +>.$]
=- =^ moz +>.$ (queue-logs mistime) :: oldest first
@ -176,7 +178,8 @@
^- move
=- [ost %hiss /timestamps ~ %json-rpc-response %hiss -]
^- hiss:eyre
%+ json-request:rpc node-url
%+ json-request:rpc
(need (de-purl:html node-url))
:- %a
^- (list json)
%+ turn

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

@ -0,0 +1,7 @@
|_ [=bowl:gall ~]
++ poke-noun
|= a=*
:_ ..poke-noun
=/ force ?=(%force a)
[[ost.bowl %goad /goad force ~] ~]
--

View File

@ -186,6 +186,7 @@
++ poke-kiln-keep-ford (wrap poke-keep-ford):from-kiln
++ poke-kiln-autoload (wrap poke-autoload):from-kiln
++ poke-kiln-overload (wrap poke-overload):from-kiln
++ poke-kiln-goad-gall (wrap poke-goad-gall):from-kiln
++ poke-kiln-wash-gall (wrap poke-wash-gall):from-kiln
++ poke-kiln-unmount (wrap poke-unmount):from-kiln
++ poke-kiln-unsync (wrap poke-unsync):from-kiln

View File

@ -0,0 +1,61 @@
:: invite-hook: receive invites from any source
::
/+ *invite-json
|%
+$ move [bone [%poke wire dock [%invite-action invite-action]]]
--
::
|_ [bol=bowl:gall ~]
::
++ this .
::
++ poke-json
|= =json
^- (quip move _this)
?> (team:title our.bol src.bol)
=/ act (json-to-action json)
?> ?=(%invite -.act)
:_ this
[(invite-hook-poke recipient.invite.act act)]~
::
++ poke-invite-action
|= act=invite-action
^- (quip move _this)
:_ this
?+ -.act
~
::
%invite
?: (team:title our.bol src.bol)
?> !(team:title our.bol ship.invite.act)
[(invite-hook-poke recipient.invite.act act)]~
?> ?=(^ (invitatory-scry path.act))
?> ?=(~ (invite-scry path.act uid.act))
[(invite-poke path.act act)]~
==
::
++ invite-hook-poke
|= [=ship action=invite-action]
^- move
[ost.bol %poke /invite-hook [ship %invite-hook] [%invite-action action]]
::
++ invite-poke
|= [pax=path action=invite-action]
^- move
[ost.bol %poke pax [our.bol %invite-store] [%invite-action action]]
::
++ invitatory-scry
|= pax=path
^- (unit invitatory)
=. pax
;:(weld /=invite-store/(scot %da now.bol)/invitatory pax /noun)
.^((unit invitatory) %gx pax)
::
++ invite-scry
|= [pax=path uid=serial]
^- (unit invite)
=. pax
;:(weld /=invite-store/(scot %da now.bol)/invite pax /(scot %uv uid)/noun)
.^((unit invite) %gx pax)
--

View File

@ -0,0 +1,174 @@
/+ *invite-json
|%
+$ move [bone card]
::
+$ card
$% [%diff invite-diff]
[%quit ~]
==
::
+$ state
$% [%0 state-zero]
==
::
+$ state-zero
$: =invites
==
--
::
|_ [bol=bowl:gall state]
::
++ this .
::
++ prep
|= old=(unit state)
^- (quip move _this)
?~ old
[~ this]
[~ this(+<+ u.old)]
::
++ peek-x-all
|= pax=path
^- (unit (unit [%noun (map path invitatory)]))
[~ ~ %noun invites]
::
++ peek-x-invitatory
|= pax=path
^- (unit (unit [%noun (unit invitatory)]))
?~ pax
~
=/ invitatory=(unit invitatory) (~(get by invites) pax)
[~ ~ %noun invitatory]
::
++ peek-x-invite
|= pax=path
^- (unit (unit [%noun (unit invite)]))
:: /:path/:uid
=/ pas (flop pax)
?~ pas
~
=/ uid=serial (slav %uv i.pas)
=. pax (scag (dec (lent pax)) `(list @ta)`pax)
=/ invitatory=(unit invitatory) (~(get by invites) pax)
?~ invitatory
~
=/ invite=(unit invite) (~(get by u.invitatory) uid)
[~ ~ %noun invite]
::
++ peer-all
|= pax=path
^- (quip move _this)
?> (team:title our.bol src.bol)
:: send all updates from now on
:_ this
[ost.bol %diff %invite-initial invites]~
::
++ peer-updates
|= pax=path
^- (quip move _this)
?> (team:title our.bol src.bol)
:: send all updates from now on
[~ this]
::
++ peer-invitatory
|= pax=path
^- (quip move _this)
?> (team:title our.bol src.bol)
=/ inv=(unit invitatory) (~(get by invites) pax)
?~ inv !!
:_ this
[ost.bol %diff %invite-update [%invitatory u.inv]]~
::
++ poke-json
|= =json
^- (quip move _this)
?> (team:title our.bol src.bol)
(poke-invite-action (json-to-action json))
::
++ poke-invite-action
|= action=invite-action
^- (quip move _this)
?> (team:title our.bol src.bol)
?- -.action
%create (handle-create action)
%delete (handle-delete action)
%invite (handle-invite action)
%accept (handle-accept action)
%decline (handle-decline action)
==
::
++ handle-create
|= act=invite-action
^- (quip move _this)
?> ?=(%create -.act)
?: (~(has by invites) path.act)
[~ this]
:- (send-diff path.act act)
this(invites (~(put by invites) path.act *invitatory))
::
++ handle-delete
|= act=invite-action
^- (quip move _this)
?> ?=(%delete -.act)
?. (~(has by invites) path.act)
[~ this]
:- (send-diff path.act act)
this(invites (~(del by invites) path.act))
::
++ handle-invite
|= act=invite-action
^- (quip move _this)
?> ?=(%invite -.act)
?. (~(has by invites) path.act)
[~ this]
=/ container (~(got by invites) path.act)
=. uid.act (sham eny.bol)
=. container (~(put by container) uid.act invite.act)
:- (send-diff path.act act)
this(invites (~(put by invites) path.act container))
::
++ handle-accept
|= act=invite-action
^- (quip move _this)
?> ?=(%accept -.act)
?. (~(has by invites) path.act)
[~ this]
=/ container (~(got by invites) path.act)
=/ invite (~(get by container) uid.act)
?~ invite
[~ this]
=. container (~(del by container) uid.act)
:- (send-diff path.act [%accepted path.act uid.act u.invite])
this(invites (~(put by invites) path.act container))
::
++ handle-decline
|= act=invite-action
^- (quip move _this)
?> ?=(%decline -.act)
?. (~(has by invites) path.act)
[~ this]
=/ container (~(got by invites) path.act)
=/ invite (~(get by container) uid.act)
?~ invite
[~ this]
=. container (~(del by container) uid.act)
:- (send-diff path.act act)
this(invites (~(put by invites) path.act container))
::
++ update-subscribers
|= [pax=path upd=invite-update]
^- (list move)
%+ turn (prey:pubsub:userlib pax bol)
|= [=bone *]
[bone %diff %invite-update upd]
::
++ send-diff
|= [pax=path upd=invite-update]
^- (list move)
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%invitatory pax] upd)
==
::
--

View File

@ -0,0 +1,49 @@
:: invite-view: provide a json interface to invite-store
::
/+ *invite-json
::
|%
+$ move [bone card]
::
+$ card
$% [%peer wire dock path]
[%diff %json json]
==
--
::
|_ [bol=bowl:gall ~]
::
++ this .
::
++ prep
|= old=*
^- (quip move _this)
:_ this
[ost.bol %peer / [our.bol %invite-store] /updates]~
::
++ peer-primary
|= pax=path
^- (quip move _this)
?> (team:title our.bol src.bol)
:_ this
[ost.bol %diff %json (invites-to-json invites-scry)]~
::
++ diff-invite-update
|= [wir=wire upd=invite-update]
^- (quip move _this)
=/ updates-json (update-to-json upd)
:_ this
%+ turn (prey:pubsub:userlib /primary bol)
|= [=bone *]
[bone %diff %json updates-json]
::
++ quit
|= wir=wire
^- (quip move _this)
:_ this
[ost.bol %peer / [our.bol %invite-store] /updates]~
::
++ invites-scry
^- invites
.^(invites %gx /=invite-store/(scot %da now.bol)/all/noun)
--

View File

@ -0,0 +1,162 @@
:: pool-group-hook: maintain groups based on invite pool
::
/- group-store
/+ tapp, stdio, ethio
=, ethereum-types
=, able:jael
::
=> |%
++ group-path /invite-peers
++ refresh-rate ~m15
--
::
=> |%
+$ app-state
$: %0
url=_'http://eth-mainnet.urbit.org:8545'
inviter=ship
invited=(set ship)
==
::
+$ peek-data ~
+$ in-poke-data ~
+$ out-poke-data
[%group-action group-action:group-store]
+$ in-peer-data ~
+$ out-peer-data ~
++ tapp
%: ^tapp
app-state
peek-data
in-poke-data
out-poke-data
in-peer-data
out-peer-data
==
++ tapp-async tapp-async:tapp
++ stdio (^stdio out-poke-data out-peer-data)
++ ethio (^ethio out-poke-data out-peer-data)
--
::
:: Async helpers
::
=> |%
++ get-invited-by
|= [url=@t who=ship]
=/ m (async:stdio ,ship)
^- form:m
;< res=@t bind:m
%+ read-contract:ethio url
:+ `'invitedBy'
delegated-sending:contracts:azimuth
:- 'invitedBy(uint32)'
:~ [%uint `@`who]
==
%- pure:m
^- ship ^- @
%+ decode-results:abi:ethereum res
[%uint]~
::
++ get-invited
|= [url=@ta who=ship]
=/ m (async:stdio ,(list ship))
^- form:m
;< res=@t bind:m
%+ read-contract:ethio url
:+ `'getInvited'
delegated-sending:contracts:azimuth
:- 'getInvited(uint32)'
:~ [%uint `@`who]
==
%- pure:m
;; (list ship)
%+ decode-results:abi:ethereum res
[%array %uint]~
::
++ send-poke
|= [our=ship =group-action:group-store]
=/ m (async:stdio ,~)
^- form:m
%+ poke-app:stdio
[our %group-store]
[%group-action group-action]
--
::
:: Main loop
::
=> |%
++ start
|= [state=app-state our=ship]
=/ m tapp-async
^- form:m
;< inviter=ship bind:m (get-invited-by url.state our)
?: =(0 inviter)
:: we're done here, don't do anything ever again
(pure:m state)
=. inviter.state inviter
:: create the group
;< ~ bind:m (send-poke our %bundle group-path)
:: start update timer loop
;< ~ bind:m set-timer
:: go ahead and update for the first time
(update state our)
::
:: Get updates since last checked
::
++ update
|= [state=app-state our=ship]
=/ m tapp-async
^- form:m
;< invited=(list ship) bind:m (get-invited [url inviter]:state)
=/ new=(list ship)
%+ skip invited
~(has in invited.state)
;< ~ bind:m
?: =(~ new) (pure:(async:stdio ,~) ~)
(send-poke our %add (sy new) group-path)
%- pure:m
state(invited (~(gas in invited.state) new))
::
:: Set update timer
::
++ set-timer
=/ m (async:tapp ,~)
^- form:m
;< now=@da bind:m get-time:stdio
=/ next=@da (add now refresh-rate)
::NOTE we use +send-raw-card here to ensure we always set a new timer,
:: regardless of what happens further on in the flow.
(send-raw-card:stdio %wait /effect/(scot %da next) next)
--
::
:: Main
::
=* default-tapp default-tapp:tapp
%- create-tapp-all:tapp
|_ [=bowl:gall state=app-state]
++ handle-init
=/ m tapp-async
^- form:m
(start state our.bowl)
::
++ handle-take
|= =sign:tapp
=/ m tapp-async
^- form:m
?+ -.sign ~|([%strange-sign -.sign] !!)
%coup
?~ error.sign (pure:m state)
%- (slog [leaf+"pool-group-hook effect failed" u.error.sign])
(pure:m state)
::
%wake
;< ~ bind:m
set-timer
(update state our.bowl)
==
::
++ handle-poke handle-poke:default-tapp
++ handle-diff handle-diff:default-tapp
++ handle-peer handle-peer:default-tapp
++ handle-peek handle-peek:default-tapp
--

View File

@ -1,3 +0,0 @@
:- %say
|= [* ~ ~]
[%azimuth-tracker-poke %init ~]

View File

@ -0,0 +1,14 @@
:: Kiln: force Gall to rebuild agents
::
:::: /hoon/goad-gall/hood/gen
::
/? 310
::
::::
!:
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
~
[force=_| agent=term]
==
[%kiln-goad-gall force ?:(?=(%$ agent) ~ (some agent))]

View File

@ -1,38 +0,0 @@
:: eth-watcher utilities
::
/- *eth-watcher
::
|%
:: +log-to-id: extract the event-id from an event-log
::
++ log-to-id
|= log=event-log:rpc:ethereum
^- event-id:ethereum
?> ?=(^ mined.log)
:- block-number.u.mined.log
log-index.u.mined.log
::
:: +store-new-logs: add logs to an old loglist, ensuring newest-first ordering
::
:: assumes :new is already ordered newest-first
::
++ store-new-logs
|= [new=loglist old=loglist]
^- loglist
?~ new old
=+ new-place=(log-to-id i.new)
|-
?~ old [i.new old]
=+ old-place=(log-to-id i.old)
:: if the :old-place is older than :new-place,
:: put :new-place down, and grab the next one from :new
:: otherwise, keep looking through :old
::
?: ?| (gth block.new-place block.old-place)
?& =(block.new-place block.old-place)
(gth log.new-place log.old-place)
==
==
[i.new ^$(new t.new)]
[i.old $(old t.old)]
--

194
pkg/arvo/lib/ethio.hoon Normal file
View File

@ -0,0 +1,194 @@
:: ethio: Asynchronous Ethereum input/output functions.
::.
/+ stdio
=, ethereum-types
=, able:jael
::
|* [out-poke-data=mold out-peer-data=mold]
=> |%
++ stdio (^stdio out-poke-data out-peer-data)
+$ topics (list ?(@ux (list @ux)))
--
|%
:: +request-rpc: send rpc request, with retry
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (async:stdio ,json)
^- form:m
|^ %+ (retry json) `10
=/ m (async:stdio ,(unit json))
^- form:m
=/ =request:http
:* method=%'POST'
url=url
header-list=['Content-Type'^'application/json' ~]
^= body
%- some %- as-octt:mimes:html
%- en-json:html
(request-to-json:rpc:ethereum id req)
==
;< ~ bind:m (send-request:stdio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:stdio
?~ rep
(pure:m ~)
(parse-response u.rep)
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(async:stdio (unit result))]
=/ m (async:stdio ,result)
=| try=@ud
|^ |- ^- form:m
=* loop $
?: =(crash-after `try)
(async-fail:stdio %retry-too-many ~)
;< ~ bind:m (backoff try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
loop(try +(try))
::
++ backoff
|= [try=@ud limit=@dr]
=/ m (async:stdio ,~)
^- form:m
;< eny=@uvJ bind:m get-entropy:stdio
;< now=@da bind:m get-time:stdio
%- wait:stdio
%+ add now
%+ min limit
?: =(0 try) ~s0
%+ add
(mul ~s1 (bex (dec try)))
(mul ~s0..0001 (~(rad og eny) 1.000))
--
::
++ parse-response
|= =client-response:iris
=/ m (async:stdio ,(unit json))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
(pure:m ~)
=/ body=@t q.data.u.full-file.client-response
=/ jon=(unit json) (de-json:html body)
?~ jon
(pure:m ~)
=, dejs-soft:format
=/ array=(unit (list response:rpc:jstd))
((ar parse-one-response) u.jon)
?~ array
=/ res=(unit response:rpc:jstd) (parse-one-response u.jon)
?~ res
(async-fail:stdio %request-rpc-parse-error >id< ~)
?: ?=(%error -.u.res)
(async-fail:stdio %request-rpc-error >id< >+.res< ~)
?. ?=(%result -.u.res)
(async-fail:stdio %request-rpc-fail >u.res< ~)
(pure:m `res.u.res)
(async-fail:stdio %request-rpc-batch >%not-implemented< ~)
:: (pure:m `[%batch u.array])
::
++ parse-one-response
|= =json
^- (unit response:rpc:jstd)
=/ res=(unit [@t ^json])
%. json
=, dejs-soft:format
(ot id+so result+some ~)
?^ res `[%result u.res]
~| parse-one-response=json
:+ ~ %error %- need
%. json
=, dejs-soft:format
(ot id+so error+(ot code+no message+so ~) ~)
--
:: +read-contract: calls a read function on a contract, produces result hex
::
++ read-contract
|= [url=@t proto-read-request:rpc:ethereum]
=/ m (async:stdio ,@t)
;< =json bind:m
%^ request-rpc url id
:+ %eth-call
^- call:rpc:ethereum
[~ to ~ ~ ~ `tape`(encode-call:rpc:ethereum function arguments)]
[%label %latest]
?. ?=(%s -.json) (async-fail:stdio %request-rpc-fail >json< ~)
(pure:m p.json)
::
++ get-latest-block
|= url=@ta
=/ m (async:stdio ,block)
^- form:m
;< =json bind:m
(request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (async:stdio ,block)
^- form:m
|^
;< =json bind:m
%+ request-rpc url
:- `'block by number'
[%eth-get-block-by-number number |]
=/ =block (parse-block json)
?. =(number number.id.block)
(async-fail:stdio %reorg-detected >number< >block< ~)
(pure:m block)
::
++ parse-block
|= =json
^- block
=< [[&1 &2] |2]
^- [@ @ @]
~| json
%. json
=, dejs:format
%- ot
:~ hash+parse-hex-result:rpc:ethereum
number+parse-hex-result:rpc:ethereum
'parentHash'^parse-hex-result:rpc:ethereum
==
--
::
++ get-logs-by-hash
|= [url=@ta =hash:block contracts=(list address) =topics]
=/ m (async:stdio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by hash'
%eth-get-logs-by-hash
hash
contracts
topics
==
%- pure:m
(parse-event-logs:rpc:ethereum json)
::
++ get-logs-by-range
|= $: url=@ta
contracts=(list address)
=topics
=from=number:block
=to=number:block
==
=/ m (async:stdio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by range'
%eth-get-logs
`number+from-number
`number+to-number
contracts
topics
==
%- pure:m
(parse-event-logs:rpc:ethereum json)
--

View File

@ -75,39 +75,43 @@
|= [our/ship lit/?]
%- ~(gas in *(set well:gall))
^- (list well:gall)
?: lit
:~ [%home %dojo]
:: [%home %azimuth-tracker]
==
=+ myr=(clan:title our)
:~ [%home %dojo]
==
:: boot all default apps off the home desk
::
:: ?: ?=($pawn myr)
:: :~ [%home %lens]
:: [%base %hall]
:: [%base %talk]
:: [%base %dojo]
:: [%base %modulo]
:: [%home %launch]
:: [%home %chat]
:: [%home %publish]
:: [%home %clock]
:: [%home %weather]
:: ==
:: :~ [%home %lens]
:: [%home %acme]
:: [%home %dns]
:: [%home %dojo]
:: [%home %hall]
:: [%home %talk]
:: [%home %modulo]
:: [%home %launch]
:: [%home %chat]
:: [%home %publish]
:: [%home %clock]
:: [%home %weather]
:: [%home %azimuth-tracker]
=- (turn - |=(a=term home+a))
^- (list term)
?: lit
:~ %dojo
:: %eth-watcher
:: %azimuth-tracker
==
:~ %dojo
==
:: %+ welp
:: ?: ?=(%pawn (clan:title our)) ~
:: :~ %acme
:: %dns
:: %eth-watcher
:: %azimuth-tracker
:: ==
:: :~ %lens
:: %dojo
:: %modulo
:: %launch
:: %publish
:: %clock
:: %weather
:: %group-store
:: %group-hook
:: %permission-store
:: %permission-hook
:: %permission-group-hook
:: %invite-store
:: %invite-hook
:: %invite-view
:: %chat-store
:: %chat-hook
:: %chat-view
:: %chat-cli
:: ==
::
++ deft-fish :: default connects

View File

@ -82,12 +82,14 @@
^- (list term)
?: lit
:~ %dojo
%eth-watcher
%azimuth-tracker
==
%+ welp
?: ?=(%pawn (clan:title our)) ~
:~ %acme
%dns
%eth-watcher
%azimuth-tracker
==
:~ %lens
@ -102,6 +104,9 @@
%permission-store
%permission-hook
%permission-group-hook
%invite-store
%invite-hook
%invite-view
%chat-store
%chat-hook
%chat-view

View File

@ -198,6 +198,7 @@
%kiln-keep-ford =;(f (f !<(_+<.f vase)) poke-keep-ford)
%kiln-autoload =;(f (f !<(_+<.f vase)) poke-autoload)
%kiln-overload =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-overload)
%kiln-wash-gall =;(f (f !<(_+<.f vase)) poke-wash-gall)
%kiln-unmount =;(f (f !<(_+<.f vase)) poke-unmount)
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
@ -297,6 +298,10 @@
=< abet
(emit %pass /kiln %arvo %f [%keep compiler-cache-size build-cache-size])
::
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
abet:(emit %pass /kiln %arvo %m %goad force agent)
::
++ poke-wash-gall |=(* abet:(emit %pass /kiln %arvo %m [%wash ~]))
::
++ mack

View File

@ -63,6 +63,7 @@
++ card ::
$% {$build wire ? schematic:ford} ::
{$drop wire @tas} ::
[%goad wire force=? agent=(unit dude:gall)] ::
{$info wire @tas nori} ::
{$mont wire @tas beam} ::
{$dirk wire @tas} ::
@ -288,6 +289,10 @@
|= [compiler-cache-size=@ud build-cache-size=@ud]
abet:(emit %keep /kiln compiler-cache-size build-cache-size)
::
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
abet:(emit %goad /kiln force agent)
::
++ poke-wash-gall |=(* abet:(emit %wash /kiln ~))
::
++ mack

View File

@ -0,0 +1,138 @@
/- *invite-store
|%
++ slan |=(mod/@tas |=(txt/@ta (need (slaw mod txt))))
::
++ seri ::: serial
=, dejs:format
^- $-(json serial)
(cu (slan %uv) so)
::
++ invites-to-json
|= inv=invites
^- json
%+ frond:enjs:format %invite-initial
%- pairs:enjs:format
%+ turn ~(tap by inv)
|= [=path =invitatory]
^- [cord json]
[(spat path) (invitatory-to-json invitatory)]
::
++ invitatory-to-json
|= =invitatory
^- json
=, enjs:format
%- pairs
%+ turn ~(tap by invitatory)
|= [=serial =invite]
^- [cord json]
[(scot %uv serial) (invite-to-json invite)]
::
++ invite-to-json
|= =invite
^- json
=, enjs:format
%- pairs
:~ [%ship (ship ship.invite)]
[%app [%s app.invite]]
[%path (path path.invite)]
[%recipient (ship recipient.invite)]
[%text [%s text.invite]]
==
::
++ update-to-json
|= upd=invite-update
=, enjs:format
^- json
%+ frond %invite-update
%- pairs
:~
?: =(%create -.upd)
?> ?=(%create -.upd)
[%create (pairs [%path (path path.upd)]~)]
?: =(%delete -.upd)
?> ?=(%delete -.upd)
[%delete (pairs [%path (path path.upd)]~)]
?: =(%accepted -.upd)
?> ?=(%accepted -.upd)
:- %accepted
%- pairs
:~ [%path (path path.upd)]
[%uid s+(scot %uv uid.upd)]
[%invite (invite-to-json invite.upd)]
==
?: =(%decline -.upd)
?> ?=(%decline -.upd)
:- %decline
%- pairs
:~ [%path (path path.upd)]
[%uid s+(scot %uv uid.upd)]
==
?: =(%invite -.upd)
?> ?=(%invite -.upd)
:- %invite
%- pairs
:~ [%path (path path.upd)]
[%uid s+(scot %uv uid.upd)]
[%invite (invite-to-json invite.upd)]
==
?: =(%invitatory -.upd)
?> ?=(%invitatory -.upd)
:- %invitatory
(invitatory-to-json invitatory.upd)
::
:: %noop
[*@t *json]
==
::
++ json-to-action
|= jon=json
^- invite-action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%invite invite]
[%accept accept]
[%decline decline]
==
::
++ create
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
::
++ invite
%- ot
:~ [%path pa]
[%uid seri]
[%invite invi]
==
::
++ accept
%- ot
:~ [%path pa]
[%uid seri]
==
::
++ decline
%- ot
:~ [%path pa]
[%uid seri]
==
::
++ invi
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%app (se %tas)]
[%path pa]
[%recipient (su ;~(pfix sig fed:ag))]
[%text so]
==
--
--

View File

@ -1,7 +0,0 @@
/- *eth-watcher
|_ act=action
++ grab
|%
++ noun action
--
--

View File

@ -1,7 +0,0 @@
/- *eth-watcher
|_ upd=update
++ grab
|%
++ noun update
--
--

View File

@ -0,0 +1,11 @@
/+ *invite-json
=, dejs:format
|_ act=invite-action
++ grab
|%
++ noun invite-action
++ json
|= jon=^json
(json-to-action jon)
--
--

View File

@ -0,0 +1,14 @@
/+ *invite-json
|_ inv=invites
::
++ grow
|%
++ json (invites-to-json inv)
--
::
++ grab
|%
++ noun invites
--
::
--

View File

@ -0,0 +1,13 @@
/+ *invite-json
|_ upd=invite-update
++ grow
|%
++ json (update-to-json upd)
--
::
++ grab
|%
++ noun invite-update
--
::
--

View File

@ -1,39 +1,38 @@
:: watcher: ethereum event log collector
:: eth-watcher: ethereum event log collector
::
=, able:jael
|%
++ name @tas
::
++ config
$: node=purl:eyre
from-block=@ud
to-block=(unit @ud)
+$ config
$: url=@ta
from=number:block
contracts=(list address:ethereum)
topics=(list $@(@ux (list @ux)))
=topics
==
::
++ action
$% [%watch =name =config]
::TODO support modifying existing config for future polling
[%clear =name]
==
+$ loglist (list event-log:rpc:ethereum)
+$ topics (list ?(@ux (list @ux)))
::
++ update
$% :: %snap: all known-good logs, sent on-subscribe and on-reorg
::TODO there's probably a way to be more nuanced about what we forgot
:: to cope with a reorg
+$ poke
$% :: %watch: configure a watchdog and fetch initial logs
::
[%snap =snapshot]
:: %vent: newly added logs
[%watch =path =config]
:: %clear: remove a watchdog
::
[%logs =loglist]
[%clear =path]
==
::
++ snapshot
$: last-heard-block=@ud
heard=(set event-id:ethereum)
logs=loglist
+$ diff
$% :: %history: full event log history, oldest first
::
[%history =loglist]
:: %log: newly added log
::
[%log =event-log:rpc:ethereum]
:: %disavow: forget logs
::
:: this is sent when a reorg happens that invalidates
:: previously-sent logs
::
[%disavow =id:block]
==
::
++ loglist
(list event-log:rpc:ethereum) :: newest first
--

View File

@ -0,0 +1,44 @@
|%
++ serial @uvH
::
+$ invite
$: =ship :: ship to subscribe to upon accepting invite
app=@tas :: app to subscribe to upon accepting invite
=path :: path to subscribe to upon accepting invite
recipient=ship :: recipient to receive invite
text=cord :: text to describe the invite
==
::
:: +invites: each application using invites creates its own path that
:: contains a map of serial to invite. this allows it to only receive
:: invites that it is concerned with
::
+$ invites (map path invitatory) :: main data structure
::
+$ invitatory (map serial invite) :: containing or conveying an invitation
::
::
+$ invite-base
$% [%create =path] :: create a path
[%delete =path] :: delete a path
[%invite =path uid=serial =invite] :: receive an invite at path/uid
[%decline =path uid=serial] :: decline an invite at path/uid
==
::
+$ invite-action
$% invite-base
[%accept =path uid=serial] :: accept an invite at path/uid
==
::
+$ invite-update
$% invite-base
[%invitatory =invitatory] :: receive invitatory
[%accepted =path uid=serial =invite] :: an invite has been accepted
==
::
+$ invite-diff
$% [%invite-initial invites]
[%invite-update invite-update]
==
--

View File

@ -90,9 +90,10 @@
=/ drip (~(got by movs.drips.state) num)
=. movs.drips.state (~(del by movs.drips.state) num)
?^ error
:: if we errored, drop it
%- (slog leaf/"drip failed" u.error)
event-core
:: if the receiver errored, drop it
::
%. event-core
(slog leaf/"drip failed" (flop u.error))
event-core(moves [duct %give %meta drip]~)
:: +trim: in response to memory pressue
::

View File

@ -8,10 +8,11 @@
-- ::
=> |% :: console protocol
++ axle ::
$: $1 ::
$: $2 ::
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
lit/? :: boot in lite mode
dog/_| :: auto-goad
$= hef :: other weights
$: a/(unit mass) ::
b/(unit mass) ::
@ -46,7 +47,10 @@
$>(%wegh task:able:ames) ::
== ::
$: %b ::
$>(%wegh task:able:behn) ::
$> $? %wait ::
%wegh ::
== ::
task:able:behn ::
== ::
$: %c ::
$> $? %merg :: merge desks
@ -76,6 +80,7 @@
$: %m ::
$> $? %conf ::
%deal ::
%goad ::
%wegh ::
== ::
task:able:mall ::
@ -100,7 +105,10 @@
gift:able:ames ::
== == ::
$: %b ::
$% $>(%mass gift:able:behn) ::
$% $> $? %mass ::
%wake ::
== ::
gift:able:behn ::
$>(%writ gift:able:clay) :: XX %slip
$>(%mere gift:able:clay) :: XX %slip
== == ::
@ -150,13 +158,46 @@
^- {(list move) axle}
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
::
++ auto :: stage automation
^+ .
?. dog.all .
=. dog.all |
(pass /auto/one [%b %wait +(now)])
::
++ auto-wake :: resume automation
|= [=wire error=(unit tang)]
?+ wire
?~ error
~|(behn-bad-wake+wire !!)
(crud %wake u.error)
::
[%auto %one ~]
?~ error
~& %behn-goad
(pass / [%m %goad force=| ~])
:: %goad crashed, wait again, then force
::
~& %behn-goad-retry
%. [/auto/two [%b %wait +(now)]]
pass:(crud %goad u.error)
::
[%auto %two ~]
?~ error
~& %behn-goad-again
(pass / [%m %goad force=& ~])
:: %goad crashed again, bail out
::
~& %behn-goad-fail
(crud %goad u.error)
==
::
++ call :: receive input
|= kyz/task:able
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
$flow +>
$harm +>
$hail (send %hey ~)
$hail auto:(send %hey ~)
$belt (send `dill-belt`p.kyz)
$text (from %out (tuba p.kyz))
$crud :: (send `dill-belt`[%cru p.kyz q.kyz])
@ -197,6 +238,14 @@
|= git/gift:able
+>(moz :_(moz [hen %give git]))
::
++ deal :: pass to %gall
|= [=wire =deal:mall]
(pass wire [%m %deal [our our] ram deal])
::
++ pass :: pass note
|= [=wire =note]
+>(moz :_(moz [hen %pass wire note]))
::
++ from :: receive belt
|= bit/dill-blit
^+ +>
@ -286,23 +335,19 @@
$c '6'
$w '7'
~ '9'
==
==
--
::
++ heft
%_ .
moz
:* [hen %pass /heft/ames %a %wegh ~]
[hen %pass /heft/behn %b %wegh ~]
[hen %pass /heft/clay %c %wegh ~]
[hen %pass /heft/eyre %e %wegh ~]
[hen %pass /heft/ford %f %wegh ~]
[hen %pass /heft/gall %m %wegh ~]
[hen %pass /heft/iris %i %wegh ~]
[hen %pass /heft/jael %j %wegh ~]
moz
==
==
=< (pass /heft/ames [%a %wegh ~])
=< (pass /heft/behn [%b %wegh ~])
=< (pass /heft/clay [%c %wegh ~])
=< (pass /heft/eyre [%e %wegh ~])
=< (pass /heft/ford [%f %wegh ~])
=< (pass /heft/gall [%m %wegh ~])
=< (pass /heft/iris [%i %wegh ~])
=< (pass /heft/jael [%j %wegh ~])
.
:: XX move
::
++ sein
@ -313,25 +358,21 @@
[[151 %noun] %j our %sein da+now /(scot %p who)]
::
++ init :: initialize
^+ .
=. moz
:_ moz
[hen %pass /merg/home %c %merg %home our %base da+now %init]
.
(pass /merg/home [%c %merg %home our %base da+now %init])
::
++ mere :: continue init
^+ .
=/ myt (flop (fall tem ~))
=/ can (clan:title our)
=. tem ~
=. moz :_(moz [hen %pass ~ %m %conf [[our ram] our %home]])
=. +> (pass / [%m %conf [[our ram] our %home]])
=. +> (sync %home our %base)
=. +> ?: ?=(?($czar $pawn) can) +>
(sync %base (sein our) %kids)
=. +> ?. ?=(?($duke $king $czar) can) +>
:: make kids desk publicly readable, so syncs work.
::
(show %kids):(sync %kids our %base)
=? +> ?=(?($earl $duke $king) can)
(sync %base (sein our) %kids)
=? +> ?=(?($duke $king $czar) can)
:: make kids desk publicly readable, so syncs work.
::
(show %kids):(sync %kids our %base)
=. +> autoload
=. +> hood-set-boot-apps
=. +> peer
@ -341,74 +382,38 @@
::
++ into :: preinitialize
|= gyl/(list gill)
%_ +>
tem `(turn gyl |=(a/gill [%yow a]))
moz
:_ moz
[hen %pass / %c %warp our %base `[%sing %y [%ud 1] /]]
==
=. tem `(turn gyl |=(a/gill [%yow a]))
(pass / [%c %warp our %base `[%sing %y [%ud 1] /]])
::
++ send :: send action
|= bet/dill-belt
^+ +>
?^ tem
+>(tem `[bet u.tem])
%_ +>
moz
:_ moz
[hen %pass ~ %m %deal [our our] ram %poke [%dill-belt -:!>(bet) bet]]
==
(deal / [%poke [%dill-belt -:!>(bet) bet]])
::
++ hood-set-boot-apps
%_ .
moz
:_ moz
:* hen %pass ~ %m %deal [our our]
ram %poke %drum-set-boot-apps !>(lit.all)
==
==
(deal / [%poke %drum-set-boot-apps !>(lit.all)])
::
++ peer
%_ .
moz
:_(moz [hen %pass ~ %m %deal [our our] ram %watch /drum])
==
(deal / [%watch /drum])
::
++ show :: permit reads on desk
|= des/desk
%_ +>.$
moz
:_ moz
[hen %pass /show %c %perm des / r+`[%black ~]]
==
(pass /show [%c %perm des / r+`[%black ~]])
::
++ sync
|= syn/{desk ship desk}
%_ +>.$
moz
:_ moz
:* hen %pass /sync %m %deal [our our]
ram %poke %hood-sync -:!>(syn) syn
==
==
(deal /sync [%poke %hood-sync -:!>(syn) syn])
::
++ autoload
%_ .
moz
:_ moz
:* hen %pass /autoload %m %deal [our our]
ram %poke %kiln-start-autoload [%atom %n `~] ~
==
==
(deal /autoload [%poke %kiln-start-autoload [%atom %n `~] ~])
::
++ pump :: send diff ack
%_ .
moz
:_(moz [hen %pass ~ %m %deal [our our] ram %pump ~])
==
(deal / [%pump ~])
::
++ take :: receive
|= sih/sign
|= {tea/wire sih/sign}
^+ +>
?- sih
{?($a $b $c $e $f $m $i $j) $mass *}
@ -462,6 +467,9 @@
::
{$d $blit *}
(done +.sih)
::
{$b $wake *}
(auto-wake tea error.sih)
==
:: +wegh: receive a memory report from a vane and maybe emit full report
::
@ -554,7 +562,7 @@
=* duc (need hey.all)
=/ app %hood
=/ see (tuba "<awaiting {(trip app)}, this may take a minute>")
=/ zon=axon [app input=[~ ~] width=80 cursor=0 see]
=/ zon=axon [app input=[~ ~] width=80 cursor=(lent see) see]
::
=^ moz all abet:(~(into as duc zon) ~)
[moz ..^$]
@ -591,8 +599,38 @@
[moz ..^$]
::
++ load :: import old state
|= old/axle
..^$(all old)
=> |%
:: without .dog
::
++ axle-one
$: $1
hey/(unit duct)
dug/(map duct axon)
lit/?
$= hef
$: a/(unit mass)
b/(unit mass)
c/(unit mass)
e/(unit mass)
f/(unit mass)
g/(unit mass)
i/(unit mass)
j/(unit mass)
==
$= veb
$~ (~(put by *(map @tas log-level)) %hole %soft)
(map @tas log-level)
==
::
++ axle-both
$%(axle-one axle)
--
::
|= old=axle-both
?- -.old
%1 $(old [%2 [hey dug lit dog=& hef veb]:old])
%2 ..^$(all old)
==
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
@ -613,6 +651,6 @@
::
~& [%dill-take-no-flow hen -.q.hin +<.q.hin]
[~ ..^$]
=^ moz all abet:(take:u.nus q.hin)
=^ moz all abet:(take:u.nus tea q.hin)
[moz ..^$]
--

View File

@ -274,6 +274,48 @@
=/ pass [path note-arvo]
(mo-pass pass)
::
:: +mo-reboot: ask %ford to rebuild the specified agent
::
++ mo-reboot
|= [force=? =term =ship]
^+ mo-core
=/ gent (~(got by running.agents.state) term)
=. hen control-duct.gent
=* desk q.beak.gent
:: if we're forcing a reboot, we don't try to %kill the old build
::
?: force
(mo-boot term ship desk)
::
=/ =wire
=/ ship (scot %p ship)
=/ case (scot r.beak.gent)
/sys/core/[term]/[ship]/[desk]/[case]
%. [term ship desk]
=< mo-boot
=/ =note-arvo [%f %kill ~]
(mo-pass wire note-arvo)
::
::
:: +mo-goad: rebuild agent(s)
::
++ mo-goad
|= [force=? agent=(unit dude)]
^+ mo-core
?^ agent
~| goad-gone+u.agent
(mo-reboot force u.agent our)
::
=/ agents=(list term)
~(tap in ~(key by running.agents.state))
|- ^+ mo-core
?~ agents
mo-core
%= $
agents t.agents
..mo-core (mo-reboot force i.agents our)
==
::
:: +mo-pass: prepend a standard %pass to the current list of moves.
::
++ mo-pass
@ -926,6 +968,7 @@
=/ task [hen routes agent-action]
(~(put to tasks) task)
::
~& >> [%gall-not-running term -.agent-action]
%_ mo-core
blocked.agents.state (~(put by blocked.agents.state) term blocked)
==
@ -2357,6 +2400,7 @@
%dirk `%c
%drop `%c
%flog `%d
%goad `%g
%info `%c
%init `%m
%keep `%f
@ -2423,6 +2467,9 @@
::
=> (mo-handle-local:initialised p.sock internal-task)
mo-abet
::
%goad
mo-abet:(mo-goad:initialised force.task agent.task)
::
%init
=/ payload gall-payload(system-duct.agents.state duct)

View File

@ -805,12 +805,11 @@
|= =public-keys-result
^+ ..feel
?: ?=(%full -.public-keys-result)
=. pos.zim (~(uni by pos.zim) points.public-keys-result)
=/ pointl=(list [who=ship =point])
~(tap by points.public-keys-result)
|- ^+ ..feel
?~ pointl
..feel
..feel(pos.zim (~(uni by pos.zim) points.public-keys-result))
:: if changing rift upward, then signal a breach
::
=? ..feel

View File

@ -226,6 +226,48 @@
=/ pass [path note-arvo]
(mo-pass pass)
::
:: +mo-reboot: ask %ford to rebuild the specified agent
::
++ mo-reboot
|= [force=? =term =ship]
^+ mo-core
=/ gent (~(got by running.agents.state) term)
=. hen control-duct.gent
=* desk q.beak.gent
:: if we're forcing a reboot, we don't try to %kill the old build
::
?: force
(mo-boot term ship desk)
::
=/ =wire
=/ ship (scot %p ship)
=/ case (scot r.beak.gent)
/sys/core/[term]/[ship]/[desk]/[case]
%. [term ship desk]
=< mo-boot
=/ =note-arvo [%f %kill ~]
(mo-pass wire note-arvo)
::
::
:: +mo-goad: rebuild agent(s)
::
++ mo-goad
|= [force=? agent=(unit dude)]
^+ mo-core
?^ agent
~| goad-gone+u.agent
(mo-reboot force u.agent our)
::
=/ agents=(list term)
~(tap in ~(key by running.agents.state))
|- ^+ mo-core
?~ agents
mo-core
%= $
agents t.agents
..mo-core (mo-reboot force i.agents our)
==
::
:: +mo-pass: prepend a standard %pass to the current list of moves.
::
++ mo-pass
@ -841,6 +883,7 @@
=/ deal [hen routes deal]
(~(put to deals) deal)
::
~& >> [%gall-not-running term -.deal]
%_ mo-core
blocked.agents.state (~(put by blocked.agents.state) term blocked)
==
@ -1626,6 +1669,9 @@
::
=> (mo-handle-local:initialised p.sock term deal)
mo-abet
::
%goad
mo-abet:(mo-goad:initialised force.task agent.task)
::
%init
=/ payload mall-payload(system-duct.agents.state duct)

View File

@ -1885,6 +1885,7 @@
{$conf-mall p/dock q/dock} :: configure app
$>(%init vane-task) :: set owner
{$deal p/sock q/term r/deal} :: full transmission
[%goad force=? agent=(unit dude)] :: rebuild agent(s)
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
$>(%west vane-task) :: network request
@ -2028,6 +2029,7 @@
$% {$conf p/dock q/dock} :: configure app
$>(%init vane-task) :: set owner
{$deal p/sock q/internal-task} :: full transmission
[%goad force=? agent=(unit dude)] :: rebuild agent(s)
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
$>(%west vane-task) :: network request
@ -7800,6 +7802,9 @@
++ conditional-star-release
0x8c24.1098.c3d3.498f.e126.1421.633f.d579.86d7.4aea
::
++ delegated-sending
0xf790.8ab1.f1e3.52f8.3c5e.bc75.051c.0565.aeae.a5fb
::
:: launch: block number of azimuth deploy
::
++ launch 6.784.800

View File

@ -53,4 +53,281 @@
!> 0x2ad3.9968
!> (mug [(dec (bex 128)) 1])
==
:: SHA tests
:: For references see FIPS180-4 and related test vectors
:: https://nvlpubs.nist.gov/nistpubs/FIPS/NIST.FIPS.180-4.pdf
:: https://csrc.nist.gov/projects/cryptographic-algorithm-validation-program
::
++ test-sha-1
=/ a ''
=/ b 'abc'
=/ c 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'
=/ d 'abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn\
/hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu'
;: weld
%+ expect-eq
!> 0xda39.a3ee.5e6b.4b0d.3255.bfef.9560.1890.afd8.0709
!> `@ux`(sha-1:sha (swp 3 a))
::
%+ expect-eq
!> 0xa999.3e36.4706.816a.ba3e.2571.7850.c26c.9cd0.d89d
!> `@ux`(sha-1:sha (swp 3 b))
::
%+ expect-eq
!> 0x8498.3e44.1c3b.d26e.baae.4aa1.f951.29e5.e546.70f1
!> `@ux`(sha-1:sha (swp 3 c))
::
%+ expect-eq
!> 0xa49b.2446.a02c.645b.f419.f995.b670.9125.3a04.a259
!> `@ux`(sha-1:sha (swp 3 d))
::
==
::
++ test-sha-1l
=/ a 0x0
=/ b 0x549e.959e
=/ c 0x7c.9c67.323a.1df1.adbf.e5ce.b415.eaef.0155.ece2.820f.4d50.c1ec.22cb.
a492.8ac6.56c8.3fe5.85db.6a78.ce40.bc42.757a.ba7e.5a3f.5824.28d6.ca68.
d0c3.9783.36a6.efb7.2961.3e8d.9979.0162.04bf.d921.322f.dd52.2218.3554.
447d.e5e6.e9bb.e6ed.f76d.7b71.e18d.c2e8.d6dc.89b7.3983.64f6.52fa.fc73.
4329.aafa.3dcd.45d4.f31e.388e.4faf.d7fc.6495.f37c.a5cb.ab7f.54d5.8646.
3da4.bfea.a3ba.e09f.7b8e.9239.d832.b4f0.a733.aa60.9cc1.f8d4
=/ d 0x938.f2e2.ebb6.4f8a.f8bb.fc91
;: weld
:: Empty string
::
%+ expect-eq
!> 0xda39.a3ee.5e6b.4b0d.3255.bfef.9560.1890.afd8.0709
!> `@ux`(sha-1l:sha [(met 3 a) a])
:: Short Message
::
%+ expect-eq
!> 0xb78b.ae6d.1433.8ffc.cfd5.d5b5.674a.275f.6ef9.c717
!> `@ux`(sha-1l:sha [(met 3 b) b])
:: Long Message
::
%+ expect-eq
!> 0xd8fd.6a91.ef3b.6ced.05b9.8358.a991.07c1.fac8.c807
!> `@ux`(sha-1l:sha [(met 3 c) c])
:: Leading-zero byte
::
%+ expect-eq
!> 0x9f4e.66b6.ceea.40dc.f4b9.166c.28f1.c884.7414.1da9
!> `@ux`(sha-1l:sha [(met 3 d) d])
::
==
::
++ test-shay
=/ a 0x0
=/ b 0xb4.190e
=/ c 0x45.1101.250e.c6f2.6652.249d.59dc.974b.7361.d571.a810.1cdf.d36a.ba3b.
5854.d3ae.086b.5fdd.4597.721b.66e3.c0dc.5d8c.606d.9657.d0e3.2328.3a52.
17d1.f53f.2f28.4f57.b85c.8a61.ac89.2471.1f89.5c5e.d90e.f177.45ed.2d72.
8abd.22a5.f7a1.3479.a462.d71b.56c1.9a74.a40b.655c.58ed.fe0a.188a.d2cf.
46cb.f305.24f6.5d42.3c83.7dd1.ff2b.f462.ac41.9800.7345.bb44.dbb7.b1c8.
6129.8cdf.6198.2a83.3afc.728f.ae1e.da2f.87aa.2c94.8085.8bec
=/ d 0x777.fc1e.1ca4.7304.c2e2.6569.2838.109e.26aa.b9e5.c4ae.4e86.00df.4b1f
;: weld
:: Empty string
::
%+ expect-eq
!> 0xe3b0.c442.98fc.1c14.9afb.f4c8.996f.b924.27ae.41e4.649b.934c.a495.
991b.7852.b855
!> `@ux`(sha-256l:sha [(met 3 a) a])
:: Short Message
::
%+ expect-eq
!> 0xdff2.e730.91f6.c05e.5288.96c4.c831.b944.8653.dc2f.f043.528f.6769.
437b.c7b9.75c2
!> `@ux`(sha-256l:sha [(met 3 b) b])
:: Long Message
::
%+ expect-eq
!> 0x3c59.3aa5.39fd.cdae.516c.df2f.1500.0f66.3418.5c88.f505.b397.75fb.
9ab1.37a1.0aa2
!> `@ux`(sha-256l:sha [(met 3 c) c])
:: Leading-zero byte
::
%+ expect-eq
!> 0xffb4.fc03.e054.f8ec.bc31.470f.c023.bedc.d4a4.06b9.dd56.c71d.a1b6.
60dc.c484.2c65
!> `@ux`(sha-256l:sha [(met 3 d) d])
==
++ test-shal
=/ a 0x0
=/ b 0x23be.86d5
=/ c 0x4f.0560.0950.664d.5190.a2eb.c29c.9edb.89c2.0079.a4d3.e6bc.3b27.d75e.
34e2.fa3d.0276.8502.bd69.7900.7859.8d5f.cf3d.6779.bfed.1284.bbe5.ad72.
fb45.6015.181d.9587.d6e8.64c9.4056.4eaa.fb4f.2fea.d434.6ea0.9b68.77d9.
340f.6b82.eb15.1588.0872.213d.a3ad.88fe.ba9f.4f13.817a.71d6.f90a.1a17.
c43a.15c0.38d9.88b5.b29e.dffe.2d6a.0628.13ce.dbe8.52cd.e302.b3e3.3b69.
6846.d2a8.e36b.d680.efcc.6cd3.f9e9.a4c1.ae8c.ac10.cc52.44d1.3167.7140.
3991.76ed.4670.0019.a004.a163.806f.7fa4.67fc.4e17.b461.7bbd.7641.aaff.
7ff5.6396.ba8c.08a8.be10.0b33.a20b.5daf.134a.2aef.a5e1.c349.6770.dcf6.
baa4.f7bb
=/ d 0xa.55db
;: weld
:: Empty string
::
%+ expect-eq
!> 0xcf83.e135.7eef.b8bd.f154.2850.d66d.8007.d620.e405.0b57.15dc.83f4.
a921.d36c.e9ce.47d0.d13c.5d85.f2b0.ff83.18d2.877e.ec2f.63b9.31bd.
4741.7a81.a538.327a.f927.da3e
!> `@ux`(sha-512l:sha [(met 3 a) a])
:: Short message
::
%+ expect-eq
!> 0x76d4.2c8e.adea.35a6.9990.c63a.762f.3306.14a4.6999.77f0.58ad.b988.
f406.fb0b.e8f2.ea3d.ce3a.2bbd.1d82.7b70.b9b2.99ae.6f9e.5058.ee97.
b50b.d492.2d6d.37dd.c761.f8eb
!> `@ux`(sha-512l:sha [(met 3 b) b])
:: Long message
::
%+ expect-eq
!> 0xa9db.490c.708c.c725.48d7.8635.aa7d.a79b.b253.f945.d710.e5cb.677a.
474e.fc7c.65a2.aab4.5bc7.ca11.13c8.ce0f.3c32.e139.9de9.c459.535e.
8816.521a.b714.b2a6.cd20.0525
!> `@ux`(sha-512l:sha [(met 3 c) c])
:: Leading-zero byte
::
%+ expect-eq
!> 0x7952.585e.5330.cb24.7d72.bae6.96fc.8a6b.0f7d.0804.577e.347d.99bc.
1b11.e52f.3849.85a4.2844.9382.306a.8926.1ae1.43c2.f3fb.6138.04ab.
20b4.2dc0.97e5.bf4a.96ef.919b
!> `@ux`(sha-512l:sha [(met 3 d) d])
::
==
::
++ test-shax
=/ a ''
=/ b 'abc'
=/ c 'abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'
;: weld
:: Empty string
::
%+ expect-eq
!> 0xe3b0.c442.98fc.1c14.9afb.f4c8.996f.b924.27ae.41e4.649b.934c.a495.
991b.7852.b855
!> `@ux`(sha-256:sha (swp 3 a))
:: Short Message
::
%+ expect-eq
!> 0xba78.16bf.8f01.cfea.4141.40de.5dae.2223.b003.61a3.9617.7a9c.b410.
ff61.f200.15ad
!> `@ux`(sha-256:sha (swp 3 b))
:: Long Message
::
%+ expect-eq
!> 0x248d.6a61.d206.38b8.e5c0.2693.0c3e.6039.a33c.e459.64ff.2167.f6ec.
edd4.19db.06c1
!> `@ux`(sha-256:sha (swp 3 c))
::
==
::
++ test-shaz
=/ a ''
=/ b 'abc'
=/ c 'abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijkl\
/mnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu'
;: weld
:: Empty string
::
%+ expect-eq
!> 0xcf83.e135.7eef.b8bd.f154.2850.d66d.8007.d620.e405.0b57.15dc.83f4.
a921.d36c.e9ce.47d0.d13c.5d85.f2b0.ff83.18d2.877e.ec2f.63b9.31bd.
4741.7a81.a538.327a.f927.da3e
!> `@ux`(sha-512:sha (swp 3 a))
:: Short Message
::
%+ expect-eq
!> 0xddaf.35a1.9361.7aba.cc41.7349.ae20.4131.12e6.fa4e.89a9.7ea2.0a9e.
eee6.4b55.d39a.2192.992a.274f.c1a8.36ba.3c23.a3fe.ebbd.454d.4423.
643c.e80e.2a9a.c94f.a54c.a49f
!> `@ux`(sha-512:sha (swp 3 b))
:: Long Message
::
%+ expect-eq
!> 0x8e95.9b75.dae3.13da.8cf4.f728.14fc.143f.8f77.79c6.eb9f.7fa1.7299.
aead.b688.9018.501d.289e.4900.f7e4.331b.99de.c4b5.433a.c7d3.29ee.
b6dd.2654.5e96.e55b.874b.e909
!> `@ux`(sha-512:sha (swp 3 c))
::
==
::
++ test-sham
;: weld
%+ expect-eq
!> 0v3.71s52.4bqnp.ki2b8.9hhsp.2ufgg
!> (sham [2 4])
::
%+ expect-eq
!> 0v1.hg8mv.t7s3f.u4f8a.q5noe.dvqvh
!> (sham "hello")
::
==
::
++ test-raw
;: weld
%+ expect-eq
!> 0b1001
!> `@ub`(~(raw og 27) 4)
::
%+ expect-eq
!> 0b0
!> `@ub`(~(raw og 27) 3)
::
%+ expect-eq
!> 0b1111
!> `@ub`(~(raw og 11) 4)
::
%+ expect-eq
!> 0b100
!> `@ub`(~(raw og 11) 3)
::
==
::
++ test-raws
=/ rng ~(. og 7)
=^ a rng (rads:rng 4)
=^ b rng (rads:rng 4)
%+ expect-eq
!> [0b10 0b1]
!> [`@ub`a `@ub`b]
::
++ test-rad
;: weld
%+ expect-eq
!> 4
!> (~(rad og 5) 11)
::
%+ expect-eq
!> 2
!> (~(rad og 758.716.593) 11)
::
%+ expect-eq
!> 71.499
!> (~(rad og 1) 100.000)
::
==
::
++ test-rads
=/ rng ~(. og 7)
=^ a rng (rads:rng 10)
=^ b rng (rads:rng 10)
%+ expect-eq
!> [2 8]
!> [a b]
::
++ test-shaw
;: weld
%+ expect-eq
!> 0b11.0111
!> `@ub`(shaw 3 6 98)
::
%+ expect-eq
!> 0b11
!> `@ub`(shaw 2 6 98)
::
==
:: End SHA tests
--

View File

@ -25,6 +25,12 @@ class UrbitApi {
delete: this.chatViewDelete.bind(this),
join: this.chatViewJoin.bind(this),
};
this.invite = {
accept: this.inviteAccept.bind(this),
decline: this.inviteDecline.bind(this),
invite: this.inviteInvite.bind(this)
};
}
bind(path, method, ship = this.authTokens.ship, app, success, fail, quit) {
@ -138,6 +144,46 @@ class UrbitApi {
this.chatViewAction({ join: { ship, path } });
}
inviteAction(data) {
this.action("invite-store", "json", data);
}
inviteInvite(path, ship) {
this.action("invite-hook", "json",
{
invite: {
path: '/chat',
invite: {
path,
ship: `~${window.ship}`,
recipient: ship,
app: 'chat-hook',
text: `You have been invited to /${window.ship}${path}`,
},
uid: uuid()
}
}
);
}
inviteAccept(uid) {
this.inviteAction({
accept: {
path: '/chat',
uid
}
});
}
inviteDecline(uid) {
this.inviteAction({
decline: {
path: '/chat',
uid
}
});
}
}
export let api = new UrbitApi();

View File

@ -52,6 +52,11 @@ export class InviteElement extends Component {
members: ''
}, () => {
props.api.groups.add(aud, props.path);
if (props.permissions.kind === 'white') {
aud.forEach((ship) => {
props.api.invite.invite(props.station, ship);
});
}
});
}

View File

@ -4,20 +4,17 @@ import _ from 'lodash';
export class SidebarInvite extends Component {
onAccept() {
this.props.api.invite.accept(this.props.uid);
}
onDecline() {
this.props.api.invite.decline(this.props.uid);
}
render() {
const { props } = this;
let cir = _.get(props, 'msg.sep.inv.cir', false);
let aut = _.get(props, 'msg.aut', false);
if (!aut || !cir || !props.config) {
return (
<div></div>
);
}
cir = cir.split('/')[1];
return (
<div className='pa3'>
<div className='w-100 v-mid'>
@ -26,17 +23,12 @@ export class SidebarInvite extends Component {
width: 12,
height: 12
}}></div>
<p className="dib body-regular fw-normal">Invite to&nbsp;
<span className='fw-bold'>
{cir}
</span>
<p className="dib body-regular fw-normal">
{props.invite.text}
</p>
</div>
<div className="w-100">
<p className='dib gray label-small-mono'>Hosted by {aut}</p>
</div>
<a className="dib w-50 pointer btn-font nice-green underline" onClick={this.onAccept.bind(this)}>Accept</a>
<a className="dib w-50 tr pointer btn-font nice-red underline" onClick={this.onReject.bind(this)}>Reject</a>
<a className="dib w-50 tr pointer btn-font nice-red underline" onClick={this.onDecline.bind(this)}>Decline</a>
</div>
)
}

View File

@ -93,7 +93,7 @@ export class MemberScreen extends Component {
{ window.ship === deSig(props.match.params.ship) ? (
<InviteElement
path={`/chat${state.station}/write`}
station={state.station}
station={`/${props.match.params.station}`}
permissions={props.write}
api={props.api} />
) : null }
@ -111,6 +111,7 @@ export class MemberScreen extends Component {
{ window.ship === deSig(props.match.params.ship) ?
( <InviteElement
path={`/chat${state.station}/read`}
station={`/${props.match.params.station}`}
permissions={props.read}
api={props.api}/>
) : null

View File

@ -68,7 +68,6 @@ export class NewScreen extends Component {
return;
}
// TODO: send invites
let aud = [];
let isValid = true;
if (state.invites.length > 2) {
@ -123,6 +122,11 @@ export class NewScreen extends Component {
}, () => {
props.setSpinner(true);
props.api.chatView.create(station, state.security, readAud, writeAud);
aud.forEach((ship) => {
if (ship !== `~${window.ship}`) {
props.api.invite.invite(station, ship);
}
});
});
}

View File

@ -47,16 +47,16 @@ export class Root extends Component {
unreads[stat] = envelopes.length > state.inbox[stat].config.read;
});
let inviteConfig = false;
let invites = '/chat' in state.invites ?
state.invites['/chat'] : {};
const renderChannelSidebar = (props) => (
<Sidebar
inbox={state.inbox}
messagePreviews={messagePreviews}
invites={[]}
invites={invites}
unreads={unreads}
api={api}
inviteConfig={inviteConfig}
{...props}
/>
);

View File

@ -3,18 +3,12 @@ import { Link } from "react-router-dom";
import classnames from 'classnames';
import _ from 'lodash';
import { SidebarInvite } from '/components/lib/sidebar-invite';
import { SidebarItem } from '/components/lib/sidebar-item';
export class Sidebar extends Component {
componentWillUnmount() {
if (this.setInvitesToReadInterval) {
clearInterval(this.setInvitesToReadInterval);
this.setInvitesToReadInterval = null;
}
}
onClickNew() {
this.props.history.push('/~chat/new');
}
@ -23,6 +17,16 @@ export class Sidebar extends Component {
const { props, state } = this;
let station = `/${props.match.params.ship}/${props.match.params.station}`;
let sidebarInvites = Object.keys(props.invites)
.map((uid) => {
return (
<SidebarInvite
uid={uid}
invite={props.invites[uid]}
api={props.api} />
);
});
let sidebarItems = Object.keys(props.inbox)
.map((box) => {
let msg = props.messagePreviews[box];
@ -73,6 +77,7 @@ export class Sidebar extends Component {
<div className="overflow-y-auto" style={{
height: 'calc(100vh - 60px - 48px)'
}}>
{sidebarInvites}
{sidebarItems}
</div>
</div>

View File

@ -8,7 +8,7 @@ export class InviteUpdateReducer {
this.create(data, state);
this.delete(data, state);
this.invite(data, state);
this.accept(data, state);
this.accepted(data, state);
this.decline(data, state);
}
}
@ -34,9 +34,10 @@ export class InviteUpdateReducer {
}
}
accept(json, state) {
let data = _.get(json, 'accept', false);
accepted(json, state) {
let data = _.get(json, 'accepted', false);
if (data) {
console.log(data);
delete state.invites[data.path][data.uid];
}
}

View File

@ -18,6 +18,10 @@ export class Subscription {
this.handleEvent.bind(this),
this.handleError.bind(this),
this.handleQuitAndResubscribe.bind(this));
api.bind('/primary', 'PUT', api.authTokens.ship, 'invite-view',
this.handleEvent.bind(this),
this.handleError.bind(this),
this.handleQuitAndResubscribe.bind(this));
api.bind('/all', 'PUT', api.authTokens.ship, 'group-store',
this.handleEvent.bind(this),
this.handleError.bind(this),

View File

@ -2075,6 +2075,8 @@ u3_pier_tank(c3_l tab_l, c3_w pri_w, u3_noun tac)
fprintf(fil_u, "\033[0m");
}
fflush(fil_u);
u3_term_io_loja(0);
u3z(blu);
u3z(tac);

View File

@ -2,7 +2,7 @@
set -e
sha=$(git rev-parse $(git branch --show-current))
sha=$(git rev-parse HEAD)
brass=$(nix-build nix/ops -A brass-ropsten --no-out-link)
ivory=$(nix-build nix/ops -A ivory-ropsten --no-out-link)