urbit/pkg/arvo/app/group-store.hoon

434 lines
11 KiB
Plaintext
Raw Normal View History

2020-05-15 01:50:04 +03:00
:: group-store: Store groups of ships
2019-11-21 02:18:45 +03:00
::
2020-05-15 01:50:04 +03:00
:: group-store stores groups of ships, so that resources in other apps can be
:: associated with a group. The current model of group-store rolls
:: permissions and invites inside this store for simplicity reasons, although
:: these should be prised apart in a future revision of group store.
::
2020-05-21 07:30:02 +03:00
::
2020-05-15 01:50:04 +03:00
:: ## Scry paths
::
:: /y/groups:
:: A listing of the current groups
:: /y/groups/[group-id]/tag-queries:
:: A listing of the tag queries for a group
:: /x/groups/[group-id]:
:: The group itself
2020-05-21 07:30:02 +03:00
:: /x/groups/[group-id]/join/[ship]:
:: A flag indicated if the ship is permitted to join
2020-05-15 01:50:04 +03:00
::
:: ## Subscription paths
::
:: /groups:
:: A stream of the current updates to the state, sending the initial state
:: upon subscribe.
::
:: ## Pokes
::
:: %group-action:
:: Modify the group. Further documented in /sur/group-store.hoon
::
::
/- *group
/+ store=group-store, default-agent, verb, dbug
2019-11-21 02:18:45 +03:00
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
2020-05-15 01:50:04 +03:00
state-one
2019-11-21 02:18:45 +03:00
==
::
+$ state-zero
$: %0
2020-05-15 01:50:04 +03:00
* :: =groups
==
::
::
+$ state-one
$: %1
2019-11-21 02:18:45 +03:00
=groups
==
::
2020-05-15 01:50:04 +03:00
+$ diff
$% [%group-update update:store]
[%group-initial groups]
==
2019-11-21 02:18:45 +03:00
--
::
2020-05-15 01:50:04 +03:00
=| state-one
2019-11-21 02:18:45 +03:00
=* state -
::
%- agent:dbug
%+ verb |
2019-11-21 02:18:45 +03:00
^- agent:gall
=<
|_ =bowl:gall
+* this .
group-core +>
2020-01-04 00:06:42 +03:00
gc ~(. group-core bowl)
2019-11-21 02:18:45 +03:00
def ~(. (default-agent this %|) bowl)
::
2020-05-21 07:30:02 +03:00
++ on-init on-init:def
2019-11-21 02:18:45 +03:00
++ on-save !>(state)
++ on-load
2020-05-15 01:50:04 +03:00
|= =old=vase
=/ old !<(versioned-state old-vase)
?. ?=(%1 -.old)
`this
`this(state old)
2019-11-21 02:18:45 +03:00
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
2020-05-21 07:30:02 +03:00
?: ?=(?(%group-update %group-action) mark)
2020-05-15 01:50:04 +03:00
(poke-group-update:gc !<(update:store vase))
2019-11-21 02:18:45 +03:00
(on-poke:def mark vase)
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
2020-05-15 01:50:04 +03:00
?> ?=([%groups ~] path)
:_ this
2020-05-21 07:30:02 +03:00
[%give %fact ~ %group-update !>([%initial groups])]~
2019-11-21 02:18:45 +03:00
::
++ on-leave on-leave:def
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
2020-05-21 07:30:02 +03:00
[%x %groups @ @ ~]
=/ group-id
(group-id:de-path:store t.t.path)
?~ group-id ~
``noun+!>((peek-group u.group-id))
[%x %groups @ @ %join @ ~]
=/ group-id
(group-id:de-path:store t.t.path)
=/ =ship
(slav %p i.t.t.t.t.t.path)
?~ group-id ~
``noun+!>((peek-group-join u.group-id ship))
2020-05-15 01:50:04 +03:00
::
2020-05-21 07:30:02 +03:00
[%x %groups @ @ %role @ ~]
=/ group-id
(group-id:de-path:store t.t.path)
?~ group-id ~
=/ =ship
(slav %p i.t.t.t.t.t.path)
``noun+!>((peek-group-role u.group-id ship))
2019-11-21 02:18:45 +03:00
==
::
2020-01-04 00:06:42 +03:00
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
2019-11-21 02:18:45 +03:00
--
::
|_ bol=bowl:gall
2020-05-15 01:50:04 +03:00
++ ship-rank
|= =ship
^- rank
=/ size
(met 3 ship)
?: (lte size 2)
%0
?: (lte size 4)
%1
?: (lte size 8)
%2
%3
2020-05-21 07:30:02 +03:00
++ peek-group
|= =group-id
^- (unit group)
(~(get by groups) group-id)
++ peek-group-join
|= [=group-id =ship]
=/ =group
(~(gut by groups) group-id *group)
2020-05-15 01:50:04 +03:00
=* policy policy.group
?- -.policy
%invite
|((~(has in pending.policy) ship) (~(has in members.group) ship))
%open
&(!(~(has in banned.policy) ship) (~(has in ranks.policy) (ship-rank ship)))
==
2020-05-21 07:30:02 +03:00
++ peek-group-role
|= [=group-id =ship]
=/ =group
(~(got by groups) group-id)
=* policy policy.group
=* tag-queries tag-queries.group
=/ admins=(set ^ship)
(~(gut by tag-queries) %admin ~)
?: (~(has in admins) ship)
`%admin
=/ mods
(~(gut by tag-queries) %moderator ~)
?: (~(has in mods) ship)
`%moderator
=/ janitors
(~(gut by tag-queries) %janitor ~)
?. (~(has in janitors) ship)
~
`%janitor
2020-05-15 01:50:04 +03:00
::
++ poke-group-update
|= =update:store
2019-11-21 02:18:45 +03:00
^- (quip card _state)
?> (team:title our.bol src.bol)
2020-05-15 01:50:04 +03:00
|^
?- -.update
%add-group (add-group +.update)
%add-members (add-members +.update)
%remove-members (remove-members +.update)
%add-tag (add-tag +.update)
%remove-tag (remove-tag +.update)
%change-policy (change-policy +.update)
%remove-group (remove-group +.update)
%initial-group (initial-group +.update)
%initial [~ state]
2019-11-21 02:18:45 +03:00
==
2020-05-15 01:50:04 +03:00
:: +add-group: add group to store
::
2020-05-21 07:30:02 +03:00
:: always include ship in own groups, no-op if group already exists
2020-05-15 01:50:04 +03:00
::
++ add-group
2020-05-21 07:30:02 +03:00
|= [=group-id =policy]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
?: (~(has by groups) group-id)
[~ state]
2020-05-21 07:30:02 +03:00
=| =group
=. members.group
(~(put in members.group) our.bol)
=. policy.group policy
2020-05-15 01:50:04 +03:00
=. groups
(~(put by groups) group-id group)
:_ state
2020-05-21 07:30:02 +03:00
(send-diff %add-group group-id policy)
2020-05-15 01:50:04 +03:00
:: +add-members: add members to group
::
:: no-op if group does not exist
::
++ add-members
|= [=group-id new-ships=(set ship) tags=(set tag)]
^- (quip card _state)
?. (~(has by groups) group-id)
[~ state]
=/ =group (~(got by groups) group-id)
=. members.group (~(uni in members.group) new-ships)
=. tag-queries.group
(merge-tags tag-queries.group new-ships tags)
2020-05-21 07:30:02 +03:00
=* policy policy.group
=. policy
?. ?=(%invite -.policy)
policy
=. pending.policy
(~(dif in pending.policy) new-ships)
policy
2020-05-15 01:50:04 +03:00
=. groups
(~(put by groups) group-id group)
:_ state
(send-diff %add-members group-id new-ships tags)
:: +remove-members: remove members from group
::
:: no-op if group does not exist
2020-05-21 07:30:02 +03:00
::
2020-05-15 01:50:04 +03:00
::
++ remove-members
|= [=group-id ships=(set ship)]
^- (quip card _state)
?. (~(has by groups) group-id)
[~ state]
=/ =group
(~(got by groups) group-id)
=. members.group
(~(dif in members.group) ships)
2020-05-21 07:30:02 +03:00
=. tag-queries.group
(remove-tags group ships)
2020-05-15 01:50:04 +03:00
=. groups
(~(put by groups) group-id group)
:_ state
(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 (is this right?)
::
++ 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))
=. tag-queries.group
(merge-tags tag-queries.group ships (sy tag ~))
=. groups
(~(put by groups) group-id group)
:_ state
(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?)
::
++ 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))
(~(has by tag-queries.group) tag)
==
=/ tag-query
(~(got by tag-queries.group) tag)
=. tag-query
(~(dif in tag-query) ships)
=. tag-queries.group
(~(put by tag-queries.group) tag tag-query)
:_ state
(send-diff %remove-tag group-id tag ships)
:: initial-group: initialize foreign group
::
++ initial-group
|= [=group-id =group]
^- (quip card _state)
=. groups
(~(put by groups) group-id group)
:_ state
(send-diff %initial-group group-id group)
:: +change-policy: modify group access control
::
2020-05-21 07:30:02 +03:00
:: If the change will kick members, then send a separate
:: %remove-members diff after the %change-policy diff
2020-05-15 01:50:04 +03:00
++ change-policy
|= [=group-id =diff:policy]
^- (quip card _state)
?. (~(has by groups) group-id)
[~ state]
=/ =group
(~(got by groups) group-id)
|^
2020-05-21 07:30:02 +03:00
=^ 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)
2020-05-15 01:50:04 +03:00
==
=. groups
(~(put by groups) group-id group)
:_ state
2020-05-21 07:30:02 +03:00
%+ weld
(send-diff %change-policy group-id diff)
cards
2020-05-15 01:50:04 +03:00
::
++ allow-ranks
|= ranks=(set rank)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. ranks.policy.group
(~(uni in ranks.policy.group) ranks)
`group
2020-05-15 01:50:04 +03:00
::
++ ban-ranks
|= ranks=(set rank)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. ranks.policy.group
(~(dif in ranks.policy.group) ranks)
`group
2020-05-15 01:50:04 +03:00
::
++ allow-ships
|= ships=(set ship)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. banned.policy.group
(~(dif in banned.policy.group) ships)
`group
2020-05-15 01:50:04 +03:00
::
++ ban-ships
|= ships=(set ship)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. banned.policy.group
(~(uni in banned.policy.group) ships)
=/ to-remove=(set ship)
(~(int in members.group) banned.policy.group)
:- ~[(poke-us %remove-members group-id to-remove)]
group
::
++ add-invites
|= ships=(set ship)
^- (quip card _group)
?> ?=(%invite -.policy.group)
=. pending.policy.group
(~(uni in pending.policy.group) ships)
`group
::
++ remove-invites
|= ships=(set ship)
^- (quip card _group)
?> ?=(%invite -.policy.group)
=. pending.policy.group
(~(uni in pending.policy.group) ships)
`group
++ replace
|= =policy
^- (quip card _group)
=. policy.group
policy
`group
2020-05-15 01:50:04 +03:00
--
:: +remove-group: remove group from store
::
:: no-op if group does not exist
++ remove-group
|= [=group-id ~]
^- (quip card _state)
?. (~(has by groups) group-id)
`state
=. groups
(~(del by groups) group-id)
:_ state
(send-diff %remove-group group-id ~)
::
--
2020-05-21 07:30:02 +03:00
++ remove-tags
|= [=group ships=(set ship)]
^- tag-quries
%- malt
%+ spin
~(tap by tag-queries.group)
tag-queries.group
|= [=tag tagged=(set ship)]
:- tag
(~(dif in tagged) ships)
::
++ poke-us
|= =action:store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(action)]
2020-05-15 01:50:04 +03:00
:: +send-diff: update subscribers of new state
2019-11-21 02:18:45 +03:00
::
2020-05-15 01:50:04 +03:00
:: We only allow subscriptions on /groups
:: so just give the fact there.
2019-11-21 02:18:45 +03:00
++ send-diff
2020-05-15 01:50:04 +03:00
|= =update:store
2019-11-21 02:18:45 +03:00
^- (list card)
2020-05-15 01:50:04 +03:00
[%give %fact ~[/groups] %group-update !>(update)]~
2019-11-21 02:18:45 +03:00
::
--