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

groups: begin rewrite

Browse Source
This commit is contained in:
Liam Fitzgerald 2020-05-15 08:50:04 +10:00
parent d1d417fb22
commit d2de8d72eb
25 changed files with 1270 additions and 665 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -39,7 +39,7 @@
:_ this(invite-created %.y)
:~ (invite-poke:cc [%create /contacts])
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]
[%pass /group %agent [our.bol %group-store] %watch /updates]
[%pass /group %agent [our.bol %group-store] %watch /groups]
==
++ on-save !>(state)
++ on-load

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

@ -1,6 +1,6 @@
:: group-hook: allow syncing group data from foreign paths to local paths
::
/- *group-store, *group-hook
/- *group, store=group-store, hook=group-hook
/+ default-agent, verb, dbug
~% %group-hook-top ..is ~
|%
@ -8,6 +8,7 @@
::
++ versioned-state
$% state-zero
state-one
==
::
::
@ -16,247 +17,47 @@
synced=(map path ship)
==
::
+$ state-one
$: %1
synced=(map group-id ship)
==
::
--
::
=| state-zero
=| state-one
=* 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)
%+ 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
++ 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-group-hook-action:gc !<(group-hook-action vase))
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?. ?=([%group @ *] path)
(on-watch:def path)
?. (~(has by synced.state) t.path)
(on-watch:def path)
=/ scry-path=^path
:(welp /=group-store/(scot %da now.bowl) t.path /noun)
=/ grp=(unit group)
.^((unit group) %gx scry-path)
?~ grp
(on-watch:def path)
:_ this
[%give %fact ~ %group-update !>([%path u.grp t.path])]~
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
::
%watch-ack
?~ p.sign
[~ this]
%- (slog u.p.sign)
?> ?=([@ %group ^] wire)
=/ =ship (slav %p i.wire)
=* group t.t.wire
:: only remove from synced if this watch-nack came from the ship we
:: thought we were actively syncing from
::
=? synced.state
=(ship (~(gut by synced.state) group ship))
(~(del by synced.state) group)
[~ this]
::
%kick
?> ?=([@ %group ^] wire)
=/ =ship (slav %p i.wire)
=* group t.t.wire
?. (~(has by synced.state) group)
[~ this]
=* group-path t.wire
:_ this
[%pass wire %agent [ship %group-hook] %watch group-path]~
::
%fact
?. ?=(%group-update p.cage.sign)
(on-agent:def wire sign)
=^ cards state
?: (team:title our.bowl src.bowl)
(handle-local:gc !<(group-update q.cage.sign))
(handle-foreign:gc !<(group-update q.cage.sign))
[cards this]
==
--
|_ =bowl:gall
+* this .
group-core +>
gc ~(. group-core bowl)
def ~(. (default-agent this %|) bowl)
::
|_ bol=bowl:gall
++ on-init on-init:def
++ 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]]
::
++ poke-group-hook-action
|= act=group-hook-action
^- (quip card _state)
?- -.act
%add
?. (team:title our.bol src.bol)
[~ state]
=/ group-path [%group path.act]
=/ group-wire [(scot %p ship.act) group-path]
?: (~(has by synced.state) path.act)
[~ state]
=. synced.state (~(put by synced.state) path.act ship.act)
:_ state
?: =(ship.act our.bol)
[%pass group-wire %agent [ship.act %group-store] %watch group-path]~
[%pass group-wire %agent [ship.act %group-hook] %watch group-path]~
::
%remove
=/ ship (~(get by synced.state) path.act)
?~ ship
[~ state]
?: &(=(u.ship our.bol) (team:title our.bol src.bol))
:: delete one of our own paths
=/ group-wire [(scot %p our.bol) %group path.act]
:_ state(synced (~(del by synced.state) path.act))
%+ snoc
(pull-wire group-wire path.act)
[%give %kick [%group path.act]~ ~]
?: |(=(u.ship src.bol) (team:title our.bol src.bol))
:: delete a foreign ship's path
=/ group-wire [(scot %p u.ship) %group path.act]
:_ state(synced (~(del by synced.state) path.act))
(pull-wire group-wire path.act)
:: don't allow
[~ state]
==
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ handle-local
|= diff=group-update
^- (quip card _state)
?- -.diff
%initial [~ state]
%keys [~ state]
%path [~ state]
%bundle [~ state]
%add [(update-subscribers [%group pax.diff] diff) state]
%remove [(update-subscribers [%group pax.diff] diff) state]
::
%unbundle
=/ ship (~(get by synced.state) pax.diff)
?~ ship [~ state]
(poke-group-hook-action [%remove pax.diff])
==
::
++ handle-foreign
|= diff=group-update
^- (quip card _state)
?- -.diff
%initial [~ state]
%keys [~ state]
%bundle [~ state]
%path
:_ state
?~ pax.diff ~
=/ ship (~(get by synced.state) pax.diff)
?~ ship ~
?. =(src.bol u.ship) ~
=/ have-group=(unit group)
(group-scry pax.diff)
?~ have-group
:: if we don't have the group yet, create it
::
:~ (group-poke pax.diff [%bundle pax.diff])
(group-poke pax.diff [%add members.diff pax.diff])
==
:: if we already have the group, calculate and apply the diff
::
=/ added=group (~(dif in members.diff) u.have-group)
=/ removed=group (~(dif in u.have-group) members.diff)
%+ weld
?~ added ~
[(group-poke pax.diff [%add added pax.diff])]~
?~ removed ~
[(group-poke pax.diff [%remove removed pax.diff])]~
::
%add
:_ state
?~ pax.diff ~
=/ ship (~(get by synced.state) pax.diff)
?~ ship ~
?. =(src.bol u.ship) ~
[(group-poke pax.diff diff)]~
::
%remove
?~ pax.diff [~ state]
=/ ship (~(get by synced.state) pax.diff)
?~ ship [~ state]
?. =(src.bol u.ship) [~ state]
?. (~(has in members.diff) our.bol)
:_ state
[(group-poke pax.diff diff)]~
=/ changes (poke-group-hook-action [%remove pax.diff])
:_ +.changes
%+ welp -.changes
:~ (group-poke pax.diff diff)
(group-poke pax.diff [%unbundle pax.diff])
==
::
%unbundle
?~ pax.diff [~ state]
=/ ship (~(get by synced.state) pax.diff)
?~ ship [~ state]
?. =(src.bol u.ship) [~ state]
(poke-group-hook-action [%remove pax.diff])
==
::
++ group-poke
|= [pax=path action=group-action]
^- card
[%pass pax %agent [our.bol %group-store] %poke %group-action !>(action)]
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
::
++ update-subscribers
|= [pax=path diff=group-update]
^- (list card)
[%give %fact ~[pax] %group-update !>(diff)]~
::
++ pull-wire
|= [wir=wire pax=path]
^- (list card)
=/ shp (~(get by synced.state) pax)
?~ shp
~
?: =(u.shp our.bol)
[%pass wir %agent [our.bol %group-store] %leave ~]~
[%pass wir %agent [u.shp %group-hook] %leave ~]~
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-agent on-agent:def
>>>>>>> 457bd4c3a... groups: begin rewrite
--

