ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-09-20 15:08:34 +03:00
Code Issues Packages Projects Releases Wiki Activity

chat: update to new groups

Browse Source
This commit is contained in:
Liam Fitzgerald 2020-05-25 15:52:54 +10:00
parent f60181871a
commit 841ba72bd9
15 changed files with 337 additions and 272 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,10 +9,11 @@
:: we concat the ship onto the head of the path,
:: and trust it to take care of the rest.
::
/- view=chat-view, hook=chat-hook,
/- view=chat-view, hook=chat-hook, *group,
*permission-store, *group-store, *invite-store,
*rw-security, sole
/+ shoe, default-agent, verb, dbug, store=chat-store
sole
/+ shoe, default-agent, verb, dbug, store=chat-store,
group-store
::
|%
+$ card card:shoe
@ -743,10 +744,10 @@
=/ with-group=? ?=(%village-with-group security)
=/ =target [with-group our-self path]
=/ real-path=^path (target-to-path target)
=/ =rw-security
=/ =policy
?- security
%channel %channel
?(%village %village-with-group) %village
%channel *open:policy
?(%village %village-with-group) *invite:policy
==
?^ (scry-for (unit mailbox:store) %chat-store [%mailbox real-path])
=- [[- ~] state]
@ -765,7 +766,7 @@
''
real-path :: chat
real-path :: group
rw-security
policy
~
(fall allow-history %.y)
==
@ -798,29 +799,33 @@
:: but if they already were, we want to send an invite ourselves.
::
?. %^ scry-for ?
%permission-store
[%permitted (scot %p ship) real-path]
%group-store
%+ welp
real-path
/permitted/[(scot %p ship)]
~
`(invite-card real-path ship)
:: whitelist: empty if no matching permission, else true if whitelist
::
=/ whitelist=(unit ?)
=; perm=(unit permission)
?~(perm ~ `?=(%white kind.u.perm))
=; grp=(unit ^group)
?~(grp ~ `?=(%open -.u.grp))
::TODO +permission-of-target?
%^ scry-for (unit permission)
%permission-store
[%permission real-path]
%^ scry-for (unit ^group)
%group-store
`^path`[%groups real-path]
?~ whitelist
~& [%weird-no-permission real-path]
~
=/ =group-id
(need (group-id:de-path:group-store real-path))
%- some
%^ act %do-permission %group-store
:- %group-action
!> ^- group-action
!> ^- action:group-store
?: =(u.whitelist allow)
[%add ships real-path]
[%remove ships real-path]
[%add-members group-id ships ~]
[%remove-members group-id ships]
:: +join: sync with remote mailbox
::
++ join

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

@ -6,7 +6,7 @@
*permission-hook, *group-store, *permission-group-hook, ::TMP for upgrade
hook=chat-hook,
view=chat-view
/+ default-agent, verb, dbug, store=chat-store
/+ default-agent, verb, dbug, store=chat-store, group-store, grpl=group
~% %chat-hook-top ..is ~
|%
+$ card card:agent:gall
@ -170,8 +170,8 @@
?: =(our.bol host)
%^ make-poke %group-store
%group-action
!> ^- group-action
[%unbundle group]
!> ^- action:group-store
[%remove-group (need (group-id:de-path:group-store group)) ~]
:: else, just delete the sync in the hook
::
%^ make-poke %permission-hook
@ -182,15 +182,17 @@
++ create-group
|= [group=path who=(set ship)]
^- (list card)
=/ =group-id
(need (group-id:de-path:group-store group))
:~ %^ make-poke %group-store
%group-action
!> ^- group-action
[%bundle group]
!> ^- action:group-store
[%add-group group-id *invite:policy]
::
%^ make-poke %group-store
%group-action
!> ^- group-action
[%add who group]
!> ^- action:group-store
[%add-members group-id who ~]
==
::
++ hookup-group
@ -281,9 +283,9 @@
(fact-invite-update:cc wire !<(invite-update q.cage.sign))
[cards this]
::
%permission-update
%group-update
=^ cards state
(fact-permission-update:cc wire !<(permission-update q.cage.sign))
(fact-group-update:cc wire !<(update:group-store q.cage.sign))
[cards this]
==
==
@ -297,6 +299,7 @@
::
~% %chat-hook-library ..card ~
|_ bol=bowl:gall
++ grp ~(. grpl bol)
::
++ poke-json
|= jon=json
@ -324,7 +327,7 @@
?~ ship ~
?. =(u.ship our.bol) ~
:: check if write is permitted
?. (is-permitted src.bol path.act) ~
?. (is-permitted:grp src.bol path.act) ~
=: author.envelope.act src.bol
when.envelope.act now.bol
==
@ -398,7 +401,7 @@
?> ?=(^ pax)
?> (~(has by synced) pax)
:: check if read is permitted
?> (is-permitted src.bol pax)
?> (is-permitted:grp src.bol pax)
=/ box (chat-scry pax)
?~ box !!
[%give %fact ~ %chat-update !>([%create pax])]~
@ -412,7 +415,7 @@
=/ pas `path`(oust [last 1] `(list @ta)`pax)
?> ?=([* ^] pas)
?> (~(has by synced) pas)
?> (is-permitted src.bol pas)
?> (is-permitted:grp src.bol pas)
=/ envs envelopes:(need (chat-scry pas))
=/ length (lent envs)
=/ latest
@ -440,14 +443,18 @@
~[(chat-view-poke [%join shp app-path ask-history])]
==
::
++ fact-permission-update
|= [wir=wire fact=permission-update]
++ fact-group-update
|= [wir=wire =update:group-store]
^- (quip card _state)
|^
:_ state
?+ -.fact ~
%add (handle-permissions [%add path.fact who.fact])
%remove (handle-permissions [%remove path.fact who.fact])
?. ?=(?(%add-members %remove-members) -.update)
~
=/ =path
(group-id:en-path:group-store group-id.update)
?- -.update
%add-members (handle-permissions [%add path ships.update])
%remove-members (handle-permissions [%remove path ships.update])
==
::
++ handle-permissions
@ -464,8 +471,8 @@
%- zing
%+ turn ~(tap in who)
|= =ship
?: (is-permitted ship chat)
?: ?|(=(kind %remove) =(ship our.bol) (is-managed pax)) ~
?: (is-permitted:grp ship chat)
?: ?|(=(kind %remove) =(ship our.bol) (is-managed-path:grp pax)) ~
:: if ship has just been added to the permitted group,
:: send them an invite
~[(send-invite chat ship)]
@ -479,11 +486,6 @@
=/ act=invite-action [%invite /chat (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
::
++ is-managed
|= =path
^- ?
?> ?=(^ path)
!=(i.path '~')
--
::
++ fact-chat-update
@ -699,16 +701,6 @@
/resource-indices
==
::
::NOTE this assumes permission paths match group paths
++ is-permitted
|= [who=ship chat=path]
^- ?
%+ lien (groups-of-chat chat)
|= =group-path
%^ scry ?
%permission-store
[%permitted (scot %p who) group-path]
::
++ scry
|* [=mold app=term =path]
.^ mold

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

@ -3,9 +3,10 @@
::
/- *permission-store,
*permission-hook,
*group-store,
*group,
*invite-store,
*metadata-store,
group-hook,
*permission-group-hook,
*chat-hook,
*metadata-hook,
@ -13,7 +14,8 @@
hook=chat-hook
/+ *server, default-agent, verb, dbug,
store=chat-store,
view=chat-view
view=chat-view,
group-store
::
~% %chat-view-top ..is ~
|%
@ -24,6 +26,12 @@
+$ state-0
$: %0
~
+$ poke
$% [%chat-action chat-action]
[%group-action action:group-store]
[%chat-hook-action chat-hook-action]
[%permission-hook-action permission-hook-action]
[%permission-group-hook-action permission-group-hook-action]
==
::
+$ card card:agent:gall
@ -188,7 +196,7 @@
%- create-group
:* group-path.act
app-path.act
security.act
policy.act
members.act
title.act
description.act
@ -208,97 +216,36 @@
:: we aren't guaranteed to have metadata: the chat might have been
:: deleted by the host, which pushes metadata deletion down to us.
::
=/ group-path=(unit path)
(maybe-group-from-chat app-path.act)
?~ group-path ~
=* group u.group-path
=/ group=path
(group-from-chat app-path.act)
=/ =group-id
(need (group-id:de-path:group-store group))
%- zing
:~ ?. (is-creator group %chat app-path.act) ~
[(metadata-poke [%remove group [%chat app-path.act]])]~
::
?: (is-managed group) ~
:~ (group-poke [%unbundle group])
:~ (group-proxy-poke %remove-members group-id (sy our.bol ~))
(group-poke [%remove-group group-id ~])
(metadata-hook-poke [%remove group])
(metadata-store-poke [%remove group [%chat app-path.act]])
==
==
::
%join
:: joining unmanaged chat if we don't have the group already
=/ group-path
?. (is-managed app-path.act) app-path.act
(group-from-chat app-path.act)
:~ (chat-hook-poke [%add-synced ship.act app-path.act ask-history.act])
(permission-hook-poke [%add-synced ship.act group-path])
(fall (maybe-group-from-chat app-path.act) app-path.act)
=/ =group-id
(need (group-id:de-path:group-store group-path))
:~ (group-proxy-poke %add-members group-id (sy our.bol ~) ~)
(group-hook-poke %add group-id)
(chat-hook-poke [%add-synced ship.act app-path.act ask-history.act])
(metadata-hook-poke [%add-synced ship.act group-path])
==
::
%groupify
?> ?=([%'~' ^] app-path.act)
:: retrieve old data
::
=/ data=(unit mailbox:store)
(scry-for (unit mailbox:store) %chat-store [%mailbox app-path.act])
?~ data
~& [%cannot-groupify-nonexistent app-path.act]
~
=/ permission=(unit permission)
(scry-for (unit permission) %permission-store [%permission app-path.act])
?: |(?=(~ permission) ?=(%black kind.u.permission))
~& [%cannot-groupify-blacklist app-path.act]
~
=/ =metadata
=- (fall - *metadata)
%^ scry-for (unit metadata)
%metadata-store
=/ encoded-path=@ta
(scot %t (spat app-path.act))
/metadata/[encoded-path]/chat/[encoded-path]
:: figure out new data
::
=/ chat-path=^path (slag 1 `path`app-path.act)
:: group-path: the group to associate with the chat
:: members: members of group, if it's new
:: new-members: new members of group, if it already exists
::
=/ [group-path=path members=(set ship) new-members=(set ship)]
?~ existing.act
[chat-path who.u.permission ~]
:+ group-path.u.existing.act
~
?. inclusive.u.existing.act ~
%- ~(dif in who.u.permission)
~| [%groupifying-with-nonexistent-group group-path.u.existing.act]
%- need
(group-scry group-path.u.existing.act)
:: make changes
::
;: weld
:: delete the old chat
::
(poke-chat-view-action %delete app-path.act)
::
:: create the new chat. if needed, creates the new group.
::
%- poke-chat-view-action
:* %create
title.metadata
description.metadata
chat-path
group-path
%village
members
&
==
::
:: if needed, add members to the existing group
::
?~ new-members ~
[(group-poke [%add new-members group-path])]~
::
:: import messages into the new chat
::
[(chat-poke %messages chat-path envelopes.u.data)]~
==
:: TODO
~
==
::
++ create-chat
@ -309,43 +256,23 @@
==
::
++ create-group
|= [=path app-path=path sec=rw-security ships=(set ship) title=@t desc=@t]
|= [=path app-path=path =policy ships=(set ship) title=@t desc=@t]
^- (list card)
?^ (group-scry path)
:~ (create-security path %village)
(permission-hook-poke [%add-owned path path])
==
:: do not create a managed group if this is a sig path or a blacklist
?^ (group-scry path) ~
=/ =group-id
(need (group-id:de-path:group-store path))
?> =(our.bol ship.group-id)
:: do not create a contacts object if this is unmanaged
::
?: =(sec %channel)
:~ (group-poke [%bundle path])
(create-security path sec)
(permission-hook-poke [%add-owned path path])
==
?: (is-managed path)
~[(contact-view-poke [%create path ships title desc])]
%+ welp
:~ (group-poke [%bundle path])
(group-poke [%add ships path])
(create-security path sec)
(permission-hook-poke [%add-owned path path])
==
%- zing
%+ turn ~(tap in ships)
:-
?: =(path app-path)
(group-poke %add-group group-id policy)
(contact-view-poke %create path ships title desc)
%+ murn ~(tap in ships)
|= =ship
^- (unit card)
?: =(ship our.bol) ~
[(send-invite app-path ship)]~
::
++ create-security
|= [pax=path sec=rw-security]
^- card
?+ sec !!
%channel
(perm-group-hook-poke [%associate pax [[pax %black] ~ ~]])
::
%village
(perm-group-hook-poke [%associate pax [[pax %white] ~ ~]])
==
`(send-invite path app-path ship)
::
++ create-metadata
|= [title=@t description=@t group-path=path app-path=path]
@ -389,13 +316,17 @@
==
::
++ send-invite
|= [=path =ship]
|= [group-path=path app-path=path =ship]
^- card
=/ managed=?
!=(app-path group-path)
=/ =invite
:* our.bol %chat-hook
path ship ''
:* our.bol
?:(managed %group-hook %chat-hook)
?:(managed group-path app-path)
ship ''
==
=/ act=invite-action [%invite /chat (shaf %msg-uid eny.bol) invite]
=/ act=invite-action [%invite ?:(managed /groups /chat) (shaf %msg-uid eny.bol) invite]
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
::
++ chat-scry
@ -469,9 +400,18 @@
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
::
++ group-poke
|= act=group-action
|= act=action:group-store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
++ group-hook-poke
|= act=action:group-hook
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
::
++ group-proxy-poke
|= act=action:group-store
^- card
[%pass / %agent [ship.group-id.act %group-hook] %poke %group-action !>(act)]
::
++ permission-poke
|= act=permission-action
@ -505,7 +445,7 @@
++ group-scry
|= pax=path
^- (unit group)
(scry-for (unit group) %group-store pax)
(scry-for (unit group) %group-store [%groups pax])
::
++ scry-for
|* [=mold app=term =path]

82
pkg/arvo/app/contact-hook.hoon
View File

@ -1,12 +1,12 @@
:: contact-hook:
::
/- *group-store,
*group-hook,
/- group-hook,
*contact-hook,
*invite-store,
*metadata-hook,
*metadata-store
/+ *contact-json, default-agent, dbug
*metadata-store,
*group
/+ *contact-json, default-agent, dbug, group-store, verb
~% %contact-hook-top ..is ~
|%
+$ card card:agent:gall
@ -26,6 +26,7 @@
=| state-one
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ bol=bowl:gall
@ -99,7 +100,7 @@
::
%group-update
=^ cards state
(fact-group-update:cc wire !<(group-update q.cage.sign))
(fact-group-update:cc wire !<(update:group-store q.cage.sign))
[cards this]
::
%invite-update
@ -146,7 +147,7 @@
?. |(=(shp our.bol) =(src.bol ship)) ~
:: scry group to check if ship is a member
=/ =group (need (group-scry path))
?. (~(has in group) shp) ~
?. (~(has in members.group) shp) ~
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]~
::
++ poke-hook-action
@ -206,7 +207,7 @@
?> (~(has by synced) pax)
:: scry groups to check if ship is a member
=/ =group (need (group-scry pax))
?> (~(has in group) src.bol)
?> (~(has in members.group) src.bol)
=/ contacts (need (contacts-scry pax))
[%give %fact ~ %contact-update !>([%contacts pax contacts])]~
::
@ -267,18 +268,10 @@
%edit
:_ state
(give-fact path.fact [%edit path.fact ship.fact edit-field.fact])
::
%remove
:_ state
~[(group-poke [%remove [ship.fact ~ ~] path.fact])]
::
%delete
=. synced (~(del by synced) path.fact)
:_ state
:~ (group-poke [%unbundle path.fact])
(metadata-hook-poke [%remove path.fact])
(metadata-poke [%remove path.fact [%contacts path.fact]])
==
`state
==
::
++ foreign
@ -331,12 +324,7 @@
=/ owner (~(get by synced) path.fact)
?~ owner ~
?> |(=(u.owner src.bol) =(src.bol ship.fact))
%+ welp
:~ (group-poke [%remove [ship.fact ~ ~] path.fact])
(contact-poke [%remove path.fact ship.fact])
==
?. =(ship.fact our.bol) ~
~[(group-poke [%unbundle path.fact])]
~[(contact-poke [%remove path.fact ship.fact])]
::
%edit
=/ owner (~(got by synced) path.fact)
@ -346,17 +334,20 @@
--
::
++ fact-group-update
|= [wir=wire fact=group-update]
|= [wir=wire fact=update:group-store]
^- (quip card _state)
|^
?+ -.fact [~ state]
%add (add +.fact)
%remove (remove +.fact)
%unbundle (unbundle +.fact)
%add-members (add-members +.fact)
%initial-group (initial-group +.fact)
%remove-members (remove +.fact)
%remove-group (unbundle +.fact)
==
++ add
|= [ships=(set ship) =path]
++ add-members
|= [=group-id ships=(set ship) tags=(set term)]
^- (quip card _state)
=/ =path
(group-id:en-path:group-store group-id)
=/ owner (~(get by synced) path)
?~ owner [~ state]
?. =(u.owner our.bol) [~ state]
@ -365,9 +356,20 @@
|= =ship
(send-invite-poke path ship)
::
++ unbundle
|= =path
++ initial-group
|= [=group-id =group]
^- (quip card _state)
=/ =path
(group-id:en-path:group-store group-id)
?: (~(has by synced) path)
[~ state]
(poke-hook-action %add-synced ship.group-id path)
::
++ unbundle
|= [=group-id ~]
^- (quip card _state)
=/ =path
(group-id:en-path:group-store group-id)
?. (~(has by synced) path)
:_ state
[(contact-poke [%delete path])]~
@ -377,18 +379,20 @@
==
::
++ remove
|= [members=group =path]
|= [=group-id ships=(set ship)]
^- (quip card _state)
:: if pax is synced, remove member from contacts and kick their sub
=/ =path
(group-id:en-path:group-store group-id)
=/ owner=(unit ship) (~(get by synced) path)
?~ owner
:_ state
%+ turn ~(tap in members)
%+ turn ~(tap in ships)
|= =ship
(contact-poke [%remove path ship])
:_ state
%- zing
%+ turn ~(tap in members)
%+ turn ~(tap in ships)
|= =ship
:~ [%give %kick ~[[%contacts path]] `ship]
?: =(ship our.bol)
@ -414,9 +418,11 @@
%accepted
=/ changes
(poke-hook-action [%add-synced ship.invite.fact path.invite.fact])
=/ =group-id
(need (group-id:de-path:group-store path.invite.fact))
:-
%+ welp
:~ (group-hook-poke [%add ship.invite.fact path.invite.fact])
:~ (group-hook-poke %add group-id)
(metadata-hook-poke [%add-synced ship.invite.fact path.invite.fact])
==
-.changes
@ -424,9 +430,9 @@
==
::
++ group-hook-poke
|= act=group-hook-action
|= =action:group-hook
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(action)]
::
++ invite-poke
|= act=invite-action
@ -439,7 +445,7 @@
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
::
++ group-poke
|= act=group-action
|= act=action:group-store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
@ -469,7 +475,7 @@
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) `path`[%groups pax] /noun))
::
++ pull-wire
|= pax=path

