From 230c5a877892673673dcf303b9f52afc6dce9494 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Fri, 1 Sep 2023 13:52:42 -0700 Subject: [PATCH] wip: new monolith structure --- desk/app/channels.hoon | 1242 ++++++++-------------------------- desk/app/groups.hoon | 9 +- desk/lib/channel-server.hoon | 41 -- desk/lib/notes.hoon | 35 + desk/sur/cite.hoon | 2 +- desk/sur/diary.hoon | 116 +++- desk/sur/groups.hoon | 2 +- 7 files changed, 412 insertions(+), 1035 deletions(-) delete mode 100644 desk/lib/channel-server.hoon create mode 100644 desk/lib/notes.hoon diff --git a/desk/app/channels.hoon b/desk/app/channels.hoon index 6f0a653a6e..3e73c95743 100644 --- a/desk/app/channels.hoon +++ b/desk/app/channels.hoon @@ -1,26 +1,21 @@ +:: TODO: refactor initial subscription to actually fetch by notes :: TODO: listen to groups to join channel -:: TODO: should version negotiation be by han or one for all? -:: TODO: migrate data from source apps :: -/- j=joint, d=diary, h=heap, g=groups, ha=hark +/- d=diary, g=groups, ha=hark /- meta /- e=epic /+ default-agent, verb, dbug, sparse -/+ epos-lib=saga -/+ libserver=channel-server +/+ libnotes=notes :: performance, keep warm -/+ diary-json +:: /+ diary-json :: XX ^- agent:gall => |% +$ card card:agent:gall - +$ han ?(%diary %heap) +$ current-state $: %0 =shelf:d - =stash:h - vod=(map [flag:d plan:d] (unit said:d)) - voh=(map [flag:d id-curio:h] (unit said:h)) + voc=(map [nest:d plan:d] (unit said:d)) == -- =| current-state @@ -77,7 +72,6 @@ `this -- |_ [=bowl:gall cards=(list card)] -+* epos ~(. epos-lib [bowl %diary-update okay:d]) ++ abet [(flop cards) state] ++ cor . ++ emit |=(=card cor(cards [card cards])) @@ -112,237 +106,146 @@ =. cor %+ roll ~(tap by wex.bowl) - |= [[[=wire =ship =dude:gall] acked=? =path] core=_cor] + |= [[[=(pole knot) sub-ship=ship =dude:gall] acked=? =path] core=_cor] =. cor core =/ keep=? - ?+ wire | - [%epic *] &(=(dap.bowl dude) =(/epic wire) =(/epic path)) + ?+ pole | + [%epic *] &(=(dap.bowl dude) =(/epic pole) =(/epic path)) [%groups *] &(=(%groups dude) =(our.bowl ship) =(/groups path)) - [han @ @ %updates ~] - ?. =(%channel-server dude) | - ?. =((scot %p ship) i.t.wire) | - =* qflag i.t.t.wire - ?- i.wire - %diary - ?~ diary=(~(get by shelf) ship qflag) | - ?. ?=(%chi -.saga.net.u.diary) | - ?. ?=([%diary @ %updates ?(~ [@ ~])] path) | - =(qflag i.t.path) - :: - %heap - ?~ heap=(~(get by stash) ship qflag) | - ?. ?=(%chi -.saga.net.u.heap) | - ?. ?=([%heap @ %updates ?(~ [@ ~])] path) | - =(qflag i.t.path) - == + [=han:d ship=@ name=@ %updates ~] + ?. =(server dude) | + ?. =((scot %p sub-ship) ship.pole) | + ?~ diary=(~(get by shelf) han.pole sub-ship name.pole) | + ?. ?=(%chi -.saga.net.u.diary) | + ?. ?=([han:d @ %updates ?(~ [@ ~])] path) | + ?. =(han.pole i.path) | + =(name.pole i.t.path) :: - [han @ @ %checkpoint ~] - ?. =(%channel-server dude) | - ?. =((scot %p ship) i.t.wire) | - =* qflag i.t.t.wire - ?- i.wire - %diary - ?~ diary=(~(get by shelf) ship qflag) | - ?. ?=(%chi -.saga.net.u.diary) | - ?. ?=([%diary @ %checkpoint %before @] path) | - =(qflag i.t.path) - :: - %heap - ?~ heap=(~(get by stash) ship qflag) | - ?. ?=(%chi -.saga.net.u.heap) | - ?. ?=([%heap @ %checkpoint %before @] path) | - =(qflag i.t.path) - == + [=han:d ship=@ name=@ %checkpoint ~] + ?. =(server dude) | + ?. =((scot %p sub-ship) ship.pole) | + ?~ diary=(~(get by shelf) han.pole sub-ship name.pole) | + ?. ?=(%chi -.saga.net.u.diary) | + ?. ?=([han:d @ %checkpoint %before @] path) | + ?. =(han.pole i.path) | + =(name.pole i.t.path) :: - [%said @ @ han @ *] - ?. =(%channel-server dude) | :: maybe %diary ? - ?. =((scot %p ship) i.t.wire) | :: ? - =* qflag i.t.t.wire - =* rest t.t.t.t.t.wire - ?. =(wire path) | - ?- i.t.t.t.wire - %diary - ?. ?=([@ ?(~ [@ ~])] rest) | - ?~ pplan=(slaw %ud i.rest) | - =/ qplan=(unit (unit time)) - ?~ t.rest `~ - ?~ q=(slaw %ud i.t.rest) ~ - ``u.q - ?~ qplan | - (~(has by vod) [ship qflag] u.pplan u.qplan) - :: - %heap - ?. ?=([@ ~] rest) | - ?~ id=(slaw %ud i.rest) | - (~(has by voh) [ship qflag] u.id) - == + [%said =han:d ship=@ name=@ %note time=@ quip=?(~ [@ ~])] + ?. =(server dude) | + ?. =((scot %p sub-ship) ship.pole) | + ?~ pplan=(slaw %ud time.pole) | + =/ qplan=(unit (unit time)) + ?~ quip.pole `~ + ?~ q=(slaw %ud -.quip.pole) ~ + ``u.q + ?~ qplan | + ?. (~(has by voc) [han.pole sub-ship name.pole] u.pplan u.qplan) | + =(wire path) == ?: keep cor - (emit %pass wire %agent [ship dude] %leave ~) + (emit %pass pole %agent [sub-ship dude] %leave ~) :: :: watch all the subscriptions we expect to have :: =. cor watch-groups =/ diaries ~(tap in ~(key by shelf)) - =/ heaps ~(tap in ~(key by stash)) =. cor =/ ships %- ~(gas in *(set ship)) - %+ welp (turn diaries head) - (turn heaps head) + %+ turn diaries + |= =nest:d + ship.nest %+ roll ~(tap in ships) |= [=ship cr=_cor] ?: =(ship our.bowl) cr (watch-epic:cr ship) :: =. cor - %+ roll ~(tap by shelf) - |= [[=flag:d *] core=_cor] - di-abet:di-safe-sub:(di-abed:di-core:core flag) - :: - =. cor - %+ roll ~(tap by stash) - |= [[=flag:d *] core=_cor] - he-abet:he-safe-sub:(he-abed:he-core:core flag) + %+ roll + ~(tap by shelf) + |= [[=nest:d *] core=_cor] + di-abet:di-safe-sub:(di-abed:di-core:core nest) :: =. cor |- - ?^ diaries - =. cor di-abet:di-upgrade:(di-abed:di-core i.diaries) - $(diaries t.diaries) - ?^ heaps - =. cor he-abet:he-upgrade:(he-abed:he-core i.heaps) - $(heaps t.heaps) - cor + ?~ diaries + cor + =. cor di-abet:di-upgrade:(di-abed:di-core i.diaries) + $(diaries t.diaries) cor :: ++ poke |= [=mark =vase] ^+ cor - ?+ mark ~|(bad-poke/mark !!) + ?+ mark ~|(bad-poke+mark !!) %diary-action =+ !<(=a-shelf:d vase) ?: ?=(%create -.a-shelf) di-abet:(di-create:di-core create-diary.a-shelf) ?: ?=(%join -.a-diary.a-shelf) - di-abet:(di-join:di-core [flag group.a-diary]:a-shelf) - di-abet:(di-a-diary:(di-abed:di-core flag.a-shelf) a-diary.a-shelf) - :: - %heap-action - =+ !<(=a-stash:h vase) - ?: ?=(%create -.a-stash) - he-abet:(he-create:he-core create-heap.a-stash) - ?: ?=(%join -.a-heap.a-stash) - he-abet:(he-join:he-core [flag group.a-heap]:a-stash) - he-abet:(he-a-heap:(he-abed:he-core flag.a-stash) a-heap.a-stash) + di-abet:(di-join:di-core [nest group.a-diary]:a-shelf) + di-abet:(di-a-diary:(di-abed:di-core nest.a-shelf) a-diary.a-shelf) == :: ++ watch |= =(pole knot) ^+ cor - ?+ pole ~|(bad-watch-path/pole !!) - [%briefs ~] ?>(from-self cor) - [%ui ~] ?>(from-self cor) - [%imp ~] ?>(from-self cor) - [%epic ~] (give %fact ~ epic+!>(okay:d)) - [%diary ship=@ name=@ %ui ?(~ [%notes ~])] ?>(from-self cor) - [%heap ship=@ name=@ %ui ?(~ [%notes ~])] ?>(from-self cor) - [%said host=@ name=@ =han rest=*] + ?+ pole ~|(bad-watch-path+pole !!) + [%epic ~] (give %fact ~ epic+!>(okay:d)) + [%briefs ~] ?>(from-self cor) + [%ui ~] ?>(from-self cor) + [=han:d ship=@ name=@ %ui ~] ?>(from-self cor) + [%said =han:d host=@ name=@ %note time=@ quip=?(~ [@ ~])] =/ host=ship (slav %p host.pole) - =/ =flag:d [host name.pole] - (watch-said han.pole flag rest.pole) + =/ =nest:d [han.pole host name.pole] + =/ =plan:d =,(pole [(slav %ud time) ?~(quip ~ `(slav %ud -.quip))]) + (watch-said nest plan) == :: ++ watch-said - |= [=han =flag:d =(pole knot)] - ^+ cor - ?- han - %diary - ?. ?=([time=@ quip=?(~ [@ ~])] pole) cor - =/ =plan:d =,(pole [(slav %ud time) ?~(quip ~ `(slav %ud -.quip))]) - ?. (~(has by shelf) flag) - =/ wire (said-wire-diary flag plan) - (safe-watch wire [p.flag server] wire) - di-abet:(di-said:(di-abed:di-core flag) plan) - :: - %heap - ?. ?=([time=@ ~] pole) cor - =/ =id-curio:h (slav %ud time.pole) - ?. (~(has by stash) flag) - =/ wire (said-wire-heap flag id-curio) - (safe-watch wire [p.flag server] wire) - he-abet:(he-said:(he-abed:he-core flag) id-curio) - == + |= [=nest:d =plan:d] + ?. (~(has by shelf) nest) + =/ wire (said-wire nest plan) + (safe-watch wire [ship.nest server] wire) + di-abet:(di-said:(di-abed:di-core nest) plan) :: -++ said-wire-diary - |= [=flag:d =plan:d] +++ said-wire + |= [=nest:d =plan:d] ^- wire %+ welp - /said/(scot %p p.flag)/[q.flag]/diary/(scot %ud p.plan) + /said/[han.nest]/(scot %p ship.nest)/[name.nest]/(scot %ud p.plan) ?~(q.plan / /(scot %ud u.q.plan)) :: -++ said-wire-heap - |= [=flag:d =id-curio:h] - ^- wire - /said/(scot %p p.flag)/[q.flag]/heap/(scot %ud id-curio) -:: ++ take-said - |= [=han =flag:d =(pole knot) =sign:agent:gall] + |= [=nest:d =plan:d =sign:agent:gall] + =/ =wire (said-wire nest plan) ^+ cor - ?: ?=(%poke-ack -.sign) cor - ?: ?=(%watch-ack -.sign) + ?+ -.sign !! + %watch-ack %. cor ?~ p.sign same - (slog leaf+"Preview failed for {} {}" u.p.sign) + (slog leaf+"Preview failed" u.p.sign) :: - ?- han - %diary - ?. ?=([time=@ quip=?(~ [@ ~])] pole) cor - =/ =plan:d =,(pole [(slav %ud time) ?~(quip ~ `(slav %ud -.quip))]) - =/ =wire (said-wire-diary flag plan) - ?- -.sign - %kick - ?: (~(has by vod) flag plan) - cor :: subscription ended politely - (give %kick ~[(said-wire-diary flag plan)] ~) - :: - %fact - =. cor (give %fact ~[wire] cage.sign) - =. cor (give %kick ~[wire] ~) - ?+ p.cage.sign ~|(funny-mark+p.cage.sign !!) - %diary-denied cor(vod (~(put by vod) [flag plan] ~)) - %diary-said - =+ !<(=said:d q.cage.sign) - cor(vod (~(put by vod) [flag plan] `said)) - == - == + %kick + ?: (~(has by voc) nest plan) + cor :: subscription ended politely + (give %kick ~[wire] ~) :: - %heap - ?. ?=([time=@ ~] pole) cor - =/ =id-curio:h (slav %ud time.pole) - =/ =wire (said-wire-heap flag id-curio) - ?- -.sign - %kick - ?: (~(has by voh) [flag id-curio]) - cor :: subscription ended politely - (give %kick ~[(said-wire-heap flag id-curio)] ~) - :: - %fact - =. cor (give %fact ~[wire] cage.sign) - =. cor (give %kick ~[wire] ~) - ?+ p.cage.sign ~|(funny-mark+p.cage.sign !!) - %heap-denied cor(voh (~(put by voh) [flag id-curio] ~)) - %heap-said - =+ !<(=said:h q.cage.sign) - cor(voh (~(put by voh) [flag id-curio] `said)) - == + %fact + =. cor (give %fact ~[wire] cage.sign) + =. cor (give %kick ~[wire] ~) + ?+ p.cage.sign ~|(funny-mark+p.cage.sign !!) + %diary-denied cor(voc (~(put by voc) [nest plan] ~)) + %diary-said + =+ !<(=said:d q.cage.sign) + cor(voc (~(put by voc) [nest plan] `said)) == == :: ++ agent |= [=(pole knot) =sign:agent:gall] ^+ cor - ?+ pole ~|(bad-agent-wire/pole !!) + ?+ pole ~|(bad-agent-wire+pole !!) ~ cor [%epic ~] (take-epic sign) [%hark ~] @@ -351,18 +254,15 @@ %- (slog leaf+"Failed to hark" u.p.sign) cor :: - [%diary ship=@ name=@ rest=*] - =/ =ship (slav %p ship.pole) - di-abet:(di-agent:(di-abed:di-core ship name.pole) rest.pole sign) - :: - [%heap ship=@ name=@ rest=*] + [=han:d ship=@ name=@ rest=*] =/ =ship (slav %p ship.pole) - he-abet:(he-agent:(he-abed:he-core ship name.pole) rest.pole sign) + di-abet:(di-agent:(di-abed:di-core han.pole ship name.pole) rest.pole sign) :: - [%said host=@ name=@ =han rest=*] + [%said =han:d host=@ name=@ %note time=@ quip=?(~ [@ ~])] =/ host=ship (slav %p host.pole) - =/ =flag:d [host name.pole] - (take-said han.pole flag rest.pole sign) + =/ =nest:d [han.pole host name.pole] + =/ =plan:d =,(pole [(slav %ud time) ?~(quip ~ `(slav %ud -.quip))]) + (take-said nest plan sign) :: [%groups ~] ?+ -.sign !! @@ -385,21 +285,6 @@ |= her=ship (safe-watch /epic [her server] /epic) :: -++ safe-watch-epic - |= her=ship - ^- [(unit saga:e) _cor] - =/ diaries=(list [=flag:d =diary:d]) ~(tap by shelf) - |- - ?^ diaries - ?. =(p.flag.i.diaries her) $(diaries t.diaries) - [`saga.net.diary.i.diaries cor] - =/ heaps=(list [=flag:h =heap:h]) ~(tap by stash) - |- - ?^ heaps - ?. =(p.flag.i.heaps her) $(heaps t.heaps) - [`saga.net.heap.i.heaps cor] - `(watch-epic her) -:: ++ take-epic |= =sign:agent:gall ^+ cor @@ -411,19 +296,10 @@ ~& p.cage.sign cor =+ !<(=epic:e q.cage.sign) - =. cor - %+ roll ~(tap by shelf) - |= [[=flag:g =diary:d] out=_cor] - ?. =(src.bowl p.flag) out - di-abet:(di-take-epic:(di-abed:di-core:out flag) epic) - :: - =. cor - %+ roll ~(tap by stash) - |= [[=flag:g =heap:h] out=_cor] - ?. =(src.bowl p.flag) out - he-abet:(he-take-epic:(he-abed:he-core:out flag) epic) - :: - cor + %+ roll ~(tap by shelf) + |= [[=nest:d =diary:d] out=_cor] + ?. =(src.bowl ship.nest) out + di-abet:(di-take-epic:(di-abed:di-core:out nest) epic) :: %watch-ack %. cor @@ -433,17 +309,11 @@ :: ++ take-groups |= =action:g - =/ affected=(list [han flag:d]) - %+ welp - %+ murn ~(tap by shelf) - |= [=flag:d =diary:d] - ?. =(p.action group.perm.perm.diary) ~ - `[%diary flag] - %+ murn ~(tap by stash) - |= [=flag:h =heap:h] - ?. =(p.action group.perm.perm.heap) ~ - `[%heap flag] - :: + =/ affected=(list nest:d) + %+ murn ~(tap by shelf) + |= [=nest:d =diary:d] + ?. =(p.action group.perm.perm.diary) ~ + `nest =/ diff q.q.action ?+ diff cor [%fleet * %add-sects *] (recheck-perms affected ~) @@ -458,66 +328,35 @@ == :: ++ recheck-perms - |= [affected=(list [han flag:d]) sects=(set sect:g)] - ~& "%channel-server recheck permissions for {}" + |= [affected=(list nest:d) sects=(set sect:g)] + ~& "%channel recheck permissions for {}" %+ roll affected - |= [[=han =flag:d] co=_cor] - =. cor co - ?- han - %diary di-abet:(di-recheck:(di-abed:di-core flag) sects) - %heap he-abet:(he-recheck:(he-abed:he-core flag) sects) - == + |= [=nest:d co=_cor] + =/ di (di-abed:di-core:co nest) + di-abet:(di-recheck:di sects) :: ++ peek |= =(pole knot) ^- (unit (unit cage)) ?+ pole [~ ~] - [%x %diary %shelf ~] ``shelf+!>((di-rr-shelf:di-core shelf)) - [%x %diary %init ~] ``noun+!>([diary-briefs (di-rr-shelf:di-core shelf)]) - [%x %diary %briefs ~] ``diary-briefs+!>(diary-briefs) - [%x %diary ship=@ name=@ rest=*] - =/ =ship (slav %p ship.pole) - (di-peek:(di-abed:di-core ship name.pole) rest.pole) - :: - [%u %diary ship=@ name=@ ~] + [%x %shelf ~] ``shelf+!>((di-rr-shelf:di-core shelf)) + [%x %init ~] ``noun+!>([briefs (di-rr-shelf:di-core shelf)]) + [%x %briefs ~] ``channel-briefs+!>(briefs) + [%x =han:d ship=@ name=@ rest=*] =/ =ship (slav %p ship.pole) - ``loob+!>((~(has by shelf) [ship name.pole])) + (di-peek:(di-abed:di-core han.pole ship name.pole) rest.pole) :: - [%x %heap %stash ~] ``stash+!>((he-rr-stash:he-core stash)) - [%x %heap %init ~] ``noun+!>([heap-briefs (he-rr-stash:he-core stash)]) - [%x %heap %briefs ~] ``heap-briefs+!>(heap-briefs) - [%x %heap ship=@ name=@ rest=*] + [%u =han:d ship=@ name=@ ~] =/ =ship (slav %p ship.pole) - (he-peek:(he-abed:he-core ship name.pole) rest.pole) - :: - [%u %heap ship=@ name=@ ~] - =/ =ship (slav %p ship.pole) - ``loob+!>((~(has by stash) [ship name.pole])) + ``loob+!>((~(has by shelf) han.pole ship name.pole)) == :: -++ diary-briefs +++ briefs ^- briefs:d %- ~(gas by *briefs:d) %+ turn ~(tap in ~(key by shelf)) - |= =flag:d - [flag di-brief:(di-abed:di-core flag)] -:: -++ heap-briefs - ^- briefs:h - %- ~(gas by *briefs:d) - %+ turn ~(tap in ~(key by stash)) - |= =flag:d - [flag he-brief:(he-abed:he-core flag)] -:: -++ spin-yarn - |= [=nest:g group=flag:g rest=path con=(list content:ha) but=(unit button:ha)] - ^- new-yarn:ha - =/ rope [`group `nest q.byk.bowl (welp /(scot %p p.q.nest)/[q.q.nest] rest)] - =/ link - %- welp :_ rest - :- %groups - /(scot %p p.group)/[q.group]/channels/[p.nest]/(scot %p p.q.nest)/[q.flag] - [& & rope con link but] + |= =nest:d + [nest di-brief:(di-abed:di-core nest)] :: ++ pass-hark |= =new-yarn:ha @@ -528,7 +367,7 @@ ++ from-self =(our src):bowl :: ++ di-core - |_ [=flag:d =diary:d gone=_|] + |_ [=nest:d =diary:d gone=_|] ++ di-core . ++ emit |=(=card di-core(cor (^emit card))) ++ emil |=(caz=(list card) di-core(cor (^emil caz))) @@ -537,52 +376,50 @@ ++ di-abet %_ cor shelf - ?:(gone (~(del by shelf) flag) (~(put by shelf) flag diary)) + ?:(gone (~(del by shelf) nest) (~(put by shelf) nest diary)) == - :: ++ di-abed - |= f=flag:d - di-core(flag f, diary (~(got by shelf) f)) + |= n=nest:d + di-core(nest n, diary (~(got by shelf) n)) :: - ++ di-area `path`/diary/(scot %p p.flag)/[q.flag] - ++ di-sub-wire `path`/diary/(scot %p p.flag)/[q.flag]/updates + ++ di-area `path`/[han.nest]/(scot %p ship.nest)/[name.nest] + ++ di-sub-wire (weld di-area /updates) ++ di-give-brief - (give %fact ~[/briefs] diary-brief-update+!>([flag di-brief])) - :: - :: give a "response" to our subscribers - :: - ++ di-response - |= =r-diary:d - =/ =r-shelf:d [flag r-diary] - (give %fact ~[/ui] %diary-response !>(r-shelf)) + (give %fact ~[/briefs] channel-brief-update+!>([nest di-brief])) +:: :: :: handle creating a channel :: ++ di-create |= create=create-diary:d ?> from-self - =. flag [our.bowl name.create] - ?< (~(has by shelf) flag) + =. nest [han.create our.bowl name.create] + ?< (~(has by shelf) nest) =. diary *diary:d =. group.perm.perm.diary group.create =. last-read.remark.diary now.bowl - =/ =cage [%diary-command !>([%create create])] + =/ =cage [%channel-command !>([%create create])] (emit %pass (weld di-area /create) %agent [our.bowl server] %poke cage) :: + :: :: handle joining a channel :: ++ di-join - |= [f=flag:d group=flag:g] - ?< (~(has by shelf) flag) + |= [n=nest:d group=flag:g] + ?< (~(has by shelf) nest) ?> |(=(p.group src.bowl) from-self) - =. flag f + =. nest n =. diary *diary:d =. group.perm.perm.diary group =. last-read.remark.diary now.bowl =. di-core di-give-brief =. di-core (di-response %join group) - =^ sag=(unit saga:e) cor (safe-watch-epic p.flag) - =? saga.net.diary ?=(^ sag) u.sag + =. di-core + =/ diaries=(list [=nest:d =diary:d]) ~(tap by shelf) + |- + ?~ diaries di-core(cor (watch-epic ship.nest)) + ?: !=(ship.nest.i.diaries ship.nest) $(diaries t.diaries) + di-core(saga.net.diary saga.net.diary.i.diaries) di-safe-sub :: :: handle an action from the client @@ -594,17 +431,15 @@ ++ di-a-diary |= =a-diary:d ?> from-self - ?+ -.a-diary (di-send-command a-diary) - %join !! :: handled elsewhere - %leave di-leave + ?+ -.a-diary (di-send-command [%diary nest a-diary]) + %join !! :: handled elsewhere + %leave di-leave ?(%read %read-at %watch %unwatch) (di-a-remark a-diary) == :: ++ di-a-remark - |= =a-remark:j + |= =a-remark:d ^+ di-core - =. di-core - (give %fact ~[(snoc di-area %ui)] diary-response+!>([flag a-remark])) =. remark.diary ?- -.a-remark %watch remark.diary(watching &) @@ -620,13 +455,14 @@ :: proxy command to host :: ++ di-send-command - |= =c-diary:d + |= command=c-shelf:d ^+ di-core + ?> ?=(%diary -.command) :: don't allow anyone else to proxy through us ?. =(src.bowl our.bowl) ~|("%diary-action poke failed: only allowed from self" !!) - =/ =cage [%diary-command !>(`c-shelf:d`[%diary flag c-diary])] - (emit %pass di-area %agent [p.flag server] %poke cage) + =/ =cage [%channel-command !>(command)] + (emit %pass di-area %agent [ship.nest.command server] %poke cage) :: :: handle a said (previews) request where we have the data to respond :: @@ -635,8 +471,9 @@ ^+ di-core =. di-core %^ give %fact ~ - ?. (di-can-read src.bowl) diary-denied+!>(~) - (diary-said:libserver flag plan notes.diary) + ?. (di-can-read src.bowl) + diary-denied+!>(~) + (said:libnotes nest plan notes.diary) (give %kick ~ ~) :: :: when we get a new %diary agent update, we need to check if we @@ -653,7 +490,7 @@ :: if we're still behind even with the upgrade, no-op :: ?. =(okay:d ver.saga.net.diary) - ~& future-shock+[ver.saga.net.diary flag] + ~& future-shock+[ver.saga.net.diary nest] di-core :: safe to sync and resume updates from host :: @@ -683,30 +520,30 @@ di-safe-sub :: ++ di-has-sub - (~(has by wex.bowl) [di-sub-wire p.flag dap.bowl]) + ^- ? + (~(has by wex.bowl) [di-sub-wire ship.nest dap.bowl]) :: ++ di-safe-sub - ^+ di-core ?: di-has-sub di-core ?. ?=(%chi -.saga.net.diary) di-core ?^ notes.diary di-start-updates =. load.net.diary | - %^ safe-watch (weld di-area /checkpoint) [p.flag server] - ?. =(our.bowl p.flag) - /diary/[q.flag]/checkpoint/before/20 - /diary/[q.flag]/checkpoint/time-range/(scot %da *@da) + %^ safe-watch (weld di-area /checkpoint) [ship.nest server] + ?. =(our.bowl ship.nest) + /[han.nest]/[name.nest]/checkpoint/before/20 + /[han.nest]/[name.nest]/checkpoint/time-range/(scot %da *@da) :: ++ di-start-updates :: not most optimal time, should maintain last heard time instead =/ tim=(unit time) (bind (ram:on-notes:d notes.diary) head) - %^ safe-watch di-sub-wire [p.flag server] - /diary/[q.flag]/updates/(scot %da (fall tim *@da)) + %^ safe-watch di-sub-wire [ship.nest server] + /[han.nest]/[name.nest]/updates/(scot %da (fall tim *@da)) :: ++ di-agent |= [=wire =sign:agent:gall] ^+ di-core - ?+ wire ~|(diary-strange-agent-wire+wire !!) + ?+ wire ~|(channel-strange-agent-wire+wire !!) ~ di-core :: noop wire, should only send pokes [%create ~] (di-take-create sign) [%updates ~] (di-take-update sign) @@ -719,21 +556,21 @@ ?- -.sign %poke-ack =+ ?~ p.sign ~ - %- (slog leaf+"%diary: Failed creation (poke)" u.p.sign) + %- (slog leaf+"{}: Failed creation (poke)" u.p.sign) ~ - =/ =path /diary/[q.flag]/create + =/ =path /[han.nest]/[name.nest]/create =/ =wire (weld di-area /create) (emit %pass wire %agent [our.bowl server] %watch path) :: %kick di-safe-sub %watch-ack ?~ p.sign di-core - %- (slog leaf+"%diary: Failed creation" u.p.sign) + %- (slog leaf+"{}: Failed creation" u.p.sign) di-core :: %fact =* cage cage.sign - ?. =(%diary-update p.cage) + ?. =(%channel-update p.cage) ~|(diary-strange-fact+p.cage !!) =+ !<(=update:d q.cage) =. di-core (di-u-shelf update) @@ -748,14 +585,14 @@ %kick di-safe-sub %watch-ack ?~ p.sign di-core - %- (slog leaf+"%diary: Failed subscription" u.p.sign) + %- (slog leaf+"{}: Failed subscription" u.p.sign) di-core :: %fact =* cage cage.sign - ?+ p.cage ~|(diary-strange-fact+p.cage !!) - %diary-logs (di-apply-logs !<(log:d q.cage)) - %diary-update (di-u-shelf !<(update:d q.cage)) + ?+ p.cage ~|(channel-strange-fact+p.cage !!) + %channel-logs (di-apply-logs !<(log:d q.cage)) + %channel-update (di-u-shelf !<(update:d q.cage)) == == :: @@ -767,13 +604,13 @@ %kick ?:(load.net.diary di-core di-safe-sub) %watch-ack ?~ p.sign di-core - %- (slog leaf+"%diary: Failed partial checkpoint" u.p.sign) + %- (slog leaf+"{}: Failed partial checkpoint" u.p.sign) di-core :: %fact =* cage cage.sign ?+ p.cage ~|(diary-strange-fact+p.cage !!) - %diary-checkpoint + %channel-checkpoint (di-ingest-checkpoint !<(u-checkpoint:d q.cage)) == == @@ -782,13 +619,13 @@ |= chk=u-checkpoint:d ^+ di-core =. load.net.diary & - =^ changed sort.diary (apply-rev:j sort.diary sort.chk) + =^ changed sort.diary (apply-rev:d sort.diary sort.chk) =? di-core changed (di-response %sort sort.sort.diary) - =^ changed view.diary (apply-rev:j view.diary view.chk) + =^ changed view.diary (apply-rev:d view.diary view.chk) =? di-core changed (di-response %view view.view.diary) - =^ changed perm.diary (apply-rev:j perm.diary perm.chk) + =^ changed perm.diary (apply-rev:d perm.diary perm.chk) =? di-core changed (di-response %perm perm.perm.diary) - =^ changed order.diary (apply-rev:j order.diary order.chk) + =^ changed order.diary (apply-rev:d order.diary order.chk) =? di-core changed (di-response %order order.order.diary) =/ old notes.diary =. notes.diary @@ -806,7 +643,7 @@ (some [id `(di-rr-note u.note)]) =. di-core di-start-updates =/ wire (weld di-area /checkpoint) - (emit %pass wire %agent [p.flag dap.bowl] %leave ~) + (emit %pass wire %agent [ship.nest dap.bowl] %leave ~) :: ++ di-apply-logs |= =log:d @@ -832,22 +669,22 @@ (di-response %create perm.u-diary) :: %order - =^ changed order.diary (apply-rev:j order.diary +.u-diary) + =^ changed order.diary (apply-rev:d order.diary +.u-diary) ?. changed di-core (di-response %order order.order.diary) :: %view - =^ changed view.diary (apply-rev:j view.diary +.u-diary) + =^ changed view.diary (apply-rev:d view.diary +.u-diary) ?. changed di-core (di-response %view view.view.diary) :: %sort - =^ changed sort.diary (apply-rev:j sort.diary +.u-diary) + =^ changed sort.diary (apply-rev:d sort.diary +.u-diary) ?. changed di-core (di-response %sort sort.sort.diary) :: %perm - =^ changed perm.diary (apply-rev:j perm.diary +.u-diary) + =^ changed perm.diary (apply-rev:d perm.diary +.u-diary) ?. changed di-core (di-response %perm perm.perm.diary) :: @@ -894,14 +731,14 @@ ?- -.u-note %quip (di-u-quip id-note u.u.note id.u-note u-quip.u-note) %feels - =/ merged (apply-feels:j feels.u.u.note feels.u-note) + =/ merged (di-apply-feels feels.u.u.note feels.u-note) ?: =(merged feels.u.u.note) di-core =. notes.diary (put:on-notes:d notes.diary id-note `u.u.note(feels merged)) - (di-response %note id-note %feels (reduce-feels:j merged)) + (di-response %note id-note %feels (di-rr-feels merged)) :: %essay - =^ changed +.u.u.note (apply-rev:j +.u.u.note +.u-note) + =^ changed +.u.u.note (apply-rev:d +.u.u.note +.u-note) ?. changed di-core =. notes.diary (put:on-notes:d notes.diary id-note `u.u.note) (di-response %note id-note %essay +>.u.u.note) @@ -933,10 +770,10 @@ :: ?~ quip di-core :: - =/ merged (apply-feels:j feels.u.u.quip feels.u-quip) + =/ merged (di-apply-feels feels.u.u.quip feels.u-quip) ?: =(merged feels.u.u.quip) di-core =. di-core (di-put-quip id-note id-quip `u.u.quip(feels merged)) - (di-response %note id-note %quip id-quip %feels (reduce-feels:j merged)) + (di-response %note id-note %quip id-quip %feels (di-rr-feels merged)) :: :: put a quip into a note by id :: @@ -965,10 +802,17 @@ ^- note:d %_ old quips (di-apply-quips quips.old quips.new) - feels (apply-feels:j feels.old feels.new) - + +:(apply-rev:j +.old +.new) + feels (di-apply-feels feels.old feels.new) + + +:(apply-rev:d +.old +.new) == :: + ++ di-apply-feels + |= [old=feels:d new=feels:d] + ^- feels:d + %- (~(uno by old) new) + |= [* a=(rev:d (unit feel:d)) b=(rev:d (unit feel:d))] + +:(apply-rev:d a b) + :: ++ di-apply-quips |= [old=quips:d new=quips:d] ((uno:mo-quips:d old new) di-apply-quip) @@ -980,7 +824,7 @@ ?~ new ~ :- ~ %= u.old - feels (apply-feels:j feels.u.old feels.u.new) + feels (di-apply-feels feels.u.old feels.u.new) + +.u.new == :: @@ -1000,6 +844,14 @@ sort +.sort.diary order +.order.diary == + ++ di-rr-notes + |= =notes:d + ^- rr-notes:d + %+ gas:rr-on-notes:d *rr-notes:d + %+ turn (tap:on-notes:d notes) + |= [=id-note:d note=(unit note:d)] + ^- [id-note:d (unit rr-note:d)] + [id-note ?~(note ~ `(di-rr-note u.note))] :: ++ di-rr-note |= =note:d @@ -1007,7 +859,7 @@ :_ +>.note :+ id.note (di-rr-quips quips.note) - (reduce-feels:j feels.note) + (di-rr-feels feels.note) :: ++ di-rr-quips |= =quips:d @@ -1024,7 +876,16 @@ |= =quip:d ^- rr-quip:d :_ +.quip - [id.quip (reduce-feels:j feels.quip)] + [id.quip (di-rr-feels feels.quip)] + :: + ++ di-rr-feels + |= =feels:d + ^- (map ship feel:d) + %- ~(gas by *(map ship feel:d)) + %+ murn ~(tap by feels) + |= [=ship (rev:d feel=(unit feel:d))] + ?~ feel ~ + (some ship u.feel) :: :: emit hark notifications when necessary :: @@ -1042,15 +903,26 @@ ?: |(=(author.quip our.bowl) &(!in-replies !=(author.note our.bowl))) di-core =/ cs=(list content:ha) - :~ [%ship author.quip] ' commented on ' - [%emph title.note] ': ' - [%ship author.quip] ': ' - (flatten q.content.quip) + ?- -.han-data.note + %diary + :~ [%ship author.quip] ' commented on ' + [%emph title.han-data.note] ': ' + [%ship author.quip] ': ' + (flatten q.content.quip) + == + %heap + =/ content (flatten q.content.quip) + =/ title=@t + ?^ title.han-data.note (need title.han-data.note) + ?: (lte (met 3 content) 80) content + (cat 3 (end [3 77] content) '...') + :~ [%ship author.quip] ' commented on ' + [%emph title] ': ' + [%ship author.quip] ': ' + content + == == - %- emit - %- pass-hark - %^ spin-yarn [%diary flag] group.perm.perm.diary - [/note/(rsh 4 (scot %ui id-note)) cs ~] + (emit (pass-hark (di-spin /note/(rsh 4 (scot %ui id-note)) cs ~))) :: ++ flatten |= content=(list inline:d) @@ -1073,28 +945,47 @@ == -- :: + :: convert content into a full yarn suitable for hark + :: + ++ di-spin + |= [rest=path con=(list content:ha) but=(unit button:ha)] + ^- new-yarn:ha + =* group group.perm.perm.diary + =/ gn=nest:g nest + =/ thread (welp /[han.nest]/(scot %p ship.nest)/[name.nest] rest) + =/ rope [`group `gn q.byk.bowl thread] + =/ link (welp /groups/(scot %p p.group)/[q.group]/channels thread) + [& & rope con link but] + :: + :: give a "response" to our subscribers + :: + ++ di-response + |= =r-diary:d + =/ =r-shelf:d [nest r-diary] + (give %fact ~[/ui (snoc di-area %ui)] channel-response+!>(r-shelf)) + :: :: produce an up-to-date brief :: ++ di-brief ^- brief:d - =/ =id-note:d - ?~ tim=(ram:on-notes:d notes.diary) *id-note:d + =/ =time + ?~ tim=(ram:on-notes:d notes.diary) *time key.u.tim =/ unreads (lot:on-notes:d notes.diary `last-read.remark.diary ~) - =/ read-id=(unit id-note:d) + =/ read-id=(unit ^time) =/ pried (pry:on-notes:d unreads) ?~ pried ~ - ?~ val.u.pried ~ :: should check next note? + ?~ val.u.pried ~ `id.u.val.u.pried =/ count %- lent %+ skim ~(tap by unreads) - |= [=id-note:d note=(unit note:d)] + |= [tim=^time note=(unit note:d)] ?& ?=(^ note) !=(author.u.note our.bowl) == - [id-note count read-id] + [time count read-id] :: :: handle scries :: @@ -1102,8 +993,8 @@ |= =(pole knot) ^- (unit (unit cage)) ?+ pole [~ ~] - [%notes rest=*] (di-peek-notes rest.pole) - [%perm ~] ``diary-perm+!>(perm.perm.diary) + [%notes rest=*] (di-peek-notes rest.pole) + [%perm ~] ``channel-perm+!>(perm.perm.diary) == :: ++ di-peek-notes @@ -1111,43 +1002,42 @@ ^- (unit (unit cage)) =* on on-notes:d ?+ pole [~ ~] - :: [%newest count=@ mode=?(%outline %note) ~] =/ count (slav %ud count.pole) =/ ls (top:mo-notes:d notes.diary count) ?: =(mode.pole %note) - ``diary-notes+!>((gas:on *notes:d ls)) - =- ``diary-outlines+!>(-) + ``channel-notes+!>((gas:on *notes:d ls)) + =- ``channel-outlines+!>(-) %+ gas:on:outlines:d *outlines:d %+ murn ls |= [=time note=(unit note:d)] ?~ note ~ - (some [time (diary-trace:libserver u.note)]) + (some [time (trace:libnotes u.note)]) :: [%older start=@ count=@ mode=?(%outline %note) ~] =/ count (slav %ud count.pole) =/ start (slav %ud start.pole) =/ ls (bat:mo-notes:d notes.diary `start count) ?: =(mode.pole %note) - ``diary-notes+!>((gas:on *notes:d ls)) - =- ``diary-outlines+!>(-) + ``channel-notes+!>((gas:on *notes:d ls)) + =- ``channel-outlines+!>(-) %+ gas:on:outlines:d *outlines:d %+ murn ls |= [=time note=(unit note:d)] ?~ note ~ - (some [time (diary-trace:libserver u.note)]) + (some [time (trace:libnotes u.note)]) :: [%newer start=@ count=@ ~] =/ count (slav %ud count.pole) =/ start (slav %ud start.pole) - ``diary-notes+!>((gas:on *notes:d (tab:on notes.diary `start count))) + ``channel-notes+!>((gas:on *notes:d (tab:on notes.diary `start count))) :: [%note time=@ ~] =/ time (slav %ud time.pole) =/ note (get:on notes.diary time) ?~ note ~ ?~ u.note `~ - ``diary-note+!>((di-rr-note u.u.note)) + ``channel-note+!>((di-rr-note u.u.note)) :: [%note %id time=@ %quips rest=*] =/ time (slav %ud time.pole) @@ -1162,22 +1052,20 @@ ^- (unit (unit cage)) =* on on-quips:d ?+ pole [~ ~] - [%all ~] - ``diary-quips+!>(quips) - :: + [%all ~] ``channel-quips+!>(quips) [%newest count=@ ~] =/ count (slav %ud count.pole) - ``diary-quips+!>((gas:on *quips:d (top:mo-quips:d quips count))) + ``channel-quips+!>((gas:on *quips:d (top:mo-quips:d quips count))) :: [%older start=@ count=@ ~] =/ count (slav %ud count.pole) =/ start (slav %ud start.pole) - ``diary-quips+!>((gas:on *quips:d (bat:mo-quips:d quips `start count))) + ``channel-quips+!>((gas:on *quips:d (bat:mo-quips:d quips `start count))) :: [%newer start=@ count=@ ~] =/ count (slav %ud count.pole) =/ start (slav %ud start.pole) - ``diary-quips+!>((gas:on *quips:d (tab:on quips `start count))) + ``channel-quips+!>((gas:on *quips:d (tab:on quips `start count))) :: [%quip %id time=@ ~] =/ time (slav %ud time.pole) @@ -1206,18 +1094,41 @@ :: :: assorted helpers :: - ++ di-from-host |(=(p.flag src.bowl) =(p.group.perm.perm.diary src.bowl)) + ++ di-from-admin + ?: =(ship.nest src.bowl) & + .^ admin=? + ;: weld + /gx + di-groups-scry + /channel/[han.nest]/(scot %p ship.nest)/[name.nest] + /fleet/(scot %p src.bowl)/is-bloc/loob + == == + :: + ++ di-from-host |(=(ship.nest src.bowl) =(p.group.perm.perm.diary src.bowl)) + ++ di-can-write + ?: =(ship.nest src.bowl) & + =/ =path + %+ welp di-groups-scry + :+ %channel han.nest + /(scot %p ship.nest)/[name.nest]/can-write/(scot %p src.bowl)/noun + =+ .^(write=(unit [bloc=? sects=(set sect:g)]) %gx path) + ?~ write | + =/ perms (need write) + ?: |(bloc.perms =(~ writers.perm.perm.diary)) & + !=(~ (~(int in writers.perm.perm.diary) sects.perms)) + :: ++ di-can-read |= her=ship =/ =path %+ welp di-groups-scry - /channel/diary/(scot %p p.flag)/[q.flag]/can-read/(scot %p her)/loob + :+ %channel han.nest + /(scot %p ship.nest)/[name.nest]/can-read/(scot %p her)/loob .^(? %gx path) :: :: leave the subscription only :: ++ di-simple-leave - (emit %pass di-sub-wire %agent [p.flag dap.bowl] %leave ~) + (emit %pass di-sub-wire %agent [ship.nest server] %leave ~) :: :: Leave the subscription, tell people about it, and delete our local :: state for the channel @@ -1228,569 +1139,4 @@ =. gone & di-core -- -:: -++ he-core - |_ [=flag:h =heap:h gone=_|] - ++ he-core . - ++ emit |=(=card he-core(cor (^emit card))) - ++ emil |=(caz=(list card) he-core(cor (^emil caz))) - ++ give |=(=gift:agent:gall he-core(cor (^give gift))) - ++ safe-watch |=([=wire =dock =path] he-core(cor (^safe-watch +<))) - ++ he-abet - %_ cor - stash - ?:(gone (~(del by stash) flag) (~(put by stash) flag heap)) - == - :: - ++ he-abed - |= f=flag:h - he-core(flag f, heap (~(got by stash) f)) - :: - ++ he-area `path`/heap/(scot %p p.flag)/[q.flag] - ++ he-sub-wire `path`/heap/(scot %p p.flag)/[q.flag]/updates - ++ he-give-brief - (give %fact ~[/briefs] heap-brief-update+!>([flag he-brief])) - :: - ++ he-response - |= =r-heap:h - =/ =r-stash:h [flag r-heap] - (give %fact ~[/ui] %heap-response !>(r-stash)) - :: - ++ he-create - |= create=create-heap:h - ?> from-self - =. flag [our.bowl name.create] - ?< (~(has by shelf) flag) - =. heap *heap:h - =. group.perm.perm.heap group.create - =. last-read.remark.heap now.bowl - =/ =cage [%heap-command !>([%create create])] - (emit %pass (weld he-area /create) %agent [our.bowl server] %poke cage) - :: - ++ he-join - |= [f=flag:h group=flag:g] - ?< (~(has by stash) flag) - ?> |(=(p.group src.bowl) from-self) - =. flag f - =. heap *heap:h - =. group.perm.perm.heap group - =. last-read.remark.heap now.bowl - =. he-core he-give-brief - =. he-core (he-response %join group) - =^ sag=(unit saga:e) cor (safe-watch-epic p.flag) - =? saga.net.heap ?=(^ sag) u.sag - he-safe-sub - :: - ++ he-a-heap - |= =a-heap:h - ?> from-self - ?+ -.a-heap (he-send-command a-heap) - %join !! :: handled elsewhere - %leave he-leave - ?(%read %read-at %watch %unwatch) (he-a-remark a-heap) - == - :: - ++ he-a-remark - |= =a-remark:j - ^+ he-core - =. he-core - (give %fact ~[(snoc he-area %ui)] heap-response+!>([flag a-remark])) - =. remark.heap - ?- -.a-remark - %watch remark.heap(watching &) - %unwatch remark.heap(watching |) - %read-at !! - %read - =/ [=time curio=(unit curio:h)] (need (ram:on-curios:h curios.heap)) - remark.heap(last-read `@da`(add time (div ~s1 100))) - == - =. he-core he-give-brief - (he-response a-remark) - :: - ++ he-send-command - |= =c-heap:h - ^+ he-core - ?. =(src.bowl our.bowl) - ~|("%heap-action poke failed: only allowed from self" !!) - =/ =cage [%heap-command !>(`c-stash:h`[%heap flag c-heap])] - (emit %pass he-area %agent [p.flag server] %poke cage) - :: - ++ he-said - |= =id-curio:h - ^+ he-core - =. he-core - %^ give %fact ~ - ?. (he-can-read src.bowl) heap-denied+!>(~) - (heap-said:libserver flag id-curio curios.heap) - (give %kick ~ ~) - :: - ++ he-upgrade - ^+ he-core - :: if we're ahead or synced, no-op - :: - ?. ?=(%dex -.saga.net.heap) - he-core - :: if we're still behind even with the upgrade, no-op - :: - ?. =(okay:d ver.saga.net.heap) - ~& future-shock+[ver.saga.net.heap flag] - he-core - :: safe to sync and resume updates from host - :: - => .(saga.net.heap `saga:e`saga.net.heap) - he-make-chi - :: - ++ he-take-epic - |= her=epic:e - ^+ he-core - ?: (lth her okay:d) he-make-lev - ?: (gth her okay:d) (he-make-dex her) - he-make-chi - :: - ++ he-make-dex - |= her=epic:e - =. saga.net.heap dex+her - he-simple-leave - :: - ++ he-make-lev - =. saga.net.heap lev/~ - he-simple-leave - :: - ++ he-make-chi - =. saga.net.heap chi/~ - he-safe-sub - :: - ++ he-has-sub - (~(has by wex.bowl) [he-sub-wire p.flag dap.bowl]) - :: - ++ he-safe-sub - ^+ he-core - ?: he-has-sub he-core - ?. ?=(%chi -.saga.net.heap) he-core - ?^ curios.heap he-start-updates - =. load.net.heap | - %^ safe-watch (weld he-area /checkpoint) [p.flag server] - ?. =(our.bowl p.flag) - /heap/[q.flag]/checkpoint/before/20 - /heap/[q.flag]/checkpoint/time-range/(scot %da *@da) - :: - ++ he-start-updates - =/ tim=(unit time) - (bind (ram:on-curios:d curios.heap) head) - %^ safe-watch he-sub-wire [p.flag server] - /heap/[q.flag]/updates/(scot %da (fall tim *@da)) - :: - ++ he-agent - |= [=wire =sign:agent:gall] - ^+ he-core - ?+ wire ~|(heap-strange-agent-wire+wire !!) - ~ he-core :: noop wire, should only send pokes - [%create ~] (he-take-create sign) - [%updates ~] (he-take-update sign) - [%checkpoint ~] (he-take-checkpoint sign) - == - :: - ++ he-take-create - |= =sign:agent:gall - ^+ he-core - ?- -.sign - %poke-ack - =+ ?~ p.sign ~ - %- (slog leaf+"%heap: Failed creation (poke)" u.p.sign) - ~ - =/ =path /heap/[q.flag]/create - =/ =wire (weld he-area /create) - (emit %pass wire %agent [our.bowl server] %watch path) - :: - %kick he-safe-sub - %watch-ack - ?~ p.sign he-core - %- (slog leaf+"%heap: Failed creation" u.p.sign) - he-core - :: - %fact - =* cage cage.sign - ?. =(%heap-update p.cage) - ~|(heap-strange-fact+p.cage !!) - =+ !<(=update:h q.cage) - =. he-core (he-u-stash update) - =. he-core he-give-brief - he-safe-sub - == - :: - ++ he-take-update - |= =sign:agent:gall - ^+ he-core - ?+ -.sign he-core - %kick he-safe-sub - %watch-ack - ?~ p.sign he-core - %- (slog leaf+"%heap: Failed subscription" u.p.sign) - he-core - :: - %fact - =* cage cage.sign - ?+ p.cage ~|(heap-strange-fact+p.cage !!) - %heap-logs (he-apply-logs !<(log:h q.cage)) - %heap-update (he-u-stash !<(update:h q.cage)) - == - == - :: - ++ he-take-checkpoint - |= =sign:agent:gall - ^+ he-core - ?+ -.sign he-core - %kick ?:(load.net.heap he-core he-safe-sub) - %watch-ack - ?~ p.sign he-core - %- (slog leaf+"%heap: Failed partial checkpoint" u.p.sign) - he-core - :: - %fact - =* cage cage.sign - ?+ p.cage ~|(heap-strange-fact+p.cage !!) - %heap-checkpoint - (he-ingest-checkpoint !<(u-checkpoint:h q.cage)) - == - == - :: - ++ he-ingest-checkpoint - |= chk=u-checkpoint:h - ^+ he-core - =. load.net.heap & - =^ changed view.heap (apply-rev:j view.heap view.chk) - =? he-core changed (he-response %view view.view.heap) - =^ changed perm.heap (apply-rev:j perm.heap perm.chk) - =? he-core changed (he-response %perm perm.perm.heap) - =/ old curios.heap - =. curios.heap - ((uno:mo-curios:h curios.heap curios.chk) he-apply-unit-curio) - =? he-core !=(old curios.heap) - %+ he-response %curios - %+ gas:rr-on-curios:h *rr-curios:h - %+ murn (turn (tap:on-curios:h curios.chk) head) - |= id=id-curio:h - ^- (unit [id-curio:h (unit rr-curio:h)]) - =/ curio (got:on-curios:h curios.heap id) - =/ old (get:on-curios:h old id) - ?: =(old `curio) ~ - ?~ curio (some [id ~]) - (some [id `(he-rr-curio u.curio)]) - =. he-core he-start-updates - =/ wire (weld he-area /checkpoint) - (emit %pass wire %agent [p.flag %heap] %leave ~) - :: - ++ he-apply-logs - |= =log:h - ^+ he-core - %+ roll (tap:log-on:h log) - |= [[=time =u-heap:h] he=_he-core] - (he-u-stash:he time u-heap) - :: - ++ he-u-stash - |= [=time =u-heap:h] - ?> he-from-host - ^+ he-core - ?- -.u-heap - %create - ?. =(0 rev.perm.heap) he-core - =. perm.perm.heap perm.u-heap - (he-response %create perm.u-heap) - :: - %view - =^ changed view.heap (apply-rev:h view.heap +.u-heap) - ?. changed he-core - (he-response %view view.view.heap) - :: - %perm - =^ changed perm.heap (apply-rev:h perm.heap +.u-heap) - ?. changed he-core - (he-response %perm perm.perm.heap) - :: - %curio - =/ old curios.heap - =. he-core (he-u-curio id.u-heap u-curio.u-heap) - =? he-core !=(old curios.heap) he-give-brief - he-core - == - :: - ++ he-u-curio - |= [=id-curio:h =u-curio:h] - ^+ he-core - =/ curio (get:on-curios:h curios.heap id-curio) - ?: ?=([~ ~] curio) he-core - ?: ?=(%set -.u-curio) - ?~ curio - =/ rr-curio=(unit rr-curio:h) (bind curio.u-curio he-rr-curio) - =? he-core ?=(^ curio.u-curio) - =. he-core (he-hark u.curio.u-curio) - ?~ replying.u.curio.u-curio - he-core - =* op-id u.replying.u.curio.u-curio - =/ op (get:on-curios:h curios.heap op-id) - ?~ op he-core - ?~ u.op he-core - =. replied.u.u.op (~(put in replied.u.u.op) id-curio) - =. curios.heap (put:on-curios:h curios.heap op-id u.op) - he-core - =. curios.heap (put:on-curios:h curios.heap id-curio curio.u-curio) - (he-response %curio id-curio %set rr-curio) - :: - ?~ curio.u-curio - =. curios.heap (put:on-curios:h curios.heap id-curio ~) - (he-response %curio id-curio %set ~) - :: - =* old u.u.curio - =* new u.curio.u-curio - =/ merged (he-apply-curio id-curio old new) - ?: =(merged old) he-core - =. curios.heap (put:on-curios:h curios.heap id-curio `merged) - (he-response %curio id-curio %set `(he-rr-curio merged)) - :: - ?~ note - he-core - :: - ?- -.u-curio - %feels - =/ merged (apply-feels:j feels.u.u.curio feels.u-curio) - ?: =(merged feels.u.u.curio) he-core - =. curios.heap - (put:on-curios:h curios.heap id-curio `u.u.curio(feels merged)) - (he-response %curio id-curio %feels (reduce-feels:j merged)) - :: - %heart - =^ changed +.u.u.curio (apply-rev:h +.u.u.curio +.u-curio) - ?. changed he-core - =. curios.heap (put:on-curios:h curios.heap id-curio `u.u.curio) - (he-response %curio id-curio %heart +>.u.u.curio) - == - :: - ++ he-apply-unit-curio - |= [=id-curio:h old=(unit curio:h) new=(unit curio:h)] - ^- (unit curio:h) - ?~ old ~ - ?~ new ~ - `(he-apply-curio id-curio u.old u.new) - :: - ++ he-apply-curio - |= [=id-curio:h old=curio:h new=curio:h] - ^- curio:h - %_ old - feels (apply-feels:j feels.old feels.new) - replied (~(uni in replied.old) replied.new) - + +:(apply-rev:h +.old +.new) - == - :: - ++ he-rr-stash - |= =stash:h - ^- rr-stash:h - %- ~(run by stash) - |= =heap:h - ^- rr-heap:h - %* . *rr-heap:h - curios *rr-curios:h - view +.view.heap - perm +.perm.heap - == - :: - ++ he-rr-curio - |= =curio:h - ^- rr-curio:h - :_ +>.curio - :+ id.curio - (reduce-feels:j feels.curio) - replied.curio - :: - ++ he-rr-curio-list - |= curios=(list [id-curio:h (unit curio:h)]) - ^- rr-curios:h - %+ gas:rr-on-curios:h *rr-curios:h - %+ turn curios - |= [=id-curio:h curio=(unit curio:h)] - [id-curio (bind curio he-rr-curio)] - :: - ++ he-hark - |= =curio:h - |^ ^+ he-core - ?~ replying.curio he-core - =/ op (get:on-curios:h curios.heap u.replying.curio) - ?~ op he-core - ?~ u.op he-core - =/ in-replies - %+ lien ~(tap in replied.u.u.op) - |= =id-curio:h - =/ curio (get:on-curios:h curios.heap id-curio) - ?~ curio %.n - ?~ u.curio %.n - =(author.u.u.curio our.bowl) - =/ content (trip (flatten q.content.curio)) - =/ title=@t - ?^ title.curio u.title.curio - ?: (lte (lent content) 80) (crip content) - (crip (weld (swag [0 77] content) "...")) - =/ am-op-author =(author.u.u.op our.bowl) - =/ am-author =(author.curio our.bowl) - =? he-core &(!am-author |(in-replies am-op-author)) - %- emit - %- pass-hark - %^ spin-yarn [%heap flag] group.perm.perm.heap - :_ ~ - :- /curio/(rsh 4 (scot %ui u.replying.curio)) - :~ [%ship author.curio] - ' commented on ' - [%emph title] - ': ' - [%ship author.curio] - ': ' - (flatten q.content.curio) - == - he-core - :: - ++ flatten - |= content=(list inline:h) - ^- cord - %- crip - %- zing - %+ turn - content - |= c=inline:h - ^- tape - ?@ c (trip c) - ?- -.c - ?(%break %block) "" - %tag (trip p.c) - %link (trip q.c) - ?(%code %inline-code) "" - %ship (scow %p p.c) - ?(%italics %bold %strike %blockquote) (trip (flatten p.c)) - == - -- - :: - ++ he-brief - ^- brief:h - =/ =id-curio:h - ?~ tim=(ram:on-curios:h curios.heap) *id-curio:h - key.u.tim - =/ unreads - (lot:on-curios:h curios.heap `last-read.remark.heap ~) - =/ read-id=(unit id-curio:h) - =/ pried (pry:on-curios:h unreads) - ?~ pried ~ - ?~ val.u.pried ~ :: should check next note? - `id.u.val.u.pried - =/ count - %- lent - %+ skim ~(tap by unreads) - |= [=id-curio:h curio=(unit curio:h)] - ?& ?=(^ curio) - !=(author.u.curio our.bowl) - == - [id-curio count read-id] - :: - ++ he-peek - |= =(pole knot) - ^- (unit (unit cage)) - ?+ pole [~ ~] - [%curios rest=*] (he-peek-curios rest.pole) - [%perm ~] ``heap-perm+!>(perm.perm.heap) - == - :: - ++ he-peek-curios - |= =(pole knot) - ^- (unit (unit cage)) - |^ - =* on on-curios:h - =* mo mo-curios:h - ?+ pole [~ ~] - [%newest count=@ ~] - =/ count (slav %ud count.pole) - ``heap-curios+!>((he-rr-curio-list (top:mo curios.heap count))) - :: - [%newest count=@ %blocks ~] - =/ count (slav %ud count.pole) - ``heap-curios+!>((he-rr-curio-list (top:mo blocks-only count))) - :: - [%older start=@ count=@ ~] - =/ count (slav %ud count.pole) - =/ start (slav %ud start.pole) - ``heap-curios+!>((he-rr-curio-list (bat:mo curios.heap `start count))) - :: - [%older start=@ count=@ %blocks ~] - =/ count (slav %ud count.pole) - =/ start (slav %ud start.pole) - ``heap-curios+!>((he-rr-curio-list (bat:mo blocks-only `start count))) - :: - [%newer start=@ count=@ ~] - =/ count (slav %ud count.pole) - =/ start (slav %ud start.pole) - ``heap-curios+!>((he-rr-curio-list (tab:on curios.heap `start count))) - :: - [%newer start=@ count=@ %blocks ~] - =/ count (slav %ud count.pole) - =/ start (slav %ud start.pole) - ``heap-curios+!>((he-rr-curio-list (tab:on blocks-only `start count))) - :: - [%curio %id time=@ %full ~] - =/ =id-curio:h (slav %ud time.pole) - =/ curio (get:on curios.heap id-curio) - ?~ curio ~ - ?~ u.curio `~ - =- ``heap-curios+!>(-) - %- he-rr-curio-list - %+ welp - ~[[id-curio `u.u.curio]] - %+ murn - ~(tap in replied.u.u.curio) - |= i=id-curio:h - ^- (unit [id-curio:h (unit curio:h)]) - =/ c (get:on curios.heap i) - ?~ c ~ - ?~ u.c ~ - (some [id-curio `u.u.c]) - :: - [%curio %id time=@ ~] - =/ =id-curio:h (slav %ud time.pole) - ``curio+!>((need (need (get:on curios.heap id-curio)))) - == - :: - ++ blocks-only - ^- curios:h - =- +:- - %^ (dip:on-curios:h @) curios.heap ~ - |= [st=@ =time curio=(unit curio:h)] - :_ [%.n st] - ?~ curio ~ - ?^ replying.u.curio ~ - ``u.curio - -- - :: - ++ he-recheck - |= sects=(set sect:g) - :: if our read permissions restored, re-subscribe - ?: (he-can-read our.bowl) he-safe-sub - he-core - :: - ++ he-groups-scry - ^- path - =* group group.perm.perm.heap - :- (scot %p our.bowl) - /groups/(scot %da now.bowl)/groups/(scot %p p.group)/[q.group] - :: - ++ he-from-host |(=(p.flag src.bowl) =(p.group.perm.perm.heap src.bowl)) - ++ he-can-read - |= her=ship - =/ =path - %+ welp he-groups-scry - /channel/heap/(scot %p p.flag)/[q.flag]/can-read/(scot %p her)/loob - .^(? %gx path) - :: - ++ he-simple-leave - (emit %pass he-sub-wire %agent [p.flag dap.bowl] %leave ~) - :: - ++ he-leave - =. he-core he-simple-leave - =. he-core (he-response %leave ~) - =. gone & - he-core - -- -- diff --git a/desk/app/groups.hoon b/desk/app/groups.hoon index ae7cebc94d..73d5aec939 100644 --- a/desk/app/groups.hoon +++ b/desk/app/groups.hoon @@ -249,7 +249,7 @@ :: %diary =/ perms .^(perm:d %gx path) - =/ =c-shelf:d [%diary +.nest %del-writers writers.perms] + =/ =c-shelf:d [%diary nest %del-writers writers.perms] =/ =wire /diary =/ =dock [our.bowl %channels-server] =/ =cage [act:mar:d !>(c-shelf)] @@ -894,12 +894,7 @@ =/ =wire (snoc go-area %join-channels) [%pass wire %agent dock %poke cage] =/ =dock [our.bowl %channels] - =/ =vase - ?+ p.nes !! - %diary !>([%diary flag q.nes]) - %heap !>([%heap flag q.nes]) - == - =/ =cage [(cat 3 p.nes '-action') vase] + =/ =cage ['channel-action' !>([%diary nes q.nes])] =/ =wire (snoc go-area %join-channels) [%pass wire %agent dock %poke cage] -- diff --git a/desk/lib/channel-server.hoon b/desk/lib/channel-server.hoon deleted file mode 100644 index cc45dadcc8..0000000000 --- a/desk/lib/channel-server.hoon +++ /dev/null @@ -1,41 +0,0 @@ -/- d=diary, h=heap -:: convert a note to a preview for a "said" response -:: -|% -++ diary-said - |= [=flag:d =plan:d =notes:d] - ^- cage - =/ note=(unit (unit note:d)) (get:on-notes:d notes p.plan) - =/ =outline:d - ?~ note - ::TODO give "outline" that formally declares deletion - [0 ~ 'Unknown post' '' ~ ~nul *@da] - ?~ u.note - [0 ~ 'This post was deleted' '' ~ ~nul *@da] - (diary-trace u.u.note) - [%diary-said !>(`said:d`[flag outline])] -:: -++ diary-trace - |= =note:d - ^- outline:d - =; quippers=(set ship) - [~(wyt by quips.note) quippers +>.note] - =- (~(gas in *(set ship)) (scag 3 ~(tap in -))) - %- ~(gas in *(set ship)) - %+ murn (tap:on-quips:d quips.note) - |= [@ quip=(unit quip:d)] - ?~ quip ~ - (some author.u.quip) -:: -++ heap-said - |= [=flag:h =id-curio:h =curios:h] - ^- cage - =/ curio=(unit (unit curio:h)) (get:on-curios:h curios id-curio) - =/ =curio:h - ?~ curio - [*seal:h 0 `'Unkonwn link' [~ ~] ~nul *@da ~] - ?~ u.curio - [*seal:h 0 `'This link was deleted' [~ ~] ~nul *@da ~] - u.u.curio - [%diary-said !>(`said:h`[flag curio])] --- diff --git a/desk/lib/notes.hoon b/desk/lib/notes.hoon new file mode 100644 index 0000000000..1c72184391 --- /dev/null +++ b/desk/lib/notes.hoon @@ -0,0 +1,35 @@ +/- d=diary, h=heap +:: convert a note to a preview for a "said" response +:: +|% +++ said + |= [=nest:d =plan:d =notes:d] + ^- cage + =/ note=(unit (unit note:d)) (get:on-notes:d notes p.plan) + =/ =outline:d + ?~ note + ::TODO give "outline" that formally declares deletion + ?- han.nest + %diary [0 ~ ~ ~nul *@da %diary 'Unknown post' ''] + %heap [0 ~ ~ ~nul *@da %heap ~ 'Unknown link'] + == + ?~ u.note + ?- han.nest + %diary [0 ~ ~ ~nul *@da %diary 'This post was deleted' ''] + %heap [0 ~ ~ ~nul *@da %heap ~ 'This link was deleted'] + == + (trace u.u.note) + [%said !>(`said:d`[nest outline])] +:: +++ trace + |= =note:d + ^- outline:d + =; quippers=(set ship) + [~(wyt by quips.note) quippers +>.note] + =- (~(gas in *(set ship)) (scag 3 ~(tap in -))) + %- ~(gas in *(set ship)) + %+ murn (tap:on-quips:d quips.note) + |= [@ quip=(unit quip:d)] + ?~ quip ~ + (some author.u.quip) +-- diff --git a/desk/sur/cite.hoon b/desk/sur/cite.hoon index 387342bf08..113bed7596 100644 --- a/desk/sur/cite.hoon +++ b/desk/sur/cite.hoon @@ -22,6 +22,7 @@ ?~ ship ~ `[%group u.ship name.pole] == +:: ++ parse |= =path ^- cite @@ -54,4 +55,3 @@ :: work out what app == -- - diff --git a/desk/sur/diary.hoon b/desk/sur/diary.hoon index e80156e897..3c113485a1 100644 --- a/desk/sur/diary.hoon +++ b/desk/sur/diary.hoon @@ -15,7 +15,7 @@ :: commands _may_ become updates, :: updates _may_ become responses. :: -/- g=groups, c=cite, e=epic, j=joint +/- g=groups, c=cite, e=epic /- zer=diary-0, uno=diary-1 /+ mp=mop-extensions |% @@ -39,17 +39,17 @@ :: +| %primitives :: -+$ shelf (map flag diary) ++$ shelf (map nest diary) ++ diary |^ ,[global local] :: $global: should be identical between ships :: +$ global $: =notes - order=(rev:j order=arranged-notes) - view=(rev:j =view) - sort=(rev:j =sort) - perm=(rev:j =perm) + order=(rev order=arranged-notes) + view=(rev =view) + sort=(rev =sort) + perm=(rev =perm) == :: $window: sparse set of time ranges :: @@ -72,7 +72,7 @@ -- :: $note: a diary post :: -+$ note [seal (rev:j essay)] ++$ note [seal (rev essay)] +$ id-note time +$ notes ((mop id-note (unit note)) lte) ++ on-notes ((on id-note (unit note)) lte) @@ -89,13 +89,13 @@ +$ seal $+ diary-seal $: id=id-note =quips - =feels:j + =feels == :: $cork: host-side data for a quip :: +$ cork $: id=id-quip - =feels:j + =feels == :: $essay: the post data itself :: @@ -106,12 +106,17 @@ :: sent: the client-side time the post was made :: +$ essay - $: title=@t - image=@t - content=(list verse) + $: content=(list verse) author=ship sent=time + =han-data == +:: ++$ han-data + $% [%diary title=@t image=@t] + [%heap title=(unit @t)] + == +:: +$ story (pair (list block) (list inline)) :: $memo: the comment data itself :: @@ -183,16 +188,20 @@ [%break ~] == :: -:: $flag: identifier for a diary channel -+$ flag (pair ship term) ++$ han ?(%diary %heap) +:: $nest: identifier for a diary channel ++$ nest [=han =ship name=term] :: $view: the persisted display format for a diary +$ view $~(%list ?(%grid %list)) :: $sort: the persisted sort type for a diary +$ sort $~(%time ?(%alpha %time %arranged)) :: $arranged-notes: an array of noteIds +$ arranged-notes (unit (list time)) +:: $feel: either an emoji identifier like :diff or a URL for custom ++$ feel @ta ++$ feels (map ship (rev (unit feel))) :: $said: used for references -+$ said (pair flag outline) ++$ said (pair nest outline) :: $plan: index into diary state :: p: Note being referred to :: q: Quip being referred to, if any @@ -209,7 +218,7 @@ :: brief: the last time a diary was read, how many posts since, :: and the id of the last read note :: -+$ briefs (map flag brief) ++$ briefs (map nest brief) +$ brief [last=time count=@ud read-id=(unit time)] :: $remark: a marker representing the last note I've read :: @@ -237,7 +246,8 @@ :: read permission is stored with the group's data. :: +$ create-diary - $: name=term + $: =han + name=term group=flag:g title=cord description=cord @@ -256,6 +266,24 @@ +$ outlines ((mop time outline) lte) ++ on ((^on time outline) lte) -- +++ rev + |$ [data] + [rev=@ud data] +:: +++ apply-rev + |* [old=(rev) new=(rev)] + ^+ [changed=& old] + ?: (lth rev.old rev.new) + &+new + |+old +:: +++ next-rev + |* [old=(rev) new=*] + ^+ [changed=& old] + ?: =(+.old new) + |+old + &+old(rev +(rev.old), + new) +:: +| %actions :: :: some actions happen to be the same as commands, but this can freely @@ -266,15 +294,23 @@ :: originally caused it +$ a-shelf $% [%create =create-diary] - [%diary =flag =a-diary] + [%diary =nest =a-diary] == +$ a-diary $% [%join group=flag:g] [%leave ~] - a-remark:j + a-remark c-diary == :: ++$ a-remark + $~ [%read ~] + $% [%read ~] + [%read-at =time] + [%watch ~] + [%unwatch ~] + == +:: +$ a-note c-note +$ a-quip c-quip :: @@ -282,7 +318,7 @@ :: +$ c-shelf $% [%create =create-diary] - [%diary =flag =c-diary] + [%diary =nest =c-diary] == +$ c-diary $% [%note =c-note] @@ -298,45 +334,50 @@ [%edit id=id-note =essay] [%del id=id-note] [%quip id=id-note =c-quip] - c-feel:j + c-feel == :: +$ c-quip $% [%add =memo] [%del id=id-quip] - c-feel:j + c-feel + == +:: ++$ c-feel + $% [%add-feel id=@da p=ship q=feel] + [%del-feel id=@da p=ship] == :: +| %updates :: +$ update [=time =u-diary] -+$ u-shelf [=flag =u-diary] ++$ u-shelf [=nest =u-diary] +$ u-diary $% [%create =perm] - [%order (rev:j order=arranged-notes)] - [%view (rev:j =view)] - [%sort (rev:j =sort)] - [%perm (rev:j =perm)] + [%order (rev order=arranged-notes)] + [%view (rev =view)] + [%sort (rev =sort)] + [%perm (rev =perm)] [%note id=id-note =u-note] == :: +$ u-note $% [%set note=(unit note)] - [%feels =feels:j] - [%essay (rev:j =essay)] + [%feels =feels] + [%essay (rev =essay)] [%quip id=id-quip =u-quip] == :: +$ u-quip $% [%set quip=(unit quip)] - [%feels =feels:j] + [%feels =feels] == :: +$ u-checkpoint global:diary :: +| %responses :: -+$ r-shelf [=flag =r-diary] ++$ r-shelf [=nest =r-diary] +$ r-diary $% [%notes =rr-notes] [%note id=id-note =r-note] @@ -348,24 +389,24 @@ [%create =perm] [%join group=flag:g] [%leave ~] - a-remark:j + a-remark == :: +$ r-note $% [%set note=(unit rr-note)] [%quip id=id-quip =r-quip] - [%feels feels=rr-feels:j] + [%feels feels=rr-feels] [%essay =essay] == :: +$ r-quip $% [%set quip=(unit rr-quip)] - [%feels feels=rr-feels:j] + [%feels feels=rr-feels] == :: versions of backend types with their revision numbers stripped, :: because the frontend shouldn't care to learn those. :: -+$ rr-shelf (map flag rr-diary) ++$ rr-shelf (map nest rr-diary) ++ rr-diary |^ ,[global local] +$ global @@ -383,10 +424,11 @@ -- +$ rr-notes ((mop id-note (unit rr-note)) lte) +$ rr-note [rr-seal essay] -+$ rr-seal [id=id-note =rr-quips =rr-feels:j] ++$ rr-seal [id=id-note =rr-quips =rr-feels] ++$ rr-feels (map ship feel) +$ rr-quip [rr-cork memo] +$ rr-quips ((mop id-quip rr-quip) lte) -+$ rr-cork [id=id-quip =rr-feels:j] ++$ rr-cork [id=id-quip =rr-feels] ++ rr-on-notes ((on id-note (unit rr-note)) lte) ++ rr-on-quips ((on id-quip rr-quip) lte) -- diff --git a/desk/sur/groups.hoon b/desk/sur/groups.hoon index 0c495b8bd5..e3bc1cc52a 100644 --- a/desk/sur/groups.hoon +++ b/desk/sur/groups.hoon @@ -17,7 +17,7 @@ :: :: $nest: ID for a channel, {app}/{ship}/{name} :: -+$ nest (pair dude:gall flag) ++$ nest (pair term flag) :: :: $sect: ID for cabal, similar to a role ::