mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 08:32:39 +03:00
contacts: write hooks and use permisssioning system
This commit is contained in:
parent
6d95cc76a4
commit
54b64f5682
45
pkg/arvo/app/contact-pull-hook.hoon
Normal file
45
pkg/arvo/app/contact-pull-hook.hoon
Normal file
@ -0,0 +1,45 @@
|
||||
/- *resource
|
||||
/+ store=contact-store, contact, default-agent, verb, dbug, pull-hook
|
||||
~% %contact-pull-hook-top ..part ~
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
++ config
|
||||
^- config:pull-hook
|
||||
:* %contact-store
|
||||
update:store
|
||||
%contact-update
|
||||
%contact-push-hook
|
||||
==
|
||||
--
|
||||
::
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
%- (agent:pull-hook config)
|
||||
^- (pull-hook:pull-hook config)
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
dep ~(. (default:pull-hook this config) bowl)
|
||||
con ~(. contact bowl)
|
||||
::
|
||||
++ on-init on-init:def
|
||||
++ on-save !>(~)
|
||||
++ on-load on-load:def
|
||||
++ on-poke on-poke:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-watch on-watch:def
|
||||
++ on-leave on-leave:def
|
||||
++ on-pull-nack
|
||||
|= [=resource =tang]
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
?~ (get-contact:con entity.resource) ~
|
||||
=- [%pass /pl-nack %agent [our.bowl %contact-store] %poke %contact-update -]~
|
||||
!> ^- update:store
|
||||
[%remove entity.resource]
|
||||
::
|
||||
++ on-pull-kick |=(=resource `/)
|
||||
--
|
81
pkg/arvo/app/contact-push-hook.hoon
Normal file
81
pkg/arvo/app/contact-push-hook.hoon
Normal file
@ -0,0 +1,81 @@
|
||||
/+ store=contact-store, res=resource, contact, default-agent, dbug, push-hook
|
||||
~% %contact-push-hook-top ..part ~
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
++ config
|
||||
^- config:push-hook
|
||||
:* %contact-store
|
||||
/our
|
||||
update:store
|
||||
%contact-update
|
||||
%graph-pull-hook
|
||||
==
|
||||
::
|
||||
+$ agent (push-hook:push-hook config)
|
||||
--
|
||||
::
|
||||
%- agent:dbug
|
||||
^- agent:gall
|
||||
%- (agent:push-hook config)
|
||||
^- agent
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
con ~(. contact bowl)
|
||||
::
|
||||
++ on-init on-init:def
|
||||
++ on-save !>(~)
|
||||
++ on-load on-load:def
|
||||
++ on-poke on-poke:def
|
||||
++ 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)
|
||||
?- -.update
|
||||
%initial %.n
|
||||
%add %.y
|
||||
%remove %.y
|
||||
%edit %.y
|
||||
%allow %.n
|
||||
%disallow %.n
|
||||
==
|
||||
::
|
||||
++ resource-for-update
|
||||
|= =vase
|
||||
^- (unit resource:res)
|
||||
=/ =update:store !<(update:store vase)
|
||||
?- -.update
|
||||
%initial ~
|
||||
%add `[our.bowl %our]
|
||||
%remove `[our.bowl %our]
|
||||
%edit `[our.bowl %our]
|
||||
%allow ~
|
||||
%disallow `[our.bowl %our]
|
||||
==
|
||||
::
|
||||
++ initial-watch
|
||||
|= [=path =resource:res]
|
||||
^- vase
|
||||
?> (is-allowed:con src.bowl)
|
||||
!> ^- update:store
|
||||
=/ contact=(unit contact:store) (get-contact:con our.bowl)
|
||||
:+ %add
|
||||
our.bowl
|
||||
?^ contact u.contact
|
||||
*contact:store
|
||||
::
|
||||
++ take-update
|
||||
|= =vase
|
||||
^- [(list card) agent]
|
||||
=/ =update:store !<(update:store vase)
|
||||
?. ?=(%disallow -.update) [~ this]
|
||||
:_ this
|
||||
[%give %kick ~[resource+(en-path:res [our.bowl %our])] ~]~
|
||||
--
|
@ -48,6 +48,14 @@
|
||||
?+ path (on-watch:def path)
|
||||
[%all ~] (give [%initial rolodex])
|
||||
[%updates ~] ~
|
||||
::
|
||||
[%our ~]
|
||||
%- give
|
||||
:+ %add
|
||||
our.bowl
|
||||
=/ contact=(unit contact:store) (~(get by rolodex) our.bowl)
|
||||
?~ contact *contact:store
|
||||
u.contact
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
@ -87,20 +95,19 @@
|
||||
^- (quip card _state)
|
||||
=. rolodex (~(uni by rolodex) rolo)
|
||||
:_ state(rolodex rolodex)
|
||||
(send-diff [%initial rolodex])
|
||||
(send-diff [%initial rolodex] %.n)
|
||||
::
|
||||
++ handle-add
|
||||
|= [=ship =contact:store]
|
||||
^- (quip card _state)
|
||||
?< (~(has by rolodex) ship)
|
||||
:- (send-diff [%add ship contact])
|
||||
:- (send-diff [%add ship contact] =(ship our.bowl))
|
||||
state(rolodex (~(put by rolodex) ship contact))
|
||||
::
|
||||
++ handle-remove
|
||||
|= =ship
|
||||
^- (quip card _state)
|
||||
?> (~(has by rolodex) ship)
|
||||
:- (send-diff [%remove ship])
|
||||
:- (send-diff [%remove ship] =(ship our.bowl))
|
||||
state(rolodex (~(del by rolodex) ship))
|
||||
::
|
||||
++ handle-edit
|
||||
@ -109,7 +116,7 @@
|
||||
^- (quip card _state)
|
||||
=/ contact (~(got by rolodex) ship)
|
||||
=. contact (edit-contact contact edit-field)
|
||||
:- (send-diff [%edit ship edit-field])
|
||||
:- (send-diff [%edit ship edit-field] =(ship our.bowl))
|
||||
state(rolodex (~(put by rolodex) ship contact))
|
||||
::
|
||||
++ edit-contact
|
||||
@ -128,7 +135,7 @@
|
||||
++ handle-allow
|
||||
|= =beings:store
|
||||
^- (quip card _state)
|
||||
:- (send-diff [%allow beings])
|
||||
:- (send-diff [%allow beings] %.n)
|
||||
?- -.beings
|
||||
%group state(allowed-groups (~(put in allowed-groups) resource.beings))
|
||||
%ships state(allowed-ships (~(uni in allowed-ships) ships.beings))
|
||||
@ -137,16 +144,20 @@
|
||||
++ handle-disallow
|
||||
|= =beings:store
|
||||
^- (quip card _state)
|
||||
:- (send-diff [%disallow beings])
|
||||
:- (send-diff [%disallow beings] %.y)
|
||||
?- -.beings
|
||||
%group state(allowed-groups (~(del in allowed-groups) resource.beings))
|
||||
%ships state(allowed-ships (~(dif in allowed-ships) ships.beings))
|
||||
==
|
||||
::
|
||||
++ send-diff
|
||||
|= =update:store
|
||||
|= [=update:store our=?]
|
||||
^- (list card)
|
||||
[%give %fact ~[/updates] %contact-update !>(update)]~
|
||||
=/ paths=(list path)
|
||||
?: our
|
||||
`(list path)`[/updates /our]~
|
||||
~[/updates]
|
||||
[%give %fact paths %contact-update !>(update)]~
|
||||
--
|
||||
::
|
||||
++ import
|
||||
@ -169,6 +180,13 @@
|
||||
:- ~ :- ~ :- %contact-update
|
||||
!> ^- update:store
|
||||
[%add ship u.contact]
|
||||
::
|
||||
[%x %allowed-ship @ ~]
|
||||
=/ =ship (slav %p i.t.t.path)
|
||||
``noun+!>((~(has in allowed-ships) ship))
|
||||
::
|
||||
[%x %allowed-groups ~]
|
||||
``noun+!>(allowed-groups)
|
||||
==
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
|
34
pkg/arvo/lib/contact.hoon
Normal file
34
pkg/arvo/lib/contact.hoon
Normal file
@ -0,0 +1,34 @@
|
||||
/- store=contact-store
|
||||
/+ group
|
||||
|_ =bowl:gall
|
||||
++ scry-for
|
||||
|* [=mold =path]
|
||||
.^ mold
|
||||
%gx
|
||||
(scot %p our.bowl)
|
||||
%contact-store
|
||||
(scot %da now.bowl)
|
||||
(snoc `^path`path %noun)
|
||||
==
|
||||
::
|
||||
++ get-contact
|
||||
|= =ship
|
||||
^- (unit contact:store)
|
||||
=/ upd (scry-for (unit update:store) /contact/(scot %p ship))
|
||||
?~ upd ~
|
||||
?> ?=(%add -.u.upd)
|
||||
`contact.u.upd
|
||||
::
|
||||
++ is-allowed
|
||||
|= =ship
|
||||
^- ?
|
||||
=/ shp (scry-for ? /allowed-ship/(scot %p ship))
|
||||
?: shp %.y
|
||||
=/ allowed-groups ~(tap in (scry-for (set resource) /allowed-groups))
|
||||
=/ grp ~(. group bowl)
|
||||
|-
|
||||
?~ allowed-groups %.n
|
||||
?: ~(has in (members:grp i.allowed-groups) ship)
|
||||
%.y
|
||||
$(allowed-groups t.allowed-groups)
|
||||
--
|
Loading…
Reference in New Issue
Block a user