urbit/pkg/arvo/app/permission-hook.hoon
2019-10-12 18:58:20 -07:00

282 lines
7.8 KiB
Plaintext

:: permission-hook: allows mirroring permissions between local and foreign
:: ships. access control to an owned permission path is specified by the
:: access-control path.
::
/- *permission-hook
/+ *permission-json
|%
+$ move [bone card]
::
+$ card
$% [%diff [%permission-update permission-update]]
[%quit ~]
[%poke wire dock [%permission-action permission-action]]
[%pull wire dock ~]
[%peer wire dock path]
==
::
+$ state
$% [%0 state-zero]
==
::
+$ owner-access [ship=ship access-control=path]
::
+$ state-zero
$: synced=(map path owner-access)
access-control=(map path (set path))
boned=(map wire (list bone))
==
::
--
::
|_ [bol=bowl:gall state]
::
++ this .
::
++ prep
|= old=(unit state)
^- (quip move _this)
[~ ?~(old this this(+<+ u.old))]
::
++ poke-permission-hook-action
|= act=permission-hook-action
^- (quip move _this)
?- -.act
%add-owned
?> (team:title our.bol src.bol)
?: (~(has by synced) owned.act)
[~ this]
=. synced (~(put by synced) owned.act [our.bol access.act])
=/ access-paths
?. (~(has by access-control) access.act)
[owned.act ~ ~]
(~(put in (~(got by access-control) access.act)) owned.act)
=. access-control
(~(put by access-control) access.act access-paths)
=/ perm-path [%permission owned.act]
:_ (track-bone perm-path)
[ost.bol %peer perm-path [our.bol %permission-store] perm-path]~
::
%add-synced
?> (team:title our.bol src.bol)
?: (~(has by synced) path.act)
[~ this]
=. synced (~(put by synced) path.act [ship.act ~])
=/ perm-path [%permission path.act]
:_ (track-bone perm-path)
[ost.bol %peer perm-path [ship.act %permission-hook] perm-path]~
::
%remove
=/ owner-access=(unit owner-access) (~(get by synced) path.act)
?~ owner-access
[~ this]
?: &(=(ship.u.owner-access our.bol) (team:title our.bol src.bol))
:: delete one of our.bol own paths
:_ %_ this
synced (~(del by synced) path.act)
boned (~(del by boned) [%permission path.act])
::
access-control
(~(del by access-control) access-control.u.owner-access)
==
%- zing
:~ (pull-wire [%permission path.act])
^- (list move)
%+ turn (prey:pubsub:userlib [%permission path.act] bol)
|= [=bone *]
[bone %quit ~]
==
?. |(=(ship.u.owner-access src.bol) (team:title our.bol src.bol))
:: if neither ship = source or source = us, do nothing
[~ this]
:: delete a foreign ship's path
:_ %_ this
synced (~(del by synced) path.act)
boned (~(del by boned) [%permission path.act])
==
(pull-wire [%permission path.act])
==
::
++ peer-permission
|= pax=path
^- (quip move _this)
?> ?=([* ^] pax)
=/ =owner-access (~(got by synced) pax)
?> =(our.bol ship.owner-access)
:: scry permissions to check if subscriber is allowed
?> (permitted-scry (scot %p src.bol) access-control.owner-access)
=/ pem (permission-scry pax)
:_ this
[ost.bol %diff %permission-update [%create pax pem]]~
::
++ diff-permission-update
|= [wir=wire diff=permission-update]
^- (quip move _this)
?: (team:title our.bol src.bol)
(handle-local diff)
(handle-foreign diff)
::
++ handle-local
|= diff=permission-update
^- (quip move _this)
?- -.diff
%create [~ this]
%add (change-local-permission [%add path.diff who.diff])
%remove (change-local-permission [%remove path.diff who.diff])
::
%delete
?. (~(has by synced) path.diff)
[~ this]
:_ this(synced (~(del by synced) path.diff))
[ost.bol %pull [%permission path.diff] [our.bol %permission-store] ~]~
==
::
++ change-local-permission
|= [kind=?(%add %remove) pax=path who=(set ship)]
^- (quip move _this)
:_ this
%+ weld
?- 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 move _this)
?- -.diff
%create (change-foreign-permission path.diff diff)
%add (change-foreign-permission path.diff diff)
%remove (change-foreign-permission path.diff diff)
::
%delete
?> ?=([* ^] path.diff)
=/ owner-access=(unit owner-access) (~(get by synced) path.diff)
?~ owner-access
[~ this]
?. =(ship.u.owner-access src.bol)
[~ this]
:_ this(synced (~(del by synced) path.diff))
:~ (permission-poke diff)
[ost.bol %pull [%permission path.diff] [src.bol %permission-hook] ~]
==
==
::
++ change-foreign-permission
|= [pax=path diff=permission-update]
^- (quip move _this)
?> ?=([* ^] pax)
=/ owner-access=(unit owner-access) (~(get by synced) pax)
:_ this
?~ owner-access ~
?. =(src.bol ship.u.owner-access) ~
[(permission-poke diff)]~
::
++ quit-subscriptions
|= [kind=?(%add %remove) pax=path who=(set ship) access-paths=(set path)]
^- (list move)
=/ perm (permission-scry pax)
?. ?|
?&(=(kind.perm %black) =(kind %add))
?&(=(kind.perm %white) =(kind %remove))
==
:: if allow, do nothing
~
=/ sup
%- ~(gas by *(map [ship path] bone))
%+ turn ~(tap by sup.bol)
|=([=bone anchor=[ship path]] [anchor bone])
:: if ban, iterate through
:: all ships that have been banned
:: and all affected paths that have had their permissions changed
:: then quit their subscriptions
::
%- zing
%+ turn ~(tap in who)
|= check-ship=ship
^- (list move)
%+ murn ~(tap in access-paths)
|= access-path=path
^- (unit move)
=/ bne (~(get by sup) [check-ship [%permission access-path]])
?~(bne ~ `[u.bne %quit ~])
::
++ quit
|= wir=wire
^- (quip move _this)
~& permission-hook-quit+wir
?> ?=([* ^] wir)
?. (~(has by synced) t.wir)
:: no-op
[~ this]
=/ =owner-access (~(got by synced) t.wir)
~& %permission-hook-resubscribe
:_ (track-bone wir)
[ost.bol %peer wir [ship.owner-access %permission-hook] wir]~
::
++ reap
|= [wir=wire saw=(unit tang)]
^- (quip move _this)
?~ saw
[~ this]
?> ?=(^ wir)
:_ this(synced (~(del by synced) t.wir))
%. ~
%- slog
:* leaf+"permission-hook failed subscribe on {(spud t.wir)}"
leaf+"stack trace:"
u.saw
==
::
++ permission-scry
|= pax=path
^- permission
=. pax ;:(weld /=permission-store/(scot %da now.bol)/permission pax /noun)
(need .^((unit permission) %gx pax))
::
++ permitted-scry
|= pax=path
^- ?
.^(? %gx ;:(weld /=permission-store/(scot %da now.bol)/permitted pax /noun))
::
++ permission-poke
|= act=permission-action
^- move
[ost.bol %poke / [our.bol %permission-store] [%permission-action act]]
::
++ update-subscribers
|= [pax=path upd=permission-update]
^- (list move)
%+ turn (prey:pubsub:userlib pax bol)
|= [=bone *]
[bone %diff %permission-update upd]
::
++ track-bone
|= wir=wire
^+ this
=/ bnd (~(get by boned) wir)
?^ bnd
this(boned (~(put by boned) wir (snoc u.bnd ost.bol)))
this(boned (~(put by boned) wir [ost.bol]~))
::
++ pull-wire
|= pax=path
^- (list move)
?> ?=([* ^] pax)
=/ bnd (~(get by boned) pax)
?~ bnd ~
=/ owner-access=(unit owner-access) (~(get by synced) t.pax)
?~ owner-access ~
%+ turn u.bnd
|= =bone
?: =(ship.u.owner-access our.bol)
[bone %pull pax [our.bol %permission-store] ~]
[bone %pull pax [ship.u.owner-access %permission-hook] ~]
::
--