192
pkg/arvo/app/group-listen-hook.hoon Normal file
View File

@ -0,0 +1,192 @@
:: 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 ~])]~
::
--

293
pkg/arvo/app/group-proxy-hook.hoon Normal file
View File

@ -0,0 +1,293 @@
:: 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)
==
--

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

@ -1,23 +1,64 @@
:: group-store: data store for groups of ships
:: group-store: Store groups of ships
::
/- *group-store
/+ default-agent, verb, dbug
:: 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.
::
:: ## 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
:: /x/groups/[group-id]/tag-queries/[tag]:
:: The subset with tag
:: /x/groups/[group-id]/permitted/[ship]:
:: A flag indicated if the ship is permitted
::
::
:: ## 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
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
state-one
==
::
+$ state-zero
$: %0
* :: =groups
==
::
::
+$ state-one
$: %1
=groups
==
::
+$ diff [%group-update group-update]
+$ diff
$% [%group-update update:store]
[%group-initial groups]
==
--
::
=| state-zero
=| state-one
=* state -
::
%- agent:dbug
@ -30,19 +71,24 @@
gc ~(. group-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-init
:_ this
[%pass / %arvo %d %flog %text "{(trip dap.bowl)} started"]~
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
|= =old=vase
=/ old !<(versioned-state old-vase)
?. ?=(%1 -.old)
`this
`this(state old)
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?: ?=(%group-action mark)
(poke-group-action:gc !<(group-action vase))
?: ?=(%group-update mark)
(poke-group-update:gc !<(update:store vase))
(on-poke:def mark vase)
[cards this]
::
@ -50,22 +96,9 @@
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give %group-update !>([%initial groups]))
[%updates ~] ~
[%keys ~] (give %group-update !>([%keys ~(key by groups)]))
[%group *]
(give %group-update !>([%path (~(got by groups) t.path) t.path]))
==
[cards this]
::
++ give
|= =cage
^- (list card)
[%give %fact ~ cage]~
--
?> ?=([%groups ~] path)
:_ this
[%give %fact ~ %group-initial !>(groups)]~
::
++ on-leave on-leave:def
::
@ -73,7 +106,13 @@
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x *] ``noun+!>((~(get by groups) t.path))
[%x %groups @ @ ~] ``noun+!>((peek-group t.t.path))
::
[%x %groups @ @ %permitted @ ~]
``noun+!>((peek-group-permitted t.t.path (slav %p i.t.t.t.t.t.path)))
::
[%x %groups @ @ %permission-role @ ~]
``noun+!>((peek-group-permitted t.t.path (slav %p i.t.t.t.t.t.path)))
==
::
++ on-agent on-agent:def
@ -82,85 +121,257 @@
--
::
|_ bol=bowl:gall
++ ship-rank
|= =ship
^- rank
=/ size
(met 3 ship)
?: (lte size 2)
%0
?: (lte size 4)
%1
?: (lte size 8)
%2
%3
++ peek-group-permitted
|= [=path =ship]
^- ?
=/ maybe-group
(peek-group path)
?~ maybe-group
%.n
=* group u.maybe-group
=* 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)))
==
::
++ poke-group-action
|= action=group-action
++ peek-group
|= =path
^- (unit group)
=/ m-group-id
(group-id:de-path:store path)
?~ m-group-id ~
=* group-id u.m-group-id
(~(get by groups) group-id)
::
++ poke-group-update
|= =update:store
^- (quip card _state)
?> (team:title our.bol src.bol)
?- -.action
%add (handle-add action)
%remove (handle-remove action)
%bundle (handle-bundle action)
%unbundle (handle-unbundle action)
|^
?- -.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]
==
:: +add-group: add group to store
::
:: no-op if group-already exists
::
++ add-group
|= [=group-id =group]
^- (quip card _state)
?: (~(has by groups) group-id)
[~ state]
=. groups
(~(put by groups) group-id group)
:_ state
(send-diff %add-group group-id group)
:: +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)
=. 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
:: TODO: remove tags as well
::
++ 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)
=. 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
::
::
++ change-policy
|= [=group-id =diff:policy]
^- (quip card _state)
?. (~(has by groups) group-id)
[~ state]
=/ =group
(~(got by groups) group-id)
=* policy policy.group
|^
=. policy
=- ~& - -
?+ -.diff !!
%allow-ranks (allow-ranks +.diff)
%ban-ranks (ban-ranks +.diff)
%allow-ships (allow-ships +.diff)
%ban-ships (ban-ships +.diff)
==
=. groups
(~(put by groups) group-id group)
:_ state
(send-diff %change-policy group-id diff)
::
++ allow-ranks
|= ranks=(set rank)
^- ^policy
?> ?=(%open -.policy)
=. ranks.policy
(~(uni in ranks.policy) ranks)
policy
::
++ ban-ranks
|= ranks=(set rank)
^- ^policy
?> ?=(%open -.policy)
=. ranks.policy
(~(dif in ranks.policy) ranks)
policy
::
++ allow-ships
|= ships=(set ship)
^- ^policy
?> ?=(%open -.policy)
=. banned.policy
(~(dif in banned.policy) ships)
policy
::
++ ban-ships
|= ships=(set ship)
^- ^policy
?> ?=(%open -.policy)
=. banned.policy
(~(uni in banned.policy) ships)
=. members.group
(~(dif in members.group) banned.policy)
policy
--
:: +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 ~)
::
--
:: +merge-tags: merge tags
++ 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)
==
:: +send-diff: update subscribers of new state
::
++ handle-add
|= act=group-action
^- (quip card _state)
?> ?=(%add -.act)
?~ pax.act
[~ state]
?. (~(has by groups) pax.act)
[~ state]
=/ members (~(got by groups) pax.act)
=. members (~(uni in members) members.act)
?: =(members (~(got by groups) pax.act))
[~ state]
:- (send-diff pax.act act)
state(groups (~(put by groups) pax.act members))
::
++ handle-remove
|= act=group-action
^- (quip card _state)
?> ?=(%remove -.act)
?~ pax.act
[~ state]
?. (~(has by groups) pax.act)
[~ state]
=/ members (~(got by groups) pax.act)
=. members (~(dif in members) members.act)
?: =(members (~(got by groups) pax.act))
[~ state]
:- (send-diff pax.act act)
state(groups (~(put by groups) pax.act members))
::
++ handle-bundle
|= act=group-action
^- (quip card _state)
?> ?=(%bundle -.act)
?~ pax.act
[~ state]
?: (~(has by groups) pax.act)
[~ state]
:- (send-diff pax.act act)
state(groups (~(put by groups) pax.act *group))
::
++ handle-unbundle
|= act=group-action
^- (quip card _state)
?> ?=(%unbundle -.act)
?~ pax.act
[~ state]
?. (~(has by groups) pax.act)
[~ state]
:- (send-diff pax.act act)
state(groups (~(del by groups) pax.act))
::
++ update-subscribers
|= [pax=path act=group-action]
^- (list card)
[%give %fact ~[pax] %group-update !>(act)]~
::
:: We only allow subscriptions on /groups
:: so just give the fact there.
++ send-diff
|= [pax=path act=group-action]
|= =update:store
^- (list card)
%- zing
:~ (update-subscribers /all act)
(update-subscribers /updates act)
(update-subscribers [%group pax] act)
?. |(=(%bundle -.act) =(%unbundle -.act))
~
(update-subscribers /keys act)
==
[%give %fact ~[/groups] %group-update !>(update)]~
::
--

