urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-28 22:33:06 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #2814 from urbit/lf/chat-type-namespacing

Browse Source 
chat: improve namespacing of chat-* types
This commit is contained in:
matildepark 2020-05-19 19:54:22 -04:00 committed by GitHub
commit 91cf06b542
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
20 changed files with 532 additions and 513 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
pkg/arvo/app/chat-cli.hoon
View File

@ -9,10 +9,10 @@
:: we concat the ship onto the head of the path,
:: and trust it to take care of the rest.
::
/- *chat-store, *chat-view, *chat-hook,
/- view=chat-view, hook=chat-hook,
*permission-store, *group-store, *invite-store,
sole-sur=sole
/+ sole-lib=sole, chat-eval, default-agent, verb, dbug,
*rw-security, sole-sur=sole
/+ sole-lib=sole, default-agent, verb, dbug, store=chat-store,
auto=language-server-complete
::
|%
@ -26,7 +26,7 @@
+$ state-1
$: %1
grams=(list mail) :: all messages
known=(set [target serial]) :: known message lookup
known=(set [target serial:store]) :: known message lookup
count=@ud :: (lent grams)
bound=(map target glyph) :: bound circle glyphs
binds=(jug glyph target) :: circle glyph lookup
@ -39,7 +39,7 @@
==
::
+$ state-0
$: grams=(list [[=ship =path] envelope]) :: all messages
$: grams=(list [[=ship =path] envelope:store]) :: all messages
known=(set [[=ship =path] serial]) :: known message lookup
count=@ud :: (lent grams)
bound=(map [=ship =path] glyph) :: bound circle glyphs
@ -52,7 +52,7 @@
eny=@uvJ :: entropy
==
::
+$ mail [source=target envelope]
+$ mail [source=target envelope:store]
+$ target [in-group=? =ship =path]
::
+$ glyph char
@ -62,7 +62,7 @@
::
+$ command
$% [%target (set target)] :: set messaging target
[%say letter] :: send message
[%say letter:store] :: send message
[%eval cord hoon] :: send #-message
::
::
@ -153,7 +153,7 @@
::
%fact
?+ p.cage.sign ~|([%chat-cli-bad-sub-mark wire p.cage.sign] !!)
%chat-update (diff-chat-update:tc wire !<(chat-update q.cage.sign))
%chat-update (diff-chat-update:tc wire !<(update:store q.cage.sign))
%invite-update (handle-invite-update:tc !<(invite-update q.cage.sign))
==
==
@ -226,8 +226,8 @@
::
++ catch-up
^- (quip card _state)
=/ =inbox
(scry-for inbox %chat-store /all)
=/ =inbox:store
(scry-for inbox:store %chat-store /all)
|- ^- (quip card _state)
?~ inbox [~ state]
=* path p.n.inbox
@ -315,7 +315,7 @@
:: +diff-chat-update: get new mailboxes & messages
::
++ diff-chat-update
|= [=wire upd=chat-update]
|= [=wire upd=update:store]
^- (quip card _state)
?+ -.upd [~ state]
%create (notice-create (path-to-target path.upd))
@ -325,7 +325,7 @@
==
::
++ read-envelopes
|= [=target envs=(list envelope)]
|= [=target envs=(list envelope:store)]
^- (quip card _state)
?~ envs [~ state]
=^ cards-i state (read-envelope target i.envs)
@ -411,7 +411,7 @@
:: +read-envelope: add envelope to state and show it to user
::
++ read-envelope
|= [=target =envelope]
|= [=target =envelope:store]
^- (quip card _state)
?: (~(has in known) [target uid.envelope])
::NOTE we no-op only because edits aren't possible
@ -851,7 +851,7 @@
%channel %channel
?(%village %village-with-group) %village
==
?^ (scry-for (unit mailbox) %chat-store [%mailbox real-path])
?^ (scry-for (unit mailbox:store) %chat-store [%mailbox real-path])
=- [[- ~] state]
%- print:sh-out
"{(spud path)} already exists!"
@ -862,7 +862,7 @@
=- [[- moz] state]
%^ act %do-create %chat-view
:- %chat-view-action
!> ^- chat-view-action
!> ^- action:view
:* %create
(rsh 3 1 (spat path))
''
@ -880,7 +880,7 @@
=- [[- ~] state]
%^ act %do-delete %chat-view
:- %chat-view-action
!> ^- chat-view-action
!> ^- action:view
[%delete (target-to-path | our-self path)]
:: +change-permission: modify permissions on a local chat
::
@ -939,7 +939,7 @@
:: gives ugly %chat-hook-reap
%^ act %do-join %chat-view
:- %chat-view-action
!> ^- chat-view-action
!> ^- action:view
[%join ship.target (target-to-path target) (fall ask-history %.y)]
:: +leave: unsync & destroy mailbox
::
@ -952,12 +952,12 @@
"can't ;leave local chats, maybe use ;delete instead"
%^ act %do-leave %chat-hook
:- %chat-hook-action
!> ^- chat-hook-action
!> ^- action:hook
[%remove (target-to-path target)]
:: +say: send messages
::
++ say
|= =letter
|= =letter:store
^- (quip card _state)
~! bowl
=/ =serial (shaf %msg-uid eny.bowl)
@ -967,7 +967,7 @@
|= =target
%^ act %out-message %chat-hook
:- %chat-action
!> ^- chat-action
!> ^- action:store
:+ %message (target-to-path target)
[serial *@ our-self now.bowl letter]
:: +eval: run hoon, send code and result as message
@ -976,7 +976,7 @@
::
++ eval
|= [txt=cord exe=hoon]
(say %code txt (eval:chat-eval bowl exe))
(say %code txt (eval:store bowl exe))
:: +lookup-glyph: print glyph info for all, glyph or target
::
++ lookup-glyph
@ -1188,7 +1188,7 @@
:: and the %notify flag is set, emit a bell.
::
++ show-envelope
|= [=target =envelope]
|= [=target =envelope:store]
^- (list card)
%+ weld
^- (list card)
@ -1309,7 +1309,7 @@
::
++ mr
|_ $: source=target
envelope
envelope:store
==
:: +activate: produce sole-effect for printing message details
::

