From 34328a0ac33498f9b12a3b66160c162c913831db Mon Sep 17 00:00:00 2001 From: ~wicrum-wicrun <99811688+wicrum-wicrun@users.noreply.github.com> Date: Wed, 15 Feb 2023 15:54:06 +0100 Subject: [PATCH] Ad Fontes-style networking --- pkg/base-dev/lib/mip.hoon | 55 +++++++ pkg/base-dev/lib/sss.hoon | 249 +++++++++++++++---------------- pkg/base-dev/mar/sss/to-pub.hoon | 12 -- pkg/base-dev/sur/sss.hoon | 17 +-- 4 files changed, 182 insertions(+), 151 deletions(-) create mode 100644 pkg/base-dev/lib/mip.hoon delete mode 100644 pkg/base-dev/mar/sss/to-pub.hoon diff --git a/pkg/base-dev/lib/mip.hoon b/pkg/base-dev/lib/mip.hoon new file mode 100644 index 0000000000..322a4c85f9 --- /dev/null +++ b/pkg/base-dev/lib/mip.hoon @@ -0,0 +1,55 @@ +|% +++ mip :: map of maps + |$ [kex key value] + (map kex (map key value)) +:: +++ bi :: mip engine + =| a=(map * (map)) + |@ + ++ del + |* [b=* c=*] + =+ d=(~(gut by a) b ~) + =+ e=(~(del by d) c) + ?~ e + (~(del by a) b) + (~(put by a) b e) + :: + ++ get + |* [b=* c=*] + => .(b `_?>(?=(^ a) p.n.a)`b, c `_?>(?=(^ a) ?>(?=(^ q.n.a) p.n.q.n.a))`c) + ^- (unit _?>(?=(^ a) ?>(?=(^ q.n.a) q.n.q.n.a))) + (~(get by (~(gut by a) b ~)) c) + :: + ++ got + |* [b=* c=*] + (need (get b c)) + :: + ++ gut + |* [b=* c=* d=*] + (~(gut by (~(gut by a) b ~)) c d) + :: + ++ has + |* [b=* c=*] + !=(~ (get b c)) + :: + ++ key + |* b=* + ~(key by (~(gut by a) b ~)) + :: + ++ put + |* [b=* c=* d=*] + %+ ~(put by a) b + %. [c d] + %~ put by + (~(gut by a) b ~) + :: + ++ tap + ::NOTE naive turn-based implementation find-errors ): + =< $ + =+ b=`_?>(?=(^ a) *(list [x=_p.n.a _?>(?=(^ q.n.a) [y=p v=q]:n.q.n.a)]))`~ + |. ^+ b + ?~ a + b + $(a r.a, b (welp (turn ~(tap by q.n.a) (lead p.n.a)) $(a l.a))) + -- +-- diff --git a/pkg/base-dev/lib/sss.hoon b/pkg/base-dev/lib/sss.hoon index 2edbd1210e..7b9e7f60e9 100644 --- a/pkg/base-dev/lib/sss.hoon +++ b/pkg/base-dev/lib/sss.hoon @@ -1,4 +1,5 @@ /- *sss +/+ *mip :: |% ++ mk-subs |* [=(lake) paths=mold] -:+6:(da lake paths) @@ -28,44 +29,44 @@ :_ q.vax %- ~(play ut p.vax) =- [%wtgr [%wtts - [%& 2]~] [%$ 1]] - =/ pax ~| %need-path ;;(path -.q.vax) + =/ pax ~| %path-none ;;(path -.q.vax) |- ^- spec ?~ pax [%base %null] [%bccl ~[[%leaf %ta -.pax] $(pax +.pax)]] :: -++ zoom |= =noun ~| %path-none $/sss/;;(path noun) +++ zoom |= =noun ~| %need-path $/sss/;;(path noun) ++ da |* [=(lake) paths=mold] => |% - +$ flow - $: =aeon - rok=[=aeon fail=_| =rock:lake] - wav=((mop aeon wave:lake) lte) - == + +$ flow [=aeon fail=_| =rock:lake] -- |_ [sub=(map [ship dude paths] flow) =bowl:gall result-type=type on-rock-type=type] - +* wav ((on aeon wave:lake) lte) +$ from (on-rock:poke lake paths) +$ into (response:poke lake paths) +$ result (request:poke paths) - ++ pine - |= [=what =ship =dude path=paths] + ++ behn-s25 + |= [=dude =aeon path=noun] ^- card:agent:gall - :* %pass (zoom request/pine/ship^dude^what^path) - %agent [ship dude] - %poke %sss-to-pub :- result-type ^- result - [path dap.bowl %pine what] + :* %pass (zoom sub/behn/(scot %p src.bowl)^dude^(scot %ud aeon)^path) + %arvo %b %wait (add ~s25 now.bowl) + == + ++ pine |= [ship dude paths] (scry ~ +<) + ++ surf pine + ++ scry + |= [when=(unit aeon) who=ship which=dude where=paths] + ^- card:agent:gall + =/ when ?~ when %~ (scot %ud u.when) + :* %pass (zoom request/scry/(scot %p who)^which^when^where) + %agent [who which] + %poke %sss-to-pub :- result-type ^- result + [where which ^when] == - ++ surf - |= [=ship =dude path=paths] - (pine %wave ship dude path) - :: ++ read ;; (map [ship dude path] [fail=? rock:lake]) %- ~(run by sub) |= =flow - [fail rock]:rok.flow + [fail rock]:flow :: ++ chit |= [[aeon=term ship=term dude=term path=paths] =sign:agent:gall] @@ -74,97 +75,47 @@ ?~ p.sign sub %+ ~(jab by sub) [(slav %p ship) dude path] |= =flow - ?. =(aeon.rok.flow (slav %ud aeon)) flow - flow(fail.rok &) + ?> =(aeon.flow (slav %ud aeon)) + flow(fail &) :: ++ behn - |= [ship=term =dude path=paths] + |= [ship=term =dude aeon=term path=paths] ^- (list card:agent:gall) - => .(ship (slav %p ship)) + =/ ship (slav %p ship) ?. (~(has by sub) ship dude path) ~ - ~[(pine %wave ship dude path)] + ~[(scry `(slav %ud aeon) ship dude path)] :: ++ apply |= res=(response:poke lake paths) - ?~ ;;((soft path) path.res) ~| %need-path !! - ?@ payload.res - (pine-response res) - (scry-response res) - :: - ++ pine-response - |= res=[path=paths from=dude =aeon =what] ^- (quip card:agent:gall _sub) - =* current [src.bowl from.res path.res] - =/ =flow (~(gut by sub) current *flow) - :_ (~(put by sub) current flow(aeon (max aeon.flow aeon.res))) - ?- what.res - %rock - ?. |((lth aeon.rok.flow aeon.res) =(aeon.res 0)) ~ - :~ :* %pass (zoom request/scry/(scot %p src.bowl)^from.res^what.res^(scot %ud aeon.res)^path.res) - %agent [src.bowl from.res] - %poke %sss-to-pub :- result-type ^- result - [path.res dap.bowl %scry %rock aeon.res] - == == + ?- type.res + %yore + :_ sub :_ ~ + (pine src.bowl dude.res path.res) :: - %wave - =/ cards=(list card:agent:gall) - :~ :* %pass (zoom behn/(scot %p src.bowl)^from.res^path.res) - %arvo %b %wait (add ~s10 now.bowl) - == == - =? cards (gth aeon.res +(aeon.flow)) [(pine %rock current) cards] - =? cards (gth aeon.res aeon.rok.flow) - %+ weld cards - %+ turn (gulf +(aeon.rok.flow) aeon.res) - |= =aeon - ^- card:agent:gall - :* %pass (zoom request/scry/(scot %p src.bowl)^from.res^what.res^(scot %ud aeon)^path.res) - %agent [src.bowl from.res] - %poke %sss-to-pub :- result-type ^- result - [path.res dap.bowl %scry %wave aeon] - == - cards - == - :: - ++ scry-response - |= $: path=paths - =dude - =aeon - $%([what=%rock =rock:lake] [what=%wave =wave:lake]) - == - ^- (quip card:agent:gall _sub) - =* current [src.bowl dude path] - =/ =flow (~(gut by sub) current *flow) - ?. (lth aeon.rok.flow aeon) - %. `sub - (slog leaf/"ignoring stale {} at aeon {}" ~) - |^ - ?- what - %rock - =. wav.flow (lot:wav wav.flow `aeon ~) - =. rok.flow [aeon | rock] - =. aeon.flow (max aeon aeon.flow) - (swim ~) + %nigh + :_ sub :_ ~ + (behn-s25 [dude aeon path]:res) :: - %wave - ?: =(aeon +(aeon.rok.flow)) - =. rok.flow [aeon | (wash:lake rock.rok.flow wave)] - (swim `wave) - `(~(put by sub) current flow(wav (put:wav wav.flow aeon wave))) - == - ++ swim - |= wave=(unit wave:lake) - ^- (quip card:agent:gall _sub) - =^ wave wav.flow (del:wav wav.flow +(aeon.rok.flow)) - ?^ wave - =. rok.flow [+(aeon.rok.flow) | (wash:lake rock.rok.flow u.wave)] - (swim wave) + %scry + =* current [src.bowl dude.res path.res] + =/ [wave=(unit wave:lake) =flow] + =/ old=flow (~(gut by sub) current *flow) + ?- what.res + %rock ?> (gte aeon.res aeon.old) + `[aeon.res | rock.res] + %wave ?> =(aeon.res +(aeon.old)) + [`wave.res [aeon.res | (wash:lake rock.old wave.res)]] + == :_ (~(put by sub) current flow) - :~ :* %pass (zoom on-rock/(scot %ud aeon.rok.flow)^(scot %p src.bowl)^dude^path) + %- flop + :~ (scry `+(aeon.res) src.bowl dude.res path.res) + :* %pass (zoom on-rock/(scot %ud aeon.flow)^(scot %p src.bowl)^dude.res^path.res) %agent [our dap]:bowl - %poke %sss-on-rock :- on-rock-type ^- from - [path src.bowl dude rock.rok.flow ^wave] + %poke %sss-on-rock on-rock-type ^- from + [path.res src.bowl dude.res rock.flow wave] == == - -- + == -- ++ du |* [=(lake) paths=mold] @@ -175,6 +126,7 @@ $: rok=((mop aeon rock:lake) gte) wav=((mop aeon wave:lake) lte) rul=rule + mem=(mip aeon [ship dude] @da) == -- |_ [pub=(map paths tide) =bowl:gall result-type=type] @@ -183,6 +135,18 @@ :: +$ into (request:poke paths) +$ result (response:poke lake paths) + ++ behn-s25 + |= [=dude =aeon path=noun] + ^- card:agent:gall + :* %pass (zoom pub/behn/(scot %p src.bowl)^dude^(scot %ud aeon)^path) + %arvo %b %wait (add ~s25 now.bowl) + == + ++ behn-rest + |= [=ship =dude =aeon path=noun =@da] + ^- card:agent:gall + :* %pass (zoom pub/behn/(scot %p ship)^dude^(scot %ud aeon)^path) + %arvo %b %rest da + == ++ rule |= [path=paths =^rule] ^+ pub @@ -199,22 +163,46 @@ rul rul.tide wav ~ == + ++ behn + |= [ship=term =dude aeon=term path=paths] + ^+ pub + %+ ~(jab by pub) path + |= =tide + ^+ tide + tide(mem (~(del bi mem.tide) (slav %ud aeon) (slav %p ship) dude)) :: + ++ send + |= [=wave:lake =ship =dude =aeon path=paths] + ^- card:agent:gall + =* mark (cat 3 %sss- name:lake) + :* %pass (zoom response/scry/(scot %p ship)^dude^(scot %ud aeon)^path) + %agent [ship dude] + %poke mark result-type ^- (response:poke lake paths) + [path dap.bowl aeon scry/wave/wave] + == ++ give |= [path=paths =wave:lake] - ^+ pub + ^- (quip card:agent:gall _pub) ?~ ;;((soft ^path) path) ~| %need-path !! - %+ ~(put by pub) path =/ =tide (~(gut by pub) path *tide) =/ next=aeon - .+ %+ max + .+ %+ max (fall (bind (pry:rok rok.tide) head) 0) (fall (bind (ram:wav wav.tide) head) 0) - =/ last=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok) - =. wav.tide (put:wav wav.tide next wave) - ?. =(next (add aeon.last waves.rul.tide)) tide - (form tide) - :: + :: + :_ %+ ~(put by pub) path + =/ last=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok) + =. wav.tide (put:wav wav.tide next wave) + =. mem.tide (~(del by mem.tide) next) + ?. =(next (add aeon.last waves.rul.tide)) tide + (form tide) + :: + %+ (corl zing turn) ~(tap by (~(gut by mem.tide) next ~)) + |= [[=ship =dude] =@da] + ^- (list card:agent:gall) + :~ (behn-rest ship dude next path da) + (send wave ship dude next path) + == ++ form |= =tide ^+ tide @@ -249,32 +237,33 @@ :: ++ apply |= req=(request:poke paths) - ^- card:agent:gall - =* mark (cat 3 %sss- name:lake) + |^ ^- (quip card:agent:gall _pub) =/ =tide (~(gut by pub) path.req *tide) - ?- type.req - %scry - :* %pass (zoom response/scry/(scot %p src.bowl)^from.req^what.req^(scot %ud aeon.req)^path.req) - %agent [src.bowl from.req] - %poke mark result-type ^- result - :* path.req dap.bowl aeon.req - ?- what.req - %wave wave/(got:wav wav.tide aeon.req) - %rock ?: =(aeon.req 0) rock/*rock:lake - rock/(got:rok rok.tide aeon.req) - == == == - :: - %pine - =/ =aeon - ?- what.req - %rock key:(fall (pry:rok rok.tide) *[=key val]:rok) - %wave key:(fall (ram:wav wav.tide) *[=key val]:wav) - == - :* %pass (zoom response/pine/(scot %p src.bowl)^from.req^what.req^path.req) - %agent [src.bowl from.req] - %poke mark result-type ^- result - [path.req dap.bowl aeon what.req] - == + ?~ when.req + =/ last (fall (pry:rok rok.tide) *[=key =val]:rok) + :_ pub :_ ~ + (mk-card key.last scry/rock/val.last) + ?^ dat=(get:wav wav.tide u.when.req) + :_ pub :_ ~ + (mk-card u.when.req scry/wave/u.dat) + ?. (gth u.when.req key::(fall (ram:wav wav.tide) [key=+(u.when.req) **])) + :_ pub :_ ~ + (mk-card u.when.req yore/~) + :- ~[(behn-s25 [dude u.when path]:req) (mk-card u.when.req nigh/~)] + %+ ~(put by pub) path.req + %= tide mem + %^ ~(put bi mem.tide) u.when.req [src.bowl dude.req] + (add ~s25 now.bowl) == + :: + ++ mk-card + |= dat=_|2:*(response:poke lake paths) + =* mark (cat 3 %sss- name:lake) + =* when ?~(when.req %$ (scot %ud u.when.req)) + :* %pass (zoom response/scry/(scot %p src.bowl)^dude.req^when^path.req) + %agent [src.bowl dude.req] + %poke mark result-type path.req dap.bowl dat + == + -- -- -- diff --git a/pkg/base-dev/mar/sss/to-pub.hoon b/pkg/base-dev/mar/sss/to-pub.hoon deleted file mode 100644 index 2f57c3b1e9..0000000000 --- a/pkg/base-dev/mar/sss/to-pub.hoon +++ /dev/null @@ -1,12 +0,0 @@ -/- *sss -|_ =(request:poke) -++ grow - |% - ++ noun request - -- -++ grab - |% - ++ noun (request:poke) - -- -++ grad %noun --- diff --git a/pkg/base-dev/sur/sss.hoon b/pkg/base-dev/sur/sss.hoon index f6e66d1588..9533719d7c 100644 --- a/pkg/base-dev/sur/sss.hoon +++ b/pkg/base-dev/sur/sss.hoon @@ -16,20 +16,19 @@ ++ request |* paths=mold $: path=paths - from=dude - $% [type=%pine =what] - [type=%scry =what =aeon] - == == + =dude + when=(unit aeon) + == ++ response |* [=(lake) paths=mold] $: path=paths =dude =aeon - $= payload - $@ =what - $% [what=%rock =rock:lake] - [what=%wave =wave:lake] - == == + $% [type=?(%nigh %yore) ~] + $: type=%scry + $% [what=%rock =rock:lake] + [what=%wave =wave:lake] + == == == == ++ on-rock |* [=(lake) paths=mold] ,[path=paths src=ship from=dude =rock:lake wave=(unit wave:lake)]