urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-24 13:06:09 +03:00
Code Issues Packages Projects Releases Wiki Activity

spider: rename thread -> strand, imp -> thread

Browse Source
This commit is contained in:
Philip Monk 2019-11-16 03:25:30 -08:00
parent c1b0bd63e4
commit 7837d51aba
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
46 changed files with 636 additions and 1437 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkg/arvo/age/aqua.hoon
View File

@ -391,7 +391,7 @@
[%swap-files ~]
=. userspace-ova.pil
=/ slim-dirs=(list path)
~[/app /age /imp /gen /lib /mar /sur /hoon/sys /arvo/sys /zuse/sys]
~[/app /age /ted /gen /lib /mar /sur /hoon/sys /arvo/sys /zuse/sys]
:_ ~
%- unix-event
%- %*(. file-ovum:pill-lib directories slim-dirs)

24
pkg/arvo/age/dojo.hoon
View File

@ -64,7 +64,7 @@
$~ [%ex *hoon]
$% {$ur p/@t} :: http GET request
{$ge p/dojo-model} :: generator
{$im p/term q/(list dojo-source)} :: imp
{$te p/term q/(list dojo-source)} :: thread
{$dv p/path} :: core from source
{$ex p/hoon} :: hoon expression
{$sa p/mark} :: example mark value
@ -205,7 +205,7 @@
;~ pose
;~(plug (cold %ur lus) parse-url)
;~(plug (cold %ge lus) parse-model)
;~(plug (cold %im hep) sym (star ;~(pfix ace parse-source)))
;~(plug (cold %te hep) sym (star ;~(pfix ace parse-source)))
;~(plug (cold %as pad) sym ;~(pfix ace parse-source))
;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source))
parse-value
@ -344,7 +344,7 @@
=< he-diff
%- he-card
?: =(/wool u.pux)
:: really shoud stop the imp as well
:: really shoud stop the thread as well
::
[%pass u.pux %agent [our.hid %spider] %leave ~]
[%pass u.pux %arvo %f %kill ~]
@ -404,7 +404,7 @@
$as =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
$do =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$])
$ge =^(mod +>.$ (dy-init-model p.bul) [[%ge mod] +>.$])
$im =^(mod +>.$ (dy-init-ordered q.bul) [bul(q mod) +>.$])
$te =^(mod +>.$ (dy-init-ordered q.bul) [bul(q mod) +>.$])
$ur [bul +>.$]
$tu =^(dof +>.$ (dy-init-ordered p.bul) [[%tu dof] +>.$])
==
@ -728,14 +728,14 @@
|= [fil=term src=(list dojo-source)]
^+ +>+>
?> ?=(~ pux)
=/ iid (scot %ta (cat 3 'dojo_' (scot %uv (sham eny.hid))))
=/ tid (scot %ta (cat 3 'dojo_' (scot %uv (sham eny.hid))))
=. poy `+>+<.$(pux `/wool)
=. +>+>.$
%- he-card
[%pass /wool %agent [our.hid %spider] %watch /imp-result/[iid]]
[%pass /wool %agent [our.hid %spider] %watch /thread-result/[tid]]
%- he-card
=/ =cage :: also sub
[%spider-start !>([~ `iid fil (dy-sore src)])]
[%spider-start !>([~ `tid fil (dy-sore src)])]
[%pass /wool %agent [our.hid %spider] %poke cage]
::
++ dy-make :: build step
@ -744,7 +744,7 @@
=+ bil=q.u.cud :: XX =*
?: ?=($ur -.bil)
(dy-request /hand `request:http`[%'GET' p.bil ~ ~])
?: ?=($im -.bil)
?: ?=($te -.bil)
(dy-wool-poke p.bil q.bil)
%- dy-ford
^- [path schematic:ford]
@ -933,12 +933,12 @@
(he-diff(poy ~) %tan u.p.sign)
::
%fact
?+ p.cage.sign ~|([%dojo-imp-bad-mark-result p.cage.sign] !!)
%imp-fail
?+ p.cage.sign ~|([%dojo-thread-bad-mark-result p.cage.sign] !!)
%thread-fail
=+ !<([=term =tang] q.cage.sign)
(he-diff(poy ~) %tan leaf+"imp failed: {<term>}" tang)
(he-diff(poy ~) %tan leaf+"thread failed: {<term>}" tang)
::
%imp-done
%thread-done
?> ?=(^ poy)
(~(dy-hand dy u.poy(pux ~)) %noun q.cage.sign)
==

22
pkg/arvo/age/eth-watcher.hoon
View File

@ -19,7 +19,7 @@
+$ context [=path dog=watchdog]
+$ watchdog
$: config
running=(unit =iid:spider)
running=(unit =tid:spider)
=number:block
=pending-logs
=history
@ -169,14 +169,14 @@
%poke-ack
?~ p.sign
[~ this]
%- (slog leaf+"eth-watcher couldn't start imp" u.p.sign)
%- (slog leaf+"eth-watcher couldn't start thread" u.p.sign)
:_ (clear-running t.wire) :_ ~
(leave-spider t.wire our.bowl)
::
%watch-ack
?~ p.sign
[~ this]
%- (slog leaf+"eth-watcher couldn't start listen to imp" u.p.sign)
%- (slog leaf+"eth-watcher couldn't start listen to thread" u.p.sign)
[~ (clear-running t.wire)]
::
%kick [~ (clear-running t.wire)]
@ -186,12 +186,12 @@
?~ dog
[~ this]
?+ p.cage.sign (on-agent:def wire sign)
%imp-fail
%thread-fail
=+ !<([=term =tang] q.cage.sign)
%- (slog leaf+"eth-watcher failed; will retry" leaf+<term> tang)
[~ this(dogs.state (~(put by dogs.state) path u.dog(running ~)))]
::
%imp-done
%thread-done
=+ !<([vows=disavows pup=watchpup] q.cage.sign)
=. u.dog
%_ u.dog
@ -286,7 +286,7 @@
::
=/ dogs=(list [=path dog=watchdog]) ~(tap by dogs.state)
=| cards=(list card)
=/ iid-gen ~(. og eny.bowl)
=/ tid-gen ~(. og eny.bowl)
^- (quip card agent:mall)
=- [(flop -<) ->]
|- ^- (quip card agent:mall)
@ -306,14 +306,14 @@
==
loop(i.dogs i.dogs(running.dog ~))
::
=^ rand iid-gen (raws:iid-gen 128)
=/ new-iid (cat 3 'eth-watcher--' (scot %uv rand))
=> .(running.dog.i.dogs `new-iid)
=^ rand tid-gen (raws:tid-gen 128)
=/ new-tid (cat 3 'eth-watcher--' (scot %uv rand))
=> .(running.dog.i.dogs `new-tid)
=/ args
:^ ~ `new-iid %eth-watcher
:^ ~ `new-tid %eth-watcher
!>(`watchpup`[- number pending-logs blocks]:dog)
=. cards
:* (watch-spider path our.bowl /imp-result/[new-iid])
:* (watch-spider path our.bowl /thread-result/[new-tid])
(poke-spider path our.bowl %spider-start !>(args))
cards
==

416
pkg/arvo/age/spider.hoon
View File