89
pkg/arvo/app/contact-view.hoon
View File

@ -1,15 +1,16 @@
:: contact-view: sets up contact JS client and combines commands
:: into semantic actions for the UI
::
/- *group-store,
*group-hook,
/-
group-hook,
*invite-store,
*contact-hook,
*metadata-store,
*metadata-hook,
*permission-group-hook,
*permission-hook
/+ *server, *contact-json, default-agent, dbug
/+ *server, *contact-json, default-agent, dbug, verb,
group-store
|%
+$ versioned-state
$% state-0
@ -26,6 +27,7 @@
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
@ -39,9 +41,7 @@
:_ this
:~ [%pass /updates %agent [our.bowl %contact-store] %watch /updates]
(contact-poke:cc [%create /~/default])
(group-poke:cc [%bundle /~/default])
(contact-poke:cc [%add /~/default our.bowl *contact])
(group-poke:cc [%add [our.bowl ~ ~] /~/default])
:* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action
!>([%serve-dir /'~groups' /app/landscape %.n])
@ -125,30 +125,51 @@
++ poke-contact-view-action
|= act=contact-view-action
^- (list card)
?> (team:title our.bol src.bol)
?- -.act
%create
?> ?=([@ *] path.act)
=/ =group-id
[our.bol name.act]
=/ =path
(group-id:en-path:group-store group-id)
%+ weld
:~ (group-poke [%bundle path.act])
(contact-poke [%create path.act])
(contact-hook-poke [%add-owned path.act])
(group-hook-poke [%add our.bol path.act])
(group-poke [%add (~(put in ships.act) our.bol) path.act])
(perm-group-hook-poke [%associate path.act [[path.act %white] ~ ~]])
(permission-hook-poke [%add-owned path.act path.act])
:~ (group-poke [%add-group group-id policy.act])
(contact-poke [%create path])
(contact-hook-poke [%add-owned path])
==
(create-metadata path.act title.act description.act)
(create-metadata path title.act description.act)
::
%join
=/ =path
(group-id:en-path:group-store group-id.act)
:~ (group-listen-hook-poke [%add group-id.act])
(group-proxy-poke %add-members group-id.act (sy our.bol ~) ~)
(contact-hook-poke [%add-synced ship.group-id.act path])
(sync-metadata ship.group-id.act path)
==
::
%invite
=* group-id group-id.act
=/ =path
(group-id:en-path:group-store group-id)
:~ (send-invite ship.group-id %groups path ship.act text.act)
(add-pending group-id ship.act)
==
::
%delete
=/ =group-id
(need (group-id:de-path:group-store path.act))
%+ weld
:~ (contact-hook-poke [%remove path.act])
(group-poke [%unbundle path.act])
(group-poke [%remove-group group-id ~])
(contact-poke [%delete path.act])
==
(delete-metadata path.act)
::
%remove
:~ (group-poke [%remove [ship.act ~ ~] path.act])
=/ =group-id
(need (group-id:de-path:group-store path.act))
:~ (group-poke %remove-members group-id (sy ship.act ~))
(contact-poke [%remove path.act ship.act])
==
::
@ -184,6 +205,26 @@
::
:: +utilities
::
++ add-pending
|= [=group-id =ship]
^- card
=/ app=term
?: =(our.bol ship.group-id)
%group-store
%group-hook
=/ =cage
:- %group-action
!> ^- action:group-store
[%change-policy group-id %add-invites (sy ship ~)]
[%pass / %agent [ship.group-id app] %poke cage]
++ send-invite
|= =invite
^- card
=/ =cage
:- %invite-action
!> ^- invite-action
[%invite /groups (shaf %invite-uid eny.bol) invite]
[%pass / %agent [recipient.invite %invite-hook] %poke cage]
++ contact-poke
|= act=contact-action
^- card
@ -200,12 +241,17 @@
[%pass / %agent [ship %contact-hook] %poke %contact-action !>(act)]
::
++ group-poke
|= act=group-action
|= act=action:group-store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
::
++ group-hook-poke
|= act=group-hook-action
++ group-proxy-poke
|= act=action:group-store
^- card
[%pass / %agent [ship.group-id.act %group-hook] %poke %group-action !>(act)]
::
++ group-listen-hook-poke
|= act=action:group-hook
^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
::
@ -233,6 +279,11 @@
%poke %permission-hook-action !>(act)
==
::
++ sync-metadata
|= [=ship =path]
^- card
(metadata-hook-poke %add-synced ship path)
::
++ create-metadata
|= [=path title=@t description=@t]
^- (list card)

