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

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

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

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

@ -3,9 +3,10 @@
:: ::
/- *permission-store, /- *permission-store,
*permission-hook, *permission-hook,
*group-store, *group,
*invite-store, *invite-store,
*metadata-store, *metadata-store,
group-hook,
*permission-group-hook, *permission-group-hook,
*chat-hook, *chat-hook,
*metadata-hook, *metadata-hook,
@ -13,7 +14,8 @@
hook=chat-hook hook=chat-hook
/+ *server, default-agent, verb, dbug, /+ *server, default-agent, verb, dbug,
store=chat-store, store=chat-store,
view=chat-view view=chat-view,
group-store
:: ::
~% %chat-view-top ..is ~ ~% %chat-view-top ..is ~
|% |%
@ -24,6 +26,12 @@
+$ state-0 +$ state-0
$: %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 +$ card card:agent:gall
@ -188,7 +196,7 @@
%- create-group %- create-group
:* group-path.act :* group-path.act
app-path.act app-path.act
security.act policy.act
members.act members.act
title.act title.act
description.act description.act
@ -208,97 +216,36 @@
:: we aren't guaranteed to have metadata: the chat might have been :: we aren't guaranteed to have metadata: the chat might have been
:: deleted by the host, which pushes metadata deletion down to us. :: deleted by the host, which pushes metadata deletion down to us.
:: ::
=/ group-path=(unit path) =/ group=path
(maybe-group-from-chat app-path.act) (group-from-chat app-path.act)
?~ group-path ~ =/ =group-id
=* group u.group-path (need (group-id:de-path:group-store group))
%- zing %- zing
:~ ?. (is-creator group %chat app-path.act) ~ :~ ?. (is-creator group %chat app-path.act) ~
[(metadata-poke [%remove group [%chat app-path.act]])]~ [(metadata-poke [%remove group [%chat app-path.act]])]~
:: ::
?: (is-managed group) ~ :~ (group-proxy-poke %remove-members group-id (sy our.bol ~))
:~ (group-poke [%unbundle group]) (group-poke [%remove-group group-id ~])
(metadata-hook-poke [%remove group]) (metadata-hook-poke [%remove group])
(metadata-store-poke [%remove group [%chat app-path.act]]) (metadata-store-poke [%remove group [%chat app-path.act]])
== ==
== ==
:: ::
%join %join
:: joining unmanaged chat if we don't have the group already
=/ group-path =/ group-path
?. (is-managed app-path.act) app-path.act (fall (maybe-group-from-chat app-path.act) app-path.act)
(group-from-chat app-path.act) =/ =group-id
:~ (chat-hook-poke [%add-synced ship.act app-path.act ask-history.act]) (need (group-id:de-path:group-store group-path))
(permission-hook-poke [%add-synced ship.act 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]) (metadata-hook-poke [%add-synced ship.act group-path])
== ==
:: ::
%groupify %groupify
?> ?=([%'~' ^] app-path.act) :: TODO
:: 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)]~
==
== ==
:: ::
++ create-chat ++ create-chat
@ -309,43 +256,23 @@
== ==
:: ::
++ create-group ++ 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) ^- (list card)
?^ (group-scry path) ?^ (group-scry path) ~
:~ (create-security path %village) =/ =group-id
(permission-hook-poke [%add-owned path path]) (need (group-id:de-path:group-store path))
== ?> =(our.bol ship.group-id)
:: do not create a managed group if this is a sig path or a blacklist :: do not create a contacts object if this is unmanaged
:: ::
?: =(sec %channel) :-
:~ (group-poke [%bundle path]) ?: =(path app-path)
(create-security path sec) (group-poke %add-group group-id policy)
(permission-hook-poke [%add-owned path path]) (contact-view-poke %create path ships title desc)
== %+ murn ~(tap in ships)
?: (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)
|= =ship |= =ship
^- (unit card)
?: =(ship our.bol) ~ ?: =(ship our.bol) ~
[(send-invite app-path ship)]~ `(send-invite path 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] ~ ~]])
==
:: ::
++ create-metadata ++ create-metadata
|= [title=@t description=@t group-path=path app-path=path] |= [title=@t description=@t group-path=path app-path=path]
@ -389,13 +316,17 @@
== ==
:: ::
++ send-invite ++ send-invite
|= [=path =ship] |= [group-path=path app-path=path =ship]
^- card ^- card
=/ managed=?
!=(app-path group-path)
=/ =invite =/ =invite
:* our.bol %chat-hook :* our.bol
path ship '' ?:(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)] [%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
:: ::
++ chat-scry ++ chat-scry
@ -469,9 +400,18 @@
[%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)] [%pass / %agent [our.bol %chat-store] %poke %chat-action !>(act)]
:: ::
++ group-poke ++ group-poke
|= act=group-action |= act=action:group-store
^- card ^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)] [%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 ++ permission-poke
|= act=permission-action |= act=permission-action
@ -505,7 +445,7 @@
++ group-scry ++ group-scry
|= pax=path |= pax=path
^- (unit group) ^- (unit group)
(scry-for (unit group) %group-store pax) (scry-for (unit group) %group-store [%groups pax])
:: ::
++ scry-for ++ scry-for
|* [=mold app=term =path] |* [=mold app=term =path]

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

@ -1,12 +1,12 @@
:: contact-hook: :: contact-hook:
:: ::
/- *group-store, /- group-hook,
*group-hook,
*contact-hook, *contact-hook,
*invite-store, *invite-store,
*metadata-hook, *metadata-hook,
*metadata-store *metadata-store,
/+ *contact-json, default-agent, dbug *group
/+ *contact-json, default-agent, dbug, group-store, verb
~% %contact-hook-top ..is ~ ~% %contact-hook-top ..is ~
|% |%
+$ card card:agent:gall +$ card card:agent:gall
@ -26,6 +26,7 @@
=| state-one =| state-one
=* state - =* state -
%- agent:dbug %- agent:dbug
%+ verb |
^- agent:gall ^- agent:gall
=< =<
|_ bol=bowl:gall |_ bol=bowl:gall
@ -99,7 +100,7 @@
:: ::
%group-update %group-update
=^ cards state =^ 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] [cards this]
:: ::
%invite-update %invite-update
@ -146,7 +147,7 @@
?. |(=(shp our.bol) =(src.bol ship)) ~ ?. |(=(shp our.bol) =(src.bol ship)) ~
:: scry group to check if ship is a member :: scry group to check if ship is a member
=/ =group (need (group-scry path)) =/ =group (need (group-scry path))
?. (~(has in group) shp) ~ ?. (~(has in members.group) shp) ~
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]~ [%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]~
:: ::
++ poke-hook-action ++ poke-hook-action
@ -206,7 +207,7 @@
?> (~(has by synced) pax) ?> (~(has by synced) pax)
:: scry groups to check if ship is a member :: scry groups to check if ship is a member
=/ =group (need (group-scry pax)) =/ =group (need (group-scry pax))
?> (~(has in group) src.bol) ?> (~(has in members.group) src.bol)
=/ contacts (need (contacts-scry pax)) =/ contacts (need (contacts-scry pax))
[%give %fact ~ %contact-update !>([%contacts pax contacts])]~ [%give %fact ~ %contact-update !>([%contacts pax contacts])]~
:: ::
@ -267,18 +268,10 @@
%edit %edit
:_ state :_ state
(give-fact path.fact [%edit path.fact ship.fact edit-field.fact]) (give-fact path.fact [%edit path.fact ship.fact edit-field.fact])
::
%remove
:_ state
~[(group-poke [%remove [ship.fact ~ ~] path.fact])]
:: ::
%delete %delete
=. synced (~(del by synced) path.fact) =. synced (~(del by synced) path.fact)
:_ state `state
:~ (group-poke [%unbundle path.fact])
(metadata-hook-poke [%remove path.fact])
(metadata-poke [%remove path.fact [%contacts path.fact]])
==
== ==
:: ::
++ foreign ++ foreign
@ -331,12 +324,7 @@
=/ owner (~(get by synced) path.fact) =/ owner (~(get by synced) path.fact)
?~ owner ~ ?~ owner ~
?> |(=(u.owner src.bol) =(src.bol ship.fact)) ?> |(=(u.owner src.bol) =(src.bol ship.fact))
%+ welp ~[(contact-poke [%remove path.fact ship.fact])]
:~ (group-poke [%remove [ship.fact ~ ~] path.fact])
(contact-poke [%remove path.fact ship.fact])
==
?. =(ship.fact our.bol) ~
~[(group-poke [%unbundle path.fact])]
:: ::
%edit %edit
=/ owner (~(got by synced) path.fact) =/ owner (~(got by synced) path.fact)
@ -346,17 +334,20 @@
-- --
:: ::
++ fact-group-update ++ fact-group-update
|= [wir=wire fact=group-update] |= [wir=wire fact=update:group-store]
^- (quip card _state) ^- (quip card _state)
|^ |^
?+ -.fact [~ state] ?+ -.fact [~ state]
%add (add +.fact) %add-members (add-members +.fact)
%remove (remove +.fact) %initial-group (initial-group +.fact)
%unbundle (unbundle +.fact) %remove-members (remove +.fact)
%remove-group (unbundle +.fact)
== ==
++ add ++ add-members
|= [ships=(set ship) =path] |= [=group-id ships=(set ship) tags=(set term)]
^- (quip card _state) ^- (quip card _state)
=/ =path
(group-id:en-path:group-store group-id)
=/ owner (~(get by synced) path) =/ owner (~(get by synced) path)
?~ owner [~ state] ?~ owner [~ state]
?. =(u.owner our.bol) [~ state] ?. =(u.owner our.bol) [~ state]
@ -365,9 +356,20 @@
|= =ship |= =ship
(send-invite-poke path ship) (send-invite-poke path ship)
:: ::
++ unbundle ++ initial-group
|= =path |= [=group-id =group]
^- (quip card _state) ^- (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) ?. (~(has by synced) path)
:_ state :_ state
[(contact-poke [%delete path])]~ [(contact-poke [%delete path])]~
@ -377,18 +379,20 @@
== ==
:: ::
++ remove ++ remove
|= [members=group =path] |= [=group-id ships=(set ship)]
^- (quip card _state) ^- (quip card _state)
:: if pax is synced, remove member from contacts and kick their sub :: 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=(unit ship) (~(get by synced) path)
?~ owner ?~ owner
:_ state :_ state
%+ turn ~(tap in members) %+ turn ~(tap in ships)
|= =ship |= =ship
(contact-poke [%remove path ship]) (contact-poke [%remove path ship])
:_ state :_ state
%- zing %- zing
%+ turn ~(tap in members) %+ turn ~(tap in ships)
|= =ship |= =ship
:~ [%give %kick ~[[%contacts path]] `ship] :~ [%give %kick ~[[%contacts path]] `ship]
?: =(ship our.bol) ?: =(ship our.bol)
@ -414,9 +418,11 @@
%accepted %accepted
=/ changes =/ changes
(poke-hook-action [%add-synced ship.invite.fact path.invite.fact]) (poke-hook-action [%add-synced ship.invite.fact path.invite.fact])
=/ =group-id
(need (group-id:de-path:group-store path.invite.fact))
:- :-
%+ welp %+ 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]) (metadata-hook-poke [%add-synced ship.invite.fact path.invite.fact])
== ==
-.changes -.changes
@ -424,9 +430,9 @@
== ==
:: ::
++ group-hook-poke ++ group-hook-poke
|= act=group-hook-action |= =action:group-hook
^- card ^- 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 ++ invite-poke
|= act=invite-action |= act=invite-action
@ -439,7 +445,7 @@
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)] [%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
:: ::
++ group-poke ++ group-poke
|= act=group-action |= act=action:group-store
^- card ^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)] [%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
:: ::
@ -469,7 +475,7 @@
++ group-scry ++ group-scry
|= pax=path |= pax=path
^- (unit group) ^- (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 ++ pull-wire
|= pax=path |= 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 :: contact-view: sets up contact JS client and combines commands
:: into semantic actions for the UI :: into semantic actions for the UI
:: ::
/- *group-store, /-
*group-hook, group-hook,
*invite-store, *invite-store,
*contact-hook, *contact-hook,
*metadata-store, *metadata-store,
*metadata-hook, *metadata-hook,
*permission-group-hook, *permission-group-hook,
*permission-hook *permission-hook
/+ *server, *contact-json, default-agent, dbug /+ *server, *contact-json, default-agent, dbug, verb,
group-store
|% |%
+$ versioned-state +$ versioned-state
$% state-0 $% state-0
@ -26,6 +27,7 @@
=* state - =* state -
:: ::
%- agent:dbug %- agent:dbug
%+ verb |
^- agent:gall ^- agent:gall
=< =<
|_ =bowl:gall |_ =bowl:gall
@ -39,9 +41,7 @@
:_ this :_ this
:~ [%pass /updates %agent [our.bowl %contact-store] %watch /updates] :~ [%pass /updates %agent [our.bowl %contact-store] %watch /updates]
(contact-poke:cc [%create /~/default]) (contact-poke:cc [%create /~/default])
(group-poke:cc [%bundle /~/default])
(contact-poke:cc [%add /~/default our.bowl *contact]) (contact-poke:cc [%add /~/default our.bowl *contact])
(group-poke:cc [%add [our.bowl ~ ~] /~/default])
:* %pass /srv %agent [our.bol %file-server] :* %pass /srv %agent [our.bol %file-server]
%poke %file-server-action %poke %file-server-action
!>([%serve-dir /'~groups' /app/landscape %.n]) !>([%serve-dir /'~groups' /app/landscape %.n])
@ -125,30 +125,51 @@
++ poke-contact-view-action ++ poke-contact-view-action
|= act=contact-view-action |= act=contact-view-action
^- (list card) ^- (list card)
?> (team:title our.bol src.bol)
?- -.act ?- -.act
%create %create
?> ?=([@ *] path.act) =/ =group-id
[our.bol name.act]
=/ =path
(group-id:en-path:group-store group-id)
%+ weld %+ weld
:~ (group-poke [%bundle path.act]) :~ (group-poke [%add-group group-id policy.act])
(contact-poke [%create path.act]) (contact-poke [%create path])
(contact-hook-poke [%add-owned path.act]) (contact-hook-poke [%add-owned path])
(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])
== ==
(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 %delete
=/ =group-id
(need (group-id:de-path:group-store path.act))
%+ weld %+ weld
:~ (contact-hook-poke [%remove path.act]) :~ (contact-hook-poke [%remove path.act])
(group-poke [%unbundle path.act]) (group-poke [%remove-group group-id ~])
(contact-poke [%delete path.act]) (contact-poke [%delete path.act])
== ==
(delete-metadata path.act) (delete-metadata path.act)
:: ::
%remove %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]) (contact-poke [%remove path.act ship.act])
== ==
:: ::
@ -184,6 +205,26 @@
:: ::
:: +utilities :: +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 ++ contact-poke
|= act=contact-action |= act=contact-action
^- card ^- card
@ -200,12 +241,17 @@
[%pass / %agent [ship %contact-hook] %poke %contact-action !>(act)] [%pass / %agent [ship %contact-hook] %poke %contact-action !>(act)]
:: ::
++ group-poke ++ group-poke
|= act=group-action |= act=action:group-store
^- card ^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)] [%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
:: ::
++ group-hook-poke ++ group-proxy-poke
|= act=group-hook-action |= 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 ^- card
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)] [%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
:: ::
@ -233,6 +279,11 @@
%poke %permission-hook-action !>(act) %poke %permission-hook-action !>(act)
== ==
:: ::
++ sync-metadata
|= [=ship =path]
^- card
(metadata-hook-poke %add-synced ship path)
::
++ create-metadata ++ create-metadata
|= [=path title=@t description=@t] |= [=path title=@t description=@t]
^- (list card) ^- (list card)

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

@ -85,7 +85,7 @@
?> ?=([%groups *] path) ?> ?=([%groups *] path)
=/ =group-id =/ =group-id
(need (group-id:de-path:store t.path)) (need (group-id:de-path:store t.path))
?> (permitted:gc src.bowl group-id) ?> (can-join:grp:gc group-id src.bowl)
=^ cards state =^ cards state
(start-proxy:gc src.bowl group-id) (start-proxy:gc src.bowl group-id)
[cards this] [cards this]
@ -105,7 +105,7 @@
-- --
|_ bol=bowl:gall |_ bol=bowl:gall
++ def ~(. (default-agent state %|) bol) ++ def ~(. (default-agent state %|) bol)
++ grp ~(. grpl bol) ++ grp ~(. grpl bol)
:: +| %pokes :: +| %pokes
:: ::
:: +poke-group-update: Proxy poke to %group-store :: +poke-group-update: Proxy poke to %group-store
@ -121,7 +121,7 @@
=/ =path =/ =path
(group-id:en-path:store group-id.update) (group-id:en-path:store group-id.update)
?> (should-proxy-poke update) ?> (should-proxy-poke update)
?> (is-permitted:grp src.bol path) ?> (can-join:grp group-id.update src.bol)
:_ state :_ state
[%pass [%store path] %agent [our.bol %group-store] %poke %group-update !>(update)]~ [%pass [%store path] %agent [our.bol %group-store] %poke %group-update !>(update)]~
:: +poke-hook-action: Start/stop syncing a foreign group :: +poke-hook-action: Start/stop syncing a foreign group
@ -310,17 +310,21 @@
++ should-proxy-poke ++ should-proxy-poke
|= =update:store |= =update:store
^- ? ^- ?
=- ~& - -
?: ?=(%initial -.update) ?: ?=(%initial -.update)
%.n %.n
|^ |^
=/ role=(unit role-tag) =/ role=(unit role-tag)
(role-for-ship:grp group-id.update src.bol) (role-for-ship:grp group-id.update src.bol)
~& role
~& update
?~ role ?~ role
member non-member
?- u.role ?- u.role
%admin admin %admin admin
%moderator moderator %moderator moderator
%janitor member %janitor member
%member member
== ==
++ member ++ member
?: ?=(%add-members -.update) ?: ?=(%add-members -.update)
@ -334,6 +338,10 @@
?= $? %add-members %remove-members ?= $? %add-members %remove-members
%add-tag %remove-tag == %add-tag %remove-tag ==
-.update -.update
++ non-member
?& =- ~& - - ?=(%add-members -.update)
(can-join:grp group-id.update src.bol)
==
-- --
:: ::
:: +handle-revocations: Handle revoked permissions from a update:store :: +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 ~) (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 ++ remove-tags
|= [=group ships=(set ship)] |= [=group ships=(set ship)]
^- tag-quries ^- tag-queries
%- malt %- malt
%+ spin %+ turn
~(tap by tag-queries.group) ~(tap by tag-queries.group)
tag-queries.group
|= [=tag tagged=(set ship)] |= [=tag tagged=(set ship)]
:- tag :- tag
(~(dif in tagged) ships) (~(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 :: /group/%group-path all updates related to this group
:: ::
/- *metadata-store, *metadata-hook /- *metadata-store, *metadata-hook
/+ default-agent, dbug /+ default-agent, dbug, verb, grpl=group
~% %metadata-hook-top ..is ~ ~% %metadata-hook-top ..is ~
|% |%
+$ card card:agent:gall +$ card card:agent:gall
@ -20,6 +20,7 @@
=| state-zero =| state-zero
=* state - =* state -
%- agent:dbug %- agent:dbug
%+ verb |
^- agent:gall ^- agent:gall
=< =<
|_ =bowl:gall |_ =bowl:gall
@ -73,6 +74,7 @@
-- --
:: ::
|_ =bowl:gall |_ =bowl:gall
+* grp ~(. grpl bowl)
++ poke-hook-action ++ poke-hook-action
|= act=metadata-hook-action |= act=metadata-hook-action
^- (quip card _state) ^- (quip card _state)
@ -120,7 +122,7 @@
%add (send group-path.act) %add (send group-path.act)
%remove (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 ?- -.act
%add (metadata-poke our.bowl %metadata-store) %add (metadata-poke our.bowl %metadata-store)
%remove (metadata-poke our.bowl %metadata-store) %remove (metadata-poke our.bowl %metadata-store)
@ -153,7 +155,7 @@
^- (list card) ^- (list card)
|^ |^
?> =(our.bowl (~(got by synced) path)) ?> =(our.bowl (~(got by synced) path))
?> (is-permitted src.bowl path) ?> (is-permitted:grp src.bowl path)
%+ turn ~(tap by (metadata-scry path)) %+ turn ~(tap by (metadata-scry path))
|= [[=group-path =resource] =metadata] |= [[=group-path =resource] =metadata]
^- card ^- card
@ -235,14 +237,4 @@
?> ?=(^ wir) ?> ?=(^ wir)
[~ ?~(saw state state(synced (~(del by synced) t.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|create: initialize a group
:: ::
/- *group-store /- *group-store, *group
:- %say :- %say
|= $: [now=@da eny=@uvJ =beak] |= $: [now=@da eny=@uvJ =beak]
[[=term ~] ~] [[=term ~] ~]
== ==
:- %group-update :- %group-update
^- action ^- 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 /- *contact-view, *contact-hook
/+ base64 /+ base64, group-store
|% |%
++ nu :: parse number as hex ++ nu :: parse number as hex
|= jon/json |= jon/json
@ -128,18 +128,27 @@
%- of %- of
:~ [%create create] :~ [%create create]
[%delete delete] [%delete delete]
[%join group-id:dejs:group-store]
[%invite invite]
[%remove remove] [%remove remove]
[%share share] [%share share]
== ==
:: ::
++ create ++ create
%- ot %- ot
:~ [%path pa] :~ [%name so]
[%ships (as (su ;~(pfix sig fed:ag)))] [%policy policy:dejs:group-store]
[%title so] [%title so]
[%description so] [%description so]
== ==
:: ::
++ invite
%- ot
:~ [%group-id group-id:dejs:group-store]
[%ship (su ;~(pfix sig fed:ag))]
[%text so]
==
::
++ delete (ot [%path pa]~) ++ delete (ot [%path pa]~)
:: ::
++ remove ++ remove

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

@ -20,7 +20,12 @@
++ scry-group ++ scry-group
|= =group-id |= =group-id
%- scry-group-path %- 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 ++ members-from-path
|= =group-path |= =group-path
@ -58,12 +63,36 @@
?: (~(has in members.group) ship) ?: (~(has in members.group) ship)
`%member `%member
~ ~
++ can-join ++ can-join-from-path
|= [=path =ship] |= [=path =ship]
%+ scry-for %+ scry-for
? ?
%+ welp %+ welp
[%groups path] [%groups path]
/join/[(scot %p ship)] /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 +$ action
@ -14,7 +14,7 @@
description=@t description=@t
app-path=path app-path=path
group-path=path group-path=path
security=rw-security =policy
members=(set ship) members=(set ship)
allow-history=? allow-history=?
== ==

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

@ -1,9 +1,15 @@
/- *contact-store /- *contact-store, *group
|% |%
+$ contact-view-action +$ contact-view-action
$% :: %create: create in both groups and contacts $% :: %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: remove from both groups and contacts
:: ::
[%remove =path =ship] [%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 :: %member: Ordinary member, this tag is implied if the user is not in any
:: of the other roles :: of the other roles
+$ role-tag +$ role-tag
?(%admin %moderator %janitor %members) ?(%admin %moderator %janitor %member)
:: $tag-queries: a mapping from a $tag to the members it identifies :: $tag-queries: a mapping from a $tag to the members it identifies
:: ::
+$ tag-queries (jug tag ship) +$ tag-queries (jug tag ship)

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

@ -8,7 +8,7 @@
^- form:m ^- form:m
=* loop $ =* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect ;< [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 ~) (pure:m ~)
loop loop
:: ::
@ -36,8 +36,7 @@
=/ m (strand:spider ,~) =/ m (strand:spider ,~)
^- form:m ^- form:m
;< ~ bind:m (start-agent ship %group-store) ;< ~ bind:m (start-agent ship %group-store)
;< ~ bind:m (start-agent ship %group-listen-hook) ;< ~ bind:m (start-agent ship %group-hook)
;< ~ bind:m (start-agent ship %group-proxy-hook)
(pure:m ~) (pure:m ~)
-- --
=, strand=strand:spider =, strand=strand:spider
@ -47,17 +46,27 @@
;< az=tid:spider ;< az=tid:spider
bind:m start-azimuth bind:m start-azimuth
;< ~ bind:m (spawn az ~bud) ;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~marbud)
;< ~ bind:m (spawn az ~zod) ;< ~ bind:m (spawn az ~zod)
;< ~ bind:m (spawn az ~marzod)
;< ~ bind:m (real-ship az ~bud) ;< ~ 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 (real-ship az ~zod)
;< ~ bind:m (wait-for-goad ~zod) ;< ~ bind:m (real-ship az ~marzod)
;< ~ bind:m (start-group-agents ~bud) ;< ~ bind:m (wait-for-goad ~marzod)
;< ~ bind:m (start-group-agents ~zod) ;< ~ bind:m (start-group-agents ~marbud)
;< ~ bind:m (dojo ~bud ":group-store|create 'test-group'") ;< ~ bind:m (start-group-agents ~marzod)
;< ~ bind:m (wait-for-output ~bud ">=") ;< ~ bind:m (dojo ~marbud ":group-store|create 'test-group'")
;< ~ bind:m (dojo ~zod ":group-store|add ~bud 'test-group'") ;< ~ bind:m (wait-for-output ~marbud ">=")
;< ~ bind:m (wait-for-output ~zod ">=") ;< ~ bind:m (dojo ~marzod ":group-hook|add ~marbud 'test-group'")
;< ~ bind:m (dojo ~zod ":group-listen-hook|add ~bud 'test-group'") ;< ~ bind:m (wait-for-output ~marzod ">=")
;< ~ bind:m (wait-for-output ~zod ">=") ;< ~ 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) (pure:m *vase)