@ -1,104 +1,104 @@
/- spider
/+ libthread=thread, default-agent, verb
=, thread=thread:libthread
/+ libstrand=strand, default-agent, verb
=, strand=strand:libstrand
|%
+$ card card:agent:mall
+$ imp-thread imp:spider
+$ iid iid:spider
+$ imput imput:spider
+$ imp (list iid)
+$ imp-form _*eval-form:eval:(thread ,vase)
+$ card card:agent:mall
+$ thread thread:spider
+$ tid tid:spider
+$ input input:spider
+$ yarn (list tid)
+$ thread-form _*eval-form:eval:(strand ,vase)
+$ trie
$~ [*imp-form ~]
[=imp-form kid=(map iid trie)]
$~ [*thread-form ~]
[=thread-form kid=(map tid trie)]
::
+$ trying ?(%find %build %none)
+$ state
$: starting=(map imp [=trying =vase])
$: starting=(map yarn [=trying =vase])
running=trie
iid=(map iid imp)
tid=(map tid yarn)
==
::
+$ clean-slate
$: starting=(map imp [=trying =vase])
running=(list imp)
iid=(map iid imp)
$: starting=(map yarn [=trying =vase])
running=(list yarn)
tid=(map tid yarn)
==
::
+$ start-args
[parent=(unit iid) use=(unit iid) file=term =vase]
[parent=(unit tid) use=(unit tid) file=term =vase]
--
::
:: Trie operations
::
|%
++ get-imp
|= [=trie =imp]
^- (unit =imp-form)
?~ imp
`imp-form.trie
=/ son (~(get by kid.trie) i.imp)
++ get-yarn
|= [=trie =yarn]
^- (unit =thread-form)
?~ yarn
`thread-form.trie
=/ son (~(get by kid.trie) i.yarn)
?~ son
~
$(trie u.son, imp t.imp)
$(trie u.son, yarn t.yarn)
::
++ get-imp-children
|= [=trie =imp]
^- (list ^imp)
?~ imp
(turn (tap-imp trie) head)
=/ son (~(get by kid.trie) i.imp)
++ get-yarn-children
|= [=trie =yarn]
^- (list ^yarn)
?~ yarn
(turn (tap-yarn trie) head)
=/ son (~(get by kid.trie) i.yarn)
?~ son
~
$(trie u.son, imp t.imp)
$(trie u.son, yarn t.yarn)
::
::
++ has-imp
|= [=trie =imp]
!=(~ (get-imp trie imp))
++ has-yarn
|= [=trie =yarn]
!=(~ (get-yarn trie yarn))
::
++ put-imp
|= [=trie =imp =imp-form]
++ put-yarn
|= [=trie =yarn =thread-form]
^+ trie
?~ imp
trie(imp-form imp-form)
=/ son (~(gut by kid.trie) i.imp [*^imp-form ~])
?~ yarn
trie(thread-form thread-form)
=/ son (~(gut by kid.trie) i.yarn [*^thread-form ~])
%= trie
kid
%+ ~(put by kid.trie) i.imp
$(trie son, imp t.imp)
%+ ~(put by kid.trie) i.yarn
$(trie son, yarn t.yarn)
==
::
++ del-imp
|= [=trie =imp]
++ del-yarn
|= [=trie =yarn]
^+ trie
?~ imp
?~ yarn
trie
|-
?~ t.imp
trie(kid (~(del by kid.trie) i.imp))
=/ son (~(get by kid.trie) i.imp)
?~ t.yarn
trie(kid (~(del by kid.trie) i.yarn))
=/ son (~(get by kid.trie) i.yarn)
?~ son
trie
%= trie
kid
%+ ~(put by kid.trie) i.imp
$(trie u.son, imp t.imp)
%+ ~(put by kid.trie) i.yarn
$(trie u.son, yarn t.yarn)
==
::
++ tap-imp
=| =imp
++ tap-yarn
=| =yarn
|= =trie
^- (list [=^imp =imp-form])
^- (list [=^yarn =thread-form])
%+ welp
?~ imp
?~ yarn
~
[(flop imp) imp-form.trie]~
[(flop yarn) thread-form.trie]~
=/ kids ~(tap by kid.trie)
|- ^- (list [=^imp =imp-form])
|- ^- (list [=^yarn =thread-form])
?~ kids
~
=/ next-1 ^$(imp [p.i.kids imp], trie q.i.kids)
=/ next-1 ^$(yarn [p.i.kids yarn], trie q.i.kids)
=/ next-2 $(kids t.kids)
(welp next-1 next-2)
--
@ -118,17 +118,17 @@
++ on-load
|= old-state=vase
=+ !<(=clean-slate old-state)
=. iid.state iid.clean-slate
=/ imps=(list imp)
=. tid.state tid.clean-slate
=/ yarns=(list yarn)
%+ welp running.clean-slate
~(tap in ~(key by starting.clean-slate))
|- ^- (quip card _this)
?~ imps
?~ yarns
`this
=^ cards-1 state
(handle-stop-imp:sc (imp-to-iid i.imps) |)
(handle-stop-thread:sc (yarn-to-tid i.yarns) |)
=^ cards-2 this
$(imps t.imps)
$(yarns t.yarns)
[(weld cards-1 cards-2) this]
::
++ on-poke
@ -136,9 +136,9 @@
^- (quip card _this)
=^ cards state
?+ mark (on-poke:def mark vase)
%spider-imput (on-poke-imput:sc !<(imput vase))
%spider-start (handle-start-imp:sc !<(start-args vase))
%spider-stop (handle-stop-imp:sc !<([iid ?] vase))
%spider-input (on-poke-input:sc !<(input vase))
%spider-start (handle-start-thread:sc !<(start-args vase))
%spider-stop (handle-stop-thread:sc !<([tid ?] vase))
==
[cards this]
::
@ -147,8 +147,8 @@
^- (quip card _this)
=^ cards state
?+ path (on-watch:def path)
[%imp @ *] (on-watch:sc t.path)
[%imp-result @ ~] (on-watch-result:sc i.t.path)
[%thread @ *] (on-watch:sc t.path)
[%thread-result @ ~] (on-watch-result:sc i.t.path)
==
[cards this]
::
@ -158,13 +158,13 @@
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %tree ~]
``noun+!>((turn (tap-imp running.state) head))
``noun+!>((turn (tap-yarn running.state) head))
::
[%x %starting @ ~]
``noun+!>((has-imp running.state (~(got by iid.state) i.t.t.path)))
``noun+!>((has-yarn running.state (~(got by tid.state) i.t.t.path)))
::
[%x %saxo @ ~]
``noun+!>((~(got by iid.state) i.t.t.path))
``noun+!>((~(got by tid.state) i.t.t.path))
==
::
++ on-agent
@ -172,7 +172,7 @@
^- (quip card _this)
=^ cards state
?+ wire !!
[%imp @ *] (on-agent:sc i.t.wire t.t.wire sign)
[%thread @ *] (on-agent:sc i.t.wire t.t.wire sign)
==
[cards this]
::
@ -181,265 +181,265 @@
^- (quip card _this)
=^ cards state
?+ wire (on-arvo:def wire sign-arvo)
[%imp @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
[%find @ ~] (handle-find:sc i.t.wire sign-arvo)
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
[%thread @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo)
[%find @ ~] (handle-find:sc i.t.wire sign-arvo)
[%build @ ~] (handle-build:sc i.t.wire sign-arvo)
==
[cards this]
:: On unexpected failure, kill all outstanding threads
:: On unexpected failure, kill all outstanding strands
::
++ on-fail
|= [=term =tang]
^- (quip card _this)
%- (slog leaf+"spider crashed, killing all threads: {<term>}" tang)
%- (slog leaf+"spider crashed, killing all strands: {<term>}" tang)
(on-load on-save)
--
::
|_ =bowl:mall
++ on-poke-imput
|= imput
=/ imp (~(got by iid.state) iid)
(take-input imp ~ %poke cage)
++ on-poke-input
|= input
=/ yarn (~(got by tid.state) tid)
(take-input yarn ~ %poke cage)
::
++ on-watch
|= [=iid =path]
(take-input (~(got by iid.state) iid) ~ %watch path)
|= [=tid =path]
(take-input (~(got by tid.state) tid) ~ %watch path)
::
++ on-watch-result
|= =iid
|= =tid
^- (quip card ^state)
`state
::
++ handle-sign
|= [=iid =wire =sign-arvo]
=/ imp (~(get by iid.state) iid)
?~ imp
%- (slog leaf+"spider got sign for non-existent {<iid>}" ~)
|= [=tid =wire =sign-arvo]
=/ yarn (~(get by tid.state) tid)
?~ yarn
%- (slog leaf+"spider got sign for non-existent {<tid>}" ~)
`state
(take-input u.imp ~ %sign wire sign-arvo)
(take-input u.yarn ~ %sign wire sign-arvo)
::
++ on-agent
|= [=iid =wire =sign:agent:mall]
=/ imp (~(get by iid.state) iid)
?~ imp
%- (slog leaf+"spider got agent for non-existent {<iid>}" ~)
|= [=tid =wire =sign:agent:mall]
=/ yarn (~(get by tid.state) tid)
?~ yarn
%- (slog leaf+"spider got agent for non-existent {<tid>}" ~)
`state
(take-input u.imp ~ %agent wire sign)
(take-input u.yarn ~ %agent wire sign)
::
++ handle-start-imp
|= [parent-iid=(unit iid) use=(unit iid) file=term =vase]
++ handle-start-thread
|= [parent-tid=(unit tid) use=(unit tid) file=term =vase]
^- (quip card ^state)
=/ parent-imp=imp
?~ parent-iid
=/ parent-yarn=yarn
?~ parent-tid
/
(~(got by iid.state) u.parent-iid)
=/ new-iid (fall use (scot %uv (sham eny.bowl)))
=/ =imp (snoc parent-imp new-iid)
(~(got by tid.state) u.parent-tid)
=/ new-tid (fall use (scot %uv (sham eny.bowl)))
=/ =yarn (snoc parent-yarn new-tid)
::
?: (has-imp running.state imp)
~| [%already-started imp]
?: (has-yarn running.state yarn)
~| [%already-started yarn]
!!
?: (~(has by starting.state) imp)
~| [%already-starting imp]
?: (~(has by starting.state) yarn)
~| [%already-starting yarn]
!!
::
=: starting.state (~(put by starting.state) imp [%find vase])
iid.state (~(put by iid.state) new-iid imp)
=: starting.state (~(put by starting.state) yarn [%find vase])
tid.state (~(put by tid.state) new-tid yarn)
==
=/ =card
=/ =schematic:ford [%path [our.bowl %home] %imp file]
[%pass /find/[new-iid] %arvo %f %build live=%.n schematic]
=/ =schematic:ford [%path [our.bowl %home] %ted file]
[%pass /find/[new-tid] %arvo %f %build live=%.n schematic]
[[card ~] state]
::
++ handle-find
|= [=iid =sign-arvo]
|= [=tid =sign-arvo]
^- (quip card ^state)
=/ =imp (~(got by iid.state) iid)
=/ =yarn (~(got by tid.state) tid)
=. starting.state
(~(jab by starting.state) imp |=([=trying =vase] [%none vase]))
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
(imp-fail-not-running iid %find-imp-incomplete tang.result.sign-arvo)
(thread-fail-not-running tid %find-thread-incomplete tang.result.sign-arvo)
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
(imp-fail-not-running iid %find-imp-error message.build-result)
(thread-fail-not-running tid %find-thread-error message.build-result)
?. ?=([%path *] +.build-result)
(imp-fail-not-running iid %find-imp-strange ~)
(thread-fail-not-running tid %find-thread-strange ~)
=. starting.state
(~(jab by starting.state) imp |=([=trying =vase] [%build vase]))
(~(jab by starting.state) yarn |=([=trying =vase] [%build vase]))
=/ =card
=/ =schematic:ford [%core rail.build-result]
[%pass /build/[iid] %arvo %f %build live=%.n schematic]
[%pass /build/[tid] %arvo %f %build live=%.n schematic]
[[card ~] state]
::
++ handle-build
|= [=iid =sign-arvo]
|= [=tid =sign-arvo]
^- (quip card ^state)
=/ =imp (~(got by iid.state) iid)
=/ =yarn (~(got by tid.state) tid)
=. starting.state
(~(jab by starting.state) imp |=([=trying =vase] [%none vase]))
(~(jab by starting.state) yarn |=([=trying =vase] [%none vase]))
?> ?=([%f %made *] sign-arvo)
?: ?=(%incomplete -.result.sign-arvo)
(imp-fail-not-running iid %build-imp-incomplete tang.result.sign-arvo)
(thread-fail-not-running tid %build-thread-incomplete tang.result.sign-arvo)
=/ =build-result:ford build-result.result.sign-arvo
?: ?=(%error -.build-result)
(imp-fail-not-running iid %build-imp-error message.build-result)
(thread-fail-not-running tid %build-thread-error message.build-result)
=/ =cage (result-to-cage:ford build-result)
?. ?=(%noun p.cage)
(imp-fail-not-running iid %build-imp-strange >p.cage< ~)
=/ maybe-imp (mule |.(!<(imp-thread q.cage)))
?: ?=(%| -.maybe-imp)
(imp-fail-not-running iid %imp-not-imp ~)
(start-imp imp p.maybe-imp)
(thread-fail-not-running tid %build-thread-strange >p.cage< ~)
=/ maybe-thread (mule |.(!<(thread q.cage)))
?: ?=(%| -.maybe-thread)
(thread-fail-not-running tid %thread-not-thread ~)
(start-thread yarn p.maybe-thread)
::
++ start-imp
|= [=imp =imp-thread]
++ start-thread
|= [=yarn =thread]
^- (quip card ^state)
=/ =vase vase:(~(got by starting.state) imp)
?< (has-imp running.state imp)
=/ m (thread ,^vase)
=/ res (mule |.((imp-thread vase)))
=/ =vase vase:(~(got by starting.state) yarn)
?< (has-yarn running.state yarn)
=/ m (strand ,^vase)
=/ res (mule |.((thread vase)))
?: ?=(%| -.res)
(imp-fail-not-running (imp-to-iid imp) %false-start p.res)
(thread-fail-not-running (yarn-to-tid yarn) %false-start p.res)
=/ =eval-form:eval:m
(from-form:eval:m p.res)
=: starting.state (~(del by starting.state) imp)
running.state (put-imp running.state imp eval-form)
=: starting.state (~(del by starting.state) yarn)
running.state (put-yarn running.state yarn eval-form)
==
(take-input imp ~)
(take-input yarn ~)
::
++ handle-stop-imp
|= [=iid nice=?]
++ handle-stop-thread
|= [=tid nice=?]
^- (quip card ^state)
=/ =imp (~(got by iid.state) iid)
?: (has-imp running.state imp)
=/ =yarn (~(got by tid.state) tid)
?: (has-yarn running.state yarn)
?: nice
(imp-done imp *vase)
(imp-fail imp %cancelled ~)
?: (~(has by starting.state) imp)
(imp-fail-not-running iid %stopped-before-started ~)
~& [%imp-not-started imp]
(thread-done yarn *vase)
(thread-fail yarn %cancelled ~)
?: (~(has by starting.state) yarn)
(thread-fail-not-running tid %stopped-before-started ~)
~& [%thread-not-started yarn]
`state
::
++ take-input
|= [=imp input=(unit input:thread)]
|= [=yarn input=(unit input:strand)]
^- (quip card ^state)
=/ m (thread ,vase)
?. (has-imp running.state imp)
%- (slog leaf+"spider got input for non-existent {<imp>} 2" ~)
=/ m (strand ,vase)
?. (has-yarn running.state yarn)
%- (slog leaf+"spider got input for non-existent {<yarn>} 2" ~)
`state
=/ =eval-form:eval:m
imp-form:(need (get-imp running.state imp))
thread-form:(need (get-yarn running.state yarn))
=| cards=(list card)
|- ^- (quip card ^state)
=^ r=[cards=(list card) =eval-result:eval:m] eval-form
=/ out
%- mule |.
(take:eval:m eval-form (convert-bowl imp bowl) input)
(take:eval:m eval-form (convert-bowl yarn bowl) input)
?- -.out
%& p.out
%| [[~ [%fail %crash p.out]] eval-form]
==
=. running.state (put-imp running.state imp eval-form)
=/ =iid (imp-to-iid imp)
=. running.state (put-yarn running.state yarn eval-form)
=/ =tid (yarn-to-tid yarn)
=. cards.r
%+ turn cards.r
|= =card
^- ^card
?+ card card
[%pass * *] [%pass [%imp iid p.card] q.card]
[%pass * *] [%pass [%thread tid p.card] q.card]
[%give %fact *]
?~ path.p.card
card
card(path.p `[%imp iid u.path.p.card])
card(path.p `[%thread tid u.path.p.card])
::
[%give %kick *]
?~ path.p.card
card
card(path.p `[%imp iid u.path.p.card])
card(path.p `[%thread tid u.path.p.card])
==
=. cards (weld cards cards.r)
=^ final-cards=(list card) state
?- -.eval-result.r
%next `state
%fail (imp-fail imp err.eval-result.r)
%done (imp-done imp value.eval-result.r)
%fail (thread-fail yarn err.eval-result.r)
%done (thread-done yarn value.eval-result.r)
==
[(weld cards final-cards) state]
::
++ imp-fail-not-running
|= [=iid =term =tang]
=/ =imp (~(got by iid.state) iid)
:_ state(starting (~(del by starting.state) imp))
%- welp :_ (imp-say-fail iid term tang)
=/ =trying trying:(~(got by starting.state) imp)
++ thread-fail-not-running
|= [=tid =term =tang]
=/ =yarn (~(got by tid.state) tid)
:_ state(starting (~(del by starting.state) yarn))
%- welp :_ (thread-say-fail tid term tang)
=/ =trying trying:(~(got by starting.state) yarn)
?- trying
%find [%pass /find/[iid] %arvo %f %kill ~]~
%build [%pass /build/[iid] %arvo %f %kill ~]~
%find [%pass /find/[tid] %arvo %f %kill ~]~
%build [%pass /build/[tid] %arvo %f %kill ~]~
%none ~
==
::
++ imp-say-fail
|= [=iid =term =tang]
++ thread-say-fail
|= [=tid =term =tang]
^- (list card)
:~ [%give %fact `/imp-result/[iid] %imp-fail !>([term tang])]
[%give %kick `/imp-result/[iid] ~]
:~ [%give %fact `/thread-result/[tid] %thread-fail !>([term tang])]
[%give %kick `/thread-result/[tid] ~]
==
::
++ imp-fail
|= [=imp =term =tang]
++ thread-fail
|= [=yarn =term =tang]
^- (quip card ^state)
%- (slog leaf+"thread {<imp>} failed" leaf+<term> tang)
=/ =iid (imp-to-iid imp)
=/ fail-cards (imp-say-fail iid term tang)
=^ cards state (imp-clean imp)
%- (slog leaf+"strand {<yarn>} failed" leaf+<term> tang)
=/ =tid (yarn-to-tid yarn)
=/ fail-cards (thread-say-fail tid term tang)
=^ cards state (thread-clean yarn)
[(weld fail-cards cards) state]
::
++ imp-done
|= [=imp =vase]
++ thread-done
|= [=yarn =vase]
^- (quip card ^state)
:: %- (slog leaf+"thread {<imp>} finished" (sell vase) ~)
=/ =iid (imp-to-iid imp)
:: %- (slog leaf+"strand {<yarn>} finished" (sell vase) ~)
=/ =tid (yarn-to-tid yarn)
=/ done-cards=(list card)
:~ [%give %fact `/imp-result/[iid] %imp-done vase]
[%give %kick `/imp-result/[iid] ~]
:~ [%give %fact `/thread-result/[tid] %thread-done vase]
[%give %kick `/thread-result/[tid] ~]
==
=^ cards state (imp-clean imp)
=^ cards state (thread-clean yarn)
[(weld done-cards cards) state]
::
++ imp-clean
|= =imp
++ thread-clean
|= =yarn
^- (quip card ^state)
=/ children=(list ^imp)
[imp (get-imp-children running.state imp)]
=/ children=(list ^yarn)
[yarn (get-yarn-children running.state yarn)]
|- ^- (quip card ^state)
?~ children
`state
=^ cards-children state $(children t.children)
=^ cards-our state
=/ =^imp i.children
=/ =iid (imp-to-iid imp)
=: running.state (del-imp running.state imp)
iid.state (~(del by iid.state) iid)
=/ =^yarn i.children
=/ =tid (yarn-to-tid yarn)
=: running.state (del-yarn running.state yarn)
tid.state (~(del by tid.state) tid)
==
:_ state
%+ murn ~(tap by wex.bowl)
|= [[=wire =ship =term] [acked=? =path]]
^- (unit card)
?. ?& ?=([%imp @ *] wire)
=(iid i.t.wire)
?. ?& ?=([%thread @ *] wire)
=(tid i.t.wire)
==
~
`[%pass wire %agent [ship term] %leave ~]
[(welp cards-children cards-our) state]
::
++ convert-bowl
|= [=imp =bowl:mall]
|= [=yarn =bowl:mall]
^- bowl:spider
:* our.bowl
src.bowl
(imp-to-iid imp)
(imp-to-parent imp)
(yarn-to-tid yarn)
(yarn-to-parent yarn)
wex.bowl
sup.bowl
eny.bowl
@ -447,23 +447,23 @@
byk.bowl
==
::
++ imp-to-iid
|= =imp
^- iid
=/ fimp (flop imp)
?> ?=([@ *] fimp)
i.fimp
++ yarn-to-tid
|= =yarn
^- tid
=/ nary (flop yarn)
?> ?=([@ *] nary)
i.nary
::
++ imp-to-parent
|= =imp
^- (unit iid)
=/ fimp (flop imp)
?> ?=([@ *] fimp)
?~ t.fimp
++ yarn-to-parent
|= =yarn
^- (unit tid)
=/ nary (flop yarn)
?> ?=([@ *] nary)
?~ t.nary
~
`i.t.fimp
`i.t.nary
::
++ clean-state
!> ^- clean-slate
state(running (turn (tap-imp running.state) head))
state(running (turn (tap-yarn running.state) head))
--

4
pkg/arvo/gen/spider/stop.hoon
View File

@ -1,3 +1,3 @@
:- %say
|= [* [name=term ~] ~]
[%spider-stop name |]
|= [* [tid=@ta ~] ~]
[%spider-stop tid |]

8
pkg/arvo/gen/spider/tree.hoon
View File

@ -3,9 +3,7 @@
|= [[now=@da *] ~ *]
:- %tang
=/ tree
.^((list (list @ud)) %mx /=spider/(scot %da now)/tree/noun)
.^((list (list tid:spider)) %mx /=spider/(scot %da now)/tree/noun)
%+ turn tree
|= imp=(list @ud)
=/ =path
(turn imp |=(=@ud (scot %ud ud)))
>path<
|= yarn=(list tid:spider)
>`path`yarn<

10
pkg/arvo/imp/first.hoon
View File

@ -1,10 +0,0 @@
/- spider
/+ threadio
=, thread=thread:spider
^- imp:spider
|= vase
=/ m (thread ,vase)
^- form:m
~& > %first-starting
;< ~ bind:m echo:threadio
(pure:m *vase)

12
pkg/arvo/imp/time.hoon
View File

@ -1,12 +0,0 @@
/- spider
/+ threadio
=, thread=thread:spider
^- imp:spider
|= arg=vase
=/ m (thread ,vase)
^- form:m
=+ !<([arg=@dr ~] arg)
;< now-1=@da bind:m get-time:threadio
;< ~ bind:m (sleep:threadio arg)
;< now-2=@da bind:m get-time:threadio
(pure:m !>(`@dr`(sub now-2 now-1)))

32
pkg/arvo/lib/aqua-vane-imp.hoon → pkg/arvo/lib/aqua-vane-thread.hoon
View File

@ -1,6 +1,6 @@
/- spider, *aquarium
/+ ph-io, threadio
=, thread=thread:spider
/+ ph-io, strandio
=, strand=strand:spider
|%
++ vane-handler
$_ ^|
@ -17,27 +17,27 @@
::
=; core
|= handler=vane-handler
^- imp:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
^- form:m
;< ~ bind:m (watch-our:threadio /effects %aqua /effect)
;< ~ bind:m (watch-our:strandio /effects %aqua /effect)
;< ~ bind:m
%- (main-loop:threadio ,_handler)
%- (main-loop:strandio ,_handler)
:~ handle-unix-effect:core
handle-arvo-response:core
pure:(thread ,vane-handler)
pure:(strand ,vane-handler)
==
(pure:m *vase)
::
|%
++ handle-unix-effect
|= handler=vane-handler
=/ m (thread ,vane-handler)
=/ m (strand ,vane-handler)
^- form:m
;< [her=ship =unix-effect] bind:m
((handle:threadio ,[ship unix-effect]) take-unix-effect:ph-io)
;< =bowl:spider bind:m get-bowl:threadio
((handle:strandio ,[ship unix-effect]) take-unix-effect:ph-io)
;< =bowl:spider bind:m get-bowl:strandio
=^ cards handler
(~(handle-unix-effect handler bowl) her unix-effect)
?~ cards
@ -45,19 +45,19 @@
:: send in next event to avoid inverting subscription flow. real
:: solution is probably for gall to drip subscription updates.
::
;< ~ bind:m (sleep:threadio ~s0)
;< ~ bind:m (send-raw-cards:threadio cards)
;< ~ bind:m (sleep:strandio ~s0)
;< ~ bind:m (send-raw-cards:strandio cards)
(pure:m handler)
::
++ handle-arvo-response
|= handler=vane-handler
=/ m (thread ,vane-handler)
=/ m (strand ,vane-handler)
^- form:m
;< [=wire =sign-arvo] bind:m
((handle:threadio ,[wire sign-arvo]) take-sign-arvo:threadio)
;< =bowl:spider bind:m get-bowl:threadio
((handle:strandio ,[wire sign-arvo]) take-sign-arvo:strandio)
;< =bowl:spider bind:m get-bowl:strandio
=^ cards handler
(~(handle-arvo-response handler bowl) wire sign-arvo)
;< ~ bind:m (send-raw-cards:threadio cards)
;< ~ bind:m (send-raw-cards:strandio cards)
(pure:m handler)
--

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

@ -1,11 +1,11 @@
/+ threadio
=, thread=thread:threadio
/+ strandio
=, strand=strand:strandio
=, able:jael
|%
++ tract azimuth:contracts:azimuth
++ fetch-point
|= [url=@ta who=ship]
=/ m (thread ,point:azimuth)
=/ m (strand ,point:azimuth)
^- form:m
=/ =request:rpc:ethereum
:+ %eth-call
@ -31,10 +31,10 @@
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (thread ,json)
=/ m (strand ,json)
^- form:m
%+ (retry json) `10
=/ m (thread ,(unit json))
=/ m (strand ,(unit json))
^- form:m
|^
=/ =request:http
@ -46,16 +46,16 @@
%- en-json:html
(request-to-json:rpc:ethereum id req)
==
;< ~ bind:m (send-request:threadio request)
;< ~ bind:m (send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:threadio
take-maybe-response:strandio
?~ rep
(pure:m ~)
(parse-response u.rep)
::
++ parse-response
|= =client-response:iris
=/ m (thread ,(unit json))
=/ m (strand ,(unit json))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
@ -70,13 +70,13 @@
?~ array
=/ res=(unit response:rpc:jstd) (parse-one-response u.jon)
?~ res
(thread-fail:threadio %request-rpc-parse-error >id< ~)
(strand-fail:strandio %request-rpc-parse-error >id< ~)
?: ?=(%error -.u.res)
(thread-fail:threadio %request-rpc-error >id< >+.res< ~)
(strand-fail:strandio %request-rpc-error >id< >+.res< ~)
?. ?=(%result -.u.res)
(thread-fail:threadio %request-rpc-fail >u.res< ~)
(strand-fail:strandio %request-rpc-fail >u.res< ~)
(pure:m `res.u.res)
(thread-fail:threadio %request-rpc-batch >%not-implemented< ~)
(strand-fail:strandio %request-rpc-batch >%not-implemented< ~)
:: (pure:m `[%batch u.array])
::
++ parse-one-response
@ -96,14 +96,14 @@
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(thread (unit result))]
=/ m (thread ,result)
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
=/ m (strand ,result)
=| try=@ud
|- ^- form:m
=* loop $
?: =(crash-after `try)
(thread-fail:threadio %retry-too-many ~)
;< ~ bind:m (backoff:threadio try ~m1)
(strand-fail:strandio %retry-too-many ~)
;< ~ bind:m (backoff:strandio try ~m1)
;< res=(unit result) bind:m computation
?^ res
(pure:m u.res)
@ -111,21 +111,21 @@
::
++ get-latest-block
|= url=@ta
=/ m (thread ,block)
=/ m (strand ,block)
^- form:m
;< =json bind:m (request-rpc url `'block number' %eth-block-number ~)
(get-block-by-number url (parse-eth-block-number:rpc:ethereum json))
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (thread ,block)
=/ m (strand ,block)
^- form:m
|^
;< =json bind:m
(request-rpc url `'block by number' %eth-get-block-by-number number |)
=/ =block (parse-block json)
?. =(number number.id.block)
(thread-fail:threadio %reorg-detected >number< >block< ~)
(strand-fail:strandio %reorg-detected >number< >block< ~)
(pure:m block)
::
++ parse-block

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

@ -1,6 +1,6 @@
:: ethio: Asynchronous Ethereum input/output functions.
::.
/+ threadio
/+ strandio
=, ethereum-types
=, able:jael
::
@ -12,10 +12,10 @@
::
++ request-rpc
|= [url=@ta id=(unit @t) req=request:rpc:ethereum]
=/ m (thread:threadio ,json)
=/ m (strand:strandio ,json)
^- form:m
|^ %+ (retry:threadio json) `10
=/ m (thread:threadio ,(unit json))
|^ %+ (retry:strandio json) `10
=/ m (strand:strandio ,(unit json))
^- form:m
=/ =request:http
:* method=%'POST'
@ -26,16 +26,16 @@
%- en-json:html
(request-to-json:rpc:ethereum id req)
==
;< ~ bind:m (send-request:threadio request)
;< ~ bind:m (send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:threadio
take-maybe-response:strandio
?~ rep
(pure:m ~)
(parse-response u.rep)
::
++ parse-response
|= =client-response:iris
=/ m (thread:threadio ,(unit json))
=/ m (strand:strandio ,(unit json))
^- form:m
?> ?=(%finished -.client-response)
?~ full-file.client-response
@ -50,13 +50,13 @@
?~ array
=/ res=(unit response:rpc:jstd) (parse-one-response u.jon)
?~ res
(thread-fail:threadio %request-rpc-parse-error >id< ~)
(strand-fail:strandio %request-rpc-parse-error >id< ~)
?: ?=(%error -.u.res)
(thread-fail:threadio %request-rpc-error >id< >+.res< ~)
(strand-fail:strandio %request-rpc-error >id< >+.res< ~)
?. ?=(%result -.u.res)
(thread-fail:threadio %request-rpc-fail >u.res< ~)
(strand-fail:strandio %request-rpc-fail >u.res< ~)
(pure:m `res.u.res)
(thread-fail:threadio %request-rpc-batch >%not-implemented< ~)
(strand-fail:strandio %request-rpc-batch >%not-implemented< ~)
:: (pure:m `[%batch u.array])
::
++ parse-one-response
@ -77,19 +77,19 @@
::
++ read-contract
|= [url=@t proto-read-request:rpc:ethereum]
=/ m (thread:threadio ,@t)
=/ m (strand:strandio ,@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) (thread-fail:threadio %request-rpc-fail >json< ~)
?. ?=(%s -.json) (strand-fail:strandio %request-rpc-fail >json< ~)
(pure:m p.json)
::
++ get-latest-block
|= url=@ta
=/ m (thread:threadio ,block)
=/ m (strand:strandio ,block)
^- form:m
;< =json bind:m
(request-rpc url `'block number' %eth-block-number ~)
@ -97,7 +97,7 @@
::
++ get-block-by-number
|= [url=@ta =number:block]
=/ m (thread:threadio ,block)
=/ m (strand:strandio ,block)
^- form:m
|^
;< =json bind:m
@ -106,7 +106,7 @@
[%eth-get-block-by-number number |]
=/ =block (parse-block json)
?. =(number number.id.block)
(thread-fail:threadio %reorg-detected >number< >block< ~)
(strand-fail:strandio %reorg-detected >number< >block< ~)
(pure:m block)
::
++ parse-block
@ -126,7 +126,7 @@
::
++ get-logs-by-hash
|= [url=@ta =hash:block contracts=(list address) =topics]
=/ m (thread:threadio (list event-log:rpc:ethereum))
=/ m (strand:strandio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url
@ -146,7 +146,7 @@
=from=number:block
=to=number:block
==
=/ m (thread:threadio (list event-log:rpc:ethereum))
=/ m (strand:strandio (list event-log:rpc:ethereum))
^- form:m
;< =json bind:m
%+ request-rpc url

86
pkg/arvo/lib/ph.hoon
View File

@ -1,86 +0,0 @@
:: Defines the ph monad.
::
:: A complete ph test has type data:(ph ,~). This is a function that
:: accepts a new unix-effect and produces a list of ph-events to inject
:: back into the system. It also produces one of four "next steps":
::
:: %wait: no change; on next unix-effect call this same function.
:: %cont: swap out this test for another one. Mainly useful for
:: the implementation of +bind.
:: %fail: the test has failed.
:: %done: the test has finished successfully.
::
:: When producing %done, you may specify a value. The ph app assumes
:: the value of each whole test will be ~. During the test, though, it
:: may be useful to produce intermediate values.
::
:: We define two additional functions. +return takes a value and
:: produces a test which immediately produces a %done with that value.
::
:: +bind takes a test and a function from the output type of that test
:: to another test. This is useful to link tests together. See
:: lib/ph/tests.hoon for examples of usage.
::
:: You may recognize monad terminology. These functions satisfy the
:: monad laws: If `f` and `g` are the sort of function that go in the
:: second argument to bind and `m` is a test, then:
::
:: (cork pure (curr bind f)) = f
:: (bind m pure) = m
:: ((bind m f) g) = (bind m (bind f g))
::
:: Maintaining these laws requires a particular interpretation of the
:: monad, which the ph app implements in +diff-aqua-effects. Thus,
:: within the ph app the monad laws hold.
::
/- aquarium
=, aquarium
|%
+$ ph-input
[now=@da who=ship uf=unix-effect]
::
++ ph-output-raw
|* a=mold
$~ [& ~ %done *a]
$: thru=?
events=(list ph-event)
$= next
$% [%wait ~]
[%cont self=(ph-form-raw a)]
[%fail ~]
[%done value=a]
==
==
::
++ ph-form-raw
|* a=mold
$-(ph-input (ph-output-raw a))
::
++ ph
|* a=mold
|%
++ output (ph-output-raw a)
++ form (ph-form-raw a)
++ pure
|= arg=a
^- form
|= ph-input
[& ~ %done arg]
::
++ bind
|* b=mold
|= [m-b=(ph-form-raw b) fun=$-(b form)]
^- form
|= input=ph-input
=/ b-res=(ph-output-raw b)
(m-b input)
^- output
:+ thru.b-res events.b-res
?- -.next.b-res
%wait [%wait ~]
%cont [%cont ..$(m-b self.next.b-res)]
%fail [%fail ~]
%done [%cont (fun value.next.b-res)]
==
--
--

457
pkg/arvo/lib/ph/azimuth.hoon
View File

@ -1,457 +0,0 @@
:: Mock Azimuth
::
/+ ph, ph-util, ph-philter, ph-tests
=, ph
=, ph-util
=, ph-philter
|= our=ship
=> |%
+$ az-log [topics=(lest @) data=@t]
--
=| logs=(list az-log) :: oldest logs first
=| lives=(map ship [lyfe=life rut=rift])
=| $= eth-filters
$: next=_1 :: jael assumes != 0
all=(map @ud [from-block=@ud last-block=@ud address=@ux])
==
|%
++ this-az .
++ add-logs
|= new-logs=(list az-log)
^+ this-az
=. logs (weld logs new-logs)
this-az
::
++ router
=/ n (philter ,_this-az)
^- form:n
|%
++ stay this-az
++ run
|= pin=ph-input
^- output:n
=, enjs:format
=/ ask (extract-request uf.pin 'http://localhost:8545/')
?~ ask
[& ~ %wait ~]
?~ body.request.u.ask
[& ~ %wait ~]
=/ req q.u.body.request.u.ask
|^ ^- output:n
=/ method (get-method req)
:: =; a ~& [%give-azimuth-response a] -
?: =(method 'eth_blockNumber')
:- | :_ [%wait ~]
%+ answer-request req
s+(crip (num-to-hex:ethereum latest-block))
?: =(method 'eth_getBlockByNumber')
:- | :_ [%wait ~]
%+ answer-request req
:- %o
=/ number (hex-to-num:ethereum (get-first-param req))
=/ hash (number-to-hash number)
=/ parent-hash (number-to-hash ?~(number number (dec number)))
%- malt
^- (list (pair term json))
:~ hash+s+(crip (prefix-hex:ethereum (render-hex-bytes:ethereum 32 hash)))
number+s+(crip (num-to-hex:ethereum number))
'parentHash'^s+(crip (num-to-hex:ethereum parent-hash))
==
?: =(method 'eth_getLogs')
:- | :_ [%wait ~]
%+ answer-request req
?^ (get-param-obj-maybe req 'blockHash')
%- logs-by-hash
(get-param-obj req 'blockHash')
%+ logs-by-range
(get-param-obj req 'fromBlock')
(get-param-obj req 'toBlock')
?: =(method 'eth_newFilter')
:+ |
(answer-request req s+(scot %ux next.eth-filters))
=. all.eth-filters
%+ ~(put by all.eth-filters)
next.eth-filters
:+
(get-param-obj req 'fromBlock')
(get-param-obj req 'fromBlock')
(get-param-obj req 'address')
=. next.eth-filters +(next.eth-filters)
[%cont ..stay]
?: =(method 'eth_getFilterLogs')
=/ fil (~(get by all.eth-filters) (get-filter-id req))
?~ fil
~|(%no-filter-not-implemented !!)
:+ |
%+ answer-request req
~| [eth-filters latest-block]
(logs-by-range from-block.u.fil latest-block)
=. last-block.u.fil latest-block
[%cont ..stay]
?: =(method 'eth_getFilterChanges')
=/ fil-id (get-filter-id req)
=/ fil (~(get by all.eth-filters) fil-id)
?~ fil
~|(%no-filter-not-implemented !!)
:+ |
%+ answer-request req
(logs-by-range last-block.u.fil latest-block)
=. all.eth-filters
%+ ~(put by all.eth-filters)
fil-id
u.fil(last-block latest-block)
[%cont ..stay]
~& [%ph-azimuth-miss req]
[& ~ %wait ~]
::
++ latest-block
(add launch:contracts:azimuth (dec (lent logs)))
::
++ get-id
|= req=@t
=, dejs:format
%. (need (de-json:html req))
(ot id+so ~)
::
++ get-method
|= req=@t
=, dejs:format
%. (need (de-json:html req))
(ot method+so ~)
::
++ get-param-obj
|= [req=@t param=@t]
=, dejs:format
%- hex-to-num:ethereum
=/ array
%. (need (de-json:html req))
(ot params+(ar (ot param^so ~)) ~)
?> ?=([* ~] array)
i.array
::
++ get-param-obj-maybe
|= [req=@t param=@t]
^- (unit @ud)
=, dejs-soft:format
=/ array
%. (need (de-json:html req))
(ot params+(ar (ot param^so ~)) ~)
?~ array
~
:- ~
?> ?=([* ~] u.array)
%- hex-to-num:ethereum
i.u.array
::
++ get-filter-id
|= req=@t
=, dejs:format
%- hex-to-num:ethereum
=/ id
%. (need (de-json:html req))
(ot params+(ar so) ~)
?> ?=([* ~] id)
i.id
::
++ get-first-param
|= req=@t
=, dejs:format
=/ id
%. (need (de-json:html req))
(ot params+(at so bo ~) ~)
-.id
::
++ answer-request
|= [req=@t result=json]
^- (list ph-event)
=/ resp
%- crip
%- en-json:html
%- pairs
:~ id+s+(get-id req)
jsonrpc+s+'2.0'
result+result
==
:_ ~
:* %event
who.pin
//http-client/0v1n.2m9vh
%receive
num.u.ask
[%start [200 ~] `(as-octs:mimes:html resp) &]
==
::
++ number-to-hash
|= =number:block:able:jael
^- @
?: (lth number launch:contracts:azimuth)
(cat 3 0x5364 (sub launch:contracts:azimuth number))
(cat 3 0x5363 (sub number launch:contracts:azimuth))
::
++ hash-to-number
|= =hash:block:able:jael
(add launch:contracts:azimuth (div hash 0x1.0000))
::
++ logs-by-range
|= [from-block=@ud to-block=@ud]
%+ logs-to-json (max launch:contracts:azimuth from-block)
?: (lth to-block launch:contracts:azimuth)
~
%+ swag
?: (lth from-block launch:contracts:azimuth)
[0 +((sub to-block launch:contracts:azimuth))]
:- (sub from-block launch:contracts:azimuth)
+((sub to-block from-block))
logs
::
++ logs-by-hash
|= =hash:block:able:jael
=/ =number:block:able:jael (hash-to-number hash)
(logs-by-range number number)
::
++ logs-to-json
|= [count=@ud selected-logs=(list az-log)]
^- json
:- %a
|- ^- (list json)
?~ selected-logs
~
:_ $(selected-logs t.selected-logs, count +(count))
%- pairs
:~ 'logIndex'^s+'0x0'
'transactionIndex'^s+'0x0'
:+ 'transactionHash' %s
(crip (prefix-hex:ethereum (render-hex-bytes:ethereum 32 `@`0x5362)))
::
:+ 'blockHash' %s
=/ hash (number-to-hash count)
(crip (prefix-hex:ethereum (render-hex-bytes:ethereum 32 hash)))
::
:+ 'blockNumber' %s
(crip (num-to-hex:ethereum count))
::
:+ 'address' %s
(crip (address-to-hex:ethereum azimuth:contracts:azimuth))
::
'type'^s+'mined'
::
'data'^s+data.i.selected-logs
:+ 'topics' %a
%+ turn topics.i.selected-logs
|= topic=@ux
^- json
:- %s
%- crip
%- prefix-hex:ethereum
(render-hex-bytes:ethereum 32 `@`topic)
==
--
--
::
++ raw-real-ship
|= who=ship
=/ m (ph ,~)
^- form:m
?. =(%earl (clan:title who))
(raw-ship:(ph-tests our) who `(dawn who ~))
=/ spon=ship (^sein:title who)
=/ cub (pit:nu:crub:crypto 512 (shaz (jam who life=1 %entropy)))
=/ =seed:able:jael
[who 1 sec:ex:cub ~]
=/ =pass pub:ex:cub
=/ com=tape "|moon {(scow %p who)}, =public-key {(scow %uw pass)}"
;< ~ bind:m (just-events:(ph-tests our) (dojo spon com))
(raw-ship:(ph-tests our) who `(dawn who `seed))
::
++ dawn
|= [who=ship seed=(unit seed:able:jael)]
^- dawn-event:able:jael
=/ spon=(list [ship point:azimuth])
|- ^- (list [ship point:azimuth])
=/ =ship (^sein:title who)
=/ a-point=[^ship point:azimuth]
=/ spon-spon [& (^sein:title ship)]
=/ life-rift ~|([ship lives] (~(got by lives) ship))
=/ =life lyfe.life-rift
=/ =rift rut.life-rift
=/ =pass
%^ pass-from-eth:azimuth
(as-octs:mimes:html (get-public ship life %crypt))
(as-octs:mimes:html (get-public ship life %auth))
1
:^ ship
*[address address address address]:azimuth
`[life=life pass rift spon-spon ~]
~
?: ?=(%czar (clan:title ship))
[a-point]~
[a-point $(who ship)]
=/ =seed:able:jael
?^ seed
u.seed
=/ life-rift (~(got by lives) who)
=/ =life lyfe.life-rift
[who life sec:ex:(get-keys who life) ~]
:* seed
spon
get-czars
~[~['arvo' 'netw' 'ork']]
0
`(need (de-purl:html 'http://localhost:8545'))
==
::
:: Should only do galaxies
::
++ get-czars
^- (map ship [rift life pass])
%- malt
%+ murn
~(tap by lives)
|= [who=ship lyfe=life rut=rift]
?. =(%czar (clan:title who))
~
%- some
:^ who rut lyfe
%^ pass-from-eth:azimuth
(as-octs:mimes:html (get-public who lyfe %crypt))
(as-octs:mimes:html (get-public who lyfe %auth))
1
::
++ spawn
|= who=@p
?< (~(has by lives) who)
=. lives (~(put by lives) who [1 0])
=. this-az
%- add-logs
:~ %- changed-keys:lo
:* who
(get-public who 1 %crypt)
(get-public who 1 %auth)
1
1
==
==
(spam-logs 30)
::
:: our: host ship
:: who: cycle keys
:: her: wait until hears about cycle
::
++ cycle-keys-and-hear
|= [our=@p who=@p her=@p]
=. this-az (cycle-keys who)
=/ new-lyfe lyfe:(~(got by lives) who)
=/ m (ph ,_this-az)
;< [this-az=_this-az ~] bind:m
%+ (wrap-philter ,_this-az ,~)
router:this-az
^+ *form:(ph ,~)
|= pin=ph-input
:+ & ~
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/life/(scot %da now.pin)/(scot %p who)/noun
=/ lyfe (scry-aqua noun our now.pin aqua-pax)
~& [new-lyfe=[0 new-lyfe] lyfe=lyfe]
?: =([~ new-lyfe] lyfe)
[%done ~]
[%wait ~]
(pure:m this-az)
::
++ cycle-keys
|= who=@p
=/ prev (~(got by lives) who)
=/ lyfe +(lyfe.prev)
=. lives (~(put by lives) who [lyfe rut.prev])
%- add-logs
:_ ~
%- changed-keys:lo
:* who
(get-public who lyfe %crypt)
(get-public who lyfe %auth)
1
lyfe
==
::
:: our: host ship
:: who: breachee
:: her: wait until hears about breach
::
++ breach-and-hear
|= [our=@p who=@p her=@p]
=. this-az (breach who)
=/ new-rut rut:(~(got by lives) who)
=/ m (ph ,_this-az)
;< [this-az=_this-az ~] bind:m
%+ (wrap-philter ,_this-az ,~)
router:this-az
^+ *form:(ph ,~)
|= pin=ph-input
:+ & ~
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.pin)/(scot %p who)/noun
=/ rut (scry-aqua noun our now.pin aqua-pax)
?: =([~ new-rut] rut)
[%done ~]
[%wait ~]
(pure:m this-az)
::
++ breach
|= who=@p
=. this-az (cycle-keys who)
=/ prev (~(got by lives) who)
=/ rut +(rut.prev)
=. lives (~(put by lives) who [lyfe.prev rut])
=. this-az
(add-logs (broke-continuity:lo who rut) ~)
(spam-logs 30)
::
++ spam-logs
|= n=@
?: =(n 0)
this-az
=. this-az ?:((~(has by lives) ~fes) (cycle-keys ~fes) (spawn ~fes))
$(n (dec n))
::
++ get-keys
|= [who=@p lyfe=life]
^- acru:ames
%+ pit:nu:crub:crypto 32
(can 5 [1 (scot %p who)] [1 (scot %ud lyfe)] ~)
::
++ get-public
|= [who=@p lyfe=life typ=?(%auth %crypt)]
=/ bod (rsh 3 1 pub:ex:(get-keys who lyfe))
=+ [enc=(rsh 8 1 bod) aut=(end 8 1 bod)]
?: =(%auth typ)
aut
enc
::
:: Generate logs
::
++ lo
=, azimuth-events:azimuth
|%
++ broke-continuity
|= [who=ship rut=rift]
^- az-log
:- ~[^broke-continuity who]
%- crip
%- prefix-hex:ethereum
(render-hex-bytes:ethereum 32 `@`rut)
::
++ changed-keys
|= [who=ship enc=@ux aut=@ux crypto=@ud lyfe=life]
^- az-log
:- ~[^changed-keys who]
%- crip
%- prefix-hex:ethereum
;: welp
(render-hex-bytes:ethereum 32 `@`enc)
(render-hex-bytes:ethereum 32 `@`aut)
(render-hex-bytes:ethereum 32 `@`crypto)
(render-hex-bytes:ethereum 32 `@`lyfe)
==
--
--

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