16
pkg/arvo/app/group-hook.hoon
View File

@ -85,7 +85,7 @@
?> ?=([%groups *] path)
=/ =group-id
(need (group-id:de-path:store t.path))
?> (permitted:gc src.bowl group-id)
?> (can-join:grp:gc group-id src.bowl)
=^ cards state
(start-proxy:gc src.bowl group-id)
[cards this]
@ -105,7 +105,7 @@
--
|_ bol=bowl:gall
++ def ~(. (default-agent state %|) bol)
++ grp ~(. grpl bol)
++ grp ~(. grpl bol)
:: +| %pokes
::
:: +poke-group-update: Proxy poke to %group-store
@ -121,7 +121,7 @@
=/ =path
(group-id:en-path:store group-id.update)
?> (should-proxy-poke update)
?> (is-permitted:grp src.bol path)
?> (can-join:grp group-id.update src.bol)
:_ state
[%pass [%store path] %agent [our.bol %group-store] %poke %group-update !>(update)]~
:: +poke-hook-action: Start/stop syncing a foreign group
@ -310,17 +310,21 @@
++ should-proxy-poke
|= =update:store
^- ?
=- ~& - -
?: ?=(%initial -.update)
%.n
|^
=/ role=(unit role-tag)
(role-for-ship:grp group-id.update src.bol)
~& role
~& update
?~ role
member
non-member
?- u.role
%admin admin
%moderator moderator
%janitor member
%member member
==
++ member
?: ?=(%add-members -.update)
@ -334,6 +338,10 @@
?= $? %add-members %remove-members
%add-tag %remove-tag ==
-.update
++ non-member
?& =- ~& - - ?=(%add-members -.update)
(can-join:grp group-id.update src.bol)
==
--
::
:: +handle-revocations: Handle revoked permissions from a update:store