103
pkg/arvo/app/chat-hook.hoon
View File

@ -2,9 +2,11 @@
:: mirror chat data from foreign to local based on read permissions
:: allow sending chat messages to foreign paths based on write perms
::
/- *permission-store, *chat-hook, *invite-store, *metadata-store,
*permission-hook, *group-store, *permission-group-hook ::TMP for upgrade
/+ *chat-json, *chat-eval, default-agent, verb, dbug
/- *permission-store, *invite-store, *metadata-store,
*permission-hook, *group-store, *permission-group-hook, ::TMP for upgrade
hook=chat-hook,
view=chat-view
/+ default-agent, verb, dbug, store=chat-store
~% %chat-hook-top ..is ~
|%
+$ card card:agent:gall
@ -21,20 +23,20 @@
==
+$ state-0 [%0 state-base]
+$ state-base
$: =synced
$: =synced:hook
invite-created=_|
allow-history=(map path ?)
==
::
+$ poke
$% [%chat-action chat-action]
$% [%chat-action action:store]
[%permission-action permission-action]
[%invite-action invite-action]
[%chat-view-action chat-view-action]
[%chat-view-action action:view]
==
::
+$ fact
$% [%chat-update chat-update]
$% [%chat-update update:store]
==
--
=| state-1
@ -108,8 +110,8 @@
++ recreate-chat
|= [host=ship chat=path new-chat=path]
^- (list card)
=/ old-mailbox=mailbox
(need (scry:cc (unit mailbox) %chat-store [%mailbox chat]))
=/ old-mailbox=mailbox:store
(need (scry:cc (unit mailbox:store) %chat-store [%mailbox chat]))
=* enves envelopes.old-mailbox
:~ (chat-poke:cc [%delete new-chat])
(chat-poke:cc [%delete chat])
@ -117,7 +119,7 @@
(chat-poke:cc [%messages new-chat enves])
(chat-poke:cc [%read new-chat])
%^ make-poke %chat-hook %chat-hook-action
!> ^- chat-hook-action
!> ^- action:hook
?: =(our.bol host) [%add-owned new-chat %.y]
[%add-synced host new-chat %.y]
==
@ -230,14 +232,14 @@
=^ cards state
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(chat-action vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
%noun
?: =(%store-load q.vase)
[loaded-cards.state state(loaded-cards ~)]
[~ state]
::
%chat-hook-action
(poke-chat-hook-action:cc !<(chat-hook-action vase))
(poke-chat-hook-action:cc !<(action:hook vase))
==
[cards this]
::
@ -270,7 +272,7 @@
?+ p.cage.sign (on-agent:def wire sign)
%chat-update
=^ cards state
(fact-chat-update:cc wire !<(chat-update q.cage.sign))
(fact-chat-update:cc wire !<(update:store q.cage.sign))
[cards this]
::
%invite-update
@ -298,10 +300,10 @@
++ poke-json
|= jon=json
^- (quip card _state)
(poke-chat-action (json-to-action jon))
(poke-chat-action (action:dejs:store jon))
::
++ poke-chat-action
|= act=chat-action
|= act=action:store
^- (quip card _state)
?> ?=(%message -.act)
:: local
@ -312,7 +314,7 @@
=* letter letter.envelope.act
=? letter &(?=(%code -.letter) ?=(~ output.letter))
=/ =hoon (ream expression.letter)
letter(output (eval bol hoon))
letter(output (eval:store bol hoon))
=/ ship (~(got by synced) path.act)
=/ appl ?:(=(ship our.bol) %chat-store %chat-hook)
[%pass / %agent [ship appl] %poke %chat-action !>(act)]~
@ -328,7 +330,7 @@
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]~
::
++ poke-chat-hook-action
|= act=chat-hook-action
|= act=action:hook
^- (quip card _state)
?- -.act
%add-owned
@ -352,7 +354,7 @@
=/ chat-path [%mailbox path.act]
:_ state
[%pass chat-path %agent [ship.act %chat-hook] %watch chat-path]~
=/ mailbox=(unit mailbox) (chat-scry path.act)
=/ mailbox=(unit mailbox:store) (chat-scry path.act)
=/ chat-history=path
:- %backlog
%+ weld path.act
@ -484,72 +486,72 @@
--
::
++ fact-chat-update
|= [wir=wire fact=chat-update]
|= [wir=wire =update:store]
^- (quip card _state)
?: (team:title our.bol src.bol)
(handle-local fact)
(handle-foreign fact)
(handle-local update)
(handle-foreign update)
::
++ handle-local
|= fact=chat-update
|= =update:store
^- (quip card _state)
?+ -.fact [~ state]
?+ -.update [~ state]
%delete
?. (~(has by synced) path.fact) [~ state]
=. synced (~(del by synced) path.fact)
?. (~(has by synced) path.update) [~ state]
=. synced (~(del by synced) path.update)
:_ state
:~ [%pass [%mailbox path.fact] %agent [our.bol %chat-store] %leave ~]
:~ [%pass [%mailbox path.update] %agent [our.bol %chat-store] %leave ~]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%message
:_ state
[%give %fact [%mailbox path.fact]~ %chat-update !>(fact)]~
[%give %fact [%mailbox path.update]~ %chat-update !>(update)]~
::
%messages
:_ state
[%give %fact [%mailbox path.fact]~ %chat-update !>(fact)]~
[%give %fact [%mailbox path.update]~ %chat-update !>(update)]~
==
::
++ handle-foreign
|= fact=chat-update
|= =update:store
^- (quip card _state)
?+ -.fact [~ state]
?+ -.update [~ state]
%create
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%create path.fact])]~
[(chat-poke [%create path.update])]~
::
%delete
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp [~ state]
?. =(u.shp src.bol) [~ state]
=. synced (~(del by synced) path.fact)
=. synced (~(del by synced) path.update)
:_ state
:- (chat-poke [%delete path.fact])
:~ [%pass [%mailbox path.fact] %agent [src.bol %chat-hook] %leave ~]
:- (chat-poke [%delete path.update])
:~ [%pass [%mailbox path.update] %agent [src.bol %chat-hook] %leave ~]
[%give %fact [/synced]~ %chat-hook-update !>([%initial synced])]
==
::
%message
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%message path.fact envelope.fact])]~
[(chat-poke [%message path.update envelope.update])]~
::
%messages
:_ state
?> ?=([* ^] path.fact)
=/ shp (~(get by synced) path.fact)
?> ?=([* ^] path.update)
=/ shp (~(get by synced) path.update)
?~ shp ~
?. =(src.bol u.shp) ~
[(chat-poke [%messages path.fact envelopes.fact])]~
[(chat-poke [%messages path.update envelopes.update])]~
==
::
++ kick
@ -564,7 +566,8 @@
~& store-kick+wir
?. (~(has by synced) t.wir) [~ state]
~& %chat-store-resubscribe
=/ mailbox=(unit mailbox) (chat-scry t.wir)
=/ mailbox=(unit mailbox:store)
(chat-scry t.wir)
:_ state
[%pass wir %agent [our.bol %chat-store] %watch [%mailbox t.wir]]~
::
@ -573,7 +576,7 @@
?. (~(has by synced) t.wir) [~ state]
~& %chat-hook-resubscribe
=/ =ship (~(got by synced) t.wir)
=/ mailbox=(unit mailbox) (chat-scry t.wir)
=/ mailbox=(unit mailbox:store) (chat-scry t.wir)
=/ chat-history
%+ welp backlog+t.wir
?~(mailbox /0 /(scot %ud (lent envelopes.u.mailbox)))
@ -612,12 +615,12 @@
==
::
++ chat-poke
|= act=chat-action
|= act=action:store
^- card
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
::
++ chat-view-poke
|= act=chat-view-action
|= act=action:view
^- card
[%pass / %agent [our.bol %chat-view] %poke %chat-view-action !>(act)]
::
@ -633,8 +636,8 @@
::
++ chat-scry
|= pax=path
^- (unit mailbox)
%^ scry (unit mailbox)
^- (unit mailbox:store)
%^ scry (unit mailbox:store)
%chat-store
[%mailbox pax]
::