@ -1,15 +1,15 @@
/- *aquarium, spider
/+ libthread=thread, *threadio, util=ph-util
=, thread=thread:libthread
/+ libstrand=strand, *strandio, util=ph-util
=, strand=strand:libstrand
|%
++ send-events
|= events=(list aqua-event)
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(poke-our %aqua %aqua-events !>(events))
::
++ take-unix-effect
=/ m (thread ,[ship unix-effect])
=/ m (strand ,[ship unix-effect])
^- form:m
;< =cage bind:m (take-fact /effects)
?> ?=(%aqua-effect p.cage)
@ -21,83 +21,83 @@
(end-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre ~)
::
++ start-azimuth
=/ m (thread ,iid:spider)
=/ m (strand ,tid:spider)
^- form:m
;< ~ bind:m (start-test %aqua-ames %aqua-behn %aqua-dill ~)
(start-imp %aqua-eyre-azimuth)
(start-thread %aqua-eyre-azimuth)
::
++ end-azimuth
(end-test %aqua-ames %aqua-behn %aqua-dill %aqua-eyre-azimuth ~)
::
++ start-test
|= vane-imps=(list term)
=/ m (thread ,~)
|= vane-threads=(list term)
=/ m (strand ,~)
^- form:m
~& > "starting"
;< ~ bind:m (start-imps vane-imps)
;< ~ bind:m (start-threads vane-threads)
;< ~ bind:m (watch-our /effects %aqua /effect)
:: Get our very own event with no mistakes in it... yet.
::
:: We want to wait for the vane imps to actually start and get their
:: subscriptions started. Other ways to do this are delaying the ack
:: from spider until the build is finished (does that guarantee the
:: subscriptions have started?) or subscribe to the imps themselves
:: for a notification when they're done. This is probably the best
:: option because the imp can delay until it gets a positive ack on
:: the subscription.
:: We want to wait for the vane threads to actually start and get
:: their subscriptions started. Other ways to do this are delaying
:: the ack from spider until the build is finished (does that
:: guarantee the subscriptions have started?) or subscribe to the
:: threads themselves for a notification when they're done. This is
:: probably the best option because the thread can delay until it
:: gets a positive ack on the subscription.
::
;< ~ bind:m (sleep ~s0)
(pure:m ~)
::
++ end-test
|= vane-imps=(list term)
=/ m (thread ,~)
|= vane-threads=(list term)
=/ m (strand ,~)
^- form:m
~& > "done"
;< ~ bind:m (stop-imps vane-imps)
;< ~ bind:m (stop-threads vane-threads)
;< ~ bind:m (leave-our /effects %aqua)
(pure:m ~)
::
++ start-imps
|= imps=(list term)
=/ m (thread ,~)
++ start-threads
|= threads=(list term)
=/ m (strand ,~)
^- form:m
;< =bowl:spider bind:m get-bowl
|- ^- form:m
=* loop $
?~ imps
?~ threads
(pure:m ~)
=/ poke-vase !>([`iid.bowl ~ i.imps *vase])
=/ poke-vase !>([`tid.bowl ~ i.threads *vase])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
loop(imps t.imps)
loop(threads t.threads)
::
++ stop-imps
|= imps=(list term)
=/ m (thread ,~)
++ stop-threads
|= threads=(list term)
=/ m (strand ,~)
^- form:m
(pure:m ~)
::
++ spawn
|= [=iid:spider =ship]
|= [=tid:spider =ship]
~& > "spawning {<ship>}"
=/ m (thread ,~)
=/ =vase !>(`imput:spider`[iid %azimuth-command !>([%spawn ship])])
(poke-our %spider %spider-imput vase)
=/ m (strand ,~)
=/ =vase !>(`input:spider`[tid %azimuth-command !>([%spawn ship])])
(poke-our %spider %spider-input vase)
::
++ breach
|= [=iid:spider who=ship]
=/ m (thread ,~)
|= [=tid:spider who=ship]
=/ m (strand ,~)
~& > "breaching {<who>}"
=/ =vase
!>([iid %azimuth-command !>([%breach who])])
(poke-our %spider %spider-imput vase)
!>([tid %azimuth-command !>([%breach who])])
(poke-our %spider %spider-input vase)
::
:: who: breachee
:: her: wait until hears about breach
::
++ breach-and-hear
|= [=iid:spider who=ship her=ship]
=/ m (thread ,~)
|= [=tid:spider who=ship her=ship]
=/ m (strand ,~)
~& > "breaching {<who>} for {<her>}"
;< =bowl:spider bind:m get-bowl
=/ aqua-pax
@ -109,8 +109,8 @@
1
+(+.old-rut)
=/ =vase
!>([iid %azimuth-command !>([%breach who])])
;< ~ bind:m (poke-our %spider %spider-imput vase)
!>([tid %azimuth-command !>([%breach who])])
;< ~ bind:m (poke-our %spider %spider-input vase)
|- ^- form:m
=* loop $
;< [him=ship =unix-effect] bind:m take-unix-effect
@ -124,16 +124,16 @@
loop
::
++ real-ship
|= [=iid:spider =ship]
|= [=tid:spider =ship]
~& > "booting real {<ship>}"
=/ m (thread ,~)
=/ =vase !>([iid %azimuth-command !>([%create-ship ship])])
;< ~ bind:m (poke-our %spider %spider-imput vase)
=/ m (strand ,~)
=/ =vase !>([tid %azimuth-command !>([%create-ship ship])])
;< ~ bind:m (poke-our %spider %spider-input vase)
(check-ship-booted ship)
::
++ raw-ship
|= [=ship keys=(unit dawn-event:able:jael)]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
~& > "starting {<ship>}"
;< ~ bind:m (send-events (init:util ship keys))
@ -141,7 +141,7 @@
::
++ check-ship-booted
|= =ship
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
@ -158,14 +158,14 @@
::
++ dojo
|= [=ship =tape]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
~& > "dojo: {tape}"
(send-events (dojo:util ship tape))
::
++ wait-for-output
|= [=ship =tape]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
~& > "waiting for output: {tape}"
|- ^- form:m
@ -179,7 +179,7 @@
::
++ send-hi
|= [from=@p to=@p]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< ~ bind:m (dojo from "|hi {(scow %p to)}")
(wait-for-output from "hi {(scow %p to)} successful")
@ -188,7 +188,7 @@
::
++ send-hi-not-responding
|= [from=@p to=@p]
=/ m (thread ,~)
=/ m (strand ,~)
;< ~ bind:m (dojo from "|hi {(scow %p to)}")
(wait-for-output from "{(scow %p to)} not responding still trying")
::
@ -196,7 +196,7 @@
::
++ mount
|= [=ship =desk]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< ~ bind:m (dojo ship "|mount /={(trip desk)}=")
|- ^- form:m
@ -210,7 +210,7 @@
::
++ touch-file
|= [her=ship =desk extra=@t]
=/ m (thread ,@t)
=/ m (strand ,@t)
^- form:m
~& > "touching file on {<her>}/{<desk>}"
;< ~ bind:m (mount her desk)
@ -236,7 +236,7 @@
::
++ check-file-touched
|= [=ship =desk warped=@t]
=/ m (thread ,~)
=/ m (strand ,~)
~& > "checking file touched on {<ship>}/{<desk>}"
;< ~ bind:m (mount ship desk)
^- form:m