221
pkg/arvo/app/permission-group-hook.hoon
View File

@ -27,212 +27,23 @@
%+ verb |
%- agent:dbug
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?+ mark (on-poke:def mark vase)
%json
:: only accept json from the host team
::
?> (team:title our.bowl src.bowl)
=^ cards state
%- handle-action:do
%- json-to-perm-group-hook-action
!<(json vase)
[cards this]
::
%permission-group-hook-action
=^ cards state
%- handle-action:do
!<(permission-group-hook-action vase)
[cards this]
==
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=([%group *] wire)
(on-agent:def wire sign)
?- -.sign
%poke-ack ~|([dap.bowl %unexpected-poke-ack wire] !!)
::
%kick
:_ this
[(watch-group:do t.wire)]~
::
%watch-ack
?~ p.sign [~ this]
=/ =tank leaf+"{(trip dap.bowl)} failed subscribe at {(spud wire)}"
%- (slog tank u.p.sign)
[~ this(relation (~(del by relation) t.wire))]
::
%fact
?. ?=(%group-update p.cage.sign)
(on-agent:def wire sign)
=^ cards state
%- handle-group-update:do
!<(group-update q.cage.sign)
[cards this]
==
::
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ handle-action
|= act=permission-group-hook-action
^- (quip card _state)
?> (team:title our.bowl src.bowl)
?- -.act
%associate (handle-associate group.act permissions.act)
%dissociate (handle-dissociate group.act permissions.act)
==
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ handle-associate
|= [group=group-path associate=(set [permission-path kind])]
^- (quip card _state)
=/ perms (~(get by relation) group)
:: if relation does not exist, create it and subscribe.
=/ perm-paths=(set path)
(~(run in associate) head)
?~ perms
:_ state(relation (~(put by relation) group perm-paths))
(snoc (recreate-permissions perm-paths associate) (watch-group group))
::
=/ grp (group-scry group)
=. u.perms (~(uni in u.perms) perm-paths)
:_ state(relation (~(put by relation) group u.perms))
%+ weld
(recreate-permissions perm-paths associate)
?~ grp
~
(add-members group u.grp u.perms)
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ handle-dissociate
|= [group=path remove=(set permission-path)]
^- (quip card _state)
=/ perms=(set permission-path)
(fall (~(get by relation) group) *(set permission-path))
?: =(~ perms)
[~ state]
:: remove what we must. if that means we are no longer mirroring this group
:: into any permissions, remove it from state entirely.
::
=. perms (~(del in perms) remove)
?~ perms
:_ state(relation (~(del by relation) group))
[(group-pull group)]~
[~ state(relation (~(put by relation) group perms))]
::
++ handle-group-update
|= diff=group-update
^- (quip card _state)
?- -.diff
%initial [~ state]
%keys [~ state]
%bundle [~ state]
::
%path
:: set all permissions paths
=/ perms (~(got by relation) pax.diff)
:_ state
(add-members pax.diff members.diff perms)
::
%add
:: set all permissions paths
=/ perms (~(get by relation) pax.diff)
?~ perms
[~ state]
:_ state
%+ turn ~(tap in u.perms)
|= =path
(permission-poke path [%add path members.diff])
::
%remove
:: set all permissions paths
=/ perms (~(get by relation) pax.diff)
?~ perms
[~ state]
:_ state
%+ turn ~(tap in u.perms)
|= =path
(permission-poke path [%remove path members.diff])
::
%unbundle
:: pull subscriptions
=/ perms (~(get by relation) pax.diff)
?~ perms
:_ state(relation (~(del by relation) pax.diff))
[(group-pull pax.diff)]~
:_ state(relation (~(del by relation) pax.diff))
:- (group-pull pax.diff)
%+ turn ~(tap in u.perms)
|= =path
(permission-poke path [%delete path])
==
::
++ permission-poke
|= [=wire action=permission-action]
^- card
:* %pass
[%write wire]
%agent
[our.bowl %permission-store]
%poke
[%permission-action !>(action)]
==
::
++ group-scry
|= pax=path
^- (unit group)
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bowl) pax /noun))
::
++ add-members
|= [pax=path mem=(set ship) perms=(set path)]
^- (list card)
%+ turn ~(tap in perms)
|= =path
(permission-poke path [%add path mem])
::
++ recreate-permissions
|= [perm-paths=(set path) associate=(set [permission-path kind])]
^- (list card)
%+ weld
%+ turn ~(tap in perm-paths)
|= =path
(permission-poke path [%delete path])
%+ turn ~(tap in associate)
|= [=path =kind]
=| pem=permission
=. kind.pem kind
(permission-poke path [%create path pem])
::
::
++ watch-group
|= =group-path
^- card
=. group-path [%group group-path]
[%pass group-path %agent [our.bowl %group-store] %watch group-path]
::
++ group-pull
|= =group-path
^- card
[%pass [%group group-path] %agent [our.bowl %group-store] %leave ~]
++ on-poke on-poke:def
++ on-agent on-agent:def
++ on-peek on-peek:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--

