ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-01 11:33:41 +03:00
Code Issues Packages Projects Releases Wiki Activity

groups: add prototype state adapters and cleanup

Browse Source
This commit is contained in:
Liam Fitzgerald 2020-06-03 12:21:00 +10:00
parent 9b36beeb7a
commit f392e861ee
12 changed files with 274 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -13,7 +13,7 @@
*permission-store, *group-store, *invite-store,
sole
/+ shoe, default-agent, verb, dbug, store=chat-store,
group-store
group-store, grpl=group
::
|%
+$ card card:shoe
@ -196,6 +196,7 @@
--
::
|_ =bowl:gall
++ grp ~(. grpl bowl)
:: +prep: setup & state adapter
::
++ prep
@ -798,11 +799,7 @@
:: if they weren't permitted before, some hook will send an invite.
:: but if they already were, we want to send an invite ourselves.
::
?. %^ scry-for ?
%group-store
%+ welp
real-path
/permitted/[(scot %p ship)]
?. (is-permitted:grp ship real-path)
~
`(invite-card real-path ship)
:: whitelist: empty if no matching permission, else true if whitelist
@ -824,7 +821,7 @@
:- %group-action
!> ^- action:group-store
?: =(u.whitelist allow)
[%add-members group-id ships ~]
[%add-members group-id ships]
[%remove-members group-id ships]
:: +join: sync with remote mailbox
::

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

@ -194,7 +194,7 @@
%^ make-poke %group-store
%group-action
!> ^- action:group-store
[%add-members group-id who ~]
[%add-members group-id who]
==
::
++ hookup-group
@ -606,8 +606,13 @@
|= [wir=wire saw=(unit tang)]
^- (quip card _state)
?~ saw [~ state]
|^
?+ wir [~ state]
[%mailbox @ @ @ ~] (migrate t.wir)
::
[%store @ *]
?: ?=([@ @ @ ~] t.wir)
(migrate t.wir)
(poke-chat-hook-action %remove t.wir)
::
[%backlog @ @ @ *]
@ -620,6 +625,19 @@
u.saw
==
==
++ migrate
|= pax=path
^- (quip card _state)
?> ?=([@ @ @ ~] pax)
=/ =ship
(slav %p i.t.pax)
=^ cards state
(poke-chat-hook-action %remove pax)
:_ state
%+ snoc
cards
(chat-view-poke %join ship t.pax %.y)
--
::
++ chat-poke
|= act=action:store

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

@ -1,6 +1,6 @@
:: chat-store: data store that holds linear sequences of chat messages
::
/+ store=chat-store, default-agent, verb, dbug
/+ store=chat-store, default-agent, verb, dbug, group-store
~% %chat-store-top ..is ~
|%
+$ card card:agent:gall
@ -8,14 +8,16 @@
$% state-zero
state-one
state-two
state-three
==
::
+$ state-zero [%0 =inbox:store]
+$ state-one [%1 =inbox:store]
+$ state-two [%2 =inbox:store]
+$ state-zero [%0 =inbox:store]
+$ state-one [%1 =inbox:store]
+$ state-two [%2 =inbox:store]
+$ state-three [%3 =inbox:store]
--
::
=| state-two
=| state-three
=* state -
::
%- agent:dbug
@ -34,14 +36,11 @@
++ on-load
|= old-vase=vase
=/ old !<(versioned-state old-vase)
?: ?=(%2 -.old)
?: ?=(%3 -.old)
[~ this(state old)]
=/ reversed-inbox=inbox:store
%- ~(run by inbox.old)
|= =mailbox:store
^- mailbox:store
[config.mailbox (flop envelopes.mailbox)]
[~ this(state [%2 reversed-inbox])]
=/ =inbox:store
(migrate-path-map:group-store inbox.old)
`this(state [%3 inbox])
::
++ on-poke
~/ %chat-store-poke

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