76
pkg/arvo/lib/ph/philter.hoon
View File

@ -1,76 +0,0 @@
:: Wrap tests in stateful philters
::
/+ ph
=, ph
|%
::
:: A philter is similar to a test in structure, but they don't
:: terminate and have a ++stay arm for saving their state.
::
:: They may be wrappped around a test with +wrap-philter.
::
++ philter
|* o=mold
|%
++ output
$~ [& ~ %wait ~]
$: thru=?
events=(list ph-event)
$= next
$% [%wait ~]
[%cont self=form]
==
==
++ form
$_ ^?
|%
++ stay *o
++ run |~(ph-input *output)
--
--
::
:: Run the inner test wrapped in the outer philter. The philter may
:: respond to any event that the test didn't consume. One use is to
:: mock outside services, like an Ethereum node or LetsEncrypt.
::
++ wrap-philter
|* [o=mold i=mold]
|= [outer=_*form:(philter o) inner=_*form:(ph i)]
^+ *form:(ph ,[o i])
|= input=ph-input
=/ res-i=_*output:(ph i)
(inner input)
?. thru.res-i
:+ thru.res-i events.res-i
?- -.next.res-i
%wait [%wait ~]
%cont [%cont ..$(inner self.next.res-i)]
%fail [%fail ~]
%done [%done stay:outer value.next.res-i]
==
=/ res-o=_*output:(philter o)
(run:outer input)
^+ *output:(ph ,[o i])
:+ thru.res-o (welp events.res-i events.res-o)
?- -.next.res-i
%wait
?- -.next.res-o
%wait [%wait ~]
%cont [%cont ..$(outer self.next.res-o)]
==
::
%cont
=. inner self.next.res-i
?- -.next.res-o
%wait [%cont ..$]
%cont [%cont ..$(outer self.next.res-o)]
==
::
%fail [%fail ~]
%done
?- -.next.res-o
%wait [%done stay:outer value.next.res-i]
%cont [%done stay:self.next.res-o value.next.res-i]
==
==
--