10
pkg/arvo/gen/group-hook/add.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|join: initialize a group
::
/- *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ~] ~]
==
:- %group-action
^- action
[%add ship term]

10
pkg/arvo/gen/group-listen-hook/add.hoon Normal file
View File

@ -0,0 +1,10 @@
:: 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]

10
pkg/arvo/gen/group-listen-hook/remove.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-listen-hook|remove: add a group
::
/- *group, *group-hook
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ~] ~]
==
:- %group-hook-action
^- action
[%remove ship term]

8
pkg/arvo/gen/group-store/add.hoon
View File

@ -1,10 +1,10 @@
:: group-store|add: add members to a group
::
/- *group-store
/- *group, *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path members=(list ship) ~] ~]
[[=ship =term ships=(list ship) ~] ~]
==
:- %group-action
^- group-action
[%add (sy members) path]
^- action
[%add-members [ship term] (sy ships) ~]

10
pkg/arvo/gen/group-store/allow-ranks.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|allow-ranks: allow ranks for group
::
/- *group, *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ranks=(list rank) ~] ~]
==
:- %group-update
^- action
[%change-policy [ship term] %allow-ranks (sy ranks)]

10
pkg/arvo/gen/group-store/allow-ships.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|allow-ships: remove ships from banlist
::
/- *group, *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ships=(list ship) ~] ~]
==
:- %group-update
^- action
[%change-policy [ship term] %allow-ships (sy ships)]

