diff --git a/pkg/arvo/app/permission-hook.hoon b/pkg/arvo/app/permission-hook.hoon new file mode 100644 index 0000000000..6feb3eec41 --- /dev/null +++ b/pkg/arvo/app/permission-hook.hoon @@ -0,0 +1,330 @@ +:: permission-hook: mirror remote permissions +:: +:: allows mirroring permissions between local and foreign ships. +:: local permission path are exposed according to the permssion paths +:: configured for them as `access-control`. +:: +/- *permission-hook +/+ *permission-json, default-agent, verb +:: +|% ++$ state + $% [%0 state-0] + == +:: ++$ owner-access [ship=ship access-control=path] +:: ++$ state-0 + $: synced=(map path owner-access) + access-control=(map path (set path)) + boned=(map wire (list bone)) + == +:: ++$ 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) + %permission-hook-action + =^ cards state + (handle-permission-hook-action:do !<(permission-hook-action vase)) + [cards this] + == + :: + ++ on-watch + |= =path + ^- (quip card _this) + ?. ?=([%permission ^] path) (on-watch:def path) + =^ cards state + (handle-watch-permission:do t.path) + [cards this] + :: + ++ on-agent + |= [=wire =sign:agent:gall] + ^- (quip card _this) + ?- -.sign + %poke-ack (on-agent:def wire sign) + :: + %fact + ?. ?=(%permission-update p.cage.sign) + (on-agent:def wire sign) + =^ cards state + (handle-permission-update:do wire !<(permission-update q.cage.sign)) + [cards this] + :: + %watch-ack + ?~ p.sign [~ this] + ?> ?=(^ wire) + :_ this(synced (~(del by synced) t.wire)) + ::NOTE we could've gotten rejected for permission reasons, so we don't + :: try to resubscribe automatically. + %. ~ + %- slog + :* leaf+"permission-hook failed subscribe on {(spud t.wire)}" + leaf+"stack trace:" + u.p.sign + == + :: + %kick + ?> ?=([* ^] wire) + :: if we're not actively using it, we can safely ignore the %kick. + :: + ?. (~(has by synced) t.wire) + [~ this] + :: otherwise, resubscribe. + :: + =/ =owner-access (~(got by synced) t.wire) + :_ this + [%pass wire %agent [ship.owner-access %permission-hook] %watch wire]~ + == + :: + ++ on-leave on-leave:def + ++ on-peek on-peek:def + ++ on-arvo on-arvo:def + ++ on-fail on-fail:def + -- +:: +|_ =bowl:gall +++ handle-permission-hook-action + |= act=permission-hook-action + ^- (quip card _state) + ?- -.act + %add-owned + ?> (team:title our.bowl src.bowl) + ?: (~(has by synced) owned.act) + [~ state] + =. synced (~(put by synced) owned.act [our.bowl access.act]) + =. access-control + (~(put ju access-control) access.act owned.act) + =/ perm-path [%permission owned.act] + :_ state + [%pass perm-path %agent [our.bowl %permission-store] %watch perm-path]~ + :: + %add-synced + ?> (team:title our.bowl src.bowl) + ?: (~(has by synced) path.act) + [~ state] + =. synced (~(put by synced) path.act [ship.act ~]) + =/ perm-path [%permission path.act] + :_ state + [%pass perm-path %agent [ship.act %permission-hook] %watch perm-path]~ + :: + %remove + =/ owner-access=(unit owner-access) + (~(get by synced) path.act) + ?~ owner-access + [~ state] + :: if we own it, and it's us asking, + :: + ?: ?& =(ship.u.owner-access our.bowl) + (team:title our.bowl src.bowl) + == + :: delete the permission path and its subscriptions from this hook. + :: + :- :- [%give %kick `[%permission path.act] ~] + (leave-permission path.act) + %_ state + synced (~(del by synced) path.act) + :: + access-control + (~(del by access-control) access-control.u.owner-access) + == + :: else, if either source = ship or source = us, + :: + ?: |(=(ship.u.owner-access src.bowl) (team:title our.bowl src.bowl)) + :: delete a foreign ship's path. + :: + :- (leave-permission path.act) + %_ state + synced (~(del by synced) path.act) + boned (~(del by boned) [%permission path.act]) + == + :: else, ignore action entirely. + :: + [~ state] + == +:: +++ handle-watch-permission + |= =path + ^- (quip card _state) + =/ =owner-access (~(got by synced) path) + ?> =(our.bowl ship.owner-access) + :: scry permissions to check if subscriber is allowed + :: + ?> (permitted src.bowl access-control.owner-access) + =/ pem (permission-scry path) + :_ state + [%give %fact ~ %permission-update !>([%create path pem])]~ +:: +++ handle-permission-update + |= [=wire diff=permission-update] + ^- (quip card _state) + ?: (team:title our.bowl src.bowl) + (handle-local diff) + (handle-foreign diff) +:: +++ handle-local + |= diff=permission-update + ^- (quip card _state) + ?- -.diff + %create [~ state] + %add (change-local-permission %add [path who]:diff) + %remove (change-local-permission %remove [path who]:diff) + :: + %delete + ?. (~(has by synced) path.diff) + [~ state] + :_ state(synced (~(del by synced) path.diff)) + :_ ~ + :* %pass + [%permission path.diff] + %agent + [our.bowl %permission-store] + [%leave ~] + == + == +:: +++ change-local-permission + |= [kind=?(%add %remove) pax=path who=(set ship)] + ^- (quip card _state) + :_ state + :- ?- kind + %add (update-subscribers [%permission pax] [%add pax who]) + %remove (update-subscribers [%permission pax] [%remove pax who]) + == + =/ access-paths=(unit (set path)) (~(get by access-control) pax) + :: check if this path changes the access permissions for other paths + ?~ access-paths ~ + (quit-subscriptions kind pax who u.access-paths) +:: +++ handle-foreign + |= diff=permission-update + ^- (quip card _state) + ?- -.diff + ?(%create %add %remove) + (change-foreign-permission path.diff diff) + :: + %delete + ?> ?=([* ^] path.diff) + =/ owner-access=(unit owner-access) + (~(get by synced) path.diff) + ?~ owner-access + [~ state] + ?. =(ship.u.owner-access src.bowl) + [~ state] + :_ state(synced (~(del by synced) path.diff)) + :~ (permission-poke diff) + :: + :* %pass + [%permission path.diff] + %agent + [src.bowl %permission-hook] + [%leave ~] + == + == + == +:: +++ change-foreign-permission + |= [=path diff=permission-update] + ^- (quip card _state) + ?> ?=([* ^] path) + =/ owner-access=(unit owner-access) + (~(get by synced) path) + :_ state + ?~ owner-access ~ + ?. =(src.bowl ship.u.owner-access) ~ + [(permission-poke diff)]~ +:: +++ quit-subscriptions + |= $: kind=?(%add %remove) + perm-path=path + who=(set ship) + access-paths=(set path) + == + ^- (list card) + =/ perm (permission-scry perm-path) + :: if the change resolves to "allow", + :: + ?. ?| ?&(=(%black kind.perm) =(%add kind)) + ?&(=(%white kind.perm) =(%remove kind)) + == + :: do nothing. + ~ + :: else, it resolves to "deny"/"ban". + :: kick subscriptions for all ships, at all affected paths. + :: + %- zing + %+ turn ~(tap in who) + |= check-ship=ship + ^- (list card) + %+ turn ~(tap in access-paths) + |= access-path=path + [%give %kick `[%permission access-path] `check-ship] +:: +++ permission-scry + |= pax=path + ^- permission + =. pax ;:(weld /=permission-store/(scot %da now.bowl)/permission pax /noun) + (need .^((unit permission) %gx pax)) +:: +++ permitted + |= [who=ship =path] + .^ ? + %gx + (scot %p our.bowl) + %permission-store + (scot %da now.bowl) + %permitted + (scot %p src.bowl) + (snoc path %noun) + == +:: +++ permission-poke + |= act=permission-action + ^- card + :* %pass + /permission-action + %agent + [our.bowl %permission-store] + %poke + %permission-action + !>(act) + == +:: +++ update-subscribers + |= [=path upd=permission-update] + ^- card + [%give %fact `path %permission-update !>(upd)] +:: +++ leave-permission + |= =path + ^- (list card) + =/ owner-access=(unit owner-access) + (~(get by synced) path) + ?~ owner-access ~ + :_ ~ + =/ perm-path [%permission path] + ?: =(ship.u.owner-access our.bowl) + [%pass perm-path %agent [our.bowl %permission-store] %leave ~] + [%pass perm-path %agent [ship.u.owner-access %permission-hook] %leave ~] +--