180
pkg/arvo/lib/ph/tests.hoon
View File

@ -1,180 +0,0 @@
:: Useful tests for testing things
::
/+ ph, ph-util
=, ph
=, ph-util
|= our=ship
::
:: Useful tests
::
|%
::
:: Never-ending test, for development.
::
++ stall
|= ph-input
[& ~ %wait ~]
::
:: Stall until you run :aqua|dojo ~ship "%go" on any ship.
::
++ please-press-enter
^+ *form:(ph ,~)
|= pin=ph-input
:+ & ~
?: (is-dojo-output who.pin who.pin uf.pin "%go")
[%done ~]
[%wait ~]
::
:: Test to produce events unconditionally.
::
++ just-events
|= events=(list ph-event)
=/ m (ph ,~)
^- form:m
|= ph-input
[& events %done ~]
::
::
::
++ wait-for-dojo
|= [her=@p what=tape]
=/ m (ph ,~)
^- form:m
|= pin=ph-input
:+ & ~
?. (is-dojo-output her who.pin uf.pin what)
[%wait ~]
[%done ~]
::
:: Boot ship; don't check it succeeded.
::
++ boot-ship
|= [her=ship keys=(unit dawn-event:able:jael)]
^+ *form:(ph ,~)
|= ph-input
[& (init her keys) %done ~]
::
:: Wait until ship has finished booting.
::
++ check-ship-booted
|= her=ship
^+ *form:(ph ,~)
|= ph-input
=; done=?
:+ & ~
?: done
[%done ~]
[%wait ~]
:: This is a pretty bad heuristic, but in general galaxies will
:: hit the first of these cases, and other ships will hit the
:: second.
::
?|
%^ is-dojo-output her who :- uf
"clay: committed initial filesystem (all)"
::
%^ is-dojo-output her who :- uf
"is your neighbor"
==
::
:: Send "|hi" from one ship to another
::
++ send-hi
|= [from=@p to=@p]
=/ m (ph ,~)
;< ~ bind:m (just-events (dojo from "|hi {(scow %p to)}"))
(wait-for-dojo from "hi {(scow %p to)} successful")
::
:: Send "|hi" and wait for "not responding" message
::
++ send-hi-not-responding
|= [from=@p to=@p]
=/ m (ph ,~)
;< ~ bind:m (just-events (dojo from "|hi {(scow %p to)}"))
(wait-for-dojo from "{(scow %p to)} not responding still trying")
::
:: Boot a ship and verify it booted. Parent must already be booted.
::
++ raw-ship
|= [her=ship keys=(unit dawn-event:able:jael)]
=/ m (ph ,~)
^- form:m
;< ~ bind:m (boot-ship her keys)
(check-ship-booted her)
::
:: Boot a fake star and its parent.
::
++ star
|= her=ship
=/ m (ph ,~)
^- form:m
;< ~ bind:m (raw-ship (^sein:title her) ~)
(raw-ship her ~)
::
:: Boot a fake planet, its parent, and its grandparent.
::
++ planet
|= her=ship
=/ m (ph ,~)
^- form:m
;< ~ bind:m (star (^sein:title her))
(raw-ship her ~)
::
:: Mount a desk.
::
++ mount
|= [her=ship des=desk]
=/ m (ph ,~)
^- form:m
;< ~ bind:m (just-events (dojo her "|mount /={(trip des)}="))
|= pin=ph-input
?: (is-ergo her who.pin uf.pin)
[& ~ %done ~]
[& ~ %wait ~]
::
:: Modify /sur/aquarium/hoon on the given ship
::
++ touch-file
|= [her=ship des=desk]
=/ m (ph ,@t)
^- form:m
;< ~ bind:m (mount her des)
|= pin=ph-input
=/ host-pax
/(scot %p our)/home/(scot %da now.pin)/sur/aquarium/hoon
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p her)/cx/(scot %p her)/[des]/(scot %da now.pin)
pax
/noun
==
=/ warped
%^ cat 3 '=> . '
(need (scry-aqua (unit @) our now.pin aqua-pax))
[& (insert-file her des host-pax warped) %done warped]
::
:: Check /sur/aquarium/hoon on the given has the given contents.
::
++ check-file-touched
|= [her=ship des=desk warped=@t]
=/ m (ph ,~)
;< ~ bind:m (mount her des)
^- form:m
|= pin=ph-input
:: %ergo is no longer sufficient because .^ is pinned to beginning of
:: the event. So we hope somebody sets a timer for something.
::
?. &(=(her who.pin) ?=(?(%init %ergo %doze) -.q.uf.pin))
[& ~ %wait ~]
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p her)/cx/(scot %p her)/[des]/(scot %da now.pin)
pax
/noun
==
?: =(warped (need (scry-aqua (unit @) our now.pin aqua-pax)))
[& ~ %done ~]
[& ~ %wait ~]
--

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

