mirror of
https://github.com/ilyakooo0/urbit.git
synced 2025-01-03 12:42:48 +03:00
keep logs
This commit is contained in:
parent
55b708d1b7
commit
1ab6fea917
143
app/aqua.hoon
143
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
|
||||
|
52
app/ph.hoon
52
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
|
||||
|
63
lib/ph.hoon
63
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
|
||||
|
@ -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)
|
||||
==
|
||||
--
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user