:: :: :: :::: /app/hall/hoon :: :: :: :: :: :: ::TODO document gate samples fully. :: ::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. :: /- hall :: structures /+ hall, hall-legacy :: libraries /= seed /~ !>(.) /= filter-gram /^ $-({telegram:hall bowl:gall} telegram:hall) /| /: /%/filter /!noun/ /~ |=({t/telegram:hall bowl:gall} t) == :: :::: :: =, hall => :> # :> # %arch :> # :> data structures :: |% :> # %state :> state data structures +| ++ state :> application state $: stories/(map name story) :< conversations outbox/(map serial tracking) :< sent messages log/(map name @ud) :< logged to clay nicks/(map ship nick) :< local nicknames binds/(jug char audience) :< circle glyph lookup public/(set circle) :< publicly member of rir/wire :< current rumor wire == :: ++ story :> wire content $: count/@ud :< (lent grams) grams/(list telegram) :< all messages known/(map serial @ud) :< messages heard sourced/(map circle (list @ud)) :< heard from sequence/(map circle @ud) :< last-heard p circle locals/group :< local status remotes/(map circle group) :< remote status shape/config :< configuration mirrors/(map circle config) :< remote config peers/(jar ship query) :< subscribers inherited/_| :< from parent? == :: :> # %deltas :> changes to state +| ++ delta :: $% :: public state :: {$public add/? cir/circle} :< show/hide membership :: messaging state :: {$out cir/circle out/(list thought)} :< send msgs to circle $: $done :> set delivery state cir/circle :: ses/(list serial) :: res/delivery :: == :: :: shared ui state :: {$glyph diff-glyph} :< un/bound glyph {$nick diff-nick} :< changed nickname :: story state :: {$story nom/name det/delta-story} :< change to story :: side-effects :: {$init $~} :< initialize {$observe who/ship} :< watch burden bearer $: $present :> send %present cmd hos/ship :: nos/(set name) :: dif/diff-status :: == :: == :: ++ delta-story :> story delta $? diff-story :< both in & outward $% {$inherited ihr/?} :< inherited flag {$follow sub/? srs/(set source)} :< un/subscribe {$sequent cir/circle num/@ud} :< update last-heard {$gram src/circle gam/telegram} :< new/changed msgs {$sourced src/circle num/@ud} :< new heard-from == == :: :> # %out :> outgoing data +| ++ move (pair bone card) :< all actions ++ lime :> diff fruit $% {$hall-prize prize} :: {$hall-rumor rumor} :: == :: ++ pear :> poke fruit $% {$hall-command command} :: {$hall-action action} ::TODO see ++gentle-quit == :: ++ card :> general card $% {$diff lime} :: {$info wire ship term nori:clay} :: {$peer wire dock path} :: {$poke wire dock pear} :: {$pull wire dock $~} :: {$quit $~} :: == :: ++ weir :> parsed wire $% {$repeat cir/circle ses/(list serial)} :< messaging wire {$circle nom/name src/source} :< subscription wire == :: -- :: :> # :> # %work :> # :> functional cores and arms. :: |_ {bol/bowl:gall $1 state} :: :> # %transition :> prep transition +| ++ prep :> adapts state. :: => |% ++ states $%({$1 s/state} {$0 s/state-0}) :: ++ state-0 (cork state |=(a/state a(stories (~(run by stories.a) story-0)))) ++ story-0 %+ cork story |= a/story %= a shape *config-0 mirrors (~(run by mirrors.a) config-0) peers (~(run by peers.a) |=(a/(list query) (turn a query-0))) == ++ query-0 $? $: $circle nom/name wer/(unit circle) wat/(set circle-data) ran/range-0 == query == ++ config-0 {src/(set source-0) cap/cord tag/tags fit/filter con/control} ++ source-0 {cir/circle ran/range-0} ++ range-0 %- unit $: hed/place-0 tal/(unit place-0) == ++ place-0 $% {$da @da} {$ud @ud} {$sd @sd} == -- =| mos/(list move) |= old/(unit states) ^- (quip move _..prep) ?~ old %- pre-bake ta-done:ta-init:ta ?- -.u.old $1 [mos ..prep(+<+ u.old)] :: $0 =- $(old `[%1 s.u.old(stories -)]) |^ %- ~(run by stories.s.u.old) |= soy/story-0 ^- story %= soy shape (prep-config shape.soy) mirrors (~(run by mirrors.soy) prep-config) peers %- ~(run by peers.soy) |= a/(list query-0) ^- (list query) (murn a prep-query) == :: ++ prep-config |= cof/config-0 ^- config =. src.cof %- ~(gas in *(set source)) (murn ~(tap in src.cof) prep-source) :* src.cof cap.cof tag.cof fit.cof con.cof 0 == :: ++ prep-source |= src/source-0 ^- (unit source) =+ nan=(prep-range ran.src) ?~ nan ~& [%forgetting-source src] ~ `src(ran u.nan) :: ++ prep-query |= que/query-0 ^- (unit query) ?. ?=($circle -.que) `que =+ nan=(prep-range ran.que) ?~ nan ~& [%forgetting-query que] ~ `que(ran u.nan) :: ++ prep-range |= ran/range-0 ^- (unit range) ?~ ran `ran :: ranges with a relative end aren't stored because they end :: immediately, so if we find one we can safely discard it. ?: ?=({$~ {$sd @sd}} tal.u.ran) ~ :: we replace relative range starts with the current date. :: this is practically correct. ?: ?=({$sd @sd} hed.u.ran) `ran(hed.u [%da now.bol]) `ran -- == :: :> # %engines :> main cores. +| :: ++ ta :> thinker core, used for processing pokes into deltas. :: |_ :> deltas: deltas created by core operations. :: deltas/(list delta) :> # %resolve +| :: ++ ta-done :> resolve core :> :> produces the moves stored in ++ta's moves. :> they are produced in reverse order because :> ++ta-emil and ++ta-emit add them to the head of :> the {moves}. :> :> we don't produce any new state, because ++ta :> doesn't make any changes to it itself. :: ^- (list delta) (flop deltas) :: :> # :> # %emitters :> # :> arms that create outward changes. +| :: ++ ta-delta :> adds a delta to the head of {deltas}. :: |= det/delta %_(+> deltas [det deltas]) :: ++ ta-deltas :> adds multiple deltas to the head of {deltas}. :> :> flops to stay consistent with ++ta-delta. :: |= des/(list delta) %_(+> deltas (welp (flop des) deltas)) :: ++ ta-speak :> sends {sep} as an %app message to the user's inbox. :: |= sep/speech %+ ta-action %phrase :- [[our.bol %inbox] ~ ~] [%app dap.bol sep]~ :: ++ ta-grieve :> sends a stack trace to the user's inbox. :: |= {msg/tape fal/tang} %^ ta-speak %fat [%name 'stack trace' %tank fal] [%lin | (crip msg)] :: ++ ta-note :> sends {msg} to the user's inbox. :: |= msg/tape (ta-speak %lin | (crip msg)) :: ++ ta-evil :> tracing printf and crash. :: |= msg/cord ~| [%hall-ta-evil msg] !! :: :> # :> # %data :> # :> utility functions for data retrieval. +| :: ++ ta-know :> story monad :> :> produces a gill that takes a gate. if the story :> {nom} exists, calls the gate with a story core. :> if it doesn't, does nothing. :: |= nom/name |= fun/$-(_so _ta) ^+ +>+> =+ pur=(~(get by stories) nom) ?~ pur %- ta-evil (crip "no story '{(trip nom)}'") (fun ~(. so nom ~ u.pur)) :: :> # :> # %interaction-events :> # :> arms that apply events we received. +| :: ++ ta-init :> initialize app :> :> populate state on first boot. creates our default mailbox and journal. :: :: create default circles. => %+ roll ^- (list {security name cord}) :~ [%mailbox %inbox 'default home'] [%journal %public 'visible activity'] == |= {{typ/security nom/name des/cord} _ta} (ta-action [%create nom des typ]) %- ta-deltas :: if needed, subscribe to our parent's /burden. =+ sen=(above our.bol) ?: ?| !=(%czar (clan:title sen)) =(sen our.bol) =(%pawn (clan:title our.bol)) == ~ [%init ~]~ :: ++ ta-apply :> applies the command sent by {src}. :: |= {src/ship cod/command} ^+ +> ?- -.cod :: %publish commands prompt us (as a circle host) :: to verify and distribute messages. $publish (ta-think | src +.cod) :: %present commands are used to ask us to set :: someone's status in the indicated stories. $present (ta-present src +.cod) :: %bearing commands are used by our children to :: let us know they're bearing our /burden. we :: need to watch them to allow changes to go up. $bearing (ta-observe src) ::TODO isn't this redundant with ta-subscribe? == :: ++ ta-present :> update a status :> :> sets status for the indicated stories, :> but only if they have write permission there. :: |= {who/ship nos/(set name) dif/diff-status} ^+ +> =+ nol=~(tap in nos) |- ?~ nol +>.^$ =. +>.^$ ?. (~(has by stories) i.nol) +>.^$ =+ soy=(~(got by stories) i.nol) so-done:(~(so-present so i.nol ~ soy) who dif) $(nol t.nol) :: ++ ta-action :> performs action sent by a client. :: |= act/action ^+ +> =< work :> # :> # %actions :> # :> action processing core :> :> ++work calls the appropriate action processing :> arm. most use ++affect to retrieve the affected :> story, crashing if it doesn't exist. |% :> # %utility +| ++ work :< perform action ^+ ..ta-action ?- -.act :: circle configuration $create (action-create +.act) $design (action-design +.act) $source (action-source +.act) $depict (action-depict +.act) $filter (action-filter +.act) $permit (action-permit +.act) $delete (action-delete +.act) $usage (action-usage +.act) $read (action-read +.act) $newdm (action-newdm +.act) :: messaging $convey (action-convey +.act) $phrase (action-phrase +.act) :: personal metadata $notify (action-notify +.act) $naming (action-naming +.act) :: changing shared ui $glyph (action-glyph +.act) $nick (action-nick +.act) :: misc changes $public (action-public +.act) == :: ++ affect :> delta to story :> :> store a delta about a story. if the story :> does not exist, crash. :: |= {nom/name det/delta-story} ?: (~(has by stories) nom) (impact nom det) (ta-evil (crip "no story {(trip nom)}")) :: ++ impact :> delta for story :> :> Store a delta about a story. :: |= {nom/name det/delta-story} (ta-delta %story nom det) :: ++ present :> send status update :: |= {aud/audience dif/diff-status} ^+ ..ta-action =/ cic ^- (jug ship name) %- ~(rep in aud) |= {c/circle m/(jug ship name)} (~(put ju m) hos.c nom.c) =? ..ta-action (~(has by cic) our.bol) =+ nos=~(tap in (~(get ju cic) our.bol)) (ta-present our.bol (~(get ju cic) our.bol) dif) =. cic (~(del by cic) our.bol) %- ta-deltas %- ~(rep by cic) |= {{h/ship s/(set name)} l/(list delta)} :_ l [%present h s dif] :: :> # %circle-configuration +| ++ action-create :> creates a story with the specified parameters. :: |= {nom/name des/cord typ/security} ^+ ..ta-action ?. (~(has in stories) nom) %^ impact nom %new :* [[[our.bol nom] ~] ~ ~] des ~ *filter :- typ ?. ?=(?($village $journal) typ) ~ [our.bol ~ ~] 0 == (ta-evil (crip "{(trip nom)}: already exists")) :: ++ action-design :> creates a story with the specified config. :: |= {nom/name cof/config} ?. (~(has in stories) nom) (impact nom %new cof) (ta-evil (crip "{(trip nom)}: already exists")) :: ++ action-delete :> delete + announce :> :> delete story {nom}, optionally announcing the :> event with message {mes}. :: |= {nom/name mes/(unit cord)} ^+ ..ta-action =? ..ta-action ?=(^ mes) %+ action-phrase [[our.bol nom] ~ ~] [%lin | u.mes]~ (affect nom %remove ~) :: ++ action-depict :> change description of story {nom} to {des}. :: |= {nom/name cap/cord} (affect nom %config [our.bol nom] %caption cap) :: ++ action-filter :> change message rules :> :> replaces the story's current filter with the :> specified one. :: |= {nom/name fit/filter} (affect nom %config [our.bol nom] %filter fit) :: ++ action-permit :> invite to/banish from story {nom} all {sis}. :: |= {nom/name inv/? sis/(set ship)} =+ soy=(~(get by stories) nom) ?~ soy (ta-evil (crip "no story {(trip nom)}")) so-done:(~(so-permit so nom ~ u.soy) inv sis) :: ++ action-source :> add/remove {pos} as sources for story {nom}. :: |= {nom/name sub/? srs/(set source)} =+ soy=(~(get by stories) nom) ?~ soy (ta-evil (crip "no story {(trip nom)}")) so-done:(~(so-sources so nom ~ u.soy) sub srs) :: ++ action-usage :> add or remove usage tags. :: |= {nom/name add/? tas/tags} =+ soy=(~(get by stories) nom) ?~ soy (ta-evil (crip "no story {(trip nom)}")) so-done:(~(so-usage so nom ~ u.soy) add tas) :: ++ action-read :> set the read message number :: |= {nom/name red/@ud} =+ soy=(~(get by stories) nom) ?~ soy (ta-evil (crip "no story {(trip nom)}")) so-done:(~(so-read so nom ~ u.soy) red) :: ++ action-newdm :> copy all behavior of create, permit, and source in that order :: |= {sis/(set ship)} =/ nom/name %^ rsh 3 1 %+ roll %+ sort %+ turn (weld ~(tap in sis) [our.bol ~]) |= p/ship ^- cord (scot %p p) aor |= {p/cord nam/name} ^- @tas (crip "{(trip `@t`nam)}.{(slag 1 (trip p))}") =/ dels/(list delta) :~ :* %story %inbox %follow & [[[our.bol nom] ~] ~ ~] == :* %story nom %new [[[our.bol nom] ~] ~ ~] 'dm' ~ *filter [%village (~(put in sis) our.bol)] 0 == == (ta-deltas dels) :: :> # %messaging +| ++ action-convey :> post exact :> :> sends the messages provided in the action. :: |= tos/(list thought) (ta-think & our.bol tos) :: ++ action-phrase :> post easy :> :> sends the message contents provided in the :> action generating a serial and setting a :> timestamp. :: |= {aud/audience ses/(list speech)} ^+ ..ta-action =- (ta-think & our.bol tos) |- ^- tos/(list thought) ?~ ses ~ =^ sir eny.bol ~(uniq hall bol) :_ $(ses t.ses) [sir aud [now.bol i.ses]] :: :> # %personal-metadata +| :: ++ action-notify :> our presence update :> :> notify the audience of our new presence state, :> or tell them to remove us if {pes} is ~. :: |= {aud/audience pes/(unit presence)} ^+ ..ta-action ?~ pes (present aud %remove ~) (present aud %presence u.pes) :: ++ action-naming :> our name update :: |= {aud/audience man/human} ^+ ..ta-action (present aud %human %full man) :: :> # %changing-shared-ui +| ++ action-nick :> new identity :> :> assigns a new local identity ("nickname") to the :> target ship. :: |= {who/ship nic/nick} ^+ ..ta-action ?. =((~(get by nicks) who) `nic) ..ta-action :: no change (ta-delta %nick who nic) :: ++ action-glyph :> un/bind glyph {lif} to audience {aud}. :: |= {lif/char aud/audience bin/?} (ta-delta %glyph bin lif aud) :: ++ action-public :> show/hide membership :> :> add or remove a circle from the public membership list. :: |= {add/? cir/circle} (ta-delta %public add cir) -- :: :> # :> # %subscription-events :> # :> arms that react to subscription events. +| :: ++ ta-observe :> watch burden bearer :> :> subscribe to a child who is bearing our burden. ::TODO everyone should be able to bear if they so desire. :: |= who/ship ^+ +> ?. =(our.bol (above who)) ~&([%not-our-bearer who] +>) (ta-delta %observe who) :: ++ ta-subscribe :> listen to :> :> reaction to incoming subscriptions. :: |= {her/ship qer/query} ^+ +> ?+ -.qer +> $burden (ta-observe her) $circle %+ ta-delta %story [nom.qer %peer & her qer] == :: ++ ta-greet :> subscription success :> :> store a started subscription as source. :: |= {nom/name src/source} %- (ta-know nom) |= sor/_so =< so-done (so-greet:sor src) :: ++ ta-leave :> subscription failed :> :> removes {src} from story {nom}'s sources. :: |= {nom/name src/source} %- (ta-know nom) |= sor/_so =< so-done (so-leave:sor src) :: ++ ta-take :> apply prize :> :> for a %burden prize, bear the burden in a new :> or existing story. :> for a %circle prize, use ++so to accept it. :> for a %report prize, silently ignore. :: |= {wir/wire piz/prize} ^+ +> ?+ -.piz ~&([%ignoring-prize -.piz] +>) $report +> :: $burden =+ sos=~(tap by sos.piz) |- ^+ ..ta-take ?~ sos ..ta-take =. ..ta-take =+ (fall (~(get by stories) p.i.sos) *story) => (~(so-bear so p.i.sos ~ -) q.i.sos) =. acs (flop acs) |- ^+ ..ta-take ?~ acs ..ta-take =. ..ta-take (ta-action i.acs) $(acs t.acs) $(sos t.sos) ::TODO runtime error ::%+ roll ~(tap by sos.piz) ::|= {{n/name b/burden} _..ta-take} ::=+ (fall (~(get by stories) n) *story) ::so-done:(~(so-bear so n ~ -) b) :: $circle =+ wer=(etch wir) ?> ?=($circle -.wer) %- (ta-know nom.wer) |= sor/_so =< so-done (so-take:sor cir.src.wer +.piz) == :: ++ ta-hear :> apply rumor :> :> apply changes from a rumor to our state. :> for %burden, authoratively apply the story :> diff. if it's a new one, bear it. :> for %circle, apply the story diff normally. :: |= {wir/wire rum/rumor} ^+ +> ?+ -.rum ~&([%ignoring-rumor -.rum] +>) :: $burden ?+ -.rum.rum %- (ta-know nom.rum) |= sor/_so =< so-done (so-hear:sor & [our.bol nom.rum] rum.rum) :: $new =? +> !(~(has by stories) nom.rum) (ta-delta %story +.rum) => =+ (fall (~(get by stories) nom.rum) *story) %- ~(so-bear so nom.rum ~ -) [~ [cof.rum.rum ~] [~ ~]] =. acs (flop acs) |- ^+ +>+ ?~ acs +>+ =. +>+ (ta-action i.acs) $(acs t.acs) ::TODO runtime error ::=< so-done ::%- ~(so-bear so nom.rum ~ (fall (~(get by stories) nom.rum) *story)) ::[~ [cof.rum.rum ~] [~ ~]] == :: $circle =+ wer=(etch wir) ?> ?=($circle -.wer) %- (ta-know nom.wer) |= sor/_so =< so-done (so-hear:sor | cir.src.wer rum.rum) == :: ++ ta-repeat :> message delivered :> :> message got delivered. if an error was returned :> mark the message as rejected. if not, received. :: |= {who/circle ses/(list serial) fal/(unit tang)} ^+ +> ?~ fal (ta-delta %done who ses %accepted) =. +> (ta-delta %done who ses %rejected) =- (ta-grieve - u.fal) %+ weld "{(scow %ud (lent ses))} message(s) " "rejected by {(scow %p hos.who)}/{(trip nom.who)}" :: ++ ta-resub :> subscription dropped :> :> when a subscription gets dropped by gall, we :> resubscribe. :: |= {nom/name src/source} ^+ +> %- (ta-know nom) |= sor/_so =< so-done (so-resub:sor src) :: :> # :> # %messaging :> # :> arms for sending and processing messages. +| :: ++ ta-think :> publish or review :> :> consumes each thought. :: |= {pub/? aut/ship tos/(list thought)} ^+ +> ?~ tos +> $(tos t.tos, +> (ta-consume pub aut i.tos)) :: ++ ta-consume :> to each audience :> :> conducts thought {tot} to each circle in its audience. :: |= {pub/? aut/ship tot/thought} =+ aud=~(tap in aud.tot) |- ^+ +>.^$ ?~ aud +>.^$ $(aud t.aud, +>.^$ (ta-conduct pub aut i.aud tot)) :: ++ ta-conduct :> thought to circle :> :> either publishes or records a thought. :: |= {pub/? aut/ship cir/circle tot/thought} ^+ +> ?: pub ?. (team:title our.bol aut) (ta-note "strange author {(scow %p aut)}") =. aut our.bol ?: =(aut hos.cir) ?: (~(has by stories) nom.cir) (ta-record nom.cir hos.cir tot) ::TODO avenue for abuse? (ta-note "have no story {(scow %tas nom.cir)}") (ta-transmit cir tot) ?. =(our.bol hos.cir) +> (ta-record nom.cir aut tot) :: ++ ta-record :> add to story :> :> add or update telegram {gam} in story {nom}. :: |= {nom/name gam/telegram} %- (ta-know nom) |= sor/_so =< so-done (so-learn:sor [our.bol nom] gam) :: ++ ta-transmit :> sends thought {tot} to {cir}. :: |= {cir/circle tot/thought} ^+ +> (ta-delta %out cir tot ~) :: :> # :> # %stories :> # :> arms for modifying stories. +| :: ++ so :> story core, used for doing work on a story. :: |_ :> nom: story name in {stories}. :> acs: hall actions issued due to changes. :: story is faceless to ease data access. :: $: nom/name acs/(list action) story == :: :> # %resolve +| ++ so-done :> apply actions generated by story operations. ::TODO maybe produce list of actions, apply in ++ta :: ^+ +> =. acs (flop acs) |- ^+ +>+ ?~ acs +>+ =. +>+ (ta-action i.acs) $(acs t.acs) :: :> # :> # %emitters :> # :> arms that create outward changes. +| :: ++ so-act :> stores a hall action. :: |= act/action ^+ +> +>(acs [act acs]) :: ++ so-note :> sends {msg} as an %app message to the user's inbox. :: |= msg/cord ^+ +> %+ so-act %phrase :- [[our.bol %inbox] ~ ~] [%app dap.bol %lin | msg]~ :: ++ so-delta :> store delta in ++ta core. :: |= det/delta ^+ +> +>(deltas [det deltas]) :: ++ so-deltas :> store multiple deltas in ++ta core. :: |= des/(list delta) %_(+> deltas (welp (flop des) deltas)) :: ++ so-delta-our :> adds a delta about this story. :: |= det/delta-story ^+ +> (so-delta %story nom det) :: ++ so-deltas-our :> adds multiple deltas about this story. :: |= des/(list delta-story) ^+ +> %- so-deltas %+ turn des |= d/delta-story [%story nom d] :: :> # :> # %data :> # :> utility functions for data retrieval. +| :: ++ so-cir [our.bol nom] :< us as circle :: :> # :> # %interaction-events :> # :> arms that apply events we received. +| :: ++ so-take :> apply the prize as if it were rumors. :: |= {src/circle nes/(list envelope) cos/lobby pes/crowd} ^+ +> =. +>.$ (so-hear | src %config src %full loc.cos) =. +>.$ =+ los=~(tap by loc.pes) |- ?~ los +>.^$ =. +>.^$ (so-hear | src %status src p.i.los %full q.i.los) $(los t.los) ::TODO ideally you'd just do this, but that runtime errors... ::%- ~(rep in loc.pes) ::|= {{w/ship s/status} _+>.$} ::(so-hear | src %status src w %full s) (so-unpack src nes) :: ++ so-hear :> apply changes from a rumor to this story. :: |= {bur/? src/circle rum/rumor-story} ::TODO tall-form gate comments like this for everything? ::|= $: :> bur: whether the story is inherited :: :> src: story to change :: :> rum: change to this story :: :: :: bur/? :: src/circle :: rum/rumor-story :: == ^+ +> ?- -.rum $bear (so-bear bur.rum) $peer (so-delta-our rum) $gram (so-open src nev.rum) $remove ::TODO should also remove from {remotes}? (so-delta-our %config src %remove ~) :: $new ?: =(src so-cir) (so-config-full ~ cof.rum) $(rum [%config src %full cof.rum]) :: $config :: we only subscribe to remotes' configs. ?. =(src cir.rum) ~! %unexpected-remote-config-from-remote !! =/ old/(unit config) ?: =(cir.rum so-cir) `shape (~(get by mirrors) cir.rum) :: ignore if it won't result in change. ?. ?| &(?=($remove -.dif.rum) ?=(^ old)) ?=($~ old) !=(u.old (change-config u.old dif.rum)) == +>.$ :: full changes to us need to get split up. ?: &(=(cir.rum so-cir) ?=($full -.dif.rum)) (so-config-full `shape cof.dif.rum) (so-delta-our rum) :: $status :: we only subscribe to remotes' locals. ?. |(=(src cir.rum) =(src so-cir)) ~! %unexpected-remote-status-from-remote !! =/ old/(unit status) ?: =(cir.rum so-cir) (~(get by locals) who.rum) =- (~(get by -) who.rum) (fall (~(get by remotes) cir.rum) *group) :: ignore if it won't result in change. ?. ?| &(?=($remove -.dif.rum) ?=(^ old)) ?=($~ old) !=(u.old (change-status u.old dif.rum)) == +>.$ (so-delta-our rum) == :: ++ so-bear :> accept burden :> :> add what was pushed down from above to our :> state. in case of conflict, existing data is :> overwritten. :: ::NOTE we don't use ++roll here because of urbit/arvo#447. :: |= {gaz/(list telegram) cos/lobby pes/crowd} ^+ +> =* self +> :: :: local config =. self (so-config-full `shape loc.cos) :: :: remote config =. self =+ rem=~(tap by rem.cos) |- ^+ self ?~ rem self =* wer p.i.rem =* cof q.i.rem :: only make a delta if it actually changed. =? self !=(`cof (~(get by mirrors) wer)) (so-delta-our %config wer %full cof) $(rem t.rem) :: :: local status =. self =+ sas=~(tap by loc.pes) |- ^+ self ?~ sas self =* who p.i.sas =* sat q.i.sas :: only make a delta if it actually changed. =? deltas !=(`sat (~(get by locals) who)) :_ deltas :^ %story nom %status [[our.bol nom] who %full sat] $(sas t.sas) :: :: remote status =. self =+ rem=~(tap by rem.pes) |- ^+ self ?~ rem self =* wer p.i.rem =* gou q.i.rem :: only make deltas if it actually changed. =? deltas !=(`gou (~(get by remotes) wer)) %+ welp deltas =+ gop=~(tap by gou) =+ hav=(fall (~(get by remotes) wer) *group) =| l/(list delta) |- ^+ l ?~ gop l =* who p.i.gop =* sat q.i.gop :: only make a delta if it actually changed. =? l !=(`sat (~(get by hav) who)) [[%story nom %status wer who %full sat] l] $(gop t.gop) $(rem t.rem) :: :: telegrams =. self %_ self deltas %+ welp deltas %- flop ^- (list delta) %+ murn gaz |= t/telegram ^- (unit delta) :: in audience, replace above with us. ::TODO this really should be done by the sender. =. aud.t =+ dem=[(above our.bol) nom] ?. (~(has in aud.t) dem) aud.t =+ (~(del in aud.t) dem) (~(put in -) so-cir) =+ num=(~(get by known) uid.t) ?: &(?=(^ num) =(t (snag u.num grams))) ~ ::TODO this really should have sent us the message :: src as well but that's not an easy fix. `[%story nom %gram [(above our.bol) nom] t] == :: inherited flag %_(self deltas [[%story nom %inherited &] deltas]) ::TODO runtime error ::(so-delta-our %inherited &) :: :> # :> # %changes :> # :> arms that make miscellaneous changes to this story. +| :: ++ so-present :> accept status diff |= {who/ship dif/diff-status} ^+ +> :: only have presence if you have write permission. ?. |((so-admire who) ?=($remove -.dif)) +> :: ignore if it won't result in change, :: or if it sets an impersonating handle. ?. ?: ?=($remove -.dif) (~(has by locals) who) ?| !(~(has by locals) who) :: =+ old=(~(got by locals) who) =+ new=(change-status - dif) ?& !=(old new) :: ?= $~ (rush (fall han.man.new '') ;~(pfix sig fed:ag)) ::TODO calling with %+ gives syntax error == == +> (so-delta-our %status so-cir who dif) :: ++ so-config-full :> split full config :> :> split a %full config delta up into multiple :> smaller ones, for easier application. :: |= {old/(unit config) cof/config} ^+ +> ~? &(?=(^ old) !=(src.u.old src.cof)) %maybe-missing-src-changes %- so-deltas =- %+ turn - |= d/diff-config [%story nom [%config so-cir d]] ^- (list diff-config) ::TODO figure out how to deal with src changes here. :: %follow will probably behave a bit iffy in some cases. ?~ old :: if we have no previous config, all diffs apply. :~ [%caption cap.cof] [%usage & tag.cof] [%filter fit.cof] [%secure sec.con.cof] [%permit & sis.con.cof] [%read red.cof] == =- (murn - same) ^- (list (unit diff-config)) =* col u.old :: if we have previous config, figure out the changes. :~ ?: =(cap.col cap.cof) ~ `[%caption cap.cof] :: =+ gon=(~(dif in tag.col) tag.cof) ?~ gon ~ `[%usage | gon] :: =+ new=(~(dif in tag.cof) tag.col) ?~ new ~ `[%usage & new] :: ?: =(fit.col fit.cof) ~ `[%filter fit.cof] :: ?: =(sec.con.col sec.con.cof) ~ `[%secure sec.con.cof] :: =+ gon=(~(dif in sis.con.col) sis.con.cof) ?~ gon ~ `[%permit | gon] :: =+ new=(~(dif in sis.con.cof) sis.con.col) ?~ new ~ `[%permit & new] == :: ++ so-sources :> change source :> :> adds or removes {srs} from our sources, :> skipping over ones we already (don't) have. :: |= {add/? srs/(set source)} ^+ +> =/ sus/(set source) %. src.shape ?:(add ~(dif in srs) ~(int in srs)) :: we only make a delta for removals here, :: because we don't need to wait for ++reap when :: pulling subscriptions. =? +>.$ !add =+ sos=~(tap in sus) |- ^+ +>.^$ ?~ sos +>.^$ =. +>.^$ (so-delta-our %config so-cir %source | i.sos) $(sos t.sos) ::TODO ideally below, but unexplained runtime error at `so-delta-our` ::%+ roll ~(tap in sus) ::|= {src/source _+>.$} ::^+ +>.^$ ::(so-delta-our %config so-cir %source | src) ?~ sus +>.$ (so-delta-our %follow add sus) :: ++ so-depict :> change description :> :> modifies our caption. :: |= cap/cord ^+ +> ?: =(cap cap.shape) +> (so-delta-our %config so-cir %caption cap) :: ++ so-usage :> add or remove usage tags. :: |= {add/? tas/tags} ^+ +> =/ sas/tags %. tag.shape ?:(add ~(dif in tas) ~(int in tas)) ?~ sas +>.$ (so-delta-our %config so-cir %usage add sas) :: ++ so-read :> set the read message number in circle config |= {red/@ud} ^+ +> ?: =(red red.shape) +> (so-delta-our %config so-cir %read red) :: ++ so-filter :> change message rules :> :> modifies our filter. :: |= fit/filter ^+ +> ?: =(fit fit.shape) +> (so-delta-our %config so-cir %filter fit) :: ++ so-delete :> delete story :> :> deletes this story. removes it from {stories} :> and unsubscribes from all src. :: (so-delta-our %remove ~) :: :> # :> # %subscriptions :> # :> arms for starting and ending subscriptions +| :: ++ so-greet :> subscription started :> :> store a started subscription as source. :: |= src/source ^+ +> ?: (~(has in src.shape) src) +> (so-delta-our %config so-cir %source & src) :: ++ so-leave :> subscription ended :> :> delete {src} from our sources. :: |= src/source ^+ +> ?. (~(has in src.shape) src) +> (so-delta-our %config so-cir %source | src) :: ++ so-resub :> subscription revived :> :> re-subscribe to a dropped subscription. :> if it was already active, we continue where :> we left off. :: |= src/source ^+ +> =+ seq=(~(get by sequence) cir.src) =/ ner/range ?~ seq ran.src =- `[[%ud u.seq] -] ?~ ran.src ~ tal.u.ran.src :: if our subscription changes or ends, remove :: the original source. =? +>.$ !=(ner ran.src) (so-delta-our %config so-cir %source | src) :: if we're past the range, don't resubscribe. ?: ?& ?=(^ ran.src) ?=(^ tal.u.ran.src) :: ?- -.u.tal.u.ran.src $sd & $da (gte now.bol +.u.tal.u.ran.src) $ud ?& ?=(^ seq) (gte u.seq +.u.tal.u.ran.src) == == == +>.$ (so-delta-our %follow & [[cir.src -] ~ ~]) :: ++ so-first-grams :> beginning of stream :> :> find all grams that fall within the range. :: |= ran/range ^- (list telegram) =+ [num=0 gaz=grams zeg=*(list telegram)] :: fill in empty ranges to select all grams, :: and calculate absolutes for relative places. =. ran ?~ ran `[[%ud 0] `[%ud count]] =* hed hed.u.ran =? hed ?=($sd -.hed) [%ud (sub count (min count (abs:si +.hed)))] ?~ tal.u.ran `[hed `[%ud count]] =* tal u.tal.u.ran =? tal ?=($sd -.tal) [%ud (sub count (min count (abs:si +.tal)))] ran :: never fails, but compiler needs it. ?> &(?=(^ ran) ?=(^ tal.u.ran)) =* hed hed.u.ran =* tal u.tal.u.ran %- flop |- ^- (list telegram) ?~ gaz zeg ?: ?- -.u.tal.u.ran :: after the end $ud (lth +.u.tal.u.ran num) $da (lth +.u.tal.u.ran wen.i.gaz) $sd !! :: caught above == :: if past the range, we're done searching. zeg ?: ?- -.hed.u.ran :: before the start $ud (lth num +.hed.u.ran) $da (lth wen.i.gaz +.hed.u.ran) $sd !! :: caught above == :: if before the range, continue onward. $(num +(num), gaz t.gaz) :: if in the range, add this gram and continue. $(num +(num), gaz t.gaz, zeg [i.gaz zeg]) :: ++ so-in-range :> place in range? :> :> produces two booleans: whether we're :> currently in the range, and whether the range :> has passed. ::TODO to deal with changed messages, we'll want :: to be able to pass in a num. :: |= ran/range ^- {in/? done/?} ?~ ran [& |] =/ min ?- -.hed.u.ran $sd & :: relative is always in. $ud (gth count +.hed.u.ran) $da (gth now.bol +.hed.u.ran) == ?~ tal.u.ran [min |] =- [&(min -) !-] ?- -.u.tal.u.ran $sd | :: relative is always done. $ud (gte +(+.u.tal.u.ran) count) $da (gte +.u.tal.u.ran now.bol) == :: :> # :> # %messaging :> # :> arms for adding to this story's messages. +| :: ++ so-sane :> sanitize %lin speech according to our settings. :: |= sep/speech ^- speech ?+ -.sep sep ?($ire $fat $app) sep(sep $(sep sep.sep)) :: $lin =- sep(msg -) %- crip %- tufa %+ turn (tuba (trip msg.sep)) |= a/@c :: always replace control characters. ?: |((lth a 32) =(a `@c`127)) `@`'?' :: if desired, remove uppercasing. ?: ?& !cas.fit.shape (gte a 'A') (lte a 'Z') == (add a 32) :: if desired, replace non-ascii characters. ?: ?& !utf.fit.shape (gth a 127) == `@`'?' a == :: ++ so-unpack :> process envelopes :> :> learn telegrams from list of envelopes and :> update the sequence of the source if needed. :: |= {src/circle nes/(list envelope)} ^+ +> =. +> (so-lesson src (turn nes tail)) =/ num %+ roll nes |= {nev/envelope max/@ud} ?:((gth num.nev max) num.nev max) ?. (gth num (fall (~(get by sequence) src) 0)) +>.$ (so-delta-our %sequent src num) :: ++ so-open :> process envelope :> :> learn telegram from envelope and update the :> sequence of the source if needed. :: |= {src/circle nev/envelope} ^+ +> =. +> (so-learn src gam.nev) ?. (gth num.nev (fall (~(get by sequence) src) 0)) +> (so-delta-our %sequent src num.nev) :: ++ so-lesson :> learn all telegrams in a list. :: |= {src/circle gaz/(list telegram)} ^+ +> ?~ gaz +> $(gaz t.gaz, +> (so-learn src i.gaz)) :: ++ so-learn :> save/update message :> :> store an incoming telegram, updating if it :> already exists. :: |= {src/circle gam/telegram} ^+ +> :: check for write permissions. ::TODO we want to !! instead of silently failing, :: so that ++coup-repeat of the caller gets :: an error. but the caller may not be the :: author. if we check for that to be true, :: can we guarantee it's not an older message :: getting resent? does that matter? think. ?. (so-admire aut.gam) +> :: clean up the message to conform to our rules. =. sep.gam (so-sane sep.gam) =. gam (filter-gram gam bol) :: if we already have it, ignore. =+ old=(~(get by known) uid.gam) ?. &(?=(^ old) =(gam (snag u.old grams))) (so-delta-our %gram src gam) =+ sed=(~(get by sourced) src) ?: |(?=($~ sed) ?=($~ (find [u.old]~ u.sed))) (so-delta-our %sourced src u.old) +>.$ :: :> # :> # %permissions :> # :> arms relating to story permissions. +| :: ++ so-permit :> invite/banish :> :> update config to dis/allow ships permission. :: |= {inv/? sis/(set ship)} ^+ +> :> wyt: whitelist? :> add: add to list? =/ wyt/? ?=(?($village $journal) sec.con.shape) =/ add/? =(inv wyt) =/ sus/(set ship) %. sis.con.shape ?:(add ~(dif in sis) ~(int in sis)) ?~ sus +>.$ :: if banished, remove their presences. =? +>.$ !inv %- so-deltas-our %+ turn ~(tap in `(set ship)`sus) |= s/ship :+ %status so-cir [s %remove ~] (so-delta-our %config so-cir %permit [add sus]) :: ++ so-admire :> accept from :> :> checks {her} write permissions. :: |= her/ship ^- ? ?- sec.con.shape $channel !(~(has in sis.con.shape) her) :< blacklist $village (~(has in sis.con.shape) her) :< whitelist $journal (~(has in sis.con.shape) her) :< author whitelist $mailbox !(~(has in sis.con.shape) her) :< author blacklist == :: ++ so-visible :> checks {her} read permissions. :: |= her/ship ^- ? ?- sec.con.shape $channel !(~(has in sis.con.shape) her) :< blacklist $village (~(has in sis.con.shape) her) :< whitelist $journal & :< all $mailbox (team:title our.bol her) :< our team == -- -- :: ++ da :> delta application :> :> core for doing things, mostly applying deltas to :> application state, but also dealing with events :> that aren't pokes. :> where appropriate, creates moves. those get :> produced when finalizing with ++da-done. :: |_ :> moves: moves created by core operations. :: moves/(list move) :> # %resolve +| :: ++ da-done :> resolve core :> :> produces the moves stored in ++da's moves. :> they are produced in reverse order because :> ++da-emil and ++da-emit add them to the head of :> the {moves}. :: ^- (quip move _+>) [(flop moves) +>] :: :> # :> # %emitters :> # :> arms that create outward changes. +| :: ++ da-emil :> emit move list :> :> adds multiple moves to the head of {moves}. :> flops to stay consistent with ++ta-emit. :: |= mol/(list move) %_(+> moves (welp (flop mol) moves)) :: ++ da-emit :> emit a move :> :> adds a move to the head of {moves}. :: |= mov/move %_(+> moves [mov moves]) :: ++ da-present :> send %present cmd :: |= {hos/ship nos/(set name) dif/diff-status} ^+ +> %- da-emit :* ost.bol %poke /present [hos dap.bol] [%hall-command %present nos dif] == :: :> # :> # %change-application :> # :> arms that change the application state. +| :: ++ da-change :> apply delta :> :> modifies application state according to the :> change specified in {dif}. :: |= det/delta ^+ +> ?- -.det $public (da-change-public +.det) $out (da-change-out +.det) $done (da-change-done +.det) $glyph (da-change-glyph +.det) $nick (da-change-nick +.det) $story (da-change-story +.det) $init da-init $observe (da-observe +.det) $present (da-present +.det) == :: ++ da-init :> startup side-effects :> :> apply %init delta, querying the /burden of the :> ship above us. :: (da-emit (wire-to-peer /burden)) :: ++ da-observe :> watch burden bearer :> :> apply %observe delta, querying the /report of :> {who} below us. :: |= who/ship (da-emit (wire-to-peer /report/(scot %p who))) :: ++ da-change-public :> show/hide membership :> :> add/remove a circle to/from the public :> membership list. :: |= {add/? cir/circle} ^+ +> =- +>.$(public -) ?: add (~(put in public) cir) (~(del in public) cir) :: ++ da-change-out :> outgoing messages :> :> apply an %out delta, sending a message. :: |= {cir/circle out/(list thought)} ^+ +> =+ ses=(turn out head) =. outbox :: for every serial, add %pending state. %+ roll ses |= {s/serial o/_outbox} =? o ?=($~ o) outbox =+ t=(fall (~(get by o) s) *tracking) %+ ~(put by o) s (~(put by t) cir %pending) %+ da-emit ost.bol :* %poke /repeat/(scot %p hos.cir)/[nom.cir]/(scot %ud (jam ses)) [hos.cir dap.bol] [%hall-command %publish out] == :: ++ da-change-done :> delivered messages :> :> apply a %done delta, setting new delivery state :> for messages. :: |= {cir/circle ses/(list serial) res/delivery} ^+ +> %_ +> outbox :: for every serial, set new delivery state. %- ~(gas by outbox) %+ turn ses |= s/serial :- s %+ ~(put by (~(got by outbox) s)) cir res == :: ++ da-change-glyph :> un/bound glyph :> :> apply a %glyph delta, un/binding a glyph to/from :> an audience. :: |= {bin/? gyf/char aud/audience} ^+ +> ?: bin %_ +> binds (~(put ju binds) gyf aud) == =/ ole/(list audience) ?. =(aud ~) [aud ~] ~(tap in (~(get ju binds) gyf)) |- ^+ +>.^$ ?~ ole +>.^$ %_ $ binds (~(del ju binds) gyf i.ole) ole t.ole == :: ++ da-change-nick :> changed nickname :> :> apply a %nick delta, setting a nickname for a :> ship. :: |= {who/ship nic/nick} ^+ +> +>(nicks (change-nicks nicks who nic)) :: :> # :> # %stories :> # :> arms for modifying stories. +| :: ++ da-change-story :> apply circle delta :> :> apply a %story delta, redirecting the delta :> itself to ++sa-change. :> in case of a new or deleted story, specialized :> arms are called. :: |= {nom/name det/delta-story} ^+ +> ?+ -.det =< sa-done %. det =+ (fall (~(get by stories) nom) *story) ~(sa-change sa nom -) :: $new (da-create nom +.det) $bear ~&(%unexpected-unsplit-bear +>) $remove (da-delete nom) == :: ++ da-create :> configure story :> :> creates story {nom} with config {con}. :: |= {nom/name cof/config} ^+ +> =< sa-done %- ~(sa-change sa nom *story) [%config [our.bol nom] %full cof] :: ++ da-delete :> delete story :> :> calls the story core to delete story {nom}. :: |= nom/name ^+ +> =. +> %- da-emil ~(sa-delete sa nom (~(got by stories) nom)) +>(stories (~(del by stories) nom)) :: ++ sa :> story delta core :> :> story core, used for doing work on a story. :: |_ :> nom: story name in {stories}. :: story is faceless to ease data access. :: $: nom/name story == :> # %resolve +| :: ++ sa-done :> apply changes :> :> put changed story back into the map. :: +>(stories (~(put by stories) nom +<+)) :: :> # :> # %emitters :> # :> arms that create outward changes. +| :: ++ sa-emil :> emit move list :> :> adds multiple moves to the head of {moves}. :> flops to stay consistent with ++ta-emit. :: |= mol/(list move) %_(+> moves (welp (flop mol) moves)) :: ++ sa-emit :> emit a move :> :> adds a move to the head of {moves}. :: |= mov/move %_(+> moves [mov moves]) :: ++ sa-sauce :> cards to moves. :: |= {ost/bone cub/(list card)} ^- (list move) (flop (turn cub |=(a/card [ost a]))) :: :> # :> # %data :> # :> utility functions for data retrieval. +| :: ++ sa-cir [our.bol nom] :: :> # :> # %delta-application :> # :> arms for applying deltas. +| :: ++ sa-delete :> deletion of story :> :> apply a %remove story delta, unsubscribing :> this story from all its active sources. :: %+ weld (sa-abjure src.shape) (sa-eject ~(key by peers)) :: ++ sa-change :> apply circle delta :> :> figure out whether to apply a %story delta to :> local or remote data. :: |= det/delta-story ^+ +> %. det ?: ?& ?=(?($config $status) -.det) !=(cir.det sa-cir) == sa-change-remote sa-change-local :: ++ sa-change-local :> apply our delta :> :> apply a %story delta to local data. :: |= det/delta-story ^+ +> ?+ -.det ~&([%unexpected-delta-local -.det] !!) :: $inherited +>(inherited ihr.det) :: $peer ?: add.det +>(peers (~(add ja peers) who.det qer.det)) =+ qes=(~(get ja peers) who.det) =. qes =+ res=(find ~[qer.det] qes) ?~ res qes (oust [u.res 1] qes) ?~ qes +>.$(peers (~(del by peers) who.det)) +>.$(peers (~(put in peers) who.det qes)) :: $follow (sa-emil (sa-follow-effects sub.det srs.det)) :: $sequent +>(sequence (~(put by sequence) cir.det num.det)) :: $gram (sa-change-gram +.det) :: $sourced (sa-add-gram-source +.det) :: $config =. +> %- sa-emil (sa-config-effects shape dif.det) +>(shape (change-config shape dif.det)) :: $status %_ +> locals ?: ?=($remove -.dif.det) (~(del by locals) who.det) %+ ~(put by locals) who.det %+ change-status (fall (~(get by locals) who.det) *status) dif.det == == :: ++ sa-add-gram-source :> remember message source :> :> if it's not already known, make note of the :> fact that message {num} was heard from {src}. :: |= {src/circle num/@ud} ^+ +> =- +>.$(sourced -) =+ sed=(fall (~(get by sourced) src) ~) ?^ (find ~[num] sed) sourced (~(put by sourced) src [num sed]) :: ++ sa-change-gram :> save/update message :> :> apply a %gram delta, either appending or :> updating a message. :: |= {src/circle gam/telegram} ^+ +> ::TODO move "known" logic up into ++so? that way, :: we can attach message numbers to changes. =+ old=(~(get by known) uid.gam) ?~ old :: new message %. [src count] %_ sa-add-gram-source grams (welp grams [gam ~]) count +(count) known (~(put by known) uid.gam count) == :: changed message %. [src u.old] %_ sa-add-gram-source grams %+ welp (scag u.old grams) [gam (slag +(u.old) grams)] == :: ++ sa-change-remote :> apply remote's delta :> :> apply a story diff to remote data. :: |= det/delta-story ^+ +> ?+ -.det ~&([%unexpected-delta-remote -.det] !!) :: $config ?: ?=($remove -.dif.det) +>(mirrors (~(del by mirrors) cir.det)) =/ new/config %+ change-config (fall (~(get by mirrors) cir.det) *config) dif.det +>.$(mirrors (~(put by mirrors) cir.det new)) :: $status %_ +>.$ remotes %+ ~(put by remotes) cir.det =+ ole=(fall (~(get by remotes) cir.det) *group) ?: ?=($remove -.dif.det) (~(del by ole) who.det) =+ old=(fall (~(get by ole) who.det) *status) (~(put by ole) who.det (change-status old dif.det)) == == :: ++ sa-config-effects :> apply side-effects for a %config delta. :: |= {old/config dif/diff-config} ^- (list move) ?+ -.dif ~ $permit (sa-permit-effects sec.con.old sis.con.old +.dif) ::NOTE when doing a lone %secure, calculate the :: necessary %permit deltas alongside it. == :: ++ sa-follow-effects :> un/subscribe :> :> apply side-effects for a %follow delta, :> un/subscribing this story to/from {cos}. :: |= {sub/? srs/(set source)} ^- (list move) %. srs ?:(sub sa-acquire sa-abjure) :: ++ sa-permit-effects :> notify permitted :> :> apply side-effects for a %permit delta, :> kicking the subscriptions of {sis} if they :> are being banished. :: |= {sec/security old/(set ship) add/? sis/(set ship)} ^- (list move) =/ wyt ?=(?($village $journal) sec) =/ inv =(wyt add) ?: inv ~ =/ sus/(set ship) %. sis.con.shape ?:(add ~(dif in sis) ~(int in sis)) (sa-eject sus) :: :> # :> # %subscriptions :> # :> arms for starting and ending subscriptions +| :: ++ sa-acquire :> subscribes this story to each circle. :: |= srs/(set source) =- (murn - same) %+ turn ~(tap in srs) |= {cir/circle ran/range} ^- (unit move) ?: =(cir sa-cir) ~ :: ignore self-subs =+ wat=~[%grams %config-l %group-l] `(wire-to-peer (circle-wire nom wat cir ran)) :: ++ sa-abjure :> unsubscribes this story from each circle. :: |= srs/(set source) ^- (list move) %+ turn ~(tap in srs) |= {cir/circle ran/range} ^- move =/ wir %^ circle-wire nom ~[%grams %config-l %group-l] [cir ran] [ost.bol %pull wir [hos.cir dap.bol] ~] :: ++ sa-eject :> removes ships {sis} from {followers}. :: |= sis/(set ship) ^- (list move) %- zing %+ turn ~(tap in sup.bol) |= {b/bone s/ship p/path} ^- (list move) ?. ?& (~(has in sis) s) ?=({$circle @tas *} p) =(i.t.p nom) == ~ (gentle-quit b s (path-to-query p)) :: ++ sa-unearth :> ships' bones :> :> find the bones in {sup.bol} that belong to :> a ship in {sis}. :: |= sis/(set ship) ^- (set bone) %- ~(rep in sup.bol) |= {{b/bone s/ship p/path} c/(set bone)} ?. ?& (~(has in sis) s) ?=({$circle @tas *} p) =(i.t.p nom) == c (~(put in c) b) -- -- :: :: :> # :> # %wire-utility :> # +| :: ++ circle-wire :> /circle peer wire :> :> constructs a /circle %peer path for subscribing :> {nom} to a source. :: |= {nom/name wat/(list circle-data) source} ^- wire ;: weld /circle/[nom]/(scot %p hos.cir)/[nom.cir] (sort wat gth) :: consistence (range-to-path ran) == :: ++ wire-to-peer :> peer move from wire :> :> builds the peer move associated with the wire. :: |= wir/wire ^- move =+ tar=(wire-to-target wir) [ost.bol %peer wir [p.tar dap.bol] q.tar] :: ++ wire-to-target :> ship+path from wire :> :> parses {wir} to obtain the target ship and the :> query path. :: |= wir/wire ^- (pair ship path) ?+ wir ~&(wir !!) {$circle @ @ *} :- (slav %p i.t.t.wir) (welp /circle t.t.t.wir) :: {$burden *} :- (above our.bol) /burden/(scot %p our.bol) :: {$report @ *} :- (slav %p i.t.wir) /report == :: ++ etch :> parse wire :> :> parses {wir} to obtain either %circle with story :> and circle or %repeat with message number, source :> ship, story and serials. :: |= wir/wire ^- weir ?+ wir !! {$circle @ @ @ *} :: $circle, us, host, target :^ %circle i.t.wir [(slav %p i.t.t.wir) i.t.t.t.wir] (path-to-range t.t.t.t.wir) :: {$repeat @ @ @ $~} :+ %repeat [(slav %p i.t.wir) i.t.t.wir] ((list serial) (cue (slav %ud i.t.t.t.wir))) == :: ++ etch-circle :> parse /circle wire :> :> parses a /circle wire, call a gate with the :> result. :: |= $: wir/wire $= fun $- {nom/name src/source} {(list move) _.} == =+ wer=(etch wir) ?>(?=($circle -.wer) (fun nom.wer src.wer)) :: ++ etch-repeat :> parses a /repeat wire, call gate with the result. :: |= $: wir/wire $= fun $- {cir/circle ses/(list serial)} {(list move) _.} == =+ wer=(etch wir) ?>(?=($repeat -.wer) (fun cir.wer ses.wer)) :: ++ gentle-quit :> quit other, pull us :> :> we want to gently pull our own subscriptions, :> rather than quitting them, so that we may :> differentiate between a gall/ames quit and a :> foreign quit. but since wex.bol isn't filled, :> we'll have to just guess at what the correct wire :> wire is. this is truly terrible, but will have to :> do for now. ::TODO get rid of this once gall improves. :: it needs to tell us the difference between :: an app-caused quit and a queue-caused one. :: (aka connected/disconnected/rejected state) :: |= {bon/bone who/ship qer/query} ^- (list move) ?. ?=($circle -.qer) ~ ?. =(who our.bol) [bon %quit ~]~ %- zing %+ turn ~(tap in ~(key by stories)) |= n/name ^- (list move) :~ :^ ost.bol %poke / :+ [our.bol dap.bol] %hall-action :^ %source n | [[[our.bol nom.qer] ran.qer] ~ ~] :: :^ ost.bol %pull %^ circle-wire n ~(tap in wat.qer) [[our.bol nom.qer] ran.qer] [[our.bol dap.bol] ~] == :: :> # :> # %new-events :> # +| ++ bake :> apply state delta :> :> applies a change to the application state, :> producing side-effects. :: |= det/delta ^- (quip move _+>) da-done:(da-change:da det) :: ++ pre-bake :> apply more deltas :: |= des/(list delta) ^- (quip move _+>) =| moz/(list move) |- ^- (quip move _+>.^$) ?~ des [moz +>.^$] =^ mos +>.^$ (bake i.des) $(moz :(welp moz mos (affection i.des)), des t.des) ::TODO ideally you'd just do this, but that runtime errors on "bake"... ::%+ roll des ::|= {d/delta m/(list move) _+>.$} ::=^ mos +>.^$ (bake d) ::[:(welp m mos (affection d)) +>.^$] :: ++ peek |= pax/path ?> ?=({$x *} pax) :: others unsupported. ^- (unit (unit (pair mark prize))) =+ piz=(look (path-to-query t.pax)) ?~ piz ~ ?~ u.piz [~ ~] ``[%hall-prize u.u.piz] :: ++ look :> query on state :> :> find the result (if any) for a given query. :: |= qer/query ^- (unit (unit prize)) ?- -.qer $client ``[%client binds nicks] :: $circles =- ``[%circles -] %- ~(gas in *(set name)) %+ murn ~(tap by stories) |= {n/name s/story} ^- (unit name) ?:((~(so-visible so:ta n ~ s) who.qer) `n ~) :: $public ``[%public public] :: $burden :+ ~ ~ :- %burden %- ~(gas in *(map name burden)) %+ murn ~(tap by stories) |= {n/name s/story} ^- (unit (pair name burden)) :: only auto-federate channels for now. ?. ?=($channel sec.con.shape.s) ~ :+ ~ n :: share no more than the last 100, for performance reasons. :+ ?: (lte count.s 100) grams.s (slag (sub count.s 100) grams.s) [shape.s mirrors.s] [locals.s remotes.s] :: $report ::TODO gall note: need to be able to subscirbe to just changes... or just :: data etc. ``[%report ~] :: $peers =+ soy=(~(get by stories) nom.qer) ?~ soy ~ ``[%peers peers.u.soy] :: $circle ::REVIEW should we send precs & config to out of range subs? =+ soy=(~(get by stories) nom.qer) ?~ soy ~ :+ ~ ~ :- %circle :+ ?. (~(has in wat.qer) %grams) ~ %+ turn =- (~(so-first-grams so:ta nom.qer ~ -) ran.qer) ::TODO this can be done more efficiently. ?~ wer.qer u.soy =- u.soy(grams -, count (lent -)) ?. (~(has by sourced.u.soy) u.wer.qer) ~ %+ turn %- flop (~(got by sourced.u.soy) u.wer.qer) |= n/@ud (snag n grams.u.soy) (cury gram-to-envelope nom.qer) :- shape.u.soy ?. (~(has in wat.qer) %config-r) ~ mirrors.u.soy :- locals.u.soy ?. (~(has in wat.qer) %group-r) ~ remotes.u.soy == :: ++ dedicate :> rumor-story to theirs :> :> modify a %story diff to make it about their ship :> instead of ours. :: |= {who/ship nom/name det/delta-story} ^- rumor-story ?+ -.det det :: :: internal-only changes. $follow !! $inherited !! $sequent !! $sourced !! :: $gram :+ %gram ?. =(src.det [our.bol nom]) src.det [who nom] %+ gram-to-envelope nom %_ gam.det aud %- ~(run in aud.gam.det) |= c/circle ?. =(c [our.bol nom]) c [who nom] == :: $config ?. =(cir.det [our.bol nom]) det det(cir [who nom]) :: $status ?. =(cir.det [our.bol nom]) det det(cir [who nom]) == :: ++ gram-to-envelope :> wrap gram with nr :> :> deduce the initial msg number from a telegram :> for a given story. assumes both story and :> telegram are known. :: |= {nom/name gam/telegram} ^- envelope :_ gam %. uid.gam ~(got by known:(~(got by stories) nom)) :: ++ circle-feel-story :: |= $: wer/(unit circle) wat/(set circle-data) nom/name det/delta-story == ^- ? ?& ?~ wer & ?+ -.det & $gram =(src.det u.wer) $config =(cir.det u.wer) $status =(cir.det u.wer) == :: ?: =(wat ~) & %- ~(has in wat) ?+ -.det %hasnot $gram %grams $new %config-l $remove %config-l $config ?: =(cir.det [our.bol nom]) %config-l %config-r $status ?: =(cir.det [our.bol nom]) %group-l %group-r == == :: ++ feel :> delta to rumor :> :> if the given delta changes the result of the given :> query, produce the relevant rumor. :: |= {qer/query det/delta} ^- (unit rumor) ?- -.qer $client :: changes to shared ui state apply. ?+ -.det ~ $glyph `[%client det] $nick `[%client det] == :: $circles ::NOTE this is another case where having access to :: the pre-delta state would be nice to have. ?. ?=($story -.det) ~ =; add/(unit ?) ?~ add ~ `[%circles u.add nom.det] ::REVIEW this could be considered leaky, since it :: doesn't check if {who} ever knew of {nom}, :: but does that matter? can't really check.. :: if the story got deleted, remove it from the circles listing. ?: ?=($remove -.det.det) `| =+ soy=(~(got by stories) nom.det) :: if the story got created, or something about the read permissions set :: for the subscriber changed, update the circles listing. =; dif/? ?. dif ~ :: if the story just got created, don't send a remove rumor, because it :: never showed up in the first place. =- ?:(&(?=($new -.det.det) !-) ~ `-) ?| (team:title our.bol who.qer) (~(so-visible so:ta nom.det ~ soy) who.qer) == ?| ?=($new -.det.det) :: ?& ?=($config -.det.det) ?=($permit -.dif.det.det) ?=(?($channel $village) sec.con.shape.soy) (~(has in sis.dif.det.det) who.qer) == == :: $public ?. ?=($public -.det) ~ `det :: $burden ?. ?=($story -.det) ~ ?: &(=(who.qer src.bol) =(rir /report/(scot %p src.bol))) ~ ?: ?=(?($follow $inherited $sequent $sourced) -.det.det) ~ :: only burden channels for now. ?. (~(has by stories) nom.det) ~ ?. =(%channel sec.con.shape:(~(got by stories) nom.det)) ~ `[%burden nom.det (dedicate who.qer nom.det det.det)] :: $report :: only send changes we didn't get from above. ?: =(src.bol (above our.bol)) ~ :: only send story reports about grams and status. ?. ?=($story -.det) ~ ?. ?=(?($gram $status) -.det.det) ~ =+ soy=(~(got by stories) nom.det) :: and only if the story is inherited. ?. inherited.soy ~ :: only burden channels for now. ?. =(%channel sec.con.shape.soy) ~ `[%burden nom.det (dedicate (above our.bol) nom.det det.det)] :: $peers ?. ?=($story -.det) ~ ?. =(nom.qer nom.det) ~ ?. ?=($peer -.det.det) ~ `[%peers +.det.det] :: $circle ?. ?=($story -.det) ~ ?. =(nom.qer nom.det) ~ ?. %- circle-feel-story [wer.qer wat.qer nom.det det.det] ~ ?. ?| ?=($remove -.det.det) :: =< in %. ran.qer =+ soy=(~(got by stories) nom.qer) ~(so-in-range so:ta nom.qer ~ soy) == ~ =+ out=?($gram $new $config $status $remove) ?. ?=(out -.det.det) ~ :+ ~ %circle ?+ det.det det.det {$gram *} :+ %gram src.det.det (gram-to-envelope nom.det gam.det.det) == == :: ++ affection :> rumors to interested :> :> for a given delta, send rumors to all queries it :> affects. :: |= det/delta ^- (list move) :: cache results for paths. =| res/(map path (list move)) %- zing %+ turn ~(tap by sup.bol) |= {b/bone s/ship p/path} ^- (list move) =+ mur=(~(get by res) p) ?^ mur u.mur =- =. res (~(put by res) p -) - =+ qer=(path-to-query p) %+ welp =+ rum=(feel qer det) ?~ rum ~ [b %diff %hall-rumor u.rum]~ ?. ?=($circle -.qer) ~ :: kill the subscription if we forgot the story. ?. (~(has by stories) nom.qer) (gentle-quit b s qer) :: kill the subscription if it's past its range. =- ?:(done:- (gentle-quit b s qer) ~) %. ran.qer =- ~(so-in-range so:ta nom.qer ~ -) (~(got by stories) nom.qer) :: ++ path-to-query :> path, coins, query :> :> parse a path into a (list coin), then parse that :> into a query structure. :: |= pax/path ?. ?=({$circle @tas *} pax) (coins-to-query (path-to-coins pax)) =/ qer/query [%circle i.t.pax ~ ~ ~] ?> ?=($circle -.qer) :: for type system. =+ pax=t.t.pax =+ ^- {qer/query pax/path} ?. ?=({@ @ *} pax) [qer pax] =+ hos=(slaw %p i.pax) ?~ hos [qer pax] :_ t.t.pax qer(wer `[u.hos i.t.pax]) ?> ?=($circle -.qer) |- ^+ qer ?~ pax qer ::TODO can probably do this a bit better... ?+ i.pax qer(ran (path-to-range pax)) :: circle-data %_ $ pax t.pax wat.qer (~(put in wat.qer) i.pax) == $group %_ $ pax t.pax wat.qer %- ~(uni in wat.qer) ^+ wat.qer (sy %group-l %group-r ~) == $config %_ $ pax t.pax wat.qer %- ~(uni in wat.qer) ^+ wat.qer (sy %config-l %config-r ~) == == :: ++ path-to-coins :> path to coin list :> :> parse a path into a list of coins. :: |= pax/path ^- (list coin) %+ turn `path`pax |= a/@ta (need (slay a)) :: ++ coins-to-query :> coin list to query :> :> parse a list of coins into a query structure. :: ^- $-((list coin) query) => depa |^ %- af :~ [%client ul] [%circles (at /[%p])] [%public ul] [%burden (at /[%p])] [%report ul] == ++ term (do %tas) ++ rang (mu (al plac (mu (un plac)))) ++ plac (or %da %ud) -- :: ++ leak :> visible to :> :> determine if the given query is visible to the :> ship. :: |= {who/ship qer/query} ^- ? ?- -.qer $client (team:title our.bol who) $circles =(who who.qer) $public & $burden ?& =(who who.qer) =(our.bol (above who)) == $peers =(who our.bol) ::TODO or so-visible? $report =(who (above our.bol)) :: $circle ?. (~(has by stories) nom.qer) | %. who ~(so-visible so:ta nom.qer ~ (~(got by stories) nom.qer)) == :: :> # :> # %poke-events :> # +| :: ++ poke-hall-command :> accept command :> :> incoming hall command. process it and update logs. :: |= cod/command ^- (quip move _+>) =^ mos +>.$ %- pre-bake ta-done:(ta-apply:ta src.bol cod) =^ mow +>.$ log-all-to-file [(welp mos mow) +>.$] :: ++ poke-hall-action :> accept action :> :> incoming hall action. process it. :: |= act/action ^- (quip move _+>) ?. (team:title our.bol src.bol) %- pre-bake =< ta-done %- ta-note:ta "hall-action stranger {(scow %p src.bol)}" =^ mos +>.$ %- pre-bake ta-done:(ta-action:ta act) =^ mow +>.$ log-all-to-file [(welp mos mow) +>.$] :: :> # :> # %subscription-events :> # +| :: ++ diff-hall-prize :> accept prize :> :> accept a query result. :: |= {wir/wire piz/prize} ^- (quip move _+>) =^ mos +>.$ %- pre-bake => (ta-take:ta wir piz) (flop deltas) ::TODO ideally this, but runtime error for %burden prize ::%- pre-bake ::ta-done:(ta-take:ta wir piz) =^ mow +>.$ log-all-to-file [(welp mos mow) +>.$] :: ++ diff-hall-rumor :> accept rumor :> :> accept a query result change. :: |= {wir/wire rum/rumor} ^- (quip move _+>) ::NOTE to keep us from echoing changes back to their :: sender, we want to know (in ++feel) if a delta :: was caused by a rumor from a /report. :: if gall worked as advertised, we'd use ost.bol :: and wex.bol to find out, but wex is never set, :: so we just keep track of the "current rumor :: wire" instead. =. rir wir =^ mos +>.$ %- pre-bake => (ta-hear:ta wir rum) (flop deltas) ::TODO runtime error for %burden rumors. ::ta-done:(ta-hear:ta wir rum) =^ mow +>.$ log-all-to-file [(welp mos mow) +>.$] :: ++ peer :> accept subscription :> :> incoming subscription on {pax}. :: |= pax/path ^- (quip move _+>) ?: ?=({$sole *} pax) ~&(%hall-no-sole !!) =+ qer=(path-to-query pax) ?. (leak src.bol qer) ~&(%peer-invisible !!) =^ mos +>.$ %- pre-bake ta-done:(ta-subscribe:ta src.bol qer) :_ +>.$ =+ piz=(look qer) ?~ piz ~&([%query-unavailable pax] mos) ?~ u.piz ~&([%query-invalid pax] mos) :_ mos [ost.bol %diff %hall-prize u.u.piz] :: ++ pull :> unsubscribes. :: |= pax/path ^- (quip move _+>) [~ +>] :: ++ pull-circle :> someone ends a /circle subscription. :: |= pax/path ^- (quip move _+>) %- pre-bake =+ qer=(path-to-query %circle pax) ?> ?=($circle -.qer) ?. (~(has by stories) nom.qer) ~ [%story nom.qer %peer | src.bol qer]~ :: ++ reap :> subscription n/ack :> :> update state to reflect subscription success :: |= {wir/wire fal/(unit tang)} ^- (quip move _+>) %- pre-bake %+ welp ?. ?=({$circle *} wir) ~ =+ wer=(etch wir) ?> ?=($circle -.wer) =< ta-done %. [nom.wer src.wer] ?~ fal ta-greet:ta ta-leave:ta ?~ fal ~ =< ta-done =- (ta-grieve:ta - u.fal) =+ (wire-to-target wir) %+ weld "failed (re)subscribe to {(scow %p p)} on " %+ roll q |= {a/@ta b/tape} :(weld b "/" (trip a)) :: ++ quit :> dropped subscription :> :> gall dropped out subscription. resubscribe. :: |= wir/wire ^- (quip move _+>) [[(wire-to-peer wir) ~] +>] :: ++ quit-circle :> dropped circle sub :> :> gall dropped our subscription. resubscribe. :: |= wir/wire ^- (quip move _+>) %+ etch-circle [%circle wir] |= {nom/name src/source} %- pre-bake ta-done:(ta-resub:ta nom src) :: ++ coup-repeat :> message n/ack :> :> ack from ++ta-transmit. mark the message as :> received or rejected. :: |= {wir/wire fal/(unit tang)} ^- (quip move _+>) %+ etch-repeat [%repeat wir] |= {cir/circle ses/(list serial)} %- pre-bake ta-done:(ta-repeat:ta cir ses fal) :: :> # :> # %logging :> # +| :: ++ poke-hall-save :> save as log :> :> stores the telegrams of story {nom} in a log file, :> to be re-loaded by ++poke-hall-load. ::TODO maybe update to also store sourced list. :: |= nom/name ^- (quip move _+>) =/ paf/path /(scot %p our.bol)/home/(scot %da now.bol)/hall/[nom]/hall-telegrams =+ grams:(~(got by stories) nom) :_ +>.$ :_ ~ :* ost.bol %info /jamfile our.bol (foal:space:userlib paf [%hall-telegrams !>(-)]) == :: ++ poke-load-legacy :> loads legacy messages into the story {nom}. :: |= nom/name ^- (quip move _+>) =/ jams/json .^ json %cx /(scot %p our.bol)/home/(scot %da now.bol)/hall/legacy-telegrams/json == =+ grams=(from-json:hall-legacy jams) ~& [%loaded (lent grams)] %- pre-bake %+ turn (flop grams) |= t/telegram [%story nom %gram [our.bol nom] t] :: ++ poke-hall-load :> load from log :> :> loads the telegrams of story {nom} into our state, :> as saved in ++poke-hall-save. :: |= nom/name ^- (quip move _+>) =/ grams .^ (list telegram) %cx /(scot %p our.bol)/home/(scot %da now.bol)/hall/[nom]/hall-telegrams == %- pre-bake %+ turn grams |= t/telegram [%story nom %gram [our.bol nom] t] :: ++ poke-hall-log :> starts logging story {nom}'s messages. :: |= nom/name ^- (quip move _+>) :- [(log-to-file nom) ~] %= +>.$ log %+ ~(put by log) nom count:(~(got by stories) nom) == :: ++ poke-hall-unlog :> stops logging story {nom}'s messages. :: |= nom/name ^- (quip move _+>) :- ~ +>.$(log (~(del by log) nom)) :: ++ log-all-to-file :> update stories logs :> :> for every story we're logging, (over)writes all :> their grams to log files if new ones have arrived. :: ^- (quip move _.) :_ %_ . log %- ~(urn by log) |= {nom/name len/@ud} count:(~(got by stories) nom) == %+ murn ~(tap by log) |= {nom/name len/@ud} ^- (unit move) ?: (gte len count:(~(got by stories) nom)) ~ `(log-to-file nom) :: ++ log-to-file :> logs all grams of story {nom} to a file. :: |= nom/name ^- move =+ ^- paf/path =+ day=(year %*(. (yore now.bol) +.t +:*tarp)) %+ en-beam:format [our.bol %home da+now.bol] /hall-telegrams/(scot %da day)/[nom]/hall =+ grams:(~(got by stories) nom) :* ost.bol %info /jamfile our.bol (foal:space:userlib paf [%hall-telegrams !>(-)]) == :: ::TODO for debug purposes. remove eventually. :: users beware, here be dragons. ++ poke-noun |= a/@t ^- (quip move _+>) ?: =(a 'check') ~& 'verifying message reference integrity...' =- ~&(- [~ +>.$]) %- ~(urn by stories) |= {n/name s/story} =+ %- ~(rep by known.s) |= {{u/serial a/@ud} k/@ud m/@ud} :- ?:((gth a k) a k) ?: =(u uid:(snag a grams.s)) m ~? (lth m 3) :* [%fake a u] [%prev uid:(snag (dec a) grams.s)] [%real uid:(snag a grams.s)] [%next uid:(snag +(a) grams.s)] == +(m) :^ count=count.s lent=(lent grams.s) known=k mismatch=m ?: =(a 'check subs') ~& 'here are all incoming non-circle subs' ~& ^- (list (pair ship path)) %+ murn ~(tap by sup.bol) |= {b/bone s/ship p/path} ^- (unit (pair ship path)) ?: ?=({$circle *} p) ~ `[s p] [~ +>] ?: =(a 'rebuild') ~& 'rebuilding message references...' =- [~ +>.$(stories -)] %- ~(urn by stories) |= {nom/name soy/story} =+ %+ roll grams.soy |= {t/telegram c/@ud k/(map serial @ud) s/(map circle (list @ud))} :+ +(c) (~(put by k) uid.t c) =/ src/circle ?: (~(has by aud.t) [our.bol nom]) [our.bol nom] ?~ aud.t ~&(%strange-aud [our.bol %inbox]) n.aud.t %+ ~(put by s) src [c (fall (~(get by s) src) ~)] soy(count c, known k, sourced s) ?: =(a 'refederate') ~& 'refederating. may take a while...' :_ +> =+ bov=(above our.bol) ?: =(bov our.bol) ~ :~ [ost.bol %pull /burden [bov dap.bol] ~] (wire-to-peer /burden) == ?: =(a 'incoming') ~& 'incoming subscriptions (ignoring circle subs):' ~& %+ skip ~(tap by sup.bol) |= {bone (pair ship path)} &(?=({$circle *} q) !?=({$circle $inbox *} q)) [~ +>] ?: =(a 'sources') ~& 'sources per story:' ~& %- ~(urn by stories) |= {n/name s/story} [n src.shape.s] [~ +>] ?: =(`0 (find "re-listen " (trip a))) ~& 're-listening' :_ +> :_ ~ (wire-to-peer /report/(crip (slag 10 (trip a)))) [~ +>] --