@ -1,7 +1,7 @@
:: Utility functions for constructing tests
::
/+ ph
=, ph
/- aquarium
=, aquarium
|%
::
:: Turn [ship (list unix-event)] into (list ph-event)

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

@ -63,7 +63,7 @@
::
++ file-ovum
=/ directories
`(list path)`~[/app /age /gen /lib /mar /ren /sec /sur /sys /tests /web]
`(list path)`~[/app /age /ted /gen /lib /mar /ren /sec /sur /sys /tests /web]
|= bas=path
^- unix-event
::

54
pkg/arvo/lib/thread.hoon → pkg/arvo/lib/strand.hoon
View File

@ -6,13 +6,13 @@
[%agent =wire =sign:agent:mall]
[%watch =path]
==
+$ thread-input [=bowl in=(unit input)]
+$ iid @taiid
+$ strand-input [=bowl in=(unit input)]
+$ tid @tatid
+$ bowl
$: our=ship
src=ship
iid=iid
mom=(unit iid)
tid=tid
mom=(unit tid)
wex=boat:mall
sup=bitt:mall
eny=@uvJ
@ -34,28 +34,28 @@
:: fail: abort computation; don't send effects
:: done: finish computation; send effects
::
++ thread-output-raw
++ strand-output-raw
|* a=mold
$~ [~ %done *a]
$: cards=(list card)
$= next
$% [%wait ~]
[%skip ~]
[%cont self=(thread-form-raw a)]
[%cont self=(strand-form-raw a)]
[%fail err=(pair term tang)]
[%done value=a]
==
==
::
++ thread-form-raw
++ strand-form-raw
|* a=mold
$-(thread-input (thread-output-raw a))
$-(strand-input (strand-output-raw a))
::
:: Abort thread computation with error message
:: Abort strand computation with error message
::
++ thread-fail
++ strand-fail
|= err=(pair term tang)
|= thread-input
|= strand-input
[~ %fail err]
::
:: Asynchronous transcaction monad.
@ -66,31 +66,31 @@
:: - Continuation
:: - Exception
::
++ thread
++ strand
|* a=mold
|%
++ output (thread-output-raw a)
++ output (strand-output-raw a)
::
:: Type of an thread computation.
:: Type of an strand computation.
::
++ form (thread-form-raw a)
++ form (strand-form-raw a)
::
:: Monadic pure. Identity computation for bind.
::
++ pure
|= arg=a
^- form
|= thread-input
|= strand-input
[~ %done arg]
::
:: Monadic bind. Combines two computations, associatively.
::
++ bind
|* b=mold
|= [m-b=(thread-form-raw b) fun=$-(b form)]
|= [m-b=(strand-form-raw b) fun=$-(b form)]
^- form
|= input=thread-input
=/ b-res=(thread-output-raw b)
|= input=strand-input
=/ b-res=(strand-output-raw b)
(m-b input)
^- output
:- cards.b-res
@ -102,12 +102,12 @@
%done [%cont (fun value.next.b-res)]
==
::
:: The thread monad must be evaluted in a particular way to maintain
:: The strand monad must be evaluted in a particular way to maintain
:: its monadic character. +take:eval implements this.
::
++ eval
|%
:: Indelible state of a thread
:: Indelible state of a strand
::
+$ eval-form
$: =form
@ -128,18 +128,18 @@
[%done value=a]
==
::
:: Take a new sign and run the thread against it
:: Take a new sign and run the strand against it
::
++ take
:: cards: accumulate throughout recursion the cards to be
:: produced now
=| cards=(list card)
|= [=eval-form =thread-input]
|= [=eval-form =strand-input]
^- [[(list card) =eval-result] _eval-form]
=* take-loop $
:: run the thread callback
:: run the strand callback
::
=/ =output (form.eval-form thread-input)
=/ =output (form.eval-form strand-input)
:: add cards to cards
::
=. cards
@ -151,7 +151,7 @@
::
?- -.next.output
%wait [[cards %next ~] eval-form]
%skip ~| [%take-got-skip ?~(in.thread-input ~ [+< +>-]:u.in.thread-input)]
%skip ~| [%take-got-skip ?~(in.strand-input ~ [+< +>-]:u.in.strand-input)]
!!
%fail [[cards %fail err.next.output] eval-form]
%done [[cards %done value.next.output] eval-form]
@ -160,7 +160,7 @@
::
%_ take-loop
form.eval-form self.next.output
thread-input [bowl.thread-input ~]
strand-input [bowl.strand-input ~]
==
==
--

160
pkg/arvo/lib/threadio.hoon → pkg/arvo/lib/strandio.hoon
View File

@ -1,47 +1,47 @@
/- spider
/+ libthread=thread
=, thread=thread:libthread
=, thread-fail=thread-fail:libthread
/+ libstrand=strand
=, strand=strand:libstrand
=, strand-fail=strand-fail:libstrand
|%
++ send-raw-cards
|= cards=(list =card:agent:mall)
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
|= thread-input:thread
|= strand-input:strand
[cards %done ~]
::
++ send-raw-card
|= =card:agent:mall
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(send-raw-cards card ~)
::
++ ignore
|= tin=thread-input:thread
|= tin=strand-input:strand
`[%fail %ignore ~]
::
++ get-bowl
=/ m (thread ,bowl:thread)
=/ m (strand ,bowl:strand)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
`[%done bowl.tin]
::
++ get-time
=/ m (thread ,@da)
=/ m (strand ,@da)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
`[%done now.bowl.tin]
::
++ get-our
=/ m (thread ,ship)
=/ m (strand ,ship)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
`[%done our.bowl.tin]
::
++ get-entropy
=/ m (thread ,@uvJ)
=/ m (strand ,@uvJ)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
`[%done eny.bowl.tin]
::
:: Convert skips to %ignore failures.
@ -50,10 +50,10 @@
::
++ handle
|* a=mold
=/ m (thread ,a)
=/ m (strand ,a)
|= =form:m
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
=/ res (form tin)
=? next.res ?=(%skip -.next.res)
[%fail %ignore ~]
@ -63,9 +63,9 @@
::
++ take-poke
|= =mark
=/ m (thread ,vase)
=/ m (strand ,vase)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %poke @ *]
@ -77,9 +77,9 @@
::
::
++ take-sign-arvo
=/ m (thread ,[wire sign-arvo])
=/ m (strand ,[wire sign-arvo])
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign *]
@ -90,9 +90,9 @@
::
++ take-fact-prefix
|= =wire
=/ m (thread ,[path cage])
=/ m (strand ,[path cage])
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %fact *]
@ -105,9 +105,9 @@
::
++ take-fact
|= =wire
=/ m (thread ,cage)
=/ m (strand ,cage)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %fact *]
@ -120,9 +120,9 @@
::
++ take-kick
|= =wire
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %kick *]
@ -132,7 +132,7 @@
==
::
++ echo
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
%- (main-loop ,~)
:~ |= ~
@ -152,8 +152,8 @@
==
::
++ take-watch
=/ m (thread ,path)
|= tin=thread-input:thread
=/ m (strand ,path)
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %watch *]
@ -162,9 +162,9 @@
::
++ take-wake
|= until=(unit @da)
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign [%wait @ ~] %b %wake *]
@ -177,9 +177,9 @@
::
++ take-poke-ack
|= =wire
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %poke-ack *]
@ -192,9 +192,9 @@
::
++ take-watch-ack
|= =wire
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %agent * %watch-ack *]
@ -207,7 +207,7 @@
::
++ poke
|= [=dock =cage]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall [%pass /poke %agent dock %poke cage]
;< ~ bind:m (send-raw-card card)
@ -215,14 +215,14 @@
::
++ poke-our
|= [=term =cage]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(poke [our term] cage)
::
++ watch
|= [=wire =dock =path]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall [%pass watch+wire %agent dock %watch path]
;< ~ bind:m (send-raw-card card)
@ -230,28 +230,28 @@
::
++ watch-our
|= [=wire =term =path]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(watch wire [our term] path)
::
++ leave
|= [=wire =dock]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall [%pass watch+wire %agent dock %leave ~]
(send-raw-card card)
::
++ leave-our
|= [=wire =term]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our
(leave wire [our term])
::
++ rewatch
|= [=wire =dock =path]
=/ m (thread ,~)
=/ m (strand ,~)
;< ~ bind:m ((handle ,~) (take-kick wire))
;< ~ bind:m (flog-text "rewatching {<dock>} {<path>}")
;< ~ bind:m (watch wire dock path)
@ -259,21 +259,21 @@
::
++ wait
|= until=@da
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< ~ bind:m (send-wait until)
(take-wake `until)
::
++ sleep
|= for=@dr
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< now=@da bind:m get-time
(wait (add now for))
::
++ send-wait
|= until=@da
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
=/ =card:agent:mall
[%pass /wait/(scot %da until) %arvo %b %wait until]
@ -281,7 +281,7 @@
::
++ set-timeout
|* computation-result=mold
=/ m (thread ,computation-result)
=/ m (strand ,computation-result)
|= [time=@dr computation=form:m]
^- form:m
;< now=@da bind:m get-time
@ -289,7 +289,7 @@
=/ =card:agent:mall
[%pass /timeout/(scot %da when) %arvo %b %wait when]
;< ~ bind:m (send-raw-card card)
|= tin=thread-input:thread
|= tin=strand-input:strand
=* loop $
?: ?& ?=([~ %sign [%timeout @ ~] %b %wake *] in.tin)
=((scot %da when) i.t.wire.u.in.tin)
@ -306,19 +306,19 @@
::
++ send-request
|= =request:http
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(send-raw-card %pass /request %arvo %i %request request *outbound-config:iris)
::
++ send-cancel-request
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(send-raw-card %pass /request %arvo %i %cancel-request ~)
::
++ take-client-response
=/ m (thread ,client-response:iris)
=/ m (strand ,client-response:iris)
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign [%request ~] %i %http-response %finished *]
@ -328,7 +328,7 @@
:: Wait until we get an HTTP response or cancelation and unset contract
::
++ take-maybe-sigh
=/ m (thread ,(unit httr:eyre))
=/ m (strand ,(unit httr:eyre))
^- form:m
;< rep=(unit client-response:iris) bind:m
take-maybe-response
@ -341,9 +341,9 @@
(pure:m (some (to-httr:iris +.u.rep)))
::
++ take-maybe-response
=/ m (thread ,(unit client-response:iris))
=/ m (strand ,(unit client-response:iris))
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
?+ in.tin `[%skip ~]
~ `[%wait ~]
[~ %sign [%request ~] %i %http-response %cancel *]
@ -354,7 +354,7 @@
::
++ extract-body
|= =client-response:iris
=/ m (thread ,cord)
=/ m (strand ,cord)
^- form:m
?> ?=(%finished -.client-response)
?> ?=(^ full-file.client-response)
@ -362,7 +362,7 @@
::
++ fetch-json
|= url=tape
=/ m (thread ,json)
=/ m (strand ,json)
^- form:m
=/ =request:http [%'GET' (crip url) ~ ~]
;< ~ bind:m (send-request request)
@ -370,32 +370,32 @@
;< =cord bind:m (extract-body client-response)
=/ json=(unit json) (de-json:html cord)
?~ json
(thread-fail %json-parse-error ~)
(strand-fail %json-parse-error ~)
(pure:m u.json)
::
:: Queue on skip, try next on fail %ignore
::
++ main-loop
|* a=mold
=/ m (thread ,~)
=/ m-a (thread ,a)
=| queue=(qeu (unit input:thread))
=| active=(unit [in=(unit input:thread) =form:m-a forms=(list $-(a form:m-a))])
=/ m (strand ,~)
=/ m-a (strand ,a)
=| queue=(qeu (unit input:strand))
=| active=(unit [in=(unit input:strand) =form:m-a forms=(list $-(a form:m-a))])
=| state=a
|= forms=(lest $-(a form:m-a))
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
=* top `form:m`..$
=. queue (~(put to queue) in.tin)
|^ (continue bowl.tin)
::
++ continue
|= =bowl:thread
|= =bowl:strand
^- output:m
?> =(~ active)
?: =(~ queue)
`[%cont top]
=^ in=(unit input:thread) queue ~(get to queue)
=^ in=(unit input:strand) queue ~(get to queue)
^- output:m
=. active `[in (i.forms state) t.forms]
^- output:m
@ -403,7 +403,7 @@
::
++ run
^- form:m
|= tin=thread-input:thread
|= tin=strand-input:strand
^- output:m
?> ?=(^ active)
=/ res (form.u.active tin)
@ -426,13 +426,13 @@
::
++ retry
|* result=mold
|= [crash-after=(unit @ud) computation=_*form:(thread (unit result))]
=/ m (thread ,result)
|= [crash-after=(unit @ud) computation=_*form:(strand (unit result))]
=/ m (strand ,result)
=| try=@ud
|- ^- form:m
=* loop $
?: =(crash-after `try)
(thread-fail %retry-too-many ~)
(strand-fail %retry-too-many ~)
;< ~ bind:m (backoff try ~m1)
;< res=(unit result) bind:m computation
?^ res
@ -441,7 +441,7 @@
::
++ backoff
|= [try=@ud limit=@dr]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< eny=@uvJ bind:m get-entropy
%- sleep
@ -457,19 +457,19 @@
::
++ flog
|= =flog:dill
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(send-raw-card %pass / %arvo %d %flog flog)
::
++ flog-text
|= =tape
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(flog %text tape)
::
++ flog-tang
|= =tang
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
=/ =wall
(zing (turn (flop tang) (cury wash [0 80])))
@ -486,7 +486,7 @@
::
++ install-domain
|= =turf
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(send-raw-card %pass / %arvo %e %rule %turf %put turf)
::
@ -494,14 +494,14 @@
::
:: Imps
::
++ start-imp
++ start-thread
|= file=term
=/ m (thread ,iid:spider)
=/ m (strand ,tid:spider)
^- form:m
;< =bowl:spider bind:m get-bowl
=/ iid (scot %ta (cat 3 'thread_' (scot %uv (sham file eny.bowl))))
=/ poke-vase !>([`iid.bowl `iid file *vase])
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
=/ poke-vase !>([`tid.bowl `tid file *vase])
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for imp to start
(pure:m iid)
;< ~ bind:m (sleep ~s0) :: wait for thread to start
(pure:m tid)
--

12
pkg/arvo/sur/spider.hoon
View File

@ -1,8 +1,8 @@
/+ libthread=thread
=, thread=thread:libthread
/+ libstrand=strand
=, strand=strand:libstrand
|%
+$ imp $-(vase _*form:(thread ,vase))
+$ imput [=iid =cage]
+$ iid iid:thread
+$ bowl bowl:thread
+$ thread $-(vase _*form:(strand ,vase))
+$ input [=tid =cage]
+$ tid tid:strand
+$ bowl bowl:strand
--

4
pkg/arvo/imp/aqua/ames.hoon → pkg/arvo/ted/aqua/ames.hoon
View File

@ -6,7 +6,7 @@
:: to drop them.
::
/- aquarium, spider
/+ aqua-vane-imp
/+ aqua-vane-thread
=, aquarium
=| ships=(list ship)
|%
@ -35,7 +35,7 @@
[%event who hear]
--
::
%- aqua-vane-imp
%- aqua-vane-thread
|_ =bowl:spider
+* this .
++ handle-unix-effect

4
pkg/arvo/imp/aqua/behn.hoon → pkg/arvo/ted/aqua/behn.hoon
View File

@ -1,5 +1,5 @@
/- aquarium, spider
/+ aqua-vane-imp
/+ aqua-vane-thread
=, aquarium
|%
+$ pier next-timer=(unit @da)
@ -85,7 +85,7 @@
--
--
::
%- aqua-vane-imp
%- aqua-vane-thread
|_ =bowl:spider
+* this .
++ handle-unix-effect

4
pkg/arvo/imp/aqua/dill.hoon → pkg/arvo/ted/aqua/dill.hoon
View File

@ -8,7 +8,7 @@
:: programmatically send events.
::
/- aquarium, spider
/+ aqua-vane-imp
/+ aqua-vane-thread
|%
++ handle-blit
|= [who=@p way=wire %blit blits=(list blit:dill)]
@ -30,7 +30,7 @@
~
--
::
%- aqua-vane-imp
%- aqua-vane-thread
|_ =bowl:spider
+* this .
++ handle-unix-effect

34
pkg/arvo/imp/aqua/eyre-azimuth.hoon → pkg/arvo/ted/aqua/eyre-azimuth.hoon
View File

@ -1,8 +1,8 @@
:: Pass-through Eyre driver
::
/- spider, *aquarium
/+ ph-io, util=ph-util, threadio
=, thread=thread:spider
/+ ph-io, util=ph-util, strandio
=, strand=strand:spider
|%
+$ state
$: logs=(list az-log) :: oldest logs first
@ -18,25 +18,25 @@
+$ az-log [topics=(lest @) data=@t]
--
=; core
^- imp:spider
^- thread:spider
|= args=vase
=/ m (thread ,vase)
=/ m (strand ,vase)
^- form:m
;< ~ bind:m (watch-our:threadio /effects %aqua /effect)
;< ~ bind:m (watch-our:strandio /effects %aqua /effect)
;< ~ bind:m
%- (main-loop:threadio ,state)
%- (main-loop:strandio ,state)
:~ |=(=state ~(handle-unix-effect core state))
|=(=state ~(handle-poke core state))
pure:(thread ,state)
pure:(strand ,state)
==
(pure:m *vase)
::
|_ =state
++ handle-unix-effect
=/ m (thread ,_state)
=/ m (strand ,_state)
^- form:m
;< [her=ship =unix-effect] bind:m
((handle:threadio ,[ship unix-effect]) take-unix-effect:ph-io)
((handle:strandio ,[ship unix-effect]) take-unix-effect:ph-io)
;< our=ship bind:m get-our:ph-io
=/ card (router our her unix-effect)
?~ card
@ -44,8 +44,8 @@
:: send in next event to avoid inverting subscription flow. real
:: solution is probably for gall to drip subscription updates.
::
;< ~ bind:m (sleep:threadio ~s0)
;< ~ bind:m (send-raw-cards:threadio u.card ~)
;< ~ bind:m (sleep:strandio ~s0)
;< ~ bind:m (send-raw-cards:strandio u.card ~)
(pure:m state)
::
++ router
@ -229,7 +229,7 @@
--
::
++ handle-poke
=/ m (thread ,_state)
=/ m (strand ,_state)
^- form:m
;< =vase bind:m ((handle:ph-io ,vase) (take-poke:ph-io %azimuth-command))
=/ command !<(azimuth-command vase)
@ -241,7 +241,7 @@
::
++ raw-real-ship
|= who=ship
=/ m (thread ,_state)
=/ m (strand ,_state)
^- form:m
?. =(%earl (clan:title who))
;< ~ bind:m (raw-ship:ph-io who `(dawn who ~))
@ -312,7 +312,7 @@
::
++ spawn
|= who=@p
=/ m (thread ,_state)
=/ m (strand ,_state)
^- form:m
?< (~(has by lives.state) who)
=. lives.state (~(put by lives.state) who [1 0])
@ -330,7 +330,7 @@
::
++ cycle-keys
|= who=@p
=/ m (thread ,_state)
=/ m (strand ,_state)
^- form:m
=/ prev (~(got by lives.state) who)
=/ lyfe +(lyfe.prev)
@ -349,7 +349,7 @@
::
++ breach
|= who=@p
=/ m (thread ,_state)
=/ m (strand ,_state)
^- form:m
;< =new=^state bind:m (cycle-keys who)
=. state new-state
@ -363,7 +363,7 @@
::
++ spam-logs
|= n=@
=/ m (thread ,_state)
=/ m (strand ,_state)
^- form:m
=* loop $
?: =(n 0)