26
pkg/arvo/app/group-store.hoon
View File

@ -406,13 +406,31 @@
(send-diff %remove-group group-id ~)
::
--
++ merge-tags
|= [=tag-queries ships=(set ship) tags=(set tag)]
^+ tag-queries
=/ tags ~(tap in tags)
|-
?~ tags
tag-queries
=* tag i.tags
=/ current-query=(set ship)
(~(gut by tag-queries) tag ~)
%= $
tags t.tags
::
tag-queries
%+ ~(put by tag-queries)
tag
(~(uni in current-query) ships)
==
++ remove-tags
|= [=group ships=(set ship)]
^- tag-quries
^- tag-queries
%- malt
%+ spin
~(tap by tag-queries.group)
tag-queries.group
%+ turn
~(tap by tag-queries.group)
|= [=tag tagged=(set ship)]
:- tag
(~(dif in tagged) ships)

18
pkg/arvo/app/metadata-hook.hoon
View File

@ -4,7 +4,7 @@
:: /group/%group-path all updates related to this group
::
/- *metadata-store, *metadata-hook
/+ default-agent, dbug
/+ default-agent, dbug, verb, grpl=group
~% %metadata-hook-top ..is ~
|%
+$ card card:agent:gall
@ -20,6 +20,7 @@
=| state-zero
=* state -
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
@ -73,6 +74,7 @@
--
::
|_ =bowl:gall
+* grp ~(. grpl bowl)
++ poke-hook-action
|= act=metadata-hook-action
^- (quip card _state)
@ -120,7 +122,7 @@
%add (send group-path.act)
%remove (send group-path.act)
==
?> (is-permitted src.bowl group-path.act)
?> (is-permitted:grp src.bowl group-path.act)
?- -.act
%add (metadata-poke our.bowl %metadata-store)
%remove (metadata-poke our.bowl %metadata-store)
@ -153,7 +155,7 @@
^- (list card)
|^
?> =(our.bowl (~(got by synced) path))
?> (is-permitted src.bowl path)
?> (is-permitted:grp src.bowl path)
%+ turn ~(tap by (metadata-scry path))
|= [[=group-path =resource] =metadata]
^- card
@ -235,14 +237,4 @@
?> ?=(^ wir)
[~ ?~(saw state state(synced (~(del by synced) t.wir)))]
::
++ is-permitted
|= [=ship pax=path]
^- ?
=. pax
;: weld
/=permission-store/(scot %da now.bowl)/permitted
[(scot %p ship) pax]
/noun
==
.^(? %gx pax)
--

