mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-13 08:38:43 +03:00
ea93dd3af8
Specifically, this commit removes the add action from the contact-view and replaces it with a listener within contact-hook for additions to groups. This means that when a ship is added to a group that the contact-hook is watching, the ship is automatically sent an invite to join that "managed group" from the contacts application. This also includes the UI integration work on the management screen and settings screen for working with the new group / permission structure.
415 lines
11 KiB
Plaintext
415 lines
11 KiB
Plaintext
:: contact-hook:
|
|
::
|
|
/- *group-store, *group-hook, *contact-hook, *invite-store
|
|
/+ *contact-json, default-agent
|
|
|%
|
|
+$ card card:agent:gall
|
|
::
|
|
+$ versioned-state
|
|
$% state-zero
|
|
==
|
|
::
|
|
+$ state-zero
|
|
$: %0
|
|
synced=(map path ship)
|
|
invite-created=_|
|
|
==
|
|
--
|
|
=| state-zero
|
|
=* state -
|
|
^- agent:gall
|
|
=<
|
|
|_ bol=bowl:gall
|
|
+* this .
|
|
contact-core +>
|
|
cc ~(. contact-core bol)
|
|
def ~(. (default-agent this %|) bol)
|
|
::
|
|
++ on-init
|
|
^- (quip card _this)
|
|
:_ this(invite-created %.y)
|
|
:~ (invite-poke:cc [%create /contacts])
|
|
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]
|
|
[%pass /group %agent [our.bol %group-store] %watch /updates]
|
|
==
|
|
++ on-save !>(state)
|
|
++ on-load
|
|
|= old=vase
|
|
`this(state !<(state-zero old))
|
|
::
|
|
++ on-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
=^ cards state
|
|
?+ mark (on-poke:def mark vase)
|
|
%json
|
|
(poke-json:cc !<(json vase))
|
|
::
|
|
%contact-action
|
|
(poke-contact-action:cc !<(contact-action vase))
|
|
::
|
|
%contact-hook-action
|
|
(poke-hook-action:cc !<(contact-hook-action vase))
|
|
==
|
|
[cards this]
|
|
::
|
|
++ on-watch
|
|
|= =path
|
|
^- (quip card _this)
|
|
?+ path (on-watch:def path)
|
|
[%contacts *] [(watch-contacts:cc t.path) this]
|
|
==
|
|
::
|
|
++ on-agent
|
|
|= [=wire =sign:agent:gall]
|
|
^- (quip card _this)
|
|
?+ -.sign (on-agent:def wire sign)
|
|
%kick [(kick:cc wire) this]
|
|
%watch-ack
|
|
=^ cards state
|
|
(watch-ack:cc wire p.sign)
|
|
[cards this]
|
|
::
|
|
%fact
|
|
?+ p.cage.sign (on-agent:def wire sign)
|
|
%contact-update
|
|
=^ cards state
|
|
(fact-contact-update:cc wire !<(contact-update q.cage.sign))
|
|
[cards this]
|
|
::
|
|
%group-update
|
|
=^ cards state
|
|
(fact-group-update:cc wire !<(group-update q.cage.sign))
|
|
[cards this]
|
|
::
|
|
%invite-update
|
|
=^ cards state
|
|
(fact-invite-update:cc wire !<(invite-update q.cage.sign))
|
|
[cards this]
|
|
==
|
|
==
|
|
::
|
|
++ on-leave on-leave:def
|
|
++ on-peek on-peek:def
|
|
++ on-arvo on-arvo:def
|
|
++ on-fail on-fail:def
|
|
--
|
|
::
|
|
|_ bol=bowl:gall
|
|
::
|
|
++ poke-json
|
|
|= jon=json
|
|
^- (quip card _state)
|
|
(poke-contact-action (json-to-action jon))
|
|
::
|
|
++ poke-contact-action
|
|
|= act=contact-action
|
|
^- (quip card _state)
|
|
|^
|
|
:_ state
|
|
?+ -.act !!
|
|
%edit (handle-contact-action path.act ship.act act)
|
|
%add (handle-contact-action path.act ship.act act)
|
|
%remove (handle-contact-action path.act ship.act act)
|
|
==
|
|
::
|
|
++ handle-contact-action
|
|
|= [=path =ship act=contact-action]
|
|
^- (list card)
|
|
:: local
|
|
?: (team:title our.bol src.bol)
|
|
=/ shp ?:(=(path /~/default) our.bol (~(got by synced) path))
|
|
=/ appl ?:(=(shp our.bol) %contact-store %contact-hook)
|
|
[%pass / %agent [shp appl] %poke %contact-action !>(act)]~
|
|
:: foreign
|
|
=/ shp (~(got by synced) path)
|
|
?. |(=(shp our.bol) =(src.bol ship)) ~
|
|
:: scry group to check if ship is a member
|
|
=/ =group (need (group-scry path))
|
|
?. (~(has in group) shp) ~
|
|
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]~
|
|
--
|
|
::
|
|
++ poke-hook-action
|
|
|= act=contact-hook-action
|
|
^- (quip card _state)
|
|
?- -.act
|
|
%add-owned
|
|
?> (team:title our.bol src.bol)
|
|
=/ contact-path [%contacts path.act]
|
|
?: (~(has by synced) path.act)
|
|
[~ state]
|
|
=. synced (~(put by synced) path.act our.bol)
|
|
:_ state
|
|
[%pass contact-path %agent [our.bol %contact-store] %watch contact-path]~
|
|
::
|
|
%add-synced
|
|
?> (team:title our.bol src.bol)
|
|
?: (~(has by synced) path.act) [~ state]
|
|
=. synced (~(put by synced) path.act ship.act)
|
|
=/ contact-path [%contacts path.act]
|
|
:_ state
|
|
[%pass contact-path %agent [ship.act %contact-hook] %watch contact-path]~
|
|
::
|
|
%remove
|
|
=/ ship (~(get by synced) path.act)
|
|
?~ ship [~ state]
|
|
?: &(=(u.ship our.bol) (team:title our.bol src.bol))
|
|
:: delete one of our.bol own paths
|
|
:_ state(synced (~(del by synced) path.act))
|
|
%- zing
|
|
:~ (pull-wire [%contacts path.act])
|
|
[%give %kick ~[[%contacts path.act]] ~]~
|
|
==
|
|
?. |(=(u.ship src.bol) (team:title our.bol src.bol))
|
|
:: if neither ship = source or source = us, do nothing
|
|
[~ state]
|
|
:: delete a foreign ship's path
|
|
:- (pull-wire [%contacts path.act])
|
|
state(synced (~(del by synced) path.act))
|
|
==
|
|
::
|
|
++ watch-contacts
|
|
|= pax=path
|
|
^- (list card)
|
|
?> ?=(^ pax)
|
|
?> (~(has by synced) pax)
|
|
:: scry groups to check if ship is a member
|
|
=/ =group (need (group-scry pax))
|
|
?> (~(has in group) src.bol)
|
|
=/ contacts (need (contacts-scry pax))
|
|
:~ :*
|
|
%give %fact ~ %contact-update
|
|
!>([%contacts pax contacts])
|
|
== ==
|
|
::
|
|
++ watch-ack
|
|
|= [wir=wire saw=(unit tang)]
|
|
^- (quip card _state)
|
|
?~ saw
|
|
[~ state]
|
|
?> ?=(^ wir)
|
|
:_ state(synced (~(del by synced) t.wir))
|
|
%. ~
|
|
%- slog
|
|
:* leaf+"contact-hook failed subscribe on {(spud t.wir)}"
|
|
leaf+"stack trace:"
|
|
u.saw
|
|
==
|
|
::
|
|
++ kick
|
|
|= wir=wire
|
|
^- (list card)
|
|
?+ wir !!
|
|
[%inv ~]
|
|
[%pass /inv %agent [our.bol %invite-store] %watch /invitatory/contacts]~
|
|
::
|
|
[%group ~]
|
|
[%pass /group %agent [our.bol %group-store] %watch /updates]~
|
|
::
|
|
[%contacts @ *]
|
|
~& contacts-kick+wir
|
|
?. (~(has by synced) t.wir) ~
|
|
~& %contact-hook-resubscribe
|
|
=/ =ship (~(got by synced) t.wir)
|
|
?: =(ship our.bol)
|
|
[%pass wir %agent [our.bol %contact-store] %watch wir]~
|
|
[%pass wir %agent [ship %contact-hook] %watch wir]~
|
|
==
|
|
::
|
|
++ fact-contact-update
|
|
|= [wir=wire fact=contact-update]
|
|
^- (quip card _state)
|
|
|^
|
|
?: (team:title our.bol src.bol)
|
|
(local fact)
|
|
:_ state
|
|
(foreign fact)
|
|
::
|
|
++ give-fact
|
|
|= [=path update=contact-update]
|
|
^- (list card)
|
|
[%give %fact ~[[%contacts path]] %contact-update !>(update)]~
|
|
::
|
|
++ local
|
|
|= fact=contact-update
|
|
^- (quip card _state)
|
|
?+ -.fact [~ state]
|
|
%add
|
|
:_ state
|
|
(give-fact path.fact [%add path.fact ship.fact contact.fact])
|
|
::
|
|
%edit
|
|
:_ state
|
|
(give-fact path.fact [%edit path.fact ship.fact edit-field.fact])
|
|
::
|
|
%remove
|
|
:_ state
|
|
~[(group-poke [%remove [ship.fact ~ ~] path.fact])]
|
|
::
|
|
%delete
|
|
=. synced (~(del by synced) path.fact)
|
|
:_ state
|
|
[(group-poke [%unbundle path.fact])]~
|
|
==
|
|
::
|
|
++ foreign
|
|
|= fact=contact-update
|
|
^- (list card)
|
|
?+ -.fact ~
|
|
%contacts
|
|
=/ owner (~(got by synced) path.fact)
|
|
?> =(owner src.bol)
|
|
%+ weld
|
|
:~ (contact-poke [%delete path.fact])
|
|
(contact-poke [%create path.fact])
|
|
==
|
|
%+ turn ~(tap by contacts.fact)
|
|
|= [=ship =contact]
|
|
(contact-poke [%add path.fact ship contact])
|
|
::
|
|
%add
|
|
=/ owner (~(got by synced) path.fact)
|
|
?> |(=(owner src.bol) =(src.bol ship.fact))
|
|
~[(contact-poke [%add path.fact ship.fact contact.fact])]
|
|
::
|
|
%remove
|
|
=/ owner (~(got by synced) path.fact)
|
|
?> |(=(owner src.bol) =(src.bol ship.fact))
|
|
%+ welp
|
|
:~ (group-poke [%remove [ship.fact ~ ~] path.fact])
|
|
(contact-poke [%remove path.fact ship.fact])
|
|
==
|
|
?. =(ship.fact our.bol) ~
|
|
~[(group-poke [%unbundle path.fact])]
|
|
::
|
|
%edit
|
|
=/ owner (~(got by synced) path.fact)
|
|
?> |(=(owner src.bol) =(src.bol ship.fact))
|
|
~[(contact-poke [%edit path.fact ship.fact edit-field.fact])]
|
|
==
|
|
--
|
|
::
|
|
++ fact-group-update
|
|
|= [wir=wire fact=group-update]
|
|
^- (quip card _state)
|
|
|^
|
|
?+ -.fact [~ state]
|
|
%add (add +.fact)
|
|
%remove (remove +.fact)
|
|
%unbundle (unbundle +.fact)
|
|
==
|
|
++ add
|
|
|= [ships=(set ship) =path]
|
|
^- (quip card _state)
|
|
?. (~(has by synced) path)
|
|
[~ state]
|
|
:_ state
|
|
%+ turn ~(tap in (~(del in ships) our.bol))
|
|
|= =ship
|
|
(send-invite-poke path ship)
|
|
::
|
|
++ unbundle
|
|
|= =path
|
|
^- (quip card _state)
|
|
?. (~(has by synced) path)
|
|
[~ state]
|
|
:_ state(synced (~(del by synced) path))
|
|
:~ [%pass [%contacts path] %agent [our.bol %contact-store] %leave ~]
|
|
[(contact-poke [%delete path])]
|
|
==
|
|
::
|
|
++ remove
|
|
|= [members=group =path]
|
|
^- (quip card _state)
|
|
:: if pax is synced, remove member from contacts and kick their sub
|
|
=/ owner=(unit ship) (~(get by synced) path)
|
|
?~ owner
|
|
:_ state
|
|
%+ turn ~(tap in members)
|
|
|= =ship
|
|
(contact-poke [%remove path ship])
|
|
:_ state
|
|
%- zing
|
|
%+ turn ~(tap in members)
|
|
|= =ship
|
|
:~ [%give %kick ~[[%contacts path]] `ship]
|
|
?: =(ship our.bol)
|
|
(contact-poke [%delete path])
|
|
(contact-poke [%remove path ship])
|
|
==
|
|
::
|
|
++ send-invite-poke
|
|
|= [=path =ship]
|
|
^- card
|
|
=/ =invite
|
|
:* our.bol %contact-hook
|
|
path ship ''
|
|
==
|
|
=/ act=invite-action [%invite /contacts (shaf %msg-uid eny.bol) invite]
|
|
[%pass / %agent [our.bol %invite-hook] %poke %invite-action !>(act)]
|
|
--
|
|
::
|
|
++ fact-invite-update
|
|
|= [wir=wire fact=invite-update]
|
|
^- (quip card _state)
|
|
?+ -.fact [~ state]
|
|
%accepted
|
|
=/ changes
|
|
(poke-hook-action [%add-synced ship.invite.fact path.invite.fact])
|
|
:-
|
|
%+ welp
|
|
[(group-hook-poke [%add ship.invite.fact path.invite.fact])]~
|
|
-.changes
|
|
+.changes
|
|
==
|
|
::
|
|
++ group-hook-poke
|
|
|= act=group-hook-action
|
|
^- card
|
|
[%pass / %agent [our.bol %group-hook] %poke %group-hook-action !>(act)]
|
|
::
|
|
++ invite-poke
|
|
|= act=invite-action
|
|
^- card
|
|
[%pass / %agent [our.bol %invite-store] %poke %invite-action !>(act)]
|
|
::
|
|
++ contact-poke
|
|
|= act=contact-action
|
|
^- card
|
|
[%pass / %agent [our.bol %contact-store] %poke %contact-action !>(act)]
|
|
::
|
|
++ group-poke
|
|
|= act=group-action
|
|
^- card
|
|
[%pass / %agent [our.bol %group-store] %poke %group-action !>(act)]
|
|
::
|
|
++ contacts-scry
|
|
|= pax=path
|
|
^- (unit contacts)
|
|
=. pax ;:(weld /=contact-store/(scot %da now.bol)/contacts pax /noun)
|
|
.^((unit contacts) %gx pax)
|
|
::
|
|
++ invite-scry
|
|
|= uid=serial
|
|
^- (unit invite)
|
|
=/ pax
|
|
/=invite-store/(scot %da now.bol)/invite/contacts/(scot %uv uid)/noun
|
|
.^((unit invite) %gx pax)
|
|
::
|
|
++ group-scry
|
|
|= pax=path
|
|
^- (unit group)
|
|
.^((unit group) %gx ;:(weld /=group-store/(scot %da now.bol) pax /noun))
|
|
::
|
|
++ pull-wire
|
|
|= pax=path
|
|
^- (list card)
|
|
?> ?=(^ pax)
|
|
=/ shp (~(get by synced) t.pax)
|
|
?~ shp ~
|
|
?: =(u.shp our.bol)
|
|
[%pass pax %agent [our.bol %chat-store] %leave ~]~
|
|
[%pass pax %agent [u.shp %chat-hook] %leave ~]~
|
|
--
|