10
pkg/arvo/gen/group-store/ban-ranks.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|allow-ranks: allow ranks for group
::
/- *group, *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ranks=(list rank) ~] ~]
==
:- %group-update
^- action
[%change-policy [ship term] %ban-ranks (sy ranks)]

10
pkg/arvo/gen/group-store/ban-ships.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|ban-ships: ban members from a group
::
/- *group, *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ships=(list ship) ~] ~]
==
:- %group-update
^- action
[%change-policy [ship term] %ban-ships (sy ships)]

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

@ -3,8 +3,8 @@
/- *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path ~] ~]
[[=term ~] ~]
==
:- %group-action
^- group-action
[%bundle path]
:- %group-update
^- action
[%add-group [p.beak term] (sy p.beak ~) ~ %open ~ ~]

10
pkg/arvo/gen/group-store/join.hoon Normal file
View File

@ -0,0 +1,10 @@
:: group-store|join: join a group
::
/- *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=ship =term ~] ~]
==
:- %group-action
^- action
[%join-group ship term]

6
pkg/arvo/gen/group-store/remove.hoon
View File

@ -3,8 +3,8 @@
/- *group-store
:- %say
|= $: [now=@da eny=@uvJ =beak]
[[=path members=(list ship) ~] ~]
[[=ship =term ships=(list ship) ~] ~]
==
:- %group-action
^- group-action
[%remove (sy members) path]
^- action
[%remove-members [p.beak term] (sy ships)]