89
pkg/arvo/app/chat-store.hoon
View File

@ -1,6 +1,6 @@
:: chat-store: data store that holds linear sequences of chat messages
::
/+ *chat-json, *chat-eval, default-agent, verb, dbug
/+ store=chat-store, default-agent, verb, dbug
~% %chat-store-top ..is ~
|%
+$ card card:agent:gall
@ -10,14 +10,14 @@
state-two
==
::
+$ state-zero [%0 =inbox]
+$ state-one [%1 =inbox]
+$ state-two [%2 =inbox]
+$ state-zero [%0 =inbox:store]
+$ state-one [%1 =inbox:store]
+$ state-two [%2 =inbox:store]
::
+$ diff
$% [%chat-initial inbox]
[%chat-configs chat-configs]
[%chat-update chat-update]
$% [%chat-initial inbox:store]
[%chat-configs configs:store]
[%chat-update update:store]
==
--
::
@ -42,10 +42,10 @@
=/ old !<(versioned-state old-vase)
?: ?=(%2 -.old)
[~ this(state old)]
=/ reversed-inbox=^inbox
=/ reversed-inbox=inbox:store
%- ~(run by inbox.old)
|= =mailbox
^- ^mailbox
|= =mailbox:store
^- mailbox:store
[config.mailbox (flop envelopes.mailbox)]
[~ this(state [%2 reversed-inbox])]
::
@ -57,7 +57,7 @@
=^ cards state
?+ mark (on-poke:def mark vase)
%json (poke-json:cc !<(json vase))
%chat-action (poke-chat-action:cc !<(chat-action vase))
%chat-action (poke-chat-action:cc !<(action:store vase))
==
[cards this]
::
@ -71,7 +71,7 @@
?+ path (on-watch:def path)
[%keys ~] (give %chat-update !>([%keys ~(key by inbox)]))
[%all ~] (give %chat-initial !>(inbox))
[%configs ~] (give %chat-configs !>((inbox-to-configs inbox)))
[%configs ~] (give %chat-configs !>((inbox-to-configs:store inbox)))
[%updates ~] ~
[%mailbox @ *]
?> (~(has by inbox) t.path)
@ -92,7 +92,7 @@
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %all ~] ``noun+!>(inbox)
[%x %configs ~] ``noun+!>((inbox-to-configs inbox))
[%x %configs ~] ``noun+!>((inbox-to-configs:store inbox))
[%x %keys ~] ``noun+!>(~(key by inbox))
[%x %envelopes *] (peek-x-envelopes:cc t.t.path)
[%x %mailbox *]
@ -159,10 +159,10 @@
++ poke-json
|= jon=json
^- (quip card _state)
(poke-chat-action (json-to-action jon))
(poke-chat-action (action:dejs:store jon))
::
++ poke-chat-action
|= action=chat-action
|= =action:store
^- (quip card _state)
?- -.action
%create (handle-create action)
@ -178,43 +178,46 @@
==
::
++ handle-create
|= act=chat-action
|= =action:store
^- (quip card _state)
?> ?=(%create -.act)
?: (~(has by inbox) path.act) [~ state]
:- (send-diff path.act act)
state(inbox (~(put by inbox) path.act *mailbox))
?> ?=(%create -.action)
?: (~(has by inbox) path.action) [~ state]
:- (send-diff path.action action)
state(inbox (~(put by inbox) path.action *mailbox:store))
::
++ handle-delete
|= act=chat-action
|= =action:store
^- (quip card _state)
?> ?=(%delete -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
?> ?=(%delete -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
?~ mailbox [~ state]
:- (send-diff path.act act)
state(inbox (~(del by inbox) path.act))
:- (send-diff path.action action)
state(inbox (~(del by inbox) path.action))
::
++ handle-message
|= act=chat-action
|= =action:store
^- (quip card _state)
?> ?=(%message -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
?> ?=(%message -.action)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.action)
?~ mailbox
[~ state]
=. letter.envelope.act (evaluate-letter [author letter]:envelope.act)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.act)
:- (send-diff path.act act(envelope envelope))
state(inbox (~(put by inbox) path.act u.mailbox))
=. letter.envelope.action (evaluate-letter [author letter]:envelope.action)
=^ envelope u.mailbox (prepend-envelope u.mailbox envelope.action)
:- (send-diff path.action action(envelope envelope))
state(inbox (~(put by inbox) path.action u.mailbox))
::
++ handle-messages
|= act=chat-action
|= act=action:store
^- (quip card _state)
?> ?=(%messages -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
=/ mailbox=(unit mailbox:store)
(~(get by inbox) path.act)
?~ mailbox
[~ state]
=. envelopes.act (flop envelopes.act)
=/ evaluated-envelopes=(list envelope) ~
=| evaluated-envelopes=(list envelope:store)
|- ^- (quip card _state)
?~ envelopes.act
:_ state(inbox (~(put by inbox) path.act u.mailbox))
@ -226,10 +229,10 @@
$(envelopes.act t.envelopes.act)
::
++ handle-read
|= act=chat-action
|= act=action:store
^- (quip card _state)
?> ?=(%read -.act)
=/ mailbox=(unit mailbox) (~(get by inbox) path.act)
=/ mailbox=(unit mailbox:store) (~(get by inbox) path.act)
?~ mailbox
[~ state]
=. read.config.u.mailbox length.config.u.mailbox
@ -237,19 +240,19 @@
state(inbox (~(put by inbox) path.act u.mailbox))
::
++ evaluate-letter
|= [author=ship =letter]
^- ^letter
|= [author=ship =letter:store]
^- letter:store
=? letter
?& ?=(%code -.letter)
?=(~ output.letter)
(team:title our.bol author)
==
=/ =hoon (ream expression.letter)
letter(output (eval bol hoon))
letter(output (eval:store bol hoon))
letter
::
++ prepend-envelope
|= [=mailbox =envelope]
|= [=mailbox:store =envelope:store]
^+ [envelope mailbox]
=. number.envelope +(length.config.mailbox)
=: length.config.mailbox +(length.config.mailbox)
@ -258,12 +261,12 @@
[envelope mailbox]
::
++ update-subscribers
|= [pax=path update=chat-update]
|= [pax=path =update:store]
^- (list card)
[%give %fact ~[pax] %chat-update !>(update)]~
::
++ send-diff
|= [pax=path upd=chat-update]
|= [pax=path upd=update:store]
^- (list card)
%- zing
:~ (update-subscribers /all upd)

61
pkg/arvo/app/chat-view.hoon
View File

@ -8,8 +8,12 @@
*metadata-store,
*permission-group-hook,
*chat-hook,
*metadata-hook
/+ *server, *chat-json, default-agent, verb, dbug
*metadata-hook,
*rw-security,
hook=chat-hook
/+ *server, default-agent, verb, dbug,
store=chat-store,
view=chat-view
/= index
/^ octs
/; as-octs:mimes:html
@ -48,9 +52,9 @@
::
+$ poke
$% [%launch-action [@tas path @t]]
[%chat-action chat-action]
[%chat-action action:store]
[%group-action group-action]
[%chat-hook-action chat-hook-action]
[%chat-hook-action action:hook]
[%permission-hook-action permission-hook-action]
[%permission-group-hook-action permission-group-hook-action]
==
@ -89,11 +93,11 @@
::
%json
:_ this
(poke-chat-view-action:cc (json-to-view-action !<(json vase)))
(poke-chat-view-action:cc (action:dejs:view !<(json vase)))
::
%chat-view-action
:_ this
(poke-chat-view-action:cc !<(chat-view-action vase))
(poke-chat-view-action:cc !<(action:view vase))
==
::
++ on-watch
@ -108,7 +112,7 @@
:: create inbox with 20 messages max per mailbox and send that along
:: then quit the subscription
:_ this
[%give %fact ~ %json !>((inbox-to-json truncated-inbox-scry))]~
[%give %fact ~ %json !>((inbox:enjs:store truncated-inbox-scry))]~
?: =(/configs path)
[[%give %fact ~ %json !>(*json)]~ this]
(on-watch:def path)
@ -116,11 +120,12 @@
++ message-limit 20
::
++ truncated-inbox-scry
^- inbox
=/ =inbox .^(inbox %gx /=chat-store/(scot %da now.bol)/all/noun)
^- inbox:store
=/ =inbox:store
.^(inbox:store %gx /=chat-store/(scot %da now.bol)/all/noun)
%- ~(run by inbox)
|= =mailbox
^- ^mailbox
|= =mailbox:store
^- mailbox:store
[config.mailbox (scag message-limit envelopes.mailbox)]
--
::
@ -137,7 +142,7 @@
?+ p.cage.sign (on-agent:def wire sign)
%chat-update
:_ this
(diff-chat-update:cc !<(chat-update q.cage.sign))
(diff-chat-update:cc !<(update:store q.cage.sign))
==
==
::
@ -183,7 +188,7 @@
=/ envelopes (envelope-scry [(scot %ud start) (scot %ud end) pax])
%- json-response:gen
%- json-to-octs
%- update-to-json
%- update:enjs:store
[%messages pax start end envelopes]
::
[%'~chat' *] (html-response:gen index)
@ -193,10 +198,10 @@
|= jon=json
^- (list card)
?> (team:title our.bol src.bol)
(poke-chat-view-action (json-to-view-action jon))
(poke-chat-view-action (action:dejs:view jon))
::
++ poke-chat-view-action
|= act=chat-view-action
|= act=action:view
^- (list card)
|^
?> (team:title our.bol src.bol)
@ -260,8 +265,8 @@
?> ?=([%'~' ^] app-path.act)
:: retrieve old data
::
=/ data=(unit mailbox)
(scry-for (unit mailbox) %chat-store [%mailbox app-path.act])
=/ data=(unit mailbox:store)
(scry-for (unit mailbox:store) %chat-store [%mailbox app-path.act])
?~ data
~& [%cannot-groupify-nonexistent app-path.act]
~
@ -421,9 +426,9 @@
::
++ chat-scry
|= pax=path
^- (unit mailbox)
^- (unit mailbox:store)
=. pax ;:(weld /=chat-store/(scot %da now.bol)/mailbox pax /noun)
.^((unit mailbox) %gx pax)
.^((unit mailbox:store) %gx pax)
::
++ maybe-group-from-chat
|= app-path=path
@ -478,10 +483,10 @@
--
::
++ diff-chat-update
|= upd=chat-update
|= upd=update:store
^- (list card)
=/ updates-json (update-to-json upd)
=/ configs-json (configs-to-json configs-scry)
=/ updates-json (update:enjs:store upd)
=/ configs-json (configs:enjs:store configs-scry)
:~ [%give %fact ~[/primary] %json !>(updates-json)]
[%give %fact ~[/configs] %json !>(configs-json)]
==
@ -489,7 +494,7 @@
:: +utilities
::
++ chat-poke
|= act=chat-action
|= act=action:store
^- card
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
::
@ -504,7 +509,7 @@
[%pass / %agent [our.bol %permission-store] %poke %permission-action !>(act)]
::
++ chat-hook-poke
|= act=chat-hook-action
|= act=action:hook
^- card
[%pass / %agent [our.bol %chat-hook] %poke %chat-hook-action !>(act)]
::
@ -524,12 +529,12 @@
::
++ envelope-scry
|= pax=path
^- (list envelope)
(scry-for (list envelope) %chat-store [%envelopes pax])
^- (list envelope:store)
(scry-for (list envelope:store) %chat-store [%envelopes pax])
::
++ configs-scry
^- chat-configs
(scry-for chat-configs %chat-store /configs)
^- configs:store
(scry-for configs:store %chat-store /configs)
::
++ group-scry
|= pax=path

51
pkg/arvo/lib/chat-hook.hoon Normal file
View File

@ -0,0 +1,51 @@
/- sur=chat-hook
^?
=< [sur .]
=, sur
|%
::
++ enjs
|%
++ update
|= upd=^update
=, enjs:format
^- json
%+ frond %chat-hook-update
%- pairs
%+ turn ~(tap by synced.upd)
|= [pax=^path shp=^ship]
^- [cord json]
[(spat pax) s+(scot %p shp)]
--
++ dejs
|%
::
++ action
|= jon=json
^- ^action
=, dejs:format
=< (parse-json jon)
|%
::
++ parse-json
%- of
:~ [%add-owned add-owned]
[%add-synced add-synced]
[%remove pa]
==
::
++ add-owned
%- ot
:~ [%path pa]
[%allow-history bo]
==
::
++ add-synced
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%path pa]
[%ask-history bo]
==
--
--
--

301
pkg/arvo/lib/chat-json.hoon
View File

@ -1,301 +0,0 @@
/- *chat-store, *chat-hook, *chat-view
/+ chat-eval
|%
::
++ slan |=(mod/@tas |=(txt/@ta (need (slaw mod txt))))
::
++ seri ::: serial
=, dejs:format
^- $-(json serial)
(cu (slan %uv) so)
::
++ re :: recursive reparsers
|* {gar/* sef/_|.(fist:dejs-soft:format)}
|= jon/json
^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ dank :: tank
^- $-(json (unit tank))
=, ^? dejs-soft:format
%+ re *tank |. ~+
%- of :~
leaf+sa
palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~)
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
::
++ eval ::: %exp speech
::: extract contents of an %exp speech, evaluating
::: the {exp} if there is no {res} yet.
::
|= a=json
^- [cord (list tank)]
=, ^? dejs-soft:format
=+ exp=((ot expression+so ~) a)
%- need
?~ exp [~ '' ~]
:+ ~ u.exp
::NOTE when sending, if output is an empty list, chat-store will evaluate
(fall ((ot output+(ar dank) ~) a) ~)
::
++ lett
=, enjs:format
|= =letter
^- json
=; result=(each json tang)
?- -.result
%& p.result
%| (frond %text s+'[[json rendering error]]')
==
%- mule
|.
?- -.letter
%text
(frond %text s+text.letter)
::
%url
(frond %url s+url.letter)
::
%code
%+ frond %code
%- pairs
:~ [%expression s+expression.letter]
[%output a+(turn output.letter tank)]
==
::
%me
(frond %me s+narrative.letter)
::
==
::
++ enve
|= =envelope
^- json
=, enjs:format
%- pairs
:~ [%uid s+(scot %uv uid.envelope)]
[%number (numb number.envelope)]
[%author (ship author.envelope)]
[%when (time when.envelope)]
[%letter (lett letter.envelope)]
==
::
++ conf
|= =config
^- json
=, enjs:format
%- pairs
:~ [%length (numb length.config)]
[%read (numb read.config)]
==
::
++ inbox-to-configs
|= =inbox
^- chat-configs
%- ~(run by inbox)
|= =mailbox
^- config
config.mailbox
::
++ configs-to-json
|= cfg=chat-configs
=, enjs:format
^- json
%+ frond %chat-configs
%- pairs
%+ turn ~(tap by cfg)
|= [pax=^path =config]
^- [cord json]
[(spat pax) (conf config)]
::
++ inbox-to-json
|= box=inbox
=, enjs:format
^- json
%+ frond %chat-initial
%- pairs
%+ turn ~(tap by box)
|= [pax=^path =mailbox]
^- [cord json]
:- (spat pax)
%- pairs
:~ [%envelopes [%a (turn envelopes.mailbox enve)]]
[%config (conf config.mailbox)]
==
::
++ hook-update-to-json
|= upd=chat-hook-update
=, enjs:format
^- json
%+ frond %chat-hook-update
%- pairs
%+ turn ~(tap by synced.upd)
|= [pax=^path shp=^ship]
^- [cord json]
[(spat pax) s+(scot %p shp)]
::
++ update-to-json
|= upd=chat-update
=, enjs:format
^- json
%+ frond %chat-update
%- pairs
:~
?: ?=(%message -.upd)
:- %message
%- pairs
:~ [%path (path path.upd)]
[%envelope (enve envelope.upd)]
==
?: ?=(%messages -.upd)
:- %messages
%- pairs
:~ [%path (path path.upd)]
[%start (numb start.upd)]
[%end (numb end.upd)]
[%envelopes [%a (turn envelopes.upd enve)]]
==
?: ?=(%read -.upd)
[%read (pairs [%path (path path.upd)]~)]
?: ?=(%create -.upd)
[%create (pairs [%path (path path.upd)]~)]
?: ?=(%delete -.upd)
[%delete (pairs [%path (path path.upd)]~)]
?: ?=(%config -.upd)
:- %config
%- pairs
:~ [%path (path path.upd)]
[%config (conf config.upd)]
==
[*@t *^json]
==
::
++ json-to-action
|= jon=json
^- chat-action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%message message]
[%messages messages]
[%read read]
==
::
++ create
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
::
++ message
%- ot
:~ [%path pa]
[%envelope envelope]
==
::
++ messages
%- ot
:~ [%path pa]
[%envelopes (ar envelope)]
==
::
++ read
(ot [%path pa] ~)
::
++ envelope
%- ot
:~ [%uid seri]
[%number ni]
[%author (su ;~(pfix sig fed:ag))]
[%when di]
[%letter letter]
==
::
++ letter
%- of
:~ [%text so]
[%url so]
[%code eval]
[%me so]
==
::
--
::
++ json-to-hook-action
|= jon=json
^- chat-hook-action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%add-owned add-owned]
[%add-synced add-synced]
[%remove pa]
==
::
++ add-owned
%- ot
:~ [%path pa]
[%allow-history bo]
==
::
++ add-synced
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%path pa]
[%ask-history bo]
==
--
::
++ json-to-view-action
|= jon=json
^- chat-view-action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%join join]
[%groupify groupify]
==
::
++ create
%- ot
:~ [%title so]
[%description so]
[%app-path pa]
[%group-path pa]
[%security sec]
[%members (as (su ;~(pfix sig fed:ag)))]
[%allow-history bo]
==
::
++ delete
(ot [%app-path pa]~)
::
++ join
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%app-path pa]
[%ask-history bo]
==
::
++ groupify
=- (ot [%app-path pa] [%existing -] ~)
(mu (ot [%group-path pa] [%inclusive bo] ~))
::
++ sec
=, dejs:format
^- $-(json rw-security)
(su (perk %channel %village %journal %mailbox ~))
--
--

233
pkg/arvo/lib/chat-store.hoon Normal file
View File

@ -0,0 +1,233 @@
/- sur=chat-store
^?
=< [sur .]
=, sur
|%
++ enjs
=, enjs:format
|%
::
++ letter
|= =^letter
^- json
?- -.letter
%text
(frond %text s+text.letter)
::
%url
(frond %url s+url.letter)
::
%code
%+ frond %code
%- pairs
:~ [%expression s+expression.letter]
[%output a+(turn output.letter tank)]
==
::
%me
(frond %me s+narrative.letter)
::
==
::
++ envelope
|= =^envelope
^- json
%- pairs
:~ [%uid s+(scot %uv uid.envelope)]
[%number (numb number.envelope)]
[%author (ship author.envelope)]
[%when (time when.envelope)]
[%letter (letter letter.envelope)]
==
::
++ config
|= =^config
^- json
%- pairs
:~ [%length (numb length.config)]
[%read (numb read.config)]
==
::
++ configs
|= cfg=^configs
^- json
%+ frond %chat-configs
%- pairs
%+ turn ~(tap by cfg)
|= [pax=^path =^config]
^- [cord json]
[(spat pax) (^config config)]
::
++ inbox
|= box=^inbox
^- json
%+ frond %chat-initial
%- pairs
%+ turn ~(tap by box)
|= [pax=^path =mailbox]
^- [cord json]
:- (spat pax)
%- pairs
:~ [%envelopes [%a (turn envelopes.mailbox envelope)]]
[%config (config config.mailbox)]
==
::
++ update
|= upd=^update
^- json
%+ frond %chat-update
%- pairs
:~
?: ?=(%message -.upd)
:- %message
%- pairs
:~ [%path (path path.upd)]
[%envelope (envelope envelope.upd)]
==
?: ?=(%messages -.upd)
:- %messages
%- pairs
:~ [%path (path path.upd)]
[%start (numb start.upd)]
[%end (numb end.upd)]
[%envelopes [%a (turn envelopes.upd envelope)]]
==
?: ?=(%read -.upd)
[%read (pairs [%path (path path.upd)]~)]
?: ?=(%create -.upd)
[%create (pairs [%path (path path.upd)]~)]
?: ?=(%delete -.upd)
[%delete (pairs [%path (path path.upd)]~)]
?: ?=(%config -.upd)
:- %config
%- pairs
:~ [%path (path path.upd)]
[%config (config config.upd)]
==
[*@t *json]
==
--
++ dejs
=, dejs:format
|%
::
++ action
|= jon=json
^- ^action
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%message message]
[%messages messages]
[%read read]
==
::
++ create
(ot [%path pa]~)
::
++ delete
(ot [%path pa]~)
::
++ message
%- ot
:~ [%path pa]
[%envelope envelope]
==
::
++ messages
%- ot
:~ [%path pa]
[%envelopes (ar envelope)]
==
::
++ read
(ot [%path pa] ~)
::
++ envelope
%- ot
:~ [%uid serial]
[%number ni]
[%author (su ;~(pfix sig fed:ag))]
[%when di]
[%letter letter]
==
::
++ letter
%- of
:~ [%text so]
[%url so]
[%code eval]
[%me so]
==
::
++ serial
^- $-(json ^serial)
(cu (cury slav %uv) so)
::
++ re :: recursive reparsers
|* {gar/* sef/_|.(fist:dejs-soft:format)}
|= jon/json
^- (unit _gar)
=- ~! gar ~! (need -) -
((sef) jon)
::
++ dank :: tank
^- $-(json (unit tank))
=, ^? dejs-soft:format
%+ re *tank |. ~+
%- of :~
leaf+sa
palm+(ot style+(ot mid+sa cap+sa open+sa close+sa ~) lines+(ar dank) ~)
rose+(ot style+(ot mid+sa open+sa close+sa ~) lines+(ar dank) ~)
==
:: %exp speech
++ eval
::: extract contents of an %exp speech, evaluating
::: the {exp} if there is no {res} yet.
::
|= a=json
^- [cord (list tank)]
=, ^? dejs-soft:format
=+ exp=((ot expression+so ~) a)
%- need
?~ exp [~ '' ~]
:+ ~ u.exp
::NOTE when sending, if output is an empty list, chat-store will evaluate
(fall ((ot output+(ar dank) ~) a) ~)
::
--
--
::
++ inbox-to-configs
|= =inbox
^- configs
%- ~(run by inbox)
|= =mailbox
^- config
config.mailbox
::
++ eval
|= [=bowl:gall =hoon]
^- (list tank)
=/ fowl=[our=@p now=@da eny=@uvJ]
:+ our.bowl
now.bowl
(shaz (cat 3 (mix [now eny]:bowl) %eny))
::
=/ subject [fowl ..zuse]
=/ minted=(each [=type =nock] (list tank))
%- mule |.
(~(mint ut -:!>(subject)) %noun hoon)
?: ?=(%| -.minted) p.minted
=/ =toon
(mock [subject nock.p.minted] |=(^ ~))
?- -.toon
%0 [(sell type.p.minted p.toon) ~]
%1 :- leaf+".^ unsupported in chat eval"
(turn ;;((list path) p.toon) smyt)
%2 [leaf+"crash!" p.toon]
==
--

53
pkg/arvo/lib/chat-view.hoon Normal file
View File

@ -0,0 +1,53 @@
/- sur=chat-view, *rw-security
^?
=< [sur .]
=, sur
|%
++ dejs
|%
++ action
|= jon=json
^- ^action
=, dejs:format
=< (parse-json jon)
|%
++ parse-json
%- of
:~ [%create create]
[%delete delete]
[%join join]
[%groupify groupify]
==
::
++ create
%- ot
:~ [%title so]
[%description so]
[%app-path pa]
[%group-path pa]
[%security sec]
[%members (as (su ;~(pfix sig fed:ag)))]
[%allow-history bo]
==
::
++ delete
(ot [%app-path pa]~)
::
++ join
%- ot
:~ [%ship (su ;~(pfix sig fed:ag))]
[%app-path pa]
[%ask-history bo]
==
::
++ groupify
=- (ot [%app-path pa] [%existing -] ~)
(mu (ot [%group-path pa] [%inclusive bo] ~))
::
++ sec
=, dejs:format
^- $-(json rw-security)
(su (perk %channel %village %journal %mailbox ~))
--
--
--

23
pkg/arvo/lib/chat/eval.hoon
View File

@ -1,23 +0,0 @@
|%
++ eval
|= [=bowl:gall =hoon]
^- (list tank)
=/ fowl=[our=@p now=@da eny=@uvJ]
:+ our.bowl
now.bowl
(shaz (cat 3 (mix [now eny]:bowl) %eny))
::
=/ subject [fowl ..zuse]
=/ minted=(each [=type =nock] (list tank))
%- mule |.
(~(mint ut -:!>(subject)) %noun hoon)
?: ?=(%| -.minted) p.minted
=/ =toon
(mock [subject nock.p.minted] |=(^ ~))
?- -.toon
%0 [(sell type.p.minted p.toon) ~]
%1 :- leaf+".^ unsupported in chat eval"
(turn ;;((list path) p.toon) smyt)
%2 [leaf+"crash!" p.toon]
==
--

11
pkg/arvo/mar/chat/action.hoon
View File

@ -1,11 +1,8 @@
/+ *chat-json
=, dejs:format
|_ act=chat-action
/+ *chat-store
|_ act=action
++ grab
|%
++ noun chat-action
++ json
|= jon=^json
(json-to-action jon)
++ noun action
++ json action:dejs
--
--

4
pkg/arvo/mar/chat/config.hoon
View File

@ -1,9 +1,9 @@
/+ *chat-json
/+ *chat-store
|_ cfg=config
::
++ grow
|%
++ json (conf cfg)
++ json (config:enjs cfg)
--
::
++ grab

8
pkg/arvo/mar/chat/configs.hoon
View File

@ -1,14 +1,14 @@
/+ *chat-json
|_ cfg=(map path config)
/+ *chat-store
|_ cfg=configs
::
++ grow
|%
++ json (configs-to-json cfg)
++ json (configs:dejs cfg)
--
::
++ grab
|%
++ noun chat-configs
++ noun configs
--
::
--

10
pkg/arvo/mar/chat/hook-action.hoon
View File

@ -1,11 +1,9 @@
/+ *chat-json
|_ act=chat-hook-action
/+ *chat-hook
|_ act=action
++ grab
|%
++ noun chat-hook-action
++ json
|= jon=^json
(json-to-hook-action jon)
++ noun action
++ json action:dejs
--
--

8
pkg/arvo/mar/chat/hook-update.hoon
View File

@ -1,13 +1,13 @@
/+ *chat-json
|_ upd=chat-hook-update
/+ *chat-hook
|_ upd=update
++ grow
|%
++ json (hook-update-to-json upd)
++ json (update:enjs upd)
--
::
++ grab
|%
++ noun chat-hook-update
++ noun update
--
::
--

4
pkg/arvo/mar/chat/initial.hoon
View File

@ -1,9 +1,9 @@
/+ *chat-json
/+ *chat-store
|_ box=inbox
::
++ grow
|%
++ json (inbox-to-json box)
++ json (inbox:enjs box)
--
::
++ grab

8
pkg/arvo/mar/chat/update.hoon
View File

@ -1,13 +1,13 @@
/+ *chat-json
|_ upd=chat-update
/+ *chat-store
|_ upd=update
++ grow
|%
++ json (update-to-json upd)
++ json (update:enjs upd)
--
::
++ grab
|%
++ noun chat-update
++ noun update
--
::
--

11
pkg/arvo/mar/chat/view-action.hoon
View File

@ -1,11 +1,8 @@
/+ *chat-json
=, dejs:format
|_ act=chat-action
/+ *chat-view
|_ act=action
++ grab
|%
++ noun chat-view-action
++ json
|= jon=^json
(json-to-view-action jon)
++ noun action
++ json action:dejs
--
--

5
pkg/arvo/sur/chat-hook.hoon
View File

@ -1,7 +1,8 @@
/- *rw-security
^?
|%
+$ synced (map path ship)
+$ chat-hook-action
+$ action
$% :: %add-owned: make a chatroom accessible to foreign ships
::
[%add-owned =path allow-history=?]
@ -14,5 +15,5 @@
[%remove =path]
==
::
+$ chat-hook-update [%initial =synced]
+$ update [%initial =synced]
--

13
pkg/arvo/sur/chat-store.hoon
View File

@ -1,3 +1,4 @@
^?
|%
+$ serial @uvH
::
@ -28,26 +29,26 @@
::
+$ inbox (map path mailbox)
::
+$ chat-configs (map path config)
+$ configs (map path config)
::
+$ chat-base
+$ diff
$% [%create =path] :: %create: create a mailbox at path
[%delete =path] :: %delete: delete a mailbox at path
[%message =path =envelope] :: %message: append a message to mailbox
[%read =path] :: %read: set mailbox to read
==
::
+$ chat-action
+$ action
$% :: %messages: append a list of messages to mailbox
::
[%messages =path envelopes=(list envelope)]
chat-base
diff
==
::
+$ chat-update
+$ update
$% [%keys keys=(set path)]
[%config =path =config]
[%messages =path start=@ud end=@ud envelopes=(list envelope)]
chat-base
diff
==
--

3
pkg/arvo/sur/chat-view.hoon
View File

@ -1,6 +1,7 @@
/- *rw-security
^?
|%
+$ chat-view-action
+$ action
$% :: %create: create a new chat
::
:: if :app-path and :group-path are different, :members must be empty,