mirror of
https://github.com/urbit/shrub.git
synced 2024-12-22 18:31:44 +03:00
272 lines
7.3 KiB
Plaintext
272 lines
7.3 KiB
Plaintext
:: contact-store [landscape]:
|
|
::
|
|
:: data store that holds individual contact data
|
|
::
|
|
/- store=contact-store, *resource
|
|
/+ default-agent, dbug, *migrate, contact, verb
|
|
|%
|
|
+$ card card:agent:gall
|
|
+$ state-4
|
|
$: %4
|
|
=rolodex:store
|
|
allowed-groups=(set resource)
|
|
allowed-ships=(set ship)
|
|
is-public=_|
|
|
==
|
|
+$ versioned-state
|
|
$% [%0 *]
|
|
[%1 *]
|
|
[%2 *]
|
|
[%3 *]
|
|
state-4
|
|
==
|
|
--
|
|
::
|
|
=| state-4
|
|
=* state -
|
|
%- agent:dbug
|
|
%+ verb |
|
|
^- agent:gall
|
|
|_ =bowl:gall
|
|
+* this .
|
|
def ~(. (default-agent this %|) bowl)
|
|
con ~(. contact bowl)
|
|
::
|
|
++ on-init
|
|
=. rolodex (~(put by rolodex) our.bowl *contact:store)
|
|
[~ this(state state)]
|
|
::
|
|
++ on-save !>(state)
|
|
++ on-load
|
|
|= old-vase=vase
|
|
^- (quip card _this)
|
|
=/ old !<(versioned-state old-vase)
|
|
?+ -.old
|
|
=. rolodex (~(put by rolodex) our.bowl *contact:store)
|
|
[~ this(state state)]
|
|
::
|
|
%4 [~ this(state old)]
|
|
==
|
|
::
|
|
++ on-watch
|
|
|= =path
|
|
^- (quip card _this)
|
|
?> (team:title our.bowl src.bowl)
|
|
|^
|
|
=/ cards=(list card)
|
|
?+ path (on-watch:def path)
|
|
[%all ~] (give [%initial rolodex is-public])
|
|
[%updates ~] ~
|
|
::
|
|
[%our ~]
|
|
%- give
|
|
:+ %add
|
|
our.bowl
|
|
=/ contact=(unit contact:store) (~(get by rolodex) our.bowl)
|
|
?~ contact *contact:store
|
|
u.contact
|
|
==
|
|
[cards this]
|
|
::
|
|
++ give
|
|
|= =update:store
|
|
^- (list card)
|
|
[%give %fact ~ [%contact-update-0 !>(update)]]~
|
|
--
|
|
::
|
|
++ on-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
?> (team:title our.bowl src.bowl)
|
|
|^
|
|
=^ cards state
|
|
?+ mark (on-poke:def mark vase)
|
|
%contact-update-0 (update !<(update:store vase))
|
|
%import (import q.vase)
|
|
==
|
|
[cards this]
|
|
::
|
|
++ update
|
|
|= =update:store
|
|
^- (quip card _state)
|
|
|^
|
|
?- -.update
|
|
%initial (handle-initial +.update)
|
|
%add (handle-add +.update)
|
|
%remove (handle-remove +.update)
|
|
%edit (handle-edit +.update)
|
|
%allow (handle-allow +.update)
|
|
%disallow (handle-disallow +.update)
|
|
%set-public (handle-set-public +.update)
|
|
==
|
|
::
|
|
++ handle-initial
|
|
|= [rolo=rolodex:store *]
|
|
^- (quip card _state)
|
|
=/ our-contact (~(got by rolodex) our.bowl)
|
|
=/ diff-rolo=rolodex:store
|
|
%- ~(gas by *rolodex:store)
|
|
%+ skim ~(tap in rolo)
|
|
|= [=ship =contact:store]
|
|
?~ local-con=(~(get by rolodex) ship) %.y
|
|
(gth last-updated.contact last-updated.u.local-con)
|
|
=/ new-rolo=rolodex:store
|
|
(~(uni by rolodex) diff-rolo)
|
|
=. new-rolo (~(put by new-rolo) our.bowl our-contact)
|
|
?: =(new-rolo rolodex) `state
|
|
:_ state(rolodex new-rolo)
|
|
(send-diff [%initial new-rolo is-public] %.n)
|
|
::
|
|
++ handle-add
|
|
|= [=ship =contact:store]
|
|
^- (quip card _state)
|
|
:: ensure difference
|
|
=/ old=(unit contact:store) (~(get by rolodex) ship)
|
|
?. ?| ?=(~ old)
|
|
!=(contact(last-updated *@da) u.old(last-updated *@da))
|
|
==
|
|
[~ state]
|
|
~| "cannot add a data url to cover!"
|
|
?> ?| ?=(~ cover.contact)
|
|
!=('data:' (cut 3 [0 5] u.cover.contact))
|
|
==
|
|
~| "cannot add a data url to avatar!"
|
|
?> ?| ?=(~ avatar.contact)
|
|
!=('data:' (cut 3 [0 5] u.avatar.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)
|
|
[~ state]
|
|
:- (send-diff [%remove ship] =(ship our.bowl))
|
|
?: =(ship our.bowl)
|
|
state(rolodex (~(put by rolodex) our.bowl *contact:store))
|
|
state(rolodex (~(del by rolodex) ship))
|
|
::
|
|
++ handle-edit
|
|
|= [=ship =edit-field:store timestamp=@da]
|
|
|^
|
|
^- (quip card _state)
|
|
=/ old (fall (~(get by rolodex) ship) *contact:store)
|
|
?: (lte timestamp last-updated.old)
|
|
[~ state]
|
|
=/ contact (edit-contact old edit-field)
|
|
?: =(old contact)
|
|
[~ state]
|
|
~| "cannot add a data url to cover!"
|
|
?> ?| ?=(~ cover.contact)
|
|
!=('data:' (cut 3 [0 5] u.cover.contact))
|
|
==
|
|
~| "cannot add a data url to avatar!"
|
|
?> ?| ?=(~ avatar.contact)
|
|
!=('data:' (cut 3 [0 5] u.avatar.contact))
|
|
==
|
|
=. last-updated.contact timestamp
|
|
:- (send-diff [%edit ship edit-field timestamp] =(ship our.bowl))
|
|
state(rolodex (~(put by rolodex) ship contact))
|
|
::
|
|
++ edit-contact
|
|
|= [=contact:store edit=edit-field:store]
|
|
^- contact:store
|
|
?- -.edit
|
|
%nickname contact(nickname nickname.edit)
|
|
%bio contact(bio bio.edit)
|
|
%status contact(status status.edit)
|
|
%color contact(color color.edit)
|
|
%avatar contact(avatar avatar.edit)
|
|
%cover contact(cover cover.edit)
|
|
::
|
|
%add-group
|
|
contact(groups (~(put in groups.contact) resource.edit))
|
|
::
|
|
%remove-group
|
|
contact(groups (~(del in groups.contact) resource.edit))
|
|
==
|
|
--
|
|
::
|
|
++ handle-allow
|
|
|= =beings:store
|
|
^- (quip card _state)
|
|
:- (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))
|
|
==
|
|
::
|
|
++ handle-disallow
|
|
|= =beings:store
|
|
^- (quip card _state)
|
|
:- (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))
|
|
==
|
|
::
|
|
++ handle-set-public
|
|
|= public=?
|
|
^- (quip card _state)
|
|
:_ state(is-public public)
|
|
(send-diff [%set-public public] %.n)
|
|
::
|
|
++ send-diff
|
|
|= [=update:store our=?]
|
|
^- (list card)
|
|
=/ paths=(list path)
|
|
?: our
|
|
[/updates /our /all ~]
|
|
[/updates /all ~]
|
|
[%give %fact paths %contact-update-0 !>(update)]~
|
|
--
|
|
::
|
|
++ import
|
|
|= arc=*
|
|
^- (quip card _state)
|
|
:: note: we are purposefully wiping all state before state-4
|
|
[~ *state-4]
|
|
--
|
|
::
|
|
++ on-peek
|
|
|= =path
|
|
^- (unit (unit cage))
|
|
?+ path (on-peek:def path)
|
|
[%x %all ~] ``noun+!>(rolodex)
|
|
::
|
|
[%x %contact @ ~]
|
|
=/ =ship (slav %p i.t.t.path)
|
|
=/ contact=(unit contact:store) (~(get by rolodex) ship)
|
|
?~ contact [~ ~]
|
|
:- ~ :- ~ :- %contact-update-0
|
|
!> ^- update:store
|
|
[%add ship u.contact]
|
|
::
|
|
[%x %allowed-ship @ ~]
|
|
=/ =ship (slav %p i.t.t.path)
|
|
``noun+!>((~(has in allowed-ships) ship))
|
|
::
|
|
[%x %is-public ~]
|
|
``noun+!>(is-public)
|
|
::
|
|
[%x %allowed-groups ~]
|
|
``noun+!>(allowed-groups)
|
|
|
|
::
|
|
[%x %is-allowed @ @ @ @ ~]
|
|
=/ is-personal =(i.t.t.t.t.t.path 'true')
|
|
=/ =resource
|
|
?: is-personal
|
|
[our.bowl %'']
|
|
[(slav %p i.t.t.path) i.t.t.t.path]
|
|
=/ =ship (slav %p i.t.t.t.t.path)
|
|
``json+!>(`json`b+(is-allowed:con resource ship))
|
|
==
|
|
::
|
|
++ on-leave on-leave:def
|
|
++ on-agent on-agent:def
|
|
++ on-arvo on-arvo:def
|
|
++ on-fail on-fail:def
|
|
--
|