4
pkg/arvo/gen/group-store/create.hoon
View File

@ -1,10 +1,10 @@
:: group-store|create: initialize a group
::
/- *group-store
/- *group-store, *group
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=term ~] ~]
==
:- %group-update
^- action
[%add-group [p.beak term] (sy p.beak ~) ~ %open ~ ~]
[%add-group [p.beak term] %open (sy %0 %1 ~) ~]

15
pkg/arvo/lib/contact-json.hoon
View File

@ -1,5 +1,5 @@
/- *contact-view, *contact-hook
/+ base64
/+ base64, group-store
|%
++ nu :: parse number as hex
|= jon/json
@ -128,18 +128,27 @@
%- of
:~ [%create create]
[%delete delete]
[%join group-id:dejs:group-store]
[%invite invite]
[%remove remove]
[%share share]
==
::
++ create
%- ot
:~ [%path pa]
[%ships (as (su ;~(pfix sig fed:ag)))]
:~ [%name so]
[%policy policy:dejs:group-store]
[%title so]
[%description so]
==
::
++ invite
%- ot
:~ [%group-id group-id:dejs:group-store]
[%ship (su ;~(pfix sig fed:ag))]
[%text so]
==
::
++ delete (ot [%path pa]~)
::
++ remove

33
pkg/arvo/lib/group.hoon
View File

