shrub/pkg/arvo/app/group-push-hook.hoon

182 lines
3.8 KiB
Plaintext
Raw Normal View History

:: group-hook [landscape]:
::
:: allow syncing group data from foreign paths to local paths
::
/- *group, *invite-store
/+ default-agent, verb, dbug, store=group-store, grpl=group, push-hook,
resource
~% %group-hook-top ..part ~
|%
+$ card card:agent:gall
::
++ config
^- config:push-hook
:* %group-store
/groups
update:store
%group-update
%group-pull-hook
==
::
+$ agent (push-hook:push-hook config)
--
::
::
%- agent:dbug
%+ verb |
^- agent:gall
%- (agent:push-hook config)
^- agent
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
grp ~(. grpl bowl)
::
++ on-init on-init:def
++ on-save !>(~)
++ on-load on-load:def
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?. =(mark %sane)
(on-poke:def mark vase)
[(sane !<(?(%check %fix) vase)) this]
::
++ scry-sharing
.^ (set resource)
%gx
(scot %p our.bowl)
%group-push-hook
(scot %da now.bowl)
/sharing/noun
==
::
++ sane
|= input=?(%check %fix)
^- (list card)
=; cards=(list card)
?: =(%check input)
~&(cards ~)
cards
%+ murn
~(tap in scry-sharing)
|= rid=resource
^- (unit card)
=/ u-g=(unit group)
(scry-group:grp rid)
?~ u-g
`(poke-us %remove rid)
=* group u.u-g
=/ subs=(set ship)
(get-subscribers-for-group rid)
=/ to-remove=(set ship)
(~(dif in members.group) (~(gas in subs) our.bowl ~))
?~ to-remove ~
`(poke-store %remove-members rid to-remove)
::
++ poke-us
|= =action:push-hook
^- card
=- [%pass / %agent [our.bowl %group-push-hook] %poke -]
push-hook-action+!>(action)
::
++ poke-store
|= =update:store
^- card
=+ group-update+!>(update)
[%pass /sane %agent [our.bowl %group-store] %poke -]
::
++ get-subscribers-for-group
|= rid=resource
^- (set ship)
=/ target=path
(en-path:resource rid)
%- ~(gas in *(set ship))
%+ murn
~(val by sup.bowl)
|= [her=ship =path]
^- (unit ship)
?. =(path resource+target)
~
`her
--
++ on-agent on-agent:def
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ should-proxy-update
|= =vase
=/ =update:store
!<(update:store vase)
?: ?=(%initial -.update)
%.n
|^
=/ role=(unit (unit role-tag))
(role-for-ship:grp resource.update src.bowl)
?~ role
non-member
?~ u.role
member
?- u.u.role
%admin admin
%moderator moderator
%janitor member
==
++ member
?: ?=(%add-members -.update)
=(~(tap in ships.update) ~[src.bowl])
?: ?=(%remove-members -.update)
=(~(tap in ships.update) ~[src.bowl])
%.n
++ admin
!?=(?(%remove-group %add-group) -.update)
++ moderator
?= $? %add-members %remove-members
%add-tag %remove-tag ==
-.update
++ non-member
?& ?=(%add-members -.update)
(can-join:grp resource.update src.bowl)
=(~(tap in ships.update) ~[src.bowl])
==
--
++ resource-for-update resource-for-update:grp
::
++ take-update
|= =vase
^- [(list card) agent]
=/ =update:store
!<(update:store vase)
?: ?=(%remove-group -.update)
=/ paths
~[resource+(en-path:resource resource.update)]
:_ this
[%give %kick paths ~]~
?. ?=(%remove-members -.update)
[~ this]
=/ paths
~[resource+(en-path:resource resource.update)]
:_ this
%+ turn
~(tap in ships.update)
|= =ship
[%give %kick paths `ship]
::
++ initial-watch
|= [=path rid=resource]
^- vase
=/ group
(scry-group:grp rid)
?> ?=(^ group)
?> (~(has in members.u.group) src.bowl)
!> ^- update:store
[%initial-group rid u.group]
::
--