4
pkg/arvo/imp/aqua/eyre.hoon → pkg/arvo/ted/aqua/eyre.hoon
View File

@ -1,7 +1,7 @@
:: Pass-through Eyre driver
::
/- aquarium, spider
/+ aqua-vane-imp
/+ aqua-vane-thread
=, aquarium
|%
+$ pier http-requests=(set @ud)
@ -100,7 +100,7 @@
--
--
::
%- aqua-vane-imp
%- aqua-vane-thread
|_ =bowl:spider
+* this .
++ handle-unix-effect

58
pkg/arvo/imp/azimuth-tracker.hoon → pkg/arvo/ted/azimuth-tracker.hoon
View File

@ -1,6 +1,6 @@
/- spider
/+ threadio, *azimuth
=, thread=thread:spider
/+ strandio, *azimuth
=, strand=strand:spider
=, able:jael
|%
+$ pending-udiffs (map number:block udiffs:point)
@ -43,7 +43,7 @@
::
++ get-logs-by-hash
|= [url=@ta whos=(set ship) =hash:block]
=/ m (thread udiffs:point)
=/ m (strand udiffs:point)
^- form:m
;< =json bind:m
%+ request-rpc url
@ -60,7 +60,7 @@
::
++ get-logs-by-range
|= [url=@ta whos=(set ship) =from=number:block =to=number:block]
=/ m (thread udiffs:point)
=/ m (strand udiffs:point)
^- form:m
;< =json bind:m
%+ request-rpc url
@ -113,7 +113,7 @@
::
++ jael-update
|= =udiffs:point
=/ m (thread ,~)
=/ m (strand ,~)
|- ^- form:m
=* loop $
?~ udiffs
@ -123,14 +123,14 @@
:~ [%give %fact `/ %azimuth-udiff !>(i.udiffs)]
[%give %fact `path %azimuth-udiff !>(i.udiffs)]
==
;< ~ bind:m (send-raw-cards:threadio cards)
;< ~ bind:m (send-raw-cards:strandio cards)
loop(udiffs t.udiffs)
::
++ handle-azimuth-tracker-poke
=/ m (thread ,in-poke-data)
=/ m (strand ,in-poke-data)
^- form:m
;< =vase bind:m
((handle:threadio ,vase) (take-poke:threadio %azimuth-tracker-poke))
((handle:strandio ,vase) (take-poke:strandio %azimuth-tracker-poke))
=/ =in-poke-data !<(in-poke-data vase)
(pure:m in-poke-data)
--
@ -143,33 +143,33 @@
::
++ handle-watch
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
;< =in-poke-data bind:m handle-azimuth-tracker-poke
?. ?=(%watch -.in-poke-data)
ignore:threadio
ignore:strandio
(pure:m state(url url.in-poke-data))
::
:: Send %listen to jael
::
++ handle-listen
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
;< =in-poke-data bind:m handle-azimuth-tracker-poke
?. ?=(%listen -.in-poke-data)
ignore:threadio
ignore:strandio
=/ card
[%pass /lo %arvo %j %listen (silt whos.in-poke-data) source.in-poke-data]
;< ~ bind:m (send-raw-card:threadio card)
;< ~ bind:m (send-raw-card:strandio card)
(pure:m state)
::
:: Start watching a node
::
++ handle-peer
|= state=app-state
=/ m (thread ,app-state)
;< =path bind:m ((handle:threadio ,path) take-watch:threadio)
=/ m (strand ,app-state)
;< =path bind:m ((handle:strandio ,path) take-watch:strandio)
=: number.state 0
pending-udiffs.state *pending-udiffs
blocks.state *(list block)
@ -180,31 +180,31 @@
(~(put in whos.state) u.who)
==
::
;< ~ bind:m send-cancel-request:threadio
;< ~ bind:m send-cancel-request:strandio
(get-updates state)
::
:: Get more blocks
::
++ handle-wake
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
;< ~ bind:m ((handle:threadio ,~) (take-wake:threadio ~))
;< ~ bind:m ((handle:strandio ,~) (take-wake:strandio ~))
(get-updates state)
::
:: Get updates since last checked
::
++ get-updates
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
;< =latest=block bind:m (get-latest-block url.state)
;< state=app-state bind:m (zoom state number.id.latest-block)
|- ^- form:m
=* walk-loop $
?: (gth number.state number.id.latest-block)
;< now=@da bind:m get-time:threadio
;< ~ bind:m (send-wait:threadio (add now ~m5))
;< now=@da bind:m get-time:strandio
;< ~ bind:m (send-wait:strandio (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
@ -220,7 +220,7 @@
::
++ take-block
|= [url=@ta whos=(set ship) =a=pending-udiffs =block blocks=(list block)]
=/ m (thread ,[pending-udiffs (lest ^block)])
=/ m (strand ,[pending-udiffs (lest ^block)])
^- form:m
?: &(?=(^ blocks) !=(parent-hash.block hash.id.i.blocks))
(rewind url a-pending-udiffs block blocks)
@ -234,7 +234,7 @@
::
++ release-old-events
|= [=pending-udiffs =number:block]
=/ m (thread ,^pending-udiffs)
=/ m (strand ,^pending-udiffs)
^- form:m
=/ rel-number (sub number 30)
=/ =udiffs:point (~(get ja pending-udiffs) rel-number)
@ -245,7 +245,7 @@
::
++ rewind
|= [url=@ta =pending-udiffs =block blocks=(list block)]
=/ m (thread ,[^pending-udiffs (lest ^block)])
=/ m (strand ,[^pending-udiffs (lest ^block)])
|- ^- form:m
=* loop $
?~ blocks
@ -263,7 +263,7 @@
::
++ disavow
|= =block
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
(jael-update [*ship id.block %disavow ~]~)
::
@ -275,7 +275,7 @@
::
++ zoom
|= [state=app-state =latest=number:block]
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
=/ zoom-margin=number:block 100
?: (lth latest-number (add number.state zoom-margin))
@ -291,12 +291,12 @@
::
:: Main
::
^- imp:spider
^- thread:spider
|= args=vase
=/ m (thread ,vase)
=/ m (strand ,vase)
^- form:m
;< ~ bind:m
%- (main-loop:threadio ,app-state)
%- (main-loop:strandio ,app-state)
:~ handle-listen
handle-watch
handle-wake

70
pkg/arvo/imp/dns.hoon → pkg/arvo/ted/dns.hoon
View File

@ -1,6 +1,6 @@
/- spider, dns
/+ threadio
=, thread=thread:spider
/+ strandio
=, strand=strand:spider
::
:: types and boilerplate
::
@ -13,36 +13,36 @@
==
--
::
=< ^- imp:spider
=< ^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
^- form:m
~& > 'Entering dns loop'
;< our=@p bind:m get-our:threadio
;< our=@p bind:m get-our:strandio
;< ~ bind:m
%- (main-loop:threadio ,app-state)
%- (main-loop:strandio ,app-state)
:~ handle-dns-auto
handle-dns-address
handle-diff
::
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
;< ~ bind:m
(rewatch:threadio /sub collector-app /(scot %p our))
(rewatch:strandio /sub collector-app /(scot %p our))
(pure:m state)
==
(pure:m *vase)
::
:: monadic helpers (XX move to threadio?)
:: monadic helpers (XX move to strandio?)
::
=> |%
++ request
|= =hiss:eyre
=/ m (thread ,(unit httr:eyre))
=/ m (strand ,(unit httr:eyre))
^- form:m
;< ~ bind:m (send-request:threadio (hiss-to-request:html hiss))
take-maybe-sigh:threadio
;< ~ bind:m (send-request:strandio (hiss-to-request:html hiss))
take-maybe-sigh:strandio
::
:: +self-check-http: confirm our availability at .host on port 80
::
@ -51,7 +51,7 @@
::
++ self-check-http
|= [=host:eyre max=@ud]
=/ m (thread ,?)
=/ m (strand ,?)
^- form:m
:: XX also scry into eyre
:: q:.^(hart:eyre %e /(scot %p our)/host/real)
@ -64,7 +64,7 @@
=* loop $
?: =(try max)
(pure:m |)
;< ~ bind:m (backoff:threadio try ~h1)
;< ~ bind:m (backoff:strandio try ~h1)
;< rep=(unit httr:eyre) bind:m (request hiss)
?: ?& ?=(^ rep)
|(=(200 p.u.rep) =(307 p.u.rep))
@ -78,11 +78,11 @@
::
++ app-message
|= [app=term =cord =tang]
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
=/ msg=tape :(weld (trip app) ": " (trip cord))
;< ~ bind:m (flog-text:threadio msg)
(flog-tang:threadio tang)
;< ~ bind:m (flog-text:strandio msg)
(flog-tang:strandio tang)
--
::
:: application actions
@ -92,21 +92,21 @@
::
++ turf-confirm-install
|= =turf
=/ m (thread ,?)
=/ m (strand ,?)
^- form:m
;< good=? bind:m (self-check-http &+turf 5)
?. good
(pure:m |)
;< ~ bind:m (install-domain:threadio turf)
;< ~ bind:m (install-domain:strandio turf)
(pure:m &)
::
:: +galaxy-domains
::
++ galaxy-domains
=/ m (thread ,~)
=/ m (strand ,~)
^- form:m
;< our=@p bind:m get-our:threadio
;< now=@da bind:m get-time:threadio
;< our=@p bind:m get-our:strandio
;< now=@da bind:m get-time:strandio
=/ ames-domains=(list turf)
.^((list turf) %j /(scot %p our)/turf/(scot %da now))
|- ^- form:m
@ -130,19 +130,19 @@
::
++ request-by-ip
|= if=@if
=/ m (thread ,?)
=/ m (strand ,?)
^- form:m
;< good=? bind:m (self-check-http |+if 5)
?. good
:: XX details
~& %bail-early
(pure:m |)
;< ~ bind:m (poke:threadio collector-app %dns-address !>([%if if]))
;< ~ bind:m (poke:strandio collector-app %dns-address !>([%if if]))
=/ msg=cord
(cat 3 'request for DNS sent to ' (scot %p p:collector-app))
;< ~ bind:m (app-message %dns msg ~)
;< our=@p bind:m get-our:threadio
;< ~ bind:m (watch:threadio /sub collector-app /(scot %p our))
;< our=@p bind:m get-our:strandio
;< ~ bind:m (watch:strandio /sub collector-app /(scot %p our))
=/ msg=cord
(cat 3 'awaiting response from ' (scot %p p:collector-app))
;< ~ bind:m (app-message %dns msg ~)
@ -152,11 +152,11 @@
|%
++ handle-dns-auto
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
;< =vase bind:m
((handle:threadio ,vase) (take-poke:threadio %dns-auto))
;< our=ship bind:m get-our:threadio
((handle:strandio ,vase) (take-poke:strandio %dns-auto))
;< our=ship bind:m get-our:strandio
?. ?=(%czar (clan:title our))
~& %not-galaxy
(pure:m state)
@ -165,14 +165,14 @@
::
++ handle-dns-address
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
~& %stuff
;< =vase bind:m
((handle:threadio ,vase) (take-poke:threadio %dns-address))
((handle:strandio ,vase) (take-poke:strandio %dns-address))
=/ adr !<(address:dns vase)
~& [%dns-stuff adr]
;< our=ship bind:m get-our:threadio
;< our=ship bind:m get-our:strandio
=/ rac (clan:title our)
?. ?=(?(%king %duke) rac)
~| [%dns-collector-bind-invalid rac] !!
@ -189,11 +189,11 @@
::
++ handle-diff
|= state=app-state
=/ m (thread ,app-state)
=/ m (strand ,app-state)
^- form:m
;< our=ship bind:m get-our:threadio
;< our=ship bind:m get-our:strandio
;< =cage bind:m
((handle:threadio ,cage) (take-fact:threadio /(scot %p our)))
((handle:strandio ,cage) (take-fact:strandio /(scot %p our)))
?> ?=(%dns-binding p.cage)
=/ =binding:dns !<(binding:dns q.cage)
?~ requested.state

10
pkg/arvo/imp/eth-watcher.hoon → pkg/arvo/ted/eth-watcher.hoon
View File

@ -1,7 +1,7 @@
:: eth-watcher: ethereum event log collector
::
/- spider, *eth-watcher
/+ tapp, threadio, ethio
/+ tapp, strandio, ethio
=, ethereum-types
=, able:jael
::
@ -10,7 +10,7 @@
|= args=vase
|^
=+ !<(pup=watchpup args)
=/ m (thread:threadio ,vase)
=/ m (strand:strandio ,vase)
^- form:m
;< =latest=block bind:m (get-latest-block:ethio url.pup)
;< pup=watchpup bind:m (zoom pup number.id.latest-block)
@ -30,7 +30,7 @@
::
++ take-block
|= [pup=watchpup =block]
=/ m (thread:threadio ,[disavows watchpup])
=/ m (strand:strandio ,[disavows watchpup])
^- form:m
:: if this next block isn't direct descendant of our logs, reorg happened
?: &(?=(^ blocks.pup) !=(parent-hash.block hash.id.i.blocks.pup))
@ -50,7 +50,7 @@
++ rewind
:: block: wants to be head of blocks.pup, but might not match
|= [pup=watchpup =block]
=/ m (thread:threadio ,[disavows watchpup])
=/ m (strand:strandio ,[disavows watchpup])
=* blocks blocks.pup
=| vows=disavows
|- ^- form:m
@ -76,7 +76,7 @@
::
++ zoom
|= [pup=watchpup =latest=number:block]
=/ m (thread:threadio ,watchpup)
=/ m (strand:strandio ,watchpup)
^- form:m
=/ zoom-margin=number:block 100
?: (lth latest-number (add number.pup zoom-margin))

22
pkg/arvo/imp/example-fetch.hoon → pkg/arvo/ted/example-fetch.hoon
View File

@ -1,25 +1,25 @@
:: Little app to demonstrate the structure of imps.
:: Little app to demonstrate the structure of threads.
::
:: Fetches the top comment of each of the top stories from Hacker News
::
::
/- spider
/+ *threadio
=, thread=thread:spider
/+ *strandio
=, strand=strand:spider
|%
+$ top-comments (list tape)
--
=; core
^- imp:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
^- form:m
~& > 'entering main loop'
;< ~ bind:m
%- (main-loop ,top-comments)
:~ handle-print:core
handle-fetch:core
:: `$-(top-comments _*form:(thread ,top-comments))`handle-poll:core
:: `$-(top-comments _*form:(strand ,top-comments))`handle-poll:core
==
(pure:m *vase)
|%
@ -46,7 +46,7 @@
::
++ handle-print
|= =top-comments
=/ m (thread ,^top-comments)
=/ m (strand ,^top-comments)
^- form:m
;< =vase bind:m ((handle ,vase) (take-poke %example-fetch-print))
(print top-comments)
@ -55,7 +55,7 @@
::
++ print
|= =top-comments
=/ m (thread ,^top-comments)
=/ m (strand ,^top-comments)
^- form:m
%- (slog leaf+"drumroll please..." ~)
;< ~ bind:m (sleep ~s3)
@ -66,7 +66,7 @@
::
++ handle-fetch
|= =top-comments
=/ m (thread ,^top-comments)
=/ m (strand ,^top-comments)
^- form:m
;< =vase bind:m ((handle ,vase) (take-poke %example-fetch-fetch))
(fetch top-comments)
@ -75,7 +75,7 @@
::
++ fetch
|= =top-comments
=/ m (thread ,^top-comments)
=/ m (strand ,^top-comments)
^- form:m
=. top-comments ~
%+ (set-timeout ^top-comments) ~s15
@ -128,7 +128,7 @@
::
++ handle-poll
|= =top-comments
=/ m (thread ,^top-comments)
=/ m (strand ,^top-comments)
^- form:m
!!
--

10
pkg/arvo/ted/first.hoon Normal file
View File

@ -0,0 +1,10 @@
/- spider
/+ strandio
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (strand ,vase)
^- form:m
~& > %first-starting
;< ~ bind:m echo:strandio
(pure:m *vase)

6
pkg/arvo/imp/ph/add.hoon → pkg/arvo/ted/ph/add.hoon
View File

@ -1,9 +1,9 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= args=vase
=/ m (thread ,vase)
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)
;< ~ bind:m (dojo ~bud "[%test-result (add 2 3)]")

8
pkg/arvo/imp/ph/boot-az.hoon → pkg/arvo/ted/ph/boot-az.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m start-azimuth
=/ m (strand ,vase)
;< az=tid:spider bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (real-ship az ~bud)
;< ~ bind:m end-azimuth

6
pkg/arvo/imp/ph/boot-planet.hoon → pkg/arvo/ted/ph/boot-planet.hoon
View File

@ -1,9 +1,9 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)
;< ~ bind:m (raw-ship ~marbud ~)

