mirror of
https://github.com/ilyakooo0/urbit.git
synced 2025-01-06 23:16:29 +03:00
groups: finish rewrite
This commit is contained in:
Liam Fitzgerald
parent
d2de8d72eb
commit
f60181871a
@ -1,7 +1,7 @@
|
|||||||
:: group-hook: allow syncing group data from foreign paths to local paths
|
:: group-hook: allow syncing group data from foreign paths to local paths
|
||||||
::
|
::
|
||||||
/- *group, store=group-store, hook=group-hook
|
/- *group, hook=group-hook, *invite-store
|
||||||
/+ default-agent, verb, dbug
|
/+ default-agent, verb, dbug, store=group-store, grpl=group
|
||||||
~% %group-hook-top ..is ~
|
~% %group-hook-top ..is ~
|
||||||
|%
|
|%
|
||||||
+$ card card:agent:gall
|
+$ card card:agent:gall
|
||||||
@ -19,7 +19,8 @@
|
|||||||
::
|
::
|
||||||
+$ state-one
|
+$ state-one
|
||||||
$: %1
|
$: %1
|
||||||
synced=(map group-id ship)
|
listening=(set group-id)
|
||||||
|
proxied=(jug group-id ship)
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
--
|
--
|
||||||
@ -30,34 +31,422 @@
|
|||||||
%- agent:dbug
|
%- agent:dbug
|
||||||
%+ verb |
|
%+ verb |
|
||||||
^- agent:gall
|
^- agent:gall
|
||||||
|_ =bowl:gall
|
=<
|
||||||
+* this .
|
|_ =bowl:gall
|
||||||
group-core +>
|
+* this .
|
||||||
gc ~(. group-core bowl)
|
group-core +>
|
||||||
def ~(. (default-agent this %|) bowl)
|
gc ~(. group-core bowl)
|
||||||
|
def ~(. (default-agent this %|) bowl)
|
||||||
|
::
|
||||||
|
++ on-init
|
||||||
|
^- (quip card _this)
|
||||||
|
:_ this
|
||||||
|
:- [%pass /invites %agent [our.bowl %invite-store] %poke %invite-action !>([%create /groups])]
|
||||||
|
~[watch-invites:gc watch-store:gc]
|
||||||
|
++ on-save !>(state)
|
||||||
|
++ on-load
|
||||||
|
|= =vase
|
||||||
|
^- (quip card _this)
|
||||||
|
=/ old !<(state-one vase)
|
||||||
|
`this(state old)
|
||||||
|
:: %+ murn ~(tap by synced.old)
|
||||||
|
:: |= [=path =ship]
|
||||||
|
:: ^- (unit card)
|
||||||
|
:: =/ =wire [(scot %p ship) %group path]
|
||||||
|
:: =/ =term ?:(=(our.bowl ship) %group-store %group-hook)
|
||||||
|
:: ?: (~(has by wex.bowl) [wire ship term]) ~
|
||||||
|
:: `[%pass wire %agent [ship term] %watch [%group path]]
|
||||||
|
::
|
||||||
|
++ on-poke
|
||||||
|
|= [=mark =vase]
|
||||||
|
^- (quip card _this)
|
||||||
|
=^ cards state
|
||||||
|
?+ mark (on-poke:def mark vase)
|
||||||
|
%group-action (poke-group-update:gc !<(action:store vase))
|
||||||
|
%group-hook-action (poke-hook-action:gc !<(action:hook vase))
|
||||||
|
==
|
||||||
|
[cards this]
|
||||||
|
::
|
||||||
|
++ on-agent
|
||||||
|
|= [=wire =sign:agent:gall]
|
||||||
|
^- (quip card _this)
|
||||||
|
=^ cards state
|
||||||
|
?+ -.wire (on-agent:def:gc wire sign)
|
||||||
|
%invites (take-invite-sign:gc wire sign)
|
||||||
|
%store (take-store-sign:gc wire sign)
|
||||||
|
%proxy (take-proxy-sign:gc wire sign)
|
||||||
|
==
|
||||||
|
[cards this]
|
||||||
|
::
|
||||||
|
++ on-watch
|
||||||
|
|= =path
|
||||||
|
^- (quip card _this)
|
||||||
|
?< (team:title [our src]:bowl)
|
||||||
|
?> ?=([%groups *] path)
|
||||||
|
=/ =group-id
|
||||||
|
(need (group-id:de-path:store t.path))
|
||||||
|
?> (permitted:gc src.bowl group-id)
|
||||||
|
=^ cards state
|
||||||
|
(start-proxy:gc src.bowl group-id)
|
||||||
|
[cards this]
|
||||||
|
::
|
||||||
|
++ on-leave
|
||||||
|
|= =path
|
||||||
|
^- (quip card _this)
|
||||||
|
?> ?=([%groups @ @ ~] path)
|
||||||
|
=/ =group-id
|
||||||
|
(need (group-id:de-path:store t.path))
|
||||||
|
=^ cards state
|
||||||
|
(stop-proxy:gc src.bowl group-id)
|
||||||
|
[cards this]
|
||||||
|
++ on-peek on-peek:def
|
||||||
|
++ on-arvo on-arvo:def
|
||||||
|
++ on-fail on-fail:def
|
||||||
|
--
|
||||||
|
|_ bol=bowl:gall
|
||||||
|
++ def ~(. (default-agent state %|) bol)
|
||||||
|
++ grp ~(. grpl bol)
|
||||||
|
:: +| %pokes
|
||||||
::
|
::
|
||||||
++ on-init on-init:def
|
:: +poke-group-update: Proxy poke to %group-store
|
||||||
++ on-save !>(state)
|
|
||||||
++ on-load
|
|
||||||
|= =vase
|
|
||||||
^- (quip card _this)
|
|
||||||
=/ old !<(state-one vase)
|
|
||||||
:_ this(state old)
|
|
||||||
%+ murn ~(tap by synced.old)
|
|
||||||
|= [=path =ship]
|
|
||||||
^- (unit card)
|
|
||||||
=/ =wire [(scot %p ship) %group path]
|
|
||||||
=/ =term ?:(=(our.bowl ship) %group-store %group-hook)
|
|
||||||
?: (~(has by wex.bowl) [wire ship term]) ~
|
|
||||||
`[%pass wire %agent [ship term] %watch [%group path]]
|
|
||||||
::
|
::
|
||||||
++ on-leave on-leave:def
|
:: Only proxy pokes if permissions are correct and we host the group.
|
||||||
++ on-peek on-peek:def
|
|
||||||
++ on-arvo on-arvo:def
|
|
||||||
++ on-fail on-fail:def
|
|
||||||
::
|
::
|
||||||
++ on-poke on-poke:def
|
++ poke-group-update
|
||||||
++ on-watch on-watch:def
|
|= =update:store
|
||||||
++ on-agent on-agent:def
|
^- (quip card _state)
|
||||||
>>>>>>> 457bd4c3a... groups: begin rewrite
|
?: ?=(%initial -.update)
|
||||||
|
[~ state]
|
||||||
|
?> =(ship.group-id.update our.bol)
|
||||||
|
=/ =path
|
||||||
|
(group-id:en-path:store group-id.update)
|
||||||
|
?> (should-proxy-poke update)
|
||||||
|
?> (is-permitted:grp src.bol path)
|
||||||
|
:_ state
|
||||||
|
[%pass [%store path] %agent [our.bol %group-store] %poke %group-update !>(update)]~
|
||||||
|
:: +poke-hook-action: Start/stop syncing a foreign group
|
||||||
|
::
|
||||||
|
++ poke-hook-action
|
||||||
|
|= =action:hook
|
||||||
|
^- (quip card _state)
|
||||||
|
|^
|
||||||
|
?- -.action
|
||||||
|
%add (add +.action)
|
||||||
|
%remove (remove +.action)
|
||||||
|
==
|
||||||
|
++ add
|
||||||
|
|= =group-id
|
||||||
|
^- (quip card _state)
|
||||||
|
?: (~(has in listening) group-id)
|
||||||
|
`state
|
||||||
|
=. listening
|
||||||
|
(~(put in listening) group-id)
|
||||||
|
:_ state
|
||||||
|
:~ (listen-group group-id)
|
||||||
|
(add-self group-id)
|
||||||
|
==
|
||||||
|
++ remove
|
||||||
|
|= =group-id
|
||||||
|
^- (quip card _state)
|
||||||
|
?. (~(has in listening) group-id)
|
||||||
|
`state
|
||||||
|
=. listening
|
||||||
|
(~(del in listening) group-id)
|
||||||
|
:_ state
|
||||||
|
(leave-group group-id)
|
||||||
|
--
|
||||||
|
:: |signs: signs from agents
|
||||||
|
::
|
||||||
|
:: +| %signs
|
||||||
|
++ take-invite-sign
|
||||||
|
|= [=wire =sign:agent:gall]
|
||||||
|
^- (quip card _state)
|
||||||
|
|^
|
||||||
|
?+ -.sign (on-agent:def wire sign)
|
||||||
|
%kick [~[watch-invites] state]
|
||||||
|
::
|
||||||
|
%fact
|
||||||
|
?. =(%invite-update p.cage.sign)
|
||||||
|
[~ state]
|
||||||
|
(fact !<(invite-update q.cage.sign))
|
||||||
|
==
|
||||||
|
++ fact
|
||||||
|
|= update=invite-update
|
||||||
|
^- (quip card _state)
|
||||||
|
?+ -.update [~ state]
|
||||||
|
%invite
|
||||||
|
=* invite invite.update
|
||||||
|
?. =(our.bol ship.invite)
|
||||||
|
[~ state]
|
||||||
|
=/ =group-id
|
||||||
|
(need (group-id:de-path:store path.invite))
|
||||||
|
=/ =cage
|
||||||
|
:- %group-update
|
||||||
|
!> ^- update:store
|
||||||
|
[%change-policy group-id [%add-invites (sy recipient.invite ~)]]
|
||||||
|
:_ state
|
||||||
|
[%pass [%store path.invite] %agent [our.bol %group-store] %poke cage]~
|
||||||
|
%accepted
|
||||||
|
=* invite invite.update
|
||||||
|
?. =(our.bol ship.invite)
|
||||||
|
[~ state]
|
||||||
|
=/ =group-id
|
||||||
|
(need (group-id:de-path:store path.update))
|
||||||
|
=/ =cage
|
||||||
|
:- %group-update
|
||||||
|
!> ^- update:store
|
||||||
|
[%add-members group-id (sy recipient.invite ~) ~]
|
||||||
|
:_ state
|
||||||
|
[%pass [%store path.invite] %agent [our.bol %group-store] %poke cage]~
|
||||||
|
==
|
||||||
|
--
|
||||||
|
:: +take-proxy-sign: take sign from foreign %group-hook
|
||||||
|
::
|
||||||
|
++ take-proxy-sign
|
||||||
|
|= [=wire =sign:agent:gall]
|
||||||
|
^- (quip card _state)
|
||||||
|
=/ =group-id
|
||||||
|
~| "bad proxy wire: {<wire>}"
|
||||||
|
(need (group-id:de-path:store +.wire))
|
||||||
|
|^
|
||||||
|
?+ -.sign (on-agent:def wire sign)
|
||||||
|
%kick [~[(listen-group group-id)] state]
|
||||||
|
::
|
||||||
|
%fact
|
||||||
|
?. ?=(%group-update p.cage.sign)
|
||||||
|
[~ state]
|
||||||
|
(fact !<(update:store q.cage.sign))
|
||||||
|
==
|
||||||
|
::
|
||||||
|
:: +fact: Handle new update from %group-hook
|
||||||
|
::
|
||||||
|
++ fact
|
||||||
|
|= =update:store
|
||||||
|
^- (quip card _state)
|
||||||
|
?: ?=(%initial -.update)
|
||||||
|
[~ state]
|
||||||
|
:_ state
|
||||||
|
[%pass [%store wire] %agent [our.bol %group-store] %poke %group-update !>(update)]~
|
||||||
|
--
|
||||||
|
:: +take-store-sign: Handle incoming sign from %group-store
|
||||||
|
::
|
||||||
|
:: group-store should send us all its store updates over a subscription on
|
||||||
|
:: /groups. We also proxy pokes to it.
|
||||||
|
::
|
||||||
|
++ take-store-sign
|
||||||
|
|= [=wire =sign:agent:gall]
|
||||||
|
^- (quip card _state)
|
||||||
|
|^
|
||||||
|
?+ -.sign (on-agent:def wire sign)
|
||||||
|
%kick [~[watch-store] state]
|
||||||
|
::
|
||||||
|
%fact
|
||||||
|
?+ p.cage.sign ~|("{<dap.bol>} unexpected mark: {<p.cage.sign>}" !!)
|
||||||
|
%group-initial [~ state]
|
||||||
|
%group-update (fact !<(update:store q.cage.sign))
|
||||||
|
==
|
||||||
|
==
|
||||||
|
:: +take-store-update: Handle new %fact from %group-store
|
||||||
|
::
|
||||||
|
:: We forward the update onto the correct path, and recalculate permissions,
|
||||||
|
:: kicking any subscriptions whose permissions have been revoked.
|
||||||
|
::
|
||||||
|
++ fact
|
||||||
|
|= =update:store
|
||||||
|
^- (quip card _state)
|
||||||
|
?: ?=(%initial -.update)
|
||||||
|
`state
|
||||||
|
=/ =path
|
||||||
|
(group-id:en-path:store group-id.update)
|
||||||
|
?. (~(has by proxied) group-id.update)
|
||||||
|
[~ state]
|
||||||
|
=^ cards state
|
||||||
|
(handle-revocations update)
|
||||||
|
:_ state
|
||||||
|
:- [%give %fact [%groups path]~ %group-update !>(update)]
|
||||||
|
cards
|
||||||
|
--
|
||||||
|
:: +listen-group: Start a new subscription to the proxied .group-id
|
||||||
|
::
|
||||||
|
++ listen-group
|
||||||
|
|= =group-id
|
||||||
|
^- card
|
||||||
|
=/ pax=path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
[%pass [%proxy pax] %agent [ship.group-id %group-hook] %watch [%groups pax]]
|
||||||
|
:: +add-self: Add self to group
|
||||||
|
++ add-self
|
||||||
|
|= =group-id
|
||||||
|
^- card
|
||||||
|
=/ pax=path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
=/ =cage
|
||||||
|
:- %group-action
|
||||||
|
!> ^- action:store
|
||||||
|
[%add-members group-id (sy our.bol ~) ~]
|
||||||
|
[%pass [%proxy pax] %agent [ship.group-id %group-hook] %poke cage]
|
||||||
|
:: +leave-group: Leave a foreign group
|
||||||
|
::
|
||||||
|
++ leave-group
|
||||||
|
|= =group-id
|
||||||
|
^- (list card)
|
||||||
|
=/ pax=path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
:~ [%pass [%proxy pax] %agent [ship.group-id %group-hook] %leave ~]
|
||||||
|
[%pass [%store pax] %agent [our.bol %group-store] %poke %group-update !>([%remove-group group-id ~])]
|
||||||
|
[%pass [%proxy pax] %agent [ship.group-id %group-hook] %poke %group-action !>([%remove-members group-id (sy our.bol ~)])]
|
||||||
|
==
|
||||||
|
:: +store-leave-group: Remove a foreign group from our group-store
|
||||||
|
::
|
||||||
|
++ store-leave-group
|
||||||
|
|= =group-id
|
||||||
|
^- card
|
||||||
|
=/ pax=path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
[%pass [%store pax] %agent [our.bol %group-store] %poke %group-update !>([%remove-group group-id ~])]
|
||||||
|
:: +should-proxy-poke: Check if poke should be proxied
|
||||||
|
::
|
||||||
|
:: We only allow users to add and remove themselves.
|
||||||
|
++ should-proxy-poke
|
||||||
|
|= =update:store
|
||||||
|
^- ?
|
||||||
|
?: ?=(%initial -.update)
|
||||||
|
%.n
|
||||||
|
|^
|
||||||
|
=/ role=(unit role-tag)
|
||||||
|
(role-for-ship:grp group-id.update src.bol)
|
||||||
|
?~ role
|
||||||
|
member
|
||||||
|
?- u.role
|
||||||
|
%admin admin
|
||||||
|
%moderator moderator
|
||||||
|
%janitor member
|
||||||
|
==
|
||||||
|
++ member
|
||||||
|
?: ?=(%add-members -.update)
|
||||||
|
=(~(tap in ships.update) ~[src.bol])
|
||||||
|
?: ?=(%remove-members -.update)
|
||||||
|
=(~(tap in ships.update) ~[src.bol])
|
||||||
|
%.n
|
||||||
|
++ admin
|
||||||
|
!?=(?(%remove-group %add-group) -.update)
|
||||||
|
++ moderator
|
||||||
|
?= $? %add-members %remove-members
|
||||||
|
%add-tag %remove-tag ==
|
||||||
|
-.update
|
||||||
|
--
|
||||||
|
::
|
||||||
|
:: +handle-revocations: Handle revoked permissions from a update:store
|
||||||
|
::
|
||||||
|
:: If the mutation to the group store has impacted permissions, then kick
|
||||||
|
:: relevant subscriptions and remove them from our state
|
||||||
|
::
|
||||||
|
++ handle-revocations
|
||||||
|
|= =update:store
|
||||||
|
^- (quip card _state)
|
||||||
|
?+ -.update [~ state]
|
||||||
|
::
|
||||||
|
%remove-group
|
||||||
|
=* group-id group-id.update
|
||||||
|
=/ =path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
=. proxied
|
||||||
|
(~(del by proxied) group-id)
|
||||||
|
:_ state
|
||||||
|
[%give %kick [%groups path]~ ~]~
|
||||||
|
::
|
||||||
|
%remove-members
|
||||||
|
=* group-id group-id.update
|
||||||
|
=/ =path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
=/ to-kick=(list ship)
|
||||||
|
~(tap in ships.update)
|
||||||
|
=/ subs=(set ship)
|
||||||
|
(~(gut by proxied) group-id ~)
|
||||||
|
=| cards=(list card)
|
||||||
|
|-
|
||||||
|
?~ to-kick
|
||||||
|
[cards state]
|
||||||
|
=. proxied
|
||||||
|
(~(del ju proxied) group-id i.to-kick)
|
||||||
|
=. cards
|
||||||
|
[[%give %kick [%groups path]~ `i.to-kick] cards]
|
||||||
|
$(to-kick t.to-kick)
|
||||||
|
==
|
||||||
|
:: +start-proxy: Start proxying .path to .who
|
||||||
|
::
|
||||||
|
++ start-proxy
|
||||||
|
|= [who=ship =group-id]
|
||||||
|
^- (quip card _state)
|
||||||
|
=. proxied
|
||||||
|
(~(put ju proxied) group-id who)
|
||||||
|
[(give-initial group-id) state]
|
||||||
|
:: +stop-proxy: Stop proxying .path to .who
|
||||||
|
::
|
||||||
|
++ stop-proxy
|
||||||
|
|= [who=ship =group-id]
|
||||||
|
^- (quip card _state)
|
||||||
|
=. proxied
|
||||||
|
(~(del ju proxied) group-id who)
|
||||||
|
`state
|
||||||
|
:: +can-join: check if .ship can join .group-id
|
||||||
|
::
|
||||||
|
++ can-join
|
||||||
|
|= [=ship =group-id]
|
||||||
|
^- ?
|
||||||
|
=/ =path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
=* group-id u.u-group-id
|
||||||
|
=/ scry-path=^path
|
||||||
|
(welp [%groups path] /join/[(scot %p ship)])
|
||||||
|
(scry-store ? scry-path)
|
||||||
|
:: +give-initial: give initial state for .group-id
|
||||||
|
::
|
||||||
|
:: Must be called in +on-watch. No-ops if the group does not exist yet
|
||||||
|
++ give-initial
|
||||||
|
|= =group-id
|
||||||
|
^- (list card)
|
||||||
|
=/ =path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
=/ u-group
|
||||||
|
(scry-store (unit group) [%groups path])
|
||||||
|
?~ u-group ~
|
||||||
|
=* group u.u-group
|
||||||
|
=/ =cage
|
||||||
|
:- %group-update
|
||||||
|
!> ^- update:store
|
||||||
|
[%initial-group group-id group]
|
||||||
|
[%give %fact ~ cage]~
|
||||||
|
++ scry-initial
|
||||||
|
|= =group-id
|
||||||
|
^- (unit group)
|
||||||
|
=/ =path
|
||||||
|
(group-id:en-path:store group-id)
|
||||||
|
(scry-store (unit group) [%groups path])
|
||||||
|
::
|
||||||
|
++ scry-role
|
||||||
|
|= [=group-id =ship]
|
||||||
|
%+ scry-store
|
||||||
|
(unit role-tag)
|
||||||
|
%+ welp
|
||||||
|
`path`[%groups (group-id:en-path:store group-id)]
|
||||||
|
/role/[(scot %p ship)]
|
||||||
|
::
|
||||||
|
++ scry-store
|
||||||
|
|* [=mold =path]
|
||||||
|
.^ mold
|
||||||
|
%gx
|
||||||
|
(scot %p our.bol)
|
||||||
|
%group-store
|
||||||
|
(scot %da now.bol)
|
||||||
|
(welp path /noun)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ watch-invites
|
||||||
|
^- card
|
||||||
|
[%pass /invites %agent [our.bol %invite-store] %watch /invitatory/groups]
|
||||||
|
::
|
||||||
|
++ watch-store
|
||||||
|
^- card
|
||||||
|
[%pass /store %agent [our.bol %group-store] %watch /groups]
|
||||||
--
|
--
|
||||||
|
|||||||
@ -1,192 +0,0 @@
|
|||||||
:: group-listen-hook: receive group updates
|
|
||||||
::
|
|
||||||
::
|
|
||||||
::
|
|
||||||
/- *group, hook=group-hook
|
|
||||||
/+ dbug, verb, store=group-store, default-agent
|
|
||||||
|%
|
|
||||||
+$ card card:agent:gall
|
|
||||||
+$ versioned-state
|
|
||||||
$% state-zero
|
|
||||||
==
|
|
||||||
+$ state-zero
|
|
||||||
$: %0
|
|
||||||
listening=(set group-id)
|
|
||||||
==
|
|
||||||
--
|
|
||||||
|
|
||||||
=| state-zero
|
|
||||||
=* state -
|
|
||||||
::
|
|
||||||
%- agent:dbug
|
|
||||||
%+ verb |
|
|
||||||
^- agent:gall
|
|
||||||
=<
|
|
||||||
|_ =bowl:gall
|
|
||||||
+* this .
|
|
||||||
group-core +>
|
|
||||||
gc ~(. group-core bowl)
|
|
||||||
def ~(. (default-agent this %|) bowl)
|
|
||||||
::
|
|
||||||
++ on-init on-init:def
|
|
||||||
++ on-save !>(state)
|
|
||||||
++ on-load
|
|
||||||
|= =vase
|
|
||||||
^- (quip card _this)
|
|
||||||
=/ old !<(state-zero vase)
|
|
||||||
`this(state old)
|
|
||||||
::
|
|
||||||
++ on-leave on-leave:def
|
|
||||||
++ on-peek on-peek:def
|
|
||||||
++ on-arvo on-arvo:def
|
|
||||||
++ on-fail on-fail:def
|
|
||||||
::
|
|
||||||
++ on-poke
|
|
||||||
|= [=mark =vase]
|
|
||||||
^- (quip card _this)
|
|
||||||
?. ?=(%group-hook-action mark)
|
|
||||||
(on-poke:def mark vase)
|
|
||||||
=^ cards state
|
|
||||||
(poke-hook-action:gc !<(action:hook vase))
|
|
||||||
[cards this]
|
|
||||||
::
|
|
||||||
++ on-watch on-watch:def
|
|
||||||
|
|
||||||
++ on-agent
|
|
||||||
|= [=wire =sign:agent:gall]
|
|
||||||
^- (quip card _this)
|
|
||||||
=^ cards state
|
|
||||||
?+ -.wire ~|([dap.bowl %weird-agent-wire wire] !!)
|
|
||||||
%store (take-store-sign sign)
|
|
||||||
%proxy (take-proxy-sign +.wire sign)
|
|
||||||
==
|
|
||||||
[cards this]
|
|
||||||
--
|
|
||||||
|_ bol=bowl:gall
|
|
||||||
:: +poke-hook-action: Start/stop syncing a foreign group
|
|
||||||
::
|
|
||||||
++ poke-hook-action
|
|
||||||
|= =action:hook
|
|
||||||
^- (quip card _state)
|
|
||||||
|^
|
|
||||||
?- -.action
|
|
||||||
%add (add +.action)
|
|
||||||
%remove (remove +.action)
|
|
||||||
==
|
|
||||||
++ add
|
|
||||||
|= =group-id
|
|
||||||
^- (quip card _state)
|
|
||||||
?: (~(has in listening) group-id)
|
|
||||||
`state
|
|
||||||
=. listening
|
|
||||||
(~(put in listening) group-id)
|
|
||||||
=/ group-path
|
|
||||||
(group-id:en-path:store group-id)
|
|
||||||
:_ state
|
|
||||||
%+ weld
|
|
||||||
(listen-group group-id)
|
|
||||||
(add-self group-id)
|
|
||||||
++ remove
|
|
||||||
|= =group-id
|
|
||||||
^- (quip card _state)
|
|
||||||
?. (~(has in listening) group-id)
|
|
||||||
`state
|
|
||||||
=. listening
|
|
||||||
(~(del in listening) group-id)
|
|
||||||
:_ state
|
|
||||||
(leave-group group-id)
|
|
||||||
--
|
|
||||||
:: +take-store-sign: take sign from %group-store
|
|
||||||
::
|
|
||||||
:: We only poke %group-store to remove ourselves when we leave a channel.
|
|
||||||
++ take-store-sign
|
|
||||||
|= =sign:agent:gall
|
|
||||||
^- (quip card _state)
|
|
||||||
?- -.sign
|
|
||||||
%watch-ack [~ state]
|
|
||||||
%kick [~ state]
|
|
||||||
%fact [~ state]
|
|
||||||
%poke-ack
|
|
||||||
?~ p.sign [~ state]
|
|
||||||
=/ =tank
|
|
||||||
:- %leaf
|
|
||||||
"{(trip dap.bol)} failed poke to group-store"
|
|
||||||
%- (slog tank u.p.sign)
|
|
||||||
[~ state]
|
|
||||||
==
|
|
||||||
:: +take-proxy-sign: take sign from %group-proxy-hook
|
|
||||||
::
|
|
||||||
++ take-proxy-sign
|
|
||||||
|= [=wire =sign:agent:gall]
|
|
||||||
^- (quip card _state)
|
|
||||||
=/ =group-id
|
|
||||||
~| "bad proxy wire: {<wire>}"
|
|
||||||
~| <sign>
|
|
||||||
(need (group-id:de-path:store wire))
|
|
||||||
?- -.sign
|
|
||||||
%kick [(listen-group group-id) state]
|
|
||||||
::
|
|
||||||
%poke-ack
|
|
||||||
?~ p.sign [~ state]
|
|
||||||
=/ =tank
|
|
||||||
:- %leaf
|
|
||||||
"{(trip dap.bol)} failed poke to group-proxy!"
|
|
||||||
%- (slog tank u.p.sign)
|
|
||||||
[~ state]
|
|
||||||
::
|
|
||||||
%watch-ack
|
|
||||||
?~ p.sign [~ state]
|
|
||||||
=/ =tank
|
|
||||||
:- %leaf
|
|
||||||
"{(trip dap.bol)} failed subscribe to group-proxy!"
|
|
||||||
%- (slog tank u.p.sign)
|
|
||||||
[(store-leave-group group-id) state]
|
|
||||||
::
|
|
||||||
%fact
|
|
||||||
?> ?=(%group-update p.cage.sign)
|
|
||||||
(take-proxy-update wire !<(update:store q.cage.sign))
|
|
||||||
==
|
|
||||||
::
|
|
||||||
:: +take-proxy-update: Handle new update from %group-proxy-hook
|
|
||||||
::
|
|
||||||
++ take-proxy-update
|
|
||||||
|= [=wire =update:store]
|
|
||||||
^- (quip card _state)
|
|
||||||
?: ?=(%initial -.update)
|
|
||||||
[~ state]
|
|
||||||
:_ state
|
|
||||||
[%pass [%listen wire] %agent [our.bol %group-store] %poke %group-update !>(update)]~
|
|
||||||
:: +listen-group: Start a new subscription to the proxied .group-id
|
|
||||||
::
|
|
||||||
++ listen-group
|
|
||||||
|= =group-id
|
|
||||||
^- (list card)
|
|
||||||
=/ pax=path
|
|
||||||
(group-id:en-path:store group-id)
|
|
||||||
[%pass [%listen pax] %agent [ship.group-id %group-proxy-hook] %watch [%groups pax]]~
|
|
||||||
:: +add-self: Add self to group
|
|
||||||
++ add-self
|
|
||||||
|= =group-id
|
|
||||||
^- (list card)
|
|
||||||
=/ pax=path
|
|
||||||
(group-id:en-path:store group-id)
|
|
||||||
[%pass [%listen pax] %agent [ship.group-id %group-proxy-hook] %poke %group-action !>([%add-members group-id (sy our.bol ~) ~])]~
|
|
||||||
:: +leave-group: Leave a foreign group
|
|
||||||
++ leave-group
|
|
||||||
|= =group-id
|
|
||||||
^- (list card)
|
|
||||||
=/ pax=path
|
|
||||||
(group-id:en-path:store group-id)
|
|
||||||
:~ [%pass [%listen pax] %agent [ship.group-id %group-proxy-hook] %leave ~]
|
|
||||||
[%pass [%store pax] %agent [our.bol %group-store] %poke %group-update !>([%remove-group group-id ~])]
|
|
||||||
[%pass [%listen pax] %agent [ship.group-id %group-proxy-hook] %poke %group-action !>([%remove-members group-id (sy our.bol ~)])]
|
|
||||||
==
|
|
||||||
:: +store-leave-group: Remove a foreign group from our group-store
|
|
||||||
++ store-leave-group
|
|
||||||
|= =group-id
|
|
||||||
^- (list card)
|
|
||||||
=/ pax=path
|
|
||||||
(group-id:en-path:store group-id)
|
|
||||||
[%pass [%store pax] %agent [our.bol %group-store] %poke %group-update !>([%remove-group group-id ~])]~
|
|
||||||
::
|
|
||||||
--
|
|
||||||
@ -1,293 +0,0 @@
|
|||||||
:: group-proxy-hook: propagate group updates
|
|
||||||
::
|
|
||||||
:: This hook relays foreign subscriptions and pokes into local stores, if
|
|
||||||
:: permissions are met.
|
|
||||||
::
|
|
||||||
:: Subscriptions:
|
|
||||||
:: - /groups/[group-id]: updates for a particular group
|
|
||||||
::
|
|
||||||
:: Pokes:
|
|
||||||
:: - %group-update: Proxy update to local group update. Crashes if permissions
|
|
||||||
:: checks fail.
|
|
||||||
::
|
|
||||||
/- *group, hook=group-hook
|
|
||||||
/+ dbug, verb, store=group-store, default-agent
|
|
||||||
|%
|
|
||||||
+$ card card:agent:gall
|
|
||||||
+$ state-zero
|
|
||||||
$: %0
|
|
||||||
proxied=(jug path ship)
|
|
||||||
==
|
|
||||||
+$ versioned-state
|
|
||||||
$% state-zero
|
|
||||||
==
|
|
||||||
--
|
|
||||||
::
|
|
||||||
=| state-zero
|
|
||||||
=* state -
|
|
||||||
%- agent:dbug
|
|
||||||
%+ verb |
|
|
||||||
^- agent:gall
|
|
||||||
=<
|
|
||||||
|_ =bowl:gall
|
|
||||||
+* this .
|
|
||||||
group-core +>
|
|
||||||
gc ~(. group-core bowl)
|
|
||||||
def ~(. (default-agent this %|) bowl)
|
|
||||||
::
|
|
||||||
++ on-init
|
|
||||||
:_ this
|
|
||||||
:~ [%pass / %arvo %d %flog %text "{(trip dap.bowl)} started"]
|
|
||||||
[%pass /store %agent [our.bowl %group-store] %watch /groups]
|
|
||||||
==
|
|
||||||
++ on-save !>(state)
|
|
||||||
++ on-load
|
|
||||||
|= =vase
|
|
||||||
`this(state !<(state-zero vase))
|
|
||||||
++ on-peek on-peek:def
|
|
||||||
++ on-arvo on-arvo:def
|
|
||||||
++ on-fail on-fail:def
|
|
||||||
::
|
|
||||||
++ on-leave
|
|
||||||
|= =path
|
|
||||||
^- (quip card _this)
|
|
||||||
=^ cards state
|
|
||||||
(stop-proxy:gc src.bowl path)
|
|
||||||
[cards this]
|
|
||||||
::
|
|
||||||
++ on-poke
|
|
||||||
|= [=mark =vase]
|
|
||||||
^- (quip card _this)
|
|
||||||
=^ cards state
|
|
||||||
?+ mark (on-poke:def mark vase)
|
|
||||||
%group-action (poke-group-update:gc !<(action:store vase))
|
|
||||||
==
|
|
||||||
[cards this]
|
|
||||||
::
|
|
||||||
++ on-watch
|
|
||||||
|= =path
|
|
||||||
^- (quip card _this)
|
|
||||||
?< (team:title [our src]:bowl)
|
|
||||||
?> ?=([%groups *] path)
|
|
||||||
?> (permitted:gc src.bowl t.path)
|
|
||||||
=^ cards state
|
|
||||||
(start-proxy:gc src.bowl t.path)
|
|
||||||
[cards this]
|
|
||||||
::
|
|
||||||
++ on-agent
|
|
||||||
|= [=wire =sign:agent:gall]
|
|
||||||
^- (quip card _this)
|
|
||||||
=^ cards state
|
|
||||||
?+ -.wire ~|([dap.bowl %bad-agent-wire wire] !!)
|
|
||||||
%store (take-store-sign sign)
|
|
||||||
%listen (take-listen-sign sign)
|
|
||||||
==
|
|
||||||
[cards this]
|
|
||||||
--
|
|
||||||
|_ bol=bowl:gall
|
|
||||||
:: +should-proxy-poke: Check if poke should be proxied
|
|
||||||
::
|
|
||||||
:: We only allow users to add and remove themselves.
|
|
||||||
++ should-proxy-poke
|
|
||||||
|= =update:store
|
|
||||||
^- ?
|
|
||||||
?: ?=(%add-members -.update)
|
|
||||||
=(~(tap in ships.update) ~[src.bol])
|
|
||||||
?: ?=(%remove-members -.update)
|
|
||||||
=(~(tap in ships.update) ~[src.bol])
|
|
||||||
%.n
|
|
||||||
:: +poke-group-update: Proxy poke to %group-store
|
|
||||||
::
|
|
||||||
:: Only proxy pokes if permissions are correct and we host the group.
|
|
||||||
::
|
|
||||||
++ poke-group-update
|
|
||||||
|= =update:store
|
|
||||||
^- (quip card _state)
|
|
||||||
?: ?=(%initial -.update)
|
|
||||||
[~ state]
|
|
||||||
?> =(ship.group-id.update our.bol)
|
|
||||||
?> (should-proxy-poke update)
|
|
||||||
=/ =path
|
|
||||||
(group-id:en-path:store group-id.update)
|
|
||||||
?> (permitted src.bol path)
|
|
||||||
:_ state
|
|
||||||
[%pass [%store path] %agent [our.bol %group-store] %poke %group-update !>(update)]~
|
|
||||||
:: +take-listen-sign: Handle incoming sign from %group-listen-hook
|
|
||||||
::
|
|
||||||
:: group-listen-hook doesn't send us anything except pokes
|
|
||||||
++ take-listen-sign
|
|
||||||
|= =sign:agent:gall
|
|
||||||
^- (quip card _state)
|
|
||||||
?- -.sign
|
|
||||||
%kick [~ state]
|
|
||||||
%watch-ack [~ state]
|
|
||||||
%fact [~ state]
|
|
||||||
::
|
|
||||||
%poke-ack
|
|
||||||
?~ p.sign [~ state]
|
|
||||||
=/ =tank
|
|
||||||
:- %leaf
|
|
||||||
"{(trip dap.bol)} failed poke to group-listen. very wrong!"
|
|
||||||
%- (slog tank u.p.sign)
|
|
||||||
[~ state]
|
|
||||||
==
|
|
||||||
:: +take-store-sign: Handle incoming sign from %group-store
|
|
||||||
::
|
|
||||||
:: group-store should send us all its store updates over a subscription on
|
|
||||||
:: /groups. We also proxy pokes to it.
|
|
||||||
::
|
|
||||||
++ take-store-sign
|
|
||||||
|= =sign:agent:gall
|
|
||||||
^- (quip card _state)
|
|
||||||
?- -.sign
|
|
||||||
%kick [watch-store state]
|
|
||||||
::
|
|
||||||
%poke-ack
|
|
||||||
?~ p.sign [~ state]
|
|
||||||
=/ =tank
|
|
||||||
:- %leaf
|
|
||||||
"{(trip dap.bol)} failed poke to group-store"
|
|
||||||
%- (slog tank u.p.sign)
|
|
||||||
[~ state]
|
|
||||||
::
|
|
||||||
%watch-ack
|
|
||||||
?~ p.sign [~ state]
|
|
||||||
=/ =tank
|
|
||||||
:- %leaf
|
|
||||||
"{(trip dap.bol)} failed subscribe to group-store. very wrong!"
|
|
||||||
%- (slog tank u.p.sign)
|
|
||||||
[~ state]
|
|
||||||
::
|
|
||||||
%fact
|
|
||||||
?+ p.cage.sign ~|("{<dap.bol>} unexpected mark: {<p.cage.sign>}" !!)
|
|
||||||
%group-initial [~ state]
|
|
||||||
%group-update (take-store-update !<(update:store q.cage.sign))
|
|
||||||
==
|
|
||||||
==
|
|
||||||
:: +take-store-update: Handle new %fact from %group-store
|
|
||||||
::
|
|
||||||
:: We forward the update onto the correct path, and recalculate permissions,
|
|
||||||
:: kicking any subscriptions whose permissions have been revoked.
|
|
||||||
::
|
|
||||||
++ take-store-update
|
|
||||||
|= =update:store
|
|
||||||
^- (quip card _state)
|
|
||||||
?: ?=(%initial -.update)
|
|
||||||
`state
|
|
||||||
=/ =path
|
|
||||||
(group-id:en-path:store group-id.update)
|
|
||||||
?. (~(has by proxied) path)
|
|
||||||
[~ state]
|
|
||||||
=^ cards state
|
|
||||||
(handle-revocations update path)
|
|
||||||
:_ state
|
|
||||||
:- [%give %fact [%groups path]~ %group-update !>(update)]
|
|
||||||
cards
|
|
||||||
::
|
|
||||||
:: +handle-revocations: Handle revoked permissions from a update:store
|
|
||||||
::
|
|
||||||
:: If the mutation to the group store has impacted permissions, then kick
|
|
||||||
:: relevant subscriptions and remove them from our state
|
|
||||||
::
|
|
||||||
++ handle-revocations
|
|
||||||
|= [=update:store =path]
|
|
||||||
^- (quip card _state)
|
|
||||||
|^
|
|
||||||
?: ?=(%remove-group -.update)
|
|
||||||
=. proxied
|
|
||||||
(~(del by proxied) group-id.update)
|
|
||||||
:_ state
|
|
||||||
[%give %kick [%groups path]~ ~]~
|
|
||||||
?: ?=(%change-policy -.update)
|
|
||||||
(handle-permissions-change diff.update)
|
|
||||||
?. ?=(%remove-members -.update)
|
|
||||||
[~ state]
|
|
||||||
(revoked-permissions ships.update)
|
|
||||||
::
|
|
||||||
++ handle-permissions-change
|
|
||||||
|= =diff:policy
|
|
||||||
^- (quip card _state)
|
|
||||||
?+ -.diff [~ state]
|
|
||||||
%ban-ships (revoked-permissions ships.diff)
|
|
||||||
==
|
|
||||||
::
|
|
||||||
++ revoked-permissions
|
|
||||||
|= ships=(set ship)
|
|
||||||
^- (quip card _state)
|
|
||||||
=/ to-kick=(list ship)
|
|
||||||
~(tap in ships)
|
|
||||||
=/ subs=(set ship)
|
|
||||||
(~(gut by proxied) path ~)
|
|
||||||
=| cards=(list card)
|
|
||||||
|-
|
|
||||||
?~ to-kick
|
|
||||||
[cards state]
|
|
||||||
=. proxied
|
|
||||||
(~(del ju proxied) path i.to-kick)
|
|
||||||
=. cards
|
|
||||||
[[%give %kick [%groups path]~ `i.to-kick] cards]
|
|
||||||
$(to-kick t.to-kick)
|
|
||||||
--
|
|
||||||
:: +start-proxy: Start proxying .path to .who
|
|
||||||
::
|
|
||||||
++ start-proxy
|
|
||||||
|= [who=ship =path]
|
|
||||||
^- (quip card _state)
|
|
||||||
=. proxied
|
|
||||||
(~(put ju proxied) path who)
|
|
||||||
[(give-initial path) state]
|
|
||||||
:: +stop-proxy: Stop proxying .path to .who
|
|
||||||
::
|
|
||||||
++ stop-proxy
|
|
||||||
|= [who=ship =path]
|
|
||||||
^- (quip card _state)
|
|
||||||
=. proxied
|
|
||||||
(~(del ju proxied) path who)
|
|
||||||
`state
|
|
||||||
:: +watch-store: Watch group-store for changes
|
|
||||||
::
|
|
||||||
++ watch-store
|
|
||||||
^- (list card)
|
|
||||||
[%pass /group-store %agent [our.bol %group-store] %watch /groups]~
|
|
||||||
:: +permitted: check if .ship can access .path
|
|
||||||
::
|
|
||||||
++ permitted
|
|
||||||
|= [=ship =path]
|
|
||||||
^- ?
|
|
||||||
?> ?=([@ @ *] path)
|
|
||||||
=/ u-group-id
|
|
||||||
(group-id:de-path:store path)
|
|
||||||
?~ u-group-id
|
|
||||||
%.n
|
|
||||||
=* group-id u.u-group-id
|
|
||||||
=/ pax=^path
|
|
||||||
(welp [%groups path] /permitted/[(scot %p ship)])
|
|
||||||
(scry-store ? pax)
|
|
||||||
:: +give-initial: give initial state for .path
|
|
||||||
::
|
|
||||||
:: Must be called in +on-watch. No-ops if the group does not exist yet
|
|
||||||
++ give-initial
|
|
||||||
|= =path
|
|
||||||
^- (list card)
|
|
||||||
=/ u-group
|
|
||||||
(scry-store (unit group) [%groups path])
|
|
||||||
?~ u-group ~
|
|
||||||
=* group u.u-group
|
|
||||||
=/ =group-id
|
|
||||||
(need (group-id:de-path:store path))
|
|
||||||
=/ =cage
|
|
||||||
:- %group-update
|
|
||||||
!> ^- update:store
|
|
||||||
[%initial-group group-id group]
|
|
||||||
[%give %fact ~ cage]~
|
|
||||||
::
|
|
||||||
++ scry-store
|
|
||||||
|* [=mold =path]
|
|
||||||
.^ mold
|
|
||||||
%gx
|
|
||||||
(scot %p our.bol)
|
|
||||||
%group-store
|
|
||||||
(scot %da now.bol)
|
|
||||||
(welp path /noun)
|
|
||||||
==
|
|
||||||
--
|
|
||||||
@ -5,6 +5,7 @@
|
|||||||
:: permissions and invites inside this store for simplicity reasons, although
|
:: permissions and invites inside this store for simplicity reasons, although
|
||||||
:: these should be prised apart in a future revision of group store.
|
:: these should be prised apart in a future revision of group store.
|
||||||
::
|
::
|
||||||
|
::
|
||||||
:: ## Scry paths
|
:: ## Scry paths
|
||||||
::
|
::
|
||||||
:: /y/groups:
|
:: /y/groups:
|
||||||
@ -13,11 +14,8 @@
|
|||||||
:: A listing of the tag queries for a group
|
:: A listing of the tag queries for a group
|
||||||
:: /x/groups/[group-id]:
|
:: /x/groups/[group-id]:
|
||||||
:: The group itself
|
:: The group itself
|
||||||
:: /x/groups/[group-id]/tag-queries/[tag]:
|
:: /x/groups/[group-id]/join/[ship]:
|
||||||
:: The subset with tag
|
:: A flag indicated if the ship is permitted to join
|
||||||
:: /x/groups/[group-id]/permitted/[ship]:
|
|
||||||
:: A flag indicated if the ship is permitted
|
|
||||||
::
|
|
||||||
::
|
::
|
||||||
:: ## Subscription paths
|
:: ## Subscription paths
|
||||||
::
|
::
|
||||||
@ -71,9 +69,7 @@
|
|||||||
gc ~(. group-core bowl)
|
gc ~(. group-core bowl)
|
||||||
def ~(. (default-agent this %|) bowl)
|
def ~(. (default-agent this %|) bowl)
|
||||||
::
|
::
|
||||||
++ on-init
|
++ on-init on-init:def
|
||||||
:_ this
|
|
||||||
[%pass / %arvo %d %flog %text "{(trip dap.bowl)} started"]~
|
|
||||||
++ on-save !>(state)
|
++ on-save !>(state)
|
||||||
++ on-load
|
++ on-load
|
||||||
|= =old=vase
|
|= =old=vase
|
||||||
@ -87,7 +83,7 @@
|
|||||||
^- (quip card _this)
|
^- (quip card _this)
|
||||||
?> (team:title our.bowl src.bowl)
|
?> (team:title our.bowl src.bowl)
|
||||||
=^ cards state
|
=^ cards state
|
||||||
?: ?=(%group-update mark)
|
?: ?=(?(%group-update %group-action) mark)
|
||||||
(poke-group-update:gc !<(update:store vase))
|
(poke-group-update:gc !<(update:store vase))
|
||||||
(on-poke:def mark vase)
|
(on-poke:def mark vase)
|
||||||
[cards this]
|
[cards this]
|
||||||
@ -98,7 +94,7 @@
|
|||||||
?> (team:title our.bowl src.bowl)
|
?> (team:title our.bowl src.bowl)
|
||||||
?> ?=([%groups ~] path)
|
?> ?=([%groups ~] path)
|
||||||
:_ this
|
:_ this
|
||||||
[%give %fact ~ %group-initial !>(groups)]~
|
[%give %fact ~ %group-update !>([%initial groups])]~
|
||||||
::
|
::
|
||||||
++ on-leave on-leave:def
|
++ on-leave on-leave:def
|
||||||
::
|
::
|
||||||
@ -106,13 +102,26 @@
|
|||||||
|= =path
|
|= =path
|
||||||
^- (unit (unit cage))
|
^- (unit (unit cage))
|
||||||
?+ path (on-peek:def path)
|
?+ path (on-peek:def path)
|
||||||
[%x %groups @ @ ~] ``noun+!>((peek-group t.t.path))
|
[%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))
|
||||||
::
|
::
|
||||||
[%x %groups @ @ %permitted @ ~]
|
[%x %groups @ @ %role @ ~]
|
||||||
``noun+!>((peek-group-permitted t.t.path (slav %p i.t.t.t.t.t.path)))
|
=/ group-id
|
||||||
::
|
(group-id:de-path:store t.t.path)
|
||||||
[%x %groups @ @ %permission-role @ ~]
|
?~ group-id ~
|
||||||
``noun+!>((peek-group-permitted t.t.path (slav %p i.t.t.t.t.t.path)))
|
=/ =ship
|
||||||
|
(slav %p i.t.t.t.t.t.path)
|
||||||
|
``noun+!>((peek-group-role u.group-id ship))
|
||||||
==
|
==
|
||||||
::
|
::
|
||||||
++ on-agent on-agent:def
|
++ on-agent on-agent:def
|
||||||
@ -133,14 +142,15 @@
|
|||||||
?: (lte size 8)
|
?: (lte size 8)
|
||||||
%2
|
%2
|
||||||
%3
|
%3
|
||||||
++ peek-group-permitted
|
++ peek-group
|
||||||
|= [=path =ship]
|
|= =group-id
|
||||||
^- ?
|
^- (unit group)
|
||||||
=/ maybe-group
|
(~(get by groups) group-id)
|
||||||
(peek-group path)
|
|
||||||
?~ maybe-group
|
++ peek-group-join
|
||||||
%.n
|
|= [=group-id =ship]
|
||||||
=* group u.maybe-group
|
=/ =group
|
||||||
|
(~(gut by groups) group-id *group)
|
||||||
=* policy policy.group
|
=* policy policy.group
|
||||||
?- -.policy
|
?- -.policy
|
||||||
%invite
|
%invite
|
||||||
@ -148,15 +158,25 @@
|
|||||||
%open
|
%open
|
||||||
&(!(~(has in banned.policy) ship) (~(has in ranks.policy) (ship-rank ship)))
|
&(!(~(has in banned.policy) ship) (~(has in ranks.policy) (ship-rank ship)))
|
||||||
==
|
==
|
||||||
::
|
++ peek-group-role
|
||||||
++ peek-group
|
|= [=group-id =ship]
|
||||||
|= =path
|
=/ =group
|
||||||
^- (unit group)
|
(~(got by groups) group-id)
|
||||||
=/ m-group-id
|
=* policy policy.group
|
||||||
(group-id:de-path:store path)
|
=* tag-queries tag-queries.group
|
||||||
?~ m-group-id ~
|
=/ admins=(set ^ship)
|
||||||
=* group-id u.m-group-id
|
(~(gut by tag-queries) %admin ~)
|
||||||
(~(get by groups) group-id)
|
?: (~(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
|
||||||
::
|
::
|
||||||
++ poke-group-update
|
++ poke-group-update
|
||||||
|= =update:store
|
|= =update:store
|
||||||
@ -176,17 +196,21 @@
|
|||||||
==
|
==
|
||||||
:: +add-group: add group to store
|
:: +add-group: add group to store
|
||||||
::
|
::
|
||||||
:: no-op if group-already exists
|
:: always include ship in own groups, no-op if group already exists
|
||||||
::
|
::
|
||||||
++ add-group
|
++ add-group
|
||||||
|= [=group-id =group]
|
|= [=group-id =policy]
|
||||||
^- (quip card _state)
|
^- (quip card _state)
|
||||||
?: (~(has by groups) group-id)
|
?: (~(has by groups) group-id)
|
||||||
[~ state]
|
[~ state]
|
||||||
|
=| =group
|
||||||
|
=. members.group
|
||||||
|
(~(put in members.group) our.bol)
|
||||||
|
=. policy.group policy
|
||||||
=. groups
|
=. groups
|
||||||
(~(put by groups) group-id group)
|
(~(put by groups) group-id group)
|
||||||
:_ state
|
:_ state
|
||||||
(send-diff %add-group group-id group)
|
(send-diff %add-group group-id policy)
|
||||||
:: +add-members: add members to group
|
:: +add-members: add members to group
|
||||||
::
|
::
|
||||||
:: no-op if group does not exist
|
:: no-op if group does not exist
|
||||||
@ -200,6 +224,13 @@
|
|||||||
=. members.group (~(uni in members.group) new-ships)
|
=. members.group (~(uni in members.group) new-ships)
|
||||||
=. tag-queries.group
|
=. tag-queries.group
|
||||||
(merge-tags tag-queries.group new-ships tags)
|
(merge-tags tag-queries.group new-ships tags)
|
||||||
|
=* policy policy.group
|
||||||
|
=. policy
|
||||||
|
?. ?=(%invite -.policy)
|
||||||
|
policy
|
||||||
|
=. pending.policy
|
||||||
|
(~(dif in pending.policy) new-ships)
|
||||||
|
policy
|
||||||
=. groups
|
=. groups
|
||||||
(~(put by groups) group-id group)
|
(~(put by groups) group-id group)
|
||||||
:_ state
|
:_ state
|
||||||
@ -207,7 +238,7 @@
|
|||||||
:: +remove-members: remove members from group
|
:: +remove-members: remove members from group
|
||||||
::
|
::
|
||||||
:: no-op if group does not exist
|
:: no-op if group does not exist
|
||||||
:: TODO: remove tags as well
|
::
|
||||||
::
|
::
|
||||||
++ remove-members
|
++ remove-members
|
||||||
|= [=group-id ships=(set ship)]
|
|= [=group-id ships=(set ship)]
|
||||||
@ -218,6 +249,8 @@
|
|||||||
(~(got by groups) group-id)
|
(~(got by groups) group-id)
|
||||||
=. members.group
|
=. members.group
|
||||||
(~(dif in members.group) ships)
|
(~(dif in members.group) ships)
|
||||||
|
=. tag-queries.group
|
||||||
|
(remove-tags group ships)
|
||||||
=. groups
|
=. groups
|
||||||
(~(put by groups) group-id group)
|
(~(put by groups) group-id group)
|
||||||
:_ state
|
:_ state
|
||||||
@ -275,7 +308,8 @@
|
|||||||
(send-diff %initial-group group-id group)
|
(send-diff %initial-group group-id group)
|
||||||
:: +change-policy: modify group access control
|
:: +change-policy: modify group access control
|
||||||
::
|
::
|
||||||
::
|
:: If the change will kick members, then send a separate
|
||||||
|
:: %remove-members diff after the %change-policy diff
|
||||||
++ change-policy
|
++ change-policy
|
||||||
|= [=group-id =diff:policy]
|
|= [=group-id =diff:policy]
|
||||||
^- (quip card _state)
|
^- (quip card _state)
|
||||||
@ -283,54 +317,80 @@
|
|||||||
[~ state]
|
[~ state]
|
||||||
=/ =group
|
=/ =group
|
||||||
(~(got by groups) group-id)
|
(~(got by groups) group-id)
|
||||||
=* policy policy.group
|
|
||||||
|^
|
|^
|
||||||
=. policy
|
=^ cards group
|
||||||
=- ~& - -
|
?- -.diff
|
||||||
?+ -.diff !!
|
%allow-ranks (allow-ranks +.diff)
|
||||||
%allow-ranks (allow-ranks +.diff)
|
%ban-ranks (ban-ranks +.diff)
|
||||||
%ban-ranks (ban-ranks +.diff)
|
%allow-ships (allow-ships +.diff)
|
||||||
%allow-ships (allow-ships +.diff)
|
%ban-ships (ban-ships +.diff)
|
||||||
%ban-ships (ban-ships +.diff)
|
%add-invites (add-invites +.diff)
|
||||||
|
%remove-invites (remove-invites +.diff)
|
||||||
|
%replace (replace +.diff)
|
||||||
==
|
==
|
||||||
=. groups
|
=. groups
|
||||||
(~(put by groups) group-id group)
|
(~(put by groups) group-id group)
|
||||||
:_ state
|
:_ state
|
||||||
(send-diff %change-policy group-id diff)
|
%+ weld
|
||||||
|
(send-diff %change-policy group-id diff)
|
||||||
|
cards
|
||||||
::
|
::
|
||||||
++ allow-ranks
|
++ allow-ranks
|
||||||
|= ranks=(set rank)
|
|= ranks=(set rank)
|
||||||
^- ^policy
|
^- (quip card _group)
|
||||||
?> ?=(%open -.policy)
|
?> ?=(%open -.policy.group)
|
||||||
=. ranks.policy
|
=. ranks.policy.group
|
||||||
(~(uni in ranks.policy) ranks)
|
(~(uni in ranks.policy.group) ranks)
|
||||||
policy
|
`group
|
||||||
::
|
::
|
||||||
++ ban-ranks
|
++ ban-ranks
|
||||||
|= ranks=(set rank)
|
|= ranks=(set rank)
|
||||||
^- ^policy
|
^- (quip card _group)
|
||||||
?> ?=(%open -.policy)
|
?> ?=(%open -.policy.group)
|
||||||
=. ranks.policy
|
=. ranks.policy.group
|
||||||
(~(dif in ranks.policy) ranks)
|
(~(dif in ranks.policy.group) ranks)
|
||||||
policy
|
`group
|
||||||
::
|
::
|
||||||
++ allow-ships
|
++ allow-ships
|
||||||
|= ships=(set ship)
|
|= ships=(set ship)
|
||||||
^- ^policy
|
^- (quip card _group)
|
||||||
?> ?=(%open -.policy)
|
?> ?=(%open -.policy.group)
|
||||||
=. banned.policy
|
=. banned.policy.group
|
||||||
(~(dif in banned.policy) ships)
|
(~(dif in banned.policy.group) ships)
|
||||||
policy
|
`group
|
||||||
::
|
::
|
||||||
++ ban-ships
|
++ ban-ships
|
||||||
|= ships=(set ship)
|
|= ships=(set ship)
|
||||||
^- ^policy
|
^- (quip card _group)
|
||||||
?> ?=(%open -.policy)
|
?> ?=(%open -.policy.group)
|
||||||
=. banned.policy
|
=. banned.policy.group
|
||||||
(~(uni in banned.policy) ships)
|
(~(uni in banned.policy.group) ships)
|
||||||
=. members.group
|
=/ to-remove=(set ship)
|
||||||
(~(dif in members.group) banned.policy)
|
(~(int in members.group) banned.policy.group)
|
||||||
policy
|
:- ~[(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
|
||||||
--
|
--
|
||||||
:: +remove-group: remove group from store
|
:: +remove-group: remove group from store
|
||||||
::
|
::
|
||||||
@ -346,25 +406,21 @@
|
|||||||
(send-diff %remove-group group-id ~)
|
(send-diff %remove-group group-id ~)
|
||||||
::
|
::
|
||||||
--
|
--
|
||||||
:: +merge-tags: merge tags
|
++ remove-tags
|
||||||
++ merge-tags
|
|= [=group ships=(set ship)]
|
||||||
|= [=tag-queries ships=(set ship) tags=(set tag)]
|
^- tag-quries
|
||||||
^+ tag-queries
|
%- malt
|
||||||
=/ tags ~(tap in tags)
|
%+ spin
|
||||||
|-
|
~(tap by tag-queries.group)
|
||||||
?~ tags
|
tag-queries.group
|
||||||
tag-queries
|
|= [=tag tagged=(set ship)]
|
||||||
=* tag i.tags
|
:- tag
|
||||||
=/ current-query=(set ship)
|
(~(dif in tagged) ships)
|
||||||
(~(gut by tag-queries) tag ~)
|
::
|
||||||
%= $
|
++ poke-us
|
||||||
tags t.tags
|
|= =action:store
|
||||||
::
|
^- card
|
||||||
tag-queries
|
[%pass / %agent [our.bol %group-store] %poke %group-action !>(action)]
|
||||||
%+ ~(put by tag-queries)
|
|
||||||
tag
|
|
||||||
(~(uni in current-query) ships)
|
|
||||||
==
|
|
||||||
:: +send-diff: update subscribers of new state
|
:: +send-diff: update subscribers of new state
|
||||||
::
|
::
|
||||||
:: We only allow subscriptions on /groups
|
:: We only allow subscriptions on /groups
|
||||||
|
|||||||
@ -1,10 +1,10 @@
|
|||||||
:: group-store|join: initialize a group
|
:: group-listen-hook|add: add a group
|
||||||
::
|
::
|
||||||
/- *group-store
|
/- *group, *group-hook
|
||||||
:- %say
|
:- %say
|
||||||
|= $: [now=@da eny=@uvJ =beak]
|
|= $: [now=@da eny=@uvJ =beak]
|
||||||
[[=ship =term ~] ~]
|
[[=ship =term ~] ~]
|
||||||
==
|
==
|
||||||
:- %group-action
|
:- %group-hook-action
|
||||||
^- action
|
^- action
|
||||||
[%add ship term]
|
[%add ship term]
|
||||||
|
|||||||
@ -1,10 +0,0 @@
|
|||||||
:: group-listen-hook|add: add a group
|
|
||||||
::
|
|
||||||
/- *group, *group-hook
|
|
||||||
:- %say
|
|
||||||
|= $: [now=@da eny=@uvJ =beak]
|
|
||||||
[[=ship =term ~] ~]
|
|
||||||
==
|
|
||||||
:- %group-hook-action
|
|
||||||
^- action
|
|
||||||
[%add ship term]
|
|
||||||
@ -29,4 +29,265 @@
|
|||||||
=* term i.t.path
|
=* term i.t.path
|
||||||
`[u.ship term]
|
`[u.ship term]
|
||||||
--
|
--
|
||||||
|
++ enjs
|
||||||
|
=, enjs:format
|
||||||
|
|%
|
||||||
|
::
|
||||||
|
++ update
|
||||||
|
|= =^update
|
||||||
|
^- json
|
||||||
|
%+ frond -.update
|
||||||
|
?- -.update
|
||||||
|
%add-group (add-group update)
|
||||||
|
%add-members (add-members update)
|
||||||
|
%add-tag (add-tag update)
|
||||||
|
%remove-members (remove-members update)
|
||||||
|
%remove-tag (remove-tag update)
|
||||||
|
%initial (initial update)
|
||||||
|
%initial-group (initial-group update)
|
||||||
|
%remove-group (remove-group update)
|
||||||
|
%change-policy (change-policy update)
|
||||||
|
==
|
||||||
|
++ group-id-path
|
||||||
|
|= =^group-id
|
||||||
|
%- spat
|
||||||
|
%- group-id:en-path
|
||||||
|
group-id
|
||||||
|
++ initial-group
|
||||||
|
|= =^update
|
||||||
|
?> ?=(%initial-group -.update)
|
||||||
|
%- pairs
|
||||||
|
:~ group-id+(group-id group-id.update)
|
||||||
|
group+(group group.update)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ initial
|
||||||
|
|= =^initial
|
||||||
|
?> ?=(%initial -.initial)
|
||||||
|
%- pairs
|
||||||
|
%+ turn
|
||||||
|
~(tap by groups.initial)
|
||||||
|
|= [=^group-id grp=^group]
|
||||||
|
^- [@t json]
|
||||||
|
:_ (group grp)
|
||||||
|
(group-id-path group-id)
|
||||||
|
::
|
||||||
|
++ group
|
||||||
|
|= =^group
|
||||||
|
^- json
|
||||||
|
%- pairs
|
||||||
|
:~ members+(set ship members.group)
|
||||||
|
policy+(policy policy.group)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ set
|
||||||
|
|* [item=$-(* json) sit=(^set)]
|
||||||
|
^- json
|
||||||
|
:- %a
|
||||||
|
%+ turn
|
||||||
|
~(tap in sit)
|
||||||
|
item
|
||||||
|
::
|
||||||
|
++ policy
|
||||||
|
|= =^policy
|
||||||
|
%+ frond -.policy
|
||||||
|
%- pairs
|
||||||
|
?- -.policy
|
||||||
|
%invite
|
||||||
|
:~ pending+(set ship pending.policy)
|
||||||
|
==
|
||||||
|
%open
|
||||||
|
:~ banned+(set ship banned.policy)
|
||||||
|
ranks+(set numb ranks.policy)
|
||||||
|
==
|
||||||
|
==
|
||||||
|
++ 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 numb ranks.diff) ~]
|
||||||
|
%ban-ranks [ranks+(set numb ranks.diff) ~]
|
||||||
|
%allow-ships [ranks+(set ship ships.diff) ~]
|
||||||
|
%ban-ships [ranks+(set ship ships.diff) ~]
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ remove-group
|
||||||
|
|= =^update
|
||||||
|
^- json
|
||||||
|
?> ?=(%remove-group -.update)
|
||||||
|
(frond %group-id (group-id group-id.update))
|
||||||
|
::
|
||||||
|
++ group-id
|
||||||
|
|= =^group-id
|
||||||
|
^- json
|
||||||
|
%- pairs
|
||||||
|
:~ name+s+term.group-id
|
||||||
|
ship+(ship ship.group-id)
|
||||||
|
==
|
||||||
|
++ add-group
|
||||||
|
|= =action
|
||||||
|
^- json
|
||||||
|
?> ?=(%add-group -.action)
|
||||||
|
%- pairs
|
||||||
|
:~ group-id+(group-id group-id.action)
|
||||||
|
policy+(policy policy.action)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ add-members
|
||||||
|
|= =action
|
||||||
|
^- json
|
||||||
|
?> ?=(%add-members -.action)
|
||||||
|
%- pairs
|
||||||
|
:~ group-id+(group-id group-id.action)
|
||||||
|
ships+(set ship ships.action)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ remove-members
|
||||||
|
|= =action
|
||||||
|
^- json
|
||||||
|
?> ?=(%remove-members -.action)
|
||||||
|
%- pairs
|
||||||
|
:~ group-id+(group-id group-id.action)
|
||||||
|
ships+(set ship ships.action)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ add-tag
|
||||||
|
|= =action
|
||||||
|
^- json
|
||||||
|
?> ?=(%add-tag -.action)
|
||||||
|
%- pairs
|
||||||
|
:~ group-id+(group-id group-id.action)
|
||||||
|
tag+s+tag.action
|
||||||
|
ships+(set ship ships.action)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ remove-tag
|
||||||
|
|= =action
|
||||||
|
^- json
|
||||||
|
?> ?=(%remove-tag -.action)
|
||||||
|
%- pairs
|
||||||
|
:~ group-id+(group-id group-id.action)
|
||||||
|
tag+s+tag.action
|
||||||
|
ships+(set ship ships.action)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ change-policy
|
||||||
|
|= =action
|
||||||
|
^- json
|
||||||
|
?> ?=(%change-policy -.action)
|
||||||
|
%- pairs
|
||||||
|
:~ group-id+(group-id group-id.action)
|
||||||
|
diff+(policy-diff diff.action)
|
||||||
|
==
|
||||||
|
--
|
||||||
|
++ dejs
|
||||||
|
=, dejs:format
|
||||||
|
|%
|
||||||
|
::
|
||||||
|
++ action
|
||||||
|
^- $-(json ^action)
|
||||||
|
%- of
|
||||||
|
:~
|
||||||
|
add-group+add-group
|
||||||
|
add-members+add-members
|
||||||
|
remove-members+remove-members
|
||||||
|
add-tag+add-tag
|
||||||
|
remove-tag+remove-tag
|
||||||
|
change-policy+change-policy
|
||||||
|
remove-group+remove-group
|
||||||
|
==
|
||||||
|
++ rank
|
||||||
|
|= =json
|
||||||
|
^- ^rank
|
||||||
|
?> ?=(%n -.json)
|
||||||
|
%0
|
||||||
|
:: move to zuse also
|
||||||
|
++ oj
|
||||||
|
|* =fist
|
||||||
|
^- $-(json (jug cord _(fist *json)))
|
||||||
|
(om (as fist))
|
||||||
|
++ tag-queries
|
||||||
|
^- $-(json ^tag-queries)
|
||||||
|
(oj ship)
|
||||||
|
:: TODO: move to zuse
|
||||||
|
++ ship
|
||||||
|
(su ;~(pfix sig fed:ag))
|
||||||
|
++ policy
|
||||||
|
^- $-(json ^policy)
|
||||||
|
%- of
|
||||||
|
:~ invite+invite-policy
|
||||||
|
open+open-policy
|
||||||
|
==
|
||||||
|
++ invite-policy
|
||||||
|
%- ot
|
||||||
|
:~ pending+(as ship)
|
||||||
|
==
|
||||||
|
++ open-policy
|
||||||
|
%- ot
|
||||||
|
:~ ranks+(as rank)
|
||||||
|
banned+(as ship)
|
||||||
|
==
|
||||||
|
++ policy-diff
|
||||||
|
^- $-(json diff:^policy)
|
||||||
|
%- of
|
||||||
|
:~ add-invites+(as ship)
|
||||||
|
remove-invites+(as ship)
|
||||||
|
allow-ranks+(as rank)
|
||||||
|
allow-ships+(as ship)
|
||||||
|
ban-ranks+(as rank)
|
||||||
|
ban-ships+(as ship)
|
||||||
|
replace+policy
|
||||||
|
==
|
||||||
|
++ group-id
|
||||||
|
%- ot
|
||||||
|
:~ ship+ship
|
||||||
|
name+so
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ remove-group
|
||||||
|
|= =json
|
||||||
|
?> ?=(%o -.json)
|
||||||
|
=/ =group-id
|
||||||
|
(group-id (~(got by p.json) 'group-id'))
|
||||||
|
[group-id ~]
|
||||||
|
|
||||||
|
++ add-group
|
||||||
|
%- ot
|
||||||
|
:~ group-id+group-id
|
||||||
|
policy+policy
|
||||||
|
==
|
||||||
|
++ add-members
|
||||||
|
%- ot
|
||||||
|
:~ group-id+group-id
|
||||||
|
ships+(as ship)
|
||||||
|
tags+(as so)
|
||||||
|
==
|
||||||
|
++ remove-members
|
||||||
|
^- $-(json [^group-id (set ^ship)])
|
||||||
|
%- ot
|
||||||
|
:~ group-id+group-id
|
||||||
|
ships+(as ship)
|
||||||
|
==
|
||||||
|
++ add-tag
|
||||||
|
%- ot
|
||||||
|
:~ group-id+group-id
|
||||||
|
tag+so
|
||||||
|
ships+(as ship)
|
||||||
|
==
|
||||||
|
++ remove-tag
|
||||||
|
%- ot
|
||||||
|
:~ group-id+group-id
|
||||||
|
tag+so
|
||||||
|
ships+(as ship)
|
||||||
|
==
|
||||||
|
++ change-policy
|
||||||
|
%- ot
|
||||||
|
:~ group-id+group-id
|
||||||
|
diff+policy-diff
|
||||||
|
==
|
||||||
|
--
|
||||||
|
|
||||||
--
|
--
|
||||||
|
|||||||
69
pkg/arvo/lib/group.hoon
Normal file
69
pkg/arvo/lib/group.hoon
Normal file
@ -0,0 +1,69 @@
|
|||||||
|
/- *group, *metadata-store
|
||||||
|
/+ store=group-store
|
||||||
|
|_ =bowl:gall
|
||||||
|
++ scry-for
|
||||||
|
|* [=mold =path]
|
||||||
|
.^ mold
|
||||||
|
%gx
|
||||||
|
(scot %p our.bowl)
|
||||||
|
%group-store
|
||||||
|
(scot %da now.bowl)
|
||||||
|
(snoc `^path`path %noun)
|
||||||
|
==
|
||||||
|
::
|
||||||
|
++ scry-group-path
|
||||||
|
|= =path
|
||||||
|
%+ scry-for
|
||||||
|
(unit group)
|
||||||
|
[%groups path]
|
||||||
|
::
|
||||||
|
++ scry-group
|
||||||
|
|= =group-id
|
||||||
|
%- scry-group-path
|
||||||
|
(group-id:en-path group-id)
|
||||||
|
::
|
||||||
|
++ members-from-path
|
||||||
|
|= =group-path
|
||||||
|
^- (set ship)
|
||||||
|
=- members:(fall - *group)
|
||||||
|
(scry-group-path group-path)
|
||||||
|
::
|
||||||
|
++ is-permitted
|
||||||
|
|= [=ship =group-path]
|
||||||
|
^- ?
|
||||||
|
=- (~(has in -) ship)
|
||||||
|
(members-from-path group-path)
|
||||||
|
::
|
||||||
|
++ role-for-ship
|
||||||
|
|= [=group-id =ship]
|
||||||
|
^- (unit role-tag)
|
||||||
|
=/ grp=(unit group)
|
||||||
|
(scry-group group-id)
|
||||||
|
?~ grp ~
|
||||||
|
=* group u.grp
|
||||||
|
=* 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
|
||||||
|
?: (~(has in members.group) ship)
|
||||||
|
`%member
|
||||||
|
~
|
||||||
|
++ can-join
|
||||||
|
|= [=path =ship]
|
||||||
|
%+ scry-for
|
||||||
|
?
|
||||||
|
%+ welp
|
||||||
|
[%groups path]
|
||||||
|
/join/[(scot %p ship)]
|
||||||
|
|
||||||
|
--
|
||||||
@ -1,33 +1,9 @@
|
|||||||
/+ *group-store
|
/+ store=group-store
|
||||||
=, dejs:format
|
=, dejs:format
|
||||||
|_ act=action
|
|_ =action:store
|
||||||
++ grab
|
++ grab
|
||||||
|%
|
|%
|
||||||
++ noun action
|
++ noun action:store
|
||||||
:: ++ json
|
++ json action:dejs:store
|
||||||
:: |= jon=^json
|
|
||||||
:: =< (parse-group-action jon)
|
|
||||||
:: |%
|
|
||||||
:: ++ parse-group-action
|
|
||||||
:: %- of
|
|
||||||
:: :~
|
|
||||||
:: [%add add-action]
|
|
||||||
:: [%remove remove-action]
|
|
||||||
:: [%bundle pa]
|
|
||||||
:: [%unbundle pa]
|
|
||||||
:: ==
|
|
||||||
:: ::
|
|
||||||
:: ++ add-action
|
|
||||||
:: %- ot
|
|
||||||
:: :~ [%members (as (su ;~(pfix sig fed:ag)))]
|
|
||||||
:: [%path pa]
|
|
||||||
:: ==
|
|
||||||
:: ::
|
|
||||||
:: ++ remove-action
|
|
||||||
:: %- ot
|
|
||||||
:: :~ [%members (as (su ;~(pfix sig fed:ag)))]
|
|
||||||
:: [%path pa]
|
|
||||||
:: ==
|
|
||||||
:: --
|
|
||||||
--
|
--
|
||||||
--
|
--
|
||||||
|
|||||||
@ -1,62 +1,13 @@
|
|||||||
/- *group-store
|
/+ *group-store
|
||||||
|_ upd=update
|
|_ upd=update
|
||||||
|
++ grow
|
||||||
|
|%
|
||||||
|
++ json
|
||||||
|
%+ frond:enjs:format %group-update
|
||||||
|
(update:enjs upd)
|
||||||
|
--
|
||||||
++ grab
|
++ grab
|
||||||
|%
|
|%
|
||||||
++ noun update
|
++ noun update
|
||||||
--
|
--
|
||||||
:: ++ grow
|
|
||||||
:: |%
|
|
||||||
:: ++ json
|
|
||||||
:: =, enjs:format
|
|
||||||
:: ^- ^json
|
|
||||||
:: %+ frond %group-update
|
|
||||||
:: %- pairs
|
|
||||||
:: :~
|
|
||||||
:: ::
|
|
||||||
:: :: %add
|
|
||||||
:: ?: =(%add -.upd)
|
|
||||||
:: ?> ?=(%add -.upd)
|
|
||||||
:: :- %add
|
|
||||||
:: %- pairs
|
|
||||||
:: :~ [%members (set-to-array members.upd ship)]
|
|
||||||
:: [%path (path pax.upd)]
|
|
||||||
:: ==
|
|
||||||
:: ::
|
|
||||||
:: :: %remove
|
|
||||||
:: ?: =(%remove -.upd)
|
|
||||||
:: ?> ?=(%remove -.upd)
|
|
||||||
:: :- %remove
|
|
||||||
:: %- pairs
|
|
||||||
:: :~ [%members (set-to-array members.upd ship)]
|
|
||||||
:: [%path (path pax.upd)]
|
|
||||||
:: ==
|
|
||||||
:: ::
|
|
||||||
:: :: %bundle
|
|
||||||
:: ?: =(%bundle -.upd)
|
|
||||||
:: ?> ?=(%bundle -.upd)
|
|
||||||
:: [%bundle (pairs [%path (path pax.upd)]~)]
|
|
||||||
:: ::
|
|
||||||
:: :: %unbundle
|
|
||||||
:: ?: =(%unbundle -.upd)
|
|
||||||
:: ?> ?=(%unbundle -.upd)
|
|
||||||
:: [%unbundle (pairs [%path (path pax.upd)]~)]
|
|
||||||
:: ::
|
|
||||||
:: :: %keys
|
|
||||||
:: ?: =(%keys -.upd)
|
|
||||||
:: ?> ?=(%keys -.upd)
|
|
||||||
:: [%keys (pairs [%keys (set-to-array keys.upd path)]~)]
|
|
||||||
:: ::
|
|
||||||
:: :: %path
|
|
||||||
:: ?: =(%path -.upd)
|
|
||||||
:: ?> ?=(%path -.upd)
|
|
||||||
:: :- %path
|
|
||||||
:: %- pairs
|
|
||||||
:: :~ [%members (set-to-array members.upd ship)]
|
|
||||||
:: [%path (path pax.upd)]
|
|
||||||
:: ==
|
|
||||||
:: ::
|
|
||||||
:: :: %noop
|
|
||||||
:: [*@t *^json]
|
|
||||||
:: ==
|
|
||||||
:: --
|
|
||||||
--
|
--
|
||||||
|
|||||||
@ -13,11 +13,11 @@
|
|||||||
:: %remove-group: remove a group from the store
|
:: %remove-group: remove a group from the store
|
||||||
::
|
::
|
||||||
+$ action
|
+$ action
|
||||||
$% [%add-group =group-id ships=(set ship) =tag-queries =policy]
|
$% [%add-group =group-id =policy]
|
||||||
[%add-members =group-id ships=(set ship) tags=(set term)]
|
[%add-members =group-id ships=(set ship) tags=(set term)]
|
||||||
[%remove-members =group-id ships=(set ship)]
|
[%remove-members =group-id ships=(set ship)]
|
||||||
[%add-tag =group-id =term ships=(set ship)]
|
[%add-tag =group-id =tag ships=(set ship)]
|
||||||
[%remove-tag =group-id =term ships=(set ship)]
|
[%remove-tag =group-id =tag ships=(set ship)]
|
||||||
[%change-policy =group-id =diff:policy]
|
[%change-policy =group-id =diff:policy]
|
||||||
[%remove-group =group-id ~]
|
[%remove-group =group-id ~]
|
||||||
==
|
==
|
||||||
|
|||||||
@ -1,3 +1,4 @@
|
|||||||
|
^?
|
||||||
|%
|
|%
|
||||||
:: $group-id: unique identifier for a group
|
:: $group-id: unique identifier for a group
|
||||||
::
|
::
|
||||||
@ -14,15 +15,17 @@
|
|||||||
:: %admin - denotes that member can add and remove members
|
:: %admin - denotes that member can add and remove members
|
||||||
::
|
::
|
||||||
+$ tag term
|
+$ tag term
|
||||||
:: $permission-tag: a kind of $tag that identifies a privileged user
|
:: $role-tag: a kind of $tag that identifies a privileged user
|
||||||
::
|
::
|
||||||
:: These roles are
|
:: These roles are
|
||||||
:: %admin: Administrator, can do everything except delete the group
|
:: %admin: Administrator, can do everything except delete the group
|
||||||
:: %moderator: Moderator, can add/remove/ban users
|
:: %moderator: Moderator, can add/remove/ban users
|
||||||
:: %janitor: Has no special meaning inside group-store,
|
:: %janitor: Has no special meaning inside group-store,
|
||||||
:: but may be given additional privileges in other apps.
|
:: but may be given additional privileges in other apps.
|
||||||
+$ permission-tag
|
:: %member: Ordinary member, this tag is implied if the user is not in any
|
||||||
?(%admin %moderator %janitor)
|
:: of the other roles
|
||||||
|
+$ role-tag
|
||||||
|
?(%admin %moderator %janitor %members)
|
||||||
:: $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)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user