From 23d43bd5f42cff2380ffeb3e556b440473050059 Mon Sep 17 00:00:00 2001 From: ~wicrum-wicrun <99811688+wicrum-wicrun@users.noreply.github.com> Date: Wed, 1 Feb 2023 17:05:18 +0100 Subject: [PATCH] Add draft code --- pkg/base-dev/lib/sss.hoon | 289 +++++++++++++++++++++++++++++++ pkg/base-dev/mar/sss/to-pub.hoon | 12 ++ pkg/base-dev/sur/sss.hoon | 37 ++++ 3 files changed, 338 insertions(+) create mode 100644 pkg/base-dev/lib/sss.hoon create mode 100644 pkg/base-dev/mar/sss/to-pub.hoon create mode 100644 pkg/base-dev/sur/sss.hoon diff --git a/pkg/base-dev/lib/sss.hoon b/pkg/base-dev/lib/sss.hoon new file mode 100644 index 000000000..b4818f3d7 --- /dev/null +++ b/pkg/base-dev/lib/sss.hoon @@ -0,0 +1,289 @@ +/- *sss +:: +|% +++ mk-subs |* [=(lake) paths=mold] -:+6:(da lake paths) +++ mk-pubs |* [=(lake) paths=mold] -:+6:(du lake paths) +++ mk-mar + |* =(lake) + |_ =(response:poke lake *) + ++ grow + |% + ++ noun response + -- + ++ grab + |% + ++ noun (response:poke lake *) + -- + ++ grad %noun + -- +++ lake-mark + |= =mark + ^+ mark + ?> =('sss-' (end [3 3] mark)) + (cut 3 [4 (met 3 mark)] mark) +:: +++ fled :: Like +sped but head is a path. + |= vax=vase + ^- vase + :_ q.vax + %- ~(play ut p.vax) + =- [%wtgr [%wtts - [%& 2]~] [%$ 1]] + =/ pax ~| %need-path ;;(path -.q.vax) + |- ^- spec + ?~ pax [%base %null] + [%bccl ~[[%leaf %ta -.pax] $(pax +.pax)]] +:: +++ zoom |= =noun ~| %path-none $/sss/;;(path noun) +++ da + |* [=(lake) paths=mold] + => + |% + +$ flow + $: =aeon + rok=[=aeon fail=_| =rock:lake] + wav=((mop aeon wave:lake) lte) + == + -- + |_ [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] + ^- 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] + == + ++ 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 + :: + ++ chit + |= [[aeon=term ship=term dude=term path=paths] =sign:agent:gall] + ^+ sub + ?> ?=(%poke-ack -.sign) + ?~ p.sign sub + %+ ~(jab by sub) [(slav %p ship) dude path] + |= =flow + ?. =(aeon.rok.flow (slav %ud aeon)) flow + flow(fail.rok &) + :: + ++ behn + |= [ship=term =dude path=paths] + ^- (list card:agent:gall) + => .(ship (slav %p ship)) + ?. (~(has by sub) ship dude path) ~ + ~[(pine %wave 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] + == == + :: + %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 ~) + :: + %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) + :_ (~(put by sub) current flow) + :~ :* %pass (zoom on-rock/(scot %ud aeon.rok.flow)^(scot %p src.bowl)^dude^path) + %agent [our dap]:bowl + %poke %sss-on-rock :- on-rock-type ^- from + [path src.bowl dude rock.rok.flow ^wave] + == == + -- + -- +++ du + |* [=(lake) paths=mold] + => + |% + +$ rule [rocks=_1 waves=_5] + +$ tide + $: rok=((mop aeon rock:lake) gte) + wav=((mop aeon wave:lake) lte) + rul=rule + == + -- + |_ [pub=(map paths tide) =bowl:gall result-type=type] + +* rok ((on aeon rock:lake) gte) + wav ((on aeon wave:lake) lte) + :: + +$ into (request:poke paths) + +$ result (response:poke lake paths) + ++ rule + |= [path=paths =^rule] + ^+ pub + %+ ~(jab by pub) path + |= =tide + (petrify tide(rul rule)) + :: + ++ wipe + |= path=paths + ^+ pub + %+ ~(jab by pub) path + |= =tide + %* . (petrify tide(rul [0 0])) + rul rul.tide + == + ++ give + |= [path=paths =wave:lake] + ^+ pub + ?~ ;;((soft ^path) path) ~| %need-path !! + %+ ~(put by pub) path + =/ =tide (~(gut by pub) path *tide) + =/ next=aeon + .+ %+ 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 + (petrify tide) + :: + ++ petrify + ~& %hmm + |= =tide + ^+ tide + =/ next=aeon + %+ 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) + =. rok.tide + %+ gas:rok +<-:gas:rok + %- tab:rok :_ [~ +(rocks.rul.tide)] + %^ put:rok rok.tide next + %+ roll (tab:wav wav.tide `aeon.last waves.rul.tide) + |= [[aeon =wave:lake] =_rock.last] + (wash:lake rock wave) + ~| %rock-none + tide(wav (lot:wav wav.tide (bind (ram:rok rok.tide) |=([r=@ *] (dec r))) ~)) + :: + ++ read + ;; (map path rock:lake) + %- ~(run by pub) + |= =tide + =< rock + =/ snap=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok) + %+ roll (tap:wav (lot:wav wav.tide `aeon.snap ~)) + |= [[=aeon =wave:lake] =_snap] + ?. =(aeon +(aeon.snap)) snap + [aeon (wash:lake rock.snap wave)] + :: + +:: %+ ~(put by pub) path +:: =/ =tide (~(gut by pub) path *tide) +:: =^ last rok.tide (pop:rok rok.tide) +:: =^ next wav.tide +:: %^ (dip:wav ,[aeon rock:lake]) +:: (lot:wav wav.tide `-.last ~) +:: last +:: |= [[aeon =rock:lake] [=aeon =wave:lake]] +:: ^- [(unit wave:lake) ? [^aeon rock:lake]] +:: [~ | aeon (wash:lake rock wave)] +:: tide(rok (put:rok +<-:put:rok next)) + :: + ++ apply + |= req=(request:poke paths) + ^- card:agent:gall + =* mark (cat 3 %sss- name:lake) + =/ =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] + == + == + -- +-- diff --git a/pkg/base-dev/mar/sss/to-pub.hoon b/pkg/base-dev/mar/sss/to-pub.hoon new file mode 100644 index 000000000..2f57c3b1e --- /dev/null +++ b/pkg/base-dev/mar/sss/to-pub.hoon @@ -0,0 +1,12 @@ +/- *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 new file mode 100644 index 000000000..9db56febb --- /dev/null +++ b/pkg/base-dev/sur/sss.hoon @@ -0,0 +1,37 @@ +|% +++ lake + |$ [rock wave] + $_ ^? + |% + ++ name *term + +$ rock ^rock + +$ wave ^wave + ++ wash |~ [rock wave] *rock + -- ++$ aeon @ud ++$ dude dude:agent:gall ++$ what ?(%rock %wave) +++ poke + |% + ++ request + |* paths=mold + $: path=paths + from=dude + $% [type=%pine =what] + [type=%scry =what aeon=@ud] + == == + ++ response + |* [=(lake) paths=mold] + $: path=paths + from=dude + aeon=@ud + $= payload + $@ =what + $% [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)] + -- +--