8
pkg/arvo/imp/ph/breach-hi-cousin.hoon → pkg/arvo/ted/ph/breach-hi-cousin.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m
=/ m (strand ,vase)
;< az=tid:spider bind:m
start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~dev)

8
pkg/arvo/imp/ph/breach-hi.hoon → pkg/arvo/ted/ph/breach-hi.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m
=/ m (strand ,vase)
;< az=tid:spider bind:m
start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~dev)

8
pkg/arvo/imp/ph/breach-multiple.hoon → pkg/arvo/ted/ph/breach-multiple.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m start-azimuth
=/ m (strand ,vase)
;< az=tid:spider bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~marbud)
;< ~ bind:m (real-ship az ~bud)

8
pkg/arvo/imp/ph/breach-sudden.hoon → pkg/arvo/ted/ph/breach-sudden.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m start-azimuth
=/ m (strand ,vase)
;< az=tid:spider bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~marbud)
;< ~ bind:m (real-ship az ~bud)

8
pkg/arvo/imp/ph/breach-sync.hoon → pkg/arvo/ted/ph/breach-sync.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m start-azimuth
=/ m (strand ,vase)
;< az=tid:spider bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~marbud)
;< ~ bind:m (real-ship az ~bud)

6
pkg/arvo/imp/ph/change-file.hoon → pkg/arvo/ted/ph/change-file.hoon
View File

@ -1,9 +1,9 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)
;< file=@t bind:m (touch-file ~bud %home %foo)

6
pkg/arvo/imp/ph/child-sync.hoon → pkg/arvo/ted/ph/child-sync.hoon
View File

@ -1,9 +1,9 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)
;< ~ bind:m (raw-ship ~marbud ~)

8
pkg/arvo/imp/ph/hi-az.hoon → pkg/arvo/ted/ph/hi-az.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m start-azimuth
=/ m (strand ,vase)
;< az=tid:spider bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~dev)
;< ~ bind:m (real-ship az ~bud)

6
pkg/arvo/imp/ph/hi.hoon → pkg/arvo/ted/ph/hi.hoon
View File

@ -1,9 +1,9 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)
;< ~ bind:m (raw-ship ~dev ~)

8
pkg/arvo/imp/ph/moon-az.hoon → pkg/arvo/ted/ph/moon-az.hoon
View File

@ -1,10 +1,10 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
;< az=iid:spider bind:m
=/ m (strand ,vase)
;< az=tid:spider bind:m
start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~marbud)

6
pkg/arvo/imp/ph/second-cousin-hi.hoon → pkg/arvo/ted/ph/second-cousin-hi.hoon
View File

@ -1,9 +1,9 @@
/- spider
/+ *ph-io
=, thread=thread:spider
^- imp:spider
=, strand=strand:spider
^- thread:spider
|= vase
=/ m (thread ,vase)
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (raw-ship ~bud ~)
;< ~ bind:m (raw-ship ~marbud ~)

12
pkg/arvo/ted/time.hoon Normal file
View File

@ -0,0 +1,12 @@
/- spider
/+ strandio
=, strand=strand:spider
^- thread:spider
|= arg=vase
=/ m (strand ,vase)
^- form:m
=+ !<([arg=@dr ~] arg)
;< now-1=@da bind:m get-time:strandio
;< ~ bind:m (sleep:strandio arg)
;< now-2=@da bind:m get-time:strandio
(pure:m !>(`@dr`(sub now-2 now-1)))