@ -20,7 +20,12 @@
++ scry-group
|= =group-id
%- scry-group-path
(group-id:en-path group-id)
(group-id:en-path:store group-id)
::
++ members
|= =group-id
%- members-from-path
(group-id:en-path:store group-id)
::
++ members-from-path
|= =group-path
@ -58,12 +63,36 @@
?: (~(has in members.group) ship)
`%member
~
++ can-join
++ can-join-from-path
|= [=path =ship]
%+ scry-for
?
%+ welp
[%groups path]
/join/[(scot %p ship)]
::
++ can-join
|= [=group-id =ship]
=- ~& - -
%+ can-join-from-path
(group-id:en-path:store group-id)
ship
++ is-managed-path
|= =path
=/ contact
.^ (unit *)
%gx
(scot %p our.bowl)
%contact-store
(scot %da now.bowl)
(snoc `^path`[%contacts path] %noun)
==
?~ contact
%.n
%.y
++ is-managed
|= =group-id
%- is-managed-path
(group-id:en-path:store group-id)
--

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

@ -1,4 +1,4 @@
/- *rw-security
/- *group
^?
|%
+$ action
@ -14,7 +14,7 @@
description=@t
app-path=path
group-path=path
security=rw-security
=policy
members=(set ship)
allow-history=?
==

10
pkg/arvo/sur/contact-view.hoon
View File

@ -1,9 +1,15 @@
/- *contact-store
/- *contact-store, *group
|%
+$ contact-view-action
$% :: %create: create in both groups and contacts
::
[%create =path ships=(set ship) title=@t description=@t]
[%create name=term =policy title=@t description=@t]
:: %join: join open group in both groups and contacts
::
[%join =group-id]
:: %invite: invite to invite-only group and contacts
::
[%invite =group-id =ship text=cord]
:: %remove: remove from both groups and contacts
::
[%remove =path =ship]

2
pkg/arvo/sur/group.hoon
View File

@ -25,7 +25,7 @@
:: %member: Ordinary member, this tag is implied if the user is not in any
:: of the other roles
+$ role-tag
?(%admin %moderator %janitor %members)
?(%admin %moderator %janitor %member)
:: $tag-queries: a mapping from a $tag to the members it identifies
::
+$ tag-queries (jug tag ship)

35
pkg/arvo/ted/ph/group-rejoin.hoon
View File

@ -8,7 +8,7 @@
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-dojo-output:util ship her unix-effect "{(trip agent)} started")
?: (is-dojo-output:util ship her unix-effect "activated app home/{(trip agent)}")
(pure:m ~)
loop
::
@ -36,8 +36,7 @@
=/ m (strand:spider ,~)
^- form:m
;< ~ bind:m (start-agent ship %group-store)
;< ~ bind:m (start-agent ship %group-listen-hook)
;< ~ bind:m (start-agent ship %group-proxy-hook)
;< ~ bind:m (start-agent ship %group-hook)
(pure:m ~)
--
=, strand=strand:spider
@ -47,17 +46,27 @@
;< az=tid:spider
bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~marbud)
;< ~ bind:m (spawn az ~zod)
;< ~ bind:m (spawn az ~marzod)
;< ~ bind:m (real-ship az ~bud)
;< ~ bind:m (wait-for-goad ~bud)
;< ~ bind:m (real-ship az ~marbud)
;< ~ bind:m (wait-for-goad ~marbud)
;< ~ bind:m (real-ship az ~zod)
;< ~ bind:m (wait-for-goad ~zod)
;< ~ bind:m (start-group-agents ~bud)
;< ~ bind:m (start-group-agents ~zod)
;< ~ bind:m (dojo ~bud ":group-store|create 'test-group'")
;< ~ bind:m (wait-for-output ~bud ">=")
;< ~ bind:m (dojo ~zod ":group-store|add ~bud 'test-group'")
;< ~ bind:m (wait-for-output ~zod ">=")
;< ~ bind:m (dojo ~zod ":group-listen-hook|add ~bud 'test-group'")
;< ~ bind:m (wait-for-output ~zod ">=")
;< ~ bind:m (real-ship az ~marzod)
;< ~ bind:m (wait-for-goad ~marzod)
;< ~ bind:m (start-group-agents ~marbud)
;< ~ bind:m (start-group-agents ~marzod)
;< ~ bind:m (dojo ~marbud ":group-store|create 'test-group'")
;< ~ bind:m (wait-for-output ~marbud ">=")
;< ~ bind:m (dojo ~marzod ":group-hook|add ~marbud 'test-group'")
;< ~ bind:m (wait-for-output ~marzod ">=")
;< ~ bind:m (sleep ~s1)
;< ~ bind:m (breach-and-hear az ~marzod ~marbud)
;< ~ bind:m (real-ship az ~marzod)
;< ~ bind:m (wait-for-goad ~marzod)
;< ~ bind:m (start-group-agents ~marzod)
;< ~ bind:m (dojo ~marzod ":group-hook|add ~marbud 'test-group'")
;< ~ bind:m (sleep ~s3)
;< ~ bind:m end-azimuth
(pure:m *vase)