shrub/pkg/arvo/app/permission-store.hoon
2020-08-31 21:54:39 -04:00

204 lines
4.8 KiB
Plaintext

:: permission-store [landscape]:
::
:: track black- and whitelists of ships
::
/- *permission-store
/+ default-agent, verb, dbug
::
|%
+$ card card:agent:gall
::
+$ versioned-state
$% state-zero
==
::
+$ state-zero
$: %0
permissions=permission-map
==
--
=| state-zero
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
permission-core +>
pc ~(. permission-core bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(state-zero old))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?: ?=(%permission-action mark)
(poke-permission-action:pc !<(permission-action vase))
(on-poke:def mark vase)
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
|^
=/ cards=(list card)
?+ path (on-watch:def path)
[%all ~] (give %permission-update !>([%initial permissions]))
[%updates ~] ~
[%permission @ *]
=/ =vase !>([%create t.path (~(got by permissions) t.path)])
(give %permission-update vase)
==
[cards this]
::
++ give
|= =cage
^- (list card)
[%give %fact ~ cage]~
--
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %keys ~] ``noun+!>(~(key by permissions))
[%x %permission *]
?~ t.t.path ~
``noun+!>((~(get by permissions) t.t.path))
::
[%x %permitted @ *]
?~ t.t.t.path ~
=/ pem (~(get by permissions) t.t.t.path)
?~ pem ~
=/ who (slav %p i.t.t.path)
=/ has (~(has in who.u.pem) who)
``noun+!>(?-(kind.u.pem %black !has, %white has))
==
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
::
|_ bol=bowl:gall
::
++ poke-permission-action
|= action=permission-action
^- (quip card _state)
?> (team:title our.bol src.bol)
?- -.action
%initial [~ state]
%add (handle-add action)
%remove (handle-remove action)
%create (handle-create action)
%delete (handle-delete action)
%allow (handle-allow action)
%deny (handle-deny action)
==
::
++ handle-add
|= act=permission-action
^- (quip card _state)
?> ?=(%add -.act)
?~ path.act
[~ state]
:: TODO: calculate diff
:: =+ new=(~(dif in who.what.action) who.u.pem)
:: ?~(new ~ `what.action(who new))
?. (~(has by permissions) path.act)
[~ state]
:- (send-diff path.act act)
=/ perm (~(got by permissions) path.act)
=. who.perm (~(uni in who.perm) who.act)
state(permissions (~(put by permissions) path.act perm))
::
++ handle-remove
|= act=permission-action
^- (quip card _state)
?> ?=(%remove -.act)
?~ path.act
[~ state]
?. (~(has by permissions) path.act)
[~ state]
=/ perm (~(got by permissions) path.act)
=. who.perm (~(dif in who.perm) who.act)
:: TODO: calculate diff
:: =+ new=(~(int in who.what.action) who.u.pem)
:: ?~(new ~ `what.action(who new))
:- (send-diff path.act act)
state(permissions (~(put by permissions) path.act perm))
::
++ handle-create
|= act=permission-action
^- (quip card _state)
?> ?=(%create -.act)
?~ path.act
[~ state]
?: (~(has by permissions) path.act)
[~ state]
:: TODO: calculate diff
:- (send-diff path.act act)
state(permissions (~(put by permissions) path.act permission.act))
::
++ handle-delete
|= act=permission-action
^- (quip card _state)
?> ?=(%delete -.act)
?~ path.act
[~ state]
?. (~(has by permissions) path.act)
[~ state]
:- (send-diff path.act act)
state(permissions (~(del by permissions) path.act))
::
++ handle-allow
|= act=permission-action
^- (quip card _state)
?> ?=(%allow -.act)
?~ path.act
[~ state]
=/ perm (~(get by permissions) path.act)
?~ perm
[~ state]
?: =(kind.u.perm %white)
(handle-add [%add +.act])
(handle-remove [%remove +.act])
::
++ handle-deny
|= act=permission-action
^- (quip card _state)
?> ?=(%deny -.act)
?~ path.act
[~ state]
=/ perm (~(get by permissions) path.act)
?~ perm
[~ state]
?: =(kind.u.perm %black)
(handle-add [%add +.act])
(handle-remove [%remove +.act])
::
++ update-subscribers
|= [pax=path upd=permission-update]
^- (list card)
[%give %fact ~[pax] %permission-update !>(upd)]~
::
++ send-diff
|= [pax=path upd=permission-update]
^- (list card)
%- zing
:~ (update-subscribers /all upd)
(update-subscribers /updates upd)
(update-subscribers [%permission pax] upd)
==
--