From fc9cae644214e865187e24c6363d5c3c9558baae Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 16 Jan 2019 01:19:40 -0800 Subject: [PATCH 01/55] add userspace vere app --- app/here.hoon | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++ mar/pill.hoon | 18 +++++++ sur/pill.hoon | 3 ++ sys/arvo.hoon | 5 ++ 4 files changed, 165 insertions(+) create mode 100644 app/here.hoon create mode 100644 mar/pill.hoon create mode 100644 sur/pill.hoon diff --git a/app/here.hoon b/app/here.hoon new file mode 100644 index 000000000..26dec2834 --- /dev/null +++ b/app/here.hoon @@ -0,0 +1,139 @@ +:: usage: +:: /- pill +:: =p .^(pill:pill %cx %/urbit/pill) +:: |start %here +:: :here &pill p +:: :here %init +:: :here [%dojo "+ls %"] +:: :here [%dojo "our"] +:: +/- pill +=, pill +=> $~ |% + ++ move (pair bone card) + ++ card + $% [%turf wire ~] + [%vein wire] + [%look wire src=(each ship purl:eyre)] + [%wind wire p=@ud] + [%snap wire snap=snapshot:jael kick=?] + == + ++ state + $: pil=pill + roc=* + == + -- +=, gall +|_ $: hid/bowl + state + == +++ poke-pill + |= p=pill + ^- (quip move _+>) + =. pil p + ~& lent=(met 3 (jam boot-ova.pil)) + =/ res=toon :: (each * (list tank)) + (mock [boot-ova.pil [2 [0 3] [0 2]]] scry) + ?- -.res + %0 + ~& %suc + =. roc +7.p.res + `+>.$ + ::(u3v-plow userspace-ova.pil) + :: + %1 + ~& [%vere-blocked p.res] + `+>.$ + :: + %2 + ~& %vere-fail + %- (slog p.res) + `+>.$ + == +:: +++ u3v-plow + |= ova=* + ^- (quip move _+>) + =+ ova=((list ,*) ova) + ?~ ova + `+>.$ + =/ res (mox +47.roc) + ?> ?=(%0 -.res) + =+ poke=p.res + =+ res=(slum poke now.hid i.ova) + =+ effects=((list ovum) -.res) + :: ~& effects + =+ %+ turn effects + |= ovo=ovum + ~? =(%blit p.q.ovo) + :+ p.ovo p.q.ovo + =+ bs=((list blit:dill) q.q.ovo) + %+ turn bs + |= b=blit:dill + ?: ?=(%lin -.b) + [%lin (tape p.b)] + b + :: [p.ovo p.q.ovo %hrm ] ::((list blit:dill) q.q.ovo)] + ~? !=(%blit p.q.ovo) + ovo + ~ + =. roc +3.res + $(ova t.ova) +:: +++ poke-noun + |= val=* + ^- (quip move _+>) + ~& r=(met 3 (jam roc)) + ?+ val ~|(%bad-noun-arg !!) + %init + =+ who=~bud + %- u3v-plow + :~ + [/ %wack 0] :: eny + [/ %whom who] :: eny + [//newt/0v1n.2m9vh %barn ~] + [//behn/0v1n.2m9vh %born ~] + [//term/1 %boot %fake who] + -.userspace-ova.pil + [//http/0v1n.2m9vh %live 8.080 `8.445] + [//term/1 %belt %ctl %x] + == + :: + [%dojo p=*] + %- u3v-plow + :~ + [//term/1 %belt %ctl %e] + [//term/1 %belt %ctl %u] + [//term/1 %belt %txt (tape p.val)] + [//term/1 %belt %ret ~] + == + :: + [%peek p=*] + =+ res=(mox +46.roc) + ?> ?=(%0 -.res) + =+ peek=p.res + ~& (slum peek p.val) + `+>.$ + :: + [%wish p=@t] + =+ res=(mox +22.roc) + ?> ?=(%0 -.res) + =+ wish=p.res + ~& (slum wish p.val) + `+>.$ + == +:: +++ mox |=(* (mock [roc +<] scry)) +:: +++ scry |=([* *] ~) +:: +++ prep + |= old/(unit noun) + ^- [(list move) _+>.$] + ?~ old + `+>.$ + =+ new=((soft state) u.old) + ?~ new + `+>.$ + `+>.$(+<+ u.new) +-- diff --git a/mar/pill.hoon b/mar/pill.hoon new file mode 100644 index 000000000..e3eda05fc --- /dev/null +++ b/mar/pill.hoon @@ -0,0 +1,18 @@ +:: +:::: /hoon/pill/mar + :: +/- pill +=, pill +=, mimes:html +|_ pil=pill +++ grow + |% + ++ mime [/application/octet-stream (as-octs (jam pil))] + -- +++ grab + |% + ++ noun pill + ++ mime |=([p=mite:eyre q=octs:eyre] (pill (cue q.q))) + -- +++ grad %mime +-- diff --git a/sur/pill.hoon b/sur/pill.hoon new file mode 100644 index 000000000..3e271acc9 --- /dev/null +++ b/sur/pill.hoon @@ -0,0 +1,3 @@ +|% ++= pill [boot-ova=* kernel-ova=* userspace-ova=*] +-- diff --git a/sys/arvo.hoon b/sys/arvo.hoon index fc270f5f6..c89685ca7 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -577,7 +577,11 @@ :: ++ poke |= * :: 47 ^- [(list ovum) *] + ~& =+ a=+< + =+ (met 3 (jam a)) + [%larval-poking ?:((gth - 10.000) - `a)] => .(+< ((hard ,[now=@da ovo=ovum]) +<)) + ~& [%larval-harded now p.ovo p.q.ovo] ^- [(list ovum) *] =. +>.$ ?+ -.q.ovo @@ -613,6 +617,7 @@ == :: upgrade once we've accumulated identity, entropy, and %zuse :: + ~& [%upgrading ?=(^ who) ?=(^ eny) ?=(^ bod)] ?. &(?=(^ who) ?=(^ eny) ?=(^ bod)) [~ +>.$] ~> %slog.[0 leaf+"arvo: metamorphosis"] From fe02c7653731f920ff9e062fd3fc9d1a43c3d78d Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 30 Jan 2019 18:48:30 -0800 Subject: [PATCH 02/55] clear clay state and ford cache when hear sunk --- lib/hood/kiln.hoon | 10 ++++++---- sys/vane/clay.hoon | 40 ++++++++++++++++++++++++++++++++++++++-- sys/zuse.hoon | 6 ++++-- 3 files changed, 48 insertions(+), 8 deletions(-) diff --git a/lib/hood/kiln.hoon b/lib/hood/kiln.hoon index 69f0a8ce9..07cd879de 100644 --- a/lib/hood/kiln.hoon +++ b/lib/hood/kiln.hoon @@ -382,10 +382,12 @@ ++ writ |= rot=riot ?~ rot - %^ spam - leaf+"bad %writ response" - (render "on sync" sud her syd) - ~ + =. +>.$ + %^ spam + leaf+"sync cancelled, retrying" + (render "on sync" sud her syd) + ~ + start-sync =. let ?. ?=($w p.p.u.rot) let ud:((hard cass:clay) q.q.r.u.rot) =/ =wire /kiln/sync/[syd]/(scot %p her)/[sud] :: germ: merge mode for sync merges diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 82fd732e1..d1bdb9d81 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -343,7 +343,9 @@ == == :: $: $f :: $% [%build live=? schematic=schematic:ford] :: - == == + [%keep compiler-cache=@ud build-cache=@ud] :: + [%wipe percent-to-remove=@ud] :: + == == :: $: $b :: $% {$wait p/@da} :: {$rest p/@da} :: @@ -3884,7 +3886,41 @@ abet:(perm:den pax.req rit.req) [mos ..^$] :: - $sunk [~ ..^$] + $sunk + !: + :: if we sunk, don't clear clay + :: + ?: =(our p.req) + [~ ..^$] + :: cancel subscriptions + :: + =/ foreign-desk=(map desk rede) + (fall (~(get by hoy.ruf) p.req) ~) + =/ cancel-ducts=(list duct) + %- zing ^- (list (list duct)) + %+ turn ~(tap by foreign-desk) + |= [=desk =rede] + %+ weld + ^- (list duct) %- zing ^- (list (list duct)) + %+ turn ~(tap by qyx.rede) + |= [=wove ducts=(set duct)] + ~(tap in ducts) + ?~ ref.rede + ~ + (turn ~(tap by fod.u.ref.rede) head) + =/ cancel-moves=(list move) + %+ turn cancel-ducts + |= =duct + [duct %give %writ ~] + =/ clear-ford-cache-moves=(list move) + :~ [hen %pass /clear/keep %f %keep 0 1] + [hen %pass /clear/wipe %f %wipe 100] + [hen %pass /clear/kepe %f %keep 2.048 64] + == + :: delete local state of foreign desk + :: + =. hoy.ruf (~(del by hoy.ruf) p.req) + [(weld cancel-moves clear-ford-cache-moves) ..^$] :: ?($warp $werp) :: capture whether this read is on behalf of another ship diff --git a/sys/zuse.hoon b/sys/zuse.hoon index 722f1efee..4a980c0ff 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -7169,11 +7169,13 @@ :: azimuth: data contract :: :: ++ azimuth 0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579 :: ropsten - ++ azimuth 0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb :: mainnet + :: ++ azimuth 0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb :: mainnet + ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge :: :: launch: block number of azimuth deploy :: - ++ launch 6.784.800 + :: ++ launch 6.784.800 :: mainnet + ++ launch 0 :: local bridge -- :: :: hashes of ship event signatures From 075700583fe63c3e8378ebaf51f58a37fbd9497b Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 1 Feb 2019 13:46:09 -0800 Subject: [PATCH 03/55] WIP --- app/eth-manage.hoon | 2 +- lib/hood/kiln.hoon | 7 ++ sys/vane/clay.hoon | 187 +++++++++++++++++++++++++++++++++----------- sys/vane/jael.hoon | 47 +++++++---- sys/zuse.hoon | 17 ++-- 5 files changed, 193 insertions(+), 67 deletions(-) diff --git a/app/eth-manage.hoon b/app/eth-manage.hoon index d161f40a5..865e8e567 100644 --- a/app/eth-manage.hoon +++ b/app/eth-manage.hoon @@ -34,7 +34,7 @@ %look :_ ~ =/ pul - (need (de-purl:html 'http://eth-mainnet.urbit.org:8545')) + (need (de-purl:html 'http://localhost:8545')) [ost.hid %look /hi |+pul] == :: diff --git a/lib/hood/kiln.hoon b/lib/hood/kiln.hoon index 07cd879de..4368d2e8a 100644 --- a/lib/hood/kiln.hoon +++ b/lib/hood/kiln.hoon @@ -416,6 +416,13 @@ :: ++ mere |= mes=(each (set path) (pair term tang)) + ?: ?=([%| %ali-sunk *] mes) + =. +>.$ + %^ spam + leaf+"merge cancelled because sunk, restarting" + (render "on sync" sud her syd) + ~ + start-sync:stop =. let +(let) =. +>.$ %- spam diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index d1bdb9d81..c6c7c6354 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -1,5 +1,5 @@ :: clay (4c), revision control -:: +!: :: This is split in three top-level sections: structure definitions, main :: logic, and arvo interface. :: @@ -298,7 +298,10 @@ :: :: Foreign desk data. :: -+= rung rus/(map desk rede) :: neighbor desks +++ rung + $: rit=rift :: lyfe of 1st contact + rus=(map desk rede) :: neighbor desks + == :: :: Hash of a commit, for lookup in the object store (hut.ran) :: @@ -370,6 +373,23 @@ $: @tas :: by any $% {$crud p/@tas q/(list tank)} :: == == == :: +-- +:: +:: Old state types for ++load +:: +=> |% +++ raft-1 + $: rom/room + hoy/(map ship rung-1) + ran/rang :: hashes + mon/(map term beam) + hez/(unit duct) + cez/(map @ta crew) + cue/(qeu [duct task:able]) + tip/@da + == ++= rung-1 rus/(map desk rede) +++ raft-2 raft -- => :: %utilities :: @@ -393,6 +413,7 @@ :: -- local urbit `our` :: -- current time `now` :: -- current duct `hen` +:: -- scry handler `ski` :: -- all vane state `++raft` (rarely used, except for the object store) :: -- target urbit `her` :: -- target desk `syd` @@ -430,11 +451,11 @@ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |% ++ de :: per desk - |= [our=ship now=@da hen=duct raft] + |= [our=ship now=@da ski=sley hen=duct raft] |= [her=ship syd=desk] :: XX ruf=raft crashes in the compiler :: - =* ruf |3.+6.^$ + =* ruf |4.+6.^$ :: =+ ^- [hun=(unit duct) rede] ?. =(our her) @@ -459,9 +480,11 @@ ?. =(our her) :: save foreign +rede :: - =/ rus rus:(fall (~(get by hoy.ruf) her) *rung) - =/ rug (~(put by rus) syd red) - ruf(hoy (~(put by hoy.ruf) her rug)) + =/ run (fall (~(get by hoy.ruf) her) *rung) + =? rit.run =(0 rit.run) + (fall (rift-scry her) *rift) + =/ rug (~(put by rus.run) syd red) + ruf(hoy (~(put by hoy.ruf) her run(rus rug))) :: save domestic +room :: %= ruf @@ -469,6 +492,20 @@ dos.rom (~(put by dos.rom.ruf) syd [qyx dom dok mer per pew]:red) == :: + :: +rift-scry: for a +rift + :: + ++ rift-scry + ~/ %rift-scry + |= who=ship + ^- (unit rift) + =; rit + ?~(rit ~ u.rit) + ;; (unit (unit rift)) + %- (sloy-light ski) + =/ pur=spur + /(scot %p who) + [[151 %noun] %j our %rift da+now pur] + :: :: Handle `%sing` requests :: ++ aver @@ -521,7 +558,8 @@ ~& [%clay-first-failure message.head.row] ~ ?: ?=([%success [%success *] [%error *]] row) - ~& [%clay-second-failure message.tail.row] + ~& %clay-second-failure + %- (slog message.tail.row) ~ ?. ?=([%success [%success *] [%success *]] row) ~ @@ -1759,6 +1797,7 @@ :* hen %pass [%foreign-x (scot %p our) (scot %p her) syd car (scot cas) pax] %f %build live=%.n %pin + :: XX perhaps should be now as in ++validate-plops (case-to-date cas) (vale-page [her syd] peg) == @@ -1870,7 +1909,14 @@ %- emit :* hen %pass [%foreign-plops (scot %p our) (scot %p her) syd lum ~] - %f %build live=%.n %pin (case-to-date cas) + %f %build live=%.n %pin + :: This corresponds to all the changes from [her syd] + :: to [our %home]. This should be (case-to-date cas) + :: in the context of the foreign desk, but since we're + :: getting everything from our own desk now we want to + :: use our most recent commit. + :: + now %list ^- (list schematic:ford) %+ turn ~(tap in pop) @@ -2816,12 +2862,14 @@ ++ me :: merge ali into bob |= {ali/(pair ship desk) alh/(unit dome) new/?} :: from =+ bob=`(pair ship desk)`[our syd] :: to + :: ?: &(?=(~ mer) !new) + :: ~& [%not-actually-merging ali=ali bob=bob hen=hen] + :: ..me =+ ^- dat/(each mery term) ?~ mer - ?: new - =+ *mery - [%& -(sor ali:+, hen hen:+, wat %null)] - [%| %not-actually-merging] + ?> new :: checked in ++take + =+ *mery + [%& -(sor ali:+, hen hen:+, wat %null)] ?. new ?: =(ali sor.u.mer) [%& u.mer] @@ -2940,7 +2988,9 @@ |= rot/riot ^+ +> ?~ rot - (error:he %bad-fetch-ali ~) + ?: (~(has by hoy) her) + (error:he %bad-fetch-ali ~) + (error:he %ali-sunk ~) =+ ^= dum :: construct an empty mime cache :: @@ -3174,7 +3224,7 @@ =+ (cat 3 %diff- nam) [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali - ~] %f %build live=%.n %pin - (case-to-date:((de our now hen ruf) p.oth q.oth) r.oth) + (case-to-date:((de our now ski hen ruf) p.oth q.oth) r.oth) %list ^- (list schematic:ford) %+ murn ~(tap by q.bas.dat) @@ -3701,8 +3751,8 @@ :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: =| :: instrument state - $: $1 :: vane version - ruf/raft :: revision tree + $: ver=%2 :: vane version + ruf=raft :: revision tree == :: |= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation ^? :: opaque core @@ -3733,7 +3783,7 @@ =/ des ~(tap in ~(key by dos.rom.ruf)) |- ?~ des [[[hen %give %mack ~] mos] ..^^$] - =/ den ((de our now hen ruf) our i.des) + =/ den ((de our now ski hen ruf) our i.des) =^ mor ruf =< abet:wake ?: ?=(^ cew.req) den @@ -3768,7 +3818,7 @@ :: $drop =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:drop-me:den [mos ..^$] :: @@ -3787,11 +3837,12 @@ ?: =(%$ des.req) [~ ..^$] =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:(edit:den now dit.req) [mos ..^$] :: $init + ~& [%init hen] [~ ..^$(hun.rom.ruf hen)] :: $into @@ -3827,7 +3878,7 @@ ?: =(%$ des.req) [~ ..^$] =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:abet:(start:(me:ze:den [her.req dem.req] ~ &) cas.req how.req) [mos ..^$] :: @@ -3844,7 +3895,7 @@ ?~ dos [~ ..^$] =^ mos ruf - =/ den ((de our now hen ruf) p.bem q.bem) + =/ den ((de our now ski hen ruf) p.bem q.bem) abet:(mont:den des.req bem) [mos ..^$] :: @@ -3882,23 +3933,32 @@ :: $perm =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:(perm:den pax.req rit.req) [mos ..^$] :: $sunk - !: + ~& rift=[p.req q.req] + ~& desks=(turn ~(tap by dos.rom.ruf) head) + ~& hoy=(turn ~(tap by hoy.ruf) head) :: if we sunk, don't clear clay :: ?: =(our p.req) [~ ..^$] :: cancel subscriptions :: - =/ foreign-desk=(map desk rede) - (fall (~(get by hoy.ruf) p.req) ~) + =/ foreign-desk=(unit rung) + (~(get by hoy.ruf) p.req) + ?~ foreign-desk + ~& [%never-heard-of-her p.req q.req] + [~ ..^$] + ~& old-rift=rit.u.foreign-desk + ?: (gte rit.u.foreign-desk q.req) + ~& 'replaying sunk, so not clearing state' + [~ ..^$] =/ cancel-ducts=(list duct) %- zing ^- (list (list duct)) - %+ turn ~(tap by foreign-desk) + %+ turn ~(tap by rus.u.foreign-desk) |= [=desk =rede] %+ weld ^- (list duct) %- zing ^- (list (list duct)) @@ -3915,12 +3975,12 @@ =/ clear-ford-cache-moves=(list move) :~ [hen %pass /clear/keep %f %keep 0 1] [hen %pass /clear/wipe %f %wipe 100] - [hen %pass /clear/kepe %f %keep 2.048 64] + [hen %pass /clear/kep %f %keep 2.048 64] == :: delete local state of foreign desk :: =. hoy.ruf (~(del by hoy.ruf) p.req) - [(weld cancel-moves clear-ford-cache-moves) ..^$] + [(weld clear-ford-cache-moves cancel-moves) ..^$] :: ?($warp $werp) :: capture whether this read is on behalf of another ship @@ -3935,7 +3995,7 @@ ?> ?=($warp -.req) =* rif rif.req =^ mos ruf - =/ den ((de our now hen ruf) wer.req p.rif) + =/ den ((de our now ski hen ruf) wer.req p.rif) =< abet ?~ q.rif cancel-request:den @@ -3957,7 +4017,7 @@ =+ syd=(slav %tas i.t.pax) =+ inx=(slav %ud i.t.t.pax) =^ mos ruf - =/ den ((de our now hen ruf) wer syd) + =/ den ((de our now ski hen ruf) wer syd) abet:(take-foreign-update:den inx ((hard (unit rand)) res.req)) [[[hen %give %mack ~] mos] ..^$] :: @@ -3977,11 +4037,34 @@ :: ++ load => |% - ++ axle $%([%1 ruf=raft]) + ++ axle $% [%1 ruf-1=raft-1] + [%2 ruf-2=raft] + == -- |= old=axle ^+ ..^$ - ..^$(ruf ruf.old) + =? old ?=(%1 -.old) + ~& desks=(turn ~(tap by dos.rom.ruf-1.old) head) + ~& hoy=(turn ~(tap by hoy.ruf-1.old) head) + (load-1-2 old) + ~& hrm=[-.old ver] + ?> ?=(%2 -.old) + ~& desks=(turn ~(tap by dos.rom.ruf-2.old) head) + ~& hoy=(turn ~(tap by hoy.ruf-2.old) head) + %_(..^$ ruf ruf-2.old) +:: +++ load-1-2 + |= [%1 ruf-1=raft-1] + ^- [%2 ruf-2=raft] + :- %2 + %= ruf-1 + hoy + %- ~(rut by hoy.ruf-1) + |= [her=ship run-1=rung-1] + ^- rung + :- (fall (rift-scry her) *rift) + rus.run-1 + == :: ++ scry :: inspect |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} @@ -4004,14 +4087,14 @@ ?: ?=(%| -.m) ~ ?: =(p.m his) ~ `p.m - =/ den ((de our now [/scryduct ~] ruf) his syd) + =/ den ((de our now ski [/scryduct ~] ruf) his syd) =+ (aver:den for u.run u.luk tyl) ?~ - - ?~ u.- - ?: ?=(%& -.u.u.-) ``p.u.u.- ~ :: -++ stay [%1 ruf] +++ stay [%2 ruf] ++ take :: accept response |= {tea/wire hen/duct hin/(hypo sign)} ^+ [*(list move) ..^$] @@ -4026,7 +4109,10 @@ %+ bind (~(get by dos.rom.ruf) sud) |=(a=dojo dom.a) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) + ?~ mer.den + ~& [%not-actually-merging ali=[her sud] bob=[our syd] hen=hen] + [~ ruf] abet:abet:(route:(me:ze:den [her sud] kan |) sat dat) [mos ..^$] ?: ?=({$blab care @ @ *} tea) @@ -4056,7 +4142,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-inserting:den wen result.q.hin) [mos ..^$] :: @@ -4065,7 +4151,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-diffing:den wen result.q.hin) [mos ..^$] :: @@ -4074,7 +4160,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-castify:den wen result.q.hin) [mos ..^$] :: @@ -4083,7 +4169,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-mutating:den wen result.q.hin) [mos ..^$] :: @@ -4091,7 +4177,7 @@ ?> ?=({@ @ ~} t.tea) =+ syd=(slav %tas i.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-patch:den result.q.hin) [mos ..^$] :: @@ -4099,7 +4185,7 @@ ?> ?=({@ @ ~} t.tea) =+ syd=(slav %tas i.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-ergo:den result.q.hin) [mos ..^$] :: @@ -4109,7 +4195,7 @@ =* syd i.t.t.t.tea =+ lem=(slav %da i.t.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) her syd) + =/ den ((de our now ski hen ruf) her syd) abet:(take-foreign-plops:den ?~(lem ~ `lem) result.q.hin) [mos ..^$] :: @@ -4124,7 +4210,7 @@ ->+ =* pax t.t.t.t.t.t.tea =^ mos ruf - =/ den ((de our now hen ruf) her syd) + =/ den ((de our now ski hen ruf) her syd) abet:(take-foreign-x:den car cas pax result.q.hin) [mos ..^$] == @@ -4221,4 +4307,17 @@ ?~ - `[paf %ins %mime -:!>(*mime) u.mim] `[paf %mut %mime -:!>(*mime) u.mim] +:: +rift-scry: for a +rift +:: +++ rift-scry + ~/ %rift-scry + |= who=ship + ^- (unit rift) + =; lyf + ?~(lyf ~ u.lyf) + ;; (unit (unit rift)) + %- (sloy-light ski) + =/ pur=spur + /(scot %p who) + [[151 %noun] %j our %rift da+now pur] -- diff --git a/sys/vane/jael.hoon b/sys/vane/jael.hoon index d85707fbf..e23685ec5 100644 --- a/sys/vane/jael.hoon +++ b/sys/vane/jael.hoon @@ -1,4 +1,4 @@ -:: :: /van/jael +!: :: /van/jael :: :: %reference/0 !? 150 :: @@ -1409,20 +1409,22 @@ :: :- (file-discontinuity who) %= ..file - :: these must be appended here; +abet flops them - :: - moz =/ lyf=life + moz =/ rit=rift ~| sunk-unknown+who - life:(~(got by kyz.puk)) - %+ weld moz - ^- (list move) - :~ [hen %slip %a %sunk who lyf] - [hen %slip %c %sunk who lyf] - [hen %slip %d %sunk who lyf] - [hen %slip %e %sunk who lyf] - [hen %slip %f %sunk who lyf] - [hen %slip %g %sunk who lyf] - == + =< continuity-number + %+ fall + net:(fall (~(get by pos.eth) who) *point) + *[life pass continuity-number=@ud [? @p] (unit @p)] + %+ weld + ^- (list move) + :~ [hen %slip %a %sunk who rit] + [hen %slip %c %sunk who rit] + [hen %slip %d %sunk who rit] + [hen %slip %e %sunk who rit] + [hen %slip %f %sunk who rit] + [hen %slip %g %sunk who rit] + == + moz == :: pon: updated point :: new: new keypair or "kept continuity?" (yes is no-op) @@ -2289,6 +2291,23 @@ =/ pub (~(get by kyz.puk.sub.lex) u.who) ?~ pub ~ ``[%atom !>(life.u.pub)] + :: + %rift + ?. ?=([@ ~] tyl) [~ ~] + ?. ?& ?=(%& -.why) + (~(has by pry.urb.lex) p.why) + == + [~ ~] + =/ who (slaw %p i.tyl) + ?~ who [~ ~] + :: fake ships always have rift=1 + :: + ?: fak.own.sub.lex + ``[%atom !>(1)] + =/ pos (~(get by pos.eth.sub.lex) u.who) + ?~ pos ~ + ?~ net.u.pos ~ + ``[%atom !>(continuity-number.u.net.u.pos)] :: %deed ?. ?=([@ @ ~] tyl) [~ ~] diff --git a/sys/zuse.hoon b/sys/zuse.hoon index 4a980c0ff..1b7e971fb 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -69,7 +69,8 @@ == :: ++ coop (unit ares) :: possible error -++ life @ud :: ship version +++ life @ud :: ship key revision +++ rift @ud :: ship continuity ++ mime {p/mite q/octs} :: mimetyped data ++ octs {p/@ud q/@t} :: octet-stream ++ sock {p/ship q/ship} :: outgoing [our his] @@ -241,7 +242,7 @@ [%init p=ship] :: report install {$kick p/@da} :: wake up {$nuke p/@p} :: toggle auto-block - {$sunk p=ship q=life} :: report death + {$sunk p=ship q=rift} :: report death {$wake ~} :: timer activate {$wegh ~} :: report memory {$west p/ship q/path r/*} :: network request @@ -474,7 +475,7 @@ {$dirk des/desk} :: mark mount dirty {$ogre pot/$@(desk beam)} :: delete mount point {$perm des/desk pax/path rit/rite} :: change permissions - {$sunk p=ship q=life} :: report death + {$sunk p=ship q=rift} :: report death {$warp wer/ship rif/riff} :: internal file req {$werp who/ship wer/ship rif/riff} :: external file req {$wegh ~} :: report memory @@ -638,7 +639,7 @@ {$harm ~} :: all terms hung up {$init p/ship} :: after gall ready {$noop ~} :: no operation - {$sunk p=ship q=life} :: report death + {$sunk p=ship q=rift} :: report death {$talk p/tank} :: {$text p/tape} :: {$veer p/@ta q/path r/@t} :: install vane @@ -735,7 +736,7 @@ [%live p=@ud q=(unit @ud)] :: http/s ports [%rule p=http-rule] :: update config [%serv p=$@(desk beam)] :: set serving root - [%sunk p=ship q=life] :: report death + [%sunk p=ship q=rift] :: report death [%them p=(unit hiss)] :: outbound request [%they p=@ud q=httr] :: inbound response [%chis p=? q=clip r=httq] :: IPC inbound request @@ -976,7 +977,7 @@ [%kill ~] :: %sunk: receive a report that a foreign ship has lost continuity :: - [%sunk =ship =life] + [%sunk =ship =rift] :: %wegh: produce memory usage information :: [%wegh ~] @@ -1667,7 +1668,7 @@ $% {$conf p/dock q/culm} :: configure app {$init p/ship} :: set owner {$deal p/sock q/cush} :: full transmission - {$sunk p=ship q/life} :: report death + {$sunk p=ship q/rift} :: report death {$west p/ship q/path r/*} :: network request {$wegh ~} :: report memory == :: @@ -1813,7 +1814,7 @@ == == :: $: @tas :: $% [%init p=ship] :: report install - [%sunk p=ship q=life] :: report death + [%sunk p=ship q=rift] :: report death == == == :: ++ public :: public key state $: life=life :: current key number From 88579c518f54965c8094c8dc2c375390c538f684 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 1 Feb 2019 13:49:14 -0800 Subject: [PATCH 04/55] here updates --- app/here.hoon | 344 ++++++++++++++++++++++++++++++++++++++++++++++++++ mar/pill.hoon | 36 ++++++ sur/pill.hoon | 12 ++ 3 files changed, 392 insertions(+) create mode 100644 app/here.hoon create mode 100644 mar/pill.hoon create mode 100644 sur/pill.hoon diff --git a/app/here.hoon b/app/here.hoon new file mode 100644 index 000000000..6a1422467 --- /dev/null +++ b/app/here.hoon @@ -0,0 +1,344 @@ +:: usage: +:: /- pill +:: =p .^(pill:pill %cx %/urbit/pill) +:: |start %here +:: :here &pill p +:: :here %init +:: :here [%dojo "+ls %"] +:: :here [%dojo "our"] +:: +:: TODO: +:: - proper ames routing +:: - save pier point by label +:: - allow cancelling timer +:: - snapshot should keep track of outstanding timers +:: - %init should cancel outstanding timers +:: - allow pausing timer +:: - all commands should allow multiple ships +/- pill +=, pill +=> $~ |% + ++ move (pair bone card) + ++ card + $% [%turf wire ~] + [%vein wire] + [%look wire src=(each ship purl:eyre)] + [%wind wire p=@ud] + [%snap wire snap=snapshot:jael kick=?] + [%wait wire p=@da] + [%rest wire p=@da] + == + ++ unix-effect + %+ pair wire + $% [%blit p=(list blit:dill)] + [%send p=lane:ames q=@] + [%doze p=(unit @da)] + == + ++ state + $: pil=pill + assembled=* + fleet-snaps=(map term (map ship pier)) + piers=(map ship pier) + == + ++ pier + $: snap=* + event-log=(list unix-event) + next-events=(qeu unix-event) + processing-events=? + next-timer=(unit @da) + == + -- +=, gall +|_ $: hid/bowl + state + == +++ pe + |= who=ship + =+ (fall (~(get by piers) who) *pier) + =* pier-data - + =| moves=(list move) + |% + ++ abet + ^- (quip move _this) + =. piers (~(put by piers) who pier-data) + [(flop moves) this] + :: + ++ apex + =. snap assembled + ~& r=(met 3 (jam snap)) + ..abet + :: + ++ push-events + |= ova=(list unix-event) + ^+ ..abet + =. next-events (~(gas to next-events) ova) + ..abet + :: + ++ emit-moves + |= ms=(list move) + =. moves (weld ms moves) + ..abet + :: + ++ plow + |- ^+ ..abet + ?: =(~ next-events) + ..abet + ?. processing-events + ..abet + =^ ovo next-events ~(get to next-events) + =/ res (mox +47.snap) + ?> ?=(%0 -.res) + =+ poke=p.res + =+ res=(slum poke now.hid ovo) + =. event-log [ovo event-log] + =. snap +3.res + =. ..abet (handle-effects ((list ovum) -.res)) + $ + :: + ++ start-processing-events .(processing-events &) + ++ stop-processing-events .(processing-events |) + ++ mox |=(* (mock [snap +<] scry)) + :: + ++ handle-effects + |= effects=(list ovum) + ^+ ..abet + ?~ effects + ..abet + =. ..abet + =/ sof ((soft unix-effect) i.effects) + ?~ sof + ~& [%unknown-effect i.effects] + ..abet + ?- -.q.u.sof + %blit + =/ last-line + %+ roll p.q.u.sof + |= [b=blit:dill line=tape] + ?- -.b + %lin (tape p.b) + %mor ~& line "" + %hop line + %bel line + %clr "" + %sag ~& [%save-jamfile-to p.b] line + %sav ~& [%save-file-to p.b] line + %url ~& [%activate-url p.b] line + == + ~& last-line + ..abet + :: + %send (handle-send u.sof) + %doze (handle-doze u.sof) + == + $(effects t.effects) + :: + ++ handle-send + |= [way=wire %send lan=lane:ames pac=@] + ^+ ..abet + =/ dest-ip + |- ^- (unit @if) + ?- -.lan + %if `r.lan + %is ?~(q.lan ~ $(lan u.q.lan)) + %ix `r.lan + == + ?~ dest-ip + ~& [%sending-no-destination who lan] + ..abet + ?. &(=(0 (rsh u.dest-ip 0 16)) =(1 (rsh u.dest-ip 0 8))) + ~& [%havent-implemented-direct-lanes who lan] + ..abet + =/ her=ship (dis u.dest-ip 0xff) + =/ hear [//newt/0v1n.2m9vh %hear lan pac]~ + ~& [%sending who=who her=her] + =^ ms this + abet:(push-events:(pe her) hear) + (emit-moves ms) + :: + ++ handle-doze + |= [way=wire %doze tim=(unit @da)] + ^+ ..abet + ?~ tim + ?~ next-timer + ..abet + cancel-timer + ?~ next-timer + (set-timer u.tim) + (set-timer:cancel-timer u.tim) + :: + ++ set-timer + |= tim=@da + =. tim +(tim) :: nobody's perfect + =. next-timer `tim + ~& [%sleeping-until who tim] + (emit-moves [ost.hid %wait /(scot %p who) tim]~) + :: + ++ cancel-timer + ~& [%cancelling-timer who] + (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) + -- +++ this . +++ plow-all + |- ^- (quip move _this) + =/ who + =/ pers ~(tap by piers) + |- ^- (unit ship) + ?~ pers + ~ + ?: &(?=(^ next-events.q.i.pers) processing-events.q.i.pers) + ~& [%new-events p.i.pers] + `p.i.pers + ~& [%no-new-events p.i.pers] + $(pers t.pers) + ~& plowing=who + ?~ who + `this + =^ moves this abet:plow:(pe u.who) + =/ nex $ + nex(- (weld -.nex moves)) +:: +++ poke-pill + |= p=pill + ^- (quip move _this) + =. pil p + ~& lent=(met 3 (jam boot-ova.pil)) + =/ res=toon :: (each * (list tank)) + (mock [boot-ova.pil [2 [0 3] [0 2]]] scry) + ?- -.res + %0 + ~& %suc + =. assembled +7.p.res + `this + :: + %1 + ~& [%vere-blocked p.res] + `this + :: + %2 + ~& %vere-fail + %- (slog p.res) + `this + == +:: +++ poke-noun + |= val=* + ^- (quip move _this) + ?+ val ~|(%bad-noun-arg !!) + [%init whos=*] + =/ whos ((list ship) whos.val) + |- ^- (quip move _this) + ?~ whos + `this + ?~ userspace-ova.pil + ~& %no-userspace + `this + =+ who=i.whos + ~& [%initting who] + => .(this ^+(this this)) + =^ moves this + =< abet:plow + %- push-events:apex:(pe who) + ^- (list unix-event) + :~ + `unix-event`[/ %wack 0] :: eny + `unix-event`[/ %whom who] :: eny + `unix-event`[//newt/0v1n.2m9vh %barn ~] + `unix-event`[//behn/0v1n.2m9vh %born ~] + `unix-event`[//term/1 %boot %fake who] + `unix-event`-.userspace-ova.pil + `unix-event`[//http/0v1n.2m9vh %live 8.080 `8.445] + `unix-event`[//term/1 %belt %ctl `@c`%x] + == + =^ moves-all this plow-all + =/ nex $(whos t.whos) + nex(- (weld -.nex (weld moves moves-all))) + :: + [%dojo who=@p p=*] + =^ moves this + =< abet:plow + %- push-events:(pe who.val) + ^- (list unix-event) + :~ + [//term/1 %belt %ctl `@c`%e] + [//term/1 %belt %ctl `@c`%u] + [//term/1 %belt %txt ((list @c) (tape p.val))] + [//term/1 %belt %ret ~] + == + =^ moves-all this plow-all + [(weld moves moves-all) this] + :: + [%snap-fleet lab=@tas] + =. fleet-snaps (~(put by fleet-snaps) lab.val piers) + `this + :: + [%restore-fleet lab=@tas] + =. piers (~(got by fleet-snaps) lab.val) + `this + :: + [%peek who=@p p=*] + :: =+ res=(mox +46.snap) + :: ?> ?=(%0 -.res) + :: =+ peek=p.res + :: ~& (slum peek p.val) + `this + :: + [%wish who=@p p=@t] + :: =+ res=(mox +22.snap) + :: ?> ?=(%0 -.res) + :: =+ wish=p.res + :: ~& (slum wish p.val) + `this + :: + %clear-next + :: =. next-events ~ + `this + :: + [%unpause-events hers=*] + %+ execute-turn ((list ship) hers.val) + |= who=ship + start-processing-events:(pe who) + :: + [%pause-events hers=*] + %+ execute-turn ((list ship) hers.val) + |= who=ship + stop-processing-events:(pe who) + == +:: +++ execute-turn + |= [hers=(list ship) fun=$-([ship] _(pe))] + |- ^- (quip move _this) + ?~ hers + =^ moves this plow-all + [moves this] + =^ moves this + abet:plow:(fun i.hers) + =/ nex $(hers t.hers) + nex(- (weld moves -.nex)) +:: +++ wake + |= [way=wire ~] + ^- (quip move _this) + ?> ?=([@ ~] way) + =/ who (,@p (slav %p i.way)) + ~& [%waking who] + =^ moves this + =< abet:plow + %- push-events:(pe who) + ^- (list unix-event) + :~ [//behn/0v1n.2m9vh %wake ~] + == + =^ moves-all this plow-all + [(weld moves moves-all) this] +:: +++ scry |=([* *] ~) +:: +++ prep + |= old/(unit noun) + ^- [(list move) _+>.$] + ?~ old + `+>.$ + =+ new=((soft state) u.old) + ?~ new + `+>.$ + `+>.$(+<+ u.new) +-- diff --git a/mar/pill.hoon b/mar/pill.hoon new file mode 100644 index 000000000..1f0c6447e --- /dev/null +++ b/mar/pill.hoon @@ -0,0 +1,36 @@ +:: +:::: /hoon/pill/mar + :: +/- pill +=, pill +=, mimes:html +|_ pil=pill +++ grow + |% + ++ mime [/application/octet-stream (as-octs (jam pil))] + -- +++ grab + |% + ++ noun pill + ++ mime + |= [p=mite:eyre q=octs:eyre] + =+ o=(pair ,* ,*) :: ,*) + =+ (,[boot-ova=* kernel-ova=(list o) userspace-ova=(list o)] (cue q.q)) + =/ convert + |= ova=(list o) + ^- (list unix-event) + %+ turn ova + |= ovo=o + =/ sof ((soft unix-event) ovo) + ?~ sof + ~& [%unknown-event p.ovo] + !! + ~& [%known-event (wire p.ovo) (@tas -.q.ovo)] + u.sof + :: =/ boot-ova (convert boot-ova) + =/ kernel-ova (convert kernel-ova) + =/ userspace-ova (convert userspace-ova) + [boot-ova kernel-ova userspace-ova] + -- +++ grad %mime +-- diff --git a/sur/pill.hoon b/sur/pill.hoon new file mode 100644 index 000000000..33d06604b --- /dev/null +++ b/sur/pill.hoon @@ -0,0 +1,12 @@ +|% +++ unix-event + %+ pair wire + $% [%wack p=@] + [%whom p=ship] + [%live p=@ud q=(unit @ud)] + [%barn ~] + [%boot %fake p=ship] + unix-task + == ++= pill [boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)] +-- From 6138daf40c1d0182ae37c9a583a7c80978997ab5 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 1 Feb 2019 17:00:15 -0800 Subject: [PATCH 05/55] aquarium boots a fleet --- app/{here.hoon => aqua.hoon} | 256 +++++++++++++++++++++++------------ sys/vane/gall.hoon | 63 ++++----- 2 files changed, 198 insertions(+), 121 deletions(-) rename app/{here.hoon => aqua.hoon} (50%) diff --git a/app/here.hoon b/app/aqua.hoon similarity index 50% rename from app/here.hoon rename to app/aqua.hoon index 6a1422467..34b24bc87 100644 --- a/app/here.hoon +++ b/app/aqua.hoon @@ -1,11 +1,11 @@ :: usage: :: /- pill :: =p .^(pill:pill %cx %/urbit/pill) -:: |start %here -:: :here &pill p -:: :here %init -:: :here [%dojo "+ls %"] -:: :here [%dojo "our"] +:: |start %aqua +:: :aqua &pill p +:: :aqua %init +:: :aqua [%dojo "+ls %"] +:: :aqua [%dojo "our"] :: :: TODO: :: - proper ames routing @@ -15,17 +15,16 @@ :: - %init should cancel outstanding timers :: - allow pausing timer :: - all commands should allow multiple ships +:: - shared command line across ships would be cool +:: +:: We get ++unix-event and ++pill from /-pill +:: /- pill =, pill => $~ |% ++ move (pair bone card) ++ card - $% [%turf wire ~] - [%vein wire] - [%look wire src=(each ship purl:eyre)] - [%wind wire p=@ud] - [%snap wire snap=snapshot:jael kick=?] - [%wait wire p=@da] + $% [%wait wire p=@da] [%rest wire p=@da] == ++ unix-effect @@ -35,7 +34,8 @@ [%doze p=(unit @da)] == ++ state - $: pil=pill + $: %0 + pil=pill assembled=* fleet-snaps=(map term (map ship pier)) piers=(map ship pier) @@ -52,6 +52,9 @@ |_ $: hid/bowl state == +:: +:: Represents a single ship's state. +:: ++ pe |= who=ship =+ (fall (~(get by piers) who) *pier) @@ -64,6 +67,7 @@ [(flop moves) this] :: ++ apex + =. pier-data *pier =. snap assembled ~& r=(met 3 (jam snap)) ..abet @@ -79,6 +83,8 @@ =. moves (weld ms moves) ..abet :: + :: Process the events in our queue. + :: ++ plow |- ^+ ..abet ?: =(~ next-events) @@ -95,9 +101,15 @@ =. ..abet (handle-effects ((list ovum) -.res)) $ :: + ++ mox |=(* (mock [snap +<] scry)) + :: + :: Start/stop processing events. When stopped, events are added to + :: our queue but not processed. + :: ++ start-processing-events .(processing-events &) ++ stop-processing-events .(processing-events |) - ++ mox |=(* (mock [snap +<] scry)) + :: + :: Handle all the effects produced by a single event. :: ++ handle-effects |= effects=(list ovum) @@ -110,28 +122,47 @@ ~& [%unknown-effect i.effects] ..abet ?- -.q.u.sof - %blit - =/ last-line - %+ roll p.q.u.sof - |= [b=blit:dill line=tape] - ?- -.b - %lin (tape p.b) - %mor ~& line "" - %hop line - %bel line - %clr "" - %sag ~& [%save-jamfile-to p.b] line - %sav ~& [%save-file-to p.b] line - %url ~& [%activate-url p.b] line - == - ~& last-line - ..abet - :: + %blit (handle-blit u.sof) %send (handle-send u.sof) %doze (handle-doze u.sof) == $(effects t.effects) :: + :: Would love to see a proper stateful terminal handler. Ideally, + :: you'd be able to ^X into the virtual ship, like the old ^W. + :: + :: However, that's porbably not the primary way of interacting with + :: it. In practice, most of the time you'll be running from a file + :: (eg for automated testing) or fanning the same command to multiple + :: ships or otherwise making use of the fact that we can + :: programmatically send events. + :: + ++ handle-blit + |= [way=wire %blit blits=(list blit:dill)] + ^+ ..abet + =/ last-line + %+ roll blits + |= [b=blit:dill line=tape] + ?- -.b + %lin (tape p.b) + %mor ~& "{}: {line}" "" + %hop line + %bel line + %clr "" + %sag ~& [%save-jamfile-to p.b] line + %sav ~& [%save-file-to p.b] line + %url ~& [%activate-url p.b] line + == + ~& last-line + ..abet + :: + :: This needs a better SDN solution. Every ship should have an IP + :: address, and we should eventually test changing those IP + :: addresses. + :: + :: For now, we broadcast every packet to every ship and rely on them + :: to drop them. + :: ++ handle-send |= [way=wire %send lan=lane:ames pac=@] ^+ ..abet @@ -145,15 +176,23 @@ ?~ dest-ip ~& [%sending-no-destination who lan] ..abet - ?. &(=(0 (rsh u.dest-ip 0 16)) =(1 (rsh u.dest-ip 0 8))) + ?. &(=(0 (rsh 0 16 u.dest-ip)) =(1 (rsh 0 8 u.dest-ip))) ~& [%havent-implemented-direct-lanes who lan] ..abet - =/ her=ship (dis u.dest-ip 0xff) - =/ hear [//newt/0v1n.2m9vh %hear lan pac]~ - ~& [%sending who=who her=her] - =^ ms this - abet:(push-events:(pe her) hear) - (emit-moves ms) + ~& [%blast-sending who=who] + =/ hear [//newt/0v1n.2m9vh %hear lan pac] + =. this (blast-event hear) + :: =/ her ?:(=(~dev who) ~bud ~dev) ::ship (dis u.dest-ip 0xff) + :: ?. (~(has by piers) her) + :: ~& [%dropping who=who her=her] + :: ..abet + :: ~& [%sending who=who her=her ip=`@ux`u.dest-ip] + :: =^ ms this + :: abet:(push-events:(pe her) ~[hear]) + ..abet + :: + :: Would love to be able to control time more precisely, jumping + :: forward and whatnot. :: ++ handle-doze |= [way=wire %doze tim=(unit @da)] @@ -177,7 +216,11 @@ ~& [%cancelling-timer who] (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) -- +:: ++ this . +:: +:: Run all events on all ships until all queues are empty +:: ++ plow-all |- ^- (quip move _this) =/ who @@ -188,7 +231,6 @@ ?: &(?=(^ next-events.q.i.pers) processing-events.q.i.pers) ~& [%new-events p.i.pers] `p.i.pers - ~& [%no-new-events p.i.pers] $(pers t.pers) ~& plowing=who ?~ who @@ -197,6 +239,9 @@ =/ nex $ nex(- (weld -.nex moves)) :: +:: Load a pill and assemble arvo. Doesn't send any of the initial +:: events. +:: ++ poke-pill |= p=pill ^- (quip move _this) @@ -220,52 +265,46 @@ `this == :: +:: Handle commands +:: +:: Should put some thought into arg structure, maybe make a mark. +:: ++ poke-noun |= val=* ^- (quip move _this) + :: Could potentially factor out the three lines of turn-ships + :: boilerplate + :: ?+ val ~|(%bad-noun-arg !!) [%init whos=*] - =/ whos ((list ship) whos.val) - |- ^- (quip move _this) - ?~ whos - `this - ?~ userspace-ova.pil - ~& %no-userspace - `this - =+ who=i.whos + %+ turn-ships ((list ship) whos.val) + |= [who=ship thus=_this] + =. this thus ~& [%initting who] - => .(this ^+(this this)) - =^ moves this - =< abet:plow - %- push-events:apex:(pe who) - ^- (list unix-event) - :~ - `unix-event`[/ %wack 0] :: eny - `unix-event`[/ %whom who] :: eny - `unix-event`[//newt/0v1n.2m9vh %barn ~] - `unix-event`[//behn/0v1n.2m9vh %born ~] - `unix-event`[//term/1 %boot %fake who] - `unix-event`-.userspace-ova.pil - `unix-event`[//http/0v1n.2m9vh %live 8.080 `8.445] - `unix-event`[//term/1 %belt %ctl `@c`%x] - == - =^ moves-all this plow-all - =/ nex $(whos t.whos) - nex(- (weld -.nex (weld moves moves-all))) + %- push-events:apex:(pe who) + ^- (list unix-event) + :~ `unix-event`[/ %wack 0] :: eny + `unix-event`[/ %whom who] :: eny + `unix-event`[//newt/0v1n.2m9vh %barn ~] + `unix-event`[//behn/0v1n.2m9vh %born ~] + `unix-event`[//term/1 %boot %fake who] + `unix-event`-.userspace-ova.pil + `unix-event`[//http/0v1n.2m9vh %live 8.080 `8.445] + `unix-event`[//term/1 %belt %ctl `@c`%x] + == :: - [%dojo who=@p p=*] - =^ moves this - =< abet:plow - %- push-events:(pe who.val) - ^- (list unix-event) - :~ - [//term/1 %belt %ctl `@c`%e] - [//term/1 %belt %ctl `@c`%u] - [//term/1 %belt %txt ((list @c) (tape p.val))] - [//term/1 %belt %ret ~] - == - =^ moves-all this plow-all - [(weld moves moves-all) this] + [%dojo whos=* command=*] + %+ turn-ships ((list ship) whos.val) + |= [who=ship thus=_this] + =. this thus + %- push-events:(pe who) + ^- (list unix-event) + :~ + [//term/1 %belt %ctl `@c`%e] + [//term/1 %belt %ctl `@c`%u] + [//term/1 %belt %txt ((list @c) (tape command.val))] + [//term/1 %belt %ret ~] + == :: [%snap-fleet lab=@tas] =. fleet-snaps (~(put by fleet-snaps) lab.val piers) @@ -276,6 +315,7 @@ `this :: [%peek who=@p p=*] + :: should resurrect :: =+ res=(mox +46.snap) :: ?> ?=(%0 -.res) :: =+ peek=p.res @@ -283,37 +323,69 @@ `this :: [%wish who=@p p=@t] + :: should resurrect :: =+ res=(mox +22.snap) :: ?> ?=(%0 -.res) :: =+ wish=p.res :: ~& (slum wish p.val) `this - :: - %clear-next - :: =. next-events ~ - `this :: [%unpause-events hers=*] - %+ execute-turn ((list ship) hers.val) - |= who=ship + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus start-processing-events:(pe who) :: [%pause-events hers=*] - %+ execute-turn ((list ship) hers.val) - |= who=ship + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus stop-processing-events:(pe who) == :: -++ execute-turn - |= [hers=(list ship) fun=$-([ship] _(pe))] +:: Run a callback function against a list of ships, aggregating state +:: and plowing all ships at the end. +:: +:: I think we should use patterns like this more often. Because we +:: don't, here's some points to be aware. +:: +:: `fun` must take `this` as a parameter, since it needs to be +:: downstream of previous state changes. You could use `state` as +:: the state variable, but it muddles the code and it's not clear +:: whether it's better. You could use the `_(pe)` core if you're +:: sure you'll never need to refer to anything outside of your pier, +:: but I don't think we can guarantee that. +:: +:: The callback function must start with `=. this thus`, or else +:: you don't get the new state. Would be great if you could hot-swap +:: that context in here, but we don't know where to put it unless we +:: restrict the callbacks to always have `this` at a particular axis, +:: and that doesn't feel right +:: +++ turn-ships + |= [hers=(list ship) fun=$-([ship _this] _(pe))] |- ^- (quip move _this) ?~ hers =^ moves this plow-all [moves this] =^ moves this - abet:plow:(fun i.hers) - =/ nex $(hers t.hers) - nex(- (weld moves -.nex)) + abet:plow:(fun i.hers this) + =^ nex-moves this $(hers t.hers, this this) + [(weld moves nex-moves) this] +:: +:: Send the same event to all ships +:: +++ blast-event + |= ovo=unix-event + =/ pers ~(tap by piers) + |- ^+ this + ?~ pers + this + =^ moves-dropped this + abet:(push-events:(pe p.i.pers) ~[ovo]) + $(pers t.pers) +:: +:: Received timer wake :: ++ wake |= [way=wire ~] @@ -330,8 +402,12 @@ =^ moves-all this plow-all [(weld moves moves-all) this] :: +:: Trivial scry for mock +:: ++ scry |=([* *] ~) :: +:: Throw away old state if it doesn't soft to new state. +:: ++ prep |= old/(unit noun) ^- [(list move) _+>.$] diff --git a/sys/vane/gall.hoon b/sys/vane/gall.hoon index 5eff555a6..e0a96ca3a 100644 --- a/sys/vane/gall.hoon +++ b/sys/vane/gall.hoon @@ -1258,37 +1258,38 @@ ^- (unit @tas) ?+ sep ~& [%ap-vain sep] ~ - $build `%f - $cash `%a - $conf `%g - $cred `%c - $crew `%c - $crow `%c - $deal `%g - $dirk `%c - $drop `%c - $flog `%d - $info `%c - $keep `%f - $kill `%f - $look `%j - $merg `%c - $mint `%j - $mont `%c - $nuke `%a - $ogre `%c - $perm `%c - $rule `%e - $serv `%e - $snap `%j - $them `%e - $wait `%b - $want `%a - $warp `%c - $well `%e - $well `%e - $wind `%j - $wipe `%f + %build `%f + %cash `%a + %conf `%g + %cred `%c + %crew `%c + %crow `%c + %deal `%g + %dirk `%c + %drop `%c + %flog `%d + %info `%c + %keep `%f + %kill `%f + %look `%j + %merg `%c + %mint `%j + %mont `%c + %nuke `%a + %ogre `%c + %perm `%c + %rest `%b + %rule `%e + %serv `%e + %snap `%j + %them `%e + %wait `%b + %want `%a + %warp `%c + %well `%e + %well `%e + %wind `%j + %wipe `%f == -- -- From 54a618723c97f9aea1737e724646bd79de85726e Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 1 Feb 2019 17:14:11 -0800 Subject: [PATCH 06/55] comments --- app/aqua.hoon | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 34b24bc87..b9ff29ce7 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -1,21 +1,16 @@ :: usage: -:: /- pill -:: =p .^(pill:pill %cx %/urbit/pill) :: |start %aqua -:: :aqua &pill p -:: :aqua %init -:: :aqua [%dojo "+ls %"] -:: :aqua [%dojo "our"] +:: /- pill +:: :aqua &pill .^(pill:pill %cx %/urbit/pill) +:: :aqua [%init ~[~bud ~dev]] +:: :aqua [%dojo ~[~bud ~dev] "[our eny (add 3 5)]"] +:: :aqua [%dojo ~[~bud] "|hi ~dev"] +:: :aqua [%pause-events ~[~bud ~dev]] :: :: TODO: -:: - proper ames routing -:: - save pier point by label -:: - allow cancelling timer :: - snapshot should keep track of outstanding timers :: - %init should cancel outstanding timers -:: - allow pausing timer -:: - all commands should allow multiple ships -:: - shared command line across ships would be cool +:: :: :: We get ++unix-event and ++pill from /-pill :: From ea2746588110625883b40e97395cb341e15d7ed6 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 4 Feb 2019 14:13:20 -0800 Subject: [PATCH 07/55] add outgoing http support and proper restoring --- app/aqua.hoon | 172 ++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 153 insertions(+), 19 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index b9ff29ce7..8ba3bd995 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -7,10 +7,6 @@ :: :aqua [%dojo ~[~bud] "|hi ~dev"] :: :aqua [%pause-events ~[~bud ~dev]] :: -:: TODO: -:: - snapshot should keep track of outstanding timers -:: - %init should cancel outstanding timers -:: :: :: We get ++unix-event and ++pill from /-pill :: @@ -21,12 +17,14 @@ ++ card $% [%wait wire p=@da] [%rest wire p=@da] + [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] == ++ unix-effect %+ pair wire $% [%blit p=(list blit:dill)] [%send p=lane:ames q=@] [%doze p=(unit @da)] + [%thus p=@ud q=(unit hiss:eyre)] == ++ state $: %0 @@ -41,6 +39,7 @@ next-events=(qeu unix-event) processing-events=? next-timer=(unit @da) + http-requests=(set @ud) == -- =, gall @@ -96,6 +95,39 @@ =. ..abet (handle-effects ((list ovum) -.res)) $ :: + :: Restart outstanding requests + :: + ++ restore + ^+ ..abet + :: Restore behn + :: + =. ..abet + ?~ next-timer + ..abet + (set-timer u.next-timer) + :: Restore eyre + :: + =. http-requests ~ + =. ..abet (push-events [//http/0v1n.2m9vh %born ~]~) + ..abet + :: + :: Cancel outstanding requests + :: + ++ sleep + ^+ ..abet + :: Sleep behn + :: + =. ..abet + ?~ next-timer + ..abet + cancel-timer + :: Sleep eyre + :: + :: Eyre doesn't support cancelling HTTP requests from userspace. + :: + =. http-requests ~ + ..abet + :: ++ mox |=(* (mock [snap +<] scry)) :: :: Start/stop processing events. When stopped, events are added to @@ -114,12 +146,13 @@ =. ..abet =/ sof ((soft unix-effect) i.effects) ?~ sof - ~& [%unknown-effect i.effects] + ~& [who=who %unknown-effect i.effects] ..abet ?- -.q.u.sof %blit (handle-blit u.sof) %send (handle-send u.sof) %doze (handle-doze u.sof) + %thus (handle-thus u.sof) == $(effects t.effects) :: @@ -210,6 +243,64 @@ ++ cancel-timer ~& [%cancelling-timer who] (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) + :: + ++ take-wake + |= [way=wire ~] + =. next-timer ~ + %- push-events:(pe who) + [//behn/0v1n.2m9vh %wake ~]~ + :: + :: Handle outgoing HTTP request + :: + ++ handle-thus + |= [way=wire %thus num=@ud req=(unit hiss:eyre)] + ^+ ..abet + ?~ req + ?. (~(has in http-requests) num) + ..abet + :: Eyre doesn't support cancelling HTTP requests from userspace, + :: so we remove it from our state so we won't pass along the + :: response. + :: + ~& [%cant-cancel-thus who=who num=num] + =. http-requests (~(del in http-requests) num) + ..abet + =. http-requests (~(put in http-requests) num) + %- emit-moves :_ ~ + :* ost.hid + %hiss + /(scot %p who)/(scot %ud num) + ~ + %httr + [%hiss u.req] + == + :: + :: Pass HTTP response back to virtual ship + :: + ++ take-sigh-httr + |= [way=wire res=httr:eyre] + ^+ ..abet + ?> ?=([@ ~] way) + =/ num (slav %ud i.way) + ?. (~(has in http-requests) num) + ~& [%ignoring-httr who=who num=num] + ..abet + =. http-requests (~(del in http-requests) num) + (push-events [//http/0v1n.2m9vh %they num res]~) + :: + :: Got error in HTTP response + :: + ++ take-sigh-tang + |= [way=wire tan=tang] + ^+ ..abet + ?> ?=([@ ~] way) + =/ num (slav %ud i.way) + ?. (~(has in http-requests) num) + ~& [%ignoring-httr who=who num=num] + ..abet + =. http-requests (~(del in http-requests) num) + %- (slog tan) + ..abet -- :: ++ this . @@ -271,8 +362,8 @@ :: boilerplate :: ?+ val ~|(%bad-noun-arg !!) - [%init whos=*] - %+ turn-ships ((list ship) whos.val) + [%init hers=*] + %+ turn-ships ((list ship) hers.val) |= [who=ship thus=_this] =. this thus ~& [%initting who] @@ -284,12 +375,13 @@ `unix-event`[//behn/0v1n.2m9vh %born ~] `unix-event`[//term/1 %boot %fake who] `unix-event`-.userspace-ova.pil + `unix-event`[//http/0v1n.2m9vh %born ~] `unix-event`[//http/0v1n.2m9vh %live 8.080 `8.445] `unix-event`[//term/1 %belt %ctl `@c`%x] == :: - [%dojo whos=* command=*] - %+ turn-ships ((list ship) whos.val) + [%dojo hers=* command=*] + %+ turn-ships ((list ship) hers.val) |= [who=ship thus=_this] =. this thus %- push-events:(pe who) @@ -300,14 +392,34 @@ [//term/1 %belt %txt ((list @c) (tape command.val))] [//term/1 %belt %ret ~] == + :: + [%raw-event hers=* ovo=*] + =/ ovo ((soft unix-event) ovo.val) + ?~ ovo + ~& %ovo-not-an-event + `this + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus + (push-events:(pe who) ~[u.ovo]) :: [%snap-fleet lab=@tas] =. fleet-snaps (~(put by fleet-snaps) lab.val piers) `this :: [%restore-fleet lab=@tas] + =^ moves-1 this + %+ turn-ships (turn ~(tap by piers) head) + |= [who=ship thus=_this] + =. this thus + sleep:(pe who) =. piers (~(got by fleet-snaps) lab.val) - `this + =^ moves-2 this + %+ turn-ships (turn ~(tap by piers) head) + |= [who=ship thus=_this] + =. this thus + restore:(pe who) + [(weld moves-1 moves-2) this] :: [%peek who=@p p=*] :: should resurrect @@ -385,17 +497,39 @@ ++ wake |= [way=wire ~] ^- (quip move _this) - ?> ?=([@ ~] way) + ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) ~& [%waking who] - =^ moves this - =< abet:plow - %- push-events:(pe who) - ^- (list unix-event) - :~ [//behn/0v1n.2m9vh %wake ~] - == - =^ moves-all this plow-all - [(weld moves moves-all) this] + %+ turn-ships ~[who] + |= [who=ship thus=_this] + =. this thus + (take-wake:(pe who) t.way ~) +:: +:: Received inbound HTTP response +:: +++ sigh-httr + |= [way=wire res=httr:eyre] + ^- (quip move _this) + ?> ?=([@ *] way) + =/ who (,@p (slav %p i.way)) + ~& [%received-httr who] + %+ turn-ships ~[who] + |= [who=ship thus=_this] + =. this thus + (take-sigh-httr:(pe who) t.way res) +:: +:: Received inbound HTTP response error +:: +++ sigh-tang + |= [way=wire tan=tang] + ^- (quip move _this) + ?> ?=([@ *] way) + =/ who (,@p (slav %p i.way)) + ~& [%received-httr who] + %+ turn-ships ~[who] + |= [who=ship thus=_this] + =. this thus + (take-sigh-tang:(pe who) t.way tan) :: :: Trivial scry for mock :: From fd5df264d9b7c067f3b284ef764779f7c2fb2271 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 4 Feb 2019 14:31:55 -0800 Subject: [PATCH 08/55] resurrect peek and wish --- app/aqua.hoon | 78 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 48 insertions(+), 30 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 8ba3bd995..818dc34f5 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -6,6 +6,8 @@ :: :aqua [%dojo ~[~bud ~dev] "[our eny (add 3 5)]"] :: :aqua [%dojo ~[~bud] "|hi ~dev"] :: :aqua [%pause-events ~[~bud ~dev]] +:: :aqua [%wish ~[~bud ~dev] '(add 2 3)'] +:: :aqua [%peek ~[~bud] /cx/~bud/home/(scot %da now)/app/curl/hoon] :: :: :: We get ++unix-event and ++pill from /-pill @@ -88,13 +90,33 @@ =^ ovo next-events ~(get to next-events) =/ res (mox +47.snap) ?> ?=(%0 -.res) - =+ poke=p.res - =+ res=(slum poke now.hid ovo) + =/ poke p.res + =/ res (slum poke now.hid ovo) =. event-log [ovo event-log] =. snap +3.res =. ..abet (handle-effects ((list ovum) -.res)) $ :: + :: Peek + :: + ++ peek + |= p=* + =/ res (mox +46.snap) + ?> ?=(%0 -.res) + =/ peek p.res + ~& [who=who %peeked (slum peek [now.hid p])] + ..abet + :: + :: Wish + :: + ++ wish + |= txt=@t + =/ res (mox +22.snap) + ?> ?=(%0 -.res) + =/ wish p.res + ~& [who=who %wished (slum wish txt)] + ..abet + :: :: Restart outstanding requests :: ++ restore @@ -402,6 +424,30 @@ |= [who=ship thus=_this] =. this thus (push-events:(pe who) ~[u.ovo]) + :: + [%peek hers=* p=*] + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus + (peek:(pe who) p.val) + :: + [%wish hers=* p=@t] + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus + (wish:(pe who) p.val) + :: + [%unpause-events hers=*] + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus + start-processing-events:(pe who) + :: + [%pause-events hers=*] + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus + stop-processing-events:(pe who) :: [%snap-fleet lab=@tas] =. fleet-snaps (~(put by fleet-snaps) lab.val piers) @@ -420,34 +466,6 @@ =. this thus restore:(pe who) [(weld moves-1 moves-2) this] - :: - [%peek who=@p p=*] - :: should resurrect - :: =+ res=(mox +46.snap) - :: ?> ?=(%0 -.res) - :: =+ peek=p.res - :: ~& (slum peek p.val) - `this - :: - [%wish who=@p p=@t] - :: should resurrect - :: =+ res=(mox +22.snap) - :: ?> ?=(%0 -.res) - :: =+ wish=p.res - :: ~& (slum wish p.val) - `this - :: - [%unpause-events hers=*] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - start-processing-events:(pe who) - :: - [%pause-events hers=*] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - stop-processing-events:(pe who) == :: :: Run a callback function against a list of ships, aggregating state From 81e8c5928004c13229c4bb3b7214c788fbbc071f Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 4 Feb 2019 16:05:34 -0800 Subject: [PATCH 09/55] implement barebones clay file injection --- app/aqua.hoon | 37 ++++++++++++++++++++++++++++++------- 1 file changed, 30 insertions(+), 7 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 818dc34f5..7392a0d76 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -5,9 +5,11 @@ :: :aqua [%init ~[~bud ~dev]] :: :aqua [%dojo ~[~bud ~dev] "[our eny (add 3 5)]"] :: :aqua [%dojo ~[~bud] "|hi ~dev"] -:: :aqua [%pause-events ~[~bud ~dev]] :: :aqua [%wish ~[~bud ~dev] '(add 2 3)'] :: :aqua [%peek ~[~bud] /cx/~bud/home/(scot %da now)/app/curl/hoon] +:: :aqua [%dojo ~[~bud ~dev] '|mount %'] +:: :aqua [%file ~[~bud ~dev] %/sys/vane] +:: :aqua [%pause-events ~[~bud ~dev]] :: :: :: We get ++unix-event and ++pill from /-pill @@ -27,6 +29,7 @@ [%send p=lane:ames q=@] [%doze p=(unit @da)] [%thus p=@ud q=(unit hiss:eyre)] + [%ergo p=@tas q=mode:clay] == ++ state $: %0 @@ -175,6 +178,7 @@ %send (handle-send u.sof) %doze (handle-doze u.sof) %thus (handle-thus u.sof) + %ergo (handle-ergo u.sof) == $(effects t.effects) :: @@ -229,7 +233,7 @@ ?. &(=(0 (rsh 0 16 u.dest-ip)) =(1 (rsh 0 8 u.dest-ip))) ~& [%havent-implemented-direct-lanes who lan] ..abet - ~& [%blast-sending who=who] + ~& [who=who %blast-sending] =/ hear [//newt/0v1n.2m9vh %hear lan pac] =. this (blast-event hear) :: =/ her ?:(=(~dev who) ~bud ~dev) ::ship (dis u.dest-ip 0xff) @@ -259,11 +263,9 @@ |= tim=@da =. tim +(tim) :: nobody's perfect =. next-timer `tim - ~& [%sleeping-until who tim] (emit-moves [ost.hid %wait /(scot %p who) tim]~) :: ++ cancel-timer - ~& [%cancelling-timer who] (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) :: ++ take-wake @@ -284,7 +286,7 @@ :: so we remove it from our state so we won't pass along the :: response. :: - ~& [%cant-cancel-thus who=who num=num] + ~& [who=who %cant-cancel-thus num=num] =. http-requests (~(del in http-requests) num) ..abet =. http-requests (~(put in http-requests) num) @@ -305,7 +307,7 @@ ?> ?=([@ ~] way) =/ num (slav %ud i.way) ?. (~(has in http-requests) num) - ~& [%ignoring-httr who=who num=num] + ~& [who=who %ignoring-httr num=num] ..abet =. http-requests (~(del in http-requests) num) (push-events [//http/0v1n.2m9vh %they num res]~) @@ -318,11 +320,22 @@ ?> ?=([@ ~] way) =/ num (slav %ud i.way) ?. (~(has in http-requests) num) - ~& [%ignoring-httr who=who num=num] + ~& [who=who %ignoring-httr num=num] ..abet =. http-requests (~(del in http-requests) num) %- (slog tan) ..abet + :: + :: We should mirror a mount point of child to a clay desk of host. + :: For now, we just allow injecting a change to the child, so we + :: throw away ergos. + :: + ++ handle-ergo + |= [way=wire %ergo mount-point=@tas mod=mode:clay] + ^+ ..abet + ~& [who=who %file-changes (turn mod head)] + ..abet + :: -- :: ++ this . @@ -424,6 +437,16 @@ |= [who=ship thus=_this] =. this thus (push-events:(pe who) ~[u.ovo]) + :: + [%file hers=* pax=*] + =/ pax (path pax.val) + ?> ?=([@ @ @ *] pax) + =/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] + %+ turn-ships ((list ship) hers.val) + |= [who=ship thus=_this] + =. this thus + %- push-events:(pe who) + [//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~]~ :: [%peek hers=* p=*] %+ turn-ships ((list ship) hers.val) From da5515b6a8c7f10e07f2a636d78a8ef1bddc9cd9 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Tue, 5 Feb 2019 18:21:41 -0800 Subject: [PATCH 10/55] first integration test --- app/aqua.hoon | 94 ++++++++++++++++++++++------- app/ph.hoon | 149 ++++++++++++++++++++++++++++++++++++++++++++++ lib/ph.hoon | 72 ++++++++++++++++++++++ mar/pill.hoon | 4 +- sur/aquarium.hoon | 29 +++++++++ sur/pill.hoon | 12 ---- 6 files changed, 326 insertions(+), 34 deletions(-) create mode 100644 app/ph.hoon create mode 100644 lib/ph.hoon create mode 100644 sur/aquarium.hoon delete mode 100644 sur/pill.hoon diff --git a/app/aqua.hoon b/app/aqua.hoon index 7392a0d76..3ac9763ec 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -1,7 +1,9 @@ +:: An aquarium of virtual ships. Put in some fish and watch them! +:: :: usage: :: |start %aqua -:: /- pill -:: :aqua &pill .^(pill:pill %cx %/urbit/pill) +:: /- aquarium +:: :aqua &pill .^(pill:aquarium %cx %/urbit/pill) :: :aqua [%init ~[~bud ~dev]] :: :aqua [%dojo ~[~bud ~dev] "[our eny (add 3 5)]"] :: :aqua [%dojo ~[~bud] "|hi ~dev"] @@ -12,24 +14,17 @@ :: :aqua [%pause-events ~[~bud ~dev]] :: :: -:: We get ++unix-event and ++pill from /-pill +:: We get ++unix-event and ++pill from /-aquarium :: -/- pill -=, pill +/- aquarium +=, aquarium => $~ |% ++ move (pair bone card) ++ card $% [%wait wire p=@da] [%rest wire p=@da] [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] - == - ++ unix-effect - %+ pair wire - $% [%blit p=(list blit:dill)] - [%send p=lane:ames q=@] - [%doze p=(unit @da)] - [%thus p=@ud q=(unit hiss:eyre)] - [%ergo p=@tas q=mode:clay] + [%diff %aqua-effect aqua-effect] == ++ state $: %0 @@ -48,7 +43,7 @@ == -- =, gall -|_ $: hid/bowl +|_ $: hid=bowl state == :: @@ -173,13 +168,15 @@ ?~ sof ~& [who=who %unknown-effect i.effects] ..abet - ?- -.q.u.sof + =. ..abet + ?- -.q.u.sof %blit (handle-blit u.sof) %send (handle-send u.sof) %doze (handle-doze u.sof) %thus (handle-thus u.sof) %ergo (handle-ergo u.sof) - == + == + (publish-effect u.sof) $(effects t.effects) :: :: Would love to see a proper stateful terminal handler. Ideally, @@ -336,6 +333,18 @@ ~& [who=who %file-changes (turn mod head)] ..abet :: + :: Give effect to our subscribers + :: + ++ publish-effect + |= ovo=unix-effect + ^+ ..abet + %- emit-moves + %+ murn ~(tap by sup.hid) + |= [b=bone her=ship pax=path] + ^- (unit move) + ?. =(/effects/(scot %p who) pax) + ~ + `[b %diff %aqua-effect who ovo] -- :: ++ this . @@ -360,6 +369,19 @@ =/ nex $ nex(- (weld -.nex moves)) :: +:: Subscribe to effects from a ship +:: +++ peer-effects + |= pax=path + ^- (quip move _this) + ?. ?=([@ ~] pax) + ~& [%aqua-bad-peer-effects pax] + `this + ?~ (slaw %p i.pax) + ~& [%aqua-bad-peer-effects-ship pax] + `this + `this +:: :: Load a pill and assemble arvo. Doesn't send any of the initial :: events. :: @@ -386,10 +408,12 @@ `this == :: -:: Handle commands +:: Handle commands from CLI :: :: Should put some thought into arg structure, maybe make a mark. :: +:: Should convert some of these to just rewrite into ++poke-events. +:: ++ poke-noun |= val=* ^- (quip move _this) @@ -491,6 +515,33 @@ [(weld moves-1 moves-2) this] == :: +:: +:: +++ poke-aqua-events + |= events=(list aqua-event) + ^- (quip move _this) + %+ turn-events events + |= [ovo=aqua-event thus=_this] + =. this thus + ?- -.ovo + %init-ship + %- push-events:apex:(pe who.ovo) + ^- (list unix-event) + :~ [/ %wack 0] :: eny + [/ %whom who.ovo] :: eny + [//newt/0v1n.2m9vh %barn ~] + [//behn/0v1n.2m9vh %born ~] + [//term/1 %boot %fake who.ovo] + -.userspace-ova.pil + [//http/0v1n.2m9vh %born ~] + [//http/0v1n.2m9vh %live 8.080 `8.445] + [//term/1 %belt %ctl `@c`%x] + == + :: + %event + (push-events:(pe who.ovo) [ovo.ovo]~) + == +:: :: Run a callback function against a list of ships, aggregating state :: and plowing all ships at the end. :: @@ -510,8 +561,9 @@ :: restrict the callbacks to always have `this` at a particular axis, :: and that doesn't feel right :: -++ turn-ships - |= [hers=(list ship) fun=$-([ship _this] _(pe))] +++ turn-plow + |* arg=mold + |= [hers=(list arg) fun=$-([arg _this] _(pe))] |- ^- (quip move _this) ?~ hers =^ moves this plow-all @@ -521,6 +573,9 @@ =^ nex-moves this $(hers t.hers, this this) [(weld moves nex-moves) this] :: +++ turn-ships (turn-plow ship) +++ turn-events (turn-plow aqua-event) +:: :: Send the same event to all ships :: ++ blast-event @@ -540,7 +595,6 @@ ^- (quip move _this) ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) - ~& [%waking who] %+ turn-ships ~[who] |= [who=ship thus=_this] =. this thus diff --git a/app/ph.hoon b/app/ph.hoon new file mode 100644 index 000000000..5d8fd6a76 --- /dev/null +++ b/app/ph.hoon @@ -0,0 +1,149 @@ +:: Test the pH of your aquarium. See if it's safe to put real fish in. +:: +:: usage: +:: :aqua [%run-test %test-add] +:: +:: TODO: +:: - Restore a fleet +:: - Compose tests +:: +/- aquarium +/+ ph +=, aquarium +=, ph +=> $~ |% + ++ move (pair bone card) + ++ card + $% [%peer wire dock path] + [%poke wire dock %aqua-events (list aqua-event)] + == + :: + ++ test-map (map term test-core) + :: + ++ state + $: %0 + test-cores=test-map + other-state + == + ++ other-state + $~ + -- +=, gall +|_ $: hid=bowl + state + == +++ this . +++ install-tests + ^+ this + =. test-cores + %- malt + ^- (list (pair term test-core)) + :~ + :- %test-add + |% + ++ start + ^- (pair (list ship) (list ph-event)) + :- ~[~bud] + %- zing + :~ (init ~bud) + (dojo ~bud "[%test-result (add 2 3)]") + == + :: + ++ route + |= ovo=aqua-effect + ^- (list ph-event) + (expect-dojo-output ~bud ovo "[%test-result 5]") + :: XX if it's been five minutes, we failed + -- + :: + :- %test-hi + |% + ++ start + ^- (pair (list ship) (list ph-event)) + :- ~[~bud ~dev] + %- zing + :~ (init ~bud) + (init ~dev) + (dojo ~bud "|hi ~dev") + == + :: + ++ route + |= ovo=aqua-effect + ^- (list ph-event) + :: + :: doesn't work because for some reason we lose the + :: subscription immediately after opening it. maybe + :: because we receive so many events without immediate + :: reap it triggers the backpressure mechanism in gall? + :: + (expect-dojo-output ~bud ovo "hi ~dev successful") + -- + == + this +:: +++ prep + |= old=(unit [@ tests=* rest=*]) + ^- [(list move) _this] + =. this install-tests + ?~ old + `this + =/ new ((soft other-state) rest.u.old) + ?~ new + `this + `this(+<+>+ u.new) +:: +++ run-events + |= what=(list ph-event) + ^- [(list move) _this] + ?: =(~ what) + `this + =/ res + |- ^- (each (list aqua-event) $~) + ?~ what + [%& ~] + ?: ?=(%test-done -.i.what) + ~& ?~(p.i.what "test successful" "test failed") + [%| ~] + =/ nex $(what t.what) + ?: ?=(%| -.nex) + nex + [%& `aqua-event`i.what p.nex] + ?: ?=(%| -.res) + `this + [[ost.hid %poke /running [our.hid %aqua] %aqua-events p.res]~ this] +:: +:: Should check whether we're already subscribed +:: +++ subscribe-to-effects + |= [lab=@tas hers=(list ship)] + :_ this + %+ turn hers + |= her=ship + ^- move + :* ost.hid + %peer + /[lab]/(scot %p her) + [our.hid %aqua] + /effects/(scot %p her) + == +:: +++ poke-noun + |= arg=* + ^- (quip move _this) + ?+ arg ~|(%bad-noun-arg !!) + [%run-test lab=@tas] + =/ res=[hers=(list ship) events=(list ph-event)] + start:(~(got by test-cores) lab.arg) + =^ moves-1 this (subscribe-to-effects lab.arg hers.res) + =^ moves-2 this (run-events events.res) + [(weld moves-1 moves-2) this] + == +:: +++ diff-aqua-effect + |= [way=wire ovo=aqua-effect] + ^- (quip move _this) + :: ~& [%diff-aqua-effect way -.q.ovo.ovo] + ?> ?=([@ @ ~] way) + =/ lab i.way + (run-events (route:(~(got by test-cores) lab) ovo)) +-- diff --git a/lib/ph.hoon b/lib/ph.hoon new file mode 100644 index 000000000..81ea46ea4 --- /dev/null +++ b/lib/ph.hoon @@ -0,0 +1,72 @@ +:: +:::: /hoon/ph/lib + :: +/- aquarium +=, aquarium +|% +:: Defines a complete integration test. +:: +:: Perhaps route should take a unix-effect rather than a sign. +:: Similarly, perhaps ++abet should produce a list of +:: unix-events. Also, perhaps we should support state. +:: +:: Perhaps closer to this: +:: ++ test-core +:: $_ ^? +:: |% +:: ++ start ^?(..abet) +:: ++ route |~([wire unix-effect] ^?(..abet)) +:: ++ abet *(list unix-event) +:: -- +:: +++ test-core + $_ ^? + |% + ++ start *(pair (list ship) (list ph-event)) + ++ route |~(aqua-effect *(list ph-event)) + -- +:: +++ ph-event + $% [%test-done p=?] + aqua-event + == +:: +++ send-events-to + |= [who=ship what=(list unix-event)] + ^- (list ph-event) + %+ turn what + |= ovo=unix-event + [%event who ovo] +:: +++ init + |= who=ship + ^- (list ph-event) + [%init-ship who]~ +:: +:: factor out send-events-to +:: +++ dojo + |= [who=ship what=tape] + ^- (list ph-event) + %+ send-events-to who + ^- (list unix-event) + :~ + [//term/1 %belt %ctl `@c`%e] + [//term/1 %belt %ctl `@c`%u] + [//term/1 %belt %txt ((list @c) what)] + [//term/1 %belt %ret ~] + == +:: +++ expect-dojo-output + |= [who=ship ovo=aqua-effect what=tape] + ^- (list ph-event) + ?. ?=(%blit -.q.ovo.ovo) + ~ + ?. %+ lien p.q.ovo.ovo + |= =blit:dill + ?. ?=(%lin -.blit) + | + !=(~ (find what p.blit)) + ~ + [%test-done &]~ +-- diff --git a/mar/pill.hoon b/mar/pill.hoon index 1f0c6447e..15c0cdf6d 100644 --- a/mar/pill.hoon +++ b/mar/pill.hoon @@ -1,8 +1,8 @@ :: :::: /hoon/pill/mar :: -/- pill -=, pill +/- aquarium +=, aquarium =, mimes:html |_ pil=pill ++ grow diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon new file mode 100644 index 000000000..d6bf34356 --- /dev/null +++ b/sur/aquarium.hoon @@ -0,0 +1,29 @@ +|% +++ aqua-event + $% [%init-ship who=ship] + [%event who=ship ovo=unix-event] + == +:: +++ aqua-effect + ,[who=ship ovo=unix-effect] +:: +++ unix-event + %+ pair wire + $% [%wack p=@] + [%whom p=ship] + [%live p=@ud q=(unit @ud)] + [%barn ~] + [%boot %fake p=ship] + unix-task + == +:: +++ unix-effect + %+ pair wire + $% [%blit p=(list blit:dill)] + [%send p=lane:ames q=@] + [%doze p=(unit @da)] + [%thus p=@ud q=(unit hiss:eyre)] + [%ergo p=@tas q=mode:clay] + == ++= pill [boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)] +-- diff --git a/sur/pill.hoon b/sur/pill.hoon deleted file mode 100644 index 33d06604b..000000000 --- a/sur/pill.hoon +++ /dev/null @@ -1,12 +0,0 @@ -|% -++ unix-event - %+ pair wire - $% [%wack p=@] - [%whom p=ship] - [%live p=@ud q=(unit @ud)] - [%barn ~] - [%boot %fake p=ship] - unix-task - == -+= pill [boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)] --- From 1cfea70e8b300f41134b6f095f134d5abe31d7a9 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 7 Feb 2019 17:12:57 -0800 Subject: [PATCH 11/55] hoist moves into variable --- app/aqua.hoon | 152 ++++++++++++++++++++++++++------------------------ 1 file changed, 80 insertions(+), 72 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 3ac9763ec..26227bf86 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -43,6 +43,10 @@ == -- =, gall +:: +:: Hoist moves into state for cleaner state management +:: +=| moves=(list move) |_ $: hid=bowl state == @@ -53,38 +57,37 @@ |= who=ship =+ (fall (~(get by piers) who) *pier) =* pier-data - - =| moves=(list move) |% - ++ abet - ^- (quip move _this) + ++ abet-pe + ^+ this =. piers (~(put by piers) who pier-data) - [(flop moves) this] + this :: ++ apex =. pier-data *pier =. snap assembled ~& r=(met 3 (jam snap)) - ..abet + ..abet-pe :: ++ push-events |= ova=(list unix-event) - ^+ ..abet + ^+ ..abet-pe =. next-events (~(gas to next-events) ova) - ..abet + ..abet-pe :: ++ emit-moves |= ms=(list move) =. moves (weld ms moves) - ..abet + ..abet-pe :: :: Process the events in our queue. :: ++ plow - |- ^+ ..abet + |- ^+ ..abet-pe ?: =(~ next-events) - ..abet + ..abet-pe ?. processing-events - ..abet + ..abet-pe =^ ovo next-events ~(get to next-events) =/ res (mox +47.snap) ?> ?=(%0 -.res) @@ -92,7 +95,7 @@ =/ res (slum poke now.hid ovo) =. event-log [ovo event-log] =. snap +3.res - =. ..abet (handle-effects ((list ovum) -.res)) + =. ..abet-pe (handle-effects ((list ovum) -.res)) $ :: :: Peek @@ -103,7 +106,7 @@ ?> ?=(%0 -.res) =/ peek p.res ~& [who=who %peeked (slum peek [now.hid p])] - ..abet + ..abet-pe :: :: Wish :: @@ -113,40 +116,40 @@ ?> ?=(%0 -.res) =/ wish p.res ~& [who=who %wished (slum wish txt)] - ..abet + ..abet-pe :: :: Restart outstanding requests :: ++ restore - ^+ ..abet + ^+ ..abet-pe :: Restore behn :: - =. ..abet + =. ..abet-pe ?~ next-timer - ..abet + ..abet-pe (set-timer u.next-timer) :: Restore eyre :: =. http-requests ~ - =. ..abet (push-events [//http/0v1n.2m9vh %born ~]~) - ..abet + =. ..abet-pe (push-events [//http/0v1n.2m9vh %born ~]~) + ..abet-pe :: :: Cancel outstanding requests :: ++ sleep - ^+ ..abet + ^+ ..abet-pe :: Sleep behn :: - =. ..abet + =. ..abet-pe ?~ next-timer - ..abet + ..abet-pe cancel-timer :: Sleep eyre :: :: Eyre doesn't support cancelling HTTP requests from userspace. :: =. http-requests ~ - ..abet + ..abet-pe :: ++ mox |=(* (mock [snap +<] scry)) :: @@ -160,15 +163,15 @@ :: ++ handle-effects |= effects=(list ovum) - ^+ ..abet + ^+ ..abet-pe ?~ effects - ..abet - =. ..abet + ..abet-pe + =. ..abet-pe =/ sof ((soft unix-effect) i.effects) ?~ sof ~& [who=who %unknown-effect i.effects] - ..abet - =. ..abet + ..abet-pe + =. ..abet-pe ?- -.q.u.sof %blit (handle-blit u.sof) %send (handle-send u.sof) @@ -190,7 +193,7 @@ :: ++ handle-blit |= [way=wire %blit blits=(list blit:dill)] - ^+ ..abet + ^+ ..abet-pe =/ last-line %+ roll blits |= [b=blit:dill line=tape] @@ -205,7 +208,7 @@ %url ~& [%activate-url p.b] line == ~& last-line - ..abet + ..abet-pe :: :: This needs a better SDN solution. Every ship should have an IP :: address, and we should eventually test changing those IP @@ -216,7 +219,7 @@ :: ++ handle-send |= [way=wire %send lan=lane:ames pac=@] - ^+ ..abet + ^+ ..abet-pe =/ dest-ip |- ^- (unit @if) ?- -.lan @@ -226,31 +229,31 @@ == ?~ dest-ip ~& [%sending-no-destination who lan] - ..abet + ..abet-pe ?. &(=(0 (rsh 0 16 u.dest-ip)) =(1 (rsh 0 8 u.dest-ip))) ~& [%havent-implemented-direct-lanes who lan] - ..abet + ..abet-pe ~& [who=who %blast-sending] =/ hear [//newt/0v1n.2m9vh %hear lan pac] =. this (blast-event hear) :: =/ her ?:(=(~dev who) ~bud ~dev) ::ship (dis u.dest-ip 0xff) :: ?. (~(has by piers) her) :: ~& [%dropping who=who her=her] - :: ..abet + :: ..abet-pe :: ~& [%sending who=who her=her ip=`@ux`u.dest-ip] :: =^ ms this - :: abet:(push-events:(pe her) ~[hear]) - ..abet + :: abet-pe:(push-events:(pe her) ~[hear]) + ..abet-pe :: :: Would love to be able to control time more precisely, jumping :: forward and whatnot. :: ++ handle-doze |= [way=wire %doze tim=(unit @da)] - ^+ ..abet + ^+ ..abet-pe ?~ tim ?~ next-timer - ..abet + ..abet-pe cancel-timer ?~ next-timer (set-timer u.tim) @@ -275,17 +278,17 @@ :: ++ handle-thus |= [way=wire %thus num=@ud req=(unit hiss:eyre)] - ^+ ..abet + ^+ ..abet-pe ?~ req ?. (~(has in http-requests) num) - ..abet + ..abet-pe :: Eyre doesn't support cancelling HTTP requests from userspace, :: so we remove it from our state so we won't pass along the :: response. :: ~& [who=who %cant-cancel-thus num=num] =. http-requests (~(del in http-requests) num) - ..abet + ..abet-pe =. http-requests (~(put in http-requests) num) %- emit-moves :_ ~ :* ost.hid @@ -300,12 +303,12 @@ :: ++ take-sigh-httr |= [way=wire res=httr:eyre] - ^+ ..abet + ^+ ..abet-pe ?> ?=([@ ~] way) =/ num (slav %ud i.way) ?. (~(has in http-requests) num) ~& [who=who %ignoring-httr num=num] - ..abet + ..abet-pe =. http-requests (~(del in http-requests) num) (push-events [//http/0v1n.2m9vh %they num res]~) :: @@ -313,15 +316,15 @@ :: ++ take-sigh-tang |= [way=wire tan=tang] - ^+ ..abet + ^+ ..abet-pe ?> ?=([@ ~] way) =/ num (slav %ud i.way) ?. (~(has in http-requests) num) ~& [who=who %ignoring-httr num=num] - ..abet + ..abet-pe =. http-requests (~(del in http-requests) num) %- (slog tan) - ..abet + ..abet-pe :: :: We should mirror a mount point of child to a clay desk of host. :: For now, we just allow injecting a change to the child, so we @@ -329,15 +332,15 @@ :: ++ handle-ergo |= [way=wire %ergo mount-point=@tas mod=mode:clay] - ^+ ..abet + ^+ ..abet-pe ~& [who=who %file-changes (turn mod head)] - ..abet + ..abet-pe :: :: Give effect to our subscribers :: ++ publish-effect |= ovo=unix-effect - ^+ ..abet + ^+ ..abet-pe %- emit-moves %+ murn ~(tap by sup.hid) |= [b=bone her=ship pax=path] @@ -348,11 +351,12 @@ -- :: ++ this . +++ abet-aqua [(flop moves) this] :: :: Run all events on all ships until all queues are empty :: ++ plow-all - |- ^- (quip move _this) + |- ^+ this =/ who =/ pers ~(tap by piers) |- ^- (unit ship) @@ -364,10 +368,9 @@ $(pers t.pers) ~& plowing=who ?~ who - `this - =^ moves this abet:plow:(pe u.who) - =/ nex $ - nex(- (weld -.nex moves)) + this + =. this abet-pe:plow:(pe u.who) + $ :: :: Subscribe to effects from a ship :: @@ -388,6 +391,7 @@ ++ poke-pill |= p=pill ^- (quip move _this) + =< abet-aqua =. pil p ~& lent=(met 3 (jam boot-ova.pil)) =/ res=toon :: (each * (list tank)) @@ -396,16 +400,16 @@ %0 ~& %suc =. assembled +7.p.res - `this + this :: %1 ~& [%vere-blocked p.res] - `this + this :: %2 ~& %vere-fail %- (slog p.res) - `this + this == :: :: Handle commands from CLI @@ -417,6 +421,8 @@ ++ poke-noun |= val=* ^- (quip move _this) + =< abet-aqua + ^+ this :: Could potentially factor out the three lines of turn-ships :: boilerplate :: @@ -456,7 +462,7 @@ =/ ovo ((soft unix-event) ovo.val) ?~ ovo ~& %ovo-not-an-event - `this + this %+ turn-ships ((list ship) hers.val) |= [who=ship thus=_this] =. this thus @@ -498,28 +504,29 @@ :: [%snap-fleet lab=@tas] =. fleet-snaps (~(put by fleet-snaps) lab.val piers) - `this + this :: [%restore-fleet lab=@tas] - =^ moves-1 this + =. this %+ turn-ships (turn ~(tap by piers) head) |= [who=ship thus=_this] =. this thus sleep:(pe who) =. piers (~(got by fleet-snaps) lab.val) - =^ moves-2 this + =. this %+ turn-ships (turn ~(tap by piers) head) |= [who=ship thus=_this] =. this thus restore:(pe who) - [(weld moves-1 moves-2) this] + this == :: -:: +:: Apply a list of events tagged by ship :: ++ poke-aqua-events |= events=(list aqua-event) ^- (quip move _this) + =< abet-aqua %+ turn-events events |= [ovo=aqua-event thus=_this] =. this thus @@ -564,14 +571,12 @@ ++ turn-plow |* arg=mold |= [hers=(list arg) fun=$-([arg _this] _(pe))] - |- ^- (quip move _this) + |- ^+ this ?~ hers - =^ moves this plow-all - [moves this] - =^ moves this - abet:plow:(fun i.hers this) - =^ nex-moves this $(hers t.hers, this this) - [(weld moves nex-moves) this] + plow-all + =. this + abet-pe:plow:(fun i.hers this) + $(hers t.hers, this this) :: ++ turn-ships (turn-plow ship) ++ turn-events (turn-plow aqua-event) @@ -584,8 +589,8 @@ |- ^+ this ?~ pers this - =^ moves-dropped this - abet:(push-events:(pe p.i.pers) ~[ovo]) + =. this + abet-pe:(push-events:(pe p.i.pers) ~[ovo]) $(pers t.pers) :: :: Received timer wake @@ -593,6 +598,7 @@ ++ wake |= [way=wire ~] ^- (quip move _this) + =< abet-aqua ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) %+ turn-ships ~[who] @@ -605,6 +611,7 @@ ++ sigh-httr |= [way=wire res=httr:eyre] ^- (quip move _this) + =< abet-aqua ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) ~& [%received-httr who] @@ -618,6 +625,7 @@ ++ sigh-tang |= [way=wire tan=tang] ^- (quip move _this) + =< abet-aqua ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) ~& [%received-httr who] From 39ce13817b049154be94cafe50122c677f49e173 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 7 Feb 2019 18:03:46 -0800 Subject: [PATCH 12/55] test-hi works --- app/aqua.hoon | 58 +++++++++++++++++++++++++++++++++++------------ app/ph.hoon | 24 +++++++++++++------- lib/ph.hoon | 10 ++++---- sur/aquarium.hoon | 4 ++-- 4 files changed, 67 insertions(+), 29 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 26227bf86..ab1abc9e6 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -24,7 +24,7 @@ $% [%wait wire p=@da] [%rest wire p=@da] [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] - [%diff %aqua-effect aqua-effect] + [%diff %aqua-effects aqua-effects] == ++ state $: %0 @@ -44,8 +44,11 @@ -- =, gall :: -:: Hoist moves into state for cleaner state management +:: aqua-effect-list: collect list of aqua effects to broadcast at once +:: to avoid gall backpressure +:: moves: Hoist moves into state for cleaner state management :: +=| unix-effects=(jar ship unix-effect) =| moves=(list move) |_ $: hid=bowl state @@ -77,7 +80,7 @@ :: ++ emit-moves |= ms=(list move) - =. moves (weld ms moves) + =. this (^emit-moves ms) ..abet-pe :: :: Process the events in our queue. @@ -341,17 +344,42 @@ ++ publish-effect |= ovo=unix-effect ^+ ..abet-pe + =. unix-effects (~(add ja unix-effects) who ovo) + ..abet-pe + -- +:: +++ this . +:: +:: ++apex-aqua and ++abet-aqua must bookend calls from gall +:: +++ apex-aqua + ^+ this + =: moves ~ + unix-effects ~ + == + this +:: +++ abet-aqua + ^- (quip move _this) + =. this %- emit-moves %+ murn ~(tap by sup.hid) |= [b=bone her=ship pax=path] ^- (unit move) - ?. =(/effects/(scot %p who) pax) + ?. ?=([%effects @ ~] pax) ~ - `[b %diff %aqua-effect who ovo] - -- + =/ who (slav %p i.t.pax) + =/ fx (~(get ja unix-effects) who) + ?~ fx + ~ + `[b %diff %aqua-effects who fx] + [(flop moves) this] +:: +++ emit-moves + |= ms=(list move) + =. moves (weld ms moves) + this :: -++ this . -++ abet-aqua [(flop moves) this] :: :: Run all events on all ships until all queues are empty :: @@ -382,7 +410,7 @@ `this ?~ (slaw %p i.pax) ~& [%aqua-bad-peer-effects-ship pax] - `this + !! `this :: :: Load a pill and assemble arvo. Doesn't send any of the initial @@ -391,7 +419,7 @@ ++ poke-pill |= p=pill ^- (quip move _this) - =< abet-aqua + =. this apex-aqua =< abet-aqua =. pil p ~& lent=(met 3 (jam boot-ova.pil)) =/ res=toon :: (each * (list tank)) @@ -421,7 +449,7 @@ ++ poke-noun |= val=* ^- (quip move _this) - =< abet-aqua + =. this apex-aqua =< abet-aqua ^+ this :: Could potentially factor out the three lines of turn-ships :: boilerplate @@ -526,7 +554,7 @@ ++ poke-aqua-events |= events=(list aqua-event) ^- (quip move _this) - =< abet-aqua + =. this apex-aqua =< abet-aqua %+ turn-events events |= [ovo=aqua-event thus=_this] =. this thus @@ -598,7 +626,7 @@ ++ wake |= [way=wire ~] ^- (quip move _this) - =< abet-aqua + =. this apex-aqua =< abet-aqua ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) %+ turn-ships ~[who] @@ -611,7 +639,7 @@ ++ sigh-httr |= [way=wire res=httr:eyre] ^- (quip move _this) - =< abet-aqua + =. this apex-aqua =< abet-aqua ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) ~& [%received-httr who] @@ -625,7 +653,7 @@ ++ sigh-tang |= [way=wire tan=tang] ^- (quip move _this) - =< abet-aqua + =. this apex-aqua =< abet-aqua ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) ~& [%received-httr who] diff --git a/app/ph.hoon b/app/ph.hoon index 5d8fd6a76..c9515eb2c 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -50,9 +50,9 @@ == :: ++ route - |= ovo=aqua-effect + |= [who=ship ovo=unix-effect] ^- (list ph-event) - (expect-dojo-output ~bud ovo "[%test-result 5]") + (expect-dojo-output ~bud who ovo "[%test-result 5]") :: XX if it's been five minutes, we failed -- :: @@ -68,7 +68,7 @@ == :: ++ route - |= ovo=aqua-effect + |= [who=ship ovo=unix-effect] ^- (list ph-event) :: :: doesn't work because for some reason we lose the @@ -76,7 +76,7 @@ :: because we receive so many events without immediate :: reap it triggers the backpressure mechanism in gall? :: - (expect-dojo-output ~bud ovo "hi ~dev successful") + (expect-dojo-output ~bud who ovo "hi ~dev successful") -- == this @@ -129,6 +129,7 @@ :: ++ poke-noun |= arg=* + ~& %herm ^- (quip move _this) ?+ arg ~|(%bad-noun-arg !!) [%run-test lab=@tas] @@ -139,11 +140,18 @@ [(weld moves-1 moves-2) this] == :: -++ diff-aqua-effect - |= [way=wire ovo=aqua-effect] +++ diff-aqua-effects + |= [way=wire ova=aqua-effects] ^- (quip move _this) - :: ~& [%diff-aqua-effect way -.q.ovo.ovo] + :: ~& [%diff-aqua-effect way who.ova] ?> ?=([@ @ ~] way) =/ lab i.way - (run-events (route:(~(got by test-cores) lab) ovo)) + %- run-events + |- ^- (list ph-event) + ?~ ovo.ova + ~ + ~& [%diff-aqua-effect-i way -.q.i.ovo.ova] + %+ weld + (route:(~(got by test-cores) lab) who.ova i.ovo.ova) + $(ovo.ova t.ovo.ova) -- diff --git a/lib/ph.hoon b/lib/ph.hoon index 81ea46ea4..5978fff34 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -23,7 +23,7 @@ $_ ^? |% ++ start *(pair (list ship) (list ph-event)) - ++ route |~(aqua-effect *(list ph-event)) + ++ route |~([ship unix-effect] *(list ph-event)) -- :: ++ ph-event @@ -58,11 +58,13 @@ == :: ++ expect-dojo-output - |= [who=ship ovo=aqua-effect what=tape] + |= [who=ship her=ship ovo=unix-effect what=tape] ^- (list ph-event) - ?. ?=(%blit -.q.ovo.ovo) + ?. =(who her) ~ - ?. %+ lien p.q.ovo.ovo + ?. ?=(%blit -.q.ovo) + ~ + ?. %+ lien p.q.ovo |= =blit:dill ?. ?=(%lin -.blit) | diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon index d6bf34356..c265485fa 100644 --- a/sur/aquarium.hoon +++ b/sur/aquarium.hoon @@ -4,8 +4,8 @@ [%event who=ship ovo=unix-event] == :: -++ aqua-effect - ,[who=ship ovo=unix-effect] +++ aqua-effects + ,[who=ship ovo=(list unix-effect)] :: ++ unix-event %+ pair wire From 705a5315583340ec84579df60e1f60f5f30ff93b Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 8 Feb 2019 11:52:36 -0800 Subject: [PATCH 13/55] add init cache to aqua for faster boot times --- app/aqua.hoon | 58 ++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 46 insertions(+), 12 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index ab1abc9e6..a4ee3f3a3 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -30,6 +30,7 @@ $: %0 pil=pill assembled=* + init-cache=(map ship pier) fleet-snaps=(map term (map ship pier)) piers=(map ship pier) == @@ -560,18 +561,30 @@ =. this thus ?- -.ovo %init-ship - %- push-events:apex:(pe who.ovo) - ^- (list unix-event) - :~ [/ %wack 0] :: eny - [/ %whom who.ovo] :: eny - [//newt/0v1n.2m9vh %barn ~] - [//behn/0v1n.2m9vh %born ~] - [//term/1 %boot %fake who.ovo] - -.userspace-ova.pil - [//http/0v1n.2m9vh %born ~] - [//http/0v1n.2m9vh %live 8.080 `8.445] - [//term/1 %belt %ctl `@c`%x] - == + =/ prev (~(get by init-cache) who.ovo) + ?^ prev + ~& [%loading-cached-ship who.ovo] + =. this (restore-ships ~[who.ovo] init-cache) + (pe who.ovo) + =/ initted + =< plow + %- push-events:apex:(pe who.ovo) + ^- (list unix-event) + :~ [/ %wack 0] :: eny + [/ %whom who.ovo] :: eny + [//newt/0v1n.2m9vh %barn ~] + [//behn/0v1n.2m9vh %born ~] + [//term/1 %boot %fake who.ovo] + -.userspace-ova.pil + [//http/0v1n.2m9vh %born ~] + [//http/0v1n.2m9vh %live 8.080 `8.445] + [//term/1 %belt %ctl `@c`%x] + == + =. this abet-pe:initted + =. init-cache + %+ ~(put by init-cache) who.ovo + (~(got by piers) who.ovo) + (pe who.ovo) :: %event (push-events:(pe who.ovo) [ovo.ovo]~) @@ -621,6 +634,27 @@ abet-pe:(push-events:(pe p.i.pers) ~[ovo]) $(pers t.pers) :: +:: Restore ships +:: +++ restore-ships + |= [hers=(list ship) from=(map ship pier)] + =. this + %+ turn-ships hers + |= [who=ship thus=_this] + =. this thus + sleep:(pe who) + =. piers + %- ~(gas by piers) + %+ turn hers + |= her=ship + [her (~(got by from) her)] + =. this + %+ turn-ships hers + |= [who=ship thus=_this] + =. this thus + restore:(pe who) + this +:: :: Received timer wake :: ++ wake From 1a87a5c9fad7c96a45ee051eed4f962aa895d4af Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 8 Feb 2019 13:34:24 -0800 Subject: [PATCH 14/55] add a little state to tests --- app/aqua.hoon | 3 ++ app/ph.hoon | 115 +++++++++++++++++++++++++++++++--------------- lib/ph.hoon | 2 +- sur/aquarium.hoon | 1 + 4 files changed, 82 insertions(+), 39 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index a4ee3f3a3..99bd626f6 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -585,6 +585,9 @@ %+ ~(put by init-cache) who.ovo (~(got by piers) who.ovo) (pe who.ovo) + :: + %pause-events + stop-processing-events:(pe who.ovo) :: %event (push-events:(pe who.ovo) [ovo.ovo]~) diff --git a/app/ph.hoon b/app/ph.hoon index c9515eb2c..1a7ef671a 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -14,15 +14,15 @@ => $~ |% ++ move (pair bone card) ++ card - $% [%peer wire dock path] - [%poke wire dock %aqua-events (list aqua-event)] + $% [%poke wire dock %aqua-events (list aqua-event)] + [%peer wire dock path] + [%pull wire dock ~] == :: - ++ test-map (map term test-core) - :: ++ state $: %0 - test-cores=test-map + raw-test-cores=(map term test-core) + test-cores=(map term [hers=(list ship) cor=test-core]) other-state == ++ other-state @@ -35,66 +35,80 @@ ++ this . ++ install-tests ^+ this - =. test-cores + =. raw-test-cores %- malt ^- (list (pair term test-core)) :~ - :- %test-add + :- %add + =+ num=5 |% ++ start - ^- (pair (list ship) (list ph-event)) - :- ~[~bud] - %- zing - :~ (init ~bud) - (dojo ~bud "[%test-result (add 2 3)]") - == + ^- (trel (list ship) (list ph-event) _..start) + =. num +(num) + :+ ~[~bud] + %- zing + :~ (init ~bud) + (dojo ~bud "[%test-result (add 2 3)]") + == + ..start :: ++ route |= [who=ship ovo=unix-effect] ^- (list ph-event) + ~& [%num num] (expect-dojo-output ~bud who ovo "[%test-result 5]") :: XX if it's been five minutes, we failed -- :: - :- %test-hi + :- %hi |% ++ start - ^- (pair (list ship) (list ph-event)) - :- ~[~bud ~dev] - %- zing - :~ (init ~bud) - (init ~dev) - (dojo ~bud "|hi ~dev") - == + ^- (trel (list ship) (list ph-event) _..start) + :+ ~[~bud ~dev] + %- zing + :~ (init ~bud) + (init ~dev) + (dojo ~bud "|hi ~dev") + == + ..start :: ++ route |= [who=ship ovo=unix-effect] ^- (list ph-event) - :: - :: doesn't work because for some reason we lose the - :: subscription immediately after opening it. maybe - :: because we receive so many events without immediate - :: reap it triggers the backpressure mechanism in gall? - :: (expect-dojo-output ~bud who ovo "hi ~dev successful") -- + :: + :- %individual-breach + *test-core + :: + :: (init ~zod) + :: (init ~marzod) + :: wait for sync to finish + :: cycle ~zod keys + :: verify it sunk + :: kill ~zod + :: (init ~zod) w/new keys + :: change file on ~zod + :: wait for sync to finish + :: verify file has changed + :: == this :: ++ prep |= old=(unit [@ tests=* rest=*]) - ^- [(list move) _this] + ^- (quip move _this) =. this install-tests ?~ old `this =/ new ((soft other-state) rest.u.old) ?~ new `this - `this(+<+>+ u.new) + `this(+<+>+> u.new) :: ++ run-events - |= what=(list ph-event) - ^- [(list move) _this] + |= [lab=term what=(list ph-event)] + ^- (quip move _this) ?: =(~ what) `this =/ res @@ -109,9 +123,33 @@ nex [%& `aqua-event`i.what p.nex] ?: ?=(%| -.res) - `this + (cancel-test lab) [[ost.hid %poke /running [our.hid %aqua] %aqua-events p.res]~ this] :: +:: Cancel subscriptions to ships +:: +++ cancel-test + |= lab=term + ^- (quip move _this) + =/ test (~(get by test-cores) lab) + ?~ test + `this + =. test-cores (~(del by test-cores) lab) + :_ this + %- zing + %+ turn hers.u.test + |= her=ship + ^- (list move) + :~ [ost.hid %pull /[lab]/(scot %p her) [our.hid %aqua] ~] + :* ost.hid + %poke + /cancelling + [our.hid %aqua] + %aqua-events + [%pause-events her]~ + == + == +:: :: Should check whether we're already subscribed :: ++ subscribe-to-effects @@ -133,10 +171,11 @@ ^- (quip move _this) ?+ arg ~|(%bad-noun-arg !!) [%run-test lab=@tas] - =/ res=[hers=(list ship) events=(list ph-event)] - start:(~(got by test-cores) lab.arg) + =/ res=[hers=(list ship) events=(list ph-event) new-state=test-core] + start:(~(got by raw-test-cores) lab.arg) + =. test-cores (~(put by test-cores) lab.arg hers.res new-state.res) =^ moves-1 this (subscribe-to-effects lab.arg hers.res) - =^ moves-2 this (run-events events.res) + =^ moves-2 this (run-events lab.arg events.res) [(weld moves-1 moves-2) this] == :: @@ -144,14 +183,14 @@ |= [way=wire ova=aqua-effects] ^- (quip move _this) :: ~& [%diff-aqua-effect way who.ova] - ?> ?=([@ @ ~] way) + ?> ?=([@tas @ ~] way) =/ lab i.way - %- run-events + %+ run-events lab |- ^- (list ph-event) ?~ ovo.ova ~ ~& [%diff-aqua-effect-i way -.q.i.ovo.ova] %+ weld - (route:(~(got by test-cores) lab) who.ova i.ovo.ova) + (route:cor:(~(got by test-cores) lab) who.ova i.ovo.ova) $(ovo.ova t.ovo.ova) -- diff --git a/lib/ph.hoon b/lib/ph.hoon index 5978fff34..e3d2fcc15 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -22,7 +22,7 @@ ++ test-core $_ ^? |% - ++ start *(pair (list ship) (list ph-event)) + ++ start *(trel (list ship) (list ph-event) _^?(..start)) ++ route |~([ship unix-effect] *(list ph-event)) -- :: diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon index c265485fa..24a9a3fe5 100644 --- a/sur/aquarium.hoon +++ b/sur/aquarium.hoon @@ -1,6 +1,7 @@ |% ++ aqua-event $% [%init-ship who=ship] + [%pause-events who=ship] [%event who=ship ovo=unix-event] == :: From 64b11765b50a9e91ff8d5f0fb242aaa638c53380 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 8 Feb 2019 15:21:40 -0800 Subject: [PATCH 15/55] WIP merge --- app/aqua.hoon | 17 ++++++++++------- app/ph.hoon | 31 +++++++++++++++++++++++++++++-- lib/ph.hoon | 10 ++++++++++ 3 files changed, 49 insertions(+), 9 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 99bd626f6..8b35a6c02 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -35,8 +35,9 @@ piers=(map ship pier) == ++ pier - $: snap=* - event-log=(list unix-event) + $: tym=@da + snap=* + event-log=(list [@da unix-event]) next-events=(qeu unix-event) processing-events=? next-timer=(unit @da) @@ -96,8 +97,9 @@ =/ res (mox +47.snap) ?> ?=(%0 -.res) =/ poke p.res - =/ res (slum poke now.hid ovo) - =. event-log [ovo event-log] + =. tym (max +(tym) now.hid) + =/ res (slum poke tym ovo) + =. event-log [[tym ovo] event-log] =. snap +3.res =. ..abet-pe (handle-effects ((list ovum) -.res)) $ @@ -237,7 +239,7 @@ ?. &(=(0 (rsh 0 16 u.dest-ip)) =(1 (rsh 0 8 u.dest-ip))) ~& [%havent-implemented-direct-lanes who lan] ..abet-pe - ~& [who=who %blast-sending] + :: ~& [who=who %blast-sending] =/ hear [//newt/0v1n.2m9vh %hear lan pac] =. this (blast-event hear) :: =/ her ?:(=(~dev who) ~bud ~dev) ::ship (dis u.dest-ip 0xff) @@ -337,7 +339,7 @@ ++ handle-ergo |= [way=wire %ergo mount-point=@tas mod=mode:clay] ^+ ..abet-pe - ~& [who=who %file-changes (turn mod head)] + ~& [who=who %file-changes (lent mod)] :: (turn mod head)] ..abet-pe :: :: Give effect to our subscribers @@ -562,7 +564,7 @@ ?- -.ovo %init-ship =/ prev (~(get by init-cache) who.ovo) - ?^ prev + ?: &(?=(^ prev) !=(who.ovo ~marbud)) ~& [%loading-cached-ship who.ovo] =. this (restore-ships ~[who.ovo] init-cache) (pe who.ovo) @@ -590,6 +592,7 @@ stop-processing-events:(pe who.ovo) :: %event + ~& ev=-.q.ovo.ovo (push-events:(pe who.ovo) [ovo.ovo]~) == :: diff --git a/app/ph.hoon b/app/ph.hoon index 1a7ef671a..54e7a3043 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -77,6 +77,33 @@ ^- (list ph-event) (expect-dojo-output ~bud who ovo "hi ~dev successful") -- + :: + :- %child-sync + |% + ++ start + ^- (trel (list ship) (list ph-event) _..start) + :+ ~[~bud ~marbud] + %- zing + :~ (init ~bud) + :: (dojo ~bud "|mount %") + :: %+ insert-file ~bud + :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon + (init ~marbud) + :: (dojo ~marbud "|mount %") + :: %+ insert-file ~marbud + :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon + == + ..start + ++ route + |= [who=ship ovo=unix-effect] + ^- (list ph-event) + (expect-dojo-output ~marbud who ovo "hrm") + -- + :: (init ~zod) + :: (init ~marzod) + :: wait for initial sync + :: change file on zod + :: check on ~marzod :: :- %individual-breach *test-core @@ -90,7 +117,7 @@ :: (init ~zod) w/new keys :: change file on ~zod :: wait for sync to finish - :: verify file has changed + :: verify file has changed on ~marzod :: == this @@ -189,7 +216,7 @@ |- ^- (list ph-event) ?~ ovo.ova ~ - ~& [%diff-aqua-effect-i way -.q.i.ovo.ova] + :: ~& [%diff-aqua-effect-i way -.q.i.ovo.ova] %+ weld (route:cor:(~(got by test-cores) lab) who.ova i.ovo.ova) $(ovo.ova t.ovo.ova) diff --git a/lib/ph.hoon b/lib/ph.hoon index e3d2fcc15..6065eafa2 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -57,6 +57,16 @@ [//term/1 %belt %ret ~] == :: +++ insert-file + |= [who=ship pax=path] + ^- (list ph-event) + ?> ?=([@ @ @ *] pax) + =/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] + %+ send-events-to who + :~ + [//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~] + == +:: ++ expect-dojo-output |= [who=ship her=ship ovo=unix-effect what=tape] ^- (list ph-event) From 0fc7ab112ebcbdc2d19cbe86a335ccf1554dc555 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 8 Feb 2019 19:17:46 -0800 Subject: [PATCH 16/55] modify behn to not fire in the middle of another event and take one timer at a time --- sys/vane/behn.hoon | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) diff --git a/sys/vane/behn.hoon b/sys/vane/behn.hoon index 30aa9cf35..2415a54bb 100644 --- a/sys/vane/behn.hoon +++ b/sys/vane/behn.hoon @@ -59,9 +59,6 @@ ++ wait |= date=@da ^+ [moves state] - :: process elapsed timers first to maintain sort order - :: - =. event-core notify-clients =. timers.state (set-timer [date duct]) set-wake :: +wake: unix says we should wake up; notify clients and set :next-wake @@ -92,7 +89,7 @@ :: ++ notify-clients =* timers timers.state - |- ^+ event-core + ^+ event-core :: ?~ timers =. moves (flop moves) @@ -102,10 +99,10 @@ =. moves (flop moves) event-core :: - %_ $ - timers t.timers - moves [[duct.i.timers %give %wake ~] moves] - == + =. moves [[duct.i.timers %give %wake ~] moves] + => .(timers t.timers) + =. moves (flop moves) + event-core :: +set-wake: set or unset a unix timer to wake us when next timer expires :: :: We prepend the unix %doze event so that it is handled first. Arvo must From da12f0467a32a59db27533395a3dfac785e4a486 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 8 Feb 2019 19:18:38 -0800 Subject: [PATCH 17/55] WIP --- app/aqua.hoon | 45 +++++++++++++++++++++++++++------------------ app/ph.hoon | 15 +++++++++++++-- lib/hood/helm.hoon | 3 ++- lib/ph.hoon | 13 +++++++++++-- sys/vane/clay.hoon | 8 ++++++-- sys/vane/gall.hoon | 1 - 6 files changed, 59 insertions(+), 26 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 8b35a6c02..68f04463e 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -30,13 +30,13 @@ $: %0 pil=pill assembled=* + tym=@da init-cache=(map ship pier) fleet-snaps=(map term (map ship pier)) piers=(map ship pier) == ++ pier - $: tym=@da - snap=* + $: snap=* event-log=(list [@da unix-event]) next-events=(qeu unix-event) processing-events=? @@ -268,14 +268,17 @@ ++ set-timer |= tim=@da =. tim +(tim) :: nobody's perfect + ~& [who=who %setting-timer tim] =. next-timer `tim (emit-moves [ost.hid %wait /(scot %p who) tim]~) :: ++ cancel-timer + ~& [who=who %cancell-timer (need next-timer)] (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) :: ++ take-wake |= [way=wire ~] + ~& [who=who %wakey now.hid] =. next-timer ~ %- push-events:(pe who) [//behn/0v1n.2m9vh %wake ~]~ @@ -459,22 +462,27 @@ :: ?+ val ~|(%bad-noun-arg !!) [%init hers=*] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - ~& [%initting who] - %- push-events:apex:(pe who) - ^- (list unix-event) - :~ `unix-event`[/ %wack 0] :: eny - `unix-event`[/ %whom who] :: eny - `unix-event`[//newt/0v1n.2m9vh %barn ~] - `unix-event`[//behn/0v1n.2m9vh %born ~] - `unix-event`[//term/1 %boot %fake who] - `unix-event`-.userspace-ova.pil - `unix-event`[//http/0v1n.2m9vh %born ~] - `unix-event`[//http/0v1n.2m9vh %live 8.080 `8.445] - `unix-event`[//term/1 %belt %ctl `@c`%x] - == + =/ hers ((list ship) hers.val) + ?~ hers + this + =^ ms this (poke-aqua-events [%init-ship i.hers]~) + (emit-moves ms) + :: %+ turn-ships ((list ship) hers.val) + :: |= [who=ship thus=_this] + :: =. this thus + :: ~& [%initting who] + :: %- push-events:apex:(pe who) + :: ^- (list unix-event) + :: :~ `unix-event`[/ %wack 0] :: eny + :: `unix-event`[/ %whom who] :: eny + :: `unix-event`[//newt/0v1n.2m9vh %barn ~] + :: `unix-event`[//behn/0v1n.2m9vh %born ~] + :: `unix-event`[//term/1 %boot %fake who] + :: `unix-event`-.userspace-ova.pil + :: `unix-event`[//http/0v1n.2m9vh %born ~] + :: `unix-event`[//http/0v1n.2m9vh %live 8.080 `8.445] + :: `unix-event`[//term/1 %belt %ctl `@c`%x] + :: == :: [%dojo hers=* command=*] %+ turn-ships ((list ship) hers.val) @@ -568,6 +576,7 @@ ~& [%loading-cached-ship who.ovo] =. this (restore-ships ~[who.ovo] init-cache) (pe who.ovo) + =. this abet-pe:sleep:(pe who.ovo) =/ initted =< plow %- push-events:apex:(pe who.ovo) diff --git a/app/ph.hoon b/app/ph.hoon index 54e7a3043..16265b189 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -85,10 +85,11 @@ :+ ~[~bud ~marbud] %- zing :~ (init ~bud) + :: (dojo ~bud "\"magic-go\":[.^(") :: (dojo ~bud "|mount %") :: %+ insert-file ~bud :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon - (init ~marbud) + :: (init ~marbud) :: (dojo ~marbud "|mount %") :: %+ insert-file ~marbud :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon @@ -97,7 +98,17 @@ ++ route |= [who=ship ovo=unix-effect] ^- (list ph-event) - (expect-dojo-output ~marbud who ovo "hrm") + :: + :: This is actually super fragile. If we start ~marbud any + :: earlier in the process, we get a crash. The crash may be + :: harmless, not sure. + :: + %- on-dojo-output + :^ ~bud who ovo + :- "~zod not responding still trying" + ^- $-($~ (list ph-event)) + |= ~ + (init ~marbud) -- :: (init ~zod) :: (init ~marzod) diff --git a/lib/hood/helm.hoon b/lib/hood/helm.hoon index 462361511..f5b566fda 100644 --- a/lib/hood/helm.hoon +++ b/lib/hood/helm.hoon @@ -189,7 +189,8 @@ =/ top=path /(scot %p our)/home/(scot %da now)/sys =/ hun .^(@ %cx (welp top /hoon/hoon)) =/ arv .^(@ %cx (welp top /arvo/hoon)) - :- [%flog /reset [%lyra `@t`hun `@t`arv]] + :- `card`[%flog /reset [%lyra `@t`hun `@t`arv]] + ^- (list card) %+ turn (module-ova:pill top) |=(a=[wire flog:dill] [%flog a]) diff --git a/lib/ph.hoon b/lib/ph.hoon index 6065eafa2..0adc5855f 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -67,8 +67,8 @@ [//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~] == :: -++ expect-dojo-output - |= [who=ship her=ship ovo=unix-effect what=tape] +++ on-dojo-output + |= [who=ship her=ship ovo=unix-effect what=tape fun=$-($~ (list ph-event))] ^- (list ph-event) ?. =(who her) ~ @@ -80,5 +80,14 @@ | !=(~ (find what p.blit)) ~ + (fun) +:: +++ expect-dojo-output + |= [who=ship her=ship ovo=unix-effect what=tape] + ^- (list ph-event) + %- on-dojo-output + :^ who her ovo + :- what + |= ~ [%test-done &]~ -- diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 1297256b0..c6c2113ed 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -2397,8 +2397,8 @@ ^+ bar ?- -.mys $ins :: insert if not exist - ?: (~(has by bar) pax) !! :: - ?: (~(has by hat) pax) !! :: + ?: (~(has by bar) pax) ~|([%ins-bar pax] !!) :: + ?: (~(has by hat) pax) ~|([%ins-hat pax] !!) :: %+ ~(put by bar) pax %- make-direct-blob ?: &(?=($mime -.p.mys) =([%hoon ~] (slag (dec (lent pax)) pax))) @@ -4231,6 +4231,10 @@ :: $note [[hen %give +.q.hin]~ ..^$] $wake + :: dear reader, if it crashes here, check the wire. If it came + :: from ++bait, then I don't think we have any handling for that + :: sort of thing. + :: =^ queued cue.ruf ~(get to cue.ruf) :: =/ queued-duct=duct -.queued diff --git a/sys/vane/gall.hoon b/sys/vane/gall.hoon index 07e534bf3..5ec68757f 100644 --- a/sys/vane/gall.hoon +++ b/sys/vane/gall.hoon @@ -1258,7 +1258,6 @@ ^- (unit @tas) ?+ sep ~& [%ap-vain sep] ~ -<<<<<<< HEAD %build `%f %cash `%a %conf `%g From 17cea6a1c7d833568ec759980586f4283322f07e Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 11 Feb 2019 13:42:54 -0800 Subject: [PATCH 18/55] better child-sync test --- app/aqua.hoon | 2 +- app/ph.hoon | 46 +++++++++++++++++++++++++++++++++++----------- 2 files changed, 36 insertions(+), 12 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 68f04463e..dc0b58cf9 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -572,7 +572,7 @@ ?- -.ovo %init-ship =/ prev (~(get by init-cache) who.ovo) - ?: &(?=(^ prev) !=(who.ovo ~marbud)) + ?: &(?=(^ prev) (lth who.ovo ~marzod)) ~& [%loading-cached-ship who.ovo] =. this (restore-ships ~[who.ovo] init-cache) (pe who.ovo) diff --git a/app/ph.hoon b/app/ph.hoon index 16265b189..4fcc9c1b3 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -82,7 +82,7 @@ |% ++ start ^- (trel (list ship) (list ph-event) _..start) - :+ ~[~bud ~marbud] + :+ ~[~bud ~marbud ~linnup-torsyx] %- zing :~ (init ~bud) :: (dojo ~bud "\"magic-go\":[.^(") @@ -98,17 +98,37 @@ ++ route |= [who=ship ovo=unix-effect] ^- (list ph-event) + %- zing + :~ + %- on-dojo-output + :^ ~bud who ovo + :- "+ /~bud/base/2/web/testing/udon" + ^- $-($~ (list ph-event)) + |= ~ + (init ~marbud) :: - :: This is actually super fragile. If we start ~marbud any - :: earlier in the process, we get a crash. The crash may be - :: harmless, not sure. + %- on-dojo-output + :^ ~marbud who ovo + :- "; ~bud is your neighbor" + ^- $-($~ (list ph-event)) + |= ~ + (init ~linnup-torsyx) :: - %- on-dojo-output - :^ ~bud who ovo - :- "~zod not responding still trying" - ^- $-($~ (list ph-event)) - |= ~ - (init ~marbud) + %- on-dojo-output + :^ ~linnup-torsyx who ovo + :- "; ~bud is your neighbor" + ^- $-($~ (list ph-event)) + |= ~ + (dojo ~linnup-torsyx "|hi ~bud") + :: + %- on-dojo-output + :^ ~linnup-torsyx who ovo + :- "hi ~bud successful" + :: :- "; ~bud is your neighbor" + ^- $-($~ (list ph-event)) + |= ~ + [%test-done &]~ + == -- :: (init ~zod) :: (init ~marzod) @@ -223,12 +243,16 @@ :: ~& [%diff-aqua-effect way who.ova] ?> ?=([@tas @ ~] way) =/ lab i.way + =/ test-cor (~(get by test-cores) lab) + ?~ test-cor + ~& [%ph-dropping lab] + `this %+ run-events lab |- ^- (list ph-event) ?~ ovo.ova ~ :: ~& [%diff-aqua-effect-i way -.q.i.ovo.ova] %+ weld - (route:cor:(~(got by test-cores) lab) who.ova i.ovo.ova) + (route:cor.u.test-cor who.ova i.ovo.ova) $(ovo.ova t.ovo.ova) -- From 600dc02a2f045dfe34f5f880b3b7df9637e8b4a9 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 11 Feb 2019 15:25:25 -0800 Subject: [PATCH 19/55] basic ph test composition --- app/ph.hoon | 132 +++++++++++++++++++++++++++++++++------------------- lib/ph.hoon | 83 ++++++++++++++++++++++++++++++++- 2 files changed, 165 insertions(+), 50 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 4fcc9c1b3..043a15538 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -1,4 +1,4 @@ -:: Test the pH of your aquarium. See if it's safe to put real fish in. +:: Test the pH of your aquarium. See if it's safe to put in real fish. :: :: usage: :: :aqua [%run-test %test-add] @@ -42,82 +42,107 @@ :- %add =+ num=5 |% + ++ ships ~[~bud] ++ start - ^- (trel (list ship) (list ph-event) _..start) + ^- (pair (list ph-event) _..start) =. num +(num) - :+ ~[~bud] - %- zing - :~ (init ~bud) - (dojo ~bud "[%test-result (add 2 3)]") - == - ..start + :_ ..start + %- zing + :~ (init ~bud) + (dojo ~bud "[%test-result (add 2 3)]") + == :: ++ route |= [who=ship ovo=unix-effect] - ^- (list ph-event) + ^- (quip ph-event _..start) ~& [%num num] + :_ ..start (expect-dojo-output ~bud who ovo "[%test-result 5]") :: XX if it's been five minutes, we failed -- :: :- %hi |% + ++ ships ~[~bud ~marbud] ++ start - ^- (trel (list ship) (list ph-event) _..start) - :+ ~[~bud ~dev] - %- zing - :~ (init ~bud) - (init ~dev) - (dojo ~bud "|hi ~dev") - == - ..start + ^- (pair (list ph-event) _..start) + :_ ..start + %- zing + :~ (init ~bud) + (init ~dev) + (dojo ~bud "|hi ~dev") + == :: ++ route |= [who=ship ovo=unix-effect] - ^- (list ph-event) + ^- (quip ph-event _..start) + :_ ..start (expect-dojo-output ~bud who ovo "hi ~dev successful") -- + :: + [%headstart-marbud marbud:head-starts] + :: + :- %composed-child-sync + %+ compose-tests marbud:head-starts + ^- test-core + |% + ++ ships ~[~bud ~marbud ~linnup-torsyx] + ++ start + :_ ..start + (init ~linnup-torsyx) + :: + ++ route + |= [who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + :_ ..start + %- zing + :~ + %- on-dojo-output + :^ ~linnup-torsyx who ovo + :- "; ~bud is your neighbor" + |= ~ + (dojo ~linnup-torsyx "|hi ~bud") + :: + %- on-dojo-output + :^ ~linnup-torsyx who ovo + :- "hi ~bud successful" + :: :- "; ~bud is your neighbor" + |= ~ + [%test-done &]~ + == + -- :: :- %child-sync |% + ++ ships ~[~bud ~marbud ~linnup-torsyx] ++ start - ^- (trel (list ship) (list ph-event) _..start) - :+ ~[~bud ~marbud ~linnup-torsyx] - %- zing - :~ (init ~bud) - :: (dojo ~bud "\"magic-go\":[.^(") - :: (dojo ~bud "|mount %") - :: %+ insert-file ~bud - :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon - :: (init ~marbud) - :: (dojo ~marbud "|mount %") - :: %+ insert-file ~marbud - :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon - == - ..start + ^- (pair (list ph-event) _..start) + :_ ..start + %- zing + :~ (init ~bud) + == + :: ++ route |= [who=ship ovo=unix-effect] - ^- (list ph-event) + ^- (quip ph-event _..start) + :_ ..start %- zing :~ %- on-dojo-output :^ ~bud who ovo :- "+ /~bud/base/2/web/testing/udon" - ^- $-($~ (list ph-event)) |= ~ (init ~marbud) :: %- on-dojo-output :^ ~marbud who ovo :- "; ~bud is your neighbor" - ^- $-($~ (list ph-event)) |= ~ (init ~linnup-torsyx) :: %- on-dojo-output :^ ~linnup-torsyx who ovo :- "; ~bud is your neighbor" - ^- $-($~ (list ph-event)) |= ~ (dojo ~linnup-torsyx "|hi ~bud") :: @@ -125,11 +150,19 @@ :^ ~linnup-torsyx who ovo :- "hi ~bud successful" :: :- "; ~bud is your neighbor" - ^- $-($~ (list ph-event)) |= ~ [%test-done &]~ == -- + :: (dojo ~bud "\"magic-go\":[.^(") + :: (dojo ~bud "|mount %") + :: %+ insert-file ~bud + :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon + :: (init ~marbud) + :: (dojo ~marbud "|mount %") + :: %+ insert-file ~marbud + :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon + :: :: (init ~zod) :: (init ~marzod) :: wait for initial sync @@ -229,10 +262,10 @@ ^- (quip move _this) ?+ arg ~|(%bad-noun-arg !!) [%run-test lab=@tas] - =/ res=[hers=(list ship) events=(list ph-event) new-state=test-core] + =/ res=[events=(list ph-event) new-state=test-core] start:(~(got by raw-test-cores) lab.arg) - =. test-cores (~(put by test-cores) lab.arg hers.res new-state.res) - =^ moves-1 this (subscribe-to-effects lab.arg hers.res) + =. test-cores (~(put by test-cores) lab.arg [ships .]:new-state.res) + =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) =^ moves-2 this (run-events lab.arg events.res) [(weld moves-1 moves-2) this] == @@ -247,12 +280,15 @@ ?~ test-cor ~& [%ph-dropping lab] `this - %+ run-events lab - |- ^- (list ph-event) - ?~ ovo.ova - ~ - :: ~& [%diff-aqua-effect-i way -.q.i.ovo.ova] - %+ weld - (route:cor.u.test-cor who.ova i.ovo.ova) - $(ovo.ova t.ovo.ova) + =^ events u.test-cor + |- ^- (quip ph-event _u.test-cor) + ?~ ovo.ova + [~ u.test-cor] + =^ events-1 cor.u.test-cor + (route:cor.u.test-cor who.ova i.ovo.ova) + =^ events-2 u.test-cor + $(ovo.ova t.ovo.ova) + [(weld events-1 events-2) u.test-cor] + =. test-cores (~(put by test-cores) lab u.test-cor) + (run-events lab events) -- diff --git a/lib/ph.hoon b/lib/ph.hoon index 0adc5855f..725166d22 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -22,8 +22,9 @@ ++ test-core $_ ^? |% - ++ start *(trel (list ship) (list ph-event) _^?(..start)) - ++ route |~([ship unix-effect] *(list ph-event)) + ++ ships *(list ship) + ++ start *(quip ph-event _^?(..start)) + ++ route |~([ship unix-effect] *(quip ph-event _^?(..start))) -- :: ++ ph-event @@ -90,4 +91,82 @@ :- what |= ~ [%test-done &]~ +:: +++ compose-tests + |= [a=test-core b=test-core] + ^- test-core + =/ done-with-a | + |% + :: Union of ships in a and b + :: + ++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b))) + :: + :: Start with start of a + :: + ++ start + ^- (quip ph-event _..start) + =^ events a start:a + [events ..start] + :: + :: Keep going on a until it's done. If success, go to b. + :: + :: In theory, we should be able to just swap out the whole core + :: for b, but in practice the types are hard, and we generally + :: try to avoid changing the structure of a core in the middle + :: like that. + :: + ++ route + |= [who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + ?: done-with-a + =^ events b (route:b who ovo) + [events ..start] + =^ events a (route:a who ovo) + =+ ^- [done=(list ph-event) other-events=(list ph-event)] + %+ skid events + |= e=ph-event + =(%test-done -.e) + ?~ done + [other-events ..start] + ?> ?=(%test-done -.i.done) + ?. p.i.done + [[%test-done |]~ ..start] + =. done-with-a & + =^ events-start b start:b + [(weld other-events events-start) ..start] + -- +:: +++ head-starts + |% + ++ marbud + ^- test-core + |% + ++ ships ~[~bud ~marbud] + ++ start + ^- (quip ph-event _..start) + :_ ..start + %- zing + :~ (init ~bud) + == + :: + ++ route + |= [who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + :_ ..start + %- zing + :~ + %- on-dojo-output + :^ ~bud who ovo + :- "+ /~bud/base/2/web/testing/udon" + |= ~ + (init ~marbud) + :: + %- on-dojo-output + :^ ~marbud who ovo + :- "; ~bud is your neighbor" + |= ~ + [%test-done &]~ + == + -- + -- -- From 11adf30c72d06d62262dcd0c7a56098c1fe9e270 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 11 Feb 2019 15:53:23 -0800 Subject: [PATCH 20/55] more modular test headstarts --- app/ph.hoon | 33 +++++++++++-------------------- lib/ph.hoon | 56 +++++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 55 insertions(+), 34 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 043a15538..dbe517b84 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -63,7 +63,7 @@ :: :- %hi |% - ++ ships ~[~bud ~marbud] + ++ ships ~[~bud ~dev] ++ start ^- (pair (list ph-event) _..start) :_ ..start @@ -80,36 +80,25 @@ (expect-dojo-output ~bud who ovo "hi ~dev successful") -- :: - [%headstart-marbud marbud:head-starts] + [%headstart-bud (galaxy:head-starts ~bud)] :: - :- %composed-child-sync - %+ compose-tests marbud:head-starts + :- %composed-child-boot + %+ compose-tests (planet:head-starts ~linnup-torsyx) ^- test-core |% - ++ ships ~[~bud ~marbud ~linnup-torsyx] + ++ ships ~ ++ start - :_ ..start - (init ~linnup-torsyx) + [(dojo ~linnup-torsyx "|hi ~bud") ..start] :: ++ route |= [who=ship ovo=unix-effect] ^- (quip ph-event _..start) :_ ..start - %- zing - :~ - %- on-dojo-output - :^ ~linnup-torsyx who ovo - :- "; ~bud is your neighbor" - |= ~ - (dojo ~linnup-torsyx "|hi ~bud") - :: - %- on-dojo-output - :^ ~linnup-torsyx who ovo - :- "hi ~bud successful" - :: :- "; ~bud is your neighbor" - |= ~ - [%test-done &]~ - == + %- on-dojo-output + :^ ~linnup-torsyx who ovo + :- "hi ~bud successful" + |= ~ + [%test-done &]~ -- :: :- %child-sync diff --git a/lib/ph.hoon b/lib/ph.hoon index 725166d22..7d47c1650 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -138,35 +138,67 @@ :: ++ head-starts |% - ++ marbud + :: Don't use directly, or else you might not have a parent. + :: + :: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors. + :: + ++ raw-ship + |= her=ship ^- test-core |% - ++ ships ~[~bud ~marbud] + ++ ships ~[her] ++ start ^- (quip ph-event _..start) - :_ ..start - %- zing - :~ (init ~bud) - == + [(init her) ..start] :: ++ route |= [who=ship ovo=unix-effect] ^- (quip ph-event _..start) :_ ..start %- zing + :: This is a pretty bad heuristic, but in general galaxies will + :: hit the first of these cases, and other ships will hit the + :: second. + :: :~ %- on-dojo-output - :^ ~bud who ovo - :- "+ /~bud/base/2/web/testing/udon" + :^ her who ovo + :- "+ /{(scow %p her)}/base/2/web/testing/udon" |= ~ - (init ~marbud) + [%test-done &]~ :: %- on-dojo-output - :^ ~marbud who ovo - :- "; ~bud is your neighbor" + :^ her who ovo + :- "is your neighbor" |= ~ [%test-done &]~ == -- - -- + ++ galaxy + |= her=ship + ?> =(%czar (clan:title her)) + (raw-ship her) + :: + ++ star + |= her=ship + ?> =(%king (clan:title her)) + %+ compose-tests (galaxy (^sein:title her)) + (raw-ship her) + :: + ++ planet + |= her=ship + ?> =(%duke (clan:title her)) + %+ compose-tests (star (^sein:title her)) + (raw-ship her) + :: + ++ ship-with-ancestors + |= her=ship + %. her + ?- (clan:title her) + %czar galaxy + %king star + %duke planet + %earl ~|(%moon-not-implemented !!) + %pawn ~|(%comet-not-implemented !!) + == -- From 3336699660297e010fa5087193745b14acb1d565 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Mon, 11 Feb 2019 18:46:36 -0800 Subject: [PATCH 21/55] most of proper cache restoration --- app/aqua.hoon | 53 +++++++++++++++----- app/ph.hoon | 56 ++++++++++++++++----- lib/ph.hoon | 121 ++++++++++++++++++++++++++++------------------ sur/aquarium.hoon | 2 + 4 files changed, 160 insertions(+), 72 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index dc0b58cf9..ce9f29f4c 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -546,18 +546,8 @@ this :: [%restore-fleet lab=@tas] - =. this - %+ turn-ships (turn ~(tap by piers) head) - |= [who=ship thus=_this] - =. this thus - sleep:(pe who) - =. piers (~(got by fleet-snaps) lab.val) - =. this - %+ turn-ships (turn ~(tap by piers) head) - |= [who=ship thus=_this] - =. this thus - restore:(pe who) - this + =^ ms this (poke-aqua-events [%restore-snap lab.val]~) + (emit-moves ms) == :: :: Apply a list of events tagged by ship @@ -599,6 +589,33 @@ :: %pause-events stop-processing-events:(pe who.ovo) + :: + %snap-ships + =. fleet-snaps + %+ ~(put by fleet-snaps) lab.ovo + %- malt + %+ murn hers.ovo + |= her=ship + ^- (unit (pair ship pier)) + =+ per=(~(get by piers) her) + ?~ per + ~ + `[her u.per] + (pe -.hers.ovo) + :: + %restore-snap + =. this + %+ turn-ships (turn ~(tap by piers) head) + |= [who=ship thus=_this] + =. this thus + sleep:(pe who) + =. piers (~(got by fleet-snaps) lab.ovo) + =. this + %+ turn-ships (turn ~(tap by piers) head) + |= [who=ship thus=_this] + =. this thus + restore:(pe who) + (pe ~bud) :: XX why ~bud? need an example :: %event ~& ev=-.q.ovo.ovo @@ -711,6 +728,17 @@ =. this thus (take-sigh-tang:(pe who) t.way tan) :: +:: Handle scry to aqua +:: +++ peek-x-fleet-snap + |= pax=path + ^- (unit (unit [%noun noun])) + ~& [%peeking pax] + ?. ?=([@ ~] pax) + ~ + :^ ~ ~ %noun + (~(has by fleet-snaps) i.pax) +:: :: Trivial scry for mock :: ++ scry |=([* *] ~) @@ -720,6 +748,7 @@ ++ prep |= old/(unit noun) ^- [(list move) _+>.$] + ~& prep=%aqua ?~ old `+>.$ =+ new=((soft state) u.old) diff --git a/app/ph.hoon b/app/ph.hoon index dbe517b84..f2f94e4f9 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -33,17 +33,22 @@ state == ++ this . +++ test-lib ~(. ^test-lib our.hid) ++ install-tests ^+ this =. raw-test-cores + ~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid)) + =, test-lib %- malt ^- (list (pair term test-core)) :~ :- %add =+ num=5 - |% + |_ [our=@p now=@da] + ++ label %add ++ ships ~[~bud] ++ start + |= now=@da ^- (pair (list ph-event) _..start) =. num +(num) :_ ..start @@ -53,7 +58,7 @@ == :: ++ route - |= [who=ship ovo=unix-effect] + |= [now=@da who=ship ovo=unix-effect] ^- (quip ph-event _..start) ~& [%num num] :_ ..start @@ -62,9 +67,11 @@ -- :: :- %hi - |% + |_ [our=@p now=@da] + ++ label %hi ++ ships ~[~bud ~dev] ++ start + |= now=@da ^- (pair (list ph-event) _..start) :_ ..start %- zing @@ -74,24 +81,26 @@ == :: ++ route - |= [who=ship ovo=unix-effect] + |= [now=@da who=ship ovo=unix-effect] ^- (quip ph-event _..start) :_ ..start (expect-dojo-output ~bud who ovo "hi ~dev successful") -- :: - [%headstart-bud (galaxy:head-starts ~bud)] + [%headstart-bud (galaxy ~bud)] :: :- %composed-child-boot - %+ compose-tests (planet:head-starts ~linnup-torsyx) + %+ compose-tests (planet ~linnup-torsyx) ^- test-core - |% + |_ [our=@p now=@da] + ++ label %composed-child-boot ++ ships ~ ++ start + |= now=@da [(dojo ~linnup-torsyx "|hi ~bud") ..start] :: ++ route - |= [who=ship ovo=unix-effect] + |= [now=@da who=ship ovo=unix-effect] ^- (quip ph-event _..start) :_ ..start %- on-dojo-output @@ -100,11 +109,34 @@ |= ~ [%test-done &]~ -- + :: + :- %composed-child-boot-2 + %+ compose-tests (planet ~haplun-todtus) + ^- test-core + |_ [our=@p now=@da] + ++ label %composed-child-boot-2 + ++ ships ~ + ++ start + |= now=@da + [(dojo ~haplun-todtus "|hi ~bud") ..start] + :: + ++ route + |= [now=@da who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + :_ ..start + %- on-dojo-output + :^ ~haplun-todtus who ovo + :- "hi ~bud successful" + |= ~ + [%test-done &]~ + -- :: :- %child-sync - |% + |_ [our=@p now=@da] + ++ label %child-sync ++ ships ~[~bud ~marbud ~linnup-torsyx] ++ start + |= now=@da ^- (pair (list ph-event) _..start) :_ ..start %- zing @@ -112,7 +144,7 @@ == :: ++ route - |= [who=ship ovo=unix-effect] + |= [now=@da who=ship ovo=unix-effect] ^- (quip ph-event _..start) :_ ..start %- zing @@ -252,7 +284,7 @@ ?+ arg ~|(%bad-noun-arg !!) [%run-test lab=@tas] =/ res=[events=(list ph-event) new-state=test-core] - start:(~(got by raw-test-cores) lab.arg) + (start:(~(got by raw-test-cores) lab.arg) now.hid) =. test-cores (~(put by test-cores) lab.arg [ships .]:new-state.res) =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) =^ moves-2 this (run-events lab.arg events.res) @@ -274,7 +306,7 @@ ?~ ovo.ova [~ u.test-cor] =^ events-1 cor.u.test-cor - (route:cor.u.test-cor who.ova i.ovo.ova) + (route:cor.u.test-cor now.hid who.ova i.ovo.ova) =^ events-2 u.test-cor $(ovo.ova t.ovo.ova) [(weld events-1 events-2) u.test-cor] diff --git a/lib/ph.hoon b/lib/ph.hoon index 7d47c1650..3a15b80d7 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -22,9 +22,10 @@ ++ test-core $_ ^? |% + ++ label *term ++ ships *(list ship) - ++ start *(quip ph-event _^?(..start)) - ++ route |~([ship unix-effect] *(quip ph-event _^?(..start))) + ++ start |~(@da *(quip ph-event _^?(..start))) + ++ route |~([@da [ship unix-effect]] *(quip ph-event _^?(..start))) -- :: ++ ph-event @@ -92,52 +93,73 @@ |= ~ [%test-done &]~ :: -++ compose-tests - |= [a=test-core b=test-core] - ^- test-core - =/ done-with-a | - |% - :: Union of ships in a and b - :: - ++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b))) - :: - :: Start with start of a - :: - ++ start - ^- (quip ph-event _..start) - =^ events a start:a - [events ..start] - :: - :: Keep going on a until it's done. If success, go to b. - :: - :: In theory, we should be able to just swap out the whole core - :: for b, but in practice the types are hard, and we generally - :: try to avoid changing the structure of a core in the middle - :: like that. - :: - ++ route - |= [who=ship ovo=unix-effect] - ^- (quip ph-event _..start) - ?: done-with-a - =^ events b (route:b who ovo) +++ test-lib + |_ our=ship + ++ compose-tests + |= [a=test-core b=test-core] + ^- test-core + =/ done-with-a | + |% + :: + :: Cache lookup label + :: + ++ label :((cury cat 3) label:a '--1-' label:b) + :: + :: Union of ships in a and b + :: + ++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b))) + :: + :: Start with start of a + :: + ++ start + |= now=@da + ^- (quip ph-event _..start) + =/ have-cache + .^ @f + %gx + (scot %p our) + %aqua + (scot %da now) + /fleet-snap/[label:a]/noun + == + ~& [%have-cache label:a have-cache] + ?: have-cache + =. done-with-a & + =/ restore-event [%restore-snap label:a] + =^ events-start b (start:b now) + [[restore-event events-start] ..start] + =^ events a (start:a now) [events ..start] - =^ events a (route:a who ovo) - =+ ^- [done=(list ph-event) other-events=(list ph-event)] - %+ skid events - |= e=ph-event - =(%test-done -.e) - ?~ done - [other-events ..start] - ?> ?=(%test-done -.i.done) - ?. p.i.done - [[%test-done |]~ ..start] - =. done-with-a & - =^ events-start b start:b - [(weld other-events events-start) ..start] - -- -:: -++ head-starts - |% + :: + :: Keep going on a until it's done. If success, go to b. + :: + :: In theory, we should be able to just swap out the whole core + :: for b, but in practice the types are hard, and we generally + :: try to avoid changing the structure of a core in the middle + :: like that. + :: + ++ route + |= [now=@da who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + ?: done-with-a + =^ events b (route:b now who ovo) + [events ..start] + =^ events a (route:a now who ovo) + =+ ^- [done=(list ph-event) other-events=(list ph-event)] + %+ skid events + |= e=ph-event + =(%test-done -.e) + ?~ done + [other-events ..start] + ?> ?=(%test-done -.i.done) + ?. p.i.done + [[%test-done |]~ ..start] + =. done-with-a & + =/ snap-event [%snap-ships label:a ships:a] + =^ events-start b (start:b now) + [(welp other-events [snap-event events-start]) ..start] + -- + :: :: Don't use directly, or else you might not have a parent. :: :: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors. @@ -146,13 +168,15 @@ |= her=ship ^- test-core |% + ++ label (cat 3 'iinit-' (scot %p her)) ++ ships ~[her] ++ start + |= now=@da ^- (quip ph-event _..start) [(init her) ..start] :: ++ route - |= [who=ship ovo=unix-effect] + |= [now=@da who=ship ovo=unix-effect] ^- (quip ph-event _..start) :_ ..start %- zing @@ -201,4 +225,5 @@ %earl ~|(%moon-not-implemented !!) %pawn ~|(%comet-not-implemented !!) == + -- -- diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon index 24a9a3fe5..1adaec11e 100644 --- a/sur/aquarium.hoon +++ b/sur/aquarium.hoon @@ -2,6 +2,8 @@ ++ aqua-event $% [%init-ship who=ship] [%pause-events who=ship] + [%snap-ships lab=term hers=(list ship)] + [%restore-snap lab=term] [%event who=ship ovo=unix-event] == :: From 42d5c9004c412e1d8d146c4e4f1c5548b3de5ff2 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Tue, 12 Feb 2019 11:26:48 -0800 Subject: [PATCH 22/55] small fixes and docs --- app/aqua.hoon | 2 +- app/ph.hoon | 4 +++- lib/ph.hoon | 37 ++++++++++++++++++++----------------- 3 files changed, 24 insertions(+), 19 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index ce9f29f4c..a39fd714f 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -609,7 +609,7 @@ |= [who=ship thus=_this] =. this thus sleep:(pe who) - =. piers (~(got by fleet-snaps) lab.ovo) + =. piers (~(uni by piers) (~(got by fleet-snaps) lab.ovo)) =. this %+ turn-ships (turn ~(tap by piers) head) |= [who=ship thus=_this] diff --git a/app/ph.hoon b/app/ph.hoon index f2f94e4f9..b9142f413 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -111,7 +111,9 @@ -- :: :- %composed-child-boot-2 - %+ compose-tests (planet ~haplun-todtus) + %+ compose-tests + %+ compose-tests (planet ~mitnep-todsut) + (planet ~haplun-todtus) ^- test-core |_ [our=@p now=@da] ++ label %composed-child-boot-2 diff --git a/lib/ph.hoon b/lib/ph.hoon index 3a15b80d7..477cfa7b2 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -6,26 +6,28 @@ |% :: Defines a complete integration test. :: -:: Perhaps route should take a unix-effect rather than a sign. -:: Similarly, perhaps ++abet should produce a list of -:: unix-events. Also, perhaps we should support state. -:: -:: Perhaps closer to this: -:: ++ test-core -:: $_ ^? -:: |% -:: ++ start ^?(..abet) -:: ++ route |~([wire unix-effect] ^?(..abet)) -:: ++ abet *(list unix-event) -:: -- -:: ++ test-core $_ ^? |% + :: + :: Unique name, used as a cache label. + :: ++ label *term + :: + :: List of ships that are part of the test. + :: + :: We'll only hear effects from these ships, and only these will + :: be in the cache points. + :: ++ ships *(list ship) - ++ start |~(@da *(quip ph-event _^?(..start))) - ++ route |~([@da [ship unix-effect]] *(quip ph-event _^?(..start))) + :: + :: Called first to kick off the test. + :: + ++ start |~(now=@da *(quip ph-event _^?(..start))) + :: + :: Called on every effect from a ship. + :: + ++ route |~([now=@da ship unix-effect] *(quip ph-event _^?(..start))) -- :: ++ ph-event @@ -103,7 +105,7 @@ :: :: Cache lookup label :: - ++ label :((cury cat 3) label:a '--1-' label:b) + ++ label :((cury cat 3) label:a '--' label:b) :: :: Union of ships in a and b :: @@ -168,7 +170,7 @@ |= her=ship ^- test-core |% - ++ label (cat 3 'iinit-' (scot %p her)) + ++ label (cat 3 'init-' (scot %p her)) ++ ships ~[her] ++ start |= now=@da @@ -198,6 +200,7 @@ [%test-done &]~ == -- + :: ++ galaxy |= her=ship ?> =(%czar (clan:title her)) From 6337c9162bbcec507019622d3afd1d244a992b7f Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Tue, 12 Feb 2019 16:11:19 -0800 Subject: [PATCH 23/55] no barcabs anymore --- app/ph.hoon | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index b9142f413..9b512cee7 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -44,7 +44,7 @@ :~ :- %add =+ num=5 - |_ [our=@p now=@da] + |% ++ label %add ++ ships ~[~bud] ++ start @@ -67,7 +67,7 @@ -- :: :- %hi - |_ [our=@p now=@da] + |% ++ label %hi ++ ships ~[~bud ~dev] ++ start @@ -92,7 +92,7 @@ :- %composed-child-boot %+ compose-tests (planet ~linnup-torsyx) ^- test-core - |_ [our=@p now=@da] + |% ++ label %composed-child-boot ++ ships ~ ++ start @@ -115,7 +115,7 @@ %+ compose-tests (planet ~mitnep-todsut) (planet ~haplun-todtus) ^- test-core - |_ [our=@p now=@da] + |% ++ label %composed-child-boot-2 ++ ships ~ ++ start @@ -134,7 +134,7 @@ -- :: :- %child-sync - |_ [our=@p now=@da] + |% ++ label %child-sync ++ ships ~[~bud ~marbud ~linnup-torsyx] ++ start From 7f8e3daaaf64bfca42b51443b6f4cace23f6efce Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 14 Feb 2019 17:18:04 -0800 Subject: [PATCH 24/55] add test for changing a file --- app/aqua.hoon | 27 +++++++++++++++++++--- app/ph.hoon | 63 ++++++++++++++++----------------------------------- lib/ph.hoon | 30 ++++++++++++++++-------- 3 files changed, 65 insertions(+), 55 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index a39fd714f..b9e75e231 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -111,8 +111,13 @@ =/ res (mox +46.snap) ?> ?=(%0 -.res) =/ peek p.res - ~& [who=who %peeked (slum peek [now.hid p])] - ..abet-pe + =/ pax (path p) + ~& [who=who %peeking-in tym pax] + ?> ?=([@ @ @ @ *] pax) + =. i.t.t.t.pax (scot %da tym) + =/ pek (slum peek [tym pax]) + ~& [who=who %peeked] + pek :: :: Wish :: @@ -521,7 +526,8 @@ %+ turn-ships ((list ship) hers.val) |= [who=ship thus=_this] =. this thus - (peek:(pe who) p.val) + ~& [who=who %peek-result (peek:(pe who) p.val)] + (pe who) :: [%wish hers=* p=@t] %+ turn-ships ((list ship) hers.val) @@ -739,6 +745,21 @@ :^ ~ ~ %noun (~(has by fleet-snaps) i.pax) :: +:: +:: +++ peek-x-i + |= pax=path + ^- (unit (unit [%noun noun])) + ~& [%peeking-i pax] + ?. ?=([@ @ @ *] pax) + ~ + =/ who (slav %p i.pax) + =/ pier (~(get by piers) who) + ?~ pier + ~ + :^ ~ ~ %noun + (peek:(pe who) [%cx pax]) +:: :: Trivial scry for mock :: ++ scry |=([* *] ~) diff --git a/app/ph.hoon b/app/ph.hoon index 9b512cee7..2ad41a615 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -133,16 +133,23 @@ [%test-done &]~ -- :: - :- %child-sync + :- %change-file + %+ compose-tests (galaxy ~bud) + ^- test-core + =| warped=@t |% - ++ label %child-sync - ++ ships ~[~bud ~marbud ~linnup-torsyx] + ++ label %change-file + ++ ships ~ ++ start |= now=@da ^- (pair (list ph-event) _..start) + =/ pax + /(scot %p our.hid)/home/(scot %da now.hid)/sur/aquarium/hoon + =. warped (cat 3 '=> . ' .^(@t %cx pax)) :_ ..start %- zing - :~ (init ~bud) + :~ (dojo ~bud "|mount %") + (insert-file ~bud pax warped) == :: ++ route @@ -150,47 +157,17 @@ ^- (quip ph-event _..start) :_ ..start %- zing - :~ - %- on-dojo-output - :^ ~bud who ovo - :- "+ /~bud/base/2/web/testing/udon" - |= ~ - (init ~marbud) - :: - %- on-dojo-output - :^ ~marbud who ovo - :- "; ~bud is your neighbor" - |= ~ - (init ~linnup-torsyx) - :: - %- on-dojo-output - :^ ~linnup-torsyx who ovo - :- "; ~bud is your neighbor" - |= ~ - (dojo ~linnup-torsyx "|hi ~bud") - :: - %- on-dojo-output - :^ ~linnup-torsyx who ovo - :- "hi ~bud successful" - :: :- "; ~bud is your neighbor" - |= ~ - [%test-done &]~ + :~ %- on-ergo + :^ ~bud who ovo + |= $~ + =/ pax /i/~bud/home/(scot %da now)/sur/aquarium/hoon/noun + ~& [%compare (met 3 warped) (met 3 (need (scry-aqua (unit @) now pax)))] + ?: =(warped (need (scry-aqua (unit @) now pax))) + [%test-done &]~ + ~& %not-done-yet + ~ == -- - :: (dojo ~bud "\"magic-go\":[.^(") - :: (dojo ~bud "|mount %") - :: %+ insert-file ~bud - :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon - :: (init ~marbud) - :: (dojo ~marbud "|mount %") - :: %+ insert-file ~marbud - :: /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/clay/hoon - :: - :: (init ~zod) - :: (init ~marzod) - :: wait for initial sync - :: change file on zod - :: check on ~marzod :: :- %individual-breach *test-core diff --git a/lib/ph.hoon b/lib/ph.hoon index 477cfa7b2..67f88a6d4 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -62,10 +62,10 @@ == :: ++ insert-file - |= [who=ship pax=path] + |= [who=ship pax=path txt=@t] ^- (list ph-event) ?> ?=([@ @ @ *] pax) - =/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] + =/ file [/text/plain (as-octs:mimes:html txt)] %+ send-events-to who :~ [//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~] @@ -95,6 +95,14 @@ |= ~ [%test-done &]~ :: +++ on-ergo + |= [who=ship her=ship ovo=unix-effect fun=$-($~ (list ph-event))] + ?. =(who her) + ~ + ?. ?=(%ergo -.q.ovo) + ~ + (fun) +:: ++ test-lib |_ our=ship ++ compose-tests @@ -117,13 +125,7 @@ |= now=@da ^- (quip ph-event _..start) =/ have-cache - .^ @f - %gx - (scot %p our) - %aqua - (scot %da now) - /fleet-snap/[label:a]/noun - == + (scry-aqua ? now /fleet-snap/[label:a]/noun) ~& [%have-cache label:a have-cache] ?: have-cache =. done-with-a & @@ -228,5 +230,15 @@ %earl ~|(%moon-not-implemented !!) %pawn ~|(%comet-not-implemented !!) == + :: + ++ scry-aqua + |* [a=mold now=@da pax=path] + .^ a + %gx + (scot %p our) + %aqua + (scot %da now) + pax + == -- -- From c3faca01aaee293c7eec41c560db53dbbbec5189 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 14 Feb 2019 17:36:30 -0800 Subject: [PATCH 25/55] factor out ++touch-file --- app/ph.hoon | 34 +--------------------------------- lib/ph.hoon | 39 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 33 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 2ad41a615..13a8586b8 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -135,39 +135,7 @@ :: :- %change-file %+ compose-tests (galaxy ~bud) - ^- test-core - =| warped=@t - |% - ++ label %change-file - ++ ships ~ - ++ start - |= now=@da - ^- (pair (list ph-event) _..start) - =/ pax - /(scot %p our.hid)/home/(scot %da now.hid)/sur/aquarium/hoon - =. warped (cat 3 '=> . ' .^(@t %cx pax)) - :_ ..start - %- zing - :~ (dojo ~bud "|mount %") - (insert-file ~bud pax warped) - == - :: - ++ route - |= [now=@da who=ship ovo=unix-effect] - ^- (quip ph-event _..start) - :_ ..start - %- zing - :~ %- on-ergo - :^ ~bud who ovo - |= $~ - =/ pax /i/~bud/home/(scot %da now)/sur/aquarium/hoon/noun - ~& [%compare (met 3 warped) (met 3 (need (scry-aqua (unit @) now pax)))] - ?: =(warped (need (scry-aqua (unit @) now pax))) - [%test-done &]~ - ~& %not-done-yet - ~ - == - -- + (touch-file ~bud) :: :- %individual-breach *test-core diff --git a/lib/ph.hoon b/lib/ph.hoon index 67f88a6d4..edf45ba65 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -231,6 +231,45 @@ %pawn ~|(%comet-not-implemented !!) == :: + :: Touches /sur/aquarium/hoon on the given ship. + :: + :: You must have started the ship or this will fail. + :: + ++ touch-file + |= her=ship + ^- test-core + =| warped=@t + |% + ++ label %touch-file + ++ ships ~ + ++ start + |= now=@da + ^- (pair (list ph-event) _..start) + =/ pax + /(scot %p our)/home/(scot %da now)/sur/aquarium/hoon + =. warped (cat 3 '=> . ' .^(@t %cx pax)) + :_ ..start + %- zing + :~ (dojo her "|mount %") + (insert-file her pax warped) + == + :: + ++ route + |= [now=@da who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + :_ ..start + %- zing + :~ %- on-ergo + :^ her who ovo + |= $~ + =/ pax /i/[(scot %p her)]/home/(scot %da now)/sur/aquarium/hoon/noun + ?: =(warped (need (scry-aqua (unit @) now pax))) + [%test-done &]~ + ~& %not-done-yet + ~ + == + -- + :: ++ scry-aqua |* [a=mold now=@da pax=path] .^ a From c4f3614f7b3b5118c57bc99b26bea813dfbfa508 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Sat, 16 Feb 2019 01:24:37 -0800 Subject: [PATCH 26/55] various fixes, add ++check-file-touched --- app/aqua.hoon | 11 +++++++++- app/ph.hoon | 7 +++++++ lib/ph.hoon | 52 ++++++++++++++++++++++++++++++++++++++++------ sys/vane/clay.hoon | 7 +++++-- 4 files changed, 68 insertions(+), 9 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index b9e75e231..5fe6b6f37 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -4,6 +4,10 @@ :: |start %aqua :: /- aquarium :: :aqua &pill .^(pill:aquarium %cx %/urbit/pill) +:: OR +:: :aqua &pill +solid +:: +:: Then try stuff: :: :aqua [%init ~[~bud ~dev]] :: :aqua [%dojo ~[~bud ~dev] "[our eny (add 3 5)]"] :: :aqua [%dojo ~[~bud] "|hi ~dev"] @@ -495,7 +499,7 @@ =. this thus %- push-events:(pe who) ^- (list unix-event) - :~ + :~ [//term/1 %belt %ctl `@c`%e] [//term/1 %belt %ctl `@c`%u] [//term/1 %belt %txt ((list @c) (tape command.val))] @@ -554,6 +558,11 @@ [%restore-fleet lab=@tas] =^ ms this (poke-aqua-events [%restore-snap lab.val]~) (emit-moves ms) + :: + [%clear-snap lab=@tas] + =. fleet-snaps ~ :: (~(del by fleet-snaps) lab.val) + =. init-cache ~ + this == :: :: Apply a list of events tagged by ship diff --git a/app/ph.hoon b/app/ph.hoon index 13a8586b8..ef94d4562 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -136,6 +136,13 @@ :- %change-file %+ compose-tests (galaxy ~bud) (touch-file ~bud) + :: + :- %child-sync + %+ compose-tests + %+ compose-tests + (star ~marbud) + (touch-file ~bud) + (check-file-touched ~marbud) :: :- %individual-breach *test-core diff --git a/lib/ph.hoon b/lib/ph.hoon index edf45ba65..fddc4e768 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -79,7 +79,7 @@ ?. ?=(%blit -.q.ovo) ~ ?. %+ lien p.q.ovo - |= =blit:dill + |= =blit:dill ?. ?=(%lin -.blit) | !=(~ (find what p.blit)) @@ -113,7 +113,7 @@ :: :: Cache lookup label :: - ++ label :((cury cat 3) label:a '--' label:b) + ++ label `@tas`:((cury cat 3) label:a '--' label:b) :: :: Union of ships in a and b :: @@ -124,10 +124,10 @@ ++ start |= now=@da ^- (quip ph-event _..start) - =/ have-cache + =/ have-cache (scry-aqua ? now /fleet-snap/[label:a]/noun) - ~& [%have-cache label:a have-cache] ?: have-cache + ~& [%caching-in label:a label] =. done-with-a & =/ restore-event [%restore-snap label:a] =^ events-start b (start:b now) @@ -156,6 +156,7 @@ ?~ done [other-events ..start] ?> ?=(%test-done -.i.done) + ~& [%transitioning label] ?. p.i.done [[%test-done |]~ ..start] =. done-with-a & @@ -233,14 +234,14 @@ :: :: Touches /sur/aquarium/hoon on the given ship. :: - :: You must have started the ship or this will fail. + :: Ship must have been started. :: ++ touch-file |= her=ship ^- test-core =| warped=@t |% - ++ label %touch-file + ++ label (cat 3 'touch-file-' (scot %p her)) ++ ships ~ ++ start |= now=@da @@ -270,6 +271,45 @@ == -- :: + :: Checks that /sur/aquarium/hoon has been touched, as by ++touch-file + :: + :: Ship must have been started. + :: + ++ check-file-touched + |= her=ship + ^- test-core + |% + ++ label (cat 3 'check-file-touched-' (scot %p her)) + ++ ships ~ + ++ start + |= now=@da + :: mounting is not strictly necessary since we check via scry, + :: but this way we don't have to check on every event, just + :: ergos (and dojo because we can't guarantee an ergo if the desk + :: is already mounted) + :: + ~& %mounting + [(dojo her "|mount %") ..start] + :: + ++ route + |= [now=@da who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + =/ cb + |= $~ + ~& %cbing + =/ pax /home/(scot %da now)/sur/aquarium/hoon + =/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax))) + =/ aqua-pax :(weld /i/(scot %p her) pax /noun) + ?: =(warped (need (scry-aqua (unit @) now aqua-pax))) + [%test-done &]~ + ~& %not-done-yet + ~ + :_ ..start + %- zing + :~ (on-ergo her who ovo cb) + (on-dojo-output her who ovo ">=" cb) + == + -- ++ scry-aqua |* [a=mold now=@da pax=path] .^ a diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index c6c2113ed..5f6e651cf 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -2397,8 +2397,8 @@ ^+ bar ?- -.mys $ins :: insert if not exist - ?: (~(has by bar) pax) ~|([%ins-bar pax] !!) :: - ?: (~(has by hat) pax) ~|([%ins-hat pax] !!) :: + ?: (~(has by bar) pax) ~|([%ins-bar pax hen] !!) :: + ?: (~(has by hat) pax) ~|([%ins-hat pax hen] !!) :: %+ ~(put by bar) pax %- make-direct-blob ?: &(?=($mime -.p.mys) =([%hoon ~] (slag (dec (lent pax)) pax))) @@ -4231,6 +4231,9 @@ :: $note [[hen %give +.q.hin]~ ..^$] $wake + ?: ?=([%tyme ~] tea) + ~& %out-of-tyme + `..^$ :: dear reader, if it crashes here, check the wire. If it came :: from ++bait, then I don't think we have any handling for that :: sort of thing. From ad4750fb93a60267933e2b321b8b0cf15bdd003b Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 21 Feb 2019 15:13:40 -0800 Subject: [PATCH 27/55] add swap-vanes to aqua --- app/aqua.hoon | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 5fe6b6f37..ac8ebee23 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -406,7 +406,6 @@ ?~ pers ~ ?: &(?=(^ next-events.q.i.pers) processing-events.q.i.pers) - ~& [%new-events p.i.pers] `p.i.pers $(pers t.pers) ~& plowing=who @@ -439,6 +438,8 @@ ~& lent=(met 3 (jam boot-ova.pil)) =/ res=toon :: (each * (list tank)) (mock [boot-ova.pil [2 [0 3] [0 2]]] scry) + =. fleet-snaps ~ + =. init-cache ~ ?- -.res %0 ~& %suc @@ -470,6 +471,31 @@ :: boilerplate :: ?+ val ~|(%bad-noun-arg !!) + [%swap-vanes vs=*] + ?> ?=([[%7 * %1 installed=*] ~] boot-ova.pil) + =. installed.boot-ova.pil + %+ roll (,(list term) vs.val) + |= [v=term _installed.boot-ova.pil] + %^ slum installed.boot-ova.pil now.hid + =/ vane + ?+ v ~|([%unknown-vane v] !!) + %a %ames + %b %behn + %c %clay + %d %dill + %e %eyre + %f %ford + %g %gall + %j %ford + == + =/ pax + /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/[vane] + =/ txt .^(@ %cx (weld pax /hoon)) + [/vane/[vane] [%veer v pax txt]] + => .(this ^+(this this)) + =^ ms this (poke-pill pil) + (emit-moves ms) + :: [%init hers=*] =/ hers ((list ship) hers.val) ?~ hers From 3e1d742deb99a36cabb18070b26a309d7ea45d03 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 21 Feb 2019 15:56:46 -0800 Subject: [PATCH 28/55] add control flow to |verb --- sys/arvo.hoon | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/sys/arvo.hoon b/sys/arvo.hoon index 5e0872812..3cbb8683a 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -50,7 +50,7 @@ ++ mill (each vase milt) :: vase+metavase ++ milt {p/* q/*} :: metavase ++ monk (each ship {p/@tas q/@ta}) :: general identity -++ muse {p/@tas q/duct r/arvo} :: sourced move +++ muse {p/@tas q/duct r/arvo s/@ud} :: sourced move ++ move {p/duct q/arvo} :: arvo move ++ ovum {p/wire q/curd} :: typeless ovum ++ pane (list {p/@tas q/vase}) :: kernel modules @@ -462,7 +462,7 @@ :: ++ hurl :: start loop |= {lac/? ovo/ovum} - ~? &(!lac !=(%belt -.q.ovo)) [%unix -.q.ovo p.ovo] + ~? &(!lac !=(%belt -.q.ovo)) ["" %unix -.q.ovo p.ovo] :: ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))} ^- {p/(list ovum) q=(list [label=@tas =vane])} ?> ?=(^ p.ovo) @@ -474,6 +474,7 @@ :+ %& [%cell [%atom %tas `%soft] %noun] [%soft q.ovo] + 0 == == :: @@ -486,7 +487,7 @@ (swim:win org pux hen hil) :: ++ fire :: execute - |= {org/term lal/term pux/(unit wire) hen/duct hil/mill} + |= {org/term deh/@ud lal/term pux/(unit wire) hen/duct hil/mill} ^- {{p/(list ovum) q/(list muse)} _vanes} ?: &(?=(^ pux) ?=($~ hen)) [[[[lal u.pux] (curd +>.hil)]~ ~] vanes] @@ -498,7 +499,8 @@ [-.tuh [+<.tuh [i.naf +>.tuh]]] :: =+ fiq=(race org lal pux hen hil vane.i.naf) - [[~ (turn p.fiq |=(a/move [lal a]))] [[label.i.naf q.fiq] t.naf]] + :- [~ (turn p.fiq |=(a/move [lal p.a q.a +(deh)]))] + [[label.i.naf q.fiq] t.naf] :: ++ jack :: dispatch card |= {lac/? gum/muse} @@ -506,11 +508,13 @@ ~| %failed-jack :: =. lac |(lac ?=(?(%g %f) p.gum)) :: =. lac &(lac !?=($b p.gum)) - %+ fire - p.gum + %^ fire + p.gum + s.gum ?- -.r.gum $pass ~? &(!lac !=(%$ p.gum)) + :- (runt [s.gum '|'] "") :^ %pass [p.gum p.q.r.gum] [(symp +>-.q.q.r.gum) p.r.gum] q.gum @@ -522,11 +526,14 @@ ~| [%jack-bad-card p.gum (symp +>-.p.r.gum)] !! ~? &(!lac |(!=(%blit +>-.p.r.gum) !=(%d p.gum))) + :- (runt [s.gum '|'] "") [%give p.gum (symp +>-.p.r.gum) `duct`q.gum] [i.i.q.gum [~ t.i.q.gum] t.q.gum p.r.gum] :: $slip - ~? !lac [%slip p.gum (symp +>-.q.p.r.gum) q.gum] + ~? !lac + :- (runt [s.gum '|'] "") + [%slip p.gum (symp +>-.q.p.r.gum) q.gum] [p.p.r.gum ~ q.gum q.p.r.gum] == :: @@ -551,7 +558,7 @@ [%soft q.ovo] %+ kick lac %+ turn vanes - |=([label=@tas *] [label ~ [%pass p.ovo label card]]) + |=([label=@tas *] [label ~ [%pass p.ovo label card] 0]) -- -- =< :: Arvo larval stage @@ -584,11 +591,7 @@ :: ++ poke |= * :: 47 ^- [(list ovum) *] - ~& =+ a=+< - =+ (met 3 (jam a)) - [%larval-poking ?:((gth - 10.000) - `a)] => .(+< ((hard ,[now=@da ovo=ovum]) +<)) - ~& [%larval-harded now p.ovo p.q.ovo] ^- [(list ovum) *] =. +>.$ ?+ -.q.ovo From 99b6111597f4cd40fc9fd15793a177b748bbfeb2 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 21 Feb 2019 15:57:51 -0800 Subject: [PATCH 29/55] wip --- app/ph.hoon | 10 ++++--- lib/ph.hoon | 67 +++++++++++++++++++++++++++++++++++----------- sys/arvo.hoon | 2 +- sys/vane/clay.hoon | 29 ++++++++++++++------ sys/vane/ford.hoon | 1 + 5 files changed, 82 insertions(+), 27 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index ef94d4562..937f50ef7 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -139,9 +139,13 @@ :: :- %child-sync %+ compose-tests - %+ compose-tests - (star ~marbud) - (touch-file ~bud) + :: %+ compose-tests + :: %+ compose-tests + %+ compose-tests + (galaxy ~bud) + :: (reload-vane ~bud %clay) + (raw-ship ~marbud) + :: (touch-file ~bud) (check-file-touched ~marbud) :: :- %individual-breach diff --git a/lib/ph.hoon b/lib/ph.hoon index fddc4e768..958766d55 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -109,6 +109,25 @@ |= [a=test-core b=test-core] ^- test-core =/ done-with-a | + => + |% + ++ filter-a + |= [now=@da events=(list ph-event)] + ^- (quip ph-event _..filter-a) + =+ ^- [done=(list ph-event) other-events=(list ph-event)] + %+ skid events + |= e=ph-event + =(%test-done -.e) + ?~ done + [other-events ..filter-a] + ?> ?=(%test-done -.i.done) + ?. p.i.done + [[%test-done |]~ ..filter-a] + =. done-with-a & + =/ snap-event [%snap-ships label:a ships:a] + =^ events-start b (start:b now) + [(welp other-events [snap-event events-start]) ..filter-a] + -- |% :: :: Cache lookup label @@ -131,7 +150,8 @@ =. done-with-a & =/ restore-event [%restore-snap label:a] =^ events-start b (start:b now) - [[restore-event events-start] ..start] + =^ events ..filter-a (filter-a now restore-event events-start) + [events ..start] =^ events a (start:a now) [events ..start] :: @@ -149,20 +169,8 @@ =^ events b (route:b now who ovo) [events ..start] =^ events a (route:a now who ovo) - =+ ^- [done=(list ph-event) other-events=(list ph-event)] - %+ skid events - |= e=ph-event - =(%test-done -.e) - ?~ done - [other-events ..start] - ?> ?=(%test-done -.i.done) - ~& [%transitioning label] - ?. p.i.done - [[%test-done |]~ ..start] - =. done-with-a & - =/ snap-event [%snap-ships label:a ships:a] - =^ events-start b (start:b now) - [(welp other-events [snap-event events-start]) ..start] + =^ events ..filter-a (filter-a now events) + [events ..start] -- :: :: Don't use directly, or else you might not have a parent. @@ -310,6 +318,35 @@ (on-dojo-output her who ovo ">=" cb) == -- + :: + :: Reload vane from filesystem + :: + :: Ship must have been started. + :: + ++ reload-vane + |= [her=ship vane=term] + ^- test-core + |% + ++ label :((cury cat 3) 'reload-vane-' (scot %p her) '-' vane) + ++ ships ~ + ++ start + |= now=@da + ^- (pair (list ph-event) _..start) + =/ pax + /(scot %p our)/home/(scot %da now)/sys/vane/[vane]/hoon + :_ ..start + %- zing + :~ (dojo her "|mount %") + (insert-file her pax .^(@t %cx pax)) + [%test-done &]~ + == + :: + ++ route + |= [now=@da who=ship ovo=unix-effect] + ^- (quip ph-event _..start) + `..start + -- + :: ++ scry-aqua |* [a=mold now=@da pax=path] .^ a diff --git a/sys/arvo.hoon b/sys/arvo.hoon index 3cbb8683a..164ea8758 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -644,7 +644,7 @@ :: =/ pit=vase !>(..is) :: =/ vil=vile (viol p.pit) :: cached reflexives -=| $: lac=? :: laconic bit +=| $: lac=_| :: laconic bit eny=@ :: entropy our=ship :: identity bud=vase :: %zuse diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 5f6e651cf..5e67a3798 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -1171,6 +1171,7 @@ ?~ hat +>.$ wake:(print-changes:(checkout-ankh u.hat) wen lem) + ~& [%edit our hen] ?. =(~ dok) ~& %already-applying-changes +> :: @@ -2376,6 +2377,7 @@ ++ apply-changes :: apply-changes:ze |= lar/(list {p/path q/misu}) :: store changes ^- (map path blob) + ~& [%apply-changes our hen] =+ ^= hat :: current state ?: =(let.dom 0) :: initial commit ~ :: has nothing @@ -3768,6 +3770,17 @@ wrapped-task ((hard task:able) p.wrapped-task) :: + :: only one of these should be going at once, so queue + :: + ?: &(?=(?(%info %into %merg) -.req) |(=(now tip.ruf) ?=(^ cue.ruf))) + =. cue.ruf (~(put to cue.ruf) [hen req]) + =/ wait=(list move) + ?~(cue.ruf ~ [hen %pass /queued-request %b %wait now]~) + [wait ..^$] + (handle-task hen req) +:: +++ handle-task + |= [hen=duct req=task:able] ^+ [*(list move) ..^$] ?- -.req $boat @@ -3823,19 +3836,13 @@ [mos ..^$] :: $info - :: second write at :now gets enqueued with a timer to be run in next event - :: - ?: =(now tip.ruf) - =. cue.ruf (~(put to cue.ruf) [hen req]) - =/ =move [hen %pass /queued-request %b %wait now] - :: - [~[move] ..^$] :: set the last date to now so we'll know to enqueue a second write :: =. tip.ruf now :: ?: =(%$ des.req) [~ ..^$] + => .(ruf `raft`ruf) :: TMI =^ mos ruf =/ den ((de our now ski hen ruf) our des.req) abet:(edit:den now dit.req) @@ -3877,6 +3884,7 @@ $merg :: direct state up ?: =(%$ des.req) [~ ..^$] + => .(ruf `raft`ruf) :: TMI =^ mos ruf =/ den ((de our now ski hen ruf) our des.req) abet:abet:(start:(me:ze:den [her.req dem.req] ~ &) cas.req how.req) @@ -4246,7 +4254,12 @@ ~| [%mismatched-ducts %queued queued-duct %timer hen] ?> =(hen queued-duct) :: - (call hen [-:!>(*task:able) queued-task]) + =/ wait + ?~ cue.ruf + ~ + [hen %pass /queued-request %b %wait now]~ + =^ moves ..^$ (handle-task hen queued-task) + [(weld wait moves) ..^$] :: =^ mos=(list move) une :: wake:(un our now hen ruf) :: [mos ..^^$] diff --git a/sys/vane/ford.hoon b/sys/vane/ford.hoon index cde22f241..069789f4b 100644 --- a/sys/vane/ford.hoon +++ b/sys/vane/ford.hoon @@ -5751,6 +5751,7 @@ :: =? state ?=(^ last-sent.live.duct-status) =/ old-build=^build build(date date.u.last-sent.live.duct-status) + ~& [%x-live-15 our (build-to-tape build) (build-to-tape old-build)] :: (remove-anchor-from-root old-build [%duct duct]) :: From e319df9e8daab31ea1b9916c8b850860f3661882 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 22 Feb 2019 14:11:53 -0800 Subject: [PATCH 30/55] trigger dill init on merge completion --- sys/vane/dill.hoon | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/sys/vane/dill.hoon b/sys/vane/dill.hoon index 82113fd1a..1d85561e7 100644 --- a/sys/vane/dill.hoon +++ b/sys/vane/dill.hoon @@ -298,10 +298,15 @@ ++ init :: initialize ~& [%dill-init our ram] ^+ . + =. moz :_(moz [hen %pass / %c %merg %home our %base da+now %init]) + . + :: + ++ mere :: continue init + ~& [%dill-mere our ram] + ^+ . =/ myt (flop (need tem)) =/ can (clan:title our) =. tem ~ - =. moz :_(moz [hen %pass / %c %merg %home our %base da+now %init]) =. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]]) =. +> (sync %home our %base) =. +> ?: ?=(?($czar $pawn) can) +> @@ -391,11 +396,6 @@ :: {$a $send *} +>(moz :_(moz [hen %give +.sih])) - :: - {$c $mere *} - ?: ?=(%& -.p.sih) - +>.$ - (mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih) :: {$g $onto *} :: ~& [%take-gall-onto +>.sih] @@ -420,6 +420,11 @@ :: {$c $writ *} init + :: + {$c $mere *} + ?: ?=(%& -.p.sih) + mere + (mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih) :: {$c $mack *} ?~ p.sih +>.$ From 3f74d30085d111b231b99f156304c447c5505b36 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 22 Feb 2019 14:16:22 -0800 Subject: [PATCH 31/55] add ford printf in bad situation --- sys/vane/ford.hoon | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/sys/vane/ford.hoon b/sys/vane/ford.hoon index 069789f4b..796f69343 100644 --- a/sys/vane/ford.hoon +++ b/sys/vane/ford.hoon @@ -5751,7 +5751,10 @@ :: =? state ?=(^ last-sent.live.duct-status) =/ old-build=^build build(date date.u.last-sent.live.duct-status) - ~& [%x-live-15 our (build-to-tape build) (build-to-tape old-build)] + ~? =(date.build date.old-build) + :+ "old and new builds have same date, will probably crash!" + (build-to-tape build) + (build-to-tape old-build) :: (remove-anchor-from-root old-build [%duct duct]) :: From e22eac6a728c8608de1258cdadf3b1fa8d7d6f5c Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 22 Feb 2019 15:52:18 -0800 Subject: [PATCH 32/55] child-sync test passes --- app/ph.hoon | 14 +++++--------- lib/hood/drum.hoon | 8 ++++---- lib/ph.hoon | 27 ++++++++++++++++----------- sys/arvo.hoon | 4 ++-- sys/vane/clay.hoon | 11 ++++++++--- sys/vane/dill.hoon | 4 +++- 6 files changed, 38 insertions(+), 30 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 937f50ef7..b8c887d61 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -135,18 +135,14 @@ :: :- %change-file %+ compose-tests (galaxy ~bud) - (touch-file ~bud) + (touch-file ~bud %home) :: :- %child-sync %+ compose-tests - :: %+ compose-tests - :: %+ compose-tests - %+ compose-tests - (galaxy ~bud) - :: (reload-vane ~bud %clay) - (raw-ship ~marbud) - :: (touch-file ~bud) - (check-file-touched ~marbud) + %+ compose-tests + (star ~marbud) + (touch-file ~bud %base) + (check-file-touched ~marbud %home) :: :- %individual-breach *test-core diff --git a/lib/hood/drum.hoon b/lib/hood/drum.hoon index 0fa4ec657..33082ece8 100644 --- a/lib/hood/drum.hoon +++ b/lib/hood/drum.hoon @@ -80,11 +80,11 @@ :: ?: ?=($pawn myr) [[%base %collections] [%base %hall] [%base %talk] [%base %dojo] ~] - :~ [%home %collections] - [%home %acme] - [%home %dns] + :~ :: [%home %collections] + :: [%home %acme] + :: [%home %dns] [%home %dojo] - [%home %hall] + :: [%home %hall] [%home %talk] == :: diff --git a/lib/ph.hoon b/lib/ph.hoon index 958766d55..70295531b 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -62,13 +62,13 @@ == :: ++ insert-file - |= [who=ship pax=path txt=@t] + |= [who=ship des=desk pax=path txt=@t] ^- (list ph-event) ?> ?=([@ @ @ *] pax) =/ file [/text/plain (as-octs:mimes:html txt)] %+ send-events-to who :~ - [//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~] + [//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~] == :: ++ on-dojo-output @@ -245,7 +245,7 @@ :: Ship must have been started. :: ++ touch-file - |= her=ship + |= [her=ship des=desk] ^- test-core =| warped=@t |% @@ -259,8 +259,8 @@ =. warped (cat 3 '=> . ' .^(@t %cx pax)) :_ ..start %- zing - :~ (dojo her "|mount %") - (insert-file her pax warped) + :~ (dojo her "|mount /={(trip des)}=") + (insert-file her des pax warped) == :: ++ route @@ -271,7 +271,7 @@ :~ %- on-ergo :^ her who ovo |= $~ - =/ pax /i/[(scot %p her)]/home/(scot %da now)/sur/aquarium/hoon/noun + =/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun ?: =(warped (need (scry-aqua (unit @) now pax))) [%test-done &]~ ~& %not-done-yet @@ -284,7 +284,7 @@ :: Ship must have been started. :: ++ check-file-touched - |= her=ship + |= [her=ship des=desk] ^- test-core |% ++ label (cat 3 'check-file-touched-' (scot %p her)) @@ -297,7 +297,7 @@ :: is already mounted) :: ~& %mounting - [(dojo her "|mount %") ..start] + [(dojo her "|mount /={(trip des)}=") ..start] :: ++ route |= [now=@da who=ship ovo=unix-effect] @@ -307,7 +307,12 @@ ~& %cbing =/ pax /home/(scot %da now)/sur/aquarium/hoon =/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax))) - =/ aqua-pax :(weld /i/(scot %p her) pax /noun) + =/ aqua-pax + ;: weld + /i/(scot %p her) + pax(- des) + /noun + == ?: =(warped (need (scry-aqua (unit @) now aqua-pax))) [%test-done &]~ ~& %not-done-yet @@ -336,8 +341,8 @@ /(scot %p our)/home/(scot %da now)/sys/vane/[vane]/hoon :_ ..start %- zing - :~ (dojo her "|mount %") - (insert-file her pax .^(@t %cx pax)) + :~ (dojo her "|mount /=home=") + (insert-file her %home pax .^(@t %cx pax)) [%test-done &]~ == :: diff --git a/sys/arvo.hoon b/sys/arvo.hoon index 164ea8758..801847e33 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -462,7 +462,7 @@ :: ++ hurl :: start loop |= {lac/? ovo/ovum} - ~? &(!lac !=(%belt -.q.ovo)) ["" %unix -.q.ovo p.ovo] + ~? &(!lac !=(%belt -.q.ovo)) ["" %unix -.q.ovo p.ovo now] :: ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))} ^- {p/(list ovum) q=(list [label=@tas =vane])} ?> ?=(^ p.ovo) @@ -644,7 +644,7 @@ :: =/ pit=vase !>(..is) :: =/ vil=vile (viol p.pit) :: cached reflexives -=| $: lac=_| :: laconic bit +=| $: lac=_& :: laconic bit eny=@ :: entropy our=ship :: identity bud=vase :: %zuse diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 5e67a3798..879dbe13c 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -3773,9 +3773,9 @@ :: only one of these should be going at once, so queue :: ?: &(?=(?(%info %into %merg) -.req) |(=(now tip.ruf) ?=(^ cue.ruf))) - =. cue.ruf (~(put to cue.ruf) [hen req]) =/ wait=(list move) - ?~(cue.ruf ~ [hen %pass /queued-request %b %wait now]~) + ?^(cue.ruf ~ [hen %pass /queued-request %b %wait now]~) + =. cue.ruf (~(put to cue.ruf) [hen req]) [wait ..^$] (handle-task hen req) :: @@ -4251,13 +4251,18 @@ =/ queued-duct=duct -.queued =/ queued-task=task:able +.queued :: + ~& :* %x-clay-waking + queued-duct + hen + ?~(cue.ruf /empty -:(need ~(top to cue.ruf))) + == ~| [%mismatched-ducts %queued queued-duct %timer hen] ?> =(hen queued-duct) :: =/ wait ?~ cue.ruf ~ - [hen %pass /queued-request %b %wait now]~ + [-:(need ~(top to cue.ruf)) %pass /queued-request %b %wait now]~ =^ moves ..^$ (handle-task hen queued-task) [(weld wait moves) ..^$] :: =^ mos=(list move) une diff --git a/sys/vane/dill.hoon b/sys/vane/dill.hoon index 1d85561e7..d71ad0699 100644 --- a/sys/vane/dill.hoon +++ b/sys/vane/dill.hoon @@ -298,7 +298,9 @@ ++ init :: initialize ~& [%dill-init our ram] ^+ . - =. moz :_(moz [hen %pass / %c %merg %home our %base da+now %init]) + =. moz + :_ moz + [hen %pass /merg/home %c %merg %home our %base da+now %init] . :: ++ mere :: continue init From 1ab6fea917a0323f4953e83ff5ddb94bfc8c8c85 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 6 Mar 2019 12:22:37 -0800 Subject: [PATCH 33/55] keep logs --- app/aqua.hoon | 143 +++++++++++++++++++++++++++++++++------------- app/ph.hoon | 52 +++++++++++++---- lib/ph.hoon | 63 +++++++++++++++++--- sur/aquarium.hoon | 40 ++++++++++--- sys/arvo.hoon | 2 +- 5 files changed, 232 insertions(+), 68 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 48f29b6ed..29b70f950 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -23,25 +23,35 @@ /- aquarium =, aquarium => $~ |% - ++ move (pair bone card) - ++ card + +$ move (pair bone card) + +$ card $% [%wait wire p=@da] [%rest wire p=@da] [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] - [%diff %aqua-effects aqua-effects] + [%diff diff-type] == - ++ state + :: + :: Outgoing subscription updates + :: + +$ diff-type + $% [%aqua-effects aqua-effects] + [%aqua-events aqua-events] + [%aqua-boths aqua-boths] + == + :: + +$ state $: %0 pil=pill assembled=* tym=@da - init-cache=(map ship pier) + init-cache=(map [ship (unit dawn-event)] pier) fleet-snaps=(map term (map ship pier)) piers=(map ship pier) == - ++ pier + :: + +$ pier $: snap=* - event-log=(list [@da unix-event]) + event-log=(list unix-timed-event) next-events=(qeu unix-event) processing-events=? next-timer=(unit @da) @@ -55,6 +65,8 @@ :: moves: Hoist moves into state for cleaner state management :: =| unix-effects=(jar ship unix-effect) +=| unix-events=(jar ship unix-timed-event) +=| unix-boths=(jar ship unix-both) =| moves=(list move) |_ $: hid=bowl state @@ -103,8 +115,8 @@ =/ poke p.res =. tym (max +(tym) now.hid) =/ res (slum poke tym ovo) - =. event-log [[tym ovo] event-log] =. snap +3.res + =. ..abet-pe (publish-event tym ovo) =. ..abet-pe (handle-effects ((list ovum) -.res)) $ :: @@ -307,6 +319,7 @@ ~& [who=who %cant-cancel-thus num=num] =. http-requests (~(del in http-requests) num) ..abet-pe + ~& [who=who %requesting u.req] =. http-requests (~(put in http-requests) num) %- emit-moves :_ ~ :* ost.hid @@ -360,6 +373,17 @@ |= ovo=unix-effect ^+ ..abet-pe =. unix-effects (~(add ja unix-effects) who ovo) + =. unix-boths (~(add ja unix-boths) who [%effect ovo]) + ..abet-pe + :: + :: Give event to our subscribers + :: + ++ publish-event + |= ovo=unix-timed-event + ^+ ..abet-pe + =. event-log [ovo event-log] + =. unix-events (~(add ja unix-events) who ovo) + =. unix-boths (~(add ja unix-boths) who [%event ovo]) ..abet-pe -- :: @@ -369,8 +393,10 @@ :: ++ apex-aqua ^+ this - =: moves ~ + =: moves ~ unix-effects ~ + unix-events ~ + unix-boths ~ == this :: @@ -381,13 +407,28 @@ %+ murn ~(tap by sup.hid) |= [b=bone her=ship pax=path] ^- (unit move) - ?. ?=([%effects @ ~] pax) - ~ - =/ who (slav %p i.t.pax) - =/ fx (~(get ja unix-effects) who) - ?~ fx - ~ - `[b %diff %aqua-effects who fx] + ?+ pax ~ + [%effects @ ~] + =/ who (slav %p i.t.pax) + =/ fx (~(get ja unix-effects) who) + ?~ fx + ~ + `[b %diff %aqua-effects who fx] + :: + [%events @ ~] + =/ who (slav %p i.t.pax) + =/ ve (~(get ja unix-events) who) + ?~ ve + ~ + `[b %diff %aqua-events who ve] + :: + [%boths @ ~] + =/ who (slav %p i.t.pax) + =/ bo (~(get ja unix-boths) who) + ?~ bo + ~ + `[b %diff %aqua-boths who bo] + == [(flop moves) this] :: ++ emit-moves @@ -427,6 +468,32 @@ !! `this :: +:: Subscribe to events to a ship +:: +++ peer-events + |= pax=path + ^- (quip move _this) + ?. ?=([@ ~] pax) + ~& [%aqua-bad-peer-events pax] + `this + ?~ (slaw %p i.pax) + ~& [%aqua-bad-peer-events-ship pax] + !! + `this +:: +:: Subscribe to both events and effects of a ship +:: +++ peer-boths + |= pax=path + ^- (quip move _this) + ?. ?=([@ ~] pax) + ~& [%aqua-bad-peer-boths pax] + `this + ?~ (slaw %p i.pax) + ~& [%aqua-bad-peer-boths-ship pax] + !! + `this +:: :: Load a pill and assemble arvo. Doesn't send any of the initial :: events. :: @@ -500,24 +567,8 @@ =/ hers ((list ship) hers.val) ?~ hers this - =^ ms this (poke-aqua-events [%init-ship i.hers]~) + =^ ms this (poke-aqua-events [%init-ship i.hers ~]~) (emit-moves ms) - :: %+ turn-ships ((list ship) hers.val) - :: |= [who=ship thus=_this] - :: =. this thus - :: ~& [%initting who] - :: %- push-events:apex:(pe who) - :: ^- (list unix-event) - :: :~ `unix-event`[/ %wack 0] :: eny - :: `unix-event`[/ %whom who] :: eny - :: `unix-event`[//newt/0v1n.2m9vh %barn ~] - :: `unix-event`[//behn/0v1n.2m9vh %born ~] - :: `unix-event`[//term/1 %boot %fake who] - :: `unix-event`-.userspace-ova.pil - :: `unix-event`[//http/0v1n.2m9vh %born ~] - :: `unix-event`[//http/0v1n.2m9vh %live 8.080 `8.445] - :: `unix-event`[//term/1 %belt %ctl `@c`%x] - :: == :: [%dojo hers=* command=*] %+ turn-ships ((list ship) hers.val) @@ -602,11 +653,11 @@ =. this thus ?- -.ovo %init-ship - =/ prev (~(get by init-cache) who.ovo) - ?: &(?=(^ prev) (lth who.ovo ~marzod)) - ~& [%loading-cached-ship who.ovo] - =. this (restore-ships ~[who.ovo] init-cache) - (pe who.ovo) + :: =/ prev (~(get by init-cache) [who keys]:ovo) + :: ?: &(?=(^ prev) (lth who.ovo ~marzod)) + :: ~& [%loading-cached-ship who.ovo] + :: =. this (restore-ship who.ovo u.prev) + :: (pe who.ovo) =. this abet-pe:sleep:(pe who.ovo) =/ initted =< plow @@ -616,14 +667,17 @@ [/ %whom who.ovo] :: eny [//newt/0v1n.2m9vh %barn ~] [//behn/0v1n.2m9vh %born ~] - [//term/1 %boot %fake who.ovo] + :+ //term/1 %boot + ?~ keys.ovo + [%fake who.ovo] + [%dawn u.keys.ovo] -.userspace-ova.pil [//http/0v1n.2m9vh %born ~] [//http/0v1n.2m9vh %live 8.080 `8.445] == =. this abet-pe:initted =. init-cache - %+ ~(put by init-cache) who.ovo + %+ ~(put by init-cache) [who keys]:ovo (~(got by piers) who.ovo) (pe who.ovo) :: @@ -727,6 +781,15 @@ restore:(pe who) this :: +:: Restore ships from pier +:: +++ restore-ship + |= [her=ship per=pier] + =. this abet-pe:plow:sleep:(pe her) + =. piers (~(put by piers) her per) + =. this abet-pe:plow:restore:(pe her) + this +:: :: Received timer wake :: ++ wake diff --git a/app/ph.hoon b/app/ph.hoon index b8c887d61..8da418eb2 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -12,20 +12,27 @@ =, aquarium =, ph => $~ |% - ++ move (pair bone card) - ++ card + +$ move (pair bone card) + +$ card $% [%poke wire dock %aqua-events (list aqua-event)] [%peer wire dock path] [%pull wire dock ~] == :: - ++ state + +$ state $: %0 raw-test-cores=(map term test-core) - test-cores=(map term [hers=(list ship) cor=test-core]) + test-cores=(map term test-core-state) other-state == - ++ other-state + :: + +$ test-core-state + $: hers=(list ship) + cor=test-core + effect-log=(list [who=ship ovo=unix-effect]) + == + :: + +$ other-state $~ -- =, gall @@ -53,7 +60,7 @@ =. num +(num) :_ ..start %- zing - :~ (init ~bud) + :~ (init ~bud ~) (dojo ~bud "[%test-result (add 2 3)]") == :: @@ -63,7 +70,6 @@ ~& [%num num] :_ ..start (expect-dojo-output ~bud who ovo "[%test-result 5]") - :: XX if it's been five minutes, we failed -- :: :- %hi @@ -75,8 +81,8 @@ ^- (pair (list ph-event) _..start) :_ ..start %- zing - :~ (init ~bud) - (init ~dev) + :~ (init ~bud ~) + (init ~dev ~) (dojo ~bud "|hi ~dev") == :: @@ -143,6 +149,16 @@ (star ~marbud) (touch-file ~bud %base) (check-file-touched ~marbud %home) + :: + :- %boot-azimuth + %+ compose-tests + %+ compose-tests + (raw-ship ~bud `(dawn:azimuth ~bud)) + (touch-file ~bud %home) + :: %- assert-happens + :: :~ + :: == + *test-core :: :- %individual-breach *test-core @@ -239,10 +255,24 @@ [%run-test lab=@tas] =/ res=[events=(list ph-event) new-state=test-core] (start:(~(got by raw-test-cores) lab.arg) now.hid) - =. test-cores (~(put by test-cores) lab.arg [ships .]:new-state.res) + =. test-cores (~(put by test-cores) lab.arg [ships . ~]:new-state.res) =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) =^ moves-2 this (run-events lab.arg events.res) [(weld moves-1 moves-2) this] + :: + [%print lab=@tas] + =/ log effect-log:(~(got by test-cores) lab.arg) + ~& lent=(lent log) + ~& %+ roll log + |= [[who=ship ovo=unix-effect] ~] + ?: ?=(?(%blit %doze) -.q.ovo) + ~ + ?: ?=(%ergo -.q.ovo) + ~& [who [- +<]:ovo %omitted-by-ph] + ~ + ~& [who ovo] + ~ + `this == :: ++ diff-aqua-effects @@ -259,6 +289,8 @@ |- ^- (quip ph-event _u.test-cor) ?~ ovo.ova [~ u.test-cor] + =. effect-log.u.test-cor + [[who i.ovo]:ova effect-log.u.test-cor] =^ events-1 cor.u.test-cor (route:cor.u.test-cor now.hid who.ova i.ovo.ova) =^ events-2 u.test-cor diff --git a/lib/ph.hoon b/lib/ph.hoon index 70295531b..17d727217 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -12,7 +12,7 @@ :: :: Unique name, used as a cache label. :: - ++ label *term + ++ label *@ta :: :: List of ships that are part of the test. :: @@ -43,9 +43,9 @@ [%event who ovo] :: ++ init - |= who=ship + |= [who=ship keys=(unit dawn-event)] ^- (list ph-event) - [%init-ship who]~ + [%init-ship who keys]~ :: :: factor out send-events-to :: @@ -103,6 +103,51 @@ ~ (fun) :: +++ azimuth + |% + ++ dawn + |= who=ship + ^- dawn-event + :* (need (private-key who)) + (^sein:title who) + czar + ~[~['arvo' 'netw' 'ork']] + 0 + `(need (de-purl:html 'http://localhost:8545')) + ~ + == + :: + ++ czar + ^- (map ship [life pass]) + %- my + ^- (list (pair ship [life pass])) + %+ murn (gulf 0x0 0xff) + |= her=ship + ^- (unit [ship life pass]) + =/ pub (public-key her) + ?~ pub + ~ + `[her u.pub] + :: + ++ private-key + |= who=ship + =- (~(get by -) who) + ^- (map ship seed:able:jael) + %- my + :~ [~bud ~bud 1 'BbudB' ~] + [~dev ~dev 1 'Bdev' ~] + == + :: + ++ public-key + |= who=ship + ^- (unit [life pass]) + =/ priv (private-key who) + ?~ priv + ~ + =/ cub (nol:nu:crub:crypto key.u.priv) + `[lyf.u.priv pub:ex:cub] + -- +:: ++ test-lib |_ our=ship ++ compose-tests @@ -178,15 +223,15 @@ :: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors. :: ++ raw-ship - |= her=ship + |= [her=ship keys=(unit dawn-event)] ^- test-core |% - ++ label (cat 3 'init-' (scot %p her)) + ++ label :((cury cat 3) 'init-' (scot %p her) '-' (scot %uw (mug (fall keys *dawn-event)))) ++ ships ~[her] ++ start |= now=@da ^- (quip ph-event _..start) - [(init her) ..start] + [(init her keys) ..start] :: ++ route |= [now=@da who=ship ovo=unix-effect] @@ -215,19 +260,19 @@ ++ galaxy |= her=ship ?> =(%czar (clan:title her)) - (raw-ship her) + (raw-ship her ~) :: ++ star |= her=ship ?> =(%king (clan:title her)) %+ compose-tests (galaxy (^sein:title her)) - (raw-ship her) + (raw-ship her ~) :: ++ planet |= her=ship ?> =(%duke (clan:title her)) %+ compose-tests (star (^sein:title her)) - (raw-ship her) + (raw-ship her ~) :: ++ ship-with-ancestors |= her=ship diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon index 1adaec11e..bfec9f638 100644 --- a/sur/aquarium.hoon +++ b/sur/aquarium.hoon @@ -1,26 +1,39 @@ |% -++ aqua-event - $% [%init-ship who=ship] ++$ aqua-event + $% [%init-ship who=ship keys=(unit dawn-event)] [%pause-events who=ship] [%snap-ships lab=term hers=(list ship)] [%restore-snap lab=term] [%event who=ship ovo=unix-event] == :: -++ aqua-effects - ,[who=ship ovo=(list unix-effect)] ++$ aqua-effects + [who=ship ovo=(list unix-effect)] :: -++ unix-event ++$ aqua-events + [who=ship ovo=(list unix-timed-event)] +:: ++$ aqua-boths + [who=ship ovo=(list unix-both)] +:: ++$ unix-both + $% [%event unix-timed-event] + [%effect unix-effect] + == +:: ++$ unix-timed-event [tym=@da ovo=unix-event] +:: ++$ unix-event %+ pair wire $% [%wack p=@] [%whom p=ship] [%live p=@ud q=(unit @ud)] [%barn ~] - [%boot %fake p=ship] + [%boot $%([%fake p=ship] [%dawn p=dawn-event])] unix-task == :: -++ unix-effect ++$ unix-effect %+ pair wire $% [%blit p=(list blit:dill)] [%send p=lane:ames q=@] @@ -28,5 +41,16 @@ [%thus p=@ud q=(unit hiss:eyre)] [%ergo p=@tas q=mode:clay] == -+= pill [boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)] ++$ pill + [boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)] +:: ++$ dawn-event + $: =seed:able:jael + spon=ship + czar=(map ship [=life =pass]) + turf=(list turf) + bloq=@ud + node=(unit purl:eyre) + snap=(unit snapshot:jael) + == -- diff --git a/sys/arvo.hoon b/sys/arvo.hoon index a9e85ba03..10b548506 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -644,7 +644,7 @@ :: =/ pit=vase !>(..is) :: =/ vil=vile (viol p.pit) :: cached reflexives -=| $: lac=_& :: laconic bit +=| $: lac=_| :: laconic bit eny=@ :: entropy our=ship :: identity bud=vase :: %zuse From 68d3ebd8d4cb30ffc12552c5cb4471960e457790 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 6 Mar 2019 12:24:27 -0800 Subject: [PATCH 34/55] remove init-cache --- app/aqua.hoon | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 29b70f950..cf172a477 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -44,7 +44,6 @@ pil=pill assembled=* tym=@da - init-cache=(map [ship (unit dawn-event)] pier) fleet-snaps=(map term (map ship pier)) piers=(map ship pier) == @@ -506,7 +505,6 @@ =/ res=toon :: (each * (list tank)) (mock [boot-ova.pil [2 [0 3] [0 2]]] scry) =. fleet-snaps ~ - =. init-cache ~ ?- -.res %0 ~& %suc @@ -638,7 +636,6 @@ :: [%clear-snap lab=@tas] =. fleet-snaps ~ :: (~(del by fleet-snaps) lab.val) - =. init-cache ~ this == :: @@ -653,11 +650,6 @@ =. this thus ?- -.ovo %init-ship - :: =/ prev (~(get by init-cache) [who keys]:ovo) - :: ?: &(?=(^ prev) (lth who.ovo ~marzod)) - :: ~& [%loading-cached-ship who.ovo] - :: =. this (restore-ship who.ovo u.prev) - :: (pe who.ovo) =. this abet-pe:sleep:(pe who.ovo) =/ initted =< plow @@ -676,9 +668,6 @@ [//http/0v1n.2m9vh %live 8.080 `8.445] == =. this abet-pe:initted - =. init-cache - %+ ~(put by init-cache) [who keys]:ovo - (~(got by piers) who.ovo) (pe who.ovo) :: %pause-events From 186984fb1d0444f4fc4516aa730653aaa4b8f353 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 6 Mar 2019 13:14:32 -0800 Subject: [PATCH 35/55] style --- app/aqua.hoon | 28 +++++++++++++++++++--------- 1 file changed, 19 insertions(+), 9 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index cf172a477..1964d8069 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -59,8 +59,8 @@ -- =, gall :: -:: aqua-effect-list: collect list of aqua effects to broadcast at once -:: to avoid gall backpressure +:: unix-{effects,events,boths}: collect jar of effects and events to +:: brodcast all at once to avoid gall backpressure :: moves: Hoist moves into state for cleaner state management :: =| unix-effects=(jar ship unix-effect) @@ -78,23 +78,32 @@ =+ (fall (~(get by piers) who) *pier) =* pier-data - |% + :: + :: Done; install data + :: ++ abet-pe ^+ this =. piers (~(put by piers) who pier-data) this :: + :: Initialize new ship + :: ++ apex =. pier-data *pier =. snap assembled - ~& r=(met 3 (jam snap)) + ~& pill-size=(met 3 (jam snap)) ..abet-pe :: + :: Enqueue events to child arvo + :: ++ push-events |= ova=(list unix-event) ^+ ..abet-pe =. next-events (~(gas to next-events) ova) ..abet-pe :: + :: Send moves to host arvo + :: ++ emit-moves |= ms=(list move) =. this (^emit-moves ms) @@ -109,14 +118,14 @@ ?. processing-events ..abet-pe =^ ovo next-events ~(get to next-events) - =/ res (mox +47.snap) - ?> ?=(%0 -.res) - =/ poke p.res + =/ poke-arm (mox +47.snap) + ?> ?=(%0 -.poke-arm) + =/ poke p.poke-arm =. tym (max +(tym) now.hid) - =/ res (slum poke tym ovo) - =. snap +3.res + =/ poke-result (slum poke tym ovo) + =. snap +.poke-result =. ..abet-pe (publish-event tym ovo) - =. ..abet-pe (handle-effects ((list ovum) -.res)) + =. ..abet-pe (handle-effects ((list ovum) -.poke-result)) $ :: :: Peek @@ -170,6 +179,7 @@ ?~ next-timer ..abet-pe cancel-timer + :: :: Sleep eyre :: :: Eyre doesn't support cancelling HTTP requests from userspace. From dab83cd28e4a2e560b9f8efd72c7f6aa6909b04a Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 6 Mar 2019 23:31:14 -0800 Subject: [PATCH 36/55] restructure to separate vane apps --- app/aqua-ames.hoon | 72 ++++++ app/aqua-behn.hoon | 120 ++++++++++ app/aqua-dill.hoon | 78 +++++++ app/aqua-eyre.hoon | 148 ++++++++++++ app/aqua.hoon | 438 +++++------------------------------- app/ph.hoon | 129 +++++++---- gen/aqua/dojo.hoon | 14 ++ gen/aqua/file.hoon | 8 + gen/aqua/init.hoon | 6 + gen/aqua/raw-event.hoon | 6 + gen/aqua/restore-fleet.hoon | 6 + gen/aqua/snap-fleet.hoon | 8 + lib/ph.hoon | 107 +++++---- sur/aquarium.hoon | 50 +++- 14 files changed, 723 insertions(+), 467 deletions(-) create mode 100644 app/aqua-ames.hoon create mode 100644 app/aqua-behn.hoon create mode 100644 app/aqua-dill.hoon create mode 100644 app/aqua-eyre.hoon create mode 100644 gen/aqua/dojo.hoon create mode 100644 gen/aqua/file.hoon create mode 100644 gen/aqua/init.hoon create mode 100644 gen/aqua/raw-event.hoon create mode 100644 gen/aqua/restore-fleet.hoon create mode 100644 gen/aqua/snap-fleet.hoon diff --git a/app/aqua-ames.hoon b/app/aqua-ames.hoon new file mode 100644 index 000000000..97265440d --- /dev/null +++ b/app/aqua-ames.hoon @@ -0,0 +1,72 @@ +:: This needs a better SDN solution. Every ship should have an IP +:: address, and we should eventually test changing those IP +:: addresses. +:: +:: For now, we broadcast every packet to every ship and rely on them +:: to drop them. +:: +/- aquarium +=, aquarium +=> $~ |% + +$ move (pair bone card) + +$ card + $% [%poke wire dock %aqua-events (list aqua-event)] + [%peer wire dock path] + [%pull wire dock ~] + == + :: + +$ state + $: %0 + subscribed=_| + == + -- +=, gall +=| moves=(list move) +|_ $: bowl + state + == +++ this . +++ apex %_(this moves ~) +++ abet [(flop moves) this] +++ emit-moves + |= ms=(list move) + %_(this moves (weld ms moves)) +:: +++ emit-aqua-events + |= aes=(list aqua-event) + %- emit-moves + [%poke /aqua-events [our %aqua] %aqua-events aes]~ +:: +++ poke-aqua-vane-control + |= command=?(%subscribe %unsubscribe) + :_ this(subscribed =(command %subscribe) + (aqua-vane-control-handler subscribed) +:: +++ diff-aqua-effects + |= [way=wire afs=aqua-effects] + ^- (quip move _this) + =. this apex =< abet + |- ^+ this + ?~ ufs.afs + this + =. this + ?+ -.q.i.ufs.afs this + %restore handle-restore + %send (handle-send i.ufs.afs) + -- + $(ufs.afs t.ufs.afs) +:: +++ handle-restore + %- emit-aqua-events + [%event who [//newt/0v1n.2m9vh %barn ~]]~ +:: +++ handle-send + |= [way=wire %send lan=lane:ames pac=@] + ^+ this + =/ hear [//newt/0v1n.2m9vh %hear lan pac] + %- emit-aqua-events + %+ turn + .^((list ship) %gx /(scot %p our)/aqua/(scot %da now)/ships/noun) + |= who=ship + [%event who hear] +-- diff --git a/app/aqua-behn.hoon b/app/aqua-behn.hoon new file mode 100644 index 000000000..b8005a30e --- /dev/null +++ b/app/aqua-behn.hoon @@ -0,0 +1,120 @@ +/- aquarium +=, aquarium +=> $~ |% + +$ move (pair bone card) + +$ card + $% [%poke wire dock %aqua-events (list aqua-event)] + [%peer wire dock path] + [%pull wire dock ~] + [%wait wire p=@da] + [%rest wire p=@da] + == + :: + +$ state + $: %0 + subscribed=_| + piers=(map ship next-timer=(unit @da)) + == + -- +=, gall +=| moves=(list move) +|_ $: bowl + state + == +++ this . +++ apex %_(this moves ~) +++ abet [(flop moves) this] +++ emit-moves + |= ms=(list move) + %_(this moves (weld ms moves)) +:: +++ emit-aqua-events + |= aes=(list aqua-event) + %- emit-moves + [%poke /aqua-events [our %aqua] %aqua-events aes]~ +:: +++ poke-aqua-vane-control + |= command=?(%subscribe %unsubscribe) + :_ this(subscribed =(command %subscribe) + (aqua-vane-control-handler subscribed) +:: +++ diff-aqua-effects + |= [way=wire afs=aqua-effects] + ^- (quip move _this) + =. this apex =< abet + |- ^+ this + ?~ ufs.afs + this + =. this + ?+ -.q.i.ufs.afs this + %sleep abet-pe:handle-sleep:(pe who.afs) + %restore abet-pe:handle-restore:(pe who.afs) + %doze abet-pe:(handle-doze:(pe who.afs) i.ufs.afs) + -- + $(ufs.afs t.ufs.afs) +:: +:: Received timer wake +:: +++ wake + |= [way=wire ~] + ^- (quip move _this) + =. this apex =< abet + ?> ?=([@ *] way) + =/ who (,@p (slav %p i.way)) + abet-pe:(take-wake:(pe who) t.way ~) +:: +++ pe + |= who=ship + =+ (fall (~(get by piers) who) *pier) + =* pier-data - + |% + ++ abet-pe + ^+ this + =. piers (~(put by piers) who pier-data) + this + :: + ++ handle-sleep + ^+ ..abet-pe + =< ..abet-pe(pier-data *pier) + ?~ next-timer + ..abet-pe + cancel-timer + :: + ++ handle-restore + ^+ ..abet-pe + %- emit-aqua-events + [%event who [//behn/0v1n.2m9vh %born ~]]~ + :: + ++ handle-doze + |= [way=wire %doze tim=(unit @da)] + ^+ ..abet-pe + ?~ tim + ?~ next-timer + this + cancel-timer + ?~ next-timer + (set-timer u.tim) + (set-timer:cancel-timer u.tim) + :: + ++ set-timer + |= tim=@da + =. tim +(tim) :: nobody's perfect + ~& [who=who %setting-timer tim] + =. next-timer `tim + (emit-moves [ost.hid %wait /(scot %p who) tim]~) + :: + ++ cancel-timer + ~& [who=who %cancell-timer (need next-timer)] + =. next-timer ~ + (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) + :: + ++ take-wake + |= [way=wire ~] + ~& [who=who %aqua-behn-wake now.hid] + =. next-timer ~ + =. this + %- emit-aqua-events + [%event who [//behn/0v1n.2m9vh %wake ~]]~ + ..abet-pe + -- +-- diff --git a/app/aqua-dill.hoon b/app/aqua-dill.hoon new file mode 100644 index 000000000..c01be9754 --- /dev/null +++ b/app/aqua-dill.hoon @@ -0,0 +1,78 @@ +:: Would love to see a proper stateful terminal handler. Ideally, +:: you'd be able to ^X into the virtual ship, like the old ^W. +:: +:: However, that's probably not the primary way of interacting with +:: it. In practice, most of the time you'll be running from a file +:: (eg for automated testing) or fanning the same command to multiple +:: ships or otherwise making use of the fact that we can +:: programmatically send events. +:: +/- aquarium +=, aquarium +=> $~ |% + +$ move (pair bone card) + +$ card + $% [%poke wire dock %aqua-events (list aqua-event)] + [%peer wire dock path] + [%pull wire dock ~] + == + :: + +$ state + $: %0 + subscribed=_| + == + -- +=, gall +=| moves=(list move) +|_ $: bowl + state + == +++ this . +++ apex %_(this moves ~) +++ abet [(flop moves) this] +++ emit-moves + |= ms=(list move) + %_(this moves (weld ms moves)) +:: +++ emit-aqua-events + |= aes=(list aqua-event) + %- emit-moves + [%poke /aqua-events [our %aqua] %aqua-events aes]~ +:: +++ poke-aqua-vane-control + |= command=?(%subscribe %unsubscribe) + :_ this(subscribed =(command %subscribe) + (aqua-vane-control-handler subscribed) +:: +++ diff-aqua-effects + |= [way=wire afs=aqua-effects] + ^- (quip move _this) + =. this apex =< abet + |- ^+ this + ?~ ufs.afs + this + =. this + ?+ -.q.i.ufs.afs this + %blit (handle-blit i.ufs.afs) + -- + $(ufs.afs t.ufs.afs) +:: +++ handle-blit + |= [way=wire %blit blits=(list blit:dill)] + ^+ ..abet-pe + =/ last-line + %+ roll blits + |= [b=blit:dill line=tape] + ?- -.b + %lin (tape p.b) + %mor ~& "{}: {line}" "" + %hop line + %bel line + %clr "" + %sag ~& [%save-jamfile-to p.b] line + %sav ~& [%save-file-to p.b] line + %url ~& [%activate-url p.b] line + == + ~& last-line + ..abet-pe +-- diff --git a/app/aqua-eyre.hoon b/app/aqua-eyre.hoon new file mode 100644 index 000000000..653a7aecf --- /dev/null +++ b/app/aqua-eyre.hoon @@ -0,0 +1,148 @@ +:: Pass-through Eyre driver +:: +/- aquarium +=, aquarium +=> $~ |% + +$ move (pair bone card) + +$ card + $% [%poke wire dock %aqua-events (list aqua-event)] + [%peer wire dock path] + [%pull wire dock ~] + [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] + == + :: + +$ state + $: %0 + subscribed=_| + piers=(map ship http-requests=(set @ud)) + == + -- +=, gall +=| moves=(list move) +|_ $: bowl + state + == +++ this . +++ apex %_(this moves ~) +++ abet [(flop moves) this] +++ emit-moves + |= ms=(list move) + %_(this moves (weld ms moves)) +:: +++ emit-aqua-events + |= aes=(list aqua-event) + %- emit-moves + [%poke /aqua-events [our %aqua] %aqua-events aes]~ +:: +++ poke-aqua-vane-control + |= command=?(%subscribe %unsubscribe) + :_ this(subscribed =(command %subscribe) + (aqua-vane-control-handler subscribed) +:: +++ diff-aqua-effects + |= [way=wire afs=aqua-effects] + ^- (quip move _this) + =. this apex =< abet + |- ^+ this + ?~ ufs.afs + this + =. this + ?+ -.q.i.ufs.afs this + %sleep abet-pe:handle-sleep:(pe who.afs) + %restore abet-pe:handle-restore:(pe who.afs) + %thus abet-pe:(handle-thus:(pe who.afs) i.ufs.afs) + -- + $(ufs.afs t.ufs.afs) +:: +:: Received inbound HTTP response +:: +++ sigh-httr + |= [way=wire res=httr:eyre] + ^- (quip move _this) + =. this apex-aqua =< abet-aqua + ?> ?=([@ *] way) + =/ who (,@p (slav %p i.way)) + ~& [%received-httr who] + abet-pe:(take-sigh-httr:(pe who) t.way res) +:: +:: Received inbound HTTP response error +:: +++ sigh-tang + |= [way=wire tan=tang] + ^- (quip move _this) + =. this apex-aqua =< abet-aqua + ?> ?=([@ *] way) + =/ who (,@p (slav %p i.way)) + ~& [%received-httr who] + abet-pe:(take-sigh-tang:(pe who) t.way tan) +:: +++ pe + |= who=ship + =+ (fall (~(get by piers) who) *pier) + =* pier-data - + |% + ++ abet-pe + ^+ this + =. piers (~(put by piers) who pier-data) + this + :: + ++ handle-sleep + ^+ ..abet-pe + ..abet-pe(pier-data *pier) + :: + ++ handle-restore + ^+ ..abet-pe + %- emit-aqua-events + [%event who [//http/0v1n.2m9vh %born ~]]~ + :: + ++ handle-thus + |= [way=wire %thus num=@ud req=(unit hiss:eyre)] + ^+ ..abet-pe + ?~ req + ?. (~(has in http-requests) num) + ..abet-pe + :: Eyre doesn't support cancelling HTTP requests from userspace, + :: so we remove it from our state so we won't pass along the + :: response. + :: + ~& [who=who %aqua-eyre-cant-cancel-thus num=num] + =. http-requests (~(del in http-requests) num) + ..abet-pe + ~& [who=who %aqua-eyre-requesting u.req] + =. http-requests (~(put in http-requests) num) + %- emit-moves :_ ~ + :* ost.hid + %hiss + /(scot %p who)/(scot %ud num) + ~ + %httr + [%hiss u.req] + == + :: + :: Pass HTTP response back to virtual ship + :: + ++ take-sigh-httr + |= [way=wire res=httr:eyre] + ^+ ..abet-pe + ?> ?=([@ ~] way) + =/ num (slav %ud i.way) + ?. (~(has in http-requests) num) + ~& [who=who %ignoring-httr num=num] + ..abet-pe + =. http-requests (~(del in http-requests) num) + (emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]~) + :: + :: Got error in HTTP response + :: + ++ take-sigh-tang + |= [way=wire tan=tang] + ^+ ..abet-pe + ?> ?=([@ ~] way) + =/ num (slav %ud i.way) + ?. (~(has in http-requests) num) + ~& [who=who %ignoring-httr num=num] + ..abet-pe + =. http-requests (~(del in http-requests) num) + %- (slog tan) + ..abet-pe +-- diff --git a/app/aqua.hoon b/app/aqua.hoon index 1964d8069..4c6e01ccd 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -25,10 +25,7 @@ => $~ |% +$ move (pair bone card) +$ card - $% [%wait wire p=@da] - [%rest wire p=@da] - [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] - [%diff diff-type] + $% [%diff diff-type] == :: :: Outgoing subscription updates @@ -53,8 +50,6 @@ event-log=(list unix-timed-event) next-events=(qeu unix-event) processing-events=? - next-timer=(unit @da) - http-requests=(set @ud) == -- =, gall @@ -117,14 +112,14 @@ ..abet-pe ?. processing-events ..abet-pe - =^ ovo next-events ~(get to next-events) + =^ ue next-events ~(get to next-events) =/ poke-arm (mox +47.snap) ?> ?=(%0 -.poke-arm) =/ poke p.poke-arm =. tym (max +(tym) now.hid) - =/ poke-result (slum poke tym ovo) + =/ poke-result (slum poke tym ue) =. snap +.poke-result - =. ..abet-pe (publish-event tym ovo) + =. ..abet-pe (publish-event tym ue) =. ..abet-pe (handle-effects ((list ovum) -.poke-result)) $ :: @@ -153,40 +148,6 @@ ~& [who=who %wished (slum wish txt)] ..abet-pe :: - :: Restart outstanding requests - :: - ++ restore - ^+ ..abet-pe - :: Restore behn - :: - =. ..abet-pe - ?~ next-timer - ..abet-pe - (set-timer u.next-timer) - :: Restore eyre - :: - =. http-requests ~ - =. ..abet-pe (push-events [//http/0v1n.2m9vh %born ~]~) - ..abet-pe - :: - :: Cancel outstanding requests - :: - ++ sleep - ^+ ..abet-pe - :: Sleep behn - :: - =. ..abet-pe - ?~ next-timer - ..abet-pe - cancel-timer - :: - :: Sleep eyre - :: - :: Eyre doesn't support cancelling HTTP requests from userspace. - :: - =. http-requests ~ - ..abet-pe - :: ++ mox |=(* (mock [snap +<] scry)) :: :: Start/stop processing events. When stopped, events are added to @@ -207,192 +168,26 @@ ?~ sof ~& [who=who %unknown-effect i.effects] ..abet-pe - =. ..abet-pe - ?- -.q.u.sof - %blit (handle-blit u.sof) - %send (handle-send u.sof) - %doze (handle-doze u.sof) - %thus (handle-thus u.sof) - %ergo (handle-ergo u.sof) - == (publish-effect u.sof) $(effects t.effects) :: - :: Would love to see a proper stateful terminal handler. Ideally, - :: you'd be able to ^X into the virtual ship, like the old ^W. - :: - :: However, that's porbably not the primary way of interacting with - :: it. In practice, most of the time you'll be running from a file - :: (eg for automated testing) or fanning the same command to multiple - :: ships or otherwise making use of the fact that we can - :: programmatically send events. - :: - ++ handle-blit - |= [way=wire %blit blits=(list blit:dill)] - ^+ ..abet-pe - =/ last-line - %+ roll blits - |= [b=blit:dill line=tape] - ?- -.b - %lin (tape p.b) - %mor ~& "{}: {line}" "" - %hop line - %bel line - %clr "" - %sag ~& [%save-jamfile-to p.b] line - %sav ~& [%save-file-to p.b] line - %url ~& [%activate-url p.b] line - == - ~& last-line - ..abet-pe - :: - :: This needs a better SDN solution. Every ship should have an IP - :: address, and we should eventually test changing those IP - :: addresses. - :: - :: For now, we broadcast every packet to every ship and rely on them - :: to drop them. - :: - ++ handle-send - |= [way=wire %send lan=lane:ames pac=@] - ^+ ..abet-pe - =/ dest-ip - |- ^- (unit @if) - ?- -.lan - %if `r.lan - %is ?~(q.lan ~ $(lan u.q.lan)) - %ix `r.lan - == - ?~ dest-ip - ~& [%sending-no-destination who lan] - ..abet-pe - ?. &(=(0 (rsh 0 16 u.dest-ip)) =(1 (rsh 0 8 u.dest-ip))) - ~& [%havent-implemented-direct-lanes who lan] - ..abet-pe - :: ~& [who=who %blast-sending] - =/ hear [//newt/0v1n.2m9vh %hear lan pac] - =. this (blast-event hear) - :: =/ her ?:(=(~dev who) ~bud ~dev) ::ship (dis u.dest-ip 0xff) - :: ?. (~(has by piers) her) - :: ~& [%dropping who=who her=her] - :: ..abet-pe - :: ~& [%sending who=who her=her ip=`@ux`u.dest-ip] - :: =^ ms this - :: abet-pe:(push-events:(pe her) ~[hear]) - ..abet-pe - :: - :: Would love to be able to control time more precisely, jumping - :: forward and whatnot. - :: - ++ handle-doze - |= [way=wire %doze tim=(unit @da)] - ^+ ..abet-pe - ?~ tim - ?~ next-timer - ..abet-pe - cancel-timer - ?~ next-timer - (set-timer u.tim) - (set-timer:cancel-timer u.tim) - :: - ++ set-timer - |= tim=@da - =. tim +(tim) :: nobody's perfect - ~& [who=who %setting-timer tim] - =. next-timer `tim - (emit-moves [ost.hid %wait /(scot %p who) tim]~) - :: - ++ cancel-timer - ~& [who=who %cancell-timer (need next-timer)] - (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) - :: - ++ take-wake - |= [way=wire ~] - ~& [who=who %wakey now.hid] - =. next-timer ~ - %- push-events:(pe who) - [//behn/0v1n.2m9vh %wake ~]~ - :: - :: Handle outgoing HTTP request - :: - ++ handle-thus - |= [way=wire %thus num=@ud req=(unit hiss:eyre)] - ^+ ..abet-pe - ?~ req - ?. (~(has in http-requests) num) - ..abet-pe - :: Eyre doesn't support cancelling HTTP requests from userspace, - :: so we remove it from our state so we won't pass along the - :: response. - :: - ~& [who=who %cant-cancel-thus num=num] - =. http-requests (~(del in http-requests) num) - ..abet-pe - ~& [who=who %requesting u.req] - =. http-requests (~(put in http-requests) num) - %- emit-moves :_ ~ - :* ost.hid - %hiss - /(scot %p who)/(scot %ud num) - ~ - %httr - [%hiss u.req] - == - :: - :: Pass HTTP response back to virtual ship - :: - ++ take-sigh-httr - |= [way=wire res=httr:eyre] - ^+ ..abet-pe - ?> ?=([@ ~] way) - =/ num (slav %ud i.way) - ?. (~(has in http-requests) num) - ~& [who=who %ignoring-httr num=num] - ..abet-pe - =. http-requests (~(del in http-requests) num) - (push-events [//http/0v1n.2m9vh %they num res]~) - :: - :: Got error in HTTP response - :: - ++ take-sigh-tang - |= [way=wire tan=tang] - ^+ ..abet-pe - ?> ?=([@ ~] way) - =/ num (slav %ud i.way) - ?. (~(has in http-requests) num) - ~& [who=who %ignoring-httr num=num] - ..abet-pe - =. http-requests (~(del in http-requests) num) - %- (slog tan) - ..abet-pe - :: - :: We should mirror a mount point of child to a clay desk of host. - :: For now, we just allow injecting a change to the child, so we - :: throw away ergos. - :: - ++ handle-ergo - |= [way=wire %ergo mount-point=@tas mod=mode:clay] - ^+ ..abet-pe - ~& [who=who %file-changes (lent mod)] :: (turn mod head)] - ..abet-pe - :: :: Give effect to our subscribers :: ++ publish-effect - |= ovo=unix-effect + |= uf=unix-effect ^+ ..abet-pe - =. unix-effects (~(add ja unix-effects) who ovo) - =. unix-boths (~(add ja unix-boths) who [%effect ovo]) + =. unix-effects (~(add ja unix-effects) who uf) + =. unix-boths (~(add ja unix-boths) who [%effect uf]) ..abet-pe :: :: Give event to our subscribers :: ++ publish-event - |= ovo=unix-timed-event + |= ute=unix-timed-event ^+ ..abet-pe - =. event-log [ovo event-log] - =. unix-events (~(add ja unix-events) who ovo) - =. unix-boths (~(add ja unix-boths) who [%event ovo]) + =. event-log [ute event-log] + =. unix-events (~(add ja unix-events) who ute) + =. unix-boths (~(add ja unix-boths) who [%event ute]) ..abet-pe -- :: @@ -413,30 +208,37 @@ ^- (quip move _this) =. this %- emit-moves - %+ murn ~(tap by sup.hid) + %- zing ^- (list (list move)) + %+ turn ~(tap by sup.hid) |= [b=bone her=ship pax=path] - ^- (unit move) + ^- (list move) ?+ pax ~ [%effects @ ~] =/ who (slav %p i.t.pax) - =/ fx (~(get ja unix-effects) who) - ?~ fx + =/ ufs (~(get ja unix-effects) who) + ?~ ufs ~ - `[b %diff %aqua-effects who fx] + [b %diff %aqua-effects who ufs]~ + :: + [%effects ~] + %+ turn + ~(tap by unix-effects) + |= [who=ship ufs=(list unix-effect)] + [b %diff %aqua-effects who ufs] :: [%events @ ~] =/ who (slav %p i.t.pax) =/ ve (~(get ja unix-events) who) ?~ ve ~ - `[b %diff %aqua-events who ve] + [b %diff %aqua-events who ve]~ :: [%boths @ ~] =/ who (slav %p i.t.pax) =/ bo (~(get ja unix-boths) who) ?~ bo ~ - `[b %diff %aqua-boths who bo] + [b %diff %aqua-boths who bo]~ == [(flop moves) this] :: @@ -469,7 +271,7 @@ ++ peer-effects |= pax=path ^- (quip move _this) - ?. ?=([@ ~] pax) + ?: ?=([@ @ *] pax) ~& [%aqua-bad-peer-effects pax] `this ?~ (slaw %p i.pax) @@ -570,53 +372,6 @@ => .(this ^+(this this)) =^ ms this (poke-pill pil) (emit-moves ms) - :: - [%init hers=*] - =/ hers ((list ship) hers.val) - ?~ hers - this - =^ ms this (poke-aqua-events [%init-ship i.hers ~]~) - (emit-moves ms) - :: - [%dojo hers=* command=*] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - %- push-events:(pe who) - ^- (list unix-event) - :~ - [//term/1 %belt %ctl `@c`%e] - [//term/1 %belt %ctl `@c`%u] - [//term/1 %belt %txt ((list @c) (tape command.val))] - [//term/1 %belt %ret ~] - == - :: - [%raw-event hers=* ovo=*] - =/ ovo ((soft unix-event) ovo.val) - ?~ ovo - ~& %ovo-not-an-event - this - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - (push-events:(pe who) ~[u.ovo]) - :: - [%file hers=* pax=*] - =/ pax (path pax.val) - ?> ?=([@ @ @ *] pax) - =/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - %- push-events:(pe who) - [//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~]~ - :: - [%peek hers=* p=*] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - ~& [who=who %peek-result (peek:(pe who) p.val)] - (pe who) :: [%wish hers=* p=@t] %+ turn-ships ((list ship) hers.val) @@ -635,14 +390,6 @@ |= [who=ship thus=_this] =. this thus stop-processing-events:(pe who) - :: - [%snap-fleet lab=@tas] - =. fleet-snaps (~(put by fleet-snaps) lab.val piers) - this - :: - [%restore-fleet lab=@tas] - =^ ms this (poke-aqua-events [%restore-snap lab.val]~) - (emit-moves ms) :: [%clear-snap lab=@tas] =. fleet-snaps ~ :: (~(del by fleet-snaps) lab.val) @@ -656,63 +403,63 @@ ^- (quip move _this) =. this apex-aqua =< abet-aqua %+ turn-events events - |= [ovo=aqua-event thus=_this] + |= [ae=aqua-event thus=_this] =. this thus - ?- -.ovo + ?- -.ae %init-ship - =. this abet-pe:sleep:(pe who.ovo) + =. this abet-pe:(publish-effect:(pe who.ae) [/ %sleep ~]) =/ initted =< plow - %- push-events:apex:(pe who.ovo) + %- push-events:apex:(pe who.ae) ^- (list unix-event) :~ [/ %wack 0] :: eny - [/ %whom who.ovo] :: eny + [/ %whom who.ae] :: eny [//newt/0v1n.2m9vh %barn ~] [//behn/0v1n.2m9vh %born ~] :+ //term/1 %boot - ?~ keys.ovo - [%fake who.ovo] - [%dawn u.keys.ovo] + ?~ keys.ae + [%fake who.ae] + [%dawn u.keys.ae] -.userspace-ova.pil [//http/0v1n.2m9vh %born ~] [//http/0v1n.2m9vh %live 8.080 `8.445] == =. this abet-pe:initted - (pe who.ovo) + (pe who.ae) :: %pause-events - stop-processing-events:(pe who.ovo) + stop-processing-events:(pe who.ae) :: %snap-ships =. fleet-snaps - %+ ~(put by fleet-snaps) lab.ovo + %+ ~(put by fleet-snaps) lab.ae %- malt - %+ murn hers.ovo + %+ murn hers.ae |= her=ship ^- (unit (pair ship pier)) =+ per=(~(get by piers) her) ?~ per ~ `[her u.per] - (pe -.hers.ovo) + (pe -.hers.ae) :: %restore-snap =. this %+ turn-ships (turn ~(tap by piers) head) |= [who=ship thus=_this] =. this thus - sleep:(pe who) - =. piers (~(uni by piers) (~(got by fleet-snaps) lab.ovo)) + (publish-effect:(pe who) [/ %sleep ~]) + =. piers (~(uni by piers) (~(got by fleet-snaps) lab.ae)) =. this %+ turn-ships (turn ~(tap by piers) head) |= [who=ship thus=_this] =. this thus - restore:(pe who) + (publish-effect:(pe who) [/ %restore ~]) (pe ~bud) :: XX why ~bud? need an example :: %event - ~& ev=-.q.ovo.ovo - (push-events:(pe who.ovo) [ovo.ovo]~) + ~& ev=-.q.ue.ae + (push-events:(pe who.ae) [ue.ae]~) == :: :: Run a callback function against a list of ships, aggregating state @@ -747,90 +494,7 @@ ++ turn-ships (turn-plow ship) ++ turn-events (turn-plow aqua-event) :: -:: Send the same event to all ships -:: -++ blast-event - |= ovo=unix-event - =/ pers ~(tap by piers) - |- ^+ this - ?~ pers - this - =. this - abet-pe:(push-events:(pe p.i.pers) ~[ovo]) - $(pers t.pers) -:: -:: Restore ships -:: -++ restore-ships - |= [hers=(list ship) from=(map ship pier)] - =. this - %+ turn-ships hers - |= [who=ship thus=_this] - =. this thus - sleep:(pe who) - =. piers - %- ~(gas by piers) - %+ turn hers - |= her=ship - [her (~(got by from) her)] - =. this - %+ turn-ships hers - |= [who=ship thus=_this] - =. this thus - restore:(pe who) - this -:: -:: Restore ships from pier -:: -++ restore-ship - |= [her=ship per=pier] - =. this abet-pe:plow:sleep:(pe her) - =. piers (~(put by piers) her per) - =. this abet-pe:plow:restore:(pe her) - this -:: -:: Received timer wake -:: -++ wake - |= [way=wire ~] - ^- (quip move _this) - =. this apex-aqua =< abet-aqua - ?> ?=([@ *] way) - =/ who (,@p (slav %p i.way)) - %+ turn-ships ~[who] - |= [who=ship thus=_this] - =. this thus - (take-wake:(pe who) t.way ~) -:: -:: Received inbound HTTP response -:: -++ sigh-httr - |= [way=wire res=httr:eyre] - ^- (quip move _this) - =. this apex-aqua =< abet-aqua - ?> ?=([@ *] way) - =/ who (,@p (slav %p i.way)) - ~& [%received-httr who] - %+ turn-ships ~[who] - |= [who=ship thus=_this] - =. this thus - (take-sigh-httr:(pe who) t.way res) -:: -:: Received inbound HTTP response error -:: -++ sigh-tang - |= [way=wire tan=tang] - ^- (quip move _this) - =. this apex-aqua =< abet-aqua - ?> ?=([@ *] way) - =/ who (,@p (slav %p i.way)) - ~& [%received-httr who] - %+ turn-ships ~[who] - |= [who=ship thus=_this] - =. this thus - (take-sigh-tang:(pe who) t.way tan) -:: -:: Handle scry to aqua +:: Check whether we have a snapshot :: ++ peek-x-fleet-snap |= pax=path @@ -841,7 +505,7 @@ :^ ~ ~ %noun (~(has by fleet-snaps) i.pax) :: -:: +:: Pass scry into child ship :: ++ peek-x-i |= pax=path @@ -856,6 +520,16 @@ :^ ~ ~ %noun (peek:(pe who) [%cx pax]) :: +:: Get all created ships +:: +++ peek-x-ships + |= pax=path + ^- (unit (unit %noun (list ship))) + ?. ?=(~ pax) + ~ + :^ ~ ~ %noun + (turn ~(tap by piers) head) +:: :: Trivial scry for mock :: ++ scry |=([* *] ~) diff --git a/app/ph.hoon b/app/ph.hoon index 8da418eb2..87a50e0ed 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -14,22 +14,27 @@ => $~ |% +$ move (pair bone card) +$ card - $% [%poke wire dock %aqua-events (list aqua-event)] + $% [%poke wire dock poke-types] [%peer wire dock path] [%pull wire dock ~] == :: + +$ poke-types + $% [%aqua-events (list aqua-event)] + [%drum-start term term] + == + :: +$ state $: %0 - raw-test-cores=(map term test-core) + raw-test-cores=(map term raw-test-core) test-cores=(map term test-core-state) other-state == :: +$ test-core-state $: hers=(list ship) - cor=test-core - effect-log=(list [who=ship ovo=unix-effect]) + cor=raw-test-core + effect-log=(list [who=ship uf=unix-effect]) == :: +$ other-state @@ -47,9 +52,10 @@ ~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid)) =, test-lib %- malt - ^- (list (pair term test-core)) + ^- (list (pair term raw-test-core)) :~ :- %add + ^- raw-test-core =+ num=5 |% ++ label %add @@ -65,14 +71,16 @@ == :: ++ route - |= [now=@da who=ship ovo=unix-effect] - ^- (quip ph-event _..start) + |= [now=@da who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] ~& [%num num] + :- ? :_ ..start - (expect-dojo-output ~bud who ovo "[%test-result 5]") + (expect-dojo-output ~bud who uf "[%test-result 5]") -- :: :- %hi + ^- raw-test-core |% ++ label %hi ++ ships ~[~bud ~dev] @@ -87,30 +95,29 @@ == :: ++ route - |= [now=@da who=ship ovo=unix-effect] - ^- (quip ph-event _..start) + |= [now=@da who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] + :- ? :_ ..start - (expect-dojo-output ~bud who ovo "hi ~dev successful") + (expect-dojo-output ~bud who uf "hi ~dev successful") -- :: [%headstart-bud (galaxy ~bud)] :: :- %composed-child-boot %+ compose-tests (planet ~linnup-torsyx) - ^- test-core + %+ porcelain-test %composed-child-boot |% - ++ label %composed-child-boot - ++ ships ~ ++ start |= now=@da [(dojo ~linnup-torsyx "|hi ~bud") ..start] :: ++ route - |= [now=@da who=ship ovo=unix-effect] + |= [now=@da who=ship uf=unix-effect] ^- (quip ph-event _..start) :_ ..start %- on-dojo-output - :^ ~linnup-torsyx who ovo + :^ ~linnup-torsyx who uf :- "hi ~bud successful" |= ~ [%test-done &]~ @@ -120,20 +127,19 @@ %+ compose-tests %+ compose-tests (planet ~mitnep-todsut) (planet ~haplun-todtus) - ^- test-core + %+ porcelain-test + %composed-child-boot-2 |% - ++ label %composed-child-boot-2 - ++ ships ~ ++ start |= now=@da [(dojo ~haplun-todtus "|hi ~bud") ..start] :: ++ route - |= [now=@da who=ship ovo=unix-effect] + |= [now=@da who=ship uf=unix-effect] ^- (quip ph-event _..start) :_ ..start %- on-dojo-output - :^ ~haplun-todtus who ovo + :^ ~haplun-todtus who uf :- "hi ~bud successful" |= ~ [%test-done &]~ @@ -158,10 +164,10 @@ :: %- assert-happens :: :~ :: == - *test-core + *raw-test-core :: :- %individual-breach - *test-core + *raw-test-core :: :: (init ~zod) :: (init ~marzod) @@ -188,6 +194,16 @@ `this `this(+<+>+> u.new) :: +++ publish-aqua-effects + |= afs=aqua-effects + ^- (list move) + %+ murn ~(tap by sup.hid) + |= [b=bone her=ship pax=path] + ^- (unit move) + ?. ?=([%effects ~] pax) + ~ + `[b %diff %aqua-effects ae] +:: ++ run-events |= [lab=term what=(list ph-event)] ^- (quip move _this) @@ -252,8 +268,19 @@ ~& %herm ^- (quip move _this) ?+ arg ~|(%bad-noun-arg !!) + %init + :_ this + %- zing ^- (list (list move)) + %+ turn + ^- (list term) + ~[%aqua-ames %aqua-behn %aqua-dill %aqua-eyre] + |= vane-app=term + :~ [ost.hid %poke /start [our.hid %hood] %drum-start %home vane-app] + [ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe] + == + :: [%run-test lab=@tas] - =/ res=[events=(list ph-event) new-state=test-core] + =/ res=[events=(list ph-event) new-state=raw-test-core] (start:(~(got by raw-test-cores) lab.arg) now.hid) =. test-cores (~(put by test-cores) lab.arg [ships . ~]:new-state.res) =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) @@ -264,38 +291,56 @@ =/ log effect-log:(~(got by test-cores) lab.arg) ~& lent=(lent log) ~& %+ roll log - |= [[who=ship ovo=unix-effect] ~] - ?: ?=(?(%blit %doze) -.q.ovo) + |= [[who=ship uf=unix-effect] ~] + ?: ?=(?(%blit %doze) -.q.uf) ~ - ?: ?=(%ergo -.q.ovo) - ~& [who [- +<]:ovo %omitted-by-ph] + ?: ?=(%ergo -.q.uf) + ~& [who [- +<]:uf %omitted-by-ph] ~ - ~& [who ovo] + ~& [who uf] ~ `this == :: ++ diff-aqua-effects - |= [way=wire ova=aqua-effects] + |= [way=wire afs=aqua-effects] ^- (quip move _this) - :: ~& [%diff-aqua-effect way who.ova] + :: ~& [%diff-aqua-effect way who.ae] ?> ?=([@tas @ ~] way) =/ lab i.way =/ test-cor (~(get by test-cores) lab) ?~ test-cor ~& [%ph-dropping lab] `this - =^ events u.test-cor - |- ^- (quip ph-event _u.test-cor) - ?~ ovo.ova - [~ u.test-cor] - =. effect-log.u.test-cor - [[who i.ovo]:ova effect-log.u.test-cor] - =^ events-1 cor.u.test-cor - (route:cor.u.test-cor now.hid who.ova i.ovo.ova) - =^ events-2 u.test-cor - $(ovo.ova t.ovo.ova) - [(weld events-1 events-2) u.test-cor] + =+ |- ^- $: thru-effects=(list unix-effects) + events=(list ph=event) + cor=_u.test-cor + == + ?~ ufs.ae + [~ ~ u.test-cor] + =. effect-log.u.test-cor + [[who i.ufs]:ae effect-log.u.test-cor] + =+ ^- [[thru=? events-1=(list ph-event)] cor=cor.u.test-cor] + (route:cor.u.test-cor now.hid who.ae i.ufs.ae) + =. cor.u.test-cor cor + =+ $(ufs.ae t.ufs.ae) + :+ ?: thru + [i.ufs.ae thru-effects] + thru-efects + (weld events-1 events) + cor + =. u.test=cor cor =. test-cores (~(put by test-cores) lab u.test-cor) + =^ moves this (publish-aqua-effects who.ae thru-effects) (run-events lab events) +:: +:: Subscribe to effects +:: +++ peer-effects + |= pax=path + ^- (quip move _this) + ?. ?=(~ pax) + ~& [%ph-bad-peer-effects pax] + `this + `this -- diff --git a/gen/aqua/dojo.hoon b/gen/aqua/dojo.hoon new file mode 100644 index 000000000..5d9fa23b0 --- /dev/null +++ b/gen/aqua/dojo.hoon @@ -0,0 +1,14 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship command=tape] ~] +:- %aqua-events +%+ turn + ^- (list unix-event) + :~ [//term/1 %belt %ctl `@c`%e] + [//term/1 %belt %ctl `@c`%u] + [//term/1 %belt %txt ((list @c) command)] + [//term/1 %belt %ret ~] + == +|= ue=unix-event +[%event her ue] diff --git a/gen/aqua/file.hoon b/gen/aqua/file.hoon new file mode 100644 index 000000000..bcc9d28a4 --- /dev/null +++ b/gen/aqua/file.hoon @@ -0,0 +1,8 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship pax=path] ~] +:- %aqua-events :_ ~ +:+ %event her +=/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] +[//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~]~ diff --git a/gen/aqua/init.hoon b/gen/aqua/init.hoon new file mode 100644 index 000000000..4a47a73b7 --- /dev/null +++ b/gen/aqua/init.hoon @@ -0,0 +1,6 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship] ~] +:- %aqua-events +[%init-ship her ~]~ diff --git a/gen/aqua/raw-event.hoon b/gen/aqua/raw-event.hoon new file mode 100644 index 000000000..b6d53e65a --- /dev/null +++ b/gen/aqua/raw-event.hoon @@ -0,0 +1,6 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship ue=unix-event] ~] +:- %aqua-events +[%event her ue]~ diff --git a/gen/aqua/restore-fleet.hoon b/gen/aqua/restore-fleet.hoon new file mode 100644 index 000000000..3a38cdaee --- /dev/null +++ b/gen/aqua/restore-fleet.hoon @@ -0,0 +1,6 @@ +/- aquarium +=, aquarium +:- %say +|= [* [label=@ta] ~] +:- %aqua-events +[%snap-ships label]~ diff --git a/gen/aqua/snap-fleet.hoon b/gen/aqua/snap-fleet.hoon new file mode 100644 index 000000000..6fcdf0ab3 --- /dev/null +++ b/gen/aqua/snap-fleet.hoon @@ -0,0 +1,8 @@ +/- aquarium +=, aquarium +:- %say +|= [[now=@da eny=@uvJ bec=beak] [label=@ta] ships=(list ship)] +:- %aqua-events +=? ships ?=(~ ships) + .^((list ship) %gx /(scot %p p.bec)/aqua/(scot %da now)/ships/noun) +[%snap-ships label ships]~ diff --git a/lib/ph.hoon b/lib/ph.hoon index 17d727217..6cb86cd83 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -6,7 +6,7 @@ |% :: Defines a complete integration test. :: -++ test-core +++ raw-test-core $_ ^? |% :: @@ -27,6 +27,18 @@ :: :: Called on every effect from a ship. :: + ++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start)])) + -- +:: +++ porcelain-test-core + $_ ^? + |% + :: Called first to kick off the test. + :: + ++ start |~(now=@da *(quip ph-event _^?(..start))) + :: + :: Called on every effect from a ship. + :: ++ route |~([now=@da ship unix-effect] *(quip ph-event _^?(..start))) -- :: @@ -35,12 +47,29 @@ aqua-event == :: +++ porcelain-test + |= [label=@ta porcelain=porcelain-test-core] + ^- raw-test-core + |% + ++ label ^label + ++ ships ~ + ++ start + |= now=@da + =^ events porcelain (start:porcelain now) + [events ..start] + :: + ++ route + |= args=[@da ship unix-effect] + =^ events porcelain (route:porcelain args) + [& events ..start] + -- +:: ++ send-events-to |= [who=ship what=(list unix-event)] ^- (list ph-event) %+ turn what - |= ovo=unix-event - [%event who ovo] + |= ue=unix-event + [%event who ue] :: ++ init |= [who=ship keys=(unit dawn-event)] @@ -72,13 +101,13 @@ == :: ++ on-dojo-output - |= [who=ship her=ship ovo=unix-effect what=tape fun=$-($~ (list ph-event))] + |= [who=ship her=ship uf=unix-effect what=tape fun=$-($~ (list ph-event))] ^- (list ph-event) ?. =(who her) ~ - ?. ?=(%blit -.q.ovo) + ?. ?=(%blit -.q.uf) ~ - ?. %+ lien p.q.ovo + ?. %+ lien p.q.uf |= =blit:dill ?. ?=(%lin -.blit) | @@ -87,19 +116,19 @@ (fun) :: ++ expect-dojo-output - |= [who=ship her=ship ovo=unix-effect what=tape] + |= [who=ship her=ship uf=unix-effect what=tape] ^- (list ph-event) %- on-dojo-output - :^ who her ovo + :^ who her uf :- what |= ~ [%test-done &]~ :: ++ on-ergo - |= [who=ship her=ship ovo=unix-effect fun=$-($~ (list ph-event))] + |= [who=ship her=ship uf=unix-effect fun=$-($~ (list ph-event))] ?. =(who her) ~ - ?. ?=(%ergo -.q.ovo) + ?. ?=(%ergo -.q.uf) ~ (fun) :: @@ -151,8 +180,8 @@ ++ test-lib |_ our=ship ++ compose-tests - |= [a=test-core b=test-core] - ^- test-core + |= [a=raw-test-core b=raw-test-core] + ^- raw-test-core =/ done-with-a | => |% @@ -208,14 +237,18 @@ :: like that. :: ++ route - |= [now=@da who=ship ovo=unix-effect] - ^- (quip ph-event _..start) + |= [now=@da who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] ?: done-with-a - =^ events b (route:b now who ovo) - [events ..start] - =^ events a (route:a now who ovo) + =+ ^- [thru=? events=(list ph-event) cor=raw-test-core] + (route:b now who uf) + =. b cor + [thru events ..start] + =+ ^- [thru=? events=(list ph-event) cor=raw-test-core] + (route:a now who uf) + =. a cor =^ events ..filter-a (filter-a now events) - [events ..start] + [thru events ..start] -- :: :: Don't use directly, or else you might not have a parent. @@ -224,7 +257,7 @@ :: ++ raw-ship |= [her=ship keys=(unit dawn-event)] - ^- test-core + ^- raw-test-core |% ++ label :((cury cat 3) 'init-' (scot %p her) '-' (scot %uw (mug (fall keys *dawn-event)))) ++ ships ~[her] @@ -234,8 +267,9 @@ [(init her keys) ..start] :: ++ route - |= [now=@da who=ship ovo=unix-effect] - ^- (quip ph-event _..start) + |= [now=@da who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] + :- & :_ ..start %- zing :: This is a pretty bad heuristic, but in general galaxies will @@ -244,13 +278,13 @@ :: :~ %- on-dojo-output - :^ her who ovo + :^ her who uf :- "+ /{(scow %p her)}/base/2/web/testing/udon" |= ~ [%test-done &]~ :: %- on-dojo-output - :^ her who ovo + :^ her who uf :- "is your neighbor" |= ~ [%test-done &]~ @@ -291,11 +325,10 @@ :: ++ touch-file |= [her=ship des=desk] - ^- test-core + %+ porcelain-test + (cat 3 'touch-file-' (scot %p her)) =| warped=@t |% - ++ label (cat 3 'touch-file-' (scot %p her)) - ++ ships ~ ++ start |= now=@da ^- (pair (list ph-event) _..start) @@ -309,12 +342,12 @@ == :: ++ route - |= [now=@da who=ship ovo=unix-effect] + |= [now=@da who=ship uf=unix-effect] ^- (quip ph-event _..start) :_ ..start %- zing :~ %- on-ergo - :^ her who ovo + :^ her who uf |= $~ =/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun ?: =(warped (need (scry-aqua (unit @) now pax))) @@ -330,10 +363,9 @@ :: ++ check-file-touched |= [her=ship des=desk] - ^- test-core + %+ porcelain-test + (cat 3 'check-file-touched-' (scot %p her)) |% - ++ label (cat 3 'check-file-touched-' (scot %p her)) - ++ ships ~ ++ start |= now=@da :: mounting is not strictly necessary since we check via scry, @@ -345,7 +377,7 @@ [(dojo her "|mount /={(trip des)}=") ..start] :: ++ route - |= [now=@da who=ship ovo=unix-effect] + |= [now=@da who=ship uf=unix-effect] ^- (quip ph-event _..start) =/ cb |= $~ @@ -364,8 +396,8 @@ ~ :_ ..start %- zing - :~ (on-ergo her who ovo cb) - (on-dojo-output her who ovo ">=" cb) + :~ (on-ergo her who uf cb) + (on-dojo-output her who uf ">=" cb) == -- :: @@ -375,10 +407,9 @@ :: ++ reload-vane |= [her=ship vane=term] - ^- test-core + %+ porcelain-test + :((cury cat 3) 'reload-vane-' (scot %p her) '-' vane) |% - ++ label :((cury cat 3) 'reload-vane-' (scot %p her) '-' vane) - ++ ships ~ ++ start |= now=@da ^- (pair (list ph-event) _..start) @@ -392,7 +423,7 @@ == :: ++ route - |= [now=@da who=ship ovo=unix-effect] + |= [now=@da who=ship uf=unix-effect] ^- (quip ph-event _..start) `..start -- diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon index bfec9f638..bed8f3a97 100644 --- a/sur/aquarium.hoon +++ b/sur/aquarium.hoon @@ -1,27 +1,40 @@ +:: +:: Traditionally, ovo refers an event or card, and ova refers to a list +:: of them. We have several versions of each of these depending on +:: context, so we do away with that naming scheme and use the following +:: naming scheme. +:: +:: Every card is either a an `event` or an `effect`. Prepended to this +:: is `unix` if it has no ship associated with it, or `aqua` if it +:: does. `timed` is added if it includes the time of the event. +:: +:: Short names are simply the first letter of each word plus `s` if +:: it's a list. +:: |% +$ aqua-event $% [%init-ship who=ship keys=(unit dawn-event)] [%pause-events who=ship] [%snap-ships lab=term hers=(list ship)] [%restore-snap lab=term] - [%event who=ship ovo=unix-event] + [%event who=ship ue=unix-event] == :: +$ aqua-effects - [who=ship ovo=(list unix-effect)] + [who=ship ufs=(list unix-effect)] :: +$ aqua-events - [who=ship ovo=(list unix-timed-event)] + [who=ship utes=(list unix-timed-event)] :: +$ aqua-boths - [who=ship ovo=(list unix-both)] + [who=ship ub=(list unix-both)] :: +$ unix-both $% [%event unix-timed-event] [%effect unix-effect] == :: -+$ unix-timed-event [tym=@da ovo=unix-event] ++$ unix-timed-event [tym=@da ue=unix-event] :: +$ unix-event %+ pair wire @@ -40,6 +53,8 @@ [%doze p=(unit @da)] [%thus p=@ud q=(unit hiss:eyre)] [%ergo p=@tas q=mode:clay] + [%sleep ~] + [%restore ~] == +$ pill [boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)] @@ -53,4 +68,29 @@ node=(unit purl:eyre) snap=(unit snapshot:jael) == +:: ++$ vane-card + $% [%peer wire dock path] + [%pull wire dock ~] + == +:: +++ aqua-vane-control-handler + |= subscribed=? + |= command=?(%subscribe %unsubscribe) + ^- (list vane-cards) + ?- command + %subscribe + %+ weld + ^- (list vane-card) + ?. subscribed + ~ + [%pull /aqua [our %ph]]~ + ^- (list vane-card) + [%peer /aqua [our %ph] /effects]~ + :: + %unsubscribe + ?. subscribed + ~ + [%pull /aqua [our %ph]]~ + -- -- From ae8966e5adbda93810f3b9572c93afaacb243049 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 7 Mar 2019 21:15:42 -0800 Subject: [PATCH 37/55] compiles --- app/aqua-ames.hoon | 11 ++++++----- app/aqua-behn.hoon | 28 +++++++++++++++++----------- app/aqua-dill.hoon | 16 ++++++++-------- app/aqua-eyre.hoon | 45 +++++++++++++++++++++++++++------------------ app/aqua.hoon | 10 +++++----- app/ph.hoon | 45 ++++++++++++++++++++++++++------------------- lib/ph.hoon | 2 +- sur/aquarium.hoon | 20 ++++++++++---------- 8 files changed, 100 insertions(+), 77 deletions(-) diff --git a/app/aqua-ames.hoon b/app/aqua-ames.hoon index 97265440d..cb9e86c28 100644 --- a/app/aqua-ames.hoon +++ b/app/aqua-ames.hoon @@ -35,12 +35,12 @@ ++ emit-aqua-events |= aes=(list aqua-event) %- emit-moves - [%poke /aqua-events [our %aqua] %aqua-events aes]~ + [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ :: ++ poke-aqua-vane-control |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe) - (aqua-vane-control-handler subscribed) + :_ this(subscribed =(command %subscribe)) + (aqua-vane-control-handler our ost subscribed command) :: ++ diff-aqua-effects |= [way=wire afs=aqua-effects] @@ -51,12 +51,13 @@ this =. this ?+ -.q.i.ufs.afs this - %restore handle-restore + %restore (handle-restore who.afs) %send (handle-send i.ufs.afs) - -- + == $(ufs.afs t.ufs.afs) :: ++ handle-restore + |= who=@p %- emit-aqua-events [%event who [//newt/0v1n.2m9vh %barn ~]]~ :: diff --git a/app/aqua-behn.hoon b/app/aqua-behn.hoon index b8005a30e..8c8c71b68 100644 --- a/app/aqua-behn.hoon +++ b/app/aqua-behn.hoon @@ -13,8 +13,10 @@ +$ state $: %0 subscribed=_| - piers=(map ship next-timer=(unit @da)) + piers=(map ship pier) == + :: + +$ pier next-timer=(unit @da) -- =, gall =| moves=(list move) @@ -31,12 +33,12 @@ ++ emit-aqua-events |= aes=(list aqua-event) %- emit-moves - [%poke /aqua-events [our %aqua] %aqua-events aes]~ + [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ :: ++ poke-aqua-vane-control |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe) - (aqua-vane-control-handler subscribed) + :_ this(subscribed =(command %subscribe)) + (aqua-vane-control-handler our ost subscribed command) :: ++ diff-aqua-effects |= [way=wire afs=aqua-effects] @@ -50,7 +52,7 @@ %sleep abet-pe:handle-sleep:(pe who.afs) %restore abet-pe:handle-restore:(pe who.afs) %doze abet-pe:(handle-doze:(pe who.afs) i.ufs.afs) - -- + == $(ufs.afs t.ufs.afs) :: :: Received timer wake @@ -82,15 +84,17 @@ :: ++ handle-restore ^+ ..abet-pe - %- emit-aqua-events - [%event who [//behn/0v1n.2m9vh %born ~]]~ + =. this + %- emit-aqua-events + [%event who [//behn/0v1n.2m9vh %born ~]]~ + ..abet-pe :: ++ handle-doze |= [way=wire %doze tim=(unit @da)] ^+ ..abet-pe ?~ tim ?~ next-timer - this + ..abet-pe cancel-timer ?~ next-timer (set-timer u.tim) @@ -101,16 +105,18 @@ =. tim +(tim) :: nobody's perfect ~& [who=who %setting-timer tim] =. next-timer `tim - (emit-moves [ost.hid %wait /(scot %p who) tim]~) + =. this (emit-moves [ost %wait /(scot %p who) tim]~) + ..abet-pe :: ++ cancel-timer ~& [who=who %cancell-timer (need next-timer)] =. next-timer ~ - (emit-moves [ost.hid %rest /(scot %p who) (need next-timer)]~) + =. this (emit-moves [ost %rest /(scot %p who) (need next-timer)]~) + ..abet-pe :: ++ take-wake |= [way=wire ~] - ~& [who=who %aqua-behn-wake now.hid] + ~& [who=who %aqua-behn-wake now] =. next-timer ~ =. this %- emit-aqua-events diff --git a/app/aqua-dill.hoon b/app/aqua-dill.hoon index c01be9754..4286b942c 100644 --- a/app/aqua-dill.hoon +++ b/app/aqua-dill.hoon @@ -37,12 +37,12 @@ ++ emit-aqua-events |= aes=(list aqua-event) %- emit-moves - [%poke /aqua-events [our %aqua] %aqua-events aes]~ + [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ :: ++ poke-aqua-vane-control |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe) - (aqua-vane-control-handler subscribed) + :_ this(subscribed =(command %subscribe)) + (aqua-vane-control-handler our ost subscribed command) :: ++ diff-aqua-effects |= [way=wire afs=aqua-effects] @@ -53,13 +53,13 @@ this =. this ?+ -.q.i.ufs.afs this - %blit (handle-blit i.ufs.afs) - -- + %blit (handle-blit who.afs i.ufs.afs) + == $(ufs.afs t.ufs.afs) :: ++ handle-blit - |= [way=wire %blit blits=(list blit:dill)] - ^+ ..abet-pe + |= [who=@p way=wire %blit blits=(list blit:dill)] + ^+ this =/ last-line %+ roll blits |= [b=blit:dill line=tape] @@ -74,5 +74,5 @@ %url ~& [%activate-url p.b] line == ~& last-line - ..abet-pe + this -- diff --git a/app/aqua-eyre.hoon b/app/aqua-eyre.hoon index 653a7aecf..cc87ea667 100644 --- a/app/aqua-eyre.hoon +++ b/app/aqua-eyre.hoon @@ -14,8 +14,10 @@ +$ state $: %0 subscribed=_| - piers=(map ship http-requests=(set @ud)) + piers=(map ship pier) == + :: + +$ pier http-requests=(set @ud) -- =, gall =| moves=(list move) @@ -32,12 +34,12 @@ ++ emit-aqua-events |= aes=(list aqua-event) %- emit-moves - [%poke /aqua-events [our %aqua] %aqua-events aes]~ + [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ :: ++ poke-aqua-vane-control |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe) - (aqua-vane-control-handler subscribed) + :_ this(subscribed =(command %subscribe)) + (aqua-vane-control-handler our ost subscribed command) :: ++ diff-aqua-effects |= [way=wire afs=aqua-effects] @@ -51,7 +53,7 @@ %sleep abet-pe:handle-sleep:(pe who.afs) %restore abet-pe:handle-restore:(pe who.afs) %thus abet-pe:(handle-thus:(pe who.afs) i.ufs.afs) - -- + == $(ufs.afs t.ufs.afs) :: :: Received inbound HTTP response @@ -59,7 +61,7 @@ ++ sigh-httr |= [way=wire res=httr:eyre] ^- (quip move _this) - =. this apex-aqua =< abet-aqua + =. this apex =< abet ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) ~& [%received-httr who] @@ -70,7 +72,7 @@ ++ sigh-tang |= [way=wire tan=tang] ^- (quip move _this) - =. this apex-aqua =< abet-aqua + =. this apex =< abet ?> ?=([@ *] way) =/ who (,@p (slav %p i.way)) ~& [%received-httr who] @@ -92,8 +94,10 @@ :: ++ handle-restore ^+ ..abet-pe - %- emit-aqua-events - [%event who [//http/0v1n.2m9vh %born ~]]~ + =. this + %- emit-aqua-events + [%event who [//http/0v1n.2m9vh %born ~]]~ + ..abet-pe :: ++ handle-thus |= [way=wire %thus num=@ud req=(unit hiss:eyre)] @@ -110,14 +114,16 @@ ..abet-pe ~& [who=who %aqua-eyre-requesting u.req] =. http-requests (~(put in http-requests) num) - %- emit-moves :_ ~ - :* ost.hid - %hiss - /(scot %p who)/(scot %ud num) - ~ - %httr - [%hiss u.req] - == + =. this + %- emit-moves :_ ~ + :* ost + %hiss + /(scot %p who)/(scot %ud num) + ~ + %httr + [%hiss u.req] + == + ..abet-pe :: :: Pass HTTP response back to virtual ship :: @@ -130,7 +136,9 @@ ~& [who=who %ignoring-httr num=num] ..abet-pe =. http-requests (~(del in http-requests) num) - (emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]~) + =. this + (emit-aqua-events [%event who [//http/0v1n.2m9vh %they num res]]~) + ..abet-pe :: :: Got error in HTTP response :: @@ -145,4 +153,5 @@ =. http-requests (~(del in http-requests) num) %- (slog tan) ..abet-pe + -- -- diff --git a/app/aqua.hoon b/app/aqua.hoon index 4c6e01ccd..84c9e7494 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -92,9 +92,9 @@ :: Enqueue events to child arvo :: ++ push-events - |= ova=(list unix-event) + |= ues=(list unix-event) ^+ ..abet-pe - =. next-events (~(gas to next-events) ova) + =. next-events (~(gas to next-events) ues) ..abet-pe :: :: Send moves to host arvo @@ -271,7 +271,7 @@ ++ peer-effects |= pax=path ^- (quip move _this) - ?: ?=([@ @ *] pax) + ?. ?=([@ *] pax) ~& [%aqua-bad-peer-effects pax] `this ?~ (slaw %p i.pax) @@ -524,11 +524,11 @@ :: ++ peek-x-ships |= pax=path - ^- (unit (unit %noun (list ship))) + ^- (unit (unit [%noun (list ship)])) ?. ?=(~ pax) ~ :^ ~ ~ %noun - (turn ~(tap by piers) head) + `(list ship)`(turn ~(tap by piers) head) :: :: Trivial scry for mock :: diff --git a/app/ph.hoon b/app/ph.hoon index 87a50e0ed..c79055a79 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -14,14 +14,20 @@ => $~ |% +$ move (pair bone card) +$ card - $% [%poke wire dock poke-types] + $% [%poke wire dock poke-type] [%peer wire dock path] [%pull wire dock ~] + [%diff diff-type] == :: - +$ poke-types + +$ poke-type $% [%aqua-events (list aqua-event)] [%drum-start term term] + [%aqua-vane-control ?(%subscribe %unsubscribe)] + == + :: + +$ diff-type + $% [%aqua-effects aqua-effects] == :: +$ state @@ -74,7 +80,7 @@ |= [now=@da who=ship uf=unix-effect] ^- [? (quip ph-event _..start)] ~& [%num num] - :- ? + :- & :_ ..start (expect-dojo-output ~bud who uf "[%test-result 5]") -- @@ -97,7 +103,7 @@ ++ route |= [now=@da who=ship uf=unix-effect] ^- [? (quip ph-event _..start)] - :- ? + :- & :_ ..start (expect-dojo-output ~bud who uf "hi ~dev successful") -- @@ -106,7 +112,7 @@ :: :- %composed-child-boot %+ compose-tests (planet ~linnup-torsyx) - %+ porcelain-test %composed-child-boot + %+ porcelain-test %composed-child-boot |% ++ start |= now=@da @@ -202,7 +208,7 @@ ^- (unit move) ?. ?=([%effects ~] pax) ~ - `[b %diff %aqua-effects ae] + `[ost.hid %diff %aqua-effects afs] :: ++ run-events |= [lab=term what=(list ph-event)] @@ -305,34 +311,35 @@ ++ diff-aqua-effects |= [way=wire afs=aqua-effects] ^- (quip move _this) - :: ~& [%diff-aqua-effect way who.ae] + :: ~& [%diff-aqua-effect way who.afs] ?> ?=([@tas @ ~] way) =/ lab i.way =/ test-cor (~(get by test-cores) lab) ?~ test-cor ~& [%ph-dropping lab] `this - =+ |- ^- $: thru-effects=(list unix-effects) - events=(list ph=event) + =+ |- ^- $: thru-effects=(list unix-effect) + events=(list ph-event) cor=_u.test-cor == - ?~ ufs.ae + ?~ ufs.afs [~ ~ u.test-cor] =. effect-log.u.test-cor - [[who i.ufs]:ae effect-log.u.test-cor] - =+ ^- [[thru=? events-1=(list ph-event)] cor=cor.u.test-cor] - (route:cor.u.test-cor now.hid who.ae i.ufs.ae) + [[who i.ufs]:afs effect-log.u.test-cor] + =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-cor] + (route:cor.u.test-cor now.hid who.afs i.ufs.afs) =. cor.u.test-cor cor - =+ $(ufs.ae t.ufs.ae) + =+ $(ufs.afs t.ufs.afs) :+ ?: thru - [i.ufs.ae thru-effects] - thru-efects + [i.ufs.afs thru-effects] + thru-effects (weld events-1 events) cor - =. u.test=cor cor + =. u.test-cor cor =. test-cores (~(put by test-cores) lab u.test-cor) - =^ moves this (publish-aqua-effects who.ae thru-effects) - (run-events lab events) + =/ moves-1 (publish-aqua-effects who.afs thru-effects) + =^ moves-2 this (run-events lab events) + [(weld moves-1 moves-2) this] :: :: Subscribe to effects :: diff --git a/lib/ph.hoon b/lib/ph.hoon index 6cb86cd83..c4d3bcfb4 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -27,7 +27,7 @@ :: :: Called on every effect from a ship. :: - ++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start)])) + ++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start))]) -- :: ++ porcelain-test-core diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon index bed8f3a97..3d04cd5e1 100644 --- a/sur/aquarium.hoon +++ b/sur/aquarium.hoon @@ -69,28 +69,28 @@ snap=(unit snapshot:jael) == :: -+$ vane-card ++$ vane-move + %+ pair bone $% [%peer wire dock path] [%pull wire dock ~] == :: ++ aqua-vane-control-handler - |= subscribed=? - |= command=?(%subscribe %unsubscribe) - ^- (list vane-cards) + |= [our=@p ost=bone subscribed=? command=?(%subscribe %unsubscribe)] + ^- (list vane-move) ?- command %subscribe %+ weld - ^- (list vane-card) + ^- (list vane-move) ?. subscribed ~ - [%pull /aqua [our %ph]]~ - ^- (list vane-card) - [%peer /aqua [our %ph] /effects]~ + [ost %pull /aqua [our %ph] ~]~ + ^- (list vane-move) + [ost %peer /aqua [our %ph] /effects]~ :: %unsubscribe ?. subscribed ~ - [%pull /aqua [our %ph]]~ - -- + [ost %pull /aqua [our %ph] ~]~ + == -- From e2619830945faab9ee206e2d0cc8783428d208ff Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 7 Mar 2019 21:27:07 -0800 Subject: [PATCH 38/55] clean up printfs --- sys/arvo.hoon | 2 +- sys/vane/clay.hoon | 12 +++++------- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/sys/arvo.hoon b/sys/arvo.hoon index 10b548506..a9e85ba03 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -644,7 +644,7 @@ :: =/ pit=vase !>(..is) :: =/ vil=vile (viol p.pit) :: cached reflexives -=| $: lac=_| :: laconic bit +=| $: lac=_& :: laconic bit eny=@ :: entropy our=ship :: identity bud=vase :: %zuse diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 053653e77..53505c1f6 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -1171,7 +1171,6 @@ ?~ hat +>.$ wake:(print-changes:(checkout-ankh u.hat) wen lem) - ~& [%edit our hen] ?. =(~ dok) ~& %already-applying-changes +> :: @@ -2376,7 +2375,6 @@ ++ apply-changes :: apply-changes:ze |= lar/(list {p/path q/misu}) :: store changes ^- (map path blob) - ~& [%apply-changes our hen] =+ ^= hat :: current state ?: =(let.dom 0) :: initial commit ~ :: has nothing @@ -4250,11 +4248,11 @@ =/ queued-duct=duct -.queued =/ queued-task=task:able +.queued :: - ~& :* %x-clay-waking - queued-duct - hen - ?~(cue.ruf /empty -:(need ~(top to cue.ruf))) - == + :: ~& :* %x-clay-waking + :: queued-duct + :: hen + :: ?~(cue.ruf /empty -:(need ~(top to cue.ruf))) + :: == ~| [%mismatched-ducts %queued queued-duct %timer hen] ?> =(hen queued-duct) :: From 187aff92797b0a679cd5ee5fefd2e6b65120947a Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Thu, 7 Mar 2019 22:28:10 -0800 Subject: [PATCH 39/55] working after rearchitecture --- app/aqua-behn.hoon | 2 +- app/aqua.hoon | 8 ++++---- app/ph.hoon | 10 +++------- lib/ph.hoon | 14 +++++++------- 4 files changed, 15 insertions(+), 19 deletions(-) diff --git a/app/aqua-behn.hoon b/app/aqua-behn.hoon index 8c8c71b68..d483acb88 100644 --- a/app/aqua-behn.hoon +++ b/app/aqua-behn.hoon @@ -110,8 +110,8 @@ :: ++ cancel-timer ~& [who=who %cancell-timer (need next-timer)] - =. next-timer ~ =. this (emit-moves [ost %rest /(scot %p who) (need next-timer)]~) + =. next-timer ~ ..abet-pe :: ++ take-wake diff --git a/app/aqua.hoon b/app/aqua.hoon index 84c9e7494..94a81f798 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -218,27 +218,27 @@ =/ ufs (~(get ja unix-effects) who) ?~ ufs ~ - [b %diff %aqua-effects who ufs]~ + [b %diff %aqua-effects who (flop ufs)]~ :: [%effects ~] %+ turn ~(tap by unix-effects) |= [who=ship ufs=(list unix-effect)] - [b %diff %aqua-effects who ufs] + [b %diff %aqua-effects who (flop ufs)] :: [%events @ ~] =/ who (slav %p i.t.pax) =/ ve (~(get ja unix-events) who) ?~ ve ~ - [b %diff %aqua-events who ve]~ + [b %diff %aqua-events who (flop ve)]~ :: [%boths @ ~] =/ who (slav %p i.t.pax) =/ bo (~(get ja unix-boths) who) ?~ bo ~ - [b %diff %aqua-boths who bo]~ + [b %diff %aqua-boths who (flop bo)]~ == [(flop moves) this] :: diff --git a/app/ph.hoon b/app/ph.hoon index c79055a79..1ddee8e3f 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -62,14 +62,12 @@ :~ :- %add ^- raw-test-core - =+ num=5 |% ++ label %add ++ ships ~[~bud] ++ start |= now=@da ^- (pair (list ph-event) _..start) - =. num +(num) :_ ..start %- zing :~ (init ~bud ~) @@ -79,7 +77,6 @@ ++ route |= [now=@da who=ship uf=unix-effect] ^- [? (quip ph-event _..start)] - ~& [%num num] :- & :_ ..start (expect-dojo-output ~bud who uf "[%test-result 5]") @@ -208,7 +205,7 @@ ^- (unit move) ?. ?=([%effects ~] pax) ~ - `[ost.hid %diff %aqua-effects afs] + `[b %diff %aqua-effects afs] :: ++ run-events |= [lab=term what=(list ph-event)] @@ -220,7 +217,7 @@ ?~ what [%& ~] ?: ?=(%test-done -.i.what) - ~& ?~(p.i.what "test successful" "test failed") + ~& ?~(p.i.what "TEST SUCCESSFUL" "TEST FAILED") [%| ~] =/ nex $(what t.what) ?: ?=(%| -.nex) @@ -271,7 +268,6 @@ :: ++ poke-noun |= arg=* - ~& %herm ^- (quip move _this) ?+ arg ~|(%bad-noun-arg !!) %init @@ -279,7 +275,7 @@ %- zing ^- (list (list move)) %+ turn ^- (list term) - ~[%aqua-ames %aqua-behn %aqua-dill %aqua-eyre] + ~[%aqua %aqua-ames %aqua-behn %aqua-dill %aqua-eyre] |= vane-app=term :~ [ost.hid %poke /start [our.hid %hood] %drum-start %home vane-app] [ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe] diff --git a/lib/ph.hoon b/lib/ph.hoon index c4d3bcfb4..1def470a6 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -219,13 +219,13 @@ ^- (quip ph-event _..start) =/ have-cache (scry-aqua ? now /fleet-snap/[label:a]/noun) - ?: have-cache - ~& [%caching-in label:a label] - =. done-with-a & - =/ restore-event [%restore-snap label:a] - =^ events-start b (start:b now) - =^ events ..filter-a (filter-a now restore-event events-start) - [events ..start] + :: ?: have-cache + :: ~& [%caching-in label:a label] + :: =. done-with-a & + :: =/ restore-event [%restore-snap label:a] + :: =^ events-start b (start:b now) + :: =^ events ..filter-a (filter-a now restore-event events-start) + :: [events ..start] =^ events a (start:a now) [events ..start] :: From c2c2b04b0b96bd2c1be5cf2b71992dbb4341a520 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 8 Mar 2019 13:48:09 -0800 Subject: [PATCH 40/55] better init for ph --- app/ph.hoon | 41 +++++++++++++++++++++++++++++++---------- lib/ph.hoon | 3 ++- sys/vane/gall.hoon | 3 +-- 3 files changed, 34 insertions(+), 13 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 1ddee8e3f..a570df6da 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -47,6 +47,8 @@ $~ -- =, gall +=/ vane-apps=(list term) + ~[%aqua %aqua-ames %aqua-behn %aqua-dill %aqua-eyre] |_ $: hid=bowl state == @@ -266,20 +268,37 @@ /effects/(scot %p her) == :: +:: Start the vane drivers +:: +++ init-vanes + ^- (list move) + %+ murn + `(list term)`[%aqua vane-apps] + |= vane-app=term + ^- (unit move) + =/ app-started + .^(? %gu /(scot %p our.hid)/[vane-app]/(scot %da now.hid)) + ?: app-started + ~ + `[ost.hid %poke /start [our.hid %hood] %drum-start %home vane-app] +:: +:: Restart the vane drivers' subscriptions +:: +++ subscribe-vanes + ^- (list move) + %+ turn + vane-apps + |= vane-app=term + [ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe] +:: +:: User interface +:: ++ poke-noun |= arg=* ^- (quip move _this) ?+ arg ~|(%bad-noun-arg !!) %init - :_ this - %- zing ^- (list (list move)) - %+ turn - ^- (list term) - ~[%aqua %aqua-ames %aqua-behn %aqua-dill %aqua-eyre] - |= vane-app=term - :~ [ost.hid %poke /start [our.hid %hood] %drum-start %home vane-app] - [ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe] - == + [init-vanes this] :: [%run-test lab=@tas] =/ res=[events=(list ph-event) new-state=raw-test-core] @@ -287,7 +306,7 @@ =. test-cores (~(put by test-cores) lab.arg [ships . ~]:new-state.res) =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) =^ moves-2 this (run-events lab.arg events.res) - [(weld moves-1 moves-2) this] + [:(weld init-vanes subscribe-vanes moves-1 moves-2) this] :: [%print lab=@tas] =/ log effect-log:(~(got by test-cores) lab.arg) @@ -304,6 +323,8 @@ `this == :: +:: Receive effects back from aqua +:: ++ diff-aqua-effects |= [way=wire afs=aqua-effects] ^- (quip move _this) diff --git a/lib/ph.hoon b/lib/ph.hoon index 1def470a6..19ac2634b 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -337,7 +337,8 @@ =. warped (cat 3 '=> . ' .^(@t %cx pax)) :_ ..start %- zing - :~ (dojo her "|mount /={(trip des)}=") + :~ (dojo her "|verb") + (dojo her "|mount /={(trip des)}=") (insert-file her des pax warped) == :: diff --git a/sys/vane/gall.hoon b/sys/vane/gall.hoon index a8b0fc749..39cccb205 100644 --- a/sys/vane/gall.hoon +++ b/sys/vane/gall.hoon @@ -1363,9 +1363,8 @@ =(~ tyl) =([%$ %da now] lot) =(our his) - (~(has by bum.mast.all) syd) == - ``[%null !>(~)] + ``[%noun !>((~(has by bum.mast.all) syd))] ?. =(our his) ~ ?. =([%$ %da now] lot) From 18934433eef1535bdfcce0f65fe2833114e79032 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 13 Mar 2019 04:50:56 -0700 Subject: [PATCH 41/55] unclog gall queue --- app/aqua-ames.hoon | 22 +++++++++++++++------- app/aqua.hoon | 3 ++- app/ph.hoon | 21 ++++++++++++++++++++- lib/ph.hoon | 46 +++++++++++++++++++++++----------------------- sys/vane/clay.hoon | 1 + sys/vane/gall.hoon | 14 ++++++++++---- 6 files changed, 71 insertions(+), 36 deletions(-) diff --git a/app/aqua-ames.hoon b/app/aqua-ames.hoon index cb9e86c28..26ff8ab15 100644 --- a/app/aqua-ames.hoon +++ b/app/aqua-ames.hoon @@ -22,20 +22,27 @@ -- =, gall =| moves=(list move) +=| aqua-event-list=(list aqua-event) +=| ships=(list ship) |_ $: bowl state == ++ this . -++ apex %_(this moves ~) -++ abet [(flop moves) this] +++ apex %_(this moves ~, aqua-event-list ~, ships ~) +++ abet + =? this !=(~ aqua-event-list) + %- emit-moves + [ost %poke /aqua-events [our %aqua] %aqua-events aqua-event-list]~ + :: ~? !?=(~ moves) [%aqua-ames-moves (lent moves)] + [moves this] +:: ++ emit-moves |= ms=(list move) - %_(this moves (weld ms moves)) + %_(this moves (weld moves ms)) :: ++ emit-aqua-events |= aes=(list aqua-event) - %- emit-moves - [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ + %_(this aqua-event-list (weld aqua-event-list aes)) :: ++ poke-aqua-vane-control |= command=?(%subscribe %unsubscribe) @@ -65,9 +72,10 @@ |= [way=wire %send lan=lane:ames pac=@] ^+ this =/ hear [//newt/0v1n.2m9vh %hear lan pac] - %- emit-aqua-events - %+ turn + =? ships =(~ ships) .^((list ship) %gx /(scot %p our)/aqua/(scot %da now)/ships/noun) + %- emit-aqua-events + %+ turn ships |= who=ship [%event who hear] -- diff --git a/app/aqua.hoon b/app/aqua.hoon index 94a81f798..c1ef5b040 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -458,7 +458,8 @@ (pe ~bud) :: XX why ~bud? need an example :: %event - ~& ev=-.q.ue.ae + ~? !?=(?(%belt %hear) -.q.ue.ae) + raw-event=[who.ae -.q.ue.ae] (push-events:(pe who.ae) [ue.ae]~) == :: diff --git a/app/ph.hoon b/app/ph.hoon index a570df6da..e174236f9 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -291,6 +291,18 @@ |= vane-app=term [ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe] :: +:: Pause all existing ships +:: +++ pause-fleet + ^- (list move) + :_ ~ + :* ost.hid %poke /pause-fleet [our.hid %aqua] %aqua-events + %+ turn + .^((list ship) %gx /(scot %p our.hid)/aqua/(scot %da now.hid)/ships/noun) + |= who=ship + [%pause-events who] + == +:: :: User interface :: ++ poke-noun @@ -306,7 +318,7 @@ =. test-cores (~(put by test-cores) lab.arg [ships . ~]:new-state.res) =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) =^ moves-2 this (run-events lab.arg events.res) - [:(weld init-vanes subscribe-vanes moves-1 moves-2) this] + [:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this] :: [%print lab=@tas] =/ log effect-log:(~(got by test-cores) lab.arg) @@ -367,4 +379,11 @@ ~& [%ph-bad-peer-effects pax] `this `this +:: +:: Subscription cancelled +:: +++ pull + |= pax=path + ~& [%ph-unsubscribed pax ost.hid] + `+>.$ -- diff --git a/lib/ph.hoon b/lib/ph.hoon index 19ac2634b..1bb543f1e 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -124,11 +124,15 @@ |= ~ [%test-done &]~ :: +++ is-ergo + |= [who=ship her=ship uf=unix-effect] + ?& =(who her) + ?=(%ergo -.q.uf) + == +:: ++ on-ergo - |= [who=ship her=ship uf=unix-effect fun=$-($~ (list ph-event))] - ?. =(who her) - ~ - ?. ?=(%ergo -.q.uf) + |= [who=ship her=ship uf=unix-effect fun=$-($~ (list ph-event))] + ?. (is-ergo who her uf) ~ (fun) :: @@ -327,35 +331,31 @@ |= [her=ship des=desk] %+ porcelain-test (cat 3 'touch-file-' (scot %p her)) - =| warped=@t + =| [warped=@t change-sent=_|] |% ++ start |= now=@da ^- (pair (list ph-event) _..start) - =/ pax - /(scot %p our)/home/(scot %da now)/sur/aquarium/hoon - =. warped (cat 3 '=> . ' .^(@t %cx pax)) :_ ..start - %- zing - :~ (dojo her "|verb") - (dojo her "|mount /={(trip des)}=") - (insert-file her des pax warped) - == + (dojo her "|mount /={(trip des)}=") :: ++ route |= [now=@da who=ship uf=unix-effect] ^- (quip ph-event _..start) + ?. (is-ergo her who uf) + `..start + ?. change-sent + =/ host-pax + /(scot %p our)/home/(scot %da now)/sur/aquarium/hoon + =. warped (cat 3 '=> . ' .^(@t %cx host-pax)) + =. change-sent & + [(insert-file her des host-pax warped) ..start] :_ ..start - %- zing - :~ %- on-ergo - :^ her who uf - |= $~ - =/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun - ?: =(warped (need (scry-aqua (unit @) now pax))) - [%test-done &]~ - ~& %not-done-yet - ~ - == + =/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun + ?: =(warped (need (scry-aqua (unit @) now pax))) + [%test-done &]~ + ~& %not-done-yet + ~ -- :: :: Checks that /sur/aquarium/hoon has been touched, as by ++touch-file diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 53505c1f6..164b67432 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -3773,6 +3773,7 @@ =/ wait=(list move) ?^(cue.ruf ~ [hen %pass /queued-request %b %wait now]~) =. cue.ruf (~(put to cue.ruf) [hen req]) + :: ~& [%enqueueing (turn ~(tap to cue.ruf) head)] [wait ..^$] (handle-task hen req) :: diff --git a/sys/vane/gall.hoon b/sys/vane/gall.hoon index 39cccb205..80519cf1c 100644 --- a/sys/vane/gall.hoon +++ b/sys/vane/gall.hoon @@ -728,10 +728,16 @@ ++ ap-fill :: add to queue ^- {? _.} =+ suy=(fall (~(get by qel.ged) ost) 0) - ?: =(20 suy) - [%| +] - :: ~? !=(20 suy) [%ap-fill-add [[our dap] q.q.pry ost] +(suy)] - [%& +(qel.ged (~(put by qel.ged) ost +(suy)))] + =/ subscriber-ship p:(~(got by sup.ged) ost) + ?: &(=(20 suy) !=(our subscriber-ship)) + ~& [%gall-pulling-20 ost (~(get by sup.ged) ost) (~(get by r.zam) ost)] + [%| ..ap-fill] + :: ~& :* %gall-pushing-20 + :: ost + :: suy=suy + :: (~(get by r.zam) ost) + :: == + [%& ..ap-fill(qel.ged (~(put by qel.ged) ost +(suy)))] :: ++ ap-find :: general arm ~/ %ap-find From 3d64641da76aed21122b57710744c1f8208305b2 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 13 Mar 2019 05:04:54 -0700 Subject: [PATCH 42/55] make gen/aqua/file compile --- gen/aqua/file.hoon | 3 ++- sys/vane/clay.hoon | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/gen/aqua/file.hoon b/gen/aqua/file.hoon index bcc9d28a4..f9d3c7283 100644 --- a/gen/aqua/file.hoon +++ b/gen/aqua/file.hoon @@ -3,6 +3,7 @@ :- %say |= [* [her=ship pax=path] ~] :- %aqua-events :_ ~ -:+ %event her +:+ %event her +?> ?=([@ @ @ *] pax) =/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] [//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~]~ diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 164b67432..e5e480410 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -4249,7 +4249,7 @@ =/ queued-duct=duct -.queued =/ queued-task=task:able +.queued :: - :: ~& :* %x-clay-waking + :: ~& :* %clay-waking :: queued-duct :: hen :: ?~(cue.ruf /empty -:(need ~(top to cue.ruf))) From aba533998f0206462c14bb12c7d01753de15676f Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 20 Mar 2019 13:57:24 -0700 Subject: [PATCH 43/55] cleanup --- app/aqua.hoon | 2 +- app/ph.hoon | 221 +++++++++++++++++++++++--------------------------- lib/ph.hoon | 101 +++++++++++++---------- 3 files changed, 162 insertions(+), 162 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index c1ef5b040..540a4f984 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -260,7 +260,7 @@ ?: &(?=(^ next-events.q.i.pers) processing-events.q.i.pers) `p.i.pers $(pers t.pers) - ~& plowing=who + ~? aqua-debug=| plowing=who ?~ who this =. this abet-pe:plow:(pe u.who) diff --git a/app/ph.hoon b/app/ph.hoon index e174236f9..2fb24f911 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -54,114 +54,106 @@ == ++ this . ++ test-lib ~(. ^test-lib our.hid) -++ install-tests - ^+ this - =. raw-test-cores - ~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid)) - =, test-lib - %- malt - ^- (list (pair term raw-test-core)) - :~ - :- %add - ^- raw-test-core - |% - ++ label %add - ++ ships ~[~bud] - ++ start - |= now=@da - ^- (pair (list ph-event) _..start) - :_ ..start - %- zing - :~ (init ~bud ~) - (dojo ~bud "[%test-result (add 2 3)]") - == - :: - ++ route - |= [now=@da who=ship uf=unix-effect] - ^- [? (quip ph-event _..start)] - :- & - :_ ..start - (expect-dojo-output ~bud who uf "[%test-result 5]") - -- - :: - :- %hi - ^- raw-test-core - |% - ++ label %hi - ++ ships ~[~bud ~dev] - ++ start - |= now=@da - ^- (pair (list ph-event) _..start) - :_ ..start - %- zing - :~ (init ~bud ~) - (init ~dev ~) - (dojo ~bud "|hi ~dev") - == - :: - ++ route - |= [now=@da who=ship uf=unix-effect] - ^- [? (quip ph-event _..start)] - :- & - :_ ..start - (expect-dojo-output ~bud who uf "hi ~dev successful") - -- - :: - [%headstart-bud (galaxy ~bud)] - :: - :- %composed-child-boot - %+ compose-tests (planet ~linnup-torsyx) - %+ porcelain-test %composed-child-boot - |% - ++ start - |= now=@da - [(dojo ~linnup-torsyx "|hi ~bud") ..start] - :: - ++ route - |= [now=@da who=ship uf=unix-effect] - ^- (quip ph-event _..start) - :_ ..start - %- on-dojo-output - :^ ~linnup-torsyx who uf - :- "hi ~bud successful" - |= ~ - [%test-done &]~ - -- +:: +:: Tests that will be run automatically with :ph %run-all-tests +:: +++ auto-tests + =, test-lib + %- malt + ^- (list (pair term raw-test-core)) + :~ + :- %boot-bud + (galaxy ~bud) + :: + :- %add + ^- raw-test-core + %+ compose-tests (galaxy ~bud) + %+ stateless-test + %add + |% + ++ start + |= now=@da + (dojo ~bud "[%test-result (add 2 3)]") :: - :- %composed-child-boot-2 + ++ route + |= [now=@da who=ship uf=unix-effect] + (expect-dojo-output ~bud who uf "[%test-result 5]") + -- + :: + :- %hi + %+ compose-tests %+ compose-tests - %+ compose-tests (planet ~mitnep-todsut) - (planet ~haplun-todtus) - %+ porcelain-test - %composed-child-boot-2 - |% - ++ start - |= now=@da - [(dojo ~haplun-todtus "|hi ~bud") ..start] - :: - ++ route - |= [now=@da who=ship uf=unix-effect] - ^- (quip ph-event _..start) - :_ ..start - %- on-dojo-output - :^ ~haplun-todtus who uf - :- "hi ~bud successful" - |= ~ - [%test-done &]~ - -- + (galaxy ~bud) + (galaxy ~dev) + %+ stateless-test + %hi + |% + ++ start + |= now=@da + (dojo ~bud "|hi ~dev") :: - :- %change-file - %+ compose-tests (galaxy ~bud) - (touch-file ~bud %home) + ++ route + |= [now=@da who=ship uf=unix-effect] + (expect-dojo-output ~bud who uf "hi ~dev successful") + -- + :: + :- %boot-planet + (planet ~linnup-torsyx) + :: + :- %hi-grandparent + %+ compose-tests (planet ~linnup-torsyx) + %+ stateless-test + %hi-grandparent + |% + ++ start + |= now=@da + (dojo ~linnup-torsyx "|hi ~bud") :: - :- %child-sync - %+ compose-tests - %+ compose-tests - (star ~marbud) - (touch-file ~bud %base) - (check-file-touched ~marbud %home) + ++ route + |= [now=@da who=ship uf=unix-effect] + (expect-dojo-output ~linnup-torsyx who uf "hi ~bud successful") + -- + :: + :- %second-cousin-hi + %+ compose-tests + %+ compose-tests (planet ~mitnep-todsut) + (planet ~haplun-todtus) + %+ stateless-test + %second-cousin-hi + |% + ++ start + |= now=@da + (dojo ~haplun-todtus "|hi ~bud") :: - :- %boot-azimuth + ++ route + |= [now=@da who=ship uf=unix-effect] + (expect-dojo-output ~haplun-todtus who uf "hi ~bud successful") + -- + :: + :- %change-file + %+ compose-tests (galaxy ~bud) + (touch-file ~bud %home) + :: + :- %child-sync + %+ compose-tests + %+ compose-tests + (star ~marbud) + (touch-file ~bud %base) + (check-file-touched ~marbud %home) + == +:: +:: Tests that will not be run automatically. +:: +:: Some valid reasons for not running a test automatically: +:: - Nondeterministic +:: - Depends on external services +:: - Is very slow +:: +++ manual-tests + =, test-lib + %- malt + ^- (list (pair term raw-test-core)) + :~ :- %boot-from-azimuth %+ compose-tests %+ compose-tests (raw-ship ~bud `(dawn:azimuth ~bud)) @@ -170,27 +162,18 @@ :: :~ :: == *raw-test-core - :: - :- %individual-breach - *raw-test-core - :: - :: (init ~zod) - :: (init ~marzod) - :: wait for sync to finish - :: cycle ~zod keys - :: verify it sunk - :: kill ~zod - :: (init ~zod) w/new keys - :: change file on ~zod - :: wait for sync to finish - :: verify file has changed on ~marzod - :: - == + == +:: +++ install-tests + ^+ this + =. raw-test-cores + (~(uni by auto-tests) manual-tests) this :: ++ prep |= old=(unit [@ tests=* rest=*]) ^- (quip move _this) + ~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid)) =. this install-tests ?~ old `this diff --git a/lib/ph.hoon b/lib/ph.hoon index 1bb543f1e..4becf965e 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -30,6 +30,8 @@ ++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start))]) -- :: +:: XXX doc +:: ++ porcelain-test-core $_ ^? |% @@ -42,11 +44,22 @@ ++ route |~([now=@da ship unix-effect] *(quip ph-event _^?(..start))) -- :: +:: XXX doc +:: +++ stateless-test-core + $_ ^? + |% + ++ start |~(now=@da *(list ph-event)) + ++ route |~([now=@da ship unix-effect] *(list ph-event)) + -- +:: ++ ph-event $% [%test-done p=?] aqua-event == :: +:: XXX doc +:: ++ porcelain-test |= [label=@ta porcelain=porcelain-test-core] ^- raw-test-core @@ -64,6 +77,23 @@ [& events ..start] -- :: +:: XXX doc +:: +++ stateless-test + |= [label=@tas stateless=stateless-test-core] + %+ porcelain-test + label + ^- porcelain-test-core + |% + ++ start + |= now=@da + [(start:stateless now) ..start] + :: + ++ route + |= args=[@da ship unix-effect] + [(route:stateless args) ..start] + -- +:: ++ send-events-to |= [who=ship what=(list unix-event)] ^- (list ph-event) @@ -100,28 +130,23 @@ [//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~] == :: -++ on-dojo-output - |= [who=ship her=ship uf=unix-effect what=tape fun=$-($~ (list ph-event))] - ^- (list ph-event) - ?. =(who her) - ~ - ?. ?=(%blit -.q.uf) - ~ - ?. %+ lien p.q.uf +++ is-dojo-output + |= [who=ship her=ship uf=unix-effect what=tape] + ?& =(who her) + ?=(%blit -.q.uf) + :: + %+ lien p.q.uf |= =blit:dill ?. ?=(%lin -.blit) | !=(~ (find what p.blit)) - ~ - (fun) + == :: ++ expect-dojo-output |= [who=ship her=ship uf=unix-effect what=tape] ^- (list ph-event) - %- on-dojo-output - :^ who her uf - :- what - |= ~ + ?. (is-dojo-output who her uf what) + ~ [%test-done &]~ :: ++ is-ergo @@ -281,16 +306,14 @@ :: second. :: :~ - %- on-dojo-output - :^ her who uf - :- "+ /{(scow %p her)}/base/2/web/testing/udon" - |= ~ + ?. %^ is-dojo-output her who :- uf + "+ /{(scow %p her)}/base/2/web/testing/udon" + ~ [%test-done &]~ :: - %- on-dojo-output - :^ her who uf - :- "is your neighbor" - |= ~ + ?. %^ is-dojo-output her who :- uf + "is your neighbor" + ~ [%test-done &]~ == -- @@ -354,7 +377,6 @@ =/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun ?: =(warped (need (scry-aqua (unit @) now pax))) [%test-done &]~ - ~& %not-done-yet ~ -- :: @@ -374,32 +396,27 @@ :: ergos (and dojo because we can't guarantee an ergo if the desk :: is already mounted) :: - ~& %mounting [(dojo her "|mount /={(trip des)}=") ..start] :: ++ route |= [now=@da who=ship uf=unix-effect] ^- (quip ph-event _..start) - =/ cb - |= $~ - ~& %cbing - =/ pax /home/(scot %da now)/sur/aquarium/hoon - =/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax))) - =/ aqua-pax - ;: weld - /i/(scot %p her) - pax(- des) - /noun + :_ ..start + ?. ?| (is-ergo her who uf) + (is-dojo-output her who uf ">=") == - ?: =(warped (need (scry-aqua (unit @) now aqua-pax))) - [%test-done &]~ - ~& %not-done-yet ~ - :_ ..start - %- zing - :~ (on-ergo her who uf cb) - (on-dojo-output her who uf ">=" cb) - == + =/ pax /home/(scot %da now)/sur/aquarium/hoon + =/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax))) + =/ aqua-pax + ;: weld + /i/(scot %p her) + pax(- des) + /noun + == + ?: =(warped (need (scry-aqua (unit @) now aqua-pax))) + [%test-done &]~ + ~ -- :: :: Reload vane from filesystem From 4fc3f637912b2d2a04ef62676c5a8e30da39f31b Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 20 Mar 2019 14:38:42 -0700 Subject: [PATCH 44/55] move test cores into the iron age --- app/aqua.hoon | 2 +- app/ph.hoon | 24 +++++++--------- lib/ph.hoon | 77 ++++++++++++++++++++++++--------------------------- 3 files changed, 47 insertions(+), 56 deletions(-) diff --git a/app/aqua.hoon b/app/aqua.hoon index 540a4f984..7a7d7a347 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -458,7 +458,7 @@ (pe ~bud) :: XX why ~bud? need an example :: %event - ~? !?=(?(%belt %hear) -.q.ue.ae) + ~? &(aqua-debug=| !?=(?(%belt %hear) -.q.ue.ae)) raw-event=[who.ae -.q.ue.ae] (push-events:(pe who.ae) [ue.ae]~) == diff --git a/app/ph.hoon b/app/ph.hoon index 2fb24f911..70517068b 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -70,13 +70,12 @@ %+ compose-tests (galaxy ~bud) %+ stateless-test %add - |% + |_ now=@da ++ start - |= now=@da (dojo ~bud "[%test-result (add 2 3)]") :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] (expect-dojo-output ~bud who uf "[%test-result 5]") -- :: @@ -87,13 +86,12 @@ (galaxy ~dev) %+ stateless-test %hi - |% + |_ now=@da ++ start - |= now=@da (dojo ~bud "|hi ~dev") :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] (expect-dojo-output ~bud who uf "hi ~dev successful") -- :: @@ -104,13 +102,12 @@ %+ compose-tests (planet ~linnup-torsyx) %+ stateless-test %hi-grandparent - |% + |_ now=@da ++ start - |= now=@da (dojo ~linnup-torsyx "|hi ~bud") :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] (expect-dojo-output ~linnup-torsyx who uf "hi ~bud successful") -- :: @@ -120,13 +117,12 @@ (planet ~haplun-todtus) %+ stateless-test %second-cousin-hi - |% + |_ now=@da ++ start - |= now=@da (dojo ~haplun-todtus "|hi ~bud") :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] (expect-dojo-output ~haplun-todtus who uf "hi ~bud successful") -- :: @@ -297,7 +293,7 @@ :: [%run-test lab=@tas] =/ res=[events=(list ph-event) new-state=raw-test-core] - (start:(~(got by raw-test-cores) lab.arg) now.hid) + ~(start (~(got by raw-test-cores) lab.arg) now.hid) =. test-cores (~(put by test-cores) lab.arg [ships . ~]:new-state.res) =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) =^ moves-2 this (run-events lab.arg events.res) @@ -339,7 +335,7 @@ =. effect-log.u.test-cor [[who i.ufs]:afs effect-log.u.test-cor] =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-cor] - (route:cor.u.test-cor now.hid who.afs i.ufs.afs) + (~(route cor.u.test-cor now.hid) who.afs i.ufs.afs) =. cor.u.test-cor cor =+ $(ufs.afs t.ufs.afs) :+ ?: thru diff --git a/lib/ph.hoon b/lib/ph.hoon index 4becf965e..84a44f520 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -1,14 +1,15 @@ :: :::: /hoon/ph/lib :: +:: XXX should raw-ship and others be stateless-test-core? /- aquarium =, aquarium |% :: Defines a complete integration test. :: ++ raw-test-core - $_ ^? - |% + $_ ^| + |_ now=@da :: :: Unique name, used as a cache label. :: @@ -23,34 +24,34 @@ :: :: Called first to kick off the test. :: - ++ start |~(now=@da *(quip ph-event _^?(..start))) + ++ start *(quip ph-event _^|(..start)) :: :: Called on every effect from a ship. :: - ++ route |~([now=@da ship unix-effect] *[? (quip ph-event _^?(..start))]) + ++ route |~([ship unix-effect] *[? (quip ph-event _^|(..start))]) -- :: :: XXX doc :: ++ porcelain-test-core - $_ ^? - |% + $_ ^| + |_ now=@da :: Called first to kick off the test. :: - ++ start |~(now=@da *(quip ph-event _^?(..start))) + ++ start *(quip ph-event _^|(..start)) :: :: Called on every effect from a ship. :: - ++ route |~([now=@da ship unix-effect] *(quip ph-event _^?(..start))) + ++ route |~([ship unix-effect] *(quip ph-event _^|(..start))) -- :: :: XXX doc :: ++ stateless-test-core - $_ ^? - |% - ++ start |~(now=@da *(list ph-event)) - ++ route |~([now=@da ship unix-effect] *(list ph-event)) + $_ ^| + |_ now=@da + ++ start *(list ph-event) + ++ route |~([ship unix-effect] *(list ph-event)) -- :: ++ ph-event @@ -63,17 +64,16 @@ ++ porcelain-test |= [label=@ta porcelain=porcelain-test-core] ^- raw-test-core - |% + |_ now=@da ++ label ^label ++ ships ~ ++ start - |= now=@da - =^ events porcelain (start:porcelain now) + =^ events porcelain ~(start porcelain now) [events ..start] :: ++ route - |= args=[@da ship unix-effect] - =^ events porcelain (route:porcelain args) + |= args=[ship unix-effect] + =^ events porcelain (~(route porcelain now) args) [& events ..start] -- :: @@ -84,14 +84,13 @@ %+ porcelain-test label ^- porcelain-test-core - |% + |_ now=@da ++ start - |= now=@da - [(start:stateless now) ..start] + [~(start stateless now) ..start] :: ++ route - |= args=[@da ship unix-effect] - [(route:stateless args) ..start] + |= args=[ship unix-effect] + [(~(route stateless now) args) ..start] -- :: ++ send-events-to @@ -228,10 +227,10 @@ [[%test-done |]~ ..filter-a] =. done-with-a & =/ snap-event [%snap-ships label:a ships:a] - =^ events-start b (start:b now) + =^ events-start b ~(start b now) [(welp other-events [snap-event events-start]) ..filter-a] -- - |% + |_ now=@da :: :: Cache lookup label :: @@ -244,7 +243,6 @@ :: Start with start of a :: ++ start - |= now=@da ^- (quip ph-event _..start) =/ have-cache (scry-aqua ? now /fleet-snap/[label:a]/noun) @@ -255,7 +253,7 @@ :: =^ events-start b (start:b now) :: =^ events ..filter-a (filter-a now restore-event events-start) :: [events ..start] - =^ events a (start:a now) + =^ events a ~(start a now) [events ..start] :: :: Keep going on a until it's done. If success, go to b. @@ -266,15 +264,15 @@ :: like that. :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] ^- [? (quip ph-event _..start)] ?: done-with-a =+ ^- [thru=? events=(list ph-event) cor=raw-test-core] - (route:b now who uf) + (~(route b now) who uf) =. b cor [thru events ..start] =+ ^- [thru=? events=(list ph-event) cor=raw-test-core] - (route:a now who uf) + (~(route a now) who uf) =. a cor =^ events ..filter-a (filter-a now events) [thru events ..start] @@ -287,16 +285,15 @@ ++ raw-ship |= [her=ship keys=(unit dawn-event)] ^- raw-test-core - |% + |_ now=@da ++ label :((cury cat 3) 'init-' (scot %p her) '-' (scot %uw (mug (fall keys *dawn-event)))) ++ ships ~[her] ++ start - |= now=@da ^- (quip ph-event _..start) [(init her keys) ..start] :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] ^- [? (quip ph-event _..start)] :- & :_ ..start @@ -355,15 +352,15 @@ %+ porcelain-test (cat 3 'touch-file-' (scot %p her)) =| [warped=@t change-sent=_|] - |% + ^- porcelain-test-core + |_ now=@da ++ start - |= now=@da ^- (pair (list ph-event) _..start) :_ ..start (dojo her "|mount /={(trip des)}=") :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] ^- (quip ph-event _..start) ?. (is-ergo her who uf) `..start @@ -388,9 +385,8 @@ |= [her=ship des=desk] %+ porcelain-test (cat 3 'check-file-touched-' (scot %p her)) - |% + |_ now=@da ++ start - |= now=@da :: mounting is not strictly necessary since we check via scry, :: but this way we don't have to check on every event, just :: ergos (and dojo because we can't guarantee an ergo if the desk @@ -399,7 +395,7 @@ [(dojo her "|mount /={(trip des)}=") ..start] :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] ^- (quip ph-event _..start) :_ ..start ?. ?| (is-ergo her who uf) @@ -427,9 +423,8 @@ |= [her=ship vane=term] %+ porcelain-test :((cury cat 3) 'reload-vane-' (scot %p her) '-' vane) - |% + |_ now=@da ++ start - |= now=@da ^- (pair (list ph-event) _..start) =/ pax /(scot %p our)/home/(scot %da now)/sys/vane/[vane]/hoon @@ -441,7 +436,7 @@ == :: ++ route - |= [now=@da who=ship uf=unix-effect] + |= [who=ship uf=unix-effect] ^- (quip ph-event _..start) `..start -- From 0dc6e6990e328d5fdd4fd3fbcb6fb29976b1dd74 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 20 Mar 2019 14:52:05 -0700 Subject: [PATCH 45/55] cleanup --- lib/ph.hoon | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/lib/ph.hoon b/lib/ph.hoon index 84a44f520..11dcdc8df 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -383,7 +383,7 @@ :: ++ check-file-touched |= [her=ship des=desk] - %+ porcelain-test + %+ stateless-test (cat 3 'check-file-touched-' (scot %p her)) |_ now=@da ++ start @@ -392,12 +392,11 @@ :: ergos (and dojo because we can't guarantee an ergo if the desk :: is already mounted) :: - [(dojo her "|mount /={(trip des)}=") ..start] + (dojo her "|mount /={(trip des)}=") :: ++ route |= [who=ship uf=unix-effect] - ^- (quip ph-event _..start) - :_ ..start + ^- (list ph-event) ?. ?| (is-ergo her who uf) (is-dojo-output her who uf ">=") == @@ -421,14 +420,13 @@ :: ++ reload-vane |= [her=ship vane=term] - %+ porcelain-test + %+ stateless-test :((cury cat 3) 'reload-vane-' (scot %p her) '-' vane) |_ now=@da ++ start - ^- (pair (list ph-event) _..start) + ^- (list ph-event) =/ pax /(scot %p our)/home/(scot %da now)/sys/vane/[vane]/hoon - :_ ..start %- zing :~ (dojo her "|mount /=home=") (insert-file her %home pax .^(@t %cx pax)) @@ -437,8 +435,7 @@ :: ++ route |= [who=ship uf=unix-effect] - ^- (quip ph-event _..start) - `..start + ~ -- :: ++ scry-aqua From e8c7c169345d7a177941831eed839f42ed1a3be4 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 20 Mar 2019 17:37:05 -0700 Subject: [PATCH 46/55] add test queue and result summary --- app/aqua-behn.hoon | 6 +- app/aqua.hoon | 6 +- app/ph.hoon | 135 ++++++++++++++++++++++++++++++--------------- lib/ph.hoon | 14 ++--- 4 files changed, 101 insertions(+), 60 deletions(-) diff --git a/app/aqua-behn.hoon b/app/aqua-behn.hoon index d483acb88..6763bd02c 100644 --- a/app/aqua-behn.hoon +++ b/app/aqua-behn.hoon @@ -103,20 +103,20 @@ ++ set-timer |= tim=@da =. tim +(tim) :: nobody's perfect - ~& [who=who %setting-timer tim] + ~? debug=| [who=who %setting-timer tim] =. next-timer `tim =. this (emit-moves [ost %wait /(scot %p who) tim]~) ..abet-pe :: ++ cancel-timer - ~& [who=who %cancell-timer (need next-timer)] + ~? debug=| [who=who %cancell-timer (need next-timer)] =. this (emit-moves [ost %rest /(scot %p who) (need next-timer)]~) =. next-timer ~ ..abet-pe :: ++ take-wake |= [way=wire ~] - ~& [who=who %aqua-behn-wake now] + ~? debug=| [who=who %aqua-behn-wake now] =. next-timer ~ =. this %- emit-aqua-events diff --git a/app/aqua.hoon b/app/aqua.hoon index 7a7d7a347..0c15a412b 100644 --- a/app/aqua.hoon +++ b/app/aqua.hoon @@ -131,11 +131,9 @@ ?> ?=(%0 -.res) =/ peek p.res =/ pax (path p) - ~& [who=who %peeking-in tym pax] ?> ?=([@ @ @ @ *] pax) =. i.t.t.t.pax (scot %da tym) =/ pek (slum peek [tym pax]) - ~& [who=who %peeked] pek :: :: Wish @@ -166,7 +164,7 @@ =. ..abet-pe =/ sof ((soft unix-effect) i.effects) ?~ sof - ~& [who=who %unknown-effect i.effects] + ~? aqua-debug=| [who=who %unknown-effect i.effects] ..abet-pe (publish-effect u.sof) $(effects t.effects) @@ -500,7 +498,6 @@ ++ peek-x-fleet-snap |= pax=path ^- (unit (unit [%noun noun])) - ~& [%peeking pax] ?. ?=([@ ~] pax) ~ :^ ~ ~ %noun @@ -511,7 +508,6 @@ ++ peek-x-i |= pax=path ^- (unit (unit [%noun noun])) - ~& [%peeking-i pax] ?. ?=([@ @ @ *] pax) ~ =/ who (slav %p i.pax) diff --git a/app/ph.hoon b/app/ph.hoon index 70517068b..03f76ff42 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -33,7 +33,7 @@ +$ state $: %0 raw-test-cores=(map term raw-test-core) - test-cores=(map term test-core-state) + test-core=(unit test-core-state) other-state == :: @@ -44,7 +44,9 @@ == :: +$ other-state - $~ + $: test-qeu=(qeu term) + results=(list (pair term ?)) + == -- =, gall =/ vane-apps=(list term) @@ -59,7 +61,6 @@ :: ++ auto-tests =, test-lib - %- malt ^- (list (pair term raw-test-core)) :~ :- %boot-bud @@ -119,11 +120,11 @@ %second-cousin-hi |_ now=@da ++ start - (dojo ~haplun-todtus "|hi ~bud") + (dojo ~haplun-todtus "|hi ~mitnep-todsut") :: ++ route |= [who=ship uf=unix-effect] - (expect-dojo-output ~haplun-todtus who uf "hi ~bud successful") + (expect-dojo-output ~haplun-todtus who uf "hi ~mitnep-todsut successful") -- :: :- %change-file @@ -147,7 +148,6 @@ :: ++ manual-tests =, test-lib - %- malt ^- (list (pair term raw-test-core)) :~ :- %boot-from-azimuth %+ compose-tests @@ -163,20 +163,21 @@ ++ install-tests ^+ this =. raw-test-cores - (~(uni by auto-tests) manual-tests) + (~(uni by (malt auto-tests)) (malt manual-tests)) this :: ++ prep |= old=(unit [@ tests=* rest=*]) ^- (quip move _this) - ~& jael=.^(noun %j /(scot %p our.hid)/code/(scot %da now.hid)/(scot %p our.hid)) + ~& prep=%ph =. this install-tests - ?~ old - `this - =/ new ((soft other-state) rest.u.old) - ?~ new - `this - `this(+<+>+> u.new) + `this + :: ?~ old + :: `this + :: =/ new ((soft other-state) rest.u.old) + :: ?~ new + :: `this + :: `this(+<+>+> u.new) :: ++ publish-aqua-effects |= afs=aqua-effects @@ -194,32 +195,34 @@ ?: =(~ what) `this =/ res - |- ^- (each (list aqua-event) $~) + |- ^- (each (list aqua-event) ?) ?~ what [%& ~] ?: ?=(%test-done -.i.what) - ~& ?~(p.i.what "TEST SUCCESSFUL" "TEST FAILED") - [%| ~] + ~& ?~ p.i.what + "TEST {(trip lab)} SUCCESSFUL" + "TEST {(trip lab)} FAILED" + [%| p.i.what] =/ nex $(what t.what) ?: ?=(%| -.nex) nex [%& `aqua-event`i.what p.nex] ?: ?=(%| -.res) - (cancel-test lab) + =^ moves-1 this (finish-test lab p.res) + =^ moves-2 this run-test + [(weld moves-1 moves-2) this] [[ost.hid %poke /running [our.hid %aqua] %aqua-events p.res]~ this] :: :: Cancel subscriptions to ships :: -++ cancel-test - |= lab=term +++ finish-test + |= [lab=term success=?] ^- (quip move _this) - =/ test (~(get by test-cores) lab) - ?~ test + ?~ test-core `this - =. test-cores (~(del by test-cores) lab) - :_ this + :_ this(test-core ~, results [[lab success] results]) %- zing - %+ turn hers.u.test + %+ turn hers.u.test-core |= her=ship ^- (list move) :~ [ost.hid %pull /[lab]/(scot %p her) [our.hid %aqua] ~] @@ -232,6 +235,42 @@ == == :: +:: XXX doc +:: +++ run-test + ^- (quip move _this) + ?^ test-core + `this + ?: =(~ test-qeu) + ?~ results + `this + =/ throw-away print-results + `this(results ~) + =^ lab test-qeu ~(get to test-qeu) + ~& [running-test=lab test-qeu] + =/ res=[events=(list ph-event) new-state=raw-test-core] + ~(start (~(got by raw-test-cores) lab) now.hid) + => .(test-core `(unit test-core-state)`test-core) + =. test-core `[ships . ~]:new-state.res + =^ moves-1 this (subscribe-to-effects lab ships.new-state.res) + =^ moves-2 this (run-events lab events.res) + [:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this] +:: +:: +:: +++ print-results + ~& "TEST REPORT:" + =/ throw-away + %+ turn + results + |= [lab=term success=?] + ~& "{?:(success "SUCCESS" "FAILURE")}: {(trip lab)}" + ~ + ~& ?: (levy results |=([term s=?] s)) + "ALL TESTS SUCCEEDED" + "FAILURES" + ~ +:: :: Should check whether we're already subscribed :: ++ subscribe-to-effects @@ -290,17 +329,25 @@ ?+ arg ~|(%bad-noun-arg !!) %init [init-vanes this] + :: + %run-all-tests + =. test-qeu + %- ~(gas to test-qeu) + (turn auto-tests head) + run-test :: [%run-test lab=@tas] - =/ res=[events=(list ph-event) new-state=raw-test-core] - ~(start (~(got by raw-test-cores) lab.arg) now.hid) - =. test-cores (~(put by test-cores) lab.arg [ships . ~]:new-state.res) - =^ moves-1 this (subscribe-to-effects lab.arg ships.new-state.res) - =^ moves-2 this (run-events lab.arg events.res) - [:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this] + ?. (~(has by raw-test-cores) lab.arg) + ~& [%no-test lab.arg] + `this + =. test-qeu (~(put to test-qeu) lab.arg) + run-test + :: + %cancel-test + !! :: - [%print lab=@tas] - =/ log effect-log:(~(got by test-cores) lab.arg) + %print + =/ log effect-log:(need test-core) ~& lent=(lent log) ~& %+ roll log |= [[who=ship uf=unix-effect] ~] @@ -322,29 +369,28 @@ :: ~& [%diff-aqua-effect way who.afs] ?> ?=([@tas @ ~] way) =/ lab i.way - =/ test-cor (~(get by test-cores) lab) - ?~ test-cor + ?~ test-core ~& [%ph-dropping lab] `this =+ |- ^- $: thru-effects=(list unix-effect) events=(list ph-event) - cor=_u.test-cor + cor=_u.test-core == ?~ ufs.afs - [~ ~ u.test-cor] - =. effect-log.u.test-cor - [[who i.ufs]:afs effect-log.u.test-cor] - =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-cor] - (~(route cor.u.test-cor now.hid) who.afs i.ufs.afs) - =. cor.u.test-cor cor + [~ ~ u.test-core] + =. effect-log.u.test-core + [[who i.ufs]:afs effect-log.u.test-core] + =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-core] + (~(route cor.u.test-core now.hid) who.afs i.ufs.afs) + =. cor.u.test-core cor =+ $(ufs.afs t.ufs.afs) :+ ?: thru [i.ufs.afs thru-effects] thru-effects (weld events-1 events) cor - =. u.test-cor cor - =. test-cores (~(put by test-cores) lab u.test-cor) + =. test-core `cor + => .(test-core `(unit test-core-state)`test-core) =/ moves-1 (publish-aqua-effects who.afs thru-effects) =^ moves-2 this (run-events lab events) [(weld moves-1 moves-2) this] @@ -363,6 +409,5 @@ :: ++ pull |= pax=path - ~& [%ph-unsubscribed pax ost.hid] `+>.$ -- diff --git a/lib/ph.hoon b/lib/ph.hoon index 11dcdc8df..9f2ecd00b 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -246,13 +246,13 @@ ^- (quip ph-event _..start) =/ have-cache (scry-aqua ? now /fleet-snap/[label:a]/noun) - :: ?: have-cache - :: ~& [%caching-in label:a label] - :: =. done-with-a & - :: =/ restore-event [%restore-snap label:a] - :: =^ events-start b (start:b now) - :: =^ events ..filter-a (filter-a now restore-event events-start) - :: [events ..start] + ?: have-cache + ~& [%caching-in label:a label] + =. done-with-a & + =/ restore-event [%restore-snap label:a] + =^ events-start b ~(start b now) + =^ events ..filter-a (filter-a now restore-event events-start) + [events ..start] =^ events a ~(start a now) [events ..start] :: From 7edcbf71f3474190c1b94d91396410fd0847cdd4 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Wed, 20 Mar 2019 17:45:36 -0700 Subject: [PATCH 47/55] add ability to cancel test --- app/ph.hoon | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 03f76ff42..5723f3ee8 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -343,8 +343,11 @@ =. test-qeu (~(put to test-qeu) lab.arg) run-test :: - %cancel-test - !! + %cancel + =^ moves-1 this (finish-test %last |) + =. test-qeu ~ + =^ moves-2 this run-test + [:(weld moves-1 moves-2) this] :: %print =/ log effect-log:(need test-core) From 154a726ba78ae99fac4273d7dd123d5df8700d4a Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 22 Mar 2019 17:18:54 -0700 Subject: [PATCH 48/55] clean and doc --- app/ph.hoon | 65 ++++++++++++++++++++++++++++++++++++++++++++-- lib/hood/drum.hoon | 8 +++--- lib/hood/helm.hoon | 3 +-- lib/ph.hoon | 60 ++++++++++++++++++++++++++++-------------- sys/arvo.hoon | 1 - 5 files changed, 109 insertions(+), 28 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 5723f3ee8..3182e2dae 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -158,6 +158,67 @@ :: :~ :: == *raw-test-core + :: + :- %simple-add + %+ compose-tests (galaxy ~bud) + %+ stateless-test + %add + ^- stateless-test-core + |_ now=@da + ++ start + =/ command "[%test-result (add 2 3)]" + :~ [%event ~bud //term/1 %belt %txt ((list @c) command)] + [%event ~bud //term/1 %belt %ret ~] + == + :: + ++ route + |= [who=ship uf=unix-effect] + ?. (is-dojo-output ~bud who uf "[%test-result 5]") + ~ + [%test-done &]~ + -- + :: + :- %count + %+ compose-tests (galaxy ~bud) + %+ porcelain-test + %state + =| count=@ + |_ now=@da + ++ start + ^- (quip ph-event _..start) + [(dojo ~bud "\"count: {}\"") ..start] + :: + ++ route + |= [who=ship uf=unix-effect] + ^- (quip ph-event _..start) + ?. (is-dojo-output ~bud who uf "\"count: {}\"") + [~ ..start] + ?: (gte count 10) + [[%test-done &]~ ..start] + =. count +(count) + start + -- + :: + :- %break-behn + %+ compose-tests + %+ compose-tests + (galaxy ~bud) + (galaxy ~dev) + ^- raw-test-core + |_ now=@da + ++ label %break-behn + ++ ships ~ + ++ start + [(dojo ~bud "|hi ~dev") ..start] + :: + ++ route + |= [who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] + ?: ?=(%doze -.q.uf) + [| ~ ..start] + :- & :_ ..start + (expect-dojo-output ~bud who uf "hi ~dev successful") + -- == :: ++ install-tests @@ -235,7 +296,7 @@ == == :: -:: XXX doc +:: Start another test if one is in the queue :: ++ run-test ^- (quip move _this) @@ -256,7 +317,7 @@ =^ moves-2 this (run-events lab events.res) [:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this] :: -:: +:: Print results with ~& :: ++ print-results ~& "TEST REPORT:" diff --git a/lib/hood/drum.hoon b/lib/hood/drum.hoon index ac67177ff..7293ea83a 100644 --- a/lib/hood/drum.hoon +++ b/lib/hood/drum.hoon @@ -80,11 +80,11 @@ :: ?: ?=($pawn myr) [[%base %collections] [%base %hall] [%base %talk] [%base %dojo] ~] - :~ :: [%home %collections] - :: [%home %acme] - :: [%home %dns] + :~ [%home %collections] + [%home %acme] + [%home %dns] [%home %dojo] - :: [%home %hall] + [%home %hall] [%home %talk] == :: diff --git a/lib/hood/helm.hoon b/lib/hood/helm.hoon index c3c8b9b7b..0fe2d42be 100644 --- a/lib/hood/helm.hoon +++ b/lib/hood/helm.hoon @@ -196,8 +196,7 @@ =/ top=path /(scot %p our)/home/(scot %da now)/sys =/ hun .^(@ %cx (welp top /hoon/hoon)) =/ arv .^(@ %cx (welp top /arvo/hoon)) - :- `card`[%flog /reset [%lyra `@t`hun `@t`arv]] - ^- (list card) + :- [%flog /reset [%lyra `@t`hun `@t`arv]] %+ turn (module-ova:pill top) |=(a=[wire flog:dill] [%flog a]) diff --git a/lib/ph.hoon b/lib/ph.hoon index 9f2ecd00b..ddf3e0921 100644 --- a/lib/ph.hoon +++ b/lib/ph.hoon @@ -1,7 +1,6 @@ :: :::: /hoon/ph/lib :: -:: XXX should raw-ship and others be stateless-test-core? /- aquarium =, aquarium |% @@ -28,10 +27,18 @@ :: :: Called on every effect from a ship. :: + :: The loobean in the return value says whether we should pass on + :: the effect to vane drivers. Usually this should be yes. + :: ++ route |~([ship unix-effect] *[? (quip ph-event _^|(..start))]) -- :: -:: XXX doc +:: A simpler interface for when you don't need all the power. +:: +:: Doesn't allwow you to explicitly subscribe to certain ships or +:: blocking certain effects from going to their usual vane drivers. +:: +:: Use with +porcelain-test :: ++ porcelain-test-core $_ ^| @@ -45,12 +52,19 @@ ++ route |~([ship unix-effect] *(quip ph-event _^|(..start))) -- :: -:: XXX doc +:: A simpler interface for when you don't need test state. +:: +:: Use with +stateless-test :: ++ stateless-test-core $_ ^| |_ now=@da + :: Called first to kick off the test. + :: ++ start *(list ph-event) + :: + :: Called on every effect from a ship. + :: ++ route |~([ship unix-effect] *(list ph-event)) -- :: @@ -59,7 +73,7 @@ aqua-event == :: -:: XXX doc +:: Call with a +porecelain-test-core create a stateless test. :: ++ porcelain-test |= [label=@ta porcelain=porcelain-test-core] @@ -77,7 +91,7 @@ [& events ..start] -- :: -:: XXX doc +:: Call with a +stateless-test-core create a stateless test. :: ++ stateless-test |= [label=@tas stateless=stateless-test-core] @@ -93,6 +107,8 @@ [(~(route stateless now) args) ..start] -- :: +:: Turn [ship (list unix-event)] into (list ph-event) +:: ++ send-events-to |= [who=ship what=(list unix-event)] ^- (list ph-event) @@ -100,6 +116,8 @@ |= ue=unix-event [%event who ue] :: +:: Start a ship (low-level; prefer +raw-ship) +:: ++ init |= [who=ship keys=(unit dawn-event)] ^- (list ph-event) @@ -119,6 +137,8 @@ [//term/1 %belt %ret ~] == :: +:: Inject a file into a ship +:: ++ insert-file |= [who=ship des=desk pax=path txt=@t] ^- (list ph-event) @@ -129,6 +149,9 @@ [//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~] == :: +:: Checks whether the given event is a dojo output blit containing the +:: given tape +:: ++ is-dojo-output |= [who=ship her=ship uf=unix-effect what=tape] ?& =(who her) @@ -141,6 +164,8 @@ !=(~ (find what p.blit)) == :: +:: Test is successful if +is-dojo-output +:: ++ expect-dojo-output |= [who=ship her=ship uf=unix-effect what=tape] ^- (list ph-event) @@ -148,18 +173,14 @@ ~ [%test-done &]~ :: +:: Check whether the given event is an ergo +:: ++ is-ergo |= [who=ship her=ship uf=unix-effect] ?& =(who her) ?=(%ergo -.q.uf) == :: -++ on-ergo - |= [who=ship her=ship uf=unix-effect fun=$-($~ (list ph-event))] - ?. (is-ergo who her uf) - ~ - (fun) -:: ++ azimuth |% ++ dawn @@ -207,6 +228,11 @@ :: ++ test-lib |_ our=ship + :: + :: Run one test, then the next. + :: + :: Caches the result of the first test. + :: ++ compose-tests |= [a=raw-test-core b=raw-test-core] ^- raw-test-core @@ -278,7 +304,7 @@ [thru events ..start] -- :: - :: Don't use directly, or else you might not have a parent. + :: Don't use directly unless you've already started any parent. :: :: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors. :: @@ -345,8 +371,6 @@ :: :: Touches /sur/aquarium/hoon on the given ship. :: - :: Ship must have been started. - :: ++ touch-file |= [her=ship des=desk] %+ porcelain-test @@ -377,9 +401,7 @@ ~ -- :: - :: Checks that /sur/aquarium/hoon has been touched, as by ++touch-file - :: - :: Ship must have been started. + :: Check that /sur/aquarium/hoon has been touched, as by ++touch-file :: ++ check-file-touched |= [her=ship des=desk] @@ -416,8 +438,6 @@ :: :: Reload vane from filesystem :: - :: Ship must have been started. - :: ++ reload-vane |= [her=ship vane=term] %+ stateless-test @@ -438,6 +458,8 @@ ~ -- :: + :: Scry into a running aqua ship + :: ++ scry-aqua |* [a=mold now=@da pax=path] .^ a diff --git a/sys/arvo.hoon b/sys/arvo.hoon index a9e85ba03..9ecd67a41 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -627,7 +627,6 @@ == :: upgrade once we've accumulated identity, entropy, and %zuse :: - ~& [%upgrading ?=(^ who) ?=(^ eny) ?=(^ bod)] ?. &(?=(^ who) ?=(^ eny) ?=(^ bod)) [~ +>.$] ~> %slog.[0 leaf+"arvo: metamorphosis"] From 8ebe809d8ee7072fb9ce78d1c976f034f0a02f7b Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 22 Mar 2019 17:44:23 -0700 Subject: [PATCH 49/55] disable clay sunk handling --- sys/vane/clay.hoon | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index e5e480410..3be49523c 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -3947,6 +3947,11 @@ ~& rift=[p.req q.req] ~& desks=(turn ~(tap by dos.rom.ruf) head) ~& hoy=(turn ~(tap by hoy.ruf) head) + :: + :: Don't clear state, because it doesn't quite work yet. + :: + ?: =(0 0) + `...^$ :: if we sunk, don't clear clay :: ?: =(our p.req) From 3fcd17b884fcf29dcc84dbf8c26a97e21cfe1b4d Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 22 Mar 2019 18:11:04 -0700 Subject: [PATCH 50/55] small improvements --- app/ph.hoon | 2 +- sys/vane/clay.hoon | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/app/ph.hoon b/app/ph.hoon index 3182e2dae..b57b48dea 100644 --- a/app/ph.hoon +++ b/app/ph.hoon @@ -50,7 +50,7 @@ -- =, gall =/ vane-apps=(list term) - ~[%aqua %aqua-ames %aqua-behn %aqua-dill %aqua-eyre] + ~[%aqua-ames %aqua-behn %aqua-dill %aqua-eyre] |_ $: hid=bowl state == diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 3be49523c..588c9aa0e 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -3951,7 +3951,7 @@ :: Don't clear state, because it doesn't quite work yet. :: ?: =(0 0) - `...^$ + `..^$ :: if we sunk, don't clear clay :: ?: =(our p.req) From 19cb5710e9798c277e2554818286c9312276f16d Mon Sep 17 00:00:00 2001 From: Fang Date: Mon, 25 Mar 2019 17:16:51 +0100 Subject: [PATCH 51/55] Add a readme --- README.md | 58 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 README.md diff --git a/README.md b/README.md new file mode 100644 index 000000000..bb5fc6a1d --- /dev/null +++ b/README.md @@ -0,0 +1,58 @@ +# Arvo + +A clean-slate operating system. + +## Usage + +To run Arvo, you'll need [Urbit](https://github.com/urbit/urbit/). To install Urbit and run Arvo please follow the instructions in the [getting started docs](https://urbit.org/docs/getting-started/). You'll be on the live network in a few minutes. + +If you're doing development on Arvo, keep reading. + +## Documentation + +Find Arvo's documentation [on urbit.org](https://urbit.org/docs/learn/arvo/). + +## Development + +To boot a fake ship from your development files, run `urbit` with the following arguments: + +``` +urbit -F zod -A /path/to/arvo -c fakezod +``` + +Mount Arvo's filesystem allows you to update its contents through Unix. To do so, run `|mount` in dojo. It is most common to `|mount /=home=`. + +To create a custom pill (bootstrapping object) from the files loaded into the home desk, run `.my/pill +solid`. Your pill will appear in `/path/to/fakezod/.urb/put/my.pill`. + +To boot a fake ship with a custom pill, use the `-B` flag: + +``` +urbit -F zod -A /path/to/arvo -B /path/to.pill -c fakezod +``` + +To run all tests in `/tests`, run `+test` in dojo. `+test /some/path` would only run all tests in `/tests/some/path`. + +## Maintainers + +Most parts of Arvo have dedicated maintainers. + +* `/sys/hoon`: @pilfer-pandex (~pilfer-pandex) +* `/sys/zuse`: @pilfer-pandex (~pilfer-pandex) +* `/sys/arvo`: @jtobin (~nidsut-tomdun) +* `/sys/vane/ames`: @belisarius222 (~rovnys-ricfer) & @joemfb (~master-morzod) +* `/sys/vane/behn`: @belisarius222 (~rovnys-ricfer) +* `/sys/vane/clay`: @philipcmonk (~wicdev-wisryt) +* `/sys/vane/dill`: @bernardodelaplaz (~rigdyn-sondur) +* `/sys/vane/eyre`: @eglaysher (~littel-ponnys) +* `/sys/vane/ford`: @belisarius222 (~rovnys-ricfer) & @eglaysher (~littel-ponnys) +* `/sys/vane/gall`: @jtobin (~nidsut-tomdun) +* `/sys/vane/jael`: @fang- (~palfun-foslup) & @joemfb (~master-morzod) +* `/app/acme`: @joemfb (~master-morzod) +* `/app/dns`: @joemfb (~master-morzod) +* `/app/hall`: @fang- (~palfun-foslup) +* `/app/talk`: @fang- (~palfun-foslup) +* `/lib/test`: @eglaysher (~littel-ponnys) + +## Contact + +We are using our new UI, Landscape, to run a few experimental cities. If you have an Azimuth point, please send us your planet name at [support@urbit.org](mailto:support@urbit.org) to request access. \ No newline at end of file From 98ef8fa38f75347b8d17cb2f881cfd0c6882bf8b Mon Sep 17 00:00:00 2001 From: Fang Date: Mon, 25 Mar 2019 17:23:37 +0100 Subject: [PATCH 52/55] Add minimal contributing section to readme --- README.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/README.md b/README.md index bb5fc6a1d..738b6b1f6 100644 --- a/README.md +++ b/README.md @@ -32,6 +32,12 @@ urbit -F zod -A /path/to/arvo -B /path/to.pill -c fakezod To run all tests in `/tests`, run `+test` in dojo. `+test /some/path` would only run all tests in `/tests/some/path`. +## Contributing + +Contributions of any form are more than welcome! If something doesn't seem right, and there is no issue about it yet, feel free to open one. + +If you're looking to make code contributions, a good place to start might be the [good contributor issues](https://github.com/urbit/arvo/issues?q=is%3Aopen+is%3Aissue+label%3A%22good+contributor+issue%22). + ## Maintainers Most parts of Arvo have dedicated maintainers. From da883a5eee3124e4cbfed086362b3c9b50e03ac2 Mon Sep 17 00:00:00 2001 From: Fang Date: Mon, 25 Mar 2019 23:03:24 +0100 Subject: [PATCH 53/55] Add simple .md mark --- mar/md.hoon | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 mar/md.hoon diff --git a/mar/md.hoon b/mar/md.hoon new file mode 100644 index 000000000..467457d31 --- /dev/null +++ b/mar/md.hoon @@ -0,0 +1,19 @@ +:: +:::: /hoon/md/mar + :: +/? 310 +:: +=, format +=, mimes:html +|_ txt/wain +:: +++ grab :: convert from + |% + ++ mime |=({p/mite:eyre q/octs:eyre} (to-wain q.q)) + ++ noun wain :: clam from %noun + -- +++ grow + |% + ++ mime [/text/plain (as-octs (of-wain txt))] + -- +-- \ No newline at end of file From 3c92eb506bf172ca50416c79e3cf49e6e1cfd149 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 29 Mar 2019 15:39:01 -0700 Subject: [PATCH 54/55] fix review comments --- app/aqua-ames.hoon | 4 +++- app/aqua-behn.hoon | 3 +-- app/aqua-dill.hoon | 2 +- app/aqua-eyre.hoon | 2 +- app/eth-manage.hoon | 2 +- mar/md.hoon | 3 ++- sur/aquarium.hoon | 10 +++++----- sys/zuse.hoon | 8 ++++---- 8 files changed, 18 insertions(+), 16 deletions(-) diff --git a/app/aqua-ames.hoon b/app/aqua-ames.hoon index 26ff8ab15..96e77f809 100644 --- a/app/aqua-ames.hoon +++ b/app/aqua-ames.hoon @@ -7,7 +7,7 @@ :: /- aquarium =, aquarium -=> $~ |% +=> |% +$ move (pair bone card) +$ card $% [%poke wire dock %aqua-events (list aqua-event)] @@ -49,6 +49,8 @@ :_ this(subscribed =(command %subscribe)) (aqua-vane-control-handler our ost subscribed command) :: +:: Handle effects from ships. We only react to %send effects. +:: ++ diff-aqua-effects |= [way=wire afs=aqua-effects] ^- (quip move _this) diff --git a/app/aqua-behn.hoon b/app/aqua-behn.hoon index 6763bd02c..ee65d4b51 100644 --- a/app/aqua-behn.hoon +++ b/app/aqua-behn.hoon @@ -1,6 +1,6 @@ /- aquarium =, aquarium -=> $~ |% +=> |% +$ move (pair bone card) +$ card $% [%poke wire dock %aqua-events (list aqua-event)] @@ -102,7 +102,6 @@ :: ++ set-timer |= tim=@da - =. tim +(tim) :: nobody's perfect ~? debug=| [who=who %setting-timer tim] =. next-timer `tim =. this (emit-moves [ost %wait /(scot %p who) tim]~) diff --git a/app/aqua-dill.hoon b/app/aqua-dill.hoon index 4286b942c..c7b93b0e1 100644 --- a/app/aqua-dill.hoon +++ b/app/aqua-dill.hoon @@ -9,7 +9,7 @@ :: /- aquarium =, aquarium -=> $~ |% +=> |% +$ move (pair bone card) +$ card $% [%poke wire dock %aqua-events (list aqua-event)] diff --git a/app/aqua-eyre.hoon b/app/aqua-eyre.hoon index cc87ea667..f40f5f8c4 100644 --- a/app/aqua-eyre.hoon +++ b/app/aqua-eyre.hoon @@ -2,7 +2,7 @@ :: /- aquarium =, aquarium -=> $~ |% +=> |% +$ move (pair bone card) +$ card $% [%poke wire dock %aqua-events (list aqua-event)] diff --git a/app/eth-manage.hoon b/app/eth-manage.hoon index 7a70062f2..413f7ed95 100644 --- a/app/eth-manage.hoon +++ b/app/eth-manage.hoon @@ -34,7 +34,7 @@ %look-ethnode :_ ~ =/ pul - (need (de-purl:html 'http://localhost:8545')) + (need (de-purl:html 'http://eth-mainnet.urbit.org:8545')) [ost.hid %look /hi |+pul] :: [%look-kick who=@p] diff --git a/mar/md.hoon b/mar/md.hoon index 467457d31..53051fe5b 100644 --- a/mar/md.hoon +++ b/mar/md.hoon @@ -16,4 +16,5 @@ |% ++ mime [/text/plain (as-octs (of-wain txt))] -- --- \ No newline at end of file +++ grad %mime +-- diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon index 3d04cd5e1..4124088c4 100644 --- a/sur/aquarium.hoon +++ b/sur/aquarium.hoon @@ -1,10 +1,10 @@ :: -:: Traditionally, ovo refers an event or card, and ova refers to a list -:: of them. We have several versions of each of these depending on -:: context, so we do away with that naming scheme and use the following -:: naming scheme. +:: Traditionally, ovo refers to an ovum -- (pair wire card) -- and ova +:: refers to a list of them. We have several versions of each of these +:: depending on context, so we do away with that naming scheme and use +:: the following naming scheme. :: -:: Every card is either a an `event` or an `effect`. Prepended to this +:: Every card is either an `event` or an `effect`. Prepended to this :: is `unix` if it has no ship associated with it, or `aqua` if it :: does. `timed` is added if it includes the time of the event. :: diff --git a/sys/zuse.hoon b/sys/zuse.hoon index 3652ec279..2acca5225 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -7199,14 +7199,14 @@ |% :: azimuth: data contract :: + ++ azimuth 0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb :: mainnet :: ++ azimuth 0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579 :: ropsten - :: ++ azimuth 0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb :: mainnet - ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge + :: ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge :: :: launch: block number of azimuth deploy :: - :: ++ launch 6.784.800 :: mainnet - ++ launch 0 :: local bridge + ++ launch 6.784.800 :: mainnet + :: ++ launch 0 :: local bridge -- :: :: hashes of ship event signatures From 7590a4fc38c218017860e912a155a1e11219b86e Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 29 Mar 2019 15:44:22 -0700 Subject: [PATCH 55/55] add aqua to ci --- .travis/test.js | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/.travis/test.js b/.travis/test.js index 996a10dc6..aff7302e2 100644 --- a/.travis/test.js +++ b/.travis/test.js @@ -82,6 +82,26 @@ function barMass(urb) { }) } +function aqua(urb) { + return urb.line("|start %ph") + .then(function(){ + return urb.line(":ph %init"); + }) + .then(function(){ + return urb.line(":aqua &pill +solid"); + }) + .then(function(){ + urb.every(/TEST [^ ]* FAILED/, function(arg){ + throw Error(arg); + }); + return urb.line(":ph %run-all-tests"); + }) + .then(function(){ + return urb.expectEcho("ALL TESTS SUCCEEDED") + .then(function(){ return urb.resetListeners(); }) + }) +} + Promise.resolve(urbit) .then(actions.safeBoot) .then(function(){ @@ -93,6 +113,9 @@ Promise.resolve(urbit) .then(function(){ return barMass(urbit); }) +.then(function(){ + return aqua(urbit); +}) .then(function(){ return rePill(urbit); })