shrub/pkg/landscape/app/group-store.hoon

740 lines
18 KiB
Plaintext
Raw Normal View History

:: group-store [landscape]:
::
:: Store groups of ships
2019-11-21 02:18:45 +03:00
::
2020-05-15 01:50:04 +03:00
:: group-store stores groups of ships, so that resources in other apps can be
:: associated with a group. The current model of group-store rolls
:: and invites inside this store for simplicity reasons, although
2020-05-15 01:50:04 +03:00
:: these should be prised apart in a future revision of group store.
::
2020-05-21 07:30:02 +03:00
::
2020-05-15 01:50:04 +03:00
:: ## Scry paths
::
:: /y/groups:
:: A listing of the current groups
:: /x/groups/[resource]:
2020-05-15 01:50:04 +03:00
:: The group itself
:: /x/groups/[resource]/join/[ship]:
2020-05-21 07:30:02 +03:00
:: A flag indicated if the ship is permitted to join
2020-05-15 01:50:04 +03:00
::
:: ## Subscription paths
::
:: /groups:
:: A stream of the current updates to the state, sending the initial state
:: upon subscribe.
::
:: ## Pokes
::
:: %group-action:
:: Modify the group. Further documented in /sur/group-store.hoon
::
::
/- *group
/+ store=group-store, default-agent, verb, dbug, resource, *migrate, agentio
/+ gladio
2019-11-21 02:18:45 +03:00
|%
+$ card card:agent:gall
2022-12-09 21:22:04 +03:00
++ ota-host ~sogryp-dister-dozzod-dozzod
2019-11-21 02:18:45 +03:00
::
+$ versioned-state
$% state-zero
2020-05-15 01:50:04 +03:00
state-one
state-two
state-three
2019-11-21 02:18:45 +03:00
==
::
+$ state-zero
[%0 *]
2020-05-15 01:50:04 +03:00
::
+$ state-one
$: %1
=groups:groups-state-one
2019-11-21 02:18:45 +03:00
==
::
+$ state-two
$: %2
=groups
2020-05-15 01:50:04 +03:00
==
::
+$ state-three
$: %3
=groups
wait=(set ship)
==
2019-11-21 02:18:45 +03:00
--
::
=| state-three
2019-11-21 02:18:45 +03:00
=* state -
::
%- agent:dbug
%+ verb &
2019-11-21 02:18:45 +03:00
^- agent:gall
=<
|_ =bowl:gall
+* this .
group-core +>
2020-01-04 00:06:42 +03:00
gc ~(. group-core bowl)
2019-11-21 02:18:45 +03:00
def ~(. (default-agent this %|) bowl)
::
2020-05-21 07:30:02 +03:00
++ on-init on-init:def
2019-11-21 02:18:45 +03:00
++ on-save !>(state)
++ on-load
2020-05-15 01:50:04 +03:00
|= =old=vase
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|^
?- -.old
%3 [(flop cards) this(state old)]
::
%2
%_ $
old [%3 groups.old ~]
cards
%- welp
:_ cards
:~ [%pass /pyre/export %agent [our dap]:bowl %poke noun+!>(%export)]
[%pass /pyre/migrate %agent [our dap]:bowl %poke noun+!>(%migrate)]
2022-12-07 01:30:04 +03:00
[%pass / %agent [our %hood]:bowl %poke %kiln-install !>([%groups ota-host %groups])]
[%pass / %agent [our %hood]:bowl %poke %kiln-install !>([%talk ota-host %talk])]
==
==
::
%1
%_ $
-.old %2
groups.old (groups-1-to-2 groups.old)
==
::
%0 $(old *state-two)
==
2020-06-24 03:28:57 +03:00
::
++ groups-1-to-2
|= =groups:groups-state-one
^+ ^groups
%- ~(run by groups)
|= =group:groups-state-one
=/ =tags
(tags-1-to-2 tags.group)
[members.group tags [policy hidden]:group]
::
++ tags-1-to-2
|= =tags:groups-state-one
^- ^tags
%- ~(gas by *^tags)
%+ murn
~(tap by tags)
|= [=tag:groups-state-one ships=(set ship)]
?^ tag ~
`[tag ships]
--
2019-11-21 02:18:45 +03:00
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?> (team:title our.bowl src.bowl)
=^ cards state
?+ mark (on-poke:def mark vase)
%sane (poke-sane:gc !<(?(%check %fix) vase))
::
%noun
?+ q.vase !!
%migrate poke-migrate:gc
%export poke-export:gc
2022-12-14 21:46:36 +03:00
%rebuild poke-rebuild:gc
==
::
2021-03-11 06:50:36 +03:00
?(%group-update-0 %group-action)
2020-05-15 01:50:04 +03:00
(poke-group-update:gc !<(update:store vase))
2020-12-01 00:06:05 +03:00
::
%import
(poke-import:gc q.vase)
==
2019-11-21 02:18:45 +03:00
[cards this]
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
2022-12-09 05:22:22 +03:00
?: ?=([%wait ~] path)
`this
2020-05-15 01:50:04 +03:00
?> ?=([%groups ~] path)
:_ this
2021-03-11 06:50:36 +03:00
[%give %fact ~ %group-update-0 !>([%initial groups])]~
2019-11-21 02:18:45 +03:00
::
++ on-leave on-leave:def
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path (on-peek:def path)
2022-12-09 05:22:22 +03:00
[%x %wait ~]
``ships+!>(~(tap in wait))
2020-05-27 07:32:43 +03:00
[%y %groups ~]
``noun+!>(`(set resource)`~(key by groups))
2020-05-27 07:32:43 +03:00
::
[%x %groups %ship @ @ ~]
=/ rid=(unit resource)
(de-path-soft:resource t.t.path)
?~ rid ~
``noun+!>(`(unit group)`(peek-group u.rid))
2020-05-27 07:32:43 +03:00
::
[%x %groups %ship @ @ %join @ ~]
=/ rid=(unit resource)
(de-path-soft:resource t.t.path)
2020-05-21 07:30:02 +03:00
=/ =ship
(slav %p i.t.t.t.t.t.t.path)
?~ rid ~
``noun+!>(`?`(peek-group-join u.rid ship))
2020-12-01 00:06:05 +03:00
::
[%x %export ~]
``noun+!>(state)
2019-11-21 02:18:45 +03:00
==
::
2020-12-01 00:06:05 +03:00
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
2022-11-29 06:17:28 +03:00
=^ cards state
?+ wire [- state]:(on-agent:def wire sign)
[%pyre *] (take-pyre:gc t.wire sign)
[%gladio @ ~] (take-migrate:gc sign)
2022-11-29 06:17:28 +03:00
::
[%try-rejoin @ *]
?> ?=(%poke-ack -.sign)
=/ rid=resource (de-path:resource t.t.wire)
?~ p.sign
=/ =cage
[%pull-hook-action !>([%add entity.rid rid])]
:_ state
[%pass / %agent [our.bowl %group-pull-hook] %poke cage]~
=/ nack-count=@ud (slav %ud i.t.wire)
=/ wakeup=@da
(add now.bowl (mul ~s1 (bex (min 19 nack-count))))
:_ state
[%pass wire %arvo %b %wait wakeup]~
==
[cards this]
2020-12-01 00:06:05 +03:00
::
++ on-arvo
2022-12-09 02:21:09 +03:00
|= [=(pole knot) =sign-arvo]
2020-12-01 00:06:05 +03:00
^- (quip card _this)
2022-12-09 02:21:09 +03:00
?: ?=([%gladio %backoff ship=@ ~] pole)
=^ cards state
(take-backoff:gc (slav %p ship.pole) sign-arvo)
[cards this]
?. ?=([%try-rejoin count=@ res=*] pole)
(on-arvo:def pole sign-arvo)
=/ =resource (de-path:resource res.pole)
=/ nack-count=@ud (slav %ud count.pole)
2020-12-08 03:22:26 +03:00
?> ?=([%behn %wake *] sign-arvo)
2020-12-01 00:06:05 +03:00
~? ?=(^ error.sign-arvo)
"behn errored in backoff timers, continuing anyway"
:_ this
[(try-rejoin:gc resource +(nack-count))]~
::
2020-01-04 00:06:42 +03:00
++ on-fail on-fail:def
2019-11-21 02:18:45 +03:00
--
::
|_ bol=bowl:gall
+* io ~(. agentio bol)
2022-12-14 21:46:36 +03:00
++ poke-rebuild
^- (quip card _state)
2022-12-14 22:29:17 +03:00
|^
=. wait
put-missing
=^ cards state
rewatch
2022-12-14 22:29:17 +03:00
[cards state]
::
++ rewatch
2022-12-14 22:29:17 +03:00
=/ wait ~(tap in wait)
=| cards=(list card)
|-
?~ wait
[cards state]
=/ wir /gladio/(scot %p i.wait)
2022-12-14 22:29:17 +03:00
=. cards
:_(cards (watch-init-migrate i.wait))
:: if we have a subscription already, leave first to restart
=? cards
(~(has by wex.bol) [wir i.wait dap.bol])
2023-01-04 03:17:02 +03:00
:_(cards [%pass wir %agent [i.wait %groups] %leave ~])
2022-12-14 22:29:17 +03:00
$(wait t.wait)
::
++ put-missing
=/ wex ~(tap by wex.bol)
|-
?~ wex
wait
=/ [[=wire =ship =term] [acked=? =(pole knot)]]
i.wex
?. ?=([%gladio ship=@ ~] pole)
$(wex t.wex)
$(wex t.wex, wait (~(put in wait) (slav %p ship.pole)))
--
2022-12-14 21:46:36 +03:00
::
++ poke-export
^- (quip card _state)
:_ state
=; =cage
[%pass /export %agent [our.bol %hood] %poke cage]~
drum-put+!>([/groups/jam ~(export gladio bol)])
::
++ poke-migrate
^- (quip card _state)
=^ cards-1=(list card) wait
2022-12-09 05:39:47 +03:00
(~(migrate-start gladio bol) wait)
=/ cards-2=(list card)
2022-12-09 02:21:09 +03:00
(turn ~(tap in wait) watch-init-migrate)
=/ cards (welp cards-1 cards-2)
[cards state(wait wait)]
::
2022-12-09 02:21:09 +03:00
++ watch-init-migrate
|= =ship
^- card
[%pass /gladio/(scot %p ship) %agent [ship %groups] %watch /init]
::
++ backoff-migrate
|= =ship
^- card
[%pass /gladio/backoff/(scot %p ship) %arvo %b %wait (add ~h1 now.bol)]
::
++ take-pyre
|= [=wire =sign:agent:gall]
^- (quip card _state)
:_ state
?> ?=(%poke-ack -.sign)
?~ p.sign
~
[%pass / %pyre leaf/"{<wire>} failed" u.p.sign]~
::
2022-12-09 02:21:09 +03:00
++ take-backoff
|= [=ship sign=sign-arvo]
^- (quip card _state)
?> ?=([%behn %wake *] sign)
?: ?=(^ error.sign)
`state
:_ state
~[(watch-init-migrate ship)]
::
++ take-migrate
|= =sign:agent:gall
^- (quip card _state)
2022-12-09 02:21:09 +03:00
?. (~(has in wait) src.bol)
:: already succeeded
`state
2022-12-09 02:21:09 +03:00
?- -.sign
?(%poke-ack %fact) `state
%kick :_(state (watch-init-migrate src.bol)^~)
%watch-ack
?~ p.sign
:: they have public release
~& migrating/src.bol
2022-12-09 05:22:22 +03:00
=. wait (~(del in wait) src.bol)
:_ state
2022-12-09 20:07:51 +03:00
:- [%give %fact ~[/wait] ships+!>(~(tap in wait))]
2022-12-09 02:21:09 +03:00
(~(migrate-ship gladio bol) src.bol)
:_ state
~[(backoff-migrate src.bol)]
==
::
2020-05-21 07:30:02 +03:00
++ peek-group
|= rid=resource
2020-05-21 07:30:02 +03:00
^- (unit group)
(~(get by groups) rid)
2020-12-01 00:06:05 +03:00
::
2020-05-21 07:30:02 +03:00
++ peek-group-join
|= [rid=resource =ship]
^- ?
=/ ugroup
(~(get by groups) rid)
?~ ugroup
%.n
=* group u.ugroup
2020-05-15 01:50:04 +03:00
=* policy policy.group
?- -.policy
%invite
2020-07-02 05:17:28 +03:00
?| (~(has in pending.policy) ship)
(~(has in members.group) ship)
==
2020-05-15 01:50:04 +03:00
%open
?! ?|
2020-07-02 05:17:28 +03:00
(~(has in banned.policy) ship)
(~(has in ban-ranks.policy) (clan:title ship))
==
2020-05-15 01:50:04 +03:00
==
++ poke-sane
|= input=?(%check %fix)
^- (quip card _state)
=; cards=(list card)
?: =(%check input)
~& cards
`state
[cards state]
%+ roll ~(tap in ~(key by groups))
|= [rid=resource out=(list card)]
?. ?& =(entity.rid our.bol)
!(~(has in members:(~(got by groups) rid)) our.bol)
==
out
=/ =wire
sane+(en-path:resource rid)
=* poke-self ~(poke-self pass:io wire)
%+ weld out
2021-03-18 06:53:57 +03:00
:~ (poke-self group-update-0+!>([%add-members rid (silt our.bol ~)]))
(poke-self group-update-0+!>([%add-tag rid %admin (silt our.bol ~)]))
==
2020-12-01 00:06:05 +03:00
::
++ poke-import
|= arc=*
^- (quip card _state)
|^
=/ sty=state-three
[%3 (remake-groups ;;((tree [resource tree-group]) +.arc)) ~]
2020-12-01 00:06:05 +03:00
:_ sty
%+ roll ~(tap by groups.sty)
2020-12-02 10:03:05 +03:00
|= [[rid=resource grp=group] out=(list card)]
?: =(entity.rid our.bol)
2020-12-01 00:06:05 +03:00
%+ weld out
2020-12-02 10:03:05 +03:00
%+ roll ~(tap in members.grp)
2020-12-01 00:06:05 +03:00
|= [recipient=@p out=(list card)]
?: =(recipient our.bol)
out
:: TODO: figure out contacts integration
out
2020-12-01 00:06:05 +03:00
:_ out
2020-12-02 10:03:05 +03:00
(try-rejoin rid 0)
::
++ remake-groups
|= grps=(tree [resource tree-group])
^- ^groups
%- remake-map
(~(run by grps) remake-group)
::
2020-12-02 10:03:05 +03:00
++ remake-group
|= grp=tree-group
^- group
2020-12-02 10:03:05 +03:00
%= grp
members (remake-set members.grp)
tags (remake-jug tags.grp)
policy (remake-policy policy.grp)
==
::
2020-12-02 10:03:05 +03:00
+$ tree-group
$: members=(tree ship)
tags=(tree [tag (tree ship)])
policy=tree-policy
hidden=?
==
::
2020-12-02 10:03:05 +03:00
+$ tree-policy
$% [%invite pending=(tree ship)]
[%open ban-ranks=(tree rank:title) banned=(tree ship)]
==
::
2020-12-02 10:03:05 +03:00
++ remake-policy
|= pl=tree-policy
^- policy
?- -.pl
%invite [%invite (remake-set pending.pl)]
%open [%open (remake-set ban-ranks.pl) (remake-set banned.pl)]
==
--
2020-05-15 01:50:04 +03:00
::
2020-12-01 00:06:05 +03:00
++ try-rejoin
|= [rid=resource nack-count=@ud]
^- card
=/ =cage
2021-03-11 06:50:36 +03:00
:- %group-update-0
2020-12-01 00:06:05 +03:00
!> ^- update:store
[%add-members rid (sy our.bol ~)]
=/ =wire
[%try-rejoin (scot %ud nack-count) (en-path:resource rid)]
[%pass wire %agent [entity.rid %group-push-hook] %poke cage]
::
2020-05-15 01:50:04 +03:00
++ poke-group-update
|= =update:store
2019-11-21 02:18:45 +03:00
^- (quip card _state)
?> (team:title our.bol src.bol)
2020-05-15 01:50:04 +03:00
|^
?- -.update
%add-group (add-group +.update)
%add-members (add-members +.update)
%remove-members (remove-members +.update)
%add-tag (add-tag +.update)
%remove-tag (remove-tag +.update)
%change-policy (change-policy +.update)
%remove-group (remove-group +.update)
2020-07-02 05:17:28 +03:00
%expose (expose +.update)
2020-05-15 01:50:04 +03:00
%initial-group (initial-group +.update)
%initial [~ state]
2019-11-21 02:18:45 +03:00
==
2020-07-02 05:17:28 +03:00
:: +expose: unset .hidden flag
2020-05-27 07:32:43 +03:00
::
2020-07-02 05:17:28 +03:00
++ expose
|= [rid=resource ~]
2020-05-27 07:32:43 +03:00
^- (quip card _state)
=/ =group
(~(got by groups) rid)
2020-05-27 07:32:43 +03:00
=. hidden.group %.n
=. groups
(~(put by groups) rid group)
2020-05-27 07:32:43 +03:00
:_ state
2020-07-02 05:17:28 +03:00
(send-diff %expose rid ~)
2020-05-15 01:50:04 +03:00
:: +add-group: add group to store
::
2020-07-02 05:17:28 +03:00
:: no-op if group already exists
2020-05-15 01:50:04 +03:00
::
++ add-group
|= [rid=resource =policy hidden=?]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
?< (~(has by groups) rid)
2020-05-21 07:30:02 +03:00
=| =group
=. policy.group policy
2020-05-27 07:32:43 +03:00
=. hidden.group hidden
2020-05-27 09:19:29 +03:00
=. tags.group
(~(put ju tags.group) %admin our.bol)
2020-05-15 01:50:04 +03:00
=. groups
(~(put by groups) rid group)
2020-05-15 01:50:04 +03:00
:_ state
(send-diff %add-group rid policy hidden)
2020-05-15 01:50:04 +03:00
:: +add-members: add members to group
::
++ add-members
|= [rid=resource new-ships=(set ship)]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
=. groups
2020-07-02 05:17:28 +03:00
%+ ~(jab by groups) rid
|= group
%= +<
members (~(uni in members) new-ships)
::
policy
?. ?=(%invite -.policy)
policy
policy(pending (~(dif in pending.policy) new-ships))
==
2020-05-15 01:50:04 +03:00
:_ state
(send-diff %add-members rid new-ships)
2020-05-15 01:50:04 +03:00
:: +remove-members: remove members from group
::
:: no-op if group does not exist
2020-05-21 07:30:02 +03:00
::
2020-05-15 01:50:04 +03:00
::
++ remove-members
|= [rid=resource ships=(set ship)]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
?. (~(has by groups) rid) [~ state]
2020-05-15 01:50:04 +03:00
=. groups
2020-07-02 05:17:28 +03:00
%+ ~(jab by groups) rid
|= group
%= +<
members (~(dif in members) ships)
tags (remove-tags +< ships)
==
2020-05-15 01:50:04 +03:00
:_ state
(send-diff %remove-members rid ships)
2020-05-15 01:50:04 +03:00
:: +add-tag: add tag to ships
::
2020-05-27 09:19:29 +03:00
:: crash if ships are not in group
2020-05-15 01:50:04 +03:00
::
++ add-tag
|= [rid=resource =tag ships=(set ship)]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
=. groups
2020-07-02 05:17:28 +03:00
%+ ~(jab by groups) rid
|= group
?> ?=(~ (~(dif in ships) members))
+<(tags (merge-tags tags ships (sy tag ~)))
2020-05-15 01:50:04 +03:00
:_ state
(send-diff %add-tag rid tag ships)
2020-05-15 01:50:04 +03:00
:: +remove-tag: remove tag from ships
::
:: crash if ships are not in group or tag does not exist
2020-05-15 01:50:04 +03:00
::
++ remove-tag
|= [rid=resource =tag ships=(set ship)]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
=. groups
2020-07-02 05:17:28 +03:00
%+ ~(jab by groups) rid
|= group
?> ?& ?=(~ (~(dif in ships) members))
(~(has by tags) tag)
==
%= +<
tags (dif-ju tags tag ships)
2020-07-02 05:17:28 +03:00
==
2020-05-15 01:50:04 +03:00
:_ state
(send-diff %remove-tag rid tag ships)
2020-05-15 01:50:04 +03:00
:: initial-group: initialize foreign group
::
++ initial-group
|= [rid=resource =group]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
=. groups
(~(put by groups) rid group)
2020-05-15 01:50:04 +03:00
:_ state
(send-diff %initial-group rid group)
2020-05-15 01:50:04 +03:00
:: +change-policy: modify group access control
::
2020-05-21 07:30:02 +03:00
:: If the change will kick members, then send a separate
:: %remove-members diff after the %change-policy diff
2020-05-15 01:50:04 +03:00
++ change-policy
|= [rid=resource =diff:policy]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
?. (~(has by groups) rid)
2020-05-15 01:50:04 +03:00
[~ state]
=/ =group
(~(got by groups) rid)
2020-05-15 01:50:04 +03:00
|^
2020-05-21 07:30:02 +03:00
=^ cards group
?- -.diff
%open (open +.diff)
%invite (invite +.diff)
%replace (replace +.diff)
2020-05-15 01:50:04 +03:00
==
=. groups
(~(put by groups) rid group)
2020-05-15 01:50:04 +03:00
:_ state
2020-05-21 07:30:02 +03:00
%+ weld
(send-diff %change-policy rid diff)
2020-05-21 07:30:02 +03:00
cards
2020-05-15 01:50:04 +03:00
::
++ open
|= =diff:open:policy
?- -.diff
%allow-ranks (allow-ranks +.diff)
%ban-ranks (ban-ranks +.diff)
%allow-ships (allow-ships +.diff)
%ban-ships (ban-ships +.diff)
==
::
++ invite
|= =diff:invite:policy
?- -.diff
%add-invites (add-invites +.diff)
%remove-invites (remove-invites +.diff)
==
::
2020-05-15 01:50:04 +03:00
++ allow-ranks
|= ranks=(set rank:title)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. ban-ranks.policy.group
(~(dif in ban-ranks.policy.group) ranks)
2020-05-21 07:30:02 +03:00
`group
2020-05-15 01:50:04 +03:00
::
++ ban-ranks
|= ranks=(set rank:title)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. ban-ranks.policy.group
(~(uni in ban-ranks.policy.group) ranks)
2020-05-21 07:30:02 +03:00
`group
2020-05-15 01:50:04 +03:00
::
++ allow-ships
|= ships=(set ship)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. banned.policy.group
(~(dif in banned.policy.group) ships)
`group
2020-05-15 01:50:04 +03:00
::
++ ban-ships
|= ships=(set ship)
2020-05-21 07:30:02 +03:00
^- (quip card _group)
?> ?=(%open -.policy.group)
=. banned.policy.group
(~(uni in banned.policy.group) ships)
=/ to-remove=(set ship)
(~(int in members.group) banned.policy.group)
:- ~[(poke-us %remove-members rid to-remove)]
2020-05-21 07:30:02 +03:00
group
::
++ add-invites
|= ships=(set ship)
^- (quip card _group)
?> ?=(%invite -.policy.group)
=. pending.policy.group
(~(uni in pending.policy.group) ships)
`group
::
++ remove-invites
|= ships=(set ship)
^- (quip card _group)
?> ?=(%invite -.policy.group)
=. pending.policy.group
(~(dif in pending.policy.group) ships)
2020-05-21 07:30:02 +03:00
`group
++ replace
|= =policy
^- (quip card _group)
=. policy.group
policy
`group
2020-05-15 01:50:04 +03:00
--
:: +remove-group: remove group from store
::
:: no-op if group does not exist
++ remove-group
|= [rid=resource ~]
2020-05-15 01:50:04 +03:00
^- (quip card _state)
?. (~(has by groups) rid)
2020-05-15 01:50:04 +03:00
`state
=. groups
(~(del by groups) rid)
2020-05-15 01:50:04 +03:00
:_ state
(send-diff %remove-group rid ~)
2020-05-15 01:50:04 +03:00
::
--
:: TODO: move to +zuse
++ dif-ju
|= [=tags =tag remove=(set ship)]
=/ ships ~(tap in remove)
|-
?~ ships
tags
$(tags (~(del ju tags) tag i.ships), ships t.ships)
::
2020-05-25 08:52:54 +03:00
++ merge-tags
|= [=tags ships=(set ship) new-tags=(set tag)]
2020-05-27 09:19:29 +03:00
^+ tags
=/ tags-list ~(tap in new-tags)
2020-05-25 08:52:54 +03:00
|-
2020-05-27 09:19:29 +03:00
?~ tags-list
tags
=* tag i.tags-list
=/ old-ships=(set ship)
(~(gut by tags) tag ~)
2020-05-25 08:52:54 +03:00
%= $
2020-05-27 09:19:29 +03:00
tags-list t.tags-list
2020-05-25 08:52:54 +03:00
::
2020-05-27 09:19:29 +03:00
tags
%+ ~(put by tags)
tag
(~(uni in old-ships) ships)
2020-05-25 08:52:54 +03:00
==
2020-05-21 07:30:02 +03:00
++ remove-tags
|= [=group ships=(set ship)]
2020-05-27 09:19:29 +03:00
^- tags
%- malt
2020-05-25 08:52:54 +03:00
%+ turn
2020-05-27 09:19:29 +03:00
~(tap by tags.group)
2020-05-21 07:30:02 +03:00
|= [=tag tagged=(set ship)]
:- tag
(~(dif in tagged) ships)
::
++ poke-us
|= =action:store
^- card
[%pass / %agent [our.bol %group-store] %poke %group-action !>(action)]
2020-05-15 01:50:04 +03:00
:: +send-diff: update subscribers of new state
2019-11-21 02:18:45 +03:00
::
2020-05-15 01:50:04 +03:00
:: We only allow subscriptions on /groups
:: so just give the fact there.
2019-11-21 02:18:45 +03:00
++ send-diff
2020-05-15 01:50:04 +03:00
|= =update:store
2019-11-21 02:18:45 +03:00
^- (list card)
2021-03-11 06:50:36 +03:00
[%give %fact ~[/groups] %group-update-0 !>(update)]~
2019-11-21 02:18:45 +03:00
::
--