@ -259,7 +259,7 @@
=/ =cage
:- %group-action
!> ^- action:group-store
[%add-members group-id (sy our.bol ~) ~]
[%add-members group-id (sy our.bol ~)]
:: we need this info in the wire to continue the flow after the
:: poke ack
=/ =wire
@ -294,7 +294,7 @@
(group-poke %remove-group old-group-id ~)
?. inclusive.u.existing.act
~
:- (group-poke %add-members group-id ships ~)
:- (group-poke %add-members group-id ships)
%+ turn
~(tap in ships)
|= =ship

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

@ -163,7 +163,7 @@
=/ =cage
:- %group-action
!> ^- action:group-store
[%add-members group-id.act (sy our.bol ~) ~]
[%add-members group-id.act (sy our.bol ~)]
=/ =wire
[%join-group path]
[%pass wire %agent [ship.group-id.act %group-hook] %poke cage]~
@ -255,7 +255,7 @@
=/ =cage
:- %group-action
!> ^- action:group-store
[%change-policy group-id %add-invites (sy ship ~)]
[%change-policy group-id %invite %add-invites (sy ship ~)]
[%pass / %agent [ship.group-id app] %poke cage]
++ send-invite
|= =invite

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

@ -27,7 +27,7 @@
:: Modify the group. Further documented in /sur/group-store.hoon
::
::
/- *group
/- *group, permission-store
/+ store=group-store, default-agent, verb, dbug
|%
+$ card card:agent:gall
@ -39,7 +39,7 @@
::
+$ state-zero
$: %0
* :: =groups
=groups:state-zero:store
==
::
::
@ -72,9 +72,124 @@
++ on-load
|= =old=vase
=/ old !<(versioned-state old-vase)
?. ?=(%1 -.old)
`this
`this(state old)
?: ?=(%1 -.old)
`this(state old)
|^
:- ~[kick-all]
=* paths ~(key by groups.old)
=/ [unmanaged=(list path) managed=(list path)]
(skid ~(tap in paths) |=(=path =('~' (snag 0 path))))
=. groups (all-unmanaged unmanaged)
=. groups (all-managed managed)
this
::
++ all-managed
|= paths=(list path)
^+ groups
?~ paths
groups
=/ [=group-id =group]
(migrate-group i.paths)
%= $
paths t.paths
::
groups
(~(put by groups) group-id group)
==
::
++ all-unmanaged
|= paths=(list path)
^+ groups
?~ paths
groups
=/ [=group-id =group]
(migrate-unmanaged i.paths)
%= $
paths t.paths
::
groups
(~(put by groups) group-id group)
==
++ kick-all
^- card
:+ %give %kick
:_ ~
%~ tap by
%+ roll ~(val by sup.bowl)
|= [[=ship pax=path] paths=(set path)]
(~(put in paths) pax)
::
++ migrate-unmanaged
|= pax=path
^- [group-id group]
=/ [=policy members=(set ship)]
(unmanaged-permissions pax)
?> =('~' -.pax)
=. pax +.pax
=/ =group-id
(need (group-id:de-path:store pax))
=/ =tags
(~(put ju *tags) %admin ship.group-id)
[group-id members tags policy %.y]
::
++ unmanaged-permissions
|= pax=path
^- [policy (set ship)]
=/ perm
(need (scry-group-permissions pax))
?: ?=(%black kind.perm)
:- [%open ~ who.perm]
~
:_ who.perm
*invite:policy
::
++ migrate-group
|= pax=path
=/ members
(~(got by groups.old) pax)
=^ =policy members
(migrate-permissions pax members)
=/ =group-id
(need (group-id:de-path:store pax))
=/ =tags
(~(put ju *tags) %admin ship.group-id)
[group-id members tags policy %.n]
::
++ migrate-permissions
|= [pax=path ships=(set ship)]
^- [policy (set ship)]
=/ perm
(scry-group-permissions pax)
?~ perm
[*invite:policy ships]
?> ?=(%white kind.u.perm)
[[%invite ~] (~(uni in ships) who.u.perm)]
::
++ scry-unmanaged-groups
^- (set path)
.^ (set path)
%gx
(scot %p our.bowl)
%permission-store
(scot %da now.bowl)
/keys/noun
==
::
++ scry-group-permissions
|= pax=path
^- (unit permission:permission-store)
.^ (unit permission:permission-store)
%gx
(scot %p our.bowl)
%permission-store
(scot %da now.bowl)
;: weld
/permission
pax
/noun
==
==
--
::
++ on-poke
|= [=mark =vase]
@ -187,8 +302,7 @@
++ add-group
|= [=group-id =policy hidden=?]
^- (quip card _state)
?: (~(has by groups) group-id)
[~ state]
?< (~(has by groups) group-id)
=| =group
=. members.group
(~(put in members.group) our.bol)
@ -202,17 +316,11 @@
(send-diff %add-group group-id policy hidden)
:: +add-members: add members to group
::
:: no-op if group does not exist
::
++ add-members
|= [=group-id new-ships=(set ship) tags=(set tag)]
|= [=group-id new-ships=(set ship)]
^- (quip card _state)
?. (~(has by groups) group-id)
[~ state]
=/ =group (~(got by groups) group-id)
=. members.group (~(uni in members.group) new-ships)
=. tags.group
(merge-tags tags.group new-ships tags)
=* policy policy.group
=. policy
?. ?=(%invite -.policy)
@ -223,7 +331,7 @@
=. groups
(~(put by groups) group-id group)
:_ state
(send-diff %add-members group-id new-ships tags)
(send-diff %add-members group-id new-ships)
:: +remove-members: remove members from group
::
:: no-op if group does not exist
@ -232,8 +340,6 @@
++ remove-members
|= [=group-id ships=(set ship)]
^- (quip card _state)
?. (~(has by groups) group-id)
[~ state]
=/ =group
(~(got by groups) group-id)
=. members.group
@ -246,14 +352,11 @@
(send-diff %remove-members group-id ships)
:: +add-tag: add tag to ships
::
:: no-op if group does not exist
:: crash if ships are not in group
::
++ add-tag
|= [=group-id =tag ships=(set ship)]
^- (quip card _state)
?. (~(has by groups) group-id)
[~ state]
=/ =group
(~(got by groups) group-id)
?> ?=(~ (~(dif in ships) members.group))
@ -265,14 +368,11 @@
(send-diff %add-tag group-id tag ships)
:: +remove-tag: remove tag from ships
::
:: no-op if group does not exist
:: crash if ships are not in group or tag does not exist (is this right?)
:: crash if ships are not in group or tag does not exist
::
++ remove-tag
|= [=group-id =tag ships=(set ship)]
^- (quip card _state)
?: (~(has by groups) group-id)
[~ state]
=/ =group
(~(got by groups) group-id)
?> ?& ?=(~ (~(dif in ships) members.group))
@ -309,13 +409,9 @@
|^
=^ cards group
?- -.diff
%allow-ranks (allow-ranks +.diff)
%ban-ranks (ban-ranks +.diff)
%allow-ships (allow-ships +.diff)
%ban-ships (ban-ships +.diff)
%add-invites (add-invites +.diff)
%remove-invites (remove-invites +.diff)
%replace (replace +.diff)
%open (open +.diff)
%invite (invite +.diff)
%replace (replace +.diff)
==
=. groups
(~(put by groups) group-id group)
@ -324,6 +420,22 @@
(send-diff %change-policy group-id diff)
cards
::
++ open
|= =diff:open:policy
?- -.diff
%allow-ranks (allow-ranks +.diff)
%ban-ranks (ban-ranks +.diff)
%allow-ships (allow-ships +.diff)
%ban-ships (ban-ships +.diff)
==
::
++ invite
|= =diff:invite:policy
?- -.diff
%add-invites (add-invites +.diff)
%remove-invites (remove-invites +.diff)
==
::
++ allow-ranks
|= ranks=(set rank:title)
^- (quip card _group)

19
pkg/arvo/app/link-view.hoon
View File

@ -10,6 +10,7 @@
:: /json/[n]/submission/[wood-url]/[collection] nth matching submission
:: /json/seen mark-as-read updates
::
::
/- *link-view,
*invite-store, *group,
link-listen-hook,
@ -214,7 +215,7 @@
%agent [ship.group-id %group-hook]
%poke %group-action
!> ^- action:group-store
[%add-members group-id (sy our.bowl ~) ~]
[%add-members group-id (sy our.bowl ~)]
==
:: sync the group
::
@ -235,7 +236,7 @@
%^ do-poke %link-listen-hook
%link-listen-action
!> ^- action:link-listen-hook
[%watch /[term.group-id]]
[%watch ~[term.group-id]]
==
::
++ handle-action
@ -294,16 +295,13 @@
==
?: ?=(%group -.members) ~
:: if the group is "real", make contact-view do the heavy lifting
:: TODO: verify
=/ =group-id
(need (group-id:de-path:group-store group-path))
=/ =policy
[%invite ships.members]
?: real-group
:- %^ do-poke %contact-view
%contact-view-action
!> ^- contact-view-action:contact-view
[%create term.group-id policy title description]
[%groupify group-id title description]
%+ turn ~(tap in ships.members)
|= =ship
^- card
@ -320,7 +318,8 @@
==
:: for "unmanaged" groups, do it ourselves
::
=/ =policy
[%invite ships.members]
:* :: create the new group
::
%^ do-poke %group-store
@ -394,10 +393,12 @@
%+ turn (groups-from-resource:md %link path)
|= =group=^path
^- (list card)
=/ =group-id
(need (group-id:de-path:group-store group-path))
:- %^ do-poke %group-store
%group-action
!> ~ :: ^- action:group-store
:: [%add ships group-path]
!> ^- action:group-store
[%add-members group-id ships]
:: for managed groups, rely purely on group logic for invites
::
?. ?=([%'~' ^] group-path)

12
pkg/arvo/app/publish.hoon
View File

@ -878,11 +878,7 @@
^- (quip card _state)
?. ?=(?(%remove-members %add-members) -.update)
[~ state]
=/ ships=(set ship)
?- -.update :: axes vary
%remove-members ships.update
%add-members ships.update
==
=* ships ships.update
=/ =path
(group-id:en-path:group-store group-id.update)
=/ book=(unit @tas)
@ -940,7 +936,7 @@
=/ =cage
:- %group-action
!> ^- action:group-store
[%add-members group-id (sy our.bol ~) ~]
[%add-members group-id (sy our.bol ~)]
:_ state
[%pass join-wire %agent [ship.group-id %group-hook] %poke cage]~
==
@ -1694,7 +1690,7 @@
=/ =cage
:- %group-action
!> ^- action:group-store
[%add-members group-id (sy our.bol ~) ~]
[%add-members group-id (sy our.bol ~)]
:_ state
[%pass join-wire %agent [who.act %group-hook] %poke cage]~
:: %unsubscribe
@ -1766,7 +1762,7 @@
(group-poke %remove-group old-group-id ~)
?. inclusive.act
~
:- (group-poke %add-members group-id ships ~)
:- (group-poke %add-members group-id ships)
%+ turn
~(tap in ships)
|= =ship

2
pkg/arvo/gen/group-store/join.hoon
View File

@ -7,4 +7,4 @@
==
:- %group-action
^- action
[%add-members [ship term] (sy p.beak ~) ~]
[%add-members [ship term] (sy p.beak ~)]

66
pkg/arvo/lib/group-store.hoon
View File

@ -3,6 +3,19 @@
=< [. sur]
=, sur
|%
++ migrate-path-map
|* map=(map path *)
=/ keys=(list path)
(skim ~(tap in ~(key by map)) |=(=path =('~' (snag 0 path))))
|-
?~ keys
map
=* key i.keys
?> ?=(^ key)
=/ value
(~(got by map) key)
$(keys t.keys, map (~(put by map) t.key value))
:: +en-path: transform into path
::
++ en-path
@ -66,6 +79,7 @@
|= =^initial
?> ?=(%initial -.initial)
%- pairs
^- (list [@t json])
%+ turn
~(tap by groups.initial)
|= [=^group-id grp=^group]
@ -154,15 +168,31 @@
++ policy-diff
|= =diff:^policy
%+ frond -.diff
%- pairs
?+ -.diff !!
%add-invites [invitees+(set ship invitees.diff) ~]
%remove-invites [invitees+(set ship invitees.diff) ~]
%allow-ranks [ranks+(set rank ranks.diff) ~]
%ban-ranks [ranks+(set rank ranks.diff) ~]
%allow-ships [ranks+(set ship ships.diff) ~]
%ban-ships [ranks+(set ship ships.diff) ~]
|^
?- -.diff
%invite (invite +.diff)
%open (open +.diff)
%replace (policy +.diff)
==
++ open
|= =diff:open:^policy
%+ frond -.diff
%- pairs
?- -.diff
%allow-ranks ~[ranks+(set rank ranks.diff)]
%ban-ranks ~[ranks+(set rank ranks.diff)]
%allow-ships ~[ranks+(set ship ships.diff)]
%ban-ships ~[ranks+(set ship ships.diff)]
==
++ invite
|= =diff:invite:^policy
%+ frond -.diff
%- pairs
?- -.diff
%add-invites ~[invitees+(set ship invitees.diff)]
%remove-invites ~[invitees+(set ship invitees.diff)]
==
--
::
++ groupify
|= =^update
@ -311,17 +341,26 @@
:~ ban-ranks+(as rank)
banned+(as ship)
==
++ policy-diff
^- $-(json diff:^policy)
++ open-policy-diff
%- of
:~ add-invites+(as ship)
remove-invites+(as ship)
allow-ranks+(as rank)
:~ allow-ranks+(as rank)
allow-ships+(as ship)
ban-ranks+(as rank)
ban-ships+(as ship)
==
++ invite-policy-diff
%- of
:~ add-invites+(as ship)
remove-invites+(as ship)
==
++ policy-diff
^- $-(json diff:^policy)
%- of
:~ invite+invite-policy-diff
open+open-policy-diff
replace+policy
==
::
++ group-id
%- ot
:~ ship+ship
@ -353,7 +392,6 @@
%- ot
:~ group-id+group-id
ships+(as ship)
tags+(as tag)
==
++ remove-members
^- $-(json [^group-id (set ^ship)])

28
pkg/arvo/sur/group-store.hoon
View File

@ -1,21 +1,39 @@
/- *group
|%
::
++ state-zero
|%
+$ group (set ship)
::
+$ group-action
$% [%add members=group pax=path] :: add member to group
[%remove members=group pax=path] :: remove member from group
[%bundle pax=path] :: create group at path
[%unbundle pax=path] :: delete group at path
==
::
+$ group-update
$% [%keys keys=(set path)] :: keys have changed
[%path members=group pax=path]
group-action
==
::
+$ groups (map path group)
--
:: $action: request to change group-store state
::
:: %add-group: add a group
:: %add-members: add members to a group
:: %remove-members: remove members from a group
:: %add-tag: add a tag to a set of ships, creating the tag if it doesn't exist
:: %remove-tag:
:: remove a tag from a set of ships. If the set is empty remove the tag
:: from the group.
:: %add-tag: add a tag to a set of ships
:: %remove-tag: remove a tag from a set of ships
:: %change-policy: change a group's policy
:: %remove-group: remove a group from the store
:: %groupify: unset .hidden flag
::
+$ action
$% [%add-group =group-id =policy hidden=?]
[%add-members =group-id ships=(set ship) tags=(set tag)]
[%add-members =group-id ships=(set ship)]
[%remove-members =group-id ships=(set ship)]
[%add-tag =group-id =tag ships=(set ship)]
[%remove-tag =group-id =tag ships=(set ship)]

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

@ -34,7 +34,7 @@
:: $group: description of a group of users
::
:: .members: members of the group
:: .tag-queries: a map of subsets
:: .tag-queries: a map of tags to subsets of members
:: .policy: permissions for the group
:: .hidden: is group unmanaged
+$ group
@ -55,8 +55,8 @@
==
:: $diff: change group policy
+$ diff
$% diff:invite
diff:open
$% [%invite diff:invite]
[%open diff:open]
[%replace =policy]
==
:: $invite: allow only invited ships