32
pkg/arvo/lib/group-store.hoon Normal file
View File

@ -0,0 +1,32 @@
/- *group, sur=group-store
^?
=< [. sur]
=, sur
|%
:: +en-path: transform into path
::
++ en-path
|%
::
++ group-id
|= ^group-id
^- path
/[(scot %p ship)]/[term]
--
:: +de-path: transform from path
::
++ de-path
|%
::
++ group-id
|= =path
^- (unit ^group-id)
?. ?=([@ @ *] path)
~
=/ ship=(unit ship)
(slaw %p i.path)
?~ ship ~
=* term i.t.path
`[u.ship term]
--
--

56
pkg/arvo/mar/group/action.hoon
View File

@ -1,33 +1,33 @@
/+ *group-json
/+ *group-store
=, dejs:format
|_ act=group-action
|_ act=action
++ grab
|%
++ noun group-action
++ json
|= 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]
==
--
++ noun action
:: ++ json
:: |= 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]
:: ==
:: --
--
--

4
pkg/arvo/mar/group/hook-action.hoon
View File

@ -1,9 +1,9 @@
/- *group-hook
=, dejs:format
|_ act=group-hook-action
|_ act=action
++ grab
|%
++ noun group-hook-action
++ noun action
++ json
|= jon=^json
=< (parse-action jon)

120
pkg/arvo/mar/group/update.hoon
View File

@ -1,66 +1,62 @@
/+ *group-json
|_ upd=group-update
/- *group-store
|_ upd=update
++ grab
|%
++ noun group-update
--
++ grow
|%
++ json
=, enjs:format
^- ^json
%+ frond %group-update
%- pairs
:~
?: =(%initial -.upd)
?> ?=(%initial -.upd)
:- %initial
(groups-to-json groups.upd)
::
:: %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]
==
++ 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]
:: ==
:: --
--

32
pkg/arvo/sur/group-hook.hoon
View File

@ -1,12 +1,26 @@
/- *group, store=group-store
|%
+$ group-hook-action
$% [%add =ship =path] :: if ship is our, make the group publicly
:: available for other ships to sync
:: if ship is foreign, delete any local
:: group at that path and mirror the
:: foreign group at our local path
::
[%remove =path] :: remove the path.
:: $action: request to change group-hook state
::
:: %add:
:: if ship is ours make group available to sync, else sync foreign group
:: to group-store.
:: %remove:
:: if ship is ours make unavailable to sync, else stop syncing foreign
:: group.
::
+$ action
$% [%add =group-id]
[%remove =group-id]
==
:: $update: description of state change
::
:: %no-perms:
:: Group is unavailable to sync
::
+$ update
$% [%no-perms =group-id]
action
==
--
--

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

@ -1,20 +1,37 @@
/- *group
|%
+$ group (set ship)
:: $action: request to change group-store state
::
+$ 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
:: %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.
:: %change-policy: change a group's policy
:: %remove-group: remove a group from the store
::
+$ action
$% [%add-group =group-id ships=(set ship) =tag-queries =policy]
[%add-members =group-id ships=(set ship) tags=(set term)]
[%remove-members =group-id ships=(set ship)]
[%add-tag =group-id =term ships=(set ship)]
[%remove-tag =group-id =term ships=(set ship)]
[%change-policy =group-id =diff:policy]
[%remove-group =group-id ~]
==
:: $update: a description of a processed state change
::
+$ group-update
$% [%initial =groups]
[%keys keys=(set path)] :: keys have changed
[%path members=group pax=path]
group-action
:: %initial: describe groups upon new subscription
::
+$ update
$% initial
action
==
+$ initial
$% [%initial-group =group-id =group]
[%initial =groups]
==
::
+$ groups (map path group)
--

95
pkg/arvo/sur/group.hoon Normal file
View File

@ -0,0 +1,95 @@
|%
:: $group-id: unique identifier for a group
::
+$ group-id [=ship =term]
:: $groups: a mapping from group-ids to groups
::
+$ groups (map group-id group)
:: $tag: an identifier used to identify a subset of members
::
:: Tags may be used and recognised differently across apps.
:: TODO: document 'blessed' tags
:: example tags:
:: %pending - denotes that member has been invited but not joined yet
:: %admin - denotes that member can add and remove members
::
+$ tag term
:: $permission-tag: a kind of $tag that identifies a privileged user
::
:: These roles are
:: %admin: Administrator, can do everything except delete the group
:: %moderator: Moderator, can add/remove/ban users
:: %janitor: Has no special meaning inside group-store,
:: but may be given additional privileges in other apps.
+$ permission-tag
?(%admin %moderator %janitor)
:: $tag-queries: a mapping from a $tag to the members it identifies
::
+$ tag-queries (jug tag ship)
:: $group: description of a group of users
::
:: members: members of the group
:: tag-queries: a map of subsets
:: policy: permissions for the group
::
+$ group
$: members=(set ship)
=tag-queries
=policy
==
:: $rank: ship class by length
::
:: 0: galaxy or star -- 2 bytes
:: 1: planet -- 4 bytes
:: 2: moon -- 8 bytes
:: 3: comet -- 16 bytes
+$ rank ?(%0 %1 %2 %3)
:: $policy: access control for a group
::
++ policy
=< policy
|%
::
+$ policy
$% invite
open
==
:: $diff: change group policy
+$ diff
$% diff:invite
diff:open
[%replace =policy]
==
:: $invite: allow only invited ships
++ invite
=< invite-policy
|%
::
+$ invite-policy
[%invite pending=(set ship)]
:: $diff: add or remove invites
::
+$ diff
$% [%add-invites invitees=(set ship)]
[%remove-invites invitees=(set ship)]
==
--
:: $open: allow all unbanned ships of approriate rank
::
++ open
=< open-policy
|%
::
+$ open-policy
[%open ranks=(set rank) banned=(set ship)]
:: $diff: ban or allow ranks and ships
::
+$ diff
$% [%allow-ranks ranks=(set rank)]
[%ban-ranks ranks=(set rank)]
[%ban-ships ships=(set ship)]
[%allow-ships ships=(set ship)]
==
--
--
--

63
pkg/arvo/ted/ph/group-rejoin.hoon Normal file
View File

@ -0,0 +1,63 @@
/- spider
/+ *ph-io
=>
|%
++ wait-for-agent-start
|= [=ship agent=term]
=/ m (strand:spider ,~)
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-dojo-output:util ship her unix-effect "{(trip agent)} started")
(pure:m ~)
loop
::
++ start-agent
|= [=ship agent=term]
=/ m (strand:spider ,~)
^- form:m
=* loop $
;< ~ bind:m (dojo ship "|start {<agent>}")
;< ~ bind:m (wait-for-agent-start ship agent)
(pure:m ~)
::
++ wait-for-goad
|= =ship
=/ m (strand:spider ,~)
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-dojo-output:util ship her unix-effect "p=%hood q=%bump")
(pure:m ~)
loop
::
++ start-group-agents
|= =ship
=/ m (strand:spider ,~)
^- form:m
;< ~ bind:m (start-agent ship %group-store)
;< ~ bind:m (start-agent ship %group-listen-hook)
;< ~ bind:m (start-agent ship %group-proxy-hook)
(pure:m ~)
--
=, strand=strand:spider
^- thread:spider
|= args=vase
=/ m (strand ,vase)
;< az=tid:spider
bind:m start-azimuth
;< ~ bind:m (spawn az ~bud)
;< ~ bind:m (spawn az ~zod)
;< ~ bind:m (real-ship az ~bud)
;< ~ bind:m (wait-for-goad ~bud)
;< ~ bind:m (real-ship az ~zod)
;< ~ bind:m (wait-for-goad ~zod)
;< ~ bind:m (start-group-agents ~bud)
;< ~ bind:m (start-group-agents ~zod)
;< ~ bind:m (dojo ~bud ":group-store|create 'test-group'")
;< ~ bind:m (wait-for-output ~bud ">=")
;< ~ bind:m (dojo ~zod ":group-store|add ~bud 'test-group'")
;< ~ bind:m (wait-for-output ~zod ">=")
;< ~ bind:m (dojo ~zod ":group-listen-hook|add ~bud 'test-group'")
;< ~ bind:m (wait-for-output ~zod ">=")
(pure:m *vase)