From c8059c455dc689388d1bcf050106bc09ba4e1ddf Mon Sep 17 00:00:00 2001 From: Fang Date: Thu, 21 Nov 2019 21:15:32 +0100 Subject: [PATCH] static gall: update permission-group-hook Also stealth-fixes a bug where it was prepending %group to paths one too many times. --- pkg/arvo/app/permission-group-hook.hoon | 217 ++++++++++++++++++++++++ 1 file changed, 217 insertions(+) create mode 100644 pkg/arvo/app/permission-group-hook.hoon diff --git a/pkg/arvo/app/permission-group-hook.hoon b/pkg/arvo/app/permission-group-hook.hoon new file mode 100644 index 0000000000..b815f5ef42 --- /dev/null +++ b/pkg/arvo/app/permission-group-hook.hoon @@ -0,0 +1,217 @@ +:: permission-group-hook: groups into permissions +:: +:: mirror the ships in specified groups to specified permission paths +:: +/- *group-store, *permission-group-hook +/+ *permission-json, default-agent, verb +:: +|% ++$ state + $% [%0 state-0] + == +:: ++$ group-path path +:: ++$ permission-path path +:: ++$ state-0 + $: relation=(map group-path (set permission-path)) + == +:: ++$ card card:agent:gall +-- +:: +=| state-0 +=* state - +:: +%+ verb | +^- 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) + == +:: +++ 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 + :- [(watch-group group)]~ + state(relation (~(put by relation) group perm-paths)) + :: + =. u.perms (~(uni in u.perms) perm-paths) + :_ state(relation (~(put by relation) group u.perms)) + %+ 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]) +:: +++ 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 + %keys [~ state] + %bundle [~ state] + :: + %path + :: 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]) + :: + %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)] + == +:: +++ 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 ~] +--