From 563aa0102e14c1dbf169ec82d088c5c1980234ec Mon Sep 17 00:00:00 2001 From: Fang Date: Mon, 12 Jun 2017 15:19:45 -0700 Subject: [PATCH] Mostly functional federation & delta model. --- app/talk-agent.hoon | 457 +++---- app/talk-guardian.hoon | 894 +++++++------ app/talk.hoon | 2894 ---------------------------------------- lib/talk.hoon | 109 +- mar/talk/command.hoon | 3 +- mar/talk/prize.hoon | 14 + mar/talk/rumor.hoon | 14 + sur/talk.hoon | 71 +- 8 files changed, 855 insertions(+), 3601 deletions(-) delete mode 100644 app/talk.hoon create mode 100644 mar/talk/prize.hoon create mode 100644 mar/talk/rumor.hoon diff --git a/app/talk-agent.hoon b/app/talk-agent.hoon index a6a93b50c..15b3d9604 100644 --- a/app/talk-agent.hoon +++ b/app/talk-agent.hoon @@ -2,15 +2,19 @@ :::: /hoon/talk-agent/app :: :: :: :: :: :: +::TODO master changes, incl %notify ::TODO guardian's todo's apply here too ::TODO make sure glyphs only get bound when joins succeed :: ...this is a bit troublesome, because failed joins don't actually :: unsubscribe us. ::TODO maybe keep track of received grams per partner, too? :: +::TODO for delta model: +:: 3) split into delta creation and application, as with hall. +:: ::> This reader implementation makes use of the mailbox ::> for all its subscriptions and messaging. All -::> lowdowns received are exclusively about the mailbox, +::> rumors received are exclusively about the mailbox, ::> since that's the only thing the reader ever ::> subscribes to. :: @@ -38,22 +42,21 @@ remotes/(map partner group) ::< remote presences mirrors/(map circle config) ::< remote configs :: ui state :: - folks/(map ship human) ::< human identities + nicks/(map ship cord) ::< human identities nik/(map (set partner) char) ::< bound circle glyphs nak/(jug char (set partner)) ::< circle glyph lookup cli/shell ::< interaction state == :: ++ shell ::> console session $: id/bone ::< identifier - count/@ud ::< messages shown + latest/@ud ::< latest shown msg num say/sole-share ::< console state active/(set partner) ::< active targets settings/(set knot) ::< frontend settings == :: ++ move (pair bone card) ::< all actions ++ lime ::> diff fruit - $% {$talk-report report} :: - {$sole-effect sole-effect} :: + $% {$sole-effect sole-effect} :: == :: ++ pear ::> poke fruit $% {$talk-command command} :: @@ -75,9 +78,8 @@ {$invite p/knot q/(set ship)} ::< give permission {$banish p/knot q/(set ship)} ::< deny permission {$source p/knot q/(set partner)} ::< add source - {$enlist p/knot q/(set ship)} ::< allow federation - {$retire p/knot q/(set ship)} ::< deny federation - {$burden p/circle} ::< help federate + :: personal metadata + {$status p/knot q/presence} ::TODO better interface ::< set status :: messaging :: {$say p/(list speech)} ::< send message {$eval p/cord q/twig} ::< send #-message @@ -123,17 +125,39 @@ ::+| :: ++ broker ::< broker ship + name - |= our/ship + ^- dock :_ %talk-guardian - ?. =((clan our) %earl) - our - (sein our) + (true-self our.bol) :: -++ inbox ::< reader's circle +++ inbox ::< reader's circle name ::> produces the name of the circle used by this ::> reader for all its operations + ^- knot (main our.bol) :: +++ incir ::< reader's circle + ::> ++inbox, except a full circle. + ^- circle + :_ inbox + (true-self our.bol) +:: +++ inpan ::< reader's partner + ::> ++inbox, except a full partner. + ^- partner + [%& incir] +:: +++ nik-from-nak ::< nik from nak + ::> + :: + ::TODO ...we really should rename these. + |= nek/_nak + ^+ nik + %- ~(gas by *(map (set partner) char)) + =- (zing -) + %+ turn (~(tap by nek)) + |= {a/char b/(set (set partner))} + (turn (~(tap by b)) |=(c/(set partner) [c a])) +:: ::> || ::> || %engines ::> || @@ -209,12 +233,20 @@ ++ ta-init ::< initialize app ::> subscribes to our broker. :: - %- ta-emit - :* ost.bol - %peer - / ::< return/diff path - (broker our.bol) - /reader/[inbox] ::< peer path + %- ta-emil + ^- (list move) + :~ :* ost.bol + %peer + / + broker + /reader + == + :* ost.bol + %peer + / + broker + /circle/[inbox] + == == :: ++ ta-reaction ::< apply reaction @@ -224,148 +256,115 @@ ^+ +> sh-done:(~(sh-reaction sh cli) rac) :: - ++ ta-change ::< apply change + ++ ta-take ::< accept prize ::> :: - |= dif/delta + |= piz/prize + ^+ +> + ?+ -.piz + ~&([%ignoring-prize -.piz] +>) + :: + $reader + %= +> + nak gys.piz + nik (nik-from-nak gys.piz) + nicks nis.piz + == + :: + $circle + %. gaz.piz + %= ta-change-grams + sources sre.loc.cos.piz + mirrors (~(put by rem.cos.piz) incir loc.cos.piz) + remotes (~(put by rem.pes.piz) inpan loc.pes.piz) + == + == + :: + ++ ta-hear ::< apply change + ::> + :: + |= dif/rumor ^+ +> ?+ -.dif - ~& [%ignoring-delta -.dif] - +> + ~&([%ignoring-rumor -.dif] +>) :: - $mor - |- ^+ +>.^$ - ?~ mor.dif +>.^$ - $(+>.^$ ^$(dif i.mor.dif), mor.dif t.mor.dif) + $reader + ?- -.dif.dif + $glyph + (ta-change-glyph +.dif.dif) + :: + $nick + +>(nicks (change-nicks nicks who.dif.dif nic.dif.dif)) + == :: - $cir - (ta-change-circle +.dif) + $circle + (ta-change-circle dif.dif) == :: ++ ta-change-circle ::< apply circle change ::> :: - |= {cir/circle dif/delta-circle} + |= dif/diff-story ^+ +> ?+ -.dif - ~& [%ignoring-delta-circle -.dif] - +> + ~&([%unexpected-circle-rumor -.dif] +>) :: - $put - (ta-low-grams count.cli gaz.dif) + $grams + (ta-change-grams gaz.dif) + :: + $config + %= +> + sources + ?. ?& ?=($sourcee -.dif.dif) + =(cir.dif incir) + == + sources + %. pas.dif.dif + ?: add.dif.dif + ~(uni in sources) + ~(dif in sources) + :: + mirrors + ?: ?=($remove -.dif.dif) (~(del by mirrors) cir.dif) + %+ ~(put by mirrors) cir.dif + %+ change-config + (fall (~(get by mirrors) cir.dif) *config) + dif.dif + == + :: + $status + %= +> + remotes + %+ ~(put by remotes) pan.dif + =+ rem=(fall (~(get by remotes) pan.dif) *group) + ?: ?=($remove -.dif.dif) (~(del by rem) who.dif) + %+ ~(put by rem) who.dif + %+ change-status + (fall (~(get by rem) who.dif) *status) + dif.dif + == == :: - ++ ta-low ::< apply lowdown - ::> processes a talk lowdown - :: - |= low/lowdown - ^+ +> - ?- -.low - $glyph (ta-low-glyph +.low) - $names (ta-low-names +.low) - $confs (ta-low-confs +.low) - $precs (ta-low-precs +.low) - $grams (ta-low-grams +.low) - == - :: - ++ ta-low-glyph ::< apply changed glyphs + ++ ta-change-glyph ::< apply changed glyphs ::> applies new set of glyph bindings. :: - |= nek/_nak + |= {bin/? gyf/char pas/(set partner)} ^+ +> - ?: =(nek nak) +> :: no change + =+ nek=(change-glyphs nak bin gyf pas) + ?: =(nek nak) +>.$ :: no change =. nak nek - =. nik - %- ~(gas by *(map (set partner) char)) - =- (zing -) - %+ turn (~(tap by nek)) - |= {a/char b/(set (set partner))} - (turn (~(tap by b)) |=(c/(set partner) [c a])) + =. nik (nik-from-nak nek) sh-done:~(sh-prod sh cli) :: - ++ ta-low-names ::< apply changed names - ::> applies new local identities. - :: - |= nas/(map ship (unit human)) - ^+ +> - %= +> - folks - %- ~(gas by *(map ship human)) - %+ murn - =< $ - %~ tap by - %. nas - ~(uni by `_nas`(~(run by folks) some)) - == - |= {s/ship h/(unit human)} - ?~(h ~ (some [s u.h])) - == - :: - ++ ta-low-confs ::< apply changed confs - ::> applies new circle configurations. - ::> because of how this reader only subscribes to - ::> the main mailbox, {coy} is always the mailbox's - ::> config. - :: - |= {coy/(unit config) cofs/(map circle (unit config))} - ^+ +> - ::> if possible, update {sources}. if we do, and we - ::> gain new ones, update the prompt. (this is to - ::> remove the mailbox from the audience after - ::> creating or joining a new circle.) - ?~ coy ~&(%mailbox-gone !!) - =. +> ::TODO =? - ?~ (~(dif in src.u.coy) sources) +>.$ - =< sh-done - %- ~(sh-pact sh(sources src.u.coy) cli) - (~(dif in src.u.coy) sources) - =. sources src.u.coy - =. cofs (~(put by cofs) [our.bol inbox] coy) - :: print changes for each config. - =. +>.$ - =< sh-done - %+ roll (~(tap by cofs)) - |= {{s/circle c/(unit config)} cil/_sh} - %^ ~(sh-low-config cil cli) - s (~(get by mirrors) s) c - :: apply config changes to {mirrors}. - =. mirrors - %- ~(gas by *_mirrors) - %+ murn (~(tap by cofs)) - |= {s/circle c/(unit config)} - ^- (unit (pair circle config)) - ?~(c ~ `[s u.c]) - +>.$ - :: - ++ ta-low-precs ::< apply changed precs - ::> applies new presences. - ::> other clients might care for {gop}, but we're - ::> only ever getting this for the mailbox, where - ::> we're the only ones present. - :: - |= {gop/group pas/(map partner group)} - ^+ +> - =/ ner/_remotes :: per-partner uni - %- ~(urn by pas) - |= {p/partner g/group} - =+ o=(~(get by remotes) p) - ?~(o g (~(uni by u.o) g)) - =. ner (~(uni by remotes) ner) :: fill in the gaps - ?: =(remotes ner) +>.$ :: no change - =. +>.$ - =< sh-done - %+ ~(sh-low-rempe sh cli) - remotes ner - +>.$(remotes ner) - :: - ++ ta-low-grams ::< apply messages + ++ ta-change-grams ::< apply messages ::> applies new or changed telegrams. :: - |= {num/@ud gams/(list telegram)} + |= gaz/(list telegram) ^+ +> - =. +>.$ (ta-lesson gams) + =. +>.$ (ta-lesson gaz) + ::TODO maybe move to ta-learn and pass num? =< sh-done - (~(sh-low-grams sh cli) num gams) + (~(sh-grams sh cli) gaz) :: ::> || ::> || %messages @@ -424,7 +423,7 @@ :: ^+ . =/ she/shell - %*(. *shell id ost.bol, active (sy [%& our.bol inbox] ~)) + %*(. *shell id ost.bol, active (sy inpan ~)) sh-done:~(sh-prod sh she) :: ++ ta-sole ::< apply sole input @@ -477,7 +476,7 @@ :* ost.bol %poke /reader/action - (broker our.bol) + broker [%talk-action act] == == @@ -555,7 +554,7 @@ :: ++ circ ::< circle ;~ pose - (cold [our.bol inbox] col) + (cold incir col) ;~(pfix cen (stag our.bol sym)) ;~(pfix fas (stag (sein our.bol) sym)) :: @@ -621,9 +620,10 @@ ;~(plug (cold %eval hax) expr) :: %+ stag %say - %+ most (jest '•') + %+ most (jest '•') ::TODO why is this not breaking msgs up? ;~ pose (stag %url aurf:urlp) + ::TODO maybe reverse loobs. at least document properly! confusing. :(stag %lin | ;~(pfix pat text)) :(stag %lin & ;~(less sem hax text)) == @@ -634,7 +634,7 @@ ++ glyph (mask "/\\\{( finds all ships whose handle matches {nym}. :: |= nym/knot ^- (list ship) - %+ murn (~(tap by folks)) - |= {p/ship q/human} - ?~ han.q ~ - ?. =(u.han.q nym) ~ + %+ murn (~(tap by nicks)) + |= {p/ship q/knot} + ?. =(q nym) ~ [~ u=p] :: ++ twig-head ::< eval data @@ -997,26 +994,17 @@ ^+ ..sh-work (sh-act %source nom & pas) :: - ++ enlist - ::> - :: - |= {nom/knot sis/(set ship)} - ^+ ..sh-work - (sh-act %enlist nom & sis) + ::> || + ::> || %personal-metadata + ::> || + ::+| :: - ++ retire + ++ status ::< set status ::> :: - |= {nom/knot sis/(set ship)} + |= {nom/knot pec/presence} ^+ ..sh-work - (sh-act %enlist nom | sis) - :: - ++ burden - ::> - :: - |= cir/circle - ^+ ..sh-work - (sh-act %burden cir) + (sh-act %status [nom ~ ~] [pec [~ ~]]) :: ::> || ::> || %messaging @@ -1141,34 +1129,31 @@ ::> no arguments, show all ?: ?=({$~ $~} +<) %+ sh-fact %mor - %+ turn (~(tap by folks)) - |= {p/ship q/human} + %+ turn (~(tap by nicks)) + |= {p/ship q/knot} :- %txt - ?~ han.q - "{

}:" - "{

}: {}" + "{

}: {}" ::> show her nick ?~ nym ?> ?=(^ her) - =+ asc=(~(get by folks) u.her) + =+ asc=(~(get by nicks) u.her) %+ sh-fact %txt ?~ asc "{} unbound" - ?~ han.u.asc "{}:" - "{}: {}" + "{}: {}" ::> show nick ship ?~ her %+ sh-fact %mor - %+ turn (reverse-folks u.nym) + %+ turn (reverse-nicks u.nym) |= p/ship [%txt "{

}: {}"] - %. [%human u.her [true=~ hand=nym]] + %. [%nick u.her (fall nym '')] %= sh-act - folks + nicks ?~ u.nym ::> unset nickname - (~(del by folks) u.her) + (~(del by nicks) u.her) ::> set nickname - (~(put by folks) u.her [true=~ hand=nym]) + (~(put by nicks) u.her u.nym) == :: ++ wo-set ::< %set @@ -1224,7 +1209,7 @@ :: |= paz/(set partner) ?: (sh-pear paz) paz - (~(put in paz) [%& our.bol inbox]) + (~(put in paz) inpan) :: ++ sh-pear ::< hearback ::> produces true if any partner is included in @@ -1528,7 +1513,7 @@ =. +>.$ %+ sh-show-sources (weld (trip inbox) ": ") - (sh-set-diff src.laz src.loc) + (sh-set-diff sre.laz sre.loc) ?: !=(sec.con.loc sec.con.laz) =. +>.$ (sh-note :(weld pre "but " (sh-cure sec.con.loc))) %^ sh-show-permits @@ -1540,14 +1525,14 @@ sec.con.loc (sh-set-diff ses.con.laz ses.con.loc) :: - ++ sh-low-config ::< do show config + ++ sh-config ::< do show config ::> prints a circle's config changes to the cli. :: |= {cir/circle old/(unit config) new/(unit config)} ^+ +> :: new circle ?~ old - :: ++sh-low-rempe will notice a new partner. + :: ++sh-show-rempe will notice a new partner. +> :: removed circle ?~ new @@ -1556,65 +1541,30 @@ (weld ~(cr-phat cr cir) ": ") u.old u.new :: - ++ sh-low-rempe ::< show remotes - ::> prints remote presence changes to the cli. - :: - |= {old/(map partner group) new/(map partner group)} - ?: (~(has in settings.she) %quiet) - +>.$ - =+ day=(sh-rempe-diff old new) - =. +>.$ - |- ^+ +>.^$ - ?~ old.day +>.^$ - =. +>.^$ $(old.day t.old.day) - (sh-note (weld "not " (~(pr-show pr p.i.old.day) ~))) - =. +>.$ - |- ^+ +>.^$ - ?~ new.day +>.^$ - =. +>.^$ $(new.day t.new.day) - =. +>.^$ - (sh-note (weld "new " (~(pr-show pr p.i.new.day) ~))) - (sh-show-precs "--" ~ (~(tap by q.i.new.day)) ~) - =. +>.$ - |- ^+ +>.^$ - ?~ cha.day +>.^$ - =. +>.^$ $(cha.day t.cha.day) - =. +>.^$ - (sh-note (weld "for " (~(pr-show pr p.i.cha.day) ~))) - =+ yez=(~(got by old) p.i.cha.day) - %+ sh-show-precs "--" - (sh-group-diff yez q.i.cha.day) - +>.$ - :: - ++ sh-low-precs ::< show presence - ::> prints presence changes to the cli. - :: - |= {old/group new/group} - ^+ +> - =+ dif=(sh-group-diff old new) - (sh-show-precs "" dif) - :: - ++ sh-low-gram ::< show telegram + ++ sh-gram ::< show telegram ::> prints the telegram. every fifth message, ::> print the message number also. :: - |= {num/@ud gam/telegram} + |= gam/telegram ^+ +> - ?: =(num count.she) - =. +> ?:(=(0 (mod num 5)) (sh-numb num) +>) - (sh-rend(count.she +(num)) gam) - ?: (gth num count.she) - =. +> (sh-numb num) - (sh-rend(count.she +(num)) gam) - +> + ::TODO is it cool to just assume all messages we print are already stored? + =+ num=(~(got by known) uid.tot.gam) + =. +>.$ + :: if the number isn't directly after latest, print it always. + ?. =(num +(latest.she)) + (sh-numb num) + :: if the number is directly after latest, print every fifth. + ?. =(0 (mod num 5)) +>.$ + (sh-numb num) + (sh-rend(latest.she num) gam) :: - ++ sh-low-grams ::< do show telegrams + ++ sh-grams ::< do show telegrams ::> prints multiple telegrams. :: - |= {num/@ud gaz/(list telegram)} + |= gaz/(list telegram) ^+ +> ?~ gaz +> - $(gaz t.gaz, num +(num), +> (sh-low-gram num i.gaz)) + $(gaz t.gaz, +> (sh-gram i.gaz)) :: -- -- @@ -1670,12 +1620,10 @@ ::> left-pads with spaces. :: |. ^- tape - =+ nym=(~(get by folks) hos.one) + =+ nym=(~(get by nicks) hos.one) ?~ nym (cr-curt |) - ?~ han.u.nym - (cr-curt |) - =+ raw=(trip u.han.u.nym) + =+ raw=(trip u.nym) =+ len=(sub 14 (lent raw)) (weld (reap len ' ') raw) :: @@ -1691,11 +1639,11 @@ ?: =(nom.one inbox) ":" ['%' (trip nom.one)] - ?: =(hos.one (sein our.bol)) - ['/' (trip nom.one)] =+ wun=(scow %p hos.one) ?: =(nom.one (main hos.one)) wun + ?: =(hos.one (sein our.bol)) + ['/' (trip nom.one)] :(welp wun "/" (trip nom.one)) -- :: @@ -1756,6 +1704,7 @@ ++ pr-show ::< render partner ::> renders a partner as text. :: + ::> moy: multiple partners in audience? |= moy/(unit ?) ^- tape ?- -.one @@ -1804,7 +1753,7 @@ ::> remove ourselves from the audience. :: ^+ . - .(lix (~(del in lix) `partner`[%& our.bol inbox])) + .(lix (~(del in lix) `partner`inpan)) :: ++ ar-maud ::< multiple audience ::> checks if there's multiple partners in the @@ -2109,7 +2058,7 @@ ?~ ace wyd (sub wyd u.ace) :- (weld pef (scag end `tape`txt)) - $(txt (slag +(end) `tape`txt), pef (reap (lent pef) ' ')) ::TODO why do we need to cast? + $(txt (slag +(end) `tape`txt), pef (reap (lent pef) ' ')) ::TODO? why do we need to cast? :: $inv :_ ~ @@ -2151,29 +2100,25 @@ [~ +>] ta-done:ta-console:ta :: -++ diff-talk-delta ::< accept change +++ diff-talk-prize ::< accept query answer ::> - ::TODO ++feel :: - |= {way/wire dif/delta} + |= {way/wire piz/prize} ^- (quip move +>) - ta-done:(ta-change:ta dif) + ta-done:(ta-take:ta piz) :: -++ diff-talk-lowdown ::< accept lowdown - ::> incoming talk-lowdown. process it. - ::> we *could* use the wire to identify what story - ::> subscription our lowdown is coming from, but - ::> since we only ever subscribe to a single story, - ::> we don't bother. +++ diff-talk-rumor ::< accept query change + ::> :: - |= {way/wire low/lowdown} - ta-done:(ta-low:ta low) + |= {way/wire dif/rumor} + ^- (quip move +>) + ta-done:(ta-hear:ta dif) :: ++ diff-talk-reaction ::< accept reaction ::> incoming talk reaction. process it. :: |= {way/wire rac/reaction} - ?. =(src.bol -:(broker our.bol)) + ?. =(src.bol -:broker) ~& [%diff-reaction-stranger src.bol] [~ +>] ta-done:(ta-reaction:ta rac) diff --git a/app/talk-guardian.hoon b/app/talk-guardian.hoon index 0e0e1a3f3..7491def55 100644 --- a/app/talk-guardian.hoon +++ b/app/talk-guardian.hoon @@ -17,6 +17,19 @@ :: ::TODO crash on pokes/peers we do not expect :: +::TODO federation should not be present at all in delta-application cores. the +:: way changes are to be applied should be figured out by the delta- +:: geenration cores entirely. +:: +::TODO for using moons as tmp identities for friends: stories may want to keep +:: lists of moons (or just ships in general?) that we define as "standalone" +:: so that the "convert to true identity" doesn't happen for them. +:: +::TODO we need to have something for upward changes on burdens as well. we +:: could use entirely new query for this. to do so, we'd need to add +:: a new code path in front of changes that checks if it's not a config +:: change, and then redirects it to existing arms. +:: /? 151 ::< hoon version /- talk ::< structures /+ talk, time-to-id ::< libraries @@ -36,7 +49,6 @@ outbox/(pair @ud (map @ud thought)) ::< urbit outbox log/(map knot @ud) ::< logged to clay nicks/(map ship knot) ::< nicknames - nik/(map (set partner) char) ::< bound circle glyphs nak/(jug char (set partner)) ::< circle glyph lookup == :: ++ story ::> wire content @@ -49,6 +61,8 @@ ::TODO never gets updated. :: sequence/(map partner @ud) ::< partners heard known/(map serial @ud) ::< messages heard + burden/? ::< from parent? + ::TODO send changes to herited story changes up. == :: ++ river (pair point point) ::< stream definition ++ point ::> stream endpoint @@ -93,7 +107,7 @@ |= old/(unit state) ^- (quip move ..prep) ?~ old - %- f-bake :- %more + %- pre-bake ta-done:ta-init:ta [~ ..prep(+<+ u.old)] :: @@ -103,6 +117,7 @@ ::> small utility functions. ::+| :: +::TODO remove, only used once. ++ strap |*({k/* v/*} (~(put by *(map _k _v)) k v)) ::< map key-value pair :: ::> || @@ -173,9 +188,6 @@ ::> utility functions for data retrieval. ::+| :: - ::TODO functions for getting readers or followers of a specific story from - :: the subs in sup.bol. - :: ++ ta-know ::< story monad ::> produces a gill that takes a gate. ::> if the story {nom} exists, calls the gate with @@ -201,6 +213,8 @@ ::> populate state on first boot. ::> creates our default mailbox and journal. :: + ::TODO but now init it spread out over two arms? ugly! + =< (ta-delta %init ~) :: side-effects %+ roll ^- (list {security knot cord}) :~ [%brown (main our.bol) 'default home'] @@ -216,36 +230,13 @@ |= {src/ship cod/command} ^+ +> ?- -.cod - ::> %review commands prompt us (as a circle host) + ::> %publish commands prompt us (as a circle host) ::> to verify and distribute messages. - $review - (ta-think | src +.cod) - ::> %burden commands ask us to add the sender as a - ::> federator for the specified story, taking the - ::> state it sent into account. - $burden - (ta-burden src +.cod) - ::> %relief commands prompt us to relieve the - ::> specified federators of their duty. - $relief - (ta-relieve src +.cod) + $publish (ta-think | src +.cod) + ::TODO document + $bearing (ta-observe src) == :: - ++ ta-burden ::< accept federator - ::> adds {src} as a federator to story {nom}, - ::> integrating its state into the story. - :: - |= {src/ship nom/knot cof/lobby pes/crowd gaz/(list telegram)} - %- (ta-know nom) |= sor/_so =< so-done - (so-burden:sor src cof pes gaz) - :: - ++ ta-relieve ::< remove federator - ::> removes {who} as federators from story {nom}. - :: - |= {src/ship nom/knot who/(set ship)} - %- (ta-know nom) |= sor/_so =< so-done - (so-relieve:sor src who) - :: ++ ta-action ::< apply reader action ::> performs action sent by a reader. :: @@ -266,7 +257,6 @@ ::+| ++ work ::< perform action ^+ ..ta-action - ::TODO %. +.act ::TODO require deltas as product? ?- -.act :: circle configuration @@ -276,8 +266,6 @@ $filter (action-filter +.act) $permit (action-permit +.act) $delete (action-delete +.act) - $enlist (action-enlist +.act) - $burden (action-burden +.act) :: messaging $convey (action-convey +.act) $phrase (action-phrase +.act) @@ -322,7 +310,6 @@ des [| |] [typ ~] - [[our.bol ~ ~] [our.bol ~ ~]] == %- react [%fail (crip "{(trip nom)}: already exists") `act] @@ -369,48 +356,7 @@ ::> add/remove {pas} as sources for story {nom}. :: |= {nom/knot sub/? pas/(set partner)} - (affect nom %config [our.bol nom] %source sub pas) - :: - ++ action-enlist ::< dis/allow federation - ::> adds {sis} to story {nom}'s list of allowed - ::> federators. - :: - |= {nom/knot fed/? sis/(set ship)} - (affect nom %config [our.bol nom] %federal fed | sis) - :: - ++ action-burden ::< help federate - ::> starts federating the specified circle. create - ::> it locally if it doesn't yet exist. - :: - ::TODO make deltas instead. - ::TODO ...but we'll still need to broadcast this move??? - |= {hos/ship nom/knot} - ^+ ..ta-action - :: update federation config. - :: we don't use the specialized so-arms for this because followers will - :: get notified once we receive updates from {hos} anyway. - =+ new=(~(has by stories) nom) - =. ..ta-action ::TODO =? - ?. new ..ta-action - %^ impact nom %new - :* [[%& hos nom] ~ ~] - *cord - *filter - *control - [[hos ~ ~] [hos ~ ~]] - == - =. ..ta-action ::TODO =? - ?: new ..ta-action - (affect nom %config [our.bol nom] %federal & | [hos ~ ~]) - =. ..ta-action ::TODO =? - ?: new ..ta-action - (affect nom %config [our.bol nom] %federal & & [hos ~ ~]) - ::TODO shouldn't src-adding be included in %fed & & application? - =. ..ta-action ::TODO =? - ?: new ..ta-action - (affect nom %config [our.bol nom] %source & [[%& hos nom] ~ ~]) - :: send %burden command with story's current state. - (ta-delta %bear [hos nom]) + (affect nom %follow sub pas) :: ::> || %messaging ::+| @@ -444,6 +390,8 @@ ::> for every story in the set, update our status. ::TODO accept (set circle). for locals, do directly. :: for remotes, send command. + :: on getting such a command, first check if + :: the sender actually is in our presende map. ::TODO split interface into action-presence and :: action-human. :: @@ -477,26 +425,37 @@ ::> arms that react to subscription events. ::+| :: + ++ ta-observe ::< watch burden bearer + ::> + :: + |= who/ship + ^+ +> + ?. =(our.bol (sein who)) + ~&([%not-our-bearer who] +>) + ~& [%gonna-observe who] + (ta-delta %observe who) + :: ++ ta-subscribe ::< listen to ::> add her to a presence list if applicable. :: + ::TODO change interface to not include path, + :: only call for /circle queries. |= {her/ship pax/path} ^+ +> - :: weird subscription path. - ::TODO catch earlier, just pass nom instead of path? - :: also check story existence earlier maybe? - ?. ?=({$circle @ta *} pax) +> - %- (ta-know i.pax) |= sor/_so =< so-done - (so-attend:sor her %hear [~ ~]) + ?. ?=({@ta *} pax) +> + ?+ -.pax + +> + :: + $burden + (ta-observe her) + :: + $circle + ?. ?=({@ta *} t.pax) +> + %- (ta-know i.t.pax) |= sor/_so =< so-done + (so-attend:sor her %hear [~ ~]) + == :: - ++ ta-leave ::< subscription failed - ::> removes {cir} from story {nom}'s followers. - :: - |= {nom/knot cir/circle} - %- (ta-know nom) |= sor/_so =< so-done - (so-leave:sor %& cir) - :: - ++ ta-cancel ::< unsubscribe + ++ ta-cancel ::< forget ::> drops {src}'s subscription. deduce the right way ::> to do this from the subscription path {pax}. :: @@ -505,22 +464,78 @@ ::TODO catch earlier, just pass nom? ?. ?=({$circle @ta *} pax) +> :: set ship status to %gone. - %- (ta-know i.pax) |= sor/_so =< so-done + %- (ta-know i.t.pax) |= sor/_so =< so-done (so-absent:sor src) :: + ++ ta-greet ::< subscription success + ::> + :: + |= {nom/knot cir/circle} + %- (ta-know nom) |= sor/_so =< so-done + (so-greet:sor %& cir) + :: + ++ ta-leave ::< subscription failed + ::> removes {cir} from story {nom}'s followers. + :: + |= {nom/knot cir/circle} + %- (ta-know nom) |= sor/_so =< so-done + (so-leave:sor %& cir) + :: + ++ ta-take ::< apply prize + ::> + :: + |= {wir/wire piz/prize} + ^+ +> + ?+ -.piz + ~&([%ignoring-prize -.piz] +>) + :: + $burden + %- ta-deltas + %+ roll (~(tap by sos.piz)) + |= {{n/knot b/burden} d/(list delta)} + =- [[%story n %bear b(gaz -)] d] + ::TODO change audiences of messages from (sein our)/n into our/n + %+ turn gaz.b + |= t/telegram + =- t(aud.tot -) + =/ oud + (~(get by aud.tot.t) [%& (sein our.bol) n]) + ?~ oud ::TODO seems like it should never occur? + ~& %unexpected-parent-not-audience + aud.tot.t + =. aud.tot.t + (~(del by aud.tot.t) [%& (sein our.bol) n]) + (~(put by aud.tot.t) [%& our.bol n] u.oud) + :: + $circle + =+ res=(tmp-parse-diff-path wir) + %- (ta-know p.res) |= sor/_so =< so-done + (so-take:sor q.res +.piz) + == + :: ++ ta-hear ::< apply rumor ::> :: - |= {det/knot src/partner dif/rumor} + |= {wir/wire dif/rumor} ^+ +> ?+ -.dif ~&([%ignoring-rumor -.dif] +>) + :: + $burden + ~& [%hear-burden -.dif.dif] + ?+ -.dif.dif + %- (ta-know nom.dif) |= sor/_so =< so-done + (so-hear:sor & [our.bol nom.dif] dif.dif) + :: + $new + ::TODO we make a %bear delta with just the config set. + (ta-delta %story nom.dif %bear ~ [con.dif.dif ~] [~ ~]) + == :: $circle - ?. ?=($& -.src) - ~&([%unexpected-rumor -.dif src] +>) - %- (ta-know det) |= sor/_so =< so-done - (so-hear-circle:sor p.src dif.dif) + =+ res=(tmp-parse-diff-path wir) + %- (ta-know p.res) |= sor/_so =< so-done + (so-hear:sor | q.res dif.dif) == :: ::> || @@ -644,6 +659,12 @@ ^+ +> +>(deltas [dif deltas]) :: + ++ so-deltas ::< send delta list + ::> + :: + |= dis/(list delta) + %_(+> deltas (welp (flop dis) deltas)) + :: ++ so-delta-our ::< send delta of us ::> adds a delta about this story. :: @@ -660,122 +681,60 @@ ++ so-pan [%& our.bol nom] ::< us as partner ++ so-cir [our.bol nom] ::< us as circle :: - ++ so-right ::< is federator? - ::> checks whether partner {pan} has authority - ::> over this story. - :: - |= pan/partner - ?& ?=($& -.pan) - =(nom nom.p.pan) - (~(has in fes.fed.shape) hos.p.pan) - == - :: ::> || ::> || %interaction-events ::> || ::> arms that apply events we received. ::+| :: - ++ so-hear-circle ::< accept circle rumor + ++ so-take ::< accept circle prize ::> :: - |= {src/circle dif/diff-story} + |= {src/circle gaz/(list telegram) cos/lobby pes/crowd} ^+ +> - ?. (~(has in src.shape) [%& src]) - ~&([%unexpected-rumor -.dif src] +>) - :: rumor from federator? apply to us. - =. src ::TODO =? - ?: (so-right [%& src]) so-cir - src - ?- -.dif - $new $(dif [%config src %full con.dif]) - $grams (so-lesson gaz.dif) - $config :: ignore foreign mirrors. - ?. |(=(src cir.dif) =(src so-cir)) +> - (so-delta-our dif) - $status :: ignore foreign remotes. - ?. |(=([%& src] pan.dif) =(src so-cir)) +> - (so-delta-our dif) - $remove (so-delta-our %config src %remove ~) - == - :: - ++ so-burden ::< accept federator - ::> if {src} is allowed to, have it federate this - ::> story. - ::> starts by assimilating {src}'s state into our - ::> own (giving priority to local state), removing - ::> redundant data, then sending updated state to - ::> all followers. - :: - |= {src/ship cof/lobby pes/crowd gaz/(list telegram)} - ^+ +> - :: continue if permitted and not yet done. - ?. (~(has in may.fed.shape) src) +> - ?: (~(has in fes.fed.shape) src) +> - :: assimilate config. - =. +> - =+ nec=shape - :: adopt security list if they're similar. - =. ses.con.nec ::TODO =? - ?. .= ?=(?($white $green) sec.con.nec) - ?=(?($white $green) sec.con.loc.cof) - ses.con.nec - (~(uni in ses.con.nec) ses.con.loc.cof) - =. fes.fed.nec - (~(put in fes.fed.nec) src) - =. src.nec - (~(put in src.nec) [%& src nom]) - ::TODO maybe do more granular deltas later. - (so-delta-our %config so-cir %full nec) - :: assimilate presence and remotes. - ::TODO!!! just delta my shit up famalam. - ::TODO should totally just make an arm that calculates deltas given - :: old and new inputs. - ::=. locals (~(uni by loc.pes) locals) - ::=. remotes (~(uni by rem.pes) remotes) - ::=. mirrors (~(uni by rem.cof) mirrors) - :::: remove redundant remotes. - ::=. remotes - :: %- ~(gas by *_remotes) - :: %+ murn (~(tap by remotes)) - :: |= {p/partner g/group} - :: ^- (unit {partner group}) - :: ?: ?& ?=($& -.p) - :: =(nom.p.p nom) - :: (~(has in fes.fed.shape) hos.p.p) - :: == - :: ~ - :: `[p g] - :::: remove redundant mirrors. - ::=. mirrors - :: %- ~(gas by *_mirrors) - :: %+ murn (~(tap by mirrors)) - :: |= {c/circle f/config} - :: ^- (unit {circle config}) - :: ?: ?& =(nom.c nom) - :: (~(has in fes.fed.shape) hos.c) - :: == - :: ~ - :: `[c f] - :: finally, learn all grams. + =. +>.$ + (so-hear | src %config src %full loc.cos) + ::TODO we'd need a %precs diff-story for this if we don't want to urn... + =. +>.$ + %- ~(rep in loc.pes) + |= {{w/ship s/status} _+>.$} + (so-hear | src %status [%& src] w %full s) (so-lesson gaz) :: - ++ so-relieve ::< remove federator - ::> if {src} is allowed to, removes {who} as - ::> federators from this story. + ++ so-hear ::< accept circle rumor + ::> :: - |= {src/ship who/(set ship)} + |= {bur/? src/circle dif/diff-story} ^+ +> - ?. (~(has in fes.fed.shape) src) +> - =+ wos=(~(uni in fes.fed.shape) who) - ?~ wos +>.$ - =. +>.$ - (so-delta-our %config so-cir %federal | & wos) - %- so-delta-our - :+ %config so-cir - :+ %source | - %- ~(run in `(set ship)`wos) ::TODO? why need to cast? - |=(s/ship [%& s nom]) + ::TODO? these checks are still important, because + :: when things are slow we may get diffs from + :: things we already unsubscribed from, right? + ::TODO account for federation. + ~? ?! ?| (~(has in sre.shape) [%& src]) + =(src so-cir) + == + [%unexpected-rumor-source nom -.dif src] + ?- -.dif + ::TODO we check for foreigns here, but they should just not get sent + :: in the first place. update ++-change or whatever! + :: (we don't care for remote remotes, etc.) + $new $(dif [%config src %full con.dif]) + $bear ~&(%so-hear-unexpected-bear +>) + $grams (so-lesson gaz.dif) + $config ::TODO accept burden change by parents. + :: ignore foreign mirrors. + ?. |(=(src cir.dif) =(src so-cir)) + ~& %unexpected-ignoring-remote-config + +> + (so-delta-our dif) + $status :: ignore foreign remotes. + ?. |(=([%& src] pan.dif) =(src so-cir)) + ~& %unexpected-ignoring-remote-status + +> + (so-delta-our dif) + $follow ~&(%follow-not-rumor +>) ::TODO crash? + $remove (so-delta-our %config src %remove ~) + == :: ::> || ::> || %changes @@ -789,10 +748,10 @@ |= {add/? pas/(set partner)} ^+ +> =/ sus/(set partner) - %. src.shape + %. sre.shape ?:(add ~(dif in pas) ~(int in pas)) ?~ sus +>.$ - (so-delta-our %config so-cir %source add sus) + (so-delta-our %follow & sus) :: ++ so-depict ::< change description ::> modifies our caption. @@ -810,28 +769,6 @@ ?: =(fit fit.shape) +> (so-delta-our %config so-cir %filter fit) :: - ++ so-federate ::< change federators - ::> adds or removes sis as active/allow - ::> ({fed} y/n) federators. - :: - |= {add/? fed/? sis/(set ship)} - =+ ses=?:(fed fes.fed.shape may.fed.shape) - =/ sus/(set ship) - %. ses - ?:(add ~(dif in sis) ~(int in sis)) - ?~ sus +>.$ - :: we also take care of the %src delta because we - :: want to keep delta application as simple as - :: possible. - =. +>.$ ::TODO =? - ?. fed +>.$ - %- so-delta-our - :+ %config so-cir - :+ %source add - %- ~(run in `(set ship)`sus) ::TODO weird casting need, depends on ?~ - |= s/ship [%& s nom] - (so-delta-our %config so-cir %federal add fed sus) - :: ++ so-delete ::< delete story ::> deletes this story. removes it from {stories} ::> and unsubscribes from all src. @@ -860,13 +797,21 @@ ::> arms for starting and ending subscriptions ::+| :: - ++ so-leave ::< unsub from source + ++ so-greet ::< subscription started + ::> + :: + |= pan/partner + ^+ +> + ?: (~(has in sre.shape) pan) +> + (so-delta-our %config so-cir %sourcee & [pan ~ ~]) + :: + ++ so-leave ::< subscription ended ::> delete {pan} from our sources. :: |= pan/partner ^+ +> - ?. (~(has in src.shape) pan) +> - (so-delta-our %config so-cir %source | [pan ~ ~]) + ?. (~(has in sre.shape) pan) +> + (so-delta-our %config so-cir %sourcee | [pan ~ ~]) :: ++ so-start ::< subscribe follower ::> called upon subscribe. deduces the range of @@ -978,22 +923,23 @@ |= gam/telegram ^+ +> :: check for write permissions. - ?. (so-admire aut.gam) +>.$ + ?. (so-admire aut.gam) +> :: clean up the message to conform to our rules. =. tot.gam (so-sane tot.gam) =. aud.tot.gam ::> if we are in the audience, mark as received. - =+ ole=(~(get by aud.tot.gam) [%& our.bol nom]) - ?^ ole (~(put by aud.tot.gam) [%& our.bol nom] -.u.ole %received) - ::> federated circles need to pretend ~src/nom - ::> is also ~our/nom. + =+ ole=(~(get by aud.tot.gam) so-pan) + ?^ ole (~(put by aud.tot.gam) so-pan -.u.ole %received) + ::TODO can we delete the below? seems old federation? ::TODO pass src through explicitly instead of :: relying on src.bol. + ::TODO? ^ why? =+ ole=(~(get by aud.tot.gam) [%& src.bol nom]) ?~ ole aud.tot.gam - ::> as described above, fake src into our. + ::TODO below line is old federation, but should work for our current + :: use case, right? why doesn't it? =. aud.tot.gam (~(del by aud.tot.gam) [%& src.bol nom]) - (~(put by aud.tot.gam) [%& our.bol nom] -.u.ole %received) + (~(put by aud.tot.gam) so-pan -.u.ole %received) (so-delta-our %grams [gam ~]) :: ::> || @@ -1046,8 +992,8 @@ |= her/ship ^- ? ?- sec.con.shape - $black !(~(has in ses.con.shape) her) ::< channel, blacklist - $white (~(has in ses.con.shape) her) ::< village, whitelist + $black !(~(has in ses.con.shape) her) ::< channel, blacklist + $white (~(has in ses.con.shape) her) ::< village, whitelist $green & ::< journal, all $brown (team our.bol her) ::< mailbox, our team == @@ -1096,41 +1042,19 @@ ++ da-react ::< send reaction ::> sends a talk-reaction diff to a reader. :: - ::TODO send the delta instead! (remove bone from delta: always ost.bol?) + ::TODO argument always ost.bol? seems to be that way |= {red/bone rac/reaction} %- da-emit + ~? !=(red ost.bol) %react-different-bones ::TODO is diff the way to react to a poke? [red %diff %talk-reaction rac] :: - ++ da-bear ::< share burden - ::> - :: - |= cir/circle - =+ soy=(~(got by stories) nom.cir) - %- da-emit - :* ost.bol - %poke - /burden - [hos.cir %talk-guardian] - :* %talk-command - %burden - nom.cir - [shape.soy mirrors.soy] - [locals.soy remotes.soy] - grams.soy - == - == - :: ::> || ::> || %data ::> || ::> utility functions for data retrieval. ::+| :: - ::TODO functions for getting readers or followers of a specific story from - :: the subs in sup.bol. - :: but maybe just on the outer core... - :: ::> || ::> || %change-application ::> || @@ -1154,11 +1078,43 @@ $glyph (da-change-glyph +.dif) $nick (da-change-nick +.dif) $story (da-change-story +.dif) - $bear (da-bear +.dif) + $init da-init + $observe (da-observe +.dif) $react (da-react +.dif) $quit (da-emit [ost.dif %quit ~]) == :: + ++ da-init ::< startup side-effects + ::> + :: + =+ sen=(sein our.bol) + ::TODO move this logic to ta-init + ?: ?| !=(%czar (clan sen)) + =(sen our.bol) + =(%pawn (clan our.bol)) + == + ..da-init + %- da-emit + :* 0 + %peer + /burden + [sen %talk-guardian] + /burden + == + :: + ++ da-observe ::< watch burden bearer + ::> + :: + |= who/ship + ~& [%peering-report who] + %- da-emit + :* 0 + %peer + /report + [who %talk-guardian] + /report + == + :: ++ da-change-out ::< outgoing messages ::> :: @@ -1170,25 +1126,31 @@ :* %poke /repeat/(scot %ud p.outbox)/(scot %p hos.cir)/[nom.cir] [hos.cir %talk-guardian] - [%talk-command %review i.out ~] + [%talk-command %publish i.out ~] == - $(p.outbox +(p.outbox), q.outbox (~(put by q.outbox) p.outbox i.out)) + %= $ + p.outbox +(p.outbox) + q.outbox (~(put by q.outbox) p.outbox i.out) + out t.out + == :: ++ da-change-done ::< sent & receives msgs ::> :: - |= don/(list {num/@ud who/partner gud/?}) + ::TODO this needs a lot of work, maybe? + :: make this dumber, make the ++ta equivalent smarter! + |= don/(list {num/@ud who/partner fal/(unit tang)}) ^+ +> ?~ don +> =+ oot=(~(get by q.outbox) num.i.don) - ?~ oot ~|([%da-change-done-none num.i.don] !!) + ?~ oot ~&([%da-change-done-none num.i.don] +>.$) ::TODO crash? =. aud.u.oot =+ olg=(~(got by aud.u.oot) who.i.don) %+ ~(put by aud.u.oot) who.i.don :- -.olg - ?:(gud.i.don %received %rejected) + ?~(fal.i.don %received ~>(%slog.[0 u.fal.i.don] %rejected)) =. +>.$ - +>.$ ::TODO!!! da-think?????????? + +>.$ ::TODO!!! da-think??? $(q.outbox (~(del by q.outbox) num.i.don)) ::|= {num/@ud pan/partner fal/(unit tang)} ::=+ oot=(~(get by q.outbox) num) @@ -1210,7 +1172,6 @@ ^+ +> ?: bin %_ +> - nik (~(put by nik) pas gyf) nak (~(put ju nak) gyf pas) == =/ ole/(list (set partner)) @@ -1219,7 +1180,6 @@ |- ^+ +>.^$ ?~ ole +>.^$ %_ $ - nik (~(del by nik) i.ole) nak (~(del ju nak) gyf i.ole) ole t.ole == @@ -1244,34 +1204,40 @@ :: |= {nom/knot dif/diff-story} ^+ +> - ::TODO just ~(got by stories) everywhere in ++da, the - :: relevant checks should be made when constructing - :: the deltas. ?+ -.dif sa-done:(~(sa-change sa nom (~(got by stories) nom)) dif) :: $new (da-create nom +.dif) + $bear (da-bear nom +.dif) $remove (da-delete nom) == :: ++ da-create ::< configure story ::> creates story {nom} with config {con}. :: - |= {nom/knot con/config} + |= {nom/knot cof/config} ^+ +> :: if it's a whitelisted circle, put us in it. - =. ses.con.con ::TODO =? - ?: ?=(?($white $green) sec.con.con) + =. ses.con.cof ::TODO =? + ?: ?=(?($white $green) sec.con.cof) [our.bol ~ ~] - ses.con.con - :: also ensure we're listed as a federator. - =. may.fed.con - (~(put in may.fed.con) our.bol) - =. fes.fed.con - (~(put in fes.fed.con) our.bol) + ses.con.cof + :: make sure it's its own source. + ::TODO? is this... necessary? probably, for other circle's reference... + =. sre.cof + (~(put in sre.cof) [%& our.bol nom]) =< sa-done - %- ~(sa-change sa nom *story) - [%config [our.bol nom] %full con] + :: default for ? is &, so we manually set to | now. + %- ~(sa-change sa nom %*(. *story burden |)) + [%config [our.bol nom] %full cof] + :: + ++ da-bear ::< accept new burden + ::> + :: + |= {nom/knot bur/burden} + ^+ +> + =+ soy=(fall (~(get by stories) nom) *story) + sa-done:(~(sa-bear sa nom soy) bur) :: ++ da-delete ::< delete story ::> calls the story core to delete story {nom}. @@ -1325,6 +1291,14 @@ (flop (turn cub |=(a/card [ost a]))) :: ::> || + ::> || %data ::TODO consistent naming! + ::> || + ::+| + :: + ++ sa-cir [our.bol nom] + ++ sa-pan [%& our.bol nom] + :: + ::> || ::> || %delta-application ::> || ::> arms for applying deltas. @@ -1333,12 +1307,48 @@ ++ sa-delete ::< deletion of story ::> :: - (sa-abjure (~(tap in src.shape))) + (sa-abjure (~(tap in sre.shape))) + :: + ++ sa-bear ::< ... + ::> + ::> for now, just overwrite all existing state. + :: + ::TODO should we calculate these changes in + :: ++so instead? the change to burden is + :: distinct, but everything else is just + :: more of the same deltas. + |= {gaz/(list telegram) cos/lobby pes/crowd} + ^+ +> + :: local config + =. +> + (sa-change-local %config sa-cir %full loc.cos) + :: remote config + =. +> + %+ roll (~(tap by rem.cos)) + |= {{r/circle c/config} _..sa-bear} + (sa-change-remote %config r %full c) + :: local presence + =. +> + %+ roll (~(tap by loc.pes)) + |= {{w/ship s/status} _..sa-bear} + (sa-change-local %status sa-pan w %full s) + :: remote presence + =. +> + %+ roll (~(tap by rem.pes)) + |= {{p/partner g/group} _..sa-bear} + %+ roll (~(tap by g)) + |= {{w/ship s/status} _..sa-bear} + (sa-change-remote %status p w %full s) + :: telegrams + =. +> + %+ roll gaz + |= {g/telegram _..sa-bear} + (sa-change-gram g) + :: burden flag + +>(burden &) :: ++ sa-change ::< apply circle delta ::> - ::> we don't do checks for federation here, this - ::> should have happened during delta generation. :: |= dif/diff-story ^+ +> @@ -1347,7 +1357,7 @@ sa-change-local :: $config - ?: =(cir.dif [our.bol nom]) + ?: =(cir.dif sa-cir) sa-change-local sa-change-remote :: @@ -1368,7 +1378,7 @@ $grams |- ^+ +>.^$ ?~ gaz.dif +>.^$ - =. +>.^$ (sa-change-grams i.gaz.dif) + =. +>.^$ (sa-change-gram i.gaz.dif) $(gaz.dif t.gaz.dif) :: $config @@ -1385,9 +1395,23 @@ (fall (~(get by locals) who.dif) *status) dif.dif == + :: + $follow + :: we have to do the effects first, because it + :: checks for new sub targets using sre.shape. + ~& [%sa-change-follow nom sub.dif pas.dif] + =. +> + (sa-emil (sa-follow-effects sub.dif pas.dif)) + %_ +> ::TODO delete, only done once success + sre.shape ::TODO =? + %. pas.dif + ?: sub.dif + ~(uni in sre.shape) + ~(dif in sre.shape) + == == :: - ++ sa-change-grams ::< save/update message + ++ sa-change-gram ::< save/update message ::> :: |= gam/telegram @@ -1439,61 +1463,62 @@ ++ sa-config-effects ::< config side-effects ::> :: + ::TODO we shouldn't even be applying %full diffs, only their results! |= {old/config dif/diff-config} ^- (list move) ?+ -.dif ~ - $source (sa-source-effects src.old +.dif) $permit (sa-permit-effects sec.con.old ses.con.old +.dif) - :: - $federal - ?. fed.dif ~ - %^ sa-source-effects src.old add.dif - %- ~(run in sis.dif) - |= s/ship [%& s nom] :: $full + ~& %full-config-changes =* new cof.dif :: deal with subscription changes. =/ sem .= ?=(?($white $green) sec.con.new) ?=(?($white $green) sec.con.old) ;: weld - (sa-source-effects src.old | (~(dif in src.old) src.new)) - (sa-source-effects src.old & (~(dif in src.new) src.old)) + ::TODO but these needs to be treated as %sourcee, right? + ::(sa-follow-effects | (~(dif in sre.old) sre.new)) + ::(sa-follow-effects & (~(dif in src.new) src.old)) + :: ?. sem ~ %^ sa-permit-effects sec.con.new ses.con.old [| (~(dif in ses.con.old) ses.con.new)] + :: ?. sem ~ %^ sa-permit-effects sec.con.new ses.con.old [& (~(dif in ses.con.new) ses.con.old)] - ::TODO maybe do federal source changes, but also take above source - :: changes into account: don't do doubles! == == :: - ++ sa-source-effects ::< un/subscribe + ++ sa-follow-effects ::< un/subscribe ::> :: - |= {old/(set partner) add/? pas/(set partner)} + |= {sub/? pas/(set partner)} ^- (list move) =/ sus/(set partner) - %. old - ?:(add ~(dif in pas) ~(int in pas)) - %. (~(tap in `(set partner)`sus)) ::TODO *need* to cast? - ?:(add sa-acquire sa-abjure) + %. sre.shape + ?:(sub ~(dif in pas) ~(int in pas)) + %. (~(tap in sus)) + ?:(sub sa-acquire sa-abjure) :: ++ sa-permit-effects ::< notify permitted ::> :: + ::TODO this seems to also be done in the action, + :: there makes more sense because logic goes into ta. |= {sec/security old/(set ship) add/? sis/(set ship)} ^- (list move) + =/ sus/(set ship) + %. ses.con.shape + ?:(add ~(dif in sis) ~(int in sis)) =/ wyt ?=(?($white $green) sec) =/ inv =(wyt add) ?: inv ::TODO %inv & speeches ~ ::TODO %inv | speeches - (sa-eject sis) + (sa-eject sus) :: ::> || ::> || %subscriptions @@ -1510,6 +1535,7 @@ %+ turn pas |= pan/partner ^- (list card) + ?: =(pan [%& our.bol nom]) ~ :: ignore self-subs ::TODO also abjure? ::> subscribe starting at the last message we got, ::> or if we haven't gotten any yet, messages ::> from up to a day ago. @@ -1543,6 +1569,7 @@ $& ::< circle partner :_ ~ :* %pull + ::TODO update path /friend/show/[nom]/(scot %p hos.p.pan)/[nom.p.pan] [hos.p.pan %talk-guardian] ~ @@ -1559,7 +1586,7 @@ [b %quit ~] :: ++ sa-unearth ::< ships' bones - ::> find the bones in {followers} that belong to + ::> find the bones in {sup.bol} that belong to ::> a ship in {sis}. :: |= sis/(set ship) @@ -1642,54 +1669,112 @@ :_ +>.$ :(welp mos (affection dif)) :: +++ pre-bake ::< apply more deltas + ::> + :: + |= dis/(list delta) + ^- (quip move +>) + %+ roll dis + |= {d/delta m/(list move) _+>.$} ::TODO ^$ nest-fails, is this correct? + =^ mos +>.^$ (f-bake d) + [(welp m mos) +>.^$] +:: ++ g-query ::< query on state ::> :: |= weg/(list coin) - ::TODO how would the system know how to parse the path? - :: should we define that ourselves? - :: ...i just want to cast to ++query if i can. ::TODO should return (unit prize)? ie for /circle/non-existing ^- prize - ?~ weg ~&(%empty-query !!) - ?: =(i.weg [%$ %tas %reader]) + =+ qer=(coins-to-query weg) + ?- -.qer + $reader [%reader nak nicks] - ?: =(i.weg [%$ %tas %friend]) + :: + $friend :- %friend %- ~(gas in *(set circle)) %+ murn - =- (~(tap in src.shape.-)) + =- (~(tap in sre.shape.-)) (~(got by stories) (main our.bol)) |= p/partner ^- (unit circle) ?. ?=($& -.p) ~ [~ p.p] - ?: ?& =(i.weg [%$ %tas %circle]) - ?=(^ t.weg) - ?=({$$ p/$ta q/@ta} i.t.weg) - == + :: + $burden + :- %burden + %- ~(gas in *(map knot burden)) + %+ murn (~(tap by stories)) + |= {n/knot s/story} + ^- (unit (pair knot burden)) + :: only auto-federate channels for now. + ?. ?=($black sec.con.shape.s) ~ + :+ ~ n + :+ grams.s + [shape.s mirrors.s] + [locals.s remotes.s] + :: + $report + ::TODO want to return no prize + [%friend ~] + :: + $circle :- %circle - =+ soy=(~(got by stories) +>.i.t.weg) + =+ soy=(~(got by stories) nom.qer) :+ grams.soy ::TODO get using specified range. [shape.soy mirrors.soy] [locals.soy remotes.soy] - ~&(%invalid-query !!) + == +:: +++ tmp-their-change ::< diff-story to theirs + ::> + :: + |= {who/ship dif/diff-story} + ^- diff-story + ?+ -.dif + dif + :: + $config + ?. =(hos.cir.dif our.bol) dif + dif(cir [who nom.cir.dif]) + :: + $status + ?. &(?=($& -.pan.dif) =(hos.p.pan.dif our.bol)) dif + dif(pan [%& who nom.p.pan.dif]) + == +:: +++ tmp-clean-change ::< remove remotes + ::> + :: + |= {nom/knot dif/diff-story} + ^- (unit diff-story) + ?+ -.dif + `dif + :: + $config + ?. =(cir.dif [our.bol nom]) ~ + `dif + :: + $status + ?. =(pan.dif [%& our.bol nom]) ~ + `dif + == :: ++ i-change ::< delta to rumor ::> :: - ::TODO probably want to do "affected by" checks for every bone, - :: and just construct the rumor once. - |= {weg/(list coin) dif/delta} + |= {who/ship weg/(list coin) dif/delta} ^- (unit rumor) - ?~ weg ~&(%empty-query !!) - ?: =(i.weg [%$ %tas %reader]) + =+ qer=(coins-to-query weg) + ?- -.qer + $reader :: changes to shared ui state apply. ?+ -.dif ~ $glyph `[%reader dif] $nick `[%reader dif] == - ?: =(i.weg [%$ %tas %friend]) + :: + $friend :: new or removed local stories apply. ::TODO include mailbox sources. check privacy flags. ?. ?=($story -.dif) ~ @@ -1700,50 +1785,91 @@ == ?~ add ~ `[%friend u.add [our.bol nom.dif]] - ?: ?& =(i.weg [%$ %tas %circle]) - ?=(^ t.weg) - ?=({$$ p/$ta q/@ta} i.t.weg) - == + :: + $burden + ::TODO only avoid src.bol when they sent a burden or similar? + ::TODO shouldn't this prevent senders from getting their message echoed + :: to them? + ?: =(who src.bol) ~ ?. ?=($story -.dif) ~ - ?. =(+>.i.t.weg nom.dif) ~ + :: only burden channels for now. + ?. =(%black sec.con.shape:(~(got by stories) nom.dif)) ~ + ~& [%sending-burden nom.dif -.dif.dif who] + `[%burden nom.dif (tmp-their-change who dif.dif)] + :: + $report + :: only send changes we didn't get from above. + ?: =(src.bol (sein our.bol)) ~ + :: only send story reports about grams and status. + ?. ?=($story -.dif) ~ + ?. ?=(?($grams $status) -.dif.dif) ~ + =+ soy=(~(got by stories) nom.dif) + :: and only if the story is inherited. + ?. burden.soy ~ + :: only burden channels for now. + ?. =(%black sec.con.shape.soy) ~ + ~& [%sending-report nom.dif -.dif.dif who] + `[%burden nom.dif (tmp-their-change who dif.dif)] + :: + $circle + ?. ?=($story -.dif) ~ + ?. =(nom.qer nom.dif) ~ + ?: ?=($follow -.dif.dif) ~ :: internal-only delta + ~& [%sending-circle nom.dif -.dif.dif who] `[%circle dif.dif] - ~&(%invalid-query !!) + == :: ++ affection ::< rumors to interested ::> :: ::TODO probably want to do "affected by" checks for every bone, - :: and just construct the rumor once. + :: and just construct the rumor once. |= dif/delta ^- (list move) %+ murn (~(tap by sup.bol)) |= {b/bone s/ship p/path} ^- (unit move) - =+ rum=(i-change (tmp-parse-path p) dif) + =+ rum=(i-change s (path-to-coins p) dif) ::TODO %quit bones that are done with their subscription. :: ...but that would also require a ta-cancel call to remove :: them from the presence list! how do? ?~ rum ~ `[b %diff %talk-rumor u.rum] :: -++ tmp-parse-path ::< ... +++ path-to-query ::< ... + ::> + :: + |= pax/path + (coins-to-query (path-to-coins pax)) +:: +++ path-to-coins ::< ... ::> :: |= pax/path ^- (list coin) - ?~ pax ~ - :- [%$ %tas `@tas`i.pax] - ?. =(%circle `@tas`i.pax) ~ - ?~ t.pax ~&(%invalid-circle-path !!) - :- [%$ %ta `@ta`i.t.pax] - ~ - ::=+ tmp=((hard range) t.t.pax) - ::?~ tmp ~ - :::- hed.u.tmp - ::?~ t.u.tmp ~ - ::[tal.u.t.u.tmp ~] + %+ turn `path`pax + |= a/@ta + (need (slay a)) :: -++ tmp-parse-peer-path ::< ... +++ coins-to-query ::< ... + ::> + :: + ^- $-((list coin) query) + ::TODO silently crashes, make it loud! + => depa + |^ %- af :~ + [%reader ul] + [%friend ul] + [%burden ul] + [%report ul] + [%circle (al knot rang)] + == + ++ knot (do %tas) + ++ rang (mu (al plac (mu (un plac)))) + ++ plac (or %da %ud) + -- +:: +++ tmp-parse-diff-path ::< ... ::> :: |= pax/path @@ -1759,25 +1885,18 @@ :: |= {who/ship weg/(list coin)} ^- ? - ::TODO - ::?: ?=({$reader *} pax) - :: ?. (team our.bol her) - :: %- ta-note - :: (crip "foreign reader {(scow %p her)}") - :: (ta-welcome ost.bol t.pax) - :::: weird subscription path. - ::?. ?=({@ *} pax) - :: (ta-evil %bad-path) - ::=+ pur=(~(get by stories) i.pax) - ::?~ pur - :: ::TODO send this to the subscriber! make them unsub! - :: %- ta-note - :: (crip "bad subscribe story '{(trip i.pax)}'") - ::=+ soy=~(. so i.pax `(list action)`~ u.pur) :: nest-fail if no cast - :::: she needs read permissions to subscribe. - ::?. (so-visible:soy her) - :: (ta-evil %no-story) - & + =+ qer=(coins-to-query weg) + ?- -.qer + $reader (team our.bol who) + $friend & + $burden =(our.bol (sein who)) + $report =(who (sein our.bol)) + :: + $circle + ?. (~(has by stories) nom.qer) | + %. who + ~(so-visible so:ta nom.qer ~ (~(got by stories) nom.qer)) + == :: ::> || ::> || %poke-events @@ -1790,7 +1909,7 @@ |= cod/command ^- (quip move +>) =^ mos +>.$ - %- f-bake :- %more + %- pre-bake ta-done:(ta-apply:ta src.bol cod) =^ mow +>.$ log-all-to-file @@ -1802,11 +1921,11 @@ |= act/action ^- (quip move +>) ?. (team src.bol our.bol) - %- f-bake :- %more + %- pre-bake =< ta-done %- ta-note:ta %- crip "talk-action stranger {(scow %p src.bol)}" - %- f-bake :- %more + %- pre-bake ta-done:(ta-action:ta ost.bol act) :: ::> || @@ -1814,16 +1933,26 @@ ::> || ::+| :: +++ diff-talk-prize ::< accept prize + ::> + :: + |= {wir/wire piz/prize} + ^- (quip move +>) + =^ mos +>.$ + %- pre-bake + ta-done:(ta-take:ta wir piz) + =^ mow +>.$ + log-all-to-file + [(welp mos mow) +>.$] +:: ++ diff-talk-rumor ::< accept rumor ::> :: |= {wir/wire dif/rumor} ^- (quip move +>) =^ mos +>.$ - %- f-bake :- %more - ::TODO parse wire to get source and target of change - =+ res=(tmp-parse-peer-path wir) - ta-done:(ta-hear:ta p.res [%& q.res] dif) + %- pre-bake + ta-done:(ta-hear:ta wir dif) =^ mow +>.$ log-all-to-file [(welp mos mow) +>.$] @@ -1834,22 +1963,21 @@ |= pax/path ^- (quip move +>) ?: ?=({$sole *} pax) ~&(%talk-broker-no-sole !!) - =+ qer=(tmp-parse-path pax) + =+ qer=(path-to-coins pax) ?. (leak src.bol qer) ~&(%peer-invisible !!) =^ mos +>.$ - %- f-bake :- %more + %- pre-bake ta-done:(ta-subscribe:ta src.bol pax) :_ +>.$ :_ mos [ost.bol %diff %talk-prize (g-query qer)] - :: ++ pull ::< unsubscribe ::> unsubscribes. :: |= pax/path ^- (quip move +>) - %- f-bake :- %more + %- pre-bake ta-done:(ta-cancel:ta src.bol pax) :: ++ reap-friend ::< subscription n/ack @@ -1859,12 +1987,14 @@ ::TODO this should deal with /reader subscriptions too. |= {wir/wire fal/(unit tang)} ^- (quip move +>) - ?~ fal [~ +>] %+ etch-friend [%friend wir] |= {nom/knot cir/circle} + ?~ fal + %- pre-bake + ta-done:(ta-greet:ta nom cir) =. u.fal [>%reap-friend-fail nom cir< u.fal] %- (slog (flop u.fal)) - %- f-bake :- %more + %- pre-bake ta-done:(ta-leave:ta nom cir) :: ++ quit-friend ::< dropped subscription @@ -1891,7 +2021,7 @@ ^- (quip move +>) %+ etch-repeat [%repeat wir] |= {num/@ud src/ship nom/knot} - (f-bake %done (strap num [%& src nom] ?=($~ fal))) + (f-bake %done (strap num [%& src nom] fal)) :: ::> || ::> || %logging diff --git a/app/talk.hoon b/app/talk.hoon deleted file mode 100644 index c7452a07f..000000000 --- a/app/talk.hoon +++ /dev/null @@ -1,2894 +0,0 @@ -:: :: :: -:::: /hoon/talk/app :: :: - :: :: :: -:: -::TODO master changes -::TODO =/ instead of =+ ^= where possible -::TODO avoid lark where possible -::TODO remove old/unused code -::TODO improve naming -::TODO tidiness -:: -/? 310 :: hoon version -/- talk, sole :: structures -/+ talk, sole, time-to-id, twitter :: libraries -/= seed /~ !>(.) -:: -:::: - :: -::x include talk and sole cores from the /+ include into our subject, -::x so we can do some-arm instead of some-arm:talk. -[. talk sole] -=> |% :: data structures - ++ house {$6 house-6} :: full state - ++ house-any :: app history - $% {$3 house-3} :: 3: talk - {$4 house-4} :: 4: talk - {$5 house-5} :: 5: talk - {$6 house-6} :: 5: talk - == :: - ++ house-3 :: - %+ cork house-4 |= house-4 :: modern house with - +<(stories (~(run by stories) story-3)) :: old stories - ++ house-4 :: - %+ cork house-5 |= house-5 :: modern house with - +<(shells (~(run by shells) shell-4)) :: no settings - ++ house-5 :: - %+ cork house-6 |= house-6 :: modern house with - +<(shells (~(run by shells) shell-5)) :: auto-audience - ++ house-6 :: - $: stories/(map knot story) :: conversations - general/(set bone) :: meta-subscribe - outbox/(pair @ud (map @ud thought)) :: urbit outbox - folks/(map ship human) :: human identities - shells/(map bone shell) :: interaction state - log/(map knot @ud) :: logged to clay - nik/(map (set partner) char) :: bound station glyphs - nak/(jug char (set partner)) :: station glyph lookup - == :: - ++ story-3 (cork story |=(story +<(|10 &11.+<))) :: missing glyphers - ++ story :: wire content - $: count/@ud :: (lent grams) - grams/(list telegram) :: all history - locals/(map ship (pair @da status)) :: local presence - remotes/(map partner atlas) :: remote presence - mirrors/(map station config) :: remote config - sequence/(map partner @ud) :: partners heard - shape/config :: configuration - known/(map serial @ud) :: messages heard - gramsers/(map bone river) :: message followers - groupers/(set bone) :: presence followers - cabalers/(set bone) :: config followers - glyphers/(set bone) :: glyph followers - == :: - ++ shell :: console session - $: her/ship :: client identity - man/knot :: mailbox - count/@ud :: messages shown - say/sole-share :: console state - active/{$~ u/(set partner)} :: active targets - $passive-deprecated :: passive targets - owners/register :: presence mirror - harbor/(map knot (pair posture cord)) :: stations mirror - system/cabal :: config mirror - settings/(set knot) :: frontend settings - == :: - ++ shell-5 :: has passive - %+ cork shell |= shell :: - %= +< :: - &6 passive=*(set partner) :: - active *(unit (set partner)) :: - == :: - ++ shell-4 (cork shell-5 |=(shell-5 +<(|8 &9.+<))):: missing settings - ++ river (pair point point) :: stream definition - ++ point :: stream endpoint - $% {$ud p/@ud} :: by number - {$da p/@da} :: by date - == :: - ++ move (pair bone card) :: all actions - ++ lime :: diff fruit - $% {$talk-report report} :: - {$sole-effect sole-effect} :: - == :: - ++ pear :: poke fruit - $% {$talk-command command} :: - {$write-comment spur ship cord} :: - {$write-fora-post spur ship cord cord} :: - == :: - ++ card :: general card - $% {$diff lime} :: - {$info wire @p @tas nori} :: - {$peer wire dock path} :: - {$poke wire dock pear} :: - {$pull wire dock $~} :: - {$quit $~} :: - == :: - ++ weir :: parsed wire - $% {$repeat p/@ud q/@p r/knot} :: - {$friend p/knot q/station} :: - == :: - ++ work :: interface action - $% {$number p/$@(@ud {@u @ud})} :: relative/absolute - {$help $~} :: print usage info - {$who p/where} :: presence - {$what p/$@(char (set partner))} :: show bound glyph - {$bind p/char q/(unit where)} :: - {$join p/where} :: - {$leave p/where} :: - {$say p/(list speech)} :: - {$eval p/cord q/twig} :: - {$invite p/knot q/(list partner)} :: whitelist add - {$banish p/knot q/(list partner)} :: blacklist add - {$block p/knot q/(list partner)} :: blacklist add - {$author p/knot q/(list partner)} :: whitelist add - {$nick p/(unit ship) q/(unit cord)} :: - {$set p/knot} :: - {$unset p/knot} :: - {$target p/where q/(unit work)} :: set active targets - :: {$destroy p/knot} :: - {$create p/posture q/knot r/cord} :: - {$probe p/station} :: - == :: - ++ where (set partner) :: non-empty audience - ++ sigh :: assemble label - ::x? why is this not in ++ta? - :: - |= {len/@ud pre/tape yiz/cord} - ^- tape - =+ nez=(trip yiz) - =+ lez=(lent nez) - ?> (gth len (lent pre)) - =. len (sub len (lent pre)) - ?. (gth lez len) - =. nez (welp pre nez) - ?. (lth lez len) nez - (runt [(sub len lez) '-'] nez) - :(welp pre (scag (dec len) nez) "+") - ++ glyphs `wall`~[">=+-" "}),." "\"'`^" "$%&@"] :: station char pool' - ++ peer-type :: stream requests - ::x helper functions for determining/specifying from/in a path, what kind - ::x of subscription our peer wants/what they're interested in. - :: - =< apex - |% - ++ apex ?($a-group $f-grams $v-glyph $x-cabal) :: options - ++ encode |=(a/apex ^-(char (end 3 1 a))) :: by first char - ++ decode :: discriminate - |= a/char ^- apex - ?+ a ~|(bad-subscription-designator+a !!) - $a %a-group - $f %f-grams - $v %v-glyph - $x %x-cabal - == - -- - -- -|% -:: old protocol workaround door -++ timed - ::x? seems hacky. if old, should be removed in "new talk", right? - ::x? seems like it's used for adding/dealing with "fake"/workaround ships - ::x? with datetimes in their status. but why? - ::x looking at ++pa-remind, this can safely be deleted when breaching state. - :: - ::x a: stations with ships and their status. - |_ a/(map partner atlas) :: XX (map partner (pair @da atlas)) - ++ strip - ::x removes workaround ships from all partner's status lists. - :: - (~(run by a) |=(b/atlas (~(del by b) `@p`%timed-sub))) - :: - ++ put :: XX put:by - ::x adds workaround ship to d with pretty-printed date c in its status, - ::x then adds it to a with key/partner b. - :: - |= {b/partner c/@da d/atlas} - =/ sta/status [%gone [~ (some (scot %da c))]] - (~(put by a) b (~(put by d) `@p`%timed-sub sta)) - :: - ++ decode-status - ::x attempts to retrieve datetime from status (as inserted by put:timed). - :: - |= a/status ^- (unit @da) - ?. ?=({$gone $~ $~ tym/@t} a) ~ - => .(a `{$gone $~ $~ tym/@t}`a) - (slaw %da tym.a) - :: - ++ uni - ::x union of two station-shipstatus maps. - :: - |= b/_a ^+ a - :: XX efficiency - %- ~(uni by a) - %- ~(urn by b) - |= nb/{p/partner q/atlas} - ?. (~(has by a) p.nb) q.nb - =/ qna (~(got by a) p.nb) - :: XX p.qna p.q.nb - =/ pqna (biff (~(get by qna) `@p`%timed-sub) decode-status) - ?~ pqna q.nb - =/ pqnb (biff (~(get by q.nb) `@p`%timed-sub) decode-status) - ?~ pqnb qna - ?: (gth u.pqna u.pqnb) qna - ?: (gth u.pqnb u.pqna) q.nb - :: unfortunately, multiple reports on the same channel can - :: be sent on the same event, necessitating last-wins - :: ~| uni-timed+[n.a n.b] - :: ?> =(n.a n.b) - q.nb - -- --- -|_ {hid/bowl house} -++ ra :: per transaction - ::x gets called when talk gets poked or otherwise prompted/needs to perform - ::x an action. - ::x arms generally modify state, and store moves in ++ra's moves. these get - ::x produced when calling ++ra-abet. - ::x in applying commands and making reports, it uses ++pa for story work. - :: - ::x moves: moves storage, added to by ++ra-emit and -emil, produced by -abed. - |_ moves/(list move) - ++ sh :: per console - ::x shell core, responsible for doing things with console sessions, - ::x like parsing input, acting based on input, showing output, keeping - ::x track of settings and other frontend state. - ::x important arms include ++sh-repo which is used to apply reports, and - ::x ++sh-sole which gets called upon cli prompt interaction. - ::x any talk commands the core's arms want to have executed get put into - ::x coz. the stored commands get applied upon calling ++sh-abet. - :: - |_ $: ::x coz: talk commands storage, applied by ++sh-abet. - ::x she: console session state used in this core. - :: - coz/(list command) :: talk actions - she/shell - == - ++ sh-scad :: command parser - ::x builds a core with parsers for talk-cli, and produces its work arm. - ::x ++work uses those parsers to parse the current talk-cli prompt input - ::x and produce a work item to be executed by ++sh-work. - :: - =< work - |% - ++ expr :: [cord twig] - |= tub/nail %. tub - %+ stag (crip q.tub) - wide:(vang & [&1:% &2:% (scot %da now.hid) |3:%]) - :: - ++ dare :: @dr - %+ sear - |= a/coin - ?. ?=({$$ $dr @} a) ~ - (some `@dr`+>.a) - nuck:so - :: - ++ ship ;~(pfix sig fed:ag) :: ship - ++ shiz :: ship set - %+ cook - |=(a/(list ^ship) (~(gas in *(set ^ship)) a)) - (most ;~(plug com (star ace)) ship) - :: - ++ pasp :: passport - ;~ pfix pat - ;~ pose - (stag %twitter ;~(pfix (jest 't') col urs:ab)) - == - == - :: - ++ stan :: station - ;~ pose - (cold [our.hid man.she] col) - ;~(pfix cen (stag our.hid sym)) - ;~(pfix fas (stag (sein our.hid) sym)) - :: - %+ cook - |= {a/@p b/(unit term)} - [a ?^(b u.b (main a))] - ;~ plug - ship - (punt ;~(pfix fas urs:ab)) - == - == - :: - ++ parn :: partner - ;~ pose - (stag %& stan) - (stag %| pasp) - == - ++ partners-flat :: collapse mixed list - |= a/(list (each partner (set partner))) - ^- (set partner) - ?~ a ~ - ?- -.i.a - $& (~(put in $(a t.a)) p.i.a) - $| (~(uni in $(a t.a)) p.i.a) - == - :: - ++ para :: partners alias - %+ cook partners-flat - %+ most ;~(plug com (star ace)) - (pick parn (sear sh-glyf glyph)) - :: - ++ parz :: non-empty partners - %+ cook ~(gas in *(set partner)) - (most ;~(plug com (star ace)) parn) - :: - ++ nump :: number reference - ;~ pose - ;~(pfix hep dem:ag) - ;~ plug - (cook lent (plus (just '0'))) - ;~(pose dem:ag (easy 0)) - == - (stag 0 dem:ag) - == - :: - ++ pore :: posture - ;~ pose - (cold %black (jest %channel)) - (cold %white (jest %village)) - (cold %green (jest %journal)) - (cold %brown (jest %mailbox)) - == - :: - ++ message - ;~ pose - ;~(plug (cold %eval hax) expr) - :: - %+ stag %say - %+ most (jest '•') - ;~ pose - (stag %url aurf:urlp) - :(stag %lin | ;~(pfix pat text)) - :(stag %lin & ;~(less sem hax text)) - == - == - :: - ++ nick (cook crip (stun [1 14] low)) :: nickname - ++ text (cook crip (plus (shim ' ' '~'))) :: bullets separating - ++ glyph (mask "/\\\{( ::x points to ++sh's |_ core's context. - =+ zoc=(flop coz) - |- ^+ +>+> ::x +> would point to |-'s context. +>+> goes to ++sh |_'s. - ::x produce context with this shell updated. - ?~ zoc +>+>.$(shells (~(put by shells) ost.hid she)) - ::x recurse, with context (of |-?) modified. - $(zoc t.zoc, +>.$ (sh-deal i.zoc)) - :: - ++ sh-deal :: apply from shell - ::x used by ++sh-abet, applies an individual talk command. - :: - |= cod/command - ^+ +> - ?- -.cod - ::x the $design command is used for modifying channel configs, - ::x which is done when joining, leaving or creating channels. - $design - ?~ q.cod - ::x updates context with new config state. - =. +>+>.$ (ra-config p.cod *config) - ::x produces context with story p.cod deleted. - +>.$(stories (~(del by stories) p.cod)) - ::x produces +> with its +> (so, +>+>) updated by ++ra-think. - +>(+> (ra-config p.cod u.q.cod)) - :: - ::x used for relaying messages (as a station host). - $review +>(+> (ra-think | her.she +.cod)) - ::x used for sending messages (as their author). - $publish +>(+> (ra-think & her.she +.cod)) - == - :: - ++ sh-fact :: send console effect - ::x adds a console effect to ++ra's moves. - :: - |= fec/sole-effect - ^+ +> - +>(moves :_(moves [ost.hid %diff %sole-effect fec])) - :: - ++ sh-peep :: peer to path - ::x? unused? - :: - |= pax/path - ^+ +> - +>(+> (ra-subscribe her.she pax)) - :: - ++ sh-peer :: subscribe shell - ::x create a shell, subscribe to default stories. - :: - =< sh-prod - %_ . - +> - =/ typ - =+ (ly ~[%a-group %f-grams %x-cabal]) - (rap 3 (turn - encode:peer-type)) - ::x subscriptions to the shell's ship's default channels. - (ra-subscribe:(ra-subscribe her.she ~) her.she [typ man.she ~]) - == - :: - ++ sh-prod :: show prompt - ::x make and store a move to modify the cli prompt, displaying audience. - :: - ^+ . - %+ sh-fact %pro - :+ & %talk-line - ^- tape - =/ rew/(pair (pair @t @t) (set partner)) - [['[' ']'] u.active.she] - =+ cha=(~(get by nik) q.rew) - ?^ cha ~[u.cha ' '] - :: ~& [rew nik nak] - =+ por=~(te-prom te man.she q.rew) - (weld `tape`[p.p.rew por] `tape`[q.p.rew ' ' ~]) - :: - ++ sh-pact :: update active aud - ::x change currently selected audience to lix, updating prompt. - :: - |= lix/(set partner) - ^+ +> - =+ act=(sh-pare lix) ::x ensure we can see what we send. - ?~ act ~|(%no-audience !!) ::x? this can't actually happen, right? - ?: =(active.she `act) +>.$ - sh-prod(active.she `act) - :: - ++ sh-pare :: adjust target list - ::x if the audience paz does not contain a partner we're subscribed to, - ::x add our mailbox to the audience (so that we can see our own message). - :: - |= paz/(set partner) - ?: (sh-pear paz) paz - (~(put in paz) [%& our.hid man.she]) - :: - ++ sh-pear :: hearback - ::x produces true if any partner is included in our subscriptions, - ::x aka, if we hear messages sent to paz. - :: - |= paz/(set partner) - ?~ paz | - ?| $(paz l.paz) - $(paz r.paz) - (~(has in sources.shape:(~(got by stories) man.she)) `partner`n.paz) - == - :: - ++ sh-pest :: report listen - ::x updates audience to be tay, only if tay is not a village/%white. - ::x? why exclude village (invite-only?) audiences from this? - :: - |= tay/partner - ^+ +> - ?. ?=($& -.tay) +> ::x if partner is a passport, do nothing. - =+ sib=(~(get by ham.system.she) `station`p.tay) ::x get config for tay - ?. |(?=($~ sib) !?=($white p.cordon.u.sib)) - +>.$ - (sh-pact [tay ~ ~]) - :: - ++ sh-rend :: print on one line - ::x renders a telegram as a single line, adds it as a console move, - ::x and updates the selected audience to match the telegram's. - :: - |= gam/telegram - =+ lin=~(tr-line tr man.she settings.she gam) - (sh-fact %txt lin) - :: - ++ sh-numb :: print msg number - ::x does as it says on the box. - :: - |= num/@ud - ^+ +> - =+ bun=(scow %ud num) - %+ sh-fact %txt - (runt [(sub 13 (lent bun)) '-'] "[{bun}]") - :: - ++ sh-glyf :: decode glyph - ::x gets the partner(s) that match a glyph. - ::x? why (set partner)? it seems like it only ever returns a single one. - ::TODO should produce a set when ambiguous. - :: - |= cha/char ^- (unit (set partner)) - =+ lax=(~(get ju nak) cha) - ?: =(~ lax) ~ ::x no partner. - ?: ?=({* $~ $~} lax) `n.lax ::x single partner. - ::x in case of multiple partners, pick the most recently active one. - =+ grams=grams:(~(got by stories) man.she) - |- ^- (unit (set partner)) - ?~ grams ~ - ::x get first partner from a telegram's audience. - =+ pan=(silt (turn (~(tap by q.q.i.grams)) head)) - ?: (~(has in lax) pan) `pan - $(grams t.grams) - :: - ::TODO we have a stdlib set diff now! - ++ sh-repo-house-diff - ::x calculates difference between two shelves (channel definitions). - :: - |= {one/shelf two/shelf} - =| $= ret - $: old/(list (pair knot (pair posture cord))) - new/(list (pair knot (pair posture cord))) - cha/(list (pair knot (pair posture cord))) - == - ^+ ret - =. ret - =+ eno=(~(tap by one)) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - =+ unt=(~(get by two) p.i.eno) - ?~ unt - ret(old [i.eno old.ret]) - ?: =(q.i.eno u.unt) ret - ret(cha [[p.i.eno u.unt] cha.ret]) - =. ret - =+ owt=(~(tap by two)) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: (~(has by one) p.i.owt) - ret - ret(new [i.owt new.ret]) - ret - :: - ++ sh-repo-atlas-diff - ::x calculates the difference between two atlasses (presence lists). - :: - |= {one/atlas two/atlas} - =| $= ret - $: old/(list (pair ship status)) - new/(list (pair ship status)) - cha/(list (pair ship status)) - == - ^+ ret - =. ret - =+ eno=(~(tap by one)) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - ?: =(%gone p.q.i.eno) ret - =+ unt=(~(get by two) p.i.eno) - ?~ unt - ret(old [i.eno old.ret]) - ?: =(%gone p.u.unt) - ret(old [i.eno old.ret]) - ?: =(q.i.eno u.unt) ret - ret(cha [[p.i.eno u.unt] cha.ret]) - =. ret - =+ owt=(~(tap by two)) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: =(%gone p.q.i.owt) ret - ?. (~(has by one) p.i.owt) - ret(new [i.owt new.ret]) - ?: =(%gone p:(~(got by one) p.i.owt)) - ret(new [i.owt new.ret]) - ret - ret - :: - ++ sh-repo-cabal-diff - ::x calculates the difference between two cabals (station configurations) - :: - |= {one/(map station config) two/(map station config)} - =| $= ret - $: old/(list (pair station config)) - new/(list (pair station config)) - cha/(list (pair station config)) - == - ^+ ret - =. ret - =+ eno=(~(tap by one)) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - =+ unt=(~(get by two) p.i.eno) - ?~ unt - ret(old [i.eno old.ret]) - ?: =(q.i.eno u.unt) ret - ret(cha [[p.i.eno u.unt] cha.ret]) - =. ret - =+ owt=(~(tap by two)) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: (~(has by one) p.i.owt) - ret - ret(new [i.owt new.ret]) - ret - :: - ++ sh-repo-rogue-diff - ::x calculates the difference between two maps of stations and their - ::x presence lists. - :: - |= {one/(map partner atlas) two/(map partner atlas)} - =| $= ret - $: old/(list (pair partner atlas)) - new/(list (pair partner atlas)) - cha/(list (pair partner atlas)) - == - =. one ~(strip timed one) - =. two ~(strip timed two) - ^+ ret - =. ret - =+ eno=(~(tap by one)) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - =+ unt=(~(get by two) p.i.eno) - ?~ unt - ret(old [i.eno old.ret]) - ?: =(q.i.eno u.unt) ret - ret(cha [[p.i.eno u.unt] cha.ret]) - =. ret - =+ owt=(~(tap by two)) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: (~(has by one) p.i.owt) - ret - ret(new [i.owt new.ret]) - ret - :: - ++ sh-repo-whom-diff - ::x calculates the difference between two partner sets. - :: - |= {one/(set partner) two/(set partner)} - =| $= ret - $: old/(list partner) - new/(list partner) - == - ^+ ret - =. ret - =+ eno=(~(tap by one)) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - ?: (~(has in two) i.eno) - ret - ret(old [i.eno old.ret]) - =. ret - =+ owt=(~(tap by two)) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: (~(has in one) i.owt) - ret - ret(new [i.owt new.ret]) - ret - :: - ++ sh-repo-ship-diff - ::x calculates the difference between two ship sets. - :: - |= {one/(set ship) two/(set ship)} - =| $= ret - $: old/(list ship) - new/(list ship) - == - ^+ ret - =. ret - =+ eno=(~(tap by one)) - |- ^+ ret - ?~ eno ret - =. ret $(eno t.eno) - ?: (~(has in two) i.eno) - ret - ret(old [i.eno old.ret]) - =. ret - =+ owt=(~(tap by two)) - |- ^+ ret - ?~ owt ret - =. ret $(owt t.owt) - ?: (~(has in one) i.owt) - ret - ret(new [i.owt new.ret]) - ret - :: - ++ sh-puss - ::x posture as text. - :: - |= a/posture ^- tape - ?- a - $black "channel" - $brown "mailbox" - $white "village" - $green "journal" - == - :: - ++ sh-repo-config-exceptions - ::x used by ++sh-repo-config-show to aid in printing info to cli. - :: - |= {pre/tape por/posture old/(list ship) new/(list ship)} - =+ out=?:(?=(?($black $brown) por) "try " "cut ") - =+ inn=?:(?=(?($black $brown) por) "ban " "add ") - =. +>.$ - |- ^+ +>.^$ - ?~ old +>.^$ - =. +>.^$ $(old t.old) - (sh-note :(weld pre out " " (scow %p i.old))) - =. +>.$ - |- ^+ +>.^$ - ?~ new +>.^$ - =. +>.^$ $(new t.new) - (sh-note :(weld pre out " " (scow %p i.new))) - +>.$ - :: - ++ sh-repo-config-sources - ::x used by ++sh-repo-config-show to aid in printing info to cli, - ::x pertaining to the un/subscribing to partners. - :: - |= {pre/tape old/(list partner) new/(list partner)} - ^+ +> - =. +>.$ - |- ^+ +>.^$ - ?~ old +>.^$ - =. +>.^$ $(old t.old) - (sh-note (weld pre "off {~(ta-full ta man.she i.old)}")) - =. +>.$ - |- ^+ +>.^$ - ?~ new +>.^$ - =. +>.^$ $(new t.new) - (sh-note (weld pre "hey {~(ta-full ta man.she i.new)}")) - +>.$ - :: - ++ sh-repo-config-show - ::x prints config changes to the cli. - :: - |= {pre/tape laz/config loc/config} - ^+ +> - =. +>.$ - ?: =(caption.loc caption.laz) +>.$ - (sh-note :(weld pre "cap " (trip caption.loc))) - =. +>.$ - %+ sh-repo-config-sources - (weld (trip man.she) ": ") - (sh-repo-whom-diff sources.laz sources.loc) - ?: !=(p.cordon.loc p.cordon.laz) - =. +>.$ (sh-note :(weld pre "but " (sh-puss p.cordon.loc))) - %^ sh-repo-config-exceptions - (weld (trip man.she) ": ") - p.cordon.loc - [~ (~(tap in q.cordon.loc))] - %^ sh-repo-config-exceptions - (weld (trip man.she) ": ") - p.cordon.loc - (sh-repo-ship-diff q.cordon.laz q.cordon.loc) - :: - ++ sh-repo-cabal-changes - ::x used by ++sh-repo-cabal for printing cabal config changes to cli. - :: - |= $: laz/(map station config) - old/(list (pair station config)) - new/(list (pair station config)) - cha/(list (pair station config)) - == - =. +>.$ - |- ^+ +>.^$ - ?~ new +>.^$ - =. +>.^$ $(new t.new) - =. +>.^$ (sh-pest [%& p.i.new]) - %+ sh-repo-config-show - (weld ~(sn-phat sn man.she p.i.new) ": ") - [*config q.i.new] - =. +>.$ - |- ^+ +>.^$ - ?~ cha +>.^$ - =. +>.^$ $(cha t.cha) - %+ sh-repo-config-show - (weld ~(sn-phat sn man.she p.i.cha) ": ") - [(~(got by laz) `station`p.i.cha) q.i.cha] - +>.$ - :: - ++ sh-repo-cabal - ::x updates the current shell's cabal and prints changes to cli. - :: - |= bal/cabal - ^+ +> - =+ laz=system.she - =. system.she bal - =. +>.$ - %+ sh-repo-cabal-changes ham.laz - (sh-repo-cabal-diff ham.laz ham.bal) - (sh-repo-config-show "" loc.laz loc.bal) - :: - ++ sh-repo-house - ::x applies new shelf ("house"?) and prints changes to cli. - :: - |= awl/(map knot (pair posture cord)) - ^+ +> - =+ dif=(sh-repo-house-diff harbor.she awl) - =. harbor.she awl - =. +>.$ - |- ^+ +>.^$ - ?~ old.dif +>.^$ - =. +>.^$ $(old.dif t.old.dif) - (sh-note "cut {(sh-puss p.q.i.old.dif)} %{(trip p.i.old.dif)}") - =. +>.$ - |- ^+ +>.^$ - ?~ new.dif +>.^$ - =. +>.^$ $(new.dif t.new.dif) - =+ :* nam=(trip p.i.new.dif) - por=(sh-puss p.q.i.new.dif) - des=(trip q.q.i.new.dif) - == - (sh-note "new {por} %{nam}: {des}") - =. +>.$ - |- ^+ +>.^$ - ?~ cha.dif +>.^$ - =. +>.^$ $(cha.dif t.cha.dif) - =+ :* nam=(trip p.i.cha.dif) - por=(sh-puss p.q.i.cha.dif) - des=(trip q.q.i.cha.dif) - == - (sh-note "mod %{nam}: {por}, {des}") - +>.$ - :: - ++ sh-note :: shell message - ::x prints a txt to cli in talk's format. - :: - |= txt/tape - ^+ +> - (sh-fact %txt (runt [14 '-'] `tape`['|' ' ' (scag 64 txt)])) - :: - ++ sh-spaz :: print status - ::x gets the presence of a status. - :: - |= saz/status - ^- tape - ['%' (trip p.saz)] - :: - ++ sh-repo-group-diff-here :: print atlas diff - ::x prints presence notifications. - :: - |= $: pre/tape - $= cul - $: old/(list (pair ship status)) - new/(list (pair ship status)) - cha/(list (pair ship status)) - == - == - ?: (~(has in settings.she) %quiet) - +>.$ - =. +>.$ - |- ^+ +>.^$ - ?~ old.cul +>.^$ - =. +>.^$ $(old.cul t.old.cul) - (sh-note (weld pre "bye {(scow %p p.i.old.cul)}")) - =. +>.$ - |- ^+ +>.^$ - ?~ new.cul +>.^$ - =. +>.^$ $(new.cul t.new.cul) - %- sh-note - (weld pre "met {(scow %p p.i.new.cul)} {(sh-spaz q.i.new.cul)}") - =. +>.$ - |- ^+ +>.^$ - ?~ cha.cul +>.^$ - %- sh-note - (weld pre "set {(scow %p p.i.cha.cul)} {(sh-spaz q.i.cha.cul)}") - +>.$ - :: - ++ sh-repo-group-here :: update local - ::x updates local presence store and prints changes. - :: - |= loc/atlas - ^+ +> - =+ cul=(sh-repo-atlas-diff p.owners.she loc) - =. p.owners.she loc - (sh-repo-group-diff-here "" cul) - :: - ++ sh-repo-group-there :: update foreign - ::x updates remote presences(?) and prints changes. - :: - |= yid/(map partner atlas) - =+ day=(sh-repo-rogue-diff q.owners.she yid) - =+ dun=q.owners.she - =. q.owners.she yid - ?: (~(has in settings.she) %quiet) - +>.$ - =. +>.$ - |- ^+ +>.^$ - ?~ old.day +>.^$ - =. +>.^$ $(old.day t.old.day) - (sh-note (weld "not " (~(ta-show ta man.she p.i.old.day) ~))) - =. +>.$ - |- ^+ +>.^$ - ?~ new.day +>.^$ - =. +>.^$ $(new.day t.new.day) - =. +>.^$ - (sh-note (weld "new " (~(ta-show ta man.she p.i.new.day) ~))) - (sh-repo-group-diff-here "--" ~ (~(tap by q.i.new.day)) ~) - =. +>.$ - |- ^+ +>.^$ - ?~ cha.day +>.^$ - =. +>.^$ $(cha.day t.cha.day) - =. +>.^$ - (sh-note (weld "for " (~(ta-show ta man.she p.i.cha.day) ~))) - =+ yez=(~(got by dun) p.i.cha.day) - %+ sh-repo-group-diff-here "--" - (sh-repo-atlas-diff yez q.i.cha.day) - +>.$ - :: - ++ sh-repo-group - ::x update local and remote presences. - :: - |= ges/register - ^+ +> - =. +> (sh-repo-group-here p.ges) - =. +> (sh-repo-group-there q.ges) - +> - :: - ++ sh-repo-gram - ::x renders telegram: increase gram count and print the gram. - ::x every fifth gram, prints the number. - :: - |= {num/@ud gam/telegram} - ^+ +> - ?: =(num count.she) - =. +> ?:(=(0 (mod num 5)) (sh-numb num) +>) - (sh-rend(count.she +(num)) gam) - ?: (gth num count.she) - =. +> (sh-numb num) - (sh-rend(count.she +(num)) gam) - +> - :: - ++ sh-repo-grams :: apply telegrams - ::x renders telegrams. - :: - |= {num/@ud gaz/(list telegram)} - ^+ +> - ?~ gaz +> - $(gaz t.gaz, num +(num), +> (sh-repo-gram num i.gaz)) - :: - ++ sh-repo-glyph :: apply binding - ::x updates glyph bindings and lookup, and updates selected audience. - :: - |= nac/(jug char (set partner)) - ^+ +> - %_ sh-prod - nak nac - nik %- ~(gas by *(map (set partner) char)) - =- (zing `(list (list {(set partner) char}))`-) - %+ turn (~(tap by nac)) - |= {a/char b/(set (set partner))} - (turn (~(tap by b)) |=(c/(set partner) [c a])) - == - :: - ++ sh-repo :: apply report - ::x applies the different kinds of reports using their handler arms above - :: - |= rad/report - ^+ +> - :: ~& [%sh-repo rad] - ?- -.rad - $cabal (sh-repo-cabal +.rad) - $grams (sh-repo-grams +.rad) - $glyph (sh-repo-glyph +.rad) :: XX ever happens? - $group (sh-repo-group +.rad) - $house (sh-repo-house +.rad) - == - :: - ++ sh-sane-chat :: sanitize chatter - ::x (for chat messages) sanitizes the input buffer and splits it into - ::x multiple lines ('•'). - :: - |= buf/(list @c) - ^- (list sole-edit) - ?~ buf ~ - =+ isa==(i.buf (turf '@')) - =+ [[pre=*@c cur=i.buf buf=t.buf] inx=0 brk=0 len=0 new=|] - =* txt -< - |^ ^- (list sole-edit) - ?: =(cur (turf '•')) - ?: =(pre (turf '•')) - [[%del inx] ?~(buf ~ $(txt +.txt))] - ?: new - [(fix ' ') $(cur `@c`' ')] - newline - ?: =(cur `@`' ') - =. brk ?:(=(pre `@`' ') brk inx) - ?. =(64 len) advance - :- (fix(inx brk) (turf '•')) - ?: isa - [[%ins +(brk) (turf '@')] newline(new &)] - newline(new &) - ?: =(64 len) - =+ dif=(sub inx brk) - ?: (lth dif 64) - :- (fix(inx brk) (turf '•')) - ?: isa - [[%ins +(brk) (turf '@')] $(len dif, new &)] - $(len dif, new &) - [[%ins inx (turf '•')] $(len 0, inx +(inx), new &)] - ?: |((lth cur 32) (gth cur 126)) - [(fix '?') advance] - ?: &((gte cur 'A') (lte cur 'Z')) - [(fix (add 32 cur)) advance] - advance - :: - ++ advance ?~(buf ~ $(len +(len), inx +(inx), txt +.txt)) - ++ newline ?~(buf ~ $(len 0, inx +(inx), txt +.txt)) - ++ fix |=(cha/@ [%mor [%del inx] [%ins inx `@c`cha] ~]) - -- - :: - ++ sh-sane :: sanitize input - ::x parses cli prompt input using ++sh-scad and sanitizes when invalid. - :: - |= {inv/sole-edit buf/(list @c)} - ^- {lit/(list sole-edit) err/(unit @u)} - =+ res=(rose (tufa buf) sh-scad) - ?: ?=($| -.res) [[inv]~ `p.res] - :_ ~ - ?~ p.res ~ - =+ wok=u.p.res - |- ^- (list sole-edit) - ?+ -.wok ~ - $target ?~(q.wok ~ $(wok u.q.wok)) - $say |- :: XX per line - ?~ p.wok ~ - ?: ?=($lin -.i.p.wok) - (sh-sane-chat buf) - $(p.wok t.p.wok) - == - :: - ++ sh-slug :: edit to sanity - ::x corrects invalid prompt input. - :: - |= {lit/(list sole-edit) err/(unit @u)} - ^+ +> - ?~ lit +> - =^ lic say.she - (~(transmit sole say.she) `sole-edit`?~(t.lit i.lit [%mor lit])) - (sh-fact [%mor [%det lic] ?~(err ~ [%err u.err]~)]) - :: - ++ sh-stir :: apply edit - ::x called when typing into the talk prompt. applies the change and does - ::x sanitizing. - :: - |= cal/sole-change - ^+ +> - =^ inv say.she (~(transceive sole say.she) cal) - =+ fix=(sh-sane inv buf.say.she) - ?~ lit.fix - +>.$ - ?~ err.fix - (sh-slug fix) :: just capital correction - ?. &(?=($del -.inv) =(+(p.inv) (lent buf.say.she))) - +>.$ :: allow interior edits, deletes - (sh-slug fix) - :: - ++ sh-lame :: send error - ::x just puts some text into the cli. - :: - |= txt/tape - (sh-fact [%txt txt]) - :: - ++ sh-whom :: current audience - ::x produces the currently selected audience for this shell. - :: - ^- audience - %- ~(gas by *audience) - %+ turn (~(tap in u.active.she)) - |=(a/partner [a *envelope %pending]) - :: - ++ sh-tell :: add command - ::x adds talk command to core state. these get applied with ++sh-abet. - :: - |= cod/command - %_(+> coz [cod coz]) - :: - ++ sh-twig-head ^- vase :: eval data - ::x makes a vase of environment data to evaluate against (#-messages). - :: - !>(`{our/@p now/@da eny/@uvI}`[our.hid now.hid (shas %eny eny.hid)]) - :: - ++ sh-work :: do work - ::x implements worker arms for different talk commands. - ::x all worker arms must produce updated state/context. - :: - |= job/work - ^+ +> - =+ roy=(~(got by stories) man.she) - =< work - |% - ++ work - ?- -.job - $number (number +.job) - $leave (leave +.job) - $join (join +.job) - $eval (eval +.job) - $who (who +.job) - $what (what +.job) - $bind (bind +.job) - $invite (invite +.job) - $banish (banish +.job) - $author (author +.job) - $block (block +.job) - $create (create +.job) - $nick (nick +.job) - $set (wo-set +.job) - $unset (unset +.job) - $target (target +.job) - $probe (probe +.job) - $help help - $say (say +.job) - == - :: - ++ activate :: from %number - |= gam/telegram - ^+ ..sh-work - =+ tay=~(. tr man.she settings.she gam) - =. ..sh-work (sh-fact tr-fact:tay) - sh-prod(active.she `tr-pals:tay) - :: - ++ help - (sh-fact %txt "see http://urbit.org/docs/using/messaging/") - :: - ++ glyph - |= idx/@ - =< cha - %+ reel glyphs - |= {all/tape ole/{cha/char num/@}} - =+ new=(snag (mod idx (lent all)) all) - =+ num=~(wyt in (~(get ju nak) new)) - ?~ cha.ole [new num] - ?: (lth num.ole num) - ole - [new num] - :: - ++ set-glyph - |= {cha/char lix/(set partner)} - =: nik (~(put by nik) lix cha) - nak (~(put ju nak) cha lix) - == - %_ ..sh-work - ..pa - %- (ra-know man.she) - |=(_pa pa-abet:(pa-report glyphers %glyph nak)) - == - :: - ++ join :: %join - |= pan/(set partner) - ^+ ..sh-work - =. ..sh-work - =+ (~(get by nik) pan) - ?^ - (sh-note "has glyph {}") - =+ cha=(glyph (mug pan)) - (sh-note:(set-glyph cha pan) "new glyph {}") - =+ loc=loc.system.she - ::x change local mailbox config to include subscription to pan. - %^ sh-tell %design man.she - `loc(sources (~(uni in sources.loc) pan)) - :: - ++ leave :: %leave - |= pan/(set partner) - ^+ ..sh-work - =+ loc=loc.system.she - ::x change local mailbox config to exclude subscription to pan. - %^ sh-tell %design man.she - `loc(sources (~(dif in sources.loc) pan)) - :: - ++ what :: %what - |= qur/$@(char (set partner)) ^+ ..sh-work - ?^ qur - =+ cha=(~(get by nik) qur) - (sh-fact %txt ?~(cha "none" [u.cha]~)) - =+ pan=(~(tap in (~(get ju nak) qur))) - ?: =(~ pan) (sh-fact %txt "~") - =< (sh-fact %mor (turn pan .)) - |=(a/(set partner) [%txt ]) :: XX ~(te-whom te man.she a) - :: - ++ who :: %who - |= pan/(set partner) ^+ ..sh-work - =< (sh-fact %mor (murn (sort (~(tap by q.owners.she) ~) aor) .)) - |= {pon/partner alt/atlas} ^- (unit sole-effect) - ?. |(=(~ pan) (~(has in pan) pon)) ~ - =- `[%tan rose+[", " `~]^- leaf+~(ta-full ta man.she pon) ~] - =< (murn (sort (~(tap by alt)) aor) .) - |= {a/ship b/presence c/human} ^- (unit tank) :: XX names - ?- b - $gone ~ - $hear `>a< - $talk `>a< :: XX difference - == - :: - ++ bind :: %bind - |= {cha/char pan/(unit (set partner))} ^+ ..sh-work - ?~ pan $(pan [~ u.active.she]) - =+ ole=(~(get by nik) u.pan) - ?: =(ole [~ cha]) ..sh-work - (sh-note:(set-glyph cha u.pan) "bound {} {}") - :: - ++ invite :: %invite - |= {nom/knot tal/(list partner)} - ^+ ..sh-work - !! - :: - ++ block :: %block - |= {nom/knot tal/(list partner)} - ^+ ..sh-work - !! - :: - ++ author :: %author - |= {nom/knot tal/(list partner)} - ^+ ..sh-work - !! - :: - ++ banish :: %banish - |= {nom/knot tal/(list partner)} - ^+ ..sh-work - !! - :: - ++ create :: %create - |= {por/posture nom/knot txt/cord} - ^+ ..sh-work - ?: (~(has in stories) nom) - (sh-lame "{(trip nom)}: already exists") - =. ..sh-work - ::x create new config for channel. - %^ sh-tell %design nom - :- ~ - :+ *(set partner) - (end 3 64 txt) - [por ~] - (join [[%& our.hid nom] ~ ~]) - :: - ++ reverse-folks - |= nym/knot - ^- (list ship) - %+ murn (~(tap by folks)) - |= {p/ship q/human} - ?~ hand.q ~ - ?. =(u.hand.q nym) ~ - [~ u=p] - :: - ++ nick :: %nick - |= {her/(unit ship) nym/(unit cord)} - ^+ ..sh-work - ?: ?=({$~ $~} +<) - %+ sh-fact %mor - %+ turn (~(tap by folks)) - |= {p/ship q/human} - :- %txt - ?~ hand.q - "{

}:" - "{

}: {}" - ?~ nym - ?> ?=(^ her) - =+ asc=(~(get by folks) u.her) - %+ sh-fact %txt - ?~ asc "{} unbound" - ?~ hand.u.asc "{}:" - "{}: {}" - ?~ her - %+ sh-fact %mor - %+ turn (reverse-folks u.nym) - |= p/ship - [%txt "{

}: {}"] - %= ..sh-work - folks ?~ u.nym - (~(del by folks) u.her) - (~(put by folks) u.her [true=~ hand=nym]) - == - :: - ++ wo-set :: %set - |= seg/knot - ^+ ..sh-work - ?~ seg - %+ sh-fact %mor - %+ turn (~(tap in settings.she)) - |= s/knot - [%txt (trip s)] - %= ..sh-work - settings.she (~(put in settings.she) seg) - == - :: - ++ unset :: %unset - |= neg/knot - ^+ ..sh-work - %= ..sh-work - settings.she (~(del in settings.she) neg) - == - :: - ++ target :: %target - |= {pan/(set partner) woe/(unit ^work)} - ^+ ..sh-work - =. ..sh-pact (sh-pact pan) - ?~(woe ..sh-work work(job u.woe)) - :: - ++ number :: %number - |= num/$@(@ud {p/@u q/@ud}) - ^+ ..sh-work - =+ roy=(~(got by stories) man.she) - |- - ?@ num - ?: (gte num count.roy) - (sh-lame "{(scow %s (new:si | +(num)))}: no such telegram") - =. ..sh-fact (sh-fact %txt "? {(scow %s (new:si | +(num)))}") - (activate (snag num grams.roy)) - ?. (gth q.num count.roy) - ?~ count.roy - (sh-lame "0: no messages") - =+ msg=(deli (dec count.roy) num) - =. ..sh-fact (sh-fact %txt "? {(scow %ud msg)}") - (activate (snag (sub count.roy +(msg)) grams.roy)) - (sh-lame "…{(reap p.num '0')}{(scow %ud q.num)}: no such telegram") - :: - ++ deli :: find number - |= {max/@ud nul/@u fin/@ud} ^- @ud - =+ dog=|-(?:(=(0 fin) 1 (mul 10 $(fin (div fin 10))))) - =. dog (mul dog (pow 10 nul)) - =- ?:((lte - max) - (sub - dog)) - (add fin (sub max (mod max dog))) - :: - ++ probe :: inquire - |= cuz/station - ^+ ..sh-work - ~& [%probe cuz] - ..sh-work - :: - ++ eval :: run - |= {txt/cord exe/twig} - => |.([(sell (slap (slop sh-twig-head seed) exe))]~) - =+ tan=p:(mule .) - (say [%fat tank+tan exp+txt] ~) - :: - ++ say :: publish - |= sep/(list speech) - ^+ ..sh-work - =- ..sh-work(coz ?~(tot coz :_(coz [%publish tot]))) - |- ^- tot/(list thought) - ?~ sep ~ - =^ sir ..sh-work sh-uniq - [[sir sh-whom [now.hid ~ i.sep]] $(sep t.sep)] - -- - :: - ++ sh-done :: apply result - ::x called upon hitting return in the prompt. if input is invalid, - ::x ++sh-slug is called. otherwise, the appropriate work is done - ::x and the entered command (if any) gets displayed to the user. - :: - =+ fix=(sh-sane [%nop ~] buf.say.she) - ?^ lit.fix - (sh-slug fix) - =+ jub=(rust (tufa buf.say.she) sh-scad) - ?~ jub (sh-fact %bel ~) - %. u.jub - =< sh-work - =+ buf=buf.say.she - =^ cal say.she (~(transmit sole say.she) [%set ~]) - %- sh-fact - :* %mor - [%nex ~] - [%det cal] - ?. ?=({$';' *} buf) ~ - :_ ~ - [%txt (runt [14 '-'] `tape`['|' ' ' (tufa `(list @)`buf)])] - == - :: - ++ sh-sole :: apply edit - ::x applies sole action. - :: - |= act/sole-action - ^+ +> - ?- -.act - $det (sh-stir +.act) - $clr ..sh-sole :: (sh-pact ~) :: XX clear to PM-to-self? - $ret sh-done - == - :: - ++ sh-uniq - ::x generates a new serial. - :: - ^- {serial _.} - [(shaf %serial eny.hid) .(eny.hid (shax eny.hid))] - -- - ++ ra-abed :: resolve core - ::x produces the moves stored in ++ra's moves. - ::x sole-effects get special treatment to become a single move. - :: - ^+ [*(list move) +>] - :_ +> - ::x seperate our sole-effects from other moves. - =+ ^= yop - |- ^- (pair (list move) (list sole-effect)) - ?~ moves [~ ~] - =+ mor=$(moves t.moves) - ?: ?& =(ost.hid p.i.moves) - ?=({$diff $sole-effect *} q.i.moves) - == - [p.mor [+>.q.i.moves q.mor]] - [[i.moves p.mor] q.mor] - ::x flop moves, flop and squash sole-effects into a %mor. - =+ :* moz=(flop p.yop) - ^= foc ^- (unit sole-effect) - ?~ q.yop ~ - ?~(t.q.yop `i.q.yop `[%mor (flop `(list sole-effect)`q.yop)]) - == - ::x produce moves or sole-effects and moves. - ?~(foc moz [[ost.hid %diff %sole-effect u.foc] moz]) - :: - ++ ra-abet :: complete core - ::x applies talk reports, then produces moves and updated state. - :: - ra-abed:ra-axel - :: - ++ ra-axel :: rebound reports - ::x extracts and applies the talk-reports in moves. - :: - ^+ . - ::x separate our talk-reports from other moves. - =+ ^= rey - |- ^- (pair (list move) (list (pair bone report))) - ?~ moves - [~ ~] - =+ mor=$(moves t.moves) - ?. ?& (~(has by shells) `bone`p.i.moves) - ?=({$diff $talk-report *} q.i.moves) - == - [[i.moves p.mor] q.mor] - [p.mor [[p.i.moves +>.q.i.moves] q.mor]] - ::x update moves to exclude talk-reports. - =. moves p.rey - =. q.rey (flop q.rey) - ?: =(q.rey ~) + - |- ^+ +> - ?~ q.rey ra-axel - ::x apply reports. - =+ bak=(ra-back(ost.hid p.i.q.rey) q.i.q.rey) - $(q.rey t.q.rey, +> bak(ost.hid ost.hid)) - :: - ++ ra-back - ::x applies report. - :: - |= rad/report - ^+ +> - sh-abet:(~(sh-repo sh ~ (~(got by shells) ost.hid)) rad) - :: - ++ ra-sole - ::x applies sole-action. - :: - |= act/sole-action - ^+ +> - =+ shu=(~(get by shells) ost.hid) - ?~ shu - ~| :+ %ra-console-broken ost.hid - ?:((~(has by sup.hid) ost.hid) %lost %unknown) - !! - sh-abet:(~(sh-sole sh ~ u.shu) act) - :: - ++ ra-emil :: ra-emit move list - ::x adds multiple moves to the core's list. flops to emulate ++ra-emit. - :: - |= mol/(list move) - %_(+> moves (welp (flop mol) moves)) - :: - ++ ra-emit :: emit a move - ::x adds a move to the core's list. - :: - |= mov/move - %_(+> moves [mov moves]) - :: - ++ ra-evil :: emit error - ::x stack trace and crash. - :: - |= msg/cord - ~| [%ra-evil msg] - !! - :: - ++ ra-house :: emit partners - ::x emits a talk-report move containing all our stories? - ::x? this is for showing people what they can subscribe to, right? - ::x? but this also shows invite-only stories, aren't they secret clubs? - :: - |= ost/bone - %+ ra-emit ost.hid - :+ %diff %talk-report - :- %house - %- ~(gas in *(map knot (pair posture cord))) - %+ turn (~(tap by stories)) - |=({a/knot b/story} [a p.cordon.shape.b caption.shape.b]) - :: - ++ ra-homes :: update partners - ::x send a list of our stories to all general subscribers. - :: - =+ gel=general - |- ^+ +> - ?~ gel +> - =. +> $(gel l.gel) - =. +> $(gel r.gel) - (ra-house n.gel) - :: - ++ ra-init :: initialize talk - ::x populate state on first boot. creates our main and public stories. - :: - %+ roll - ^- (list {posture knot cord}) - :~ [%brown (main our.hid) 'default home'] - [%green ~.public 'visible activity'] - == - |: [[typ=*posture man=*knot des=*cord] ..ra-init] ^+ ..ra-init - %+ ra-apply our.hid - :+ %design man - :- ~ :- ~ - [des [typ ~]] - :: - ++ ra-apply :: apply command - ::x applies the command sent by her. - :: - |= {her/ship cod/command} - ^+ +> - ?- -.cod - ::x the $design command is used for modifying channel configs, - ::x which is done when joining, leaving or creating channels. - ::x this may only be done by ourselves. - ::x? shouldn't this be team-only too? - $design - ?. =(her our.hid) - (ra-evil %talk-no-owner) - ?~ q.cod - ?. (~(has by stories) p.cod) - (ra-evil %talk-no-story) - ::x? why delete story if we got no config? can't we overwrite? - (ra-config(stories (~(del by stories) p.cod)) p.cod *config) - (ra-config p.cod u.q.cod) - :: - ::x used for relaying messages (as a station host). - $review (ra-think | her +.cod) - :: - ::x used for sending messages (as their author). - $publish - ?. (team our.hid her) +>.$ - (ra-think & her +.cod) - == - :: - ++ ra-config :: configure story - ::x (re)configures story man. if it's a new story, emit our stories. - :: - |= {man/knot con/config} - ^+ +> - =+ :- neu=(~(has by stories) man) - pur=(fall (~(get by stories) man) *story) - =. +>.$ pa-abet:(~(pa-reform pa man pur) con) - ?:(neu +>.$ ra-homes) - :: - ++ ra-base-hart - ::x produces our ship's host desk's web address as a hart. - :: - .^(hart %e /(scot %p our.hid)/host/(scot %da now.hid)) - :: - ++ ra-fora-post - ::x sends a fora post. if we don't have a channel for posts yet, create one - :: - |= {pax/path sup/spur hed/@t txt/@t} - ::x tell %hood to submit a fora post. - =. ..ra-emit - %+ ra-emit ost.hid - :* %poke - /fora-post - [our.hid %hood] - [%write-fora-post sup src.hid hed txt] - == - =+ man=%posts - ::x if we have a %posts story, go ahead and consume. - ?: (~(has by stories) man) - (ra-consume-fora-post man pax hed txt) - ::x if we have no %posts story, first create it, then consume. - =; new (ra-consume-fora-post:new man pax hed txt) - =. ..ra-apply - %+ ra-apply our.hid - :+ %design man - :- ~ :- ~ ::x sources - :- 'towards a community' ::x caption - [%brown ~] ::x cordon - ::x send informative message to our mailbox. - %^ ra-consume & our.hid - :^ (shaf %init eny.hid) ::x serial - (my [[%& our.hid (main our.hid)] *envelope %pending] ~) ::x audience - ::x statement - now.hid - [~ %app %tree 'receiving forum posts, ;join %posts for details'] - :: - ++ ra-consume-fora-post - ::x add a message for a fora post to the man story. - :: - |= {man/knot pax/path hed/@t txt/@t} ^+ +> - =. pax (welp pax /posts/(crip "{}~")) - %^ ra-consume | - src.hid - :* (shaf %comt eny.hid) - (my [[%& our.hid man] *envelope %pending] ~) - now.hid - (sy /fora-post eyre+pax ~) - :- %mor :~ - [%fat text+(lore txt) [%url [ra-base-hart `pax ~] ~]] - [%app %tree (crip "forum post: '{(trip hed)}'")] - == - == - :: - ++ ra-comment - ::x sends a comment. if we don't have a channel for them yet, creates one. - :: - |= {pax/path sup/spur txt/@t} - =. ..ra-emit - %+ ra-emit ost.hid - :* %poke - /comment - [our.hid %hood] - [%write-comment sup src.hid txt] - == - =+ man=%comments - ?: (~(has by stories) man) - (ra-consume-comment man pax sup txt) - =; new (ra-consume-comment:new man pax sup txt) - =. ..ra-apply - %+ ra-apply our.hid - :+ %design man - :- ~ :- ~ - :- 'letters to the editor' - [%brown ~] - %^ ra-consume & our.hid - :^ (shaf %init eny.hid) - (my [[%& our.hid (main our.hid)] *envelope %pending] ~) - now.hid - [~ %app %tree 'receiving comments, ;join %comments for details'] - :: - ++ ra-consume-comment - ::x adds a message for a comment to the man story. - :: - |= {man/knot pax/path sup/spur txt/@t} ^+ +> - =+ nam=?~(sup "" (trip i.sup)) :: file name - =+ fra=(crip (time-to-id now.hid)) :: url fragment - %^ ra-consume | - src.hid - :* (shaf %comt eny.hid) - (my [[%& our.hid man] *envelope %pending] ~) - now.hid - (sy /comment eyre+pax ~) - :- %mor :~ - [%fat text+(lore txt) [%url [ra-base-hart `pax ~] `fra]] - [%app %tree (crip "comment on /{nam}")] - == - == - :: - ++ ra-know :: story monad - ::x produces a wet core that takes a gate that takes a story core and - ::x produces updated state. - :: - |= man/knot - |* fun/$-(_pa _+>) - ^+ +>+> - =+ pur=(~(get by stories) man) - ?~ pur - ~& [%ra-know-not man] :: XX should crash - +>+>.$ - ::x call the sample gate with a ++pa core. - (fun ~(. pa man u.pur)) - :: - ++ ra-diff-talk-report :: subscription update - ::x process a talk report from cuz into story man. - :: - |= {man/knot cuz/station rad/report} - %- (ra-know man) |= par/_pa =< pa-abet - (pa-diff-talk-report:par cuz rad) - :: - ++ ra-quit :: subscription quit - ::x removes cuz from the subscribers of story man. - :: - |= {man/knot cuz/station} - %- (ra-know man) |= par/_pa =< pa-abet - (pa-quit:par %& cuz) - :: - ++ ra-retry :: subscription resend - ::x produce a %peer/subscribe move for cuz to story man. - :: - |= {man/knot cuz/station} - %- (ra-know man) |= par/_pa =< pa-abet - (pa-acquire:par [%& cuz]~) - :: - ++ ra-coup-repeat :: - ::x assemble partner and call ++ra-repeat. - :: - |= {{num/@ud her/@p man/knot} saw/(unit tang)} - (ra-repeat num [%& her man] saw) - :: - ++ ra-repeat :: remove from outbox - ::x take message out of outbox, mark it as received or rejected. - ::x crashes if pan is not in message's audience. - :: - |= {num/@ud pan/partner saw/(unit tang)} - =+ oot=(~(get by q.outbox) num) - ?~ oot ~|([%ra-repeat-none num] !!) - =. q.outbox (~(del by q.outbox) num) - =. q.u.oot - =+ olg=(~(got by q.u.oot) pan) - %+ ~(put by q.u.oot) pan - :- -.olg - ?~ saw %received - ~> %slog.[0 u.saw] - %rejected - (ra-think | our.hid u.oot ~) - :: - ++ ra-cancel :: drop a bone - ::x removes a bone from the story in pax. - :: - |= {src/ship pax/path} - ^+ +> - ?. ?=({@ @ *} pax) - ::x if story is not in path, just delete the bone from general. - +>(general (~(del in general) ost.hid)) - %- (ra-know i.t.pax) |= par/_pa =< pa-abet - ::x delete bone from all follower groups and set src's status to %gone. - (pa-notify:pa-cancel:par src %gone *human) - :: - ++ ra-human :: look up person - ::x get her identity. if she has none, make her one. - :: - |= her/ship - ^- {human _+>} - =^ who folks - =+ who=(~(get by folks) her) - ?^ who [u.who folks] - =+ who=`human`[~ `(scot %p her)] :: XX do right - [who (~(put by folks) her who)] - [who +>.$] - :: - ++ ra-console :: console subscribe - ::x make a shell for her, subscribe her to it. - :: - |= {her/ship pax/path} - ^+ +> - ::x get story from the path, default to standard mailbox. - =/ man/knot - ?+ pax !! - $~ (main her) - {@ta $~} i.pax - == - =/ she/shell - %*(. *shell her her, man man, active `(sy [%& our.hid man] ~)) - sh-abet:~(sh-peer sh ~ `shell`she) - :: - ++ ra-subscribe :: listen to - ::x subscribe her at pax. - :: - |= {her/ship pax/path} - ^+ +> - :: ~& [%ra-subscribe ost.hid her pax] - ::x empty path, meta-subscribe and send report with all our stories. - ?: ?=($~ pax) - (ra-house(general (~(put in general) ost.hid)) ost.hid) - ?. ?=({@ @ *} pax) - (ra-evil %talk-bad-path) - =+ vab=(~(gas in *(set peer-type)) (turn (rip 3 i.pax) decode:peer-type)) - =+ pur=(~(get by stories) i.t.pax) - ?~ pur - ~& [%bad-subscribe-story-c i.t.pax] - (ra-evil %talk-no-story) - =+ soy=~(. pa i.t.pax u.pur) - ::x check her read permissions. - ?. (pa-visible:soy her) - (ra-evil %talk-no-story) - =^ who +>.$ (ra-human her) - ::x for each stream type she is interested in, add her to the followers. - =. soy ?.((~(has in vab) %a-group) soy (pa-watch-group:soy her)) - =. soy ?.((~(has in vab) %v-glyph) soy (pa-watch-glyph:soy her)) - =. soy ?.((~(has in vab) %x-cabal) soy (pa-watch-cabal:soy her)) - =. soy ?.((~(has in vab) %f-grams) soy (pa-watch-grams:soy her t.t.pax)) - ::x add her status to presence map. - =. soy (pa-notify:soy her %hear who) - ::x apply changes to story. - pa-abet:soy - :: - ++ ra-think :: publish+review - ::x consumes each thought. - :: - |= {pub/? her/ship tiz/(list thought)} - ^+ +> - ?~ tiz +> - $(tiz t.tiz, +> (ra-consume pub her i.tiz)) - :: - ++ ra-normal :: normalize - ::x sanitize %lin speech, enforce lowercase and no special characters. - :: - |= tip/thought - ^- thought - ?. ?=({$lin *} r.r.tip) tip - %_ tip - q.r.r - %- crip - %+ scag 64 - %- tufa - %+ turn (tuba (trip q.r.r.tip)) - |= a/@c - ?: &((gte a 'A') (lte a 'Z')) - (add a 32) - ?: |((lth a 32) (gth a 126)) - `@`'?' - a - == - :: - ++ ra-consume :: consume thought - ::x if pub is true, sends the thought to each partner in the audience. - ::x if false, updates the thought in our store. - :: - |= {pub/? her/ship tip/thought} - =. tip (ra-normal tip) - =+ aud=(~(tap by q.tip) ~) ::x why ~ ? - |- ^+ +>.^$ - ?~ aud +>.^$ - $(aud t.aud, +>.^$ (ra-conduct pub her p.i.aud tip)) - :: - ++ ra-conduct :: thought to partner - ::x record a message or sends it. - :: - |= {pub/? her/ship tay/partner tip/thought} - ^+ +> - :: ~& [%ra-conduct pub her tay] - ?- -.tay - $& ?: pub - =. her our.hid :: XX security! - ?: =(her p.p.tay) - (ra-record q.p.tay p.p.tay tip) - (ra-transmit p.tay tip) - ?. =(our.hid p.p.tay) - +> - (ra-record q.p.tay her tip) - $| !! - == - :: - ++ ra-record :: add to story - ::x add or update a telegram in story man. - :: - |= {man/knot gam/telegram} - %- (ra-know man) |= par/_pa =< pa-abet - (pa-learn:par gam) - :: - ++ ra-transmit :: send to neighbor - ::x sends a thought to a station, adds it to the outbox. - :: - |= {cuz/station tip/thought} - ^+ +> - =. +> - %+ ra-emit ost.hid - :* %poke - /repeat/(scot %ud p.outbox)/(scot %p p.cuz)/[q.cuz] - [p.cuz %talk] - [%talk-command `command`[%review tip ~]] - == - +>(p.outbox +(p.outbox), q.outbox (~(put by q.outbox) p.outbox tip)) - :: - ++ pa :: story core - ::x story core, used for doing work on a story. - ::x as always, an -abet arms is used for applying changes to the state. - ::x ++pa-watch- arms get called by ++ra-subscribe to add a subscriber. - ::x bones are used to identify subscribers (source event identifiers) - :: - |_ ::x man: the knot identifying the story in stories. - ::x story doesn't get a face because ease of use - :: - $: man/knot - story - == - ++ pa-abet - ::x apply/fold changes back into the stories map. - :: - ^+ +> - +>(stories (~(put by stories) man `story`+<+)) - :: - ++ pa-admire :: accept from - ::x should be checking her write permissions, but defaults to allowed. - ::x commented code seems to use an older control structure. - ::x? this seems like an easy fix, why was this ever disabled? - :: - |= her/ship - ^- ? - ::?- -.cordon.shape - :: %& (~(has in p.cordon.shape) her) - :: %| !(~(has in p.cordon.shape) her) - ::== - & - :: - ++ pa-visible :: display to - ::x checks her read permissions. - :: - |= her/ship - ^- ? - ?- p.cordon.shape - $black & ::x channel, all - $green & ::x journal, all - $brown (team our.hid her) ::x mailbox, our - $white (~(has in q.cordon.shape) her) ::x village, invite - == - :: - ++ pa-report :: update - ::x sends report to all bones. - :: - |= {wac/(set bone) caw/report} - :: ~& [%pa-report man -.caw] - ^+ +> - ?~ wac +> - =. +> $(wac l.wac) - =. +> $(wac r.wac) - :: ~& [%pa-report-cabal man shape] - (pa-sauce n.wac [%diff %talk-report caw]~) - :: - ++ pa-watch-group :: subscribe presence - ::x if she may, add her bone to presence followers and send her a group - ::x (presence) report. - :: - |= her/ship - ?. (pa-admire her) - (pa-sauce ost.hid [%quit ~]~) - =. groupers (~(put in groupers) ost.hid) - (pa-report-group ost.hid ~ ~) - :: - ++ pa-watch-cabal :: subscribe config - ::x if she may, add her bone to config followers and send her an updated - ::x cabal (config) report. - :: - |= her/ship - ?. (pa-admire her) - ~& [%pa-admire-not her] - (pa-sauce ost.hid [%quit ~]~) - =. cabalers (~(put in cabalers) ost.hid) - :: ~& [%pa-watch-cabal her man shape] - (pa-sauce ost.hid [[%diff %talk-report %cabal shape mirrors] ~]) - :: - ++ pa-watch-glyph :: subscribe config - ::x if she may, add her bone to glyph followers and send an updated glyph - ::x report. - :: - |= her/ship - ?. (pa-admire her) - ~& [%pa-admire-not her] - (pa-sauce ost.hid [%quit ~]~) - =. glyphers (~(put in glyphers) ost.hid) - (pa-report [ost.hid ~ ~] %glyph nak) - :: - ++ pa-report-group :: update presence - ::x build a group report, containing our different presence maps, and - ::x send it to all bones. - ::x? why should we be responsible for sending remotes presences? - :: - |= vew/(set bone) - %^ pa-report vew %group - :- %- ~(run by locals) - |=({@ a/status} a) - %- ~(urn by remotes) :: XX preformance - |= {pan/partner atl/atlas} ^- atlas - ?. &(?=($& -.pan) =(our.hid p.p.pan)) atl - =+ (~(get by stories) q.p.pan) - ?~ - atl - %- ~(run by locals.u) - |=({@ a/status} a) - :: - ++ pa-report-cabal :: update config - ::x a cabal report, containing our and remote configs, to all config - ::x followers. - :: - (pa-report cabalers %cabal shape mirrors) - :: - ++ pa-cabal - ::x add station's config to our remote config map. - ::x? ham is unused, not even when calling this. - :: - |= {cuz/station con/config ham/(map station config)} - ^+ +> - =+ old=mirrors - =. mirrors (~(put by mirrors) cuz con) - ?: =(mirrors old) - +>.$ - pa-report-cabal - :: - ++ pa-diff-talk-report :: subscribed update - ::x process a talk report from cuz. - :: - |= {cuz/station rad/report} - ^+ +> - ::x verify we are supposed to receive reports from cuz. - ?. (~(has in sources.shape) [%& cuz]) - ~& [%pa-diff-unexpected cuz rad] - +> - ?+ -.rad ~|([%talk-odd-friend rad] !!) - $cabal (pa-cabal cuz +.rad) - $group (pa-remind [%& cuz] +.rad) - $grams (pa-lesson q.+.rad) - == - :: - ++ pa-quit :: stop subscription - ::x delete tay from our subscriptions, then send an updated capal report. - :: - |= tay/partner - pa-report-cabal(sources.shape (~(del in sources.shape) tay)) - :: - ++ pa-sauce :: send backward - ::x turns cards into moves, reverse order, prepend to existing moves. - :: - |= {ost/bone cub/(list card)} - %_ +>.$ - moves - (welp (flop (turn cub |=(a/card [ost a]))) moves) - == - :: - ++ pa-abjure :: unsubscribe move - ::x for each partner, produce a %pull/unsubscribe move. - :: - |= tal/(list partner) - %+ pa-sauce 0 ::x why bone 0? - %- zing - %+ turn tal - |= tay/partner - ^- (list card) - ?- -.tay - $| ~& tweet-abjure+p.p.tay - !! - :: - $& ~& [%pa-abjure [our.hid man] [p.p.tay q.p.tay]] - :_ ~ - :* %pull - /friend/show/[man]/(scot %p p.p.tay)/[q.p.tay] - [p.p.tay %talk] - ~ - == - == - :: - ++ pa-acquire :: subscribe to - ::x for each partner, produce a %peer/subscribe move. - :: - |= tal/(list partner) - %+ pa-sauce 0 - %- zing - %+ turn tal - |= tay/partner - ^- (list card) - =+ num=(~(get by sequence) tay) - =+ old=(sub now.hid ~d1) :: XX full backlog - ::x subscribe starting at the last message we read, - ::x or if we haven't read any yet, messages from up to a day ago. - =+ ini=?^(num (scot %ud u.num) (scot %da old)) - =/ typ - =+ (ly ~[%a-group %f-grams %x-cabal]) - (rap 3 (turn - encode:peer-type)) - ?- -.tay - $| !! - $& :: ~& [%pa-acquire [our.hid man] [p.p.tay q.p.tay]] - :_ ~ - :* %peer - /friend/show/[man]/(scot %p p.p.tay)/[q.p.tay] - [p.p.tay %talk] - /[typ]/[q.p.tay]/[ini] - == - == - :: - ++ pa-reform :: reconfigure, ugly - ::x change config of current story, subscribe/unsubscribe to/from the - ::x partners we gained/lost, and send out an updated cabal report. - :: - |= cof/config - =+ ^= dif ^- (pair (list partner) (list partner)) - =+ old=`(list partner)`(~(tap in sources.shape) ~) - =+ new=`(list partner)`(~(tap in sources.cof) ~) - :- (skip new |=(a/partner (~(has in sources.shape) a))) - (skip old |=(a/partner (~(has in sources.cof) a))) - =. +>.$ (pa-acquire p.dif) - =. +>.$ (pa-abjure q.dif) - =. shape cof - pa-report-cabal - :: - ++ pa-cancel :: unsubscribe from - ::x deletes the current ost.hid from all follower groups. - :: - :: ~& [%pa-cancel ost.hid] - %_ . - gramsers (~(del by gramsers) ost.hid) - groupers (~(del in groupers) ost.hid) - glyphers (~(del in glyphers) ost.hid) - cabalers (~(del in cabalers) ost.hid) - == - :: - ++ pa-notify :: local presence - ::x add her status to our presence map. if this changes it, send report. - :: - |= {her/ship saz/status} - ^+ +> - =/ nol (~(put by locals) her now.hid saz) - ?: =(nol locals) +>.$ - (pa-report-group(locals nol) groupers) - :: - ++ pa-remind :: remote presence - ::x adds tay's loc to our remote presence map, after merging with rem. - ::x if this changes anything, send update report. - :: - |= {tay/partner loc/atlas rem/(map partner atlas)} - ::x remove this story from the presence map, since it's in local already. - =. rem (~(del by rem) %& our.hid man) :: superceded by local data - =/ buk (~(uni timed remotes) rem) :: XX drop? - =. buk (~(put timed buk) tay now.hid loc) - ?: =(~(strip timed buk) ~(strip timed remotes)) +>.$ - (pa-report-group(remotes buk) groupers) - :: - ++ pa-start :: start stream - ::x grab all telegrams that fall within the river and send them in a - ::x grams report to ost.hid. - :: - |= riv/river - ^+ +> - =- :: ~& [%pa-start riv lab] - =. +>.$ - (pa-sauce ost.hid [[%diff %talk-report %grams q.lab r.lab] ~]) - ?: p.lab ::x? dun never gets changed, so always | ? - (pa-sauce ost.hid [[%quit ~] ~]) - +>.$(gramsers (~(put by gramsers) ost.hid riv)) - ^= lab - =+ [end=count gaz=grams dun=| zeg=*(list telegram)] - |- ^- (trel ? @ud (list telegram)) - ?~ gaz [dun end zeg] - ?: ?- -.q.riv :: after the end - $ud (lte p.q.riv end) - $da (lte p.q.riv p.r.q.i.gaz) - == - ::x if we're past the river, continue browsing back. - $(end (dec end), gaz t.gaz) - ?: ?- -.p.riv :: before the start - $ud (lth end p.p.riv) - $da (lth p.r.q.i.gaz p.p.riv) - == - ::x if we're before the river, we're done. - [dun end zeg] - ::x if we're in the river, add this gram and continue. - $(end (dec end), gaz t.gaz, zeg [i.gaz zeg]) - :: - ++ pa-watch-grams :: subscribe messages - ::x (called upon subscribe) send backlog of grams to her. - ::x deduces which messages to send from pax. - :: - |= {her/ship pax/path} - ^+ +> - ?. (pa-admire her) - ~& [%pa-watch-grams-admire ~] - (pa-sauce ost.hid [%quit ~]~) - ::x find the range of grams to send. - =+ ^= ruv ^- (unit river) - %+ biff ::x collapse unit list. - (zl:jo (turn pax ;~(biff slay |=(a/coin `(unit dime)`?~(-.a a ~))))) - |= paf/(list dime) - ?~ paf - $(paf [%ud (sub (max 64 count) 64)]~) - ?~ t.paf - $(t.paf [%da (dec (bex 128))]~) - ?. ?=({{?($ud $da) @} {?($ud $da) @} $~} paf) - ~ - ::x? the switches, they do nothing! - `[[?+(- . $ud .)]:i.paf [?+(- . $ud .)]:i.t.paf] :: XX types - :: ~& [%pa-watch-grams her pax ruv] - ?~ ruv - ~& [%pa-watch-grams-malformed pax] - (pa-sauce ost.hid [%quit ~]~) - (pa-start u.ruv) - :: - ++ pa-refresh :: update to listeners - ::x called when grams get added or changed. calculates the changes and - ::x sends them to all message followers. if we run into any followers - ::x that are no longer interested in this story, remove them. - :: - |= {num/@ud gam/telegram} - ^+ +> - =+ ^= moy - |- ^- (pair (list bone) (list move)) - ?~ gramsers [~ ~] - :: ~& [%pa-refresh num n.gramsers] - =+ lef=$(gramsers l.gramsers) - =+ rit=$(gramsers r.gramsers) - =+ old=[p=(welp p.lef p.rit) q=(welp q.lef q.rit)] - ?: ?- -.q.q.n.gramsers :: after the end - $ud (lte p.q.q.n.gramsers num) - $da (lte p.q.q.n.gramsers p.r.q.gam) - == - [[p.n.gramsers p.old] [[p.n.gramsers %quit ~] q.old]] - ?: ?- -.p.q.n.gramsers :: before the start - $ud (gth p.p.q.n.gramsers num) - $da (gth p.p.q.n.gramsers p.r.q.gam) - == - old - :- p.old - [[p.n.gramsers %diff %talk-report %grams num gam ~] q.old] - =. moves (welp q.moy moves) - |- ^+ +>.^$ - ?~ p.moy +>.^$ - $(p.moy t.p.moy, gramsers (~(del by gramsers) i.p.moy)) - :: - ++ pa-lesson :: learn multiple - ::x learn all telegrams in a list. - :: - |= gaz/(list telegram) - ^+ +> - ?~ gaz +> - $(gaz t.gaz, +> (pa-learn i.gaz)) - :: - ++ pa-learn :: learn message - ::x store an incoming telegram, modifying audience to say we received it. - ::x update existing telegram if it already exists. - :: - |= gam/telegram - ^+ +> - ::x if author isn't allowed to write here, reject. - ?. (pa-admire p.gam) - ~& %pa-admire-rejected - +>.$ - =. q.q.gam - ::x if we are in the audience, mark us as having received it. - =+ ole=(~(get by q.q.gam) [%& our.hid man]) - ?^ ole (~(put by q.q.gam) [%& our.hid man] -.u.ole %received) - :: for fedearted stations, pretend station src/foo is also our/foo - :: XX pass src through explicitly instead of relying on implicit - :: value in hid from the subscription to src/foo - =+ ole=(~(get by q.q.gam) [%& src.hid man]) - ?~ ole q.q.gam - ::x as described above, fake src into our. - =. q.q.gam (~(del by q.q.gam) [%& src.hid man]) - (~(put by q.q.gam) [%& our.hid man] -.u.ole %received) - =+ old=(~(get by known) p.q.gam) - ?~ old - (pa-append gam) ::x add - (pa-revise u.old gam) ::x modify - :: - ++ pa-append :: append new - ::x add gram to our story, and update our subscribers. - :: - |= gam/telegram - ^+ +> - %+ %= pa-refresh - grams [gam grams] - count +(count) - known (~(put by known) p.q.gam count) - == - count - gam - :: - ++ pa-revise :: revise existing - ::x modify a gram in our story, and update our subscribers. - :: - |= {num/@ud gam/telegram} - =+ way=(sub count num) - ?: =(gam (snag (dec way) grams)) - +>.$ :: no change - =. grams (welp (scag (dec way) grams) [gam (slag way grams)]) - (pa-refresh num gam) - -- - -- -:: -++ sn :: station render core - ::x used in both station and ship rendering. - :: - ::x man: mailbox. - ::x one: the station. - |_ {man/knot one/station} - ++ sn-best :: best to show - ::x returns true if one is better to show, false otherwise. - ::x prioritizes: our > main > size. - :: - |= two/station - ^- ? - ::x the station that's ours is better. - ?: =(our.hid p.one) - ?: =(our.hid p.two) - ?< =(q.one q.two) - ::x if both stations are ours, the main story is better. - ?: =((main p.one) q.one) %& - ?: =((main p.two) q.two) %| - ::x if neither are, pick the "larger" one. - (lth q.one q.two) - %& - ::x if one isn't ours but two is, two is better. - ?: =(our.hid p.two) - %| - ?: =(p.one p.two) - ::x if they're from the same ship, pick the "larger" one. - (lth q.one q.two) - ::x when in doubt, pick one if its ship is "smaller" than its channel. - ::x? i guess you want this to be consistent across (a b) and (b a), but - ::x this still seems pretty arbitrary. - (lth p.one q.one) - :: - ++ sn-curt :: render name in 14 - ::x prints a ship name in 14 characters. left-pads with spaces. - ::x? mup is unused, what is it even for? ++ta-show still uses it. - :: - |= mup/? - ^- tape - =+ raw=(cite p.one) - (runt [(sub 14 (lent raw)) ' '] raw) - :: - ++ sn-nick - ::x get nick for ship, or shortname if no nick. left-pads with spaces. - :: - |. ^- tape - =+ nym=(~(get by folks) p.one) - ?~ nym - (sn-curt |) - ?~ hand.u.nym - (sn-curt |) - =+ raw=(trip u.hand.u.nym) - =+ len=(sub 14 (lent raw)) - (weld (reap len ' ') raw) - :: - ++ sn-phat :: render accurately - ::x prints a station fully, but still taking "shortcuts" where possible: - ::x ":" for local mailbox, "~ship" for foreign mailbox, - ::x "%channel" for local station, "/channel" for parent station. - :: - ^- tape - ?: =(p.one our.hid) - ?: =(q.one man) - ":" - ['%' (trip q.one)] - ?: =(p.one (sein our.hid)) - ['/' (trip q.one)] - =+ wun=(scow %p p.one) - ?: =(q.one (main p.one)) - wun - :(welp wun "/" (trip q.one)) - -- -:: -++ ta :: partner core - ::x used primarily for printing partners. - :: - ::x man: mailbox. - ::x one: the partner. - |_ {man/knot one/partner} - ++ ta-beat :: more relevant - ::x returns true if one is better to show, false otherwise. - ::x prefers stations over passports. if both are stations, sn-best. if both - ::x are passports, pick the "larger" one, if they're equal, content hash. - :: - |= two/partner ^- ? - ?- -.one - $& - ?- -.two - $| %& - $& (~(sn-best sn man p.one) p.two) - == - :: - $| - ?- -.two - $& %| - $| ?: =(-.p.two -.p.one) - (lth (mug +.p.one) (mug +.p.two)) - (lth -.p.two -.p.one) - == - == - ++ ta-best :: most relevant - ::x picks the most relevant partner. - :: - |=(two/partner ?:((ta-beat two) two one)) - :: - ++ ta-full (ta-show ~) :: render full width - ++ ta-show :: render partner - ::x renders a partner as text. - :: - |= moy/(unit ?) - ^- tape - ?- -.one - ::x render station as glyph if we can. - $& - ?~ moy - =+ cha=(~(get by nik) one ~ ~) - =- ?~(cha - "'{u.cha ~}' {-}") - ~(sn-phat sn man p.one) - (~(sn-curt sn man p.one) u.moy) - :: - ::x render passport. - $| - =+ ^= pre ^- tape - ?- -.p.one - $twitter "@t:" - == - ?~ moy - (weld pre (trip p.p.one)) - =. pre ?.(=(& u.moy) pre ['*' pre]) - (sigh 14 pre p.p.one) - == - -- -:: -++ te :: audience renderer - ::x used for representing audiences (sets of partners) as tapes. - :: - :: man: mailbox. - :: lix: members of the audience. - |_ {man/knot lix/(set partner)} - ++ te-best ^- (unit partner) - ::x pick the most relevant partner. - :: - ?~ lix ~ - :- ~ - |- ^- partner - =+ lef=`(unit partner)`te-best(lix l.lix) - =+ rit=`(unit partner)`te-best(lix r.lix) - =. n.lix ?~(lef n.lix (~(ta-best ta man n.lix) u.lef)) - =. n.lix ?~(rit n.lix (~(ta-best ta man n.lix) u.rit)) - n.lix - :: - ++ te-deaf ^+ . :: except for self - ::x remove ourselves from the audience. - :: - .(lix (~(del in lix) `partner`[%& our.hid man])) - :: - ++ te-maud ^- ? :: multiple audience - ::x checks if there's multiple partners in the audience via pattern match. - :: - =. . te-deaf - !?=($@($~ {* $~ $~}) lix) - :: - ++ te-prom ^- tape :: render targets - ::x render all partners, ordered by relevance. - :: - =. . te-deaf - =+ ^= all - %+ sort `(list partner)`(~(tap in lix)) - |= {a/partner b/partner} - (~(ta-beat ta man a) b) - =+ fir=& - |- ^- tape - ?~ all ~ - ;: welp - ?:(fir "" " ") - (~(ta-show ta man i.all) ~) - $(all t.all, fir |) - == - :: - ++ te-whom :: render sender - ::x render sender as the most relevant partner. - :: - (~(ta-show ta man (need te-best)) ~ te-maud) - :: - ++ ta-dire :: direct message - ::x returns true if partner is a mailbox of ours. - :: - |= pan/partner ^- ? - ?& ?=($& -.pan) - =(p.p.pan our.hid) - :: - =+ sot=(~(get by stories) q.p.pan) - &(?=(^ sot) ?=($brown p.cordon.shape.u.sot)) - == - :: - ++ te-pref :: audience glyph - ::x get the glyph that corresponds to the audience, with a space appended. - ::x if it's a dm to us, use :. if it's a dm by us, use ;. complex, use *. - :: - ^- tape - =+ cha=(~(get by nik) lix) - ?^ cha ~[u.cha ' '] - ?. (lien (~(tap by lix)) ta-dire) - "* " - ?: ?=({{$& ^} $~ $~} lix) - ": " - "; " - -- -:: -++ tr :: telegram renderer - ::x responsible for converting telegrams and everything relating to them to - ::x text to be displayed in the cli. - :: - |_ $: ::x man: story. - ::x sef: settings flags. - ::x telegram: - ::x who: author. - ::x thought: - ::x sen: unique identifier. - ::x aud: audience. - ::x statement: - ::x wen: timestamp. - ::x bou: complete aroma. - ::x sep: message contents. - :: - man/knot - sef/(set knot) - who/ship - sen/serial - aud/audience - wen/@da - bou/bouquet - sep/speech - == - ++ tr-fact ^- sole-effect :: activate effect - ::x produce sole-effect for printing message details. - :: - ~[%mor [%tan tr-meta] tr-body] - :: - ++ tr-line ^- tape :: one-line print - ::x crams a telegram into a single line by displaying a short ship name, - ::x a short representation of the gram, and an optional timestamp. - :: - =+ txt=(tr-text =(who our.hid)) - ?: =(~ txt) "" - =+ ^= baw - :: ?: oug - :: ~(te-whom te man tr-pals) - ?. (~(has in sef) %noob) - (~(sn-curt sn man [who (main who)]) |) - (~(sn-nick sn man [who (main who)])) - ?: (~(has in sef) %showtime) - =+ dat=(yore now.hid) - =+ ^= t - |= a/@ ^- tape - %+ weld - ?: (lth a 10) "0" ~ - (scow %ud a) - =+ ^= time :(weld "~" (t h.t.dat) "." (t m.t.dat) "." (t s.t.dat)) - :(weld baw txt (reap (sub 67 (lent txt)) ' ') time) - (weld baw txt) - :: - ++ tr-meta ^- tang - ::x build strings that display metadata, including message serial, - ::x timestamp, author and audience. - :: - =. wen (sub wen (mod wen (div wen ~s0..0001))) :: round - =+ hed=leaf+"{(scow %uv sen)} at {(scow %da wen)}" - =+ =< paz=(turn (~(tap by aud)) .) - |=({a/partner *} leaf+~(ta-full ta man a)) - =+ bok=(turn (sort (~(tap in bou)) aor) smyt) - [%rose [" " ~ ~] [hed >who< [%rose [", " "to " ~] paz] bok]]~ - :: - ++ tr-body - ::x long-form display of message contents, specific to each speech type. - :: - |- ^- sole-effect - ?+ -.sep tan+[>sep<]~ - $exp tan+~[leaf+"# {(trip p.sep)}"] - $lin tan+~[leaf+"{?:(p.sep "" "@ ")}{(trip q.sep)}"] - $non tan+~ - $app tan+~[rose+[": " ~ ~]^~[leaf+"[{(trip p.sep)}]" leaf+(trip q.sep)]] - $url url+(crip (earf p.sep)) - $mor mor+(turn p.sep |=(speech ^$(sep +<))) - $fat [%mor $(sep q.sep) tan+(tr-rend-tors p.sep) ~] - $api - :- %tan - :_ ~ - :+ %rose - [": " ~ ~] - :~ leaf+"[{(trip id.sep)} on {(trip service.sep)}]" - leaf+(trip body.sep) - leaf+(earf url.sep) - == - == - :: - ++ tr-rend-tors - ::x render an attachment. - :: - |= a/torso ^- tang - ?- -.a - $name (welp $(a q.a) leaf+"={(trip p.a)}" ~) - $tank +.a - $text (turn (flop +.a) |=(b/cord leaf+(trip b))) - == - :: - ++ tr-pals - ::x strip delivery info from audience, producing a set of partners. - :: - ^- (set partner) - %- ~(gas in *(set partner)) - (turn (~(tap by aud)) |=({a/partner *} a)) - :: - ++ tr-chow - ::x truncate the txt to be of max len characters. if it does truncate, - ::x indicates it did so by appending a character. - :: - |= {len/@u txt/tape} ^- tape - ?: (gth len (lent txt)) txt - =. txt (scag len txt) - |- - ?~ txt txt - ?: =(' ' i.txt) - |-(['_' ?.(?=({$' ' *} t.txt) t.txt $(txt t.txt))]) - ?~ t.txt "…" - [i.txt $(txt t.txt)] - :: - ++ tr-both - ::x try to fit two tapes into a single line. - :: - |= {a/tape b/tape} ^- tape - ?: (gth (lent a) 62) (tr-chow 64 a) - %+ weld a - (tr-chow (sub 64 (lent a)) " {b}") - :: - ++ tr-text - ::x gets a tape representation of a message that fits within a single line. - :: - |= oug/? - ^- tape - ?+ -.sep ~&(tr-lost+sep "") - $mor - ?~ p.sep ~&(%tr-mor-empty "") - |- ^- tape - ?~ t.p.sep ^$(sep i.p.sep) - (tr-both ^$(sep i.p.sep) $(p.sep t.p.sep)) - :: - $fat - %+ tr-both $(sep q.sep) - ?+ -.p.sep "..." - $tank ~(ram re %rose [" " `~] +.p.sep) - == - :: - $exp (tr-chow 66 '#' ' ' (trip p.sep)) - $url =+ ful=(earf p.sep) - ?: (gth 64 (lent ful)) ['/' ' ' ful] - :+ '/' '_' - =+ hok=r.p.p.p.sep - ~! hok - =- (swag [a=(sub (max 64 (lent -)) 64) b=64] -) - ^- tape - =< ?:(?=($& -.hok) (reel p.hok .) +:(scow %if p.hok)) - |=({a/knot b/tape} ?~(b (trip a) (welp b '.' (trip a)))) - :: - $lin - =+ txt=(trip q.sep) - ?: p.sep - =+ pal=tr-pals - =. pal ?: =(who our.hid) pal - (~(del in pal) [%& who (main who)]) - (weld ~(te-pref te man pal) txt) - (weld " " txt) - :: - $app - (tr-chow 64 "[{(trip p.sep)}]: {(trip q.sep)}") - :: - $api - (tr-chow 64 "[{(trip id.sep)}@{(trip service.sep)}]: {(trip summary.sep)}") - == - -- -:: -++ peer :: accept subscription - ::x incoming subscription on pax. - :: - |= pax/path - ^+ [*(list move) +>] - ~? !=(src.hid our.hid) [%peer-talk-stranger src.hid] - :: ~& [%talk-peer src.hid ost.hid pax] - ?: ?=({$sole *} pax) - ?> (team our.hid src.hid) - ~? (~(has by shells) ost.hid) [%talk-peer-replaced ost.hid pax] - ra-abet:(ra-console:ra src.hid t.pax) - :: ~& [%talk-peer-data ost.hid src.hid pax] - ra-abet:(ra-subscribe:ra src.hid pax) -:: -++ poke-talk-command :: accept command - ::x incoming talk command. process it and update logs. - :: - |= cod/command - ^+ [*(list move) +>] - :: ~& [%talk-poke-command src.hid cod] - =^ mos +>.$ - ra-abet:(ra-apply:ra src.hid cod) - =^ mow +>.$ log-all-to-file - [(welp mos mow) +>.$] -:: -++ poke-sole-action :: accept console - ::x incoming sole action. process it. - :: - |= act/sole-action - ra-abet:(ra-sole:ra act) -:: -++ diff-talk-report :: - ::x incoming talk-report. process it and update logs. - :: - |= {way/wire rad/report} - ^- (quip move +>) - =^ mos +>.$ - %+ etch-friend way |= {man/knot cuz/station} - ra-abet:(ra-diff-talk-report:ra man cuz rad) - =^ mow +>.$ log-all-to-file - [(welp mos mow) +>.$] -:: -++ coup-repeat :: - ::x ack from ++ra-transmit. mark the message as received or rejected. - :: - |= {way/wire saw/(unit tang)} - %+ etch-repeat [%repeat way] |= {num/@ud src/@p man/knot} - ra-abet:(ra-coup-repeat:ra [num src man] saw) -:: -++ etch :: parse wire - ::x parse wire to obtain either %friend with story and station or %repeat - ::x with message number, source ship and story. - :: - |= way/wire - ^- weir - ?+ -.way !! - $friend - ?> ?=({$show @ @ @ $~} t.way) - [%friend i.t.t.way (slav %p i.t.t.t.way) i.t.t.t.t.way] - :: - $repeat - ?> ?=({@ @ @ $~} t.way) - [%repeat (slav %ud i.t.way) (slav %p i.t.t.way) i.t.t.t.way] - == -:: -++ etch-friend :: - ::x parse a /friend wire, call gate with resulting data. - :: - |= {way/wire fun/$-({man/knot cuz/station} {(list move) _.})} - =+ wer=(etch way) - ?>(?=($friend -.wer) (fun p.wer q.wer)) -:: -++ etch-repeat :: - ::x parse a /repeat wire, call gate with resulting data. - :: - |= {way/wire fun/$-({num/@ud src/@p man/knot} {(list move) _.})} - =+ wer=(etch way) - ?>(?=($repeat -.wer) (fun p.wer q.wer r.wer)) -:: -++ reap-friend :: - ::x subscription n/ack. if it failed, remove their subscription from state. - :: - |= {way/wire saw/(unit tang)} - ^- (quip move +>) - ?~ saw [~ +>] - %+ etch-friend [%friend way] |= {man/knot cuz/station} - =. u.saw [>%reap-friend-fail man cuz< u.saw] - %- (slog (flop u.saw)) - ra-abet:(ra-quit:ra man cuz) -:: -++ quit-friend :: - ::x resubscribe. - :: - |= way/wire - %+ etch-friend [%friend way] |= {man/knot cuz/station} - ra-abet:(ra-retry:ra man cuz) -:: -++ pull :: - ::x unsubscribe. remove from story and shells. - :: - |= pax/path - ^+ [*(list move) +>] - :: ~& [%talk-pull src.hid ost.hid pax] - =^ moz +>.$ ra-abet:(ra-cancel:ra src.hid pax) - [moz +>.$(shells (~(del by shells) ost.hid))] -:: -++ log-all-to-file - ::x for every story we're logging, (over)write all their grams to log files, - ::x if new ones have arrived. - :: - ^- (quip move .) - ?: & [~ .] :: XXX!!!! - :_ %_ . - log %- ~(urn by log) - |=({man/knot len/@ud} count:(~(got by stories) man)) - == - %+ murn (~(tap by log)) - |= {man/knot len/@ud} - ^- (unit move) - ?: (gte len count:(~(got by stories) man)) - ~ - `(log-to-file man) -:: -++ log-to-file - ::x log all grams of story man to a file. - :: - |= man/knot - ^- move - =+ ^- paf/path - =+ day=(year %*(. (yore now.hid) +.t +:*tarp)) - %+ tope [our.hid %home da+now.hid] - /talk-telegrams/(scot %da day)/[man]/talk - =+ grams:(~(got by stories) man) - [ost.hid %info /jamfile our.hid (foal paf [%talk-telegrams !>(-)])] -:: -++ poke-talk-comment - ::x send a comment. - :: - |= {pax/path sup/spur txt/@t} ^- (quip move +>) - ra-abet:(ra-comment:ra pax sup txt) -:: -++ poke-talk-fora-post - ::x send a fora post. - :: - |= {pax/path sup/spur hed/@t txt/@t} ^- (quip move +>) - ra-abet:(ra-fora-post:ra pax sup hed txt) -:: -++ poke-talk-save - ::x store the talk telegrams of story man in a log file. - :: - |= man/knot - ^- (quip move +>) - =+ paf=/(scot %p our.hid)/home/(scot %da now.hid)/talk/[man]/talk-telegrams - =+ grams:(~(got by stories) man) - [[ost.hid %info /jamfile our.hid (foal paf [%talk-telegrams !>(-)])]~ +>.$] -:: -++ poke-talk-load - ::x load/update the story man into our state, as saved in ++poke-talk-save. - :: - |= man/knot - =+ ^= grams - .^ (list telegram) - %cx - /(scot %p our.hid)/home/(scot %da now.hid)/talk/[man]/talk-telegrams - == - =+ toy=(~(got by stories) man) - [~ +>.$(stories (~(put by stories) man toy(grams grams, count (lent grams))))] -:: -++ poke-talk-log - ::x start logging story man. - :: - |= man/knot - ~& %poke-log - ^- (quip move +>) - :- [(log-to-file man) ~] - +>.$(log (~(put by log) man count:(~(got by stories) man))) -:: -++ poke-talk-unlog - ::x stop logging story man. - :: - |= man/knot - ^- (quip move +>) - :- ~ - +>.$(log (~(del by log) man)) -:: -++ prep - ::x state adapter. - :: - |= old/(unit house-any) - ^- (quip move ..prep) - ?~ old - ra-abet:ra-init:ra - |- - ?- -.u.old - $6 [~ ..prep(+<+ u.old)] - $5 =< ^$(-.u.old %6, shells.u.old (~(run by shells.u.old) .)) - |= shell-5 ^- shell - +<(passive %passive-deprecated, active ?^(active active `passive)) - $4 =< ^$(-.u.old %5, shells.u.old (~(run by shells.u.old) .)) - |=(shell-4 `shell-5`+<(system [system settings=*(set knot)])) - $3 =< ^$(-.u.old %4, stories.u.old (~(run by stories.u.old) .)) - |=(story-3 `story`+<(cabalers [cabalers glyphers=*(set bone)])) - == --- diff --git a/lib/talk.hoon b/lib/talk.hoon index d99178332..d6c319a34 100644 --- a/lib/talk.hoon +++ b/lib/talk.hoon @@ -11,13 +11,19 @@ [. ^talk] |_ bol/bowl ++ main :: main story - |= our/ship ^- cord - =+ can=(clan our) + |= who/ship ^- cord + =+ can=(clan who) ?+ can %porch $czar %court $king %floor == :: +::TODO add to zuse? +++ true-self + |= who/ship + ?. ?=($earl (clan who)) who + (sein who) +:: ++ said-url :: app url |= url/purl :^ ost.bol %poke /said-url @@ -87,13 +93,14 @@ $filter cof(fit fit.dif) $remove cof :: - $source + $sourcee %= cof - src + sre %. `(set partner)`pas.dif ::TODO? why do we *need* to cast? + ~& [%doing-sourcee add.dif pas.dif] ?: add.dif - ~(uni in src.cof) - ~(dif in src.cof) + ~(uni in sre.cof) + ~(dif in sre.cof) == :: $permit @@ -116,23 +123,6 @@ ~ ses.con.cof == - :: - $federal - %= cof - fes.fed - ?. fed.dif fes.fed.cof - %. sis.dif - ?: add.dif - ~(uni in fes.fed.cof) - ~(dif in fes.fed.cof) - :: - may.fed - ?: fed.dif may.fed.cof - %. sis.dif - ?: add.dif - ~(uni in may.fed.cof) - ~(dif in may.fed.cof) - == == :: ++ change-status ::< ... @@ -155,4 +145,77 @@ == == == +:: +++ depa :: de-pathing core + => |% ++ grub * :: result + ++ weir (list coin) :: parsed wire + ++ fist $-(weir grub) :: reparser instance + -- + |% + :: + ++ al + |* {hed/$-(coin *) tal/fist} + |= wir/weir ^+ [*hed *tal] + ?~ wir !! + [(hed i.wir) (tal t.wir)] + :: + ++ at + |* typ/{@tas (pole @tas)} + =+ [i-typ t-typ]=typ + |= wer/weir + ^- (tup:dray i-typ t-typ) ::< ie, (tup %p %tas ~) is {@p @tas} + ?~ wer !! + ?~ t-typ + ?^ t.wer !! + ((do i-typ) i.wer) + :- ((do i-typ) i.wer) + (^$(typ t-typ) t.wer) + :: + ++ mu :: true unit + |* wit/fist + |= wer/weir + ?~(wer ~ (some (wit wer))) + :: + ++ af :: object as frond + |* buk/(pole {cord fist}) + |= wer/weir + ?> ?=({{$$ $tas @tas} *} wer) + ?~ buk !! + =+ [[tag wit] t-buk]=buk + ?: =(tag q.p.i.wer) + [tag ~|(tag+`@tas`tag (wit t.wer))] + ?~ t-buk ~|(bad-tag+q.p.i.wer !!) + (^$(buk t-buk) wer) + :: + ++ or + |* typ/|-($@(@tas {@tas $})) + |= con/coin + ::^- _(snag *@ (turn (limo typ) |*(a/@tas [a (odo:raid a)]))) + ?> ?=($$ -.con) + =/ i-typ ?@(typ typ -.typ) + ?: =(i-typ p.p.con) + :- i-typ + ^- (odo:raid i-typ) + q.p.con + ?@ typ ~|(%bad-odor !!) + (^$(typ +.typ) con) + :: + ++ do + |* typ/@tas + |= con/coin + ^- (odo:raid typ) + ?. ?=($$ -.con) ~|(%not-dime !!) + ?. =(typ p.p.con) ~|(bad-odor+`@tas`p.p.con !!) + q.p.con + :: + ++ ul :: null + |=(wer/weir ?~(wer ~ !!)) + :: + ++ un + |* wit/$-(coin *) + |= wir/weir ^+ *wit + ?~ wir !! + ?^ t.wir !! + (wit i.wir) + -- -- diff --git a/mar/talk/command.hoon b/mar/talk/command.hoon index b5ec7e880..3806d1058 100644 --- a/mar/talk/command.hoon +++ b/mar/talk/command.hoon @@ -14,7 +14,8 @@ => [jo ..command] |= a/json ^- command =- (need ((of -) a)) - =< :~ review+(ar thot) + =< :~ publish+(ar thot) + bearing+ul == |% ++ op :: parse keys of map diff --git a/mar/talk/prize.hoon b/mar/talk/prize.hoon new file mode 100644 index 000000000..aa7b3bc1f --- /dev/null +++ b/mar/talk/prize.hoon @@ -0,0 +1,14 @@ +:: +:::: /hoon/prize/talk/mar + :: +/? 310 +/- talk +!: +[talk .] +|_ piz/prize +:: +++ grab :: convert from + |% + ++ noun prize :: clam from %noun + -- +-- diff --git a/mar/talk/rumor.hoon b/mar/talk/rumor.hoon new file mode 100644 index 000000000..4fc0164ce --- /dev/null +++ b/mar/talk/rumor.hoon @@ -0,0 +1,14 @@ +:: +:::: /hoon/rumor/talk/mar + :: +/? 310 +/- talk +!: +[talk .] +|_ dif/rumor +:: +++ grab :: convert from + |% + ++ noun rumor :: clam from %noun + -- +-- diff --git a/sur/talk.hoon b/sur/talk.hoon index 4baf6d96f..07397ad5d 100644 --- a/sur/talk.hoon +++ b/sur/talk.hoon @@ -9,26 +9,23 @@ ::> models relating to queries, their results and updates. ::+| :: -::TODO path parsing/casting: ;;(query pax) or ((hard query) pax) -:: or (raid /~zod/5 /[%p]/[%ud]) -:: ...but it's still shit. ++ query ::> query paths $% {$reader $~} ::< shared ui state {$friend $~} ::< publicly joined + {$burden $~} ::< duties to share + {$report $~} ::< duty reports {$circle nom/knot ran/range} ::< story query == :: -++ range (unit {hed/@ t/(unit {tal/@ $~})}) ::< msg range, @ud/@da +++ range (unit {hed/place tal/(unit place)}) ::< msg range, @ud/@da +++ place $%({$da @da} {$ud @ud}) ::< point for range ++ prize ::> query result $% $: $reader ::< /reader gys/(jug char (set partner)) ::< glyph bindings nis/(map ship cord) ::< nicknames == :: {$friend cis/(set circle)} ::< /friend - $: $circle ::< /circle - gaz/(list telegram) ::< queried messages - cos/lobby ::< configs - pes/crowd ::< presences - == :: + {$burden sos/(map knot burden)} ::< /burden + {$circle burden} ::< /circle == :: ++ rumor ::< query result change $% $: $reader ::< /reader @@ -38,22 +35,29 @@ == :: == :: {$friend add/? cir/circle} ::< /friend + {$burden nom/knot dif/diff-story} ::< /burden {$circle dif/diff-story} ::< /circle == :: +++ burden ::< full story state + $: gaz/(list telegram) ::< all messages + cos/lobby ::< loc & rem configs + pes/crowd ::< loc & rem presences + == :: ::TODO deltas into app ++ delta :: $% ::TODO no more %more, just produce/take list instead! {$more mor/(list delta)} ::< multiple changes :: messaging state :: {$out cir/circle out/(list thought)} ::< msgs into outbox - {$done don/(map @ud {partner ?})} ::< msgs delivered + {$done don/(map @ud {partner (unit tang)})} ::< msgs delivered :: shared ui state :: {$glyph diff-glyph} ::< un/bound glyph {$nick diff-nick} ::< changed nickname :: story state :: {$story nom/knot dif/diff-story} ::< change to story :: side-effects :: - {$bear cir/circle} ::< %burden command + {$init $~} ::< initialize + {$observe who/ship} ::< watch burden bearer {$react ost/bone rac/reaction} ::TODO ost.bol? ::< reaction to action {$quit ost/bone} ::< force unsubscribe == :: @@ -61,19 +65,21 @@ ++ diff-nick {who/ship nic/cord} ::< changed nickname ++ diff-story :: $% {$new con/config} ::< new story + {$bear bur/burden} ::< new inherited story {$grams gaz/(list telegram)} ::< new/changed msgs {$config cir/circle dif/diff-config} ::< new/changed config {$status pan/partner who/ship dif/diff-status} ::< new/changed status + {$follow sub/? pas/(set partner)} ::TODO range ::< un/subscribe {$remove $~} ::< removed story == :: ++ diff-config ::> config change $% {$full cof/config} ::< fully changed config - {$source add/? pas/(set partner)} ::< add/rem sources + ::TODO maybe just single partner, since we prob always do that + {$sourcee add/? pas/(set partner)} ::< add/rem sources {$caption cap/cord} ::< changed description {$filter fit/filter} ::< changed filter {$permit add/? sis/(set ship)} ::< add/rem to b/w-list {$secure sec/security} ::< changed security - {$federal add/? fed/? sis/(set ship)} ::< add/rem may/fes {$remove $~} ::< removed config == :: ++ diff-status ::> status change @@ -102,8 +108,6 @@ {$filter nom/knot fit/filter} ::< change message rules {$permit nom/knot inv/? sis/(set ship)} ::< invite/banish {$source nom/knot sub/? src/(set partner)} ::< un/sub to/from src - {$enlist nom/knot fed/? sis/(set ship)} ::< dis/allow federation - {$burden circle} ::< help federate :: messaging :: {$convey tos/(list thought)} ::< post exact {$phrase aud/(set partner) ses/(list speech)} ::< post easy @@ -119,18 +123,6 @@ wat/cord ::< explain why/(unit action) ::< cause == :: -++ lowdown ::> new/changed state - $% :: story state :: - $: $confs ::< configs - loc/(unit config) ::< local config - rem/(map circle (unit config)) ::< remote configs - == :: - {$precs reg/crowd} ::< presences - {$grams num/@ud gaz/(list telegram)} ::< messages - :: ui state :: - {$glyph (jug char (set partner))} ::< glyph bindings - {$names (map ship (unit human))} ::< nicknames - == :: :: ::> || ::> || %broker-communication @@ -139,19 +131,8 @@ ::+| :: ++ command ::> effect on story - $% {$review tos/(list thought)} ::< deliver - $: $burden ::< starting fed state - nom/knot - cof/lobby - pes/crowd - gaz/(list telegram) - == - {$relief nom/knot who/(set ship)} ::< federation ended - == :: -++ report ::> update - $% {$lobby cab/lobby} ::< config neighborhood - {$crowd reg/crowd} ::< presence - {$grams num/@ud gaz/(list telegram)} ::< thoughts + $% {$publish tos/(list thought)} ::< deliver + {$bearing $~} ::< prompt to listen == :: :: ::> || @@ -168,24 +149,25 @@ :: circle configurations. :: ++ lobby {loc/config rem/(map circle config)} ::< our & srcs configs ++ config ::> circle config - $: src/(set partner) ::< pulls from + $: sre/(set partner) ::< active sources cap/cord ::< description fit/filter ::< message rules con/control ::< restrictions - fed/federal ::< federators + :: so: only change src on success of peer/pull (√) + :: and: when gaining a fed, do a %peer (√) == :: ++ filter ::> content filters $: cus/? ::< dis/allow capitals + ::TODO rename cus to cas? (capitals/case instead of cuss) utf/? ::< dis/allow non-ascii == :: ++ control {sec/security ses/(set ship)} ::< access control -++ security ::> security kind +++ security ::> security mode $? $black ::< channel, blacklist $white ::< village, whitelist $green ::< journal, author list $brown ::< mailbox, our r, bl w == :: -++ federal {may/(set ship) fes/(set ship)} ::< federation control :: participant metadata. :: ++ crowd {loc/group rem/(map partner group)} ::< our & srcs presences ++ group (map ship status) ::< presence map @@ -254,7 +236,6 @@ $released ::< sent one-way $accepted ::< fully processed == :: -::TODO what is ++bouquet even for? not yet used... ++ bouquet (set flavor) ::< complete aroma ++ flavor path ::< content flavor --