keep logs

This commit is contained in:
Philip Monk 2019-03-06 12:22:37 -08:00
parent 55b708d1b7
commit 1ab6fea917
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
5 changed files with 232 additions and 68 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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)
==
--

View File

@ -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